[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 5847 - (download) (as text) (annotate)
Mon Jul 14 15:43:06 2008 UTC (11 years, 6 months ago) by dpvc
File size: 17822 byte(s)
Fixed documentation typos.

    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.15 2008/01/26 01:40:32 dpvc 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 monitary 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 monitary 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 monitary 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 By default, the answer checker for Currency values requires
  107 the student to enter the currency symbol, not just a real number.
  108 You can relax that condition by including the promoteReals=>1
  109 option to the cmp() method of the Currency value.  For example,
  110 
  111   ANS(Compute('$150')->cmp(promoteReals=>1));
  112 
  113 would allow the student to enter just 150 rather than $150.
  114 
  115 By default, the students may omit the commas, but you can
  116 force them to supply the commas using forceCommas=>1 in
  117 your cmp() call.
  118 
  119   ANS(Compute('$10,000.00')->cmp(forceCommas=>1));
  120 
  121 By default, students need not enter decimal digits, so could use
  122 $100 or $1,000. as valid entries.  You can require that the cents
  123 be provided using the forceDecimals=>1 flag.
  124 
  125   ANS(Compute('$10.95')->cmp(forceDecimals=>1));
  126 
  127 By default, if the monitary value includes decimals digits, it
  128 must have exactly two.  You can weaken this requirement to allow
  129 any number of decimals by using noExtraDecimals=>0.
  130 
  131   ANS(Compute('$10.23372')->cmp(noExtraDecimals=>0);
  132 
  133 If forceDecimals is set to 1 at the same time, then they must
  134 have 2 or more decimals, otherwise any number is OK.
  135 
  136 By default, currency values are always formatted to display using
  137 two decimal places, but you can request that if the decimals would be
  138 .00 then they should not be displayed.  This is controlled via the
  139 trimTrailingZeros context flag:
  140 
  141   Context()->flags->set(trimTrailingZeros=>1);
  142 
  143 It can also be set on an individual currency value:
  144 
  145   $m = Compute('$50')->with(trimtrailingZeros=>1);
  146 
  147 so that this $m will print as $50 rather than $50.00.
  148 
  149 =cut
  150 
  151 loadMacros("MathObjects.pl");
  152 loadMacros("problemPreserveAnswers.pl");  # needed to preserve $ in answers
  153 
  154 sub _contextCurrency_init {Currency::Init()}
  155 
  156 package Currency;
  157 
  158 #
  159 #  Initialization creates a Currency context object
  160 #  and sets up a Currency() constructor.
  161 #
  162 sub Init {
  163   my $context = $main::context{Currency} = new Currency::Context();
  164   $context->{name} = "Currency";
  165 
  166   main::PG_restricted_eval('sub Currency {Value->Package("Currency")->new(@_)}');
  167 }
  168 
  169 #
  170 #  Quote characters that are special in regular expressions
  171 #
  172 sub quoteRE {
  173   my $s = shift;
  174   $s =~ s/([-\\^\$+*?.\[\](){}])/\\$1/g;
  175   return $s;
  176 }
  177 
  178 #
  179 #  Quote common TeX special characters, and put
  180 #  the result in {\rm ... } if there are alphabetic
  181 #  characters included.
  182 #
  183 sub quoteTeX {
  184   my $s = shift;
  185   my $isText = ($s =~ m/[a-z]/i);
  186   $s =~ s/\\/\\backslash /g;
  187   $s =~ s/([\#\$%^_&{} ])/\\$1/g;
  188   $s =~ s/([~\'])/{\\tt\\char\`\\$1}/g;
  189   $s =~ s/,/{,}/g;
  190   $s = "{\\rm $s}" if $isText;
  191   return $s;
  192 }
  193 
  194 ######################################################################
  195 ######################################################################
  196 #
  197 #  The Currency context has an extra "currency" data
  198 #  type (like flags, variables, etc.)
  199 #
  200 #  It also creates some patterns needed for handling
  201 #  currency values, and sets the Parser and Value
  202 #  hashes to activate the Currency objects.
  203 #
  204 #  The tolerance is set to .005 absolute so that
  205 #  answers must be correct to the penny.  You can
  206 #  change this in the context, or for individual
  207 #  currency values.
  208 #
  209 package Currency::Context;
  210 our @ISA = ('Parser::Context');
  211 
  212 sub new {
  213   my $self = shift; my $class = ref($self) || $self;
  214   my %data = (
  215     decimal => '.',
  216     comma => ',',
  217     symbol => "\$",
  218     associativity => "left",
  219     @_,
  220   );
  221   my $context = bless Parser::Context->getCopy("Numeric"), $class;
  222   $context->{_initialized} = 0;
  223   $context->{_currency} = new Currency::Context::currency($context,%data);
  224   my $symbol = $context->{currency}{symbol};
  225   my $associativity = $context->{currency}{associativity};
  226   my $string = ($symbol =~ m/[a-z]/i ? " $symbol " : $symbol);
  227   $context->{_currency}{symbol} = $symbol;
  228   $context->operators->remove($symbol) if $context->operators->get($symbol);
  229   $context->operators->add(
  230     $symbol => {precedence => 10, associativity => $associativity, type => "unary",
  231     string => ($main::displayMode eq 'TeX' ? Currency::quoteTeX($symbol) : $symbol),
  232                 TeX => Currency::quoteTeX($symbol), class => 'Currency::UOP::currency'},
  233   );
  234   $context->{parser}{Number} = "Currency::Number";
  235   $context->{value}{Currency} = "Currency::Currency";
  236   $context->flags->set(
  237     tolerance => .005,
  238     tolType => "absolute",
  239     promoteReals => 1,
  240     forceCommas => 0,
  241     forceDecimals => 0,
  242     noExtraDecimals => 1,
  243     trimTrailingZeros => 0,
  244   );
  245   $context->{_initialized} = 1;
  246   $context->update;
  247   $context->{error}{msg}{"Missing operand after '%s'"} = "There should be a number after '%s'";
  248   return $context;
  249 }
  250 
  251 sub currency {(shift)->{_currency}}   # access to currency data
  252 
  253 
  254 ##################################################
  255 #
  256 #  This is the context data for currency.
  257 #  A special pattern is maintained for the
  258 #  comma form of numbers (using the specified
  259 #  comma and decimal-place characters).
  260 #
  261 #  You specify the currency symbol via
  262 #
  263 #    Context()->currency->set(symbol=>'$');
  264 #    Context()->currency->set(comma=>',',decimal=>'.');
  265 #
  266 #  You can add extra symbols via
  267 #
  268 #    Context()->currency->addSymbol("dollar","dollars");
  269 #
  270 #  If the symbol contains alphabetic characters, it
  271 #  is made to be right-associative (i.e., comes after
  272 #  the number), otherwise it is left-associative (i.e.,
  273 #  before the number).  You can change that for a
  274 #  symbol using
  275 #
  276 #    Context()->currency->setSymbol("Euro"=>{associativity=>"left"});
  277 #
  278 #  Finally, an extra symbol can be removed with
  279 #
  280 #    Context()->currency-removeSymbol("dollar");
  281 #
  282 package Currency::Context::currency;
  283 our @ISA = ("Value::Context::Data");
  284 
  285 #
  286 #  Set up the initial data
  287 #
  288 sub init {
  289   my $self = shift;
  290   $self->{dataName} = 'currency';
  291   $self->{name} = 'currency';
  292   $self->{Name} = 'Currency';
  293   $self->{namePattern} = qr/[-\w_.]+/;
  294   $self->{numberPattern} = qr/\d{1,3}(?:,\d\d\d)+(?:\.\d*)?(?=\D|$)/;
  295   $self->{tokenType} = "num";
  296   $self->{precedence} = -12;
  297   $self->{patterns}{$self->{numberPattern}} = [$self->{precedence},$self->{tokenType}];
  298   $self->{extraSymbols} = [];
  299 }
  300 
  301 sub addToken {}       # no tokens are needed (only uses fixed pattern)
  302 sub removeToken {}
  303 
  304 #
  305 #  Do the usual set() method, but make sure patterns are
  306 #  updated, since the settings may affect the currency
  307 #  pattern.
  308 #
  309 sub set {
  310   my $self = shift;
  311   $self->SUPER::set(@_);
  312   $self->update;
  313 }
  314 
  315 #
  316 #  Create, set and remove extra currency symbols
  317 #
  318 sub addSymbol {
  319   my $self = shift; my $operators = $self->{context}->operators;
  320   my $def = $operators->get($self->{symbol});
  321   foreach my $symbol (@_) {
  322     my ($string,$associativity) = ($symbol =~ m/[a-z]/i ? (" $symbol ","right") : ($symbol,"left"));
  323     push @{$self->{extraSymbols}},$symbol;
  324     $operators->add(
  325       $symbol => {
  326         %{$def}, associativity => $associativity,
  327         string => ($main::qisplayMode eq 'TeX' ? Currency::quoteTeX($string) : $string),
  328   TeX => Currency::quoteTeX($string),
  329       }
  330     );
  331   }
  332 }
  333 sub setSymbol {(shift)->{context}->operators->set(@_)}
  334 sub removeSymbol {(shift)->{context}->operators->remove(@_)}
  335 
  336 #
  337 #  Update the currency patterns in case the characters have changed,
  338 #  and if the symbol has changed, remove the old operator(s) and
  339 #  create a new one for the given symbol.
  340 #
  341 sub update {
  342   my $self = shift;
  343   my $context = $self->{context};
  344   my $pattern = $context->{pattern};
  345   my $operators = $context->operators;
  346   my $data = $context->{$self->{dataName}};
  347   my ($symbol,$comma,$decimal) = (Currency::quoteRE($data->{symbol}),
  348           Currency::quoteRE($data->{comma}),
  349           Currency::quoteRE($data->{decimal}));
  350   delete $self->{patterns}{$self->{numberPattern}};
  351   $self->{numberPattern} = qr/\d{1,3}(?:$comma\d\d\d)+(?:$decimal\d*)?(?=\D|$)|\d{1,3}$decimal\d*/;
  352   $self->{patterns}{$self->{numberPattern}} = [$self->{precedence},$self->{tokenType}];
  353   $pattern->{currencyChars}   = qr/(?:$symbol|$comma)/;
  354   $pattern->{currencyDecimal} = qr/$decimal/;
  355   if ($self->{symbol} && $self->{symbol} ne $data->{symbol}) {
  356     $operators->redefine($data->{symbol},from=>$context,using=>$self->{symbol});
  357     $operators->remove($self->{symbol});
  358     foreach $symbol (@{$self->{extraSymbols}}) {$operators->remove($symbol) if $operators->get($symbol)}
  359     $self->{extraSymbols} = [];
  360   }
  361   my $string = ($data->{symbol} =~ m/[^a-z]/i ? $data->{symbol} : " $data->{symbol} ");
  362   $context->operators->set($data->{symbol}=>{
  363     associativity => $data->{associativity},
  364     string => ($main::displayMode eq 'TeX' ? Currency::quoteTeX($string) : $string),
  365     TeX => Currency::quoteTeX($string),
  366   });
  367   $context->update;
  368 }
  369 
  370 ######################################################################
  371 ######################################################################
  372 #
  373 #  When creating Number objects in the Parser, we need to remove the
  374 #  comma (and currency) characters and replace the decimal character
  375 #  with an actual decimal point.
  376 #
  377 package Currency::Number;
  378 our @ISA = ('Parser::Number');
  379 
  380 sub new {
  381   my $self = shift; my $equation = shift;
  382   my $context = $equation->{context};
  383   my $pattern = $context->{pattern};
  384   my $currency = $context->{currency};
  385   my $value = shift; my $value_string;
  386   if (ref($value) eq "") {
  387     $value_string = "$value";
  388     $value =~ s/$pattern->{currencyChars}//g;   # get rid of currency characters
  389     $value =~ s/$pattern->{currencyDecimal}/./; # convert decimal to .
  390   } elsif (Value::classMatch($value,"Currency")) {
  391     #
  392     #  Put it back into a Value object, but must unmark it
  393     #  as a Real temporarily to avoid an infinite loop.
  394     #
  395     $value->{isReal} = 0;
  396     $value = $self->Item("Value")->new($equation,[$value]);
  397     $value->{value}{isReal} = 1;
  398     return $value;
  399   }
  400   $self = $self->SUPER::new($equation,$value,@_);
  401   $self->{value_string} = $value_string if defined($value_string);
  402   return $self;
  403 }
  404 
  405 ##################################################
  406 #
  407 #  This class implements the currency symbol.
  408 #  It checks that its operand is a numeric constant
  409 #  in the correct format, and produces
  410 #  a Currency object when evaluated.
  411 #
  412 package Currency::UOP::currency;
  413 our @ISA = ('Parser::UOP');
  414 
  415 sub _check {
  416   my $self = shift;
  417   my $context = $self->context;
  418   my $decimal = $context->{pattern}{currencyDecimal};
  419   my $op = $self->{op}; my $value = $op->{value_string};
  420   $self->Error("'%s' can only be used with numeric constants",$self->{uop})
  421     unless $op->type eq 'Number' && $op->class eq 'Number';
  422   $self->{ref} = $op->{ref}; # highlight the number, not the operator
  423   $self->Error("You should have a '%s' every 3 digits",$context->{currency}{comma})
  424     if $context->flag("forceCommas") && $value =~ m/\d\d\d\d/;
  425   $self->Error("Monetary values must have exactly two decimal places")
  426    if $value && $value =~ m/$decimal\d/ && $value !~ m/$decimal\d\d$/ && $context->flag('noExtraDecimals');
  427   $self->Error("Monitary values require two decimal places",shift)
  428     if $context->flag("forceDecimals") && $value !~ m/$decimal\d\d$/;
  429   $self->{type} = {%{$op->typeRef}};
  430   $self->{isCurrency} = 1;
  431 }
  432 
  433 sub _eval {my $self = shift; Value->Package("Currency")->make($self->context,@_)}
  434 
  435 #
  436 #  Use the Currency MathObject to produce the output formats
  437 #
  438 sub string {(shift)->eval->string}
  439 sub TeX    {(shift)->eval->TeX}
  440 sub perl   {(shift)->eval->perl}
  441 
  442 
  443 ######################################################################
  444 ######################################################################
  445 #
  446 #  This is the MathObject class for currency objects.
  447 #  It is basically a Real(), but one that stringifies
  448 #  and texifies itself to include the currency symbol
  449 #  and commas every three digits.
  450 #
  451 package Currency::Currency;
  452 our @ISA = ('Value::Real');
  453 
  454 #
  455 #  We need to override the new() and make() methods
  456 #  so that the Currency object will be counted as
  457 #  a Value object.  If we aren't promoting Reals,
  458 #  produce an error message.
  459 #
  460 sub new {
  461   my $self = shift; my $class = ref($self) || $self;
  462   my $context = (Value::isContext($_[0]) ? shift : $self->context);
  463   my $x = shift;
  464   Value::Error("Can't convert %s to a monitary value",lc(Value::showClass($x)))
  465       if !$self->getFlag("promoteReals",1) && Value::isRealNumber($x) && !Value::classMatch($x,"Currency");
  466   $self = bless $self->SUPER::new($context,$x,@_), $class;
  467   $self->{isReal} = $self->{isValue} = $self->{isCurrency} = 1;
  468   return $self;
  469 }
  470 
  471 sub make {
  472   my $self = shift; my $class = ref($self) || $self;
  473   $self = bless $self->SUPER::make(@_), $class;
  474   $self->{isReal} = $self->{isValue} = $self->{isCurrency} = 1;
  475   return $self;
  476 }
  477 
  478 #
  479 #  Look up the currency symbols either from the object of the context
  480 #  and format the output as a currency value (use 2 decimals and
  481 #  insert commas every three digits).  Put the currency symbol
  482 #  on the correct end for the associativity and remove leading
  483 #  and trailing spaces.
  484 #
  485 sub format {
  486   my $self = shift; my $type = shift;
  487   my $currency = ($self->{currency} || $self->context->{currency});
  488   my ($symbol,$comma,$decimal) = ($currency->{symbol},$currency->{comma},$currency->{decimal});
  489   $symbol = $self->context->operators->get($symbol)->{$type} || $symbol;
  490   $comma = "{$comma}" if $type eq 'TeX';
  491   my $s = main::prfmt($self->value,"%.2f");
  492   $s =~ s/\.00// if $self->getFlag('trimTrailingZeros');
  493   $s =~ s/\./$decimal/;
  494   while ($s =~ s/(\d)(\d\d\d(:\D|$))/$1$comma$2/) {}
  495   $s = ($currency->{associativity} eq "right" ? $s.$symbol : $symbol.$s);
  496   $s =~ s/^\s+|\s+$//g;
  497   return $s;
  498 }
  499 
  500 sub string {(shift)->format("string")}
  501 sub TeX    {(shift)->format("TeX")}
  502 
  503 
  504 
  505 #
  506 #  Override the class name to get better error messages
  507 #
  508 sub cmp_class {"a Monetary Value"}
  509 
  510 #
  511 #  Add promoteReals option to allow Reals with no dollars
  512 #
  513 sub cmp_defaults {(
  514   (shift)->SUPER::cmp_defaults,
  515   promoteReals => 0,
  516 )}
  517 
  518 sub typeMatch {
  519   my $self = shift; my $other = shift; my $ans = shift;
  520   return $self->SUPER::typeMatch($other,$ans,@_) if $self->getFlag("promoteReals");
  521   return Value::classMatch($other,'Currency');
  522 }
  523 
  524 ######################################################################
  525 
  526 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9