[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 6466 - (download) (as text) (annotate)
Tue Oct 12 15:57:29 2010 UTC (9 years, 4 months ago) by apizer
File size: 18984 byte(s)
Fixed Bug 1841 - typo in contextCurrency.pl
qisplayMode should be displayMode

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9