[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 5441 - (download) (as text) (annotate)
Tue Aug 28 22:40:15 2007 UTC (12 years, 5 months ago) by dpvc
File size: 16530 byte(s)
Add context names for the context(s) created here.

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9