[system] / trunk / pg / macros / contextCurrency.pl Repository:
ViewVC logotype

View of /trunk/pg/macros/contextCurrency.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5385 - (download) (as text) (annotate)
Sun Aug 19 20:02:41 2007 UTC (12 years, 6 months ago) by dpvc
File size: 16496 byte(s)
Added context flags to more finely control the allowed entry format
(e.g., force the use of commas, force the use of decimal places, and
so on.)  See the documentation at the top of the file for details.

    1 loadMacros("MathObjects.pl");
    2 loadMacros("problemPreserveAnswers.pl");  # needed to preserve $ in answers
    3 
    4 sub _contextCurrency_init {Currency::Init()}
    5 
    6 =head1 Context("Currency");
    7 
    8  ######################################################################
    9  #
   10  #  This file implements a context in which students can enter currency
   11  #  values that include a currency symbol and commas every three digits.
   12  #  You can specify what the currency symbol is, as well as what gets
   13  #  used for commas and decimals.
   14  #
   15  #  To use the context, put
   16  #
   17  #    loadMacros("contextCurrency.pl");
   18  #
   19  #  at the top of your problem file, and then issue the
   20  #
   21  #    Context("Currency");
   22  #
   23  #  command to select the context.  You can set the currency symbol
   24  #  and the comma or decimal values as in the following examples
   25  #
   26  #    Context()->currency->set(symbol=>'#');
   27  #    Context()->currency->set(symbol=>'euro');          # accepts '12 euro'
   28  #    Context()->currency->set(comma=>'.',decimal=>','); # accepts '10.000,00'
   29  #
   30  #  You can add additional symbols (in case you want to allow
   31  #  more than one way to write the currency).  For example:
   32  #
   33  #    Context("Currency")->currency->addSymbol("dollars","dollar");
   34  #
   35  #  would accept '$12,345.67' or '12.50 dollars' or '1 dollar' as
   36  #  acceptable values.  Note that if the symbol cantains any
   37  #  alphabetic characters, it is expected to come at the end of the
   38  #  number (as in the examples above) and if the symbol has only
   39  #  non-alphabetic characters, it comes before it.  You can change
   40  #  this as in these examples:
   41  #
   42  #    Context()->currency->setSymbol(euro=>{associativity=>"left"});
   43  #    Context()->currency->setSymbol('#'=>{associativity=>"right"});
   44  #
   45  #  You can remove a symbol as follows:
   46  #
   47  #    Context()->currency->removeSymbol('dollar');
   48  #
   49  #  To create a currency value, use
   50  #
   51  #    $m = Currency(10.99);
   52  #
   53  #  or
   54  #
   55  #    $m1 = Compute('$10.99');
   56  #    $m2 = Compute('$10,000.00');
   57  #
   58  #  and so on.  Be careful, however, that you do not put dollar signs
   59  #  inside double quotes, as this refers to variable substitution.
   60  #  For example,
   61  #
   62  #    $m = Compute("$10.99");
   63  #
   64  #  will most likely set $m to the Real value .99 rather than the
   65  #  monitary value of $10.99, since perl thinks $10 is the name of
   66  #  a variable, and will substitute that into the string before
   67  #  processing it.  Since that variable is most likely empty, the
   68  #  result will be the same as $m = Compute(".99");
   69  #
   70  #  You can use monitary values within computations, as in
   71  #
   72  #    $m1 = Compute('$10.00');
   73  #    $m2 = 3*$m1;  $m3 = $m2 + .5;
   74  #    $m4 = Compute('$10.00 + $2.59');
   75  #
   76  #  so that $m2 will be $30.00, $m3 will be $30.50, and $m4 will
   77  #  be $12.59.  Students can perform computations within their
   78  #  answers unless you disable the operators and functions as well.
   79  #
   80  #  The tolerance for this context is set initially to .005 and the
   81  #  tolType to 'absolute' so that monitary values will have to match
   82  #  to the nearest penny.  You can change that on a global basis
   83  #  using
   84  #
   85  #    Context()->flags->set(tolerance=>.0001,tolType=>"relative");
   86  #
   87  #  for example.  You can also change the tolerance on an individual
   88  #  currency value as follows:
   89  #
   90  #    $m = Compute('$1,250,000.00')->
   91  #              with(tolerance=>.0001,tolType=>'relative');
   92  #
   93  #  By default, the answer checker for Currency values requires
   94  #  the student to enter the currency symbol, not just a real number.
   95  #  You can relax that condition by including the promoteReals=>1
   96  #  option to the cmp() method of the Currency value.  For example,
   97  #
   98  #    ANS(Compute('$150')->cmp(promoteReals=>1));
   99  #
  100  #  would allow the student to enter just 150 rather than $150.
  101  #
  102  #  By default, the students may omit the commas, but you can
  103  #  force them to supply the commas using forceCommas=>1 in
  104  #  your cmp() call.
  105  #
  106  #    ANS(Compute('$10,000.00')->cmp(forceCommas=>1));
  107  #
  108  #  By default, students need not enter decimal digits, so could use
  109  #  $100 or $1,000. as valid entries.  You can require that the cents
  110  #  be provided using the forceDecimals=>1 flag.
  111  #
  112  #    ANS(Compute('$10.95')->cmp(forceDecimals=>1));
  113  #
  114  #  By default, if the monitary value includes decimals digits, it
  115  #  must have exactly two.  You can weaken this requirement to all
  116  #  any number of decimals by using noExtraDecimals=>0.
  117  #
  118  #    ANS(Compute('$10.23372')->cmp(noExtraDecimals=>0);
  119  #
  120  #  If forceDecimals is set to 1 at the same time, then they must
  121  #  have 2 or more decimals, otherwise any number is OK.
  122  #
  123  ######################################################################
  124 
  125 =cut
  126 
  127 package Currency;
  128 
  129 #
  130 #  Initialization creates a Currency context object
  131 #  and sets up a Currency() constructor.
  132 #
  133 sub Init {
  134   my $context = $main::context{Currency} = new Currency::Context();
  135   main::PG_restricted_eval('sub Currency {Value->Package("Currency")->new(@_)}');
  136 }
  137 
  138 #
  139 #  Quote characters that are special in regular expressions
  140 #
  141 sub quoteRE {
  142   my $s = shift;
  143   $s =~ s/([-\\^\$+*?.\[\](){}])/\\$1/g;
  144   return $s;
  145 }
  146 
  147 #
  148 #  Quote common TeX special characters, and put
  149 #  the result in {\rm ... } if there are alphabetic
  150 #  characters included.
  151 #
  152 sub quoteTeX {
  153   my $s = shift;
  154   my $isText = ($s =~ m/[a-z]/i);
  155   $s =~ s/\\/\\backslash /g;
  156   $s =~ s/([\#\$%^_&{} ])/\\$1/g;
  157   $s =~ s/([~\'])/{\\tt\\char\`\\$1}/g;
  158   $s =~ s/,/{,}/g;
  159   $s = "{\\rm $s}" if $isText;
  160   return $s;
  161 }
  162 
  163 ######################################################################
  164 ######################################################################
  165 #
  166 #  The Currency context has an extra "currency" data
  167 #  type (like flags, variables, etc.)
  168 #
  169 #  It also creates some patterns needed for handling
  170 #  currency values, and sets the Parser and Value
  171 #  hashes to activate the Currency objects.
  172 #
  173 #  The tolerance is set to .005 absolute so that
  174 #  answers must be correct to the penny.  You can
  175 #  change this in the context, or for individual
  176 #  currency values.
  177 #
  178 package Currency::Context;
  179 our @ISA = ('Parser::Context');
  180 
  181 sub new {
  182   my $self = shift; my $class = ref($self) || $self;
  183   my %data = (
  184     decimal => '.',
  185     comma => ',',
  186     symbol => "\$",
  187     associativity => "left",
  188     @_,
  189   );
  190   my $context = bless Parser::Context->getCopy("Numeric"), $class;
  191   $context->{_initialized} = 0;
  192   $context->{_currency} = new Currency::Context::currency($context,%data);
  193   my $symbol = $context->{currency}{symbol};
  194   my $associativity = $context->{currency}{associativity};
  195   my $string = ($symbol =~ m/[a-z]/i ? " $symbol " : $symbol);
  196   $context->{_currency}{symbol} = $symbol;
  197   $context->{parser}{Number} = "Currency::Number";
  198   $context->{value}{Currency} = "Currency::Currency";
  199   $context->operators->remove($symbol) if $context->operators->get($symbol);
  200   $context->operators->add(
  201     $symbol => {precedence => 10, associativity => $associativity, type => "unary", string => $symbol,
  202                 TeX => Currency::quoteTeX($symbol), class => 'Currency::UOP::currency'},
  203   );
  204   $context->flags->set(
  205     tolerance => .005,
  206     tolType => "absolute",
  207     promoteReals => 1,
  208     forceCommas => 0,
  209     forceDecimals => 0,
  210     noExtraDecimals => 1,
  211   );
  212   $context->{_initialized} = 1;
  213   $context->update;
  214   $context->{error}{msg}{"Missing operand after '%s'"} = "There should be a number after '%s'";
  215   return $context;
  216 }
  217 
  218 sub currency {(shift)->{_currency}}   # access to currency data
  219 
  220 
  221 ##################################################
  222 #
  223 #  This is the context data for currency.
  224 #  A special pattern is maintained for the
  225 #  comma form of numbers (using the specified
  226 #  comma and decimal-place characters).
  227 #
  228 #  You specify the currency symbol via
  229 #
  230 #    Context()->currency->set(symbol=>'$');
  231 #    Context()->currency->set(comma=>',',decimal=>'.');
  232 #
  233 #  You can add extra symbols via
  234 #
  235 #    Context()->currency->addSymbol("dollar","dollars");
  236 #
  237 #  If the symbol contains alphabetic characters, it
  238 #  is made to be right-associative (i.e., comes after
  239 #  the number), otherwise it is left-associative (i.e.,
  240 #  before the number).  You can change that for a
  241 #  symbol using
  242 #
  243 #    Context()->currency->setSymbol("Euro"=>{associativity=>"left"});
  244 #
  245 #  Finally, an extra symbol can be removed with
  246 #
  247 #    Context()->currency-removeSymbol("dollar");
  248 #
  249 package Currency::Context::currency;
  250 our @ISA = ("Value::Context::Data");
  251 
  252 #
  253 #  Set up the initial data
  254 #
  255 sub init {
  256   my $self = shift;
  257   $self->{dataName} = 'currency';
  258   $self->{name} = 'currency';
  259   $self->{Name} = 'Currency';
  260   $self->{namePattern} = qr/[-\w_.]+/;
  261   $self->{numberPattern} = qr/\d{1,3}(?:,\d\d\d)+(?:\.\d*)?(?=\D|$)/;
  262   $self->{tokenType} = "num";
  263   $self->{precedence} = -12;
  264   $self->{patterns}{$self->{numberPattern}} = [$self->{precedence},$self->{tokenType}];
  265   $self->{extraSymbols} = [];
  266 }
  267 
  268 sub addToken {}       # no tokens are needed (only uses fixed pattern)
  269 sub removeToken {}
  270 
  271 #
  272 #  Do the usual set() method, but make sure patterns are
  273 #  updated, since the settings may affect the currency
  274 #  pattern.
  275 #
  276 sub set {
  277   my $self = shift;
  278   $self->SUPER::set(@_);
  279   $self->update;
  280 }
  281 
  282 #
  283 #  Create, set and remove extra currency symbols
  284 #
  285 sub addSymbol {
  286   my $self = shift; my $operators = $self->{context}->operators;
  287   my $def = $operators->get($self->{symbol});
  288   foreach my $symbol (@_) {
  289     my ($string,$associativity) = ($symbol =~ m/[a-z]/i ? (" $symbol ","right") : ($symbol,"left"));
  290     push @{$self->{extraSymbols}},$symbol;
  291     $operators->add(
  292       $symbol => {
  293         %{$def}, associativity => $associativity,
  294         string => $string, TeX => Currency::quoteTeX($string),
  295       }
  296     );
  297   }
  298 }
  299 sub setSymbol {(shift)->{context}->operators->set(@_)}
  300 sub removeSymbol {(shift)->{context}->operators->remove(@_)}
  301 
  302 #
  303 #  Update the currency patterns in case the characters have changed,
  304 #  and if the symbol has changed, remove the old operator(s) and
  305 #  create a new one for the given symbol.
  306 #
  307 sub update {
  308   my $self = shift;
  309   my $context = $self->{context};
  310   my $pattern = $context->{pattern};
  311   my $operators = $context->operators;
  312   my $data = $context->{$self->{dataName}};
  313   my ($symbol,$comma,$decimal) = (Currency::quoteRE($data->{symbol}),
  314           Currency::quoteRE($data->{comma}),
  315           Currency::quoteRE($data->{decimal}));
  316   delete $self->{patterns}{$self->{numberPattern}};
  317   $self->{numberPattern} = qr/\d{1,3}(?:$comma\d\d\d)+(?:$decimal\d*)?(?=\D|$)|\d{1,3}$decimal\d*/;
  318   $self->{patterns}{$self->{numberPattern}} = [$self->{precedence},$self->{tokenType}];
  319   $pattern->{currencyChars}   = qr/(?:$symbol|$comma)/;
  320   $pattern->{currencyDecimal} = qr/$decimal/;
  321   if ($self->{symbol} && $self->{symbol} ne $data->{symbol}) {
  322     $operators->redefine($data->{symbol},from=>$context,using=>$self->{symbol});
  323     $operators->remove($self->{symbol});
  324     foreach $symbol (@{$self->{extraSymbols}}) {$operators->remove($symbol) if $operators->get($symbol)}
  325     $self->{extraSymbols} = [];
  326   }
  327   my $string = ($data->{symbol} =~ m/[^a-z]/i ? $data->{symbol} : " $data->{symbol} ");
  328   $context->operators->set($data->{symbol}=>{
  329     associativity => $data->{associativity},
  330     string => $string, tex => Currency::quoteTeX($string),
  331   });
  332   $context->update;
  333 }
  334 
  335 ######################################################################
  336 ######################################################################
  337 #
  338 #  When creating Number objects in the Parser, we need to remove the
  339 #  comma (and currency) characters and replace the decimal character
  340 #  with an actual decimal point.
  341 #
  342 package Currency::Number;
  343 our @ISA = ('Parser::Number');
  344 
  345 sub new {
  346   my $self = shift; my $equation = shift;
  347   my $context = $equation->{context};
  348   my $pattern = $context->{pattern};
  349   my $currency = $context->{currency};
  350   my $value = shift; my $value_string;
  351   if (ref($value) eq "") {
  352     $value_string = "$value";
  353     $value =~ s/$pattern->{currencyChars}//g;   # get rid of currency characters
  354     $value =~ s/$pattern->{currencyDecimal}/./; # convert decimal to .
  355   } elsif (Value::classMatch($value,"Currency")) {
  356     #
  357     #  Put it back into a Value object, but must unmark it
  358     #  as a Real temporarily to avoid an infinite loop.
  359     #
  360     $value->{isReal} = 0;
  361     $value = $self->Item("Value")->new($equation,[$value]);
  362     $value->{value}{isReal} = 1;
  363     return $value;
  364   }
  365   $self = $self->SUPER::new($equation,$value,@_);
  366   $self->{value_string} = $value_string if defined($value_string);
  367   return $self;
  368 }
  369 
  370 ##################################################
  371 #
  372 #  This class implements the currency symbol.
  373 #  It checks that its operand is a numeric constant
  374 #  in the correct format, and produces
  375 #  a Currency object when evaluated.
  376 #
  377 package Currency::UOP::currency;
  378 our @ISA = ('Parser::UOP');
  379 
  380 sub _check {
  381   my $self = shift;
  382   my $context = $self->context;
  383   my $decimal = $context->{pattern}{currencyDecimal};
  384   my $op = $self->{op}; my $value = $op->{value_string};
  385   $self->Error("'%s' can only be used with numeric constants",$self->{uop})
  386     unless $op->type eq 'Number' && $op->class eq 'Number';
  387   $self->{ref} = $op->{ref}; # highlight the number, not the operator
  388   $self->Error("You should have a '%s' every 3 digits",$context->{currency}{comma})
  389     if $context->flag("forceCommas") && $value =~ m/\d\d\d\d/;
  390   $self->Error("Monetary values must have exactly two decimal places")
  391    if $value && $value =~ m/$decimal\d/ && $value !~ m/$decimal\d\d$/ && $context->flag('noExtraDecimals');
  392   $self->Error("Monitary values require two decimal places",shift)
  393     if $context->flag("forceDecimals") && $value !~ m/$decimal\d\d$/;
  394   $self->{type} = {%{$op->typeRef}};
  395   $self->{isCurrency} = 1;
  396 }
  397 
  398 sub _eval {my $self = shift; Value->Package("Currency")->make($self->context,@_)}
  399 
  400 #
  401 #  Use the Currency MathObject to produce the output formats
  402 #
  403 sub string {(shift)->eval->string}
  404 sub TeX    {(shift)->eval->TeX}
  405 sub perl   {(shift)->eval->perl}
  406 
  407 
  408 ######################################################################
  409 ######################################################################
  410 #
  411 #  This is the MathObject class for currency objects.
  412 #  It is basically a Real(), but one that stringifies
  413 #  and texifies itself to include the currency symbol
  414 #  and commas every three digits.
  415 #
  416 package Currency::Currency;
  417 our @ISA = ('Value::Real');
  418 
  419 #
  420 #  We need to override the new() and make() methods
  421 #  so that the Currency object will be counted as
  422 #  a Value object.  If we aren't promoting Reals,
  423 #  produce an error message.
  424 #
  425 sub new {
  426   my $self = shift;
  427   my $context = (Value::isContext($_[0]) ? shift : $self->context);
  428   my $x = shift;
  429   Value::Error("Can't convert %s to a monitary value",lc(Value::showClass($x)))
  430       if !$self->getFlag("promoteReals",1) && Value::isRealNumber($x) && !Value::classMatch($x,"Currency");
  431   $self = $self->SUPER::new($context,$x,@_);
  432   $self->{isReal} = $self->{isValue} = $self->{isCurrency} = 1;
  433   return $self;
  434 }
  435 
  436 sub make {
  437   my $self = shift;
  438   $self = $self->SUPER::make(@_);
  439   $self->{isReal} = $self->{isValue} = $self->{isCurrency} = 1;
  440   return $self;
  441 }
  442 
  443 #
  444 #  Look up the currency symbols either from the object of the context
  445 #  and format the output as a currency value (use 2 decimals and
  446 #  insert commas every three digits).  Put the currency symbol
  447 #  on the correct end for the associativity and remove leading
  448 #  and trailing spaces.
  449 #
  450 sub string {
  451   my $self = shift;
  452   my $currency = ($self->{currency} || $self->context->{currency});
  453   my ($symbol,$comma,$decimal) = ($currency->{symbol},$currency->{comma},$currency->{decimal});
  454   $symbol = $self->context->operators->get($symbol)->{string} || $symbol;
  455   my $s = main::prfmt($self->value,"%.2f");
  456   $s =~ s/\./$decimal/;
  457   while ($s =~ s/(\d)(\d\d\d\D)/$1$comma$2/) {}
  458   $s = ($currency->{associativity} eq "right" ? $s.$symbol : $symbol.$s);
  459   $s =~ s/^\s+|\s+$//g;
  460   return $s;
  461 }
  462 
  463 #
  464 #  Just use the string and escape any TeX specials
  465 #
  466 sub TeX {
  467   my $self = shift;
  468   return Currency::quoteTeX($self->string(@_));
  469 }
  470 
  471 #
  472 #  Override the class name to get better error messages
  473 #
  474 sub cmp_class {"a Monetary Value"}
  475 
  476 #
  477 #  Add promoteReals option to allow Reals with no dollars
  478 #
  479 sub cmp_defaults {(
  480   (shift)->SUPER::cmp_defaults,
  481   promoteReals => 0,
  482 )}
  483 
  484 sub typeMatch {
  485   my $self = shift; my $other = shift; my $ans = shift;
  486   return $self->SUPER::typeMatch($other,$ans,@_) if $self->getFlag("promoteReals");
  487   return Value::classMatch($other,'Currency');
  488 }
  489 
  490 ######################################################################
  491 
  492 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9