From 34a33224acfa2d721e188152ae1118ef4e76380f Mon Sep 17 00:00:00 2001 From: "Davide P. Cervone" Date: Thu, 29 Aug 2024 10:15:23 -0400 Subject: [PATCH 1/9] Add new contextExtensions.pl framework for extending contexts --- macros/contexts/contextExtensions.pl | 548 +++++++++++++++++++++++++++ 1 file changed, 548 insertions(+) create mode 100644 macros/contexts/contextExtensions.pl diff --git a/macros/contexts/contextExtensions.pl b/macros/contexts/contextExtensions.pl new file mode 100644 index 000000000..f16c40a41 --- /dev/null +++ b/macros/contexts/contextExtensions.pl @@ -0,0 +1,548 @@ + +=head1 NAME + +contextExtensoins.pl - Implements a framework for creating contexts that + extend other contexts. + +=head1 DESCRIPTION + +MathObject contexts specify their features by creating objects that +implement the needed functionality, and assigning those object classes +to the various operators, functions, etc. that are part of the +context. For example, addition in the C context is attached +to the C<+> sign by setting its C property to +C in the context's C list. + +To change the action of C<+> (for example, to allow it to work with a +new type of object that you are defining), you would change the +C property to point to a new class (usually a subclass of +C) that implements the new functionality needed for +the new category of object. So if you are defining a new object to +handle quaternions, then you might use something like + + $context->operators->set( '+' => 'context::Quaternions::BOP::add' ); + +to direct the C<+> to use your new C +object instead of the usual one. (Of course, there is much more than +needs to be done as well, but this illustrates how such changes are +made.) + +When you change the class associated with an operator or some other +Context feature, the previous class is replaced by the new class, and +that means you have to either maintain the old functionality by using +a subclass of the original class, or by re-implementing it in your new +class. This usually means you need to know the original class when +you define your new objects, and that makes your new context dependent +on a specific original context. If you want to be able to add your +new MathObject to an arbitrary context, that was not generally easy to +do. + +The purpose of this file is to make it possible to overcome these +difficulties, and make it easier to extend a context by adding new +functionality without losing its old features, and without having to +know which context you are extending. For example, the Fraction +object can be added to an existing context this way, as can the +handling of units. + +=cut + +sub _contextExtensions_init { } + +################################################################################################# +################################################################################################# + +# +# This package provides create() and extend() functions that can be +# used to get a copy of an existing context and extend it by +# overridding the existing classes with your own, while maintining +# information about those original classes so that you can fall back +# on them for any sitautions that don't involve your new +# functionality. These functions are designed so that multiple +# extensions can be added without interfering with one another. +# +package context::Extensions; + +# +# ID to use for contexts that need a dynamic extension +# +my $id = 0; + +# +# Copy the given context (given by name or as a Context object) +# and name the new one. For example, +# +# $context = context::Extensions::create("Quaternions", "Complex"); +# +# would create a context named "Quaternions-Complex" as a copy of the +# Complex context. The implementation for classes added to this +# context should be in the context::Quaternions namespace. +# +sub create { + my ($new, $from) = @_; + my $name = "$new-$from"; + my $context = Value::isContext($from) ? $from->copy : Parser::Context->getCopy($from); + $context->{baseName} = $new; + $context->{name} = $name; + $main::context{$name} = $context; + return $context; +} + +# +# Extend a given Context object to include new features by specifying +# classes to use for operators, functions, value object, and parser +# objects, while retaining the old classes for fallback use. +# +# The changes are specified in the options following the Context, and these +# can include: +# +# opClasses => { op => 'class', ... } +# +# specifies the operators to override, and the class suffix to +# use for their implementations. For example, using +# +# opClasses => { '+' => 'BOP::add' } +# +# would attach the class context::Quaternions::BOP::add to the +# plus sign in our Qaternion setting. If the space operator (' ') +# in your list, and if the original context has it point to an +# operator that is NOT in your list, then that references operator +# is redirected automatically to 'BOP::Space' in your base context +# package. In our case, we would want to include a definition for +# context::Quaternions::BOP::Space in order to cover that possibility. +# +# ops => { op => {def}, ... } +# +# specifies new operators to add to the context (where "def" is +# an operator definition like those for any context). +# +# functions => 'class1|class2|...' +# +# specifies the function categories that you are overriding (e.g., +# +# functions => 'numeric|trig|hyperbolic' +# +# would override the functions that have classes that end in +# ::Functions:numeric, ::Function::trig, or ::Function::hyperbolic +# and direct them to your own versions of these. In our quaternion +# setting that would be to context::Quaternions::Function::numeric +# for the first of these, and similarly for the others. +# +# value => ['Class1', 'Class2', ...] +# +# specifies the Value object classes to override. For instance, +# +# value => ['Real', 'Formula'] +# +# would set $context->{value}{Real} and $context->{value}{Formula} +# to point to your own versions of these (e.g., in our example, +# these would be context::Quaternions::Value::Real and +# context::Quaternions::Value::Formula. Note that if you list +# the parenthesized version (used by the coreesponding constructor +# functions), then the parentheses are replaced by "_Parens" in the +# class name. For example, +# +# value => ['Real()'] +# +# would set +# +# $context->{value}{Real()} = 'context::Quaternions::Value::Real_Parens'; +# +# parser => ['Class1', 'Class2', ... ] +# +# specifies the Parser classes to override. This works similarly +# to the "value" option above, so that +# +# parser => ['Number'] +# +# would set $context->{parser}{Number} to your version of this class, +# which would be context::Quaternions::Parser::Number in our example. +# +# flags => { flag => value, ...} +# +# specifies the new flags to add to the context (or existing ones to +# override. +# +# reductions => { name => 1 or 0, ... } +# +# specifies new reduction rules to add to the context, and +# whether they are in effect by default (1) or not (0). Of +# course, you need to implement these reduction rules in your +# Parser objects. +# +# context => "Context" +# +# specifies that your context is a subclass of Parser::Context +# that adds methods to the context. If specified, the modified +# context will be blessed using this value as the suffix for the +# context's class. In our quaternion example, the value "Context" +# would mean the resulting modified context would be blessed +# as context::Quaternions::Context. +# +# The extend() function returns the modified context. +# +# The various operators, functions, and value and Parser objects that +# you define should use the context::Extensions::Super package below +# in order to access the original classes for those objects. Idealy, +# your new objects will mutate (i.e., re-bless) themselves to their +# original classes if they don't involve your new MathObjects. +# +# For example, the new context::Quaternions::BOP::add class should +# have the context::Extensions::Super object as one of its +# superclasses, and then its _check() method could check if either +# operand is a quaternion, and if not, it can call +# $self->mutate->_check to turn itself into the original object's +# class and perform its _check() actions. That way, the new BOP::add +# class only needs to worry about implementing the situation for +# quaternions, and lets the original class deal with everything else. +# +sub extend { + my ($context, %options) = @_; + + # + # The main context package + # + my $class = "context::$context->{baseName}"; + + # + # Extension data are stored in a context property + # + $context->{$class} = {}; + push(@{ $context->{data}{values} }, $class); + my $data = $context->{$class}; + + # + # Replace existing classes, but save the originals in the + # class data for the context + # + my $operators = $context->operators; + my $opClass = $options{opClasses} || {}; + for my $op (keys %$opClass) { + my $def = makeOpSubclass($context, $data, $operators, $op, $opClass->{$op}); + makeOpSubclass($context, $data, $operators, $def->{string}, 'BOP::Space', 1) + if $op eq ' ' && !$opClass->{ $def->{string} }; + } + # + # Make any new operators that are needed + # + $operators->set(%{ $options{ops} }) if $options{ops}; + + # + # We tie into the existing function definitions in order to handle + # arguments for this extension, but inherit the rest from the + # original function classes. + # + if ($options{functions}) { + my $functions = $context->functions; + my $pattern = qr/::Function::(?:$options{functions})$/; + for my $fn ($functions->names) { + my $def = $functions->get($fn); + if ($def->{class} && $def->{class} =~ $pattern) { + $data->{ substr($&, 2) } = $def->{class}; + $functions->set($fn => { class => "$class$&" }); + } + } + } + + # + # Replace any Parser/Value classes that are needed, saving the + # originals in the class data for the context + # + makeSubclass($context, $data, "Value", $_) for (@{ $options{value} || [] }); + makeSubclass($context, $data, "Parser", $_) for (@{ $options{parser} || [] }); + + # + # Add any new flags requested + # + $context->flags->set(%{ $options{flags} }) if $options{flags}; + + # + # Add any new reduction options + # + $context->reduction->set(%{ $options{reductions} }) if $options{reductions}; + + # + # If there is a special context class, use it + # + if ($options{context}) { + if (ref($context) ne 'Parser::Context') { + $id++; + @{"${class}::${id}::$options{context}::ISA"} = ("${class}::$options{context}", ref($context)); + $class .= "::${id}"; + } + bless $context, "${class}::$options{context}"; + } + + # + # Return the context + # + return $context; +} + +# +# Record original operator class and set the new one, +# extending to a new class if needed. +# +sub makeOpSubclass { + my ($context, $data, $operators, $op, $class, $extend) = @_; + my $def = $operators->get($op); + Value->Error("Context '%s' does not have a definition for '%s'", $from, $op) unless $def || $extend; + $data->{$op} = $def->{class}; + $operators->set($op => { class => "context::$context->{baseName}::${class}" }); + return $def; +} + +# +# Record original class for a given Value or Parser class +# +sub makeSubclass { + my ($context, $data, $Type, $Name) = @_; + my $type = lc($Type); + if ($Name =~ m/\(\)$/) { + my $name = substr($Name, 0, -2); + $data->{"${Type}::${name}_Parens"} = $context->{$type}{$Name} || $context->{$type}{$name} || "${Type}::${name}"; + $context->{$type}{$Name} = "context::$context->{baseName}::${Type}::${name}_Parens"; + return; + } + $data->{"${Type}::${Name}"} = $context->{$type}{$Name} || "${Type}::${Name}"; + $context->{$type}{$Name} = "context::$context->{baseName}::${Type}::${Name}"; + if ($Type eq 'Value' && $context->{$type}{"${Name}()"}) { + $data->{"${Type}::${Name}_Parens"} = $context->{$type}{"${Name}()"}; + $context->{$type}{"${Name}()"} = "context::$context->{baseName}::${Type}::${Name}_Parens"; + } +} + +################################################################################################# +################################################################################################# + +# +# A common class for getting the super-class of an extension class. +# +# This class handles all the details of dealing with the original +# object classes that you have overridden in the context. You should +# create a subclass of this class and define its extensionContext() +# method to return your base context name, and then include that +# subclass in your @ISA arrays for your new classes that override the +# original context's classes. +# +# For our quaternions example, you would use +# +# package context::Quaternions::Super +# our @ISA = ('context::Extensions::Super'); +# +# sub extensionContext { 'context::Quaternions' } +# +# and then use 'context::Quaternsions::Super' in the @ISA of your new +# classes for operators, functions, or Value or Parser objects. +# E.g., +# +# package context::Quaternions::BOP::add; +# our @ISA = ('context::Quaternions::Super', 'Parser::BOP'); +# +# sub _check { +# my $self = shift; +# return $self->mutate->_check +# unless $self->{lop}->class eq 'Quaternion' || $self->{rop}->class eq 'Quaternion'; +# # Do your checking for proper arguments to go along with a quaternion here +# } +# +# sub _eval { +# # Do what is needed to perform addition between quaternions or between +# # a quaternion or another legal value here. You don't have to worry +# # about any other types here, as the mutate() call above will change +# # the class to the original class (and its _eval() method) if one +# # of the operands isn't a quaternion. +# } +# +# If you need to call a method from the original class, use +# +# &{$self->super("method")}($self, args...); +# +# where "method" is the name of the method to call, and "args" are any arguments +# that you need to pass. For example, +# +# my $string = &{$self->super("string")}($self); +# +# would get the string output from the original class. +# +# The superClass() method gets you the name of the original class, in +# case you need to access any class variables from that. +# +package context::Extensions::Super; + +# +# Get a method from the original class from the extended context +# +sub super { + my ($self, $method) = @_; + return $self->superClass->can($method); +} + +# +# Get the super class name from the extension hash in the context +# +sub superClass { + my $self = shift; + my $class = ref($self) || $self; + my $name = $self->extensionContext; + my $data = $self->context->{$name}; + my $op = $self->{bop} || $self->{uop}; + return $op ? $data->{$op} : $data->{ substr($class, length($name) + 2) }; +} + +# +# Re-bless the current object to become the other object, +# if there is one, or the object's super class if not. +# +sub mutate { + my ($self, $other) = @_; + if ($other) { + delete $self->{$_} for (keys %$self); + $self->{$_} = $other->{$_} for (keys %$other); + bless $self, ref($other); + } elsif (ref($self) eq '') { + $self = $self->superClass; + } else { + bless $self, $self->superClass; + } + return $self; +} + +# +# Use the super-class new() method +# +sub new { + my $self = shift; + return &{ $self->super("new") }($self, @_); +} + +# +# Get the object's class from its class name +# +sub class { + my $self = shift; + my @class = split(/::/, ref($self) || $self); + my $name = $class[-2]; + return $name eq 'Value' || $name eq 'Parser' ? $class[-1] : $name; +} + +# +# This method must be supplied by subclassing +# context::Extensions::Super package and overriding this method with +# one that returns the extension context's name. +# +sub extensionContext { + warn Value::traceback(1); + die "The context must subclass context::Extensions::Super and supply an extensionContext() method"; +} + +################################################################################################# +################################################################################################# + +# +# A common class for handling the private extension data in an object's typeRef. +# +# This allows you to add and retrieve custom data to and from an +# object's type in such a way that it doesn't interfere with the +# original object's type, or that of any other extensions. +# +# A MathObject's typeRef property is a HASH that includes information +# about the object's type, its length (for things like lists and +# vectors), and entry types (again for objects like lists and +# vectors). We can add data to this hash to store additional +# information that we need in order to be more granualr about the +# type or class of a Parser object. +# +# To use this, create a subclass of context::Extensions::Data that +# has an extensionID() method that returns a name to use as the hash +# key to store your custom data (the default is to use the base +# context name). Your subclass should also include your Super class +# as a parent class. For example: +# +# package context::Quaternions::Data; +# our @ISA = ('context::Quaternions::Super', 'context::Extensions:Data'); +# +# sub extensionID { 'quatData' } +# +# Then use this new subclass in the @ISA list for any class that needs access +# to your custom data. +# +# The extensionData() method returns the complete hash of your custom +# data, from which you can extract the value of the property you +# need, or can set any properties that you want. E.g., +# +# $self->extensionData->{class}; +# +# could be used to obtain the custom "class" property of your data. +# +# The setExtensionType() method is used to set an object's +# $self->{type} property (which holds the object's typeRef) to a +# named type residing in your base context. For example: +# +# package context::Quaternions; +# our $QUATERNION = Value::Type("Number, undef, undef, quatData => {class => "QUATERNION"}); +# +# package context::Quaternions::Super +# our @ISA = ('context::Extensions::Super'); +# sub extensionContext { 'context::Quaternions' } +# +# package context::Quaternions::Data; +# our @ISA = ('context::Quaternions::Super', 'context::Extensions:Data'); +# sub extensionID { 'quatData' } +# +# package context::Quaternions::BOP::add; +# our @ISA = ('context::Quaternions::Data', 'Parser::BOP'); +# +# sub _check { +# my $self = shift; +# unless $self->{lop}->class eq 'Quaternion' || $self->{rop}->class eq 'Quaternion'; +# # other typechecking here +# $self->setExtensionType("QUATERNION"); # Use the type in the $QUATERNION variable above +# } +# +# Finally, the extensionDataMatch() method checks if the value of a +# given property is one of a set of values. For example, if you have +# a property called "class", then +# +# $self->extensionDataMatch($self->{lop}, "class", "QUATERNION", "COMPLEX"); +# +# would return 1 if the quatData->{class} was either "QUATERNION" or +# "COMPLEX" in the $self->{lop}{type} hash, and 0 otherwise. +# +package context::Extensions::Data; + +# +# Get the object's extensionData +# +sub extensionData { (shift)->typeRef->{ $self->extensionID } } + +# +# Set the object's extensionData (and the rest of its type) +# +sub setExtensionType { + my ($self, $type) = @_; + $self->{type} = ${ $self->extensionContext . "::${type}" }; +} + +# +# Check if an object's extension property matches one of the given values +# +sub extensionDataMatch { + my ($self, $x, $prop, @values) = @_; + my $value = $x->typeRef->{ $self->extensionID }{$prop}; + if (defined $value) { + for my $test (@values) { + return 1 if $test eq $value; + } + } + return 0; +} + +# +# The extnsion context can subclass that is produce a better name +# +sub extensionID { (shift)->extensionContext } + +################################################################################################# +################################################################################################# + +1; From 8eb9af9dc8639dd13e7cdfe31feb636647c892ec Mon Sep 17 00:00:00 2001 From: "Davide P. Cervone" Date: Thu, 29 Aug 2024 06:51:45 -0400 Subject: [PATCH 2/9] Make Fraction contexts as extensions so you can add fractions to other compatible contexts. Move original Fraction context to legacyFraction.pl --- macros/contexts/contextFraction.pl | 757 +++++++++++--------- macros/contexts/legacyFraction.pl | 1026 ++++++++++++++++++++++++++++ 2 files changed, 1445 insertions(+), 338 deletions(-) create mode 100644 macros/contexts/legacyFraction.pl diff --git a/macros/contexts/contextFraction.pl b/macros/contexts/contextFraction.pl index dbdcbfe64..c3758a44c 100644 --- a/macros/contexts/contextFraction.pl +++ b/macros/contexts/contextFraction.pl @@ -50,6 +50,22 @@ =head1 DESCRIPTION The fourth is the same as LimiteFraction, but students must enter proper fractions, and results are shown as proper fractions. +It is also possible to add fractions to an existing context using +C and passing it either the name of +the context, or the Context object itself. E.g.: + + Context(context::Fraction::extending("Matrix")); + +would produce a context where fractions can be used in Matrix entries. + +You can also pass any of the Fraction contact flags to +C to set those flags in the new +context. For example: + + Context(context::Fraction::extending("Matrix", allowMixedNumbers => 1)); + +would get a Matrix context where fractions can be entered as mixed numbers. + You can use the C function to generate fraction objects, or the C constructor to make one explicitly. For example: @@ -80,8 +96,8 @@ =head1 DESCRIPTION Here C<$c> will be the equivalent of C, C<$d> will be equivalent to C, and C<$e> will be the same as C -You can an answer checker for a fraction in the same way as you do for -ALL C -- via its C method: +You can produce an answer checker for a fraction in the same way as +you do for ALL C -- via its C method: ANS(Compute("1/2")->cmp); @@ -91,11 +107,11 @@ =head1 DESCRIPTION ANS($b->cmp); There are several options to the C method that control how the -answer checker will work. The first is controls whether unreduced +answer checker will work. The first controls whether unreduced fractions are accepted as correct. Unreduced fractions are allowed in the C and C contexts, but not in the -C context. You can control this using the -C option: +C and C contexts. You can +control this using the C option: Context("Fraction"); ANS(Compute("1/2")->cmp(studentsMustReduceFractions=>1)); @@ -105,7 +121,7 @@ =head1 DESCRIPTION Context("LimitedFraction"); ANS(Compute("1/2")->cmp(studentsMustReduceFractions=>0)); -The second controls whether warnings are issued when students don't +A second option controls whether warnings are issued when students don't reduce their answers, or to mark the answer incorrect silently. This is specified by the C option. The default is to report the warnings, but this option has an effect only when @@ -117,7 +133,7 @@ =head1 DESCRIPTION turns off these warnings. -The final option, requireFraction, specifies whether a fraction MUST +A final option, C, specifies whether a fraction MUST be entered (e.g. one would have to enter C<2/1> for a whole number). The default is 0. @@ -130,20 +146,19 @@ =head1 DESCRIPTION This determines whether fractions are reduced automatically when they are created. The default is to reduce fractions (except when -C is set), so C would produce -the fraction C<2/3>. To leave fractions unreduced, set -C 0 >>>. The C context has -C set, so reduceFractions is unset -automatically for students, but not for correct answers, so -C would still produce C<1/2>, even though C<2/4> would not be -allowed in a student answer. +C is set), so C would +produce the fraction C<2/3>. To leave fractions unreduced, set C 0 >>>. The C and +C contexts have C +set, so C is unset automatically for students, but +not for correct answers, so C would still produce +C<1/2>, even though C<2/4> would not be allowed in a student answer. =item S>> This determines whether division is allowed only between integers or not. If you want to prevent division from accepting non-integers, -then set C 1 >>> (and also C 1 >>> and -C 1 >>>). These are all three 0 by default in the +then set C 1 >>>. These are all three 0 by default in the C and C contexts, but 1 in C. =item S>> @@ -151,21 +166,22 @@ =head1 DESCRIPTION This determines whether a space between a whole number and a fraction is interpretted as implicit multiplication (as it usually would be in WeBWorK), or as addition, allowing "4 1/2" to mean "4 and 1/2". By -default, it acts as multiplication in the Fraction and -C contexts, and as addition in C. If -you set C 1 >>> you should also set C 0 >>>. -This parameter used to be named C, which is +default, it acts as multiplication in the C and +C contexts, and as addition in C +and C. If you set C 1 +>>> you should also set C 0 >>>. This +parameter used to be named C, which is deprecated, but you can still use it for backward-compatibility. =item S>> This controls whether fractions are displayed as proper fractions or -not. When set, C<5/2> will be displayed as C<2 1/2> in the answer preview -area, otherwise it will be displayed as C<5/2>. This flag is 0 by -default in the Fraction and Fraction-NoDecimals contexts, and 1 in -C. This parameter used to be named C, -which is deprecated, but you can still use it for -backward-compatibility. +not. When set, C<5/2> will be displayed as C<2 1/2> in the answer +preview area, otherwise it will be displayed as C<5/2>. This flag is +0 by default in the C and C contexts, +and 1 in C and C. This +parameter used to be named C, which is +deprecated, but you can still use it for backward-compatibility. =item S>> @@ -223,55 +239,105 @@ =head1 DESCRIPTION =cut +loadMacros('contextExtensions.pl'); + sub _contextFraction_init { context::Fraction::Init() } -########################################################################### +################################################################################################# +################################################################################################# package context::Fraction; +our @ISA = ('Parser::Context'); + +our $INTEGER = Value::Type("Number", undef, undef, fracData => { class => "INTEGER" }); +our $MINUS = Value::Type("Number", undef, undef, fracData => { class => "MINUS" }); +our $FRACTION = Value::Type("Number", undef, undef, fracData => { class => "FRACTION" }); +our $MIXED = Value::Type("Number", undef, undef, fracData => { class => "MIXED" }); + +# +# Extend a given context (by name or actual Context object) to include fractions +# The options are the default values for the Fraction context flags +# +sub extending { + my ($from, %options) = @_; + + # + # Get a copy of the original context + # + my $context = context::Extensions::create("Fraction", $from); + + # + # Add fractions into the number pattern + # + $context->{pattern}{signedNumber} = '(?:' . $context->{pattern}{signedNumber} . '|-?\d+\s*/\s*-?\d+)'; + + # + # Define fractions as being above Infinity + # + $context->{value}{Fraction} = "context::Fraction::Value::Fraction"; + $context->{precedence}{Fraction} = $context->{precedence}{Infinity} + .5; + + # + # Set the mixedNum class to be the original multiplication + # + my $operators = $context->operators; + my $mult = $operators->get('*'); + $context->{'context::Fraction'}{mixedNum} = $mult->{class}; + + # + # Extend the context with the needed classes and properties + # + return context::Extensions::extend( + $context, + opClasses => { + '/' => 'BOP::divide', + '//' => 'BOP::divide', + '/ ' => 'BOP::divide', + ' /' => 'BOP::divide', + 'u-' => 'UOP::minus', + ' ' => 'BOP::space', + }, + ops => { + ' ' => { + %$mult, + hidden => 1, + string => ' ', + TeX => '\,', + class => 'context::Fraction::BOP::and', + precedence => $mult->{precedence} - .1, + }, + mixedNum => { + %$mult, + hidden => 1, + class => "context::Fraction::BOP::space", + }, + ' ' => { string => 'mixedNum' }, + '/' => { precedence => $operators->get('/')->{precedence} + .1 }, + '//' => { precedence => $operators->get('//')->{precedence} + .1 }, + '/ ' => { precedence => $operators->get('/ ')->{precedence} + .1 }, + ' /' => { precedence => $operators->get(' /')->{precedence} + .1 }, + }, + value => ['Real'], + parser => [ 'Value', 'Number' ], + flags => { + reduceFractions => $options{reduceFractions} // 1, + strictFractions => $options{strictFractions} || 0, + allowMixedNumbers => $options{allowMixedNumbers} || 0, + requireProperFractions => $options{requireProperFractions} || 0, + requirePureFractions => $options{requirePureFractions} || 0, + showMixedNumbers => $options{showMixedNumbers} || 0, + contFracMaxDen => $options{contFracMaxDen} // 10**8, + }, + reductions => { 'a/b' => 1, 'a b/c' => 1, '0 a/b' => 1 }, + context => "Context" + ); +} # # Initialize the contexts and make the creator function. # sub Init { - my $context = $main::context{Fraction} = Parser::Context->getCopy("Numeric"); - $context->{name} = "Fraction"; - $context->{pattern}{signedNumber} = '(?:' . $context->{pattern}{signedNumber} . '|-?\d+/-?\d+)'; - $context->operators->set( - "/" => { class => "context::Fraction::BOP::divide" }, - "//" => { class => "context::Fraction::BOP::divide" }, - "/ " => { class => "context::Fraction::BOP::divide" }, - " /" => { class => "context::Fraction::BOP::divide" }, - "u-" => { class => "context::Fraction::UOP::minus" }, - " " => { precedence => 2.8, mq_precedence => 3, string => ' *' }, - " *" => { class => "context::Fraction::BOP::multiply", precedence => 2.8 }, - # precedence is lower to get proper parens in string() and TeX() calls - " " => { - precedence => 2.7, - associativity => 'left', - type => 'bin', - string => ' ', - class => 'context::Fraction::BOP::multiply', - TeX => [ ' ', ' ' ], - hidden => 1 - }, - ); - $context->flags->set( - reduceFractions => 1, - strictFractions => 0, - strictMinus => 0, - strictMultiplication => 0, - allowMixedNumbers => 0, # also set reduceConstants => 0 if you change this - requireProperFractions => 0, - requirePureFractions => 0, - showMixedNumbers => 0, - contFracMaxDen => 10**8, - ); - $context->reduction->set('a/b' => 1, 'a b/c' => 1, '0 a/b' => 1); - $context->{value}{Fraction} = "context::Fraction::Fraction"; - $context->{value}{Real} = "context::Fraction::Real"; - $context->{parser}{Value} = "context::Fraction::Value"; - $context->{parser}{Number} = "Parser::Legacy::LimitedNumeric::Number"; - $context->{precedence}{Fraction} = $context->{precedence}{Infinity} + .5; # Fractions are above Infinity + my $context = $main::context{Fraction} = context::Fraction::extending('Numeric'); $context = $main::context{'Fraction-NoDecimals'} = $context->copy; $context->{name} = "Fraction-NoDecimals"; @@ -279,82 +345,33 @@ sub Init { $context->{error}{msg}{"You are not allowed to type decimal numbers in this problem"} = "You are only allowed to enter fractions, not decimal numbers"; - $context = $main::context{LimitedFraction} = $context->copy; + $context = $main::context{LimitedFraction} = context::Fraction::extending('LimitedNumeric'); $context->{name} = "LimitedFraction"; - $context->operators->undefine('+', '-', '*', '* ', '^', '**', 'U', '.', '><', 'u+', '!', '_', ',',); - $context->parens->undefine('|', '{', '['); - $context->functions->disable('All'); $context->flags->set( - strictFractions => 1, - strictMinus => 1, - strictMultiplication => 1, - allowMixedNumbers => 1, - reduceConstants => 0, - showMixedNumbers => 1, + strictFractions => 1, + allowMixedNumbers => 1, + reduceConstants => 0, + showMixedNumbers => 1, ); $context->{cmpDefaults}{Fraction} = { studentsMustReduceFractions => 1 }; $context = $main::context{LimitedProperFraction} = $context->copy; $context->flags->set(requireProperFractions => 1); - main::PG_restricted_eval('sub Fraction {Value->Package("Fraction()")->new(@_)};'); -} - -# contFrac($x, $maxdenominator) -# Subroutine that takes a positive real input $x and outputs an array -# (a,b) where a/b is a very good fraction approximation with b no -# larger than maxdenominator. -sub contFrac { - my ($x, $maxdenominator) = @_; - - my $step = $x; - my $n = int($step); - my ($h0, $h1, $k0, $k1) = (1, $n, 0, 1); - - # End when $step is an integer. - while ($step != $n) { - $step = 1 / ($step - $n); - - # Compute the next integer from the continued fraction sequence. - $n = int($step); - - # Compute the next numerator and denominator according to the continued fraction formulas. - my ($newh, $newk) = ($n * $h1 + $h0, $n * $k1 + $k0); - - # Machine rounding error may begin to make denominators skyrocket out of control - last if ($newk > $maxdenominator); - - ($h0, $h1, $k0, $k1) = ($h1, $newh, $k1, $newk); - } - - return ($h1, $k1); + main::PG_restricted_eval('sub Fraction { Value->Package("Fraction()")->new(@_)} ;'); } # -# Convert a real to a reduced fraction approximation -# Uses contFrac() to convert .333333... into 1/3 rather -# than 333333/1000000, etc. +# Backward compatibility # -sub toFraction { - my $context = shift; - my $x = shift; - my $Real = $context->Package("Real"); - my ($a, $b); - if ($x == 0) { ($a, $b) = (0, 1); } - else { - my $sign = $x / abs($x); - ($a, $b) = contFrac(abs($x), $context->flag("contFracMaxDen")); - $a = $sign * $a; - } - return [ $Real->make($a), $Real->make($b) ]; -} +sub contFrac { context::Fraction::Context->continuedFraction(@_) } +sub toFraction { context::Fraction::Context->toFraction(@_) } # # Greatest Common Divisor # sub gcd { - my $a = abs(shift); - my $b = abs(shift); + my ($a, $b) = (abs(shift), abs(shift)); ($a, $b) = ($b, $a) if $a < $b; return $a if $b == 0; my $r = $a % $b; @@ -377,61 +394,155 @@ sub lcm { # Reduced fraction # sub reduce { - my $a = shift; - my $b = shift; + my ($a, $b) = @_; ($a, $b) = (-$a, -$b) if $b < 0; my $gcd = gcd($a, $b); return ($a / $gcd, $b / $gcd); } -########################################################################### +################################################################################################# +################################################################################################# -package context::Fraction::BOP::divide; -our @ISA = ('Parser::BOP::divide'); +package context::Fraction::Context; +our @ISA = ('Parser::Context'); + +sub class {'Context'} # -# Create a Fraction or Real from the given data +# Takes a positive real input and outputs an array (a,b) where a/b +# is a very good fraction approximation with b no larger than +# maxdenominator. # -sub _eval { - my $self = shift; - my $context = $self->{equation}{context}; - return $_[0] / $_[1] if Value::isValue($_[0]) || Value::isValue($_[1]); - my $n = $context->Package("Fraction")->make($context, @_); - $n->{isHorizontal} = 1 if $self->{def}{noFrac}; - return $n; +sub continuedFraction { + my ($self, $x) = @_; + my $step = $x; + my $n = int($step); + my ($h0, $h1, $k0, $k1) = (1, $n, 0, 1); + my $maxdenominator = $_[2] || $self->flag('contFracMaxDen', 10**8); + # + # End when $step is an integer. + # + while ($step != $n) { + $step = 1 / ($step - $n); + # + # Compute the next integer from the continued fraction sequence. + # + $n = int($step); + # + # Compute the next numerator and denominator according to the continued fraction formulas. + # + my ($newh, $newk) = ($n * $h1 + $h0, $n * $k1 + $k0); + # + # Machine rounding error may begin to make denominators skyrocket out of control + # + last if $newk > $maxdenominator; + ($h0, $h1, $k0, $k1) = ($h1, $newh, $k1, $newk); + } + return ($h1, $k1); +} + +# +# Convert a real to a reduced fraction approximation. +# +# Uses $context->continuedFracation() to convert .333333... into 1/3 +# rather than 333333/1000000, etc. +# +sub toFraction { + my ($self, $x, $max) = @_; + my ($a, $b); + if ($x == 0) { + ($a, $b) = (0, 1); + } else { + my $sign = $x / abs($x); + ($a, $b) = $self->continuedFraction(abs($x), $max); + $a = $sign * $a; + } + my $Real = $self->Package("Real"); + return [ $Real->make($a), $Real->make($b) ]; } +################################################################################################# +################################################################################################# + +# +# A common class for getting the super-class of an extension class +# +package context::Fraction::Super; +our @ISA = ('context::Extensions::Super'); + +sub extensionContext {'context::Fraction'} + +################################################################################################# +################################################################################################# + +# +# A common class for handling the fraction class data in an object's typeRef +# +package context::Fraction::Class; +our @ISA = ('context::Fraction::Super', 'context::Extensions::Data'); + +sub extensionID {'fracData'} + +sub extensionClassMatch { (shift)->extensionDataMatch(shift, "class", @_) } +sub setExtensionClass { (shift)->setExtensionType(@_) } + +################################################################################################# +################################################################################################# + +package context::Fraction::BOP::divide; +our @ISA = ('context::Fraction::Class', 'Parser::BOP'); + # # When strictFraction is in effect, only allow division # with integers and negative integers # sub _check { my $self = shift; - $self->SUPER::_check; - return unless $self->context->flag("strictFractions"); - $self->Error("The numerator of a fraction must be an integer") - unless $self->{lop}->class =~ /INTEGER|MINUS/; - $self->Error("The denominator of a fraction must be a (non-negative) integer") - unless $self->{rop}->class eq 'INTEGER'; - $self->Error("The numerator must be less than the denominator in a proper fraction") - if $self->context->flag("requireProperFractions") - && CORE::abs($self->{lop}->eval) >= CORE::abs($self->{rop}->eval); + my $lInt = $self->extensionClassMatch($self->{lop}, 'INTEGER', 'MINUS'); + my $rInt = $self->extensionClassMatch($self->{rop}, 'INTEGER', 'MINUS'); + if ($self->context->flag("strictFractions")) { + $self->Error("The numerator of a fraction must be an integer") unless $lInt; + my $rInt = $self->extensionClassMatch($self->{rop}, 'INTEGER'); + $self->Error("The denominator of a fraction must be a (non-negative) integer") unless $rInt; + $self->Error("The numerator must be less than the denominator in a proper fraction") + if $self->context->flag("requireProperFractions") + && CORE::abs($self->{lop}->eval) >= CORE::abs($self->{rop}->eval); + } + # + # This is not a fraction, so convert to original class and + # do its _check + # + return $self->mutate->_check unless $lInt && $rInt; + $self->setExtensionClass('FRACTION'); +} + +# +# Create a Fraction from the given data +# +sub _eval { + my $self = shift; + my $context = $self->context; + my $n = $context->Package("Fraction")->make($context, @_); + $n->{isHorizontal} = 1 if $self->{def}{noFrac}; + return $n; } # -# Reduce the fraction, if it is one, otherwise do the usual reduce +# Reduce the fraction # sub reduce { - my $self = shift; - return $self->SUPER::reduce unless $self->class eq 'FRACTION'; + my $self = shift; my $reduce = $self->{equation}{context}{reduction}; return $self->{lop} if $self->{rop}{isOne} && $reduce->{'x/1'}; $self->Error("Division by zero"), return $self if $self->{rop}{isZero}; return $self->{lop} if $self->{lop}{isZero} && $reduce->{'0/x'}; if ($reduce->{'a/b'}) { my ($a, $b) = context::Fraction::reduce($self->{lop}->eval, $self->{rop}->eval); - if ($self->{lop}->class eq 'INTEGER') { $self->{lop}{value} = $a } - else { $self->{lop}{op}{value} = -$a } + if ($self->extensionClassMatch($self->{lop}, 'INTEGER')) { + $self->{lop}{value} = $a; + } else { + $self->{lop}{op}{value} = -$a; + } $self->{rop}{value} = $b; } return $self; @@ -443,42 +554,22 @@ sub reduce { sub TeX { my $self = shift; my $bop = $self->{def}; - return $self->SUPER::TeX(@_) if $self->class ne 'FRACTION' || $bop->{noFrac}; my ($precedence, $showparens, $position, $outerRight) = @_; $showparens = '' unless defined($showparens); my $addparens = defined($precedence) && ($showparens eq 'all' || ($precedence > $bop->{precedence} && $showparens ne 'nofractions') || ($precedence == $bop->{precedence} && ($bop->{associativity} eq 'right' || $showparens eq 'same'))); - my $TeX = $self->eval->TeX; - $TeX = '\left(' . $TeX . '\right)' if ($addparens); + $TeX = '\left(' . $TeX . '\right)' if $addparens; return $TeX; } -# -# Indicate if the value is a fraction or not -# -sub class { - my $self = shift; - return "FRACTION" - if $self->{lop}->class =~ /INTEGER|MINUS/ - && $self->{rop}->class eq 'INTEGER'; - return $self->SUPER::class; -} - -########################################################################### - -package context::Fraction::BOP::multiply; -our @ISA = ('Parser::BOP::multiply'); +################################################################################################# +################################################################################################# -# -# For proper fractions, add the integer to the fraction -# -sub _eval { - my ($self, $a, $b) = @_; - return ($a >= 0 ? $a + $b : $a - $b); -} +package context::Fraction::BOP::space; +our @ISA = ('context::Fraction::Class', 'Parser::BOP'); # # If the implied multiplication represents a proper fraction with a @@ -487,53 +578,60 @@ sub _eval { # convert the object to a standard multiplication. # sub _check { - my $self = shift; - $self->SUPER::_check; - my $isFraction = 0; - my $allowMixedNumbers = $self->context->flag("allowProperFractions"); - $allowMixedNumbers = $self->context->flag("allowMixedNumbers") - unless defined($allowMixedNumbers) && $allowMixedNumbers ne ""; - if ($allowMixedNumbers) { - $isFraction = - ($self->{lop}->class =~ /INTEGER|MINUS/ - && !$self->{lop}{hadParens} - && $self->{rop}->class eq 'FRACTION' - && !$self->{rop}{hadParens} - && $self->{rop}->eval >= 0); + my $self = shift; + my $context = $self->context; + my $allowMixedNumbers = $context->flag("allowProperFractions") || $context->flag("allowMixedNumbers"); + # + # This is not a mixed number, so convert to original class and do + # its _check + # + unless ($allowMixedNumbers + && $self->extensionClassMatch($self->{lop}, 'INTEGER', 'MINUS') + && !$self->{lop}{hadParens} + && $self->extensionClassMatch($self->{rop}, 'FRACTION') + && !$self->{rop}{hadParens} + && $self->{rop}->eval >= 0) + { + $self->{bop} = $self->{def}{string}; + $self->{def} = $context->{operators}{ $self->{bop} }; + return $self->mutate->_check; } - if ($isFraction) { - $self->Error("Mixed numbers are not allowed; you must use a pure fraction") - if ($self->context->flag("requirePureFractions")); - $self->{isFraction} = 1; - $self->{bop} = " "; - $self->{def} = $self->context->{operators}{ $self->{bop} }; - if ($self->{lop}->class eq 'MINUS') { - # - # Hack to replace BOP with unary negation of BOP. - # (When check() is changed to accept a return value, - # this will not be necessary.) - # - my $copy = bless {%$self}, ref($self); - $copy->{lop} = $copy->{lop}{op}; - my $neg = $self->Item("UOP")->new($self->{equation}, "u-", $copy); - map { delete $self->{$_} } (keys %$self); - map { $self->{$_} = $neg->{$_} } (keys %$neg); - bless $self, ref($neg); - } + $self->{type} = $context::Fraction::MIXED; + $self->Error("Mixed numbers are not allowed; you must use a pure fraction") + if $context->flag("requirePureFractions"); + $self->{bop} = ' '; + $self->{def} = $context->{operators}{ $self->{bop} }; + if ($self->extensionClassMatch($self->{lop}, 'MINUS')) { + my $copy = bless {%$self}, $self->{def}{class}; + $copy->{lop} = $copy->{lop}{op}; + $self->mutate($self->Item("UOP")->new($self->{equation}, "u-", $copy)); } else { - $self->Error("Can't use implied multiplication in this context", $self->{bop}) - if $self->context->flag("strictMultiplication"); - bless $self, $ISA[0]; + bless $self, $self->{def}{class}; } } # -# Indicate if the value is a fraction or not +# For when the space operator's space property sends to an +# operator we didn't otherwise subclass. # -sub class { - my $self = shift; - return "FRACTION" if $self->{isFraction}; - return $self->SUPER::class; +package context::Fraction::BOP::Space; +our @ISA = ('context::Fraction::BOP::space'); + +################################################################################################# +################################################################################################# + +# +# Implements the space between mixed numbers +# +package context::Fraction::BOP::and; +our @ISA = ('Parser::BOP'); + +# +# For proper fractions, add the integer to the fraction +# +sub _eval { + my ($self, $a, $b) = @_; + return ($a >= 0 ? $a + $b : $a - $b)->with(showMixedNumbers => 1); } # @@ -556,54 +654,33 @@ sub reduce { return $self; } -########################################################################### +################################################################################################# +################################################################################################# package context::Fraction::UOP::minus; -our @ISA = ('Parser::UOP::minus'); +our @ISA = ('context::Fraction::Class', 'Parser::UOP'); # # For strict fractions, only allow minus on certain operands # sub _check { my $self = shift; - $self->SUPER::_check; $self->{hadParens} = 1 if $self->{op}{hadParens}; - return unless $self->context->flag("strictMinus"); - my $uop = $self->{def}{string} || $self->{uop}; - $self->Error("You can only use '%s' with (non-negative) numbers", $uop) - unless $self->{op}->class =~ /Number|INTEGER|FRACTION/; -} - -# -# class is MINUS if it is a negative number -# -sub class { - my $self = shift; - return "MINUS" if $self->{op}->class =~ /Number|INTEGER/; - $self->SUPER::class; -} - -# -# make isNeg properly handle the modified class -# -sub isNeg { - my $self = shift; - return ($self->class =~ /UOP|MINUS/ && $self->{uop} eq 'u-' && !$self->{op}->{isInfinite}); - + &{ $self->super('_check') }($self); + $self->setExtensionClass('MINUS') if $self->{op}->class eq 'Number'; + $self->mutate; } -########################################################################### +################################################################################################# +################################################################################################# -package context::Fraction::Value; -our @ISA = ('Parser::Value'); +package context::Fraction::Parser::Value; +our @ISA = ('context::Fraction::Class', 'Parser::Value'); -# -# Indicate if the Value object is a fraction or not -# -sub class { - my $self = shift; - return "FRACTION" if $self->{value}->classMatch('Fraction'); - return $self->SUPER::class; +sub check { + my $self = shift; + my $value = &{ $self->super("check") }($self, @_); + $self->mutate unless $self->{value}->classMatch('Fraction'); } # @@ -612,24 +689,18 @@ sub class { sub reduce { my $self = shift; my $reduce = $self->context->{reduction}; - if ($self->{value}->class eq 'Fraction') { - $self->{value} = $self->{value}->reduce; - if ($reduce->{'-n'} && $self->{value}{data}[0] < 0) { - $self->{value}{data}[0] = -$self->{value}{data}[0]; - return Parser::UOP::Neg($self); - } - return $self; - } - return $self->SUPER::reduce; + $self->{value} = $self->{value}->reduce; + return $self unless $reduce->{'-n'} && $self->{value}{data}[0] < 0; + $self->{value}{data}[0] = -$self->{value}{data}[0]; + return Parser::UOP::Neg($self); } # # Add parentheses if they were there originally, or are needed by precedence # sub string { - my $self = shift; - my $string = $self->SUPER::string(@_); - return $string unless $self->{value}->classMatch('Fraction'); + my $self = shift; + my $string = &{ $self->super('string') }($self, @_); my $precedence = shift; my $frac = $self->context->operators->get('/')->{precedence}; $string = '(' . $string . ')' if $self->{hadParens} || (defined $precedence && $precedence > $frac); @@ -642,23 +713,41 @@ sub string { # sub TeX { my $self = shift; - my $string = $self->SUPER::TeX(@_); - return $string unless $self->{value}->classMatch('Fraction'); - my $precedence = shift; - my $frac = $self->context->operators->get('/')->{precedence}; - my $noparens = shift; + my $string = &{ $self->super('TeX') }($self, @_); + my ($precedence, $noparens) = @_; + my $frac = $self->context->operators->get('/')->{precedence}; $string = '\left(' . $string . '\right)' if $self->{hadParens} || (defined $precedence && $precedence > $frac && !$noparens); return $string; } -########################################################################### +# +# Just return the fraction +# +sub makeMatrix { (shift)->{value} } + +################################################################################################# +################################################################################################# + +# +# Distinguish integers from decimals +# +package context::Fraction::Parser::Number; +our @ISA = ('context::Fraction::Class', 'Parser::Number'); + +sub new { + my $self = shift; + my $num = &{ $self->super('new') }($self, @_); + $num->setExtensionClass('INTEGER') if $num->{value_string} =~ m/^[-+]?[0-9]+$/; + return $num->mutate; +} -package context::Fraction::Real; -our @ISA = ('Value::Real'); +################################################################################################# +################################################################################################# -sub cmp_defaults { Value::Real::cmp_defaults(@_) } +package context::Fraction::Value::Real; +our @ISA = ('context::Fraction::Super', 'Value::Real'); # # Allow Real to convert Fractions to Reals @@ -667,9 +756,9 @@ sub new { my $self = shift; my $context = (Value::isContext($_[0]) ? shift : $self->context); my $x = shift; - $x = $context->Package("Formula")->new($context, $x)->eval if ref($x) eq "" && $x =~ m!/!; - $x = $x->eval if scalar(@_) == 0 && Value::classMatch($x, 'Fraction'); - $self->SUPER::new($context, $x, @_); + $x = $context->Package("Formula")->new($context, $x)->eval if !ref($x) && $x =~ m!/!; + $x = $x->eval if @_ == 0 && Value::classMatch($x, 'Fraction'); + return &{ $self->super("new") }($self, $context, $x, @_); } # @@ -680,18 +769,23 @@ sub make { my $self = shift; my $context = (Value::isContext($_[0]) ? shift : $self->context); my $x = shift; - $x = $context->Package("Formula")->new($context, $x)->eval if ref($x) eq "" && $x =~ m!/!; - $x = $x->eval if scalar(@_) == 0 && Value::classMatch($x, 'Fraction'); - $self->SUPER::make($context, $x, @_); + $x = $context->Package("Formula")->new($context, $x)->eval if !ref($x) && $x =~ m!/!; + $x = $x->eval if @_ == 0 && Value::classMatch($x, 'Fraction'); + return &{ $self->super("make") }($self, $context, $x, @_); } -########################################################################### -########################################################################### +################################################## + +package context::Fraction::Value::Real_Parens; +our @ISA = ('context::Fraction::Value::Real'); + +################################################################################################# +################################################################################################# # # Implements the MathObject for fractions # -package context::Fraction::Fraction; +package context::Fraction::Value::Fraction; our @ISA = ('Value'); sub new { @@ -699,17 +793,17 @@ sub new { my $class = ref($self) || $self; my $context = (Value::isContext($_[0]) ? shift : $self->context); my $x = shift; - $x = [ $x, @_ ] if scalar(@_) > 0; + $x = [ $x, @_ ] if @_ > 0; return $x->inContext($context) if Value::classMatch($x, 'Fraction'); $x = [$x] unless ref($x) eq 'ARRAY'; - $x->[1] = 1 if scalar(@{$x}) == 1; - Value::Error("Can't convert ARRAY of length %d to %s", scalar(@{$x}), Value::showClass($self)) - unless (scalar(@{$x}) == 2); + $x->[1] = 1 if @$x == 1; + Value::Error("Can't convert ARRAY of length %d to %s", scalar(@$x), Value::showClass($self)) + unless @$x == 2; $x->[0] = Value::makeValue($x->[0], context => $context); $x->[1] = Value::makeValue($x->[1], context => $context); - return $x->[0] if Value::classMatch($x->[0], 'Fraction') && scalar(@_) == 0; - $x = context::Fraction::toFraction($context, $x->[0]->value) if Value::isReal($x->[0]) && scalar(@_) == 0; - return $self->formula($x) if Value::isFormula($x->[0]) || Value::isFormula($x->[1]); + return $x->[0] if Value::classMatch($x->[0], 'Fraction') && @_ == 0; + $x = $context->toFraction($x->[0]->value) if Value::isReal($x->[0]) && @_ == 0; + return $self->formula($x) if Value::isFormula($x->[0]) || Value::isFormula($x->[1]); Value::Error("Fraction numerators must be integers") unless isInteger($x->[0]); Value::Error("Fraction denominators must be integers") unless isInteger($x->[1]); my ($a, $b) = ($x->[0]->value, $x->[1]->value); @@ -727,8 +821,8 @@ sub make { my $self = shift; my $class = ref($self) || $self; my $context = (Value::isContext($_[0]) ? shift : $self->context); - push(@_, 0) if scalar(@_) == 0; - push(@_, 1) if scalar(@_) == 1; + push(@_, 0) if @_ == 0; + push(@_, 1) if @_ == 1; my ($a, $b) = @_; ($a, $b) = (-$a, -$b) if $b < 0; return $context->Package("Real")->make($context, $a / $b) unless isInteger($a) && isInteger($b); @@ -745,13 +839,13 @@ sub promote { my $self = shift; my $class = ref($self) || $self; my $context = (Value::isContext($_[0]) ? shift : $self->context); - my $x = (scalar(@_) ? shift : $self); - if (scalar(@_) == 0) { + my $x = (@_ ? shift : $self); + if (@_ == 0) { return $x->inContext($context) if ref($x) eq $class; return (bless { data => [ $x->value, 1 ], context => $context }, $class) if Value::isReal($x); return (bless { data => [ $x, 1 ], context => $context }, $class) if Value::matchNumber($x); } - return $x if Value::isValue($x) && $x->classMatch("Infinity"); + return $x if Value::classMatch($x, "Infinity"); return $self->new($context, $x, @_); } @@ -762,7 +856,7 @@ sub formula { my $self = shift; my $value = shift; my $formula = $self->Package("Formula")->blank($self->context); - my ($l, $r) = Value::toFormula($formula, @{$value}); + my ($l, $r) = Value::toFormula($formula, @$value); $formula->{tree} = $formula->Item("BOP")->new($formula, '/', $l, $r); return $formula; } @@ -770,7 +864,7 @@ sub formula { # # Return the real number type # -sub typeRef { return $Value::Type{number} } +sub typeRef {$context::Fraction::FRACTION} sub length {2} sub isZero { (shift)->{data}[0] == 0 } @@ -847,10 +941,16 @@ sub power { ($a, $b, $c) = ($b, $a, -$c) if $c < 0; my ($x, $y) = ($c == 1 ? ($a, $b) : ($a**$c, $b**$c)); if ($d != 1) { - if ($x < 0 && $d % 2 == 1) { $x = -(-$x)**(1 / $d) } - else { $x = $x**(1 / $d) } - if ($y < 0 && $d % 2 == 1) { $y = -(-$y)**(1 / $d) } - else { $y = $y**(1 / $d) } + if ($x < 0 && $d % 2 == 1) { + $x = -(-$x)**(1 / $d); + } else { + $x = $x**(1 / $d); + } + if ($y < 0 && $d % 2 == 1) { + $y = -(-$y)**(1 / $d); + } else { + $y = $y**(1 / $d); + } } return $self->inherit($other)->make($x, $y) unless $x eq 'nan' || $y eq 'nan'; Value::Error("Can't raise a negative number to a non-integer power") if $a * $b < 0; @@ -913,13 +1013,8 @@ sub isReduced { return $a == $c && $b == $d; } -sub num { - return (shift->value)[0]; -} - -sub den { - return (shift->value)[1]; -} +sub num { (shift->value)[0] } +sub den { (shift->value)[1] } ################################################## # @@ -927,46 +1022,35 @@ sub den { # sub string { - my $self = shift; - my $equation = shift; - shift; - shift; - my $prec = shift; + my ($self, $equation, $skip1, $skip2, $prec) = @_; my ($a, $b) = @{ $self->{data} }; my $n = ""; return "$a" if $b == 1; - if ($self->getFlagWithAlias("showMixedNumbers", "showProperFractions") && CORE::abs($a) > $b) { $n = int($a / $b); $a = CORE::abs($a) % $b; - $n .= " " unless $a == 0; + $n .= ' ' unless $a == 0; } $n .= "$a/$b" unless $a == 0 && $n ne ''; - return "$n"; + return $n; } sub TeX { - my $self = shift; - my $equation = shift; - shift; - shift; - my $prec = shift; + my ($self, $equation, $skip1, $skip2, $prec) = @_; my ($a, $b) = @{ $self->{data} }; - my $n = ""; - my $textstyle = ''; + my $n = ""; + my $style = ''; return "$a" if $b == 1; - if ($self->getFlagWithAlias("showMixedNumbers", "showProperFractions") && CORE::abs($a) > $b) { - $n = int($a / $b); - $a = CORE::abs($a) % $b; - $n .= ' ' unless $a == 0; - $textstyle = '\\textstyle'; + $n = int($a / $b); + $a = CORE::abs($a) % $b; + $style = '\\textstyle'; } my $s = ""; ($a, $s) = (-$a, "-") if $a < 0; - $n .= ($self->{isHorizontal} ? "$s$a/$b" : "${s}{$textstyle\\frac{$a}{$b}}") + $n .= ($self->{isHorizontal} ? "$s$a/$b" : "${s}{$style\\frac{$a}{$b}}") unless $a == 0 && $n ne ''; - return "$n"; + return $n; } sub pdot { @@ -990,17 +1074,14 @@ sub pdot { ) } sub cmp_contextFlags { - my $self = shift; - my $ans = shift; - return ($self->SUPER::cmp_contextFlags($ans), reduceFractions => !$ans->{studentsMustReduceFractions},); + my ($self, $ans) = @_; + return ($self->SUPER::cmp_contextFlags($ans), reduceFractions => !$ans->{studentsMustReduceFractions}); } sub cmp_class {"a fraction of integers"} sub typeMatch { - my $self = shift; - my $other = shift; - my $ans = shift; + my ($self, $other, $ans) = @_; return 1 unless ref($other); return 0 if Value::isFormula($other); return 1 if $other->type eq 'Infinity' && $ans->{ignoreInfinity}; @@ -1009,8 +1090,7 @@ sub typeMatch { } sub cmp_postprocess { - my $self = shift; - my $ans = shift; + my ($self, $ans) = @_; my $student = $ans->{student_value}; return if $ans->{isPreview} @@ -1021,6 +1101,7 @@ sub cmp_postprocess { $self->cmp_Error($ans, "Your fraction is not reduced") if $ans->{showFractionReduceWarnings}; } -########################################################################### +################################################################################################# +################################################################################################# 1; diff --git a/macros/contexts/legacyFraction.pl b/macros/contexts/legacyFraction.pl new file mode 100644 index 000000000..dbdcbfe64 --- /dev/null +++ b/macros/contexts/legacyFraction.pl @@ -0,0 +1,1026 @@ + +=head1 NAME + +contextFraction.pl - Implements a MathObject class for Fractions. + +=head1 DESCRIPTION + +This context implements a Fraction object that works like a Real, but +keeps the numerator and denominator separate. It provides methods for +reducing the fractions, and for allowing fractions with a whole-number +preceding it, as in C<4 1/2> for "four and one half". The answer +checker can require that students reduce their results, and there are +contexts that don't allow entery of decimal values (only fractions), +and that don't allow any operators or functions (other than division +and negation). + +To use these contexts, first load the contextFraction.pl file: + + loadMacros("contextFraction.pl"); + +and then select the appropriate context -- one of the following: + + Context("Fraction"); + Context("Fraction-NoDecimals"); + Context("LimitedFraction"); + Context("LimitedProperFraction"); + +The first is the most general, and allows fractions to be intermixed +with real numbers, so C<1/2 + .5> would be allowed. Also, C<1/2.5> is +allowed, though it produces a real number, not a fraction, since this +fraction class only implements fractions of integers. All operators +and functions are defined, so there are no restrictions on what is +allowed by the student. + +The second does not allow decimal numbers to be entered, but they can +still be produced as the result of function calls, or by named +constants such as "pi". For example, C<1/sqrt(2)> is allowed (and +produces a real number result). All functions and operations are +defined, and the only real difference between this and the previous +context is that decimal numbers can't be typed in explicitly. + +The third context limits the operations that can be performed: in +addition to not being able to type decimal numbers, no operations +other than division and negation are allowed, and no function calls at +all. Thus C<1/sqrt(2)> would be illegal, as would C<1/2 + 2>. The student +must enter a whole number or a fraction in this context. It is also +permissible to enter a whole number WITH a fraction, as in C<2 1/2> for +"two and one half", or C<5/2>. + +The fourth is the same as LimiteFraction, but students must enter proper +fractions, and results are shown as proper fractions. + +You can use the C function to generate fraction objects, or +the C constructor to make one explicitly. For example: + + Context("Fraction"); + $a = Compute("1/2"); + $b = Compute("4 - 1/6"); + $c = Compute("(4/9)^(1/2)"); + + Context("LimitedFraction"); + $d = Compute("4 2/3"); + $e = Compute("-1 1/2"); + + $f = Fraction(-2,5); + +Note that C<$c> will be C<2/3>, $d will be C<14/3>, $e will be C<-3/2>, and C<$f> +will be C<-2/5>. + +Once you have created a fraction object, you can use it as you would +any real number. For example: + + Context("Fraction"); + $a = Compute("1/2"); + $b = Compute("1/3"); + $c = $a - $b; + $d = asin($a); + $e = $b**2; + +Here C<$c> will be the equivalent of C, C<$d> will be +equivalent to C, and C<$e> will be the same as C + +You can an answer checker for a fraction in the same way as you do for +ALL C -- via its C method: + + ANS(Compute("1/2")->cmp); + +or + + $b = Compute("1/2"); + ANS($b->cmp); + +There are several options to the C method that control how the +answer checker will work. The first is controls whether unreduced +fractions are accepted as correct. Unreduced fractions are allowed in +the C and C contexts, but not in the +C context. You can control this using the +C option: + + Context("Fraction"); + ANS(Compute("1/2")->cmp(studentsMustReduceFractions=>1)); + +or + + Context("LimitedFraction"); + ANS(Compute("1/2")->cmp(studentsMustReduceFractions=>0)); + +The second controls whether warnings are issued when students don't +reduce their answers, or to mark the answer incorrect silently. This +is specified by the C option. The default +is to report the warnings, but this option has an effect only when +C is 1, and so only in the C +context. For example, + + Context("LimitedFraction"); + ANS(Compute("1/2")->cmp(showFractionReductionWarnings=>0)); + +turns off these warnings. + +The final option, requireFraction, specifies whether a fraction MUST +be entered (e.g. one would have to enter C<2/1> for a whole number). The +default is 0. + +In addition to these options for C, there are Context flags that +control how fractions are handled. These include the following. + +=over + +=item S>> + +This determines whether fractions are reduced automatically when they +are created. The default is to reduce fractions (except when +C is set), so C would produce +the fraction C<2/3>. To leave fractions unreduced, set +C 0 >>>. The C context has +C set, so reduceFractions is unset +automatically for students, but not for correct answers, so +C would still produce C<1/2>, even though C<2/4> would not be +allowed in a student answer. + +=item S>> + +This determines whether division is allowed only between integers or +not. If you want to prevent division from accepting non-integers, +then set C 1 >>> (and also C 1 >>> and +C 1 >>>). These are all three 0 by default in the +C and C contexts, but 1 in C. + +=item S>> + +This determines whether a space between a whole number and a fraction +is interpretted as implicit multiplication (as it usually would be in +WeBWorK), or as addition, allowing "4 1/2" to mean "4 and 1/2". By +default, it acts as multiplication in the Fraction and +C contexts, and as addition in C. If +you set C 1 >>> you should also set C 0 >>>. +This parameter used to be named C, which is +deprecated, but you can still use it for backward-compatibility. + +=item S>> + +This controls whether fractions are displayed as proper fractions or +not. When set, C<5/2> will be displayed as C<2 1/2> in the answer preview +area, otherwise it will be displayed as C<5/2>. This flag is 0 by +default in the Fraction and Fraction-NoDecimals contexts, and 1 in +C. This parameter used to be named C, +which is deprecated, but you can still use it for +backward-compatibility. + +=item S>> + +This determines whether fractions MUST be entered as proper fractions. +It is 0 by default, meaning improper fractions are allowed. When set, +you will not be able to enter 5/2 as a fraction, but must use "2 1/2". +This flag is allowed only when C is in effect. Set it +to 1 only when you also set C, or you will not be able +to specify fractions bigger than one. It is off by default in all +four contexts. You should not set both C and +C to 1. + +=item S>> + +This determines whether fractions MUST be entered as pure fractions +rather than mixed numbers. If C is also set, then +mixed numbers will be properly interpretted, but will produce a +warning message and be marked incorrect; that is, C<2 3/4> would be +recognized as C<2+3/4> rather than C<2*3/4>, but would generate a message +indicating that mixed numbers are not allowed. This flag is off by +default in all four contexts. You should not set both +C and C to 1. + +=back + +Fraction objects have two methods that can be useful when +C is set to 0. The C method will reduce a +fraction to lowest terms, and the C method returns true when +the fraction is reduced and false otherwise. + +Fraction objects also have the C and C methods to return the +numerator and denominator. Note that these will be the unreduced numerator +and denominator when the C is set to 0. + +If you wish to convert a fraction to its numeric (real number) form, +use the C constructor to coerce it to a real. E.g., + + $a = Compute("1/2"); + $r = Real($a); + +would set $r to the value 0.5. Similarly, use C to convert a +real number to (an approximating) fraction. E.g., + + $r = Real(.5); + $a = Fraction($r); + +would set C<$a> to be C<1/2>. The fraction produced is good to about 6 +decimal places, so it can't be used for numbers that are too small. + +A side-effect of using the C context is that fractions can be +used to take powers of negative numbers when the reduced form of the +fraction has an odd denominator. Thus C<(-8)^(1/3)> will produce -2 as a +result, while in the standard C context it would produce an +error. + +=cut + +sub _contextFraction_init { context::Fraction::Init() } + +########################################################################### + +package context::Fraction; + +# +# Initialize the contexts and make the creator function. +# +sub Init { + my $context = $main::context{Fraction} = Parser::Context->getCopy("Numeric"); + $context->{name} = "Fraction"; + $context->{pattern}{signedNumber} = '(?:' . $context->{pattern}{signedNumber} . '|-?\d+/-?\d+)'; + $context->operators->set( + "/" => { class => "context::Fraction::BOP::divide" }, + "//" => { class => "context::Fraction::BOP::divide" }, + "/ " => { class => "context::Fraction::BOP::divide" }, + " /" => { class => "context::Fraction::BOP::divide" }, + "u-" => { class => "context::Fraction::UOP::minus" }, + " " => { precedence => 2.8, mq_precedence => 3, string => ' *' }, + " *" => { class => "context::Fraction::BOP::multiply", precedence => 2.8 }, + # precedence is lower to get proper parens in string() and TeX() calls + " " => { + precedence => 2.7, + associativity => 'left', + type => 'bin', + string => ' ', + class => 'context::Fraction::BOP::multiply', + TeX => [ ' ', ' ' ], + hidden => 1 + }, + ); + $context->flags->set( + reduceFractions => 1, + strictFractions => 0, + strictMinus => 0, + strictMultiplication => 0, + allowMixedNumbers => 0, # also set reduceConstants => 0 if you change this + requireProperFractions => 0, + requirePureFractions => 0, + showMixedNumbers => 0, + contFracMaxDen => 10**8, + ); + $context->reduction->set('a/b' => 1, 'a b/c' => 1, '0 a/b' => 1); + $context->{value}{Fraction} = "context::Fraction::Fraction"; + $context->{value}{Real} = "context::Fraction::Real"; + $context->{parser}{Value} = "context::Fraction::Value"; + $context->{parser}{Number} = "Parser::Legacy::LimitedNumeric::Number"; + $context->{precedence}{Fraction} = $context->{precedence}{Infinity} + .5; # Fractions are above Infinity + + $context = $main::context{'Fraction-NoDecimals'} = $context->copy; + $context->{name} = "Fraction-NoDecimals"; + Parser::Number::NoDecimals($context); + $context->{error}{msg}{"You are not allowed to type decimal numbers in this problem"} = + "You are only allowed to enter fractions, not decimal numbers"; + + $context = $main::context{LimitedFraction} = $context->copy; + $context->{name} = "LimitedFraction"; + $context->operators->undefine('+', '-', '*', '* ', '^', '**', 'U', '.', '><', 'u+', '!', '_', ',',); + $context->parens->undefine('|', '{', '['); + $context->functions->disable('All'); + $context->flags->set( + strictFractions => 1, + strictMinus => 1, + strictMultiplication => 1, + allowMixedNumbers => 1, + reduceConstants => 0, + showMixedNumbers => 1, + ); + $context->{cmpDefaults}{Fraction} = { studentsMustReduceFractions => 1 }; + + $context = $main::context{LimitedProperFraction} = $context->copy; + $context->flags->set(requireProperFractions => 1); + + main::PG_restricted_eval('sub Fraction {Value->Package("Fraction()")->new(@_)};'); +} + +# contFrac($x, $maxdenominator) +# Subroutine that takes a positive real input $x and outputs an array +# (a,b) where a/b is a very good fraction approximation with b no +# larger than maxdenominator. +sub contFrac { + my ($x, $maxdenominator) = @_; + + my $step = $x; + my $n = int($step); + my ($h0, $h1, $k0, $k1) = (1, $n, 0, 1); + + # End when $step is an integer. + while ($step != $n) { + $step = 1 / ($step - $n); + + # Compute the next integer from the continued fraction sequence. + $n = int($step); + + # Compute the next numerator and denominator according to the continued fraction formulas. + my ($newh, $newk) = ($n * $h1 + $h0, $n * $k1 + $k0); + + # Machine rounding error may begin to make denominators skyrocket out of control + last if ($newk > $maxdenominator); + + ($h0, $h1, $k0, $k1) = ($h1, $newh, $k1, $newk); + } + + return ($h1, $k1); +} + +# +# Convert a real to a reduced fraction approximation +# Uses contFrac() to convert .333333... into 1/3 rather +# than 333333/1000000, etc. +# +sub toFraction { + my $context = shift; + my $x = shift; + my $Real = $context->Package("Real"); + my ($a, $b); + if ($x == 0) { ($a, $b) = (0, 1); } + else { + my $sign = $x / abs($x); + ($a, $b) = contFrac(abs($x), $context->flag("contFracMaxDen")); + $a = $sign * $a; + } + return [ $Real->make($a), $Real->make($b) ]; +} + +# +# Greatest Common Divisor +# +sub gcd { + my $a = abs(shift); + my $b = abs(shift); + ($a, $b) = ($b, $a) if $a < $b; + return $a if $b == 0; + my $r = $a % $b; + while ($r != 0) { + ($a, $b) = ($b, $r); + $r = $a % $b; + } + return $b; +} + +# +# Least Common Multiple +# +sub lcm { + my ($a, $b) = @_; + return ($a / gcd($a, $b)) * $b; +} + +# +# Reduced fraction +# +sub reduce { + my $a = shift; + my $b = shift; + ($a, $b) = (-$a, -$b) if $b < 0; + my $gcd = gcd($a, $b); + return ($a / $gcd, $b / $gcd); +} + +########################################################################### + +package context::Fraction::BOP::divide; +our @ISA = ('Parser::BOP::divide'); + +# +# Create a Fraction or Real from the given data +# +sub _eval { + my $self = shift; + my $context = $self->{equation}{context}; + return $_[0] / $_[1] if Value::isValue($_[0]) || Value::isValue($_[1]); + my $n = $context->Package("Fraction")->make($context, @_); + $n->{isHorizontal} = 1 if $self->{def}{noFrac}; + return $n; +} + +# +# When strictFraction is in effect, only allow division +# with integers and negative integers +# +sub _check { + my $self = shift; + $self->SUPER::_check; + return unless $self->context->flag("strictFractions"); + $self->Error("The numerator of a fraction must be an integer") + unless $self->{lop}->class =~ /INTEGER|MINUS/; + $self->Error("The denominator of a fraction must be a (non-negative) integer") + unless $self->{rop}->class eq 'INTEGER'; + $self->Error("The numerator must be less than the denominator in a proper fraction") + if $self->context->flag("requireProperFractions") + && CORE::abs($self->{lop}->eval) >= CORE::abs($self->{rop}->eval); +} + +# +# Reduce the fraction, if it is one, otherwise do the usual reduce +# +sub reduce { + my $self = shift; + return $self->SUPER::reduce unless $self->class eq 'FRACTION'; + my $reduce = $self->{equation}{context}{reduction}; + return $self->{lop} if $self->{rop}{isOne} && $reduce->{'x/1'}; + $self->Error("Division by zero"), return $self if $self->{rop}{isZero}; + return $self->{lop} if $self->{lop}{isZero} && $reduce->{'0/x'}; + if ($reduce->{'a/b'}) { + my ($a, $b) = context::Fraction::reduce($self->{lop}->eval, $self->{rop}->eval); + if ($self->{lop}->class eq 'INTEGER') { $self->{lop}{value} = $a } + else { $self->{lop}{op}{value} = -$a } + $self->{rop}{value} = $b; + } + return $self; +} + +# +# Display minus signs outside the fraction +# +sub TeX { + my $self = shift; + my $bop = $self->{def}; + return $self->SUPER::TeX(@_) if $self->class ne 'FRACTION' || $bop->{noFrac}; + my ($precedence, $showparens, $position, $outerRight) = @_; + $showparens = '' unless defined($showparens); + my $addparens = defined($precedence) + && ($showparens eq 'all' + || ($precedence > $bop->{precedence} && $showparens ne 'nofractions') + || ($precedence == $bop->{precedence} && ($bop->{associativity} eq 'right' || $showparens eq 'same'))); + + my $TeX = $self->eval->TeX; + $TeX = '\left(' . $TeX . '\right)' if ($addparens); + return $TeX; +} + +# +# Indicate if the value is a fraction or not +# +sub class { + my $self = shift; + return "FRACTION" + if $self->{lop}->class =~ /INTEGER|MINUS/ + && $self->{rop}->class eq 'INTEGER'; + return $self->SUPER::class; +} + +########################################################################### + +package context::Fraction::BOP::multiply; +our @ISA = ('Parser::BOP::multiply'); + +# +# For proper fractions, add the integer to the fraction +# +sub _eval { + my ($self, $a, $b) = @_; + return ($a >= 0 ? $a + $b : $a - $b); +} + +# +# If the implied multiplication represents a proper fraction with a +# preceeding integer, then switch to the proper fraction operator +# (for proper handling of string() and TeX() calls), otherwise, +# convert the object to a standard multiplication. +# +sub _check { + my $self = shift; + $self->SUPER::_check; + my $isFraction = 0; + my $allowMixedNumbers = $self->context->flag("allowProperFractions"); + $allowMixedNumbers = $self->context->flag("allowMixedNumbers") + unless defined($allowMixedNumbers) && $allowMixedNumbers ne ""; + if ($allowMixedNumbers) { + $isFraction = + ($self->{lop}->class =~ /INTEGER|MINUS/ + && !$self->{lop}{hadParens} + && $self->{rop}->class eq 'FRACTION' + && !$self->{rop}{hadParens} + && $self->{rop}->eval >= 0); + } + if ($isFraction) { + $self->Error("Mixed numbers are not allowed; you must use a pure fraction") + if ($self->context->flag("requirePureFractions")); + $self->{isFraction} = 1; + $self->{bop} = " "; + $self->{def} = $self->context->{operators}{ $self->{bop} }; + if ($self->{lop}->class eq 'MINUS') { + # + # Hack to replace BOP with unary negation of BOP. + # (When check() is changed to accept a return value, + # this will not be necessary.) + # + my $copy = bless {%$self}, ref($self); + $copy->{lop} = $copy->{lop}{op}; + my $neg = $self->Item("UOP")->new($self->{equation}, "u-", $copy); + map { delete $self->{$_} } (keys %$self); + map { $self->{$_} = $neg->{$_} } (keys %$neg); + bless $self, ref($neg); + } + } else { + $self->Error("Can't use implied multiplication in this context", $self->{bop}) + if $self->context->flag("strictMultiplication"); + bless $self, $ISA[0]; + } +} + +# +# Indicate if the value is a fraction or not +# +sub class { + my $self = shift; + return "FRACTION" if $self->{isFraction}; + return $self->SUPER::class; +} + +# +# Reduce the fraction +# +sub reduce { + my $self = shift; + my $reduce = $self->{equation}{context}{reduction}; + my ($a, ($b, $c)) = (CORE::abs($self->{lop}->eval), $self->{rop}->eval->value); + if ($reduce->{'a b/c'}) { + ($b, $c) = context::Fraction::reduce($b, $c) if $reduce->{'a/b'}; + $a += int($b / $c); + $b = $b % $c; + $self->{lop}{value} = $a; + $self->{rop}{lop}{value} = $b; + $self->{rop}{rop}{value} = $c; + return $self->{lop} if $b == 0 || $c == 1; + } + return $self->{rop} if $a == 0 && $reduce->{'0 a/b'}; + return $self; +} + +########################################################################### + +package context::Fraction::UOP::minus; +our @ISA = ('Parser::UOP::minus'); + +# +# For strict fractions, only allow minus on certain operands +# +sub _check { + my $self = shift; + $self->SUPER::_check; + $self->{hadParens} = 1 if $self->{op}{hadParens}; + return unless $self->context->flag("strictMinus"); + my $uop = $self->{def}{string} || $self->{uop}; + $self->Error("You can only use '%s' with (non-negative) numbers", $uop) + unless $self->{op}->class =~ /Number|INTEGER|FRACTION/; +} + +# +# class is MINUS if it is a negative number +# +sub class { + my $self = shift; + return "MINUS" if $self->{op}->class =~ /Number|INTEGER/; + $self->SUPER::class; +} + +# +# make isNeg properly handle the modified class +# +sub isNeg { + my $self = shift; + return ($self->class =~ /UOP|MINUS/ && $self->{uop} eq 'u-' && !$self->{op}->{isInfinite}); + +} + +########################################################################### + +package context::Fraction::Value; +our @ISA = ('Parser::Value'); + +# +# Indicate if the Value object is a fraction or not +# +sub class { + my $self = shift; + return "FRACTION" if $self->{value}->classMatch('Fraction'); + return $self->SUPER::class; +} + +# +# Handle reductions of negative fractions +# +sub reduce { + my $self = shift; + my $reduce = $self->context->{reduction}; + if ($self->{value}->class eq 'Fraction') { + $self->{value} = $self->{value}->reduce; + if ($reduce->{'-n'} && $self->{value}{data}[0] < 0) { + $self->{value}{data}[0] = -$self->{value}{data}[0]; + return Parser::UOP::Neg($self); + } + return $self; + } + return $self->SUPER::reduce; +} + +# +# Add parentheses if they were there originally, or are needed by precedence +# +sub string { + my $self = shift; + my $string = $self->SUPER::string(@_); + return $string unless $self->{value}->classMatch('Fraction'); + my $precedence = shift; + my $frac = $self->context->operators->get('/')->{precedence}; + $string = '(' . $string . ')' if $self->{hadParens} || (defined $precedence && $precedence > $frac); + return $string; +} + +# +# Add parentheses if they were there originally, or +# are needed by precedence and we asked for exxxtra parens +# +sub TeX { + my $self = shift; + my $string = $self->SUPER::TeX(@_); + return $string unless $self->{value}->classMatch('Fraction'); + my $precedence = shift; + my $frac = $self->context->operators->get('/')->{precedence}; + my $noparens = shift; + $string = '\left(' . $string . '\right)' + if $self->{hadParens} + || (defined $precedence && $precedence > $frac && !$noparens); + return $string; +} + +########################################################################### + +package context::Fraction::Real; +our @ISA = ('Value::Real'); + +sub cmp_defaults { Value::Real::cmp_defaults(@_) } + +# +# Allow Real to convert Fractions to Reals +# +sub new { + my $self = shift; + my $context = (Value::isContext($_[0]) ? shift : $self->context); + my $x = shift; + $x = $context->Package("Formula")->new($context, $x)->eval if ref($x) eq "" && $x =~ m!/!; + $x = $x->eval if scalar(@_) == 0 && Value::classMatch($x, 'Fraction'); + $self->SUPER::new($context, $x, @_); +} + +# +# Since the signed number pattern now include fractions, we need to make sure +# we handle them when a real is made and it looks like a fraction +# +sub make { + my $self = shift; + my $context = (Value::isContext($_[0]) ? shift : $self->context); + my $x = shift; + $x = $context->Package("Formula")->new($context, $x)->eval if ref($x) eq "" && $x =~ m!/!; + $x = $x->eval if scalar(@_) == 0 && Value::classMatch($x, 'Fraction'); + $self->SUPER::make($context, $x, @_); +} + +########################################################################### +########################################################################### +# +# Implements the MathObject for fractions +# + +package context::Fraction::Fraction; +our @ISA = ('Value'); + +sub new { + my $self = shift; + my $class = ref($self) || $self; + my $context = (Value::isContext($_[0]) ? shift : $self->context); + my $x = shift; + $x = [ $x, @_ ] if scalar(@_) > 0; + return $x->inContext($context) if Value::classMatch($x, 'Fraction'); + $x = [$x] unless ref($x) eq 'ARRAY'; + $x->[1] = 1 if scalar(@{$x}) == 1; + Value::Error("Can't convert ARRAY of length %d to %s", scalar(@{$x}), Value::showClass($self)) + unless (scalar(@{$x}) == 2); + $x->[0] = Value::makeValue($x->[0], context => $context); + $x->[1] = Value::makeValue($x->[1], context => $context); + return $x->[0] if Value::classMatch($x->[0], 'Fraction') && scalar(@_) == 0; + $x = context::Fraction::toFraction($context, $x->[0]->value) if Value::isReal($x->[0]) && scalar(@_) == 0; + return $self->formula($x) if Value::isFormula($x->[0]) || Value::isFormula($x->[1]); + Value::Error("Fraction numerators must be integers") unless isInteger($x->[0]); + Value::Error("Fraction denominators must be integers") unless isInteger($x->[1]); + my ($a, $b) = ($x->[0]->value, $x->[1]->value); + ($a, $b) = (-$a, -$b) if $b < 0; + Value::Error("Denominator can't be zero") if $b == 0; + ($a, $b) = context::Fraction::reduce($a, $b) if $context->flag("reduceFractions"); + bless { data => [ $a, $b ], context => $context }, $class; +} + +# +# Produce a real if one of the terms is not an integer +# otherwise produce a fraction. +# +sub make { + my $self = shift; + my $class = ref($self) || $self; + my $context = (Value::isContext($_[0]) ? shift : $self->context); + push(@_, 0) if scalar(@_) == 0; + push(@_, 1) if scalar(@_) == 1; + my ($a, $b) = @_; + ($a, $b) = (-$a, -$b) if $b < 0; + return $context->Package("Real")->make($context, $a / $b) unless isInteger($a) && isInteger($b); + ($a, $b) = context::Fraction::reduce($a, $b) if $context->flag("reduceFractions"); + bless { data => [ $a, $b ], context => $context }, $class; +} + +# +# Promote to a fraction, allowing reals to be $x/1 even when +# not an integer (later $self->make() will produce a Real in +# that case) +# +sub promote { + my $self = shift; + my $class = ref($self) || $self; + my $context = (Value::isContext($_[0]) ? shift : $self->context); + my $x = (scalar(@_) ? shift : $self); + if (scalar(@_) == 0) { + return $x->inContext($context) if ref($x) eq $class; + return (bless { data => [ $x->value, 1 ], context => $context }, $class) if Value::isReal($x); + return (bless { data => [ $x, 1 ], context => $context }, $class) if Value::matchNumber($x); + } + return $x if Value::isValue($x) && $x->classMatch("Infinity"); + return $self->new($context, $x, @_); +} + +# +# Create a new formula from the number +# +sub formula { + my $self = shift; + my $value = shift; + my $formula = $self->Package("Formula")->blank($self->context); + my ($l, $r) = Value::toFormula($formula, @{$value}); + $formula->{tree} = $formula->Item("BOP")->new($formula, '/', $l, $r); + return $formula; +} + +# +# Return the real number type +# +sub typeRef { return $Value::Type{number} } +sub length {2} + +sub isZero { (shift)->{data}[0] == 0 } +sub isOne { (shift)->eval == 1 } + +# +# Return the real value +# +sub eval { + my $self = shift; + my ($a, $b) = $self->value; + return $a / $b; +} + +# +# Parts are not Value objects, so don't transfer +# +sub transferFlags { } + +# +# Check if a value is an integer +# +sub isInteger { + my $n = shift; + $n = $n->value if Value::isReal($n); + return $n =~ m/^-?\d+$/; +} + +# +# Get a flag that has been renamed +# +sub getFlagWithAlias { + my $self = shift; + my $flag = shift; + my $alias = shift; + return $self->getFlag($alias, $self->getFlag($flag)); +} + +################################################## +# +# Binary operations +# + +sub add { + my ($self, $l, $r, $other) = Value::checkOpOrderWithPromote(@_); + my (($a, $b), ($c, $d)) = ($l->value, $r->value); + my $M = context::Fraction::lcm($b, $d); + return $self->inherit($other)->make($a * ($M / $b) + $c * ($M / $d), $M); +} + +sub sub { + my ($self, $l, $r, $other) = Value::checkOpOrderWithPromote(@_); + my (($a, $b), ($c, $d)) = ($l->value, $r->value); + my $M = context::Fraction::lcm($b, $d); + return $self->inherit($other)->make($a * ($M / $b) - $c * ($M / $d), $M); +} + +sub mult { + my ($self, $l, $r, $other) = Value::checkOpOrderWithPromote(@_); + my (($a, $b), ($c, $d)) = ($l->value, $r->value); + return $self->inherit($other)->make($a * $c, $b * $d); +} + +sub div { + my ($self, $l, $r, $other) = Value::checkOpOrderWithPromote(@_); + my (($a, $b), ($c, $d)) = ($l->value, $r->value); + Value::Error("Division by zero") if $c == 0; + return $self->inherit($other)->make($a * $d, $b * $c); +} + +sub power { + my ($self, $l, $r, $other) = Value::checkOpOrderWithPromote(@_); + my (($a, $b), ($c, $d)) = ($l->value, $r->reduce->value); + ($a, $b, $c) = ($b, $a, -$c) if $c < 0; + my ($x, $y) = ($c == 1 ? ($a, $b) : ($a**$c, $b**$c)); + if ($d != 1) { + if ($x < 0 && $d % 2 == 1) { $x = -(-$x)**(1 / $d) } + else { $x = $x**(1 / $d) } + if ($y < 0 && $d % 2 == 1) { $y = -(-$y)**(1 / $d) } + else { $y = $y**(1 / $d) } + } + return $self->inherit($other)->make($x, $y) unless $x eq 'nan' || $y eq 'nan'; + Value::Error("Can't raise a negative number to a non-integer power") if $a * $b < 0; + Value::Error("Result of exponention is not a number"); +} + +sub compare { + my ($self, $l, $r) = Value::checkOpOrderWithPromote(@_); + return $l->eval <=> $r->eval; +} + +################################################## +# +# Numeric functions +# + +sub abs { my $self = shift; $self->make(CORE::abs($self->{data}[0]), CORE::abs($self->{data}[1])) } +sub neg { my $self = shift; $self->make(-($self->{data}[0]), $self->{data}[1]) } +sub exp { my $self = shift; $self->make(CORE::exp($self->eval)) } +sub log { my $self = shift; $self->make(CORE::log($self->eval)) } +sub sqrt { my $self = shift; $self->make(CORE::sqrt($self->{data}[0]), CORE::sqrt($self->{data}[1])) } + +################################################## +# +# Trig functions +# + +sub sin { my $self = shift; $self->make(CORE::sin($self->eval)) } +sub cos { my $self = shift; $self->make(CORE::cos($self->eval)) } + +sub atan2 { + my ($self, $l, $r, $other) = Value::checkOpOrderWithPromote(@_); + return $self->inherit($other)->make(CORE::atan2($l->eval, $r->eval)); +} + +################################################## +# +# Differentiation +# + +sub D { + my $self = shift; + return $self->make(0, 1); +} + +################################################## +# +# Utility +# + +sub reduce { + my $self = shift; + my ($a, $b) = context::Fraction::reduce($self->value); + return $self->make($a, $b); +} + +sub isReduced { + my $self = shift; + my (($a, $b), ($c, $d)) = ($self->value, $self->reduce->value); + return $a == $c && $b == $d; +} + +sub num { + return (shift->value)[0]; +} + +sub den { + return (shift->value)[1]; +} + +################################################## +# +# Formatting +# + +sub string { + my $self = shift; + my $equation = shift; + shift; + shift; + my $prec = shift; + my ($a, $b) = @{ $self->{data} }; + my $n = ""; + return "$a" if $b == 1; + + if ($self->getFlagWithAlias("showMixedNumbers", "showProperFractions") && CORE::abs($a) > $b) { + $n = int($a / $b); + $a = CORE::abs($a) % $b; + $n .= " " unless $a == 0; + } + $n .= "$a/$b" unless $a == 0 && $n ne ''; + return "$n"; +} + +sub TeX { + my $self = shift; + my $equation = shift; + shift; + shift; + my $prec = shift; + my ($a, $b) = @{ $self->{data} }; + my $n = ""; + my $textstyle = ''; + return "$a" if $b == 1; + + if ($self->getFlagWithAlias("showMixedNumbers", "showProperFractions") && CORE::abs($a) > $b) { + $n = int($a / $b); + $a = CORE::abs($a) % $b; + $n .= ' ' unless $a == 0; + $textstyle = '\\textstyle'; + } + my $s = ""; + ($a, $s) = (-$a, "-") if $a < 0; + $n .= ($self->{isHorizontal} ? "$s$a/$b" : "${s}{$textstyle\\frac{$a}{$b}}") + unless $a == 0 && $n ne ''; + return "$n"; +} + +sub pdot { + my $self = shift; + my $n = $self->string; + $n = '(' . $n . ')' if $n =~ m![^0-9]!; # add parens if not just a number + return $n; +} + +########################################################################### +# +# Answer Checker +# + +sub cmp_defaults { ( + shift->SUPER::cmp_defaults(@_), + ignoreInfinity => 1, + studentsMustReduceFractions => 0, + showFractionReduceWarnings => 1, + requireFraction => 0, +) } + +sub cmp_contextFlags { + my $self = shift; + my $ans = shift; + return ($self->SUPER::cmp_contextFlags($ans), reduceFractions => !$ans->{studentsMustReduceFractions},); +} + +sub cmp_class {"a fraction of integers"} + +sub typeMatch { + my $self = shift; + my $other = shift; + my $ans = shift; + return 1 unless ref($other); + return 0 if Value::isFormula($other); + return 1 if $other->type eq 'Infinity' && $ans->{ignoreInfinity}; + return 0 if $ans->{requireFraction} && !$other->classMatch("Fraction"); + $self->type eq $other->type; +} + +sub cmp_postprocess { + my $self = shift; + my $ans = shift; + my $student = $ans->{student_value}; + return + if $ans->{isPreview} + || !$ans->{studentsMustReduceFractions} + || !Value::classMatch($student, 'Fraction') + || $student->isReduced; + $ans->score(0); + $self->cmp_Error($ans, "Your fraction is not reduced") if $ans->{showFractionReduceWarnings}; +} + +########################################################################### + +1; From d0890925b3aeddeef8753b693335b533c2ccc090 Mon Sep 17 00:00:00 2001 From: "Davide P. Cervone" Date: Thu, 29 Aug 2024 08:27:51 -0400 Subject: [PATCH 3/9] Adjust test file for fractions --- t/contexts/fraction.t | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/t/contexts/fraction.t b/t/contexts/fraction.t index 6019df0ce..4b596f9e9 100644 --- a/t/contexts/fraction.t +++ b/t/contexts/fraction.t @@ -16,8 +16,8 @@ use lib "$ENV{PG_ROOT}/lib"; loadMacros('PGstandard.pl', 'MathObjects.pl', 'contextFraction.pl'); use Value; -require Parser::Legacy; -import Parser::Legacy; +use Parser; +use Parser::Legacy; Context('Fraction'); From ca725f0959eb2f5b1a254c66eb5f61a16db7af99 Mon Sep 17 00:00:00 2001 From: "Davide P. Cervone" Date: Sun, 1 Sep 2024 19:51:17 -0400 Subject: [PATCH 4/9] Add missing cmp_default to context::Fraction::Value::Real --- macros/contexts/contextFraction.pl | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/macros/contexts/contextFraction.pl b/macros/contexts/contextFraction.pl index c3758a44c..78ee4dea3 100644 --- a/macros/contexts/contextFraction.pl +++ b/macros/contexts/contextFraction.pl @@ -774,6 +774,11 @@ sub make { return &{ $self->super("make") }($self, $context, $x, @_); } +# +# Since this is called directly, pass it up to the parent +# +sub cmp_defaults { (shift)->SUPER::cmp_defaults(@_) } + ################################################## package context::Fraction::Value::Real_Parens; From 49a2e3f057782aea4a35d7eeda8d9ab956185912 Mon Sep 17 00:00:00 2001 From: "Davide P. Cervone" Date: Mon, 2 Sep 2024 17:33:23 -0400 Subject: [PATCH 5/9] Make sure Super class works when the context has been changed --- macros/contexts/contextExtensions.pl | 23 ++++++++++++++--------- macros/contexts/contextFraction.pl | 6 +++--- 2 files changed, 17 insertions(+), 12 deletions(-) diff --git a/macros/contexts/contextExtensions.pl b/macros/contexts/contextExtensions.pl index f16c40a41..a3b4eb0e6 100644 --- a/macros/contexts/contextExtensions.pl +++ b/macros/contexts/contextExtensions.pl @@ -364,6 +364,11 @@ sub makeSubclass { # # would get the string output from the original class. # +# If you are defining a new() or make() method (where the $self could be +# the class name rather than a class instance), you will need to pass the +# context to mutate(), super(), or superClass(). See the example for +# new() below. +# # The superClass() method gets you the name of the original class, in # case you need to access any class variables from that. # @@ -373,8 +378,8 @@ package context::Extensions::Super; # Get a method from the original class from the extended context # sub super { - my ($self, $method) = @_; - return $self->superClass->can($method); + my ($self, $method, $context) = @_; + return $self->superClass($context)->can($method); } # @@ -384,7 +389,7 @@ sub superClass { my $self = shift; my $class = ref($self) || $self; my $name = $self->extensionContext; - my $data = $self->context->{$name}; + my $data = (shift || $self->context)->{$name}; my $op = $self->{bop} || $self->{uop}; return $op ? $data->{$op} : $data->{ substr($class, length($name) + 2) }; } @@ -394,15 +399,15 @@ sub superClass { # if there is one, or the object's super class if not. # sub mutate { - my ($self, $other) = @_; + my ($self, $context, $other) = @_; if ($other) { delete $self->{$_} for (keys %$self); $self->{$_} = $other->{$_} for (keys %$other); bless $self, ref($other); } elsif (ref($self) eq '') { - $self = $self->superClass; + $self = $self->superClass($context); } else { - bless $self, $self->superClass; + bless $self, $self->superClass($context); } return $self; } @@ -411,8 +416,9 @@ sub mutate { # Use the super-class new() method # sub new { - my $self = shift; - return &{ $self->super("new") }($self, @_); + my $self = shift; + my $context = Value::isContext($_[0]) ? $_[0] : $self->context; + return &{ $self->super("new", $context) }($self, @_); } # @@ -431,7 +437,6 @@ sub class { # one that returns the extension context's name. # sub extensionContext { - warn Value::traceback(1); die "The context must subclass context::Extensions::Super and supply an extensionContext() method"; } diff --git a/macros/contexts/contextFraction.pl b/macros/contexts/contextFraction.pl index 78ee4dea3..64d074b4e 100644 --- a/macros/contexts/contextFraction.pl +++ b/macros/contexts/contextFraction.pl @@ -604,7 +604,7 @@ sub _check { if ($self->extensionClassMatch($self->{lop}, 'MINUS')) { my $copy = bless {%$self}, $self->{def}{class}; $copy->{lop} = $copy->{lop}{op}; - $self->mutate($self->Item("UOP")->new($self->{equation}, "u-", $copy)); + $self->mutate($context, $self->Item("UOP")->new($self->{equation}, "u-", $copy)); } else { bless $self, $self->{def}{class}; } @@ -758,7 +758,7 @@ sub new { my $x = shift; $x = $context->Package("Formula")->new($context, $x)->eval if !ref($x) && $x =~ m!/!; $x = $x->eval if @_ == 0 && Value::classMatch($x, 'Fraction'); - return &{ $self->super("new") }($self, $context, $x, @_); + return $self->mutate($context)->new($context, $x, @_); } # @@ -771,7 +771,7 @@ sub make { my $x = shift; $x = $context->Package("Formula")->new($context, $x)->eval if !ref($x) && $x =~ m!/!; $x = $x->eval if @_ == 0 && Value::classMatch($x, 'Fraction'); - return &{ $self->super("make") }($self, $context, $x, @_); + return $self->mutate($context)->make($context, $x, @_); } # From 77586d6c273baa735543149aba475f715281e4f5 Mon Sep 17 00:00:00 2001 From: "Davide P. Cervone" Date: Mon, 2 Sep 2024 18:06:42 -0400 Subject: [PATCH 6/9] Fix Value::isContext() to not perform stringification of its argument --- lib/Value.pm | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/lib/Value.pm b/lib/Value.pm index 4c7b799fc..a389753da 100644 --- a/lib/Value.pm +++ b/lib/Value.pm @@ -308,10 +308,9 @@ sub matchNumber { my $n = shift; $n =~ m/^$$Value::context->{pattern}{signedNu sub matchInfinite { my $n = shift; $n =~ m/^$$Value::context->{pattern}{infinite}$/i } sub isReal { classMatch(shift, 'Real') } sub isComplex { classMatch(shift, 'Complex') } -# sub isContext {class(shift) eq 'Context'} # MEG -sub isContext { my $symbol = shift || ""; class($symbol) eq 'Context' } -sub isFormula { classMatch(shift, 'Formula') } -sub isParser { my $v = shift; isBlessed($v) && $v->isa('Parser::Item') } +sub isContext { class(shift // '') eq 'Context' } +sub isFormula { classMatch(shift, 'Formula') } +sub isParser { my $v = shift; isBlessed($v) && $v->isa('Parser::Item') } sub isValue { my $v = shift // ''; From 6b037c31a4b951c6dab04ad91fbe77bc1c7ed145 Mon Sep 17 00:00:00 2001 From: "Davide P. Cervone" Date: Mon, 2 Sep 2024 18:48:17 -0400 Subject: [PATCH 7/9] Don't force extensionContext to be specified, and update documentation --- macros/contexts/contextExtensions.pl | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/macros/contexts/contextExtensions.pl b/macros/contexts/contextExtensions.pl index a3b4eb0e6..df3179cab 100644 --- a/macros/contexts/contextExtensions.pl +++ b/macros/contexts/contextExtensions.pl @@ -432,12 +432,19 @@ sub class { } # -# This method must be supplied by subclassing +# This method assumes the extension is in a class named +# "context::" where is replaced by the name of the +# context. E.g., context::Quaternions in our example. +# +# That assumption can be changed by subclassing # context::Extensions::Super package and overriding this method with -# one that returns the extension context's name. +# one that returns the extension context's name. It is more efficient +# to do that, anyway, but you can get away without it. # sub extensionContext { - die "The context must subclass context::Extensions::Super and supply an extensionContext() method"; + my $self = shift; + my $class = join('::', (split(/::/, ref($self) || $self))[0, 1]); + return $class; } ################################################################################################# From 2af2a8ccd1c382270aca1a203e212a4b893d1ae4 Mon Sep 17 00:00:00 2001 From: "Davide P. Cervone" Date: Mon, 2 Sep 2024 19:23:05 -0400 Subject: [PATCH 8/9] Apply nonsense perltidy format --- macros/contexts/contextExtensions.pl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/macros/contexts/contextExtensions.pl b/macros/contexts/contextExtensions.pl index df3179cab..b4a095da4 100644 --- a/macros/contexts/contextExtensions.pl +++ b/macros/contexts/contextExtensions.pl @@ -442,8 +442,8 @@ sub class { # to do that, anyway, but you can get away without it. # sub extensionContext { - my $self = shift; - my $class = join('::', (split(/::/, ref($self) || $self))[0, 1]); + my $self = shift; + my $class = join('::', (split(/::/, ref($self) || $self))[ 0, 1 ]); return $class; } From 48bca311f3219faed2197384540b6bbf1d277ad4 Mon Sep 17 00:00:00 2001 From: "Davide P. Cervone" Date: Mon, 2 Sep 2024 19:25:40 -0400 Subject: [PATCH 9/9] Update documentation --- macros/contexts/contextExtensions.pl | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/macros/contexts/contextExtensions.pl b/macros/contexts/contextExtensions.pl index b4a095da4..46db49989 100644 --- a/macros/contexts/contextExtensions.pl +++ b/macros/contexts/contextExtensions.pl @@ -322,7 +322,9 @@ sub makeSubclass { # create a subclass of this class and define its extensionContext() # method to return your base context name, and then include that # subclass in your @ISA arrays for your new classes that override the -# original context's classes. +# original context's classes. (This is not strictly necessary, but +# it is more efficient to do this than to have the Super class +# have to figure it out every time a Super method is used.) # # For our quaternions example, you would use #