[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 5556 - (download) (as text) (annotate)
Thu Oct 4 16:40:49 2007 UTC (12 years, 4 months ago) by sh002i
File size: 17192 byte(s)
added standard copyright/license header

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9