?

Log in

No account? Create an account
entries friends calendar profile Previous Previous Next Next
Maelstrom sums - Ed's journal
sobrique
sobrique
Maelstrom sums
Anyone fancy trying out a calculator for me? Needs perl, and also needs some idea of currencies in maelstrom.

Might want to think about bunging it up on a webshite somewhere... Hmm, maybe I'll send it to PD :)

Taken from the Profound Decisions website

Seems to work mostly, but don't do horrible things like adding Marks, Schillings and Pfecks to Kyats, because it doesn't do 'exchanges'. It just guesses based on the first one, what the currency (and hence the 'base') you're wanting to work in actually is. Seems to work nicely for kyat, but didn't really test on '3 stage' currencies. ( x kyat x riel * 10 / 9 works well for calculating 'house commission')


#!/bin/perl

use strict;
use warnings;

my $operators = "\=\-\/\*";
my $debug = 0;

my $currency = 'Kyat'; #read from command line maybe?

#using integers. So will give INTEGER logic for divisions.
#can use '%' for modulus though, which is nice. 
use integer;

#the currency conversion table. Reckoning is in 'basic unit' which can be 
#anything you like really. but it would seem to make more sense to have it as 
#one of the smallest unit of currency. All that's really vital though is that 
#the ratios are correct, since it converts to and from. 

my %currencies =
(
  'Kyat' => 
  {
    "ky" => 81, #kyat 
    "ri" => 1, #riel
  },
  'Mark' => 
  {
    "m" => 240, #mark
    "sch" => 12, #schilling
    "pf" => 1,   #pfeck
  },
  'Florin' =>
  {
    "fl" => 120, #florin
    "gu" => 15,  #guilder
    "bu" => 1,   #bushel
  },
  'Ducatto' =>
  {
    "sd" => 1, #silver ducatto
    "gd" => 128, #gold ducatto
                 #recognise the 'full' name.
  }
);

#expecting $line to look like 10 kyat 22 riel + 13 kyat 12 riel
while ( my $line =  )
{
  my @stuff = split ( " ", $line );

  #make a guess what currency we're using. Will do rather strange things if you 
  #try and add kyats to marks. Might get as far as trying to factor some 
  #exchange rates in, but for now, this'll do. 

  foreach my $cur ( %currencies )
  {
    foreach my $denom ( keys %{$currencies{$cur}} )
    {
      if ( $line =~ m/$denom/i ) 
      {
        if ( $debug ) { print "setting currency to $cur\n"; }
        $currency = $cur;
        last;
      }
    }
  }

  #evil here. Basically pulls one element at a time from the @stuff array, 
  #and 'does things'. assumes a 'currency' is a close associative multiplier 
  #operation.

  my @sum;
  while ( $#stuff >= 0 )
  {
    if ( $debug ) { print "$#stuff\n"; }

    #grab 'things' from @stuff, up as far as an operand. Once we get 
    #one of those, push them all 'back' into it.
    my $thingy = shift ( @stuff ); #grab 'head' of array.

    if ( $thingy =~ m/^\d+$/ ) 
    {
      if ( $debug ) { print "got $thingy which is numeric.\n"; }
      #single numeric thing, so stuff it on 'sum' 
      push ( @sum, $thingy );
    }

    if ( $thingy =~ m/[\+\-\*\/\%]/ )# is it +-*/% if so, just put that in sum, 
                                   # because we eval later 
    { 
      if ( $debug ) { print "got $thingy which is operand\n"; }
      #so now we 'run' sum, and stick stuff together. 
      push ( @sum, $thingy );
      next;
    }
    
    if ( $thingy =~ m/^\D+$/ ) #non digit. So a word. Like 'Kyat' 'Riel' etc. 
    {
      if ( $debug ) { print "got $thingy which is a wordy thing.\n"; }
      foreach my $denomination ( 
         keys ( %{$currencies{$currency}} ) #does our word match a 
                                            #denomination from the the currency
      )
      {
        if ( $debug ) { print "comparing $thingy with $denomination\n"; }
        if ( $thingy =~ m/$denomination/i ) 
        {  
          if ( $debug ) { print "got match on $denomination and $thingy\n";  }

          #got to do this to turn 4 kyat 22 riel into a single number of 
          #'units', but still cope with '22kyat' with no riels specified. 
          if ( $debug ) { print "Num ent in sum = $#sum\n"; }
          if ( $#sum > 0 && $sum[$#sum-1] =~ m/\d+/ ) 
          { 
            if ( $debug ) { print "merging values becaues $sum[$#sum-1]\n"; }
            push ( @sum, pop ( @sum ) * $currencies{$currency}{$denomination} 
                           + pop(@sum) );
          }
          else
          {
            if ( $debug ) { print "not merging values\n"; }
            if ( $#sum >= 0 )
            {
              push ( @sum, pop ( @sum ) * $currencies{$currency}{$denomination});
            }
          }
        }
      }
    }
    if ( $debug ) { print join(":",@sum)," and ", join(":", @stuff ),"\n"; }
  }

  # now we have an array that _should_ look like 1034 + 11 * 15 which we can do 
  #'normal' arithmetic with, and then convert to 'consolidated' values. 
  #(1 kyat 9 ri being '90' as a measure of ri.) 

  my $result = eval join(" ", @sum );
  if ( $debug ) { print "Result = $result\n"; }

  #trust me this works. It does so by doing it in 'highest first' order, 
  #because it's really sloppy to trust the sequence of 'keys' from a hash, 
  #since that's undefined 
  foreach my $key ( 
        sort { $currencies{$currency}{$b} <=> $currencies{$currency}{$a} } 
          keys ( %{$currencies{$currency}} ) )
  {
    if ( $debug ) { print $result,"\n"}

    if ( $result ) 
    {
      print $result / $currencies{$currency}{$key}, " $key ";
      $result = $result % $currencies{$currency}{$key};
    }
    else
    {
      print "0"; last
    }
  }
  print "\n";
}

Leave a comment