diff --git a/conf/pg_config.dist.yml b/conf/pg_config.dist.yml
index f8d4735028..f2f3d85542 100644
--- a/conf/pg_config.dist.yml
+++ b/conf/pg_config.dist.yml
@@ -41,28 +41,17 @@ directories:
macrosPath:
- .
- $pg_root/macros
- - $OPL_dir/macros/Alfred
- - $OPL_dir/macros/BrockPhysics
- - $OPL_dir/macros/CollegeOfIdaho
- - $OPL_dir/macros/Dartmouth
- - $OPL_dir/macros/FortLewis
- - $OPL_dir/macros/Hope
- - $OPL_dir/macros/LaTech
- - $OPL_dir/macros/MC
- - $OPL_dir/macros/Michigan
- - $OPL_dir/macros/Mizzou
- - $OPL_dir/macros/NAU
- - $OPL_dir/macros/PCC
- - $OPL_dir/macros/TCNJ
- - $OPL_dir/macros/UBC
- - $OPL_dir/macros/UMass-Amherst
- - $OPL_dir/macros/UW-Stout
- - $OPL_dir/macros/UniSiegen
- - $OPL_dir/macros/Union
- - $OPL_dir/macros/WHFreeman
- - $OPL_dir/macros/Wiley
- - $Contrib_dir/CAPA/macros/CAPA_Tools
- - $Contrib_dir/CAPA/macros/CAPA_MCTools
+ - $pg_root/macros/answers
+ - $pg_root/macros/capa
+ - $pg_root/macros/contexts
+ - $pg_root/macros/core
+ - $pg_root/macros/graph
+ - $pg_root/macros/math
+ - $pg_root/macros/misc
+ - $pg_root/macros/parsers
+ - $pg_root/macros/ui
+ - $pg_root/macros/deprecated
+
URLs:
# The public URL of the html directory above.
diff --git a/doc/MathObjects/macros/parserTables.pl b/doc/MathObjects/macros/parserTables.pl
deleted file mode 100644
index 22b9b05a6d..0000000000
--- a/doc/MathObjects/macros/parserTables.pl
+++ /dev/null
@@ -1,90 +0,0 @@
-loadMacros("parserUtils.pl");
-
-#############################################
-#
-# For Parser example tables:
-#
-
-$BTT = MODES(TeX => '{\tt ', Latex2HTML => $bHTML . '' . $eHTML, HTML => '');
-$ETT = MODES(TeX => '}', Latex2HTML => $bHTML . ' ' . $eHTML, HTML => ' ');
-
-$BC = MODES(
- TeX => '{\small\it ',
- Latex2HTML => $bHTML . '' . $eHTML,
- HTML => ''
-);
-$EC = MODES(
- TeX => '}',
- Latex2HTML => $bHTML . ' ' . $title . ' ' . $title . '
- $ehtml
- $col1
- $bhtml $ehtml
- $col2
- $bhtml
$ehtml
- };
-
- MODES(
- TeX => '\par\medskip\hbox{\qquad\vtop{'
- . '\advance\hsize by -3em '
- . $col1 . '}}'
- . '\medskip\hbox{\qquad\vtop{'
- . '\advance\hsize by -3em '
- . $col2
- . '}}\medskip',
- Latex2HTML => $HTMLtable,
- HTML => $HTMLtable
- );
-}
-
-#
-# Use columns for a match-list output
-#
-# Usage: ColumnMatchTable($ml,options)
-#
-# where $ml is a math list reference and options are those
-# allowed for ColumnTable above.
-#
-sub ColumnMatchTable {
- my $ml = shift;
-
- ColumnTable($ml->print_q, $ml->print_a, @_);
-}
-
-#
-# Command for tables with no borders.
-#
-# Usage: BeginTable(options);
-#
-# Options are taken from:
-#
-# border => n value for BORDER attribute (default 0)
-# spacing => n value for CELLSPACING attribute (default 0)
-# padding => n value for CELLPADDING attribute (default 0)
-# tex_spacing => dimen value for spacing between columns in TeX
-# (e.g, tex_spacing => 2em) (default 1em)
-# tex_border => dimen value for left- and right border in TeX (0pt)
-# center => 0 or 1 center table or not (default 1)
-#
-sub BeginTable {
- my %options = (
- border => 0,
- padding => 0,
- spacing => 0,
- center => 1,
- tex_spacing => "1em",
- tex_border => "0pt",
- @_
- );
- my ($bd, $pd, $sp) = ($options{border}, $options{padding}, $options{spacing});
- my ($tsp, $tbd) = ($options{tex_spacing}, $options{tex_border});
- my ($center, $tcenter) = (' ALIGN="CENTER"', '\centerline');
- ($center, $tcenter) = ('', '') if (!$options{center});
- my $table = qq{};
-
- MODES(
- TeX => '\par\medskip' . $tcenter . '{\kern ' . $tbd . '\vbox{\halign{#\hfil&&\kern ' . $tsp . ' #\hfil',
- Latex2HTML => $bHTML . $table . $eHTML . "\n",
- HTML => $table . "\n"
- );
-}
-
-#
-# Usage: EndTable(options)
-#
-# where options are taken from:
-#
-# tex_border => dimen extra vertical space in TeX mode (default 0pt)
-#
-sub EndTable {
- my %options = (tex_border => "0pt", @_);
- my $tbd = $options{tex_border};
- MODES(
- TeX => '\cr}}\kern ' . $tbd . '}\medskip' . "\n",
- Latex2HTML => $bHTML . '
' . $eHTML . "\n",
- HTML => '' . "\n"
- );
-}
-
-#
-# Creates a row in the table
-#
-# Usage: Row([item1,item2,...],options);
-#
-# Each item appears as a separate entry in the table.
-#
-# Options control how the row is displayed:
-#
-# indent => num Specifies size of blank column on the left
-# (default: indent => 0)
-#
-# separation => num Specifies separation of columns
-# (default: spearation => 30)
-#
-# align => "type" Specifies alignment of initial column
-# (default: align => "LEFT")
-#
-# valign => "type" Specified vertical alignment of row
-# (default: valign => "MIDDLE")
-#
-sub Row {
- my $rowref = shift;
- my @row = @{$rowref};
- my %options = (
- indent => 0,
- separation => 30,
- align => "LEFT",
- valign => "MIDDLE",
- @_
- );
- my ($cind, $csep) = ($options{indent}, $options{separation});
- my ($align, $valign) = ($options{align}, $options{valign});
- my $sep = ' ';
- $sep = '' if ($csep < 1);
- my $ind = ' ';
- $ind = '' if ($cind < 1);
- my $fill = '';
- $fill = '\hfil' if (uc($align) eq "CENTER");
- $fill = '\hfill' if (uc($align) eq "RIGHT");
-
- MODES(
- TeX => "\\cr\n" . $fill . join('& ', @row),
- Latex2HTML => $bHTML
- . "$ind"
- . $eHTML
- . join($bHTML . " $sep" . $eHTML, @row)
- . $bHTML
- . ' '
- . $eHTML . "\n",
- HTML => "$ind"
- . join(" $sep", @row)
- . ' ' . "\n"
- );
-}
-
-#
-# AlignedRow([item1,item2,...],options);
-#
-# Options control how the row is displayed:
-#
-# indent => num Specifies size of blank column on the left
-# (default: indent => 0)
-#
-# separation => num Specifies separation of columns
-# (default: spearation => 30)
-#
-# align => "type" Specifies alignment of all columns
-# (default: align => "CENTER")
-#
-# valign => "type" Specified vertical alignment of row
-# (default: valign => "MIDDLE")
-#
-sub AlignedRow {
- my $rowref = shift;
- my @row = @{$rowref};
- my %options = (
- indent => 0,
- separation => 30,
- align => "CENTER",
- valign => "MIDDLE",
- @_
- );
- my ($cind, $csep) = ($options{indent}, $options{separation});
- my ($align, $valign) = ($options{align}, $options{valign});
- my $sep = ' ';
- $sep = '' if ($csep < 1);
- my $ind = ' ';
- $ind = '' if ($cind < 1);
- my $fill = '';
- $fill = '\hfil ' if (uc($align) eq "CENTER");
- $fill = '\hfill ' if (uc($align) eq "RIGHT");
-
- MODES(
- TeX => "\\cr\n" . $fill . join('&' . $fill, @row),
- Latex2HTML => $bHTML
- . "$ind"
- . $eHTML
- . join($bHTML . " $sep" . $eHTML, @row)
- . $bHTML
- . ' '
- . $eHTML . "\n",
- HTML => "$ind"
- . join(" $sep", @row)
- . ' ' . "\n"
- );
-}
-
-#
-# Add extra space between rows of a table
-#
-# Usage: TableSpace(pixels,points)
-#
-# where pixels is the number of pixels of space in HTML mode and
-# points is the number of points to use in TeX mode.
-#
-sub TableSpace {
- my $rsep = shift;
- my $tsep = shift;
- $rsep = $tsep if (defined($tsep) && $main::displayMode eq "TeX");
- return "" if ($rsep < 1);
- MODES(
- TeX => '\vadjust{\kern ' . $rsep . 'pt}' . "\n",
- Latex2HTML => $bHTML . '
+
+
+END_HEADER_TEXT
+
+ $angleHelpExists = 1;
+ }
+
+ if (!$customstring) { $helpstring = "help (angles)"; }
+ else { $helpstring = $customstring; }
+
+ if ($main::displayMode ne "TeX") {
+ return htmlLink("#", "$helpstring", "onClick='return openhelpAngles()';");
+ } else {
+ return $helpstring;
+ }
+
+####################################
+ # Decimals
+
+ } elsif ($helptype =~ m/decimal/i) {
+
+ if ($decimalHelpExists != 1) {
+
+ HEADER_TEXT(<
+
+
+END_HEADER_TEXT
+
+ $decimalHelpExists = 1;
+ }
+
+ if (!$customstring) { $helpstring = "help (decimals)"; }
+ else { $helpstring = $customstring; }
+
+ if ($main::displayMode ne "TeX") {
+ return htmlLink("#", "$helpstring", "onClick='return openhelpDecimals()';");
+ } else {
+ return $helpstring;
+ }
+
+#########################################
+ # Equations
+
+ } elsif ($helptype =~ m/equation/i) {
+
+ if ($equationHelpExists != 1) {
+
+ HEADER_TEXT(<
+
+
+END_HEADER_TEXT
+
+ $equationHelpExists = 1;
+ }
+
+ if (!$customstring) { $helpstring = "help (equations)"; }
+ else { $helpstring = $customstring; }
+
+ if ($main::displayMode ne "TeX") {
+ return htmlLink("#", "$helpstring", "onClick='return openhelpEquations()';");
+ } else {
+ return $helpstring;
+ }
+
+###############################################
+ # Exponents
+
+ } elsif ($helptype =~ m/exponent/i) {
+
+ if ($exponentHelpExists != 1) {
+
+ HEADER_TEXT(<
+
+
+END_HEADER_TEXT
+
+ $exponentHelpExists = 1;
+ }
+
+ if (!$customstring) { $helpstring = "help (exponents)"; }
+ else { $helpstring = $customstring; }
+
+ if ($main::displayMode ne "TeX") {
+ return htmlLink("#", "$helpstring", "onClick='return openhelpExponents()';");
+ } else {
+ return $helpstring;
+ }
+
+#######################################
+ # Formulas
+
+ } elsif ($helptype =~ m/formula/i) {
+
+ my $local1UseBaseTenLogHelp = Context()->flags->get("useBaseTenLog");
+ my $local2UseBaseTenLogHelp = main::Context()->flags->get("useBaseTenLog");
+ my $globalUseBaseTenLogHelp = $useBaseTenLog;
+
+ if ($local1UseBaseTenLogHelp == 1 || $local2UseBaseTenLogHelp == 1 || $globalUseBaseTenLogHelp == 1) {
+ $useBaseTenLogHelpString =
+ "Entering logarithms: In this question, use ln(x) for natural log, and log(x), logten(x) or log10(x) for the base 10 logarithm. Enter log base b as ln(x)/ln(b) Entering logarithms: Caution: ln(x) or log(x) for natural log, and logten(x) or log10(x) for the base 10 logarithm. Enter log base b as ln(x)/ln(b)
+
+
+END_HEADER_TEXT
+
+ $formulaHelpExists = 1;
+ }
+
+ if (!$customstring) { $helpstring = "help (formulas)"; }
+ else { $helpstring = $customstring; }
+
+ if ($main::displayMode ne "TeX") {
+ return htmlLink("#", "$helpstring", "onClick='return openhelpFormulas()';");
+ } else {
+ return $helpstring;
+ }
+
+#########################################
+ # Fractions
+
+ } elsif ($helptype =~ m/fraction/i) {
+
+ if ($fractionHelpExists != 1) {
+
+ HEADER_TEXT(<
+
+
+END_HEADER_TEXT
+
+ $fractionHelpExists = 1;
+ }
+
+ if (!$customstring) { $helpstring = "help (fractions)"; }
+ else { $helpstring = $customstring; }
+
+ if ($main::displayMode ne "TeX") {
+ return htmlLink("#", "$helpstring", "onClick='return openhelpFractions()';");
+ } else {
+ return $helpstring;
+ }
+
+###########################################
+ # Inequalities
+
+ } elsif ($helptype =~ m/inequalit/i) {
+
+ if ($inequalitiesHelpExists != 1) {
+
+ HEADER_TEXT(<
+
+
+END_HEADER_TEXT
+
+ $inequalitiesHelpExists = 1;
+ }
+
+ if (!$customstring) { $helpstring = "help (inequalities)"; }
+ else { $helpstring = $customstring; }
+
+ if ($main::displayMode ne "TeX") {
+ return htmlLink("#", "$helpstring", "onClick='return openhelpInequalities()';");
+ } else {
+ return $helpstring;
+ }
+
+#######################################
+ # Intervals
+
+ } elsif ($helptype =~ m/interval/i) {
+
+ if ($intervalHelpExists != 1) {
+
+ HEADER_TEXT(<
+
+
+END_HEADER_TEXT
+
+ $intervalHelpExists = 1;
+ }
+
+ if (!$customstring) { $helpstring = "help (intervals)"; }
+ else { $helpstring = $customstring; }
+
+ if ($main::displayMode ne "TeX") {
+ return htmlLink("#", "$helpstring", "onClick='return openhelpIntervals()';");
+ } else {
+ return $helpstring;
+ }
+
+##############################################
+ # Limits
+
+ } elsif ($helptype =~ m/limit/i) {
+
+ if ($limitsHelpExists != 1) {
+
+ HEADER_TEXT(<
+
+
+END_HEADER_TEXT
+
+ $limitsHelpExists = 1;
+ }
+
+ if (!$customstring) { $helpstring = "help (limits)"; }
+ else { $helpstring = $customstring; }
+
+ if ($main::displayMode ne "TeX") {
+ return htmlLink("#", "$helpstring", "onClick='return openhelpLimits()';");
+ } else {
+ return $helpstring;
+ }
+
+###############################################
+ # Logarithms
+
+ } elsif ($helptype =~ m/log/i) {
+
+ my $local1UseBaseTenLogHelp = Context()->flags->get("useBaseTenLog");
+ my $local2UseBaseTenLogHelp = main::Context()->flags->get("useBaseTenLog");
+ my $globalUseBaseTenLogHelp = $useBaseTenLog;
+
+ if ($local1UseBaseTenLogHelp == 1 || $local2UseBaseTenLogHelp == 1 || $globalUseBaseTenLogHelp == 1) {
+ $naturalLogHelpString =
+ "Entering natural logarithm: In this question, use ln(x)Entering base 10 logarithm: In this question, use log(x), log10(x), or logten(x).Caution: log(x)ln(x)Entering natural logarithm: In this question, use ln(x) or log(x)Entering base 10 logarithm: In this question, use log10(x) or logten(x).
+
+
+END_HEADER_TEXT
+
+ $logarithmsHelpExists = 1;
+ }
+
+ if (!$customstring) { $helpstring = "help (logarithms)"; }
+ else { $helpstring = $customstring; }
+
+ if ($main::displayMode ne "TeX") {
+ return htmlLink("#", "$helpstring", "onClick='return openhelpLogarithms()';");
+ } else {
+ return $helpstring;
+ }
+
+###########################################
+ # Matrices
+
+ } elsif ($helptype =~ m/matri/i) {
+
+ if ($matricesHelpExists != 1) {
+
+ HEADER_TEXT(<
+
+
+END_HEADER_TEXT
+
+ $matricesHelpExists = 1;
+ }
+
+ if (!$customstring) { $helpstring = "help (matrices)"; }
+ else { $helpstring = $customstring; }
+
+ if ($main::displayMode ne "TeX") {
+ return htmlLink("#", "$helpstring", "onClick='return openhelpMatrices()';");
+ } else {
+ return $helpstring;
+ }
+
+##########################################
+ # Numbers
+
+ } elsif ($helptype =~ m/number/i) {
+
+ if ($numberHelpExists != 1) {
+
+ HEADER_TEXT(<
+
+
+END_HEADER_TEXT
+
+ $numberHelpExists = 1;
+ }
+
+ if (!$customstring) { $helpstring = "help (numbers)"; }
+ else { $helpstring = $customstring; }
+
+ if ($main::displayMode ne "TeX") {
+ return htmlLink("#", "$helpstring", "onClick='return openhelpNumbers()';");
+ } else {
+ return $helpstring;
+ }
+
+#######################################
+ # Points
+
+ } elsif ($helptype =~ m/point/i) {
+
+ if ($pointsHelpExists != 1) {
+
+ HEADER_TEXT(<
+
+
+END_HEADER_TEXT
+
+ $pointsHelpExists = 1;
+ }
+
+ if (!$customstring) { $helpstring = "help (points)"; }
+ else { $helpstring = $customstring; }
+
+ if ($main::displayMode ne "TeX") {
+ return htmlLink("#", "$helpstring", "onClick='return openhelpPoints()';");
+ } else {
+ return $helpstring;
+ }
+
+####################################
+ # Units
+
+ } elsif ($helptype =~ m/unit/i) {
+
+ if ($unitsHelpExists != 1) {
+
+ HEADER_TEXT(<
+
+
+END_HEADER_TEXT
+
+ $unitsHelpExists = 1;
+ }
+
+ if (!$customstring) { $helpstring = "help (units)"; }
+ else { $helpstring = $customstring; }
+
+ if ($main::displayMode ne "TeX") {
+ return htmlLink("#", "$helpstring", "onClick='return openhelpUnits()';");
+ } else {
+ return $helpstring;
+ }
+
+########################################
+ # Vectors
+
+ } elsif ($helptype =~ m/vector/i) {
+
+ if ($vectorsHelpExists != 1) {
+
+ HEADER_TEXT(<
+
+
+END_HEADER_TEXT
+
+ $vectorsHelpExists = 1;
+ }
+
+ if (!$customstring) { $helpstring = "help (vectors)"; }
+ else { $helpstring = $customstring; }
+
+ if ($main::displayMode ne "TeX") {
+ return htmlLink("#", "$helpstring", "onClick='return openhelpVectors()';");
+ } else {
+ return $helpstring;
+ }
+
+#########################################
+ # Syntax (the catch all)
+
+ #} elsif ($helptype =~ m/syntax/i) {
+ } else {
+
+ if ($syntaxHelpExists != 1) {
+
+ HEADER_TEXT(<
+
+
+END_HEADER_TEXT
+
+ $syntaxHelpExists = 1;
+ }
+
+ if (!$customstring) { $helpstring = "help (syntax)"; }
+ else { $helpstring = $customstring; }
+
+ if ($main::displayMode ne "TeX") {
+ return htmlLink("#", "$helpstring", "onClick='return openhelpSyntax()';");
+ } else {
+ return $helpstring;
+ }
+
+ }
+
+} # end AnswerFormatHelp
+
+1;
diff --git a/macros/answers/ConditionalHint.pl b/macros/answers/ConditionalHint.pl
new file mode 100644
index 0000000000..441a23fcc3
--- /dev/null
+++ b/macros/answers/ConditionalHint.pl
@@ -0,0 +1,170 @@
+sub _ConditionalHint_init { }; # don't reload this file
+
+=head1 ConditionalHint.pl
+
+################################################################################
+# WeBWorK Online Homework Delivery System
+# Copyright � 2000-2007 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.
+################################################################################
+
+=head2 NAME
+
+ConditionalHint.pl - Allows a hint to be revealed after a student
+has entered an answer correctly.
+
+=head2 DESCRIPTION
+
+The subroutine ConditionalHint() allows a hint to be revealed
+after a student has entered an answer correctly. It is useful
+for multi-part questions in which a hint for answering one part
+should not be revealed until a previous part has been answered
+correctly.
+
+A subroutine IsAnswerCorrect() that returns 0 or 1 is also
+provided.
+
+=head2 USAGE
+
+=head3 Synopsis of ConditionalHint
+
+loadMacros("ConditionalHint.pl");
+
+$ans = Compute("x^2");
+
+BEGIN_TEXT
+Enter \( x^2 \) \{ ans_rule(20) \}
+\{
+ConditionalHint(
+ ans_name=>$ans,
+ ans_number=>1,
+ html_hint=>"$BR ${BBOLD}Hint:${EBOLD}
+ \( \displaystyle \int x^2 \, dx = \frac{x^3}{3} + C.\) $BR",
+ tex_hint=>'',
+);
+\}
+END_TEXT
+
+ANS( $ans->cmp() );
+
+
+=head3 Complete Working Example of ConditionalHint
+
+DOCUMENT();
+
+loadMacros(
+"PGstandard.pl",
+"MathObjects.pl",
+"ConditionalHint.pl",
+);
+
+TEXT( beginproblem() );
+
+###################################
+# Setup
+
+Context("Numeric");
+
+@answers = ();
+$answers[1] = Compute("x^2");
+$answers[2] = Compute("4^3 / 3");
+
+#$hint = IsAnswerCorrect(ans_name=>$answers[1],ans_number=>1);
+
+$myhint = ConditionalHint(
+ans_name=>$answers[1],
+ans_number=>1,
+html_hint=>"$BR ${BBOLD}Hint:${EBOLD} \( \displaystyle \int x^2 \, dx = \frac{x^3}{3} + C.\) $BR"
+);
+
+
+##################################
+# Main text
+
+Context()->texStrings;
+BEGIN_TEXT
+(a) Enter \( x^2 \).
+\{ ans_rule(30) \}
+$BR
+$BR
+(b) When you answer part (a) correctly, a hint will appear here with an integral formula.
+$BR
+$myhint
+$BR
+\( \displaystyle \int_0^4 \frac{x^3}{3} \, dx = \)
+\{ans_rule(20)\}
+END_TEXT
+Context()->normalStrings;
+
+
+##################################
+# Answer evaluation
+
+$showPartialCorrectAnswers = 1;
+
+ANS( $answers[1]->cmp() );
+ANS( $answers[2]->cmp() );
+
+COMMENT('When the first answer is correct, a hint appears with an integral formula (using ConditionalHint.pl).');
+
+ENDDOCUMENT();
+
+=head2 AUTHOR
+
+Paul Pearson
+
+=cut
+
+sub ConditionalHint {
+
+ my %options = (
+ ans_name => '',
+ ans_number => '',
+ html_hint => '',
+ tex_hint => '',
+ @_
+ );
+
+ my $showhint = $options{ans_name}->cmp()->evaluate($inputs_ref->{ ANS_NUM_TO_NAME($options{ans_number}) })->{score};
+
+ my $hint;
+
+ if ($showhint == 1) {
+ $hint = MODES(HTML => $options{html_hint}, TeX => $options{tex_hint});
+ } else {
+ $hint = '';
+ }
+
+ return $hint;
+
+}
+
+sub IsAnswerCorrect {
+
+ my %options = (
+ ans_name => '',
+ ans_number => '',
+ @_
+ );
+
+ # my $name_of_correct_answer = shift;
+ # my $answer_rule_number = shift;
+
+ # return $name_of_correct_answer->cmp()->evaluate($inputs_ref->{ANS_NUM_TO_NAME($answer_rule_number)})->{score};
+
+ return $options{ans_name}->cmp()->evaluate($inputs_ref->{ ANS_NUM_TO_NAME($options{ans_number}) })->{score};
+
+}
+
+1;
+
diff --git a/macros/answers/Generic.pl b/macros/answers/Generic.pl
new file mode 100644
index 0000000000..6e52d12125
--- /dev/null
+++ b/macros/answers/Generic.pl
@@ -0,0 +1,187 @@
+#R. Byerly, Texas Tech University, 2005
+
+sub _Generic { } #Don't reload this file.
+
+#Documentation:
+
+=head1 Generic Answer Checker
+
+(Based on David Cervone's vector_cmp. See
+doc/parser/extensions/8-answer.pg under the webwork2 directory.)
+Place in macros directory and load this file (Generic.pl) using the
+loadMacros command. (To just copy it into a pg file, replace
+occurences of "\&" by "~~&".)
+
+ Usage:
+
+ ANS( generic_cmp(, ) );
+where is a parser object or syntactically correct string
+for a parser object.
+
+Mandatory arguments:
+
+ type =>
+where is a recognized parser type (e.g., Number, Point, Vector,
+Matrix, etc.)
+
+ checker =>
+where is a reference to a subroutine that will be passed (in
+order) the parsed (and, if possible, evaluated) student answer, the
+parsed professor's answer, and a reference to the answer hash. (The
+last is so that it can return error messages if desired.) In simple
+evaluators, the last two are typically not used.
+
+Optional arguments:
+
+ correct_ans =>
+where is a string that will show up as the correct
+answer when solutions are available.
+
+ variables_allowed => 0 or 1
+(default 0 (false). Determines whether student's answer is allowed to
+contain variables. In this case the checker must take care of
+evaluating it.)
+
+ length => n
+where n is the number of elements in an expected answer of type list,
+vector, or points. Returns error message to student if answer of wrong
+length is entered.
+
+
+####################Example:##########################
+DOCUMENT(); # This should be the first executable line in the problem.
+
+loadMacros(
+"PG.pl",
+"PGbasicmacros.pl",
+"PGanswermacros.pl",
+"Parser.pl",
+"Generic.pl",
+);
+
+TEXT(&beginproblem);
+
+Context("Vector");
+$A=Vector(1,2,1);
+$B=Vector(1,3,1);
+$C=Vector(1,4,1);
+
+BEGIN_TEXT
+Show that the vectors \(\{$A->TeX\}, \{$B->TeX\}, \{$C->TeX\}\) do
+not span \(R^3\) by giving a vector not in their span:
+\{ans_rule()\}
+END_TEXT
+
+#Easy to get by guessing!
+
+sub check{
+ my $stu=shift();
+ $x1=$stu->extract(1); $x3=$stu->extract(3);
+ $x1 != $x3; #any vectors with different 1st and 3rd coordinates
+}
+
+ANS(generic_cmp("23",type => 'Vector', length => 3, checker => ~~&check));
+
+ENDDOCUMENT(); # This should be the last executable line in the problem.
+
+####################End of Example########################
+
+=cut
+
+#End of Documentation
+
+#From parserUtils.pl:
+sub protectHTML {
+ my $string = shift;
+ $string =~ s/&/\&/g;
+ $string =~ s//\>/g;
+ $string;
+
+}
+
+sub generic_cmp {
+ my $v = shift;
+ my %opts = @_;
+ die "generic_cmp requires an argument as answer" unless defined $v;
+ die "generic_cmp requires a checker" unless defined $opts{'checker'};
+ die "generic_cmp requires a type" unless defined $opts{'type'};
+ $v = Formula($v);
+
+ $opts{'correct_ans'} = $v->string if (!defined($opts{'correct_ans'}));
+ $opts{'variables_allowed'} = 0 if (!defined($opts{'variables_allowed'}));
+ $opts{ $opts{'type'} } = $v;
+
+ my $ans = new AnswerEvaluator;
+
+ $ans->ans_hash((%opts));
+ # $ans->install_evaluator(~~&generic_cmp_check);
+ $ans->install_evaluator(\&generic_cmp_check);
+ return $ans;
+}
+
+sub generic_cmp_check {
+ my $ans = shift;
+ my $type = $ans->{type};
+ my $v = $ans->{$type};
+ $ans->score(0); # assume failure
+ my $f = Parser::Formula($ans->{student_ans});
+ my @vars = (keys(%{ $f->{variables} }));
+ if (@vars == 0) {
+ $V = Parser::Evaluate($f);
+ } elsif ($ans->{variables_allowed}) {
+ $V = $f; #if there are variables in the students answer, let the checker have it.
+ } else {
+ $ans->{ans_message} = $ans->{error_message} =
+ "Your answer contains variables " . join(",", @vars);
+ return $ans;
+ }
+ if (defined $V) {
+ $V = Formula($V) unless Value::isValue($V); # make sure we can call Value methods
+ $ans->{preview_latex_string} = $V->TeX;
+ $ans->{preview_text_string} = $V->string;
+ $ans->{student_ans} = $V->string;
+ #Some checks:
+ if (($type eq 'List') && !($V->type eq 'List')) {
+ $V = List($V); #promote single element to list
+ }
+
+ if (defined $ans->{length}) {
+ if ($ans->{length} != $V->length) {
+ $ans->{ans_message} = $ans->{error_message} = "Wrong number of entries in answer";
+ return $ans;
+ }
+ }
+
+ if (($V->type eq $type)) {
+ $ans->score(1) if ($ans->{checker}->($V, $v, $ans));
+
+ } else {
+ $ans->{ans_message} = $ans->{error_message} =
+ "Your answer doesn't seem to be a $type (it looks like " . Value::showClass($V) . ")"
+ unless $inputs_ref->{previewAnswers};
+ }
+ } else {
+ #
+ # Student answer evaluation failed.
+ # Report the error, with formatting, if possible.
+ #
+ my $context = Context();
+ my $message = $context->{error}{message};
+ if ($context->{error}{pos}) {
+ my $string = $context->{error}{string};
+ my ($s, $e) = @{ $context->{error}{pos} };
+ $message =~ s/; see.*//; # remove the position from the message
+ $ans->{student_ans} =
+ protectHTML(substr($string, 0, $s))
+ . ''
+ . protectHTML(substr($string, $s, $e - $s))
+ . ' '
+ . protectHTML(substr($string, $e));
+ }
+ $ans->{ans_message} = $ans->{error_message} = $message;
+ }
+ return $ans;
+}
+
+1;
diff --git a/macros/PGasu.pl b/macros/answers/PGasu.pl
similarity index 99%
rename from macros/PGasu.pl
rename to macros/answers/PGasu.pl
index 6f23dafa50..2862621106 100644
--- a/macros/PGasu.pl
+++ b/macros/answers/PGasu.pl
@@ -17,7 +17,7 @@ =head3 auto_right()
=pod
- Usage: ANS(auto_right());
+ Usage: ANS(auto_right());
or
ANS(auto_right("this answer can be left blank"));
@@ -90,7 +90,7 @@ =head3 must_include()
=pod
Wrapper for other answer evaluators. It insists that a string is part of
-the answer to be marked right.
+the answer to be marked right.
=cut
@@ -116,8 +116,8 @@ =head3 no_trig_fun()
This is useful if you want students to report the value of sin(pi/4),
but you don't want to allow "sin(pi/4)" as the answer.
-A similar effect can be accomplished with Contexts() by undefining
-the trig functions.
+A similar effect can be accomplished with Contexts() by undefining
+the trig functions.
See http://webwork.maa.org/wiki/Modifying_contexts_%28advanced%29#.282.29_Functions
@@ -200,7 +200,7 @@ =head3 must_have_filter()
string in it. This can be used to screen answers where you want them
in a particular form (e.g., if you allow most functions, but not trig
functions in the answer, or if the answer must include some string).
-
+
First argument is the string to have, or not have
Second argument is optional, and tells us whether yes or no
Third argument is the error message to produce (if any).
@@ -208,8 +208,8 @@ =head3 must_have_filter()
When using this filter directly, you also need to install catch_errors_filter
as a post filter.
-A similar effect can be accomplished with Contexts() by undefining
-the trig functions.
+A similar effect can be accomplished with Contexts() by undefining
+the trig functions.
See http://webwork.maa.org/wiki/Modifying_contexts_%28advanced%29
=cut
diff --git a/macros/PGfunctionevaluators.pl b/macros/answers/PGfunctionevaluators.pl
similarity index 100%
rename from macros/PGfunctionevaluators.pl
rename to macros/answers/PGfunctionevaluators.pl
diff --git a/macros/PGmiscevaluators.pl b/macros/answers/PGmiscevaluators.pl
similarity index 100%
rename from macros/PGmiscevaluators.pl
rename to macros/answers/PGmiscevaluators.pl
diff --git a/macros/PGstringevaluators.pl b/macros/answers/PGstringevaluators.pl
similarity index 100%
rename from macros/PGstringevaluators.pl
rename to macros/answers/PGstringevaluators.pl
diff --git a/macros/PGtextevaluators.pl b/macros/answers/PGtextevaluators.pl
similarity index 100%
rename from macros/PGtextevaluators.pl
rename to macros/answers/PGtextevaluators.pl
diff --git a/macros/answerComposition.pl b/macros/answers/answerComposition.pl
similarity index 100%
rename from macros/answerComposition.pl
rename to macros/answers/answerComposition.pl
diff --git a/macros/answerCustom.pl b/macros/answers/answerCustom.pl
similarity index 100%
rename from macros/answerCustom.pl
rename to macros/answers/answerCustom.pl
diff --git a/macros/answerDiscussion.pl b/macros/answers/answerDiscussion.pl
similarity index 100%
rename from macros/answerDiscussion.pl
rename to macros/answers/answerDiscussion.pl
diff --git a/macros/answerHints.pl b/macros/answers/answerHints.pl
similarity index 100%
rename from macros/answerHints.pl
rename to macros/answers/answerHints.pl
diff --git a/macros/answers/answerUtils.pl b/macros/answers/answerUtils.pl
new file mode 100644
index 0000000000..4d77ccc1e5
--- /dev/null
+++ b/macros/answers/answerUtils.pl
@@ -0,0 +1,105 @@
+##########################################################################
+#
+# Utility routines for answer checkers
+#
+#########################################################################
+
+sub _answerUtils_init { }; # don't load again
+
+loadMacros("unionUtils.pl");
+
+#
+# Evaluate an answer checker with a given student answer.
+# (works with old- and new-style answer checkers)
+#
+sub evaluateAnswer {
+ my ($ans_evaluator, $student_answer, $skipblanks) = @_;
+ return if (!$ans_evaluator);
+ return if ($skipblanks && trimString($student_answer) eq '');
+ clearEvaluator($ans_evaluator);
+ if (ref($ans_evaluator) eq 'AnswerEvaluator') {
+ $ans_evaluator->{rh_ans}{ans_label} = "" unless defined($ans_evaluator->{rh_ans}{ans_label});
+ return ($ans_evaluator->evaluate($student_answer));
+ } elsif (ref($ans_evaluator) eq 'CODE') {
+ return (&$ans_evaluator($student_answer));
+ } else {
+ warn "There is a problem using the answer evaluator";
+ }
+}
+
+#
+# Call an answer evaluator (works for new- and old-style checkers)
+#
+sub isCorrectAnswer {
+ my $cmp = shift;
+ my $correct = $cmp->{rh_ans}->{correct_ans};
+ my $hash = evaluateAnswer($cmp, @_, 1);
+ $cmp->{rh_ans}->{correct_ans} = $correct;
+ return (0) unless defined($hash);
+ return ($hash->{score} == 1);
+}
+
+#
+# Clear the error condition for an answer evaluator
+#
+sub clearEvaluator {
+ my $hash = hashFor(shift);
+ return (0) unless defined($hash);
+ $hash->setKeys(
+ ans_message => '',
+ preview_text_string => '',
+ preview_latex_string => '',
+ original_student_ans => '',
+ student_ans => '',
+ );
+ $hash->score(0);
+}
+
+#
+# Get the answer hash for a given evaluator
+#
+sub hashFor {
+ my ($ans_evaluator) = @_;
+ if (ref($ans_evaluator) eq 'AnswerEvaluator') { return $ans_evaluator->rh_ans }
+ elsif (ref($ans_evaluator) eq 'CODE') { return $ans_evaluator }
+ else { warn "There is a problem using the answer evaluator" }
+}
+
+#
+# Make error messages returned by answer checkers prettier
+#
+sub IndentError {
+ my $error = trimString(shift);
+ my $n = shift;
+ $n = 4 unless defined($n);
+ my $indent = '';
+ $indent .= ' ' while ($n--);
+ $error =~ s/ (There is a syntax error)/\n$1/g;
+ $error =~ s/ Your/\nYour/g;
+ $error =~ s/\n */\n$indent/g;
+ return $indent . $error;
+}
+
+#
+# Return the string or a blank string (if it was not defined)
+#
+sub StringOrBlank {
+ my $s = shift;
+ my $default = shift;
+ $default = '' unless defined($default);
+ $s = $default unless defined($s);
+ return $s;
+}
+
+#
+# Check for preview mode
+#
+sub isPreviewMode {
+ # for WW1
+ return ($inputs_ref->{action} =~ m/^Preview/)
+ if (defined($inputs_ref) && defined($inputs_ref->{action}));
+ # for WW2
+ return defined($inputs_ref) && defined($inputs_ref->{previewAnswers});
+}
+
+1;
diff --git a/macros/answerVariableList.pl b/macros/answers/answerVariableList.pl
similarity index 100%
rename from macros/answerVariableList.pl
rename to macros/answers/answerVariableList.pl
diff --git a/macros/extraAnswerEvaluators.pl b/macros/answers/extraAnswerEvaluators.pl
similarity index 100%
rename from macros/extraAnswerEvaluators.pl
rename to macros/answers/extraAnswerEvaluators.pl
diff --git a/macros/problemPreserveAnswers.pl b/macros/answers/problemPreserveAnswers.pl
similarity index 100%
rename from macros/problemPreserveAnswers.pl
rename to macros/answers/problemPreserveAnswers.pl
diff --git a/macros/answers/unorderedAnswer.pl b/macros/answers/unorderedAnswer.pl
new file mode 100644
index 0000000000..deb3ec645c
--- /dev/null
+++ b/macros/answers/unorderedAnswer.pl
@@ -0,0 +1,170 @@
+##########################################################################
+##########################################################################
+##
+## Routines for groups of answer blanks where the user can enter
+## answers in any order in the blanks.
+##
+
+loadMacros("answerUtils.pl");
+
+sub _unorderedAnswer_init { }; # don't reload this file
+
+##########################################################################
+#
+# Collect a group of answer checkers for use with answers that can be given
+# in any order. If N answer checkers are given, then the last N answer
+# rules will be used. It is beter to use named rules and UNORDERED_NAMED_ANS
+# below. Otherwise, be sure to use UNORDERED_ANS right after the answer
+# rules for the answers you want to compare.
+#
+# Format:
+#
+# UNORDERED_ANS(checker1, checker2, ...);
+#
+# Example:
+#
+# BEGIN_TEXT
+# The function \(f(x) = \frac{1}{x^2-$a}\) is defined except
+# for \(x =\) \{ans_rule(10)\} and \(x =\) \{ans_rule(10)\}.
+# END_TEXT
+#
+# UNORDERED_ANS(std_num_cmp(sqrt($a)), std_num_cmp(-sqrt($a)));
+#
+# (the student can enter the solutions in either order.)
+#
+sub UNORDERED_ANS {
+ my @cmp = @_;
+ my @params = ();
+ my $i;
+ my $n = scalar(@cmp);
+ #
+ # The best thing would be to use the size of @PG_ANSWERS in place of
+ # $main::ans_rule_count, but we don't have access to that
+ #
+ foreach $i (1 .. $n) { push(@params, ANS_NUM_TO_NAME($i + main::ans_rule_count() - $n), $cmp[ $i - 1 ]) }
+ my @results = unordered_answer_list(@params);
+ while (scalar(@results) > 0) { shift(@results), ANS(shift(@results)) }
+}
+
+##########################################################################
+#
+# Collect a group of answer checkers for use with named answers that
+# can be given in any order.
+#
+# Format:
+#
+# UNORDERED_NAMED_ANS(name1 => checker1, name2 => checker2, ...);
+#
+# Example:
+#
+# BEGIN_TEXT
+# The function \(f(x) = \frac{1}{x^2-$a}\) is defined except
+# for \(x =\) \{NAMED_ANS_RULE(A1,10)\}
+# and \(x =\) \{NAMED_ANS_RULE(A2,10)\}.
+# END_TEXT
+#
+# UNORDERED_NAMED_ANS(
+# A1 => std_num_cmp(sqrt($a)),
+# A2 => std_num_cmp(-sqrt($a))
+# );
+#
+# (the student can enter the solutions in either blank.)
+#
+sub UNORDERED_NAMED_ANS {
+ NAMED_ANS(unordered_answer_list(@_));
+}
+
+##########################################################################
+#
+# Low-level routine for handling unordered collections of answer checkers
+#
+sub unordered_answer_list {
+ my %params = @_;
+ my @args = @_;
+ my (@cmp, @ids);
+ while (scalar(@_) > 0) { push(@ids, shift); push(@cmp, shift) }
+ #
+ # Setup
+ #
+ my ($i, $j, $k);
+ my $n = scalar(@cmp);
+ my @cmpi = (0 .. $n - 1);
+ my @skipped = ();
+ #
+ # Check that the answers exist (otherwise it's our first time through)
+ #
+ foreach $i (@ids) { return (@args) if (!defined($inputs_ref->{$i})) }
+ #
+ # Check each answer against the available answer checkers.
+ # Keep track of the ones that match and that don't.
+ #
+ANSWER: foreach $i (0 .. $n - 1) {
+ $k = 0;
+ foreach $j (@cmpi) {
+ if (isCorrectAnswer($cmp[$j], $inputs_ref->{ $ids[$i] })) {
+ $ans[$i] = $j;
+ splice(@cmpi, $k, 1);
+ next ANSWER;
+ }
+ $k++;
+ }
+ push(@skipped, $i);
+ }
+ #
+ # Check if the unmatched checkers are all blank checkers.
+ # If so, let them report blanks as correct answers.
+ #
+ my $blankOK = 1;
+ foreach $i (@cmpi) {
+ if (ref($cmp[$i]) ne "AnswerEvaluator" || ($cmp[$i]->rh_ans)->{type} ne "blank") { $blankOK = 0; last }
+ }
+ if ($blankOK) {
+ foreach $i (@cmpi) { ($cmp[$i]->rh_ans)->{blankOK} = 1 }
+ }
+ #
+ # Assign the unmatching answers to umatched checkers
+ #
+ foreach $i (0 .. scalar(@skipped) - 1) { $ans[ $skipped[$i] ] = $cmpi[$i] }
+ #
+ # Make the final list of answer checkers in their proper order
+ #
+ my (@list) = ();
+ foreach $i (0 .. $n - 1) { clearEvaluator($cmp[ $ans[$i] ]); push(@list, $ids[$i], $cmp[ $ans[$i] ]) }
+ return (@list);
+}
+
+##################################################
+#
+# AnswerChecker that allows a blank answer in a collection of unordered
+# answer checkers. It will return "correct" for a blank answer only if
+# all the other answers are correct. (The blankOK value is set by
+# unordered_answer_list when this is true.) This lets you ask a question
+# where the number of answers is not known (by the student) ahead of time.
+#
+sub blank_cmp {
+ my %params = @_;
+ $params{debug} = 0 unless defined($params{debug});
+ my $answerEvaluator = new AnswerEvaluator;
+ $answerEvaluator->{debug} = $params{debug};
+ $answerEvaluator->ans_hash(
+ type => "blank",
+ blankOK => 0,
+ correct_ans => '',
+ weight => 0
+ );
+ $answerEvaluator->install_pre_filter('reset'); # remove the blank filter
+ $answerEvaluator->install_evaluator(\&blank_cmp_check, %params);
+ $answerEvaluator->install_post_filter('reset'); # remove the blank filter
+ return $answerEvaluator;
+}
+
+sub blank_cmp_check {
+ my $ans = shift;
+ my %params = @_;
+ $ans->{student_ans} = trimString($ans->{student_ans});
+ if ($ans->{student_ans} eq "") { $ans->score($ans->{blankOK}) }
+ else { $ans->score(0) }
+ return ($ans);
+}
+
+1;
diff --git a/macros/PG_CAPAmacros.pl b/macros/capa/PG_CAPAmacros.pl
similarity index 100%
rename from macros/PG_CAPAmacros.pl
rename to macros/capa/PG_CAPAmacros.pl
diff --git a/macros/StdConst.pg b/macros/capa/StdConst.pg
similarity index 100%
rename from macros/StdConst.pg
rename to macros/capa/StdConst.pg
diff --git a/macros/StdUnits.pg b/macros/capa/StdUnits.pg
similarity index 100%
rename from macros/StdUnits.pg
rename to macros/capa/StdUnits.pg
diff --git a/macros/contextABCD.pl b/macros/contexts/contextABCD.pl
similarity index 100%
rename from macros/contextABCD.pl
rename to macros/contexts/contextABCD.pl
diff --git a/macros/contextAlternateDecimal.pl b/macros/contexts/contextAlternateDecimal.pl
similarity index 100%
rename from macros/contextAlternateDecimal.pl
rename to macros/contexts/contextAlternateDecimal.pl
diff --git a/macros/contextAlternateIntervals.pl b/macros/contexts/contextAlternateIntervals.pl
similarity index 100%
rename from macros/contextAlternateIntervals.pl
rename to macros/contexts/contextAlternateIntervals.pl
diff --git a/macros/contextArbitraryString.pl b/macros/contexts/contextArbitraryString.pl
similarity index 100%
rename from macros/contextArbitraryString.pl
rename to macros/contexts/contextArbitraryString.pl
diff --git a/macros/contextComplexExtras.pl b/macros/contexts/contextComplexExtras.pl
similarity index 100%
rename from macros/contextComplexExtras.pl
rename to macros/contexts/contextComplexExtras.pl
diff --git a/macros/contextComplexJ.pl b/macros/contexts/contextComplexJ.pl
similarity index 100%
rename from macros/contextComplexJ.pl
rename to macros/contexts/contextComplexJ.pl
diff --git a/macros/contextCongruence.pl b/macros/contexts/contextCongruence.pl
similarity index 100%
rename from macros/contextCongruence.pl
rename to macros/contexts/contextCongruence.pl
diff --git a/macros/contextCurrency.pl b/macros/contexts/contextCurrency.pl
similarity index 100%
rename from macros/contextCurrency.pl
rename to macros/contexts/contextCurrency.pl
diff --git a/macros/contexts/contextFiniteSolutionSets.pl b/macros/contexts/contextFiniteSolutionSets.pl
new file mode 100644
index 0000000000..388c5ad10e
--- /dev/null
+++ b/macros/contexts/contextFiniteSolutionSets.pl
@@ -0,0 +1,338 @@
+################################################################################
+# WeBWorK Online Homework Delivery System
+# Copyright © 2000-2018 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
+
+contextFiniteSolutionSets.pl - Allows several common input forms for a finite
+solution set.
+
+After setting the context to "FiniteSolutionSets", make an answer like:
+Formula("1,2")
+Formula("1/2,2/3,3/4")
+Formula("sqrt(2),(1+sqrt(2))/3, -(sqrt(2)+3sqrt(5))/6")
+List(Formula("1"))
+
+Note that if it is a singleton, the structure is different.
+
+Then students can enter the answer in any number of ways. Like:
+1,2
+x=1,2
+x=1,x=2
+x=1 or 2
+x=1 or x=2
+{1,2}
+
+The "x" should be the only context variable, and it should be what the student
+needed to solve for.
+
+If the answer is not submitted like {1,2}, and if the flag preferSetNotation is
+set to 1 (which is the default) then there is a message that this is the
+preferred form (but the student still gets credit).
+
+Answers like 2/3 and (1+sqrt(2))/3 need to be in that form, so the problem
+author needs to be careful to not do things like Formula("1/2,$a/$b,3/4")
+where $a and $b have a nontrivial common divisor.
+
+No decimals are allowed.
+
+=head1 DESCRIPTION
+
+=cut
+
+loadMacros(
+ "MathObjects.pl", "bizarroArithmetic.pl", "parserAssignment.pl", "contextFraction.pl",
+ "parserRoot.pl", "PGinfo.pl",
+);
+
+sub _contextFiniteSolutionSets_init {
+ my $context = $main::context{FiniteSolutionSets} = Parser::Context->getCopy("Interval");
+ $context->{name} = "FiniteSolutionSets";
+ Parser::Number::NoDecimals($context);
+ parser::Assignment->Allow($context);
+ $context->flags->set(
+ reduceConstants => 0,
+ reduceConstantFunctions => 0,
+ formatStudentAnswer => "parsed",
+ checkSqrt => 0,
+ checkRoot => 0,
+ useBizarro => 1,
+ setSqrt => exp(1) / main::ln(2),
+ setRoot => exp(2) / main::ln(3),
+ wrongFormMessage => 'Your answer is numerically correct, but not in the expected form',
+ preferSetNotation => 1,
+ #tolerance => 0.00001,
+ );
+ $context->noreduce('(-x)+y', '(-x)-y');
+ $context->operators->set(
+ '+' => { class => 'bizarro::BOP::add', isCommand => 1 }, # override +
+ '-' => { class => 'bizarro::BOP::subtract', isCommand => 1 }, # override -
+ ' ' => { class => 'bizarro::BOP::multiply', isCommand => 1 }, # override *
+ '*' => { class => 'bizarro::BOP::multiply', isCommand => 1 }, # override *
+ '* ' => { class => 'bizarro::BOP::multiply', isCommand => 1 }, # override *
+ ' *' => { class => 'bizarro::BOP::multiply', isCommand => 1 }, # override *
+ '/' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ '/ ' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ ' /' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ '//' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ );
+ $context->operators->undefine('^', '**');
+ $context->parens->undefine('|');
+ $context->operators->redefine('or', using => ',', from => 'Numeric');
+ $context->operators->redefine(',or', using => ',', from => 'Numeric');
+ $context->operators->redefine(', or', using => ',', from => 'Numeric');
+ $context->operators->redefine('and', using => ',', from => 'Numeric');
+ $context->operators->redefine(',and', using => ',', from => 'Numeric');
+ $context->operators->redefine(', and', using => ',', from => 'Numeric');
+ $context->strings->add(
+ "no real solutions" => {},
+ "no real solution" => { alias => 'no real solutions' },
+ "none" => { alias => 'no real solutions' },
+ "no solution" => { alias => 'no real solutions' },
+ "no solutions" => { alias => 'no real solutions' },
+ #Hack. Investigate making all of this be a constant.
+ "{}" => { alias => 'no real solutions' },
+ "{ }" => { alias => 'no real solutions' },
+ "{ }" => { alias => 'no real solutions' },
+ "{ }" => { alias => 'no real solutions' },
+ "infinitely many solutions" => {},
+ "infinitely many" => { alias => 'infinitely many solutions' },
+ "infinite solutions" => { alias => 'infinitely many solutions' },
+ "infinite" => { alias => 'infinitely many solutions' },
+ );
+ $context->functions->set(sqrt => { class => 'finiteSolutionSets::Function::numeric' }); # override sqrt()
+ $context->functions->add(identity => { class => 'finiteSolutionSets::Function::numeric' });
+ parser::Root->Enable($context);
+ $context->functions->set(root => { class => 'finiteSolutionSets::Function::numeric2' }); # override root()
+ $context->lists->set(List => { open => "{", close => "}" });
+ $context->{cmpDefaults}{Formula}{checker} = sub {
+ my ($correct, $student, $ans) = @_;
+ return 0 if $ans->{isPreview} || $correct != $student;
+ if ($student->class eq 'String') { return 1 if $correct == $student }
+ $student = $ans->{student_formula};
+ $student = Formula("identity($student)"); #ensure student is parsed as Formula object
+ my $setSqrt = Context()->flag("setSqrt");
+ my $setRoot = Context()->flag("setRoot");
+ my $useBizarro = (Context()->flag("useBizarro")) ? 1 : 0;
+ Context()->flags->set(
+ checkSqrt => $setSqrt,
+ checkRoot => $setRoot,
+ bizarroAdd => $useBizarro,
+ bizarroSub => $useBizarro,
+ bizarroMul => $useBizarro,
+ bizarroDiv => $useBizarro
+ );
+ delete $correct->{test_points};
+ delete $student->{test_points};
+ delete $correct->{test_values};
+ delete $student->{test_values};
+ my $OK = ($correct == $student);
+ Context()->flags->set(
+ checkSqrt => 0,
+ checkRoot => 0,
+ bizarroAdd => 0,
+ bizarroSub => 0,
+ bizarroMul => 0,
+ bizarroDiv => 0
+ );
+ Value::Error(Context()->flag('wrongFormMessage')) unless $OK;
+ return $OK;
+ };
+ $context->{cmpDefaults}{Formula}{requireParenMatch} = 0;
+ $context->{cmpDefaults}{Formula}{list_checker} = sub {
+ my ($correct, $student, $ansHash, $value) = @_;
+ my $score = 0; # number of correct student answers
+ my @errors = (); # stores error messages
+ my ($i, $j, $k); # loop counters
+ my $studentFormula = $ansHash->{student_formula};
+
+ # Student answer needs to be a set, list, a single number, or a single assignment
+ my $studentTypeOK = 0;
+ if ($studentFormula->type eq 'Set') { $studentTypeOK = 1 }
+ if ($studentFormula->type eq 'List') { $studentTypeOK = 1 }
+ if ($studentFormula->type eq 'Assignment') { $studentTypeOK = 1 }
+ if ($studentFormula->class eq 'Formula' and $studentFormula->type eq 'Number') {
+ if ($studentFormula->isConstant) { $studentTypeOK = 1 }
+ }
+ if ($studentFormula->type eq 'String') { return (0) }
+
+ push(@errors, 'Your answer is not a list of numbers or assignments') unless $studentTypeOK;
+ return (0, @errors) unless $studentTypeOK;
+
+ # Array of the student answers
+ my @studentanswers;
+ if ($studentFormula->type eq 'Assignment') { @studentanswers = ($studentFormula) }
+ if ($studentFormula->class eq 'Formula' and $studentFormula->type eq 'Number') {
+ @studentanswers = ($studentFormula);
+ }
+ if ($studentFormula->type eq 'List') { @studentanswers = $studentFormula->value }
+ if ($studentFormula->type eq 'Set') { @studentanswers = $studentFormula->value }
+ my $n = scalar(@studentanswers); # number of student answers
+
+ # Array of the correct answers
+ my @correctanswers = $ansHash->{correct_value}->value;
+ my $m = scalar(@correctanswers); # number of correct answers
+
+ #
+ # Loop though the student answers
+ ##
+ for ($i = 0; $i < $n; $i++) {
+ my $ith = ($n == 1) ? '' : Value::List->NameForNumber($i + 1);
+ my $p = $studentanswers[$i]; # i-th student answer
+ #
+ # Check that the student's answer is a number or assignment
+ #
+ if ($p->class ne "Formula" or $p->type ne "Number" and $p->type ne "Assignment") {
+ push(@errors, "Your $ith answer is not a number or assignment");
+ $score--;
+ next;
+ }
+ if ($p->class eq "Formula" and $p->type eq "Number") {
+ if (not($p->isConstant)) {
+ push(@errors, "Your $ith answer is not a number or assignment");
+ $score--;
+ next;
+ }
+ }
+ #
+ # For assignments, grab number
+ #
+ my $q = ($p->type eq "Assignment") ? Formula((split('=', $p))[1]) : $p;
+ #
+ # Check that the number isn't an unreduced fraction
+ #
+ $mycontext = Context();
+ Context("Fraction");
+ Context()->flags->set(reduceFractions => 0);
+ my $qfrac = Compute("$q");
+ if ($qfrac->class eq 'Fraction') {
+ do { push(@errors, $q->string . " is not a reduced fraction"); $score--; next; }
+ unless $qfrac->isReduced;
+ do { push(@errors, $q->string . " can be simplified"); $score--; next; }
+ unless (($qfrac->value)[1] != 1);
+ }
+ Context($mycontext);
+ #
+ # Check that the number hasn't been given before
+ #
+ for ($j = 0, $used = 0; $j < $i; $j++) {
+ my $r = $studentanswers[$j];
+ if ($r->class eq "Formula" and $r->type eq "Number" and $r == $q) {
+ push(@errors, "Your $ith answer is the same as a previous one") unless $ansHash->{isPreview};
+ $used = 1;
+ $score--;
+ last;
+ }
+ if ($r->type eq "Assignment") {
+ $r = Formula((split('=', $r))[1]);
+ if ($r == $q) {
+ push(@errors, "Your $ith answer is the same as a previous one")
+ unless $ansHash->{isPreview};
+ $used = 1;
+ $score--;
+ last;
+ }
+ }
+ }
+ #
+ # If not already used, compare to each of the correct answers
+ # and increase the score if there is a match. If there is no
+ # match, take note if the failure is because of form
+ #
+ if (!$used) {
+ my $qcmp;
+ for ($k = 0, $match = 0, $badform = 0; $k < $m; $k++) {
+ my $s = $correctanswers[$k];
+ $qcmp = $s->cmp->evaluate($q->string);
+ if ($qcmp->{score}) { $match = 1; last; }
+ if ($qcmp->{ans_message} eq Context()->flag('wrongFormMessage')) { $badform = 1; }
+ }
+ if ($match == 1) { $score++ }
+ else {
+ $score--;
+ do {
+ if ($badform == 1) {
+ push(@errors, Context()->flag('wrongFormMessage') =~ s/Your answer/Your $ith answer/gr);
+ } elsif ($n != 1) {
+ push(@errors, "Your $ith answer is not correct");
+ }
+ } unless $ansHash->{isPreview};
+ }
+ }
+ }
+ #
+ # Check that there are the right number of answers
+ #
+ if (!$ansHash->{isPreview}) {
+ push(@errors, "You need to provide more numbers") if $n < $m and $score == $n;
+ push(@errors, "You have given too many answers") if $score > $m;
+ }
+ #
+ # Express a preference for formatting
+ #
+ if ($studentFormula->type ne 'Set' and $m == $score and Context()->flags->get('preferSetNotation') == 1) {
+ push(@errors,
+ "The preferred notation for the solution set is${BR}\\(\\left\\{"
+ . join(',', map { $_->TeX } (@correctanswers))
+ . "\\right\\}\\)");
+ }
+ return ($score, @errors);
+ };
+}
+
+###########################
+#
+# Subclass the numeric functions
+#
+package finiteSolutionSets::Function::numeric;
+our @ISA = ('Parser::Function::numeric');
+
+#
+# Override sqrt() to return a special value times x when evaluated
+#
+sub sqrt {
+ my $self = shift;
+ my $x = shift;
+ my $value = $self->context->flag("checkSqrt");
+ return $value + 1 if $value && $x == 1; # force sqrt(1) to be incorrect
+ return $value + 1 if $value && $x == $value; # force sqrt(sqrt(x)) to be incorrect
+ return $value + 1 if $value && $x == $self->context->flag("checkRoot"); # force sqrt(root(n,x))) to be incorrect
+ return $value * $x if $value;
+ return $self->SUPER::sqrt($x);
+}
+
+sub identity {
+ my $self = shift;
+ my $x = shift;
+ return $x;
+}
+
+package finiteSolutionSets::Function::numeric2;
+our @ISA = ('parser::Root::Function::numeric2');
+#
+# Override root(n,) to return a special value times x when evaluated
+#
+sub root {
+ my $self = shift;
+ my ($n, $x) = @_;
+ my $value = $self->context->flag("checkRoot");
+ return $value if $value && $x == 1; # force root(n,1) to be incorrect
+ return $value if $value && $n == 1; # force root(1,x) to be incorrect
+ return $value if $value && $x == $value; # force root(n,root(n,x)) to be incorrect
+ return $value if $value && $x == $self->context->flag("checkSqrt"); # force root(n,sqrt(x)) to be incorrect
+ return $value * $x if $value;
+ return $self->SUPER::root($n, $x);
+}
+
diff --git a/macros/contexts/contextForm.pl b/macros/contexts/contextForm.pl
new file mode 100644
index 0000000000..83a7fa5ef4
--- /dev/null
+++ b/macros/contexts/contextForm.pl
@@ -0,0 +1,150 @@
+################################################################################
+# WeBWorK Online Homework Delivery System
+# Copyright © 2000-2018 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
+
+This context distinguishes between "forms" of an expression by using bizarro
+arithmetic.
+
+For example, the answer could be "(x+1)(x+2)". Bizarro arithmetic always has
+commutative and associative addidition and multiplication, so it would be OK
+to anwer with "(2+x)(x+1)".
+
+But this context initally only uses bizarro with multiplication and division.
+So "x^2+3x+2" will not evaluate to the same as "(x+1)(x+2)".
+
+The reverse works as well: the answer could be "x^2+3x+2" and "(x+1)(x+2)"
+will not be accepted.
+
+In general if you have a problem where "form" matters, try this context. It
+may not always work for you out of the box. But even then you may be able to
+adjust the bizarro details to make it work.
+
+For example if you wanted to factor x^2+2x+1 and you declare "(x+1)^2" to be
+the answer, at first it will not accept "(x+1)(x+1)". Because bizarro exponents
+are not activated. But you could activate them (or deactivate bizarro multiplication
+and division while activating bizarro addition and subtraction) and then
+"(x+1)^2" and "(x+1)(x+1)" would be equivalent, yet distinct from "x^2+2x+1".
+
+
+=head1 DESCRIPTION
+
+=cut
+
+loadMacros("MathObjects.pl", "bizarroArithmetic.pl", "parserRoot.pl",);
+
+sub _contextForm_init {
+ my $context = $main::context{Form} = Parser::Context->getCopy("Numeric");
+ Parser::Number::NoDecimals($context);
+ $context->{name} = "Form";
+ $context->flags->set(
+ reduceConstants => 0,
+ reduceConstantFunctions => 0,
+ formatStudentAnswer => "parsed",
+ checkSqrt => 0,
+ checkRoot => 0,
+ setSqrt => exp(1) / main::ln(2),
+ setRoot => exp(2) / main::ln(3),
+ wrongFormMessage =>
+ 'Your answer is algebraically equivalent to the correct answer, but not in the expected form. Maybe it is not fully simplified. Maybe something is not completely factored or expanded. Maybe it is not in the expected form for some other reason.',
+
+ );
+ $context->noreduce('(-x)+y', '(-x)-y');
+ $context->operators->set(
+ '*' => { class => 'bizarro::BOP::multiply', isCommand => 1 }, # override *
+ '* ' => { class => 'bizarro::BOP::multiply', isCommand => 1 }, # override *
+ ' *' => { class => 'bizarro::BOP::multiply', isCommand => 1 }, # override *
+ '/' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ '/ ' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ ' /' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ );
+ $context->functions->set(sqrt => { class => 'form::Function::numeric' }); # override sqrt()
+ parser::Root->Enable($context);
+ $context->functions->set(root => { class => 'form::Function::numeric2' }); # override root()
+ $context->{cmpDefaults}{Formula}{checker} = sub {
+ my ($correct, $student, $ans) = @_;
+ return 0 if $ans->{isPreview} || $correct != $student;
+ $student = $ans->{student_formula};
+ my $setSqrt = Context()->flag("setSqrt");
+ my $setRoot = Context()->flag("setRoot");
+ Context()->flags->set(
+ checkSqrt => $setSqrt,
+ checkRoot => $setRoot,
+ bizarroAdd => 1,
+ bizarroSub => 1,
+ bizarroMul => 1,
+ bizarroDiv => 1
+ );
+ delete $correct->{test_values};
+ delete $student->{test_values};
+ my $OK = ($correct == $student);
+ Context()->flags->set(
+ checkSqrt => 0,
+ checkRoot => 0,
+ bizarroAdd => 0,
+ bizarroSub => 0,
+ bizarroMul => 0,
+ bizarroDiv => 0
+ );
+ Value::Error(Context()->flag('wrongFormMessage')) unless $OK;
+ return $OK;
+ };
+ $context->strings->add(
+ 'not a real number' => {},
+ 'not real' => { alias => 'not a real number' },
+ 'does not exist' => { alias => 'not a real number' },
+ "doesn't exist" => { alias => 'not a real number' },
+ );
+}
+
+###########################
+#
+# Subclass the numeric functions
+#
+package form::Function::numeric;
+our @ISA = ('Parser::Function::numeric');
+
+#
+# Override sqrt() to return a special value times x when evaluated
+#
+sub sqrt {
+ my $self = shift;
+ my $x = shift;
+ my $value = $self->context->flag("checkSqrt");
+ return $value + 1 if $value && $x == 1; # force sqrt(1) to be incorrect
+ return $value + 1 if $value && $x == $value; # force sqrt(sqrt(x)) to be incorrect
+ return $value + 1 if $value && $x == $self->context->flag("checkRoot"); # force sqrt(root(n,x))) to be incorrect
+ return $value * $x if $value;
+ return $self->SUPER::sqrt($x);
+}
+
+package form::Function::numeric2;
+our @ISA = ('parser::Root::Function::numeric2');
+#
+# Override root(n,) to return a special value times x when evaluated
+#
+sub root {
+ my $self = shift;
+ my ($n, $x) = @_;
+ my $value = $self->context->flag("checkRoot");
+ return $value if $value && $x == 1; # force root(n,1) to be incorrect
+ return $value if $value && $n == 1; # force root(1,x) to be incorrect
+ return $value if $value && $x == $value; # force root(n,root(n,x)) to be incorrect
+ return $value if $value && $x == $self->context->flag("checkSqrt"); # force root(n,sqrt(x)) to be incorrect
+ return $value * $x if $value;
+ return $self->SUPER::root($n, $x);
+}
+
diff --git a/macros/contextFraction.pl b/macros/contexts/contextFraction.pl
similarity index 100%
rename from macros/contextFraction.pl
rename to macros/contexts/contextFraction.pl
diff --git a/macros/contexts/contextFunctionAssign.pl b/macros/contexts/contextFunctionAssign.pl
new file mode 100644
index 0000000000..2ec50a1a42
--- /dev/null
+++ b/macros/contexts/contextFunctionAssign.pl
@@ -0,0 +1,21 @@
+######################################################################
+#Description: macro to load parserAssignment and change the error
+# message to be more specific for a function. Requires
+# answers be submitted in the form:
+# y=formula or f(x)=formula
+######################################################################
+loadMacros("parserAssignment.pl");
+
+sub parser::Assignment::Formula::cmp_equal {
+ my $self = shift;
+ my $ans = shift;
+ Value::cmp_equal($self, $ans);
+ if ($ans->{ans_message} =~ m/Your answer isn't.*it looks like/s) {
+ $ans->{ans_message} =
+ "Warning: Your answer should be of the form: '" . $self->{tree}{lop}->string . "= formula'";
+ }
+}
+
+######################################################################
+
+1;
diff --git a/macros/contextInequalities.pl b/macros/contexts/contextInequalities.pl
similarity index 100%
rename from macros/contextInequalities.pl
rename to macros/contexts/contextInequalities.pl
diff --git a/macros/contexts/contextInequalitiesAllowStrings.pl b/macros/contexts/contextInequalitiesAllowStrings.pl
new file mode 100644
index 0000000000..1291dc666e
--- /dev/null
+++ b/macros/contexts/contextInequalitiesAllowStrings.pl
@@ -0,0 +1,54 @@
+###
+
+=head1 NAME
+
+ extra macros for Intermediate Algebra problems at CofI
+
+=head1 Synposis
+ macros by R Cruz -- The College of Idaho
+=cut
+
+=head3 Allows string answers for the set of real numbers and the empty set
+
+=pod
+ Adds the string "All real numbers" to the Inequalities context
+ NOT WORKING: Adds the string "No solution" to the Inequalities context
+
+=cut
+
+loadMacros("contextInequalities.pl");
+
+sub _contextInequalitiesAllowStrings_init {
+ my $context = $main::context{"Inequalities-AllowStrings"} = Parser::Context->getCopy("Inequalities");
+
+ $context->constants->{namePattern} = qr/.*/;
+
+ #----Add variations of "All real numbers"
+
+ $context->constants->redefine("All real numbers", from => "Interval", using => "R");
+ $context->constants->set("All real numbers" => { TeX => "\\mbox{All real numbers}" });
+
+ $context->constants->redefine("all real numbers", from => "Interval", using => "R");
+ $context->constants->set("all real numbers" => { TeX => "\\mbox{all real numbers}" });
+
+ $context->constants->redefine("All Real numbers", from => "Interval", using => "R");
+ $context->constants->set("All Real numbers" => { TeX => "\\mbox{All Real numbers}" });
+
+ $context->constants->redefine("ALL REAL NUMBERS", from => "Interval", using => "R");
+ $context->constants->set("ALL REAL NUMBERS" => { TeX => "\\mbox{ALL REAL NUMBERS}" });
+
+ #-----Add variations of "No solution" = NONE
+ #************This part does not work. Can't get it to "take" the empty set
+ # Tried Set(), NONE and DNE
+ #
+ # $context->constants->redefine("No solution"",from=>"Interval",using=>"{}");
+ # $context->constants->set("No solution"=>{TeX=>"\\mbox{No solution}"});
+ #
+ # $context->constants->redefine("no solution"",from=>"Interval",using=>"{}");
+ # $context->constants->set("no solution"=>{TeX=>"\\mbox{no solution}"});
+ #
+ # $context->constants->redefine("NO SOLUTION"",from=>"Interval",using=>"{}");
+ # $context->constants->set("NO SOLUTION"=>{TeX=>"\\mbox{NO SOLUTION}"});
+
+}
+1;
diff --git a/macros/contextInequalitySetBuilder.pl b/macros/contexts/contextInequalitySetBuilder.pl
similarity index 100%
rename from macros/contextInequalitySetBuilder.pl
rename to macros/contexts/contextInequalitySetBuilder.pl
diff --git a/macros/contextInteger.pl b/macros/contexts/contextInteger.pl
similarity index 100%
rename from macros/contextInteger.pl
rename to macros/contexts/contextInteger.pl
diff --git a/macros/contextIntegerFunctions.pl b/macros/contexts/contextIntegerFunctions.pl
similarity index 100%
rename from macros/contextIntegerFunctions.pl
rename to macros/contexts/contextIntegerFunctions.pl
diff --git a/macros/contextLeadingZero.pl b/macros/contexts/contextLeadingZero.pl
similarity index 100%
rename from macros/contextLeadingZero.pl
rename to macros/contexts/contextLeadingZero.pl
diff --git a/macros/contextLimitedComplex.pl b/macros/contexts/contextLimitedComplex.pl
similarity index 100%
rename from macros/contextLimitedComplex.pl
rename to macros/contexts/contextLimitedComplex.pl
diff --git a/macros/contextLimitedFactor.pl b/macros/contexts/contextLimitedFactor.pl
similarity index 100%
rename from macros/contextLimitedFactor.pl
rename to macros/contexts/contextLimitedFactor.pl
diff --git a/macros/contextLimitedNumeric.pl b/macros/contexts/contextLimitedNumeric.pl
similarity index 100%
rename from macros/contextLimitedNumeric.pl
rename to macros/contexts/contextLimitedNumeric.pl
diff --git a/macros/contextLimitedPoint.pl b/macros/contexts/contextLimitedPoint.pl
similarity index 100%
rename from macros/contextLimitedPoint.pl
rename to macros/contexts/contextLimitedPoint.pl
diff --git a/macros/contextLimitedPolynomial.pl b/macros/contexts/contextLimitedPolynomial.pl
similarity index 100%
rename from macros/contextLimitedPolynomial.pl
rename to macros/contexts/contextLimitedPolynomial.pl
diff --git a/macros/contextLimitedPowers.pl b/macros/contexts/contextLimitedPowers.pl
similarity index 100%
rename from macros/contextLimitedPowers.pl
rename to macros/contexts/contextLimitedPowers.pl
diff --git a/macros/contextLimitedRadical.pl b/macros/contexts/contextLimitedRadical.pl
similarity index 100%
rename from macros/contextLimitedRadical.pl
rename to macros/contexts/contextLimitedRadical.pl
diff --git a/macros/contexts/contextLimitedRadicalComplex.pl b/macros/contexts/contextLimitedRadicalComplex.pl
new file mode 100644
index 0000000000..e648f52e1c
--- /dev/null
+++ b/macros/contexts/contextLimitedRadicalComplex.pl
@@ -0,0 +1,180 @@
+
+=head1 NAME
+contextLimitedRadical.pl - defines a root(n,x) function for n-th root of x, and
+allows for specification of forms of radical answers, like simplified radicals or
+with rational denominators
+
+=head1 DESCRIPTION
+
+This file enables a context LimitedRadical in which students and pg-authors may use
+root(n,x) for the nth root of x. The function makes sure n!=0, and also allows for
+negative x only if n is an odd integer.
+
+By default, the limits for Formula answer checking are [0,5] to avoid negatives in
+radicals. If it is important to distinguish sqrt(x^2) as |x| rather than x, then the
+limits should be changed to include a region where they differ.
+
+The context requires that radical expressions (using either sqrt() or root()) meet
+the form of the author's answer with respect to simplification and rationalization
+of denominators.
+
+To accomplish this, Math Objects like "root(3,2)" should be created as Formula("root(3,2)"),
+not Compute("root(3,2)"), or they will be treated as Reals and evaluated as decimals.
+Compute("root(3,x)") should be fine though, since it is unambiguously a Formula.
+
+Student answers are first compared to the correct answer in the usual way to see if
+they are at least numerically correct. Then to check that expressions are fully
+simplified, during a check, both sqrt(x) and root(n,x) are temporarily replaced by certain
+other functions. Also +, -, *, and / are temporarily replaced with bizarro arithmetic
+(from bizarroArithmetic.pl) that nearly make for a bizarro field structure on R.
+If the student and author answers disagree after this change, then the student's answer
+is not in form of the author's answer.
+
+For example "1+2" is not equivalent to "3" under bizarro addition. "2sqrt(2)" is not
+equivalent to "sqrt(8)" with the bizarro arithmetic. Any radical applied to 1 is declared
+unsimplified as well.
+
+If a student's answer is numerically equal to the author's, but not equal under bizarro
+arithmetic, students get the message that their answer is not fully simplified. So care
+should be taken by the problem author when defining answers.
+
+The near-field structure of the bizarro versions means that "1+sqrt(2)+sqrt(3)" can be
+entered as "sqrt(3)+sqrt(2)+1", etc, and not be declared "unsimplified". Also "(1+sqrt(2))/2"
+can be entered as "1/2+sqrt(2)/2" without being declared "unsimplified". However,
+"(1+2sqrt(2))/2" *will* be declared different from "1/2+sqrt(2)", even though both are
+generally considered fully simplified. If an author can foresee this arising, consider
+using parserOneOf.pl to allow for multiple forms of the correct answer.
+
+Technically both "sqrt(3)/3" and "1/sqrt(3)" are fully simplified, although you may want
+rational denominators. This context will declare them equal but not equivalent. The author
+should either accept both as correct using parserOneOf.pl, or give the message that the
+student's answer does not have a rational denominator using answerHints.pl.
+
+Note that there is nothing here that is actually doing any reducing of radical quantities
+or honestly checking for "simplified" answers - so authors need to make sure their answers
+are reduced and simplified. Also if the correct answer is "sqrt(2)" and the student
+enters "sqrt(3)+sqrt(3)" or "4sqrt(2)/2", they will just be told they are wrong, not that
+their (incorrect) answer is unsimplified.
+
+
+=cut
+
+loadMacros(
+ "contextLimitedPowers.pl",
+ "bizarroArithmetic.pl",
+
+);
+
+#
+# Set up the LimitedRadical context
+#
+sub _contextLimitedRadicalComplex_init {
+ my $context = $main::context{LimitedRadicalComplex} = Parser::Context->getCopy("Complex");
+ Parser::Number::NoDecimals($context);
+ $context->flags->set(setSqrt => exp(1) / ln(2), setRoot => exp(1) / ln(2));
+ $context->operators->set(
+ '+' => { class => 'bizarro::BOP::add', isCommand => 1 }, # override +
+ '-' => { class => 'bizarro::BOP::subtract', isCommand => 1 }, # override -
+ '*' => { class => 'bizarro::BOP::multiply', isCommand => 1 }, # override *
+ '* ' => { class => 'bizarro::BOP::multiply', isCommand => 1 }, # override *
+ ' *' => { class => 'bizarro::BOP::multiply', isCommand => 1 }, # override *
+ '/' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ '/ ' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ ' /' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ '//' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ );
+ $context->functions->set(sqrt => { class => 'my::Function::numeric' }); # override sqrt()
+ main::PG_restricted_eval('sub root {Parser::Function->call("root",@_)}');
+ $context->functions->add(root => { class => 'my::Function::numeric2' },);
+ $context->flags->set(limits => [ 0, 5 ]); # no negatives in the radicals
+ $context->flags->set(
+ reduceConstantFunctions => 0,
+ reduceConstants => 0,
+ formatStudentAnswer => 'parsed',
+ checkSqrt => 0,
+ checkRoot => 0
+ );
+ LimitedPowers::OnlyPositiveIntegers($context); # don't allow powers of 1/2, 1/3, etc
+ $context->{cmpDefaults}{Formula}{checker} = sub {
+ my ($correct, $student, $ans) = @_;
+ return 0 if $ans->{isPreview} || $correct != $student;
+ $student = $ans->{student_formula};
+ $correct = $correct->{original_formula} if defined $correct->{original_formula};
+ $student = Formula("$student");
+ $correct = Formula("$correct"); #ensure both are Formula objects
+ my ($setSqrt, $setRoot) = (Context()->flag("setSqrt"), Context()->flag("setRoot"));
+ Context()->flags->set(
+ checkSqrt => $setSqrt,
+ checkRoot => $setRoot,
+ bizarroAdd => 1,
+ bizarroSub => 1,
+ bizarroMul => 1,
+ bizarroDiv => 1
+ );
+ delete $correct->{test_values};
+ delete $student->{test_values};
+ my $OK = (($correct == $student) or ($student == $correct)); # check if equal when sqrt's are replaced by 1
+ Context()->flags->set(
+ checkSqrt => 0,
+ checkRoot => 0,
+ bizarroAdd => 0,
+ bizarroSub => 0,
+ bizarroMul => 0,
+ bizarroDiv => 0
+ );
+ Value::Error("You must simplify your answer further") unless $OK;
+ return $OK;
+ };
+}
+
+###########################
+#
+# Create root(n, x)
+#
+
+package my::Function::numeric2;
+our @ISA = ('Parser::Function::numeric2');
+
+sub root {
+ my $self = shift;
+ my $n = shift;
+ my $x = shift;
+ $self->Error("Can't take 0th roots") if ($n == 0);
+ $self->Error("Can't take general roots of negative numbers") if (($x < 0) and (($n - 1) / 2 != int(($n - 1) / 2)));
+ my $value = $self->context->flag("checkRoot");
+ return $value + 1 if $value && $x == 1; # force root(n,1) to be incorrect
+ return $value + 1 if $value && $x == $value; # force root(n,root(m,x))) to be incorrect
+ return $value + 1 if $value && $x == $self->context->flag("checkSqrt"); # force root(n,sqrt(x))) to be incorrect
+ return $value * $x if $value;
+ return ($x)**(1 / $n) if (($x > 0) and ($n != 0));
+ return -(abs($x)**(1 / $n)) if (($x < 0) and (($n - 1) / 2 == int(($n - 1) / 2)));
+}
+
+sub TeX {
+ my $self = shift;
+ my ($n, $x) = ($self->{params}[0], $self->{params}[1]);
+ return '\sqrt[' . $n->TeX . "]{" . $x->TeX . "}";
+}
+
+###########################
+#
+# Subclass the numeric functions
+#
+package my::Function::numeric;
+our @ISA = ('Parser::Function::numeric');
+
+#
+# Override sqrt() to return a special value times x when evaluated
+#
+sub sqrt {
+ my $self = shift;
+ my $x = shift;
+ my $value = $self->context->flag("checkSqrt");
+ return $value + 1 if $value && $x == 1; # force sqrt(1) to be incorrect
+ return $value + 1 if $value && $x == $value; # force sqrt(sqrt(x)) to be incorrect
+ return $value + 1 if $value && $x == $self->context->flag("checkRoot"); # force sqrt(root(n,x))) to be incorrect
+ return $value * $x if $value;
+ return $self->SUPER::sqrt($x);
+}
+
+1;
diff --git a/macros/contextLimitedVector.pl b/macros/contexts/contextLimitedVector.pl
similarity index 100%
rename from macros/contextLimitedVector.pl
rename to macros/contexts/contextLimitedVector.pl
diff --git a/macros/contextMatrixExtras.pl b/macros/contexts/contextMatrixExtras.pl
similarity index 100%
rename from macros/contextMatrixExtras.pl
rename to macros/contexts/contextMatrixExtras.pl
diff --git a/macros/contextOrdering.pl b/macros/contexts/contextOrdering.pl
similarity index 100%
rename from macros/contextOrdering.pl
rename to macros/contexts/contextOrdering.pl
diff --git a/macros/contextPartition.pl b/macros/contexts/contextPartition.pl
similarity index 100%
rename from macros/contextPartition.pl
rename to macros/contexts/contextPartition.pl
diff --git a/macros/contextPercent.pl b/macros/contexts/contextPercent.pl
similarity index 100%
rename from macros/contextPercent.pl
rename to macros/contexts/contextPercent.pl
diff --git a/macros/contextPeriodic.pl b/macros/contexts/contextPeriodic.pl
similarity index 100%
rename from macros/contextPeriodic.pl
rename to macros/contexts/contextPeriodic.pl
diff --git a/macros/contextPermutation.pl b/macros/contexts/contextPermutation.pl
similarity index 100%
rename from macros/contextPermutation.pl
rename to macros/contexts/contextPermutation.pl
diff --git a/macros/contextPermutationUBC.pl b/macros/contexts/contextPermutationUBC.pl
similarity index 100%
rename from macros/contextPermutationUBC.pl
rename to macros/contexts/contextPermutationUBC.pl
diff --git a/macros/contextPiecewiseFunction.pl b/macros/contexts/contextPiecewiseFunction.pl
similarity index 100%
rename from macros/contextPiecewiseFunction.pl
rename to macros/contexts/contextPiecewiseFunction.pl
diff --git a/macros/contextPolynomialFactors.pl b/macros/contexts/contextPolynomialFactors.pl
similarity index 100%
rename from macros/contextPolynomialFactors.pl
rename to macros/contexts/contextPolynomialFactors.pl
diff --git a/macros/contexts/contextRationalExponent.pl b/macros/contexts/contextRationalExponent.pl
new file mode 100644
index 0000000000..78ff4aeb38
--- /dev/null
+++ b/macros/contexts/contextRationalExponent.pl
@@ -0,0 +1,146 @@
+
+=head1 NAME
+
+contextRationalExponent.pl - allows the requirement of simplified rational exponent answers. May be a misnomer since nothing requires exponents to be rational.
+
+=head1 DESCRIPTION
+
+This code is a copy of contextLimitedRadical.pl, with the following changes:
+- no need for contextLimitedPowers.pl, since we need to use bizarro power, so that macro is removed
+- name of the context changed to RationalExponent
+- set class of ^ and ** to bizarro
+- removed LimitedPowers::OnlyPositiveIntegers($context) call
+- set bizarroPow flags in answer checking (on, then off)
+- undefined sqrt and root (after root is added to the context). These can be redefined by a problem author if desired.
+- added special messages if sqrt or root are used when they were undefined
+
+=cut
+
+loadMacros(
+ "bizarroArithmetic.pl",
+
+);
+
+#
+# Set up the RationalExponent context
+#
+sub _contextRationalExponent_init {
+ my $context = $main::context{RationalExponent} = Parser::Context->getCopy("Numeric");
+ Parser::Number::NoDecimals($context);
+ $context->flags->set(setSqrt => exp(1) / ln(2), setRoot => exp(1) / ln(2));
+ $context->operators->set(
+ '+' => { class => 'bizarro::BOP::add', isCommand => 1 }, # override +
+ '-' => { class => 'bizarro::BOP::subtract', isCommand => 1 }, # override -
+ '*' => { class => 'bizarro::BOP::multiply', isCommand => 1 }, # override *
+ '* ' => { class => 'bizarro::BOP::multiply', isCommand => 1 }, # override *
+ ' *' => { class => 'bizarro::BOP::multiply', isCommand => 1 }, # override *
+ '/' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ '/ ' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ ' /' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ '//' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ '**' => { class => 'bizarro::BOP::power', isCommand => 1, perl => undef }, # override **
+ '^' => { class => 'bizarro::BOP::power', isCommand => 1, perl => undef }, # override ^
+ );
+ $context->functions->set(sqrt => { class => 'my::Function::numeric' }); # override sqrt()
+ main::PG_restricted_eval('sub root {Parser::Function->call("root",@_)}');
+ $context->functions->add(root => { class => 'my::Function::numeric2' },);
+ $context->flags->set(limits => [ 0, 5 ]); # no negatives in the radicals
+ $context->flags->set(
+ reduceConstantFunctions => 0,
+ reduceConstants => 0,
+ formatStudentAnswer => 'parsed',
+ checkSqrt => 0,
+ checkRoot => 0
+ );
+ $context->functions->undefine('sqrt');
+ $context->functions->undefine('root');
+ $context->{error}{msg}{"Function 'root' is not allowed in this context"} =
+ "Please use rational exponents, not root or sqrt";
+ $context->{error}{msg}{"Function 'sqrt' is not allowed in this context"} =
+ "Please use rational exponents, not sqrt or root";
+ $context->{cmpDefaults}{Formula}{checker} = sub {
+ my ($correct, $student, $ans) = @_;
+ return 0 if $ans->{isPreview} || $correct != $student;
+ $student = $ans->{student_formula};
+ $correct = $correct->{original_formula} if defined $correct->{original_formula};
+ $student = Formula("$student");
+ $correct = Formula("$correct"); #ensure both are Formula objects
+ my ($setSqrt, $setRoot) = (Context()->flag("setSqrt"), Context()->flag("setRoot"));
+ Context()->flags->set(
+ checkSqrt => $setSqrt,
+ checkRoot => $setRoot,
+ bizarroAdd => 1,
+ bizarroSub => 1,
+ bizarroMul => 1,
+ bizarroDiv => 1,
+ bizarroPow => 1
+ );
+ delete $correct->{test_values};
+ delete $student->{test_values};
+ my $OK = (($correct == $student) or ($student == $correct)); # check if equal when sqrt's are replaced by 1
+ Context()->flags->set(
+ checkSqrt => 0,
+ checkRoot => 0,
+ bizarroAdd => 0,
+ bizarroSub => 0,
+ bizarroMul => 0,
+ bizarroDiv => 0,
+ bizarroPow => 0
+ );
+ Value::Error("You must simplify your answer further") unless $OK;
+ return $OK;
+ };
+
+}
+
+###########################
+#
+# Create root(n, x)
+#
+
+package my::Function::numeric2;
+our @ISA = ('Parser::Function::numeric2');
+
+sub root {
+ my $self = shift;
+ my $n = shift;
+ my $x = shift;
+ $self->Error("Can't take 0th roots") if ($n == 0);
+ $self->Error("Can't take general roots of negative numbers") if (($x < 0) and (($n - 1) / 2 != int(($n - 1) / 2)));
+ my $value = $self->context->flag("checkRoot");
+ return $value + 1 if $value && $x == 1; # force root(n,1) to be incorrect
+ return $value + 1 if $value && $x == $value; # force root(n,root(m,x))) to be incorrect
+ return $value + 1 if $value && $x == $self->context->flag("checkSqrt"); # force root(n,sqrt(x))) to be incorrect
+ return $value * $x if $value;
+ return ($x)**(1 / $n) if (($x > 0) and ($n != 0));
+ return -(abs($x)**(1 / $n)) if (($x < 0) and (($n - 1) / 2 == int(($n - 1) / 2)));
+}
+
+sub TeX {
+ my $self = shift;
+ my ($n, $x) = ($self->{params}[0], $self->{params}[1]);
+ return '\sqrt[' . $n->TeX . "]{" . $x->TeX . "}";
+}
+
+###########################
+#
+# Subclass the numeric functions
+#
+package my::Function::numeric;
+our @ISA = ('Parser::Function::numeric');
+
+#
+# Override sqrt() to return a special value times x when evaluated
+#
+sub sqrt {
+ my $self = shift;
+ my $x = shift;
+ my $value = $self->context->flag("checkSqrt");
+ return $value + 1 if $value && $x == 1; # force sqrt(1) to be incorrect
+ return $value + 1 if $value && $x == $value; # force sqrt(sqrt(x)) to be incorrect
+ return $value + 1 if $value && $x == $self->context->flag("checkRoot"); # force sqrt(root(n,x))) to be incorrect
+ return $value * $x if $value;
+ return $self->SUPER::sqrt($x);
+}
+
+1;
diff --git a/macros/contextRationalFunction.pl b/macros/contexts/contextRationalFunction.pl
similarity index 100%
rename from macros/contextRationalFunction.pl
rename to macros/contexts/contextRationalFunction.pl
diff --git a/macros/contextReaction.pl b/macros/contexts/contextReaction.pl
similarity index 100%
rename from macros/contextReaction.pl
rename to macros/contexts/contextReaction.pl
diff --git a/macros/contexts/contextRestrictedDomains.pl b/macros/contexts/contextRestrictedDomains.pl
new file mode 100644
index 0000000000..a6d8286faf
--- /dev/null
+++ b/macros/contexts/contextRestrictedDomains.pl
@@ -0,0 +1,223 @@
+################################################################################
+# WeBWorK Online Homework Delivery System
+# Copyright @copy; 2000-2018 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
+
+Describe this context here.
+
+=head1 DESCRIPTION
+
+=cut
+
+loadMacros("MathObjects.pl", "bizarroArithmetic.pl", "contextInequalitySetBuilder.pl", "PGinfo.pl",);
+
+sub _contextRestrictedDomains_init {
+ my $context = $main::context{RestrictedDomains} = Parser::Context->getCopy("InequalitySetBuilder");
+ $context->{name} = "RestrictedDomains";
+ $context->flags->set(
+ reduceConstants => 0,
+ reduceConstantFunctions => 0,
+ formatStudentAnswer => "parsed",
+ checkSqrt => 0,
+ checkRoot => 0,
+ setSqrt => exp(1) / main::ln(2),
+ wrongFormMessage =>
+ 'Your answer is algebraically equivalent to the correct answer, but not in the expected form. Maybe it is not fully simplified. Maybe something is not completely factored. Maybe it is not in the expected form for some other reason.',
+ useBizarro => 1,
+ expressionWeight => 0.9,
+ );
+ $context->noreduce('(-x)+y', '(-x)-y');
+ $context->operators->set(
+ '+' => { class => 'bizarro::BOP::add', isCommand => 1 }, # override +
+ '-' => { class => 'bizarro::BOP::subtract', isCommand => 1 }, # override -
+ ' ' => { class => 'bizarro::BOP::multiply', isCommand => 1 }, # override *
+ '*' => { class => 'bizarro::BOP::multiply', isCommand => 1 }, # override *
+ '* ' => { class => 'bizarro::BOP::multiply', isCommand => 1 }, # override *
+ ' *' => { class => 'bizarro::BOP::multiply', isCommand => 1 }, # override *
+ '/' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ '/ ' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ ' /' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ '//' => { class => 'bizarro::BOP::divide', isCommand => 1 }, # override /
+ );
+ $context->operators->redefine('for', using => ',', from => 'Numeric');
+ $context->operators->redefine(',for', using => ',', from => 'Numeric');
+ $context->operators->redefine(', for', using => ',', from => 'Numeric');
+ $context->operators->redefine('where', using => ',', from => 'Numeric');
+ $context->operators->redefine(',where', using => ',', from => 'Numeric');
+ $context->operators->redefine(', where', using => ',', from => 'Numeric');
+ $context->operators->add(
+ '≠' => {
+ precedence => .5,
+ associativity => 'left',
+ type => 'bin',
+ string => ' != ',
+ TeX => '\ne ',
+ class => 'Inequalities::BOP::inequality',
+ eval => 'evalNotEqualTo'
+ }
+ );
+ $context->functions->set(sqrt => { class => 'restrictedDomains::Function::numeric' }); # override sqrt()
+ $context->functions->add(identity => { class => 'restrictedDomains::Function::numeric' });
+ $context->{cmpDefaults}{Formula}{checker} = sub {
+ my ($correct, $student, $ans) = @_;
+ return 0 if $ans->{isPreview} || $correct != $student;
+ $student = $ans->{student_formula};
+ $student = Formula("identity($student)"); #ensure student is parsed as Formula object
+ my $setSqrt = Context()->flag("setSqrt");
+ my $useBizarro = Context()->flag("useBizarro");
+ Context()->flags->set(
+ checkSqrt => $setSqrt,
+ bizarroAdd => $useBizarro,
+ bizarroSub => $useBizarro,
+ bizarroMul => $useBizarro,
+ bizarroDiv => $useBizarro
+ );
+ delete $correct->{test_values};
+ delete $student->{test_values};
+ my $OK = ($correct == $student);
+ Context()->flags->set(checkSqrt => 0, bizarroAdd => 0, bizarroSub => 0, bizarroMul => 0, bizarroDiv => 0);
+ Value::Error(Context()->flag('wrongFormMessage')) unless $OK;
+ return $OK;
+ };
+ $showPartialCorrectAnswers = 1;
+ $context->{cmpDefaults}{Formula}{showLengthHints} = 0;
+ $context->{cmpDefaults}{Formula}{list_checker} = sub {
+ my ($correct, $student, $ansHash, $value) = @_;
+ my $score = 0; # number of correct student answers
+ my @errors = (); # stores error messages
+ my $i; # loop counters
+ my $studentFormula = $ansHash->{student_formula};
+ # Student answer needs to be a List consisting of a Formula/Real and then 0 or more Union/Interval/Sets
+ if ($studentFormula->class ne 'Formula') {
+ push(@errors, "Your answer isn't an expression with a possibly restricted domain");
+ return (0, @errors);
+ }
+ if ($studentFormula->type ne 'Number' and $studentFormula->type ne 'List') {
+ push(@errors, "Your answer isn't an expression with a possibly restricted domain");
+ return (0, @errors);
+ }
+ my $studentList = $studentFormula;
+ if ($studentFormula->type eq 'Number') { $studentList = Compute("$studentFormula, (-inf,inf)"); }
+ # Check that first item in list is a Formula that returns a number
+ if (($studentList->value)[0]->type ne 'Number') {
+ push(@errors, "The first part of your answer is not an expression");
+ }
+ $domainsCount = scalar($studentList->value) - 1;
+ # Identify student answers like "1/x for x != 1, 2" and change to "1/x for x!=1, x!=2"
+ my $alteredStudentList = Formula(($studentList->value)[0] . ", " . ($studentList->value)[1]);
+ for $i (2 .. $domainsCount) {
+ my $dom = ($studentList->value)[$i];
+ my $prevdom = ($alteredStudentList->value)[ $i - 1 ];
+ if ($dom->type eq 'Number' and $prevdom->class eq 'Formula' and $prevdom->type eq 'Interval') {
+ if (defined $prevdom->{tree}->{bop}) {
+ if ($prevdom->{tree}->{bop} eq '!=') {
+ my $x = (Context()->variables->variables)[0];
+ $alteredStudentList = Formula($alteredStudentList->string . ", $x != $dom");
+ } else {
+ $alteredStudentList = Formula($alteredStudentList->string . ", $dom");
+ }
+ } else {
+ $alteredStudentList = Formula($alteredStudentList->string . ", $dom");
+ }
+ } else {
+ $alteredStudentList = Formula($alteredStudentList->string . ", $dom");
+ }
+ }
+ $studentList = $alteredStudentList;
+ for $i (1 .. $domainsCount) {
+ my $dom = ($studentList->value)[$i];
+ if ($dom->type ne 'Interval' and $dom->type ne 'Union' and $dom->type ne 'Set') {
+ push(@errors, "Unable to understand how '" . $dom->string . "' describes the domain");
+ return (0, @errors);
+ }
+ }
+ my $studentExpression = ($studentList->value)[0];
+ my $studentDomain = Interval("(-inf,inf)");
+ for my $i (1 .. $domainsCount) {
+ $studentDomain = $studentDomain->intersect(Interval(($studentList->value)[$i]->string));
+ }
+ $studentDomain = Compute("$studentDomain");
+
+ # Set correct answer parts
+ my $correctFormula = $ansHash->{correct_value};
+ my $correctScore = scalar($correctFormula->value);
+ my $correctExpression = ($correctFormula->value)[0];
+ my $correctDomain = ($correctFormula->value)[1];
+ $correctDomain = Compute("$correctDomain");
+ # If the correct answer has (-inf, inf) as the domain, don't print that in the correct answer
+ if ($correctDomain == Interval("(-inf,inf)")) {
+ $ansHash->{correct_ans_latex_string} = $correctExpression->TeX;
+ }
+ my $trueDomain = $correctDomain;
+ if (defined($correctFormula->{trueDomain})) { $trueDomain = $correctFormula->{trueDomain}; }
+
+ # Check math expression
+ my $expression_cmp = $correctExpression->cmp->evaluate($studentExpression->string);
+ my $expressionOK = $expression_cmp->{score};
+ push(@errors, 'Your expression is not correct')
+ unless ($expressionOK or $expression_cmp->{ans_message} or $ansHash->{isPreview});
+ push(@errors, $expression_cmp->{ans_message}) if $expression_cmp->{ans_message};
+
+ # Check student's domain
+ my $domainOK = 1;
+ my $trueUnion = Interval($trueDomain);
+ my $studentUnion = Interval($studentDomain);
+ my $correctUnion = Interval($correctDomain);
+ if (!$correctUnion->contains($studentUnion) or !$studentUnion->contains($trueUnion)) {
+ $domainOK = 0;
+ push(@errors, 'Your domain is not correct')
+ unless ($studentFormula->type eq 'Number' or $ansHash->{isPreview});
+ push(@errors, 'You need to specify the restricted domain')
+ if ($studentFormula->type eq 'Number' and $expressionOK);
+ }
+
+ my $allCorrectScore =
+ ($ansHash->{student_formula}->type eq 'Number') ? 2 : scalar($ansHash->{student_value}->value);
+ my $expressionWeight = Context()->flag("expressionWeight");
+ $score += $expressionWeight * $allCorrectScore if $expressionOK;
+ $score += (1 - $expressionWeight) * $allCorrectScore if $domainOK;
+ #$score = $score + $domainsCount if $domainOK;
+
+ return ($score, @errors);
+ };
+}
+
+###########################
+#
+# Subclass the numeric functions
+#
+package restrictedDomains::Function::numeric;
+our @ISA = ('Parser::Function::numeric');
+
+#
+# Override sqrt() to return a special value times x when evaluated
+#
+sub sqrt {
+ my $self = shift;
+ my $x = shift;
+ my $value = $self->context->flag("checkSqrt");
+ return $value + 1 if $value && $x == 1; # force sqrt(1) to be incorrect
+ return $value + 1 if $value && $x == $value; # force sqrt(sqrt(x)) to be incorrect
+ return $value + 1 if $value && $x == $self->context->flag("checkRoot"); # force sqrt(root(n,x))) to be incorrect
+ return $value * $x if $value;
+ return $self->SUPER::sqrt($x);
+}
+
+sub identity {
+ my $self = shift;
+ my $x = shift;
+ return $x;
+}
diff --git a/macros/contextScientificNotation.pl b/macros/contexts/contextScientificNotation.pl
similarity index 100%
rename from macros/contextScientificNotation.pl
rename to macros/contexts/contextScientificNotation.pl
diff --git a/macros/contextString.pl b/macros/contexts/contextString.pl
similarity index 100%
rename from macros/contextString.pl
rename to macros/contexts/contextString.pl
diff --git a/macros/contextTF.pl b/macros/contexts/contextTF.pl
similarity index 100%
rename from macros/contextTF.pl
rename to macros/contexts/contextTF.pl
diff --git a/macros/contextTrigDegrees.pl b/macros/contexts/contextTrigDegrees.pl
similarity index 100%
rename from macros/contextTrigDegrees.pl
rename to macros/contexts/contextTrigDegrees.pl
diff --git a/macros/contextTypeset.pl b/macros/contexts/contextTypeset.pl
similarity index 100%
rename from macros/contextTypeset.pl
rename to macros/contexts/contextTypeset.pl
diff --git a/macros/MathObjects.pl b/macros/core/MathObjects.pl
similarity index 100%
rename from macros/MathObjects.pl
rename to macros/core/MathObjects.pl
diff --git a/macros/PGML.pl b/macros/core/PGML.pl
similarity index 100%
rename from macros/PGML.pl
rename to macros/core/PGML.pl
diff --git a/macros/PGanswermacros.pl b/macros/core/PGanswermacros.pl
similarity index 100%
rename from macros/PGanswermacros.pl
rename to macros/core/PGanswermacros.pl
diff --git a/macros/PGauxiliaryFunctions.pl b/macros/core/PGauxiliaryFunctions.pl
similarity index 100%
rename from macros/PGauxiliaryFunctions.pl
rename to macros/core/PGauxiliaryFunctions.pl
diff --git a/macros/PGbasicmacros.pl b/macros/core/PGbasicmacros.pl
similarity index 100%
rename from macros/PGbasicmacros.pl
rename to macros/core/PGbasicmacros.pl
diff --git a/macros/PGcommonFunctions.pl b/macros/core/PGcommonFunctions.pl
similarity index 100%
rename from macros/PGcommonFunctions.pl
rename to macros/core/PGcommonFunctions.pl
diff --git a/macros/PGessaymacros.pl b/macros/core/PGessaymacros.pl
similarity index 100%
rename from macros/PGessaymacros.pl
rename to macros/core/PGessaymacros.pl
diff --git a/macros/PGgraders.pl b/macros/core/PGgraders.pl
similarity index 100%
rename from macros/PGgraders.pl
rename to macros/core/PGgraders.pl
diff --git a/macros/PGlateximage.pl b/macros/core/PGlateximage.pl
similarity index 100%
rename from macros/PGlateximage.pl
rename to macros/core/PGlateximage.pl
diff --git a/macros/PGsequentialmacros.pl b/macros/core/PGsequentialmacros.pl
similarity index 100%
rename from macros/PGsequentialmacros.pl
rename to macros/core/PGsequentialmacros.pl
diff --git a/macros/PGstandard.pl b/macros/core/PGstandard.pl
similarity index 100%
rename from macros/PGstandard.pl
rename to macros/core/PGstandard.pl
diff --git a/macros/core/PeriodicRerandomization.pl b/macros/core/PeriodicRerandomization.pl
new file mode 100644
index 0000000000..c2bdbc38f9
--- /dev/null
+++ b/macros/core/PeriodicRerandomization.pl
@@ -0,0 +1,176 @@
+
+=head1 NAME
+
+PeriodicRerandomization.pl - forced re-randomization of the
+problem every p submissions.
+
+=head1 SYNOPSIS
+
+Let p be a positive integer. This macro provides the ability
+to force a re-randomization of the question every p attempts.
+For example, this macro can be used to create a practice exercise
+that provides a new version of the question every 4 attempts
+and displays a solution every fourth attempt.
+
+=head1 DESCRIPTION
+
+Usage:
+
+ DOCUMENT();
+ loadMacros(
+ "PGstandard.pl",
+ "MathObjects.pl",
+ "PeriodicRerandomization.pl",
+ );
+ TEXT(beginproblem());
+
+ PeriodicRerandomization("4");
+
+ $a = random(2,9,1);
+ do { $b = random(2,9,1); } until ($b != $a);
+
+ BEGIN_TEXT
+ An equation for a line in the xy-plane with slope \( $a \)
+ and y-intercept \( $b \) is
+ $BR
+ $BR
+ \( y = \) \{ ans_rule(20) \}
+ $BR
+ $BR
+ END_TEXT
+
+ PeriodicStatus(
+ "Generate a new version of this problem",
+ "You have ${attempts_modp_remaining} attempt(s) remaining
+ before you will receive a new version of this problem."
+ );
+
+ if ($attempts_modp == 0) {
+ BEGIN_TEXT
+ $BR
+ $BR
+ ${BBOLD}Solution:${EBOLD} Multiply \( x \) by \( $a \)
+ and add \( $b \).
+ $BR
+ $BR
+ END_TEXT
+ }
+
+ ANS( Compute("$a x + $b")->cmp() );
+
+ COMMENT('Periodically re-randomizes.');
+
+ ENDDOCUMENT();
+
+
+The argument of C is a number p (the period)
+that is the number of attempts allowed before the problem is
+re-randomized. C must be called before
+any random parameters are defined.
+
+The two arguments of C are (1) the text that will
+appear on the button for a new version of the problem when the number
+of attempts is 0 mod p, and (2) a message that will appear when the
+number of attempts is not 0 mod N. If C has no
+arguments, then it will use defaults.
+
+There are several globally defined variables. C<$rerand_period> is
+the period p. C<$attempts_modp> is the total number of attempts modulo
+the period except for when the problem is first accessed, in which case
+its value is -p (the rationale behind this is that the case when the
+problem is first accessed often needs to be handled separately.)
+C<$attempts_modp_remaining> is the number of attempts
+remaining before re-randomization. C<$problem_version_number> is the
+floor function applied to the total number of attempts divided by the
+period p. C<$newProblemSeed> is the problem seed for the current
+version of the problem, whereas C<$problemSeed> is the original
+problem seed (which does not change with different versions of the
+problem). You can access the total number of attempts using
+C<$envir{numOfAttempts}>, which is a sequence 0,0,1,2,3,... (not
+0,1,2,3,...).
+
+=head1 AUTHOR
+
+Paul Pearson, Fort Lewis College, Department of Mathematics
+
+=cut
+
+###########################
+
+sub _PeriodicRerandomization_init { }; # don't reload this file
+
+sub PeriodicRerandomization {
+
+ #
+ # define some global variables
+ #
+
+ $rerand_period = shift;
+ $attempts_modp = ($envir{numOfAttempts} + 1) % $rerand_period;
+ $attempts_modp_remaining = $rerand_period - $attempts_modp;
+
+ #
+ # a correction because the $envir{numOfAttempts} progression is 0,0,1,2,3... instead of 0,1,2,3,...
+ #
+ if ($envir{numOfAttempts} == 0 && !defined(${$inputs_ref}{'hasBeenAttempted'})) {
+
+ TEXT(MODES(
+ HTML => qq!');
+}
+
+sub EBRED {
+ MODES(TeX => '}', HTML => ' ');
+}
+
+$main::BBRED = BBRED();
+$main::EBRED = EBRED();
+
+$badmessage = "$BBRED Something helpful should go here. Please inform your instructor that it is missing! $EBRED";
+
+sub MUHelp {
+ my $type = shift;
+ return $badmessage unless defined($type);
+
+ my $rString = "";
+ my $typeOkay = 0;
+
+ if ($type =~ m/sqrt/i) {
+ $rstring =
+ "If necessary, type ${BBOLD}sqrt()${EBOLD} to enter a square root. For example, to enter \\(\\sqrt{7x}\\), you would type your answer as sqrt(7x). You must put parentheses around everything you want to take the square root of!!";
+ $typeOkay = 1;
+ } elsif ($type =~ m/absvaleqn/i) {
+ $rstring =
+ "Enter your answers as a comma separated list if there is more than one correct answer. Type ${BBOLD}no solution${EBOLD} if the equation has no solution.";
+ $typeOkay = 1;
+ } elsif ($type =~ m/logans/i) {
+ $rstring =
+ "Give an exact answer. If necessary, type ${BBOLD}log(b,x)${EBOLD} to enter \\(\\log_b(x)\\) as an answer. For example, type ${BBOLD}log(3,5)${EBOLD} to enter \\(\\log_3(5)\\). You may also use ${BBOLD}ln(15)${EBOLD} for \\(\\ln(15)\\), and ${BBOLD}log10(20)${EBOLD} for \\(\\log(20)\\). Enter your answers as a comma separated list if there is more than one correct answer. Type ${BBOLD}no solution${EBOLD} if the equation has no solution.";
+ $typeOkay = 1;
+ } elsif ($type =~ m/lineareqns/i) {
+ $rstring =
+ "If necessary, type ${BBOLD}no solutions${EBOLD} if the equation has no solution or type ${BBOLD}infinitely many${EBOLD} if there are infinitely many solutions.";
+ $typeOkay = 1;
+ } elsif ($type =~ m/quadeqns/i) {
+ $rstring =
+ "Enter your answers as a comma separated list if there is more than one correct answer. Type ${BBOLD}no solution${EBOLD} if the equation has no solution. If necessary, type ${BBOLD}sqrt()${EBOLD} to enter a square root. For example, to enter \\(\\sqrt{7x}\\), you would type your answer as sqrt(7x). You must put parenthesis are everything you want to take the square root of!!";
+ $typeOkay = 1;
+ }
+
+ if ($typeOkay == 1) { return $rstring; }
+ return $badmessage;
+}
+
+1;
+
+## Append .helpLink("exponents","Click here for further help.") to a string to add a help link.
diff --git a/macros/deprecated/README.md b/macros/deprecated/README.md
new file mode 100644
index 0000000000..86e399f697
--- /dev/null
+++ b/macros/deprecated/README.md
@@ -0,0 +1,6 @@
+# macros/deprecated folder
+
+This folder contains macros intended to be deprecated. These are either macros that do not
+contain functionality that is general for other pg problems (generally are specific for a particular
+university) or are no longer necessary (the functionality is either in other pg macros or webwork
+itself).
diff --git a/macros/deprecated/freemanMacros.pl b/macros/deprecated/freemanMacros.pl
new file mode 100755
index 0000000000..86fcb54f35
--- /dev/null
+++ b/macros/deprecated/freemanMacros.pl
@@ -0,0 +1,541 @@
+sub textbook_ref {
+ my ($text, $sec, $ex) = @_;
+ return "";
+ return "$text section $sec, exercise $ex";
+}
+
+sub textbook_ref_corr {
+ return "";
+ return "Similar to " . textbook_ref(@_) . ".";
+}
+
+sub textbook_ref_exact {
+ return "";
+ return "From " . textbook_ref(@_) . ".";
+}
+
+sub list_random_multi_uniq($@) {
+ my ($n, @list) = @_;
+ my @result;
+ while (@result < $n) {
+ my $i = random(0, $#list, 1);
+ if ($i == 0) {
+ push @result, shift @list;
+ } elsif ($i == $#list) {
+ push @result, pop @list;
+ } else {
+ push @result, $list[$i];
+ $list[$i] = pop @list;
+ }
+ }
+ return @result;
+}
+
+sub IINT {
+ return '\int\!\!\int';
+}
+
+sub IIINT {
+ return '\int\!\!\int\!\!\int';
+}
+
+$IINT = IINT();
+$IIINT = IIINT();
+
+sub VUSAGE {
+ return
+ $BBOLD
+ . ' Usage: '
+ . $EBOLD
+ . 'To enter a vector, for example \(\langle x,y,z\rangle\), type '
+ . $LQ . '\('
+ . $LTS
+ . '\) x, y, z \('
+ . $GTS . '\)'
+ . $RQ;
+}
+
+$VUSAGE = VUSAGE();
+
+sub PUSAGE {
+ return $BBOLD . ' Usage: ' . $EBOLD . 'To enter a point, for example \( (x,y,z) \), type "(x, y, z)".';
+}
+
+$PUSAGE = PUSAGE();
+
+#sam# copied from bkellMacros.pl -- no reason to maintain two macro files.
+#sam# FIXME -- these should probably lose their "bkell_" prefixes.
+
+# bkellMacros.pl
+# Brian Kell
+# Last updated 3:24 CDT, 24 Jun 2007
+
+###############################################################################
+# bkell_linear_simplify($a, $b)
+#
+# Returns a string representing $a*x+$b in simplified form, where "simplified"
+# means something along the lines of the following:
+#
+# a b output
+# --- --- ------
+# 0 0 0
+# 1 1 x+1
+# -1 -1 -x-1
+# -1 5 5-x
+# 2 0 2x
+# -4 3 3-4x
+# -4 -3 -4x-3
+#
+sub bkell_linear_simplify {
+ my ($a, $b) = @_;
+
+ if ($a == 0) {
+ return "$b";
+ } elsif ($b == 0) {
+ if ($a == -1) {
+ return "-x";
+ } elsif ($a == 1) {
+ return "x";
+ } else {
+ return "${a}x";
+ }
+ } elsif ($a < 0 && $b > 0) {
+ if ($a == -1) {
+ return "$b-x";
+ } else {
+ return "$b-" . (abs $a) . "x";
+ }
+ } elsif ($a == 1) {
+ return "x" . sprintf("%+d", $b);
+ } elsif ($a == -1) {
+ return "-x" . sprintf("%+d", $b);
+ } else {
+ return "${a}x" . sprintf("%+d", $b);
+ }
+}
+
+###############################################################################
+# bkell_simplify_fraction($num, $denom)
+#
+# Simplifies the fraction $num/$denom; returns the list ($num, $denom).
+#
+sub bkell_simplify_fraction {
+ my ($num, $denom) = @_;
+
+ if ($num == 0) { return (0, 1); }
+
+ my $sign = +1;
+ if ($num < 0) { $sign *= -1; $num *= -1; }
+ if ($denom < 0) { $sign *= -1; $denom *= -1; }
+
+ for ($i = 2; $i <= $num && $i <= $denom; ++$i) {
+ while ($num % $i == 0 && $denom % $i == 0) {
+ $num /= $i;
+ $denom /= $i;
+ }
+ }
+
+ return ($sign * $num, $denom);
+}
+
+###############################################################################
+# bkell_simplify_fraction_string($num, $denom [, $flags])
+#
+# Returns a string like "$num/$denom" in simplified form. If the string $flags
+# contains "+", then a leading "+" is included if the fraction is non-negative.
+# If $flags contains "0", then a fraction with a value of 0 will cause the
+# empty string to be returned. If $flags contains "1", then a fraction with a
+# value of 1 or -1 will cause only the sign to be returned (or the empty
+# string, if the fraction is non-negative and $flags does not contain "+"). If
+# $flags contains "(", then parentheses will be placed around "$num/$denom"
+# (the sign, if it exists, will be outside the parentheses); if $flags contains
+# "[", then parentheses will be used only if a sign is used and the denominator
+# is other than 1. A flag of "(" overrides "]". If $flags contains "f", then
+# the string returned will be in the form "{$num \over $denom}" instead of the
+# normal slashed version.
+#
+sub bkell_simplify_fraction_string {
+ my ($num, $denom, $flags) = @_;
+ if (!defined $flags) { $flags = ""; }
+
+ ($num, $denom) = bkell_simplify_fraction($num, $denom);
+
+ my $sign = ($num >= 0 ? ($flags =~ /\+/ ? "+" : "") : "-");
+ $num = abs $num;
+
+ my ($pre, $post);
+ if ($flags =~ /\(/ || ($flags =~ /\[/ && $sign ne "" && $denom != 1)) {
+ ($pre, $post) = ("(", ")");
+ } else {
+ ($pre, $post) = ("", "");
+ }
+
+ if ($num == 0 && $flags =~ /0/) { return ""; }
+ if ($denom == 1) {
+ if ($num == 1 && $flags =~ /1/) { return "$sign"; }
+ return "$sign$pre$num$post";
+ }
+ if ($flags =~ /f/) { return "$sign$pre {$num \\over $denom}$post"; }
+ return "$sign$pre$num/$denom$post";
+}
+
+###############################################################################
+# bkell_poly_term($coeff_num, $coeff_denom, $var [, "+"])
+#
+# Produces and simplifies a term of a polynomial of the general form
+# "($coeff_num/$coeff_denom)$var". Handles special cases (such as $num==0,
+# $denom==1, etc.). If the fourth argument is "+", then a leading "+" is
+# included if the term is positive.
+#
+sub bkell_poly_term {
+ my ($coeff_num, $coeff_denom, $var, $plus) = @_;
+ if (!defined $plus) { $plus = ""; }
+
+ if ($coeff_num == 0) { return ""; }
+
+ my $sign = +1;
+ if ($coeff_num < 0) { $sign *= -1; $coeff_num *= -1; }
+ if ($coeff_denom < 0) { $sign *= -1; $coeff_denom *= -1; }
+ $sign = ($sign > 0 ? ($plus eq "+" ? "+" : "") : "-");
+
+ my ($num, $denom) = bkell_simplify_fraction($coeff_num, $coeff_denom);
+
+ if ($denom == 1) {
+ if ($num == 1) {
+ return "$sign$var";
+ } else {
+ return "$sign$num$var";
+ }
+ }
+
+ return "$sign($num/$denom)$var";
+}
+
+###############################################################################
+# bkell_gcd($x, $y)
+#
+# Returns the greatest common divisor of $x and $y.
+#
+sub bkell_gcd {
+ my ($x, $y) = @_;
+ $x = abs $x;
+ $y = abs $y;
+ if ($x > $y) { ($x, $y) = ($y, $x); }
+ if ($x == 0) { return $y; }
+ my $r = $y % $x;
+ if ($r == 0) { return $x; }
+ return bkell_gcd($x, $r);
+}
+
+###############################################################################
+# bkell_poly_eval($x, $a_n, ..., $a_0)
+#
+# Evaluates the polynomial a_n*x^n + ... + a_1*x + a_0 at the given value of x.
+#
+sub bkell_poly_eval {
+ my $x = shift;
+ my $value = shift;
+ while (@_) { $value *= $x; $value += shift; }
+ return $value;
+}
+
+###############################################################################
+# bkell_real_zeros_finder($a_n, ..., $a_0)
+#
+# Returns a list of numerical approximations of the zeros of the polynomial
+# a_n*x^n + ... + a_1*x + a_0, in order from least to greatest.
+#
+# The possibility of overflow or underflow is ignored. Overflow is likely to be
+# a bigger problem than underflow.
+#
+# Do not use this code to guide missiles or control nuclear power plants.
+#
+sub bkell_real_zeros_finder {
+ my @coeffs = @_;
+
+ while (@coeffs && $coeffs[0] == 0) { shift @coeffs; }
+ my $deg = $#coeffs;
+
+ if ($deg == -1) {
+ return ("x"); # zero polynomial is zero everywhere
+ } elsif ($deg == 0) {
+ return (); # constant nonzero polynomial has no zeros
+ } elsif ($deg == 1) {
+ return (-$coeffs[1] / $coeffs[0]); # linear polynomial has one zero
+ }
+
+ # find critical points
+ my @derivative = @coeffs;
+ pop @derivative;
+ for (my $i = 0; $i < $#derivative; ++$i) {
+ $derivative[$i] *= @derivative - $i;
+ }
+ my @cp = bkell_real_zeros_finder(@derivative);
+
+ # if no critical points, we have a monotone function
+ if (!@cp) {
+ my ($lb, $rb) = (-1, 1);
+ my $y1 = bkell_poly_eval($lb, @coeffs);
+ my $y2 = bkell_poly_eval($rb, @coeffs);
+ my $sign = ($y1 < $y2 ? +1 : -1);
+ while ($sign * $y1 > 0) {
+ $lb *= 2;
+ $y1 = bkell_poly_eval($lb, @coeffs);
+ }
+ while ($sign * $y2 < 0) {
+ $rb *= 2;
+ $y2 = bkell_poly_eval($rb, @coeffs);
+ }
+ my $guess_x = ($lb + $rb) / 2;
+ while ($lb < $guess_x
+ && $guess_x < $rb
+ && (my $guess_y = bkell_poly_eval($guess_x, @coeffs)) != 0)
+ {
+ if (($y1 < 0 && $guess_y < 0) || ($y1 > 0 && $guess_y > 0)) {
+ $lb = $guess_x;
+ } else {
+ $rb = $guess_x;
+ }
+ $guess_x = ($lb + $rb) / 2;
+ }
+ return ($guess_x);
+ }
+
+ my @zeros = ();
+
+ # search for a zero to the left of the first critical point
+ {
+ my $y = bkell_poly_eval($cp[0], @coeffs);
+ # we catch this case when we check between critical points:
+ last if $y == 0;
+ # not really the limit, but only the sign matters:
+ my $lim = $coeffs[0] * ($deg % 2 ? -1 : +1);
+ if (($y > 0 && $lim < 0) || ($y < 0 && $lim > 0)) {
+ my ($lb, $rb) = (undef, $cp[0]);
+ my $guess_x = $rb - 10;
+ if ($guess_x >= 0) { $guess_x = -10; }
+ while ((!defined $lb || $lb < $guess_x)
+ && $guess_x < $rb
+ && (my $guess_y = bkell_poly_eval($guess_x, @coeffs)) != 0)
+ {
+ if (($y > 0 && $guess_y > 0) || ($y < 0 && $guess_y < 0)) {
+ $rb = $guess_x;
+ if (defined $lb) {
+ $guess_x = ($lb + $guess_x) / 2;
+ } else {
+ $guess_x *= 2;
+ }
+ } else {
+ $lb = $guess_x;
+ $guess_x = ($guess_x + $rb) / 2;
+ }
+ }
+ push @zeros, $guess_x;
+ }
+ }
+
+ # search for zeros between critical points
+ for (my $i = 0; $i < $#cp; ++$i) {
+ my $y1 = bkell_poly_eval($cp[$i], @coeffs);
+ if ($y1 == 0) {
+ push @zeros, $cp[$i];
+ next;
+ }
+ my $y2 = bkell_poly_eval($cp[ $i + 1 ], @coeffs);
+ if ($y2 == 0) {
+ push @zeros, $cp[ $i + 1 ];
+ ++$i;
+ next;
+ }
+ next if ($y1 > 0 && $y2 > 0) || ($y1 < 0 && $y2 < 0);
+ my ($lb, $rb) = ($cp[$i], $cp[ $i + 1 ]);
+ my $guess_x = ($lb + $rb) / 2;
+ while ($lb < $guess_x
+ && $guess_x < $rb
+ && (my $guess_y = bkell_poly_eval($guess_x, @coeffs)) != 0)
+ {
+ if (($y1 > 0 && $guess_y > 0) || ($y1 < 0 && $guess_y < 0)) {
+ $lb = $guess_x;
+ } else {
+ $rb = $guess_x;
+ }
+ $guess_x = ($lb + $rb) / 2;
+ }
+ push @zeros, $guess_x unless @zeros && $zeros[-1] == $guess_x;
+ }
+
+ # search for a zero to the right of the last critical point
+ {
+ my $y = bkell_poly_eval($cp[-1], @coeffs);
+ if ($y == 0 && $zeros[-1] != $cp[-1]) {
+ push @zeros, $cp[-1];
+ last;
+ }
+ if (($y > 0 && $coeffs[0] < 0) || ($y < 0 && $coeffs[0] > 0)) {
+ my ($lb, $rb) = ($cp[-1], undef);
+ my $guess_x = $lb + 10;
+ if ($guess_x <= 0) { $guess_x = 10; }
+ while ($lb < $guess_x
+ && (!defined $rb || $guess_x < $rb)
+ && (my $guess_y = bkell_poly_eval($guess_x, @coeffs)) != 0)
+ {
+ if (($y > 0 && $guess_y > 0) || ($y < 0 && $guess_y < 0)) {
+ $lb = $guess_x;
+ if (defined $rb) {
+ $guess_x = ($guess_x + $rb) / 2;
+ } else {
+ $guess_x *= 2;
+ }
+ } else {
+ $rb = $guess_x;
+ $guess_x = ($lb + $guess_x) / 2;
+ }
+ }
+ push @zeros, $guess_x unless @zeros && $zeros[-1] == $guess_x;
+ }
+ }
+
+ return @zeros;
+}
+
+###############################################################################
+# bkell_floor($x)
+#
+# Returns the floor of $x. Normally this would be done with POSIX::floor, but
+# WeBWorK doesn't allow you to use standard modules like POSIX.
+#
+sub bkell_floor {
+ my $x = shift;
+ my $floor = int $x;
+ if ($x < 0 && $x != $floor) { $floor -= 1; }
+ return $floor;
+}
+
+###############################################################################
+# bkell_ceil($x)
+#
+# Returns the ceiling of $x.
+#
+sub bkell_ceil {
+ return -bkell_floor(-shift);
+}
+
+###############################################################################
+# bkell_sigfigs($x, $n)
+#
+# Returns a string containing $x rounded to $n significant figures.
+#
+sub bkell_sigfigs {
+ my ($x, $n) = @_;
+
+ if ($x == 0) { return "0" . ($n > 1 ? "." : "") . ("0" x ($n - 1)); }
+
+ my $minus = "";
+ if ($x < 0) {
+ $minus = "-";
+ $x = -$x;
+ }
+
+ my $floor_log = bkell_floor(log($x) / log(10));
+
+ if ($floor_log + 1 >= $n) {
+ my $sf = 10**($floor_log - $n + 1);
+ return $minus . (sprintf("%.0f", $x / $sf) * $sf);
+ } else {
+ my $digits = $n - $floor_log - 1;
+ return $minus . sprintf("%.${digits}f", $x);
+ }
+}
+
+###############################################################################
+# bkell_125($x)
+#
+# Returns the value logarithmically nearest $x in the sequence
+# ..., -1000, -500, -200, -100, -50, -20, -10, -5, -2, -1, -0.5, -0.2,
+# -0.1, -0.05, -0.02, -0.01, ..., 0, ..., 0.01, 0.02, 0.05, 0.1,
+# 0.2, 0.5, 1, 2, 5, 10, 20, 50, 100, 200, 500, 1000, ... .
+#
+sub bkell_125 {
+ my $x = shift;
+
+ if ($x == 0) { return 0; }
+
+ my $sign = +1;
+ if ($x < 0) { $sign = -1; $x = -$x; }
+
+ my $log = log($x) / log(10);
+ my $characteristic = bkell_floor($log);
+ my $mantissa = $log - $characteristic;
+
+ my $log2 = log(2) / log(10);
+ my $log5 = log(5) / log(10);
+ my $m;
+ if ($mantissa < $log2 / 2) {
+ $m = 0;
+ } elsif ($mantissa < ($log2 + $log5) / 2) {
+ $m = $log2;
+ } elsif ($mantissa < ($log5 + 1) / 2) {
+ $m = $log5;
+ } else {
+ $m = 1;
+ }
+
+ return $sign * (10**($characteristic + $m));
+}
+
+###############################################################################
+# bkell_list_random_selection($n, @list)
+#
+# Returns a selection of $n distinct elements of @list. This is like
+# list_random_multi_uniq in freemanMacros.pl, except that this function will
+# always return the elements in the same order as they appear in @list.
+#
+sub bkell_list_random_selection {
+ my $n = int abs shift; # so strange $n won't cause infinite loop
+ my @list = @_;
+
+ my $needed = $n;
+ my @result = ();
+ while ($needed && @list) {
+ if (random(1, scalar @list) <= $needed) {
+ push @result, shift @list;
+ --$needed;
+ } else {
+ shift @list;
+ }
+ }
+
+ return @result;
+}
+
+###############################################################################
+# bkell_graph_axis($a, $b)
+#
+# Returns a list ($min, $max, $step), where $min <= $a, $max >= $b, $step is a
+# power of 10, $min and $max are multiples of $step, abs($min) <= 9*$step, and
+# abs($max) <= 9*$step. Useful for deciding bounds for the axis of a graph. For
+# example, to make a graph axis that can handle values between $a and $b, call
+# bkell_graph_axis, and then set the minimum value of the axis to $min and the
+# maximum to $max, and put tick marks every $step units.
+#
+sub bkell_graph_axis {
+ my ($a, $b) = @_;
+
+ if ($a > $b) { ($a, $b) = ($b, $a); }
+
+ my $s1 = 0;
+ my $s2 = 0;
+
+ if ($a != 0) { $s1 = bkell_floor(log(abs $a) / log(10)); }
+ if ($b != 0) { $s2 = bkell_floor(log(abs $b) / log(10)); }
+
+ my $s = ($s1 > $s2 ? $s1 : $s2);
+
+ $step = 10**$s;
+ $min = $step * bkell_floor($a / $step);
+ $max = $step * bkell_ceil($b / $step);
+
+ return ($min, $max, $step);
+}
+
+####################################################################### EOF ###
diff --git a/macros/deprecated/hhAdditionalMacros.pl b/macros/deprecated/hhAdditionalMacros.pl
new file mode 100755
index 0000000000..6f430ae29b
--- /dev/null
+++ b/macros/deprecated/hhAdditionalMacros.pl
@@ -0,0 +1,437 @@
+# additional macros developed in conjunction with the problems from
+# the consortium (hughes-hallett) calculus text
+#
+# written by Gavin LaRose,
+# version 1.2
+# 1.2: added reduced_frac()
+# 1.1: added numorfun_cmp()
+#
+# shufflemap
+# produces a reference to a hash of indices from 0 to n-1 pointing to
+# a random permutation of the same, and the index that points to 0
+#
+# string_list_cmp
+# check a comma-separated list of strings as student answers and
+# check them with the standard str_cmp evaluator. this is really
+# John Jones' number_list_cmp rewritten to be do string comparison
+#
+# integrand_fun_cmp
+# an answer evaluator that allows checking functions with 'dt' in them;
+# redundant now that the Parser allows checking with multicharacter
+# variables
+#
+# numfun_cmp
+# an answer evaluator that requires that the answer be
+# simplified to the number given without returning an error if
+# it's a function
+#
+# numorfun_cmp
+# an answer evaluator that first checks to see if the student answer
+# checks correctly as a number, and if so returns that result; if not,
+# repeats the check with a function checker and returns that. options
+# for the respective checkers are provided as separate hash references
+#
+# classify_cmp
+# take a correct answer of the form "val=string, val=string.."
+# and check a comma-separated list of student answers against these
+# if the option 'order'=>'strict' is provided, requires that the
+# answers be in the same order. any other options are passed to
+# num_cmp to check the val entries; strings are checked with a
+# standard str_cmp
+# doesn't currently allow for passing in of a reference to an array
+# of solutions to generate a list of evaluators, but that would be
+# easy to add
+#
+
+sub reduced_frac {
+ my ($num, $den) = @_;
+
+ if ($num / $den == int($num / $den)) {
+ return $num / $den;
+ } else {
+ for (my $j = ($num > $den ? $den : $num); $j > 1; $j--) {
+ if ($num / $j == int($num / $j) && $den / $j == int($den / $j)) {
+ $num = $num / $j;
+ $den = $den / $j;
+ }
+ }
+ if ($den == 1) {
+ return $num;
+ } else {
+ return ("{$num" . '\over' . "$den}");
+ }
+ }
+}
+
+sub shufflemap {
+ my $n = shift();
+ my $m = $n - 1;
+ my $zeroind;
+
+ my %map = ();
+
+ my @vals = (0 .. $m);
+ for (my $i = 0; $i < $m; $i++) {
+ my $j = random(0, $m - $i, 1);
+ $map{$i} = $vals[$j];
+ $zeroind = $i if ($map{$i} == 0);
+ splice(@vals, $j, 1);
+ }
+ $map{$m} = $vals[0];
+ $zeroind = $m if ($map{$m} == 0);
+
+ return ({%map}, $zeroind);
+}
+
+sub string_list_cmp {
+ my $cList = shift();
+ my %opts = @_;
+
+ my $ordered = 0;
+ if (defined($opts{'ordered'})) {
+ $ordered = 1 if ($opts{'ordered'});
+ delete($opts{'ordered'});
+ }
+
+ my @cAns = split(/,\s*/, $cList);
+
+ my @ansEval = ();
+ foreach (@cAns) {
+ push(@ansEval, str_cmp($_, %opts));
+ }
+
+ return (sub {
+ my $sList = shift();
+ my @sAns = split(/,\s*/, $sList);
+
+ my $res = new AnswerHash;
+
+ if ($ordered) {
+ if (@sAns) {
+ my $res = $ansEval[0]->evaluate($sAns[0]);
+ for (my $i = 1; $i < @sAns && $i < @ansEval; $i++) {
+ $res = $res->AND($ansEval[$i]->evaluate($sAns[$i]));
+ }
+ if (@ansEval > @sAns) {
+ $res->{'score'} = 0;
+ for (my $j = @sAns; $j < @ansEval; $j++) {
+ my $fakeRes = $ansEval[$j]->evaluate('something');
+ $res->{'correct_ans'} .= "AND " . $fakeRes->{'correct_ans'};
+ }
+ } elsif (@sAns > @ansEval) {
+ $res->{'score'} = 0;
+ for (my $j = @ansEval; $j < @sAns; $j++) {
+ my $fakeRes = $ansEval[0]->evaluate($sAns[$j]);
+ $res->{'student_ans'} .= ", " . $fakeRes->{'student_ans'};
+ $res->{'original_student_ans'} .= ", " . $fakeRes->{'original_student_ans'};
+ }
+ }
+ return $res;
+ } else {
+ my $res = $ansEval[0]->evaluate('');
+ for (my $i = 1; $i < @ansEval; $i++) {
+ $res = $res->AND($ansEval[$i]->evaluate(''));
+ }
+ return $res;
+ }
+ } else {
+ # go through and check each in turn
+ my $res;
+ my @missedAnsEval = ();
+ my @doneStuAns = ();
+ my $stuAnsDone = '';
+ for (my $i = 0; $i < @ansEval; $i++) {
+ my $doneOne = 0;
+ for (my $j = 0; $j < @sAns; $j++) {
+ next if ($stuAnsDone =~ /\b$j\b/);
+ my $curRes = $ansEval[$i]->evaluate($sAns[$j]);
+ if ($curRes->{'score'}) {
+ if (ref($res)) {
+ $res = $res->AND($curRes);
+ $res->{'student_ans'} .= ", " . $curRes->{'student_ans'};
+ $res->{'original_student_ans'} .= ", " . $curRes->{'original_student_ans'};
+ } else {
+ $res = $curRes;
+ }
+ $stuAnsDone .= "$j,";
+ $doneOne = 1;
+ push(@doneStuAns, $j);
+ last;
+ }
+ }
+ push(@missedAnsEval, $i) if (!$doneOne);
+ }
+ # did we miss any correct answers?
+ if (@missedAnsEval) {
+ $res->{'score'} = 0;
+
+ foreach (@missedAnsEval) {
+ my $fakeRes = $ansEval[$_]->evaluate('something');
+ $res->{'correct_ans'} .= " AND " . $fakeRes->{'correct_ans'};
+ }
+ }
+ # did we miss any student answers?
+ if (@doneStuAns != @sAns) {
+ $res->{'score'} = 0;
+
+ for (my $i = 0; $i < @sAns; $i++) {
+ if ($stuAnsDone !~ /\b$i\b/) {
+ $res->{'student_ans'} .= ", " . uc($sAns[$i]);
+ $res->{'original_student_ans'} .= ", " . $sAns[$i];
+ $res->{'preview_latex_string'} .= "\\quad \\mbox{" . uc($sAns[$i]) . "}";
+ }
+ }
+ }
+ return $res;
+ }
+ });
+}
+
+# integrand_fun_cmp
+# an answer evaluator to allow checking functions with 'dt' in them
+#
+sub integrand_fun_cmp {
+ my $cAns = shift();
+ my %opts = @_;
+
+ if (defined($opts{'var'}) && $opts{'var'}) {
+ $differential = "d" . $opts{'var'}->[0]; # we assume the first
+ push(@{ $opts{'var'} }, 'Q'); # variable is the
+ } else { # independent variable
+ $differential = "dx";
+ $opts{'var'} = [ 'x', 'Q' ];
+ }
+ $cAns =~ s/$differential/Q/;
+ $eval = fun_cmp($cAns, %opts);
+
+ return (sub {
+ my $sAns = shift();
+ $sAns = '' if (!defined($sAns));
+ $sAns =~ s/$differential/Q/;
+
+ my $ansHash = $eval->evaluate($sAns);
+ # replace Q with the correct differential
+ # are there missing values?
+ foreach my $v (qw( correct_ans original_correct_ans student_ans
+ original_student_ans preview_text_string
+ preview_latex_string ))
+ {
+ $ansHash->{$v} = '' if (!defined($ansHash->{$v}));
+ }
+ $ansHash->{'correct_ans'} =~ s/Q/$differential/;
+ $ansHash->{'original_correct_ans'} =~ s/Q/$differential/;
+ $ansHash->{'student_ans'} =~ s/Q/$differential/;
+ $ansHash->{'original_student_ans'} =~ s/Q/$differential/;
+ $ansHash->{'preview_text_string'} =~ s/Q/$differential/;
+ $ansHash->{'preview_latex_string'} =~ s/Q/$differential/;
+
+ return $ansHash;
+ });
+}
+
+# numfun_cmp
+# an answer evaluator that requires that the answer be
+# simplified to the number given without returning an error if
+# it's a function
+#
+sub numfun_cmp {
+ my $cAns = shift();
+ my %opts = @_;
+
+ my $eval1 = fun_cmp($cAns, @_);
+ my $eval2 = num_cmp($cAns, @_);
+
+ return (sub {
+ my $sAns = shift();
+ my $ans1 = $eval1->evaluate($sAns);
+ my $ans2 = $eval2->evaluate($sAns);
+
+ if ($ans2->{'score'}) {
+ return ($ans2);
+ } else {
+ $ans1->{'score'} = 0;
+ return ($ans1);
+ }
+ });
+}
+
+# numorfun_cmp
+# an answer evaluator that first checks to see if the student answer
+# checks correctly as a number, and if so returns that result; if not,
+# repeats the check with a function checker and returns that.
+#
+sub numorfun_cmp {
+ my $cAns = shift();
+ my ($numOptsRef, $funOptsRef) = @_;
+ my $eval1 = fun_cmp($cAns, %$funOptsRef);
+ my $eval2 = num_cmp($cAns, %$numOptsRef);
+
+ return (sub {
+ my $sAns = shift();
+ my $ans1 = $eval1->evaluate($sAns);
+ my $ans2 = $eval2->evaluate($sAns);
+
+ if ($ans2->{'score'}) {
+ return ($ans2);
+ } else {
+ return ($ans1);
+ }
+ });
+}
+
+sub classify_num_cmp {
+ return classify_cmp(@_, 'classifymode' => 'num');
+}
+
+sub classify_fun_cmp {
+ return classify_cmp(@_, 'classifymode' => 'fun');
+}
+
+sub classify_cmp {
+ my $cAns = shift();
+ my %opts = @_;
+
+ my $classifymode = 'num';
+ if (defined($opts{'classifymode'})) {
+ $classifymode = $opts{'classifymode'};
+ delete($opts{'classifymode'});
+ }
+
+ my $ordered = 0;
+ if (defined($opts{'order'})) {
+ $ordered = 1 if ($opts{'order'} eq 'strict');
+ delete($opts{'order'});
+ }
+
+ my @pts = split(/\s*,\s*/, $cAns);
+
+ my @xeval;
+ my @ceval;
+ foreach (@pts) {
+ my ($x, $c) = split(/\s*=\s*/);
+ $c = '' if (!defined($c));
+ if ($classifymode eq 'num') {
+ push(@xeval, num_cmp($x, %opts));
+ } else {
+ push(@xeval, fun_cmp($x, %opts));
+ }
+ push(@ceval, str_cmp($c));
+ }
+
+ return (sub {
+ my $sAns = shift();
+ my @sAnsList = split(/\s*,\s*/, $sAns);
+ my @sAnsw = ();
+ foreach (@sAnsList) {
+ my ($x, $c) = split(/\s*=\s*/);
+ $x = 'none' if (!defined($x));
+ $c = '' if (!defined($c));
+ push(@sAnsw, [ $x, $c ]);
+ }
+
+ # now build a set of answer hashes, one for each student answer
+ my @results = ();
+ my @undone = (); # list of unused evaluators
+ my $nummatched = 0; # number of student answers matched
+ for (my $j = 0; $j < @xeval; $j++) {
+ my $done = 0;
+ if ($ordered) {
+ if ($j < @sAnsw) {
+ my $x_hash = $xeval[$j]->evaluate($sAnsw[$j]->[0]);
+ my $c_hash = $xeval[$j]->evaluate($sAnsw[$j]->[1]);
+ my $res = $x_hash->AND($c_hash);
+ $res->{'preview_text_string'} =
+ $x_hash->{'preview_text_string'} . "=" . $c_hash->{'preview_text_string'};
+ $res->{'preview_latex_string'} =
+ $x_hash->{'preview_latex_string'} . "=" . $c_hash->{'preview_latex_string'};
+ $results[$j] = $res;
+ $nummatched++;
+ } else {
+ last;
+ }
+ } else {
+ for (my $i = 0; $i < @sAnsw; $i++) {
+ my $x_hash = $xeval[$j]->evaluate($sAnsw[$i]->[0]);
+
+ if ($x_hash->score()) {
+ my $c_hash = $ceval[$j]->evaluate($sAnsw[$i]->[1]);
+
+ my $res = $x_hash->AND($c_hash);
+ $res->{'preview_text_string'} = $x_hash->{'preview_text_string'};
+ $res->{'preview_latex_string'} = $x_hash->{'preview_latex_string'};
+
+ if (defined($c_hash->{preview_text_string})
+ && $c_hash->{preview_text_string} ne '')
+ {
+ $res->{preview_text_string} .= "=" . $c_hash->{'preview_text_string'};
+ $res->{preview_latex_string} .= "=" . $c_hash->{'preview_latex_string'};
+ }
+ $results[$i] = $res;
+ $done = 1;
+ $nummatched++;
+ }
+ last if ($done);
+ }
+ if (!$done) {
+ push(@undone, [ $xeval[$j], $ceval[$j] ]);
+ }
+ }
+ last if ($nummatched == @sAnsw);
+ }
+ # check any student answers we haven't yet matched
+ if ($nummatched < @sAnsw) {
+ for (my $i = 0; $i < @sAnsw; $i++) {
+ next if (ref($results[$i]));
+ my ($x_hash, $c_hash, $res);
+ if (@undone) {
+ my $aeval = shift(@undone);
+ $x_hash = $aeval->[0]->evaluate($sAnsw[$i]->[0]);
+ $c_hash = $aeval->[1]->evaluate($sAnsw[$i]->[1]);
+ $res = $x_hash->AND($c_hash);
+ } else {
+ $res = new AnswerHash;
+ $res->{'correct_ans'} = 'none';
+ $res->{'original_correct_ans'} = 'none';
+ $res->{'student_ans'} = $sAnsw[$i]->[0] . "=" . $sAnsw[$i]->[1];
+ $res->{'original_student_ans'} = $sAnsw[$i]->[0] . "=" . $sAnsw[$i]->[1];
+ $res->{'score'} = 0;
+ $x_hash = $xeval[0]->evaluate($sAnsw[$i]->[0]);
+ $c_hash = $ceval[0]->evaluate($sAnsw[$i]->[1]);
+ }
+ $res->{'preview_text_string'} = $x_hash->{'preview_text_string'};
+ $res->{'preview_latex_string'} = $x_hash->{'preview_latex_string'};
+ if (defined($c_hash->{preview_text_string})
+ && $c_hash->{preview_text_string} ne '')
+ {
+ $res->{preview_text_string} .= "=" . $c_hash->{'preview_text_string'};
+ $res->{preview_latex_string} .= "=" . $c_hash->{'preview_latex_string'};
+ }
+ $results[$i] = $res;
+ }
+ }
+ # and get any other results they didn't submit
+ my @neededResults = ();
+ foreach (@undone) {
+ my $r = $_->[0]->evaluate('');
+ $r->AND($_->[1]->evaluate(''));
+ $r->{score} = 0;
+ push(@neededResults, $r);
+ }
+
+ # ok, now build a big and...
+ my $endres = (defined($results[0])) ? $results[0] : new AnswerHash;
+ for (my $i = 1; $i < @results; $i++) {
+ $endres = $endres->AND($results[$i]);
+ }
+ # for ( my $i=0; $i<@neededResults; $i++ ) {
+ # $endres = $endres->AND( $neededResults[$i] );
+ # }
+ $endres->{'student_ans'} = $sAns;
+ $endres->{'score'} = 0 if (@xeval > @sAnsw);
+
+ return $endres;
+ });
+}
+
+1;
+
diff --git a/macros/deprecated/littleneck.pl b/macros/deprecated/littleneck.pl
new file mode 100644
index 0000000000..bbfb1fa03f
--- /dev/null
+++ b/macros/deprecated/littleneck.pl
@@ -0,0 +1,191 @@
+#*****************************
+# Question mode variables
+#*****************************
+$PRACTICE_MODE = 0;
+loadMacros("problemRandomize.pl");
+#********************************************
+# Set up a "generate new problem" button
+#********************************************
+sub rand_button {
+ if ($PRACTICE_MODE == 1) {
+ ProblemRandomize(when => "Always", onlyAfterDue => 0, style => "Input");
+ } elsif ($PRACTICE_MODE == 2) {
+ ProblemRandomize(when => "Always", onlyAfterDue => 0, label => "Generate New Problem");
+ }
+}
+#**********************************************************
+# Subroutine to reduce fractions
+# Input : Num, Denom
+# Output: Num, Denom, Wholenum (if != 0, = $num/$denom)
+#
+# 22Jul09 - Returned Wholenum < 0 if num or denom < 0
+#**********************************************************
+sub reduce_fraction {
+ $n = $_[0];
+ $d = $_[1];
+ $wholenum = 0;
+ #
+ # **********************
+ # Remove negatives
+ # **********************
+ if ($n < 0) {
+ $num = -$n;
+ } else {
+ $num = $n;
+ }
+ if ($d < 0) {
+ $denom = -$d;
+ } else {
+ $denom = $d;
+ }
+ # ******************************
+ # Check for a whole number
+ # ******************************
+ if ($num / $denom == int($num / $denom)) {
+ $wholenum = $n / $d;
+ }
+ # ***************
+ # Find gcf
+ # ***************
+ else {
+ if ($num > $denom) {
+ $gcf = $denom;
+ } else {
+ $gcf = $num;
+ }
+ $found = 0;
+ while (($found == 0) && ($gcf > 1)) {
+ if (($num / $gcf == int($num / $gcf)) && ($denom / $gcf == int($denom / $gcf))) {
+ $found = 1;
+ } else {
+ $gcf--;
+ }
+ }
+ # ********************************
+ # If a GCF was found, reduce
+ # ********************************
+ if ($found == 1) {
+ $num = $num / $gcf;
+ $denom = $denom / $gcf;
+ }
+ }
+ # ***********************
+ # Restore negatives
+ # ***********************
+ if ($n < 0) {
+ $num = -1 * $num;
+ }
+ if ($d < 0) {
+ $denom = -1 * $denom;
+ }
+ return ($num, $denom, $wholenum);
+}
+#
+#**********************************************************
+# Subroutine to produce reduced display fraction
+# Input : Num($n), Denom($d)
+# Output: Num($n), Denom($d), Wholenum($w),Display($display)
+# calls reduce_fraction to get,
+# Output: Num($n), Denom($d), Wholenum($w),
+#(if Wholenum > 0,$display = $w
+# else $Display=\(\frac{$n}{$d}\)
+#**********************************************************
+sub display_fraction_long {
+ $n = $_[0];
+ $d = $_[1];
+ $w = 0;
+ $display = 0;
+ #call reduce_fraction
+ ($n, $d, $w) = reduce_fraction($n, $d, $w);
+ #Decide on display format
+ if ($w > 0) {
+ $display = $wholenumber;
+ } else {
+ $display = "\\frac{$num}{$denom}";
+ }
+ return ($n, $d, $w, $display);
+}
+#
+#
+#
+#
+#**********************************************************
+# Subroutine to produce reduced display fraction
+# Input : Num($n), Denom($d)
+# Output: Display($display)
+# calls reduce_fraction to get,
+# Output: Num($n), Denom($d), Wholenum($w),
+#(if Wholenum > 0,$display = $w
+# else $Display=\(\frac{$n}{$d}\)
+#**********************************************************
+sub display_fraction {
+ $n = $_[0];
+ $d = $_[1];
+ $w = 0;
+ $display = 0;
+ #call reduce_fraction
+ ($n, $d, $w) = reduce_fraction($n, $d, $w);
+ #Decide on display format
+ if ($w > 0) {
+ $display = $wholenumber;
+ } else {
+ $display = "\\frac{$num}{$denom}";
+ }
+ return ($display);
+}
+#*******************************************************************************
+# sqrt_simplify(Num,Natnum,Radnum,Texstr,Error)
+#
+# Description: Given a natural number, will find the greatest perfect square
+# that is a factor and use this to simplify the expression:
+# sqrt(number).
+# Input :
+# Num = Number whose sqrt is being taken
+#
+# Output:
+# Natnum => Natural number portion of solution (= 1 if no perfect square
+# divides evenly)
+# Radnum => The value still inside the radical
+# Texstr => A LaTex string of the form "Natnum \sqrt{$Radnum}" to be used
+# for displaying the solution.
+# Error => If == 1, then the number entered was bad (ie, negative, nonint)
+# (If necessary, this code can be made specific for the error)
+#*******************************************************************************
+sub sqrt_simplify {
+ $number = $_[0];
+ ($Natnum, $Radnum) = (1, 1);
+ $Error = 0;
+
+ #***********************************
+ # Check the number for validity
+ #***********************************
+ if (($number == int($number)) && ($number > 0)) {
+ $perfsqr = 1;
+ #*************************************************************************************
+ # Check all perfect squares up to the max and store the hightest one that divides
+ #*************************************************************************************
+ for ($i = 2; $i * $i <= $number; $i++) {
+ $sqr = $i * $i;
+ if (int($number / $sqr) == $number / $sqr) {
+ $perfsqr = $i;
+ }
+ }
+ $Natnum = $perfsqr;
+ $Radnum = $number / ($Natnum * $Natnum);
+ #************************************************************
+ # If radnum = 1, the original number is a perfect square
+ # If natnum = 1, it cannot be simplified
+ #************************************************************
+ if ($Radnum == 1) {
+ $Texstr = "$Natnum";
+ } elsif ($Natnum == 1) {
+ $Texstr = "\\sqrt{$number}";
+ } else {
+ $Texstr = "$Natnum \\sqrt{$Radnum}";
+ }
+ } else {
+ ($Natnum, $Radnum, $Error) = 1;
+ $Texstr = "1";
+ }
+ return ($Num, $Natnum, $Radnum, $Texstr, $Error);
+}
diff --git a/macros/AppletObjects.pl b/macros/graph/AppletObjects.pl
similarity index 100%
rename from macros/AppletObjects.pl
rename to macros/graph/AppletObjects.pl
diff --git a/macros/CanvasObject.pl b/macros/graph/CanvasObject.pl
similarity index 100%
rename from macros/CanvasObject.pl
rename to macros/graph/CanvasObject.pl
diff --git a/macros/LiveGraphics3D.pl b/macros/graph/LiveGraphics3D.pl
similarity index 98%
rename from macros/LiveGraphics3D.pl
rename to macros/graph/LiveGraphics3D.pl
index ad64b0d3bb..4eeed59648 100644
--- a/macros/LiveGraphics3D.pl
+++ b/macros/graph/LiveGraphics3D.pl
@@ -26,7 +26,7 @@ =head2 LiveGraphics3D.pl
# Live3Ddata load raw Graphics3D data
# LiveGraphics3D access to all parameters
#
-
+
#
# LiveGraphics3D(options)
#
@@ -58,7 +58,7 @@ =head2 LiveGraphics3D.pl
# or when Java is disabled
#
# tex_size => ratio a scaling factor for the TeX image (as a portion
- # of the line width).
+ # of the line width).
# 1000 is 100%, 500 is 50%, etc.
#
# tex_center => 0 or 1 center the image in TeX mode or not
diff --git a/macros/graph/LiveGraphicsCylindricalPlot3D.pl b/macros/graph/LiveGraphicsCylindricalPlot3D.pl
new file mode 100644
index 0000000000..2abc7ae1fd
--- /dev/null
+++ b/macros/graph/LiveGraphicsCylindricalPlot3D.pl
@@ -0,0 +1,205 @@
+sub _LiveGraphicsCylindricalPlot3D_init { }; # don't reload this file
+
+loadMacros("MathObjects.pl", "LiveGraphics3D.pl");
+
+###########################################################################
+#
+# LiveGraphicsCylindricalPlot3D.pl provides a macros for creating an
+# interactive plot of a function of two variables z = f(r,t)
+# (where r is the radius and t=theta is the angle) via the LiveGraphics3D
+# Java applet. The routine CylindricalPlot3D() takes a MathObject Formula
+# of two variables defined over an annular domain and some plot options
+# as input and returns a string of plot data that can be displayed
+# using the Live3Ddata() routine of the LiveGraphics3D.pl macro.
+#
+# LiveGraphicsCylindricalPlot3D.pl automatically loads
+# MathObjects.pl and LiveGraphics3D.pl.
+#
+###########################################################################
+#
+# The main routine is
+#
+# CylindricalPlot3D
+#
+#
+# Usage: CylindricalPlot3D(options)
+#
+# Options are:
+#
+# function => $f, $f is a MathObjects Formula
+# For example, in the setup section define
+#
+# Context("Numeric");
+# Context()->variables->add(r=>"Real",t=>"Real");
+# $a = random(1,3,1);
+# $f = Formula("$a*r + t"); # use double quotes!
+#
+# before calling CylindricalPlot3D()
+#
+# rvar => "r", independent variable name, default "r"
+# tvar => "t", independent variable name, default "t"
+#
+# rmin => 0, domain for rvar
+# rmax => 3,
+#
+# tmin => -3, domain for tvar
+# tmax => 3,
+#
+# rsamples => 20, deltar = (rmax - rmin) / rsamples
+# tsamples => 20, deltat = (tmax - tmin) / tsamples
+#
+# axesframed => 1, 1 displays framed axes, 0 hides framed axes
+#
+# xaxislabel => "X", Capital letters may be easier to read
+# yaxislabel => "Y",
+# zaxislabel => "Z",
+#
+# outputtype => 1, return string of only polygons (or mesh)
+# 2, return string of only plotoptions
+# 3, return string of polygons (or mesh) and plotoptions
+# 4, return complete plot
+#
+# Happy 3D graphing! -Paul Pearson
+#
+#######################################################################################
+
+$beginplot = "Graphics3D[";
+$endplot = "]";
+
+#############################################
+# Begin CylindricalPlot3D
+
+sub CylindricalPlot3D {
+
+#############################################
+ #
+ # Set default options
+ #
+
+ my %options = (
+ function => Formula("1"),
+ rvar => "r",
+ tvar => "t",
+ rmin => 0.001,
+ rmax => 3,
+ tmin => 0,
+ tmax => 6.28,
+ rsamples => 20,
+ tsamples => 20,
+ axesframed => 1,
+ xaxislabel => "X",
+ yaxislabel => "Y",
+ zaxislabel => "Z",
+ outputtype => 4,
+ @_
+ );
+
+ my $fsubroutine;
+ $options{function}->perlFunction('fsubroutine', [ "$options{rvar}", "$options{tvar}" ]);
+
+######################################################
+ #
+ # Generate a plotdata array, which has two indices
+ #
+
+ my $rsamples1 = $options{rsamples} - 1;
+ my $tsamples1 = $options{tsamples} - 1;
+
+ my $dr = ($options{rmax} - $options{rmin}) / $options{rsamples};
+ my $dt = ($options{tmax} - $options{tmin}) / $options{tsamples};
+
+ my $r;
+ my $t;
+
+ my $x;
+ my $y;
+ my $z;
+
+ foreach my $i (0 .. $options{tsamples}) {
+ $t[$i] = $options{tmin} + $i * $dt;
+ foreach my $j (0 .. $options{rsamples}) {
+ $r[$j] = $options{rmin} + $j * $dr;
+ $x[$i][$j] = $r[$j] * cos($t[$i]);
+ $y[$i][$j] = $r[$j] * sin($t[$i]);
+ $z[$i][$j] = sprintf("%.3f", fsubroutine($r[$j], $t[$i])->value);
+ $x[$i][$j] = sprintf("%.3f", $x[$i][$j]);
+ $y[$i][$j] = sprintf("%.3f", $y[$i][$j]);
+ }
+ }
+
+###########################################################################
+ #
+ # Generate a plotstring from the plotdata.
+ #
+ # The plotstring is a list of polygons that
+ # LiveGraphics3D reads as input.
+ #
+ # For more information on the format of the plotstring, see
+ # http://www.math.umn.edu/~rogness/lg3d/page_NoMathematica.html
+ # http://www.vis.uni-stuttgart.de/~kraus/LiveGraphics3D/documentation.html
+ #
+###########################################
+ #
+ # Generate the polygons in the plotstring
+ #
+
+ my $plotstructure = "{";
+
+ foreach my $i (0 .. $tsamples1) {
+ foreach my $j (0 .. $rsamples1) {
+
+ $plotstructure =
+ $plotstructure
+ . "Polygon[{"
+ . "{$x[$i][$j],$y[$i][$j],$z[$i][$j]},"
+ . "{$x[$i+1][$j],$y[$i+1][$j],$z[$i+1][$j]},"
+ . "{$x[$i+1][$j+1],$y[$i+1][$j+1],$z[$i+1][$j+1]},"
+ . "{$x[$i][$j+1],$y[$i][$j+1],$z[$i][$j+1]}" . "}]";
+
+ if (($i < $tsamples1) || ($j < $rsamples1)) {
+ $plotstructure = $plotstructure . ",";
+ }
+
+ }
+ }
+
+ $plotstructure = $plotstructure . "}";
+
+##############################################
+ #
+ # Add plot options to the plotoptions string
+ #
+
+ my $plotoptions = "";
+
+ if (($options{outputtype} > 1) || ($options{axesframed} == 1)) {
+ $plotoptions =
+ $plotoptions
+ . "Axes->True,AxesLabel->"
+ . "{$options{xaxislabel},$options{yaxislabel},$options{zaxislabel}}";
+ }
+
+####################################################
+ #
+ # Return only the plotstring (if outputtype=>1),
+ # or only plotoptions (if outputtype=>2),
+ # or plotstring, plotoptions (if outputtype=>2),
+ # or the entire plot (default) (if outputtype=>4)
+
+ if ($options{outputtype} == 1) {
+ return $plotstructure;
+ } elsif ($options{outputtype} == 2) {
+ return $plotoptions;
+ } elsif ($options{outputtype} == 3) {
+ return "{" . $plotstructure . "," . $plotoptions . "}";
+ } elsif ($options{outputtype} == 4) {
+ return $beginplot . $plotstructure . "," . $plotoptions . $endplot;
+ } else {
+ return "Invalid outputtype (outputtype should be a number 1 through 4).";
+ }
+
+} # End CylindricalPlot3D
+#####################################################
+#####################################################
+
+1;
diff --git a/macros/graph/LiveGraphicsParametricCurve3D.pl b/macros/graph/LiveGraphicsParametricCurve3D.pl
new file mode 100644
index 0000000000..c6e4defc9c
--- /dev/null
+++ b/macros/graph/LiveGraphicsParametricCurve3D.pl
@@ -0,0 +1,194 @@
+sub _LiveGraphicsParametricCurve3D_init { }; # don't reload this file
+
+loadMacros("MathObjects.pl", "LiveGraphics3D.pl");
+
+###########################################################################
+#
+# LiveGraphicsParametricCurve3D.pl provides a macros for creating an
+# interactive plot of a vector field via the LiveGraphics3D Java applet.
+# The routine ParametricCurve3D() takes three MathObject Formulas of
+# 3 variables as input and returns a string of plot data that can be
+# displayed using the Live3Ddata() routine of the LiveGraphics3D.pl macro.
+#
+# LiveGraphicsParametricCurve3D.pl automatically loads
+# MathObjects.pl and LiveGraphics3D.pl.
+#
+###########################################################################
+#
+# The main routine is
+#
+# ParametricCurve3D()
+#
+#
+# Usage: ParametricCurve3D(options);
+#
+# Options are:
+#
+# Fx => Formula("t*cos(t)"), F = < Fx, Fy, Fz > where Fx, Fy, Fz are each
+# Fy => Formula("t*sin(t)"), functions of tvar
+# Fz => Formula("t"),
+#
+# tvar => "t", independent variable name, default "t"
+# tmin => -3, domain for tvar
+# tmax => 3,
+# tsamples => 3, deltat = (tmax - tmin) / tsamples
+#
+# axesframed => 1, 1 displays framed axes, 0 hides framed axes
+#
+# xaxislabel => "X", Capital letters may be easier to read
+# yaxislabel => "Y",
+# zaxislabel => "Z",
+#
+# orientation => 0, do not show any orientation arrows
+# => 1, show only one arrow in the middle
+# => 2, make the curve entirely of arrows
+#
+# curvecolor => "RGBColor[1.0,0.0,0.0]",
+# curvethickness => 0.001,
+#
+# outputtype => 1, return string of only polygons (or mesh)
+# 2, return string of only plotoptions
+# 3, return string of polygons (or mesh) and plotoptions
+# 4, return complete plot
+#
+# Happy 3D graphing! -Paul Pearson
+#
+#######################################################################################
+
+$beginplot = "Graphics3D[";
+$endplot = "]";
+
+###########################################
+###########################################
+# Begin ParametricCurve3D
+
+sub ParametricCurve3D {
+
+###########################################
+ #
+ # Set default options
+ #
+
+ my %options = (
+ Fx => Formula("1"),
+ Fy => Formula("1"),
+ Fz => Formula("1"),
+ tvar => 't',
+ tmin => -3,
+ tmax => 3,
+ tsamples => 20,
+ orientation => 0,
+ axesframed => 1,
+ xaxislabel => "X",
+ yaxislabel => "Y",
+ zaxislabel => "Z",
+ curvecolor => "RGBColor[1.0,0.0,0.0]",
+ curvethickness => 0.001,
+ outputtype => 4,
+ @_
+ );
+
+ my $Fxsubroutine;
+ my $Fysubroutine;
+ my $Fzsubroutine;
+
+ $options{Fx}->perlFunction('Fxsubroutine', ["$options{tvar}"]);
+ $options{Fy}->perlFunction('Fysubroutine', ["$options{tvar}"]);
+ $options{Fz}->perlFunction('Fzsubroutine', ["$options{tvar}"]);
+
+######################################################
+ #
+ # Generate plot data
+ #
+
+ my $dt = ($options{tmax} - $options{tmin}) / $options{tsamples};
+
+ my $t;
+
+ # The curve data
+ foreach my $i (0 .. $options{tsamples}) {
+ $t[$i] = $options{tmin} + $i * $dt;
+
+ $FX[$i] = sprintf("%.3f", (Fxsubroutine($t[$i])->value));
+ $FY[$i] = sprintf("%.3f", (Fysubroutine($t[$i])->value));
+ $FZ[$i] = sprintf("%.3f", (Fzsubroutine($t[$i])->value));
+
+ }
+
+ if ($options{orientation} > 0) {
+ #
+ # The arrow head data
+ #
+ my $tmidindex = sprintf("%.0f", $options{tsamples} / 2);
+
+ }
+
+###########################################################################
+ #
+ # Generate plotstructure from the plotdata.
+ #
+ # The plotstucture is a list of arrows (made of lines) that
+ # LiveGraphics3D reads as input.
+ #
+ # For more information on the format of the plotstructure, see
+ # http://www.math.umn.edu/~rogness/lg3d/page_NoMathematica.html
+ # http://www.vis.uni-stuttgart.de/~kraus/LiveGraphics3D/documentation.html
+ #
+###########################################
+ #
+ # Generate the line segments in the plotstructure
+ #
+
+ my $plotstructure = "{$options{curvecolor},Thickness[$options{curvethickness}],";
+
+ my $tsamples1 = $options{tsamples} - 1;
+
+ foreach my $i (0 .. $tsamples1) {
+
+ $plotstructure =
+ $plotstructure . "Line[{" . "{$FX[$i],$FY[$i],$FZ[$i]}," . "{$FX[$i+1],$FY[$i+1],$FZ[$i+1]}" . "}]";
+
+ if ($i < $tsamples1) { $plotstructure = $plotstructure . "," }
+
+ }
+
+ $plotstructure = $plotstructure . "}";
+
+##############################################
+ #
+ # Add plot options to the plotoptions string
+ #
+
+ my $plotoptions = "";
+
+ if (($options{outputtype} > 1) || ($options{axesframed} == 1)) {
+ $plotoptions =
+ $plotoptions
+ . "Axes->True,AxesLabel->"
+ . "{$options{xaxislabel},$options{yaxislabel},$options{zaxislabel}}";
+ }
+
+####################################################
+ #
+ # Return only the plotstring (if outputtype=>1),
+ # or only plotoptions (if outputtype=>2),
+ # or plotstring, plotoptions (if outputtype=>2),
+ # or the entire plot (default) (if outputtype=>4)
+
+ if ($options{outputtype} == 1) {
+ return $plotstructure;
+ } elsif ($options{outputtype} == 2) {
+ return $plotoptions;
+ } elsif ($options{outputtype} == 3) {
+ return "{" . $plotstructure . "," . $plotoptions . "}";
+ } elsif ($options{outputtype} == 4) {
+ return $beginplot . $plotstructure . "," . $plotoptions . $endplot;
+ } else {
+ return "Invalid outputtype (outputtype should be a number 1 through 4).";
+ }
+
+} # End ParametricCurve3D
+##############################################
+##############################################
+
+1;
diff --git a/macros/graph/LiveGraphicsParametricSurface3D.pl b/macros/graph/LiveGraphicsParametricSurface3D.pl
new file mode 100644
index 0000000000..dd8b712ad8
--- /dev/null
+++ b/macros/graph/LiveGraphicsParametricSurface3D.pl
@@ -0,0 +1,257 @@
+sub _LiveGraphicsParametricSurface3D_init { }; # don't reload this file
+
+loadMacros("MathObjects.pl", "LiveGraphics3D.pl");
+
+###########################################################################
+#
+# LiveGraphicsParametricSurface3D.pl provides a macro for creating an
+# interactive plot of a parametric surface via the LiveGraphics3D Java applet.
+# The routine ParametricSurface3D() takes three MathObject Formulas of
+# 2 variables as input and returns a string of plot data that can be
+# displayed using the Live3Ddata() routine of the LiveGraphics3D.pl macro.
+#
+# LiveGraphicsParametricSurface3D.pl automatically loads
+# MathObjects.pl and LiveGraphics3D.pl.
+#
+###########################################################################
+#
+# The main routine is
+#
+# ParametricSurface3D()
+#
+#
+# Usage: ParametricSurface3D(options);
+#
+# Options are:
+#
+# Fx => Formula("cos(u)*cos(v)"), x-coordinate function
+# Fy => Formula("sin(u)*cos(v)"), y-coordinate function
+# Fz => Formula("sin(v)"), z-coordinate function
+# F(u,v) = < Fx, Fy, Fz >
+# = < Fx(u,v), Fy(u,v), Fz(u,v) >
+#
+# uvar => "u", parameter name, default "u"
+# vvar => "v", parameter name, default "v"
+#
+# umin => -3, domain for uvar
+# umax => 3,
+#
+# vmin => -3, domain for vvar
+# vmax => 3,
+#
+# usamples => 3, deltau = (umax - umin) / usamples
+# vsamples => 3, deltav = (vmax - vmin) / vsamples
+#
+# axesframed => 1, 1 displays framed axes, 0 hides framed axes
+#
+# xaxislabel => "X", Capital letters may be easier to read
+# yaxislabel => "Y",
+# zaxislabel => "Z",
+#
+# edges => 0, 1 displays edges of polygons, 0 hides them
+# edgecolor => "RGBColor[0.2,0.2,0.2]",
+# edgethickness => "Thickness[0.001]",
+#
+# mesh => 0, 1 displays open mesh, 0 displays filled polygons
+# meshcolor => "RGBColor[0.7,0.7,0.7]", three values between 0 and 1
+# meshthickness => 0.001,
+#
+# outputtype => 1, return string of only polygons (or mesh)
+# 2, return string of only plotoptions
+# 3, return string of polygons (or mesh) and plotoptions
+# 4, return complete plot
+#
+# Happy 3D graphing! -Paul Pearson
+#
+#######################################################################################
+
+$beginplot = "Graphics3D[";
+$endplot = "]";
+
+###########################################
+###########################################
+# Begin ParametricSurface3D
+
+sub ParametricSurface3D {
+
+###########################################
+ #
+ # Set default options
+ #
+
+ my %options = (
+ Fx => Formula("1"),
+ Fy => Formula("1"),
+ Fz => Formula("1"),
+ uvar => 'u',
+ vvar => 'v',
+ umin => -3,
+ umax => 3,
+ vmin => -3,
+ vmax => 3,
+ usamples => 20,
+ vsamples => 20,
+ axesframed => 1,
+ xaxislabel => "X",
+ yaxislabel => "Y",
+ zaxislabel => "Z",
+ edges => 0,
+ edgecolor => "RGBColor[0.2,0.2,0.2]",
+ edgethickness => "Thickness[0.001]",
+ mesh => 0,
+ meshcolor => "RGBColor[0.7,0.7,0.7]",
+ meshthickness => 0.001,
+ outputtype => 4,
+ @_
+ );
+
+ my $Fxsubroutine;
+ my $Fysubroutine;
+ my $Fzsubroutine;
+
+ $options{Fx}->perlFunction('Fxsubroutine', [ "$options{uvar}", "$options{vvar}" ]);
+ $options{Fy}->perlFunction('Fysubroutine', [ "$options{uvar}", "$options{vvar}" ]);
+ $options{Fz}->perlFunction('Fzsubroutine', [ "$options{uvar}", "$options{vvar}" ]);
+
+######################################################
+ #
+ # Generate plot data
+ #
+
+ my $du = ($options{umax} - $options{umin}) / $options{usamples};
+ my $dv = ($options{vmax} - $options{vmin}) / $options{vsamples};
+
+ my $u;
+ my $v;
+
+ foreach my $i (0 .. $options{usamples}) {
+ $u[$i] = $options{umin} + $i * $du;
+ foreach my $j (0 .. $options{vsamples}) {
+ $v[$j] = $options{vmin} + $j * $dv;
+
+ $FX[$i][$j] = sprintf("%.3f", (Fxsubroutine($u[$i], $v[$j])->value));
+ $FY[$i][$j] = sprintf("%.3f", (Fysubroutine($u[$i], $v[$j])->value));
+ $FZ[$i][$j] = sprintf("%.3f", (Fzsubroutine($u[$i], $v[$j])->value));
+
+ $u[$i] = sprintf("%.3f", $u[$i]);
+ $v[$j] = sprintf("%.3f", $v[$j]);
+ }
+ }
+
+###########################################################################
+ #
+ # Generate plotstructure from the plotdata.
+ #
+ # The plotstucture is a list of arrows (made of lines) that
+ # LiveGraphics3D reads as input.
+ #
+ # For more information on the format of the plotstructure, see
+ # http://www.math.umn.edu/~rogness/lg3d/page_NoMathematica.html
+ # http://www.vis.uni-stuttgart.de/~kraus/LiveGraphics3D/documentation.html
+ #
+###########################################
+ #
+ # Generate the polygons in the plotstructure
+ #
+
+ my $plotstructure = "{";
+
+ if ($options{edges} == 0 && $options{mesh} == 0) {
+ $plotstructure = $plotstructure . "EdgeForm[],";
+ } elsif ($options{edges} == 1 && $options{mesh} == 0) {
+ $plotstructure = $plotstructure . "EdgeForm[{$options{edgecolor},$options{edgethickness}}],";
+ }
+
+ if ($options{mesh} == 1) {
+ $plotstructure = $plotstructure . "$options{meshcolor},Thickness[$options{meshthickness}],";
+ }
+
+ my $usamples1 = $options{usamples} - 1;
+ my $vsamples1 = $options{vsamples} - 1;
+
+ if ($options{mesh} == 0) {
+
+ foreach my $i (0 .. $usamples1) {
+ foreach my $j (0 .. $vsamples1) {
+
+ $plotstructure =
+ $plotstructure
+ . "Polygon[{"
+ . "{$FX[$i][$j],$FY[$i][$j],$FZ[$i][$j]},"
+ . "{$FX[$i+1][$j],$FY[$i+1][$j],$FZ[$i+1][$j]},"
+ . "{$FX[$i+1][$j+1],$FY[$i+1][$j+1],$FZ[$i+1][$j+1]},"
+ . "{$FX[$i][$j+1],$FY[$i][$j+1],$FZ[$i][$j+1]}" . "}]";
+
+ if (($i < $usamples1) || ($j < $vsamples1)) {
+ $plotstructure = $plotstructure . ",";
+ }
+
+ }
+ }
+
+ # end mesh == 0
+ } else {
+ # begin mesh == 1
+
+ foreach my $i (0 .. $usamples1) {
+ foreach my $j (0 .. $vsamples1) {
+
+ # this could be made more efficient
+ $plotstructure =
+ $plotstructure
+ . "Line[{"
+ . "{$FX[$i][$j],$FY[$i][$j],$FZ[$i][$j]},"
+ . "{$FX[$i+1][$j],$FY[$i+1][$j],$FZ[$i+1][$j]},"
+ . "{$FX[$i+1][$j+1],$FY[$i+1][$j+1],$FZ[$i+1][$j+1]},"
+ . "{$FX[$i][$j+1],$FY[$i][$j+1],$FZ[$i][$j+1]},"
+ . "{$FX[$i][$j],$FY[$i][$j],$FZ[$i][$j]}" . "}]";
+
+ if (($i < $usamples1) || ($j < $vsamples1)) {
+ $plotstructure = $plotstructure . ",";
+ }
+
+ }
+ }
+
+ } # end mesh == 1
+
+ $plotstructure = $plotstructure . "}";
+
+##############################################
+ #
+ # Add plot options to the plotoptions string
+ #
+
+ my $plotoptions = "";
+
+ if (($options{outputtype} > 1) || ($options{axesframed} == 1)) {
+ $plotoptions =
+ $plotoptions
+ . "Axes->True,AxesLabel->"
+ . "{$options{xaxislabel},$options{yaxislabel},$options{zaxislabel}}";
+ }
+
+####################################################
+ #
+ # Return only the plotstring (if outputtype=>1),
+ # or only plotoptions (if outputtype=>2),
+ # or plotstring, plotoptions (if outputtype=>2),
+ # or the entire plot (default) (if outputtype=>4)
+
+ if ($options{outputtype} == 1) {
+ return $plotstructure;
+ } elsif ($options{outputtype} == 2) {
+ return $plotoptions;
+ } elsif ($options{outputtype} == 3) {
+ return "{" . $plotstructure . "," . $plotoptions . "}";
+ } elsif ($options{outputtype} == 4) {
+ return $beginplot . $plotstructure . "," . $plotoptions . $endplot;
+ } else {
+ return "Invalid outputtype (outputtype should be a number 1 through 4).";
+ }
+
+} # End ParametricSurface3D
+##############################################
+##############################################
+
+1;
diff --git a/macros/graph/LiveGraphicsRectangularPlot3D.pl b/macros/graph/LiveGraphicsRectangularPlot3D.pl
new file mode 100644
index 0000000000..708f687048
--- /dev/null
+++ b/macros/graph/LiveGraphicsRectangularPlot3D.pl
@@ -0,0 +1,416 @@
+sub _LiveGraphicsRectangularPlot3D_init { }; # don't reload this file
+
+loadMacros("MathObjects.pl", "LiveGraphics3D.pl");
+
+###########################################################################
+#
+# LiveGraphicsRectangularPlot3D.pl provides two macros for creating an
+# interactive plot of a function of two variables z = f(x,y) in
+# Rectangular (Cartesian) coordinates via the LiveGraphics3D Java applet.
+# The routine RectangularDomainPlot3D() takes a MathObject Formula of
+# two variables defined over a rectangular domain and some plot options
+# as input and returns a string of plot data that can be displayed
+# using the Live3Ddata() routine of the LiveGraphics3D.pl macro.
+# The routine AnnularDomainPlot3D works similarly for a function
+# z = f(x,y) over an annular domain specified in polar by
+# rmin < r < rmax and tmin < theta < tmax.
+#
+# LiveGraphicsRectangularPlot3D.pl automatically loads
+# MathObjects.pl and LiveGraphics3D.pl.
+#
+###########################################################################
+#
+# The first routine is
+#
+# RectangularPlot3DRectangularDomain
+#
+#
+# Usage: RectangularPlot3DRectangularDomain(options);
+#
+# Options are:
+#
+# function => $f, $f is a MathObjects Formula
+# For example, in the setup section define
+#
+# Context("Numeric");
+# Context()->variables->add(s=>"Real",t=>"Real");
+# $a = random(1,3,1);
+# $f = Formula("$a*s^2-2*t"); # use double quotes!
+#
+# before calling RectangularPlot3DRectangularDomain()
+#
+# xvar => "s", independent variable name, default "x"
+# yvar => "t", independent variable name, default "y"
+#
+# xmin => -3, domain for xvar
+# xmax => 3,
+#
+# ymin => -3, domain for yvar
+# ymax => 3,
+#
+# xsamples => 20, deltax = (xmax - xmin) / xsamples
+# ysamples => 20, deltay = (ymax - ymin) / ysamples
+#
+# axesframed => 1, 1 displays framed axes, 0 hides framed axes
+#
+# xaxislabel => "S", Capital letters may be easier to read
+# yaxislabel => "T",
+# zaxislabel => "Z",
+#
+# outputtype => 1, return string of only polygons (or mesh)
+# 2, return string of only plotoptions
+# 3, return string of polygons (or mesh) and plotoptions
+# 4, return complete plot
+#
+#######################################################################################
+#######################################################################################
+#
+# The second routine is
+#
+# RectangularPlot3DAnnularDomain create a plotstring from a function
+#
+#
+# Usage: RectangularPlot3DAnnularDomain(options);
+#
+# Options are:
+#
+# function => $f, $f is a MathObjects Formula
+# For example, in the setup section define
+#
+# Context("Numeric");
+# Context()->variables->add(y=>"Real",r=>"Real",t=>"Real");
+# $a = random(1,3,1);
+# $f = Formula("$a*e^(- x^2 - y^2)"); # use double quotes!
+#
+# before calling RectangularPlot3DAnnularDomain()
+#
+# xvar => "x", independent variable name, default "x"
+# yvar => "y", independent variable name, default "y"
+#
+# rvar => "r", independent variable name, default "r"
+# tvar => "t", independent variable name, default "t" (for theta)
+#
+# rmin => -3, domain for rvar
+# rmax => 3,
+#
+# tmin => -3, domain for tvar
+# tmax => 3,
+#
+# rsamples => 20, deltar = (rmax - rmin) / rsamples
+# tsamples => 20, deltat = (tmax - tmin) / tsamples
+#
+# axesframed => 1, 1 displays framed axes, 0 hides framed axes
+#
+# xaxislabel => "X", Capital letters may be easier to read
+# yaxislabel => "Y",
+# zaxislabel => "Z",
+#
+# outputtype => 1, return string of only polygons (or mesh)
+# 2, return string of only plotoptions
+# 3, return string of polygons (or mesh) and plotoptions
+# 4, return complete plot
+#
+# Happy 3D graphing! - Paul Pearson
+#
+
+$beginplot = "Graphics3D[";
+$endplot = "]";
+
+###########################################
+###########################################
+# Begin RectangularPlot3DRectangularDomain
+
+sub RectangularPlot3DRectangularDomain {
+
+###########################################
+ #
+ # Set default options
+ #
+
+ my %options = (
+ function => Formula("1"),
+ xvar => 'x',
+ yvar => 'y',
+ xmin => -3,
+ xmax => 3,
+ ymin => -3,
+ ymax => 3,
+ xsamples => 20,
+ ysamples => 20,
+ axesframed => 1,
+ xaxislabel => "X",
+ yaxislabel => "Y",
+ zaxislabel => "Z",
+ outputtype => 4,
+ @_
+ );
+
+############################################
+ #
+ # Reset to Context("Numeric") just to be
+ # sure that everything will work properly.
+ #
+
+ #Context("Numeric");
+ #Context()->variables->are($options{xvar}=>"Real",$options{yvar}=>"Real");
+
+ my $fsubroutine;
+ $options{function}->perlFunction('fsubroutine', [ "$options{xvar}", "$options{yvar}" ]);
+
+######################################################
+ #
+ # Generate a plotdata array, which has two indices
+ #
+
+ my $xsamples1 = $options{xsamples} - 1;
+ my $ysamples1 = $options{ysamples} - 1;
+
+ my $dx = ($options{xmax} - $options{xmin}) / $options{xsamples};
+ my $dy = ($options{ymax} - $options{ymin}) / $options{ysamples};
+
+ my $x;
+ my $y;
+
+ my $z;
+
+ foreach my $i (0 .. $options{xsamples}) {
+ $x[$i] = $options{xmin} + $i * $dx;
+ foreach my $j (0 .. $options{ysamples}) {
+ $y[$j] = $options{ymin} + $j * $dy;
+ # Use sprintf to round to three decimal places
+ $z[$i][$j] = sprintf("%.3f", fsubroutine($x[$i], $y[$j])->value);
+ $y[$j] = sprintf("%.3f", $y[$j]);
+ }
+ $x[$i] = sprintf("%.3f", $x[$i]);
+ }
+
+###########################################################################
+ #
+ # Generate a plotstring from the plotdata.
+ #
+ # The plotstring is a list of polygons
+ # LiveGraphics3D reads as input.
+ #
+ # For more information on the format of the plotstring, see
+ # http://www.math.umn.edu/~rogness/lg3d/page_NoMathematica.html
+ # http://www.vis.uni-stuttgart.de/~kraus/LiveGraphics3D/documentation.html
+ #
+###########################################
+ #
+ # Generate the polygons in the plotstring
+ #
+
+ my $plotstructure = "{";
+
+ foreach my $i (0 .. $xsamples1) {
+ foreach my $j (0 .. $ysamples1) {
+
+ $plotstructure =
+ $plotstructure
+ . "Polygon[{"
+ . "{$x[$i],$y[$j],$z[$i][$j]},"
+ . "{$x[$i+1],$y[$j],$z[$i+1][$j]},"
+ . "{$x[$i+1],$y[$j+1],$z[$i+1][$j+1]},"
+ . "{$x[$i],$y[$j+1],$z[$i][$j+1]}" . "}]";
+
+ if (($i < $xsamples1) || ($j < $ysamples1)) {
+ $plotstructure = $plotstructure . ",";
+ }
+
+ }
+ }
+
+ $plotstructure = $plotstructure . "}";
+
+##############################################
+ #
+ # Add plot options to the plotoptions string
+ #
+
+ my $plotoptions = "";
+
+ if (($options{outputtype} > 1) || ($options{axesframed} == 1)) {
+ $plotoptions =
+ $plotoptions
+ . "Axes->True,AxesLabel->"
+ . "{$options{xaxislabel},$options{yaxislabel},$options{zaxislabel}}";
+ }
+
+####################################################
+ #
+ # Return only the plotstring (if outputtype=>1),
+ # or only plotoptions (if outputtype=>2),
+ # or plotstring, plotoptions (if outputtype=>2),
+ # or the entire plot (default) (if outputtype=>4)
+
+ if ($options{outputtype} == 1) {
+ return $plotstructure;
+ } elsif ($options{outputtype} == 2) {
+ return $plotoptions;
+ } elsif ($options{outputtype} == 3) {
+ return "{" . $plotstructure . "," . $plotoptions . "}";
+ } elsif ($options{outputtype} == 4) {
+ return $beginplot . $plotstructure . "," . $plotoptions . $endplot;
+ } else {
+ return "Invalid outputtype (outputtype should be a number 1 through 4).";
+ }
+
+} # End RectangularPlot3DRectangularDomain
+##############################################
+##############################################
+
+#############################################
+#############################################
+# Begin RectangularPlot3DAnnularDomain
+
+sub RectangularPlot3DAnnularDomain {
+
+#############################################
+ #
+ # Set default options
+ #
+
+ my %options = (
+ function => Formula("1"),
+ xvar => "x",
+ yvar => "y",
+ rvar => "r",
+ tvar => "t",
+ rmin => 0.001,
+ rmax => 3,
+ tmin => 0,
+ tmax => 6.28,
+ rsamples => 20,
+ tsamples => 20,
+ axesframed => 1,
+ xaxislabel => "X",
+ yaxislabel => "Y",
+ zaxislabel => "Z",
+ outputtype => 4,
+ @_
+ );
+
+############################################
+ #
+ # Reset to Context("Numeric") just to be
+ # sure that everything will work properly.
+ #
+
+ #Context("Numeric");
+ #Context()->variables->are(
+ #$options{xvar}=>"Real",
+ #$options{yvar}=>"Real",
+ #$options{rvar}=>"Real",
+ #$options{tvar}=>"Real"
+ #);
+
+ my $fsubroutine;
+ $options{function}->perlFunction('fsubroutine', [ "$options{xvar}", "$options{yvar}" ]);
+
+######################################################
+ #
+ # Generate a plotdata array, which has two indices
+ #
+
+ my $rsamples1 = $options{rsamples} - 1;
+ my $tsamples1 = $options{tsamples} - 1;
+
+ my $dr = ($options{rmax} - $options{rmin}) / $options{rsamples};
+ my $dt = ($options{tmax} - $options{tmin}) / $options{tsamples};
+
+ my $t;
+ my $r;
+
+ my $x;
+ my $y;
+
+ my $z;
+
+ foreach my $i (0 .. $options{tsamples}) {
+ $t[$i] = $options{tmin} + $i * $dt;
+ foreach my $j (0 .. $options{rsamples}) {
+ $r[$j] = $options{rmin} + $j * $dr;
+ $x[$i][$j] = $r[$j] * cos($t[$i]);
+ $y[$i][$j] = $r[$j] * sin($t[$i]);
+ $z[$i][$j] = sprintf("%.3f", fsubroutine($x[$i][$j], $y[$i][$j])->value);
+ $x[$i][$j] = sprintf("%.3f", $x[$i][$j]);
+ $y[$i][$j] = sprintf("%.3f", $y[$i][$j]);
+ }
+ }
+
+###########################################################################
+ #
+ # Generate a plotstring from the plotdata.
+ #
+ # The plotstring is a list of polygons that
+ # LiveGraphics3D reads as input.
+ #
+ # For more information on the format of the plotstring, see
+ # http://www.math.umn.edu/~rogness/lg3d/page_NoMathematica.html
+ # http://www.vis.uni-stuttgart.de/~kraus/LiveGraphics3D/documentation.html
+ #
+###########################################
+ #
+ # Generate the polygons in the plotstring
+ #
+
+ my $plotstructure = "{";
+
+ foreach my $i (0 .. $tsamples1) {
+ foreach my $j (0 .. $rsamples1) {
+
+ $plotstructure =
+ $plotstructure
+ . "Polygon[{"
+ . "{$x[$i][$j],$y[$i][$j],$z[$i][$j]},"
+ . "{$x[$i+1][$j],$y[$i+1][$j],$z[$i+1][$j]},"
+ . "{$x[$i+1][$j+1],$y[$i+1][$j+1],$z[$i+1][$j+1]},"
+ . "{$x[$i][$j+1],$y[$i][$j+1],$z[$i][$j+1]}" . "}]";
+
+ if (($i < $tsamples1) || ($j < $rsamples1)) {
+ $plotstructure = $plotstructure . ",";
+ }
+
+ }
+ }
+
+ $plotstructure = $plotstructure . "}";
+
+##############################################
+ #
+ # Add plot options to the plotoptions string
+ #
+
+ my $plotoptions = "";
+
+ if (($options{outputtype} > 1) || ($options{axesframed} == 1)) {
+ $plotoptions =
+ $plotoptions
+ . "Axes->True,AxesLabel->"
+ . "{$options{xaxislabel},$options{yaxislabel},$options{zaxislabel}}";
+ }
+
+####################################################
+ #
+ # Return only the plotstring (if outputtype=>1),
+ # or only plotoptions (if outputtype=>2),
+ # or plotstring, plotoptions (if outputtype=>2),
+ # or the entire plot (default) (if outputtype=>4)
+
+ if ($options{outputtype} == 1) {
+ return $plotstructure;
+ } elsif ($options{outputtype} == 2) {
+ return $plotoptions;
+ } elsif ($options{outputtype} == 3) {
+ return "{" . $plotstructure . "," . $plotoptions . "}";
+ } elsif ($options{outputtype} == 4) {
+ return $beginplot . $plotstructure . "," . $plotoptions . $endplot;
+ } else {
+ return "Invalid outputtype (outputtype should be a number 1 through 4).";
+ }
+
+} # End RectangularPlot3DAnnularDomain
+#####################################################
+#####################################################
+
+1;
diff --git a/macros/graph/LiveGraphicsVectorField2D.pl b/macros/graph/LiveGraphicsVectorField2D.pl
new file mode 100644
index 0000000000..6620c2d0a9
--- /dev/null
+++ b/macros/graph/LiveGraphicsVectorField2D.pl
@@ -0,0 +1,218 @@
+sub _LiveGraphicsVectorField2D_init { }; # don't reload this file
+
+loadMacros("MathObjects.pl", "LiveGraphics3D.pl");
+
+###########################################################################
+#
+# LiveGraphicsVectorField2D.pl provides a macros for creating an
+# interactive plot of a vector field via the LiveGraphics3D Java applet.
+# The routine VectorField2D() takes two MathObject Formulas of
+# 2 variables as input and returns a string of plot data that can be
+# displayed using the Live3Ddata() routine of the LiveGraphics3D.pl macro.
+#
+# LiveGraphicsVectorField2D.pl automatically loads
+# MathObjects.pl and LiveGraphics3D.pl.
+#
+###########################################################################
+#
+# The main routine is
+#
+# VectorField2D()
+#
+#
+# Usage: VectorField2D(options);
+#
+# Options are:
+#
+# Fx => Formula("y"), F = < Fx, Fy, Fz > where Fx, Fy, Fz are each
+# Fy => Formula("-x"), functions of 3 variables
+#
+# xvar => "r", independent variable name, default "x"
+# yvar => "s", independent variable name, default "y"
+#
+# xmin => -3, domain for xvar
+# xmax => 3,
+#
+# ymin => -3, domain for yvar
+# ymax => 3,
+#
+# xsamples => 3, deltax = (xmax - xmin) / xsamples
+# ysamples => 3, deltay = (ymax - ymin) / ysamples
+#
+# axesframed => 1, 1 displays framed axes, 0 hides framed axes
+#
+# xaxislabel => "R", Capital letters may be easier to read
+# yaxislabel => "S",
+#
+# vectorcolor => "RGBColor[1.0,0.0,0.0]",
+# vectorscale => 0.2,
+# vectorthickness => 0.001,
+#
+# outputtype => 1, return string of only polygons (or mesh)
+# 2, return string of only plotoptions
+# 3, return string of polygons (or mesh) and plotoptions
+# 4, return complete plot
+#
+# Happy 2D graphing! -Paul Pearson
+#
+#######################################################################################
+
+$beginplot = "Graphics3D[";
+$endplot = "]";
+
+###########################################
+###########################################
+# Begin VectorField2D
+
+sub VectorField2D {
+
+###########################################
+ #
+ # Set default options
+ #
+
+ my %options = (
+ Fx => Formula("1"),
+ Fy => Formula("1"),
+ xvar => 'x',
+ yvar => 'y',
+ xmin => -3,
+ xmax => 3,
+ ymin => -3,
+ ymax => 3,
+ xsamples => 20,
+ ysamples => 20,
+ axesframed => 1,
+ xaxislabel => "X",
+ yaxislabel => "Y",
+ vectorcolor => "RGBColor[1.0,0.0,0.0]",
+ vectorscale => 0.2,
+ vectorthickness => 0.001,
+ outputtype => 4,
+ @_
+ );
+
+ my $Fxsubroutine;
+ my $Fysubroutine;
+
+ $options{Fx}->perlFunction('Fxsubroutine', [ "$options{xvar}", "$options{yvar}" ]);
+ $options{Fy}->perlFunction('Fysubroutine', [ "$options{xvar}", "$options{yvar}" ]);
+
+######################################################
+ #
+ # Generate plot data
+ #
+
+ my $dx = ($options{xmax} - $options{xmin}) / $options{xsamples};
+ my $dy = ($options{ymax} - $options{ymin}) / $options{ysamples};
+
+ my $xtail;
+ my $ytail;
+
+ foreach my $i (0 .. $options{xsamples}) {
+ $xtail[$i] = $options{xmin} + $i * $dx;
+ foreach my $j (0 .. $options{ysamples}) {
+ $ytail[$j] = $options{ymin} + $j * $dy;
+
+ $FX[$i][$j] = sprintf("%.3f", $options{vectorscale} * (Fxsubroutine($xtail[$i], $ytail[$j])->value));
+ $FY[$i][$j] = sprintf("%.3f", $options{vectorscale} * (Fysubroutine($xtail[$i], $ytail[$j])->value));
+
+ $xtail[$i] = sprintf("%.3f", $xtail[$i]);
+ $ytail[$j] = sprintf("%.3f", $ytail[$j]);
+
+ $xtip[$i][$j] = $xtail[$i] + sprintf("%.3f", $FX[$i][$j]);
+ $ytip[$i][$j] = $ytail[$j] + sprintf("%.3f", $FY[$i][$j]);
+
+ $xleftbarb[$i][$j] = sprintf("%.3f", $xtail[$i] + 0.8 * $FX[$i][$j] - 0.2 * $FY[$i][$j]);
+ $yleftbarb[$i][$j] = sprintf("%.3f", $ytail[$j] + 0.8 * $FY[$i][$j] + 0.2 * $FX[$i][$j]);
+
+ $xrightbarb[$i][$j] = sprintf("%.3f", $xtail[$i] + 0.8 * $FX[$i][$j] + 0.2 * $FY[$i][$j]);
+ $yrightbarb[$i][$j] = sprintf("%.3f", $ytail[$j] + 0.8 * $FY[$i][$j] - 0.2 * $FX[$i][$j]);
+ }
+ }
+
+###########################################################################
+ #
+ # Generate plotstructure from the plotdata.
+ #
+ # The plotstucture is a list of arrows (made of lines) that
+ # LiveGraphics3D reads as input.
+ #
+ # For more information on the format of the plotstructure, see
+ # http://www.math.umn.edu/~rogness/lg3d/page_NoMathematica.html
+ # http://www.vis.uni-stuttgart.de/~kraus/LiveGraphics3D/documentation.html
+ #
+###########################################
+ #
+ # Generate the polygons in the plotstructure
+ #
+
+ my $plotstructure = "{{{{$options{vectorcolor},EdgeForm[],Thickness[$options{vectorthickness}],";
+
+ foreach my $i (0 .. $options{xsamples}) {
+ foreach my $j (0 .. $options{ysamples}) {
+
+ $plotstructure =
+ $plotstructure
+ . "Line[{"
+ . "{$xtail[$i],$ytail[$j],0},"
+ . "{$xtip[$i][$j],$ytip[$i][$j],0}" . "}],"
+ . "Line[{"
+ . "{$xleftbarb[$i][$j],$yleftbarb[$i][$j],0},"
+ . "{$xtip[$i][$j],$ytip[$i][$j],0},"
+ . "{$xrightbarb[$i][$j],$yrightbarb[$i][$j],0}" . "}]";
+
+ if (($i < $options{xsamples}) || ($j < $options{ysamples})) {
+ $plotstructure = $plotstructure . ",";
+ }
+
+ }
+ }
+
+ $plotstructure = $plotstructure . "}}}}";
+
+##############################################
+ #
+ # Add plot options to the plotoptions string
+ #
+
+ my $plotoptions = "";
+
+ if (($options{outputtype} > 1) || ($options{axesframed} == 1)) {
+
+ $plotoptions =
+ $plotoptions
+ . "PlotRange->{{$options{xmin},$options{xmax}},{$options{ymin},$options{ymax}},{-0.1,0.1}},"
+ . "ViewPoint->{0,0,1000},"
+ . "ViewVertical->{0,1,0},"
+ . "Lighting->False,"
+ . "AxesLabel->{$options{xaxislabel},$options{yaxislabel},Z},"
+ . #; # .
+ "Axes->{True,True,False}";
+
+ }
+
+####################################################
+ #
+ # Return only the plotstring (if outputtype=>1),
+ # or only plotoptions (if outputtype=>2),
+ # or plotstring, plotoptions (if outputtype=>2),
+ # or the entire plot (default) (if outputtype=>4)
+
+ if ($options{outputtype} == 1) {
+ return $plotstructure;
+ } elsif ($options{outputtype} == 2) {
+ return $plotoptions;
+ } elsif ($options{outputtype} == 3) {
+ return "{" . $plotstructure . "," . $plotoptions . "}";
+ } elsif ($options{outputtype} == 4) {
+ return $beginplot . $plotstructure . "," . $plotoptions . $endplot;
+ } else {
+ return "Invalid outputtype (outputtype should be a number 1 through 4).";
+ }
+
+} # End VectorField2D
+##############################################
+##############################################
+
+1;
diff --git a/macros/graph/LiveGraphicsVectorField3D.pl b/macros/graph/LiveGraphicsVectorField3D.pl
new file mode 100644
index 0000000000..88c6d6471e
--- /dev/null
+++ b/macros/graph/LiveGraphicsVectorField3D.pl
@@ -0,0 +1,255 @@
+sub _LiveGraphicsVectorField3D_init { }; # don't reload this file
+
+loadMacros("MathObjects.pl", "LiveGraphics3D.pl");
+
+###########################################################################
+#
+# LiveGraphicsVectorField3D.pl provides a macros for creating an
+# interactive plot of a vector field via the LiveGraphics3D Java applet.
+# The routine VectorField3D() takes three MathObject Formulas of
+# 3 variables as input and returns a string of plot data that can be
+# displayed using the Live3Ddata() routine of the LiveGraphics3D.pl macro.
+#
+# LiveGraphicsVectorField3D.pl automatically loads
+# MathObjects.pl and LiveGraphics3D.pl.
+#
+###########################################################################
+#
+# The main routine is
+#
+# VectorField3D()
+#
+#
+# Usage: VectorField3D(options);
+#
+# Options are:
+#
+# Fx => Formula("y"), F = < Fx, Fy, Fz > where Fx, Fy, Fz are each
+# Fy => Formula("-x"), functions of 3 variables
+# Fz => Formula("z"),
+#
+# xvar => "r", independent variable name, default "x"
+# yvar => "s", independent variable name, default "y"
+# zvar => "t", independent variable name, default "z"
+#
+# xmin => -3, domain for xvar
+# xmax => 3,
+#
+# ymin => -3, domain for yvar
+# ymax => 3,
+#
+# zmin => -3, domain for zvar
+# zmax => 3,
+#
+# xsamples => 3, deltax = (xmax - xmin) / xsamples
+# ysamples => 3, deltay = (ymax - ymin) / ysamples
+# zsamples => 3, deltaz = (zmax - zmin) / zsamples
+#
+# axesframed => 1, 1 displays framed axes, 0 hides framed axes
+#
+# xaxislabel => "R", Capital letters may be easier to read
+# yaxislabel => "S",
+# zaxislabel => "T",
+#
+# vectorcolor => "RGBColor[0.0,0.0,1.0]",
+# vectorscale => 0.2,
+# vectorthickness => 0.001,
+#
+# outputtype => 1, return string of only polygons (or mesh)
+# 2, return string of only plotoptions
+# 3, return string of polygons (or mesh) and plotoptions
+# 4, return complete plot
+#
+# Happy 3D graphing! -Paul Pearson
+#
+#######################################################################################
+
+$beginplot = "Graphics3D[";
+$endplot = "]";
+
+###########################################
+###########################################
+# Begin VectorField3D
+
+sub VectorField3D {
+
+###########################################
+ #
+ # Set default options
+ #
+
+ my %options = (
+ Fx => Formula("1"),
+ Fy => Formula("1"),
+ Fz => Formula("1"),
+ xvar => 'x',
+ yvar => 'y',
+ zvar => 'z',
+ xmin => -3,
+ xmax => 3,
+ ymin => -3,
+ ymax => 3,
+ zmin => -3,
+ zmax => 3,
+ xsamples => 20,
+ ysamples => 20,
+ zsamples => 20,
+ axesframed => 1,
+ xaxislabel => "X",
+ yaxislabel => "Y",
+ zaxislabel => "Z",
+ vectorcolor => "RGBColor[0.0,0.0,1.0]",
+ vectorscale => 0.2,
+ vectorthickness => 0.001,
+ xavoid => 1000000,
+ yavoid => 1000000,
+ zavoid => 1000000,
+ outputtype => 4,
+ @_
+ );
+
+ my $Fxsubroutine;
+ my $Fysubroutine;
+ my $Fzsubroutine;
+
+ $options{Fx}->perlFunction('Fxsubroutine', [ "$options{xvar}", "$options{yvar}", "$options{zvar}" ]);
+ $options{Fy}->perlFunction('Fysubroutine', [ "$options{xvar}", "$options{yvar}", "$options{zvar}" ]);
+ $options{Fz}->perlFunction('Fzsubroutine', [ "$options{xvar}", "$options{yvar}", "$options{zvar}" ]);
+
+######################################################
+ #
+ # Generate plot data
+ #
+
+ my $dx = ($options{xmax} - $options{xmin}) / $options{xsamples};
+ my $dy = ($options{ymax} - $options{ymin}) / $options{ysamples};
+ my $dz = ($options{zmax} - $options{zmin}) / $options{zsamples};
+
+ my $xtail;
+ my $ytail;
+ my $ztail;
+
+ foreach my $i (0 .. $options{xsamples}) {
+ $xtail[$i] = $options{xmin} + $i * $dx;
+ foreach my $j (0 .. $options{ysamples}) {
+ $ytail[$j] = $options{ymin} + $j * $dy;
+ foreach my $k (0 .. $options{zsamples}) {
+ $ztail[$k] = $options{zmin} + $k * $dz;
+
+ if ($xtail[$i] == $options{xavoid} && $ytail[$j] == $options{yavoid} && $ztail[$k] == $options{zavoid})
+ {
+
+ $FX[$i][$j][$k] = 0;
+ $FY[$i][$j][$k] = 0;
+ $FZ[$i][$j][$k] = 0;
+
+ } else {
+
+ $FX[$i][$j][$k] = sprintf("%.3f",
+ $options{vectorscale} * (Fxsubroutine($xtail[$i], $ytail[$j], $ztail[$k])->value));
+ $FY[$i][$j][$k] = sprintf("%.3f",
+ $options{vectorscale} * (Fysubroutine($xtail[$i], $ytail[$j], $ztail[$k])->value));
+ $FZ[$i][$j][$k] = sprintf("%.3f",
+ $options{vectorscale} * (Fzsubroutine($xtail[$i], $ytail[$j], $ztail[$k])->value));
+
+ }
+
+ $xtail[$i] = sprintf("%.3f", $xtail[$i]);
+ $ytail[$j] = sprintf("%.3f", $ytail[$j]);
+ $ztail[$k] = sprintf("%.3f", $ztail[$k]);
+
+ $xtip[$i][$j][$k] = $xtail[$i] + sprintf("%.3f", $FX[$i][$j][$k]);
+ $ytip[$i][$j][$k] = $ytail[$j] + sprintf("%.3f", $FY[$i][$j][$k]);
+ $ztip[$i][$j][$k] = $ztail[$k] + sprintf("%.3f", $FZ[$i][$j][$k]);
+
+ $xleftbarb[$i][$j][$k] = sprintf("%.3f", $xtail[$i] + 0.8 * $FX[$i][$j][$k] - 0.2 * $FY[$i][$j][$k]);
+ $yleftbarb[$i][$j][$k] = sprintf("%.3f", $ytail[$j] + 0.8 * $FY[$i][$j][$k] + 0.2 * $FX[$i][$j][$k]);
+
+ $xrightbarb[$i][$j][$k] = sprintf("%.3f", $xtail[$i] + 0.8 * $FX[$i][$j][$k] + 0.2 * $FY[$i][$j][$k]);
+ $yrightbarb[$i][$j][$k] = sprintf("%.3f", $ytail[$j] + 0.8 * $FY[$i][$j][$k] - 0.2 * $FX[$i][$j][$k]);
+
+ $zbarb[$i][$j][$k] = sprintf("%.3f", $ztail[$k] + 0.8 * $FZ[$i][$j][$k]);
+
+ }
+ }
+ }
+
+###########################################################################
+ #
+ # Generate plotstructure from the plotdata.
+ #
+ # The plotstucture is a list of arrows (made of lines) that
+ # LiveGraphics3D reads as input.
+ #
+ # For more information on the format of the plotstructure, see
+ # http://www.math.umn.edu/~rogness/lg3d/page_NoMathematica.html
+ # http://www.vis.uni-stuttgart.de/~kraus/LiveGraphics3D/documentation.html
+ #
+###########################################
+ #
+ # Generate the polygons in the plotstructure
+ #
+
+ my $plotstructure = "{{{{$options{vectorcolor},Thickness[$options{vectorthickness}],";
+
+ foreach my $i (0 .. $options{xsamples}) {
+ foreach my $j (0 .. $options{ysamples}) {
+ foreach my $k (0 .. $options{zsamples}) {
+
+ $plotstructure =
+ $plotstructure
+ . "Line[{"
+ . "{$xtail[$i],$ytail[$j],$ztail[$k]},"
+ . "{$xtip[$i][$j][$k],$ytip[$i][$j][$k],$ztip[$i][$j][$k]}" . "}],"
+ . "Line[{"
+ . "{$xleftbarb[$i][$j][$k],$yleftbarb[$i][$j][$k],$zbarb[$i][$j][$k]},"
+ . "{$xtip[$i][$j][$k],$ytip[$i][$j][$k],$ztip[$i][$j][$k]},"
+ . "{$xrightbarb[$i][$j][$k],$yrightbarb[$i][$j][$k],$zbarb[$i][$j][$k]}" . "}]";
+
+ if (($i < $options{xsamples}) || ($j < $options{ysamples}) || ($k < $options{zsamples})) {
+ $plotstructure = $plotstructure . ",";
+ }
+ }
+ }
+ }
+
+ $plotstructure = $plotstructure . "}}}}";
+
+##############################################
+ #
+ # Add plot options to the plotoptions string
+ #
+
+ my $plotoptions = "";
+
+ if (($options{outputtype} > 1) || ($options{axesframed} == 1)) {
+ $plotoptions =
+ $plotoptions
+ . "Axes->True,AxesLabel->"
+ . "{$options{xaxislabel},$options{yaxislabel},$options{zaxislabel}}";
+ }
+
+####################################################
+ #
+ # Return only the plotstring (if outputtype=>1),
+ # or only plotoptions (if outputtype=>2),
+ # or plotstring, plotoptions (if outputtype=>2),
+ # or the entire plot (default) (if outputtype=>4)
+
+ if ($options{outputtype} == 1) {
+ return $plotstructure;
+ } elsif ($options{outputtype} == 2) {
+ return $plotoptions;
+ } elsif ($options{outputtype} == 3) {
+ return "{" . $plotstructure . "," . $plotoptions . "}";
+ } elsif ($options{outputtype} == 4) {
+ return $beginplot . $plotstructure . "," . $plotoptions . $endplot;
+ } else {
+ return "Invalid outputtype (outputtype should be a number 1 through 4).";
+ }
+
+} # End VectorField3D
+##############################################
+##############################################
+
+1;
diff --git a/macros/graph/PCCgraphMacros.pl b/macros/graph/PCCgraphMacros.pl
new file mode 100644
index 0000000000..6bb10719d0
--- /dev/null
+++ b/macros/graph/PCCgraphMacros.pl
@@ -0,0 +1,128 @@
+
+=head1 NAME
+
+PCCgraphMacros.pl - A collection of tools found to be useful for graphs during the development of the PCC problem library.
+
+=head1 DESCRIPTION
+
+This file implements graphing subroutines developed for use in problems originally developed for a PCC problem library
+
+To use it, load the macro file:
+
+ loadMacros(
+ "PGstandard.pl",
+ "MathObjects.pl",
+ "PCCgraphMacros.pl",
+ );
+
+
+=cut
+
+sub _init_PCCgraphMacros { loadMacros('PCCmacros.pl'); }
+
+###############################
+#Some standard values
+################################
+sub xPixels { 240; } #number of hor pixels in the graph object
+
+sub yPixels { 240; } #number of ver pixels in the graph object
+
+sub xScreen { 240; } #number of hor pixels used on screen
+
+sub yScreen { 240; } #number of ver pixels used on screen
+
+sub TeXscalar { 400; } #400=>image is at 40.0% in hardcopy
+
+sub EnlargeImageStatementPGML {
+ KeyboardInstructions(
+ 'If you would like to enlarge the graph or make numbers and letters easier to read, you may click on it to open it in a new window. You may then enlarge that window with your mouse. To further enlarge the image, use your browser\'s zoom capabilities. On a PC this is usually *ctrl shift +* (and zooming out is *ctrl -*). On an Apple computer this is usually *apple shift +* (and zooming out is *apple -*).'
+ );
+}
+
+sub EnlargeImageStatement {
+ KeyboardInstructions(
+ 'If you would like to enlarge the graph or make numbers and letters easier to read, you may click on it to open it in a new window. You may then enlarge that window with your mouse. To further enlarge the image, use your browser\'s zoom capabilities. On a PC this is usually $BBOLD ctrl shift +$EBOLD (and zooming out is $BBOLD ctrl -$EBOLD). On an Apple computer this is usually $BBOLD apple shift +$EBOLD (and zooming out is $BBOLD apple -$EBOLD).'
+ );
+}
+
+###############################
+#Name: NiceGraphParameters
+#Input: References to two arrays: one with all the x "action" in a graph, the other with the y "action"
+#Optional Input: centerOrigin, centerXaxis, centerYaxis, buffer, roughTickNum, roughTickNumX, roughTickNumY
+#Output: A reference to an array (xmin, xmax, ymin, ymax, xticknumber, yticknumber). These parameters will make a nice looking scale for a graph that captures all of the x and y data.
+################################
+sub NiceGraphParameters {
+ my $xact = shift;
+ my $yact = shift;
+ my %options = @_;
+ my @xaction = @{$xact};
+ my @yaction = @{$yact};
+
+ if ($options{centerYaxis} or $options{centerOrigin}) {
+ my @temp = ();
+ for my $i (@xaction) { push(@temp, -$i); }
+ @xaction = (@xaction, @temp);
+ }
+
+ if ($options{centerXaxis} or $options{centerOrigin}) {
+ my @temp = ();
+ for my $i (@yaction) { push(@temp, -$i); }
+ @yaction = (@yaction, @temp);
+ }
+
+ my (@max, @min);
+ $max[0] = max(@xaction);
+ $min[0] = min(@xaction);
+ $max[1] = max(@yaction);
+ $min[1] = min(@yaction);
+
+ my @roughTickNum;
+ $roughTickNum[0] = 10;
+ $roughTickNum[1] = 10;
+ for my $i (0, 1) { $roughTickNum[$i] = $options{roughTickNum} if (defined $options{roughTickNum}); }
+ $roughTickNum[0] = $options{roughTickNumX} if (defined $options{roughTickNumX});
+ $roughTickNum[1] = $options{roughTickNumY} if (defined $options{roughTickNumY});
+
+ my $buffer = 1.618;
+ $buffer = $options{buffer} if (defined $options{buffer});
+
+ @pixels = (xPixels(), yPixels());
+
+ my (@center, @left, @right, @tickexp, %tickcoefs, @tickcoef, @marksep, @ticknum, @scale, @adjRoughTickNum);
+ for my $i (0, 1) {
+ $center[$i] = ($max[$i] + $min[$i]) / 2;
+ $low[$i] = $center[$i] + $buffer * ($min[$i] - $center[$i]);
+ $high[$i] = $center[$i] + $buffer * ($max[$i] - $center[$i]);
+ $tickexp[$i] = round(log(($high[$i] - $low[$i]) / $roughTickNum[$i]) / log(10));
+ if ($i == 0) { $adjRoughTickNum[0] = min($roughTickNum[0], $pixels[0] / ((abs($tickexp[0]) + 3) * 10)); }
+ if ($i == 1) { $adjRoughTickNum[1] = min($roughTickNum[1], $pixels[1] / ((abs($tickexp[1]) + 1) * 10)); }
+ %tickcoefs = ();
+ %tickcoefs = (
+ .2 => abs(.2 * 10**$tickexp[$i] - ($high[$i] - $low[$i]) / $adjRoughTickNum[$i]),
+ .5 => abs(.5 * 10**$tickexp[$i] - ($high[$i] - $low[$i]) / $adjRoughTickNum[$i]),
+ 1 => abs(1 * 10**$tickexp[$i] - ($high[$i] - $low[$i]) / $adjRoughTickNum[$i]),
+ 2 => abs(2 * 10**$tickexp[$i] - ($high[$i] - $low[$i]) / $adjRoughTickNum[$i]),
+ 5 => abs(5 * 10**$tickexp[$i] - ($high[$i] - $low[$i]) / $adjRoughTickNum[$i])
+ );
+ $tickcoef[$i] = .2;
+
+ for my $key (.2, .5, 1, 2, 5)
+ # division by 1.7 is a hack to make ticks more frequent
+ # this may need redoing if problems are reported
+ { $tickcoef[$i] = $key if ($tickcoefs{$key} < $tickcoefs{ $tickcoef[$i] } / 1.7); }
+ $marksep[$i] = 10**($tickexp[$i]) * $tickcoef[$i];
+ $ticknum[$i] = 2 * ceil(($high[$i] - $low[$i]) / 2 / $marksep[$i]);
+ $max[$i] = ceil($high[$i] / $marksep[$i]) * $marksep[$i];
+ $min[$i] = $max[$i] - $marksep[$i] * $ticknum[$i];
+ @temp = ();
+ }
+
+ my @xticks =
+ map { $marksep[0] * 2 * $_ } (int($min[0] / $marksep[0] / 2 + 0.1)) .. (int($max[0] / $marksep[0] / 2 - 0.1));
+ my @yticks =
+ map { $marksep[1] * 2 * $_ } (int($min[1] / $marksep[1] / 2 + 0.1)) .. (int($max[1] / $marksep[1] / 2 - 0.1));
+
+ return ($min[0], $max[0], $min[1], $max[1], $ticknum[0], $ticknum[1], \@xticks, \@yticks, $marksep[0], $marksep[1]);
+}
+
+1;
diff --git a/macros/PGanalyzeGraph.pl b/macros/graph/PGanalyzeGraph.pl
similarity index 100%
rename from macros/PGanalyzeGraph.pl
rename to macros/graph/PGanalyzeGraph.pl
diff --git a/macros/graph/PGgraphgrid.pl b/macros/graph/PGgraphgrid.pl
new file mode 100644
index 0000000000..d24c787bab
--- /dev/null
+++ b/macros/graph/PGgraphgrid.pl
@@ -0,0 +1,130 @@
+sub _PGgraphgrid_init { }; # don't reload this file
+
+=pod
+
+=head1 NAME
+
+PGgraphgrid.pl
+
+=head1 SYNOPSIS
+
+Provides subroutines plotting a parallelogram grid on a
+graph object created by PGgraphmacros.pl.
+
+=head1 DESCRIPTION
+
+Load the C macro file.
+
+=over 12
+
+=item C
+
+= back
+
+The macro C provides two different subroutines
+for graphing grids: the first one draws the grid using parallel lines
+and should be fast, and a second that draws each individual
+parallelogram and should be slow (but will suffer less from clipping):
+
+=over 12
+
+=item C
+
+=item C
+
+=back
+
+Here C<$gr> is a graph object created by C,
+C<$B> is a two by two MathObjects matrix, the integers C<$hmin> and
+C<$vmin> specify one corner of the grid, the integers C<$hmax> and
+C<$vmax> specify the opposite corner of the grid, C<$color> is a string
+that specifies the drawing color, and C<$linewidth> is a positive integer
+for the line width.
+
+=over 12
+
+=head1 AUTHORS
+
+Paul Pearson, Hope College, Department of Mathematics
+
+=cut
+
+################################################
+
+loadMacros("MathObjects.pl", "PGgraphmacros.pl",);
+
+sub graphgrid1 {
+ # inputs
+ my $gr = shift; # graph object
+ my $B = shift; # 2x2 basis matrix with B = (b1 | b2), with basis vectors in columns
+ my $xmin = shift;
+ my $ymin = shift;
+ my $xmax = shift;
+ my $ymax = shift; # (xmin,ymin) and (xmax,ymax) are two of the corners of the grid (must be integers)
+ my $color = shift; # grid color
+ my $linewidth = shift; # line thickness
+
+ # standard coordinates for horizontal lines
+ my @hx = (); # horizontal lines, x values
+ my @hy = (); # horizontal lines, y values
+ foreach my $y ($ymin .. $ymax) {
+ push(@hx, ($xmin, $xmax));
+ push(@hy, ($y, $y));
+ }
+ my $H = Matrix([ [@hx], [@hy] ]);
+ my $BH = $B * $H;
+ my @bh = $BH->value;
+ # draw parallelogram grid on graph object
+ # "horizontal" lines
+ my $bh_ncol = ($BH->dimensions)[1];
+ foreach my $i (0 .. $bh_ncol / 2) {
+ $gr->moveTo($bh[0][ 2 * $i ], $bh[1][ 2 * $i ]);
+ $gr->lineTo($bh[0][ 2 * $i + 1 ], $bh[1][ 2 * $i + 1 ], $color, $linewidth);
+ }
+
+ # standard coordinates for vertical lines
+ my @vx = (); # vertical lines, x values
+ my @vy = (); # vertical lines, y values
+ foreach my $x ($xmin .. $xmax) {
+ push(@vx, ($x, $x));
+ push(@vy, ($ymin, $ymax));
+ }
+ my $V = Matrix([ [@vx], [@vy] ]);
+ my $BV = $B * $V;
+ my @bv = $BV->value;
+ # draw parallelogram grid on graph object
+ # "vertical" lines
+ my $bv_ncol = ($BV->dimensions)[1];
+ foreach my $i (0 .. $bv_ncol / 2) {
+ $gr->moveTo($bv[0][ 2 * $i ], $bv[1][ 2 * $i ]);
+ $gr->lineTo($bv[0][ 2 * $i + 1 ], $bv[1][ 2 * $i + 1 ], $color, $linewidth);
+ }
+
+} # end graphgrid1
+
+sub graphgrid2 {
+ # inputs
+ my $gr = shift; # graph object
+ my $B = shift; # 2x2 basis matrix with B = (b1 | b2), with basis vectors in columns
+ my $xmin = shift;
+ my $ymin = shift;
+ my $xmax = shift;
+ my $ymax = shift; # (xmin,ymin) and (xmax,ymax) are two of the corners of the grid (must be integers)
+ my $color = shift; # grid color
+ my $linewidth = shift; # line thickness
+
+ foreach my $x ($xmin .. $xmax) {
+ foreach my $y ($ymin .. $ymax) {
+ my $X = Matrix([ [ $x, $x + 1, $x + 1, $x, $x ], [ $y, $y, $y + 1, $y + 1, $y ] ]);
+ my $BX = $B * $X;
+ my @bx = $BX->value;
+ $gr->moveTo($bx[0][0], $bx[1][0]);
+ $gr->lineTo($bx[0][1], $bx[1][1], $color, $linewidth);
+ $gr->lineTo($bx[0][2], $bx[1][2], $color, $linewidth);
+ $gr->lineTo($bx[0][3], $bx[1][3], $color, $linewidth);
+ $gr->lineTo($bx[0][4], $bx[1][4], $color, $linewidth);
+ }
+ }
+} # end graphgrid2
+
+1;
diff --git a/macros/PGgraphmacros.pl b/macros/graph/PGgraphmacros.pl
similarity index 100%
rename from macros/PGgraphmacros.pl
rename to macros/graph/PGgraphmacros.pl
diff --git a/macros/graph/PGnauGraphics.pl b/macros/graph/PGnauGraphics.pl
new file mode 100644
index 0000000000..728ba25950
--- /dev/null
+++ b/macros/graph/PGnauGraphics.pl
@@ -0,0 +1,328 @@
+
+sub _PGnauGraphics_init { }; #don't reload this file
+# loadMacros('PGunion.pl');
+loadMacros('PGgraphmacros.pl', 'unionTables.pl', 'PGchoicemacros.pl');
+
+######################################
+#Name: Plot
+#Input: Graphical object
+#Optional Input: tex_size => n: control size of tex output. n = 10*percentage of page (i.e. 200 = 20% of page)
+# note that in single column, the images are twice as big, so 200 = 40% of page
+# single => 0,1: turn on or off single column display which makes pictures fit (default = 0)
+#Output: An image with appropriate width and height of the graphical object
+######################################
+sub Plot {
+ my ($pic, @options) = @_;
+ my ($tex, $val, $plot, @size, $width, $height);
+
+ while (scalar @options > 0) {
+ $val = shift @options;
+ if ($val eq 'single') {
+ if (shift @options == 1) { $tex = 200 }
+ } elsif ($val eq 'tex_size') {
+ $tex = shift @options;
+ } else {
+ shift @options;
+ }
+ }
+
+ $tex = 400 unless defined($tex);
+ ($width, $height) = @{ $pic->size() };
+
+ $plot =
+ image(insertGraph($pic), width => $width, height => $height, tex_size => $tex, extra_html_tags => 'border=0');
+}
+
+######################################
+#Name: checkbox_table
+#Input: [values list], [answer list i.e. 1,0,1,0]
+#Optional Input: border => n - width of border in table (default = 0)
+# tex_size => n - control size of tex output for pictures (defualt = 10 * 95 / # of columns)
+# geometry =>[r,c] - the number of rows and columns desired in the table (default = 2,2)
+# labels => [@list] - a list of labels that appear beside the checkboxes. (default is blank)
+# [..] - other answer lists, included as many as desired. Note the lists must use the same
+# values as the others and answer lists must be in the same basic order.
+#Output: A table to be displayed and the answer evaluator.
+# The table should be placed between BEGIN_TEXT and END_TEXT.
+# The evaluator should be placed after END_TEXT by itself.
+######################################
+sub checkbox_table {
+ my ($val_ref, $ans_ref, @options) = @_;
+
+ my (
+ $i, $j, $k, @ans, $lab, $cols, $name, @vals,
+ $rows, @rule, $size, $true, $val1, $val2, $val3, $count,
+ @labels, @names, @order, @other, $quest, $table, $total, $answer,
+ $length, $letter, $tex_size, @ansrow, @valrow, @answer, %row_opts
+ );
+
+ @vals = @{$val_ref};
+ @ans0 = @{$ans_ref};
+ $count = 1;
+
+ while (@options) {
+ $val1 = shift @options;
+ if ($val1 eq 'border') {
+ $border = shift @options;
+ } elsif ($val1 eq 'tex_size') {
+ $single = shift @options;
+ } elsif ($val1 eq 'geometry') {
+ $val1 = shift @options;
+ ($rows, $cols) = @{$val1};
+ } elsif ($val1 eq 'labels') {
+ $val1 = shift @options;
+ @labels = @{$val1};
+ } else {
+ $val2 = "ans$count";
+ @$val2 = @{$val1};
+ $count++;
+ }
+ }
+
+ $border = 0 unless defined($border);
+ $rows = 2 unless defined($rows);
+ $cols = 2 unless defined($cols);
+ $tex_size = int(95 / $cols) * 10 unless defined($tex_size);
+
+ $size = scalar @vals;
+ $val1 = int(($size - 1) / $cols) + 1;
+ if ($val1 != $rows) { return ("Incorrect geometry or input.", 0); }
+ for ($i = 0; $i < $count; $i++) {
+ $val = "ans$i";
+ if (scalar @$val != $size) { return ("Values and answers do not match.", 0); }
+ }
+
+ $length = scalar @labels;
+ $total = $count * $size;
+ if ($total == $size) {
+ for ($i = $length; $i < $total; $i++) {
+ push @labels, '';
+ }
+ } else {
+ while ($length < $total) {
+ $loc = int($length / $size) + 1;
+ push @labels, "$loc";
+ $length++;
+ }
+ }
+
+ @order = NchooseK($size, $size);
+ @vals = @vals[@order];
+ for ($i = 0; $i < $count; $i++) {
+ $val1 = "ans$i";
+ $val2 = "labels$i";
+ $j = $i * $size;
+ $k = $j + $size - 1;
+ @$val1 = @$val1[@order];
+ @$val2 = @labels[ $j .. $k ];
+ @$val2 = @$val2[@order];
+ }
+
+ for ($i = 0; $i < $size; $i++) {
+ if ($vals[$i] =~ /WWPlot=HASH/) {
+ $vals[$i] = Plot($vals[$i], tex_size => $tex_size);
+ }
+ }
+
+ for ($i = 0; $i < $count; $i++) {
+ $true = '';
+ $val1 = "ans$i";
+ $val2 = "labels$i";
+ $val3 = "rule$i";
+ $name = "CheckBoxName$i";
+ for ($j = 0; $j < $size; $j++) {
+ $letter = $ALPHABET[$j];
+ if ($$val2[$j] eq '') {
+ $lab = $letter;
+ } else {
+ $lab = "$letter: " . "$$val2[$j]";
+ }
+ $$val3[$j] =
+ ($j ? NAMED_ANS_CHECKBOX_OPTION($name, $letter, $lab) : NAMED_ANS_CHECKBOX($name, $letter, $lab));
+ # TeX-mode uses \item, but we're not in a list, so remove it
+ # and put a fake box in front
+ $$val3[$j] =~ s/\\item/\$\\Box\$ / if $displayMode eq 'TeX';
+ $true .= $letter if $$val1[$j] == 1;
+ }
+ push @answer, LABELED_ANS($name => checkbox_cmp($true));
+ }
+
+ $table = BeginTable(spacing => 5, border => $border, center => 0);
+ %row_opts = (separation => 0);
+ for ($i = 0; $i < $rows; $i++) {
+ $j = 0;
+ @valrow = ();
+ while (@vals && $j < $cols) {
+ push @valrow, shift @vals;
+ $j++;
+ }
+ $table .= AlignedRow([@valrow], %row_opts);
+ for ($j = 0; $j < $count + 1; $j++) {
+ @ansrow = ();
+ $val1 = "rule$j";
+ $k = 0;
+ while (@$val1 && $k < $cols) {
+ push @ansrow, shift @$val1;
+ $k++;
+ }
+ $table .= AlignedRow([@ansrow], %row_opts);
+ }
+ if ($rows > 1 && $i > 0) {
+ $table .= TableSpace(16, 8);
+ }
+ }
+ $table .= EndTable();
+ unshift @answer, ($table);
+
+ return @answer;
+}
+
+######################################
+#Name: radio_table
+#Input: [values list], [answer list i.e. 1,0,1,0]
+#Optional Input: border => n - width of border in table (default = 0)
+# tex_size => n - control size of tex output for pictures (defualt = 10 * 95 / # of columns)
+# geometry =>[r,c] - the number of rows and columns desired in the table (default = 2,2)
+# labels => [@list] - a list of labels that appear beside the radio buttons. (default is blank)
+# [..] - other answer lists, included as many as desired. Note the lists must use the same
+# values as the others and answer lists must be in the same basic order.
+#Output: A table to be displayed and the answer evaluator.
+# The table should be placed between BEGIN_TEXT and END_TEXT.
+# The evaluator should be placed after END_TEXT by itself.
+######################################
+sub radio_table {
+ my ($val_ref, $ans_ref, @options) = @_;
+
+ my (
+ $i, $j, $k, @ans, $lab, $cols, $name, @vals,
+ $rows, @rule, $size, $true, $val1, $val2, $val3, $count,
+ @labels, @names, @order, @other, $quest, $table, $total, $answer,
+ $length, $letter, $tex_size, @ansrow, @valrow, @answer, %row_opts
+ );
+
+ @vals = @{$val_ref};
+ @ans0 = @{$ans_ref};
+ $count = 1;
+
+ while (@options) {
+ $val1 = shift @options;
+ if ($val1 eq 'border') {
+ $border = shift @options;
+ } elsif ($val1 eq 'tex_size') {
+ $tex_size = shift @options;
+ } elsif ($val1 eq 'geometry') {
+ $val1 = shift @options;
+ ($rows, $cols) = @{$val1};
+ } elsif ($val1 eq 'labels') {
+ $val1 = shift @options;
+ @labels = @{$val1};
+ } else {
+ $val2 = "ans$count";
+ @$val2 = @{$val1};
+ $count++;
+ }
+ }
+
+ $border = 0 unless defined($border);
+ $rows = 2 unless defined($rows);
+ $cols = 2 unless defined($cols);
+ $tex_size = int(95 / $cols) * 10 unless defined($tex_size);
+
+ $size = scalar @vals;
+ $val1 = int(($size - 1) / $cols) + 1;
+ if ($val1 != $rows) { return ("Incorrect geometry or input.", 0); }
+ for ($i = 0; $i < $count; $i++) {
+ $val1 = "ans$i";
+ if (scalar @$val1 != $size) { return ("Values and answers do not match.", 0); }
+ $total = 0;
+ for ($j = 0; $j < $size; $j++) {
+ $total += $$val1[$j];
+ }
+ if ($total != 1) { return ("Wrong number of correct answers for radio button.", 0); }
+ }
+
+ $length = scalar @labels;
+ $total = $count * $size;
+ if ($total == $size) {
+ for ($i = $length; $i < $total; $i++) {
+ push @labels, '';
+ }
+ } else {
+ while ($length < $total) {
+ $loc = int($length / $size) + 1;
+ push @labels, "$loc";
+ $length++;
+ }
+ }
+
+ @order = NchooseK($size, $size);
+ @vals = @vals[@order];
+ for ($i = 0; $i < $count; $i++) {
+ $val1 = "ans$i";
+ $val2 = "labels$i";
+ $j = $i * $size;
+ $k = $j + $size - 1;
+ @$val1 = @$val1[@order];
+ @$val2 = @labels[ $j .. $k ];
+ @$val2 = @$val2[@order];
+ }
+
+ for ($i = 0; $i < $size; $i++) {
+ if ($vals[$i] =~ /WWPlot=HASH/) {
+ $vals[$i] = Plot($vals[$i], tex_size => $tex_size);
+ }
+ }
+
+ for ($i = 0; $i < $count; $i++) {
+ $true = '';
+ $val1 = "ans$i";
+ $val2 = "labels$i";
+ $val3 = "rule$i";
+ $name = "CheckBoxName$i";
+ for ($j = 0; $j < $size; $j++) {
+ $letter = $ALPHABET[$j];
+ if ($$val2[$j] eq '') {
+ $lab = $letter;
+ } else {
+ $lab = "$letter: " . "$$val2[$j]";
+ }
+ $$val3[$j] = ($j ? NAMED_ANS_RADIO_EXTENSION($name, $letter, $lab) : NAMED_ANS_RADIO($name, $letter, $lab));
+ # TeX-mode uses \item, but we're not in a list, so remove it
+ # and put a fake box in front
+ $$val3[$j] =~ s/\\item/\$\\Box\$ / if $displayMode eq 'TeX';
+ $true .= $letter if $$val1[$j] == 1;
+ }
+ push @answer, LABELED_ANS($name => checkbox_cmp($true));
+ }
+
+ $table = BeginTable(spacing => 5, border => $border, center => 0);
+ %row_opts = (separation => 0);
+ for ($i = 0; $i < $rows; $i++) {
+ $j = 0;
+ @valrow = ();
+ while (@vals && $j < $cols) {
+ push @valrow, shift @vals;
+ $j++;
+ }
+ $table .= AlignedRow([@valrow], %row_opts);
+ for ($j = 0; $j < $count + 1; $j++) {
+ @ansrow = ();
+ $val1 = "rule$j";
+ $k = 0;
+ while (@$val1 && $k < $cols) {
+ push @ansrow, shift @$val1;
+ $k++;
+ }
+ $table .= AlignedRow([@ansrow], %row_opts);
+ }
+ if ($rows > 1 && $i > 0) {
+ $table .= TableSpace(16, 8);
+ }
+ }
+ $table .= EndTable();
+ unshift @answer, ($table);
+
+ return @answer;
+}
+
+1;
diff --git a/macros/PGstatisticsGraphMacros.pl b/macros/graph/PGstatisticsGraphMacros.pl
similarity index 100%
rename from macros/PGstatisticsGraphMacros.pl
rename to macros/graph/PGstatisticsGraphMacros.pl
diff --git a/macros/PGtikz.pl b/macros/graph/PGtikz.pl
similarity index 100%
rename from macros/PGtikz.pl
rename to macros/graph/PGtikz.pl
diff --git a/macros/graph/imageChoice.pl b/macros/graph/imageChoice.pl
new file mode 100644
index 0000000000..4695e6dffc
--- /dev/null
+++ b/macros/graph/imageChoice.pl
@@ -0,0 +1,104 @@
+loadMacros('PGchoicemacros.pl', 'unionUtils.pl', 'choiceUtils.pl',);
+
+sub _imageChoice_init { }; # don't reload this file
+
+######################################################################
+#
+# Create a match list where the answers are images
+#
+# Usage: $ml = new_image_match_list(options);
+#
+# where options are those that can be supplied to image_print_a below.
+# The answers should be an image name or reference to to a plot object
+# (or a reference to a pair of either of these), and they are passed
+# to the Image function for processing. See unionUtils.pl for more
+# information on how these are handled.
+#
+sub new_image_match_list {
+ my $ml = new Match(random(1, 2000, 1), \&alt_print_q, \&img_print_a);
+ $ml->{ImageOptions} = [@_];
+ $ml;
+}
+
+######################################################################
+#
+# A print routine for image matching. This is designed to display
+# four graphs per row. More can be included by setting the ImageOptions
+# variable in the match list. For example:
+#
+# $ml->{ImageOptions} = [size => [100,100]]
+#
+# You can include the following options:
+#
+# size => [w,h] the width and height of the images
+# width => n the width of the images (obsolete)
+# height => n the height of the images (obsolete)
+# tex_size => n the size for the TeX version of the image
+# separation => n the spacing between the images in a row
+# vseparation => n the spacing between the images and captions
+# link => 0 or 1 1 to make a link to the original image
+# columns => n the number of images in each row (defaults to 4)
+# border => n the width of the image border
+#
+
+sub img_print_a {
+ my $self = shift;
+ $self->{ImageOptions} = [] unless defined($self->{ImageOptions});
+ my %options = (
+ width => 150,
+ height => 150,
+ tex_size => 200,
+ columns => 4,
+ separation => 15,
+ vseparation => 5,
+ link => 0,
+ @{ $self->{ImageOptions} }
+ );
+ my ($w, $h, $m) = ($options{width}, $options{height}, $options{columns});
+ ($w, $h) = @{ $options{size} } if defined($options{size});
+ my ($sep, $vsep) = ($options{separation}, $options{vseparation});
+ my ($tsize, $link) = ($options{tex_size}, $options{link});
+ my $border = $options{border};
+ $border = ($link ? 2 : 1) unless defined($border);
+ my $HTML;
+ my @images = ();
+ my @labels = ();
+ my $i = 0;
+ my $out;
+
+ $out = BeginTable(tex_spacing => "5pt", tex_border => "5pt");
+ while ($image = shift) {
+ push(
+ @images,
+ Image(
+ $image,
+ size => [ $w, $h ],
+ tex_size => $tsize,
+ link => $link,
+ border => $border
+ )
+ );
+ push(
+ @labels,
+ MODES(
+ TeX => "\\hfil \\textbf{$main::ALPHABET[$i]}",
+ Latex2HTML => $bHTML . "$main::ALPHABET[$i] $main::ALPHABET[$i] macro file.
+
+=over 12
+
+=item C
+
+= back
+
+For a MathObject list of MathObject vectors, the way to use the
+answer checkers is the same as using a custom answer checker
+inside of C~~&name_of_answer_checker_subroutine)>
+such as
+
+=over 12
+
+=item Ccmp( checker=~~&basis_checker_list_of_vectors ) );>
+
+=item C + s * <0,1,0> + t * <0,0,1>")-cmp( checker=~~&affine_subspace_checker_vectors ) );>
+
+=back
+
+The "list of vectors" at the end of the checker name refers to the
+fact that the student answer is a list of vectors.
+
+Here is an example of how to use these answer checkers.
+
+=over 12
+
+DOCUMENT();
+loadMacros(
+"PGstandard.pl",
+"MathObjects.pl",
+"VectorListCheckers.pl",
+"PGcourse.pl",
+);
+$showPartialCorrectAnswers = 1;
+TEXT(beginproblem());
+
+Context('Vector');
+
+$B = Matrix([[1,0,0],[0,1,0],[0,0,0]]);
+
+$answer = List(ColumnVector(1,0,0),ColumnVector(0,1,0));
+
+Context()->texStrings;
+BEGIN_TEXT
+A basis for the column space of \( B = $B \) is
+$BR
+$BR
+\{ $answer->ans_rule(60) \}
+$BR
+$BR
+Enter your answer as a comma separated list of vectors, such as
+\( \verb+<1,2,3>,<4,5,6>+ \).
+END_TEXT
+Context()->normalStrings;
+
+ANS( $answer->cmp(list_checker=>~~&basis_checker_list_of_vectors) );
+
+
+
+ENDDOCUMENT();
+
+=back
+
+The answer evaluation section of the PG file is totally standard.
+
+=over 12
+
+ANS( $multians->cmp );
+
+=back
+
+The C should be used for
+solutions to non-homogeneous systems of linear equations for
+which the solution is essentially a point plus the span of
+several linearly independent vectors. When using the parametric
+plane checker, the first vector input always serves as a point
+on the hyperplane (i.e., the first vector input is always a
+particular solution), while the remaining vectors are a basis for
+the hyperplane (i.e., they span the homogeneous solution set).
+
+=head1 AUTHORS
+
+Paul Pearson, Hope College, Department of Mathematics
+
+=cut
+
+################################################
+
+loadMacros("MathObjects.pl",);
+
+sub basis_checker_list_of_vectors {
+
+ my ($correct, $student, $ansHash, $value) = @_;
+ my @c = @{$correct};
+ my @s = @{$student};
+ my $nc = scalar(@c);
+ my $ns = scalar(@s);
+ my $score = 0;
+ my @errors = ();
+
+ return ($score, @errors) if $nc != $ns;
+
+ if ($nc == 1) {
+
+ if (Vector($s[0])->isParallel($c[0])) { return ($nc, @errors); }
+
+ } else {
+
+ # Most of the answer checking is done on integers
+ # or on decimals like 0.24381729, so we will set the
+ # tolerance accordingly in a local context.
+ my $context = Context()->copy;
+ $context->flags->set(
+ tolerance => 0.001,
+ tolType => "absolute",
+ );
+
+ # put the correct vectors into the columns of a matrix $C
+ my @cor = ();
+ foreach my $i (0 .. $nc - 1) {
+ push(@cor, Matrix($c[$i]));
+ }
+ my $C = Matrix(@cor)->transpose;
+
+ # put the student vectors into the columns of a matrix $S
+ my @stu = ();
+ foreach my $i (0 .. $ns - 1) {
+ push(@stu, Matrix($s[$i]));
+ }
+ my $S = Matrix(@stu)->transpose;
+
+ # Put $C and $S into the local context so that
+ # all of the computations that follow will also be in
+ # the local context.
+ $C = Matrix($context, $C);
+ $S = Matrix($context, $S);
+
+ # Theorem: A^T A is invertible if and only if A has linearly independent columns.
+
+ # Check that the professor's vectors are, in fact, linearly independent.
+ $CTC = ($C->transpose) * $C;
+ warn "Correct answer is a linearly dependent set." if ($CTC->det == 0);
+
+ # Check that the student's vectors are linearly independent
+ if ((($S->transpose) * $S)->det == 0) {
+ Value->Error("Your vectors are linearly dependent");
+ return 0;
+ }
+
+ # S = student, C = correct, X = change of basis matrix
+ # Solve S = CX for X using (C^T C)^{-1} C^T S = X.
+ $X = ($CTC->inverse) * (($C->transpose) * $S);
+ if ($S == $C * $X) { $score = $nc; }
+
+ return ($score, @errors);
+
+ }
+
+}
+
+########################################################
+
+$vector_list_column_syntax_angle_brackets = MODES(
+ TeX => '',
+ HTML => "Enter a column vector such as
+\\( \\left\\lbrack \\begin{array}{r} 1 \\\\ 2 \\end{array} \\right\\rbrack \\)
+using the syntax \\( \\verb+<1,2>+ \\).
+If there is more than one vector in your answer, enter
+your answer as a comma separated list of vectors, such as
+\\( \\verb+<1,2>,<3,4>+ \\)."
+);
+
+########################################################
+
+$vector_list_row_syntax_angle_brackets = MODES(
+ TeX => '',
+ HTML => "Enter a row vector using the syntax \\( \\verb+<1,2>+ \\).
+If there is more than one vector in your answer, enter
+your answer as a comma separated list of vectors, such as
+\\( \\verb+<1,2>,<3,4>+ \\)."
+);
+
+########################################################
+
+sub affine_subspace_checker_vectors {
+
+ my ($correct, $student, $ansHash) = @_;
+ my @s = ();
+ my @c = ();
+
+ # Most of the answer checking is done on integers
+ # or on decimals like 0.24381729, so we will set the
+ # tolerance accordingly in a local context.
+ my $context = Context()->copy;
+ $context->flags->set(
+ tolerance => 0.001,
+ tolType => "absolute",
+ );
+
+ # Get the variables from the context
+ my @vars = $context->variables->names;
+
+ # Make an array of zeros the same length as @vars
+ my @zeros = ();
+ foreach (@vars) { push(@zeros, 0); }
+
+ # Evaluate the correct and student answers on the zero vector
+ my %h;
+ @h{@vars} = @zeros;
+ push(@c, Matrix($context, $correct->eval(%h)));
+ push(@s, Matrix($context, $student->eval(%h)));
+
+ # Make standard basis vectors e_i with ith entry = 1 and all other entries = 0
+ # and evaluate the correct and student answers on e_i
+ my @temp = ();
+ foreach my $i (0 .. $#vars) {
+ @temp = @zeros;
+ $temp[$i] = 1;
+ @h{@vars} = @temp;
+ my $c_temp = Matrix($context, $correct->eval(%h));
+ my $s_temp = Matrix($context, $student->eval(%h));
+ $c_temp = $c_temp - $c[0];
+ $s_temp = $s_temp - $s[0];
+ push(@c, $c_temp);
+ push(@s, $s_temp);
+ }
+
+ # Put the results into the columns of matrices
+ my $C0 = Matrix($context, shift(@c))->transpose; # column vector = displacement vector
+ my $C = Matrix($context, @c)->transpose; # matrix columns = vectors that span the hyperplane
+ my $S0 = Matrix($context, shift(@s))->transpose; # column vector = displacement vector
+ my $S = Matrix($context, @s)->transpose; # matrix columns = vectors that span the hyperplane
+
+ # Theorem: A^T A is invertible if and only if A has linearly independent columns.
+
+ # Check that the professor's vectors are, in fact, linearly independent.
+ $CTC = ($C->transpose) * $C;
+ warn "Correct answer is a linearly dependent set." if ($CTC->det == 0);
+
+ # Check that the student's vectors are linearly independent
+ if ((($S->transpose) * $S)->det == 0) {
+ Value->Error("Your vectors do not span a (hyper) plane of the correct dimension");
+ return 0;
+ }
+
+ # solve (S_0 = C_0 + C A) for the column vector A of weights using
+ # (S_0 - C_0) = C A
+ # C^T (S_0 - C_0) = C^T C A
+ # (C^T C)^{-1} C^T (S_0 - C_0) = A
+ my $A = ($CTC->inverse) * ($C->transpose) * ($S0 - $C0);
+ if ($S0 != $C0 + $C * $A) {
+ #Value->Error("Your particular solution $S0 is incorrect");
+ return 0;
+ }
+
+ # S = student, C = correct, X = change of basis matrix
+ # Solve S = CX for X using (C^T C)^{-1} C^T S = X.
+ $X = ($CTC->inverse) * (($C->transpose) * $S);
+ return $S == $C * $X;
+
+}
+
+1;
diff --git a/macros/math/algebraMacros.pl b/macros/math/algebraMacros.pl
new file mode 100644
index 0000000000..c458626f37
--- /dev/null
+++ b/macros/math/algebraMacros.pl
@@ -0,0 +1,250 @@
+# algebraMacros.pl
+
+# define any custom subroutines you want and then use them in
+# problems by including the file in loadMacros() calls.
+
+sub _init_macro_template {
+
+ #Possibly add initialization code here
+ #sub routine is not required, but prevents the macro from being re-loaded
+
+}
+
+######################## subroutines
+
+# fisher-yates shuffle
+# argument: reference to a list
+# shuffles list in-place
+# returns: nothing
+sub fyshuffle {
+ my $array = shift;
+ my $i = @$array;
+ while (--$i) {
+ my $j = random(0, $i, 1);
+ @$array[ $i, $j ] = @$array[ $j, $i ];
+ }
+}
+
+# extended euclidean algorithm
+# by Dick Lane
+# http://webwork.maa.org/moodle/mod/forum/discuss.php?d=2286
+# arguments: a, b
+# returns: d, x, y, s, t where gcd( a, b ) = d = a( x + sk ) + b( y + tk ) for all k
+sub xgcd ($$) {
+ my ($a, $b, $x, $y, $s, $t) = (@_, 1, 0, 0, 1);
+
+ while ($b) {
+ my $q = int($a / $b);
+ ($a, $x, $y, $b, $s, $t) = ($b, $s, $t, $a - $q * $b, $x - $q * $s, $y - $q * $t);
+ }
+
+ return [ $a, $x, $y, $s, $t ];
+}
+
+# subroutine to decompose a permutation into a product of disjoint cycles.
+# argument: reference to a list containing the permutation data
+# that is, element 0 of the list is f(0), element 1 is f(1), etc
+# returns: mathObject list of lists representing the cycle decomposition of the permutation
+sub disjointCycles {
+ $p = shift;
+
+ # create a hash representing the permutation
+ %pHash = ();
+ $pHash{$_} = $$p[$_] foreach (0 .. -1 + scalar @$p);
+
+ @cycles = ();
+ while (keys %pHash) {
+ # start with first available key
+ @c = (keys %pHash)[0];
+
+ # keep looping through set, adding elements to the current cycle (c)
+ # until we get back to the beginning of c
+ push @c, delete $pHash{ $c[-1] } while $pHash{ $c[-1] } != $c[0];
+
+ delete $pHash{ $c[-1] };
+
+ # add c to cycles if it's not just a 1-cycle
+ push @cycles, [ map { $_ + 1 } @c ] if @c > 1;
+ }
+
+ # making the lists of lists must be done carefully in order to get the behavior we want
+ # we want the cycles (Lists within the List) to always have parentheses, even if there's
+ # only one. But we want the outer List to never have parentheses
+ if (scalar @cycles > 1) {
+ $result = List(map { List(join(',', @$_)) } (@cycles));
+ } elsif (scalar @cycles > 0) {
+ $result = List(map { List('(' . join(',', @$_) . ')') } @cycles);
+ } else {
+ Context()->strings->add(id => { alias => "identity" });
+ $result = List('(' . $cycle[0] . ')');
+ }
+ return $result;
+}
+
+# subroutine to decompose a permutation into a product of transpositions ( 2-cycles ).
+# argument: mathObject list of lists representing the cycle decomposition of the permutation (i.e., the output of disjointCycles() )
+# returns: mathObject list of lists representing the permutation as a list of transpositions
+sub cyclesToTranspositions {
+ my $listOfCycles = shift;
+
+ @transpositions = ();
+
+ # decompose each cycle ( a_1 a_2 ... a_n ) into ( a_1 a_2 )( a_1 a_3 ) ... ( a_1 a_n )
+ foreach ($listOfCycles->value) {
+ my @cycle = $_->value;
+ foreach (1 .. @cycle - 1) {
+ push @transpositions, List(@cycle[ 0, $_ ]);
+ }
+ }
+
+# unlike disjointCycles, this subroutine is only used in a problem where the permutation has order > 4, so there will always be more than one element. Therefore we don't have to do any weird stuff to format the list (make parentheses display correctly)
+ return List(@transpositions);
+}
+
+# subroutine to determine the order of a permutation
+# argument: a list of lists representing a permutation in the form of a product of disjoint cycles ( i.e., the output of disjointCycles() )
+# returns: mathObject integer representing the order of the permutation
+sub cycleOrder {
+ my $p = shift; # list of lists
+
+ my $order = 1;
+ $order = lcm($order, $_->length) foreach $p->value;
+
+ return Compute($order);
+}
+
+# subroutine to determine the parity of a permutation
+# argument: a list of lists representing a permutation in the form of a product of disjoint cycles (i.e., the output of disjointCycles() )
+# returns: TRUE if the permutation is even, FALSE if the permutation is odd
+sub isEven {
+ my $p = shift;
+
+ my $numberEvenCycles = scalar grep { $_->length % 2 == 0 } $p->value;
+
+ return !($numberEvenCycles % 2);
+
+}
+
+######################## frequently-used custom checkers
+
+# you can call these when checking answers like this:
+#
+# ANS( $f->cmp( checker => ~~&modChecker ) );
+
+# make sure the external variables are available; for instance, in order to use
+# the modChecker subroutine, you must have the variable $modulus defined in
+# your problem
+
+###############################################################################
+# modChecker
+###############################################################################
+# Type: checker
+# Used in: RingsDefinition3.pg
+# RingsDefinition4.pg
+# RingsDefinition5.pg
+# RingsDefinition7.pg
+# RingsQuotientPolynomial3.pg
+# RingsQuotientPolynomial4.pg
+# RingsIdealsHomomorphisms2.pg
+# Purpose: Compare the student's answer (a number) to the correct
+# answer (a number), modulo $modulus
+# External variables:
+# $modulus
+# Comment: This checker is defined in algebraMacros.pl because it's used
+# in so many problems
+###############################################################################
+sub modChecker {
+ my ($correct, $student, $ansHash) = @_; # get correct and student MathObjects
+ return ($student % $modulus == $correct % $modulus ? 1 : 0);
+}
+###############################################################################
+
+###############################################################################
+# checkCycles
+###############################################################################
+# Type: checker
+# Used in: Permutations1.pg
+# Permutations2.pg
+# Permutations5.pg
+# Permutations6.pg
+# Purpose: Compare a student's cycle to a correct cycle, see if they
+# represent the same permutation (i.e. ( 1 2 3 ) = ( 2 3 1 ) )
+# External variables:
+# Comment: This checker is defined in algebraMacros.pl because it's used
+# in so many problems
+###############################################################################
+sub checkCycles {
+ my ($correct, $student, $ansHash) = @_;
+
+ @studentCycle = $student->value;
+ @correctCycle = $correct->value;
+
+ # immediately fail if the cycles are not the same length
+ return 0 if @studentCycle != @correctCycle;
+
+ # try each offset, see if the lists are the same
+ foreach (0 .. @studentCycle - 1) {
+ my $i = 0;
+ $i++ while $i < @studentCycle && $studentCycle[$i] == $correctCycle[ -$_ + $i ];
+ return 1 if $i == @studentCycle;
+ }
+
+ return 0;
+}
+###############################################################################
+
+###############################################################################
+# checkListOfTranspositions
+###############################################################################
+# Type: checker
+# Used in: Permutations4.pg
+# Permutations8.pg
+# Purpose: Compare a student's sequence of transpositions to a correct
+# sequence of transpositions, see if they represent the same
+# permutation
+# External variables:
+# @x - list of elements in the set on which permutations are
+# defined
+# Comment: This checker is defined in algebraMacros.pl because it's used
+# in so many problems
+###############################################################################
+sub checkListOfTranspositions {
+ my ($correct, $student, $ansHash, $value) = @_;
+
+ # create hashes which will be used to store the student and correct permutations
+ my (%studentPerm, %correctPerm);
+ $studentPerm{$_} = $correctPerm{$_} = $_ foreach (1 .. @x);
+
+ # apply each of the correct transpositions in succession, from right to left
+ foreach (1 .. @$correct) {
+ # read the transposition ( a, b ) as a pair of integers
+ $a = ($correct->[ -$_ ]->value)[0]->value;
+ $b = ($correct->[ -$_ ]->value)[1]->value;
+
+ # switch a and b elements of the hash
+ @correctPerm{ $a, $b } = @correctPerm{ $b, $a };
+ }
+
+ # apply each of the student's transpositions in succession, from right to left
+ foreach (1 .. @$student) {
+ # check to make sure this entry is a list of 2 elements, both of which are positive integers in the set @x
+ return (0, "one of your entries is not a well-defined transposition on this set")
+ if $student->[ -$_ ]->length != 2
+ || scalar grep { !Value::isReal($_) || $_ != int $_ || $_ < 1 || $_ > @x } $student->[ -$_ ]->value;
+
+ # read the transposition ( a, b ) as a pair of integers
+ $a = ($student->[ -$_ ]->value)[0]->value;
+ $b = ($student->[ -$_ ]->value)[1]->value;
+
+ # switch elements a and b of the hash
+ @studentPerm{ $a, $b } = @studentPerm{ $b, $a };
+ }
+
+ # read the two hashes to make sure they're the same. if not, the answer is wrong
+ return scalar(grep { $studentPerm{$_} != $correctPerm{$_} } (1 .. @x)) ? (0) : (scalar(@$student));
+
+# an alternative way to do this would be to compute the permutation represented by the correct list of transpositions, then do the inverse of the student's list of transpositions (work left-to-right instead of right-to-left) on the same list, and see if it results in the identity.
+}
+###############################################################################
+
+1; #required at end of file - a perl thing
diff --git a/macros/bizarroArithmetic.pl b/macros/math/bizarroArithmetic.pl
similarity index 100%
rename from macros/bizarroArithmetic.pl
rename to macros/math/bizarroArithmetic.pl
diff --git a/macros/customizeLaTeX.pl b/macros/math/customizeLaTeX.pl
similarity index 100%
rename from macros/customizeLaTeX.pl
rename to macros/math/customizeLaTeX.pl
diff --git a/macros/draggableProof.pl b/macros/math/draggableProof.pl
similarity index 100%
rename from macros/draggableProof.pl
rename to macros/math/draggableProof.pl
diff --git a/macros/draggableSubsets.pl b/macros/math/draggableSubsets.pl
similarity index 100%
rename from macros/draggableSubsets.pl
rename to macros/math/draggableSubsets.pl
diff --git a/macros/math/fixedPrecision.pl b/macros/math/fixedPrecision.pl
new file mode 100644
index 0000000000..37d5abddf3
--- /dev/null
+++ b/macros/math/fixedPrecision.pl
@@ -0,0 +1,59 @@
+sub _fixedPrecision_init { }
+loadMacros('MathObjects.pl');
+
+package FixedPrecision;
+our @ISA = ("Value::Real");
+
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ my $context = (Value::isContext($_[0]) ? shift : $self->context);
+ my $x = shift;
+ my $n = shift;
+ Value::Error("Too many arguments") if scalar(@_) > 0;
+ if (defined($n)) {
+ $x = main::prfmt($x, "%.${n}f");
+ } else {
+ $x =~ s/\s+//g;
+ my ($int, $dec) = split(/\./, $x);
+ $n = length($dec);
+ }
+ $self = bless $self->SUPER::new($context, $x), $class;
+ $self->{decimals} = $n;
+ $self->{isValue} = 1;
+ return $self;
+}
+
+sub string {
+ my $self = shift;
+ main::prfmt($self->value, "%." . $self->{decimals} . "f");
+}
+
+sub compare {
+ my ($self, $l, $r) = Value::checkOpOrder(@_);
+ $l cmp $r;
+}
+
+package FixedPrecisionNumber;
+our @ISA = ("Parser::Number");
+
+sub new {
+ my $self = shift;
+ my $class = ref($self) || $self;
+ my $equation = shift;
+ my $context = $equation->{context};
+ $self = bless $self->SUPER::new($equation, @_), $class;
+ $self->{value} = FixedPrecision->new($self->{value_string});
+ return $self;
+}
+
+sub string { (shift)->{value}->string(@_) }
+sub TeX { (shift)->{value}->TeX(@_) }
+
+package main;
+
+Context()->{parser}{Number} = "FixedPrecisionNumber";
+
+sub FixedPrecision { FixedPrecision->new(@_) }
+
+1;
diff --git a/macros/math/interpMacros.pl b/macros/math/interpMacros.pl
new file mode 100644
index 0000000000..3232a6f298
--- /dev/null
+++ b/macros/math/interpMacros.pl
@@ -0,0 +1,33 @@
+# interpMacros.pl
+# Rename this file (with .pl extension) and place it in your course macros directory,
+
+sub interpVals {
+ $arrayLength = ($#_) / 2;
+ @A_ARRAY = @_[ 0 .. ($arrayLength - 1) ];
+ @B_ARRAY = @_[ $arrayLength .. ($#_ - 1) ];
+ $A_VAL = $_[$#_];
+ $arrayLength2 = $#A_ARRAY;
+
+ for ($i = 1; $i < ($#A_ARRAY + 1); $i++) {
+ if ($A_VAL == $A_ARRAY[ $i - 1 ]) {
+ $B_VAL = $B_ARRAY[ $i - 1 ];
+ last;
+ } elsif ($A_ARRAY[ $i - 1 ] < $A_VAL && $A_VAL < $A_ARRAY[$i]) {
+ $AL = $A_ARRAY[ $i - 1 ];
+ $AR = $A_ARRAY[$i];
+ $BL = $B_ARRAY[ $i - 1 ];
+ $BR = $B_ARRAY[$i];
+ $B_VAL = (($A_VAL - $AL) / ($AR - $AL) * ($BR - $BL)) + $BL;
+ last;
+ } elsif ($A_VAL == $A_ARRAY[$i]) {
+ $B_VAL = $B_ARRAY[$i];
+ last;
+ } else {
+ $B_VAL = $B_ARRAY[0];
+ }
+ }
+
+ return $B_VAL;
+}
+
+1; #required at end of file - a perl thing
diff --git a/macros/math/regrfnsPG.pl b/macros/math/regrfnsPG.pl
new file mode 100644
index 0000000000..71e1073120
--- /dev/null
+++ b/macros/math/regrfnsPG.pl
@@ -0,0 +1,109 @@
+
+# functions for simple linear regression in perl
+
+#/* "a","b" are the two endpoints of the range of
+# random integers to be produced. */
+# inputs $a,$b are integers
+#sub rndgen
+#{ local($a,$b,$r);
+# $a=$_[0]; $b=$_[1];
+# $r=rand($b-$a+1); # in (0,b-a+1)
+# #print $a," ",$b," ",$r,"\n";
+# $r=int($r)+$a; # between a,b inclusive
+# $r;
+#}
+
+# N (size of population) and ssize (sample size) are inputs
+sub isamp {
+ local ($N, $ssize, $N1, $j, $k, $temp, @x, @xsub);
+ $N = $_[0];
+ $ssize = $_[1];
+ $N1 = $N - 1;
+ @x = 0 .. $N1;
+ for ($j = 0; $j < $ssize; $j++) { #$k=rndgen($j,$N1);
+ $k = random($j, $N1, 1); # using function in WebWork
+ $temp = $x[$j];
+ $x[$j] = $x[$k];
+ $x[$k] = $temp;
+ }
+ #for($j=0; $j<$ssize; $j++) { $xsub[$j]=$x[$j]; }
+ @xsub = @x[ 0 .. ($ssize - 1) ];
+ @xsub;
+}
+
+# simple linear regression
+# input xvec, yvec : assumed as one vector here
+# output ($n,$xbar,$ybar,$sx2,$sy2,$sxy,$b0,$b1,$sse,$mse,$x0);
+sub lsreg {
+ local ($n, $i, $xi, $yi, $sx1, $sx2, $sy1, $sy2, $sxy, $xbar, $ybar, $b0, $b1, $sse, $mse);
+ $n = ($#_ + 1) / 2;
+ #print $n,"\n";
+ $sx1 = 0;
+ $sx2 = 0;
+ $sy1 = 0;
+ $sy2 = 0;
+ $sxy = 0;
+ for ($i = 0; $i < $n; $i++) { #$xi=$xx[$i]; $yi=$yy[$i];
+ $xi = $_[$i];
+ $yi = $_[ $i + $n ];
+ $sx1 = $sx1 + $xi;
+ $sx2 = $sx2 + $xi * $xi;
+ $sy1 = $sy1 + $yi;
+ $sy2 = $sy2 + $yi * $yi;
+ $sxy = $sxy + $xi * $yi;
+ }
+ $xbar = $sx1 / $n;
+ $ybar = $sy1 / $n;
+ $sx2 = ($sx2 - $n * $xbar**2) / ($n - 1);
+ $sy2 = ($sy2 - $n * $ybar**2) / ($n - 1);
+ $sxy = ($sxy - $n * $xbar * $ybar) / ($n - 1);
+ $b1 = $sxy / $sx2;
+ $b0 = $ybar - $b1 * $xbar;
+ $sse = ($sy2 - $sxy**2 / $sx2) * ($n - 1);
+ $mse = $sse / ($n - 2);
+ @out = ($n, $xbar, $ybar, $sx2, $sy2, $sxy, $b0, $b1, $sse, $mse);
+ @out;
+}
+
+# subpopulation mean at x0
+#sqrt(mse*(1/n+(x0-xbar)^2/((n-1)*sx2)))
+# input : output of lsreg, plus x0
+# or ($n,$xbar,$ybar,$sx2,$sy2,$sxy,$b0,$b1,$sse,$mse,$x0);
+# output: point estimate and SE
+sub subpopmeanint {
+ local ($n, $xbar, $sx2, $b0, $b1, $x0, $muygx, $semu, @out);
+ $n = $_[0];
+ $xbar = $_[1];
+ $sx2 = $_[3];
+ $b0 = $_[6];
+ $b1 = $_[7];
+ $mse = $_[9];
+ $x0 = $_[10];
+ $muygx = $b0 + $b1 * $x0;
+ $semu = sqrt($mse * (1 / $n + ($x0 - $xbar)**2 / (($n - 1) * $sx2)));
+ @out = ($muygx, $semu);
+ @out;
+}
+
+#prediction interval at x=x0
+#sqrt(mse*(1+1/n+(x0-xbar)^2/((n-1)*sx2)))
+# input : output of lsreg, plus x0
+# ($n,$xbar,$ybar,$sx2,$sy2,$sxy,$b0,$b1,$sse,$mse,$x0);
+# output: point estimate and SE
+sub predint {
+ local ($n, $xbar, $sx2, $b0, $b1, $x0, $muygx, $semu, @out);
+ $n = $_[0];
+ $xbar = $_[1];
+ $sx2 = $_[3];
+ $b0 = $_[6];
+ $b1 = $_[7];
+ $mse = $_[9];
+ $x0 = $_[10];
+ $muygx = $b0 + $b1 * $x0;
+ $semu = sqrt($mse * (1 + 1 / $n + ($x0 - $xbar)**2 / (($n - 1) * $sx2)));
+ @out = ($muygx, $semu);
+ @out;
+}
+
+1; #return true
+
diff --git a/macros/tableau.pl b/macros/math/tableau.pl
old mode 100755
new mode 100644
similarity index 100%
rename from macros/tableau.pl
rename to macros/math/tableau.pl
diff --git a/macros/tableau_main_subroutines.pl b/macros/math/tableau_main_subroutines.pl
similarity index 99%
rename from macros/tableau_main_subroutines.pl
rename to macros/math/tableau_main_subroutines.pl
index 85e4f4c7ae..67a027cba1 100644
--- a/macros/tableau_main_subroutines.pl
+++ b/macros/math/tableau_main_subroutines.pl
@@ -184,7 +184,5 @@ sub get_tableau_variable_values {
# and basis is {3,4,5} (start columns with 1)
# $n= 4; $m = 7
# $x1=0; $x2=0; $x3=s1=3; $x4=s2=6; $x5=s3=9; w=10=objective value
-#
-#
1;
diff --git a/macros/misc/PCCmacros.pl b/macros/misc/PCCmacros.pl
new file mode 100644
index 0000000000..7a4c82aa17
--- /dev/null
+++ b/macros/misc/PCCmacros.pl
@@ -0,0 +1,848 @@
+
+=head1 NAME
+
+PCCmacros.pl - A collection of tools found to be useful during the development of the PCC problem library.
+
+=head1 DESCRIPTION
+
+This file implements subroutines developed for use in problems originally developed for a PCC problem library
+
+To use it, load the macro file:
+
+ loadMacros(
+ "PGstandard.pl",
+ "MathObjects.pl",
+ "PCCmacros.pl",
+ );
+
+
+=cut
+
+###############################
+#Name: perlround
+#Input: a number to round, then a place to round to. e.g. 2=>hundredths, 0=>whole, -1=>tens
+#Output: $x rounded to the $n place. This attempts to overcome quirks with rounding when the cut part is like 0.005
+################################
+sub perlround {
+ # number to round
+ my $x = shift;
+ # place to round. e.g. 2=>hundredths, 0=>whole, -1=>tens
+ my $n = shift;
+ # "fix" non-integer input
+ $n = int($n);
+ # corresponding integer to round up or down
+ my $X = $x * 10**$n;
+ $X = ($X - sprintf("%.0f", $X) eq 0.5) ? int($X + 1) : sprintf("%.0f", $X);
+ return $X / 10**$n;
+}
+
+###############################
+#Name: RandomName
+#Input: None required
+#Optional Input: 'sex' => male or female
+#Output: A name that is randomly chosen from the list maintained here.
+# If 'sex' is specified, the name is from the list of that sex.
+################################
+sub RandomName {
+ my %options = @_;
+
+ my ($sex, $name, @femlist, @malelist);
+
+ $sex = $options{'sex'} if defined($options{'sex'});
+
+ $sex = 'both' unless defined($sex);
+
+ @femlist = (
+ 'Adrian', 'Alisa', 'Alyson', 'Amber', 'Annaly', 'Ashley', 'Barbara', 'Bobbi',
+ 'Briana', 'Candi', 'Carly', 'Carmen', 'Casandra', 'Charity', 'Charlotte', 'Cheryl',
+ 'Dawn', 'Diane', 'dMarie', 'Donna', 'Eileen', 'Elishua', 'Emily', 'Fabrienne',
+ 'Hannah', 'Haley', 'Heather', 'Holli', 'Irene', 'Izabelle', 'Janieve', 'Jenny',
+ 'Jessica', 'Julie', 'Kara', 'Kayla', 'Kandace', 'Katherine', 'Kim', 'Kristen',
+ 'Kylie', 'Laney', 'Laurie', 'Lesley', 'Lily', 'Lindsay', 'Lisa', 'Maria',
+ 'Martha', 'Maygen', 'Morah', 'Michele', 'Nenia', 'Nina', 'Olivia', 'Page',
+ 'Penelope', 'Perlia', 'Priscilla', 'Rebecca', 'Renee', 'Rita', 'Ronda', 'Samantha',
+ 'Sarah', 'Selena', 'Sharell', 'Sharnell', 'Sherial', 'Stephanie', 'Subin', 'Sydney',
+ 'Tammy', 'Teresa', 'Tiffany', 'Tracei', 'Virginia', 'Wendy'
+ );
+
+ @malelist = (
+ 'Aaron', 'Aleric', 'Alejandro', 'Andrew', 'Anthony', 'Benjamin', 'Blake', 'Brandon',
+ 'Brent', 'Carl', 'Chris', 'Cody', 'Connor', 'Corey', 'Daniel', 'Dave',
+ 'Dennis', 'Derick', 'Devon', 'Douglas', 'Emiliano', 'Eric', 'Evan', 'Farshad',
+ 'Gosheven', 'Grant', 'Gregory', 'Gustav', 'Hayden', 'Henry', 'Huynh', 'Ivan',
+ 'James', 'Jay', 'Jeff', 'Jerry', 'Jon', 'Joseph', 'Joshua', 'Ken',
+ 'Kenji', 'Kimball', 'Kurt', 'Marc', 'Matthew', 'Michael', 'Nathan', 'Neil',
+ 'Nicholas', 'Parnell', 'Peter', 'Phil', 'Randi', 'Ravi', 'Ross', 'Ryan',
+ 'Scot', 'Sean', 'Sebastian', 'Shane', 'Stephen', 'Thanh', 'Tien', 'Timothy',
+ 'Wenwu', 'Will'
+ );
+
+ if ($sex eq 'both') { $name = list_random(@femlist, @malelist); }
+ elsif ($sex eq 'female') { $name = list_random(@femlist); }
+ elsif ($sex eq 'male') { $name = list_random(@malelist); }
+
+ $name;
+}
+
+###############################
+#
+# Name: RandomVariableName
+#
+# Input: None required
+#
+# Optional Input: 'type' => variable, constant, integer, or function
+#
+# Output: A variable name like x, y, t, c, etc. that is randomly chosen from the list maintained here.
+# If 'type' is specified, the name is from the list of that type.
+#
+# Sample use:
+################################
+sub RandomVariableName {
+ my %options = @_;
+
+ my ($type, $name, @varlist, @constlist, @intlist, @functionlist);
+
+ $type = $options{'type'} if defined($options{'type'});
+
+ $type = 'all' unless defined($type);
+
+ @varlist = (
+ 'x',
+ 'y',
+ # 'z',
+ 'r',
+ # 's',
+ 't',
+ );
+
+ @constlist = ('a', 'b', 'c', 'A', 'B', 'C',);
+
+ @intlist = ( #'i', potential for context confusion with complex
+ #'j', and vector
+ #'k',
+ 'm',
+ 'n',
+ 'p',
+ 'q',
+ );
+
+ @functionlist = (
+ 'f',
+ 'g',
+ 'h',
+ #'k',
+ 'F',
+ 'G',
+ 'H',
+ 'K',
+ );
+
+ if ($type eq 'all') { $name = list_random(@varlist, @constlist, @intlist); }
+ elsif ($type eq 'variable') { $name = list_random(@varlist); }
+ elsif ($type eq 'constant') { $name = list_random(@constlist); }
+ elsif ($type eq 'integer') { $name = list_random(@intlist); }
+ elsif ($type eq 'function') { $name = list_random(@functionlist); }
+
+ $name;
+}
+
+###############################
+#
+# Name: xPower
+#
+# This is just an auxiliary subroutine for the polynomial macros that follow
+#
+################################
+
+sub xPower {
+ my ($power, $maxpower, $order) = @_;
+ if ($order eq 'ascending') { return $power; }
+ else { return ($maxpower - $power); }
+}
+
+###############################
+#
+# Name: PolyString
+#
+# Input: an arrays
+#
+# PolyString(~~@poly1)
+#
+# Arrays elements should be numerical or Math Objects. The idea is that
+# these are coefficients of a polynomial, either starting from the
+# constant term or from the leading term.
+#
+# Optional Input: order=>ascending or descending, defaults to descending
+# order is ignored if output=>array
+# Optional Input: var=> some string, defaulting to "x"
+#
+# Output: an polynomial string using var and ready to be fed to Compute
+#
+# For example, given
+#
+# @poly1 = (1,2); # represents x+2
+# @poly2 = (3,-1,0,4);
+#
+# PolyString(~~@poly1);
+#
+# 'x^1+2x^0'
+#
+# PolyString(~~@poly2,order=>ascending,var=>'z');
+#
+# '3x^0+-1x^1+0x^2+4x^3'
+#
+# Note that instance of +-, x^0, x^1, 0x^n, may be present,
+# but Math Objectification will handle that.
+#
+# Note: If you intend to feed the output string to Compute() or Formula(),
+# you should set the context reductions appropriately and apply ->reduce
+# *twice* to remove excess parentheses from negative coefficients.
+#
+################################
+
+sub PolyString {
+
+ my ($xref, %options) = @_;
+ my @local_x = @{$xref};
+
+ my ($order, $var, $exponentVar, $string);
+
+ if (defined($options{'order'})) {
+ $order = $options{'order'};
+ } else {
+ $order = 'descending';
+ }
+
+ if (defined($options{'var'})) {
+ $var = $options{'var'};
+ } else {
+ $var = 'x';
+ }
+
+ # new, cmh 6/18/13
+ if (defined($options{'exponentVar'})) {
+ $exponentVar = $options{'exponentVar'};
+ } else {
+ $exponentVar = '';
+ }
+
+ # original 6/18/13
+ # $string = "$local_x[0]".$var.'^'.xPower(0,$#local_x,$order);
+ # for my $i (1..$#local_x) {
+ # $string = $string.'+'."$local_x[$i]".$var.'^'.xPower($i,$#local_x,$order);
+ # }
+
+ # modified, cmh 6/18/13
+ $string = "$local_x[0]" . $var . '^{' . xPower(0, $#local_x, $order) . $exponentVar . '}';
+ for my $i (1 .. $#local_x) {
+ $string = $string . '+' . "$local_x[$i]" . $var . '^{' . xPower($i, $#local_x, $order) . $exponentVar . '}';
+ }
+ return $string;
+}
+
+###############################
+#
+# Name: PolyMult
+#
+# Input: two arrays, for example
+#
+# PolyMult(~~@poly1, ~~@poly2)
+#
+# Arrays elements should be numerical or Math Objects
+# where multiplication and addition are allowed. The idea is that
+# these are coefficients of a polynomial, either starting from the
+# constant term or from the leading term.
+#
+# Optional Input: order=>ascending or descending, defaults to descending
+# order is ignored if output=>array
+# Optional Input: var=> some string, defaulting to "x"
+# Optional Input: output=>array, simplified, unsimplified
+# which is either an array of coefficients, an expanded and simplified
+# polynomial string using var and ready to be fed to Compute, or the same
+# but unsimplified. Default is array.
+# cmh, 6/18/13
+# Optional Input: exponentVar=> some string, defaulting to ''
+# to be used if the polynomial looks like, for example
+# x^{3n}+x^{2n}+x^{n}
+#
+# Output: described in Optional Input
+#
+# For example, given
+#
+# @poly1 = (1,2); # represents x+2
+# @poly2 = (3,-1,4); # represents 3x^2-x+4
+#
+# PolyMult(~~@poly1, ~~@poly2,
+# order=>ascending, var=>'z', output=>unsimplified)
+#
+# '3z^3+-1z^2+4z+6z^2+-2z^1+8z^0'
+#
+# Note that instance of +- may be present, but Math Objectification
+# will handle that.
+#
+#
+# Given
+#
+# @poly1 = (Fraction(1,3),2); # represents 1/3x+2
+# @poly2 = (Fraction(1,2),Fraction(-1,3)); # represents 1/2x-1/3
+#
+# PolyMult(~~@poly1, ~~@poly2)
+#
+# (Frac(1,6),Frac(8,9),Frac(-1,9))
+#
+#
+# Note: If you intend to feed the output string to Compute() or Formula(),
+# you should set the context reductions appropriately and apply ->reduce
+# *twice* to remove excess parentheses from negative coefficients.
+#
+################################
+
+sub PolyMult {
+ my ($xref, $yref, %options) = @_;
+ my @local_x = @{$xref};
+ my @local_y = @{$yref};
+
+ my ($order, $var, $output, @productArray, $productString);
+
+ $order = $options{'order'} if defined($options{'order'});
+ $order = 'descending' unless defined($options{'order'});
+
+ $var = $options{'var'} if defined($options{'var'});
+ $var = 'x' unless defined($options{'var'});
+
+ $output = $options{'output'} if defined($options{'output'});
+ $output = 'array' unless defined($options{'output'});
+
+ # cmh, 6/18/13
+ $exponentVar = $options{'exponentVar'} if defined($options{'exponentVar'});
+ $exponentVar = '' unless defined($options{'exponentVar'});
+
+ if ($output eq 'array' or $output eq 'simplified') {
+ for my $i (0 .. ($#local_x + $#local_y)) {
+ $productArray[$i] = 0;
+ foreach my $j (0 .. $i) {
+ if ($j <= $#local_x and $i - $j <= $#local_y) {
+ $productArray[$i] = $productArray[$i] + $local_x[$j] * $local_y[ $i - $j ];
+ }
+ }
+ }
+
+ if ($output eq 'array') { return @productArray; }
+
+ if ($output eq 'simplified') {
+ return PolyString(\@productArray, order => $order, var => $var, exponentVar => $exponentVar); #cmh, 6/18/13
+ }
+ }
+
+ if ($output eq 'unsimplified') {
+ $productString = '';
+ for my $i (0 .. $#local_x) {
+ for my $j (0 .. $#local_y) {
+ # $productString = $productString.'+'.$local_x[$i]*$local_y[$j].$var.'^'.xPower($i+$j,$#local_x+$#local_y,$order);
+ # cmh, 6/18/13
+ $productString =
+ $productString . '+'
+ . $local_x[$i] * $local_y[$j]
+ . $var . '^{'
+ . xPower($i + $j, $#local_x + $#local_y, $order)
+ . $exponentVar . '}';
+ }
+ }
+ return $productString;
+ }
+}
+
+#
+# Accepts an array of the form that PolyTerms outputs
+# Inserts '&' between array entries for use in array environments
+# Converts Math Object entries to their TeX form
+# Inserts a spacing command after nonempty entries - the command
+# \setlength\arraycolsep{0em} should precede the \begin{array}
+# $Spacing should be something like "\hspace{0.4em}"
+# Also creates an alignment string for the \begin{array} command
+# $align should be "r", "c", or "l"
+# Not part of PGpolynomialMacros.pl
+#
+
+sub PolyTermsTeXPrep {
+ my ($temp, $spacing, $align) = @_;
+ my @terms = @{$temp};
+ my @void = ();
+ $alignment = "$align";
+ foreach my $i (0 .. $#terms - 1) {
+ @void = splice(@terms, 2 * $i + 1, 0, ('&'));
+ if ($terms[ 2 * $i ] ne '') {
+ if (($terms[ 2 * $i ] ne '-') && ($terms[ 2 * $i ] ne '+')) {
+ $terms[ 2 * $i ] = Compute($terms[ 2 * $i ])->TeX;
+ } else {
+ $terms[ 2 * $i ] = '{}' . $terms[ 2 * $i ] . '{}';
+ }
+ $terms[ 2 * $i ] = $terms[ 2 * $i ] . $spacing;
+ }
+ $alignment = $alignment . "$align";
+ }
+ $terms[$#terms] = Compute($terms[$#terms])->TeX;
+ $terms[$#terms] = $terms[$#terms] . $spacing;
+ return (@terms, $alignment);
+
+}
+
+# PolyTerms(~~@coefficientArray,x,order)
+
+#
+# Accepts an array containing the coefficients of a polynomial
+# in descending order
+# Assumes coefficients have numerical values, but may be Math Objects
+# Returns an array of size 2n-1 of the form
+# (a_nx^n, +/-, |a_{n-1}| x^{n-1}, +/-, ...)
+# where the variable is x is the second argument, the terms are Math Objects
+# Formulas, and the +/- are Perl strings.
+# The third argument can be "ascending" to reverse the order
+# If a_j is 0, then the corresponding term and preceding sign are empty
+# strings.
+# Trims beginning and ending, so that first and last terms are nonzero
+# Not part of PGpolynomialMacros.pl
+#
+
+#=cut
+
+sub PolyTerms {
+ my ($temp, $v, $order) = @_;
+ my @poly = @{$temp};
+ while (($poly[0] == 0) && ($#poly != 0)) { shift(@poly); }
+ my $degree = $#poly;
+
+ while (($poly[$#poly] == 0) && ($#poly != 0)) { pop(@poly); }
+ my $lowestdegree = $degree - $#poly;
+
+ if ($order eq "ascending") { @poly = reverse(@poly); }
+
+ my @terms = ();
+ my @abspoly = ();
+ foreach my $i (0 .. $#poly) {
+ $abspoly[$i] = abs($poly[$i]);
+ my $j = $#poly - $i + $lowestdegree;
+ if ($order eq "ascending") { $j = $i + $lowestdegree; }
+ if ($i == 0) {
+ if ($abspoly[$i] != 1) {
+ if ($j == 0) { $terms[ 2 * $i ] = Compute("$poly[$i]")->reduce; }
+ elsif ($j == 1) { $terms[ 2 * $i ] = Compute("$poly[$i] $v")->reduce; }
+ else { $terms[ 2 * $i ] = Compute("$poly[$i] $v^{$j}")->reduce; }
+ } elsif ($poly[$i] == 1) {
+ if ($j == 0) { $terms[ 2 * $i ] = Compute("1")->reduce; }
+ elsif ($j == 1) { $terms[ 2 * $i ] = Compute("$v")->reduce; }
+ else { $terms[ 2 * $i ] = Compute("$v^{$j}")->reduce; }
+ } else {
+ if ($j == 0) { $terms[ 2 * $i ] = Compute("-1")->reduce; }
+ elsif ($j == 1) { $terms[ 2 * $i ] = Compute("-$v")->reduce; }
+ else { $terms[ 2 * $i ] = Compute("-$v^{$j}")->reduce; }
+ }
+
+ } elsif ($j > 1) {
+ if ($poly[$i] > 0) {
+ $terms[ 2 * $i - 1 ] = '+';
+ if ($poly[$i] != 1) {
+ $terms[ 2 * $i ] = Compute("$poly[$i] $v^{$j}");
+ } else {
+ $terms[ 2 * $i ] = Compute("$v^{$j}");
+ }
+ } elsif ($poly[$i] == 0) {
+ $terms[ 2 * $i - 1 ] = '';
+ $terms[ 2 * $i ] = '';
+ } elsif ($poly[$i] == -1) {
+ $terms[ 2 * $i - 1 ] = '-';
+ $terms[ 2 * $i ] = Compute("$v^{$j}");
+ } else {
+ $terms[ 2 * $i - 1 ] = '-';
+ $terms[ 2 * $i ] = Compute("$abspoly[$i] $v^{$j}");
+ }
+ } elsif ($j == 1) {
+ if ($poly[$i] > 0) {
+ $terms[ 2 * $i - 1 ] = '+';
+ if ($poly[$i] != 1) {
+ $terms[ 2 * $i ] = Compute("$poly[$i] $v");
+ } else {
+ $terms[ 2 * $i ] = Compute("$v");
+ }
+ } elsif ($poly[$i] == 0) {
+ $terms[ 2 * $i - 1 ] = '';
+ $terms[ 2 * $i ] = '';
+ } elsif ($poly[$i] == -1) {
+ $terms[ 2 * $i - 1 ] = '-';
+ $terms[ 2 * $i ] = Compute("$v");
+ } else {
+ $terms[ 2 * $i - 1 ] = '-';
+ $terms[ 2 * $i ] = Compute("$abspoly[$i] $v");
+ }
+ } else {
+ if ($poly[$i] > 0) {
+ $terms[ 2 * $i - 1 ] = '+';
+ $terms[ 2 * $i ] = Compute("$poly[$i]");
+ } elsif ($poly[$i] == 0) {
+ $terms[ 2 * $i - 1 ] = '';
+ $terms[ 2 * $i ] = '';
+ } else {
+ $terms[ 2 * $i - 1 ] = '-';
+ $terms[ 2 * $i ] = Compute("$abspoly[$i]");
+ }
+ }
+ }
+
+ return @terms;
+}
+
+###############################
+# Name: PolySub
+sub PolySub {
+ my ($xref, $yref, %options) = @_;
+ my @local_x = @{$xref};
+ my @local_y = @{$yref};
+ foreach my $y (@local_y) { $y = $y * -1; }
+ return PolyAdd(\@local_x, \@local_y, %options);
+}
+
+###############################
+# Name: PolyAdd
+#
+# Input: two arrays, for example
+#
+# PolyAdd(~~@poly1, ~~@poly2)
+#
+# Arrays elements should be numerical or Math Objects
+# where addition are allowed. The idea is that
+# these are coefficients of a polynomial, either starting from the
+# constant term or from the leading term.
+#
+# Optional Input: order=>ascending or descending, defaults to descending
+# order is ignored if output=>array
+# Optional Input: var=> some string, defaulting to "x"
+# Optional Input: subtract=> 1 will subtract; default 0
+# Optional Input: output=>array, simplified, unsimplified
+# which is either an array of coefficients, a simplified
+# polynomial string using var and ready to be fed to Compute, or the same
+# but unsimplified with like terms near each other. Default is array.
+#
+# Output: described in Optional Input
+#
+# For example, given
+#
+# @poly1 = (1,2); # represents x+2 (assuming descending)
+# @poly2 = (3,-1,4); # represents 3x^2-x+4
+#
+# PolyAdd(~~@poly1, ~~@poly2,var=>'z', output=>unsimplified)
+#
+# '3z^2+1z+-1z+2+4'
+#
+# Note that instance of +- may be present, but Math Objectification
+# will handle that.
+#
+#
+# Given
+#
+# @poly1 = (Fraction(1,3),2); # represents 1/3+2x (assuming ascending)
+# @poly2 = (Fraction(1,2),0,Fraction(-1,3));
+#
+# PolyAdd(~~@poly1, ~~@poly2,order=>ascending)
+#
+# (Frac(5,6),2,Frac(-1,3))
+#
+#
+# Note: If you intend to feed the output string to Compute() or Formula(),
+# you should set the context reductions appropriately and apply ->reduce
+# *twice* to remove excess parentheses from negative coefficients.
+#
+################################
+
+sub PolyAdd {
+ my ($xref, $yref, %options) = @_;
+ my @local_x = @{$xref};
+ my @local_y = @{$yref};
+
+ my ($order, $var, $output, @sumArray, $sumString, $subtract, $plusMinus);
+
+ $order = $options{'order'} if defined($options{'order'});
+ $order = 'descending' unless defined($options{'order'});
+
+ $var = $options{'var'} if defined($options{'var'});
+ $var = 'x' unless defined($options{'var'});
+
+ $subtract = $options{'subtract'} if defined($options{'subtract'});
+ $subtract = 0 unless defined($options{'subtract'});
+
+ $output = $options{'output'} if defined($options{'output'});
+ $output = 'array' unless defined($options{'output'});
+
+ my $Nx = max($#local_x, $#local_y) - ($#local_x);
+ my $Ny = max($#local_x, $#local_y) - ($#local_y);
+
+ if ($order eq 'ascending') {
+ for my $i (1 .. $Nx) { push(@local_x, 0); }
+ for my $i (1 .. $Ny) { push(@local_y, 0); }
+ } else {
+ for my $i (1 .. $Nx) { unshift(@local_x, 0); }
+ for my $i (1 .. $Ny) { unshift(@local_y, 0); }
+ }
+
+ if ($output eq 'array' or $output eq 'simplified') {
+ for my $i (0 .. $#local_x) {
+ $sumArray[$i] = $local_x[$i] + (-1)**($subtract) * $local_y[$i];
+ }
+
+ if ($output eq 'array') { return @sumArray; }
+ if ($output eq 'simplified') { return PolyString(\@sumArray, order => $order, var => $var); }
+ }
+
+ if ($output eq 'unsimplified') {
+ if ($subtract == 1) { $plusMinus = '-' }
+ else { $plusMinus = '+' }
+ $sumString = '';
+ for my $i (0 .. $#local_x) {
+ $sumString =
+ $sumString . '+'
+ . $local_x[$i]
+ . $var . '^'
+ . xPower($i, $#local_x, $order)
+ . $plusMinus
+ . $local_y[$i]
+ . $var . '^'
+ . xPower($i, $#local_x, $order);
+ }
+ return $sumString;
+ }
+
+}
+
+###############################
+# Name: numberWord
+#
+# Input: either a whole number <100 or a fraction with numerator and denominator less than 100. If fraction, set denominator parameter.
+# Optional Input: capital => 1 (default is 0)
+# Optional Input: denominator=> 4 (default is 1)
+# numberWord($n)
+#
+# Output: a string spelling that number
+#
+################################
+
+sub numberWord {
+ my ($n, %options, $return, $capital, $denominator, $numerator) = @_;
+
+ $capital = $options{'capital'} if defined($options{'capital'});
+ $denominator = $options{'denominator'} if defined($options{'denominator'});
+
+ $capital = 0 unless defined($capital);
+ $denominator = 1 unless defined($denominator);
+
+ return $n if (abs($n * $denominator) > 99);
+
+ my %wordNumber = (
+ 0 => 'zero',
+ 1 => 'one',
+ 2 => 'two',
+ 3 => 'three',
+ 4 => 'four',
+ 5 => 'five',
+ 6 => 'six',
+ 7 => 'seven',
+ 8 => 'eight',
+ 9 => 'nine',
+ 10 => 'ten',
+ 11 => 'eleven',
+ 12 => 'twelve',
+ 13 => 'thirteen',
+ 14 => 'fourteen',
+ 15 => 'fifteen',
+ 16 => 'sixteen',
+ 17 => 'seventeen',
+ 18 => 'eighteen',
+ 19 => 'nineteen',
+ 20 => 'twenty',
+ 30 => 'thirty',
+ 40 => 'forty',
+ 50 => 'fifty',
+ 60 => 'sixty',
+ 70 => 'seventy',
+ 80 => 'eighty',
+ 90 => 'ninety'
+ );
+
+ my %wordFraction = (
+ 1 => 'first',
+ 2 => 'second',
+ 3 => 'third',
+ 4 => 'fourth',
+ 5 => 'fifth',
+ 6 => 'sixth',
+ 7 => 'seventh',
+ 8 => 'eighth',
+ 9 => 'ninth',
+ 12 => 'twelfth',
+ 20 => 'twentieth',
+ 30 => 'thirtieth',
+ 40 => 'fortieth',
+ 50 => 'fiftieth',
+ 60 => 'sixtieth',
+ 70 => 'seventieth',
+ 80 => 'eightieth',
+ 90 => 'ninetieth'
+ );
+
+ $return = '';
+ if ($n < 0) { $return = 'negative '; }
+
+ $n = abs($n);
+
+ if ($denominator == 1) {
+ if (($n <= 20) or ($n % 10 == 0)) { $return = $return . $wordNumber{$n} }
+ else { $return = $return . numberWord($n - ($n % 10)) . '-' . numberWord($n % 10) }
+
+ } else {
+ $numerator = round($n * $denominator);
+ $return = $return . numberWord($numerator);
+ if (($denominator == 2) and ($numerator != 1)) { $return = $return . ' halves'; }
+ elsif (($denominator == 2) and ($numerator == 1)) { $return = $return . ' half' }
+ elsif (defined($wordFraction{$denominator})) {
+ $return = $return . ' ' . $wordFraction{$denominator};
+ $return = $return . 's' if ($numerator != 1);
+ } elsif (defined($wordNumber{$denominator})) {
+ $return = $return . ' ' . $wordNumber{$denominator} . 'th';
+ $return = $return . 's' if ($numerator != 1);
+ } else {
+ $return =
+ $return . ' ' . numberWord($denominator - $denominator % 10) . '-' . $wordFraction{ $denominator % 10 };
+ $return = $return . 's' if ($numerator != 1);
+ }
+ }
+
+ $return = ucfirst($return) if ($capital == 1);
+ return $return;
+
+}
+
+# radicalListCheck
+#
+# Used when multiple answers are needed (e.g for quadratic) equations
+# that may or may *not* contain radicals.
+#
+# Sample use:
+#
+# ANS($ans->cmp(limits => [1,2],list_checker => ~~&radicalListCheck));
+#
+#
+sub radicalListCheck {
+ my ($correct, $student, $ansHash, $value) = @_;
+ my $score = 0; # number of correct student answers
+ my @errors = (); # stores error messages
+ my ($i, $j, $k); # loop counters
+ return (0, @errors) if $ansHash->{isPreview};
+ my $fullStudent = $ansHash->{student_formula};
+#in line below, correct_ans seems the right thing to do. In some problems, this is blank, so I'm just going with correct_value
+# for those problems. But changing to correct_value broke other problems... so the conditional hack
+ my $fullCorrect = ($ansHash->{correct_ans}) ? Formula($ansHash->{correct_ans}) : Formula($ansHash->{correct_value});
+
+ my @fullStudentValue = $fullStudent->value;
+ my @fullCorrectValue = $fullCorrect->value;
+ my $n = scalar(@fullStudentValue); # number of student answers
+ my $m = scalar(@fullCorrectValue); # number of correct answers
+
+ #
+ # Loop though the student answers
+ ##
+ for ($i = 0; $i < $n; $i++) {
+ my $ith = Value::List->NameForNumber($i + 1);
+ my $p = $fullStudentValue[$i]; # i-th student answer
+
+ #
+ # Check that the student's answer is an assignment (or whatever the right type)
+ #
+ my $assingmentMessageGiven = 0;
+ my $nosolutionMessageGiven = 0;
+ if (defined($p)) {
+ if ($p eq "no real solutions") {
+ push(@errors, "This equation does have some solutions.");
+ $nosolutionMessageGiven = 1;
+ } elsif ($p->type ne "Assignment") {
+ push(@errors, "Your $ith entry should be written $var=_____");
+ $assingmentMessageGiven = 1;
+ }
+ }
+
+ #
+ # Check that the answer hasn't been given before
+ #
+ for ($j = 0, $used = 0; $j < $i; $j++) {
+ if ($p == $fullStudentValue[$j]) {
+ push(@errors, "Your $ith solution is the same as a previous one");
+ $used = 1;
+ last;
+ }
+ }
+
+ #
+ # If not already used, check that it is a correct and reduced answer
+ #
+ if (!$used) {
+ my ($numericallyCorrect, $reduced);
+ for ($k = 0, $numericallyCorrect = 0; ($k < $m); $k++) {
+ $q = $fullCorrectValue[$k];
+ if (Formula($q) == Formula($p)) {
+ $numericallyCorrect = 1;
+ my ($setSqrt, $setRoot) = (Context()->flag("setSqrt"), Context()->flag("setRoot"));
+ Context()->flags->set(
+ checkSqrt => $setSqrt,
+ checkRoot => $setRoot,
+ bizarroAdd => 1,
+ bizarroSub => 1,
+ bizarroMul => 1,
+ bizarroDiv => 1
+ );
+ delete $p->{test_values};
+ delete $q->{test_values};
+ if ($p == $q) { $reduced = 1 }
+ else { $reduced = 0 }
+ ; # check if form is correct
+
+ Context()->flags->set(
+ checkSqrt => 0,
+ checkRoot => 0,
+ bizarroAdd => 0,
+ bizarroSub => 0,
+ bizarroMul => 0,
+ bizarroDiv => 0
+ );
+ $score++ if ($numericallyCorrect and $reduced);
+ push(@errors, "Your $ith solution is not fully simplified")
+ if ($numericallyCorrect and !$reduced and ($n > 1));
+ push(@errors, "Your solution is not fully simplified")
+ if ($numericallyCorrect and !$reduced and ($n == 1));
+ last;
+ }
+ }
+ push(@errors, "Your $ith solution is not correct")
+ if (!$numericallyCorrect and ($n > 1) and !$assingmentMessageGiven);
+ push(@errors, "Your solution is not correct")
+ if (!$numericallyCorrect and ($n == 1) and !$assingmentMessageGiven and !$nosolutionMessageGiven);
+ }
+ }
+
+ #
+ # Check that there are the right number of answers
+ #
+ if (!$ansHash->{isPreview}) {
+ #push(@errors,"Do you have all the solutions?") if (($n < 2) and ($score < 2) and !$nosolutionMessageGiven );
+ #push(@errors,"Should a quadratic equation have more than two solutions?") if ($n > 2);
+ push(@errors, "Do you have all the solutions?") if (($n < $m) and ($score < $m) and !$nosolutionMessageGiven);
+ push(@errors, "Should this equation have more than $m solution?") if ($n > $m and $m == 1);
+ push(@errors, "Should this equation have more than $m solutions?") if ($n > $m and $m > 1);
+
+ }
+ return ($score, @errors);
+}
+
+# Keyboard instructions should only be displayed in HTML output
+sub KeyboardInstructions {
+ my $in = shift;
+ if ($displayMode =~ /HTML/) { return $in }
+}
+
+1;
diff --git a/macros/misc/PGunion.pl b/macros/misc/PGunion.pl
new file mode 100644
index 0000000000..fb101a5866
--- /dev/null
+++ b/macros/misc/PGunion.pl
@@ -0,0 +1,10 @@
+#
+# Load most of the interesting code developed at Union.
+#
+
+loadMacros(
+ "unionMacros.pl", "unionUtils.pl", "unionProblem.pl", "unionImage.pl",
+ "unionLists.pl", "unionTables.pl", "unionMessages.pl",
+);
+
+1;
diff --git a/macros/misc/unionInclude.pl b/macros/misc/unionInclude.pl
new file mode 100644
index 0000000000..27ef97cb31
--- /dev/null
+++ b/macros/misc/unionInclude.pl
@@ -0,0 +1,95 @@
+######################################################################
+#
+# Routines to make it easier to include additional PG files within
+# a given one. These files don't have to be in the courseScripts
+# directory; rather, they are assumed to be relative to the directory
+# containing the calling PG file.
+#
+
+sub _unionInclude_init { }; # don't reload this file
+
+######################################################################
+#
+# Usage: includePGfile(name)
+#
+# where name is the name of a PG file (relative to the directory
+# of the file containing this call).
+#
+sub includePGfile {
+ my $name = shift;
+ my $PGfile = $main::envir{'fileName'};
+ $PGfile =~ s![^/]+$!!;
+ $PGfile .= $name;
+ while ($PGfile =~ s![^/]*/../!!) { }
+ $PGfile =~ s!^tmpEdit/!!;
+ # warn("file is $PGfile, directory is $main::templateDirectory");
+ my $problem = read_whole_problem_file($main::templateDirectory . $PGfile);
+
+ my ($oldpname, $oldname) =
+ ($main::envir{'probFileName'}, $main::envir{'fileName'});
+ $main::envir{'probFileName'} = $PGfile;
+ $main::envir{'fileName'} = $PGfile;
+ includePGtext($problem, %main::envir);
+ ($main::envir{'probFileName'}, $main::envir{'fileName'}) =
+ ($oldpname, $oldname);
+}
+
+######################################################################
+#
+#
+# Usage: includeRandomProblem(file1,file2,...,fileN);
+#
+# where the fileNs are the names of the files from which
+# to choose (relative to the directory of the file containing
+# this call).
+#
+# To use this, make one PG file that include the call to this
+# random routine, and then include it the set definition file
+# as many times as you want (up to N times). A different problem
+# will be included for each instance in the set definition file.
+#
+sub includeRandomProblem {
+ my @flist = @_;
+ my @shuffle = _NchooseK(scalar(@flist), scalar(@flist));
+ my $start = $initialProblemNumber;
+ $start = 1 unless defined $start;
+ WARN_MESSAGE(
+ "There is an error in initializing this random problem. initialProblemNumber $start is greater than the current problem number $probNum"
+ ) if $probNum - $start < 0;
+ my $n = (@shuffle)[ $probNum - $start ];
+ includePGfile($flist[$n]);
+ #$main::problemPostamble->{HTML} = ""; # Hack to prevent ENDDOCUMENT from adding it again
+ # commenting this out is another hack which prevents nesting on quizzes -- go figure
+}
+
+#
+# Legacy code no longer needed. The included file can contain
+# BEGIN_INCLUSION(); and END_INCLUSION(); in place of DOCUMENT()
+# and ENDDOCUMENT(); calls.
+#
+sub BEGIN_INCLUSION { }
+sub END_INCLUSION { }
+
+######################################################################
+#
+# This is a service routine for includeRandomProblem() above.
+# It an array of k numbers chosen from 0 to n-1, but preserves the
+# random seed so that the included problem won't be affected by
+# this function, and replaces it by the psvn, so that the list
+# produced will be the same each time it is called.
+#
+sub _NchooseK {
+ my ($n, $k) = @_;
+ my @array = 0 .. ($n - 1);
+ my @out = ();
+ my $seed = ($main::psvn || 23) * 101 + ($initialProblemNumber || 1);
+ my $oldseed = $main::PG_random_generator->{seed};
+ $main::PG_random_generator->srand($seed);
+ while (@out < $k) {
+ push(@out, splice(@array, $main::PG_random_generator->random(0, $#array, 1), 1));
+ }
+ $main::PG_random_generator->srand($oldseed);
+ return @out;
+}
+
+1;
diff --git a/macros/misc/unionMacros.pl b/macros/misc/unionMacros.pl
new file mode 100644
index 0000000000..8c83bf3b8f
--- /dev/null
+++ b/macros/misc/unionMacros.pl
@@ -0,0 +1,162 @@
+######################################################################
+#
+# Some macros that add to the ones like $PAR, $BR, etc.
+#
+
+sub _unionMacros_init { }; # don't reload this file
+
+#
+# Shorthand for WeBWorK
+#
+$WW = "WeBWorK";
+
+#
+# Shorthands for entering and leaving rawhtml mode in
+# LaTeX2HTML (since they are so commonly used).
+#
+$bHTML = '\begin{rawhtml}';
+$eHTML = '\end{rawhtml}';
+
+#
+# HTML(htmlcode)
+# HTML(htmlcode,texcode)
+#
+# Insert $html in HTML mode or \begin{rawhtml}$html\end{rawhtml} in
+# Latex2HTML mode. In TeX mode, insert nothing for the first form, and
+# $tex for the second form.
+#
+sub HTML {
+ my ($html, $tex) = @_;
+ return ('') unless (defined($html) && $html ne '');
+ $tex = '' unless (defined($tex));
+ MODES(TeX => $tex, Latex2HTML => $bHTML . $html . $eHTML, HTML => $html);
+}
+
+#
+# Begin and end indented text
+#
+
+$BBLOCKQUOTE = HTML('', '\par\bgroup\advance\leftskip by 2em ');
+$EBLOCKQUOTE = HTML(' ', '\par\egroup ');
+
+#
+# Start and stop centering
+#
+$BCENTER = HTML('', '\begin{center}');
+$ECENTER = HTML(' ', '\end{center}');
+
+#
+# Begin and end mode
+#
+$BTT = HTML('', '\texttt{');
+$ETT = HTML(' ', '}');
+
+#
+# Begin and end mode
+#
+$BSMALL = HTML('', '{\small ');
+$ESMALL = HTML(' ', '}');
+
+#
+# Remove extra space in bold in latex2html mode
+#
+$BBOLD = HTML('', '{\bf ');
+$EBOLD = HTML(' ', '}');
+
+#
+# tth doesn't seem to understand \colon
+#
+$COLON = MODES(TeX => '\colon ', HTML => ':', HTML_dpng => '\colon ');
+
+#
+# Alternatives to the standard WW versions of these
+#
+$LT = $LTS;
+$GT = $GTS;
+
+$LE = $LTE;
+$GE = $GTE;
+
+#
+# Common math sets
+#
+$R = MODES(TeX => '{\bf R}', HTML_tth => '{\bf R}', HTML => 'R ');
+$Z = MODES(TeX => '{\bf Z}', HTML_tth => '{\bf Z}', HTML => 'Z ');
+$N = MODES(TeX => '{\bf N}', HTML_tth => '{\bf N}', HTML => 'N ');
+$Q = MODES(TeX => '{\bf Q}', HTML_tth => '{\bf Q}', HTML => 'Q ');
+$C = MODES(TeX => '{\bf C}', HTML_tth => '{\bf C}', HTML => 'C ');
+
+#
+# Superscripts and subscript (mostly for if you want answer
+# rules in these positions).
+#
+$BSUP = HTML('', '$^{');
+$ESUP = HTML(' ', '}$');
+
+$BSUB = HTML('', '$_{');
+$ESUB = HTML(' ', '}$');
+
+#
+# Browser-only BR
+#
+$BBR = HTML('' . $title . ' ' . $title . '
+ This problem requires that JavaScript be enabled!
+ \n
\n";
+ foreach $quest (@questions) {
+ $out .=
+ ''
+ . ans_rule($length)
+ . " "
+ . $i++
+ . ". $quest
\n";
+ } elsif ($main::displayMode eq 'Latex2HTML') {
+ $out = "\\par\n\\begin{rawhtml}" . "\\end{rawhtml}\n";
+ foreach $quest (@questions) {
+ $out .=
+ '\begin{rawhtml}'
+ . '\end{rawhtml}'
+ . ans_rule($length)
+ . '\begin{rawhtml} '
+ . ''
+ . $i++
+ . '. \\end{rawhtml} '
+ . $quest
+ . '\begin{rawhtml} \\end{rawhtml}' . "\n";
+ }
+ $out .= "\\begin{rawhtml}
\n\\end{rawhtml}";
+ } elsif ($main::displayMode eq 'TeX') {
+ $out = "\n\\par\\begin{enumerate}\n\\advance\\leftskip by 2em";
+ foreach $quest (@questions) { $out .= "\\item[" . ans_rule($length) . ' ' . $i++ . ".] $quest\n" }
+ $out .= "\\end{enumerate}\n";
+ } else {
+ $out = "Error: alt_print_q: Unknown displayMode: $main::displayMode.";
+ }
+ $out;
+}
+
+sub alt_print_a {
+ my $self = shift;
+ my (@array) = @_;
+ my $sep = $self->{separation} || 0;
+ my $valign = $self->{valign} || "TOP";
+ my $i = 0;
+
+ my $out = MODES(
+ TeX => "\\begin{enumerate}\n",
+ Latex2HTML => qq{\\begin{rawhtml}\\end{rawhtml}\n},
+ HTML => qq{},
+ );
+ my $elem;
+ foreach $elem (@array) {
+ my $c = $main::ALPHABET[$i];
+ $out .= MODES(
+ TeX => "\\item[$c.] $elem\n",
+ Latex2HTML => qq{\\begin{rawhtml}$c. \\end{rawhtml}$elem\\begin{rawhtml} $c. $elem
\\end{rawhtml}\n",
+ HTML => "
\n",
+ );
+ $out;
+}
+
+1;
diff --git a/macros/niceTables.pl b/macros/ui/niceTables.pl
similarity index 99%
rename from macros/niceTables.pl
rename to macros/ui/niceTables.pl
index d0da8edbcb..33380b03bb 100644
--- a/macros/niceTables.pl
+++ b/macros/ui/niceTables.pl
@@ -532,7 +532,7 @@ sub DataTable {
${ $dataref->[$i][$j] }{cellcss} =
"border-left:solid 1px; " . ${ $dataref->[$i][$j] }{cellcss};
}
- if (defined $alignmentcolumns[$m] && $alignmentcolumns[$m] != 0) {
+ if ($alignmentcolumns[$m] != 0) {
${ $dataref->[$i][$j] }{cellcss} =
"border-right:solid 1px; " . ${ $dataref->[$i][$j] }{cellcss};
}
diff --git a/macros/ui/pccTables.pl b/macros/ui/pccTables.pl
new file mode 100644
index 0000000000..20952b7f13
--- /dev/null
+++ b/macros/ui/pccTables.pl
@@ -0,0 +1,5 @@
+# This is just a redirect to niceTables.pl, which was originally called pccTables.pl
+
+loadMacros("niceTables.pl");
+
+1;
diff --git a/macros/problemPanic.pl b/macros/ui/problemPanic.pl
similarity index 100%
rename from macros/problemPanic.pl
rename to macros/ui/problemPanic.pl
diff --git a/macros/quickMatrixEntry.pl b/macros/ui/quickMatrixEntry.pl
old mode 100755
new mode 100644
similarity index 100%
rename from macros/quickMatrixEntry.pl
rename to macros/ui/quickMatrixEntry.pl
diff --git a/macros/source.pl b/macros/ui/source.pl
similarity index 100%
rename from macros/source.pl
rename to macros/ui/source.pl
diff --git a/macros/text2PG.pl b/macros/ui/text2PG.pl
similarity index 100%
rename from macros/text2PG.pl
rename to macros/ui/text2PG.pl
diff --git a/macros/unionLists.pl b/macros/ui/unionLists.pl
similarity index 100%
rename from macros/unionLists.pl
rename to macros/ui/unionLists.pl
diff --git a/macros/unionTables.pl b/macros/ui/unionTables.pl
similarity index 100%
rename from macros/unionTables.pl
rename to macros/ui/unionTables.pl
diff --git a/t/macros/load_macros.t b/t/macros/load_macros.t
index 7ba810877b..c8ab7e6575 100644
--- a/t/macros/load_macros.t
+++ b/t/macros/load_macros.t
@@ -15,16 +15,39 @@ die "PG_ROOT not found in environment.\n" unless $ENV{PG_ROOT};
use lib "$ENV{PG_ROOT}/lib";
use Test2::V0;
+use File::Find;
use WeBWorK::PG;
-my %baseMacros = ('PG.pl' => 1, 'PGstandard.pl' => 1);
+my %baseMacros = (
+ 'PG.pl' => 1,
+ 'PGstandard.pl' => 1,
+ 'PGbasicmacros.pl' => 1,
+ 'PGanswermacros.pl' => 1,
+ 'PGauxiliaryFunctions.pl' => 1,
+ 'customizeLaTeX.pl' => 1,
+ 'PGnumericevaluators.pl' => 1,
+ 'PGfunctionevaluators.pl' => 1,
+ 'PGstringevaluators.pl' => 1,
+ 'PGmiscevaluators.pl' => 1,
+ 'PGcommonFunctions.pl' => 1
+);
my %brokenMacros = ('answerDiscussion.pl' => 1);
-opendir my $dir, "$ENV{PG_ROOT}/macros" or die "Unable to open pg macro directory: $!";
-my @macro_files = sort grep { !/^\./ && /\.pl$/ && !$baseMacros{$_} && !$brokenMacros{$_} } readdir $dir;
-closedir $dir;
+# Find all macro files inside the $ENV{PG_ROOT}/macros directory.
+my @macro_files;
+find(
+ sub {
+ # Must be a file that has the ".pl" suffix.
+ return unless -f && /\.pl$/;
+ return if $baseMacros{$_} || $brokenMacros{$_};
+ push @macro_files, $_;
+ },
+ "$ENV{PG_ROOT}/macros"
+);
+
+@macro_files = sort @macro_files;
for (@macro_files) {
subtest $_ => sub {