[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 5344 - (download) (as text) (annotate)
Fri Aug 17 16:11:55 2007 UTC (12 years, 5 months ago) by dpvc
File size: 15249 byte(s)
Incorrectly had promoteReals to 1 instead of 0 (left over from
testing).  Now added promoteReals to the context in addition to the
answer cmp method, and produce error messages when computations are
performed between currency and reals.  (The message is not as good as
it should be, but to do it right would require overriding all the
operators.  I need to work out a better way of hooking into the type
checking mechanism for the operators.)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9