[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 5373 - (download) (as text) (annotate)
Sun Aug 19 02:01:57 2007 UTC (12 years, 3 months ago) by dpvc
File size: 15318 byte(s)
Normalized comments and headers to that they will format their POD
documentation properly.  (I know that the POD processing was supposed
to strip off the initial #, but that doesn't seem to happen, so I've
added a space throughout.)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9