From ad472fcc4522b4bbbb23b5dc90b42d949f7101e1 Mon Sep 17 00:00:00 2001 From: Andrew Gardener Date: Mon, 11 Dec 2017 15:48:38 -0800 Subject: [PATCH 1/3] Enhance context permutation Add new permutation `contextPermutationUBC.pl` which differs from `contextPermutation.pl` by - perform permutation multiplication - allow displaying results in cycle, one line, or two line notation - parses both cycle and one notations (one line uses [] and is converted to cycles internally) Note: that these changes are in their own seperate file as the changes may break existing usages of `contextPermutation.pl` --- macros/contextPermutationUBC.pl | 728 ++++++++++++++++++++++++++++++++ 1 file changed, 728 insertions(+) create mode 100644 macros/contextPermutationUBC.pl diff --git a/macros/contextPermutationUBC.pl b/macros/contextPermutationUBC.pl new file mode 100644 index 0000000000..ae5aebd710 --- /dev/null +++ b/macros/contextPermutationUBC.pl @@ -0,0 +1,728 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2014 The WeBWorK Project, http://openwebwork.sf.net/ +# $CVSHeader:$ +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + + +=head1 NAME + +C - Provides contexts that allow the +entry of cycles and permutations. + + +=head1 DESCRIPTION + +These contexts allow you to enter permutations using cycle notation. +The entries in a cycle are separated by spaces and enclosed in +parentheses. Cycles are multiplied by juxtaposition. A permutation +can be multiplied on the left by a number in order to obtain the +result of that number under the action of the permutation. +Exponentiation is alos allowed (as described below). + +There are three contexts included here: C, which +allows permutations in any form, C, which +only allows permutations that use disjoint cycles, and +C, which only allows permutations that +are written in canonical form (as described below). + + +=head1 USAGE + + loadMacros("contextPermutationUBC.pl"); + + Context("Permutation"); + + $P1 = Compute("(1 4 2)(3 5)"); + $P2 = Permutation([1,4,2],[3,5]); # same as $P1 + $C1 = Cycle(1,4,2); + $P3 = Cycle(1,4,2)*Cycle(3,5); # same as $P1 + + $n = 3 * $P1; # sets $n to 5 + $m = Compute("3 (2 4 3 1)"); # sets $m to 1 + + $P4 = Compute("(1 2 3)^2"); # square a cycle + $P5 = Compute("((1 2)(3 4))^2"); # square a permutation + $I = Comptue("(1 2 3)^-1"); # inverse + + $L = Compute("(1 2),(1 3 2)"); # list of permutations + + $P = $P1->inverse; # inverse + $P = $P1->canonical; # canonical representation + + $P1 = Compute("(1 2 3)(4 5)"); + $P2 = Compute("(5 4)(3 1 2)"); + $P1 == $P2; # is true + +Cycles and permutations can be multiplied to obtain the permutation +that consists of one followed by the other, or multiplied on the left +by a number to obtain the image of the number under the permutation. +A permutation raised to a positive integer is the permutation +multiplied by itself that many times. A power of -1 is the inverse of +the permutation, while a larger negative number is the inverse +multiplied by itself that many times (the absolute value of the +power). + +There are times when you might not want to allow inverses to be +computed automatically. In this case, set + + Context()->flags->set(noInverses => 1); + +This will cause an error message if a student enters a negative power +for a cycle or permutation. + +If you don't want to allow any powers at all, then set + + Context()->flags->set(noPowers => 1); + +Similarly, if you don't want to allow grouping of cycles via +parentheses (e.g., "((1 2)(3 4))^2 (5 6)"), then use + + Context()->flags->set(noGroups => 1); + +The comparison between permutations is done by comparing the +canonical forms, so even if they are entered in different orders or +with the cycles rotated, two equivalent permutations will be counted +as equal. If you want to perform more sophisticated checks, then a +custom error checker could be used. + +You can require that permutations be entered using disjoint cycles by +setting + + Context()->flags->set(requireDisjoint => 1); + +When this is set, Compute("(1 2) (1 3)") will produce an error +indicating that the permutation doesn't have disjoint cycles. + +You can also require that students enter permutations in a canonical +form. The canonical form has each cycle listed with its lowest entry +first, and with the cycles ordered by their initial entries. So the +canonical form for + + (5 4 6) (3 1 2) + +is + + (1 2 3) (4 6 5) + +To require that permutations be entered in canonical form, use + + Context()->flags->set(requireCanonical => 1); + +The C context has C, C, C, and +C all set to 1, while the C has +C, C, C, and C all set to 1. +The C context has all the flags set to 0, so any permutation +is allowed. All three contexts allow lists of permutations to be +entered. + +=cut + +########################################################### +# +# Create the contexts and add the constructor functions +# + +sub _contextPermutation_init { + my $context = $main::context{Permutation} = Parser::Context->getCopy("Numeric"); + $context->{name} = "Permutation"; + Parser::Number::NoDecimals($context); + $context->variables->clear(); + $context->operators->clear(); + $context->constants->clear(); + $context->strings->clear(); + $context->functions->disable("All"); + + $context->{pattern}{number} = '(?:(?:^|(?<=[( ^*]))-)?(?:\d+(?:\.\d*)?|\.\d+)(?:E[-+]?\d+)?', + + $context->operators->add( + ',' => {precedence => 0, associativity => 'left', type => 'bin', string => ',', + class => 'Parser::BOP::comma', isComma => 1}, + + 'fn'=> {precedence => 7.5, associativity => 'left', type => 'unary', string => '', + parenPrecedence => 5, hidden => 1}, + + ' ' => {precedence => 3, associativity => 'right', type => 'bin', string => ' ', + class => 'context::Permutation::BOP::space', hidden => 1, isComma => 1}, + + '^' => {precedence => 7, associativity => 'right', type => 'bin', string => '^', perl => '**', + class => 'context::Permutation::BOP::power'}, + + '**'=> {precedence => 7, associativity => 'right', type => 'bin', string => '^', perl => '**', + class => 'context::Permutation::BOP::power'}, + ); + + $context->{value}{Cycle} = "context::Permutation::Cycle"; + $context->{value}{Permutation} = "context::Permutation::Permutation"; + $context->{precedence}{Cycle} = $context->{precedence}{special}; + $context->{precedence}{Permutation} = $context->{precedence}{special}+1; + $context->lists->add( + "Cycle" => {class => "context::Permutation::List::Cycle", open => "(", close => ")", separator => " "}, + "PermutationOneLineNotation" => {class => "context::Permutation::List::PermutationOneLineNotation", + open => "[", close => "]", separator => " "}, + "Permutation" => {open => "", close => "", separator => " "}, # used for output only + ); + $context->parens->set( + '(' => {close => ')', type => 'Cycle', formList => 0, removable => 0, emptyOK => 0, function => 1}, + '[' => {close => ']', type => 'PermutationOneLineNotation', formList => 0, removable => 0, emptyOK => 0, function => 1}, + ); + $context->flags->set(reduceConstants => 0); + + $context->flags->set( + displayOneLineNotation => 0, # output in one line notation + displayTwoLineNotation => 0, # output in two line notation + requireDisjoint => 0, # require disjoint cycles as answers? + requireCanonical => 0, # require canonical form? + noPowers => 0, # allow powers of cycles and permutations? + noInverses => 0, # allow negative powers to mean inverse? + noGroups => 0, # allow parens for grouping (for powers)? + ); + + $context->{error}{msg}{"Entries in a Cycle must be of the same type"} = + "Entries in a Cycle must be positive integers"; + + # + # A context in which permutations must be entered as + # products of disjoint cycles. + # + $context = $main::context{"Permutation-Strict"} = $context->copy; + $context->{name} = "Permutation-Strict"; + $context->flags->set( + requireDisjoint => 1, + noPowers => 1, + noInverses => 1, + noGroups => 1, + ); + + # + # A context in which permutation must be entered + # in canonical form. + # + $context = $main::context{"Permutation-Canonical"} = $context->copy; + $context->{name} = "Permutation-Canonical"; + $context->flags->set( + requireCanonical => 1, + requireDisjoint => 0, # requireCanonical already covers that + ); + + + PG_restricted_eval("sub Cycle {context::Permutation::Cycle->new(\@_)}"); + PG_restricted_eval("sub Permutation {context::Permutation::Permutation->new(\@_)}"); + +} + +########################################################### +# +# Methods common to cycles and permutations +# + +package context::Permutation; +our @ISA = ("Value"); + +# +# Use the usual make(), and then add the permutation data +# +sub make { + my $self = shift; + $self = $self->SUPER::make(@_); + $self->makeP; + return $self; +} + +# +# Permform multiplication of a number by a cycle or permutation, +# or a product of two cycles or permutations. +# +sub mult { + my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_); + if ($l->isReal) { + $l = $l->value; + Value->Error("Can't multiply %s by a non-integer value",$self->showType) unless $l == int($l); + Value->Error("Can't multiply %s by a negative value",$self->showType) if $l < 0; + my $n = $self->{P}{$l}; $n = $l unless defined $n; + return $self->Package("Real")->make($n); + } else { + Value->Error("Can't multiply %s by %s",$l->showType,$r->showType) + unless $r->classMatch("Cycle","Permutation"); + + my @lKeys = %{$l->{P}} ? keys %{$l->{P}} : (); + my @rKeys = %{$r->{P}} ? keys %{$r->{P}} : (); + + my %unique = (); + foreach my $item (@lKeys, @rKeys) { + $unique{$item}++; + } + my @keys = main::num_sort(keys %unique); + my @cycles = (); + while(my $key = shift(@keys)) { + my @cycle = ($key); + + # complete the cycle + my $currentKey = $key; + while(@keys) { + # set to right side value if present + if ($r->{P}{$currentKey}) { + $currentKey = $r->{P}{$currentKey}; + } # else set to identity which doesn't need assignment + + # set to left side value if present + if ($l->{P}{$currentKey}) { + $currentKey = $l->{P}{$currentKey}; + } # else set to identity which doesn't need assignment + + # if cycle complete + if ($key == $currentKey) { + last; + } else { + # add $currentKey to the cycle + push(@cycle, $currentKey); + foreach my $index (reverse 0 .. $#keys) { + splice(@keys, $index, 1) if $keys[$index] == $currentKey; + } + } + } + push(@cycles, $self->Package("Cycle")->new(@cycle)); + } + # return a Cycle if there is only one cycle as the result + return @cycles[0] if scalar(@cycles) == 1; + # else return a Permutation if there are more than 1 cycles + return $self->Package("Permutation")->new(@cycles); + } +} + +# +# Perform powers by repeated multiplication; +# Negative powers are inverses. +# +sub power { + my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_); + Value->Error("Can't raise %s to %s",$l->showType,$r->showType) unless $r->isNumber; + Value->Error("Powers are not allowed") if $self->getFlag("noPowers"); + if ($r < 0) { + Value->Error("Inverses are not allowed",$l->showType) if $self->getFlag("noInverses"); + $r = -$r; $l = $l->inverse; + } + $self->Package("Permutation")->make(map {$l} (1..$r))->canonical; +} + +# +# Compare canonical representations +# +sub compare { + my ($self,$l,$r,$other) = Value::checkOpOrderWithPromote(@_); + Value->Error("Can't compare %s and %s",$self->showType,$other->showType) + unless $other->classMatch("Cycle","Permutation"); + return $l->canonical cmp $r->canonical; +} + +# +# True if the permutation is in canonical form +# +sub isCanonical { + my $self = shift; + return $self eq $self->canonical; +} + +# +# Promote a number to a Real (since we can take a number times a +# permutation, or a permutation to a power), and anything else to a +# Cycle or Permutation. +# +sub promote { + my $self = shift; my $other = shift; + return Value::makeValue($other,context => $self->{context}) if Value::matchNumber($other); + return $self->SUPER::promote($other); +} + +# +# Produce a canonical representation as a collection of +# cycles that have their lowest entry first, sorted +# by initial entry. +# +sub canonical { + my $self = shift; + my @P = (); my @C; + my %N = (map {$_ => 1} (keys %{$self->{P}})); + while (scalar(keys %N)) { + $i = (main::num_sort(keys %N))[0]; @C = (); + do { + push(@C,$self->Package("Real")->new($i)); delete $N{$i}; + $i = $self->{P}{$i} if defined $self->{P}{$i}; + } while ($i != $C[0]); + push(@P,$self->Package("Cycle")->make($self->{context},@C)); + } + return $P[0] if scalar(@P) == 1; + return $self->Package("Permutation")->make($self->{context},@P); +} + +# +# Produce the inverse of a permutation or cycle. +# +sub inverse { + my $self = shift; + my $P = {map {$self->{P}{$_} => $_} (keys %{$self->{P}})}; + return $self->with(P => $P)->canonical; +} + +# +# Produce a string version (use "(1)" as the identity). +# +sub string { + my $self = shift; + my $displayOneLineNotation = $self->getFlag("displayOneLineNotation"); + my $displayTwoLineNotation = $self->getFlag("displayTwoLineNotation"); + if ($displayOneLineNotation || $displayTwoLineNotation) { + my @keys = main::num_sort(keys %{$self->{P}}); + my $string = ""; + if (@keys) { + $string .= join(' ',@{$self->{P}}{@keys}); + } else { + $string .= "1"; + } + return "(".$string.")"; + } else { + my $string = $self->SUPER::string(@_); + $string = "(1)" unless length($string); + return $string; + } +} + +# +# Produce a TeX version (uses \; for spaces) +# +sub TeX { + my $self = shift; + my $displayTwoLineNotation = $self->getFlag("displayTwoLineNotation"); + if ($displayTwoLineNotation) { + my $tex = "\\bigl(\\begin{smallmatrix} "; + my @keys = main::num_sort(keys %{$self->{P}}); + if (@keys) { + $tex .= join(' & ',@keys) . " \\\\ " . join(' & ',@{$self->{P}}{@keys}); + } else { + $tex .= "1 \\\\ 1"; + } + $tex .= "\\end{smallmatrix}\\bigr)"; + return $tex; + } else { + my $tex = $self->string; + $tex =~ s/\) \(/)\\,(/g; + $tex =~ s/ /\\;/g; + return $tex; + } +} + +########################################################### +# +# A single cycle +# + +package context::Permutation::Cycle; +our @ISA = ("context::Permutation"); + +sub new { + my $self = shift; my $class = ref($self) || $self; + my $context = (Value::isContext($_[0]) ? shift : $self->context); + my $p = [@_]; $p = $p->[0] if scalar(@$p) == 1 && ref($p->[0]) eq "ARRAY"; + return $p->[0] if scalar(@$p) == 1 && Value::classMatch($p->[0],"Cycle","Permutation"); + my %N; + foreach my $x (@{$p}) { + $x = Value::makeValue($x,context => $context); + Value->Error("An entry of a Cycle can't be %s",$x->showType) + unless $x->isNumber && !$x->isFormula; + my $i = $x->value; + Value->Error("An entry of a Cycle can't be negative") if $i < 0; + Value->Error("Cycles can't contain repeated values") if $N{$i}; $N{$i} = 1; + } + my $cycle = bless {data => $p, context => $context}, $class; + $cycle->makeP; + return $cycle; +} + +# +# Find the internal representation of the permutation +# (a hash representing where each element goes) +# +sub makeP { + my $self = shift; + my $p = $self->{data}; my $P = {}; + my $displayOneLineNotation = $self->getFlag("displayOneLineNotation"); + my $displayTwoLineNotation = $self->getFlag("displayTwoLineNotation"); + if (@$p) { + my $i = $p->[scalar(@$p)-1]->value; + foreach my $x (@{$p}) { + my $j = $x->value; + $P->{$i} = $j if $i != $j || $displayOneLineNotation || $displayTwoLineNotation; + $i = $j; + } + } + $self->{P} = $P; +} + +########################################################### +# +# A combination of cycles +# + +package context::Permutation::Permutation; +our @ISA = ("context::Permutation"); + +sub new { + my $self = shift; my $class = ref($self) || $self; + my $context = (Value::isContext($_[0]) ? shift : $self->context); + my $disjoint = $self->getFlag("requireDisjoint"); + my $p = [@_]; my %N; + foreach my $x (@$p) { + $x = Value::makeValue($x,context=>$context) unless ref($x); + $x = Value->Package("Cycle")->new($context,$x) if ref($x) eq "ARRAY"; + Value->Error("An entry of a Permutation can't be %s",Value::showClass($x)) + unless Value::classMatch($x,"Cycle","Permutation"); + if ($disjoint) { + foreach my $i (keys %{$x->{P}}) { + Value->Error("Your Permutation does not have disjoint Cycles") if $N{$i}; + $N{$i} = 1; + } + } + } + my $perm = bless {data => $p, context => $context}, $class; + $perm->makeP; + Value->Error("Your Permutation is not in canonical form") + if $perm->getFlag("requireCanonical") && $perm ne $perm->canonical; + return $perm; +} + +# +# Find the internal representation of the permutation +# (a hash representing where each element goes) +# +sub makeP { + my $self = shift; my $p = $self->{data}; + my $P = {}; my %N; + my $displayOneLineNotation = $self->getFlag("displayOneLineNotation"); + my $displayTwoLineNotation = $self->getFlag("displayTwoLineNotation"); + foreach my $x (@$p) {map {$N{$_} = 1} (keys %{$x->{P}})} # get all elements used + foreach my $i (keys %N) { + my $j = $i; + map {$j = $_->{P}{$j} if defined $_->{P}{$j}} @$p; # apply all cycles/permutations + $P->{$i} = $j if $i != $j || $displayOneLineNotation || $displayTwoLineNotation; + } + $self->{P} = $P; +} + +########################################################### +# +# Space between numbers forms a cycle. +# Space between cycles forms a permutation. +# Space between a number and a cycle or +# permutation evaluates the permutation +# on the number. +# +package context::Permutation::BOP::space; +our @ISA = ("Parser::BOP"); + +# +# Check that the operands are appropriate, and return +# the proper type reference, or give an error. +# +sub _check { + my $self = shift; my $type; + my ($ltype,$rtype) = ($self->{lop}->typeRef,$self->{rop}->typeRef); + if ($ltype->{name} eq "Number") { + if ($rtype->{name} eq "Number") { + $type = Value::Type("Comma",2,$Value::Type{number}); + } elsif ($rtype->{name} eq "Comma") { + $type = Value::Type("Comma",$rtype->{length}+1,$Value::Type{number}); + } elsif ($rtype->{name} eq "Cycle" || $rtype->{name} eq "Permutation") { + $type = $Value::Type{number}; + } + } elsif ($ltype->{name} eq "Cycle") { + if ($rtype->{name} eq "Cycle") { + $type = Value::Type("Permutation",2,$ltype); + } elsif ($rtype->{name} eq "Permutation") { + $type = Value::Type("Permutation",$rtype->{length}+1,$ltype); + } + } + if (!$type) { + $ltype = $ltype->{name}; $rtype = $rtype->{name}; + $ltype = (($ltype =~ m/^[aeiou]/i)? "An ": "A ") . $ltype; + $rtype = (($rtype =~ m/^[aeiou]/i)? "an ": "a ") . $rtype; + $self->{equation}->Error(["%s can not be multiplied by %s",$ltype,$rtype]); + } + $self->{type} = $type; +} + +# +# Evaluate by forming a list if this is acting as a comma, +# othewise take a product (Value object will take care of things). +# +sub _eval { + my $self = shift; + my ($a,$b) = @_; + return ($a,$b) if $self->type eq "Comma"; + return $a * $b; +} + +# +# If the operator is not a comma, return the item itself. +# Otherwise, make a list out of the lists that are the left +# and right operands. +# +sub makeList { + my $self = shift; my $prec = shift; + return $self unless $self->{def}{isComma} && $self->type eq 'Comma'; + return ($self->{lop}->makeList,$self->{rop}->makeList); +} + +# +# Produce the TeX form +# +sub TeX { + my $self = shift; + return $self->{lop}->TeX."\\,".$self->{rop}->TeX; +} + + +########################################################### +# +# Powers of cycles form permutations +# +package context::Permutation::BOP::power; +our @ISA = ("Parser::BOP::power"); + +# +# Check that the operands are appropriate, +# and return the proper type reference +# +sub _check { + my $self = shift; my $equation = $self->{equation}; + $equation->Error(["Powers are not allowed"]) if $equation->{context}->flag("noPowers"); + $equation->Error(["You can only take powers of Cycles or Permutations"]) + unless $self->{lop}->type eq "Cycle"; + $self->{rop} = $self->{rop}{coords}[0] if $self->{rop}->type eq "Cycle" && $self->{rop}->length == 1; + $equation->Error(["Powers of Cycles and Permutations must be Numbers"]) + unless $self->{rop}->type eq "Number"; + $self->{type} = Value::Type("Permutation",1,$self->{lop}->typeRef); +} + + +########################################################### +# +# The List subclass for cycles in the parse tree +# + +package context::Permutation::List::Cycle; +our @ISA = ("Parser::List"); + +# +# Check that the coordinates are numbers. +# If there is one parameter and it is a cycle or permutation +# treat this as plain parentheses, not cycle parentheses +# (so you can take groups of cycles to a power). +# +sub _check { + my $self = shift; + if ($self->length == 1 && !$self->{equation}{context}->flag("noGroups")) { + my $value = $self->{coords}[0]; + return if ($value->type eq "Cycle" || $value->typeRef->{name} eq "Permutation" || + ($value->class eq "Value" && $value->{value}->classMatch("Cycle","Permutation"))); + } + foreach my $x (@{$self->{coords}}) { + unless ($x->isNumber) { + my $type = $x->type; + $type = (($type =~ m/^[aeiou]/i)? "an ": "a ") . $type; + $self->{equation}->Error(["An entry in a Cycle must be a Number not %s",$type]); + } + } +} + +# +# Produce a string version. (Shouldn't be needed, but there is +# a bug in the Value.pm version that neglects the separator value.) +# +sub string { + my $self = shift; my $precedence = shift; my @coords = (); + foreach my $x (@{$self->{coords}}) {push(@coords,$x->string)} + my $comma = $self->{equation}{context}{lists}{$self->{type}{name}}{separator}; + return $self->{open}.join($comma,@coords).$self->{close}; +} + +# +# Produce a TeX version. +# +sub TeX { + my $self = shift; my $precedence = shift; my @coords = (); + foreach my $x (@{$self->{coords}}) {push(@coords,$x->TeX)} + my $comma = $self->{equation}{context}{lists}{$self->{type}{name}}{separator}; + $comma =~ s/ /\\;/g; + return $self->{open}.join($comma,@coords).$self->{close}; +} + +######################################################################### +# +# The List subclass for one line notation permutations in the parse tree +# +package context::Permutation::List::PermutationOneLineNotation; +our @ISA = ("Parser::List"); + +# +# Check that the coordinates are numbers. +# +sub _check { + my $self = shift; + foreach my $x (@{$self->{coords}}) { + unless ($x->isNumber) { + my $type = $x->type; + $type = (($type =~ m/^[aeiou]/i)? "an ": "a ") . $type; + $self->{equation}->Error(["An entry in a Permutation must be a Number not %s",$type]); + } + } +} + +# +# Call the appropriate creation routine from Value.pm +# (Can be over-written by sub-classes) +# +sub _eval { + my $self = shift; + my @elements = @{@_[0]}; + # transform into cycles + my @keys = 1 .. scalar(@elements); + my @cycles = (); + while(my $key = shift(@keys)) { + my @cycle = ($key); + # complete the cycle + my $currentKey = $key; + while(@keys) { + if ($elements[$currentKey-1]) { + $currentKey = $elements[$currentKey-1]; + } + if ($key == $currentKey) { + last; + } else { + push(@cycle, $currentKey); + foreach my $index (reverse 0 .. $#keys) { + splice(@keys, $index, 1) if $keys[$index] == $currentKey; + } + } + } + push(@cycles, $self->Package("Cycle")->new(@cycle)); + } + # return a Cycle if there is only one cycle as the result + return @cycles[0] if scalar(@cycles) == 1; + # else return a Permutation if there are more than 1 cycles + return $self->Package("Permutation")->new(@cycles); +} + +########################################################### + +1; + From 9e766c894a6748a3adf2a648d3eb9d4d24138dcc Mon Sep 17 00:00:00 2001 From: Andrew Gardener Date: Thu, 25 Jan 2018 14:43:32 -0800 Subject: [PATCH 2/3] Add context Integer - Limits input to Integer values - Adds several integer functions for problem creation (phi, tau, lcm, gcd, isPrime, primeFactorization, randomPrime) --- macros/contextInteger.pl | 276 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 276 insertions(+) create mode 100644 macros/contextInteger.pl diff --git a/macros/contextInteger.pl b/macros/contextInteger.pl new file mode 100644 index 0000000000..c523836bb5 --- /dev/null +++ b/macros/contextInteger.pl @@ -0,0 +1,276 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2017 The WeBWorK Project, http://openwebwork.sf.net/ +# $CVSHeader:$ +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + + +=head1 NAME + +contextInteger.pl - adds integer related functions primeFactorization, phi, tau, isPrime, randomPrime, lcm, and gcd. + +=head1 DESCRIPTION + +This is a Parser context that adds integer related functions. +This forces students to only enter integers as their answers. + +=head1 USAGE + + Context("Integer") + + # generates an array of each prime factor + @a = primeFactorization(1000); + ANS(List(@a)->cmp); + + # get the gcd + $b = gcd(5, 2); + ANS($b->cmp); + + # get lcm + $c = lcm(36, 90); + ANS($c->cmp); + + # get phi + $d = phi(365); + ANS($d->cmp); + + # get tau + $e = tau(365); + ANS($e->cmp); + + # check if prime + $f = isPrime(10); #False + $h = isPrime(5); #True + + # get a random prime in a range + $randomPrime = randomPrime(100, 1000); + +=cut + +loadMacros('MathObjects.pl'); + +sub _contextInteger_init {context::Integer::Init()}; + +########################################################################### + +package context::Integer; + +# +# Initialize the contexts and make the creator function. +# +sub Init { + my $context = $main::context{Integer} = Parser::Context->getCopy("Numeric"); + $context->{name} = "Integer"; + Parser::Number::NoDecimals($context); + $context->{pattern}{number} = '(?:\d+)'; + $context->{pattern}{signedNumber} = '[-+]?(?:\d+)'; + + $context->{parser}{Number} = "Parser::Legacy::LimitedNumeric::Number"; + $context->operators->undefine( + 'U', '.', '><', 'u+', '_', + ); + + $context->functions->add( + primeFactorization => {class => 'context::Integer::Function::Numeric'}, + phi => {class => 'context::Integer::Function::Numeric'}, + tau => {class => 'context::Integer::Function::Numeric'}, + isPrime => {class => 'context::Integer::Function::Numeric'}, + randomPrime => {class => 'context::Integer::Function::Numeric'}, + lcm => {class => 'context::Integer::Function::Numeric2'}, + gcd => {class => 'context::Integer::Function::Numeric2'}, + ); + + $context->{error}{msg}{"You are not allowed to type decimal numbers in this problem"} = + "You are only allowed to enter integers, not decimal numbers"; + + main::PG_restricted_eval('sub Integer {Value->Package("Integer()")->new(@_)};'); + main::PG_restricted_eval("sub primeFactorization {context::Integer::Function::Numeric::primeFactorization(\@_)}"); + main::PG_restricted_eval("sub phi {context::Integer::Function::Numeric::phi(\@_)}"); + main::PG_restricted_eval("sub tau {context::Integer::Function::Numeric::tau(\@_)}"); + main::PG_restricted_eval("sub isPrime {context::Integer::Function::Numeric::isPrime(\@_)}"); + main::PG_restricted_eval("sub randomPrime {context::Integer::Function::Numeric::randomPrime(\@_)}"); + main::PG_restricted_eval("sub lcm {context::Integer::Function::Numeric2::lcm(\@_)}"); + main::PG_restricted_eval("sub gcd {context::Integer::Function::Numeric2::gcd(\@_)}"); +} + +# +# divisor function +# +sub _divisor { + my $power = abs(shift); my $a = abs(shift); + $self->Error("Cannot perform divisor function on Zero") if $a == 0; + $result = 1; $sqrt_a = int(sqrt($a)); + for (my $i = 2; $i < $sqrt_a; $i++) { + if ($a % $i == 0) { + # add divisor to result + $result += $i ** $power; + # if both divisors are not the same, add the other divisor + # (ex: 12 / 2 = 6 so add 6 as well) + if ($i != ($a / $i)) { + $result += ($a / $i) ** $power; + } + } + } + # add the final divisor, the number itself unless the number is 1 + $result += ($a ** $power) if $a > 1; + return $result; +} + +sub _getPrimesInRange { + my $index = shift; my $end = shift; + $self->Error("Start of range must be a positive number.") if $index < 0; + $self->Error("End of range must be greater than or equal to 2") if $end < 2; + $self->Error("Start or range must be before end of range") if $index > $end; + @primes = (); + + # consider switching to set upper limit and static array of primes + + push(@primes, 2) if $index <= 2; + # ensure index is odd + $index++ if $index % 2 == 0; + while ($index < $end) { + push(@primes, $index) if context::Integer::Function::Numeric::isPrime($index); + $index += 2; + } + + return @primes; +} + +package context::Integer::Function::Numeric; +our @ISA = qw(Parser::Function::numeric); # checks for 2 numeric inputs + +# +# Prime Factorization +# +sub primeFactorization { + my $a = abs(shift); + $self->Error("Cannot factor Zero into primes.") if $a == 0; + $self->Error("Cannot factor One into primes.") if $a == 1; + + my %factors; my $n = $a; + for (my $i = 2; ($i ** 2) <= $n; $i++) { + while ($n % $i == 0) { + $n /= $i; + $factors{$i}++; + } + } + $factors{$n}++ if $n > 1; + + # store prime factors in array for cmp + my @results = (); + for my $factor (main::num_sort(keys %factors)) { + my $string = $factor; + $string .= "**".$factors{$factor} if $factors{$factor} > 1; + push(@results, $string); + } + return @results; +} + +# +# Euler's totient function phi(n) +# +sub phi { + my $a = abs(shift); + $self->Error("Cannot phi on Zero.") if $a == 0; + $result = $a; $n = $a; + for (my $i = 2; ($i ** 2) < $n; $i++) { + while ($n % $i == 0) { + $n /= $i; + $result -= $result / $i; + } + } + $result -= $result / $n if $n > 1; + return $result; +} + +# +# number of divisors function tau(n) +# +sub tau { + my $a = shift; + return context::Integer::_divisor(0, $a); +} + +sub isPrime { + my $a = abs(shift); + return 1 if $a == 2; + return 0 if $a < 2 || $a % 2 == 0; + for (my $i = 3; $i <= sqrt($a); $i += 2) { + return 0 if $a % $i == 0; + } + return 1; +} + +sub randomPrime { + my ($start,$end) = @_; + my @primes = context::Integer::_getPrimesInRange($start, $end); + $self->Error("Could not find any prime numbers in range.") if $#primes == 0; + my $primeIndex = $main::PG_random_generator->random(0,($#primes - 1), 1); + return $primes[$primeIndex]; +} + +package context::Integer::Function::Numeric2; +our @ISA = qw(Parser::Function::numeric2); # checks for 2 numeric inputs + +# +# Greatest Common Divisor +# +sub gcd { + my $a = abs(shift); my $b = abs(shift); + return $a if $b == 0; + return $b if $a == 0; + ($a,$b) = ($b,$a) if $a > $b; + while ($a) { + ($a, $b) = ($b % $a, $a); + } + return $b; +} + +# +# Extended Greatest Common Divisor +# +# return (g, x, y) a*x + b*y = gcd(x, y) +sub egcd { + my $a = shift; my $b = shift; + if ($a == 0) { + return ($b, 0, 1); + } else { + my ($g, $x, $y) = egcd($b % $a, $a); + my $temp = int($b / $a); $temp-- if $temp > $b / $a; # act as floor() rather than int() + return ($g, $y - $temp * $x, $x); + } +} + +# +# Modular inverse +# +# x = mulinv(b) mod n, (x * b) % n == 1 +sub mulularInverse { + my $b = shift; my $n = shift; + my ($g, $x, $y) = egcd($b, $n); + if ($g == 1) { + return $x % $n; + } else { + Value::Error("Modular inverse: gcd($a, $n) != 1"); + } +} + +# +# Least Common Multiple +# +sub lcm { + my $a = abs(shift); my $b = abs(shift); + return ($a*$b)/gcd($a,$b); +} + +1; \ No newline at end of file From d4d3aedde35e5a21c6d589a332852904ecd407ff Mon Sep 17 00:00:00 2001 From: Andrew Gardener Date: Thu, 25 Jan 2018 14:45:16 -0800 Subject: [PATCH 3/3] Add context Congruence - Adds a helper function for creating congruence solutions - reuses context Integer functions - Options to accept general solution only, all solutions only, or both --- macros/contextCongruence.pl | 302 ++++++++++++++++++++++++++++++++++++ 1 file changed, 302 insertions(+) create mode 100644 macros/contextCongruence.pl diff --git a/macros/contextCongruence.pl b/macros/contextCongruence.pl new file mode 100644 index 0000000000..cc7a8489dd --- /dev/null +++ b/macros/contextCongruence.pl @@ -0,0 +1,302 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2017 The WeBWorK Project, http://openwebwork.sf.net/ +# $CVSHeader:$ +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + + +=head1 NAME + + +C - Provides contexts that allow the +entry of congruence solutions + +=head1 DESCRIPTION + +These contexts allow you to enter congruence solutions. +Either the general solution or all possible solutions can be accepted +based on settings. + +There are three contexts included here: C, which +allows both types of solutions, C, which +requires the general solution, and C, which +requires all solutions to be entered. + +Congruences must be created with three paramters (a, b, m) from ax ≡ b (mod m). + +=head1 USAGE + + + loadMacros("contextCongruence.pl"); + + Context("Congruence"); + + ax ≡ b (mod m) + can initialize with Congruence(a, b, m); + + #ex: 15x ≡ 10 (mod 25) + $C1 = Congruence(15, 10, 25); + $general_answer = Compute("4+5k"); + $all_answers = Compute("4+25k,9+25k,14+25k,19+25k,24+25k"); + $all_answers_diff_order = Compute("9+25k,4+25k,14+25k,19+25k,24+25k"); + + $C1->compare($general_answer); # is true + $C1->compare($all_answers); # is true + $C1->compare($all_answers_diff_order); # is true + + Can an force general solution only with + + Context()->flags->set(requireGeneralSolution => 1); + $C1->compare($general_answer); # is true + $C1->compare($all_answers); # is false + + + Can an force all solutions only with + + Context()->flags->set(requireAllSolutions => 1); + $C1->compare($general_answer); # is false + $C1->compare($all_answers); # is true + + Students can enter 'none' when there is no solution + #ex: 15x ≡ 10 (mod 24) + $C2 = Congruence(15, 10, 24); + $none = Compute("None"); + $n = Compute("n"); + + $C2->compare($none); # is true + $C2->compare($n); # is true + $C1->compare($none); # is false + +=cut + +loadMacros('MathObjects.pl', 'contextInteger.pl'); + +sub _contextCongruence_init {context::Congruence::Init()}; + +########################################################################### + +package context::Congruence; +our @ISA = ('Value::Formula'); + +# +# Initialize the contexts and make the creator function. +# +sub Init { + my $context = $main::context{Congruence} = Parser::Context->getCopy("Numeric"); + $context->{name} = "Congruence"; + Parser::Number::NoDecimals($context); + + $context->variables->clear(); + $context->variables->add(k => 'Real'); + + $context->strings->add( + None=>{caseSensitive=>0}, + N=>{caseSensitive=>0, alias=>"None"} + ); + + $context->flags->set( + requireGeneralSolution => 0, # require general solution as answer? + requireAllSolutions => 0, # require all solution as answer? + outputAllSolutions => 0 # default display only general solution. switch to 1 to display all possible solutions + ); + + # + # Only allow general solution for answer and output + # + $context = $main::context{"Congruence-General-Solution"} = $context->copy; + $context->{name} = "Congruence-General-Solution"; + $context->flags->set( + requireGeneralSolution => 1, + requireAllSolutions => 0, + outputAllSolutions => 0 + ); + + # + # Only allow all solutions for answer and output + # + $context = $main::context{"Congruence-All-Solutions"} = $context->copy; + $context->{name} = "Congruence-All-Solutions"; + $context->flags->set( + requireGeneralSolution => 0, + requireAllSolutions => 1, + outputAllSolutions => 1 + ); + + + main::PG_restricted_eval("sub Congruence {context::Congruence->new(\@_)}"); +} + +sub new { + my $self = shift; my $class = ref($self) || $self; + my $context = (Value::isContext($_[0]) ? shift : $self->context); + + # validation is handled in _getCongruenceData + my ($g, $residue, $divisor) = context::Congruence::Function::Numeric3::_getCongruenceData(@_); + my $formula = main::Formula->new($context, "k"); + $formula->{g} = $g; + $formula->{residue} = $residue; + $formula->{divisor} = $divisor; + return bless $formula, $class; +} + +sub compare { + my ($l,$r) = @_; my $self = $l; + my $context = $self->context; + + my $generalSolution = $l->generalSolution; + my $allSolutions = $l->allSolutions; + my $requireGeneralSolution = $self->getFlag("requireGeneralSolution"); + my $requireAllSolutions = $self->getFlag("requireAllSolutions"); + + # allow unorder formula lists + if ($r->classMatch("Formula") && scalar($r->value)) { + my @orderedValues = main::PGsort(sub { + $_[0]->eval(k=>0) < $_[1]->eval(k=>0); + },$r->value); + $r = Value::Formula->new($self->context, join(",", @orderedValues)); + } + + if ($requireGeneralSolution) { + return $generalSolution->compare($r); + } elsif ($requireAllSolutions) { + return $allSolutions->compare($r); + } else { + # check both all solutons and general solution + return 0 if $allSolutions->compare($r) == 0; + return $generalSolution->compare($r); + } +} + +sub generalSolution { + my $self = shift; + + # check no solution + return $self->Package("String")->new($self->context, "None") if ($self->{g} == 0); + + return Value::Formula->new($self->context, $self->{residue} . "+" . $self->{divisor} . "k"); +} + +sub allSolutions { + my $self = shift; + + # check no solution + return $self->Package("String")->new($self->context, "None") if ($self->{g} == 0); + + @solutions = (); + my $divisor = $self->{divisor} * $self->{g}; + for my $index (0..$self->{g}-1) { + my $residue = $self->{residue} + ($index * $self->{g}); + push(@solutions, $residue . "+" . $divisor . "k"); + } + return Value::Formula->new($self->context, join(",", @solutions)); +} + +# +# Produce a string version +# +sub string { + my $self = shift; + my $outputAllSolutions = $self->getFlag("outputAllSolutions"); + + if ($outputAllSolutions) { + return $self->allSolutions->string; + } else { + return $self->generalSolution->string; + } +} + +# +# Produce a TeX version +# +sub TeX { + my $self = shift; + my $outputAllSolutions = $self->getFlag("outputAllSolutions"); + + if ($outputAllSolutions) { + return $self->allSolutions->TeX; + } else { + return $self->generalSolution->TeX; + } +} + + +sub typeMatch { + my $self = shift; my $other = shift; + return $other->classMatch("Formula", "String"); +} + +package context::Congruence::Function::Numeric3; # checks for 3 numeric inputs +our @ISA = qw(Parser::Function); + +# +# Check for two real-valued arguments +# +sub _check { + my $self = shift; + return if ($self->checkArgCount(3)); + if (($self->{params}->[0]->isNumber && $self->{params}->[1]->isNumber && + $self->{params}->[2]->isNumber && + !$self->{params}->[0]->isComplex && !$self->{params}->[1]->isComplex && + !$self->{params}->[2]->isComplex) || + $self->context->flag("allowBadFunctionInputs")) { + $self->{type} = $Value::Type{number}; + } else { + $self->Error("Function '%s' has the wrong type of inputs",$self->{name}); + } +} + +# +# Check that the inputs are OK +# +sub _call { + my $self = shift; my $name = shift; + Value::Error("Function '%s' has too many inputs",$name) if scalar(@_) > 3; + Value::Error("Function '%s' has too few inputs",$name) if scalar(@_) < 3; + Value::Error("Function '%s' has the wrong type of inputs",$name) + unless Value::matchNumber($_[0]) && Value::matchNumber($_[1]); + return $self->$name(@_); +} + +# +# Call the appropriate routine +# +sub _eval { + my $self = shift; my $name = $self->{name}; + $self->$name(@_); +} + +# +# Congruence Class +# ax ≡ b (mod m) +# +# returns gcd, residue, divisor +sub _getCongruenceData { + my $a = shift; my $b = shift; my $m = shift; + my $g = context::Integer::Function::Numeric2::gcd($a, $m); + + # check for no solutions + if ($b % $g != 0) { + return (0, 0, 0); + } + + # (a/g)x ≡ (b/g) (mod (m/g)) reduce multiple solutions + my $a2 = $a / $g; my $b2 = $b / $g; my $m2 = $m / $g; + + # x ≡ $modularInverse * b2 (mod m2) + my $modularInverse = context::Integer::Function::Numeric2::mulularInverse($a2, $m2); + $x = ($modularInverse * $b2) % $m2; + + return ($g, $x, $m2); +} + +1;