[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 5551 - (download) (as text) (annotate)
Tue Oct 2 20:48:05 2007 UTC (12 years, 2 months ago) by sh002i
File size: 16299 byte(s)
improved formatting for docs -- these were in pod sections but were all
formatted as verbatim sections, and i moved them into normal paragraphs,
lists, etc. should make things more readable from the web.

    1 =head1 Context("Currency");
    2 
    3 #####################################################################
    4 
    5 This file implements a context in which students can enter currency
    6 values that include a currency symbol and commas every three digits.
    7 You can specify what the currency symbol is, as well as what gets
    8 used for commas and decimals.
    9 
   10 To use the context, put
   11 
   12     loadMacros("contextCurrency.pl");
   13 
   14 at the top of your problem file, and then issue the
   15 
   16     Context("Currency");
   17 
   18 command to select the context.  You can set the currency symbol
   19 and the comma or decimal values as in the following examples
   20 
   21     Context()->currency->set(symbol=>'#');
   22     Context()->currency->set(symbol=>'euro');          # accepts '12 euro'
   23     Context()->currency->set(comma=>'.',decimal=>','); # accepts '10.000,00'
   24 
   25 You can add additional symbols (in case you want to allow
   26 more than one way to write the currency).  For example:
   27 
   28     Context("Currency")->currency->addSymbol("dollars","dollar");
   29 
   30 would accept '$12,345.67' or '12.50 dollars' or '1 dollar' as
   31 acceptable values.  Note that if the symbol cantains any
   32 alphabetic characters, it is expected to come at the end of the
   33 number (as in the examples above) and if the symbol has only
   34 non-alphabetic characters, it comes before it.  You can change
   35 this as in these examples:
   36 
   37     Context()->currency->setSymbol(euro=>{associativity=>"left"});
   38     Context()->currency->setSymbol('#'=>{associativity=>"right"});
   39 
   40 You can remove a symbol as follows:
   41 
   42     Context()->currency->removeSymbol('dollar');
   43 
   44 To create a currency value, use
   45 
   46     $m = Currency(10.99);
   47 
   48 or
   49 
   50     $m1 = Compute('$10.99');
   51     $m2 = Compute('$10,000.00');
   52 
   53 and so on.  Be careful, however, that you do not put dollar signs
   54 inside double quotes, as this refers to variable substitution.
   55 For example,
   56 
   57     $m = Compute("$10.99");
   58 
   59 will most likely set $m to the Real value .99 rather than the
   60 monitary value of $10.99, since perl thinks $10 is the name of
   61 a variable, and will substitute that into the string before
   62 processing it.  Since that variable is most likely empty, the
   63 result will be the same as $m = Compute(".99");
   64 
   65 You can use monitary values within computations, as in
   66 
   67     $m1 = Compute('$10.00');
   68     $m2 = 3*$m1;  $m3 = $m2 + .5;
   69     $m4 = Compute('$10.00 + $2.59');
   70 
   71 so that $m2 will be $30.00, $m3 will be $30.50, and $m4 will
   72 be $12.59.  Students can perform computations within their
   73 answers unless you disable the operators and functions as well.
   74 
   75 The tolerance for this context is set initially to .005 and the
   76 tolType to 'absolute' so that monitary values will have to match
   77 to the nearest penny.  You can change that on a global basis
   78 using
   79 
   80     Context()->flags->set(tolerance=>.0001,tolType=>"relative");
   81 
   82 for example.  You can also change the tolerance on an individual
   83 currency value as follows:
   84 
   85     $m = Compute('$1,250,000.00')->with(tolerance=>.0001,tolType=>'relative');
   86 
   87 By default, the answer checker for Currency values requires
   88 the student to enter the currency symbol, not just a real number.
   89 You can relax that condition by including the promoteReals=>1
   90 option to the cmp() method of the Currency value.  For example,
   91 
   92     ANS(Compute('$150')->cmp(promoteReals=>1));
   93 
   94 would allow the student to enter just 150 rather than $150.
   95 
   96 By default, the students may omit the commas, but you can
   97 force them to supply the commas using forceCommas=>1 in
   98 your cmp() call.
   99 
  100     ANS(Compute('$10,000.00')->cmp(forceCommas=>1));
  101 
  102 By default, students need not enter decimal digits, so could use
  103 $100 or $1,000. as valid entries.  You can require that the cents
  104 be provided using the forceDecimals=>1 flag.
  105 
  106     ANS(Compute('$10.95')->cmp(forceDecimals=>1));
  107 
  108 By default, if the monitary value includes decimals digits, it
  109 must have exactly two.  You can weaken this requirement to all
  110 any number of decimals by using noExtraDecimals=>0.
  111 
  112     ANS(Compute('$10.23372')->cmp(noExtraDecimals=>0);
  113 
  114 If forceDecimals is set to 1 at the same time, then they must
  115 have 2 or more decimals, otherwise any number is OK.
  116 
  117 =cut
  118 
  119 loadMacros("MathObjects.pl");
  120 loadMacros("problemPreserveAnswers.pl");  # needed to preserve $ in answers
  121 
  122 sub _contextCurrency_init {Currency::Init()}
  123 
  124 package Currency;
  125 
  126 #
  127 #  Initialization creates a Currency context object
  128 #  and sets up a Currency() constructor.
  129 #
  130 sub Init {
  131   my $context = $main::context{Currency} = new Currency::Context();
  132   $context->{name} = "Currency";
  133 
  134   main::PG_restricted_eval('sub Currency {Value->Package("Currency")->new(@_)}');
  135 }
  136 
  137 #
  138 #  Quote characters that are special in regular expressions
  139 #
  140 sub quoteRE {
  141   my $s = shift;
  142   $s =~ s/([-\\^\$+*?.\[\](){}])/\\$1/g;
  143   return $s;
  144 }
  145 
  146 #
  147 #  Quote common TeX special characters, and put
  148 #  the result in {\rm ... } if there are alphabetic
  149 #  characters included.
  150 #
  151 sub quoteTeX {
  152   my $s = shift;
  153   my $isText = ($s =~ m/[a-z]/i);
  154   $s =~ s/\\/\\backslash /g;
  155   $s =~ s/([\#\$%^_&{} ])/\\$1/g;
  156   $s =~ s/([~\'])/{\\tt\\char\`\\$1}/g;
  157   $s =~ s/,/{,}/g;
  158   $s = "{\\rm $s}" if $isText;
  159   return $s;
  160 }
  161 
  162 ######################################################################
  163 ######################################################################
  164 #
  165 #  The Currency context has an extra "currency" data
  166 #  type (like flags, variables, etc.)
  167 #
  168 #  It also creates some patterns needed for handling
  169 #  currency values, and sets the Parser and Value
  170 #  hashes to activate the Currency objects.
  171 #
  172 #  The tolerance is set to .005 absolute so that
  173 #  answers must be correct to the penny.  You can
  174 #  change this in the context, or for individual
  175 #  currency values.
  176 #
  177 package Currency::Context;
  178 our @ISA = ('Parser::Context');
  179 
  180 sub new {
  181   my $self = shift; my $class = ref($self) || $self;
  182   my %data = (
  183     decimal => '.',
  184     comma => ',',
  185     symbol => "\$",
  186     associativity => "left",
  187     @_,
  188   );
  189   my $context = bless Parser::Context->getCopy("Numeric"), $class;
  190   $context->{_initialized} = 0;
  191   $context->{_currency} = new Currency::Context::currency($context,%data);
  192   my $symbol = $context->{currency}{symbol};
  193   my $associativity = $context->{currency}{associativity};
  194   my $string = ($symbol =~ m/[a-z]/i ? " $symbol " : $symbol);
  195   $context->{_currency}{symbol} = $symbol;
  196   $context->operators->remove($symbol) if $context->operators->get($symbol);
  197   $context->operators->add(
  198     $symbol => {precedence => 10, associativity => $associativity, type => "unary",
  199     string => ($main::displayMode eq 'TeX' ? Currency::quoteTeX($symbol) : $symbol),
  200                 TeX => Currency::quoteTeX($symbol), class => 'Currency::UOP::currency'},
  201   );
  202   $context->{parser}{Number} = "Currency::Number";
  203   $context->{value}{Currency} = "Currency::Currency";
  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 => ($main::qisplayMode eq 'TeX' ? Currency::quoteTeX($string) : $string),
  295   TeX => Currency::quoteTeX($string),
  296       }
  297     );
  298   }
  299 }
  300 sub setSymbol {(shift)->{context}->operators->set(@_)}
  301 sub removeSymbol {(shift)->{context}->operators->remove(@_)}
  302 
  303 #
  304 #  Update the currency patterns in case the characters have changed,
  305 #  and if the symbol has changed, remove the old operator(s) and
  306 #  create a new one for the given symbol.
  307 #
  308 sub update {
  309   my $self = shift;
  310   my $context = $self->{context};
  311   my $pattern = $context->{pattern};
  312   my $operators = $context->operators;
  313   my $data = $context->{$self->{dataName}};
  314   my ($symbol,$comma,$decimal) = (Currency::quoteRE($data->{symbol}),
  315           Currency::quoteRE($data->{comma}),
  316           Currency::quoteRE($data->{decimal}));
  317   delete $self->{patterns}{$self->{numberPattern}};
  318   $self->{numberPattern} = qr/\d{1,3}(?:$comma\d\d\d)+(?:$decimal\d*)?(?=\D|$)|\d{1,3}$decimal\d*/;
  319   $self->{patterns}{$self->{numberPattern}} = [$self->{precedence},$self->{tokenType}];
  320   $pattern->{currencyChars}   = qr/(?:$symbol|$comma)/;
  321   $pattern->{currencyDecimal} = qr/$decimal/;
  322   if ($self->{symbol} && $self->{symbol} ne $data->{symbol}) {
  323     $operators->redefine($data->{symbol},from=>$context,using=>$self->{symbol});
  324     $operators->remove($self->{symbol});
  325     foreach $symbol (@{$self->{extraSymbols}}) {$operators->remove($symbol) if $operators->get($symbol)}
  326     $self->{extraSymbols} = [];
  327   }
  328   my $string = ($data->{symbol} =~ m/[^a-z]/i ? $data->{symbol} : " $data->{symbol} ");
  329   $context->operators->set($data->{symbol}=>{
  330     associativity => $data->{associativity},
  331     string => ($main::displayMode eq 'TeX' ? Currency::quoteTeX($string) : $string),
  332     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 format {
  453   my $self = shift; my $type = 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)->{$type} || $symbol;
  457   $comma = "{$comma}" if $type eq 'TeX';
  458   my $s = main::prfmt($self->value,"%.2f");
  459   $s =~ s/\./$decimal/;
  460   while ($s =~ s/(\d)(\d\d\d\D)/$1$comma$2/) {}
  461   $s = ($currency->{associativity} eq "right" ? $s.$symbol : $symbol.$s);
  462   $s =~ s/^\s+|\s+$//g;
  463   return $s;
  464 }
  465 
  466 sub string {(shift)->format("string")}
  467 sub TeX    {(shift)->format("TeX")}
  468 
  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