From 1875b73e2d07537f4e2073717c8cb71255028e50 Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Wed, 14 Sep 2022 16:49:48 -0400 Subject: [PATCH 1/9] WIP: initial move of macro files. WIP: continued moving of macros into PG/macros and subdirectories. WIP: move macros from OPL to PG --- conf/pg_config.dist.yml | 28 +- doc/MathObjects/macros/parserTables.pl | 90 - doc/MathObjects/macros/unionTables.pl | 276 -- macros/README.md | 213 ++ macros/answers/AnswerFormatHelp.pl | 868 +++++ macros/answers/ConditionalHint.pl | 170 + macros/answers/Generic.pl | 187 + macros/{ => answers}/PGfunctionevaluators.pl | 0 macros/{ => answers}/PGmiscevaluators.pl | 0 macros/{ => answers}/PGstringevaluators.pl | 0 macros/{ => answers}/PGtextevaluators.pl | 0 macros/{ => answers}/answerComposition.pl | 0 macros/{ => answers}/answerCustom.pl | 0 macros/{ => answers}/answerDiscussion.pl | 0 macros/{ => answers}/answerHints.pl | 0 macros/answers/answerUtils.pl | 105 + macros/{ => answers}/answerVariableList.pl | 0 macros/{ => answers}/extraAnswerEvaluators.pl | 0 .../{ => answers}/problemPreserveAnswers.pl | 0 macros/answers/unorderedAnswer.pl | 170 + macros/{ => capa}/PG_CAPAmacros.pl | 0 macros/{ => capa}/StdConst.pg | 0 macros/{ => capa}/StdUnits.pg | 0 macros/compoundProblem.pl | 678 ---- macros/contextAlternateIntervals.pl | 472 --- macros/{ => contexts}/contextABCD.pl | 0 .../{ => contexts}/contextAlternateDecimal.pl | 0 .../{ => contexts}/contextArbitraryString.pl | 0 macros/{ => contexts}/contextComplexExtras.pl | 0 macros/{ => contexts}/contextComplexJ.pl | 0 macros/{ => contexts}/contextCongruence.pl | 0 macros/{ => contexts}/contextCurrency.pl | 0 macros/contexts/contextFiniteSolutionSets.pl | 337 ++ macros/contexts/contextForm.pl | 150 + macros/{ => contexts}/contextFraction.pl | 0 macros/contexts/contextFunctionAssign.pl | 21 + macros/{ => contexts}/contextInequalities.pl | 0 .../contextInequalitiesAllowStrings.pl | 54 + .../contextInequalitySetBuilder.pl | 0 macros/{ => contexts}/contextInteger.pl | 0 .../{ => contexts}/contextIntegerFunctions.pl | 0 macros/{ => contexts}/contextLeadingZero.pl | 0 .../{ => contexts}/contextLimitedComplex.pl | 0 macros/{ => contexts}/contextLimitedFactor.pl | 0 .../{ => contexts}/contextLimitedNumeric.pl | 0 macros/{ => contexts}/contextLimitedPoint.pl | 0 .../contextLimitedPolynomial.pl | 0 macros/{ => contexts}/contextLimitedPowers.pl | 0 .../{ => contexts}/contextLimitedRadical.pl | 0 .../contexts/contextLimitedRadicalComplex.pl | 179 + macros/{ => contexts}/contextLimitedVector.pl | 0 macros/{ => contexts}/contextMatrixExtras.pl | 0 macros/{ => contexts}/contextOrdering.pl | 0 macros/{ => contexts}/contextPartition.pl | 0 macros/{ => contexts}/contextPercent.pl | 0 macros/{ => contexts}/contextPeriodic.pl | 0 macros/{ => contexts}/contextPermutation.pl | 0 .../{ => contexts}/contextPermutationUBC.pl | 0 .../contextPiecewiseFunction.pl | 0 .../contextPolynomialFactors.pl | 0 macros/contexts/contextRationalExponent.pl | 146 + .../{ => contexts}/contextRationalFunction.pl | 0 macros/{ => contexts}/contextReaction.pl | 0 macros/contexts/contextRestrictedDomains.pl | 223 ++ .../contextScientificNotation.pl | 0 macros/{ => contexts}/contextString.pl | 0 macros/{ => contexts}/contextTF.pl | 0 macros/{ => contexts}/contextTypeset.pl | 4 +- macros/{ => core}/MathObjects.pl | 0 macros/{ => core}/PGML.pl | 3 +- macros/{ => core}/PGanswermacros.pl | 0 macros/{ => core}/PGauxiliaryFunctions.pl | 0 macros/core/PGbasicmacros.pl | 3227 +++++++++++++++++ macros/{ => core}/PGcommonFunctions.pl | 24 +- macros/{ => core}/PGessaymacros.pl | 0 macros/{ => core}/PGgraders.pl | 0 macros/{ => core}/PGlateximage.pl | 0 macros/{ => core}/PGsequentialmacros.pl | 0 macros/{ => core}/PGstandard.pl | 0 macros/core/PeriodicRerandomization.pl | 176 + macros/{ => core}/RserveClient.pl | 0 macros/{ => core}/Value.pl | 0 macros/{ => core}/compoundProblem2.pl | 0 macros/{ => core}/compoundProblem5.pl | 0 macros/{ => core}/problemRandomize.pl | 7 +- macros/{ => core}/sage.pl | 6 +- macros/{ => core}/scaffold.pl | 0 macros/{ => core}/weightedGrader.pl | 0 macros/{ => graph}/AppletObjects.pl | 0 macros/{ => graph}/CanvasObject.pl | 0 macros/{ => graph}/LiveGraphics3D.pl | 92 +- macros/graph/LiveGraphicsCylindricalPlot3D.pl | 205 ++ macros/graph/LiveGraphicsParametricCurve3D.pl | 194 + .../graph/LiveGraphicsParametricSurface3D.pl | 257 ++ macros/graph/LiveGraphicsRectangularPlot3D.pl | 416 +++ macros/graph/LiveGraphicsVectorField2D.pl | 218 ++ macros/graph/LiveGraphicsVectorField3D.pl | 255 ++ macros/graph/PCCgraphMacros.pl | 128 + macros/{ => graph}/PGanalyzeGraph.pl | 0 macros/graph/PGgraphgrid.pl | 130 + macros/{ => graph}/PGgraphmacros.pl | 0 macros/graph/PGnauGraphics.pl | 328 ++ macros/{ => graph}/PGstatisticsGraphMacros.pl | 0 macros/{ => graph}/PGtikz.pl | 0 macros/graph/imageChoice.pl | 104 + macros/{ => math}/LinearProgramming.pl | 0 macros/{ => math}/MatrixCheckers.pl | 0 macros/{ => math}/MatrixReduce.pl | 0 macros/math/MatrixUnimodular.pl | 235 ++ macros/{ => math}/MatrixUnits.pl | 0 macros/math/PCCfactor.pl | 456 +++ macros/{ => math}/PGcomplexmacros.pl | 0 macros/{ => math}/PGcomplexmacros2.pl | 0 macros/{ => math}/PGdiffeqmacros.pl | 0 macros/{ => math}/PGmatrixmacros.pl | 0 macros/{ => math}/PGmorematrixmacros.pl | 8 +- macros/math/PGnauBinpacking.pl | 188 + macros/math/PGnauGraphCatalog.pl | 1256 +++++++ macros/math/PGnauGraphtheory.pl | 1719 +++++++++ macros/math/PGnauScheduling.pl | 1043 ++++++ macros/math/PGnauSet.pl | 346 ++ macros/math/PGnauStats.pl | 1160 ++++++ macros/{ => math}/PGnumericalmacros.pl | 0 macros/{ => math}/PGnumericevaluators.pl | 0 macros/{ => math}/PGpolynomialmacros.pl | 0 macros/{ => math}/PGstatisticsmacros.pl | 72 +- macros/math/SI_property_tables.pl | 460 +++ macros/math/SolveLinearEquationPCC.pl | 169 + .../SystemsOfLinearEquationsProblemPCC.pl | 841 +++++ macros/math/VectorListCheckers.pl | 280 ++ macros/math/algebraMacros.pl | 307 ++ macros/{ => math}/bizarroArithmetic.pl | 0 macros/{ => math}/customizeLaTeX.pl | 0 macros/{ => math}/draggableProof.pl | 0 macros/{ => math}/draggableSubsets.pl | 0 macros/math/fixedPrecision.pl | 58 + macros/math/interpMacros.pl | 33 + macros/math/regrfnsPG.pl | 109 + macros/{ => math}/tableau.pl | 0 macros/{ => math}/tableau_main_subroutines.pl | 2 - macros/niceTables.pl | 837 ----- macros/{ => parsers}/Parser.pl | 0 macros/{ => parsers}/parserAssignment.pl | 0 macros/{ => parsers}/parserAutoStrings.pl | 0 macros/{ => parsers}/parserCustomization.pl | 0 .../{ => parsers}/parserDifferenceQuotient.pl | 0 macros/{ => parsers}/parserFormulaAnyVar.pl | 0 .../parserFormulaUpToConstant.pl | 0 .../{ => parsers}/parserFormulaWithUnits.pl | 0 macros/{ => parsers}/parserFunction.pl | 0 macros/{ => parsers}/parserFunctionPrime.pl | 0 macros/{ => parsers}/parserGraphTool.pl | 0 .../{ => parsers}/parserImplicitEquation.pl | 0 macros/{ => parsers}/parserImplicitPlane.pl | 0 .../{ => parsers}/parserLinearInequality.pl | 0 macros/{ => parsers}/parserMultiAnswer.pl | 0 macros/{ => parsers}/parserMultiPart.pl | 0 macros/{ => parsers}/parserNumberWithUnits.pl | 0 macros/{ => parsers}/parserOneOf.pl | 0 macros/{ => parsers}/parserParametricLine.pl | 0 macros/{ => parsers}/parserParametricPlane.pl | 0 macros/{ => parsers}/parserPopUp.pl | 0 macros/{ => parsers}/parserPrime.pl | 0 macros/{ => parsers}/parserQuotedString.pl | 0 macros/{ => parsers}/parserRadioButtons.pl | 0 macros/{ => parsers}/parserRoot.pl | 0 macros/{ => parsers}/parserSolutionFor.pl | 0 .../macros => macros/parsers}/parserUtils.pl | 5 +- macros/{ => parsers}/parserVectorUtils.pl | 4 +- macros/{ => parsers}/parserWordCompletion.pl | 0 macros/{ => ui}/PGchoicemacros.pl | 0 macros/{ => ui}/PGinfo.pl | 0 macros/{ => ui}/alignedChoice.pl | 0 macros/ui/choiceUtils.pl | 90 + macros/ui/pccTables.pl | 5 + macros/{ => ui}/problemPanic.pl | 0 macros/{ => ui}/quickMatrixEntry.pl | 0 macros/{ => ui}/source.pl | 0 macros/{ => ui}/text2PG.pl | 3 +- macros/{ => ui}/unionLists.pl | 0 macros/{ => ui}/unionTables.pl | 0 macros/univ/Alfredmacros.pl | 376 ++ macros/univ/BrockPhysicsMacros.pl | 1 + macros/univ/CofIdaho_macros.pl | 723 ++++ macros/univ/Dartmouthmacros.pl | 304 ++ macros/univ/MUHelp.pl | 49 + macros/univ/PCCmacros.pl | 847 +++++ macros/{ => univ}/PGasu.pl | 0 macros/univ/PGunion.pl | 10 + macros/univ/freemanMacros.pl | 541 +++ macros/univ/hhAdditionalMacros.pl | 437 +++ macros/univ/littleneck.pl | 191 + .../macros => macros/univ}/unionImage.pl | 17 +- macros/univ/unionInclude.pl | 95 + macros/univ/unionMacros.pl | 162 + macros/univ/unionMessages.pl | 75 + macros/univ/unionProblem.pl | 15 + macros/univ/unionUtils.pl | 136 + 198 files changed, 21353 insertions(+), 2453 deletions(-) delete mode 100644 doc/MathObjects/macros/parserTables.pl delete mode 100644 doc/MathObjects/macros/unionTables.pl create mode 100644 macros/README.md create mode 100755 macros/answers/AnswerFormatHelp.pl create mode 100755 macros/answers/ConditionalHint.pl create mode 100755 macros/answers/Generic.pl rename macros/{ => answers}/PGfunctionevaluators.pl (100%) rename macros/{ => answers}/PGmiscevaluators.pl (100%) rename macros/{ => answers}/PGstringevaluators.pl (100%) rename macros/{ => answers}/PGtextevaluators.pl (100%) rename macros/{ => answers}/answerComposition.pl (100%) rename macros/{ => answers}/answerCustom.pl (100%) rename macros/{ => answers}/answerDiscussion.pl (100%) rename macros/{ => answers}/answerHints.pl (100%) create mode 100755 macros/answers/answerUtils.pl rename macros/{ => answers}/answerVariableList.pl (100%) rename macros/{ => answers}/extraAnswerEvaluators.pl (100%) rename macros/{ => answers}/problemPreserveAnswers.pl (100%) create mode 100755 macros/answers/unorderedAnswer.pl rename macros/{ => capa}/PG_CAPAmacros.pl (100%) rename macros/{ => capa}/StdConst.pg (100%) rename macros/{ => capa}/StdUnits.pg (100%) delete mode 100644 macros/compoundProblem.pl delete mode 100644 macros/contextAlternateIntervals.pl rename macros/{ => contexts}/contextABCD.pl (100%) rename macros/{ => contexts}/contextAlternateDecimal.pl (100%) rename macros/{ => contexts}/contextArbitraryString.pl (100%) rename macros/{ => contexts}/contextComplexExtras.pl (100%) rename macros/{ => contexts}/contextComplexJ.pl (100%) rename macros/{ => contexts}/contextCongruence.pl (100%) rename macros/{ => contexts}/contextCurrency.pl (100%) create mode 100644 macros/contexts/contextFiniteSolutionSets.pl create mode 100644 macros/contexts/contextForm.pl rename macros/{ => contexts}/contextFraction.pl (100%) create mode 100755 macros/contexts/contextFunctionAssign.pl rename macros/{ => contexts}/contextInequalities.pl (100%) create mode 100755 macros/contexts/contextInequalitiesAllowStrings.pl rename macros/{ => contexts}/contextInequalitySetBuilder.pl (100%) rename macros/{ => contexts}/contextInteger.pl (100%) rename macros/{ => contexts}/contextIntegerFunctions.pl (100%) rename macros/{ => contexts}/contextLeadingZero.pl (100%) rename macros/{ => contexts}/contextLimitedComplex.pl (100%) rename macros/{ => contexts}/contextLimitedFactor.pl (100%) rename macros/{ => contexts}/contextLimitedNumeric.pl (100%) rename macros/{ => contexts}/contextLimitedPoint.pl (100%) rename macros/{ => contexts}/contextLimitedPolynomial.pl (100%) rename macros/{ => contexts}/contextLimitedPowers.pl (100%) rename macros/{ => contexts}/contextLimitedRadical.pl (100%) create mode 100644 macros/contexts/contextLimitedRadicalComplex.pl rename macros/{ => contexts}/contextLimitedVector.pl (100%) rename macros/{ => contexts}/contextMatrixExtras.pl (100%) rename macros/{ => contexts}/contextOrdering.pl (100%) rename macros/{ => contexts}/contextPartition.pl (100%) rename macros/{ => contexts}/contextPercent.pl (100%) rename macros/{ => contexts}/contextPeriodic.pl (100%) rename macros/{ => contexts}/contextPermutation.pl (100%) rename macros/{ => contexts}/contextPermutationUBC.pl (100%) rename macros/{ => contexts}/contextPiecewiseFunction.pl (100%) rename macros/{ => contexts}/contextPolynomialFactors.pl (100%) create mode 100755 macros/contexts/contextRationalExponent.pl rename macros/{ => contexts}/contextRationalFunction.pl (100%) rename macros/{ => contexts}/contextReaction.pl (100%) create mode 100644 macros/contexts/contextRestrictedDomains.pl rename macros/{ => contexts}/contextScientificNotation.pl (100%) rename macros/{ => contexts}/contextString.pl (100%) rename macros/{ => contexts}/contextTF.pl (100%) rename macros/{ => contexts}/contextTypeset.pl (99%) rename macros/{ => core}/MathObjects.pl (100%) rename macros/{ => core}/PGML.pl (99%) rename macros/{ => core}/PGanswermacros.pl (100%) rename macros/{ => core}/PGauxiliaryFunctions.pl (100%) create mode 100644 macros/core/PGbasicmacros.pl rename macros/{ => core}/PGcommonFunctions.pl (87%) rename macros/{ => core}/PGessaymacros.pl (100%) rename macros/{ => core}/PGgraders.pl (100%) rename macros/{ => core}/PGlateximage.pl (100%) rename macros/{ => core}/PGsequentialmacros.pl (100%) rename macros/{ => core}/PGstandard.pl (100%) create mode 100755 macros/core/PeriodicRerandomization.pl rename macros/{ => core}/RserveClient.pl (100%) rename macros/{ => core}/Value.pl (100%) rename macros/{ => core}/compoundProblem2.pl (100%) rename macros/{ => core}/compoundProblem5.pl (100%) rename macros/{ => core}/problemRandomize.pl (98%) rename macros/{ => core}/sage.pl (98%) rename macros/{ => core}/scaffold.pl (100%) rename macros/{ => core}/weightedGrader.pl (100%) rename macros/{ => graph}/AppletObjects.pl (100%) rename macros/{ => graph}/CanvasObject.pl (100%) rename macros/{ => graph}/LiveGraphics3D.pl (62%) create mode 100755 macros/graph/LiveGraphicsCylindricalPlot3D.pl create mode 100755 macros/graph/LiveGraphicsParametricCurve3D.pl create mode 100755 macros/graph/LiveGraphicsParametricSurface3D.pl create mode 100755 macros/graph/LiveGraphicsRectangularPlot3D.pl create mode 100755 macros/graph/LiveGraphicsVectorField2D.pl create mode 100755 macros/graph/LiveGraphicsVectorField3D.pl create mode 100755 macros/graph/PCCgraphMacros.pl rename macros/{ => graph}/PGanalyzeGraph.pl (100%) create mode 100644 macros/graph/PGgraphgrid.pl rename macros/{ => graph}/PGgraphmacros.pl (100%) create mode 100755 macros/graph/PGnauGraphics.pl rename macros/{ => graph}/PGstatisticsGraphMacros.pl (100%) rename macros/{ => graph}/PGtikz.pl (100%) create mode 100755 macros/graph/imageChoice.pl rename macros/{ => math}/LinearProgramming.pl (100%) rename macros/{ => math}/MatrixCheckers.pl (100%) rename macros/{ => math}/MatrixReduce.pl (100%) create mode 100755 macros/math/MatrixUnimodular.pl rename macros/{ => math}/MatrixUnits.pl (100%) create mode 100644 macros/math/PCCfactor.pl rename macros/{ => math}/PGcomplexmacros.pl (100%) rename macros/{ => math}/PGcomplexmacros2.pl (100%) rename macros/{ => math}/PGdiffeqmacros.pl (100%) rename macros/{ => math}/PGmatrixmacros.pl (100%) rename macros/{ => math}/PGmorematrixmacros.pl (99%) create mode 100755 macros/math/PGnauBinpacking.pl create mode 100755 macros/math/PGnauGraphCatalog.pl create mode 100755 macros/math/PGnauGraphtheory.pl create mode 100755 macros/math/PGnauScheduling.pl create mode 100755 macros/math/PGnauSet.pl create mode 100755 macros/math/PGnauStats.pl rename macros/{ => math}/PGnumericalmacros.pl (100%) rename macros/{ => math}/PGnumericevaluators.pl (100%) rename macros/{ => math}/PGpolynomialmacros.pl (100%) rename macros/{ => math}/PGstatisticsmacros.pl (94%) create mode 100644 macros/math/SI_property_tables.pl create mode 100755 macros/math/SolveLinearEquationPCC.pl create mode 100755 macros/math/SystemsOfLinearEquationsProblemPCC.pl create mode 100644 macros/math/VectorListCheckers.pl create mode 100755 macros/math/algebraMacros.pl rename macros/{ => math}/bizarroArithmetic.pl (100%) rename macros/{ => math}/customizeLaTeX.pl (100%) rename macros/{ => math}/draggableProof.pl (100%) rename macros/{ => math}/draggableSubsets.pl (100%) create mode 100644 macros/math/fixedPrecision.pl create mode 100644 macros/math/interpMacros.pl create mode 100644 macros/math/regrfnsPG.pl rename macros/{ => math}/tableau.pl (100%) rename macros/{ => math}/tableau_main_subroutines.pl (99%) delete mode 100644 macros/niceTables.pl rename macros/{ => parsers}/Parser.pl (100%) rename macros/{ => parsers}/parserAssignment.pl (100%) rename macros/{ => parsers}/parserAutoStrings.pl (100%) rename macros/{ => parsers}/parserCustomization.pl (100%) rename macros/{ => parsers}/parserDifferenceQuotient.pl (100%) rename macros/{ => parsers}/parserFormulaAnyVar.pl (100%) rename macros/{ => parsers}/parserFormulaUpToConstant.pl (100%) rename macros/{ => parsers}/parserFormulaWithUnits.pl (100%) rename macros/{ => parsers}/parserFunction.pl (100%) rename macros/{ => parsers}/parserFunctionPrime.pl (100%) rename macros/{ => parsers}/parserGraphTool.pl (100%) rename macros/{ => parsers}/parserImplicitEquation.pl (100%) rename macros/{ => parsers}/parserImplicitPlane.pl (100%) rename macros/{ => parsers}/parserLinearInequality.pl (100%) rename macros/{ => parsers}/parserMultiAnswer.pl (100%) rename macros/{ => parsers}/parserMultiPart.pl (100%) rename macros/{ => parsers}/parserNumberWithUnits.pl (100%) rename macros/{ => parsers}/parserOneOf.pl (100%) rename macros/{ => parsers}/parserParametricLine.pl (100%) rename macros/{ => parsers}/parserParametricPlane.pl (100%) rename macros/{ => parsers}/parserPopUp.pl (100%) rename macros/{ => parsers}/parserPrime.pl (100%) rename macros/{ => parsers}/parserQuotedString.pl (100%) rename macros/{ => parsers}/parserRadioButtons.pl (100%) rename macros/{ => parsers}/parserRoot.pl (100%) rename macros/{ => parsers}/parserSolutionFor.pl (100%) rename {doc/MathObjects/macros => macros/parsers}/parserUtils.pl (92%) mode change 100644 => 100755 rename macros/{ => parsers}/parserVectorUtils.pl (97%) rename macros/{ => parsers}/parserWordCompletion.pl (100%) rename macros/{ => ui}/PGchoicemacros.pl (100%) rename macros/{ => ui}/PGinfo.pl (100%) rename macros/{ => ui}/alignedChoice.pl (100%) create mode 100755 macros/ui/choiceUtils.pl create mode 100755 macros/ui/pccTables.pl rename macros/{ => ui}/problemPanic.pl (100%) rename macros/{ => ui}/quickMatrixEntry.pl (100%) rename macros/{ => ui}/source.pl (100%) rename macros/{ => ui}/text2PG.pl (97%) rename macros/{ => ui}/unionLists.pl (100%) rename macros/{ => ui}/unionTables.pl (100%) create mode 100755 macros/univ/Alfredmacros.pl create mode 100644 macros/univ/BrockPhysicsMacros.pl create mode 100755 macros/univ/CofIdaho_macros.pl create mode 100755 macros/univ/Dartmouthmacros.pl create mode 100644 macros/univ/MUHelp.pl create mode 100755 macros/univ/PCCmacros.pl rename macros/{ => univ}/PGasu.pl (100%) create mode 100755 macros/univ/PGunion.pl create mode 100755 macros/univ/freemanMacros.pl create mode 100755 macros/univ/hhAdditionalMacros.pl create mode 100644 macros/univ/littleneck.pl rename {doc/MathObjects/macros => macros/univ}/unionImage.pl (82%) mode change 100644 => 100755 create mode 100755 macros/univ/unionInclude.pl create mode 100755 macros/univ/unionMacros.pl create mode 100755 macros/univ/unionMessages.pl create mode 100755 macros/univ/unionProblem.pl create mode 100755 macros/univ/unionUtils.pl diff --git a/conf/pg_config.dist.yml b/conf/pg_config.dist.yml index f8d4735028..4a5a96434c 100644 --- a/conf/pg_config.dist.yml +++ b/conf/pg_config.dist.yml @@ -41,26 +41,14 @@ 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 + - $pg_root/macros/answers + - $pg_root/macros/contexts + - $pg_root/macros/core + - $pg_root/macros/graph + - $pg_root/macros/math + - $pg_root/macros/parsers + - $pg_root/macros/ui + - $pg_root/macros/univ - $Contrib_dir/CAPA/macros/CAPA_Tools - $Contrib_dir/CAPA/macros/CAPA_MCTools 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 . '' . $eHTML, - HTML => '' -); - -$LT = MODES(TeX => "<", Latex2HTML => "<", HTML => '<'); -$GT = MODES(TeX => ">", Latex2HTML => ">", HTML => '>'); - -$TEX = MODES(TeX => '{\TeX}', HTML => 'TeX', HTML_dpng => '\(\bf\TeX\)'); - -@rowOptions = ( - indent => 0, - separation => 0, - align => 'LEFT" NOWRAP="1', # alignment hack to get NOWRAP -); - -sub ParserRow { - my $f = shift; - my $t = ''; - Context()->clearError; - my ($s, $err) = PG_restricted_eval($f); - if (defined $s) { - my $ss = $s; - if (ref($s) && \&{ $s->string }) { - $t = '\(' . $s->TeX . '\)'; - $s = $s->string; - } elsif ($s !~ m/^[a-z]+$/i) { - $t = '\(' . Formula($s)->TeX . '\)'; - $s = Formula($s)->string; - } - $s =~ s//$GT/g; - if (ref($ss) && \&{ $ss->class }) { - if ($ss->class eq 'Formula') { - $s .= ' ' . $BC . '(Formula returning ' . $ss->showType . ')' . $EC; - } else { - $s .= ' ' . $BC . '(' . $ss->class . ' object)' . $EC; - } - } - } else { - $s = $BC . (Context()->{error}{message} || $err) . $EC; - $t = ''; - } - $f =~ s//$GT/g; - if ($displayMode eq 'TeX') { - $f =~ s/\^/\\char`\\^/g; - $s =~ s/\^/\\char`\\^/g; - $f =~ s/#/\\#/g; - $s =~ s/#/\\#/g; - } - my $row = Row([ $BTT . $f . $ETT, $BTT . $s . $ETT, $t ], @rowOptions); - $row =~ s/\$/\${DOLLAR}/g; - return $row; -} - -sub ParserTable { - my $table = BeginTable(border => 1, padding => 20) - . Row([ $BBOLD . "Perl Code" . $EBOLD, $BBOLD . "Result" . $EBOLD, $BBOLD . $TEX . ' version' . $EBOLD ], - @rowOptions); - foreach my $f (@_) { $table .= ParserRow($f) } - $table .= EndTable(); - return $table; -} - -sub Title { - my $title = shift; - - MODES( - TeX => "\\par\\centerline{\\bf $title}\\par\\nobreak\n", - Latex2HTML => $bHTML . '

' . $title . '

' . $eHTML, - HTML => '

' . $title . '

' - ); -} diff --git a/doc/MathObjects/macros/unionTables.pl b/doc/MathObjects/macros/unionTables.pl deleted file mode 100644 index 456964cdd5..0000000000 --- a/doc/MathObjects/macros/unionTables.pl +++ /dev/null @@ -1,276 +0,0 @@ -###################################################################### -## -## Functions for creating tables of various kinds -## -## ColumnTable() Creates a two-column display in HTML, -## but only one column in TeX. -## -## ColumnMatchTable() Does a side-by-side match table -## -## BeginTable() Begin a borderless HTML table -## Row() Create a row in the table -## AlignedRow() Create a row with alignment in each column -## TableSpace() Insert extra vertical space in the table -## EndTable() End the table -## - -###################################################################### -# -# Make a two-column table in HTML and Latex2HTML modes -# -# Usage: ColumnTable(col1,col2,[options]) -# -# Options can be taken from: -# -# indent => n the width to indent the first column -# (default is 0) -# -# separation => n the width of the separating gutter -# (default is 50) -# -# valign => type set the vertical alignment -# (default is "MIDDLE") -# -sub ColumnTable { - my $col1 = shift; - my $col2 = shift; - my %options = (indent => 0, separation => 50, valign => "MIDDLE", @_); - my ($ind, $sep) = ($options{"indent"}, $options{"separation"}); - my $valign = $options{"valign"}; - - my ($bhtml, $ehtml) = ('\begin{rawhtml}', '\end{rawhtml}'); - ($bhtml, $ehtml) = ('', '') unless ($displayMode eq "Latex2HTML"); - - my $HTMLtable = qq { - $bhtml -
 $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 . '' . $eHTML . "\n", - HTML => '' . "\n", - ); -} - -# -# A horizontal rule within a table. (Could have been a variable, -# but all the other table commands are subroutines, so kept it -# one to be consistent.) -# -sub TableLine { - MODES( - TeX => '\vadjust{\kern2pt\hrule\kern2pt}', - Latex2HTML => $bHTML . '
' . $eHTML . "\n", - HTML => '
' . "\n" - ); -} - -1; diff --git a/macros/README.md b/macros/README.md new file mode 100644 index 0000000000..fad714c4fd --- /dev/null +++ b/macros/README.md @@ -0,0 +1,213 @@ +# Structure of the macros directory + +This directory now has a subdirectory structure for clarification. + +- **answers** answer and evaluator macros +- **capa** any CAPA related macros +- **contexts** context related macros +- **core** macros related to core PG functionality +- **graph** graphing/graphical related macros. +- **math** mathematical related macros +- **parsers** macros that handle parsing +- **ui** macros that affect the UI in the PG problem +- **univ** university or other specific functionality related macros. + +## These Have Been Copied + +- `OPL/Alfred/Alfredmacros.pl` to `PG/macros/univ` +- `OPL/BrockPhysics/BrockPhysicsMacros.pl` to `PG/macros/univ` (referenced throughout OPL, but blank, should be deleted.) +- `OPL/BrockPhysics/fixedPrecision.pl` to `PG/macros/contexts` (not sure how this is used in problems). +- `OPL/Hope/PGgraphgrid.pl` to `PG/macros/graph` +- `OPL/Hope/VectorListCheckers.pl` to `PG/macros/math` +- `OPL/LaTech/SI_property_tables.pl` to `PG/macros/math` +- `OPL/LaTech/interpMacros.pl` to `PG/macros/math` +- `OPL/Mizzou/MUHelp.pl` to `PG/macros/univ` +- `OPL/TCNJ/Generic.pl` to `PG/macros/answers` +- `OPL/UBC/regrfnsPG.pl` to `PG/macros/math` +- `OPL/UMass-Amherst/algebraMacros.pl` to `PG/macros/math` +- `OPL/WHFreeman/freemanMacros.pl` to `PG/macros/univ` +- `OPL/Michigan/hhAdditionalMacros.pl` to `PG/macros/univ` + +### CollegeOfIdaho + +- `OPL/CofIdaho_macros.pl` to `PG/macros/univ` +- `OPL/CollegeOfIdaho/contextInequalitiesAllowStrings.pl` to `PG/macros/contexts` +- `OPL/CollegeOfIdaho/contextFunctionAssign.pl` to `PG/macros/contexts` +- `OPL/CollegeOfIdaho/parserUtils.pl` to `PG/macros/parsers` +- `OPL/CollegeOfIdaho/unorderedAnswer.pl` to `PG/macros/answers` + +### FortLewis + +- `OPL/FortLewis/AnswerFormatHelp.pl` to `PG/macros/answers` +- `OPL/FortLewis/ConditionalHint.pl` to `PG/macros/answers` +- `OPL/FortLewis/LiveGraphicsCylindricalPlot3D.pl` to `PG/macros/graph` +- `OPL/FortLewis/LiveGraphicsParametricCurve3D.pl` to `PG/macros/graph` +- `OPL/FortLewis/LiveGraphicsParametricSurface3D.pl` to `PG/macros/graph` +- `OPL/FortLewis/LiveGraphicsVectorField2D.pl` to `PG/macros/graph` +- `OPL/FortLewis/LiveGraphicsVectorField3D.pl` to `PG/macros/graph` +- `OPL/FortLewis/MatrixUnimodular.pl` to `PG/macros/math` +- `OPL/FortLewis/PeriodicRandomization.pl` to `PG/macros/core` + +### NAU + +- `OPL/NAU/PGnauBinpacking.pl` to `PG/macros/math` +- `OPL/NAU/PGnauGraphtheory.pl` to `PG/macros/math` +- `OPL/NAU/PGnauGraphCatalog.pl` to `PG/macros/math` +- `OPL/NAU/PGnauScheduling.pl` to `PG/macros/math` +- `OPL/NAU/PGnauSet.pl` to `PG/macros/math` +- `OPL/NAU/PGnauStats.pl` to `PG/macros/math` +- `OPL/NAU/PGnauGraphics.pl` to `PG/macros/graph` + +### Union + +- `OPL/Union/answerUtils.pl` to `PG/macros/answers` +- `OPL/Union/PGunion.pl` to `PG/macros/univ` +- `OPL/Union/unionImage.pl` to `PG/macros/univ` +- `OPL/Union/unionInclude.pl` to `PG/macros/univ` +- `OPL/Union/unionMacros.pl` to `PG/macros/univ` +- `OPL/Union/unionLists.pl` to `PG/macros/ui` +- `OPL/Union/unionProblem.pl` to `PG/macros/univ` +- `OPL/Union/unionTable.pl` to `PG/macros/ui` +- `OPL/Union/unionUtils.pl` to `PG/macros/univ` +- `OPL/Union/imageChoice.pl` to `PG/macros/graph` +- `OPL/FortLewis/AnswerHelp.pl` to `PG/macros/answers` + +### PCC + +- `OPL/PCC/contextFiniteSolutionSets.pl` to `PG/macros/contexts` +- `OPL/PCC/contextForm.pl` to `PG/macros/contexts` +- `OPL/PCC/contextLimitedRadicalComplex.pl` to `PG/macros/contexts` +- `OPL/PCC/contextRationalExponent.pl` to `PG/macros/contexts` +- `OPL/PCC/contextRestrictedDomains.pl` to `PG/macros/contexts` +- `OPL/PCC/PCCfactor.pl` to `PG/macros/math` +- `OPL/PCC/PCCgraphMacros.pl` to `PG/macros/graph` +- `OPL/PCC/PCCmacros.pl` to `PG/macros/univ` +- `OPL/PCC/pccTables.pl` to `PG/macros/ui` +- `OPL/PCC/SolveLinearEquationPCC.pl` to `PG/macros/math` +- `OPL/PCC/SystemsOfLinearEquationsProblemPCC.pl` to `PG/macros/math` + +## Not moved + +- `OPL/Hope/MatrixCheckers.pl` (already in PG/math) +- `OPL/Hope/MatrixReduce.pl` (already in PG/math) +- `OPL/Hope/MatrixUnits.pl` (already in PG/math) +- `OPL/MC/draggableProof.pl` (already in PG/math) +- `OPL/UBC/RserveClient.pl` (already in PG/core) +- `OPL/UW-Stout/*.pl` (no problems in OPL/Contrib) +- `OPL/UniSiegen/logicMacros.pl` (no problems in OPL/Contrib) +u + +### CollegeOfIdaho + +- `OPL/CollegeOfIdaho/allPlotMacros.pl` (no problems in OPL/Contrib) +- `OPL/CollegeOfIdaho/answerUtils.pl` (used newer Union version instead) +- `OPL/CollegeOfIdaho/choiceUtils.pl` (used Union version instead) +- `OPL/CollegeOfIdaho/compositionAnswer.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/compoundProblem.pl` (already version in PG/core) +- `OPL/CollegeOfIdaho/courseHeaders.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/Differentiation.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/DifferentiationDefs.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/diffquotientAnswer.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/ev3p.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/imageChoice.pl` (used Union version -- identical) +- `OPL/CollegeOfIdaho/infiniteAnswer.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/integerAnswer.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/intervalAnswer.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/lineAnswer.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/listAnswer.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/parallelAnswer.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/parserImplicitEquation.pl` (already in PG/parsers) +- `OPL/CollegeOfIdaho/parserTables.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/PGstandard.pl` (already in PG/core) +- `OPL/CollegeOfIdaho/PGunion.pl` (use union version) +- `OPL/CollegeOfIdaho/piecewiseFunctions.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/planeAnswer.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/pointAnswer.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/unionAnswer.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/variableAnswer.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/vectorAnswer.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/vectorUtils.pl` (not used in OPL/Contrib) +- `OPL/CollegeOfIdaho/weightedGrader.pl` (already in PG/core/weightedGrader) + +### FortLewis + +- `OPL/FortLewis/JavaView.pl` (not in OPL/Contrib) +- `OPL/FortLewis/JavaViewRectangularPlot3D.pl` (not in OPL/Contrib) + +### PCC + +- `OPL/PCC/contextAssignmentForm.pl` (no problems in OPL/Contrib) +- `OPL/PCC/contextInequalitySetBuilder.pl` (newer copy in `PG/macros/contexts`) +- `OPL/PCC/contextLimitedFactor.pl` (newer copy in `PG/macros/contexts`) +- `OPL/PCC/contextLimitedRadical.pl` (newer copy in `PG/macros/contexts`) +- `OPL/PCC/contextPercent.pl` (newer copy in `PG/macros/contexts`) +- `OPL/PCC/parserRoot.pl` (newer copy in `PG/macros/parsers`) + +### Union + +- `OPL/Union/answerUtils.pl` (not used in OPL/Contrib) +- `OPL/Union/courseHeaders.pl` (not used in OPL/Contrib) +- `OPL/Union/piecewiseFunctions.pl` (not used in OPL/Contrib) +- `OPL/Union/unorderedAnswer.pl` (used CollegeOfIdaho version, newer) + +## problems to check + +- `Library/UVA-Stew5e/setUVA-Stew5e-C03S01-DerivPolyExps/3-1-37_mo.pg` +- `Library/UCSB/Stewart5_3_7/Stewart5_3_7_39.pg` +- `Library/MC/PreAlgebra/setPreAlgebraC03S03/MeanMedianMode01.pg` +- `Contrib/AlfredUniv/anton8e/chapter10/10.5/prob9.pg` +- `Contrib/BrockPhysics/College_Physics_Urone/15.Thermodynamics/Carnots_Perfect_Heat_Engine_The_Second_Law_of_Thermodynamics_Restated/NU_U17-15-04-007.pg` +- `Library/CollegeOfIdaho/setAlgebra_04_03_AbsoluteValue/43IntAlg_33_AbsValGraph.pg` (error) +- `Library/CollegeOfIdaho/setAlgebra_04_03_AbsoluteValue/43IntAlg_34_AbsValGraph.pg` (error) +- `Library/FortLewis/Authoring/Templates/DiffCalcMV/Graph3DCylindrical1/Graph3DCylindrical1.pg` (nothing is viewed) +- `Library/FortLewis/Calc3/18-2-Line-integrals-parametrized/HGM5-18-2-19-Line-integrals-parametrized/HGM5-18-2-19-Line-integrals-parametrized.pg` (missing png file) +- `Library/LaTech/opes_Thermodynamics/J/J-01-Brayton01.pg` (gives a warning) +- `Contrib/Mizzou/Algebra/eqns_abs_value/abs_val_eqn_10.pg` (missing fracListChecker.pl macro) +- `Library/UMass-Amherst/Abstract-Algebra/PS-Permutations/Permutations2.pg` (warnings due to alegebraMacros.pl) +- `Contrib/PCC/BasicAlgebra/Factoring/factoring220.pg` (warnings about PCCfactor.pl) +- `Contrib/PCC/BasicAlgebra/SolveLinearEquations/LiteralEquation60.pg` (warnings about SolveLinearEquationPCC.pl) +- `Contrib/PCC/BasicAlgebra/SystemsOfLinearEquations/SystemOfEquations20.pg` (warnings about SystemsOfLinearEquationsProblemPCC.pl) +- `Library/PCC/BasicAlgebra/ComplexNumber/complexSolutions15.pg` (warnings about contextLimitedRadicalComplex.pl) +- `Contrib/CUNY/CityTech/CollegeAlgebra_Trig/RationalExponents/combine-rational-exponents-multiply.pg` (warning about contextRationalExponent.pl) +- `Contrib/PCC/CollegeAlgebra/FunctionBasics/FunctionTables20.pg` (warnings about PCCmacros.pl) +- `Library/Union/setMVfunctions/system-f2.pg` (warning about uninitialized value) + +## Todo + +- remove `BrockPhysicsMacros.pl` doesn't do anything. +- remove `parserUtils.pl` and refactor the two problems that depend on it. +- remove `answers/PGmiscevaluators.pl` (not used in OPL/Contrib) +- remove `answers/PGstringevaluators.pl` (not used in OPL/Contrib) +- remove `answers/PGtextevaluators.pl` (used in only 1 problems in OPL/Contrib) +- remove `answers/answerDiscussion.pl` (not used in OPL/Contrib) +- remove `contextAlternativeDecimal.pl` (not used in OPL/Contrib) +- only place `answerUtils.pl` is used is inside `unorderedAnswer.pl` (combine? refactor?) +- none of the LiveGraphics is working. Search for `LiveGraphics*.pl` +- What is the `fracListChecker.pl` macro? In a number of `Contrib/Mizzou` problems. + +## Info + +This PR does a few related things. + +1. Adds some directory structure to the `PG_ROOT/macros` directory. +2. Moves needed macros from the OPL macros directory into the PG_ROOT directories. +3. Updates the `t/load_macros.t` test to recursively search the `PG_ROOT/macros` directory + for macros instead of the assumed old directory structure. + +Also for testing, the following homework set was used. This set contains at least one problem for every macro. + +A number of issues arose while doing this. + +- there are a number of errors in the OPL macros that were not being shown (they are in the apache logs). These are to be fixed in this PR. +- The following macros are obsolete: algebraMacros, PGstringevaluators.pl, .... + This is because the functionality appears in other macros and there are redefined + subroutine errors upon loads. Problems with these macros need to be adjusted in the + OPL. A forthcoming PR to the webwork-problem-libraries branch will contain the deletion of the macros as well as updates to the problems. Note: the timing of this will be important so existing OPLs will still function. + +Lastly, to keep the size of this discussion box reasonable, all of the changes are +documented in `PG_ROOT/macros/README.md`. Clearly these can be added to this discussion +or some other way of documenting all of these change. Because this involved moving +files from one repository to another, git will not track specific changes, just additions and deletions. + +This is based on PR ?? because of the update to the testing infrastructure makes it +much easier to do testing with this PR. diff --git a/macros/answers/AnswerFormatHelp.pl b/macros/answers/AnswerFormatHelp.pl new file mode 100755 index 0000000000..504b8f6ce9 --- /dev/null +++ b/macros/answers/AnswerFormatHelp.pl @@ -0,0 +1,868 @@ + +=head1 NAME + +AnswerFormatHelp.pl + +=head1 SYNOPSIS + +Creates links for students to help documentation on formatting +answers and allows for custom help links. + +=head1 DESCRIPTION + +There are 16 predefined help links: angles, decimals, equations, +exponents, formulas, fractions, inequalities, intervals, limits, +logarithms, matrices, numbers, points, syntax, units, vectors. + +Usage: + + DOCUMENT(); + loadMacros("PGstandard.pl","AnswerFormatHelp.pl",); + TEXT(beginproblem()); + BEGIN_TEXT + \{ ans_rule(20) \} + \{ AnswerFormatHelp("formulas") \} $PAR + \{ ans_rule(20) \} + \{ AnswerFormatHelp("equations","help entering equations") \} $PAR + END_TEXT + ENDDOCUMENT(); + + +The first example use defaults and displays the help link right next to +the answer blank, which is recommended. The second example customizes +the link text displayed to the student, but the actual help document +is unaffected. + +=head1 AUTHOR + +Paul Pearson, Hope College, Department of Mathematics + +=cut + +########################### + +########################### +# Site administration +# +# The only thing you may need to modify is the value +# of $helpurl near the end of this file. +# +########################### +# Usage +# +# DOCUMENT(); +# loadMacros("PGstandard.pl","AnswerFormatHelp.pl",); +# TEXT(beginproblem()); +# BEGIN_TEXT +# \{ AnswerFormatHelp("formulas") \} $PAR +# \{ AnswerFormatHelp("equations","help entering equations") \} $PAR +# \{ AnswerFormatHelp("formulas","help (formulas)","http://webwork.someschool.edu/dir/subdir/") \} +# END_TEXT +# ENDDOCUMENT(); +# +# First example: use defaults. +# +# Second example: use customized text displayed to the student +# as the html link. +# +# Third example: additionally points to a particular URL where +# html help files are located. The URL must end with a forward slash. +# +# The third method is not recommended, as a universal, site-wide, +# or course-wide solution obtained by modifying the value of +# $helpdir in AnswerFormatHelp.pl is preferable to setting the +# URL in every individual PG file manually. +# +########################### + +our ( + $syntaxHelpExists, $angleHelpExists, $decimalHelpExists, $equationHelpExists, + $exponentHelpExists, $formulaHelpExists, $fractionHelpExists, $inequalitiesHelpExists, + $intervalHelpExists, $limitsHelpExists, $logarithmsHelpExists, $numberHelpExists, + $pointsHelpExists, $unitsHelpExists, $vectorsHelpExists, +) = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,); + +sub _AnswerFormatHelp_init { }; # don't reload this file + +sub AnswerFormatHelp { + + # + # Define some local variables + # + my $helptype = shift; + my $customstring = shift; + + my $helpstring = ""; + + # If producing PTX output, omit any formatting help. + # (PTX output is used to produce non-interactive presentations of a problem, + # so there is no need to give syntax formatting help.) + if ($main::displayMode eq "PTX") { + return; + } + +#################################### + # Angles + + if ($helptype =~ m/angle/i) { + + if ($angleHelpExists != 1) { + + HEADER_TEXT(< + + +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)

    • "; + } else { + $useBaseTenLogHelpString = + "
  • Entering logarithms:
    Caution: In this question, use 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)

    • "; + } + + if ($formulaHelpExists != 1) { + + HEADER_TEXT(< + + +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)

    • "; + $basetenLogHelpString = + "
  • Entering base 10 logarithm: In this question, use log(x), log10(x), or logten(x).

    • "; + } else { + $naturalLogHelpString = + "
  • Caution: In this question log(x) is the same as ln(x)

  • Entering natural logarithm: In this question, use ln(x) or log(x)

    • "; + $basetenLogHelpString = + "
  • Entering base 10 logarithm: In this question, use log10(x) or logten(x).

    • "; + } + + if ($logarithmsHelpExists != 1) { + + HEADER_TEXT(< + + +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 100755 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 100755 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/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 100755 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 100755 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/compoundProblem.pl b/macros/compoundProblem.pl deleted file mode 100644 index fd6cd865df..0000000000 --- a/macros/compoundProblem.pl +++ /dev/null @@ -1,678 +0,0 @@ -sub _compoundProblem_init { }; # don't reload this file - -###################################################################### -# -# This package implements a method of handling multi-part problems -# that show only a single part at any one time. The students can -# work on one part at a time, and then when they get it right (or -# under other circumstances deterimed by the professor), they can -# move on to the next part. Students can not return to earlier parts -# once they have been completed. The score for problem as a whole is -# made up from the scores on the individual parts, and the relative -# weighting of the various parts can be specified by the problem -# author. -# -# To use the compoundProblem library, use -# -# loadMacros("compoundProblem.pl"); -# -# at the top of your file, and then create a compoundProblem object -# via the command -# -# $cp = new compoundProblem(options) -# -# where '$cp' is the name of a variable that you will use to -# refer to the compound problem, and 'options' can include: -# -# parts => n The number of parts in the problem. -# Default: 1 -# -# weights => [n1,...,nm] The relative weights to give to each -# part in the problem. For example, -# weights => [2,1,1] -# would cause the first part to be worth 50% -# of the points (twice the amount for each of -# the other two), while the second and third -# part would be worth 25% each. If weights -# are not supplied, the parts are weighted -# by the number of answer blanks in each part -# (and you must provide the total number of -# blanks in all the parts by supplying the -# totalAnswers option). -# -# totalAnswers => n The total number of answer blanks in all -# the parts put together (this is used when -# computing the per-part scores, if part -# weights are not provided). -# -# saveAllAnswers => 0 or 1 Usually, the contents of named answer blanks -# from previous parts are made available to -# later parts using variables with the -# same name as the answer blank. Setting -# saveAllAnswers to 1 will cause ALL answer -# blanks to be available (via variables -# like $AnSwEr1, and so on). -# Default: 0 -# -# parserValues => 0 or 1 Determines whether the answers from previous -# parts are returned as MathObjects (like -# those returned from Real(), Vector(), etc) -# or as strings (the unparsed contents of the -# student answer). If you intend to use the -# previous answers as numbers, for example, -# you would want to set this to 1 so that you -# would get the final result of any formula -# the student typed, rather than the formula -# itself as a character string. -# Default: 0 -# -# nextVisible => type Tells when the "go on to the next part" option -# is available to the student. The possible -# types include: -# -# 'ifCorrect' next is available only when -# all the answers are correct. -# -# 'Always' next is always available -# (but remember that students -# can't go back once they go -# on.) -# -# 'Never' next is never allowed (the -# problem will control going -# on to the next part itself). -# -# Default: 'ifCorrect' -# -# nextStyle => type Determines the style of "next" indicator to display -# (when it is available). The type can be one of: -# -# 'CheckBox' a checkbox that allows the students -# to go on to the next part when they -# submit their answers. -# -# 'Button' a button that submits their answers -# and goes on to the next part. -# -# 'Forced' forces the student to go on to the -# next part the next time they submit -# answers. -# -# 'HTML' allows you to provide an arbitrary -# HTML string of your own. -# -# Default: 'Checkbox' -# -# nextLabel => string Specifies the string to use as the label for the checkbox, -# the name of the button, the text of the message indicating -# that the next submit will move to the next part, or the -# HTML string, depending on the setting of nextStyle above. -# -# nextNoChange => 0 or 1 Since the students must submit their answers again to go on -# to the next part, it is possible for them to change their -# answers before they submit, and if nextVisible is 'ifCorrect' -# they might go on to the next without having correct answers -# stored. This option lets you control whether the answers -# are checked against the previous ones before going on to the -# next part. If the answers don't match, a warning is issued -# and they are not allowed to move on. -# Default: 1 -# -# allowReset => 0 or 1 Determines whether a "Go back to the first part" checkbox -# is provided on parts 2 and later. This is intended for -# the professor during testing of the problem (otherwise -# it would be impossible to go back to earlier parts). -# Default: 0 -# -# resetLabel => string The string used to label the reset checkbox. -# -# Once you have created a compoundProblem object, you can use $cp->part to -# determine the part that the student is working on, and use 'if' statements -# to display the proper information for the given part. The compoundProblem -# object takes care of maintaining the data as the parts change. (See the -# compoundProblem.pg file for an example of a compound problem.) -# -# In order to handle the scoring of the problem as a whole when only part is -# showing, the compoundProblem object uses its own problem grader to manage -# the scores, and calls your own grader from there. The default is to use -# the one that was installed before the compoundProblem object was created, -# or avg_problem_grader if none was installed. You can specify a different -# one using the $cp->useGrader() method (see below). It is important that -# you NOT call install_problem_grader() yourself once you have created the -# compoundProblem object, as that would disable the special grader, causing -# the compound problem to fail to work properly. -# -# You may call the following methods once you have a compoundProblem: -# -# $cp->part Returns the part the student is working on. -# $cp->part(n) Sets the part to be part n, as long as the -# student has finished the preceeding parts. -# If not, the part is set to the highest -# one the student hasn't completed, and he -# can work up to the given part. (The -# nextVisible option is set to 'ifCorrect' if -# it was 'Never' so that students can go on -# once they finish the earlier parts.) -# -# $cp->useGrader(code_ref) Supplies your own grader to use in -# place of the default one. For example: -# $cp->useGrader(~~&std_problem_grader); -# -# $cp->score Returns the (weighted) score for this part. -# Note that this is the score shown at the bottom -# of the page on which the student pressed submit -# (not the score for the answers the student is -# submitting -- that is not available until -# after the body of the problem has been created). -# -# $cp->scoreRaw Returns the unweighted score for this part. -# -# $cp->scoreOverall Returns the overall score for the problem -# so far. -# -# $cp->addAnswers(list) Make additional answer blanks be available -# from one part to another. E.g., -# $cp->addAnswers('AnSwEr1'); -# would make the first unnamed blank be available -# in later parts as well. (This command should -# be issued only when the part containing the -# given answer blank is displayed.) -# -# $cp->nextCheckbox(label) Returns the HTML string for the "go on to next -# part" checkbox so you can use it in the body of -# the problem if you wish. This should not be -# inserted when the $displayMode is 'TeX'. If the -# label is not given or is blank, the default label -# is used. -# -# $cp->nextButton(label) Returns the HTML string for the "go on to next -# part" button so you can use it in the body of -# the problem if you wish. This should not be -# inserted when the $displayMode is 'TeX'. If the -# label is not given or is blank, the default label -# is used. -# -# $cp->nextForces(label) Returns the HTML string for the forced "go on to -# next part" so you can use it in the body of -# the problem if you wish. This should not be -# inserted when the $displayMode is 'TeX'. If the -# label is not given or is blank, the default label -# is used. -# -# $cp->reset Go back to part 1, clearing the answers -# and score. (Best used when debugging problems.) -# -# $cp->resetCheckbox(label) Returns the HTML string for the reset checkbox -# so that you can provide one within the body -# of the problem if you wish. This should not be -# inserted when the $displayMode is 'TeX'. If the -# label is not given or is blank, the default label -# will be used. -# - -###################################################################### - -package compoundProblem; - -# -# The state data that is stored between invocations of -# the problem. -# -our %defaultStatus = ( - part => 1, # the current part - answers => "", # answer labels from previous parts - new_answers => "", # answer labels for THIS part - ans_rule_count => 0, # the ans_rule count from previous parts - new_ans_rule_count => 0, # the ans_rule count from THIS part - images_created => 0, # the image count from the precious parts - new_images_created => 0, # the image count from THIS part - imageName => "", # name of images_created image file - score => 0, # the (weighted) score on this part - total => 0, # the total on previous parts - raw => 0, # raw score on this part -); - -# -# Create a new instance of the compound Problem and initialize -# it. This includes reading the status from the previous -# parts, defining the variables from the answers to previous parts, -# and setting up the grader so that the current data can be saved. -# -sub new { - my $self = shift; - my $class = ref($self) || $self; - my $cp = bless { - parts => 1, - totalAnswers => undef, - weights => undef, # array of weights per part - saveAllAnswers => 0, # usually only save named answers - parserValues => 0, # make Parser objects from the answers? - nextVisible => "ifCorrect", # or "Always" or "Never" - nextStyle => "Checkbox", # or "Button", "Forced", or "HTML" - nextLabel => undef, # Checkbox text or button name or HTML - nextNoChange => 1, # true if answer can't change for new part - allowReset => 0, # true to show "back to part 1" button - resetLabel => undef, # label for reset button - grader => $main::PG->{flags}->{PROBLEM_GRADER_TO_USE} || \&main::avg_problem_grader, - @_, - status => $defaultStatus, - }, $class; - die "You must provide either the totalAnswers or weights" - unless $cp->{totalAnswers} || $cp->{weights}; - $cp->getTotalWeight if $cp->{weights}; - main::loadMacros("Parser.pl") if $cp->{parserValues}; - $cp->reset if $cp->{allowReset} && $main::inputs_ref->{_reset}; - $cp->getStatus; - $cp->initPart; - return $cp; -} - -# -# Compute the total of the weights so that the parts can -# be properly scaled. -# -sub getTotalWeight { - my $self = shift; - $self->{totalWeight} = 0; - $self->{totalAnswers} = 1; - foreach my $w (@{ $self->{weights} }) { $self->{totalWeight} += $w } - $self->{totalWeight} = 1 if $self->{totalWeight} == 0; -} - -# -# Look up the status from the previous invocation -# and see if we need to go on to the next part. -# -sub getStatus { - my $self = shift; - main::RECORD_FORM_LABEL("_next"); - main::RECORD_FORM_LABEL("_status"); - $self->{status} = $self->decode; - $self->{isNew} = $main::inputs_ref->{_next} - || ($main::inputs_ref->{submitAnswers} - && $main::inputs_ref->{submitAnswers} eq ($self->{nextLabel} || $main::PG->maketext("Go on to next part"))); - if ($self->{isNew}) { - $self->checkAnswers; - $self->incrementPart unless $self->{nextNoChange} && $self->{answersChanged}; - } -} - -# -# Initialize the current part by setting the ans_rule -# count (so that later parts will get unique answer names), -# installing the grader (to save the data), and setting -# the variables for previous answers. -# -sub initPart { - my $self = shift; - $main::ans_rule_count = $self->{status}{ans_rule_count}; - $main::images_created{ $self->{status}{imageName} } = $self->{status}{images_created} - if $self->{status}{imageName}; - main::install_problem_grader(\&compoundProblem::grader); - $main::PG->{flags}->{compoundProblem} = $self; - $self->initAnswers($self->{status}{answers}); -} - -# -# Look through the list of answer labels and set -# the variables for them to be the associated student -# answer. Make it a Parser value if requested. -# Record the value so that is will be available -# again on the next invocation. -# -sub initAnswers { - my $self = shift; - my $answers = shift; - foreach my $id (split(/;/, $answers)) { - my $value = $main::inputs_ref->{$id}; - $value = '' unless defined($value); - if ($self->{parserValues}) { - my $parser = Parser::Formula($value); - $parser = Parser::Evaluate($parser) if $parser && $parser->isConstant; - $value = $parser if $parser; - } - ${"main::$id"} = $value unless $id =~ m/$main::ANSWER_PREFIX/o; - $value = quoteHTML($value); - main::TEXT(qq!!); - main::RECORD_FORM_LABEL($id); - } -} - -# -# Look to see is any answers have changed on this -# invocation of the problem. -# -sub checkAnswers { - my $self = shift; - foreach my $id (keys(%{$main::inputs_ref})) { - if ($id =~ m/^previous_(.*)$/) { - if ($main::inputs_ref->{$id} ne $main::inputs_ref->{$1}) { - $self->{answersChanged} = 1; - $self->{isNew} = 0 if $self->{nextNoChange}; - return; - } - } - } -} - -# -# Go on to the next part, updating the status -# to include the data from the old part so that -# it will be properly preserved when the next -# part is showing. -# -sub incrementPart { - my $self = shift; - my $status = $self->{status}; - if ($status->{part} < $self->{parts}) { - $status->{part}++; - $status->{answers} .= ';' if $status->{answers}; - $status->{answers} .= $status->{new_answers}; - $status->{ans_rule_count} = $status->{new_ans_rule_count}; - $status->{images_created} = $status->{new_images_created}; - $status->{total} += $status->{score}; - $status->{score} = $status->{raw} = 0; - $status->{new_answers} = ''; - } -} - -###################################################################### - -# -# Encode all the status information so that it can be -# maintained as the student submits answers. Since this -# state information includes things like the score from -# the previous parts, it is "encrypted" using a dumb -# hex encoding (making it harder for a student to recognize -# it as valuable data if they view the page source). -# -sub encode { - my $self = shift; - my $status = shift || $self->{status}; - my @data = (); - my $data = ""; - foreach my $id (main::lex_sort(keys(%defaultStatus))) { push(@data, $status->{$id}) } - foreach my $c (split(//, join('|', @data))) { $data .= toHex($c) } - return $data; -} - -# -# Decode the data and break it into the status hash. -# -sub decode { - my $self = shift; - my $status = shift || $main::inputs_ref->{_status}; - return {%defaultStatus} unless $status; - my @data = (); - foreach my $hex (split(/(..)/, $status)) { push(@data, fromHex($hex)) if $hex ne '' } - @data = split('\\|', join('', @data)); - $status = {%defaultStatus}; - if (scalar(@data) == 8) { - # insert imageName, images_created, new_images_created, if missing - splice(@data, 2, 0, "", 0); - splice(@data, 6, 0, 0); - } - foreach my $id (main::lex_sort(keys(%defaultStatus))) { $status->{$id} = shift(@data) } - return $status; -} - -# -# Hex encoding is shifted by 10 to obfuscate it further. -# (shouldn't be a problem since the status will be made of -# printable characters, so they are all above ASCII 32) -# -sub toHex { main::spf(ord(shift) - 10, "%X") } -sub fromHex { main::spf(hex(shift) + 10, "%c") } - -# -# Make sure the data can be properly preserved within -# an HTML tag. -# -sub quoteHTML { - my $string = shift; - $string =~ s/&/\&/g; - $string =~ s/"/\"/g; - $string =~ s/>/\>/g; - $string =~ s/{grader} = shift; -} - -# -# Make additional answer blanks from the current part -# be preserved for use in future parts. -# -sub addAnswers { - my $self = shift; - $self->{extraAnswers} = [] unless $self->{extraAnswers}; - push(@{ $self->{extraAnswers} }, @_); -} - -# -# Go back to part 1 and clear the answers and scores. -# -sub reset { - my $self = shift; - if ($main::inputs_ref->{_status}) { - my $status = $self->decode($main::inputs_ref->{_status}); - foreach my $id (split(/;/, $status->{answers})) { delete $main::inputs_ref->{$id} } - foreach my $id (1 .. $status->{ans_rule_count}) { - delete $main::inputs_ref->{"${main::QUIZ_PREFIX}${main::ANSWER_PREFIX}$id"}; - } - } - $main::inputs_ref->{_status} = $self->encode(\%defaultStatus); - $main::inputs_ref->{_next} = 0; -} - -# -# Return the HTML for the "Go back to part 1" checkbox. -# -sub resetCheckbox { - my $self = shift; - my $label = shift - || " " - . $main::PG->maketext("Go back to Part 1") - . " (" - . $main::PG->maketext("when you submit your answers") . ")."; - my $par = shift; - $par = ($par ? $main::PAR : ''); - qq'$par$label'; -} - -# -# Return the HTML for the "next part" checkbox. -# -sub nextCheckbox { - my $self = shift; - my $label = shift - || " " - . $main::PG->maketext("Go on to next part") - . " (" - . $main::PG->maketext("when you submit your answers") . ")."; - my $par = shift; - $par = ($par ? $main::PAR : ''); - $self->{nextInserted} = 1; - qq!$par$label!; -} - -# -# Return the HTML for the "next part" button. -# -sub nextButton { - my $self = shift; - my $label = quoteHTML(shift || $main::PG->maketext("Go on to next part")); - my $par = shift; - $par = ($par ? $main::PAR : ''); - $par - . qq!!; -} - -# -# Return the HTML for when going to the next part is forced. -# -sub nextForced { - my $self = shift; - my $label = shift || "" . $main::PG->maketext("Submit your answers again to go on to the next part.") . ""; - $label = $main::PAR . $label if shift; - $self->{nextInserted} = 1; - qq!$label!; -} - -# -# Return the raw HTML provided -# -sub nextHTML { shift; shift } - -###################################################################### - -# -# Return the current part, or try to set the part to the given -# part (returns the part actually set, which may be earlier if -# the student didn't complete an earlier part). -# -sub part { - my $self = shift; - my $status = $self->{status}; - my $part = shift; - return $status->{part} unless defined $part && $main::displayMode ne 'TeX' && $main::displayMode ne 'PTX'; - $part = 1 if $part < 1; - $part = $self->{parts} if $part > $self->{parts}; - if ($part > $status->{part} && !$main::inputs_ref->{_noadvance}) { - unless ((lc($self->{nextVisible}) eq 'ifcorrect' && $status->{raw} < 1) - || lc($self->{nextVisible}) eq 'never') - { - $self->initAnswers($status->{new_answers}); - $self->incrementPart; - $self->{isNew} = 1; - } - } - if ($part != $status->{part}) { - main::TEXT(''); - $self->{nextVisible} = 'IfCorrect' if lc($self->{nextVisible}) eq 'never'; - } - return $status->{part}; -} - -# -# Return the various scores -# -sub score { shift->{status}{score} } -sub scoreRaw { shift->{status}{raw} } - -sub scoreOverall { - my $self = shift; - return $self->{status}{score} + $self->{status}{total}; -} - -###################################################################### -# -# The custom grader that does the work of computing the scores -# and saving the data. -# -sub grader { - my $self = $main::PG->{flags}->{compoundProblem}; - # - # Get the answer names and the weight for the current part. - # - my @answers = keys(%{ $_[0] }); - my $weight = scalar(@answers) / $self->{totalAnswers}; - $weight = $self->{weights}[ $self->{status}{part} - 1 ] / $self->{totalWeight} - if $self->{weights} && defined($self->{weights}[ $self->{status}{part} - 1 ]); - @answers = grep(!/$main::ANSWER_PREFIX/o, @answers) unless $self->{saveAllAnswers}; - push(@answers, @{ $self->{extraAnswers} }) if $self->{extraAnswers}; - my $space = ''; - - # - # Call the original grader, but put back the old recorded_score - # (the grader will have updated it based on the score for the PART, - # not the problem as a whole). - # - my $oldScore = ($_[1])->{recorded_score}; - my ($result, $state) = &{ $self->{grader} }(@_); - $state->{recorded_score} = $oldScore; - - # - # Update that state information and encode it. - # - my $status = $self->{status}; - $status->{raw} = $result->{score}; - $status->{score} = $result->{score} * $weight; - $status->{new_ans_rule_count} = $main::ans_rule_count; - if (%main::images_created) { - $status->{imageName} = (keys %main::images_created)[0]; - $status->{new_images_created} = $main::images_created{ $status->{imageName} }; - } - $status->{new_answers} = join(';', @answers); - my $data = quoteHTML($self->encode); - - # - # Update the recorded score - # - my $newScore = $status->{total} + $status->{score}; - $state->{recorded_score} = $newScore if $newScore > $oldScore; - $state->{recorded_score} = 0 if $self->{allowReset} && $main::inputs_ref->{_reset}; - - # - # Add the compoundProblem message and data - # - $result->{type} = "compoundProblem ($result->{type})"; - $result->{msg} .= '

    Note: ' if $result->{msg}; - $result->{msg} .= - $main::PG->maketext("This problem has more than one part.") . '
    ' - . $space - . '' - . $main::PG->maketext("Your score for this attempt is for this part only;") - . '' . '
    ' - . $space - . '' - . $main::PG->maketext("your overall score is for all the parts combined.") - . '' - . qq!!; - - # - # Warn if the answers changed when they shouldn't have - # - $result->{msg} .= - '

    ' . $main::PG->maketext("You may not change your answers when going on to the next part!") . '' - if $self->{nextNoChange} && $self->{answersChanged}; - - # - # Include the "next part" checkbox, button, or whatever. - # - my $par = 1; - if ($self->{parts} > $status->{part} && !$main::inputs_ref->{previewAnswers}) { - if (lc($self->{nextVisible}) eq 'always' - || (lc($self->{nextVisible}) eq 'ifcorrect' && $result->{score} >= 1)) - { - my $method = "next" . $self->{nextStyle}; - $par = 0; - $result->{msg} .= $self->$method($self->{nextLabel}, 1) . '
    '; - } - } - - # - # Add the reset checkbox, if needed - # - $result->{msg} .= $self->resetCheckbox($self->{resetLabel}, $par) - if $self->{allowReset} && $status->{part} > 1; - - # - # Make sure we don't go on unless the next button really is checked - # - $result->{msg} .= '' - unless $self->{nextInserted}; - - return ($result, $state); -} - -1; diff --git a/macros/contextAlternateIntervals.pl b/macros/contextAlternateIntervals.pl deleted file mode 100644 index 1fe75f0671..0000000000 --- a/macros/contextAlternateIntervals.pl +++ /dev/null @@ -1,472 +0,0 @@ -################################################################################ -# WeBWorK Online Homework Delivery System -# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork -# -# This program is free software; you can redistribute it and/or modify it under -# the terms of either: (a) the GNU General Public License as published by the -# Free Software Foundation; either version 2, or (at your option) any later -# version, or (b) the "Artistic License" which comes with this package. -# -# This program is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the -# Artistic License for more details. -################################################################################ - -=head1 NAME - -C - Provides a context that allows the -entry of intervals using reversed bracket notation for open endpoints -(e.g., C<]a,b[> rather than C<(a,b)> for an open interval). - - -=head1 DESCRIPTION - -This macro file defines contexts in which open intervals can be -specified using reversed brackets rather than parentheses. Both forms -are always recognized, but you can determine whether one or the other -form produces an error message when used. You can also force the -display of intervals to use one or the other form. - - -=head1 USAGE - -To use this file, first load it into your problem, then select the -context that you wish to use. There are three pre-defined contexts, -C, C, and -C. The first allows both the standard and -alternate forms to be used, the second allows only the alternate form, -and the third allows only the standard form, but recognizes the -alternate form and gives an error message when it is used. - - loadMacros("contextAlternateIntervals.pl"); - - Context("AlternateIntervals"); - - $I1 = Compute("]2,5["); - $I2 = Compute("(2,5)"); # equivalent to $I1; - - Context("AlternateIntervals-Only"); - - $I1 = Compute("]2,5["); - $I2 = Compute("(2,5)"); # causes an error message - - Context("AlternateIntervals-Warning"); - - $I1 = Compute("]2,5["); # causes an error message - $I2 = Compute("(2,5)"); - -There are two context flags that control the input and output of -intervals. - -=over - -=item C "either" (or "alternate" or "stanard") >>> - -This specifies what formats the student is allowed to use to enter an -interval. A value of C<"either"> allows either of the formats to be -accepted, while the other two options produce error messages if the -wrong form is used. - -=item C "either" (or "alternate" or "standard") >>> - -This controls how intervals are displayed. When set to C<"either">, the -interval is displayed in whatever format was used to create it. When -set to C<"standard"> or C<"alternate">, the display is forced to be in the -given format regardless of how it was entered. - -=back - -The C context has both flags set to C<"either">, so the -intervals remain in the format the student entered them, and either -form can be used. The C context has both set to -C<"alternate">, so only the alternate format can be used, and any -Interval will be displayed in alternate format. The -C context has both set to C<"standard">, so only -standard format can be used, and all intervals will be displayed in -standard format. - -It is possible to set C and C to -different values. For example. - - Context()->flags->set( - enterIntervals => "either", - displayIntervals => "standard", - ); - -would allow students to enter intervals in either format, but all -intervals would be displayed in standard form. - -=head1 SETTING THE ALTERNATE FORM AS THE DEFAULT - -If you want to force existing problems that use the Interval context -to use one of the alternate contexts instead, then create a file named -C in your course's C -directory, and enter the following in it: - - loadMacros("contextAlternateIntervals.pl"); - context::AlternateIntervals->Default("either","either"); - -This will alter the C context so that students can -enter intervals in either format (and they will be shown in whatever -format that was used to enter them). - -You could also do - - loadMacros("contextAlternateIntervals.pl"); - context::AlternateIntervals->Default("standard","standard"); - -to cause a warning message to appear when students enter the alternate -format. - -If you want to force students to enter the alternate format, use - - loadMacros("contextAlternateIntervals.pl"); - context::AlternateIntervals->Default("alternate","alternate"); - -This will force the display of all intervals into the alternate form -(so even the ones created in the problem using standard form will show -using the alternate format), and will force students to enter their -results using the alternate format, though professor's answers will -still be allowed to be entered in either format (the C -function converts the first C<"alternate"> to C<"either">, but -arranges that the default flags for the answer checker are set to only -allow students to enter the alternative format). This allows you to -force alternate notation in problems without having to rewrite them. - -=cut - -########################################################################## - -loadMacros("MathObjects.pl"); - -sub _contextAlternateIntervals_init { context::AlternateIntervals->Init } - -########################################################################## - -package context::AlternateIntervals; - -# -# Create the AlternateIntervals contexts -# -sub Init { - my $self = shift; - my $context = $main::context{AlternateIntervals} = Parser::Context->getCopy("Interval"); - $context->{name} = "AlternateIntervals"; - $self->Enable($context); - - $context = $main::context{"AlternateIntervals-Only"} = $context->copy; - $context->{name} = "AlternativeIntervals-Only"; - $context->flags->set( - enterIntervals => "alternate", - displayIntervals => "alternate", - ); - - $context = $main::context{"AlternateIntervals-Warning"} = $context->copy; - $context->{name} = "AlternativeIntervals-Warning"; - $context->flags->set( - enterIntervals => "standard", - displayIntervals => "standard", - ); -} - -# -# Enables alternate intervals in the given context -# -sub Enable { - my $self = shift; - my $context = shift || main::Context(); - $context->flags->set( - enterIntervals => "either", # or "standard" or "alternate" - displayIntervals => "either", # or "standard" or "alternate" - ); - $context->parens->set( - "[" => { close => "[", type => "Interval", formInterval => [ "]", ")" ], removable => 0 }, - "]" => { close => "]", type => "Interval", formInterval => "[" }, - ); - $context->update; - $context->{value}{Interval} = "context::AlternateIntervals::Interval"; - $context->{value}{Formula} = "context::AlternateIntervals::Formula"; - $context->{parser}{Formula} = "context::AlternateIntervals::Formula"; - $context->{parser}{List} = "context::AlternateIntervals::Parser::List"; - $context->lists->set("Interval" => { class => "context::AlternateIntervals::Parser::Interval" }); -} - -# -# Sets the default Interval context to use alternate decimals. The -# two arguments determine the values for the enterIntervals and -# displayIntervals flags. If enterIntervals is "alternate", then -# student answers must use the alternate format for entering -# intervals (though professors can use either). -# -sub Default { - my $self = shift; - my $enter = shift || "either"; - my $display = shift || "either"; - my $cmp = ($enter eq "alternate"); - $enter = "either" if $cmp; - # - # This adds the names from InequalitySetBuilder, but we need a better way to - # link into contexts as they are created and copied. - # - my @InequalitySetBuilder = ( - "SetBuilder::", "InequalitySetBuilder::", - "InequalitySetBuilderInterval::", "InequalitySetBuilderUnion::", - "InequalitySetBuilderSet::", - ); - foreach my $name ("Interval", "Full") { - my $context = $main::context{$name} = Parser::Context->getCopy($name); - $self->Enable($context); - $context->flags->set(enterIntervals => $enter, displayIntervals => $display); - if ($cmp) { - foreach my $class ((grep {/::/} (keys %Value::)), @InequalitySetBuilder) { - $context->{cmpDefaults}{ substr($class, 0, -2) }{enterIntervals} = "alternate"; - } - } - } - main::Context(main::Context()->{name}); -} - -########################################################################## - -package context::AlternateIntervals::Formula; -our @ISA = ('Value::Formula'); - -# -# Replace the standard Open with one that handles formInterval better. -# We need to handle several possible close delimiters. -# -sub Open { - my $self = shift; - my $type = shift; - my $paren = $self->{context}{parens}{$type}; - if ($self->state eq 'operand') { - if ($type eq $paren->{close}) { - my $stack = $self->{stack}; - my $i = scalar(@{$stack}) - 1; - while ($i >= 0 && $stack->[$i]{type} ne "open") { $i-- } - if ($i >= 0 && $stack->[$i]{close}{$type}) { - $self->Close($type, $self->{ref}); - return; - } - } - $self->ImplicitMult(); - } - my $item = { type => 'open', value => $type, ref => $self->{ref}, close => {} }; - if ($paren->{formInterval}) { - my $close = $paren->{formInterval}; - $close = [$close] unless ref($close) eq 'ARRAY'; - $item->{close} = { map { $_ => 1 } @$close }; - } - $item->{close}{$type} = 1; - $self->push($item); -} - -# -# We need to modify the test for formInterval to NOT check the number -# of entries so that better error messages are produced, and to handle -# multiple close delimiters. These are both in teh "operand" branch, -# so do the original for all the choices, and copy that branch here, -# with our modifications. -# -sub Close { - my $self = shift; - my $type = shift; - my $ref = $self->{ref} = shift; - my $parens = $self->{context}{parens}; - - return $self->SUPER::Close($type, $ref, @_) if $self->state ne "operand"; - - $self->Precedence(-1); - return if ($self->{error}); - if ($self->state ne 'operand') { $self->Close($type, $ref); return } - my $paren = $parens->{ $self->prev->{value} }; - if ($paren->{close} eq $type) { - my $top = $self->pop; - if (!$paren->{removable} || ($top->{value}->type eq "Comma")) { - $top = $top->{value}; - $top = { - type => 'operand', - value => $self->Item("List")->new( - $self, [ $top->makeList ], - $top->{isConstant}, $paren, - ($top->type eq 'Comma') ? $top->entryType : $top->typeRef, - ($type ne 'start') ? ($self->top->{value}, $type) : () - ) - }; - } else { - $top->{value}{hadParens} = 1; - } - $self->pop; - $self->push($top); - $self->CloseFn() if ($paren->{function} && $self->prev->{type} eq 'fn'); - } else { - my $close = $paren->{formInterval} || []; - $close = [$close] unless ref($close) eq 'ARRAY'; - $close = { map { $_ => 1 } @$close }; - if ($close->{$type}) { - my $top = $self->pop->{value}; - my $open = $self->pop->{value}; - $self->pushOperand($self->Item("List") - ->new($self, [ $top->makeList ], $top->{isConstant}, $paren, $top->entryType, $open, $type)); - } else { - my $prev = $self->prev; - if ($type eq "start") { - $self->Error([ "Missing close parenthesis for '%s'", $prev->{value} ], $prev->{ref}); - } elsif ($prev->{value} eq "start") { - $self->Error([ "Extra close parenthesis '%s'", $type ], $ref); - } else { - $self->Error([ "Mismatched parentheses: '%s' and '%s'", $prev->{value}, $type ], $ref); - } - } - } -} - -sub class {'Formula'} - -########################################################################## - -package context::AlternateIntervals::Interval; -our @ISA = ('Value::Interval'); - -# -# Convert alternative form to regular form, but mark it as alternative. -# Give error messages about forms that aren't allowed by the context flags. -# -sub new { - my $self = shift; - return $self->SUPER::new(@_) unless scalar(@_) == 5; - my @args = @_; - my $alternate; - my $format = $self->getFlag("enterIntervals"); - if ($args[1] eq "]") { $alternate = 1; $args[1] = "(" } - if ($args[4] eq "[") { $alternate = 1; $args[4] = ")" } - Value->Error("You must use parentheses to form open intervals") - if $alternate && $format eq "standard"; - Value->Error("You must use reversed brackets to form open intervals") - if ($_[1] eq "(" || $_[4] eq ")") && $format eq "alternate"; - $self->SUPER::new(@args)->with(alternateForm => $alternate); -} - -# -# For alternative form, switch back to the alternative brackets for printing, -# or force standard or alternative form based on the context flags. -# -sub formatOutput { - my $self = shift; - my $method = shift; - my @args = @_; - my $format = $self->getFlag("displayIntervals"); - my $alternate = ($self->{alternateForm} || $format eq "alternate") && $format ne "standard"; - $args[1] = "]" if $alternate && ($args[1] || $self->{open}) eq "("; - $args[2] = "[" if $alternate && ($args[2] || $self->{close}) eq ")"; - $method = "SUPER::$method"; - $self->$method(@args); -} - -sub string { - my $self = shift; - $self->formatOutput("string", @_); -} - -sub TeX { - my $self = shift; - $self->formatOutput("TeX", @_); -} - -# -# This gets called directly, so pass it up the line -# -sub cmp_defaults { shift->SUPER::cmp_defaults(@_) } - -########################################################################## - -package context::AlternateIntervals::Parser::List; -our @ISA = ('Parser::List'); - -# -# Make sure that the standard open and close delimiters are -# used so that comparisons and so on will work properly. -# -sub new { - my $self = shift; - my $alternate = ($_[5] eq "]" || $_[6] eq "["); - my $list = $self->SUPER::new(@_); - return $list unless $alternate && $list->type eq "Interval"; - my $L = ($list->class eq "Value" ? $list->{value} : $list); - $L->{open} = "(" if $L->{open} eq "]"; - $L->{close} = ")" if $L->{close} eq "["; - $L->{alternateForm} = 1; - return $list; -} - -sub class {"List"} - -########################################################################## - -package context::AlternateIntervals::Parser::Interval; -our @ISA = ('Parser::List::Interval'); - -# -# Report errors when invalid form is specified -# -sub _check { - my $self = shift; - my $context = $self->context; - my $format = (($context->{answerHash} || {})->{enterIntervals} || $context->flag("enterIntervals")); - $self->Error("You must use parentheses to form open intervals") - if $format eq "standard" && ($self->{open} eq "]" || $self->{close} eq "["); - $self->Error("You must use reversed brackets to form open intervals") - if $format eq "alternate" && ($self->{open} eq "(" || $self->{close} eq ")"); - $self->SUPER::_check(@_); -} - -# -# Make a copy with the alternate delimiters, if needed. -# -sub fixDelimiters { - my $self = shift; - my $alternate = shift; - if ($alternate) { - $self = $self->copy; - $self->{open} = "]" if $self->{open} eq "("; - $self->{close} = "[" if $self->{close} eq ")"; - } - $self; -} - -# -# Override the output methods to replace the alternate delimiters, -# when needed. -# - -sub _eval { - my $self = shift; - return $self->fixDelimiters($self->{alternateForm})->SUPER::_eval(@_); -} - -sub string { - my $self = shift; - my $format = $self->{equation}{context}->flag("displayIntervals"); - my $alternate = - $self->type eq "Interval" - && ($self->{alternateForm} || $format eq "alternate") - && $format ne "standard"; - $self->fixDelimiters($alternate)->SUPER::string(@_); -} - -sub TeX { - my $self = shift; - my $format = $self->{equation}{context}->flag("displayIntervals"); - my $alternate = - $self->type eq "Interval" - && ($self->{alternateForm} || $format eq "alternate") - && $format ne "standard"; - $self->fixDelimiters($alternate)->SUPER::TeX(@_); -} - -sub class {"Interval"} - -########################################################################## - -1; 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/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..3564f54476 --- /dev/null +++ b/macros/contexts/contextFiniteSolutionSets.pl @@ -0,0 +1,337 @@ +################################################################################ +# 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 100755 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 100755 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..c771e5f8d4 --- /dev/null +++ b/macros/contexts/contextLimitedRadicalComplex.pl @@ -0,0 +1,179 @@ + +=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}, $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 100755 index 0000000000..2a182fc825 --- /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/contextTypeset.pl b/macros/contexts/contextTypeset.pl similarity index 99% rename from macros/contextTypeset.pl rename to macros/contexts/contextTypeset.pl index 8991b5290f..e6c242aa84 100644 --- a/macros/contextTypeset.pl +++ b/macros/contexts/contextTypeset.pl @@ -235,8 +235,8 @@ sub _check { foreach my $r (@rows) { $r = ($r->class eq 'List' ? $r->{coords} : [$r]); while (scalar(@{$r}) < $c) { push(@{$r}, $null) } - $r = - bless $context->{parser}{List} + $r = bless + $context->{parser}{List} ->new($equation, $r, 0, $context->{parens}{start}, $Value::Type{number}, '[', ']'), $context->{lists}{Matrix}{class}; } 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 99% rename from macros/PGML.pl rename to macros/core/PGML.pl index 1859dd3828..38c6a96a6f 100644 --- a/macros/PGML.pl +++ b/macros/core/PGML.pl @@ -391,9 +391,8 @@ sub Emphasis { } if ($self->nextChar(' ') !~ m/\s/ && $self->prevChar(' ') !~ m/[a-z0-9]/i) { $self->Begin($token, substr($token, 0, 1)); - } else { - $self->Text($token); } + else { $self->Text($token) } } sub Star { 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/core/PGbasicmacros.pl b/macros/core/PGbasicmacros.pl new file mode 100644 index 0000000000..e5148752ea --- /dev/null +++ b/macros/core/PGbasicmacros.pl @@ -0,0 +1,3227 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# 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 + + PGbasicmacros.pl --- located in the courseScripts directory + +=head1 SYNPOSIS + +=head1 DESCRIPTION + +=cut + +#####sub _PGbasicmacros_init { } +### In this file the _init subroutine is defined further down +### It actually initializes something! + +# this is equivalent to use strict, but can be used within the Safe compartment + +BEGIN { + be_strict; +} + +my $displayMode; + +my ( + $PAR, $BR, $BRBR, $LQ, $RQ, + $BM, $EM, $BDM, $EDM, $LTS, + $GTS, $LTE, $GTE, $BEGIN_ONE_COLUMN, $END_ONE_COLUMN, + $SOL, $SOLUTION, $HINT, $COMMENT, $US, + $SPACE, $NBSP, $NDASH, $MDASH, $BLABEL, + $ELABEL, $BBOLD, $EBOLD, $BITALIC, $EITALIC, + $BUL, $EUL, $BCENTER, $ECENTER, $BLTR, + $ELTR, $BKBD, $EKBD, $HR, $LBRACE, + $RBRACE, $LB, $RB, $DOLLAR, $PERCENT, + $CARET, $PI, $E, $LATEX, $TEX, + $APOS, @ALPHABET, $envir, $PG_random_generator, $inputs_ref, + $rh_sticky_answers, $r_ans_rule_count, +); + +our %envir; + +sub _PGbasicmacros_init { + # The big problem is that at compile time in the cached Safe compartment + # main:: has one definition, probably Safe::Root1:: + # At runtime main has another definition Safe::Rootx:: where x is > 1 + + # It is important to + # initialize the my variable version of $displayMode from the "runtime" version + # of main::displayMode + + $displayMode = main::PG_restricted_eval(q!$main::displayMode!); + + # This is initializes the remaining variables in the runtime main:: compartment. + + main::PG_restricted_eval( <<'EndOfFile'); + $displayMode = $displayMode; + + $main::PAR = PAR(); + $main::BR = BR(); + $main::BRBR = BRBR(); + $main::LQ = LQ(); + $main::RQ = RQ(); + $main::BM = BM(); + $main::EM = EM(); + $main::BDM = BDM(); + $main::EDM = EDM(); + $main::LTS = LTS(); + $main::GTS = GTS(); + $main::LTE = LTE(); + $main::GTE = GTE(); + $main::BEGIN_ONE_COLUMN = BEGIN_ONE_COLUMN(); + $main::END_ONE_COLUMN = END_ONE_COLUMN(); + $main::SOL = SOLUTION_HEADING(); + $main::SOLUTION = SOLUTION_HEADING(); + $main::HINT = HINT_HEADING(); + $main::US = US(); + $main::SPACE = SPACE(); + $main::NBSP = NBSP(); + $main::NDASH = NDASH(); + $main::MDASH = MDASH(); + $main::BLABEL = BLABEL(); + $main::ELABEL = ELABEL(); + $main::BBOLD = BBOLD(); + $main::EBOLD = EBOLD(); + $main::BITALIC = BITALIC(); + $main::EITALIC = EITALIC(); + $main::BUL = BUL(); + $main::EUL = EUL(); + $main::BCENTER = BCENTER(); + $main::ECENTER = ECENTER(); + $main::BLTR = BLTR(); + $main::ELTR = ELTR(); + $main::BKBD = BKBD(); + $main::EKBD = EKBD(); + $main::HR = HR(); + $main::LBRACE = LBRACE(); + $main::RBRACE = RBRACE(); + $main::LB = LB(); + $main::RB = RB(); + $main::DOLLAR = DOLLAR(); + $main::PERCENT = PERCENT(); + $main::CARET = CARET(); + $main::PI = PI(); + $main::E = E(); + $main::LATEX = LATEX(); + $main::TEX = TEX(); + $main::APOS = APOS(); + @main::ALPHABET = ('A'..'ZZ'); + %main::STICKY_ANSWERS = (); + +EndOfFile + + # Next we transfer the correct definitions in the main:: compartment to the local my variables + # This can't be done inside the eval above because my variables seem to be invisible inside the eval + + $PAR = PAR(); + $BR = BR(); + $BRBR = BRBR(); + $LQ = LQ(); + $RQ = RQ(); + $BM = BM(); + $EM = EM(); + $BDM = BDM(); + $EDM = EDM(); + $LTS = LTS(); + $GTS = GTS(); + $LTE = LTE(); + $GTE = GTE(); + $BEGIN_ONE_COLUMN = BEGIN_ONE_COLUMN(); + $END_ONE_COLUMN = END_ONE_COLUMN(); + $SOL = SOLUTION_HEADING(); + $SOLUTION = SOLUTION_HEADING(); + $HINT = HINT_HEADING(); + $US = US(); + $SPACE = SPACE(); + $NBSP = NBSP(); + $NDASH = NDASH(); + $MDASH = MDASH(); + $BLABEL = BLABEL(); + $ELABEL = ELABEL(); + $BBOLD = BBOLD(); + $EBOLD = EBOLD(); + $BITALIC = BITALIC(); + $EITALIC = EITALIC(); + $BUL = BUL(); + $EUL = EUL(); + $BCENTER = BCENTER(); + $ECENTER = ECENTER(); + $BLTR = BLTR(); + $ELTR = ELTR(); + $BKBD = BKBD(); + $EKBD = EKBD(); + $HR = HR(); + $LBRACE = LBRACE(); + $RBRACE = RBRACE(); + $LB = LB(); + $RB = RB(); + $DOLLAR = DOLLAR(); + $PERCENT = PERCENT(); + $CARET = CARET(); + $PI = PI(); + $E = E(); + $LATEX = LATEX(); + $TEX = TEX(); + $APOS = APOS(); + @ALPHABET = ('A' .. 'ZZ'); + + $envir = PG_restricted_eval(q!\%main::envir!); + $PG_random_generator = PG_restricted_eval(q!$main::PG_random_generator!); + $inputs_ref = $envir{inputs_ref}; + $rh_sticky_answers = PG_restricted_eval(q!\%main::STICKY_ANSWERS!); + $r_ans_rule_count = PG_restricted_eval(q!\$ans_rule_count!); +} + +=head2 Answer blank macros: + +These produce answer blanks of various sizes or pop up lists or radio answer buttons. +The names for the answer blanks are +generated implicitly. + + ans_rule( width ) + tex_ans_rule( width ) + ans_radio_buttons(value1 => label1, value2, label2 => value3, label3 => ...) + pop_up_list(@list) # list consists of (value => label, PR => "Product rule", ...) + pop_up_list([@list]) # list consists of values + +In the last case, one can use C to produce a +pop-up list containing the three strings listed, and then use str_cmp to check +the answer. + +To indicate the checked position of radio buttons put a '%' in front of the value: C +will have 'No' checked. C works inside math equations in C mode. It does not work in C mode since this mode produces gif pictures. + +The following method is defined in F for entering the answer evaluators corresponding +to answer rules with automatically generated names. The answer evaluators are matched with the +answer rules in the order in which they appear on the page. + + ANS(ans_evaluator1, ans_evaluator2, ...); + +These are more primitive macros which produce answer blanks for specialized cases when complete +control over the matching of answers blanks and answer evaluators is desired. +The names of the answer blanks must be generated manually, and it is best if they do NOT begin +with the default answer prefix (currently AnSwEr). + + labeled_ans_rule(name, width) # an alias for NAMED_ANS_RULE where width defaults to 20 if omitted. + + NAMED_ANS_RULE(name, width) + NAMED_ANS_BOX(name, rows, cols) + NAMED_ANS_RADIO(name, value, label) + NAMED_ANS_RADIO_EXTENSION(name, value, label) + NAMED_ANS_RADIO_BUTTONS(name, value1, label1, value2, label2, ...) + check_box('-name' => answer5, '-value' => 'statement3', '-label' => 'I loved this course!') + NAMED_POP_UP_LIST($name, @list) # list consists of (value => tag, PR => "Product rule", ...) + NAMED_POP_UP_LIST($name, [@list]) # list consists of a list of values (and each tag will be set to the corresponding value) + +(Name is the name of the variable, value is the value given to the variable when this option is selected, +and label is the text printed next to the button or check box. Check box variables can have multiple values.) + +NAMED_ANS_RADIO_BUTTONS creates a sequence of NAMED_ANS_RADIO and NAMED_ANS_RADIO_EXTENSION items which +are output either as an array or, in scalar context, as the array glued together with spaces. It is +usually easier to use this than to manually construct the radio buttons by hand. However, sometimes + extra flexibility is desiredin which case: + +When entering radio buttons using the "NAMED" format, you should use NAMED_ANS_RADIO button for the first button +and then use NAMED_ANS_RADIO_EXTENSION for the remaining buttons. NAMED_ANS_RADIO requires a matching answer evalutor, +while NAMED_ANS_RADIO_EXTENSION does not. The name used for NAMED_ANS_RADIO_EXTENSION should match the name +used for NAMED_ANS_RADIO (and the associated answer evaluator). + +The following method is defined in F for entering the answer evaluators corresponding +to answer rules with automatically generated names. The answer evaluators are matched with the +answer rules in the order in which they appear on the page. + + NAMED_ANS(name1 => ans_evaluator1, name2 => ans_evaluator2, ...); + +These auxiliary macros are defined in PG.pl + + NEW_ANS_NAME( ); # produces a new anonymous answer blank name by appending a number to the prefix (AnSwEr) + # and registers this name as an implicitly labeled answer + # Its use is paired with each answer evaluator being entered using ANS() + + ANS_NUM_TO_NAME(number); # prepends the prefix (AnSwEr) to the number, but does nothing else. + + RECORD_ANS_NAME( name ); # records the order in which the answer blank is rendered + # This is called by all of the constructs above, but must + # be called explicitly if an input blank is constructed explictly + # using HTML code. + +These are legacy macros: + + ANS_RULE( number, width ); # equivalent to NAMED_ANS_RULE( NEW_ANS_NAME( ), width) + ANS_BOX( question_number, height, width ); # equivalent to NAMED_ANS_BOX( NEW_ANS_NAME( ), height, width) + ANS_RADIO( question_number, value, tag ); # equivalent to NAMED_ANS_RADIO( NEW_ANS_NAME( ), value, tag) + ANS_RADIO_OPTION( question_number, value, tag ); # equivalent to NAMED_ANS_RADIO_EXTENSION( ANS_NUM_TO_NAME(number), value, tag) + +=cut + +sub labeled_ans_rule { # syntactic sugar for NAMED_ANS_RULE + my ($name, $col) = @_; + $col = 20 unless not_null($col); + NAMED_ANS_RULE($name, $col); +} + +sub NAMED_ANS_RULE { + my $name = shift; + my $col = shift; + my %options = @_; + $col = 20 unless not_null($col); + my $answer_value = ''; + $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); + + #FIXME -- code factoring needed + if ($answer_value =~ /\0/) { + my @answers = split("\0", $answer_value); + $answer_value = shift(@answers); # use up the first answer + $rh_sticky_answers->{$name} = \@answers; + # store the rest -- beacuse this stores to a main:: variable + # it must be evaluated at run time + $answer_value = '' unless defined($answer_value); + } elsif (ref($answer_value) eq 'ARRAY') { + my @answers = @{$answer_value}; + $answer_value = shift(@answers); # use up the first answer + $rh_sticky_answers->{$name} = \@answers; + # store the rest -- because this stores to a main:: variable + # it must be evaluated at run time + $answer_value = '' unless defined($answer_value); + } + + $answer_value =~ s/\s+/ /g; ## remove excessive whitespace from student answer + $name = RECORD_ANS_NAME($name, $answer_value); + $answer_value = encode_pg_and_html($answer_value); + my $previous_name = "previous_$name"; + $name = ($envir{use_opaque_prefix}) ? "%%IDPREFIX%%$name" : $name; + $previous_name = ($envir{use_opaque_prefix}) ? "%%IDPREFIX%%$previous_name" : $previous_name; + + my $label; + if (defined($options{aria_label})) { + $label = $options{aria_label}; + } else { + $label = generate_aria_label($name); + } + + my $tcol = $col / 2 > 3 ? $col / 2 : 3; ## get max + $tcol = $tcol < 40 ? $tcol : 40; ## get min + + MODES( + TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}", + Latex2HTML => qq!\\begin{rawhtml}\\end{rawhtml}!, + + # Note: codeshard is used in the css to identify input elements that come from pg + HTML => qq!! + . qq!!, + PTX => qq!! + ); +} + +sub NAMED_HIDDEN_ANS_RULE { + # this is used to hold information being passed into and out of applets + # -- preserves state -- identical to NAMED_ANS_RULE except input type "hidden" + my ($name, $col) = @_; + $col = 20 unless not_null($col); + my $answer_value = ''; + $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); + if ($answer_value =~ /\0/) { + my @answers = split("\0", $answer_value); + $answer_value = shift(@answers); # use up the first answer + $rh_sticky_answers->{$name} = \@answers; + # store the rest -- beacuse this stores to a main:: variable + # it must be evaluated at run time + $answer_value = '' unless defined($answer_value); + } elsif (ref($answer_value) eq 'ARRAY') { + my @answers = @{$answer_value}; + $answer_value = shift(@answers); # use up the first answer + $rh_sticky_answers->{$name} = \@answers; + # store the rest -- beacuse this stores to a main:: variable + # it must be evaluated at run time + $answer_value = '' unless defined($answer_value); + } + + $answer_value =~ s/\s+/ /g; ## remove excessive whitespace from student answer + + $name = RECORD_ANS_NAME($name, $answer_value); + $answer_value = encode_pg_and_html($answer_value); + + my $tcol = $col / 2 > 3 ? $col / 2 : 3; ## get max + $tcol = $tcol < 40 ? $tcol : 40; ## get min + + MODES( + TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}", + Latex2HTML => qq!\\begin{rawhtml}\\end{rawhtml}!, + HTML => qq!! + . qq!!, + PTX => '', + ); +} + +sub NAMED_ANS_RULE_OPTION { # deprecated + &NAMED_ANS_RULE_EXTENSION; +} + +sub NAMED_ANS_RULE_EXTENSION { + my $name = shift; # this is the name of the response item + my $col = shift; + my %options = @_; + + my $label; + if (defined($options{aria_label})) { + $label = $options{aria_label}; + } else { + $label = generate_aria_label($name); + } + # $answer_group_name is the name of the parent answer group + # the group name is usually the same as the answer blank name + # when there is only one answer blank. + + my $answer_group_name = $options{answer_group_name} // ''; + unless ($answer_group_name) { + WARN_MESSAGE( + "Error in NAMED_ANSWER_RULE_EXTENSION: every call to this subroutine needs + to have \$options{answer_group_name} defined. For a single answer blank this is + usually the same as the answer blank name. Answer blank name: $name" + ); + } + # warn "from named answer rule extension in PGbasic answer_group_name: |$answer_group_name|"; + my $answer_value = ''; + $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); + if (defined($rh_sticky_answers->{$name})) { + $answer_value = shift(@{ $rh_sticky_answers->{$name} }); + $answer_value = '' unless defined($answer_value); + } + + $answer_value =~ s/\s+/ /g; ## remove excessive whitespace from student answer + # warn "from NAMED_ANSWER_RULE_EXTENSION in PGbasic: + # answer_group_name: |$answer_group_name| name: |$name| answer value: |$answer_value|"; + INSERT_RESPONSE($answer_group_name, $name, $answer_value) + ; #FIXME hack -- this needs more work to decide how to make it work + $answer_value = encode_pg_and_html($answer_value); + + my $tcol = $col / 2 > 3 ? $col / 2 : 3; ## get max + $tcol = $tcol < 40 ? $tcol : 40; ## get min + MODES( + TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}", + Latex2HTML => + qq!\\begin{rawhtml}\n\n\\end{rawhtml}\n!, + HTML => qq!! + . qq!!, + PTX => qq!!, + ); +} + +sub ANS_RULE { #deprecated + my ($number, $col) = @_; + my $name = NEW_ANS_NAME($number); + NAMED_ANS_RULE($name, $col); +} + +sub NAMED_ANS_BOX { + my $name = shift; + my $row = shift; + my $col = shift; + my %options = @_; + + $row = 10 unless defined($row); + $col = 80 unless defined($col); + + my $height = .07 * $row; + my $answer_value = ''; + $answer_value = $inputs_ref->{$name} if defined($inputs_ref->{$name}); + $name = RECORD_ANS_NAME($name, $answer_value); + my $label; + if (defined($options{aria_label})) { + $label = $options{aria_label}; + } else { + $label = generate_aria_label($name); + } + # try to escape HTML entities to deal with xss stuff + $answer_value = encode_pg_and_html($answer_value); + my $out = MODES( + TeX => qq!\\vskip $height in \\hrulefill\\quad !, + Latex2HTML => + qq!\\begin{rawhtml}\\end{rawhtml}!, + HTML => qq! + + !, + PTX => '', + ); + $out; +} + +sub ANS_BOX { #deprecated + my ($number, $row, $col) = @_; + my $name = NEW_ANS_NAME(); + NAMED_ANS_BOX($name, $row, $col); +} + +sub NAMED_ANS_RADIO { + my $name = shift; + my $value = shift; + my $tag = shift; + my $extend = shift; + my %options = @_; + + my $checked = ''; + if ($value =~ /^\%/) { + $value =~ s/^\%//; + $checked = 'CHECKED'; + } + if (defined($inputs_ref->{$name})) { + if ($inputs_ref->{$name} eq $value) { + $checked = 'CHECKED'; + } else { + $checked = ''; + } + + } + $name = RECORD_ANS_NAME($name, { $value => $checked }) unless $extend; + INSERT_RESPONSE($options{answer_group_name}, $name, { $value => $checked }) if $extend; + my $label = generate_aria_label($name); + $label .= "option 1 "; + MODES( + TeX => qq!\\item{$tag}\n!, + Latex2HTML => + qq!\\begin{rawhtml}\n\\end{rawhtml}$tag!, + HTML => + qq!!, + PTX => '

  • ' . "$tag" . '
    • ' . "\n", + ); + +} + +sub NAMED_ANS_RADIO_OPTION { #deprecated + &NAMED_ANS_RADIO_EXTENSION; +} + +sub NAMED_ANS_RADIO_EXTENSION { + my $name = shift; + my $value = shift; + my $tag = shift; + my %options = @_; + + my $checked = ''; + if ($value =~ /^\%/) { + $value =~ s/^\%//; + $checked = 'CHECKED'; + } + if (defined($inputs_ref->{$name})) { + if ($inputs_ref->{$name} eq $value) { + $checked = 'CHECKED'; + } else { + $checked = ''; + } + + } + EXTEND_RESPONSE($options{answer_group_name} // $name, $name, $value, $checked); + my $label; + if (defined($options{aria_label})) { + $label = $options{aria_label}; + } else { + $label = generate_aria_label($name); + } + + MODES( + TeX => qq!\\item{$tag}\n!, + Latex2HTML => + qq!\\begin{rawhtml}\n\\end{rawhtml}$tag!, + HTML => + qq!!, + PTX => '
  • ' . "$tag" . '
    • ' . "\n", + ); + +} + +sub NAMED_ANS_RADIO_BUTTONS { + my $name = shift; + my $value = shift; + my $tag = shift; + + my @out = (); + push(@out, NAMED_ANS_RADIO($name, $value, $tag)); + my @buttons = @_; + my $label = generate_aria_label($name); + my $count = 2; + while (@buttons) { + $value = shift @buttons; + $tag = shift @buttons; + push(@out, NAMED_ANS_RADIO_OPTION($name, $value, $tag, aria_label => $label . "option $count ")); + $count++; + } + (wantarray) ? @out : join(" ", @out); +} + +sub ANS_RADIO { + my $number = shift; + my $value = shift; + my $tag = shift; + my $name = NEW_ANS_NAME(); + NAMED_ANS_RADIO($name, $value, $tag); +} + +sub ANS_RADIO_OPTION { + my $number = shift; + my $value = shift; + my $tag = shift; + my $name = ANS_NUM_TO_NAME($number); + NAMED_ANS_RADIO_OPTION($name, $value, $tag); +} + +sub ANS_RADIO_BUTTONS { + my $number = shift; + my $value = shift; + my $tag = shift; + + my @out = (); + push(@out, ANS_RADIO($number, $value, $tag)); + my @buttons = @_; + while (@buttons) { + $value = shift @buttons; + $tag = shift @buttons; + push(@out, ANS_RADIO_OPTION($number, $value, $tag)); + } + (wantarray) ? @out : join(" ", @out); +} + +############################################## +# generate_aria_label( $name ) +# takes the name of an ANS_RULE or ANS_BOX and generates an appropriate +# aria label for screen readers +############################################## + +sub generate_aria_label { + my $name = shift; + my $label = ''; + + # if we dont have an AnSwEr type name then we do the best we can + if ($name !~ /AnSwEr/) { + return maketext('answer') . ' ' . $name; + } + + # check for quiz prefix + if ($name =~ /^Q\d+/ || $name =~ /^MaTrIx_Q\d+/) { + $name =~ s/Q0*(\d+)_//; + $label .= maketext('problem') . ' ' . $1 . ' '; + } + + # get answer number + $name =~ /AnSwEr0*(\d+)/; + $label .= maketext('answer') . ' ' . $1 . ' '; + + # check for Multianswer + if ($name =~ /MuLtIaNsWeR_/) { + $name =~ s/MuLtIaNsWeR_//; + $name =~ /AnSwEr(\d+)_(\d+)/; + $label .= maketext('part') . ' ' . ($2 + 1) . ' '; + } + + # check for Matrix + if ($name =~ /^MaTrIx_/) { + $name =~ /_(\d+)_(\d+)$/; + $label .= maketext('row') . ' ' . ($1 + 1) . ' ' . maketext('column') . ' ' . ($2 + 1) . ' '; + } + + return $label; +} + +############################################## +# contained_in( $elem, $array_reference or null separated string); +# determine whether element is equal +# ( in the sense of eq, not ==, ) to an element in the array. +############################################## +sub contained_in { + my $element = shift; + my @input_list = @_; + my @output_list = (); + # Expand the list -- convert references to arrays to arrays + # Convert null separated strings to arrays + foreach my $item (@input_list) { + if ($item =~ /\0/) { + push @output_list, split('\0', $item); + } elsif (ref($item) =~ /ARRAY/) { + push @output_list, @{$item}; + } else { + push @output_list, $item; + } + } + + my @match_list = grep { $element eq $_ } @output_list; + if (@match_list) { + return 1; + } else { + return 0; + } +} + +########################## +# If multiple boxes are checked then the $inputs_ref->{name }will be a null separated string +# or a reference to an array. +########################## + +sub NAMED_ANS_CHECKBOX { + my $name = shift; + my $value = shift; + my $tag = shift; + + my $checked = ''; + if ($value =~ /^\%/) { + $value =~ s/^\%//; + $checked = 'CHECKED'; + } + + if (defined($inputs_ref->{$name})) { + if (contained_in($value, $inputs_ref->{$name})) { + $checked = 'CHECKED'; + } else { + $checked = ''; + } + + } + $name = RECORD_ANS_NAME($name, { $value => $checked }); + my $label = generate_aria_label($name); + $label .= "option 1 "; + + MODES( + TeX => qq!\\item{$tag}\n!, + Latex2HTML => + qq!\\begin{rawhtml}\n\\end{rawhtml}$tag!, + HTML => + qq!!, + PTX => '
  • ' . "$tag" . '
    • ' . "\n", + ); + +} + +sub NAMED_ANS_CHECKBOX_OPTION { + my $name = shift; + my $value = shift; + my $tag = shift; + my %options = @_; + + my $checked = ''; + if ($value =~ /^\%/) { + $value =~ s/^\%//; + $checked = 'CHECKED'; + } + + if (defined($inputs_ref->{$name})) { + if (contained_in($value, $inputs_ref->{$name})) { + $checked = 'CHECKED'; + } else { + $checked = ''; + } + + } + EXTEND_RESPONSE($name, $name, $value, $checked); + my $label; + if (defined($options{aria_label})) { + $label = $options{aria_label}; + } else { + $label = generate_aria_label($name); + } + + MODES( + TeX => qq!\\item{$tag}\n!, + Latex2HTML => + qq!\\begin{rawhtml}\n\\end{rawhtml}$tag!, + HTML => + qq!!, + PTX => '
  • ' . "$tag" . '
    • ' . "\n", + ); + +} + +sub NAMED_ANS_CHECKBOX_BUTTONS { + my $name = shift; + my $value = shift; + my $tag = shift; + + my @out = (); + push(@out, NAMED_ANS_CHECKBOX($name, $value, $tag)); + my $label = generate_aria_label($name); + my $count = 2; + my @buttons = @_; + while (@buttons) { + $value = shift @buttons; + $tag = shift @buttons; + push(@out, NAMED_ANS_CHECKBOX_OPTION($name, $value, $tag, aria_label => $label . "option $count ")); + $count++; + } + + (wantarray) ? @out : join(" ", @out); +} + +sub ANS_CHECKBOX { + my $number = shift; + my $value = shift; + my $tag = shift; + my $name = NEW_ANS_NAME(); + + NAMED_ANS_CHECKBOX($name, $value, $tag); +} + +sub ANS_CHECKBOX_OPTION { + my $number = shift; + my $value = shift; + my $tag = shift; + my $name = ANS_NUM_TO_NAME($number); + + NAMED_ANS_CHECKBOX_OPTION($name, $value, $tag); +} + +sub ANS_CHECKBOX_BUTTONS { + my $number = shift; + my $value = shift; + my $tag = shift; + + my @out = (); + push(@out, ANS_CHECKBOX($number, $value, $tag)); + + my @buttons = @_; + while (@buttons) { + $value = shift @buttons; + $tag = shift @buttons; + push(@out, ANS_CHECKBOX_OPTION($number, $value, $tag)); + } + + (wantarray) ? @out : join(" ", @out); +} + +sub ans_rule { + my $len = shift; # gives the optional length of the answer blank + $len = 20 unless $len; + my $name = NEW_ANS_NAME(); # increment is done internally + NAMED_ANS_RULE($name, $len); +} + +sub ans_rule_extension { + my $len = shift; + $len = 20 unless $len; + # warn "ans_rule_extension may be misnumbering the answers"; + my $name = NEW_ANS_NAME($$r_ans_rule_count); # don't update the answer name + NAMED_ANS_RULE($name, $len); +} + +sub ans_radio_buttons { + my $name = NEW_ANS_NAME(); + my @radio_buttons = NAMED_ANS_RADIO_BUTTONS($name, @_); + + if ($displayMode eq 'TeX') { + $radio_buttons[0] = "\n\\begin{itemize}\n" . $radio_buttons[0]; + $radio_buttons[$#radio_buttons] .= "\n\\end{itemize}\n"; + } elsif ($displayMode eq 'PTX') { + $radio_buttons[0] = '' . "\n" . $radio_buttons[0]; + $radio_buttons[$#radio_buttons] .= ''; + } + + (wantarray) ? @radio_buttons : join(" ", @radio_buttons); +} + +#added 6/14/2000 by David Etlinger +sub ans_checkbox { + my $name = NEW_ANS_NAME(); + my @checkboxes = NAMED_ANS_CHECKBOX_BUTTONS($name, @_); + + if ($displayMode eq 'TeX') { + $checkboxes[0] = "\n\\begin{itemize}\n" . $checkboxes[0]; + $checkboxes[$#checkboxes] .= "\n\\end{itemize}\n"; + } elsif ($displayMode eq 'PTX') { + $checkboxes[0] = '' . "\n" . $checkboxes[0]; + $checkboxes[$#checkboxes] .= ''; + } + + (wantarray) ? @checkboxes : join(" ", @checkboxes); +} + +## define a version of ans_rule which will work inside TeX math mode or display math mode -- at least for tth mode. +## This is great for displayed fractions. +## This will not work with latex2HTML mode since it creates gif equations. + +sub tex_ans_rule { + my $len = shift; + $len = 20 unless $len; + my $name = NEW_ANS_NAME(); + my $answer_rule = NAMED_ANS_RULE($name, $len); # we don't want to create three answer rules in different modes. + my $out = MODES( + 'TeX' => $answer_rule, + 'Latex2HTML' => '\\fbox{Answer boxes cannot be placed inside typeset equations}', + 'HTML_tth' => '\\begin{rawhtml} ' . $answer_rule . '\\end{rawhtml}', + 'HTML_dpng' => '\\fbox{Answer boxes cannot be placed inside typeset equations}', + 'HTML' => $answer_rule, + 'PTX' => 'Answer boxes cannot be placed inside typeset equations', + ); + + $out; +} + +sub tex_ans_rule_extension { + my $len = shift; + $len = 20 unless $len; + # warn "tex_ans_rule_extension may be missnumbering the answer"; + my $name = NEW_ANS_NAME($$r_ans_rule_count); + my $answer_rule = NAMED_ANS_RULE($name, $len); # we don't want to create three answer rules in different modes. + my $out = MODES( + 'TeX' => $answer_rule, + 'Latex2HTML' => '\fbox{Answer boxes cannot be placed inside typeset equations}', + 'HTML_tth' => '\\begin{rawhtml} ' . $answer_rule . '\\end{rawhtml}', + 'HTML_dpng' => '\fbox{Answer boxes cannot be placed inside typeset equations}', + 'HTML' => $answer_rule, + 'PTX' => 'Answer boxes cannot be placed inside typeset equations', + ); + + $out; +} +# still needs some cleanup. +sub NAMED_TEX_ANS_RULE { + my $name = shift; + my $len = shift; + $len = 20 unless $len; + my $answer_rule = NAMED_ANS_RULE($name, $len); # we don't want to create three answer rules in different modes. + my $out = MODES( + 'TeX' => $answer_rule, + 'Latex2HTML' => '\\fbox{Answer boxes cannot be placed inside typeset equations}', + 'HTML_tth' => '\\begin{rawhtml} ' . $answer_rule . '\\end{rawhtml}', + 'HTML_dpng' => '\\fbox{Answer boxes cannot be placed inside typeset equations}', + 'HTML' => $answer_rule, + 'PTX' => 'Answer boxes cannot be placed inside typeset equations', + ); + + $out; +} + +sub NAMED_TEX_ANS_RULE_EXTENSION { + my $name = shift; + my $len = shift; + $len = 20 unless $len; + my $answer_rule = + NAMED_ANS_RULE_EXTENSION($name, $len); # we don't want to create three answer rules in different modes. + my $out = MODES( + 'TeX' => $answer_rule, + 'Latex2HTML' => '\fbox{Answer boxes cannot be placed inside typeset equations}', + 'HTML_tth' => '\\begin{rawhtml} ' . $answer_rule . '\\end{rawhtml}', + 'HTML_dpng' => '\fbox{Answer boxes cannot be placed inside typeset equations}', + 'HTML' => $answer_rule, + 'PTX' => 'Answer boxes cannot be placed inside typeset equations', + ); + + $out; +} + +sub ans_box { + my $row = shift; + my $col = shift; + $row = 5 unless $row; + $col = 80 unless $col; + my $name = NEW_ANS_NAME(); + NAMED_ANS_BOX($name, $row, $col); +} + +# this is legacy code; use ans_checkbox instead +sub checkbox { + my %options = @_; + qq!$options{'-label'}!; +} + +sub NAMED_POP_UP_LIST { + my $name = shift; + my @list = @_; + if (ref($list[0]) eq 'ARRAY') { + my @list1 = @{ $list[0] }; + @list = map { $_ => $_ } @list1; + } + my $moodle_prefix = ($envir{use_opaque_prefix}) ? "%%IDPREFIX%%" : ''; + + my $answer_value = ''; + $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); + my $out = ""; + if ($displayMode eq 'HTML_MathJax' + || $displayMode eq 'HTML_dpng' + || $displayMode eq 'HTML' + || $displayMode eq 'HTML_tth' + || $displayMode eq 'HTML_jsMath' + || $displayMode eq 'HTML_asciimath' + || $displayMode eq 'HTML_LaTeXMathML' + || $displayMode eq 'HTML_img') + { + $out = qq!\n"; + } elsif ($displayMode eq "Latex2HTML") { + $out = qq! \\begin{rawhtml}\\end{rawhtml}\n"; + } elsif ($displayMode eq "TeX") { + $out .= "\\fbox{?}"; + } elsif ($displayMode eq "PTX") { + $out = '' . "\n"; + my $i; + foreach ($i = 0; $i < @list; $i = $i + 2) { + $out .= '
  • ' . $list[ $i + 1 ] . '
    • ' . "\n"; + } + $out .= '    '; + } + $name = RECORD_ANS_NAME($name, $answer_value); # record answer name + $out; +} + +sub pop_up_list { + my @list = @_; + my $name = NEW_ANS_NAME(); # get new answer name + NAMED_POP_UP_LIST($name, @list); +} + +=head2 answer_matrix + + Usage \[ \{ answer_matrix(rows, columns, width_of_ans_rule, @options) \} \] + + Creates an array of answer blanks and passes it to display_matrix which returns + text which represents the matrix in TeX format used in math display mode. Answers + are then passed back to whatever answer evaluators you write at the end of the problem. + (note, if you have an m x n matrix, you will need mn answer evaluators, and they will be + returned to the evaluaters starting in the top left hand corner and proceed to the left + and then at the end moving down one row, just as you would read them.) + + The options are passed on to display_matrix. + + Note (7/21/2017) The above usage does not work. Omitting the \[ \] works, but also must + load PGmatrixmacros.pl to get display_matrix used below + +=cut + +sub answer_matrix { + my $m = shift; + my $n = shift; + my $width = shift; + my @options = @_; + my @array = (); + for (my $i = 0; $i < $m; $i += 1) { + my @row_array = (); + + for (my $i = 0; $i < $n; $i += 1) { + push @row_array, ans_rule($width); + } + my $r_row_array = \@row_array; + push @array, $r_row_array; + } + # display_matrix hasn't been loaded into the cache safe compartment + # so we need to refer to the subroutine in this way to make + # sure that main is defined correctly. + my $ra_local_display_matrix = PG_restricted_eval(q!\&main::display_matrix!); + &$ra_local_display_matrix(\@array, @options); +} + +sub NAMED_ANS_ARRAY_EXTENSION { + my $name = shift; + my $col = shift; + my %options = @_; + $col = 20 unless $col; + my $answer_value = ''; + + $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); + if ($answer_value =~ /\0/) { + my @answers = split("\0", $answer_value); + $answer_value = shift(@answers); + $answer_value = '' unless defined($answer_value); + } elsif (ref($answer_value) eq 'ARRAY') { + my @answers = @{$answer_value}; + $answer_value = shift(@answers); + $answer_value = '' unless defined($answer_value); + } + + my $label; + if (defined($options{aria_label})) { + $label = $options{aria_label}; + } else { + $label = generate_aria_label($name); + } + + # warn "ans_label $options{ans_label} $name $answer_value"; + my $answer_group_name; # the name of the answer evaluator controlling this collection of responses. + # catch deprecated use of ans_label to pass answer_group_name + if (defined($options{ans_label})) { + WARN_MESSAGE( + "Error in NAMED_ANS_ARRAY_EXTENSION: the answer group name should be passed in ", + "\%options using answer_group_name=>\$answer_group_name", + "The use of ans_label=>\$answer_group_name is deprecated.", + "Answer blank name: $name" + ); + $answer_group_name = $options{ans_label}; + } + if (defined($options{answer_group_name})) { + $answer_group_name = $options{answer_group_name}; + } + if ($answer_group_name) { + INSERT_RESPONSE($options{answer_group_name}, $name, $answer_value); + } else { + WARN_MESSAGE("Error: answer_group_name must be defined for $name"); + } + $answer_value = encode_pg_and_html($answer_value); + + MODES( + TeX => "\\mbox{\\parbox[t]{10pt}{\\hrulefill}}\\hrulefill\\quad ", + Latex2HTML => + qq!\\begin{rawhtml}\n\n\\end{rawhtml}\n!, + HTML => qq!!, + PTX => qq!!, + ); +} + +sub ans_array { + my $m = shift; + my $n = shift; + my $col = shift; + $col = 20 unless $col; + my $ans_label = NEW_ANS_NAME(); + my $num = ans_rule_count(); + my @options = @_; + my @array = (); + my $answer_value = ""; + my @response_list = (); + my $name; + $main::vecnum = -1; + CLEAR_RESPONSES($ans_label); + + for (my $i = 0; $i < $n; $i += 1) { + $name = NEW_ANS_ARRAY_NAME_EXTENSION($num, 0, $i); + $array[0][$i] = NAMED_ANS_ARRAY_EXTENSION($name, $col, ans_label => $ans_label); + } + + for (my $j = 1; $j < $m; $j += 1) { + for (my $i = 0; $i < $n; $i += 1) { + $name = NEW_ANS_ARRAY_NAME_EXTENSION($num, $j, $i); + $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name, $col, ans_label => $ans_label); + } + } + my $ra_local_display_matrix = PG_restricted_eval(q!\&main::display_matrix!); + &$ra_local_display_matrix(\@array, @options); +} + +sub ans_array_extension { + my $m = shift; + my $n = shift; + my $col = shift; + $col = 20 unless $col; + my $num = ans_rule_count(); #hack -- ans_rule_count is updated after being used + my @options = @_; + my @response_list = (); + my $name; + my @array = (); + my $ans_label = $main::PG->new_label($num); + + for (my $j = 0; $j < $m; $j += 1) { + for (my $i = 0; $i < $n; $i += 1) { + $name = NEW_ANS_ARRAY_NAME_EXTENSION($num, $j, $i); + $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name, $col, answer_group_name => $ans_label, @options); + } + } + my $ra_local_display_matrix = PG_restricted_eval(q!\&main::display_matrix!); + &$ra_local_display_matrix(\@array, @options); +} + +# end answer blank macros + +=head2 Hints, solutions, and statement macros + + solution('text', 'text2', ...); + SOLUTION('text', 'text2', ...); # equivalent to TEXT(solution(...)); + + hint('text', 'text2', ...); + HINT('text', 'text2', ...); # equivalent to TEXT("$BR$HINT" . hint(@_) . "$BR") if hint(@_); + + statement('text'); + STATEMENT('text'); # equivalent to TEXT(statement(...)); + +statement takes a string, probably from EV3P, and possibly wraps opening and closing +content, paralleling one feature of solution and hint. + +If $envir{showSolutions} is set to 1 then the solution is displayed. + +If $envir{showHints} is set to 1 then the hint is displayed. + +=cut + +# $main::solutionExists is passed to processProblem which displays a "show Solution" button +# when a solution is available for viewing + +sub escapeSolutionHTML { + my $str = join('', @_); + $str = $main::PG->encode_base64($str); + $str; +} + +sub solution { + my @in = @_; + $main::solutionExists = 1; + return $envir->{showSolutions} ? join('', @in) : ''; +} + +sub SOLUTION { + my $solution_body = solution(@_); + return "" if $solution_body eq ""; + + if ($displayMode =~ /HTML/) { + TEXT($PAR, knowlLink(SOLUTION_HEADING(), value => $solution_body, type => 'solution')); + } elsif ($displayMode =~ /TeX/) { + TEXT( + "\n%%% BEGIN SOLUTION\n" + , #Marker used in PreTeXt LaTeX extraction; contact alex.jordan@pcc.edu before modifying + "\\par\\smallskip", SOLUTION_HEADING(), $solution_body, "\\par\\medskip", + "\n%%% END SOLUTION\n" #Marker used in PreTeXt LaTeX extraction; contact alex.jordan@pcc.edu before modifying + ); + } elsif ($displayMode =~ /PTX/) { + TEXT('', "\n", $solution_body, "\n", '', "\n\n"); + } else { + TEXT($PAR, $solution_body, $PAR); + } +} + +sub hint { + my @in = @_; + $main::hintExists = 1; + return $envir->{showHints} ? join('', @in) : ''; +} + +sub HINT { + my $hint_body = hint(@_); + return unless $hint_body; + if ($displayMode =~ /HTML/) { + TEXT($PAR, knowlLink(HINT_HEADING(), value => $hint_body, type => 'hint')); + } elsif ($displayMode =~ /TeX/) { + TEXT( + "\n%%% BEGIN HINT\n" + , #Marker used in PreTeXt LaTeX extraction; contact alex.jordan@pcc.edu before modifying + "\\par\\smallskip", HINT_HEADING(), $hint_body, "\\par\\medskip", + "\n%%% END HINT\n" #Marker used in PreTeXt LaTeX extraction; contact alex.jordan@pcc.edu before modifying + ); + } elsif ($displayMode =~ /PTX/) { + TEXT('', "\n", $hint_body, "\n", '', "\n\n"); + } else { + TEXT($PAR, HINT_HEADING(), $BR . $hint_body . $PAR); + } +} + +sub statement { + my @in = @_; + my $out = join(' ', @in); + $out; +} + +sub STATEMENT { + if ($displayMode eq 'PTX') { TEXT('', "\n", statement(@_), "\n", '', "\n"); } + else { TEXT(statement(@_)) } +} + +# End hints and solutions and statement macros +################################# + +=head2 Comments to instructors + + COMMENT('text', 'text2', ...); + +Takes the text to be lines of a comment to be shown only +in the Library Browser below the rendered problem. + +The function COMMENT stores the needed html in the variable +pgComment, which gets transfered to the flag 'comment' in PG_FLAGS. + +=cut + +# Add a comment which will display in the Library browser +# Currently, the only output is html + +sub COMMENT { + my @in = @_; + my $out = join("$BR", @in); + $out = '
    ' . $out . '
    '; + PG_restricted_eval(q!$main::pgComment .= "! . $out . q!"!); + return (''); +} + +################################# +# Produces a random number between $begin and $end with increment 1. +# You do not have to worry about integer or floating point types. + +=head2 Pseudo-random number generator + + Usage: + random(0, 5, .1) # produces a random number between 0 and 5 in increments of .1 + non_zero_random(0, 5, .1) # gives a non-zero random number + + list_random(2, 3, 5, 6, 7, 8, 10) # produces random value from the list + list_random(2, 3, (5..8), 10) # does the same thing + + SRAND(seed) # resets the main random generator -- use very cautiously + +SRAND(time) will create a different problem everytime it is called. This makes it difficult +to check the answers :-). + +SRAND($envir->{'inputs_ref'}->{'key'} ) will create a different problem for each login session. +This is probably what is desired. + +=cut + +sub random { + my ($begin, $end, $incr) = @_; + $PG_random_generator->random($begin, $end, $incr); +} + +sub non_zero_random { ##gives a non-zero random number + my (@arguments) = @_; + my $a = 0; + my $i = 100; #safety counter + while ($a == 0 && (0 < $i--)) { + $a = random(@arguments); + } + $a; +} + +sub list_random { + my @li = @_; + return $li[ random(1, scalar(@li)) - 1 ]; +} + +sub SRAND { # resets the main random generator -- use cautiously + my $seed = shift; + $PG_random_generator->srand($seed); +} + +# display macros + +=head2 Display Macros + +These macros produce different output depending on the display mode being used to show +the problem on the screen, or whether the problem is being converted to TeX to produce +a hard copy output. + + MODES ( TeX => "Output this in TeX mode", + HTML => "output this in HTML mode", + HTML_tth => "output this in HTML_tth mode", + HTML_dpng => "output this in HTML_dpng mode", + Latex2HTML => "output this in Latex2HTML mode", + ) + + M3 (tex_version, latex2html_version, html_version) #obsolete + +=cut + +sub M3 { + my ($tex, $l2h, $html) = @_; + MODES(TeX => $tex, Latex2HTML => $l2h, HTML => $html, HTML_tth => $html, HTML_dpng => $html); +} + +# MODES() is now table driven +our %DISPLAY_MODE_FAILOVER = ( + TeX => [], + HTML => [], + PTX => ["HTML"], + HTML_tth => [ "HTML", ], + HTML_dpng => [ "HTML_tth", "HTML", ], + HTML_jsMath => [ "HTML_dpng", "HTML_tth", "HTML", ], + HTML_MathJax => [ "HTML_dpng", "HTML_tth", "HTML", ], + HTML_asciimath => [ "HTML_dpng", "HTML_tth", "HTML", ], + HTML_LaTeXMathML => [ "HTML_dpng", "HTML_tth", "HTML", ], + # legacy modes -- these are not supported, but some problems might try to + # set the display mode to one of these values manually and some macros may + # provide rendered versions for these modes but not the one we want. + Latex2HTML => [ "TeX", "HTML", ], + HTML_img => [ "HTML_dpng", "HTML_tth", "HTML", ], +); + +# This replaces M3. You can add new modes at will to this one. +sub MODES { + my %options = @_; + + # is a string supplied for the current display mode? if so, return it + return $options{$main::displayMode} if defined $options{$main::displayMode}; + + # otherwise, fail over to backup modes + my @backup_modes; + if (exists $DISPLAY_MODE_FAILOVER{$main::displayMode}) { + @backup_modes = @{ $DISPLAY_MODE_FAILOVER{$main::displayMode} }; + foreach my $mode (@backup_modes) { + return $options{$mode} if defined $options{$mode}; + } + } + warn "ERROR in defining MODES: neither display mode '$main::displayMode' nor", + " any fallback modes (", join(", ", @backup_modes), ") supplied."; +} + +# end display macros + +=head2 Display constants + + @ALPHABET ALPHABET() capital letter alphabet -- ALPHABET[0] = 'A' + $PAR PAR() paragraph character (\par or

    ) + $BR BR() line break character + $BRBR BRBR() line break character + $LQ LQ() left double quote + $RQ RQ() right double quote + $BM BM() begin math + $EM EM() end math + $BDM BDM() begin display math + $EDM EDM() end display math + $LTS LTS() strictly less than + $GTS GTS() strictly greater than + $LTE LTE() less than or equal + $GTE GTE() greater than or equal + $BEGIN_ONE_COLUMN BEGIN_ONE_COLUMN() begin one-column mode + $END_ONE_COLUMN END_ONE_COLUMN() end one-column mode + $SOL SOLUTION_HEADING() solution headline + $SOLUTION SOLUTION_HEADING() solution headline + $HINT HINT_HEADING() hint headline + $US US() underscore character + $SPACE SPACE() space character (tex and latex only) + $NBSP NBSP() non breaking space character + $NDASH NDASH() en dash character + $MDASH MDASH() em dash character + $BLABEL BLABEL() begin label (for input) + $ELABEL ELABEL() end label (for input) + $BBOLD BBOLD() begin bold typeface + $EBOLD EBOLD() end bold typeface + $BITALIC BITALIC() begin italic typeface + $EITALIC EITALIC() end italic typeface + $BUL BUL() begin underlined type + $EUL EUL() end underlined type + $BCENTER BCENTER() begin centered environment + $ECENTER ECENTER() end centered environment + $BLTR BLTR() begin left to right environment + $ELTR ELTR() end left to right environment + $BKBD BKBD() begin "keyboard" input text + $EKBD EKBD() end "keyboard" input text + $HR HR() horizontal rule + $LBRACE LBRACE() left brace + $LB LB () left brace + $RBRACE RBRACE() right brace + $RB RB () right brace + $DOLLAR DOLLAR() a dollar sign + $PERCENT PERCENT() a percent sign + $CARET CARET() a caret sign + $PI PI() the number pi + $E E() the number e + $LATEX LATEX() the LaTeX logo + $TEX TEX() the TeX logo + $APOS APOS() an apostrophe + +=cut + +# A utility variable. Notice that "B" = $ALPHABET[1] and +# "ABCD" = @ALPHABET[0..3]. + +sub ALPHABET { + ('A' .. 'ZZ')[@_]; +} + +############################################################### +# Some constants which are different in tex and in HTML +# The order of arguments is TeX, Latex2HTML, HTML +# Adopted Davide Cervone's improvements to PAR, LTS, GTS, LTE, GTE, LBRACE, RBRACE, LB, RB. 7-14-03 AKP +sub PAR { + MODES( + TeX => '\\vskip\\baselineskip ', + Latex2HTML => '\\begin{rawhtml}

    \\end{rawhtml}', + HTML => '

    ', + PTX => "\n\n" + ); +} +#sub BR { MODES( TeX => '\\par\\noindent ', Latex2HTML => '\\begin{rawhtml}
    \\end{rawhtml}', HTML => '
    '); }; +# Alternate definition of BR which is slightly more flexible and gives more white space in printed output +# which looks better but kills more trees. +sub BR { + MODES( + TeX => '\\leavevmode\\\\\\relax ', + Latex2HTML => '\\begin{rawhtml}
    \\end{rawhtml}', + HTML => '
    ', + PTX => "\n\n" + ); +} + +sub BRBR { + MODES( + TeX => '\\leavevmode\\\\\\relax \\leavevmode\\\\\\relax ', + Latex2HTML => '\\begin{rawhtml}

    \\end{rawhtml}', + HTML => '

    ', + PTX => "\n" + ); +} +sub LQ { MODES(TeX => "\\lq\\lq{}", Latex2HTML => '"', HTML => '"', PTX => ''); } +sub RQ { MODES(TeX => "\\rq\\rq{}", Latex2HTML => '"', HTML => '"', PTX => ''); } +sub BM { MODES(TeX => '\\(', Latex2HTML => '\\(', HTML_MathJax => '\\(', HTML => '', PTX => ''); }; # begin math mode +sub EM { MODES(TeX => '\\)', Latex2HTML => '\\)', HTML_MathJax => '\\)', HTML => '', PTX => ''); }; # end math mode + +sub BDM { + MODES(TeX => '\\[', Latex2HTML => '\\[', HTML_MathJax => '\\[', HTML => '

    ', PTX => ''); +}; #begin displayMath mode + +sub EDM { + MODES(TeX => '\\]', Latex2HTML => '\\]', HTML_MathJax => '\\]', HTML => '

    ', PTX => ''); +}; #end displayMath mode + +sub LTS { + MODES(TeX => '<', Latex2HTML => '\\lt ', HTML => '<', HTML_tth => '<', PTX => '\lt'); +}; #only for use in math mode + +sub GTS { + MODES(TeX => '>', Latex2HTML => '\\gt ', HTML => '>', HTML_tth => '>', PTX => '\gt'); +}; #only for use in math mode + +sub LTE { + MODES(TeX => '\\le ', Latex2HTML => '\\le ', HTML => '<', HTML_tth => '\\le ', PTX => '\leq'); +}; #only for use in math mode + +sub GTE { + MODES(TeX => '\\ge ', Latex2HTML => '\\ge ', HTML => '>', HTML_tth => '\\ge ', PTX => '\geq'); +}; #only for use in math mode + +sub BEGIN_ONE_COLUMN { + MODES(TeX => "\\ifdefined\\nocolumns\\else\\end{multicols}\\fi\n", Latex2HTML => " ", HTML => " "); +} + +sub END_ONE_COLUMN { + MODES( + TeX => "\\ifdefined\\nocolumns\\else\\begin{multicols}{2}\n\\columnwidth=\\linewidth\\fi\n", + Latex2HTML => ' ', + HTML => ' ' + ); +} + +sub SOLUTION_HEADING { + MODES( + TeX => '{\\bf ' . maketext('Solution: ') . ' }', + Latex2HTML => '\\par {\\bf ' . maketext('Solution:') . ' }', + HTML => '' . maketext('Solution:') . ' ', + PTX => '' + ); +} + +sub HINT_HEADING { + MODES( + TeX => "{\\bf " . maketext('Hint: ') . "}", + Latex2HTML => "\\par {\\bf " . maketext('Hint:') . " }", + HTML => "" . maketext('Hint:') . " ", + PTX => '' + ); +} +sub US { MODES(TeX => '\\_', Latex2HTML => '\\_', HTML => '_', PTX => '_'); }; # underscore, e.g. file${US}name + +sub SPACE { + MODES(TeX => '\\ ', Latex2HTML => '\\ ', HTML => ' ', PTX => ' '); +}; # force a space in latex, doesn't force extra space in html +sub NBSP { MODES(TeX => '~', Latex2HTML => '~', HTML => ' ', PTX => ''); } +sub NDASH { MODES(TeX => '--', Latex2HTML => '--', HTML => '–', PTX => ''); } +sub MDASH { MODES(TeX => '---', Latex2HTML => '---', HTML => '—', PTX => ''); } +sub BBOLD { MODES(TeX => '{\\bf ', Latex2HTML => '{\\bf ', HTML => '', PTX => ''); } +sub EBOLD { MODES(TeX => '}', Latex2HTML => '}', HTML => '', PTX => ''); } +sub BLABEL { MODES(TeX => '', Latex2HTML => '', HTML => '', PTX => ''); } +sub BITALIC { MODES(TeX => '{\\it ', Latex2HTML => '{\\it ', HTML => '', PTX => ''); } +sub EITALIC { MODES(TeX => '} ', Latex2HTML => '} ', HTML => '', PTX => ''); } +sub BUL { MODES(TeX => '\\underline{', Latex2HTML => '\\underline{', HTML => '', PTX => ''); } +sub EUL { MODES(TeX => '}', Latex2HTML => '}', HTML => '', PTX => ''); } + +sub BCENTER { + MODES( + TeX => '\\begin{center} ', + Latex2HTML => ' \\begin{rawhtml}
    \\end{rawhtml} ', + HTML => '
    ', + PTX => '' + ); +} + +sub ECENTER { + MODES( + TeX => '\\end{center} ', + Latex2HTML => ' \\begin{rawhtml}
    \\end{rawhtml} ', + HTML => '
    ', + PTX => '' + ); +} + +sub BLTR { + MODES( + TeX => ' ', + Latex2HTML => ' \\begin{rawhtml}
    \\end{rawhtml} ', + HTML => '', + PTX => '' + ); +} +sub ELTR { MODES(TeX => ' ', Latex2HTML => ' \\begin{rawhtml}
    \\end{rawhtml} ', HTML => '', PTX => ''); } +sub BKBD { MODES(TeX => '\\texttt{', Latex2HTML => '', HTML => '', PTX => ''); } +sub EKBD { MODES(TeX => '}', Latex2HTML => '', HTML => '', PTX => ''); } + +sub HR { + MODES( + TeX => '\\par\\hrulefill\\par ', + Latex2HTML => '\\begin{rawhtml}
    \\end{rawhtml}', + HTML => '
    ', + PTX => '' + ); +} + +sub LBRACE { + MODES(TeX => '\{', Latex2HTML => '\\lbrace', HTML => '{', HTML_tth => '\\lbrace', PTX => '{'); +}; #not for use in math mode + +sub RBRACE { + MODES(TeX => '\}', Latex2HTML => '\\rbrace', HTML => '}', HTML_tth => '\\rbrace', PTX => '}'); +}; #not for use in math mode + +sub LB { + MODES(TeX => '\{', Latex2HTML => '\\lbrace', HTML => '{', HTML_tth => '\\lbrace', PTX => '{'); +}; #not for use in math mode + +sub RB { + MODES(TeX => '\}', Latex2HTML => '\\rbrace', HTML => '}', HTML_tth => '\\rbrace', PTX => '}'); +}; #not for use in math mode +sub DOLLAR { MODES(TeX => '\\$', Latex2HTML => '$', HTML => '$', PTX => '$'); } +sub PERCENT { MODES(TeX => '\\%', Latex2HTML => '\\%', HTML => '%', PTX => '%'); } +sub CARET { MODES(TeX => '\\verb+^+', Latex2HTML => '\\verb+^+', HTML => '^', PTX => '^'); } +sub PI { 4 * atan2(1, 1); } +sub E { exp(1); } +sub LATEX { MODES(TeX => '\\LaTeX', HTML => '\\(\\mathrm\\LaTeX\\)', PTX => ''); } +sub TEX { MODES(TeX => '\\TeX', HTML => '\\(\\mathrm\\TeX\\)', PTX => ''); } +sub APOS { MODES(TeX => "'", HTML => "'", PTX => "\\'"); } + +############################################################### + +=head2 SPAN and DIV macros + These are functions primarly meant to add + HTML block level DIV or inline SPAN + tags and the relevant closing tags for HTML output. + + At present, these macros require the user to provide TeX and + preTeXt strings which will be used in those modes instead of the + HTML block level DIV or inline SPAN tag. + + If they are missing, they will default to the empty string. + If only one string is given, it will be assumed to be the TeX string. + + At present only the following 4 HTML attributes can be set: + lang, dir, class, style. + Using the style option requires creating valid CSS text. + For safety some parsing/cleanup is done and various sorts of + (apparently) invalid values may be dropped. See the code for + details of what input sanitation is done. + + Since the use of style is particularly dangerous, in order to + enable its use you must set allowStyle to 1 in the hash. It is + possible to prevent the use of some of the other options by + setting certain control like allowLang to 0. + + Usage: + openSpan( options_hash, "tex code", "ptx code" ); + closeSpan("tex code", "ptx code"); + + Usage where TeX and PTX output will be empty by default. + openSpan( options_hash ); + closeSpan(); + + Sample options hashes + + { "lang" => "he", + "dir" => "rtl", + "class" => "largeText class123" } + + { "lang" => "he", + "allowStyle" => 1, + "style" => "background-color: \"#afafaf; float: left;\t height: 12px;" } + +=cut + +sub processDivSpanOptions { + my $option_ref = {}; + $option_ref = shift if ref($_[0]) eq 'HASH'; + + my %options = ( + allowLang => 1, # Setting the lang tag is allowed by default + allowDir => 1, # Setting the dir tag is allowed by default + allowClass => 1, # Setting the class tag is allowed by default + allowStyle => 0, # Setting the style tag is FORBIDDEN by default, use with care! + %{$option_ref}, + ); + + my $LangVal = ""; + if ($options{allowLang} && defined($options{lang})) { + # The standard for how the lang tag should be set is explained in + # https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/lang + # based on the BCP47 standard from https://www.ietf.org/rfc/bcp/bcp47.txt + + # We are going to do only minimal cleanup to the value provided + # making sure that all the characters are in the valid range A-Za-z0-9\- + # but not checking the inner structure + $LangVal = $options{lang}; + if ($LangVal =~ /[^\w\-]/) { + # Clean it up + $LangVal =~ s/[^\w\-]//g; # Drop invalid characters + WARN_MESSAGE( + "processDivSpanOptions received an HTML LANG attribute setting with invalid characters which were removed. The value after cleanup is $LangVal which may not be what was intended. See https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/lang for information on how this value should be set" + ); + } + } + + my $DirVal = ""; + if ($options{allowDir} && defined($options{dir})) { + # the ONLY allowed values are: ltr rtl auto + if (($options{dir} eq "ltr") + || ($options{dir} eq "rtl") + || ($options{dir} eq "auto")) + { + $DirVal = $options{dir}; + } else { + WARN_MESSAGE( + "processDivSpanOptions received an invalid value for the HTML DIR attribute. Only ltr rtl auto are allowed. As a result the DIR attribute has not been set." + ); + } + } + + my $ClassVal = ""; + if ($options{allowClass} && defined($options{class})) { + # Class names which are permitted here must start with a letter [A-Za-z] + # and the rest of the class name can be characters in [A-Za-z0-9\-\_]. + + # A space is used to separate class names + + # The offical W3C documentation allows class names to follow a far more general + # grammar, but this is not being permitted here at present. + # See: https://www.w3.org/TR/css-syntax-3/#token-diagrams + + my $hadBadClassNames = 0; + my @rawList = split(' ', $options{class}); + my @okList; # Will collect valid class names + my $cl; + while (@rawList) { + $cl = shift(@rawList); + if ($cl =~ /^[A-Za-z][\w\-\_]*$/) { + push(@okList, $cl); + } else { + $hadBadClassNames = 1; + # print "Invalid classname $cl dropped\n"; + } + } + if (@okList) { + $ClassVal = join(' ', @okList); + WARN_MESSAGE( + "processDivSpanOptions received some CSS class names which are not permitted by PG for the HTML CLASS attribute. Any invalid names were dropped." + ) if ($hadBadClassNames); + } else { + # No good values arrived + WARN_MESSAGE( + "processDivSpanOptions received ONLY CSS class names which are not permitted by PG for the HTML CLASS attribute. As a result the CLASS attribute has not been set." + ) if ($hadBadClassNames); + } + } + + my $StyleVal = ""; + if ($options{allowStyle} && defined($options{style})) { + # The value is validated in a very minimal sense only - use with great care + + # Replace tab with space + $options{style} =~ s/\t/ /g; + + $StyleVal = $options{style}; + + # Mininal cleanup for safety + $StyleVal =~ s/["']//g; # Drop quotes + if ($StyleVal eq $options{style}) { + # no quotes, so now drop other characters we consider invalid + # ONLY A-Za-z-_ #:; are currently allowed. + $StyleVal =~ s/[^\w\-\_ #:;]//g; + } + + if ($StyleVal ne $options{style}) { + # Did not seem safe + $StyleVal = ""; + WARN_MESSAGE( + "processDivSpanOptions received some characters in the STYLE string which are are not permitted by PG. As a result the entire STYLE string was dropped" + ); + } + } + + # Construct the desired HTML attributes + my $html_attribs = ""; + $html_attribs .= "lang=\"$LangVal\" " if ($LangVal ne ""); + $html_attribs .= "dir=\"$DirVal\" " if ($DirVal ne ""); + $html_attribs .= "class=\"$ClassVal\" " if ($ClassVal ne ""); + $html_attribs .= "style=\"$StyleVal\" " if ($StyleVal ne ""); + return ($html_attribs); +} + +sub openDivSpan { + my $type = shift; # "Span" or "Div"; + if ($type eq "Span" || $type eq "Div") { + # OK + } else { + WARN_MESSAGE("openDivSpan called with an invalid first argument. The entire call was discarded."); + return (); + } + my $option_ref = {}; + my $html_attribs; + if (ref($_[0]) eq 'HASH') { + $option_ref = shift; + $html_attribs = processDivSpanOptions($option_ref); + } + + my $tex_code = shift; # TeX code to be used for this - currently needs to be set by hand + my $ptx_code = shift; # preTeXt code to be used for this - currently needs to be set by hand + + # Fall back to empty TeX / preTeXt code if none was provided. + $tex_code = defined($tex_code) ? $tex_code : ""; + $ptx_code = defined($ptx_code) ? $ptx_code : ""; + + # Make a call to track this as opening a "object" which needs to be closed + # ON HOLD - as the internal balancing support is still work in progress + # internalBalancingIncrement("open${type}"); + + MODES( + TeX => "$tex_code", + Latex2HTML => qq!\\begin{rawhtml}<$type $html_attribs>\\end{rawhtml}!, + HTML => qq!<$type $html_attribs>\n!, + PTX => "$ptx_code", + ); +} + +sub closeDivSpan { + my $type = shift; # "Span" or "Div"; + if ($type eq "Span" || $type eq "Div") { + # OK + } else { + WARN_MESSAGE("closeDivSpan called with an invalid first argument. The entire call was discarded."); + return (); + } + + my $tex_code = shift; # TeX code to be used for this - currently needs to be set by hand + my $ptx_code = shift; # preTeXt code to be used for this - currently needs to be set by hand + + # Fall back to empty TeX / preTeXt code if none was provided. + $tex_code = defined($tex_code) ? $tex_code : ""; + $ptx_code = defined($ptx_code) ? $ptx_code : ""; + + # Make a call to track this as closing a tracked "object" which was reported as opened + # ON HOLD - as the internal balancing support is still work in progress + # internalBalancingDecrement("open${type}"); + + MODES( + TeX => "$tex_code", + Latex2HTML => qq!\\begin{rawhtml}\\end{rawhtml}!, + HTML => qq!\n!, + PTX => "$ptx_code", + ); +} + +sub openSpan { + openDivSpan(("Span", @_)); +} + +sub openDiv { + openDivSpan(("Div", @_)); +} + +sub closeSpan { + closeDivSpan(("Span", @_)); +} + +sub closeDiv { + closeDivSpan(("Div", @_)); +} + +############################################################### +## Evaluation macros + +=head2 TEXT macros + + Usage: + TEXT(@text); + +This is the simplest way to print text from a problem. The strings in the array C<@text> are concatenated +with spaces between them and printed out in the text of the problem. The text is not processed in any other way. +C is defined in PG.pl. + + Usage: + BEGIN_TEXT + text..... + END_TEXT + +This is the most common way to enter text into the problem. All of the text between BEGIN_TEXT and END_TEXT +is processed by the C macro described below and then printed using the C command. The two key words +must appear on lines by themselves. The preprocessing that makes this construction work is done in F. +See C below for details on the processing. + +=cut + +=head2 Evaluation macros + +=head3 EV3 + + TEXT(EV3("This is a formulat \( \int_0^5 x^2 \, dx \) "); + TEXT(EV3(@text)); + + TEXT(EV3(<<'END_TEXT')); + text stuff... + END_TEXT + +The BEGIN_TEXT/END_TEXT construction is translated into the construction above by PGtranslator.pm. END_TEXT must appear +on a line by itself and be left justified. (The << construction is known as a "here document" in UNIX and in PERL.) + +The single quotes around END_TEXT mean that no automatic interpolation of variables takes place in the text. +Using EV3 with strings which have been evaluated by double quotes may lead to unexpected results. + +The evaluation macro E3 first evaluates perl code inside the braces: C<\{ code \}>. +Any perl statment can be put inside the braces. The +result of the evaluation (i.e. the last statement evaluated) replaces the C<\{ code \}> construction. + +Next interpolation of all variables (e.g. C<$var or @array> ) is performed. + +Then mathematical formulas in TeX are evaluated within the +C<\( tex math mode \)> and +C<\[ tex display math mode \] > +constructions, in that order: + +=head3 refreshEquations + + refreshEquations(1); + +Prevents equations generated in "image mode" from being cached. This can be useful for debugging. +It has no effect in the other modes. + +=cut + +sub refreshEquations { + my $in = shift; + if ($displayMode eq "HTML_dpng") { + $envir->{imagegen}->refresh($in); + } +} + +=head3 addToTeXPreamble + + addToTeXPreamble("\newcommand{\myVec}[1]{\vec{#1}} "); + +Defines C<\myVec > for all the equations in the file. You can change the vector notation for an entire PG question +by changing just this line. + +If you place this macro in PGcourse.pl remember to use double backslashes because it is a .pl file. +In .pg files use single backslashes. This is in accordance with the usual rules for backslash +in PG. + +For the moment this change only works in image mode. It does not work in +jsMath or MathJax mode. Stay tuned. + +Adding this command + + \newcommand{\myVec}[1]{\vec{#1}} + +to TeX(hardcopy) portion of the setHeaderCombinedFile.pg ( or to the setHeaderHardcopyFile.pg +for each homework set will take care of the TeX hardcopy version + +You can also modify the TexPreamble file in webwork2/conf/snippets to set the definition +of \myVec for hardcopy for the entire site. + +There are ways you can use course.conf to allow course by course modification by choosing +different TeXPreamble files for different courses + +=cut + +sub addToTeXPreamble { + my $str = shift; + if ($displayMode eq "HTML_dpng") { + $envir->{imagegen}->addToTeXPreamble($str . "\n"); + } elsif ($displayMode eq "TeX" and $envir->{probNum} == 0) { + + # in TeX mode we are typically creating an entire homework set + # and typesetting that so w only want the TeXPreamble to + # appear once -- towards the beginning. + # This is potentially fragile -- if one starts + # typesetting problems separately this will fail. + # The reason for the multicols commands is baroque + # If they are not there then the newcommand gets printed + # inside a multicols environment and its scope doesn't reach the whole file + # It has to do with the way the multicol single col stuff was set up + # when printing hardcopy. --it's weird and there must be a better way. + TEXT("\\ifdefined\\nocolumns\\else \\end{multicols} \\fi\n", + $str, "\n", "\\ifdefined\\nocolumns\\else \\begin{multicols}{2}\\columnwidth=\\linewidth \\fi\n"); + } else { # for jsMath and MathJax mode + my $mathstr = "\\(" . $str . "\\)"; #add math mode. + $mathstr =~ s/\\/\\\\/g; # protect math modes ($str has a true TeX command, + # with single backslashes. The backslashes have not + # been protected by the .pg problem preprocessor + TEXT(EV3($mathstr)); + } +} + +=head3 FEQ + + FEQ($string); # processes and outputs the string + +The mathematical formulas are run through the macro C (Format EQuations) which performs +several substitutions (see below). +In C mode the resulting code is processed by tth to obtain an HTML version +of the formula. (In the future processing by WebEQ may be added here as another option.) +The Latex2HTML mode does nothing +at this stage; it creates the entire problem before running it through +TeX and creating the GIF images of the equations. + +The resulting string is output (and usually fed into TEXT to be printed in the problem). + + Usage: + + $string2 = FEQ($string1); + +This is a filter which is used to format equations by C and C, but can also be used on its own. It is best +understood with an example. + + $string1 = "${a}x^2 + ${b}x + {$c:%.1f}"; $a = 3;, $b = -2; $c = -7.345; + +when interpolated becomes: + + $string1 = '3x^2 + -2x + {-7.345:%0.1f} + +FEQ first changes the number of decimal places displayed, so that the last term becomes -7.3 Then it removes the +extraneous plus and minus signs, so that the final result is what you want: + + $string2 = '3x^2 - 2x -7.3'; + +(The %0.1f construction +is the same formatting convention used by Perl and nearly identical to the one used by the C printf statement. Some common +usage: %0.3f 3 decimal places, fixed notation; %0.3e 3 significant figures exponential notation; %0.3g uses either fixed +or exponential notation depending on the size of the number.) + +Two additional legacy formatting constructions are also supported: + +C will give a number with 3 decimal places and a negative +sign if the number is negative, no sign if the number is positive. Since this is +identical to the behavior of C<{$c:%0.3f}> the use of this syntax is depricated. + +C determines the sign and prints it +whether the number is positive or negative. You can use this +to force an expression such as C<+5.456>. + +=head3 EV2 + + TEXT(EV2(@text)); + + TEXT(EV2(< with C<@text = ("Hello", "World");> becomes, +after interpolation, C<\{ join(" ", Hello World) \}> which then causes an error when evaluated because Hello is a bare word. +C can still be useful if you allow for this, and in particular it works on double quoted strings, which lead to +unexpected results with C. Using single quoted strings with C may lead to unexpected results. + +The unexpected results have to do with the number of times backslashed constructions have to be escaped. It is quite messy. For +more details get a good Perl book and then read the code. :-) + +=cut + +sub ev_substring { + my $string = shift; + my $start_delim = shift; + my $end_delim = shift; + my $actionRef = shift; + my ($eval_out, $PG_eval_errors, $PG_full_error_report) = (); + my $out = ""; + while ($string ne "") { # DPVC -- 2001/12/07 - original "while ($string)" fails to process the string "0" correctly + if ($string =~ /\Q$start_delim\E/s) { + #print "$start_delim $end_delim evaluating_substring=$string
    "; + $string =~ s/^(.*?)\Q$start_delim\E//s + ; # get string up to next \{ ---treats string as a single line, ignoring returns + $out .= $1; + #print "$start_delim $end_delim substring_out=$out
    "; + $string =~ + s/^(.*?)\Q$end_delim\E//s; # get perl code up to \} ---treats string as a single line, ignoring returns + #print "$start_delim $end_delim evaluate_string=$1
    "; + ($eval_out, $PG_eval_errors, $PG_full_error_report) = &$actionRef($1); + $eval_out = "$start_delim $eval_out $end_delim" if $PG_full_error_report; + $out = $out . $eval_out; + #print "$start_delim $end_delim new substring_out=$out


    "; + $out .= "$PAR ERROR $0 in ev_substring, PGbasicmacros.pl:$PAR 

      $@
    $PAR" if $@; + } else { + $out .= $string; # flush the last part of the string + last; + } + + } + $out; +} + +sub safe_ev { + my ($out, $PG_eval_errors, $PG_full_error_report) = &old_safe_ev; # process input by old_safe_ev first + $out = "" unless defined($out) and $out =~ /\S/; + $out =~ s/\\/\\\\/g; # protect any new backslashes introduced. + ($out, $PG_eval_errors, $PG_full_error_report); +} + +sub old_safe_ev { + my $in = shift; + my ($out, $PG_eval_errors, $PG_full_error_report) = PG_restricted_eval("$in;"); + # the addition of the ; seems to provide better error reporting + if ($PG_eval_errors) { + my @errorLines = split("\n", $PG_eval_errors); +#$out = "
    $PAR % ERROR in $0:old_safe_ev, PGbasicmacros.pl: $PAR % There is an error occuring inside evaluation brackets \\{ ...code... \\} $BR % somewhere in an EV2 or EV3 or BEGIN_TEXT block. $BR % Code evaluated:$BR $in $BR % $BR % $errorLines[0]\n % $errorLines[1]$BR % $BR % $BR
    "; + warn " ERROR in old_safe_ev, PGbasicmacros.pl: 
    +		## There is an error occuring inside evaluation brackets \\{ ...code... \\}
+		## somewhere in an EV2 or EV3 or BEGIN_TEXT block.
+		## Code evaluated:
+		## $in
+		##" . join("\n     ", @errorLines) . "
+		##
    $BR + "; + $out = "$PAR $BBOLD $in $EBOLD $PAR"; + } + + ($out, $PG_eval_errors, $PG_full_error_report); +} + +sub FEQ { # Format EQuations + my $in = shift; + # formatting numbers -- the ?{} and !{} constructions + $in =~ s/\?\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &sspf($1, $2) )}/g; + $in =~ s/\!\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &spf($1, $2) )}/g; + + # more formatting numbers -- {number:format} constructions + $in =~ s/\{(\s*[\+\-\d\.]+[eE]*[\+\-]*\d*):(\%\d*.\d*\w)}/${ \( &spf($1, $2) )}/g; + $in =~ s/\+\s*\-/ - /g; + $in =~ s/\-\s*\+/ - /g; + $in =~ s/\+\s*\+/ + /g; + $in =~ s/\-\s*\-/ + /g; + $in; +} + +sub math_ev3 { + my $in = shift; + return general_math_ev3($in, "inline"); +} + +sub display_math_ev3 { + my $in = shift; + return general_math_ev3($in, "display"); +} + +sub general_math_ev3 { + my $in = shift; + my $mode = shift || "inline"; + + $in = FEQ($in); # Format EQuations + $in =~ s/((^|[^\\])(\\\\)*)%/$1\\%/g; # avoid % becoming TeX comments (unless already escaped) + + ## remove leading and trailing spaces so that HTML mode will + ## not include unwanted spaces as per Davide Cervone. + $in =~ s/^\s+//; + $in =~ s/\s+$//; + ## If it ends with a backslash, there should be another space + ## at the end + if ($in =~ /(^|[^\\])(\\\\)*\\$/) { $in .= ' ' } + + # some modes want the delimiters, some don't + my $in_delim = $mode eq "inline" ? "\\($in\\)" : "\\[$in\\]"; + + my $out; + if ($displayMode eq "HTML_MathJax") { + $out = ''; + } elsif ($displayMode eq "HTML_dpng") { + # for jj's version of ImageGenerator + #$out = $envir->{'imagegen'}->add($in_delim); + # for my version of ImageGenerator + $out = $envir->{'imagegen'}->add($in, $mode); + } elsif ($displayMode eq "HTML_tth") { + $out = tth($in_delim); + ## remove leading and trailing spaces as per Davide Cervone. + $out =~ s/^\s+//; + $out =~ s/\s+$//; + } elsif ($displayMode eq "HTML_img") { + $out = math2img($in, $mode); + } elsif ($displayMode eq "HTML_jsMath") { + $in =~ s/&/&/g; + $in =~ s//>/g; + $out = '' . $in . '' if $mode eq "inline"; + $out = '
    ' . $in . '
    ' if $mode eq "display"; + } elsif ($displayMode eq "HTML_asciimath") { + $in = HTML::Entities::encode_entities($in); + $out = "`$in`" if $mode eq "inline"; + $out = '
    `' . $in . '`
    ' if $mode eq "display"; + } elsif ($displayMode eq "PTX") { + #protect XML control characters + $in =~ s/\&(?!([\w#]+;))/\\amp /g; + $in =~ s/' . "$in" . '' if $mode eq "inline"; + $out = '' . "$in" . '' if $mode eq "display"; + } elsif ($displayMode eq "HTML_LaTeXMathML") { + $in = HTML::Entities::encode_entities($in); + $in = '{' . $in . '}'; + $in =~ s/\{\s*(\\(display|text|script|scriptscript)style)/$1\{/g; + $out = '$$' . $in . '$$' if $mode eq "inline"; + $out = '
    $$\displaystyle{' . $in . '}$$
    ' if $mode eq "display"; + } elsif ($displayMode eq "HTML") { + $in_delim = HTML::Entities::encode_entities($in_delim); + $out = "$in_delim"; + } else { + $out = $in_delim; + } + return $out; +} + +sub EV2 { + my $string = join(" ", @_); + # evaluate code inside of \{ \} (no nesting allowed) + $string = ev_substring($string, "\\{", "\\}", \&old_safe_ev); + $string = ev_substring($string, "\\<", "\\>", \&old_safe_ev); + $string = ev_substring($string, "\\(", "\\)", \&math_ev3); + $string = ev_substring($string, "\\[", "\\]", \&display_math_ev3); + # macros for displaying math + $string =~ s/\\\(/$BM/g; + $string =~ s/\\\)/$EM/g; + $string =~ s/\\\[/$BDM/g; + $string =~ s/\\\]/$EDM/g; + $string; +} + +sub EV3 { + my $string = join(" ", @_); + # evaluate code inside of \{ \} (no nesting allowed) + $string = ev_substring($string, "\\\\{", "\\\\}", \&safe_ev); # handles \{ \} in single quoted strings of PG files + # interpolate variables + my ($evaluated_string, $PG_eval_errors, $PG_full_errors) = + PG_restricted_eval("</>/g; + $evaluated_string = + "
    $PAR % ERROR in $0:EV3, PGbasicmacros.pl: $PAR % There is an error occuring in the following code:$BR $string $BR % $BR % $errorLines[0]\n % $errorLines[1]$BR % $BR % $BR
    "; + $@ = ""; + } + $string = $evaluated_string; + $string = ev_substring($string, "\\(", "\\)", \&math_ev3); + $string = ev_substring($string, "\\[", "\\]", \&display_math_ev3); + $string; +} + +sub EV4 { + if ($displayMode eq "HTML_dpng") { + my $string = join(" ", @_); + my ($evaluated_string, $PG_eval_errors, $PG_full_errors) = + PG_restricted_eval("</>/g; + $evaluated_string = + "
    $PAR % ERROR in $0:EV3, PGbasicmacros.pl:"
+				. "$PAR % There is an error occuring in the following code:$BR "
+				. "$string $BR % $BR % $errorLines[0]\n % $errorLines[1]$BR "
+				. "% $BR % $BR
    "; + } + $string = $evaluated_string; + $string = $envir{'imagegen'}->add($string); + $string; + } else { + EV3(@_); + } +} + +=head3 EV3P + + ###################################################################### + # + # New version of EV3 that allows `...` and ``...`` to insert TeX produced + # by the new Parser (in math and display modes). + # + # Format: EV3P(string, ...); + # EV3P({options}, string, ...); + # + # `x^2/5` will become \(\frac{x^2}{5}\) and then rendered for hardcopy or screen output + # + # where options can include: + # + # processCommands => 0 or 1 Indicates if the student's answer will + # be allowed to process \{...\}. + # Default: 1 + # + # processVariables => 0 1 Indicates whether variable substitution + # should be performed on the student's + # answer. + # Default: 1 + # + # processMath => 0 or 1 Indicates whether \(...\), \[...\], + # `...` and ``...`` will be processed + # in the student's answer. + # Default: 1 + # + # processParser => 0 or 1 Indicates if `...` and ``...`` should + # be processed when math is being + # processed. + # Default: 1 + # + # fixDollars => 0 or 1 Specifies whether dollar signs not followed + # by a letter should be replaced by ${DOLLAR} + # prior to variable substitution (to prevent + # accidental substitution of strange Perl + # values). + # Default: 1 + # + +=cut + +sub EV3P { + my $option_ref = {}; + $option_ref = shift if ref($_[0]) eq 'HASH'; + my %options = ( + processCommands => 1, + processVariables => 1, + processParser => 1, + processMath => 1, + fixDollars => 1, + %{$option_ref}, + ); + my $string = join(" ", @_); + $string = ev_substring($string, "\\\\{", "\\\\}", \&safe_ev) if $options{processCommands}; + if ($options{processVariables}) { + my $eval_string = $string; + $eval_string =~ s/\$(?![a-z\{])/\${DOLLAR}/gi if $options{fixDollars}; + my ($evaluated_string, $PG_eval_errors, $PG_full_errors) = + PG_restricted_eval("</>/g; + $evaluated_string = $BBOLD . "(Error: $error in '$string')" . $EBOLD; + } + $string = $evaluated_string; + } else { + $string =~ s/\\\\/\\/g; + } + + if ($options{processMath}) { + $string = EV3P_parser($string) if $options{processParser}; + $string = ev_substring($string, "\\(", "\\)", \&math_ev3); + $string = ev_substring($string, "\\[", "\\]", \&display_math_ev3); + } + + if ($displayMode eq 'PTX') { $string = PTX_cleanup($string) } + + return $string; +} + +# +# Look through a string for ``...`` or `...` and use +# the parser to produce TeX code for the specified mathematics. +# ``...`` does display math, `...` does in-line math. They +# can also be used within math mode already, in which case they +# use whatever mode is already in effect. +# +sub EV3P_parser { + my $string = shift; + return $string unless $string =~ m/`/; + my $start = ''; + my %end = ('\(' => '\)', '\[' => '\]'); + my @parts = split(/(``.*?``\*?|`.+?`\*?|(?:\\[()\[\]]))/s, $string); + foreach my $part (@parts) { + if ($part =~ m/^(``?)(.*)\1(\*?)$/s) { + my ($delim, $math, $star) = ($1, $2, $3); + my $f = Parser::Formula($math); + if (defined($f)) { + $f = $f->reduce if $star; + $part = $f->TeX; + $part = ($delim eq '`' ? '\(' . $part . '\)' : '\[' . $part . '\]') if (!$start); + } else { + ## FIXME: use context->{error}{ref} to highlight error in $math. + $part = $BBOLD . "(Error: $$Value::context->{error}{message} '$math')" . $EBOLD; + $part = $end{$start} . " " . $part . " " . $start if $start; + } + } elsif ($start) { + $start = '' if $part eq $end{$start}; + } elsif ($end{$part}) { + $start = $part; + } + } + return join('', @parts); +} + +sub PTX_cleanup { + my $string = shift; + # Wrap

    tags where necessary, and other cleanup + # Nothing else should be creating p tags, so assume all p tags created here + # The only supported top-level elements within a statement, hint, or solution in a problem + # are p, blockquote, pre, tabular, image, video + if ($displayMode eq 'PTX') { + #encase entire string in

    + #except not for certain "sub" structures that are also passed through EV3 + $string = "

    " . $string . "

    " unless (($string =~ /^]*\/>$/) or ($string =~ /^$/s)); + + #inside a li, the only permissible children are p, image, video, and tabular + #insert opening and closing p, to be removed later if they enclose an image, video or tabular + #we are not going to look to see if there is a nested list in there + $string =~ s/(]*(?)/$1\n

    /g; + $string =~ s/(<\/li>)/<\/p>\n$1/g; + + #close p right before any blockquote, pre, image, video, or tabular + #and open p immediately following. Later any potential side effects are cleaned up. + $string =~ s/(<(blockquote|pre|image|video|tabular)[^>]*(?)/<\/p>\n$1/g; + $string =~ s/(<\/(blockquote|pre|image|video|tabular)>)/$1\n

    /g; + $string =~ s/(<(blockquote|pre|image|video|tabular)[^>]*(?<=\/)>)/<\/p>\n$1\n

    /g; + + #within a , we may have an issue if there was an image that had '<\p>' and '

    ' wrapped around + #it from the above block. If the '

    ' has a preceding '

    ' within the cell, no problem. Otherwise, + #the '

    ' must go. Likewise at the other end. + $string =~ s/(?s)(.*?)<\/p>\n(]*(?<=\/)>)\n

    (.*?<\/cell>)/$1$2$3/g; + + #remove blank lines; assume the intent was to end a p and start a new one + #but don't put closing and opening p replacing the blank lines if they precede or follow a + #or an

  • + $string =~ s/(\r\n?|\n)(\r\n?|\n)+(?!(|<\/tabular>|
  • |\r\n?|\n))/<\/p>\n

    /g; + $string =~ s/(\r\n?|\n)(\r\n?|\n)+(?=(|<\/tabular>|

  • |\r\n?|\n))/\n/g; + + #remove whitespace following

    + $string =~ s/(?s)(

    )\s*/$1/g; + + #remove whitespace preceding

    + $string =~ s/(?s)\s*(<\/p>)/$1/g; + + #move PTX warnings from the beginning of inside a p to just before the p. + $string =~ s/

    ()/$1\n

    /g; + + #remove doulbe p's we may have created + $string =~ s/

    /

    /g; + $string =~ s/<\/p><\/p>/<\/p>/g; + + #remove empty p + $string =~ s/(\r\n?|\n)?

    <\/p>//g; + + #a tabular cell may have

    and

    but no corresponding width specification in a col. + #if so, remove all

    and

    from all cells. + my $previous; + do { + $previous = $string; + $string =~ + s/(?s)((?:\s| "\n%%% BEGIN PROBLEM PREAMBLE\n" + , #Marker used in PreTeXt LaTeX extraction; contact alex.jordan@pcc.edu before modifying + HTML => "" + ); + $out .= MODES(%{ main::PG_restricted_eval(q!$main::problemPreamble!) }); + $out .= MODES( + TeX => "\n%%% END PROBLEM PREAMBLE\n" + , #Marker used in PreTeXt LaTeX extraction; contact alex.jordan@pcc.edu before modifying + HTML => "" + ); + if ($displayMode eq 'PTX') { $out = '' } + $out; +} + +sub nicestring { + my $thingy = shift; + my @coefs = @{$thingy}; + my $n = scalar(@coefs); + $thingy = shift; + my @others; + if (defined($thingy)) { + @others = @{$thingy}; + } else { + for my $j (1 .. ($n - 2)) { + $others[ $j - 1 ] = "x^" . ($n - $j); + } + if ($n >= 2) { $others[ $n - 2 ] = "x"; } + $others[ $n - 1 ] = ""; + } + my ($j, $k) = (0, 0); + while (($k < $n) && ($coefs[$k] == 0)) { $k++; } + if ($k == $n) { return ("0"); } + my $ans; + if ($coefs[$k] == 1) { $ans = ($others[$k]) ? "$others[$k]" : "1"; } + elsif ($coefs[$k] == -1) { $ans = ($others[$k]) ? "- $others[$k]" : "-1" } + else { $ans = "$coefs[$k] $others[$k]"; } + $k++; + + for $j ($k .. ($n - 1)) { + if ($coefs[$j] != 0) { + if ($coefs[$j] == 1) { + $ans .= ($others[$j]) ? "+ $others[$j]" : "+ 1"; + } elsif ($coefs[$j] == -1) { + $ans .= ($others[$j]) ? "- $others[$j]" : "-1"; + } else { + $ans .= "+ $coefs[$j] $others[$j]"; + } + } + } + return ($ans); +} + +# kludge to clean up path names +## allow underscore character in set and section names and also allows line breaks at / +sub protect_underbar { + my $in = shift; + if ($displayMode eq 'TeX') { + $in =~ s|_|\\\_|g; + $in =~ s|/|\\\-/|g; # allows an optional hyphenation of the path (in tex) + } + $in; +} + +# An example of a macro which prints out a list (with letters) +sub OL { + my @array = @_; + my $i = 0; + my @alpha = ('A' .. 'Z', 'AA' .. 'ZZ'); + my $letter; + my $out = MODES( + TeX => "\\begin{enumerate}\n", + Latex2HTML => " \\begin{rawhtml}
      \\end{rawhtml} ", + HTML => "
      \n", + PTX => '
        ' . "\n", + ); + my $elem; + foreach $elem (@array) { + $letter = shift @alpha; + $out .= MODES( + TeX => "\\item[$ALPHABET[$i].] $elem\n", + Latex2HTML => " \\begin{rawhtml}
      1. \\end{rawhtml} $elem ", + HTML => "
        $letter. $elem\n", + HTML_dpng => "
        $letter. $elem \n", + PTX => "

      2. $elem

        3. \n", + ); + $i++; + } + $out .= MODES( + TeX => "\\end{enumerate}\n", + Latex2HTML => " \\begin{rawhtml}
      \n \\end{rawhtml} ", + HTML => "
      \n", + PTX => '
    ' . "\n", + ); +} + +sub htmlLink { + my $url = shift; + my $text = shift; + my $options = shift; + my $sanitized_url = $url; + $sanitized_url =~ s/&/&/g; + $options = "" unless defined($options); + return "$BBOLD [ the link to '$text' is broken ] $EBOLD" unless defined($url) and $url; + MODES( + TeX => "{\\bf \\underline{$text}}", + HTML => "$text", + PTX => "$text", + ); +} + +# Suggested usage: knowlLink(text, [url => ..., value => ..., type => ...]) +sub knowlLink { + my $display_text = shift; + + # Check that there are an even number of inputs + WARN_MESSAGE( + 'usage: knowlLink($display_text, [url => $url, value => $helpMessage, type => "help/hint/solution/..."]);' + . qq!after the display_text the information requires key/value pairs. + Received @_ !, scalar(@_) % 2 + ) if scalar(@_) % 2; + + my %options = @_; + + my $properties = ''; + if ($options{value}) { + $properties = + 'data-knowl-contents="' + . encode_pg_and_html($options{value}) + . ($options{base64} ? '" data-base64="1"' : '"'); + } elsif ($options{url}) { + $properties = qq!data-knowl-url="$options{url}"!; + } else { + WARN_MESSAGE( + 'usage: knowlLink($display_text, [url => $url, value => $helpMessage, type => "help/hint/solution/..."]);' + ); + } + + $properties .= qq! data-type="$options{type}"! if $options{type}; + + MODES( + TeX => "{\\bf \\underline{$display_text}}", + HTML => qq!$display_text!, + PTX => '' . $display_text . '', + ); +} + +sub iframe { + my $url = shift; + my %options = @_; # keys: height, width, id, name + my $formatted_options = join(" ", map {qq!$_ = "$options{$_}"!} (keys %options)); + return "$BBOLD\[ broken link: $url \] $EBOLD" unless defined($url); + MODES( + TeX => "\\framebox{" . protect_underbar($url) . "}\n", + HTML => qq!\n \n!, + PTX => '', + ); +} + +sub helpLink { + my $type = shift; + my $display_text = shift || $type; + my $helpurl = shift; + return "" if (not defined($envir{'localHelpURL'})); + if (defined $helpurl) { + return knowlLink($display_text, url => $envir{'localHelpURL'} . $helpurl, type => 'help'); + } + my %typeHash = ( + 'angle' => 'Entering-Angles.html', + 'decimal' => 'Entering-Decimals.html', + 'equation' => 'Entering-Equations.html', + 'exponent' => 'Entering-Exponents.html', + 'formula' => 'Entering-Formulas.html', + 'fraction' => 'Entering-Fractions.html', + 'inequalit' => 'Entering-Inequalities.html', + 'limit' => 'Entering-Limits.html', + 'log' => 'Entering-Logarithms.html', + 'number' => 'Entering-Numbers.html', + 'point' => 'Entering-Points.html', + 'vector' => 'Entering-Vectors.html', + 'interval' => 'IntervalNotation.html', + 'unit' => 'Units.html', + 'syntax' => 'Syntax.html', + ); + + my $infoRef = ''; + my $refhold = ''; + for my $ref (keys %typeHash) { + if ($type =~ /$ref/i) { + $infoRef = $typeHash{$ref}; + $refhold = $ref; + last; + } + } + # We use different help files in some cases when BaseTenLog is set + if (PG_restricted_eval(q/$envir{useBaseTenLog}/)) { + $infoRef = 'Entering-Logarithms10.html' if ($refhold eq 'log'); + $infoRef = 'Entering-Formulas10.html' if ($refhold eq 'formula'); + } + + # If infoRef is still '', we give up and just print plain text + return $display_text unless ($infoRef); + return knowlLink($display_text, url => $envir{'localHelpURL'} . $infoRef, type => 'help'); +} + +# This method is deprecated. There is no hope for the problems that use it. Java and flash are dead. +sub appletLink { + warn 'Applet problems that use the appletLink method are no longer supported.'; + MODES( + TeX => "{\\bf WeBWorK does not support appletLink}", + HTML => "
    WeBWorK does not support appletLink
    ", + PTX => 'PreTeXt does not support appletLink', + ); +} + +sub spf { + my ($number, $format) = @_; # attention, the order of format and number are reversed + $format = "%4.3g" unless $format; # default value for format + sprintf($format, $number); +} + +sub sspf { + my ($number, $format) = @_; # attention, the order of format and number are reversed + $format = "%4.3g" unless $format; # default value for format + my $sign = $number >= 0 ? " + " : " - "; + $number = $number >= 0 ? $number : -$number; + $sign . sprintf($format, $number); +} + +=head2 Sorting and other list macros + + Usage: + lex_sort(@list); # outputs list in lexigraphic (alphabetical) order + num_sort(@list); # outputs list in numerical order + uniq( @list); # outputs a list with no duplicates. Order is unspecified. + + PGsort( \&sort_subroutine, @list); + # &sort_subroutine defines order. It's output must be 1 or 0 (true or false) + +=cut + +# uniq gives unique elements of a list: +sub uniq { + my @in = @_; + my %temp = (); + while (@in) { + $temp{ shift(@in) }++; + } + my @out = keys %temp; # sort is causing trouble with Safe.?? + @out; +} + +sub lex_sort { + PGsort(sub { $_[0] lt $_[1] }, @_); +} + +sub num_sort { + PGsort(sub { $_[0] < $_[1] }, @_); +} + +=head2 Macros for handling tables + + Usage: + begintable( number_of_columns_in_table) + row(@dataelements) + endtable() + +Example of useage: + + BEGIN_TEXT + This problem tests calculating new functions from old ones:$BR + From the table below calculate the quantities asked for:$BR + \{begintable(scalar(@firstrow)+1)\} + \{row(" \(x\) ", @firstrow)\} + \{row(" \(f(x)\) ", @secondrow)\} + \{row(" \(g(x)\) ", @thirdrow)\} + \{row(" \(f'(x)\) ", @fourthrow)\} + \{row(" \(g'(x)\) ", @fifthrow)\} + \{endtable()\} + + (The arrays contain numbers which are placed in the table.) + + END_TEXT + +=cut + +sub begintable { + my $number = shift; #number of columns in table + my %options = @_; + warn "begintable(cols) requires a number indicating the number of columns" unless defined($number); + my $out = ""; + if ($displayMode eq 'TeX') { + $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{" . "|c" x $number . "|} \\hline\n"; + } elsif ($displayMode eq 'PTX') { + $out .= "\n" . '' . "\n"; + } elsif ($displayMode eq 'Latex2HTML') { + $out .= "\n\\begin{rawhtml} \n\\end{rawhtml}"; + } elsif ($displayMode eq 'HTML_MathJax' + || $displayMode eq 'HTML_dpng' + || $displayMode eq 'HTML' + || $displayMode eq 'HTML_tth' + || $displayMode eq 'HTML_jsMath' + || $displayMode eq 'HTML_asciimath' + || $displayMode eq 'HTML_LaTeXMathML' + || $displayMode eq 'HTML_img') + { + $out .= "\n"; + } else { + $out = "Error: PGbasicmacros: begintable: Unknown displayMode: $displayMode.\n"; + } + $out; +} + +sub endtable { + my $out = ""; + if ($displayMode eq 'TeX') { + $out .= "\n\\end {tabular}\\end{center}\\par\\smallskip\n"; + } elsif ($displayMode eq 'PTX') { + $out .= "\n" . '' . "\n"; + } elsif ($displayMode eq 'Latex2HTML') { + $out .= "\n\\begin{rawhtml}
    \n\\end{rawhtml}"; + } elsif ($displayMode eq 'HTML_MathJax' + || $displayMode eq 'HTML_dpng' + || $displayMode eq 'HTML' + || $displayMode eq 'HTML_tth' + || $displayMode eq 'HTML_jsMath' + || $displayMode eq 'HTML_asciimath' + || $displayMode eq 'HTML_LaTeXMathML' + || $displayMode eq 'HTML_img') + { + $out .= "\n"; + } else { + $out = "Error: PGbasicmacros: endtable: Unknown displayMode: $displayMode.\n"; + } + $out; +} + +sub row { + my @elements = @_; + my $out = ""; + if ($displayMode eq 'TeX') { + while (@elements) { + $out .= shift(@elements) . " &"; + } + chop($out); # remove last & + $out .= "\\\\ \\hline \n"; + # carriage returns must be added manually for tex + } elsif ($displayMode eq 'PTX') { + $out .= '' . "\n"; + while (@elements) { + $out .= '' . shift(@elements) . '' . "\n"; + } + $out .= '' . "\n"; + } elsif ($displayMode eq 'Latex2HTML') { + $out .= "\n\\begin{rawhtml}\n\n\\end{rawhtml}\n"; + while (@elements) { + $out .= + " \n\\begin{rawhtml}\n \n\\end{rawhtml}\n" + . shift(@elements) + . " \n\\begin{rawhtml}\n \n\\end{rawhtml}\n"; + } + $out .= " \n\\begin{rawhtml}\n \n\\end{rawhtml}\n"; + } elsif ($displayMode eq 'HTML_MathJax' + || $displayMode eq 'HTML_dpng' + || $displayMode eq 'HTML' + || $displayMode eq 'HTML_tth' + || $displayMode eq 'HTML_jsMath' + || $displayMode eq 'HTML_asciimath' + || $displayMode eq 'HTML_LaTeXMathML' + || $displayMode eq 'HTML_img') + { + $out .= "\n"; + while (@elements) { + $out .= "" . shift(@elements) . ""; + } + $out .= "\n\n"; + } else { + $out = "Error: PGbasicmacros: row: Unknown displayMode: $displayMode.\n"; + } + $out; +} + +=head2 Macros for displaying images + +Usage: + + image($image, width => 100, height => 100, tex_size => 800, alt => 'alt text', extra_html_tags => 'style="border:solid black 1pt"'); + +where C<$image> can be a local file path, URL, WWPlot object, or LaTeXImage object, +C and C are pixel counts for HTML display, while C is +per 1000 applied to linewidth (for example 800 leads to 0.8\linewidth) + + image([$image1,$image2], width => 100, height => 100, tex_size => 800, alt => ['alt text 1','alt text 2'], extra_html_tags => 'style="border:solid black 1pt"'); + image([$image1,$image2], width => 100, height => 100, tex_size => 800, alt => 'common alt text', extra_html_tags => 'style="border:solid black 1pt"'); + +this produces an array in array context and joins the elements with C<' '> in scalar context + +=cut + +# More advanced macros +sub image { + my $image_ref = shift; + my @opt = @_; + unless (scalar(@opt) % 2 == 0) { + warn "ERROR in image macro. A list of macros must be inclosed in square brackets."; + } + my %in_options = @opt; + my %known_options = ( + width => 100, + height => '', + tex_size => 800, + # default value for alt is undef, since an empty string is the explicit indicator of a decorative image + alt => undef, + extra_html_tags => '', + ); + # handle options + my %out_options = %known_options; + foreach my $opt_name (keys %in_options) { + if (exists($known_options{$opt_name})) { + $out_options{$opt_name} = $in_options{$opt_name} if exists($in_options{$opt_name}); + } else { + die "Option $opt_name not defined for image. " . "Default options are:
    ", + display_options2(%known_options); + } + } + my $width = $out_options{width}; + my $height = $out_options{height}; + my $tex_size = $out_options{tex_size}; + my $alt = $out_options{alt}; + my $width_ratio = $tex_size * (.001); + my @image_list = (); + my @alt_list = (); + + # if height was explicitly given, create string for height attribute to be used in HTML, LaTeX2HTML + # otherwise omit a height attribute and allow the browser to use aspect ratio preservation + my $height_attrib = ''; + $height_attrib = qq{height = "$height"} if ($height); + + if (ref($image_ref) =~ /ARRAY/) { + @image_list = @{$image_ref}; + } else { + push(@image_list, $image_ref); + } + if (ref($alt) =~ /ARRAY/) { + @alt_list = @{$alt}; + } else { + for my $i (@image_list) { push(@alt_list, $alt) } + } + + my @output_list = (); + while (@image_list) { + my $image_item = shift @image_list; + $image_item = insertGraph($image_item) + if (ref $image_item eq 'WWPlot' || ref $image_item eq 'LaTeXImage' || ref $image_item eq 'PGtikz'); + my $imageURL = alias($image_item) // ''; + $imageURL = ($envir{use_site_prefix}) ? $envir{use_site_prefix} . $imageURL : $imageURL; + my $out = ""; + + if ($displayMode eq 'TeX') { + my $imagePath = $imageURL; # in TeX mode, alias gives us a path, not a URL + + # We're going to create PDF files with our TeX (using pdflatex), so + # alias should have given us the path to a PNG image. + if ($imagePath) { + $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n"; + } else { + $out = ""; + } + } elsif ($displayMode eq 'Latex2HTML') { + my $wid = ($envir->{onTheFlyImageSize} || 0) + 30; + $out = + qq!\\begin{rawhtml}\n\n + \\end{rawhtml}\n ! + } elsif ($displayMode eq 'HTML_MathJax' + || $displayMode eq 'HTML_dpng' + || $displayMode eq 'HTML' + || $displayMode eq 'HTML_tth' + || $displayMode eq 'HTML_jsMath' + || $displayMode eq 'HTML_asciimath' + || $displayMode eq 'HTML_LaTeXMathML' + || $displayMode eq 'HTML_img') + { + my $altattrib = ''; + if (defined $alt_list[0]) { $altattrib = 'alt="' . encode_pg_and_html(shift @alt_list) . '"' } + $out = + qq!!; + } elsif ($displayMode eq 'PTX') { + my $ptxwidth = 100 * $width / 600; + if (defined $alt) { + $out = qq!$alt!; + } else { + $out = qq!!; + } + } else { + $out = "Error: PGbasicmacros: image: Unknown displayMode: $displayMode.\n"; + } + push(@output_list, $out); + } + return wantarray ? @output_list : join(' ', @output_list); +} + +#This is bare bones code for embedding svg +sub embedSVG { + my $file_name = shift; # just input the file name of the svg image + my $backup_file_name = shift // ''; # a png version + my $str = ''; + if ($backup_file_name) { + $str = q!" oneerror="this.src='! . alias($backup_file_name) . q!'!; + } + return MODES( + HTML => q! + !, + TeX => "\\includegraphics[width=6in]{" . alias($file_name) . "}", + PTX => '', + ); +} + +# This is bare bones code for embedding png files -- what else should be added? (there are .js scripts for example) +sub embedPDF { + my $file_name = shift; # just input the file name of the svg image + #my $backup_file_name = shift//''; # a png version + return MODES( + HTML => q! + !, + TeX => "\\includegraphics[width=6in]{" . alias($file_name) . "}", + PTX => '', + ); +} + +sub video { + my $video_ref = shift; + my @opt = @_; + unless (scalar(@opt) % 2 == 0) { + warn "ERROR in video macro. A list of macros must be inclosed in square brackets."; + } + my %in_options = @opt; + my %known_options = ( + width => 400, + height => 400, + extra_html_tags => '', + ); + # handle options + my %out_options = %known_options; + foreach my $opt_name (keys %in_options) { + if (exists($known_options{$opt_name})) { + $out_options{$opt_name} = $in_options{$opt_name} if exists($in_options{$opt_name}); + } else { + die "Option $opt_name not defined for video. " . "Default options are:
    ", + display_options2(%known_options); + } + } + my $width = $out_options{width}; + my $height = $out_options{height}; + + my @video_list = (); + + if (ref($video_ref) =~ /ARRAY/) { + @video_list = @{$video_ref}; + } else { + push(@video_list, $video_ref); + } + + my @output_list = (); + while (@video_list) { + + my $video = shift @video_list // ''; + my $videoURL = alias($video) // ''; + $video =~ /.*\.(\w*)/; + my $type = $1; + my $out; + my $htmlmessage = maketext("Your browser does not support the video tag."); + + if ($displayMode eq 'TeX') { + + $videoURL = ($envir{use_site_prefix}) ? $envir{use_site_prefix} . $videoURL : $videoURL; + $out = + "\\begin{center} {\\bf " + . maketext("This problem contains a video which must be viewed online.") + . "} \\end{center}"; + + } elsif ($displayMode eq 'Latex2HTML') { + $out = qq!\\begin{rawhtml}\n + \\end{rawhtml}\n ! + } elsif ($displayMode eq 'HTML_MathJax' + || $displayMode eq 'HTML_dpng' + || $displayMode eq 'HTML' + || $displayMode eq 'HTML_tth' + || $displayMode eq 'HTML_jsMath' + || $displayMode eq 'HTML_asciimath' + || $displayMode eq 'HTML_LaTeXMathML' + || $displayMode eq 'HTML_img') + { + $out = qq!\n + ! + } elsif ($displayMode eq 'PTX') { + my $ptxwidth = 100 * $width / 600; + $out = qq!    "; - } # now if it is a Layout Table... - else { - $table = '
    '; - for my $i (0 .. $#{$dataref}) { - if ($i == $#{$dataref} and ($midrules == 1)) { $midrulescss .= "border-bottom:solid 1px;"; } - my $midrulecss = ($midrule[$i] == 1) ? 'border-bottom:solid 1px; ' : ''; - $table .= '
    '; - for my $j (0 .. $numcols[$i]) { - $table .= - '
    ' - . ${ $dataref->[$i][$j] }{data} - . '
    '; - } - $table .= "
    "; - } - $table .= "
    "; - } - - #when \multicolumn{}{}{} is needed... - for my $i (0 .. $#{$dataref}) { - for my $j (0 .. $numcols[$i]) { - ${ $dataref->[$i][$j] }{multicolumn} = ''; - if ((${ $dataref->[$i][$j] }{halign} ne '') or (${ $dataref->[$i][$j] }{colspan} ne '')) { - ${ $dataref->[$i][$j] }{multicolumn} = '\multicolumn{'; - if (${ $dataref->[$i][$j] }{colspan} ne '') { - ${ $dataref->[$i][$j] }{multicolumn} .= ${ $dataref->[$i][$j] }{colspan}; - } else { - ${ $dataref->[$i][$j] }{multicolumn} .= '1'; - } - ${ $dataref->[$i][$j] }{multicolumn} .= '}{'; - if (${ $dataref->[$i][$j] }{halign} ne '') { - ${ $dataref->[$i][$j] }{multicolumn} .= ${ $dataref->[$i][$j] }{halign}; - } else { - ${ $dataref->[$i][$j] }{multicolumn} .= 'c'; - } - ${ $dataref->[$i][$j] }{multicolumn} .= '}{'; - } - } - } - - my $textable = ''; - # build tex string for the table - if ($options{LaYoUt} != 1) { - my ($begintabular, $endtabular) = ('\begin{tabular}', '\end{tabular}'); - if ($texalignment =~ /X/) { - ($begintabular, $endtabular) = ('\begin{tabularx}{' . $Xratio . '\linewidth}', '\end{tabularx}'); - } - $textable = '\par\begin{minipage}{\linewidth}'; - if ($center == 1) { $textable .= '\centering'; } - if ($caption ne '') { - $textable .= - '\captionsetup{textfont={sc},belowskip=12pt,aboveskip=4pt}\captionof*{table}{' . $caption . '}'; - } - $textable .= $begintabular . '{' . $texalignment . '}' . '\toprule'; - for my $i (0 .. $#{$dataref}) { - if ($rowcolor[$i] ne '') { $textable .= '\rowcolor' . $rowcolor[$i]; } - for my $j (0 .. $numcols[$i]) - - { - if (grep { uc(${ $dataref->[$i][$j] }{header}) eq $_ } ('TH', 'CH', 'COLUMN', 'COL', 'RH', 'ROW') - or ($headerrow[$i] == 1) and !(uc(${ $dataref->[$i][$j] }{header}) eq 'TD')) - { - ${ $dataref->[$i][$j] }{tex} = '\bfseries ' . ${ $dataref->[$i][$j] }{tex}; - } - - if (${ $dataref->[$i][$j] }{multicolumn} ne '') { $textable .= ${ $dataref->[$i][$j] }{multicolumn} } - $textable .= - ${ $dataref->[$i][$j] }{texpre} . ' ' - . ${ $dataref->[$i][$j] }{tex} . ' ' - . ${ $dataref->[$i][$j] }{data} . ' ' - . ${ $dataref->[$i][$j] }{texpost}; - if (${ $dataref->[$i][$j] }{multicolumn} ne '') { $textable .= '}' } - $textable .= '&' unless ($j == $numcols[$i]); - } - $textable .= '\\\\'; - if ($midrule[$i] == 1) { $textable .= '\midrule ' } - if ((($midrules == 1) or ($headerrow[$i] == 1)) and ($i != $#{$dataref})) { $textable .= '\midrule ' } - } - $textable .= '\bottomrule' . $endtabular; - $textable .= '\end{minipage}\par \vspace{1pc}'; - } # and now if it is a Layout Table... - else { - my ($begintabular, $endtabular) = ('\begin{tabular}', '\end{tabular}'); - if ($texalignment =~ /X/) { - ($begintabular, $endtabular) = ('\begin{tabularx}{' . $Xratio . '\linewidth}', '\end{tabularx}'); - } - - $textable = ($center == 1) ? '\begin{center}' : '\begin{flushleft}'; - $textable .= '{\renewcommand{\arraystretch}{2}'; - $textable .= $begintabular . '{' . $texalignment . '}'; - for my $i (0 .. $#{$dataref}) { - if ($rowcolor[$i] ne '') { $textable .= '\rowcolor' . $rowcolor[$i]; } - for my $j (0 .. $numcols[$i]) { - if (${ $dataref->[$i][$j] }{halign} ne '') { - $textable .= '\multicolumn{1}{' . ${ $dataref->[$i][$j] }{halign} . '}{'; - } - $textable .= - ${ $dataref->[$i][$j] }{tex} . ' ' - . ${ $dataref->[$i][$j] }{texpre} . ' ' - . ${ $dataref->[$i][$j] }{data} . ' ' - . ${ $dataref->[$i][$j] }{texpost}; - if (${ $dataref->[$i][$j] }{halign} ne '') { $textable .= '}' } - $textable .= '&' unless ($j == $numcols[$i]); - } - $textable .= '\\\\'; - if ($midrule[$i] == 1) { $textable .= '\midrule ' } - if (($midrules == 1) and ($i != $#{$dataref})) { $textable .= '\midrule ' } - } - $textable .= $endtabular; - $textable .= '}'; - if ($center == 1) { $textable .= '\end{center}' } - else { $textable .= '\end{flushleft}' } - } - - MODES( - TeX => $textable, - HTML => $table, - PTX => $ptxtable, - ); -} - -=pod - -Command for table to control layout - -Usage: LayoutTable(...) - See usage for DataTable. The HTML output will use section and div boxes instead of HTML tabling elements - Anything having to do with headers, captions, and data cells no longer make sense (although 'data' is still - used as the key for cell contents). - -=cut - -sub LayoutTable { - my $dataref = shift; - if ($main::displayMode eq 'PTX') { DataTable($dataref, @_); } - else { DataTable($dataref, LaYoUt => 1, @_); } -} - -sub TeX_Alignment_to_CSS { - my $alignmentstring = shift; - my $bracesregex = qr/(\{(?>[^{}]|(?R))*\})/x; - # grabs outer level braces and their contents, including inner brace pairs - my $bracecontentsregex = qr/((?>[^{}]|(??{$bracesregex}))*)/x; - # grabs contents of an outer level brace pair, including inner brace pairs - - my $css = ''; - if ($alignmentstring =~ /r\s*/) { - $css .= "text-align:right; white-space:nowrap; "; - } elsif ($alignmentstring =~ /c\s*/) { - $css .= "text-align:center; white-space:nowrap; "; - } elsif ($alignmentstring =~ /l\s*/) { - $css .= "text-align:left; white-space:nowrap; "; - } elsif ($alignmentstring =~ /X\s*/) { - $css .= "text-align:justify; white-space:normal; "; - } elsif ($alignmentstring =~ /p\s*\{((??{$bracecontentsregex}))\}\s*/) { - $css .= "text-align:justify; white-space:normal; width:" . $1 . "; "; - } - return $css; -} - -1; diff --git a/macros/Parser.pl b/macros/parsers/Parser.pl similarity index 100% rename from macros/Parser.pl rename to macros/parsers/Parser.pl diff --git a/macros/parserAssignment.pl b/macros/parsers/parserAssignment.pl similarity index 100% rename from macros/parserAssignment.pl rename to macros/parsers/parserAssignment.pl diff --git a/macros/parserAutoStrings.pl b/macros/parsers/parserAutoStrings.pl similarity index 100% rename from macros/parserAutoStrings.pl rename to macros/parsers/parserAutoStrings.pl diff --git a/macros/parserCustomization.pl b/macros/parsers/parserCustomization.pl similarity index 100% rename from macros/parserCustomization.pl rename to macros/parsers/parserCustomization.pl diff --git a/macros/parserDifferenceQuotient.pl b/macros/parsers/parserDifferenceQuotient.pl similarity index 100% rename from macros/parserDifferenceQuotient.pl rename to macros/parsers/parserDifferenceQuotient.pl diff --git a/macros/parserFormulaAnyVar.pl b/macros/parsers/parserFormulaAnyVar.pl similarity index 100% rename from macros/parserFormulaAnyVar.pl rename to macros/parsers/parserFormulaAnyVar.pl diff --git a/macros/parserFormulaUpToConstant.pl b/macros/parsers/parserFormulaUpToConstant.pl similarity index 100% rename from macros/parserFormulaUpToConstant.pl rename to macros/parsers/parserFormulaUpToConstant.pl diff --git a/macros/parserFormulaWithUnits.pl b/macros/parsers/parserFormulaWithUnits.pl similarity index 100% rename from macros/parserFormulaWithUnits.pl rename to macros/parsers/parserFormulaWithUnits.pl diff --git a/macros/parserFunction.pl b/macros/parsers/parserFunction.pl similarity index 100% rename from macros/parserFunction.pl rename to macros/parsers/parserFunction.pl diff --git a/macros/parserFunctionPrime.pl b/macros/parsers/parserFunctionPrime.pl similarity index 100% rename from macros/parserFunctionPrime.pl rename to macros/parsers/parserFunctionPrime.pl diff --git a/macros/parserGraphTool.pl b/macros/parsers/parserGraphTool.pl similarity index 100% rename from macros/parserGraphTool.pl rename to macros/parsers/parserGraphTool.pl diff --git a/macros/parserImplicitEquation.pl b/macros/parsers/parserImplicitEquation.pl similarity index 100% rename from macros/parserImplicitEquation.pl rename to macros/parsers/parserImplicitEquation.pl diff --git a/macros/parserImplicitPlane.pl b/macros/parsers/parserImplicitPlane.pl similarity index 100% rename from macros/parserImplicitPlane.pl rename to macros/parsers/parserImplicitPlane.pl diff --git a/macros/parserLinearInequality.pl b/macros/parsers/parserLinearInequality.pl similarity index 100% rename from macros/parserLinearInequality.pl rename to macros/parsers/parserLinearInequality.pl diff --git a/macros/parserMultiAnswer.pl b/macros/parsers/parserMultiAnswer.pl similarity index 100% rename from macros/parserMultiAnswer.pl rename to macros/parsers/parserMultiAnswer.pl diff --git a/macros/parserMultiPart.pl b/macros/parsers/parserMultiPart.pl similarity index 100% rename from macros/parserMultiPart.pl rename to macros/parsers/parserMultiPart.pl diff --git a/macros/parserNumberWithUnits.pl b/macros/parsers/parserNumberWithUnits.pl similarity index 100% rename from macros/parserNumberWithUnits.pl rename to macros/parsers/parserNumberWithUnits.pl diff --git a/macros/parserOneOf.pl b/macros/parsers/parserOneOf.pl similarity index 100% rename from macros/parserOneOf.pl rename to macros/parsers/parserOneOf.pl diff --git a/macros/parserParametricLine.pl b/macros/parsers/parserParametricLine.pl similarity index 100% rename from macros/parserParametricLine.pl rename to macros/parsers/parserParametricLine.pl diff --git a/macros/parserParametricPlane.pl b/macros/parsers/parserParametricPlane.pl similarity index 100% rename from macros/parserParametricPlane.pl rename to macros/parsers/parserParametricPlane.pl diff --git a/macros/parserPopUp.pl b/macros/parsers/parserPopUp.pl similarity index 100% rename from macros/parserPopUp.pl rename to macros/parsers/parserPopUp.pl diff --git a/macros/parserPrime.pl b/macros/parsers/parserPrime.pl similarity index 100% rename from macros/parserPrime.pl rename to macros/parsers/parserPrime.pl diff --git a/macros/parserQuotedString.pl b/macros/parsers/parserQuotedString.pl similarity index 100% rename from macros/parserQuotedString.pl rename to macros/parsers/parserQuotedString.pl diff --git a/macros/parserRadioButtons.pl b/macros/parsers/parserRadioButtons.pl similarity index 100% rename from macros/parserRadioButtons.pl rename to macros/parsers/parserRadioButtons.pl diff --git a/macros/parserRoot.pl b/macros/parsers/parserRoot.pl similarity index 100% rename from macros/parserRoot.pl rename to macros/parsers/parserRoot.pl diff --git a/macros/parserSolutionFor.pl b/macros/parsers/parserSolutionFor.pl similarity index 100% rename from macros/parserSolutionFor.pl rename to macros/parsers/parserSolutionFor.pl diff --git a/doc/MathObjects/macros/parserUtils.pl b/macros/parsers/parserUtils.pl old mode 100644 new mode 100755 similarity index 92% rename from doc/MathObjects/macros/parserUtils.pl rename to macros/parsers/parserUtils.pl index 136d84f5f0..b47528bc21 --- a/doc/MathObjects/macros/parserUtils.pl +++ b/macros/parsers/parserUtils.pl @@ -46,7 +46,10 @@ sub HTML { # sub protectHTML { my $string = shift; - return encode_pg_and_html($string); + $string =~ s/&/\&/g; + $string =~ s//\>/g; + $string; } sub _parserUtils_init { } diff --git a/macros/parserVectorUtils.pl b/macros/parsers/parserVectorUtils.pl similarity index 97% rename from macros/parserVectorUtils.pl rename to macros/parsers/parserVectorUtils.pl index ef64bc5643..72a35dc269 100644 --- a/macros/parserVectorUtils.pl +++ b/macros/parsers/parserVectorUtils.pl @@ -67,8 +67,8 @@ sub BoldMath { my $v = shift; my $HTML = '' . $v . ''; MODES( - TeX => "\\boldsymbol{$v}", # doesn't seem to work in TeX mode - # TeX => "\\mathbf{$v}", # gives non-italic bold in TeX mode + TeX => "\\boldsymbol{$v}", # doesn't seem to work in TeX mode + # TeX => "\\mathbf{$v}", # gives non-italic bold in TeX mode Latex2HTML => "\\boldsymbol{$v}", HTML => $HTML, HTML_tth => '\begin{rawhtml}' . $HTML . '\end{rawhtml}', diff --git a/macros/parserWordCompletion.pl b/macros/parsers/parserWordCompletion.pl similarity index 100% rename from macros/parserWordCompletion.pl rename to macros/parsers/parserWordCompletion.pl diff --git a/macros/PGchoicemacros.pl b/macros/ui/PGchoicemacros.pl similarity index 100% rename from macros/PGchoicemacros.pl rename to macros/ui/PGchoicemacros.pl diff --git a/macros/PGinfo.pl b/macros/ui/PGinfo.pl similarity index 100% rename from macros/PGinfo.pl rename to macros/ui/PGinfo.pl diff --git a/macros/alignedChoice.pl b/macros/ui/alignedChoice.pl similarity index 100% rename from macros/alignedChoice.pl rename to macros/ui/alignedChoice.pl diff --git a/macros/ui/choiceUtils.pl b/macros/ui/choiceUtils.pl new file mode 100755 index 0000000000..c67631dba8 --- /dev/null +++ b/macros/ui/choiceUtils.pl @@ -0,0 +1,90 @@ +sub _choiceUtils_init { }; # don't reload this file + +# +# A replacement for std_print_q that uses tables to align the questions, so +# that if a question wraps, it is properly indented. +# + +sub alt_print_q { + my $self = shift; + my @questions = @_; + my $length = $self->{ans_rule_len}; + my $sep = $self->{separation}; + $sep = 0 unless defined($sep); + my $valign = $self->{valign}; + $valign = "TOP" unless defined($valign); + my $i = 1; + my $quest; + + my $out = ""; + if ($main::displayMode =~ m/^HTML/) { + $out = "\n

    \n\n"; + foreach $quest (@questions) { + $out .= + '\n"; + } + $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}' . "\n"; + } + $out .= "\\begin{rawhtml}
    \end{rawhtml}' + . ans_rule($length) + . '\begin{rawhtml} ' + . $i++ + . '. \\end{rawhtml} ' + . $quest + . '\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}} + . qq{\\end{rawhtml}\n}, + HTML => qq{\n}, + ); + $i++; + } + $out .= MODES( + TeX => "\\end{enumerate}\n", + Latex2HTML => "\\begin{rawhtml}
    $c. \\end{rawhtml}$elem\\begin{rawhtml}
    $c. $elem
    \\end{rawhtml}\n", + HTML => "\n", + ); + $out; +} + +1; diff --git a/macros/ui/pccTables.pl b/macros/ui/pccTables.pl new file mode 100755 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 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 97% rename from macros/text2PG.pl rename to macros/ui/text2PG.pl index 427d817816..164bf4cc60 100644 --- a/macros/text2PG.pl +++ b/macros/ui/text2PG.pl @@ -61,9 +61,8 @@ sub text2PG { my $i = 0; if ($options{allowCommands}) { @parts = split(/(\\\{.*?\\\}|``.*?``\*?|`.+`\*?|\\\(.*?\\\)|\\\[.*?\\\])/s, $string); - } else { - @parts = split(/(``.*?``\*?|`.+`\*?|\\\(.*?\\\)|\\\[.*?\\\])/s, $string); } + else { @parts = split(/(``.*?``\*?|`.+`\*?|\\\(.*?\\\)|\\\[.*?\\\])/s, $string) } while ($i <= $#parts) { if ($options{sanitizeText}) { if ($displayMode eq 'TeX') { 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/macros/univ/Alfredmacros.pl b/macros/univ/Alfredmacros.pl new file mode 100755 index 0000000000..78ce2a9d0f --- /dev/null +++ b/macros/univ/Alfredmacros.pl @@ -0,0 +1,376 @@ +# A group of macros used in the Alfred problem library. + +sub _Alfredmacros_init { } #don't reload these macros. + +# Given a point (x,y) this macro computes the angle with respect to x-axis. The angle will be between 0 and 2pi. +sub inversetrig { + my $refangle = arctan(abs($_[1] / $_[0])); + if ($_[0] == 0) {0} + elsif ($_[0] > 0) { + if ($_[1] == 0) {0} + elsif ($_[1] > 0) { $refangle; } + else { 2 * pi- $refangle; } + } else { + if ($_[1] == 0) {pi} + elsif ($_[1] > 0) { pi- $refangle; } + else { pi + $refangle } + } +} + +## Compute the max and min of an array of numbers + +#This macro prevents students from double clicking in an answer box. This macro #is necessary for multiple integral problems where the answer box is typeset +#into the integration symbols. +sub doubleclickprevent { + TEXT(MODES( + TeX => "", + HTML => "" + )); +} + +#The problems that have the answer box in the limits must be displayed in JS +#math mode. This macro warns the user to use JS math mode if they are not. +sub jsMathwarn { + TEXT(MODES( + TeX => '', + HTML_jsMath => '', + HTML => $HR + . "Warning: to use this problem, you need to" + . "select jsMath mode in the Display Options panel at the left" + . $HR, + )); +} + +sub jsmathmode { + TEXT(MODES( + TeX => '', + HTML_jsMath => '', + HTML => $HR + . "Warning: to use this problem, you need to " + . "select jsMath mode in the Display Options panel at the left" + . $HR, + )); + TEXT(MODES( + TeX => "", + HTML => "" + )); + +} + +sub mathjaxmode { + TEXT(MODES( + TeX => '', + HTML_MathJax => '', + HTML => $HR + . "Warning: to use this problem, you need to " + . "select MathJax mode in the Display Options panel at the left" + . $HR, + )); +} + +#This subroutine includes the Strang's textbook into a problem, you have to +#feed it the chapter and section. It is assumed that the book is in the course +#directory and is labeled strangtextbook. The parameters are +#strang(chapter,section,(optional) section title. +#example \{&strang(16,5,"surface integrals")\}. +$wwstrang = "http://webwork.alfred.edu/webwork2_course_files/strangcalculus"; + +sub strang { + htmlLink( + qq!$wwstrang/Strang-$_[0]-$_[1].pdf!, + "$_[0].$_[1] $_[2] from Gilbert Strang's Calculus", + q/TARGET="new_window"/ + ); +} + +#Inserts a link to a trig table in the problem. +#example \{&trig_table()\} +sub trig_table { + htmlLink(qq!$wwstrang/trig_identities.pdf!, "Trig Identities", q/TARGET="new_window"/); +} + +sub strang_index { + htmlLink(qq!$wwstrang/Index.pdf!, "Index", q/TARGET="new_window"/); +} + +sub strang_TOC { + htmlLink(qq!$wwstrang/TOC.pdf!, "Table of Contents", q/TARGET="new_window"/); +} + +sub product_Rule_cmp { + my ($correct, $student, $self) = @_; + my ($f1stu, $f2stu, $f3stu, $f4stu) = @{$student}; + my ($f1, $f2, $f3, $f4) = @{$correct}; + my @fgrade = (0, 0, 0, 0); + my @fstu = ($f1stu, $f2stu, $f3stu, $f4stu); + my @fcorrect = ($f1, $f2, $f3, $f4); +#we will associate each student answer with a prime number, noting which student answer is in which blank. This allows us to make use of the fundamental theorem of arithmetic. + my @prime = (2, 3, 5, 7); + my @answerblank = (0, 0, 0, 0); + + for ($i = 0; $i < 4; $i++) { + for ($j = 0; $j < 4; $j++) { + if (($fcorrect[$i] == $fstu[$j]) && ($answerblank[$j] == 0)) { { + $answerblank[$j] = $prime[$i]; + $j = + 4 # you have to terminate the inner loop in this case for the special case of f=e^x where f and f' are the same. + } } + } + } + for ($i = 0; $i < 4; $i++) { + if (!$answerblank[$i]) { + $self->setMessage($i + 1, + "All of your answers should be $f, $g, or a derivative of one of these functions"); + } + } + #now we rely on the fact that products of primes are unique. First we check to see if all of the blanks are correct + if ((($answerblank[0] * $answerblank[1] == 6) && ($answerblank[2] * $answerblank[3] == 35)) + || (($answerblank[0] * $answerblank[1] == 35) && ($answerblank[2] * $answerblank[3] == 6))) + { + @fgrade = (1, 1, 1, 1); + } + #now check to see if the first pair of blanks is correct, knowing one pair is not + elsif ($answerblank[0] * $answerblank[1] == 6) { + if (($answerblank[2] == 5) || ($answerblank[2] == 7)) { + @fgrade = (1, 1, 1, 0); + } elsif (($answerblank[3] == 5) || ($answerblank[3] == 7)) { + @fgrade = (1, 1, 0, 1); + } else { + @fgrade = (1, 1, 0, 0); + } + } elsif ($answerblank[0] * $answerblank[1] == 35) { + if (($answerblank[2] == 2) || ($answerblank[2] == 3)) { + @fgrade = (1, 1, 1, 0); + } elsif (($answerblank[3] == 2) || ($answerblank[3] == 3)) { + @fgrade = (1, 1, 0, 1); + } else { + @fgrade = (1, 1, 0, 0); + } + } + #if both sets are not correct, and the first set is not correct, check to see if the last pair are + elsif ($answerblank[2] * $answerblank[3] == 6) { + if (($answerblank[0] == 5) || ($answerblank[0] == 7)) { + @fgrade = (1, 0, 1, 1); + } elsif (($answerblank[1] == 5) || ($answerblank[1] == 7)) { + @fgrade = (0, 1, 1, 1); + } else { + @fgrade = (0, 0, 1, 1); + } + } elsif ($answerblank[2] * $answerblank[3] == 35) { + if (($answerblank[0] == 2) || ($answerblank[0] == 3)) { + @fgrade = (1, 0, 1, 1); + } elsif (($answerblank[1] == 2) || ($answerblank[1] == 3)) { + @fgrade = (0, 1, 1, 1); + } else { + @fgrade = (0, 0, 1, 1); + } + } +#at this point they don't have a matched set of blanks correct. look for a single function in each pair that is right. You have to make sure you only get one for each pair of answer blanks. + else { + if (($answerblank[0]) + && ($answerblank[2]) + && ($answerblank[0] * $answerblank[2] != 6) + && ($answerblank[0] * $answerblank[2] != 35) + && ($answerblank[0] != $answerblank[2])) + { + @fgrade = (1, 0, 1, 0); + } elsif (($answerblank[0]) + && ($answerblank[3]) + && ($answerblank[0] * $answerblank[3] != 6) + && ($answerblank[0] * $answerblank[3] != 35) + && ($answerblank[0] != $answerblank[3])) + { + @fgrade = (1, 0, 0, 1); + } elsif (($answerblank[1]) + && ($answerblank[2]) + && ($answerblank[1] * $answerblank[2] != 6) + && ($answerblank[1] * $answerblank[2] != 35) + && ($answerblank[1] != $answerblank[2])) + { + @fgrade = (0, 1, 1, 0); + } elsif (($answerblank[1]) + && ($answerblank[3]) + && ($answerblank[1] * $answerblank[3] != 6) + && ($answerblank[1] * $answerblank[3] != 35) + && ($answerblank[1] != $answerblank[3])) + { + @fgrade = (0, 1, 0, 1); + } elsif ($answerblank[0]) { + @fgrade = (1, 0, 0, 0); + } elsif ($answerblank[1]) { + @fgrade = (0, 1, 0, 0); + } elsif ($answerblank[2]) { + @fgrade = (0, 0, 1, 0); + } elsif ($answerblank[3]) { + @fgrade = (0, 0, 0, 1); + } + } + return [@fgrade]; +} + +sub check_boundary_conditions { + my ($correct, $student, $self) = @_; + return product_Rule_cmp(@_); +} + +sub Snxy() { + my %args = @_; + my @x = @{ $args{inputs} }; + my @y = @{ $args{outputs} }; + my $m = $args{m}; + my $n = $args{n}; + my $i = 0; + my $sum = 0; + if ($#x == $#y) { + for ($i = 0; $i <= $#x; $i++) { + $sum = $sum + ($x[$i])**($n) * ($y[$i])**($m); + } + } else { + $sum = 0; + } + return $sum; +} + +### To use the macros your problem must include unionTables.pl, and of course Alfredmacros.pl +### Table integral returns a string that can be included in a Table to output an integral whose upper and lower limits +### of integration can be answer blanks. There are several optional parameters: +### width - change the width of the answer blanks. defaults to 3. +### lowerwidth - change the width of the lower answer blank. defaults to width +### upperwidth - change the width of the upper answer blank. defaults to width. +### upper - the uppper limit of integration, does not have to be an answer blank, defaults to answer blank with width "width" +### lower - the lower limit of integration, does not have to be an answer blank, defaults to answer blank with width "width" +### limits - boolean, if 1 puts the limits of integration above and below the integral symbol, if 0 puts them after the integral symbol. +### default is 1. +### Your code must include unionTables.pl, and of course Alfredmacros.pl +### An example: +### \{BeginTable(center=>0). +### Row([tableintegral(), +### ],separation=>2). +### EndTable(); +### \} +### which will print an integral with answer blank on the upper and lower limits with the default length of 3 +### +### This example prints out a double integral, the first integral with answer blanks with width 10, the second integral +### has 0 for the lower limit of integration and an answer blank with width 5 for the upper limit of integration. +### The default limits of integratin are answer blanks with width 3, in this case the default width was overridden to 5 +### and the default lower limit was changed to a zero. +### \{BeginTable(center=>0). +### Row([tableintegral(width=>10,limits=>'\(0\)'),tableintegral(width=>5,lower=>'\(0\)',limits=>0), +### ],separation=>2). +### EndTable(); +### \} +### An example where the width of the upper and lower answer blanks have different widths. +### \{BeginTable(center=>0). +### Row([tableintegral(lowerwidth=>10,upperwidth=>1) +### ],separation=>2). +### EndTable(); +### \} + +sub tableintegral { + my %arg = @_; + my $width = delete $arg{width} // 3; + my $lowerwidth = delete $arg{lowerwidth} // $width; + my $upperwidth = delete $arg{upperwidth} // $width; + my $lower = delete $arg{lower} // ans_rule($lowerwidth); + my $upper = delete $arg{upper} // ans_rule($upperwidth); + my $limits = delete $arg{limits} // 1; + if ($limits == 1) { + return $upper . $BR . '\(\displaystyle\int\)' . $BR . $lower; + } else { + return '\(\displaystyle\int\)', $upper . $BR . $BR . $lower; + } +} + +# a sum with answer blanks for the summation variable, lower limit, and upper limit +#\{ BeginTable(center=>0). +# Row([tablesum(width=>10), +# ],separation=>2). +# EndTable(); +#\} +# a sum with answer blanks for the upper and lower limits, and the summation variable is i +#\{ BeginTable(center=>0). +# Row([tablesum(width=>10,sumvariable=>'i'), +# ],separation=>2). +# EndTable(); +#\} +# a sum with answer blanks for the upper and lower limits, and summation variable is not used. +#\{ BeginTable(center=>0). +# Row([tablesum(width=>10,usesumvariable=>0), +# ],separation=>2). +# EndTable(); +#\} +# sum from n = 1 to infinity +#\{ BeginTable(center=>0). +# Row([tablesum(sumvariable=>'\(n\)',lower=>'\(1\)', upper=>'\(\hskip 3pt\infty\)') ],separation=>2). +# EndTable(); +#\} + +sub tablesum { + my %arg = @_; + my $width = delete $arg{width} // 3; + my $lowerwidth = delete $arg{lowerwidth} // $width; + my $upperwidth = delete $arg{upperwidth} // $width; + my $lower = delete $arg{lower} // ans_rule($lowerwidth); + my $upper = delete $arg{upper} // ans_rule($upperwidth); + my $limits = delete $arg{limits} // 1; + my $sumvariable = delete $arg{sumvariable} // ans_rule($width); + my $usesumvariable = delete $arg{usesumvariable} // 1; + + if ($usesumvariable == 0) { + if ($limits == 1) { + return $upper . $BR . '\(\displaystyle\sum\)' . $BR . $lower; + } else { + return '\(\displaystyle\int\)', $upper . $BR . $BR . $lower; + } + } else { + if ($limits == 1) { + return $upper . $BR . '\(\displaystyle\sum\)' . $BR . $sumvariable . '\( = \)' . $lower; + } else { + return '\(\displaystyle\int\)', $upper . $BR . $BR . $sumvariable . '\( = \)' . $lower; + } + } +} + +### Create a vertical bar with an upper and lower limit. +sub tableevaluate { + my %arg = @_; + my $width = delete $arg{width} // 3; + my $lowerwidth = delete $arg{lowerwidth} // $width; + my $upperwidth = delete $arg{upperwidth} // $width; + my $lower = delete $arg{lower} // ans_rule($lowerwidth); + my $upper = delete $arg{upper} // ans_rule($upperwidth); + return '\(\Bigg\vert\)', $upper . $BR . $BR . $lower; +} + +### Create a subscripted character +sub tablesubscript { + my %arg = @_; + my $width = delete $arg{width} // 3; + my $lower = delete $arg{lower} // ans_rule($width); + my $variable = delete $arg{variable} // 'c'; + return $variable, $BR . $BR . $lower; +} + +### Create a superscripted character +sub tablesuperscript { + my %arg = @_; + my $width = delete $arg{width} // 3; + my $upper = delete $arg{upper} // ans_rule($width); + my $variable = delete $arg{variable} // 'c'; + return $variable, $upper . $BR . $BR . $BR; +} + +### A fraction +sub tablefrac { + my %arg = @_; + my $width = delete $arg{width} // 3; + my $lower = delete $arg{lower} // ans_rule($width); + my $upper = delete $arg{upper} // ans_rule($width); + my $barwidth = delete $arg{barwidth} // 10 + $width; + my $divisionbar = ""; + for ($count = 1; $count <= $barwidth; $count++) { + $divisionbar = $divisionbar . "-"; + } + return $upper . $BR . $divisionbar . $BR . $lower; +} + diff --git a/macros/univ/BrockPhysicsMacros.pl b/macros/univ/BrockPhysicsMacros.pl new file mode 100644 index 0000000000..61c5d1a210 --- /dev/null +++ b/macros/univ/BrockPhysicsMacros.pl @@ -0,0 +1 @@ +# this file defines all Brock-Physics-specific macros. diff --git a/macros/univ/CofIdaho_macros.pl b/macros/univ/CofIdaho_macros.pl new file mode 100755 index 0000000000..351fec2427 --- /dev/null +++ b/macros/univ/CofIdaho_macros.pl @@ -0,0 +1,723 @@ + +=pod + +=head1 NAME + + extra macros for Intermediate Algebra problems at The College of Idaho + +=head1 Synposis + macros by R Cruz -- The College of Idaho +=cut + +=head3 Format the instuctor answer + +=pod + +1) SimplifyExponents: Formats an expression without negative exponents + To use: SimplifyExponents(num, den,~~@var,@exp); + where num = numerator's constant + den = denominator's constant + ~~@var = pointer to an array with the list of variables + @exp = array with the exponents for the variables + +2) num_and_unit_checker: Checks for units like "apples" or "oranges" + To use: ANS (num_and_units_checker($correct_answer, "units"); + +3) strict_percent_cmp: Checks percentages have been rounded as required. + To use: ANS(strict_percent_cmp($answer,"%",roundto)); + where $answer is in percent form: xx.x + roundto = "tenths" or "hundredths" + +4) Picky_equation_cmp: Checks both sides of an equation model the word problem. + To use: Picky_equation_cmp("2x+1=5"); + Note: This one allows only the variables that have been used in the CofIdaho + problems. It should be changed so that it is more flexible, or better, + convert it to a MathObject. + +5) SlopeIntercept_equation_cmp: Checks both sides of an equation for the + slope-intercept form of a line. + To use: ANS(SlopeIntercept_equation_cmp($answer)); + where $answer = "y = $m x + $b"; (Use only y and x for variables.) + +6) functionNotation_cmp: Checks for "f(x)= ***" notation + To use: + ANS(functionNotation_cmp("f(x)=2x",["x","f"])); + +7) Checks factors of polynomials. + To use: The answer must be submitted in this form: + ANS(FactorEvaluator($answer,[variable array])); + If the polynomial is prime: + ANS(FactorEvaluator("Does not factor",polynomial,[variable array])); + + Note: Answers must be in the form: monomial(poly)...(poly) with + or without parentheses about the monomial. The polynomial factors must + not contain any other grouping symbols and, in any case, only parenthesis + may be used. This needs to be in the instructions for any set that uses + this macro (in the screenHeader.pg file). + + Note: "StrictFactoringEvaluator" requires leading negatives to be factored out. + This not may not work with all situations. BE SURE TO CHANGE THIS FILE IF THE + FactoringEvaluator IS CHANGED!! + +8) RationalExpEvaluator: Checks for simplified rational expressions. + To use: ANS(RationalExpEvaluation($answer,[variable array])); + or something like: ANS(RationalExpEvaluator($answer,["x","y"])); + + Note: Answers must be of the form: (poly)/(poly) + +9) ReduceFraction: Returns a string that represents a reduced fraction. + To use: $a = SimplifyFraction(numerator expression,denominator espression); +=cut + +################################################################### +# 1) Formats an expression without negative exponents +# Thanks to John Jones at ASU for this macro. + +sub SimplifyExponents { + loadMacros("contextLimitedPowers.pl"); + my $num = shift; + my $den = shift; + my $varref = shift; + my @expos = @_; + my @vars = @$varref; + + Context()->operators->set(@LimitedPowers::OnlyPositiveIntegers); + + my $answer_n = Formula("$num"); + my $answer_d = Formula("$den"); + + for $j (0 .. (scalar(@vars) - 1)) { + $answer_n *= Formula("$vars[$j]^$expos[$j] ") if ($expos[$j] > 0); + $answer_d *= Formula("$vars[$j]^(-1*$expos[$j]) ") if ($expos[$j] < 0); + } + + $answer = $answer_n / $answer_d; + + return ($answer->reduce()); +} + +sub Simplified { + my ($correct, $student, $ah) = @_; + return unless $ah->{score} == 1; #This does not work??? + my $VariablesPlus1 = 2; #Put in the number of variables plus 1 + my $check = $ah->{student_ans}; + if (!($ah->{isPreview}) + && $correct == $student + && $check =~ /(([abxy].*){$VariablesPlus1,})|([\Q^].*[\Q^])/) + { + $ah->{ans_message} = "Simplify your answer"; + } + + return ($correct == $student && ($ah->{student_ans} !~ /(([abxy].*){$VariablesPlus1,})|([\Q^].*[\Q^])/)); +} + +################################################################### +# 2) Checks for units + +sub num_and_unit_checker { + my $correct_ans = shift; #the answer + my $correct_units = shift; #the unit type + my $old_evaluator = num_cmp($correct_ans); + + my $new_evaluator = sub { + my $student_ans = shift; + my $formatted_ans = $student_ans; + $formatted_ans =~ s{$correct_units}{}; + my $ans_hash = $old_evaluator->evaluate($formatted_ans); + if ($student_ans !~ /$correct_units/) { + $ans_hash->{score} = 0; + $ans_hash->setKeys('ans_message' => "Enter your answer with the correct units: $correct_units"); + } + $ans_hash->{original_student_ans} = "$student_ans"; + $ans_hash->{preview_latex_string} = "$student_ans"; + $ans_hash->{student_ans} = "$student_ans"; + $ans_hash->{correct_ans} = "$correct_ans" . " $correct_units"; + + return $ans_hash; + }; + + return $new_evaluator; +} + +################################################################### +# 3) Checks for rounded percents + +sub strict_percent_cmp { + my $correct_ans = shift; #the answer + my $correct_units = shift; #the unit type which should be "%" + my $error = shift; #what to round to + my $errorAmount = .1; + if ($error eq "hundredth") { $errorAmount = .01; } + my $old_evaluator = num_cmp($correct_ans, tol => 0); + + my $new_evaluator = sub { + my $student_ans = shift; + my $formatted_ans = $student_ans; + $formatted_ans =~ s{$correct_units}{}; + my $ans_hash = $old_evaluator->evaluate($formatted_ans); + if ($student_ans !~ /$correct_units/) { + $ans_hash->{score} = 0; + $ans_hash->setKeys('ans_message' => "Enter your answer with the correct units: $correct_units"); + } else { + if ($ans_hash->{score} == 0 + && abs($formatted_ans - $correct_ans) < $errorAmount) + { + $ans_hash->setKeys('ans_message' => "Round your answer to the nearest $error."); + } + } + $ans_hash->{original_student_ans} = "$student_ans"; + $ans_hash->{preview_latex_string} = "$student_ans"; + $ans_hash->{student_ans} = "$student_ans"; + $ans_hash->{correct_ans} = "$correct_ans" . " $correct_units"; + + return $ans_hash; + }; + + return $new_evaluator; +} + +################################################################### +# 4) Checks both sides of an equation model the word problem. + +sub Picky_equation_cmp { + + loadMacros("unionUtils.pl", "answerUtils.pl", "listAnswer.pl", "extraAnswerEvaluators.pl"); + + my $ans = shift; + + my $new_evaluator = sub { + my $student = shift; + + $ans =~ tr/[=]/,/; + $student =~ tr/[=]/,/; + + my $old_evaluator = fun_list_cmp($ans, + vars => [ 'a', 'b', 'c', 'd', 'h', 'l', 'n', 'v', 'w', 'x', 'y', 's', 't', 'A', 'L', 'R', 'C', 'P' ]); + my $ans_hash_old = $old_evaluator->evaluate($student); + + $ans =~ tr/,/=/; + $student =~ tr/,/=/; + $ans_hash_old->{correct_ans} = "$ans"; + $ans_hash_old->{original_student_ans} = "$student"; + $ans_hash_old->{student_ans} = "$student"; + $ans_hash_old->{preview_latex_string} = "$student"; + if ($ans_hash_old->{score} != 1) { + $ans_hash_old->{score} = 0; + # $ans_hash_old->setKeys( 'ans_message' =>"Your equation must model the problem."); + $ans_hash_old->setKeys('ans_message' => "At least one side is incorrect."); + } + if ($student !~ /[=]/) { + if ($ans =~ /[RCP]/) { + @side = split(/[=]/, $ans); + $ans_hash_old->setKeys('ans_message' => "Enter your answer in the form: $side[0] = expression."); + } else { + $ans_hash_old->setKeys('ans_message' => "You must enter an equation."); + } + } + + return $ans_hash_old; + }; + return $new_evaluator; +} + +################################################################### +# 5) Checks both sides of an equation for the slope-intercept form of a line. + +sub SlopeIntercept_equation_cmp { + + loadMacros("unionUtils.pl", "answerUtils.pl", "contextLimitedPolynomial.pl"); + + my $ans = shift; + my $formatAns = $ans; + $formatAns =~ tr/ //; + my @correctSides = split(/[=]/, $formatAns); + + my $new_evaluator = sub { + my $left_evaluator = fun_cmp($correctSides[0], vars => [ 'x', 'y' ]); + my $right_evaluator = fun_cmp($correctSides[1], vars => [ 'x', 'y' ]); + + my $student = shift; + my $formatStudent = $student; + $formatStudent =~ tr/ //; + if ($student !~ /[=]/) { + my $ans_hash = $right_evaluator->evaluate($formatStudent); + $ans_hash->{correct_ans} = "$ans"; + $ans_hash->{original_student_ans} = "$student"; + $ans_hash->{student_ans} = "$student"; + $ans_hash->{preview_latex_string} = "$student"; + $ans_hash->setKeys('ans_message' => "You must enter an equation."); + $ans_hash->{score} = 0; + return $ans_hash; + } else { + my @studentSides = split(/[=]/, $formatStudent); + + my $left_ans_hash = $left_evaluator->evaluate($studentSides[0]); + my $right_ans_hash = $right_evaluator->evaluate($studentSides[1]); + + $left_ans_hash->{correct_ans} = "$ans"; + $left_ans_hash->{original_student_ans} = "$student"; + $left_ans_hash->{student_ans} = "$student"; + $left_ans_hash->{preview_latex_string} = "$student"; + + if ($right_ans_hash->{score} == 0) { $left_ans_hash->{score} = 0; } + + my $perlNumber = "[0-9]+[\.\/]?[0-9]*|\.[0-9]+"; + my $BadForm = + ($studentSides[0] =~ /\w.*\w/ + || $studentSides[1] =~ /[a-zA-Z].*[a-zA-Z]/ + || $studentSides[1] =~ /($perlNumber)[+-]+($perlNumber[a-zA-Z][+-])?($perlNumber)/); + if ($BadForm) { + $left_ans_hash->setKeys( + 'ans_message' => "Enter your answer in the form: $BR y = mx+b, y = b or x = c"); + $left_ans_hash->{score} = 0; + } + + return $left_ans_hash; + } + }; + return $new_evaluator; +} + +################################################################### +# 6) Checks for function notation in an equality. + +sub functionNotation_cmp { + + loadMacros("unionUtils.pl", "answerUtils.pl"); + + my $ans = shift; + my @variables = @_; + + my $formatAns = $ans; + $formatAns =~ tr/ //; + my @correctSides = split(/[=]/, $formatAns); + + my $new_evaluator = sub { + # my $notation_evaluator = fun_cmp($correctSides[0],vars=>@variables); + my $notation_evaluator = ordered_cs_str_cmp($correctSides[0]); + my $notation2_evaluator = unordered_str_cmp($correctSides[0]); + my $formula_evaluator = fun_cmp($correctSides[1], vars => @variables, tol => .001); + + my $student = shift; + my $formatStudent = $student; + $formatStudent =~ tr/ //; + + if ($student !~ /[=]/ || $student !~ /(\w\s*\(\s*\w\s*\))/) { + my $ans_hash = $formula_evaluator->evaluate($formatStudent); + $ans_hash->{correct_ans} = "$ans"; + $ans_hash->{original_student_ans} = "$student"; + $ans_hash->{student_ans} = "$student"; + $ans_hash->{preview_latex_string} = "$student"; + $ans_hash->setKeys('ans_message' => "Your answer must be in function notation."); + return $ans_hash; + } else { + my @studentSides = split(/[=]/, $formatStudent); + + my $notation_ans_hash = $notation_evaluator->evaluate($studentSides[0]); + my $notation2_ans_hash = $notation2_evaluator->evaluate($studentSides[0]); + my $formula_ans_hash = $formula_evaluator->evaluate($studentSides[1]); + + $formula_ans_hash->{correct_ans} = "$ans"; + $formula_ans_hash->{original_student_ans} = "$student"; + $formula_ans_hash->{student_ans} = "$student"; + $formula_ans_hash->{preview_latex_string} = "$student"; + + if ($notation_ans_hash->{score} != 1) { + $formula_ans_hash->{ans_message} = $notation_ans_hash->{ans_message}; + if ($notation2_ans_hash->{score} == 1) { + $formula_ans_hash->setKeys( + 'ans_message' => "Your answer must be in correct function notation."); + } + $formula_ans_hash->{score} = 0; + } + + return $formula_ans_hash; + } + }; + return $new_evaluator; +} + +################################################################### +# 7) Checks factors of polynomials. +# Note: Student's answers must be of the form: monomial(poly)...(poly) with +# or without parentheses about the monomial. The polynomial factors must +# not contain any other grouping symbols and, in any case, only parenthesis +# may be used. This needs to be in the instructions for any set that uses +# this macro (in the screenHeader.pg file). +# Note: "StrictFactoringEvaluator" requires leading negatives to be factored out. +# This not may not work with all situations. BE SURE TO CHANGE THIS FILE IF THE +# FactoringEvaluator IS CHANGED!! +#---------For diagnosing problems-------------------------------------- +# $ans_hash->setKeys( 'ans_message' =>"FYI: Not checking correctly. +# AnswerHashScore: $ans_hash->{score} : +# Student: $#student_factors, $student_ans, +# Formatted: $format_student_ans, +# Student Factors: $student_factors[0], $student_factors[1], +# : Correct: $#factors, $factors[0], $factors[1], +# Number matched: $CorrectFactors"); +#---------------------------------------------------------------------- + +sub FactoringEvaluator { + + Context()->strings->add("Does not factor" => ()); + + my $ans = shift; + my $ans_text = $ans; #For string answers like "Does not factor" + if ($ans =~ /factor/) { + $ans = shift; + } + my @vars = @_; + + my $format_ans = $ans; + $format_ans =~ s/\*/ /g; #Remove any astrix + $format_ans =~ s/[\(]/,\(/g; #Put in the delimiter , + if ($format_ans =~ /^,/) { $format_ans =~ s/,//; } #Remove any leading comma + my @factors = split(/[,]/, $format_ans); #Split off the terms + for $k (0 .. $#factors) { $factors[$k] = Formula($factors[$k])->reduce; } + $ans = Formula($ans)->reduce; + + my $old_evaluator = fun_cmp($ans, var => @vars); + + my $new_evaluator = sub { + local ($factor_eval, $negfactor_eval, $factor_hash, $negfactor_hash); + + my $student_ans = shift; + + #---------For string answers---------------------------------------------- + if ($student_ans =~ /factor/) { + my $old_eval_string = str_cmp($ans_text); + my $ans_hash = $old_eval_string->evaluate($student_ans); + $ans_hash->{correct_ans} = $ans_text; #For better display (no caps) + $ans_hash->{student_ans} = $student_ans; + $ans_hash->{original_student_ans} = $student_ans; + return $ans_hash; + } + #--------------------------------------------------------------------------- + + my $ans_hash = $old_evaluator->evaluate($student_ans); + + #----------The only parentheses are allowed for grouping symbols------------ + #----------and only the minimum set needed to enter the answer correctly.--- + if ($student_ans =~ /[\{\}\[\]]/) { + $ans_hash->{student_ans} = $student_ans; + $ans_hash->{original_student_ans} = $student_ans; + $ans_hash->{score} = 0; + $ans_hash->setKeys('ans_message' => "You may only use parentheses in your answer."); + return $ans_hash; + } + if ($student_ans =~ /[\(][^\)]*[\(]/) { + $ans_hash->{student_ans} = $student_ans; + $ans_hash->{original_student_ans} = $student_ans; + $ans_hash->{score} = 0; + $ans_hash->setKeys('ans_message' => "Your answer has extraneous grouping symbols."); + return $ans_hash; + } + + #-----------Check the factors--------------------------------------------- + + if ($ans_hash->{score} == 1) { + my $format_student_ans = $student_ans; + $format_student_ans =~ s/[\*]/ /g; #Remove any astrix + $format_student_ans =~ s/[\(]/,\(/g; #Put in the delimiter , + if ($format_student_ans =~ /^,/) { $format_student_ans =~ s/,//; } #Remove leading commas + my @student_factors = split(/[,]/, $format_student_ans); #Split off the terms + for $k (0 .. $#student_factors) { $student_factors[$k] = Formula($student_factors[$k]); } + + #########Could this be done with a list?--would have to change the list's error msg. + + my $CorrectFactors = 0; + + foreach $i (0 .. $#factors) { + $factor_eval = fun_cmp($factors[$i], var => @vars); + $negfactor_eval = fun_cmp(-1 * ($factors[$i]), var => @vars); + foreach $j (0 .. $#student_factors) { + $factor_hash = $factor_eval->evaluate($student_factors[$j]); + $negfactor_hash = $negfactor_eval->evaluate($student_factors[$j]); + if ($factor_hash->{score} == 1 || $negfactor_hash->{score} == 1) { + $CorrectFactors = $CorrectFactors + 1; + + #---------This segment is for binomial factors raised to powers---------------- + # Example: (3x+1)^2 is correct, and (9x^2+6x+1) should not be accepted + # SHOULD MAKE THIS MORE GENERAL: TAKE OTHER EXPONENTS BESIDES INTEGERS, + # THE PATTERN SHOULD BE BETTER DEFINED. + #------------------------------------------------------------------------------ + $factor_string = $factors[$i]->string; + $st_factor_string = $student_factors[$j]->string; + if ($factor_string =~ /\(.*[+-]{1}.*\)\^\d+$/ + && $st_factor_string !~ /\(.*[+-]{1}.*\)\^\d+$/) + { + $ans_hash->{score} = 0; + $ans_hash->setKeys('ans_message' => "Factor the expression completely."); + } + #------------------------------------------------------------------------------- + } + } + } + + if ($CorrectFactors != $#factors + 1) { + $ans_hash->{score} = 0; + $ans_hash->setKeys( + 'ans_message' => "Check that your answer is factored + completely and is entered in the + required format." + ); + } + } + + if ($ans_text =~ /factor/) { $ans_hash->{correct_ans} = $ans_text; } #In case the answer is a string + + return $ans_hash; + }; #END of SUB + + Context()->strings->remove("Does not factor" => ()); + return $new_evaluator; +} + +sub StrictFactoringEvaluator { + + my $ans = shift; + my @vars = @_; + + my $format_ans = $ans; + $format_ans =~ s/[\*]//g; #Remove any astrix + $format_ans =~ s/[\(]/,\(/g; #Put in the delimiter , + if ($format_ans =~ /^,/) { $format_ans =~ s/,//; } #Remove any leading commas + my @factors = split(/[,]/, $format_ans); #Split off the terms + for $k (0 .. $#factors) { $factors[$k] = Formula($factors[$k]); } + $ans = Formula($ans)->reduce; + + my $old_evaluator = fun_cmp($ans, var => @vars); + + my $new_evaluator = sub { + local ($factor_eval, $factor_hash); + + my $student_ans = shift; + + #----This could be changed so that it would check prime polyomials here instead + #----of in the problem template. + if ($student_ans =~ /factor/) { + my $string_ans = $ans->string; + my $old_eval_string = std_cs_str_cmp($string_ans); + my $ans_hash = $old_eval_string->evaluate($student_ans); + return $ans_hash; + } + #------------------------------------------------------ + + my $ans_hash = $old_evaluator->evaluate($student_ans); + + if ($ans_hash->{score} == 1) { #Check factors + my $format_student_ans = $student_ans; + $format_student_ans =~ s/[\*]//g; #Remove any astrix + $format_student_ans =~ s/[\(]/,\(/g; #Put in the delimiter , + if ($format_student_ans =~ /^,/) { $format_student_ans =~ s/,//; } #Remove any leading commas + my @student_factors = split(/[,]/, $format_student_ans); #Split off the terms + for $k (0 .. $#student_factors) { $student_factors[$k] = Formula($student_factors[$k]); } + + #########Could this be done with a list?--would have to change the list's error msg. + + my $CorrectFactors = 0; + + foreach $i (0 .. $#factors) { + $factor_eval = fun_cmp($factors[$i], var => @vars); + foreach $j (0 .. $#student_factors) { + $factor_hash = $factor_eval->evaluate($student_factors[$j]); + if ($factor_hash->{score} == 1) { + $CorrectFactors = $CorrectFactors + 1; + } + } + } + + if ($CorrectFactors != $#factors + 1) { + $ans_hash->{score} = 0; + $ans_hash->setKeys('ans_message' => + "Check that your answer is factored completely and is entered in the required format."); + } + } + return $ans_hash; + }; + return $new_evaluator; +} + +################################################################### +# 8) Checks for simplified rational expressions. +# Note: Student's answers must be of the form: (poly)/(poly) +# +#---------For diagnosing problems-------------------------------------- +# $ans_hash->setKeys( 'ans_message' =>"FYI: Not checking correctly. +# Student: $student_num, $student_den,$student_ans; +# Answer: $num,$den,$ans"); +#---------------------------------------------------------------------- + +sub RationalExpEvaluator { + + Context()->strings->add("Does not simplify" => ()); + + my $ans = shift; + my $ans_text = $ans; #Mainly for string answers like "Does not simplify" + if ($ans =~ /not/) { + $ans = shift; + } + my @vars = @_; + + #---------Split off the numerator/denominator + my @factors = split(q[/], $ans); + my $num = Formula($factors[0]); + my $den = ($#factors > 0) ? Formula($factors[1]) : Formula("1"); + + my $old_evaluator = fun_cmp($ans, var => @vars); + + my $new_evaluator = sub { + my $student_ans = shift; + my $student_ans_text = $student_ans; + + #---------For string answers---------------------------------------------- + if ($student_ans_text =~ /not/) { + my $old_eval_string = str_cmp($ans_text); + my $ans_hash = $old_eval_string->evaluate($student_ans_text); + $ans_hash->{correct_ans} = $ans_text; + $ans_hash->{student_ans} = $student_ans_text; + $ans_hash->{original_student_ans} = $student_ans_text; + return $ans_hash; + } + #------------------------------------------------------------------------- + + my $ans_hash = $old_evaluator->evaluate($student_ans); + + if ($ans_hash->{score} == 1) { + #--------Check for a scalar answer in case and the student entered a decimal + if ($student_ans !~ /[a-zA-Z]/ && $ans !~ /[a-zA-Z]/) { + $ans_hash->{correct_ans} = $ans_text; + $ans_hash->{student_ans} = $student_ans_text; + $ans_hash->{original_student_ans} = $ans_hash->{student_ans}; + return $ans_hash; + } + #-------------------------------------------------------------------- + + #--------Split off the numerator/denominator------------------------- + my $student_ans_mo = Formula($student_ans_text); + my ($student_num, $student_den); + my @student_factors; + + # use MO parse tree rather than regex split because of surrounding parens from mathquill + if ($student_ans_mo->{tree}->class eq 'BOP' && $student_ans_mo->{tree}{bop} =~ m!/!) { + $student_num = $student_ans_mo->{tree}{lop}; + $student_den = $student_ans_mo->{tree}{rop}; + @student_factors = ($student_num->string, $student_den->string); + } else { + $student_num = $student_ans_mo; + $student_den = Formula('1'); + @student_factors = ($student_num->string); + } + #-------------------------------------------------------------------- + + if ($#factors != $#student_factors) { + $ans_hash->{score} = 0; + } else { + my $num_eval = fun_cmp($num, var => @vars); + my $num_hash = $num_eval->evaluate($student_num); + $ans_hash->{score} = $num_hash->{score}; + + if ($#factors > 0) { + my $den_eval = fun_cmp($den, var => @vars); + my $den_hash = $den_eval->evaluate($student_den); + $ans_hash->{score} = $den_hash->{score}; + } + } + + $ans_hash->{ans_message} = "Simplify your answer." if ($ans_hash->{score} == 0); + } + + return $ans_hash; + }; + + Context()->strings->remove("Does not simplify" => ()); + return $new_evaluator; +} + +################################################################### +# 9) Writes a fraction in reduced form. +# + +sub ReduceFraction { + my $num = shift; + my $den = shift; + my $n = 1; + my $d = 1; + + ($n, $d) = reduce($num, $den); + my $result = "$n/$d"; + if ($d == 1) { $result = "$n"; } + + return ($result); +} + +################################################################### +# 10) Checks a list of equations. +# Designed for checking a list of asymptotes + +sub equation_cmp_list { + + loadMacros("extraAnswerEvaluators.pl"); + + my $ans = shift; + my @vars = @_; + + my $format_ans = $ans; + $format_ans =~ tr/ //; #Remove any whitespace + my @ans_list = split(/[,]/, $format_ans); #Split off the terms + + # + # my $old_evaluator2 = str_cmp($ans_list[1]); + # Would like to change this to an equation evaluator later + # my $old_evaluator1 = equation_cmp($ans[0],vars=>@vars); + # my $old_evaluator2 = equation_cmp($ans[1],vars=>@vars); + + my $new_evaluator = sub { + + local ($eq_eval, $ans_hash); + + my $student_ans = shift; + chomp $student_ans; + my $format_st = $student_ans; + $format_st =~ tr/ //; #Remove any whitespace + + my @student_list = split(/,/, $format_st); + + my $Correct = -1; + foreach $i (0 .. $#ans_list) #Count the number of matches between the lists + { + my $eq_eval = str_cmp($ans_list[$i]); + foreach $j (0 .. $#student_list) { + $ans_hash = $eq_eval->evaluate($student_list[$j]); + if ($ans_hash->{score} == 1) { $Correct = $Correct + 1; } + } + } + my $Duplicates = -1; + foreach $i (0 .. $#student_list) #Check for duplicates in the student's list + { + my $eq_eval = str_cmp($student_list[$i]); + foreach $j (0 .. $#student_list) { + $ans_hash = $eq_eval->evaluate($student_list[$j]); + if ($ans_hash->{score} == 1) { $Duplicates = $Duplicates + 1; } + } + } + if ($Correct != $#ans_list || $Duplicates != $#student_list) { + $ans_hash->{score} = 0; + if ($Duplicates != $#student_list) { + $ans_hash->setKeys('ans_message' => "You have listed an asymptote more than once."); + } + } else { + $ans_hash->{score} = 1; + } + $ans_hash->{correct_ans} = $ans; + $ans_hash->{student_ans} = $student_ans; + $ans_hash->{original_student_ans} = $ans_hash->{student_ans}; + # $ans_hash->{type} = '', + $ans_hash->{preview_text_string} = $student_ans; + $ans_hash->{preview_latex_string} = $student_ans; + return $ans_hash; + }; + return $new_evaluator; +} + +1; diff --git a/macros/univ/Dartmouthmacros.pl b/macros/univ/Dartmouthmacros.pl new file mode 100755 index 0000000000..09678528b2 --- /dev/null +++ b/macros/univ/Dartmouthmacros.pl @@ -0,0 +1,304 @@ +#!/usr/bin/perl + +# this is equivalent to use strict, but can be used within the Safe compartment. +BEGIN { + be_strict; +} + +## Some local macros + +sub trs_mod { + my @inputs = @_; + my $a = $inputs[0]; + my $b = $inputs[1]; + my $zero = 1e-12; + if ($b < 0) { $b = -$b; } + +## Want mod(a,b) but perl and int are flawed + my $modvalue = $a; + # if ($a >= 0 && $a < $b) {$modvalue = $a;} + + while ($modvalue >= $b) { $modvalue = $modvalue - $b; } + while ($modvalue < 0) { $modvalue = $modvalue + $b; } + if (abs($modvalue) <= $zero) { $modvalue = 0; } + if (abs($modvalue - $b) <= $zero) { $modvalue = 0; } +## Fudge for roundoff error + return $modvalue; +} + +## Compute the product of a scalar and a vector (scalar first) +sub scalar_mult_vector { + ## Put the parameters passed into an array of values + my @vector = @_; + + ## Split off the first entry as the scalar, and the rest as the vector + my $scalar = $vector[0]; + my @vectorb = @vector[ (1 .. $#vector) ]; + + ## Initialize scalar multiple as empty vector + my @scalar_multiple = (); + + my $i; + for ($i = 0; $i <= $#vectorb; $i++) { + $scalar_multiple[$i] = $scalar * $vectorb[$i]; + } + return @scalar_multiple; +} + +## Compute the sum of two vectors +## Perl doesn't seem to have builtin array arithmetic +sub vector_sum { + ## Put the parameters passed into an array of values + my @vector = @_; + ## $#vector is the number of elements in vector minus 1 + my $halflength = ($#vector - 1) / 2; + ## Slice the input into two equal length vectors + my @vectora = @vector[ (0 .. $halflength) ]; + my @vectorb = @vector[ ($halflength + 1 .. $#vector) ]; + + ## Initialize vector sum to empty array + my @vector_sum = (); + + my $i; + for ($i = 0; $i <= $#vectora; $i++) { + $vector_sum[$i] = $vectora[$i] + $vectorb[$i]; + } + return @vector_sum; +} + +## Compute the difference of two vectors +sub vector_diff { + ## Put the parameters passed into an array of values + my @vector = @_; + ## $#vector is the number of elements in vector minus 1 + my $halflength = ($#vector - 1) / 2; + ## Slice the input into two equal length vectors + my @vectora = @vector[ (0 .. $halflength) ]; + my @vectorb = @vector[ ($halflength + 1 .. $#vector) ]; + + return vector_sum(@vectora, scalar_mult_vector(-1, @vectorb)); +} + +## Compute the length of a vector +sub vec_length { + ## Put the paramaters passed into an array of values + my @vector = @_; + + ## Initialize maximum value to first element + my $vector_length = 0; + + my $i; + for ($i = 0; $i <= $#vector; $i++) { + $vector_length = $vector_length + $vector[$i] * $vector[$i]; + } + $vector_length = sqrt($vector_length); + return $vector_length; +} + +sub vector_length { + my @vector = @_; + return vec_length(@vector); +} + +## Computes the dot product of two vectors (assumed of the same dimension) +sub dot_product { + ## Put the parameters passed into an array of values + my @vector = @_; + ## $#vector is the number of elements in vector minus 1 + my $halflength = ($#vector - 1) / 2; + ## Split the input into two equal length vectors + my @vectora = @vector[ (0 .. $halflength) ]; + my @vectorb = @vector[ ($halflength + 1 .. $#vector) ]; + + ## Initialize dot product to zero + my $dot = 0; + + my $i; + for ($i = 0; $i <= $#vectora; $i++) { + $dot = $dot + $vectora[$i] * $vectorb[$i]; + } + return $dot; +} + +sub cross_product { + ## Put the parameters passed into an array of values + my @vector = @_; + + ## Slice the input into two equal length vectors + my @vectora = @vector[ (0 .. 2) ]; + my @vectorb = @vector[ (3 .. 5) ]; + + ## Initialize dot product to zero + my @cross = (); + + $cross[0] = $vectora[1] * $vectorb[2] - $vectora[2] * $vectorb[1]; + $cross[1] = $vectora[2] * $vectorb[0] - $vectora[0] * $vectorb[2]; + $cross[2] = $vectora[0] * $vectorb[1] - $vectora[1] * $vectorb[0]; + return @cross; +} + +## Compute the maximum value in a list +#sub max { +# ## Put the paramters passed into an array of values +# my @values = @_; +# +# ## Initialize maximum value to first element +# my $max = $values[0]; +# +# my $i; +# for ($i=1; $i <= $#values; $i++) +# { +# if ($values[$i] > $max) { +# $max = $values[$i]; +# } +# } +# return $max; +#} + +## Compute the minimum value in a list +#sub min { +# ## Put the paramters passed into an array of values +# my @values = @_; +# +# ## Initialize minimum value to first element +# my $min = $values[0]; +# +# my $i; +# for ($i=1; $i <= $#values; $i++) +# { +# if ($values[$i] < $min) { +# $min = $values[$i]; +# } +# } +# return $min +#} + +## clean_scalar_string is invoked to make expressions like "$a x" look +## better when $a = 0, -1, 1 +## Usage: clean_scalar_string(scalar, "quoted string"); +## Example: clean_scalar_string(-1,"\pi") returns "-\pi" +sub clean_scalar_string { + my $local_scalar = shift; + my $local_fixed_object = shift; + my $return_object; + + if ($local_scalar == 0) { $return_object = "0"; } + elsif ($local_scalar == 1) { $return_object = "$local_fixed_object"; } + elsif ($local_scalar == -1) { $return_object = "-$local_fixed_object"; } + else { $return_object = "${local_scalar}${local_fixed_object}"; } + return $return_object; +} + +## Computes the greatest common divisor of two integers +## Example: gcd(-300, 125) returns 25 +sub trs_gcd { + my $a = shift; + my $b = shift; + my $c; + my $abs_a = abs($a); + my $abs_b = abs($b); + if ($abs_b == 0) { return $abs_a; } + else { + $c = $abs_a % $abs_b; + return trs_gcd($abs_b, $c); + } +} + +## reduced_fraction takes a pair of integers $numerator, $denominator +## ($denominator != 0) and returns an array of two elements @fraction +## $fraction[0] is the reduced numerator; $fraction[1] the reduced +## denominator +## Puts the sign of the fraction, if negative, in the numerator +## +## Usage: @fraction = reduced_fraction($numerator, $denominator) +## +sub reduced_fraction { + my $local_numerator = shift; + my $local_denominator = shift; + my $sign_of_num = 1; + my $sign_of_denom = 1; + my $sign_of_quotient; + my @local_fraction = (); + + if ($local_numerator < 0) { $sign_of_num = -1; } + if ($local_denominator < 0) { $sign_of_denom = -1; } + $sign_of_quotient = $sign_of_num * $sign_of_denom; + + my $local_gcd = trs_gcd($local_numerator, $local_denominator); +## reduced numerator + $local_fraction[0] = ($sign_of_quotient * abs($local_numerator)) / $local_gcd; +## reduced denominator + $local_fraction[1] = abs($local_denominator) / $local_gcd; + return @local_fraction; +} + +## Given Cartesian coordinates x and y returns an +## array the zeroth element which is the radius +## and the first element which is the argument +## 0 <= theta < 2*pi +## +## Returns r=0 theta=0 for the origin +## +sub coordinates_polar { + my $x = shift; + my $y = shift; + my @polar = (); + my $radius = 0; + my $theta = 0; + my $pi = acos(-1); + + $radius = sqrt($x**2 + $y**2); + if ($radius != 0) { + if ($x == 0) { + if ($y > 0) { $theta = $pi / 2; } + else { $theta = 3 * $pi / 2; } + } else { + if ($y > 0) { + if ($x > 0) { $theta = atan($y / $x); } + else { $theta = $pi - atan(-$y / $x); } + } else { + if ($x > 0) { $theta = 2 * $pi + atan($y / $x); } + else { $theta = $pi + atan($y / $x); } + } + } + } + @polar = ($radius, $theta); + return @polar; +} + +## Cylindarical coordinates from polar routine +sub coordinates_cylindrical { + my $x = shift; + my $y = shift; + my $z = shift; + my @cylindrical = (coordinates_polar($x, $y), $z); + return @cylindrical; +} + +## Spherical Coordinates from polar routine +## +sub coordinates_spherical { + my $x = shift; + my $y = shift; + my $z = shift; + my $rho = 0; + my $phi = 0; + $rho = sqrt($x * $x + $y * $y + $z * $z); + my @npolar = (); + @npolar = coordinates_polar($x, $y); + my @spherical = (); + + if ($x == 0 && $y == 0) { + if ($z >= 0) { $phi = 0; } + else { $phi = acos(-1); } + @spherical = ($rho, 0, $phi); + } else { + $rho = sqrt($x * $x + $y * $y + $z * $z); + + @spherical = ($rho, $npolar[1], acos($z / $rho)); + } + return @spherical; +} + +1; + diff --git a/macros/univ/MUHelp.pl b/macros/univ/MUHelp.pl new file mode 100644 index 0000000000..20d8faef9a --- /dev/null +++ b/macros/univ/MUHelp.pl @@ -0,0 +1,49 @@ +sub BBRED { + MODES(TeX => '{\\color{red} ', HTML => ''); +} + +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/univ/PCCmacros.pl b/macros/univ/PCCmacros.pl new file mode 100755 index 0000000000..7bd0ee0d29 --- /dev/null +++ b/macros/univ/PCCmacros.pl @@ -0,0 +1,847 @@ + +=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/PGasu.pl b/macros/univ/PGasu.pl similarity index 100% rename from macros/PGasu.pl rename to macros/univ/PGasu.pl diff --git a/macros/univ/PGunion.pl b/macros/univ/PGunion.pl new file mode 100755 index 0000000000..fb101a5866 --- /dev/null +++ b/macros/univ/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/univ/freemanMacros.pl b/macros/univ/freemanMacros.pl new file mode 100755 index 0000000000..86fcb54f35 --- /dev/null +++ b/macros/univ/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/univ/hhAdditionalMacros.pl b/macros/univ/hhAdditionalMacros.pl new file mode 100755 index 0000000000..6f430ae29b --- /dev/null +++ b/macros/univ/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/univ/littleneck.pl b/macros/univ/littleneck.pl new file mode 100644 index 0000000000..bbfb1fa03f --- /dev/null +++ b/macros/univ/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/doc/MathObjects/macros/unionImage.pl b/macros/univ/unionImage.pl old mode 100644 new mode 100755 similarity index 82% rename from doc/MathObjects/macros/unionImage.pl rename to macros/univ/unionImage.pl index c02b26fd30..9dcc4e5b6a --- a/doc/MathObjects/macros/unionImage.pl +++ b/macros/univ/unionImage.pl @@ -1,3 +1,7 @@ +loadMacros("unionMacros.pl"); + +sub _unionImage_init { }; # don't reload this file + ###################################################################### # # A routine to make including images easier to control @@ -45,6 +49,7 @@ sub Image { my $image = shift; my $ilink; + return unless defined $image; my %options = ( size => [ 150, 150 ], tex_size => 200, @@ -60,15 +65,23 @@ sub Image { my $HTML; my $TeX; ($image, $ilink) = @{$image} if (ref($image) eq "ARRAY"); + $ilink = $ilink // ''; $image = alias(insertGraph($image)) if (ref($image) eq "WWPlot"); - $image = alias($image) unless ($image =~ m!^/!i); + $image = alias($image) unless ($image =~ m!^(/|https?:)!i); # see note if ($ilink) { $ilink = alias(insertGraph($ilink)) if (ref($ilink) eq "WWPlot"); - $ilink = alias($ilink) unless ($ilink =~ m!^/!i); + $ilink = alias($ilink) unless ($ilink =~ m!^(/|https?:)!i); # see note } else { $ilink = $image; } + # + # Note: These cases were added to handle the examples where the + # $image tag has a full url -- in practice this arises when using lighttpd + # to server images from a different port + # e.g. http://hosted2.webwork.rochester.edu:8000/webwork2_course_files/.... + # A smarter implementation of alias might make this check unnecessary + # $border = (($link || $ilink ne $image) ? 2 : 1) unless defined($border); $HTML = '{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/univ/unionMacros.pl b/macros/univ/unionMacros.pl new file mode 100755 index 0000000000..8c83bf3b8f --- /dev/null +++ b/macros/univ/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('
    '); + +# +# Broser-only \displaystyle +# +$DISPLAY = MODES( + TeX => '', + Latex2HTML => '\displaystyle ', + HTML_tth => '\displaystyle ', + HTML => '' +); + +# +# Provides a title to the problem +# +sub Title { + my $title = shift; + + TEXT(MODES( + TeX => "\\par\\begin{centering}{\\bf $title}\\par\\end{centering}\\nobreak\n", + Latex2HTML => $bHTML . '

    ' . $title . '

    ' . $eHTML, + HTML => '

    ' . $title . '

    ' + )); +} + +# +# A warning that we are using javaScript +# +sub JAVASCRIPT_PROBLEM { + TEXT(HTML( + '' + )); +} + +# +# Modify a polynomial to remove coeficients of 1, -1 and 0 +# The polynomial can be a multivariable one. The parameters +# following the formula itself are the names of the variables +# for the formula. Any number can be provided, and the default +# is x, y, and z. Variable names must be one character long, +# and the formula really should be a polynomial, as the algorithm +# for removing coefficients of 0 relies on that in an important way. +# +sub FPOLY { + my $poly = shift; + $poly = FEQ($poly); + @_ = ('x', 'y', 'z') unless scalar(@_) > 0; + my $x = '[' . join('', @_) . ']'; + $poly =~ s/(^|[^\d.])1\s*(\*\s*)?($x)/$1$3/g; + $poly =~ s/-1\s*($x)/-$1/g; + $poly =~ s/(^|\+|\-)\s*0(\s*(\*\s*)?$x((\^|\*\*)\d+(\.\d*)?)?)+//g; + $poly =~ s/(^|\+|\-)\s*0+\s*([-+]|$)/$2/; + $poly =~ s/^\s*\+\s*//; + $poly = "0" if ($poly eq ""); + return $poly; +} + +1; diff --git a/macros/univ/unionMessages.pl b/macros/univ/unionMessages.pl new file mode 100755 index 0000000000..a62c6057d9 --- /dev/null +++ b/macros/univ/unionMessages.pl @@ -0,0 +1,75 @@ +sub _unionMessages_init { } + +loadMacros("unionMacros.pl"); + +###################################################################### +# +# How to say "infinity" +# + +$INFINITY_WORD = $$Value::context->flag('infiniteWord') unless defined($INFINITY_WORD); + +###################################################################### +# +# A message that can be included (within BEGIN_TEXT and END_TEXT) +# to tell the student how to enter infinity and minus infinity. +# +$INFINITY_MESSAGE = + $BITALIC + . $BSMALL + . "Use ${LQ}$INFINITY_WORD${RQ} for $LQ\\(\\infty\\)$RQ " + . "and ${LQ}-$INFINITY_WORD${RQ} for $LQ\\(-\\infty\\)$RQ." + . $ESMALL + . $EITALIC; + +$INFINITY_MESSAGE = "" if $displayMode eq 'TeX'; + +###################################################################### +# +# A message to tell students how to enter "Does not exist". +# +$DNE_MESSAGE = $BITALIC . $BSMALL . "Use ${LQ}DNE${RQ} for ${LQ}Does not exist${RQ}." . $ESMALL . $EITALIC; + +$DNE_MESSAGE = "" if $displayMode eq 'TeX'; + +###################################################################### +# +# A message to tell students how to enter unions and infinities +# +$INFINITY_UNION_MESSAGE = + "${BSMALL}${BBOLD}Note:${EBOLD} " + . "If the answer includes more than one interval, write the intervals " + . "separated by the ${LQ}union$RQ symbol, ${BITALIC}U${EITALIC}. If needed, enter " + . "\\(\\infty\\) as ${BITALIC}$INFINITY_WORD${EITALIC} and \\(-\\infty\\) as " + . "${BITALIC}-$INFINITY_WORD${EITALIC}.${ESMALL}"; + +$INFINITY_UNION_MESSAGE = "" if $displayMode eq 'TeX'; + +###################################################################### +# +# A message to tell students how to enter lists of intervals +# +$INTERVAL_LIST_MESSAGE = + $BSMALL + . $BBOLD . "Note:" + . $EBOLD + . "Your answer should be a list of one or more intervals separated by commas. " + . "Enter ${BITALIC}NONE${EITALIC} if there are no intervals."; + +$INTERVAL_LIST_MESSAGE = "" if $displayMode eq 'TeX'; + +###################################################################### +# +# A message for lists of unions +# +$UNION_LIST_MESSAGE = + $BSMALL + . $BBOLD . "Note:" + . $EBOLD + . "Your answer should be a list of one or more intervals or unions of intervals. " + . "Separate the entries in your list by commas. " + . "Enter ${BITALIC}NONE${EITALIC} if there are no intervals or unions."; + +$UNION_LIST_MESSAGE = "" if $displayMode eq 'TeX'; + +1; diff --git a/macros/univ/unionProblem.pl b/macros/univ/unionProblem.pl new file mode 100755 index 0000000000..60701e50b6 --- /dev/null +++ b/macros/univ/unionProblem.pl @@ -0,0 +1,15 @@ +#!/usr/local/bin/perl + +sub _unionProblem_init { } + +################################################## +# +# No longer needed since WW can output the grey +# box automatically by changes in global.conf +# +sub BEGIN_PROBLEM { } +sub END_PROBLEM { } + +sub problem_NoTable { } + +1; diff --git a/macros/univ/unionUtils.pl b/macros/univ/unionUtils.pl new file mode 100755 index 0000000000..18b4a5e2dd --- /dev/null +++ b/macros/univ/unionUtils.pl @@ -0,0 +1,136 @@ +###################################################################### +## +## These are some miscellaneous routines that may be useful. +## + +sub _unionUtils_init { }; # don't reload this file + +# +# Remove leading and trailing spaces +# +sub trimString { + my $s = shift; + $s =~ s/^\s+|\s+$//g; + return $s; +} + +# +# Check if a string is a number +# +sub isNumber { + my $n = shift; + $n = ($n =~ m/^[+-]?(\d+(\.\d*)?|\.\d+)([Ee][-+]?\d+)?$/); + return $n; +} + +# +# names for numbers +# +sub NameForNumber { + my $n = shift; + my $name = + ('zeroth', 'first', 'second', 'third', 'fourth', 'fifth', 'sixth', 'seventh', 'eighth', 'ninth', 'tenth')[$n]; + $name = "$n-th" if ($n > 10); + return $name; +} + +# +# A debugging routine that allows the "warn" function to print a variable that +# contains HTML code properly +# +sub showHTML { + my $string = shift; + $string =~ s/&/\&/g; + $string =~ s//\>/g; + $string; +} + +# +# Make a named subroutine that returns the value of a function. If +# no parameters are passed to the function, the function's string +# is returned. (This will be obsolete when I finish the +# new expression parser -- DPVC.) +# +sub perlFunction { + my $def = shift; + my $debug = shift; + if ($def !~ m/^\s*(\w+)\s*\(\s*((\w+\s*,?\s*)+)\s*\)\s*:?=\s*(.*)$/) { + warn "perlFunction: can't parse '$def'"; + return; + } + my ($name, $vars, $expr) = ($1, $2, $4); + my $f = $expr; + my @X; + my $x; + $vars =~ s/\s//g; + foreach $x (split(',', $vars)) { + push(@X, "\$$x"); + $expr =~ s/(\b|\d)$x\b/$1(\$$x)/g; + } + # + # Fix up the expression + # + $expr =~ s/\bpi\b/(4*atan2(1,1))/g; + $expr =~ s/\be\b/(exp(1))/g; + $expr =~ s!\\frac\{([^\}]*)\}\s*\{([^\}]*)\}!($1)/($2)!g; # fractions + $expr =~ s/\{([^\}]*)\}/($1)/g; # TeX parameters + $expr =~ s/\\//g; # TeX slashes + $expr =~ s/\^/**/g; # change ^ to ** + # + # Do implied multiplication + # + $expr =~ s/\)\s*\(/\)*\(/g; + $expr =~ s/\)\s*([a-zA-Z0-9.])/\)*$1/g; + $expr =~ s/([\d.])(\s\d)/$1*$2/g; + $expr =~ s/([\d.])\s*([a-zA-Z\(])/$1*$2/g; + # + # Fix +-, -+, ++ and -- + # + $expr =~ s/\+\s*([\+-])/$1/g; + $expr =~ s/-\s*\+/-/g; + $expr =~ s/-\s*-/+/g; + # + # Create the named function + # + PG_restricted_eval( + "sub $name { return('$f') unless (\@_); + my (" . join(',', @X) . ") = \@_; $expr}" + ); + warn("sub $name { my (" . join(',', @X) . ") = \@_; $expr}") if $debug; +} + +# +# A hack to pick display mode in HTML modes, but plain math mode +# in TeX modes. This makes fractions appear better in HTML mode, +# without making it worse in TeX modes. This is for use with +# AlignedList objects. +# +sub DMATH { + my $math = shift; + # + # HTML_tth puts an unwanted
    at the beginning, + # and uses a centered table. So here we remove the + #
    and re-align the table to the right. + # + if ($displayMode eq "HTML_tth") { + $math = trimString(EV2('\[' . $math . '\]')); + $math =~ s!
    !!; + $math =~ s!table align="center"!table align="right"!; + $math =~ s!(table [^>]*) width="100%"!$1!; + } elsif ($displayMode eq "HTML") { + $math = '\(' . $math . '\)'; + } elsif ($displayMode =~ m/^HTML/) { + $math = '\(\displaystyle ' . $math . '\)'; + } + + MODES( + TeX => '\(\displaystyle ' . $math . '\)', + Latex2HTML => '\(\displaystyle ' . $math . '\)', + HTML => $math, + HTML_tth => $math, + HTML_dpng => $math, + ); +} + +1; From c7a874e4d57161301b4a62d0dbee741371290633 Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Mon, 12 Sep 2022 07:02:33 -0400 Subject: [PATCH 2/9] Update load_macros to find all macros in new directory structure. Update load_macros to find all macros in new directory structure. Update load_macros to find all macros in new directory structure. --- macros/README.md | 15 ++++++++++++++- macros/answers/AnswerFormatHelp.pl | 0 macros/answers/ConditionalHint.pl | 0 macros/answers/Generic.pl | 0 macros/answers/answerUtils.pl | 0 macros/answers/unorderedAnswer.pl | 0 macros/contexts/contextFunctionAssign.pl | 0 .../contexts/contextInequalitiesAllowStrings.pl | 0 macros/contexts/contextRationalExponent.pl | 0 macros/core/PeriodicRerandomization.pl | 0 macros/core/weightedGrader.pl | 0 macros/graph/LiveGraphicsCylindricalPlot3D.pl | 0 macros/graph/LiveGraphicsParametricCurve3D.pl | 0 macros/graph/LiveGraphicsParametricSurface3D.pl | 0 macros/graph/LiveGraphicsRectangularPlot3D.pl | 0 macros/graph/LiveGraphicsVectorField2D.pl | 0 macros/graph/LiveGraphicsVectorField3D.pl | 0 macros/graph/PCCgraphMacros.pl | 0 macros/graph/PGnauGraphics.pl | 0 macros/graph/imageChoice.pl | 0 macros/math/MatrixUnimodular.pl | 0 macros/math/PGnauBinpacking.pl | 0 macros/math/PGnauGraphCatalog.pl | 0 macros/math/PGnauGraphtheory.pl | 0 macros/math/PGnauScheduling.pl | 0 macros/math/PGnauSet.pl | 0 macros/math/PGnauStats.pl | 0 macros/math/SolveLinearEquationPCC.pl | 0 .../math/SystemsOfLinearEquationsProblemPCC.pl | 0 macros/math/algebraMacros.pl | 0 macros/math/tableau.pl | 0 macros/parsers/parserUtils.pl | 0 macros/ui/choiceUtils.pl | 0 macros/ui/pccTables.pl | 0 macros/ui/quickMatrixEntry.pl | 0 macros/univ/Alfredmacros.pl | 0 macros/univ/CofIdaho_macros.pl | 0 macros/univ/Dartmouthmacros.pl | 0 macros/univ/PCCmacros.pl | 0 macros/univ/PGunion.pl | 0 macros/univ/freemanMacros.pl | 0 macros/univ/hhAdditionalMacros.pl | 0 macros/univ/unionImage.pl | 0 macros/univ/unionInclude.pl | 0 macros/univ/unionMacros.pl | 0 macros/univ/unionMessages.pl | 0 macros/univ/unionProblem.pl | 0 macros/univ/unionUtils.pl | 0 t/macros/load_macros.t | 17 ++++++++++++++--- 49 files changed, 28 insertions(+), 4 deletions(-) mode change 100755 => 100644 macros/answers/AnswerFormatHelp.pl mode change 100755 => 100644 macros/answers/ConditionalHint.pl mode change 100755 => 100644 macros/answers/Generic.pl mode change 100755 => 100644 macros/answers/answerUtils.pl mode change 100755 => 100644 macros/answers/unorderedAnswer.pl mode change 100755 => 100644 macros/contexts/contextFunctionAssign.pl mode change 100755 => 100644 macros/contexts/contextInequalitiesAllowStrings.pl mode change 100755 => 100644 macros/contexts/contextRationalExponent.pl mode change 100755 => 100644 macros/core/PeriodicRerandomization.pl mode change 100755 => 100644 macros/core/weightedGrader.pl mode change 100755 => 100644 macros/graph/LiveGraphicsCylindricalPlot3D.pl mode change 100755 => 100644 macros/graph/LiveGraphicsParametricCurve3D.pl mode change 100755 => 100644 macros/graph/LiveGraphicsParametricSurface3D.pl mode change 100755 => 100644 macros/graph/LiveGraphicsRectangularPlot3D.pl mode change 100755 => 100644 macros/graph/LiveGraphicsVectorField2D.pl mode change 100755 => 100644 macros/graph/LiveGraphicsVectorField3D.pl mode change 100755 => 100644 macros/graph/PCCgraphMacros.pl mode change 100755 => 100644 macros/graph/PGnauGraphics.pl mode change 100755 => 100644 macros/graph/imageChoice.pl mode change 100755 => 100644 macros/math/MatrixUnimodular.pl mode change 100755 => 100644 macros/math/PGnauBinpacking.pl mode change 100755 => 100644 macros/math/PGnauGraphCatalog.pl mode change 100755 => 100644 macros/math/PGnauGraphtheory.pl mode change 100755 => 100644 macros/math/PGnauScheduling.pl mode change 100755 => 100644 macros/math/PGnauSet.pl mode change 100755 => 100644 macros/math/PGnauStats.pl mode change 100755 => 100644 macros/math/SolveLinearEquationPCC.pl mode change 100755 => 100644 macros/math/SystemsOfLinearEquationsProblemPCC.pl mode change 100755 => 100644 macros/math/algebraMacros.pl mode change 100755 => 100644 macros/math/tableau.pl mode change 100755 => 100644 macros/parsers/parserUtils.pl mode change 100755 => 100644 macros/ui/choiceUtils.pl mode change 100755 => 100644 macros/ui/pccTables.pl mode change 100755 => 100644 macros/ui/quickMatrixEntry.pl mode change 100755 => 100644 macros/univ/Alfredmacros.pl mode change 100755 => 100644 macros/univ/CofIdaho_macros.pl mode change 100755 => 100644 macros/univ/Dartmouthmacros.pl mode change 100755 => 100644 macros/univ/PCCmacros.pl mode change 100755 => 100644 macros/univ/PGunion.pl mode change 100755 => 100644 macros/univ/freemanMacros.pl mode change 100755 => 100644 macros/univ/hhAdditionalMacros.pl mode change 100755 => 100644 macros/univ/unionImage.pl mode change 100755 => 100644 macros/univ/unionInclude.pl mode change 100755 => 100644 macros/univ/unionMacros.pl mode change 100755 => 100644 macros/univ/unionMessages.pl mode change 100755 => 100644 macros/univ/unionProblem.pl mode change 100755 => 100644 macros/univ/unionUtils.pl diff --git a/macros/README.md b/macros/README.md index fad714c4fd..70bb875dc0 100644 --- a/macros/README.md +++ b/macros/README.md @@ -180,10 +180,23 @@ u - remove `answers/PGstringevaluators.pl` (not used in OPL/Contrib) - remove `answers/PGtextevaluators.pl` (used in only 1 problems in OPL/Contrib) - remove `answers/answerDiscussion.pl` (not used in OPL/Contrib) -- remove `contextAlternativeDecimal.pl` (not used in OPL/Contrib) - only place `answerUtils.pl` is used is inside `unorderedAnswer.pl` (combine? refactor?) - none of the LiveGraphics is working. Search for `LiveGraphics*.pl` - What is the `fracListChecker.pl` macro? In a number of `Contrib/Mizzou` problems. +- The following are not in OPL/Contrib: + - `contextMatrixExtras.pl` + - `contextOrdering.pl` + - `contextPartition.pl` + - `contextPermutation.pl` + - `contextPermutationUBC.pl` + - `contextReaction.pl` + - `contextAlternativeDecimal.pl` + - `PGcomplexmacros2.pl` + - `parserFormulaAnyVar.pl` + - `parserLinearInequality.pl` + - `parserParametricPlane.pl` + +- Remove `contexts/contextPeriodic.pl`. Labelled as deprecated. No problems in OPL/Contrib. ## Info diff --git a/macros/answers/AnswerFormatHelp.pl b/macros/answers/AnswerFormatHelp.pl old mode 100755 new mode 100644 diff --git a/macros/answers/ConditionalHint.pl b/macros/answers/ConditionalHint.pl old mode 100755 new mode 100644 diff --git a/macros/answers/Generic.pl b/macros/answers/Generic.pl old mode 100755 new mode 100644 diff --git a/macros/answers/answerUtils.pl b/macros/answers/answerUtils.pl old mode 100755 new mode 100644 diff --git a/macros/answers/unorderedAnswer.pl b/macros/answers/unorderedAnswer.pl old mode 100755 new mode 100644 diff --git a/macros/contexts/contextFunctionAssign.pl b/macros/contexts/contextFunctionAssign.pl old mode 100755 new mode 100644 diff --git a/macros/contexts/contextInequalitiesAllowStrings.pl b/macros/contexts/contextInequalitiesAllowStrings.pl old mode 100755 new mode 100644 diff --git a/macros/contexts/contextRationalExponent.pl b/macros/contexts/contextRationalExponent.pl old mode 100755 new mode 100644 diff --git a/macros/core/PeriodicRerandomization.pl b/macros/core/PeriodicRerandomization.pl old mode 100755 new mode 100644 diff --git a/macros/core/weightedGrader.pl b/macros/core/weightedGrader.pl old mode 100755 new mode 100644 diff --git a/macros/graph/LiveGraphicsCylindricalPlot3D.pl b/macros/graph/LiveGraphicsCylindricalPlot3D.pl old mode 100755 new mode 100644 diff --git a/macros/graph/LiveGraphicsParametricCurve3D.pl b/macros/graph/LiveGraphicsParametricCurve3D.pl old mode 100755 new mode 100644 diff --git a/macros/graph/LiveGraphicsParametricSurface3D.pl b/macros/graph/LiveGraphicsParametricSurface3D.pl old mode 100755 new mode 100644 diff --git a/macros/graph/LiveGraphicsRectangularPlot3D.pl b/macros/graph/LiveGraphicsRectangularPlot3D.pl old mode 100755 new mode 100644 diff --git a/macros/graph/LiveGraphicsVectorField2D.pl b/macros/graph/LiveGraphicsVectorField2D.pl old mode 100755 new mode 100644 diff --git a/macros/graph/LiveGraphicsVectorField3D.pl b/macros/graph/LiveGraphicsVectorField3D.pl old mode 100755 new mode 100644 diff --git a/macros/graph/PCCgraphMacros.pl b/macros/graph/PCCgraphMacros.pl old mode 100755 new mode 100644 diff --git a/macros/graph/PGnauGraphics.pl b/macros/graph/PGnauGraphics.pl old mode 100755 new mode 100644 diff --git a/macros/graph/imageChoice.pl b/macros/graph/imageChoice.pl old mode 100755 new mode 100644 diff --git a/macros/math/MatrixUnimodular.pl b/macros/math/MatrixUnimodular.pl old mode 100755 new mode 100644 diff --git a/macros/math/PGnauBinpacking.pl b/macros/math/PGnauBinpacking.pl old mode 100755 new mode 100644 diff --git a/macros/math/PGnauGraphCatalog.pl b/macros/math/PGnauGraphCatalog.pl old mode 100755 new mode 100644 diff --git a/macros/math/PGnauGraphtheory.pl b/macros/math/PGnauGraphtheory.pl old mode 100755 new mode 100644 diff --git a/macros/math/PGnauScheduling.pl b/macros/math/PGnauScheduling.pl old mode 100755 new mode 100644 diff --git a/macros/math/PGnauSet.pl b/macros/math/PGnauSet.pl old mode 100755 new mode 100644 diff --git a/macros/math/PGnauStats.pl b/macros/math/PGnauStats.pl old mode 100755 new mode 100644 diff --git a/macros/math/SolveLinearEquationPCC.pl b/macros/math/SolveLinearEquationPCC.pl old mode 100755 new mode 100644 diff --git a/macros/math/SystemsOfLinearEquationsProblemPCC.pl b/macros/math/SystemsOfLinearEquationsProblemPCC.pl old mode 100755 new mode 100644 diff --git a/macros/math/algebraMacros.pl b/macros/math/algebraMacros.pl old mode 100755 new mode 100644 diff --git a/macros/math/tableau.pl b/macros/math/tableau.pl old mode 100755 new mode 100644 diff --git a/macros/parsers/parserUtils.pl b/macros/parsers/parserUtils.pl old mode 100755 new mode 100644 diff --git a/macros/ui/choiceUtils.pl b/macros/ui/choiceUtils.pl old mode 100755 new mode 100644 diff --git a/macros/ui/pccTables.pl b/macros/ui/pccTables.pl old mode 100755 new mode 100644 diff --git a/macros/ui/quickMatrixEntry.pl b/macros/ui/quickMatrixEntry.pl old mode 100755 new mode 100644 diff --git a/macros/univ/Alfredmacros.pl b/macros/univ/Alfredmacros.pl old mode 100755 new mode 100644 diff --git a/macros/univ/CofIdaho_macros.pl b/macros/univ/CofIdaho_macros.pl old mode 100755 new mode 100644 diff --git a/macros/univ/Dartmouthmacros.pl b/macros/univ/Dartmouthmacros.pl old mode 100755 new mode 100644 diff --git a/macros/univ/PCCmacros.pl b/macros/univ/PCCmacros.pl old mode 100755 new mode 100644 diff --git a/macros/univ/PGunion.pl b/macros/univ/PGunion.pl old mode 100755 new mode 100644 diff --git a/macros/univ/freemanMacros.pl b/macros/univ/freemanMacros.pl old mode 100755 new mode 100644 diff --git a/macros/univ/hhAdditionalMacros.pl b/macros/univ/hhAdditionalMacros.pl old mode 100755 new mode 100644 diff --git a/macros/univ/unionImage.pl b/macros/univ/unionImage.pl old mode 100755 new mode 100644 diff --git a/macros/univ/unionInclude.pl b/macros/univ/unionInclude.pl old mode 100755 new mode 100644 diff --git a/macros/univ/unionMacros.pl b/macros/univ/unionMacros.pl old mode 100755 new mode 100644 diff --git a/macros/univ/unionMessages.pl b/macros/univ/unionMessages.pl old mode 100755 new mode 100644 diff --git a/macros/univ/unionProblem.pl b/macros/univ/unionProblem.pl old mode 100755 new mode 100644 diff --git a/macros/univ/unionUtils.pl b/macros/univ/unionUtils.pl old mode 100755 new mode 100644 diff --git a/t/macros/load_macros.t b/t/macros/load_macros.t index 7ba810877b..40473db666 100644 --- a/t/macros/load_macros.t +++ b/t/macros/load_macros.t @@ -15,6 +15,8 @@ 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 File::Basename; use WeBWorK::PG; @@ -22,9 +24,18 @@ my %baseMacros = ('PG.pl' => 1, 'PGstandard.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$/; + push @macro_files, $File::Find::name; + }, + "$ENV{PG_ROOT}/macros" +); + +@macro_files = sort grep { my $f = fileparse($_); !$baseMacros{$f} && !$brokenMacros{$f} } @macro_files; for (@macro_files) { subtest $_ => sub { From c72ea34d80a86f03a0a4e5371ae539590af30ec6 Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Wed, 14 Sep 2022 11:14:43 -0400 Subject: [PATCH 3/9] FIX: warnings in some macro files. FIX: warnings in some macro files. FIX: --- conf/pg_config.dist.yml | 3 +- macros/README.md | 48 ++++------- macros/contexts/contextFiniteSolutionSets.pl | 6 +- .../contexts/contextLimitedRadicalComplex.pl | 67 ++++++++-------- macros/contexts/contextRationalExponent.pl | 2 +- macros/graph/PCCgraphMacros.pl | 2 +- macros/math/PCCfactor.pl | 38 ++++----- macros/math/PGmorematrixmacros.pl | 8 +- macros/math/PGnauScheduling.pl | 12 ++- macros/math/PGstatisticsmacros.pl | 72 ++++++++--------- macros/math/SolveLinearEquationPCC.pl | 9 +-- .../SystemsOfLinearEquationsProblemPCC.pl | 80 +++++++++---------- macros/math/algebraMacros.pl | 59 +------------- macros/math/fixedPrecision.pl | 1 + macros/math/interpMacros.pl | 2 +- macros/parsers/parserUtils.pl | 6 +- t/macros/load_macros.t | 19 ++++- 17 files changed, 185 insertions(+), 249 deletions(-) diff --git a/conf/pg_config.dist.yml b/conf/pg_config.dist.yml index 4a5a96434c..e87a6502e4 100644 --- a/conf/pg_config.dist.yml +++ b/conf/pg_config.dist.yml @@ -42,6 +42,7 @@ directories: - . - $pg_root/macros - $pg_root/macros/answers + - $pg_root/macros/capa - $pg_root/macros/contexts - $pg_root/macros/core - $pg_root/macros/graph @@ -49,8 +50,6 @@ directories: - $pg_root/macros/parsers - $pg_root/macros/ui - $pg_root/macros/univ - - $Contrib_dir/CAPA/macros/CAPA_Tools - - $Contrib_dir/CAPA/macros/CAPA_MCTools URLs: # The public URL of the html directory above. diff --git a/macros/README.md b/macros/README.md index 70bb875dc0..ed4d238ce7 100644 --- a/macros/README.md +++ b/macros/README.md @@ -16,7 +16,7 @@ This directory now has a subdirectory structure for clarification. - `OPL/Alfred/Alfredmacros.pl` to `PG/macros/univ` - `OPL/BrockPhysics/BrockPhysicsMacros.pl` to `PG/macros/univ` (referenced throughout OPL, but blank, should be deleted.) -- `OPL/BrockPhysics/fixedPrecision.pl` to `PG/macros/contexts` (not sure how this is used in problems). +- `OPL/BrockPhysics/fixedPrecision.pl` to `PG/macros/contexts` - `OPL/Hope/PGgraphgrid.pl` to `PG/macros/graph` - `OPL/Hope/VectorListCheckers.pl` to `PG/macros/math` - `OPL/LaTech/SI_property_tables.pl` to `PG/macros/math` @@ -172,14 +172,24 @@ u - `Contrib/PCC/CollegeAlgebra/FunctionBasics/FunctionTables20.pg` (warnings about PCCmacros.pl) - `Library/Union/setMVfunctions/system-f2.pg` (warning about uninitialized value) +## Macros fixed: + +- `math/algebraMacros.pl` (removed all code, already in `customizeLaTeX.pl`) +- `parsers/parserUtils.pl` (removed loadMacros call due to errors. ) +- `contexts/contextFiniteSolutionSets.pl` (fixed warnings) +- `contexts/contextLimitedRadicalComplex.pl` (fixed warnings) +- `contexts/contextRationalExponent.pl` (fixed warnings) +- `math/interpMacros.pl` (fixed warnings) +- `math/PCCfactor.pl` (fixed warnings) +- `math/SolveLinearEquationPCC.pl` (fixed warnings) +- `math/SystemsOfLinearEquationsProblemPCC.pl` (fixed warnings) + ## Todo - remove `BrockPhysicsMacros.pl` doesn't do anything. -- remove `parserUtils.pl` and refactor the two problems that depend on it. -- remove `answers/PGmiscevaluators.pl` (not used in OPL/Contrib) -- remove `answers/PGstringevaluators.pl` (not used in OPL/Contrib) -- remove `answers/PGtextevaluators.pl` (used in only 1 problems in OPL/Contrib) +- remove `parserUtils.pl` and refactor the two problems that depend on it. Seems like functionality is elsewhere. - remove `answers/answerDiscussion.pl` (not used in OPL/Contrib) +- Remove `contexts/contextPeriodic.pl`. Labelled as deprecated. No problems in OPL/Contrib. - only place `answerUtils.pl` is used is inside `unorderedAnswer.pl` (combine? refactor?) - none of the LiveGraphics is working. Search for `LiveGraphics*.pl` - What is the `fracListChecker.pl` macro? In a number of `Contrib/Mizzou` problems. @@ -196,31 +206,3 @@ u - `parserLinearInequality.pl` - `parserParametricPlane.pl` -- Remove `contexts/contextPeriodic.pl`. Labelled as deprecated. No problems in OPL/Contrib. - -## Info - -This PR does a few related things. - -1. Adds some directory structure to the `PG_ROOT/macros` directory. -2. Moves needed macros from the OPL macros directory into the PG_ROOT directories. -3. Updates the `t/load_macros.t` test to recursively search the `PG_ROOT/macros` directory - for macros instead of the assumed old directory structure. - -Also for testing, the following homework set was used. This set contains at least one problem for every macro. - -A number of issues arose while doing this. - -- there are a number of errors in the OPL macros that were not being shown (they are in the apache logs). These are to be fixed in this PR. -- The following macros are obsolete: algebraMacros, PGstringevaluators.pl, .... - This is because the functionality appears in other macros and there are redefined - subroutine errors upon loads. Problems with these macros need to be adjusted in the - OPL. A forthcoming PR to the webwork-problem-libraries branch will contain the deletion of the macros as well as updates to the problems. Note: the timing of this will be important so existing OPLs will still function. - -Lastly, to keep the size of this discussion box reasonable, all of the changes are -documented in `PG_ROOT/macros/README.md`. Clearly these can be added to this discussion -or some other way of documenting all of these change. Because this involved moving -files from one repository to another, git will not track specific changes, just additions and deletions. - -This is based on PR ?? because of the update to the testing infrastructure makes it -much easier to do testing with this PR. diff --git a/macros/contexts/contextFiniteSolutionSets.pl b/macros/contexts/contextFiniteSolutionSets.pl index 3564f54476..95a0713150 100644 --- a/macros/contexts/contextFiniteSolutionSets.pl +++ b/macros/contexts/contextFiniteSolutionSets.pl @@ -39,10 +39,10 @@ =head1 NAME 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 +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 +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. @@ -155,7 +155,7 @@ sub _contextFiniteSolutionSets_init { 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 ($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 diff --git a/macros/contexts/contextLimitedRadicalComplex.pl b/macros/contexts/contextLimitedRadicalComplex.pl index c771e5f8d4..e648f52e1c 100644 --- a/macros/contexts/contextLimitedRadicalComplex.pl +++ b/macros/contexts/contextLimitedRadicalComplex.pl @@ -1,59 +1,59 @@ =head1 NAME -contextLimitedRadical.pl - defines a root(n,x) function for n-th root of x, and +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 +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 +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 +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. +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 +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 +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 +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 +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 +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 +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. @@ -90,7 +90,7 @@ sub _contextLimitedRadicalComplex_init { $context->flags->set( reduceConstantFunctions => 0, reduceConstants => 0, - formatStudentAnswer => parsed, + formatStudentAnswer => 'parsed', checkSqrt => 0, checkRoot => 0 ); @@ -111,7 +111,8 @@ sub _contextLimitedRadicalComplex_init { bizarroMul => 1, bizarroDiv => 1 ); - delete $correct->{test_values}, $student->{test_values}; + 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, diff --git a/macros/contexts/contextRationalExponent.pl b/macros/contexts/contextRationalExponent.pl index 2a182fc825..78ff4aeb38 100644 --- a/macros/contexts/contextRationalExponent.pl +++ b/macros/contexts/contextRationalExponent.pl @@ -48,7 +48,7 @@ sub _contextRationalExponent_init { $context->flags->set( reduceConstantFunctions => 0, reduceConstants => 0, - formatStudentAnswer => parsed, + formatStudentAnswer => 'parsed', checkSqrt => 0, checkRoot => 0 ); diff --git a/macros/graph/PCCgraphMacros.pl b/macros/graph/PCCgraphMacros.pl index 0eb81b0860..6376e10e02 100644 --- a/macros/graph/PCCgraphMacros.pl +++ b/macros/graph/PCCgraphMacros.pl @@ -18,7 +18,7 @@ =head1 DESCRIPTION =cut -loadMacros("PCCmacros.pl",); +sub _init_PCCgraphMacros { loadMacros('PCCmacros.pl');} ############################### #Some standard values diff --git a/macros/math/PCCfactor.pl b/macros/math/PCCfactor.pl index 98190b97b4..d9c517548e 100644 --- a/macros/math/PCCfactor.pl +++ b/macros/math/PCCfactor.pl @@ -255,22 +255,22 @@ sub factoringMethods { my @y = ($yStart, $yEnd); my $gap = $ymax / 100; - my $box1, $box2, $box3, $box4, $box1Up, $box1Left, $box2Up, $box3Left; + my ($box1, $box2, $box3, $box4, $box1Up, $box1Left, $box2Up, $box3Left); for (my $i = 0; $i <= 1; $i++) { $picture[$i] = init_graph($xmin, $ymin, $xmax, $ymax, pixels => [ 400, 400 ]); $picture[$i]->moveTo($x[0], $y[0]); - $picture[$i]->lineTo($x[1], $y[0], blue, 3); - $picture[$i]->lineTo($x[1], $y[1], blue, 3); - $picture[$i]->lineTo($x[0], $y[1], blue, 3); - $picture[$i]->lineTo($x[0], $y[0], blue, 3); + $picture[$i]->lineTo($x[1], $y[0], 'blue', 3); + $picture[$i]->lineTo($x[1], $y[1], 'blue', 3); + $picture[$i]->lineTo($x[0], $y[1], 'blue', 3); + $picture[$i]->lineTo($x[0], $y[0], 'blue', 3); $picture[$i]->moveTo($x[0], $ymax / 2); - $picture[$i]->lineTo($x[1], $ymax / 2, blue, 2); + $picture[$i]->lineTo($x[1], $ymax / 2, 'blue', 2); $picture[$i]->moveTo($xmax / 2, $y[0]); - $picture[$i]->lineTo($xmax / 2, $y[1], blue, 2); + $picture[$i]->lineTo($xmax / 2, $y[1], 'blue', 2); $squareLength = $x[1] - $x[0]; if ($var[0] ne "1") { @@ -381,7 +381,7 @@ sub factoringMethods { my $j = $co[0] / $i; if ($j == int($j)) { push(@smallfactorA, $i); push(@largefactorA, $j); } } - my $factorPairsAOutput = ""; + for my $i (0 .. $#smallfactorA) { $factorPairsAOutput .= $smallfactorA[$i] . '(' . $largefactorA[$i] . ')'; if ($i % 4 == 3) { $factorPairsAOutput .= '\newline'; } @@ -394,7 +394,7 @@ sub factoringMethods { my $j = $co[2] / $i; if ($j == int($j)) { push(@smallfactorC, $i, -$i); push(@largefactorC, $j, -$j); } } - my $factorPairsCOutput = ""; + for my $i (0 .. $#smallfactorC) { $factorPairsCOutput .= $smallfactorC[$i] . '(' . $largefactorC[$i] . ')'; if ($i % 4 == 3) { $factorPairsCOutput .= '\newline'; } @@ -405,11 +405,11 @@ sub factoringMethods { $outputString .= $BCENTER . image( - insertGraph($picture[0]), - tex_size => 400, - height => 400, - width => 400, - extra_html_tags => "alt= '$alt1' title= '$alt1'" + insertGraph($picture[0]), + tex_size => 400, + height => 400, + width => 400, + extra_html_tags => "alt= '$alt1' title= '$alt1'" ) . $ECENTER . $PAR @@ -431,11 +431,11 @@ sub factoringMethods { . $PAR . $BCENTER . image( - insertGraph($picture[1]), - tex_size => 400, - height => 400, - width => 400, - extra_html_tags => "alt= '$alt2' title= '$alt2'" + insertGraph($picture[1]), + tex_size => 400, + height => 400, + width => 400, + extra_html_tags => "alt= '$alt2' title= '$alt2'" ) . $ECENTER . $PAR diff --git a/macros/math/PGmorematrixmacros.pl b/macros/math/PGmorematrixmacros.pl index e610a802fe..e877635885 100644 --- a/macros/math/PGmorematrixmacros.pl +++ b/macros/math/PGmorematrixmacros.pl @@ -488,8 +488,8 @@ sub vec_list_string { $rh_ans->{'ans_message'} = $display_ans . $parser->{error_msg}, $rh_ans->{'preview_text_string'} = '', $rh_ans->{'preview_latex_string'} = '', $rh_ans->throw_error( - 'SYNTAX', - 'syntax error in answer:' + 'SYNTAX', + 'syntax error in answer:' . $display_ans . $parser->{htmlerror} . "$main::BR" @@ -623,8 +623,8 @@ sub ans_array_filter { $rh_ans->{'ans_message'} = $display_ans . $parser->{error_msg}, $rh_ans->{'preview_text_string'} = '', $rh_ans->throw_error( - 'SYNTAX', - 'syntax error in answer:' + 'SYNTAX', + 'syntax error in answer:' . $display_ans . $parser->{htmlerror} . "$main::BR" diff --git a/macros/math/PGnauScheduling.pl b/macros/math/PGnauScheduling.pl index caaf3b9e7f..2a5ba74237 100644 --- a/macros/math/PGnauScheduling.pl +++ b/macros/math/PGnauScheduling.pl @@ -1010,13 +1010,11 @@ sub DrawProcessorSchedule { $done_array[$i], 'black', 'center', 'center' ); $pic->lb($label); - $pic->fillRegion( - [ - ($scaled_break_lines[$i] + $lower_region) / 2, - (($yupper - $yuppermargin) + ($ylower + $margin)) * 2 / 3, - 'gray' - ] - ); + $pic->fillRegion([ + ($scaled_break_lines[$i] + $lower_region) / 2, + (($yupper - $yuppermargin) + ($ylower + $margin)) * 2 / 3, + 'gray' + ]); } $label = new Label($scaled_break_lines[$i], $ylower + $margin * 3 / 4, $break_lines[$i], 'black', 'center', 'center'); diff --git a/macros/math/PGstatisticsmacros.pl b/macros/math/PGstatisticsmacros.pl index 63c34aae03..31f74d0ec6 100644 --- a/macros/math/PGstatisticsmacros.pl +++ b/macros/math/PGstatisticsmacros.pl @@ -215,11 +215,11 @@ =head3 Function to generate normally distributed random numbers =cut sub urand { # generate normally dist. random numbers - # urand(mean,sd,N,digits) - # Generates N random numbers. The distribution is set by - # mean equal to "mean" and the standard deviation given by - # "sd." The value of 'digits' gives the number of decimal - # places to return. + # urand(mean,sd,N,digits) + # Generates N random numbers. The distribution is set by + # mean equal to "mean" and the standard deviation given by + # "sd." The value of 'digits' gives the number of decimal + # places to return. my ($mean, $sd, $N, $digits) = @_; if ($N <= 0) { die "Invalid N: $N\n"; # Cannot generate negative or zero numbers. @@ -262,10 +262,10 @@ =head3 Function to generate exponentially distributed random numbers =cut sub exprand { # generate exponentially dist. numbers Exp(x,lambda) - # exprand(lambda,N,digits) - # Generates N random numbers. The distribution is exponetially - # distributed with parameter lambda. The value of 'digits' gives the - # number of decimal places to return. + # exprand(lambda,N,digits) + # Generates N random numbers. The distribution is exponetially + # distributed with parameter lambda. The value of 'digits' gives the + # number of decimal places to return. my ($lambda, $N, $digits) = @_; if ($lambda <= 0) { die "Invalid parameter lambda: $lambda\n"; # must be a positive number @@ -297,8 +297,8 @@ =head3 Function to generate Poisson distributed random numbers =cut sub poissonrand { # generate random, Poisson dist. numbers Pois(lambda) - # poissonrand(lambda,N) - # Generates N random numbers. The distribution is Poisson with parameter lambda. + # poissonrand(lambda,N) + # Generates N random numbers. The distribution is Poisson with parameter lambda. my ($lambda, $N) = @_; if ($lambda <= 0) { @@ -344,8 +344,8 @@ =head3 Function to generate Binomial distributed random numbers =cut sub binomrand { # generate random, binomial dist. numbers Bin(n,p) - # binomrand(p,N,num) - # Generates num random numbers. The distribution is binomial with parameters p and N. + # binomrand(p,N,num) + # Generates num random numbers. The distribution is binomial with parameters p and N. my ($p, $N, $num) = @_; if (($p <= 0) || ($p >= 1)) { @@ -401,8 +401,8 @@ =head3 Function to generate Bernoulli distributed random numbers =cut sub bernoullirand { # generate random, Bernoulli dist. numbers B(p) - # bernoullirand(p,num,{"success"=>"1","failure"=>"0"}) - # Generates num random numbers. The distribution is Bernoulli with parameter p. + # bernoullirand(p,num,{"success"=>"1","failure"=>"0"}) + # Generates num random numbers. The distribution is Bernoulli with parameter p. my $p = shift; my $num = shift; @@ -479,11 +479,11 @@ =head3 Generate random values from a discrete distribution. =cut sub discreterand { # generate random, values based on a given table - # discreterand($n,@tableOfProbabilities) - # Generates num random results. The distribution is in the given array. - # Each element in the array is itself an array. - # The first value in the array is the probability. - # The second value in the array is the value assocated with the probability. + # discreterand($n,@tableOfProbabilities) + # Generates num random results. The distribution is in the given array. + # Each element in the array is itself an array. + # The first value in the array is the probability. + # The second value in the array is the value assocated with the probability. my $num = shift; # Number of values to generate my @table = @_; # Table of arrays with the probabilities and values. @@ -545,22 +545,22 @@ =head3 Chi Squared statistic for a two way table =cut sub chisqrTable { # Given a two-way frequency table calculates the chi-squared test statistic - # chisqrTable(@frequencies) - # @frequencies is an array of pointers to arrays. Each array must have the same dimension. - # - # Returns an array: (chi square test statistic , number degrees of freedom) - # - # Example: - # my @row1 = (1,2,2,2); - # my @row2 = (3,1,2,4); - # my @row3 = (1,4,2,1); - # my @row4 = (3,1,4,3); - # my @row5 = (5,2,2,4); - # push(@table,~~@row1); - # push(@table,~~@row2); - # push(@table,~~@row3); - # push(@table,~~@row4); - # push(@table,~~@row5); + # chisqrTable(@frequencies) + # @frequencies is an array of pointers to arrays. Each array must have the same dimension. + # + # Returns an array: (chi square test statistic , number degrees of freedom) + # + # Example: + # my @row1 = (1,2,2,2); + # my @row2 = (3,1,2,4); + # my @row3 = (1,4,2,1); + # my @row4 = (3,1,4,3); + # my @row5 = (5,2,2,4); + # push(@table,~~@row1); + # push(@table,~~@row2); + # push(@table,~~@row3); + # push(@table,~~@row4); + # push(@table,~~@row5); my @table = @_; diff --git a/macros/math/SolveLinearEquationPCC.pl b/macros/math/SolveLinearEquationPCC.pl index 6bb0d13d48..7b05484f19 100644 --- a/macros/math/SolveLinearEquationPCC.pl +++ b/macros/math/SolveLinearEquationPCC.pl @@ -1,9 +1,7 @@ #These three subroutines uniformize how all our "solve this equation" problems are handled. -loadMacros("PCCmacros.pl"); - -sub _init_SolveLinearEquationPCCDevel { - +sub _init_SolveLinearEquationPCC { + loadMacros('PCCmacros.pl'); #Possibly add initialization code here #sub routine is not required, but prevents the macro from being re-loaded @@ -22,9 +20,8 @@ sub contextSetup { parser::Assignment->Allow; Context()->flags->set( reduceConstantFunctions => 0, - formatStudentAnswer => "parsed", + formatStudentAnswer => 'parsed', reduceConstants => 0, - formatStudentAnswer => parsed, reduceFractions => 0, showExtraParens => 0 ); diff --git a/macros/math/SystemsOfLinearEquationsProblemPCC.pl b/macros/math/SystemsOfLinearEquationsProblemPCC.pl index 58284041f8..235031c301 100644 --- a/macros/math/SystemsOfLinearEquationsProblemPCC.pl +++ b/macros/math/SystemsOfLinearEquationsProblemPCC.pl @@ -1,4 +1,3 @@ -loadMacros('PCCmacros.pl'); sub SystemOfLinearEquationsProblemSetup { @@ -65,7 +64,7 @@ sub makeSides { ) = @_; Context()->normalStrings; - my $ax, $by, $cx, $dy; + my ($ax, $by, $cx, $dy); if ($Asided == Fraction(1, 1)) { $ax = Formula("$X") } elsif ($Asided == Fraction(-1, 1)) { $ax = Formula("-$X") } @@ -250,7 +249,7 @@ sub SystemOfLinearEquationsProblemSolutionSetup { [```\\left\\{ \\begin{aligned} $left1 & = $right1\\\\ - $left2 & = $right2 + $left2 & = $right2 \\end{aligned} \\right.```] @@ -287,19 +286,20 @@ sub SystemOfLinearEquationsProblemSolutionSetup { if ($swap == 1) { ($left1, $right1, $left2, $right2, $leftOrd1, $rightOrd1, $leftOrd2, $rightOrd2) = makeSides( - $asided, $bsided, $csided, $dsided, $esided, $fsided, $xside1, $yside1, - $cside1, $xside2, $yside2, $cside2, $zeroa, $zerob, $zeroc, $zerod, - $zeroe, $zerof, $x, $y, "constant", 0, $leftOrd1, $rightOrd1, + $asided, $bsided, $csided, $dsided, $esided, $fsided, + $xside1, $yside1, $cside1, $xside2, $yside2, $cside2, + $zeroa, $zerob, $zeroc, $zerod, $zeroe, $zerof, + $x, $y, "constant", 0, $leftOrd1, $rightOrd1, $leftOrd2, $rightOrd2 ); $Attack = $Attack - . "Since there is a coefficient of [`-1`], it is wise to add the corresponding term to both sides of that equation, so that we have a coefficient of [`1`] to work with. + . "Since there is a coefficient of [`-1`], it is wise to add the corresponding term to both sides of that equation, so that we have a coefficient of [`1`] to work with. [```\\left\\{ \\begin{aligned} $left1 & = $right1\\\\ - $left2 & = $right2 + $left2 & = $right2 \\end{aligned} \\right.```] @@ -343,7 +343,7 @@ sub SystemOfLinearEquationsProblemSolutionSetup { [```\\left\\{\\begin{aligned} $left1 & = $right1\\\\ - $left2 & = $right2 + $left2 & = $right2 \\end{aligned}\\right.```] "; @@ -603,19 +603,19 @@ sub SystemOfLinearEquationsProblemSolutionSetup { $rightOrd2 ) = makeSides( - $asided * $eliminateYscalar1, $bsided * $eliminateYscalar1, - $csided * $eliminateYscalar2, $dsided * $eliminateYscalar2, - $esided * $eliminateYscalar1, $fsided * $eliminateYscalar2, - $xside1, $yside1, - $cside1, $xside2, - $yside2, $cside2, - $zeroa, $zerob, - $zeroc, $zerod, - $zeroe, $zerof, - $x, $y, - "constant", 0, - [ 0, 1, 2 ], [ 0, 1, 2 ], - [ 0, 1, 2 ], [ 0, 1, 2 ] + $asided * $eliminateYscalar1, $bsided * $eliminateYscalar1, + $csided * $eliminateYscalar2, $dsided * $eliminateYscalar2, + $esided * $eliminateYscalar1, $fsided * $eliminateYscalar2, + $xside1, $yside1, + $cside1, $xside2, + $yside2, $cside2, + $zeroa, $zerob, + $zeroc, $zerod, + $zeroe, $zerof, + $x, $y, + "constant", 0, + [ 0, 1, 2 ], [ 0, 1, 2 ], + [ 0, 1, 2 ], [ 0, 1, 2 ] ); Context()->normalStrings; @@ -628,7 +628,7 @@ sub SystemOfLinearEquationsProblemSolutionSetup { [```\\left\\{\\begin{aligned} $left1 & = $right1\\\\ - $left2 & = $right2 + $left2 & = $right2 \\end{aligned}\\right.```] Then we identify a common multiple of the [`$y`] coefficients. In this case, a common multiple is [`$lcmy`]. We rescale each equation so that the coefficients of [`$y`] become [`$lcmy`] and [`-$lcmy`]. @@ -655,12 +655,10 @@ sub SystemOfLinearEquationsProblemSolutionSetup { if ($determinant == Fraction(0, 1) and ($leftLastStep != $rightLastStep)) { $Attack = $Attack . "Since this is a false equation no matter what [`$x`] and [`$y`] are, the system has no solutions."; - } - elsif ($determinant == Fraction(0, 1) and ($leftLastStep == $rightLastStep)) { + } elsif ($determinant == Fraction(0, 1) and ($leftLastStep == $rightLastStep)) { $Attack = $Attack . "Since this equation is true no matter what [`$x`] and [`$y`] are, the system has infinitely solutions; Just let [`$x`] take any value and then use either equation to solve for [`$y`]. The pair that you get from this will satisfy both equations."; - } - else { + } else { $left1Step = ($eliminateXscalar1 == 1) ? $left1 : "$eliminateXscalar1\\left($left1\\right)"; $right1Step = ($eliminateXscalar1 == 1) ? $right1 : "$eliminateXscalar1\\left($right1\\right)"; $left2Step = ($eliminateXscalar2 == 1) ? $left2 : "$eliminateXscalar2\\left($left2\\right)"; @@ -671,19 +669,19 @@ sub SystemOfLinearEquationsProblemSolutionSetup { $rightOrd2 ) = makeSides( - $asided * $eliminateXscalar1, $bsided * $eliminateXscalar1, - $csided * $eliminateXscalar2, $dsided * $eliminateXscalar2, - $esided * $eliminateXscalar1, $fsided * $eliminateXscalar2, - $xside1, $yside1, - $cside1, $xside2, - $yside2, $cside2, - $zeroa, $zerob, - $zeroc, $zerod, - $zeroe, $zerof, - $x, $y, - "constant", 0, - [ 0, 1, 2 ], [ 0, 1, 2 ], - [ 0, 1, 2 ], [ 0, 1, 2 ] + $asided * $eliminateXscalar1, $bsided * $eliminateXscalar1, + $csided * $eliminateXscalar2, $dsided * $eliminateXscalar2, + $esided * $eliminateXscalar1, $fsided * $eliminateXscalar2, + $xside1, $yside1, + $cside1, $xside2, + $yside2, $cside2, + $zeroa, $zerob, + $zeroc, $zerod, + $zeroe, $zerof, + $x, $y, + "constant", 0, + [ 0, 1, 2 ], [ 0, 1, 2 ], + [ 0, 1, 2 ], [ 0, 1, 2 ] ); Context()->normalStrings; @@ -725,6 +723,8 @@ sub SystemOfLinearEquationsProblemSolutionSetup { # Set up the LinearSystems context # sub _SystemsOfLinearEquationsProblemPCC_init { + loadMacros('PCCmacros.pl', 'contextFraction.pl'); + my $context = $main::context{LinearSystems} = Parser::Context->getCopy("LimitedFraction"); $context->flags->set( diff --git a/macros/math/algebraMacros.pl b/macros/math/algebraMacros.pl index 3d62c0d298..05fccdb6e9 100644 --- a/macros/math/algebraMacros.pl +++ b/macros/math/algebraMacros.pl @@ -10,63 +10,6 @@ sub _init_macro_template { } -######################## display macros for cyclic and dihedral groups - -sub cyclic { - - my $n = shift; - -# leave one of the following return commands uncommented, depending on what notation you want to use for finite cyclic groups (e.g., Z/nZ) - - # display order n cyclic group as Z_n - return "\\mathbb{Z}_{$n}", - - # display order n cyclic group as C_n - # return "C_{$n}"; - - # display order n cyclic group as Z/nZ - # return "\\mathbb{Z}/{$n}\\mathbb{Z}"; - -} - -sub dihedral { - - my $n = shift; - -# if you want to display dihedral groups as D_n (for instance, D_4 is the dihedral group of order 8), then leave this subroutine unmodified - -# if you want to display dihedral groups as D_{2n} (for instance, D_8 is the dihedral group of order 8), then uncomment this set of if/else statements. The regular expression conditionals are to make sure it handles different types of arguments correctly. -# if( "$n" =~ m/^\s*(\d+)\s*$/ ) -# { -# $n = 2 * $1; -# } -# elsif( "$n" =~ m/^\s*(\w+)\s*$/ ) -# { -# $n = "2$1"; -# } -# else -# { -# $n = "2($n)"; -# } - - return "D_{$n}"; - -} - -sub quaternions { - - # if you want to display the Quaternion group as Q_8, then leave this subroutine unmodified - - return "Q_8" - -# if you want to display the Quaternion group using some other notation, comment the statement above and uncomment one of these (or add your own): - - # return "H_8" - - # return "Q" - -} - ######################## subroutines # fisher-yates shuffle @@ -133,7 +76,7 @@ sub disjointCycles { $result = List(map { List('(' . join(',', @$_) . ')') } @cycles); } else { Context()->strings->add(id => { alias => "identity" }); - $result = List((id)); + $result = List('('.$cycle[0].')'); } return $result; } diff --git a/macros/math/fixedPrecision.pl b/macros/math/fixedPrecision.pl index 436118ed89..37d5abddf3 100644 --- a/macros/math/fixedPrecision.pl +++ b/macros/math/fixedPrecision.pl @@ -1,4 +1,5 @@ sub _fixedPrecision_init { } +loadMacros('MathObjects.pl'); package FixedPrecision; our @ISA = ("Value::Real"); diff --git a/macros/math/interpMacros.pl b/macros/math/interpMacros.pl index 0cd3358f38..3232a6f298 100644 --- a/macros/math/interpMacros.pl +++ b/macros/math/interpMacros.pl @@ -5,7 +5,7 @@ sub interpVals { $arrayLength = ($#_) / 2; @A_ARRAY = @_[ 0 .. ($arrayLength - 1) ]; @B_ARRAY = @_[ $arrayLength .. ($#_ - 1) ]; - $A_VAL = @_[$#_]; + $A_VAL = $_[$#_]; $arrayLength2 = $#A_ARRAY; for ($i = 1; $i < ($#A_ARRAY + 1); $i++) { diff --git a/macros/parsers/parserUtils.pl b/macros/parsers/parserUtils.pl index b47528bc21..487786b38f 100644 --- a/macros/parsers/parserUtils.pl +++ b/macros/parsers/parserUtils.pl @@ -1,4 +1,8 @@ -loadMacros("unionImage.pl", "unionTables.pl",); + +# not sure why these are loaded. They are not used in this file. If these are loaded +# there is an error during the load_macros.t test. + +# loadMacros("unionImage.pl", "unionTables.pl",); $bHTML = '\begin{rawhtml}'; $eHTML = '\end{rawhtml}'; diff --git a/t/macros/load_macros.t b/t/macros/load_macros.t index 40473db666..93359a4607 100644 --- a/t/macros/load_macros.t +++ b/t/macros/load_macros.t @@ -16,11 +16,22 @@ use lib "$ENV{PG_ROOT}/lib"; use Test2::V0; use File::Find; -use File::Basename; 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); @@ -30,12 +41,12 @@ find( sub { # Must be a file that has the ".pl" suffix. return unless -f && /\.pl$/; - push @macro_files, $File::Find::name; + push @macro_files, $_; }, "$ENV{PG_ROOT}/macros" ); -@macro_files = sort grep { my $f = fileparse($_); !$baseMacros{$f} && !$brokenMacros{$f} } @macro_files; +@macro_files = sort grep { !$baseMacros{$_} && !$brokenMacros{$_} } @macro_files; for (@macro_files) { subtest $_ => sub { From 3548561c1f8861372b9b56ca87b50c7dcc8cf511 Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Wed, 14 Sep 2022 16:59:48 -0400 Subject: [PATCH 4/9] WIP: reset the branch point to migration_to_test2_new rebase and perltidy --- macros/contexts/contextAlternateIntervals.pl | 472 +++++++++++ macros/contexts/contextFiniteSolutionSets.pl | 5 +- macros/{ => contexts}/contextTrigDegrees.pl | 0 macros/contexts/contextTypeset.pl | 4 +- macros/core/PGML.pl | 3 +- macros/core/PGbasicmacros.pl | 8 +- macros/core/PGcommonFunctions.pl | 24 +- macros/core/compoundProblem.pl | 678 +++++++++++++++ macros/core/sage.pl | 6 +- macros/graph/PCCgraphMacros.pl | 2 +- macros/math/algebraMacros.pl | 2 +- macros/parsers/parserVectorUtils.pl | 4 +- macros/ui/niceTables.pl | 834 +++++++++++++++++++ macros/ui/text2PG.pl | 3 +- macros/univ/PCCmacros.pl | 3 +- 15 files changed, 2018 insertions(+), 30 deletions(-) create mode 100644 macros/contexts/contextAlternateIntervals.pl rename macros/{ => contexts}/contextTrigDegrees.pl (100%) create mode 100644 macros/core/compoundProblem.pl create mode 100644 macros/ui/niceTables.pl diff --git a/macros/contexts/contextAlternateIntervals.pl b/macros/contexts/contextAlternateIntervals.pl new file mode 100644 index 0000000000..1fe75f0671 --- /dev/null +++ b/macros/contexts/contextAlternateIntervals.pl @@ -0,0 +1,472 @@ +################################################################################ +# WeBWorK Online Homework Delivery System +# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork +# +# This program is free software; you can redistribute it and/or modify it under +# the terms of either: (a) the GNU General Public License as published by the +# Free Software Foundation; either version 2, or (at your option) any later +# version, or (b) the "Artistic License" which comes with this package. +# +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# Artistic License for more details. +################################################################################ + +=head1 NAME + +C - Provides a context that allows the +entry of intervals using reversed bracket notation for open endpoints +(e.g., C<]a,b[> rather than C<(a,b)> for an open interval). + + +=head1 DESCRIPTION + +This macro file defines contexts in which open intervals can be +specified using reversed brackets rather than parentheses. Both forms +are always recognized, but you can determine whether one or the other +form produces an error message when used. You can also force the +display of intervals to use one or the other form. + + +=head1 USAGE + +To use this file, first load it into your problem, then select the +context that you wish to use. There are three pre-defined contexts, +C, C, and +C. The first allows both the standard and +alternate forms to be used, the second allows only the alternate form, +and the third allows only the standard form, but recognizes the +alternate form and gives an error message when it is used. + + loadMacros("contextAlternateIntervals.pl"); + + Context("AlternateIntervals"); + + $I1 = Compute("]2,5["); + $I2 = Compute("(2,5)"); # equivalent to $I1; + + Context("AlternateIntervals-Only"); + + $I1 = Compute("]2,5["); + $I2 = Compute("(2,5)"); # causes an error message + + Context("AlternateIntervals-Warning"); + + $I1 = Compute("]2,5["); # causes an error message + $I2 = Compute("(2,5)"); + +There are two context flags that control the input and output of +intervals. + +=over + +=item C "either" (or "alternate" or "stanard") >>> + +This specifies what formats the student is allowed to use to enter an +interval. A value of C<"either"> allows either of the formats to be +accepted, while the other two options produce error messages if the +wrong form is used. + +=item C "either" (or "alternate" or "standard") >>> + +This controls how intervals are displayed. When set to C<"either">, the +interval is displayed in whatever format was used to create it. When +set to C<"standard"> or C<"alternate">, the display is forced to be in the +given format regardless of how it was entered. + +=back + +The C context has both flags set to C<"either">, so the +intervals remain in the format the student entered them, and either +form can be used. The C context has both set to +C<"alternate">, so only the alternate format can be used, and any +Interval will be displayed in alternate format. The +C context has both set to C<"standard">, so only +standard format can be used, and all intervals will be displayed in +standard format. + +It is possible to set C and C to +different values. For example. + + Context()->flags->set( + enterIntervals => "either", + displayIntervals => "standard", + ); + +would allow students to enter intervals in either format, but all +intervals would be displayed in standard form. + +=head1 SETTING THE ALTERNATE FORM AS THE DEFAULT + +If you want to force existing problems that use the Interval context +to use one of the alternate contexts instead, then create a file named +C in your course's C +directory, and enter the following in it: + + loadMacros("contextAlternateIntervals.pl"); + context::AlternateIntervals->Default("either","either"); + +This will alter the C context so that students can +enter intervals in either format (and they will be shown in whatever +format that was used to enter them). + +You could also do + + loadMacros("contextAlternateIntervals.pl"); + context::AlternateIntervals->Default("standard","standard"); + +to cause a warning message to appear when students enter the alternate +format. + +If you want to force students to enter the alternate format, use + + loadMacros("contextAlternateIntervals.pl"); + context::AlternateIntervals->Default("alternate","alternate"); + +This will force the display of all intervals into the alternate form +(so even the ones created in the problem using standard form will show +using the alternate format), and will force students to enter their +results using the alternate format, though professor's answers will +still be allowed to be entered in either format (the C +function converts the first C<"alternate"> to C<"either">, but +arranges that the default flags for the answer checker are set to only +allow students to enter the alternative format). This allows you to +force alternate notation in problems without having to rewrite them. + +=cut + +########################################################################## + +loadMacros("MathObjects.pl"); + +sub _contextAlternateIntervals_init { context::AlternateIntervals->Init } + +########################################################################## + +package context::AlternateIntervals; + +# +# Create the AlternateIntervals contexts +# +sub Init { + my $self = shift; + my $context = $main::context{AlternateIntervals} = Parser::Context->getCopy("Interval"); + $context->{name} = "AlternateIntervals"; + $self->Enable($context); + + $context = $main::context{"AlternateIntervals-Only"} = $context->copy; + $context->{name} = "AlternativeIntervals-Only"; + $context->flags->set( + enterIntervals => "alternate", + displayIntervals => "alternate", + ); + + $context = $main::context{"AlternateIntervals-Warning"} = $context->copy; + $context->{name} = "AlternativeIntervals-Warning"; + $context->flags->set( + enterIntervals => "standard", + displayIntervals => "standard", + ); +} + +# +# Enables alternate intervals in the given context +# +sub Enable { + my $self = shift; + my $context = shift || main::Context(); + $context->flags->set( + enterIntervals => "either", # or "standard" or "alternate" + displayIntervals => "either", # or "standard" or "alternate" + ); + $context->parens->set( + "[" => { close => "[", type => "Interval", formInterval => [ "]", ")" ], removable => 0 }, + "]" => { close => "]", type => "Interval", formInterval => "[" }, + ); + $context->update; + $context->{value}{Interval} = "context::AlternateIntervals::Interval"; + $context->{value}{Formula} = "context::AlternateIntervals::Formula"; + $context->{parser}{Formula} = "context::AlternateIntervals::Formula"; + $context->{parser}{List} = "context::AlternateIntervals::Parser::List"; + $context->lists->set("Interval" => { class => "context::AlternateIntervals::Parser::Interval" }); +} + +# +# Sets the default Interval context to use alternate decimals. The +# two arguments determine the values for the enterIntervals and +# displayIntervals flags. If enterIntervals is "alternate", then +# student answers must use the alternate format for entering +# intervals (though professors can use either). +# +sub Default { + my $self = shift; + my $enter = shift || "either"; + my $display = shift || "either"; + my $cmp = ($enter eq "alternate"); + $enter = "either" if $cmp; + # + # This adds the names from InequalitySetBuilder, but we need a better way to + # link into contexts as they are created and copied. + # + my @InequalitySetBuilder = ( + "SetBuilder::", "InequalitySetBuilder::", + "InequalitySetBuilderInterval::", "InequalitySetBuilderUnion::", + "InequalitySetBuilderSet::", + ); + foreach my $name ("Interval", "Full") { + my $context = $main::context{$name} = Parser::Context->getCopy($name); + $self->Enable($context); + $context->flags->set(enterIntervals => $enter, displayIntervals => $display); + if ($cmp) { + foreach my $class ((grep {/::/} (keys %Value::)), @InequalitySetBuilder) { + $context->{cmpDefaults}{ substr($class, 0, -2) }{enterIntervals} = "alternate"; + } + } + } + main::Context(main::Context()->{name}); +} + +########################################################################## + +package context::AlternateIntervals::Formula; +our @ISA = ('Value::Formula'); + +# +# Replace the standard Open with one that handles formInterval better. +# We need to handle several possible close delimiters. +# +sub Open { + my $self = shift; + my $type = shift; + my $paren = $self->{context}{parens}{$type}; + if ($self->state eq 'operand') { + if ($type eq $paren->{close}) { + my $stack = $self->{stack}; + my $i = scalar(@{$stack}) - 1; + while ($i >= 0 && $stack->[$i]{type} ne "open") { $i-- } + if ($i >= 0 && $stack->[$i]{close}{$type}) { + $self->Close($type, $self->{ref}); + return; + } + } + $self->ImplicitMult(); + } + my $item = { type => 'open', value => $type, ref => $self->{ref}, close => {} }; + if ($paren->{formInterval}) { + my $close = $paren->{formInterval}; + $close = [$close] unless ref($close) eq 'ARRAY'; + $item->{close} = { map { $_ => 1 } @$close }; + } + $item->{close}{$type} = 1; + $self->push($item); +} + +# +# We need to modify the test for formInterval to NOT check the number +# of entries so that better error messages are produced, and to handle +# multiple close delimiters. These are both in teh "operand" branch, +# so do the original for all the choices, and copy that branch here, +# with our modifications. +# +sub Close { + my $self = shift; + my $type = shift; + my $ref = $self->{ref} = shift; + my $parens = $self->{context}{parens}; + + return $self->SUPER::Close($type, $ref, @_) if $self->state ne "operand"; + + $self->Precedence(-1); + return if ($self->{error}); + if ($self->state ne 'operand') { $self->Close($type, $ref); return } + my $paren = $parens->{ $self->prev->{value} }; + if ($paren->{close} eq $type) { + my $top = $self->pop; + if (!$paren->{removable} || ($top->{value}->type eq "Comma")) { + $top = $top->{value}; + $top = { + type => 'operand', + value => $self->Item("List")->new( + $self, [ $top->makeList ], + $top->{isConstant}, $paren, + ($top->type eq 'Comma') ? $top->entryType : $top->typeRef, + ($type ne 'start') ? ($self->top->{value}, $type) : () + ) + }; + } else { + $top->{value}{hadParens} = 1; + } + $self->pop; + $self->push($top); + $self->CloseFn() if ($paren->{function} && $self->prev->{type} eq 'fn'); + } else { + my $close = $paren->{formInterval} || []; + $close = [$close] unless ref($close) eq 'ARRAY'; + $close = { map { $_ => 1 } @$close }; + if ($close->{$type}) { + my $top = $self->pop->{value}; + my $open = $self->pop->{value}; + $self->pushOperand($self->Item("List") + ->new($self, [ $top->makeList ], $top->{isConstant}, $paren, $top->entryType, $open, $type)); + } else { + my $prev = $self->prev; + if ($type eq "start") { + $self->Error([ "Missing close parenthesis for '%s'", $prev->{value} ], $prev->{ref}); + } elsif ($prev->{value} eq "start") { + $self->Error([ "Extra close parenthesis '%s'", $type ], $ref); + } else { + $self->Error([ "Mismatched parentheses: '%s' and '%s'", $prev->{value}, $type ], $ref); + } + } + } +} + +sub class {'Formula'} + +########################################################################## + +package context::AlternateIntervals::Interval; +our @ISA = ('Value::Interval'); + +# +# Convert alternative form to regular form, but mark it as alternative. +# Give error messages about forms that aren't allowed by the context flags. +# +sub new { + my $self = shift; + return $self->SUPER::new(@_) unless scalar(@_) == 5; + my @args = @_; + my $alternate; + my $format = $self->getFlag("enterIntervals"); + if ($args[1] eq "]") { $alternate = 1; $args[1] = "(" } + if ($args[4] eq "[") { $alternate = 1; $args[4] = ")" } + Value->Error("You must use parentheses to form open intervals") + if $alternate && $format eq "standard"; + Value->Error("You must use reversed brackets to form open intervals") + if ($_[1] eq "(" || $_[4] eq ")") && $format eq "alternate"; + $self->SUPER::new(@args)->with(alternateForm => $alternate); +} + +# +# For alternative form, switch back to the alternative brackets for printing, +# or force standard or alternative form based on the context flags. +# +sub formatOutput { + my $self = shift; + my $method = shift; + my @args = @_; + my $format = $self->getFlag("displayIntervals"); + my $alternate = ($self->{alternateForm} || $format eq "alternate") && $format ne "standard"; + $args[1] = "]" if $alternate && ($args[1] || $self->{open}) eq "("; + $args[2] = "[" if $alternate && ($args[2] || $self->{close}) eq ")"; + $method = "SUPER::$method"; + $self->$method(@args); +} + +sub string { + my $self = shift; + $self->formatOutput("string", @_); +} + +sub TeX { + my $self = shift; + $self->formatOutput("TeX", @_); +} + +# +# This gets called directly, so pass it up the line +# +sub cmp_defaults { shift->SUPER::cmp_defaults(@_) } + +########################################################################## + +package context::AlternateIntervals::Parser::List; +our @ISA = ('Parser::List'); + +# +# Make sure that the standard open and close delimiters are +# used so that comparisons and so on will work properly. +# +sub new { + my $self = shift; + my $alternate = ($_[5] eq "]" || $_[6] eq "["); + my $list = $self->SUPER::new(@_); + return $list unless $alternate && $list->type eq "Interval"; + my $L = ($list->class eq "Value" ? $list->{value} : $list); + $L->{open} = "(" if $L->{open} eq "]"; + $L->{close} = ")" if $L->{close} eq "["; + $L->{alternateForm} = 1; + return $list; +} + +sub class {"List"} + +########################################################################## + +package context::AlternateIntervals::Parser::Interval; +our @ISA = ('Parser::List::Interval'); + +# +# Report errors when invalid form is specified +# +sub _check { + my $self = shift; + my $context = $self->context; + my $format = (($context->{answerHash} || {})->{enterIntervals} || $context->flag("enterIntervals")); + $self->Error("You must use parentheses to form open intervals") + if $format eq "standard" && ($self->{open} eq "]" || $self->{close} eq "["); + $self->Error("You must use reversed brackets to form open intervals") + if $format eq "alternate" && ($self->{open} eq "(" || $self->{close} eq ")"); + $self->SUPER::_check(@_); +} + +# +# Make a copy with the alternate delimiters, if needed. +# +sub fixDelimiters { + my $self = shift; + my $alternate = shift; + if ($alternate) { + $self = $self->copy; + $self->{open} = "]" if $self->{open} eq "("; + $self->{close} = "[" if $self->{close} eq ")"; + } + $self; +} + +# +# Override the output methods to replace the alternate delimiters, +# when needed. +# + +sub _eval { + my $self = shift; + return $self->fixDelimiters($self->{alternateForm})->SUPER::_eval(@_); +} + +sub string { + my $self = shift; + my $format = $self->{equation}{context}->flag("displayIntervals"); + my $alternate = + $self->type eq "Interval" + && ($self->{alternateForm} || $format eq "alternate") + && $format ne "standard"; + $self->fixDelimiters($alternate)->SUPER::string(@_); +} + +sub TeX { + my $self = shift; + my $format = $self->{equation}{context}->flag("displayIntervals"); + my $alternate = + $self->type eq "Interval" + && ($self->{alternateForm} || $format eq "alternate") + && $format ne "standard"; + $self->fixDelimiters($alternate)->SUPER::TeX(@_); +} + +sub class {"Interval"} + +########################################################################## + +1; diff --git a/macros/contexts/contextFiniteSolutionSets.pl b/macros/contexts/contextFiniteSolutionSets.pl index 95a0713150..388c5ad10e 100644 --- a/macros/contexts/contextFiniteSolutionSets.pl +++ b/macros/contexts/contextFiniteSolutionSets.pl @@ -155,7 +155,7 @@ sub _contextFiniteSolutionSets_init { 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 ($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 @@ -265,8 +265,9 @@ sub _contextFiniteSolutionSets_init { 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"); } - elsif ($n != 1) { push(@errors, "Your $ith answer is not correct") } } unless $ansHash->{isPreview}; } } 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/contexts/contextTypeset.pl b/macros/contexts/contextTypeset.pl index e6c242aa84..8991b5290f 100644 --- a/macros/contexts/contextTypeset.pl +++ b/macros/contexts/contextTypeset.pl @@ -235,8 +235,8 @@ sub _check { foreach my $r (@rows) { $r = ($r->class eq 'List' ? $r->{coords} : [$r]); while (scalar(@{$r}) < $c) { push(@{$r}, $null) } - $r = bless - $context->{parser}{List} + $r = + bless $context->{parser}{List} ->new($equation, $r, 0, $context->{parens}{start}, $Value::Type{number}, '[', ']'), $context->{lists}{Matrix}{class}; } diff --git a/macros/core/PGML.pl b/macros/core/PGML.pl index 38c6a96a6f..1859dd3828 100644 --- a/macros/core/PGML.pl +++ b/macros/core/PGML.pl @@ -391,8 +391,9 @@ sub Emphasis { } if ($self->nextChar(' ') !~ m/\s/ && $self->prevChar(' ') !~ m/[a-z0-9]/i) { $self->Begin($token, substr($token, 0, 1)); + } else { + $self->Text($token); } - else { $self->Text($token) } } sub Star { diff --git a/macros/core/PGbasicmacros.pl b/macros/core/PGbasicmacros.pl index e5148752ea..6ea4b73887 100644 --- a/macros/core/PGbasicmacros.pl +++ b/macros/core/PGbasicmacros.pl @@ -2882,9 +2882,9 @@ =head2 Macros for displaying images image($image, width => 100, height => 100, tex_size => 800, alt => 'alt text', extra_html_tags => 'style="border:solid black 1pt"'); -where C<$image> can be a local file path, URL, WWPlot object, or LaTeXImage object, -C and C are pixel counts for HTML display, while C is -per 1000 applied to linewidth (for example 800 leads to 0.8\linewidth) +where C<$image> can be a local file path, URL, WWPlot object, PGlateximage object, +or PGtikz object, C and C are pixel counts for HTML display, +while C is per 1000 applied to linewidth (for example 800 leads to 0.8\linewidth) image([$image1,$image2], width => 100, height => 100, tex_size => 800, alt => ['alt text 1','alt text 2'], extra_html_tags => 'style="border:solid black 1pt"'); image([$image1,$image2], width => 100, height => 100, tex_size => 800, alt => 'common alt text', extra_html_tags => 'style="border:solid black 1pt"'); @@ -2947,7 +2947,7 @@ sub image { while (@image_list) { my $image_item = shift @image_list; $image_item = insertGraph($image_item) - if (ref $image_item eq 'WWPlot' || ref $image_item eq 'LaTeXImage' || ref $image_item eq 'PGtikz'); + if (ref $image_item eq 'WWPlot' || ref $image_item eq 'PGlateximage' || ref $image_item eq 'PGtikz'); my $imageURL = alias($image_item) // ''; $imageURL = ($envir{use_site_prefix}) ? $envir{use_site_prefix} . $imageURL : $imageURL; my $out = ""; diff --git a/macros/core/PGcommonFunctions.pl b/macros/core/PGcommonFunctions.pl index 53b2ebc57a..f54ffa8cab 100644 --- a/macros/core/PGcommonFunctions.pl +++ b/macros/core/PGcommonFunctions.pl @@ -111,17 +111,17 @@ package main; sub sec { CommonFunction->Call('sec', @_) } sub csc { CommonFunction->Call('csc', @_) } -sub arcsin { CommonFunction->Call('asin', @_) }; +sub arcsin { CommonFunction->Call('asin', @_) } sub asin { CommonFunction->Call('asin', @_) } -sub arccos { CommonFunction->Call('acos', @_) }; +sub arccos { CommonFunction->Call('acos', @_) } sub acos { CommonFunction->Call('acos', @_) } -sub arctan { CommonFunction->Call('atan', @_) }; +sub arctan { CommonFunction->Call('atan', @_) } sub atan { CommonFunction->Call('atan', @_) } -sub arccot { CommonFunction->Call('acot', @_) }; +sub arccot { CommonFunction->Call('acot', @_) } sub acot { CommonFunction->Call('acot', @_) } -sub arcsec { CommonFunction->Call('asec', @_) }; +sub arcsec { CommonFunction->Call('asec', @_) } sub asec { CommonFunction->Call('asec', @_) } -sub arccsc { CommonFunction->Call('acsc', @_) }; +sub arccsc { CommonFunction->Call('acsc', @_) } sub acsc { CommonFunction->Call('acsc', @_) } sub sinh { CommonFunction->Call('sinh', @_) } @@ -131,17 +131,17 @@ package main; sub csch { CommonFunction->Call('csch', @_) } sub coth { CommonFunction->Call('coth', @_) } -sub arcsinh { CommonFunction->Call('asinh', @_) }; +sub arcsinh { CommonFunction->Call('asinh', @_) } sub asinh { CommonFunction->Call('asinh', @_) } -sub arccosh { CommonFunction->Call('acosh', @_) }; +sub arccosh { CommonFunction->Call('acosh', @_) } sub acosh { CommonFunction->Call('acosh', @_) } -sub arctanh { CommonFunction->Call('atanh', @_) }; +sub arctanh { CommonFunction->Call('atanh', @_) } sub atanh { CommonFunction->Call('atanh', @_) } -sub arcsech { CommonFunction->Call('asech', @_) }; +sub arcsech { CommonFunction->Call('asech', @_) } sub asech { CommonFunction->Call('asech', @_) } -sub arccsch { CommonFunction->Call('acsch', @_) }; +sub arccsch { CommonFunction->Call('acsch', @_) } sub acsch { CommonFunction->Call('acsch', @_) } -sub arccoth { CommonFunction->Call('acoth', @_) }; +sub arccoth { CommonFunction->Call('acoth', @_) } sub acoth { CommonFunction->Call('acoth', @_) } sub sgn { CommonFunction->Call('sgn', @_) } diff --git a/macros/core/compoundProblem.pl b/macros/core/compoundProblem.pl new file mode 100644 index 0000000000..fd6cd865df --- /dev/null +++ b/macros/core/compoundProblem.pl @@ -0,0 +1,678 @@ +sub _compoundProblem_init { }; # don't reload this file + +###################################################################### +# +# This package implements a method of handling multi-part problems +# that show only a single part at any one time. The students can +# work on one part at a time, and then when they get it right (or +# under other circumstances deterimed by the professor), they can +# move on to the next part. Students can not return to earlier parts +# once they have been completed. The score for problem as a whole is +# made up from the scores on the individual parts, and the relative +# weighting of the various parts can be specified by the problem +# author. +# +# To use the compoundProblem library, use +# +# loadMacros("compoundProblem.pl"); +# +# at the top of your file, and then create a compoundProblem object +# via the command +# +# $cp = new compoundProblem(options) +# +# where '$cp' is the name of a variable that you will use to +# refer to the compound problem, and 'options' can include: +# +# parts => n The number of parts in the problem. +# Default: 1 +# +# weights => [n1,...,nm] The relative weights to give to each +# part in the problem. For example, +# weights => [2,1,1] +# would cause the first part to be worth 50% +# of the points (twice the amount for each of +# the other two), while the second and third +# part would be worth 25% each. If weights +# are not supplied, the parts are weighted +# by the number of answer blanks in each part +# (and you must provide the total number of +# blanks in all the parts by supplying the +# totalAnswers option). +# +# totalAnswers => n The total number of answer blanks in all +# the parts put together (this is used when +# computing the per-part scores, if part +# weights are not provided). +# +# saveAllAnswers => 0 or 1 Usually, the contents of named answer blanks +# from previous parts are made available to +# later parts using variables with the +# same name as the answer blank. Setting +# saveAllAnswers to 1 will cause ALL answer +# blanks to be available (via variables +# like $AnSwEr1, and so on). +# Default: 0 +# +# parserValues => 0 or 1 Determines whether the answers from previous +# parts are returned as MathObjects (like +# those returned from Real(), Vector(), etc) +# or as strings (the unparsed contents of the +# student answer). If you intend to use the +# previous answers as numbers, for example, +# you would want to set this to 1 so that you +# would get the final result of any formula +# the student typed, rather than the formula +# itself as a character string. +# Default: 0 +# +# nextVisible => type Tells when the "go on to the next part" option +# is available to the student. The possible +# types include: +# +# 'ifCorrect' next is available only when +# all the answers are correct. +# +# 'Always' next is always available +# (but remember that students +# can't go back once they go +# on.) +# +# 'Never' next is never allowed (the +# problem will control going +# on to the next part itself). +# +# Default: 'ifCorrect' +# +# nextStyle => type Determines the style of "next" indicator to display +# (when it is available). The type can be one of: +# +# 'CheckBox' a checkbox that allows the students +# to go on to the next part when they +# submit their answers. +# +# 'Button' a button that submits their answers +# and goes on to the next part. +# +# 'Forced' forces the student to go on to the +# next part the next time they submit +# answers. +# +# 'HTML' allows you to provide an arbitrary +# HTML string of your own. +# +# Default: 'Checkbox' +# +# nextLabel => string Specifies the string to use as the label for the checkbox, +# the name of the button, the text of the message indicating +# that the next submit will move to the next part, or the +# HTML string, depending on the setting of nextStyle above. +# +# nextNoChange => 0 or 1 Since the students must submit their answers again to go on +# to the next part, it is possible for them to change their +# answers before they submit, and if nextVisible is 'ifCorrect' +# they might go on to the next without having correct answers +# stored. This option lets you control whether the answers +# are checked against the previous ones before going on to the +# next part. If the answers don't match, a warning is issued +# and they are not allowed to move on. +# Default: 1 +# +# allowReset => 0 or 1 Determines whether a "Go back to the first part" checkbox +# is provided on parts 2 and later. This is intended for +# the professor during testing of the problem (otherwise +# it would be impossible to go back to earlier parts). +# Default: 0 +# +# resetLabel => string The string used to label the reset checkbox. +# +# Once you have created a compoundProblem object, you can use $cp->part to +# determine the part that the student is working on, and use 'if' statements +# to display the proper information for the given part. The compoundProblem +# object takes care of maintaining the data as the parts change. (See the +# compoundProblem.pg file for an example of a compound problem.) +# +# In order to handle the scoring of the problem as a whole when only part is +# showing, the compoundProblem object uses its own problem grader to manage +# the scores, and calls your own grader from there. The default is to use +# the one that was installed before the compoundProblem object was created, +# or avg_problem_grader if none was installed. You can specify a different +# one using the $cp->useGrader() method (see below). It is important that +# you NOT call install_problem_grader() yourself once you have created the +# compoundProblem object, as that would disable the special grader, causing +# the compound problem to fail to work properly. +# +# You may call the following methods once you have a compoundProblem: +# +# $cp->part Returns the part the student is working on. +# $cp->part(n) Sets the part to be part n, as long as the +# student has finished the preceeding parts. +# If not, the part is set to the highest +# one the student hasn't completed, and he +# can work up to the given part. (The +# nextVisible option is set to 'ifCorrect' if +# it was 'Never' so that students can go on +# once they finish the earlier parts.) +# +# $cp->useGrader(code_ref) Supplies your own grader to use in +# place of the default one. For example: +# $cp->useGrader(~~&std_problem_grader); +# +# $cp->score Returns the (weighted) score for this part. +# Note that this is the score shown at the bottom +# of the page on which the student pressed submit +# (not the score for the answers the student is +# submitting -- that is not available until +# after the body of the problem has been created). +# +# $cp->scoreRaw Returns the unweighted score for this part. +# +# $cp->scoreOverall Returns the overall score for the problem +# so far. +# +# $cp->addAnswers(list) Make additional answer blanks be available +# from one part to another. E.g., +# $cp->addAnswers('AnSwEr1'); +# would make the first unnamed blank be available +# in later parts as well. (This command should +# be issued only when the part containing the +# given answer blank is displayed.) +# +# $cp->nextCheckbox(label) Returns the HTML string for the "go on to next +# part" checkbox so you can use it in the body of +# the problem if you wish. This should not be +# inserted when the $displayMode is 'TeX'. If the +# label is not given or is blank, the default label +# is used. +# +# $cp->nextButton(label) Returns the HTML string for the "go on to next +# part" button so you can use it in the body of +# the problem if you wish. This should not be +# inserted when the $displayMode is 'TeX'. If the +# label is not given or is blank, the default label +# is used. +# +# $cp->nextForces(label) Returns the HTML string for the forced "go on to +# next part" so you can use it in the body of +# the problem if you wish. This should not be +# inserted when the $displayMode is 'TeX'. If the +# label is not given or is blank, the default label +# is used. +# +# $cp->reset Go back to part 1, clearing the answers +# and score. (Best used when debugging problems.) +# +# $cp->resetCheckbox(label) Returns the HTML string for the reset checkbox +# so that you can provide one within the body +# of the problem if you wish. This should not be +# inserted when the $displayMode is 'TeX'. If the +# label is not given or is blank, the default label +# will be used. +# + +###################################################################### + +package compoundProblem; + +# +# The state data that is stored between invocations of +# the problem. +# +our %defaultStatus = ( + part => 1, # the current part + answers => "", # answer labels from previous parts + new_answers => "", # answer labels for THIS part + ans_rule_count => 0, # the ans_rule count from previous parts + new_ans_rule_count => 0, # the ans_rule count from THIS part + images_created => 0, # the image count from the precious parts + new_images_created => 0, # the image count from THIS part + imageName => "", # name of images_created image file + score => 0, # the (weighted) score on this part + total => 0, # the total on previous parts + raw => 0, # raw score on this part +); + +# +# Create a new instance of the compound Problem and initialize +# it. This includes reading the status from the previous +# parts, defining the variables from the answers to previous parts, +# and setting up the grader so that the current data can be saved. +# +sub new { + my $self = shift; + my $class = ref($self) || $self; + my $cp = bless { + parts => 1, + totalAnswers => undef, + weights => undef, # array of weights per part + saveAllAnswers => 0, # usually only save named answers + parserValues => 0, # make Parser objects from the answers? + nextVisible => "ifCorrect", # or "Always" or "Never" + nextStyle => "Checkbox", # or "Button", "Forced", or "HTML" + nextLabel => undef, # Checkbox text or button name or HTML + nextNoChange => 1, # true if answer can't change for new part + allowReset => 0, # true to show "back to part 1" button + resetLabel => undef, # label for reset button + grader => $main::PG->{flags}->{PROBLEM_GRADER_TO_USE} || \&main::avg_problem_grader, + @_, + status => $defaultStatus, + }, $class; + die "You must provide either the totalAnswers or weights" + unless $cp->{totalAnswers} || $cp->{weights}; + $cp->getTotalWeight if $cp->{weights}; + main::loadMacros("Parser.pl") if $cp->{parserValues}; + $cp->reset if $cp->{allowReset} && $main::inputs_ref->{_reset}; + $cp->getStatus; + $cp->initPart; + return $cp; +} + +# +# Compute the total of the weights so that the parts can +# be properly scaled. +# +sub getTotalWeight { + my $self = shift; + $self->{totalWeight} = 0; + $self->{totalAnswers} = 1; + foreach my $w (@{ $self->{weights} }) { $self->{totalWeight} += $w } + $self->{totalWeight} = 1 if $self->{totalWeight} == 0; +} + +# +# Look up the status from the previous invocation +# and see if we need to go on to the next part. +# +sub getStatus { + my $self = shift; + main::RECORD_FORM_LABEL("_next"); + main::RECORD_FORM_LABEL("_status"); + $self->{status} = $self->decode; + $self->{isNew} = $main::inputs_ref->{_next} + || ($main::inputs_ref->{submitAnswers} + && $main::inputs_ref->{submitAnswers} eq ($self->{nextLabel} || $main::PG->maketext("Go on to next part"))); + if ($self->{isNew}) { + $self->checkAnswers; + $self->incrementPart unless $self->{nextNoChange} && $self->{answersChanged}; + } +} + +# +# Initialize the current part by setting the ans_rule +# count (so that later parts will get unique answer names), +# installing the grader (to save the data), and setting +# the variables for previous answers. +# +sub initPart { + my $self = shift; + $main::ans_rule_count = $self->{status}{ans_rule_count}; + $main::images_created{ $self->{status}{imageName} } = $self->{status}{images_created} + if $self->{status}{imageName}; + main::install_problem_grader(\&compoundProblem::grader); + $main::PG->{flags}->{compoundProblem} = $self; + $self->initAnswers($self->{status}{answers}); +} + +# +# Look through the list of answer labels and set +# the variables for them to be the associated student +# answer. Make it a Parser value if requested. +# Record the value so that is will be available +# again on the next invocation. +# +sub initAnswers { + my $self = shift; + my $answers = shift; + foreach my $id (split(/;/, $answers)) { + my $value = $main::inputs_ref->{$id}; + $value = '' unless defined($value); + if ($self->{parserValues}) { + my $parser = Parser::Formula($value); + $parser = Parser::Evaluate($parser) if $parser && $parser->isConstant; + $value = $parser if $parser; + } + ${"main::$id"} = $value unless $id =~ m/$main::ANSWER_PREFIX/o; + $value = quoteHTML($value); + main::TEXT(qq!!); + main::RECORD_FORM_LABEL($id); + } +} + +# +# Look to see is any answers have changed on this +# invocation of the problem. +# +sub checkAnswers { + my $self = shift; + foreach my $id (keys(%{$main::inputs_ref})) { + if ($id =~ m/^previous_(.*)$/) { + if ($main::inputs_ref->{$id} ne $main::inputs_ref->{$1}) { + $self->{answersChanged} = 1; + $self->{isNew} = 0 if $self->{nextNoChange}; + return; + } + } + } +} + +# +# Go on to the next part, updating the status +# to include the data from the old part so that +# it will be properly preserved when the next +# part is showing. +# +sub incrementPart { + my $self = shift; + my $status = $self->{status}; + if ($status->{part} < $self->{parts}) { + $status->{part}++; + $status->{answers} .= ';' if $status->{answers}; + $status->{answers} .= $status->{new_answers}; + $status->{ans_rule_count} = $status->{new_ans_rule_count}; + $status->{images_created} = $status->{new_images_created}; + $status->{total} += $status->{score}; + $status->{score} = $status->{raw} = 0; + $status->{new_answers} = ''; + } +} + +###################################################################### + +# +# Encode all the status information so that it can be +# maintained as the student submits answers. Since this +# state information includes things like the score from +# the previous parts, it is "encrypted" using a dumb +# hex encoding (making it harder for a student to recognize +# it as valuable data if they view the page source). +# +sub encode { + my $self = shift; + my $status = shift || $self->{status}; + my @data = (); + my $data = ""; + foreach my $id (main::lex_sort(keys(%defaultStatus))) { push(@data, $status->{$id}) } + foreach my $c (split(//, join('|', @data))) { $data .= toHex($c) } + return $data; +} + +# +# Decode the data and break it into the status hash. +# +sub decode { + my $self = shift; + my $status = shift || $main::inputs_ref->{_status}; + return {%defaultStatus} unless $status; + my @data = (); + foreach my $hex (split(/(..)/, $status)) { push(@data, fromHex($hex)) if $hex ne '' } + @data = split('\\|', join('', @data)); + $status = {%defaultStatus}; + if (scalar(@data) == 8) { + # insert imageName, images_created, new_images_created, if missing + splice(@data, 2, 0, "", 0); + splice(@data, 6, 0, 0); + } + foreach my $id (main::lex_sort(keys(%defaultStatus))) { $status->{$id} = shift(@data) } + return $status; +} + +# +# Hex encoding is shifted by 10 to obfuscate it further. +# (shouldn't be a problem since the status will be made of +# printable characters, so they are all above ASCII 32) +# +sub toHex { main::spf(ord(shift) - 10, "%X") } +sub fromHex { main::spf(hex(shift) + 10, "%c") } + +# +# Make sure the data can be properly preserved within +# an HTML tag. +# +sub quoteHTML { + my $string = shift; + $string =~ s/&/\&/g; + $string =~ s/"/\"/g; + $string =~ s/>/\>/g; + $string =~ s/{grader} = shift; +} + +# +# Make additional answer blanks from the current part +# be preserved for use in future parts. +# +sub addAnswers { + my $self = shift; + $self->{extraAnswers} = [] unless $self->{extraAnswers}; + push(@{ $self->{extraAnswers} }, @_); +} + +# +# Go back to part 1 and clear the answers and scores. +# +sub reset { + my $self = shift; + if ($main::inputs_ref->{_status}) { + my $status = $self->decode($main::inputs_ref->{_status}); + foreach my $id (split(/;/, $status->{answers})) { delete $main::inputs_ref->{$id} } + foreach my $id (1 .. $status->{ans_rule_count}) { + delete $main::inputs_ref->{"${main::QUIZ_PREFIX}${main::ANSWER_PREFIX}$id"}; + } + } + $main::inputs_ref->{_status} = $self->encode(\%defaultStatus); + $main::inputs_ref->{_next} = 0; +} + +# +# Return the HTML for the "Go back to part 1" checkbox. +# +sub resetCheckbox { + my $self = shift; + my $label = shift + || " " + . $main::PG->maketext("Go back to Part 1") + . " (" + . $main::PG->maketext("when you submit your answers") . ")."; + my $par = shift; + $par = ($par ? $main::PAR : ''); + qq'$par$label'; +} + +# +# Return the HTML for the "next part" checkbox. +# +sub nextCheckbox { + my $self = shift; + my $label = shift + || " " + . $main::PG->maketext("Go on to next part") + . " (" + . $main::PG->maketext("when you submit your answers") . ")."; + my $par = shift; + $par = ($par ? $main::PAR : ''); + $self->{nextInserted} = 1; + qq!$par$label!; +} + +# +# Return the HTML for the "next part" button. +# +sub nextButton { + my $self = shift; + my $label = quoteHTML(shift || $main::PG->maketext("Go on to next part")); + my $par = shift; + $par = ($par ? $main::PAR : ''); + $par + . qq!!; +} + +# +# Return the HTML for when going to the next part is forced. +# +sub nextForced { + my $self = shift; + my $label = shift || "" . $main::PG->maketext("Submit your answers again to go on to the next part.") . ""; + $label = $main::PAR . $label if shift; + $self->{nextInserted} = 1; + qq!$label!; +} + +# +# Return the raw HTML provided +# +sub nextHTML { shift; shift } + +###################################################################### + +# +# Return the current part, or try to set the part to the given +# part (returns the part actually set, which may be earlier if +# the student didn't complete an earlier part). +# +sub part { + my $self = shift; + my $status = $self->{status}; + my $part = shift; + return $status->{part} unless defined $part && $main::displayMode ne 'TeX' && $main::displayMode ne 'PTX'; + $part = 1 if $part < 1; + $part = $self->{parts} if $part > $self->{parts}; + if ($part > $status->{part} && !$main::inputs_ref->{_noadvance}) { + unless ((lc($self->{nextVisible}) eq 'ifcorrect' && $status->{raw} < 1) + || lc($self->{nextVisible}) eq 'never') + { + $self->initAnswers($status->{new_answers}); + $self->incrementPart; + $self->{isNew} = 1; + } + } + if ($part != $status->{part}) { + main::TEXT(''); + $self->{nextVisible} = 'IfCorrect' if lc($self->{nextVisible}) eq 'never'; + } + return $status->{part}; +} + +# +# Return the various scores +# +sub score { shift->{status}{score} } +sub scoreRaw { shift->{status}{raw} } + +sub scoreOverall { + my $self = shift; + return $self->{status}{score} + $self->{status}{total}; +} + +###################################################################### +# +# The custom grader that does the work of computing the scores +# and saving the data. +# +sub grader { + my $self = $main::PG->{flags}->{compoundProblem}; + # + # Get the answer names and the weight for the current part. + # + my @answers = keys(%{ $_[0] }); + my $weight = scalar(@answers) / $self->{totalAnswers}; + $weight = $self->{weights}[ $self->{status}{part} - 1 ] / $self->{totalWeight} + if $self->{weights} && defined($self->{weights}[ $self->{status}{part} - 1 ]); + @answers = grep(!/$main::ANSWER_PREFIX/o, @answers) unless $self->{saveAllAnswers}; + push(@answers, @{ $self->{extraAnswers} }) if $self->{extraAnswers}; + my $space = ''; + + # + # Call the original grader, but put back the old recorded_score + # (the grader will have updated it based on the score for the PART, + # not the problem as a whole). + # + my $oldScore = ($_[1])->{recorded_score}; + my ($result, $state) = &{ $self->{grader} }(@_); + $state->{recorded_score} = $oldScore; + + # + # Update that state information and encode it. + # + my $status = $self->{status}; + $status->{raw} = $result->{score}; + $status->{score} = $result->{score} * $weight; + $status->{new_ans_rule_count} = $main::ans_rule_count; + if (%main::images_created) { + $status->{imageName} = (keys %main::images_created)[0]; + $status->{new_images_created} = $main::images_created{ $status->{imageName} }; + } + $status->{new_answers} = join(';', @answers); + my $data = quoteHTML($self->encode); + + # + # Update the recorded score + # + my $newScore = $status->{total} + $status->{score}; + $state->{recorded_score} = $newScore if $newScore > $oldScore; + $state->{recorded_score} = 0 if $self->{allowReset} && $main::inputs_ref->{_reset}; + + # + # Add the compoundProblem message and data + # + $result->{type} = "compoundProblem ($result->{type})"; + $result->{msg} .= '

    Note: ' if $result->{msg}; + $result->{msg} .= + $main::PG->maketext("This problem has more than one part.") . '
    ' + . $space + . '' + . $main::PG->maketext("Your score for this attempt is for this part only;") + . '' . '
    ' + . $space + . '' + . $main::PG->maketext("your overall score is for all the parts combined.") + . '' + . qq!!; + + # + # Warn if the answers changed when they shouldn't have + # + $result->{msg} .= + '

    ' . $main::PG->maketext("You may not change your answers when going on to the next part!") . '' + if $self->{nextNoChange} && $self->{answersChanged}; + + # + # Include the "next part" checkbox, button, or whatever. + # + my $par = 1; + if ($self->{parts} > $status->{part} && !$main::inputs_ref->{previewAnswers}) { + if (lc($self->{nextVisible}) eq 'always' + || (lc($self->{nextVisible}) eq 'ifcorrect' && $result->{score} >= 1)) + { + my $method = "next" . $self->{nextStyle}; + $par = 0; + $result->{msg} .= $self->$method($self->{nextLabel}, 1) . '
    '; + } + } + + # + # Add the reset checkbox, if needed + # + $result->{msg} .= $self->resetCheckbox($self->{resetLabel}, $par) + if $self->{allowReset} && $status->{part} > 1; + + # + # Make sure we don't go on unless the next button really is checked + # + $result->{msg} .= '' + unless $self->{nextInserted}; + + return ($result, $state); +} + +1; diff --git a/macros/core/sage.pl b/macros/core/sage.pl index 79ce1c6bf0..72d7e22fe8 100644 --- a/macros/core/sage.pl +++ b/macros/core/sage.pl @@ -63,9 +63,9 @@ sub new { ShowAnswerBlank => 'hidden', #'hidden','visible','none' AnswerReturn => 1, # (legacy, use ShowAnswerBlank=>'none') # 0 means no answer blank is registered - # accepted_tos =>'false', # force author to accept terms of service explicitly - # removed because sagecell.sagemath.org no longer requires - # acknowledgement of terms of service. + # accepted_tos =>'false', # force author to accept terms of service explicitly + # removed because sagecell.sagemath.org no longer requires + # acknowledgement of terms of service. @_ ); diff --git a/macros/graph/PCCgraphMacros.pl b/macros/graph/PCCgraphMacros.pl index 6376e10e02..6bb10719d0 100644 --- a/macros/graph/PCCgraphMacros.pl +++ b/macros/graph/PCCgraphMacros.pl @@ -18,7 +18,7 @@ =head1 DESCRIPTION =cut -sub _init_PCCgraphMacros { loadMacros('PCCmacros.pl');} +sub _init_PCCgraphMacros { loadMacros('PCCmacros.pl'); } ############################### #Some standard values diff --git a/macros/math/algebraMacros.pl b/macros/math/algebraMacros.pl index 05fccdb6e9..c458626f37 100644 --- a/macros/math/algebraMacros.pl +++ b/macros/math/algebraMacros.pl @@ -76,7 +76,7 @@ sub disjointCycles { $result = List(map { List('(' . join(',', @$_) . ')') } @cycles); } else { Context()->strings->add(id => { alias => "identity" }); - $result = List('('.$cycle[0].')'); + $result = List('(' . $cycle[0] . ')'); } return $result; } diff --git a/macros/parsers/parserVectorUtils.pl b/macros/parsers/parserVectorUtils.pl index 72a35dc269..ef64bc5643 100644 --- a/macros/parsers/parserVectorUtils.pl +++ b/macros/parsers/parserVectorUtils.pl @@ -67,8 +67,8 @@ sub BoldMath { my $v = shift; my $HTML = '' . $v . ''; MODES( - TeX => "\\boldsymbol{$v}", # doesn't seem to work in TeX mode - # TeX => "\\mathbf{$v}", # gives non-italic bold in TeX mode + TeX => "\\boldsymbol{$v}", # doesn't seem to work in TeX mode + # TeX => "\\mathbf{$v}", # gives non-italic bold in TeX mode Latex2HTML => "\\boldsymbol{$v}", HTML => $HTML, HTML_tth => '\begin{rawhtml}' . $HTML . '\end{rawhtml}', diff --git a/macros/ui/niceTables.pl b/macros/ui/niceTables.pl new file mode 100644 index 0000000000..cfa1e37b76 --- /dev/null +++ b/macros/ui/niceTables.pl @@ -0,0 +1,834 @@ + +=head1 niceTables.pl + +Subroutines for creating tables that + * conform to accessibility standards + * allow a lot of CSS flexibility for on-screen styling + * allow some LaTeX flexibility for hard copy styling + +Hard copy data tables will always have a top rule, bottom rule, and midrule after any header row + +DataTable() Creates a table with data. + Should not be used for layout, such as displaying an array of graphs. + Should usually make use of a caption and column and/or row headers. + +LayoutTable() Creates a "table" using div boxes for layout + +NOTE: In order to reduce separate setting of on-screen and hard copy settings as much as possible, Perl 5.10+ +tools are used. These macros may behave unexpectedly or not work at all with older versions of Perl. +These macros use LaTeX packages in the hard copy that wer not formerly part of a WeBWorK hard copy preamble. +Your LaTeX distribution needs to have the packages: booktabs, tabularx, colortbl, caption, xcolor +And if you have a WeBWorK version earlier than 2.10, you need to add calls to these packages to hardcopyPreamble.tex + in webwork2/conf/snippets/ + +=head2 Description + +Command for tables displaying data. In a data table the xy-position of a cell is somehow +important along with the information inside the cell. + + Usage: DataTable([[a,b,c,...],[d,e,f,...],[g,h,i,...],...], options); + + [[a,b,c,...],[d,e,f,...],[g,h,i,...],...] is the table content, row by row + +As much as possible, options can be declared to simultaneously apply to both on-screen and hard copy. +Generally, you give settings for the hard copy tex version first. Many common such settings are automatically +translated into CSS styling for the on-screen. You can then override or augment the CSS for the on-screen version. + +With PTX output, not all features below are supported. Perhaps they can be added upon request. +Contact Alex Jordan with questions. +This version supports the center, caption, midrules, encase, and noencase options in PTX. It also honors the +horizontal alignment portions of the align option (but not vertical rules or anything found in @{}). + +Options for the WHOLE TABLE + + Applies to on-screen *and* hard copy: + center => 0 or 1 # center table + caption => string # a caption for the table + midrules => 0 or 1 # if you want rules above and below every row + # (hard copies will always have toprule and bottomrule) + align => string # an alignment string like the kinds used in LaTeX tabular environments; + # some of what you specify here will apply to both on-screen and hard copy + (texalignment => string # -what won't is specified further below + is really what it is, # for example 'rccp{1in}' would be for a four-column table with a + but align is a shortcut) # right-aligned column, two centered columns, + # and a paragraph column of fixed width 1in; defaults to all c's; + # r is for right-alignment; on-screen will have no wrap + # c for center; on-screen will have no wrap + # l for left; on-screen will have no wrap + # p{width} is for a fixed-width paragraph column + # -width should be a valid tex width; if it is also a valid css width, + # -it will be used on-screen too; otherwise, on-screen will have unspecified width + Xratio => 0.97 # X ...if X is used in column alignment then the hard copy will have a width that + # is Xratio times the \linewidth, and X columns will be paragraph columns that + # grow to be whatever width fills the overall table width. For on-screen, X is + # a normal breaking-paragraph column that will expand to screen width before + # a break happens + # | as with array environments in LaTeX, you may use | for vertical rules. + # Preceding one of the above alignment types, you may use >{...} where the ... is + # more LaTeX commands to be applied everywhere in the column. For the simple text + # syling commands: \bfseries for bold, \itshape for italic, or \ttfamily for + # teletype (monospaced font), the on-screen version will be applied too. + # *You may include \color{...} here too, where ... is a coloring mixture from the + # xcolor package. 'blue' is an example of the simplest coloring mixture. For a much + # more complicated example: rgb:blue!30!green,1;-red!10!green,2 would give 1 part + # a 30%blue-70%green mixture, mixed with 2 parts the complement of a + # 10%red-90%green mixture. + # -only mixtures like \color{blue...} will be respected on-screen, and in that + # -case the first color will named be used. Use columnscss (discussed below) if + # -want to be more picky with the on-screen version. + # *You may include \columncolor{...} to color the background of cells, where ... + # follows the same rules as for \color{...} + # NOTE: Any color commands (\color, \columncolor, \rowcolor, \cellcolor) can take the + # option [HTML] and then an HTML hexadecimal color can be declared. For example, + # \color[HTML]{FF0000} for red. It works for on-screen and hard copy. Color + # specified this way should be the same on-screen and in the hard copy, whereas + # color specified the other way often differs. + # Any more complicated tex commands will be ignored for on-screen (or cause errors + # or not behave as expected). + encase => array ref # You may want to encase all table entries in, say, \( and \) to save from typing + # them many times. To do that, use encase => ['\(','\)']. For individual cells + # you may set noencase=>1 to omit this (see section on modifying cells). + rowheaders => 1 # Make the first element of every row a row header. + + Applies to on-screen: + tablecss => string # css styling commands for the table element (see below for css syntax) + captioncss => string # css styling commands for the caption element (see below for css syntax) + columnscss => array ref # an array reference to css styling commands (strings) for columns + # use empty strings for columns for which you have no style specifications + # Ex: columnscss => ['','background-color:yellow;','','background-color:yellow;'] + # -specifications made here overrule specifications from texalignment + datacss => string # css styling commands for all the td elements (see below for css syntax) + headercss => string # css styling commands for the th elements (see below for css syntax) + allcellcss => string # css styling commands for all the cells (see below for css syntax) + + +MODIFYING CELLS + + Each cell entry (like "a" in [[a,b,c,...],...])) can be replaced with an array reference (encased in square brackets) for + more detailed customization of that cell. For example, [[[a,header=>'CH'],b,c],[d,e,f]] gives a table where the a is + a column header cell. The data content of the cell must be the first element listed, and what follows must be key=>value pairs. + These options may be applied. + + Applies to both on-screen and hard copy: + halign => string # same format as align at the table level (discussed above) but for one cell only + header => type, # Could be 'TH' (table header), 'CH', 'col', or 'column' (col header), 'RH', or 'row' + # (row header). If so, default CSS styling is used, and hard copy cell is bold. + # Can also be 'TD' to overrule a row of all headers (see modifying rows) + # If your table only has column headers (no row headers) it is probably best to make + # an entire row of headers (see modifying a row) and to not use header=> directly. + # But if your table has both column and row headers then use header=> for all the + # headers (both row- and column-) and don't use the row modification (because in + # that situation you probably don't want a THEAD tag). + tex => tex code # For tex commands whose scope will be entire cell, e.g. \bfseries or \itshape; + # \bfseries (for bold), \itshape (for italic), and \ttfamily (for monospace) will + # lead to CSS equivalents for the on-screen version + # For cell coloring: like \cellcolor{blue} for the background or \color{blue} for the + # text, use color mixtures as described in texalignment=>, and simple colors will + # apply to the on-screen version too. + # -all other tex code will be ignored for the on-screen version, so use cellcss=> + # below + b=>1, i=>1, m=>1 # These are shortcuts for adding \bfseries, \itshape, and \ttfamily to tex, which will + # in turn affect he on-screen too. + noencase => 1 # If you have global encase strings (see section on modifying the whole table) then + # you can opt to not apply them on a cell by cell basis + colspan => pos integer # for cells that span more than one column; when using this, you must set halign for + # the cell too, or else the tex output will just use {c} alignment; this feature may + # not behave as expected for certain structures, like a two-row table, with 3 columns, + # but the first row has colspans 2 and 1 with the second row having colspans 1 and 2 + # **colspan is supported for DataTable only, not LayoutTable. LayoutTable uses css + # like display:table-cell; to achieve its output, and there is no counterpart to + # colspan using this approach (at least not currently) + + Applies to on-screen: + cellcss => string, # String with cell-specific CSS styling; see below for CSS syntax + + Applies to hard copy: + texpre => tex code, # For more fussy cell-by-cell alteration of the tex version of the table + # TeX code here will precede the cell entry... + texpost => tex code # and code here will follow the cell entry + # The ordering will be: texpre tex data texpost + texencase => array ref # This is just a shortcut for entering [texpre,texpost] at once. + + The "a" in a cell can also be replaced directly with a hash reference {data=>a,options} if somehow that is of use. If you + modify the cell using an array reference [a, options] instead, it is automatically converted to a hash reference anyway. + + +MODIFYING ROWS + + You can give a row background color using arguments from colortbl's \rowcolor command: + [[[a, rowcolor => '{blue!50}'],b,c,...],[d,e,f,...],[g,h,i,...],...] + [[[a, rowcolor => '[HTML]{FF0000}'],b,c,...],[d,e,f,...],[g,h,i,...],...] + For the on-screen version, if the first style of argument is used, only the first color mentioned will be used. + + A rowcss key can be used anywhere in the row. Only the last instance in that row will be applied. + [[[a, rowcss => extra css for the row],b,c,...],[d,e,f,...],[g,h,i,...],...] + + You can make an entire row be made of CH (column header) elements without specifying it for each header: + [[[a, headerrow=>1],b,c,...],[d,e,f,...],[g,h,i,...],...] + This also encases the row in a tag. This should only be applied to the first row. In the hard copy, + a row like this will have bold entries and be followed by a midrule. + + And you can follow a row with a horizontal rule: + [[[a, midrule => 1],b,c,...],[d,e,f,...],[g,h,i,...],...] + (but this is already done once for headerrows in the hard copy, since they don't rely on surrounding CSS to stand out) + +CSS SYNTAX PRIMER + + css styling commands offer a huge variety for styling the table on screen + Basic elements are of the form "A:B;" like "border:1pt;" and "width:80%;" + ****DON'T FORGET THE SEMICOLONS. SINCE THESE COMMANDS ACCUMULATE, SEMICOLONS ARE IMPORTANT. + Also, they can be of the form "A:B C;" like "border:1pt dashed;" + Multiple commands can be used with the form "A1:B;A2:C;" like "border:1pt; margin:5pt;" + Some properties with example values and which elements they can affect: + border:2px solid blue; table, caption, th, td + border-collapse:collapse; (or separate) table + border-radius: 5px; table, caption, tr, th, td + width:50%; table, caption, th, td + height:20ex; table, caption, tr, th, td + text-align:center; table, caption, tr, th, td + vertical-align:top; table, caption, tr, th, td + padding:12pt; table, caption, th, td + margin:20px; table, caption + border-spacing:12pt; table + caption-side:bottom; table, caption + color:blue; table, caption, tr, th, td + background-color:yellow; table, caption, tr, th, td + font-weight:bold; table, caption, tr, th, td + font-style:italic; table, caption, tr, th, td + font-family:monospace; table, caption, tr, th, td + The properties border, padding, and margin + can be specified in more detail using -left, -bottom, -right, -top as in "border-bottom:5px" + + Example: DataTable([[[1, header => 'CH', cellcss => 'font-family:fantasy;'],2,3], + [4,5,[6, rowcss => 'padding-top:10pt; padding-bottom:10pt; ']]], + tablecss => "border:solid 1px; border-spacing:5px; border-radius: 5px; border-collapse:separate;"); + +=cut + +sub _niceTables_init { }; # don't reload this file + +sub DataTable { + my $dataref = shift; + + # this array will store the number of cells in each row + my @numcols = (); + + # if any cells were simply entered as their data value or an array ref, convert to a hash + for my $i (0 .. $#{$dataref}) { + $numcols[$i] = $#{ $dataref->[$i] }; + for my $j (0 .. $numcols[$i]) { # if cell was simply entered as data value, make the hash + $dataref->[$i][$j] = { data => $dataref->[$i][$j] } + unless (ref($dataref->[$i][$j]) eq "HASH" or ref($dataref->[$i][$j]) eq "ARRAY"); + # and if it was entered as an array reference, make the hash + if (ref($dataref->[$i][$j]) eq "ARRAY") { + my $temp = $dataref->[$i][$j]; + $dataref->[$i][$j] = { "data", @$temp }; + } + #before [a, options] was an option, {d=>a,options} was a shortcut for {data=>a,options} + ${ $dataref->[$i][$j] }{data} = ${ $dataref->[$i][$j] }{d} if (defined ${ $dataref->[$i][$j] }{d}); + # set default values for cell + ${ $dataref->[$i][$j] }{header} = '' unless (defined ${ $dataref->[$i][$j] }{header}); + ${ $dataref->[$i][$j] }{tex} = '' unless (defined ${ $dataref->[$i][$j] }{tex}); + ${ $dataref->[$i][$j] }{b} = 0 unless (defined ${ $dataref->[$i][$j] }{b}); + ${ $dataref->[$i][$j] }{i} = 0 unless (defined ${ $dataref->[$i][$j] }{i}); + ${ $dataref->[$i][$j] }{m} = 0 unless (defined ${ $dataref->[$i][$j] }{m}); + ${ $dataref->[$i][$j] }{noencase} = 0 unless (defined ${ $dataref->[$i][$j] }{noencase}); + ${ $dataref->[$i][$j] }{halign} = '' unless (defined ${ $dataref->[$i][$j] }{halign}); + ${ $dataref->[$i][$j] }{colspan} = '' unless (defined ${ $dataref->[$i][$j] }{colspan}); + ${ $dataref->[$i][$j] }{cellcss} = '' unless (defined ${ $dataref->[$i][$j] }{cellcss}); + ${ $dataref->[$i][$j] }{rowcss} = '' unless (defined ${ $dataref->[$i][$j] }{rowcss}); + ${ $dataref->[$i][$j] }{rowcolor} = '' unless (defined ${ $dataref->[$i][$j] }{rowcolor}); + ${ $dataref->[$i][$j] }{midrule} = 0 unless (defined ${ $dataref->[$i][$j] }{midrule}); + ${ $dataref->[$i][$j] }{headerrow} = 0 unless (defined ${ $dataref->[$i][$j] }{headerrow}); + ${ $dataref->[$i][$j] }{texencase} = [ '', '' ] unless (defined ${ $dataref->[$i][$j] }{texencase}); + ${ $dataref->[$i][$j] }{texpre} = ${ $dataref->[$i][$j] }{texencase}->[0] + unless (defined ${ $dataref->[$i][$j] }{texpre}); + ${ $dataref->[$i][$j] }{texpost} = ${ $dataref->[$i][$j] }{texencase}->[1] + unless (defined ${ $dataref->[$i][$j] }{texpost}); + } + } + + # total number of columns + my $numcol = max(@numcols) + 1; + + # define options + my %options = ( + center => 1, + caption => '', + tablecss => '', + captioncss => '', + datacss => '', + headercss => '', + allcellcss => '', + texalignment => join('', ('c') x $numcol), + rowheaders => 0, + midrules => 0, + columnscss => [ ('') x $numcol ], + Xratio => 0.97, + encase => [ '', '' ], + LaYoUt => 0, + @_ + ); + if ($options{LaYoUt} != 1) { $options{allcellcss} = 'padding-left:6pt; padding-right:6pt; ' . $options{allcellcss} } + else { $options{allcellcss} = 'padding:12pt; ' . $options{allcellcss} } + $options{captioncss} = 'padding:6pt; ' . $options{captioncss}; + $options{tablecss} = 'border-collapse:collapse; ' . $options{tablecss}; + + my $caption = $options{caption}; + my ( + $tablecss, $captioncss, $datacss, $headercss, $allcellcss, + $texalignment, $midrules, $columnscss, $Xratio, $encase + ) + = ( + $options{tablecss}, $options{captioncss}, $options{datacss}, $options{headercss}, + $options{allcellcss}, $options{texalignment}, $options{midrules}, $options{columnscss}, + $options{Xratio}, $options{encase} + ); + my $center = $options{center}; + if ($center != 0) { $tablecss .= 'text-align:center; margin:0 auto; ' } + + # shortcuts introduced late + if (defined $options{align}) { $texalignment = $options{align} } + if ($options{rowheaders} == 1) { + for my $i (0 .. $#{$dataref}) { + ${ $dataref->[$i][0] }{header} = 'RH' if (uc(${ $dataref->[$i][0] }{header}) eq ''); + } + } + + # apply contents of encase; cell shortcuts + for my $i (0 .. $#{$dataref}) { + for my $j (0 .. $numcols[$i]) { + ${ $dataref->[$i][$j] }{data} = $encase->[0] . ${ $dataref->[$i][$j] }{data} . $encase->[1] + unless (${ $dataref->[$i][$j] }{noencase} == 1); + if (${ $dataref->[$i][$j] }{b} == 1) { ${ $dataref->[$i][$j] }{tex} .= '\bfseries '; } + if (${ $dataref->[$i][$j] }{i} == 1) { ${ $dataref->[$i][$j] }{tex} .= '\itshape '; } + if (${ $dataref->[$i][$j] }{m} == 1) { ${ $dataref->[$i][$j] }{tex} .= '\ttfamily '; } + } + } + + # for each row, store rowcss, rowcolor, midrule, headerrow + my @rowcss = (); + my @rowcolor = (); + my @midrule = (); + my @headerrow = (); + for my $i (0 .. $#{$dataref}) { + $rowcss[$i] = ''; + $rowcolor[$i] = ''; + $midrule[$i] = 0; + $headerrow[$i] = 0; + for my $j (0 .. $numcols[$i]) { + $rowcss[$i] = ${ $dataref->[$i][$j] }{rowcss} if ($rowcss[$i] eq ''); + $rowcolor[$i] = ${ $dataref->[$i][$j] }{rowcolor} if ($rowcolor[$i] eq ''); + $midrule[$i] = ${ $dataref->[$i][$j] }{midrule} if ($midrule[$i] == 0); + $headerrow[$i] = ${ $dataref->[$i][$j] }{headerrow} if ($headerrow[$i] == 0); + } + if ($rowcolor[$i] =~ /\{\s*(\w*)[}!]/) { + $rowcss[$i] = 'background-color:' . $1 . '; ' . $rowcss[$i]; + } + if ($rowcolor[$i] =~ /\[\s*HTML\s*\]\s*\{\s*(\w*)[}!]/) { + $rowcss[$i] = 'background-color:#' . $1 . '; ' . $rowcss[$i]; + } + } + + # parse tex alignment for duplicate use in html + my $bracesregex = qr/(\{(?>[^{}]|(?R))*\})/x; + # grabs outer level braces and their contents, including inner brace pairs + my $bracecontentsregex = qr/((?>[^{}]|(??{$bracesregex}))*)/x; + # grabs contents of an outer level brace pair, including inner brace pairs + my @htmlalignment = split(/(>\s*(??{$bracesregex})\s*|\|\s*|p\s*(??{$bracesregex})\s*|[rclX]\s*)/, $texalignment); + my @temp = (); + foreach (@htmlalignment) { + if ((defined $_) and ($_ ne '')) { + push(@temp, $_); + } + } + @htmlalignment = @temp; + # @htmlalignment is now an array, where the entries are the parsed pieces of $texalignment; entries parsed by + # >{commands}, pipes (for vertical rules), p{width}, r, c, l, or X + + my @columnalignments = grep { $htmlalignment[$_] =~ /^p\s*(??{$bracesregex})\s*|^[rclX]\s*/ } 0 .. $#htmlalignment; + # @columnalignments is an array, where the entries are the indices form @htmlalignment that actually deal with + # alignment: p{width}, r, c, l, or X + my @alignmentcolumns; + for my $i (0 .. $#columnalignments) { $alignmentcolumns[ $columnalignments[$i] ] = $i } + # @alignmentcolumns is an array whose ith element is undefined unless the ith element of @htmlalignment was one + # of p{width}, r, c, l, or X. Otherwise it is the index of the entry in @columnalignments that corresponds to + # that alignment + + # append css to author's columnscss->[$i] that corresponds to the alignemnts in @alignmentcolumns + for my $i (0 .. $#columnalignments) { + $columnscss->[$i] = TeX_Alignment_to_CSS($htmlalignment[ $columnalignments[$i] ]) . $columnscss->[$i]; + } + # append css to author's columnscss->[$i] that corresponds to other formatting that is in @htmlalignment + for my $i (0 .. $#htmlalignment) { + if ($htmlalignment[$i] =~ /\\color\s*\{\s*(\w*)[}!]/) { + my $j = $i; + while (!defined($alignmentcolumns[$j]) && $j < $#htmlalignment) { $j += 1; } + $columnscss->[ $alignmentcolumns[$j] ] = 'color:' . $1 . '; ' . $columnscss->[ $alignmentcolumns[$j] ]; + } + if ($htmlalignment[$i] =~ /\\color\s*\[\s*HTML\s*\]\s*\{\s*(\w*)[}!]/) { + my $j = $i; + while (!defined($alignmentcolumns[$j]) && $j < $#htmlalignment) { $j += 1; } + $columnscss->[ $alignmentcolumns[$j] ] = 'color:#' . $1 . '; ' . $columnscss->[ $alignmentcolumns[$j] ]; + } + if ($htmlalignment[$i] =~ /\\columncolor\s*\{\s*(\w*)[}!]/) { + my $j = $i; + while (!defined($alignmentcolumns[$j]) && $j < $#htmlalignment) { $j += 1; } + $columnscss->[ $alignmentcolumns[$j] ] = + 'background-color:' . $1 . '; ' . $columnscss->[ $alignmentcolumns[$j] ]; + } + if ($htmlalignment[$i] =~ /\\columncolor\s*\[\s*HTML\s*\]\s*\{\s*(\w*)[}!]/) { + my $j = $i; + while (!defined($alignmentcolumns[$j]) && $j < $#htmlalignment) { $j += 1; } + $columnscss->[ $alignmentcolumns[$j] ] = + 'background-color:#' . $1 . '; ' . $columnscss->[ $alignmentcolumns[$j] ]; + } + if ($htmlalignment[$i] =~ /\\bfseries$|\\bfseries\W/) { + my $j = $i; + while (!defined($alignmentcolumns[$j]) && $j < $#htmlalignment) { $j += 1; } + $columnscss->[ $alignmentcolumns[$j] ] = 'font-weight:bold; ' . $columnscss->[ $alignmentcolumns[$j] ]; + } + if ($htmlalignment[$i] =~ /\\itshape$|\\itshape\W/) { + my $j = $i; + while (!defined($alignmentcolumns[$j]) && $j < $#htmlalignment) { $j += 1; } + $columnscss->[ $alignmentcolumns[$j] ] = 'font-style:italic; ' . $columnscss->[ $alignmentcolumns[$j] ]; + } + if ($htmlalignment[$i] =~ /\\ttfamily$|\\ttfamily\W/) { + my $j = $i; + while (!defined($alignmentcolumns[$j]) && $j < $#htmlalignment) { $j += 1; } + $columnscss->[ $alignmentcolumns[$j] ] = 'font-family:monospace; ' . $columnscss->[ $alignmentcolumns[$j] ]; + } + if ($htmlalignment[$i] =~ /\|\s*/) { + my $j = $i; + while (!defined($alignmentcolumns[$j]) && $j < $#htmlalignment) { $j += 1; } + if ($j < $#htmlalignment) { + $columnscss->[ $alignmentcolumns[$j] ] = + "border-left:solid 1px; " . $columnscss->[ $alignmentcolumns[$j] ]; + } + if (defined $alignmentcolumns[$j]) { + if ($alignmentcolumns[$j] != 0) { + $columnscss->[ $alignmentcolumns[$j] - 1 ] = + "border-right:solid 1px; " . $columnscss->[ $alignmentcolumns[$j] - 1 ]; + } + } + if ($j == $#htmlalignment) { + if ($j == $i) { $columnscss->[-1] = "border-right:solid 1px; " . $columnscss->[-1]; } + else { $columnscss->[-1] = "border-left:solid 1px; " . $columnscss->[-1]; } + } + } + + } + + # translate individual cell's tex to css + + for my $i (0 .. $#{$dataref}) { + for my $j (0 .. $numcols[$i]) { + if (${ $dataref->[$i][$j] }{tex} =~ /\\color\s*\{\s*(\w*)[}!]/) { + ${ $dataref->[$i][$j] }{cellcss} = 'color:' . $1 . '; ' . ${ $dataref->[$i][$j] }{cellcss}; + } + if (${ $dataref->[$i][$j] }{tex} =~ /\\color\s*\[\s*HTML\s*\]\s*\{\s*(\w*)[}!]/) { + ${ $dataref->[$i][$j] }{cellcss} = 'color:#' . $1 . '; ' . ${ $dataref->[$i][$j] }{cellcss}; + } + if (${ $dataref->[$i][$j] }{tex} =~ /\\cellcolor\s*\{\s*(\w*)[}!]/) { + ${ $dataref->[$i][$j] }{cellcss} = 'background-color:' . $1 . '; ' . ${ $dataref->[$i][$j] }{cellcss}; + } + if (${ $dataref->[$i][$j] }{tex} =~ /\\cellcolor\s*\[\s*HTML\s*\]\s*\{\s*(\w*)[}!]/) { + ${ $dataref->[$i][$j] }{cellcss} = 'background-color:#' . $1 . '; ' . ${ $dataref->[$i][$j] }{cellcss}; + } + if (${ $dataref->[$i][$j] }{tex} =~ /\\bfseries$|\\bfseries\W/) { + ${ $dataref->[$i][$j] }{cellcss} = 'font-weight:bold; ' . ${ $dataref->[$i][$j] }{cellcss}; + } + if (${ $dataref->[$i][$j] }{tex} =~ /\\itshape$|\\itshape\W/) { + ${ $dataref->[$i][$j] }{cellcss} = 'font-style:italic; ' . ${ $dataref->[$i][$j] }{cellcss}; + } + if (${ $dataref->[$i][$j] }{tex} =~ /\\ttfamily$|\\ttfamily\W/) { + ${ $dataref->[$i][$j] }{cellcss} = 'font-family:monospace; ' . ${ $dataref->[$i][$j] }{cellcss}; + } + } + } + + for my $i (0 .. $#columnalignments) { $alignmentcolumns[ $columnalignments[$i] ] = $i } + # @alignmentcolumns is an array with one element per column, where the elements are each one of p{width}, r, c, l, or X + + # append css to author's columnscss->[$i] that corresponds to the alignemnts in @alignmentcolumns + + # parse tex alignment for individual cells to duplicate use in html + for my $i (0 .. $#{$dataref}) { + for my $j (0 .. $numcols[$i]) { + if (${ $dataref->[$i][$j] }{halign} ne '') { + my @htmlalignment = split(/(>\s*(??{$bracesregex})\s*|\|\s*|p\s*(??{$bracesregex})\s*|[rclX]\s*)/, + ${ $dataref->[$i][$j] }{halign}); + my @temp = (); + foreach (@htmlalignment) { + if ((defined $_) and ($_ ne '')) { + push(@temp, $_); + } + } + @htmlalignment = @temp; +# @htmlalignment is now an array, where the entries are the parsed pieces of ${$dataref->[$i][$j]}{halign}; entries parsed by +# >{commands}, pipes (for vertical rules), p{width}, r, c, l, or X. There should only be one of the actual alignment characters + + my @columnalignments = + grep { $htmlalignment[$_] =~ /^p\s*(??{$bracesregex})\s*|^[rclX]\s*/ } 0 .. $#htmlalignment; +# @columnalignments is an array, where the entries are the indices form @htmlalignment that actually deal with +# alignment: p{width}, r, c, l, or X. This array should only have one entry (but structure of this whole section has been copied from above) + + my @alignmentcolumns; + for my $k (0 .. $#columnalignments) { $alignmentcolumns[ $columnalignments[$k] ] = $k } + # @alignmentcolumns is an array whose ith element is undefined unless the ith element of @htmlalignment was one + # of p{width}, r, c, l, or X. Otherwise it is the index of the entry in @columnalignments that corresponds to + # that alignment + # Again, this should only have one entry. + + for my $k (0 .. $#columnalignments) { + ${ $dataref->[$i][$j] }{cellcss} = TeX_Alignment_to_CSS($htmlalignment[ $columnalignments[$k] ]) + . ${ $dataref->[$i][$j] }{cellcss}; + } + for my $k (0 .. $#htmlalignment) { + if ($htmlalignment[$k] =~ /\\color\s*\{\s*(\w*)[}!]/) { + my $m = $k; + while (!defined($alignmentcolumns[$m]) && $m < $#htmlalignment) { $m += 1; } + ${ $dataref->[$i][$j] }{cellcss} = 'color:' . $1 . '; ' . ${ $dataref->[$i][$j] }{cellcss}; + } + if ($htmlalignment[$k] =~ /\\color\s*\[\s*HTML\s*\]\s*\{\s*(\w*)[}!]/) { + my $m = $k; + while (!defined($alignmentcolumns[$m]) && $m < $#htmlalignment) { $m += 1; } + ${ $dataref->[$i][$j] }{cellcss} = 'color:#' . $1 . '; ' . ${ $dataref->[$i][$j] }{cellcss}; + } + if ($htmlalignment[$k] =~ /\\cellcolor\s*\{\s*(\w*)[}!]/) { + my $m = $k; + while (!defined($alignmentcolumns[$m]) && $m < $#htmlalignment) { $m += 1; } + ${ $dataref->[$i][$j] }{cellcss} = + 'background-color:' . $1 . '; ' . ${ $dataref->[$i][$j] }{cellcss}; + } + if ($htmlalignment[$k] =~ /\\cellcolor\s*\[\s*HTML\s*\]\s*\{\s*(\w*)[}!]/) { + my $m = $k; + while (!defined($alignmentcolumns[$m]) && $m < $#htmlalignment) { $m += 1; } + ${ $dataref->[$i][$j] }{cellcss} = + 'background-color:#' . $1 . '; ' . ${ $dataref->[$i][$j] }{cellcss}; + } + if ($htmlalignment[$k] =~ /\\bfseries$|\\bfseries\W/) { + my $m = $k; + while (!defined($alignmentcolumns[$m]) && $m < $#htmlalignment) { $m += 1; } + ${ $dataref->[$i][$j] }{cellcss} = 'font-weight:bold; ' . ${ $dataref->[$i][$j] }{cellcss}; + } + if ($htmlalignment[$k] =~ /\\itshape$|\\itshape\W/) { + my $m = $k; + while (!defined($alignmentcolumns[$m]) && $m < $#htmlalignment) { $m += 1; } + ${ $dataref->[$i][$j] }{cellcss} = 'font-style:italic; ' . ${ $dataref->[$i][$j] }{cellcss}; + } + if ($htmlalignment[$k] =~ /\\ttfamily$|\\ttfamily\W/) { + my $m = $k; + while (!defined($alignmentcolumns[$m]) && $m < $#htmlalignment) { $m += 1; } + ${ $dataref->[$i][$j] }{cellcss} = 'font-family:monospace; ' . ${ $dataref->[$i][$j] }{cellcss}; + } + if ($htmlalignment[$k] =~ /\|\s*/) { + my $m = $k; + while (!defined($alignmentcolumns[$m]) && $m < $#htmlalignment) { $m += 1; } + if ($m < $#htmlalignment) { + ${ $dataref->[$i][$j] }{cellcss} = + "border-left:solid 1px; " . ${ $dataref->[$i][$j] }{cellcss}; + } + if ($alignmentcolumns[$m] != 0) { + ${ $dataref->[$i][$j] }{cellcss} = + "border-right:solid 1px; " . ${ $dataref->[$i][$j] }{cellcss}; + } + if ($m == $#htmlalignment) { + if ($m == $k) { + ${ $dataref->[$i][$j] }{cellcss} = + "border-right:solid 1px; " . ${ $dataref->[$i][$j] }{cellcss}; + } else { + ${ $dataref->[$i][$j] }{cellcss} = + "border-left:solid 1px; " . ${ $dataref->[$i][$j] }{cellcss}; + } + } + } + + } + } + } + } + + my $midrulescss = ''; + if ($midrules == 1) { $midrulescss = 'border-top:solid 1px; ' } + + my $table = ''; + my $ptxtable = ''; + # build html and ptx strings for the table (which have structural similarities that distinguish them from tex) + if ($options{LaYoUt} != 1) { + $table = ''; + $ptxtable = "\n"; + $table .= ''; + for my $i (0 .. $#{$columnscss}) { + $columnscss->[$i] = '' unless (defined($columnscss->[$i])); + $table .= ''; + } + $table .= ''; + if ($caption ne '') { + $table .= ''; + # Needs to be a better way to incorporate the caption into PTX output + # This way makes "captions" that extend past the table + #$ptxtable .= "\n".''.$caption.''."\n\n"; + } + my $bodystarted = 0; + for my $i (0 .. $#{$dataref}) { + my $midrulecss = ($midrule[$i] == 1) ? 'border-bottom:solid 1px; ' : ''; + if ($i == $#{$dataref} and ($midrules == 1)) { $midrulescss .= 'border-bottom:solid 1px; '; } + if ($headerrow[$i] == 1) { $table .= ''; } + elsif (!$bodystarted) { $table .= ''; $bodystarted = 1 } + $table .= ''; + $ptxtable .= "\n"; + for my $j (0 .. $numcols[$i]) { + my $colspan = + (${ $dataref->[$i][$j] }{colspan} eq '') + ? '' + : 'colspan = "' . ${ $dataref->[$i][$j] }{colspan} . '" '; + if (uc(${ $dataref->[$i][$j] }{header}) eq 'TH') { + $table .= ''; + } elsif (grep { uc(${ $dataref->[$i][$j] }{header}) eq $_ } ('CH', 'COLUMN', 'COL')) { + $table .= ''; + } elsif (grep { uc(${ $dataref->[$i][$j] }{header}) eq $_ } ('RH', 'ROW')) { + $table .= ''; + } elsif (uc(${ $dataref->[$i][$j] }{header}) eq 'TD') { + $table .= ''; + } elsif (uc($headerrow[$i]) == 1) { + $table .= ''; + } else { + $table .= ''; + } + $ptxtable .= '' . ${ $dataref->[$i][$j] }{data} . '' . "\n"; + } + $table .= ""; + $ptxtable .= "\n"; + if ($headerrow[$i] == 1) { $table .= ''; } + elsif ($bodystarted and ($i == $#{$dataref})) { $table .= ''; } + } + $table .= "
    ' . $caption . '
    ' + . ${ $dataref->[$i][$j] }{data} . '' + . ${ $dataref->[$i][$j] }{data} . '' + . ${ $dataref->[$i][$j] }{data} . '' + . ${ $dataref->[$i][$j] }{data} . '' + . ${ $dataref->[$i][$j] }{data} . '' + . ${ $dataref->[$i][$j] }{data} . '
    "; + $ptxtable .= ""; + } # now if it is a Layout Table... + else { + $table = '

    '; + for my $i (0 .. $#{$dataref}) { + if ($i == $#{$dataref} and ($midrules == 1)) { $midrulescss .= "border-bottom:solid 1px;"; } + my $midrulecss = ($midrule[$i] == 1) ? 'border-bottom:solid 1px; ' : ''; + $table .= '
    '; + for my $j (0 .. $numcols[$i]) { + $table .= + '
    ' + . ${ $dataref->[$i][$j] }{data} + . '
    '; + } + $table .= "
    "; + } + $table .= "
    "; + } + + #when \multicolumn{}{}{} is needed... + for my $i (0 .. $#{$dataref}) { + for my $j (0 .. $numcols[$i]) { + ${ $dataref->[$i][$j] }{multicolumn} = ''; + if ((${ $dataref->[$i][$j] }{halign} ne '') or (${ $dataref->[$i][$j] }{colspan} ne '')) { + ${ $dataref->[$i][$j] }{multicolumn} = '\multicolumn{'; + if (${ $dataref->[$i][$j] }{colspan} ne '') { + ${ $dataref->[$i][$j] }{multicolumn} .= ${ $dataref->[$i][$j] }{colspan}; + } else { + ${ $dataref->[$i][$j] }{multicolumn} .= '1'; + } + ${ $dataref->[$i][$j] }{multicolumn} .= '}{'; + if (${ $dataref->[$i][$j] }{halign} ne '') { + ${ $dataref->[$i][$j] }{multicolumn} .= ${ $dataref->[$i][$j] }{halign}; + } else { + ${ $dataref->[$i][$j] }{multicolumn} .= 'c'; + } + ${ $dataref->[$i][$j] }{multicolumn} .= '}{'; + } + } + } + + my $textable = ''; + # build tex string for the table + if ($options{LaYoUt} != 1) { + my ($begintabular, $endtabular) = ('\begin{tabular}', '\end{tabular}'); + if ($texalignment =~ /X/) { + ($begintabular, $endtabular) = ('\begin{tabularx}{' . $Xratio . '\linewidth}', '\end{tabularx}'); + } + $textable = '\par\begin{minipage}{\linewidth}'; + if ($center == 1) { $textable .= '\centering'; } + if ($caption ne '') { + $textable .= + '\captionsetup{textfont={sc},belowskip=12pt,aboveskip=4pt}\captionof*{table}{' . $caption . '}'; + } + $textable .= $begintabular . '{' . $texalignment . '}' . '\toprule'; + for my $i (0 .. $#{$dataref}) { + if ($rowcolor[$i] ne '') { $textable .= '\rowcolor' . $rowcolor[$i]; } + for my $j (0 .. $numcols[$i]) + + { + if (grep { uc(${ $dataref->[$i][$j] }{header}) eq $_ } ('TH', 'CH', 'COLUMN', 'COL', 'RH', 'ROW') + or ($headerrow[$i] == 1) and !(uc(${ $dataref->[$i][$j] }{header}) eq 'TD')) + { + ${ $dataref->[$i][$j] }{tex} = '\bfseries ' . ${ $dataref->[$i][$j] }{tex}; + } + + if (${ $dataref->[$i][$j] }{multicolumn} ne '') { $textable .= ${ $dataref->[$i][$j] }{multicolumn} } + $textable .= + ${ $dataref->[$i][$j] }{texpre} . ' ' + . ${ $dataref->[$i][$j] }{tex} . ' ' + . ${ $dataref->[$i][$j] }{data} . ' ' + . ${ $dataref->[$i][$j] }{texpost}; + if (${ $dataref->[$i][$j] }{multicolumn} ne '') { $textable .= '}' } + $textable .= '&' unless ($j == $numcols[$i]); + } + $textable .= '\\\\'; + if ($midrule[$i] == 1) { $textable .= '\midrule ' } + if ((($midrules == 1) or ($headerrow[$i] == 1)) and ($i != $#{$dataref})) { $textable .= '\midrule ' } + } + $textable .= '\bottomrule' . $endtabular; + $textable .= '\end{minipage}\par \vspace{1pc}'; + } # and now if it is a Layout Table... + else { + my ($begintabular, $endtabular) = ('\begin{tabular}', '\end{tabular}'); + if ($texalignment =~ /X/) { + ($begintabular, $endtabular) = ('\begin{tabularx}{' . $Xratio . '\linewidth}', '\end{tabularx}'); + } + + $textable = ($center == 1) ? '\begin{center}' : '\begin{flushleft}'; + $textable .= '{\renewcommand{\arraystretch}{2}'; + $textable .= $begintabular . '{' . $texalignment . '}'; + for my $i (0 .. $#{$dataref}) { + if ($rowcolor[$i] ne '') { $textable .= '\rowcolor' . $rowcolor[$i]; } + for my $j (0 .. $numcols[$i]) { + if (${ $dataref->[$i][$j] }{halign} ne '') { + $textable .= '\multicolumn{1}{' . ${ $dataref->[$i][$j] }{halign} . '}{'; + } + $textable .= + ${ $dataref->[$i][$j] }{tex} . ' ' + . ${ $dataref->[$i][$j] }{texpre} . ' ' + . ${ $dataref->[$i][$j] }{data} . ' ' + . ${ $dataref->[$i][$j] }{texpost}; + if (${ $dataref->[$i][$j] }{halign} ne '') { $textable .= '}' } + $textable .= '&' unless ($j == $numcols[$i]); + } + $textable .= '\\\\'; + if ($midrule[$i] == 1) { $textable .= '\midrule ' } + if (($midrules == 1) and ($i != $#{$dataref})) { $textable .= '\midrule ' } + } + $textable .= $endtabular; + $textable .= '}'; + if ($center == 1) { $textable .= '\end{center}' } + else { $textable .= '\end{flushleft}' } + } + + MODES( + TeX => $textable, + HTML => $table, + PTX => $ptxtable, + ); +} + +=pod + +Command for table to control layout + +Usage: LayoutTable(...) + See usage for DataTable. The HTML output will use section and div boxes instead of HTML tabling elements + Anything having to do with headers, captions, and data cells no longer make sense (although 'data' is still + used as the key for cell contents). + +=cut + +sub LayoutTable { + my $dataref = shift; + if ($main::displayMode eq 'PTX') { DataTable($dataref, @_); } + else { DataTable($dataref, LaYoUt => 1, @_); } +} + +sub TeX_Alignment_to_CSS { + my $alignmentstring = shift; + my $bracesregex = qr/(\{(?>[^{}]|(?R))*\})/x; + # grabs outer level braces and their contents, including inner brace pairs + my $bracecontentsregex = qr/((?>[^{}]|(??{$bracesregex}))*)/x; + # grabs contents of an outer level brace pair, including inner brace pairs + + my $css = ''; + if ($alignmentstring =~ /r\s*/) { + $css .= "text-align:right; white-space:nowrap; "; + } elsif ($alignmentstring =~ /c\s*/) { + $css .= "text-align:center; white-space:nowrap; "; + } elsif ($alignmentstring =~ /l\s*/) { + $css .= "text-align:left; white-space:nowrap; "; + } elsif ($alignmentstring =~ /X\s*/) { + $css .= "text-align:justify; white-space:normal; "; + } elsif ($alignmentstring =~ /p\s*\{((??{$bracecontentsregex}))\}\s*/) { + $css .= "text-align:justify; white-space:normal; width:" . $1 . "; "; + } + return $css; +} + +1; diff --git a/macros/ui/text2PG.pl b/macros/ui/text2PG.pl index 164bf4cc60..427d817816 100644 --- a/macros/ui/text2PG.pl +++ b/macros/ui/text2PG.pl @@ -61,8 +61,9 @@ sub text2PG { my $i = 0; if ($options{allowCommands}) { @parts = split(/(\\\{.*?\\\}|``.*?``\*?|`.+`\*?|\\\(.*?\\\)|\\\[.*?\\\])/s, $string); + } else { + @parts = split(/(``.*?``\*?|`.+`\*?|\\\(.*?\\\)|\\\[.*?\\\])/s, $string); } - else { @parts = split(/(``.*?``\*?|`.+`\*?|\\\(.*?\\\)|\\\[.*?\\\])/s, $string) } while ($i <= $#parts) { if ($options{sanitizeText}) { if ($displayMode eq 'TeX') { diff --git a/macros/univ/PCCmacros.pl b/macros/univ/PCCmacros.pl index 7bd0ee0d29..7a4c82aa17 100644 --- a/macros/univ/PCCmacros.pl +++ b/macros/univ/PCCmacros.pl @@ -374,8 +374,9 @@ sub PolyTermsTeXPrep { 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 ] . '{}'; } - else { $terms[ 2 * $i ] = '{}' . $terms[ 2 * $i ] . '{}'; } $terms[ 2 * $i ] = $terms[ 2 * $i ] . $spacing; } $alignment = $alignment . "$align"; From 62f6900f161cd924d3b34b1ba54d5cd1956ffdd5 Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Tue, 20 Sep 2022 06:47:15 -0400 Subject: [PATCH 5/9] WIP: remove university-related macros WIP: remove university-related macros --- conf/pg_config.dist.yml | 24 +- macros/README.md | 27 +- macros/{univ => answers}/PGasu.pl | 14 +- macros/{univ => graph}/unionImage.pl | 0 macros/math/SolveLinearEquationPCC.pl | 4 +- .../SystemsOfLinearEquationsProblemPCC.pl | 4 +- macros/{univ => misc}/PCCmacros.pl | 0 macros/{univ => misc}/PGunion.pl | 0 macros/{univ => misc}/unionInclude.pl | 0 macros/{univ => misc}/unionMacros.pl | 0 macros/{univ => misc}/unionMessages.pl | 0 macros/{univ => misc}/unionProblem.pl | 0 macros/{univ => misc}/unionUtils.pl | 0 macros/univ/Alfredmacros.pl | 376 --------- macros/univ/BrockPhysicsMacros.pl | 1 - macros/univ/CofIdaho_macros.pl | 723 ------------------ macros/univ/Dartmouthmacros.pl | 304 -------- macros/univ/MUHelp.pl | 49 -- macros/univ/freemanMacros.pl | 541 ------------- macros/univ/hhAdditionalMacros.pl | 437 ----------- macros/univ/littleneck.pl | 191 ----- 21 files changed, 49 insertions(+), 2646 deletions(-) rename macros/{univ => answers}/PGasu.pl (99%) rename macros/{univ => graph}/unionImage.pl (100%) rename macros/{univ => misc}/PCCmacros.pl (100%) rename macros/{univ => misc}/PGunion.pl (100%) rename macros/{univ => misc}/unionInclude.pl (100%) rename macros/{univ => misc}/unionMacros.pl (100%) rename macros/{univ => misc}/unionMessages.pl (100%) rename macros/{univ => misc}/unionProblem.pl (100%) rename macros/{univ => misc}/unionUtils.pl (100%) delete mode 100644 macros/univ/Alfredmacros.pl delete mode 100644 macros/univ/BrockPhysicsMacros.pl delete mode 100644 macros/univ/CofIdaho_macros.pl delete mode 100644 macros/univ/Dartmouthmacros.pl delete mode 100644 macros/univ/MUHelp.pl delete mode 100644 macros/univ/freemanMacros.pl delete mode 100644 macros/univ/hhAdditionalMacros.pl delete mode 100644 macros/univ/littleneck.pl diff --git a/conf/pg_config.dist.yml b/conf/pg_config.dist.yml index e87a6502e4..e54acafc04 100644 --- a/conf/pg_config.dist.yml +++ b/conf/pg_config.dist.yml @@ -47,9 +47,31 @@ directories: - $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/univ + - $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 URLs: # The public URL of the html directory above. diff --git a/macros/README.md b/macros/README.md index ed4d238ce7..4bffdeb3d1 100644 --- a/macros/README.md +++ b/macros/README.md @@ -10,18 +10,16 @@ This directory now has a subdirectory structure for clarification. - **math** mathematical related macros - **parsers** macros that handle parsing - **ui** macros that affect the UI in the PG problem -- **univ** university or other specific functionality related macros. + ## These Have Been Copied -- `OPL/Alfred/Alfredmacros.pl` to `PG/macros/univ` -- `OPL/BrockPhysics/BrockPhysicsMacros.pl` to `PG/macros/univ` (referenced throughout OPL, but blank, should be deleted.) - `OPL/BrockPhysics/fixedPrecision.pl` to `PG/macros/contexts` - `OPL/Hope/PGgraphgrid.pl` to `PG/macros/graph` - `OPL/Hope/VectorListCheckers.pl` to `PG/macros/math` - `OPL/LaTech/SI_property_tables.pl` to `PG/macros/math` - `OPL/LaTech/interpMacros.pl` to `PG/macros/math` -- `OPL/Mizzou/MUHelp.pl` to `PG/macros/univ` + - `OPL/TCNJ/Generic.pl` to `PG/macros/answers` - `OPL/UBC/regrfnsPG.pl` to `PG/macros/math` - `OPL/UMass-Amherst/algebraMacros.pl` to `PG/macros/math` @@ -30,7 +28,6 @@ This directory now has a subdirectory structure for clarification. ### CollegeOfIdaho -- `OPL/CofIdaho_macros.pl` to `PG/macros/univ` - `OPL/CollegeOfIdaho/contextInequalitiesAllowStrings.pl` to `PG/macros/contexts` - `OPL/CollegeOfIdaho/contextFunctionAssign.pl` to `PG/macros/contexts` - `OPL/CollegeOfIdaho/parserUtils.pl` to `PG/macros/parsers` @@ -61,14 +58,14 @@ This directory now has a subdirectory structure for clarification. ### Union - `OPL/Union/answerUtils.pl` to `PG/macros/answers` -- `OPL/Union/PGunion.pl` to `PG/macros/univ` -- `OPL/Union/unionImage.pl` to `PG/macros/univ` -- `OPL/Union/unionInclude.pl` to `PG/macros/univ` -- `OPL/Union/unionMacros.pl` to `PG/macros/univ` +- `OPL/Union/PGunion.pl` to `PG/macros/misc` +- `OPL/Union/unionImage.pl` to `PG/macros/graph` +- `OPL/Union/unionInclude.pl` to `PG/macros/misc` +- `OPL/Union/unionMacros.pl` to `PG/macros/misc` - `OPL/Union/unionLists.pl` to `PG/macros/ui` -- `OPL/Union/unionProblem.pl` to `PG/macros/univ` +- `OPL/Union/unionProblem.pl` to `PG/macros/misc` - `OPL/Union/unionTable.pl` to `PG/macros/ui` -- `OPL/Union/unionUtils.pl` to `PG/macros/univ` +- `OPL/Union/unionUtils.pl` to `PG/macros/misc` - `OPL/Union/imageChoice.pl` to `PG/macros/graph` - `OPL/FortLewis/AnswerHelp.pl` to `PG/macros/answers` @@ -86,7 +83,7 @@ This directory now has a subdirectory structure for clarification. - `OPL/PCC/SolveLinearEquationPCC.pl` to `PG/macros/math` - `OPL/PCC/SystemsOfLinearEquationsProblemPCC.pl` to `PG/macros/math` -## Not moved +## The following have not been moved - `OPL/Hope/MatrixCheckers.pl` (already in PG/math) - `OPL/Hope/MatrixReduce.pl` (already in PG/math) @@ -95,7 +92,11 @@ This directory now has a subdirectory structure for clarification. - `OPL/UBC/RserveClient.pl` (already in PG/core) - `OPL/UW-Stout/*.pl` (no problems in OPL/Contrib) - `OPL/UniSiegen/logicMacros.pl` (no problems in OPL/Contrib) -u +- `OPL/Alfred/Alfredmacros.pl` (not relevant) +- `OPL/BrockPhysics/BrockPhysicsMacros.pl` (not relevant) +- `OPL/Mizzou/MUHelp.pl` to `PG/macros/univ` (not relevant) +- `OPL/WHFreeman/freemanMacros.pl` to `PG/macros/univ` (not relevant) +- `OPL/Michigan/hhAdditionalMacros.pl` to `PG/macros/univ` (not relevant) ### CollegeOfIdaho diff --git a/macros/univ/PGasu.pl b/macros/answers/PGasu.pl similarity index 99% rename from macros/univ/PGasu.pl rename to macros/answers/PGasu.pl index 6f23dafa50..2862621106 100644 --- a/macros/univ/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/univ/unionImage.pl b/macros/graph/unionImage.pl similarity index 100% rename from macros/univ/unionImage.pl rename to macros/graph/unionImage.pl diff --git a/macros/math/SolveLinearEquationPCC.pl b/macros/math/SolveLinearEquationPCC.pl index 7b05484f19..587916d8de 100644 --- a/macros/math/SolveLinearEquationPCC.pl +++ b/macros/math/SolveLinearEquationPCC.pl @@ -1,7 +1,9 @@ #These three subroutines uniformize how all our "solve this equation" problems are handled. +loadMacros('PCCmacros.pl'); + sub _init_SolveLinearEquationPCC { - loadMacros('PCCmacros.pl'); + #Possibly add initialization code here #sub routine is not required, but prevents the macro from being re-loaded diff --git a/macros/math/SystemsOfLinearEquationsProblemPCC.pl b/macros/math/SystemsOfLinearEquationsProblemPCC.pl index 235031c301..2294938560 100644 --- a/macros/math/SystemsOfLinearEquationsProblemPCC.pl +++ b/macros/math/SystemsOfLinearEquationsProblemPCC.pl @@ -1,4 +1,6 @@ +loadMacros('PCCmacros.pl', 'contextFraction.pl'); + sub SystemOfLinearEquationsProblemSetup { #markers for zero-values used in formatting @@ -723,8 +725,6 @@ sub SystemOfLinearEquationsProblemSolutionSetup { # Set up the LinearSystems context # sub _SystemsOfLinearEquationsProblemPCC_init { - loadMacros('PCCmacros.pl', 'contextFraction.pl'); - my $context = $main::context{LinearSystems} = Parser::Context->getCopy("LimitedFraction"); $context->flags->set( diff --git a/macros/univ/PCCmacros.pl b/macros/misc/PCCmacros.pl similarity index 100% rename from macros/univ/PCCmacros.pl rename to macros/misc/PCCmacros.pl diff --git a/macros/univ/PGunion.pl b/macros/misc/PGunion.pl similarity index 100% rename from macros/univ/PGunion.pl rename to macros/misc/PGunion.pl diff --git a/macros/univ/unionInclude.pl b/macros/misc/unionInclude.pl similarity index 100% rename from macros/univ/unionInclude.pl rename to macros/misc/unionInclude.pl diff --git a/macros/univ/unionMacros.pl b/macros/misc/unionMacros.pl similarity index 100% rename from macros/univ/unionMacros.pl rename to macros/misc/unionMacros.pl diff --git a/macros/univ/unionMessages.pl b/macros/misc/unionMessages.pl similarity index 100% rename from macros/univ/unionMessages.pl rename to macros/misc/unionMessages.pl diff --git a/macros/univ/unionProblem.pl b/macros/misc/unionProblem.pl similarity index 100% rename from macros/univ/unionProblem.pl rename to macros/misc/unionProblem.pl diff --git a/macros/univ/unionUtils.pl b/macros/misc/unionUtils.pl similarity index 100% rename from macros/univ/unionUtils.pl rename to macros/misc/unionUtils.pl diff --git a/macros/univ/Alfredmacros.pl b/macros/univ/Alfredmacros.pl deleted file mode 100644 index 78ce2a9d0f..0000000000 --- a/macros/univ/Alfredmacros.pl +++ /dev/null @@ -1,376 +0,0 @@ -# A group of macros used in the Alfred problem library. - -sub _Alfredmacros_init { } #don't reload these macros. - -# Given a point (x,y) this macro computes the angle with respect to x-axis. The angle will be between 0 and 2pi. -sub inversetrig { - my $refangle = arctan(abs($_[1] / $_[0])); - if ($_[0] == 0) {0} - elsif ($_[0] > 0) { - if ($_[1] == 0) {0} - elsif ($_[1] > 0) { $refangle; } - else { 2 * pi- $refangle; } - } else { - if ($_[1] == 0) {pi} - elsif ($_[1] > 0) { pi- $refangle; } - else { pi + $refangle } - } -} - -## Compute the max and min of an array of numbers - -#This macro prevents students from double clicking in an answer box. This macro #is necessary for multiple integral problems where the answer box is typeset -#into the integration symbols. -sub doubleclickprevent { - TEXT(MODES( - TeX => "", - HTML => "" - )); -} - -#The problems that have the answer box in the limits must be displayed in JS -#math mode. This macro warns the user to use JS math mode if they are not. -sub jsMathwarn { - TEXT(MODES( - TeX => '', - HTML_jsMath => '', - HTML => $HR - . "Warning: to use this problem, you need to" - . "select jsMath mode in the Display Options panel at the left" - . $HR, - )); -} - -sub jsmathmode { - TEXT(MODES( - TeX => '', - HTML_jsMath => '', - HTML => $HR - . "Warning: to use this problem, you need to " - . "select jsMath mode in the Display Options panel at the left" - . $HR, - )); - TEXT(MODES( - TeX => "", - HTML => "" - )); - -} - -sub mathjaxmode { - TEXT(MODES( - TeX => '', - HTML_MathJax => '', - HTML => $HR - . "Warning: to use this problem, you need to " - . "select MathJax mode in the Display Options panel at the left" - . $HR, - )); -} - -#This subroutine includes the Strang's textbook into a problem, you have to -#feed it the chapter and section. It is assumed that the book is in the course -#directory and is labeled strangtextbook. The parameters are -#strang(chapter,section,(optional) section title. -#example \{&strang(16,5,"surface integrals")\}. -$wwstrang = "http://webwork.alfred.edu/webwork2_course_files/strangcalculus"; - -sub strang { - htmlLink( - qq!$wwstrang/Strang-$_[0]-$_[1].pdf!, - "$_[0].$_[1] $_[2] from Gilbert Strang's Calculus", - q/TARGET="new_window"/ - ); -} - -#Inserts a link to a trig table in the problem. -#example \{&trig_table()\} -sub trig_table { - htmlLink(qq!$wwstrang/trig_identities.pdf!, "Trig Identities", q/TARGET="new_window"/); -} - -sub strang_index { - htmlLink(qq!$wwstrang/Index.pdf!, "Index", q/TARGET="new_window"/); -} - -sub strang_TOC { - htmlLink(qq!$wwstrang/TOC.pdf!, "Table of Contents", q/TARGET="new_window"/); -} - -sub product_Rule_cmp { - my ($correct, $student, $self) = @_; - my ($f1stu, $f2stu, $f3stu, $f4stu) = @{$student}; - my ($f1, $f2, $f3, $f4) = @{$correct}; - my @fgrade = (0, 0, 0, 0); - my @fstu = ($f1stu, $f2stu, $f3stu, $f4stu); - my @fcorrect = ($f1, $f2, $f3, $f4); -#we will associate each student answer with a prime number, noting which student answer is in which blank. This allows us to make use of the fundamental theorem of arithmetic. - my @prime = (2, 3, 5, 7); - my @answerblank = (0, 0, 0, 0); - - for ($i = 0; $i < 4; $i++) { - for ($j = 0; $j < 4; $j++) { - if (($fcorrect[$i] == $fstu[$j]) && ($answerblank[$j] == 0)) { { - $answerblank[$j] = $prime[$i]; - $j = - 4 # you have to terminate the inner loop in this case for the special case of f=e^x where f and f' are the same. - } } - } - } - for ($i = 0; $i < 4; $i++) { - if (!$answerblank[$i]) { - $self->setMessage($i + 1, - "All of your answers should be $f, $g, or a derivative of one of these functions"); - } - } - #now we rely on the fact that products of primes are unique. First we check to see if all of the blanks are correct - if ((($answerblank[0] * $answerblank[1] == 6) && ($answerblank[2] * $answerblank[3] == 35)) - || (($answerblank[0] * $answerblank[1] == 35) && ($answerblank[2] * $answerblank[3] == 6))) - { - @fgrade = (1, 1, 1, 1); - } - #now check to see if the first pair of blanks is correct, knowing one pair is not - elsif ($answerblank[0] * $answerblank[1] == 6) { - if (($answerblank[2] == 5) || ($answerblank[2] == 7)) { - @fgrade = (1, 1, 1, 0); - } elsif (($answerblank[3] == 5) || ($answerblank[3] == 7)) { - @fgrade = (1, 1, 0, 1); - } else { - @fgrade = (1, 1, 0, 0); - } - } elsif ($answerblank[0] * $answerblank[1] == 35) { - if (($answerblank[2] == 2) || ($answerblank[2] == 3)) { - @fgrade = (1, 1, 1, 0); - } elsif (($answerblank[3] == 2) || ($answerblank[3] == 3)) { - @fgrade = (1, 1, 0, 1); - } else { - @fgrade = (1, 1, 0, 0); - } - } - #if both sets are not correct, and the first set is not correct, check to see if the last pair are - elsif ($answerblank[2] * $answerblank[3] == 6) { - if (($answerblank[0] == 5) || ($answerblank[0] == 7)) { - @fgrade = (1, 0, 1, 1); - } elsif (($answerblank[1] == 5) || ($answerblank[1] == 7)) { - @fgrade = (0, 1, 1, 1); - } else { - @fgrade = (0, 0, 1, 1); - } - } elsif ($answerblank[2] * $answerblank[3] == 35) { - if (($answerblank[0] == 2) || ($answerblank[0] == 3)) { - @fgrade = (1, 0, 1, 1); - } elsif (($answerblank[1] == 2) || ($answerblank[1] == 3)) { - @fgrade = (0, 1, 1, 1); - } else { - @fgrade = (0, 0, 1, 1); - } - } -#at this point they don't have a matched set of blanks correct. look for a single function in each pair that is right. You have to make sure you only get one for each pair of answer blanks. - else { - if (($answerblank[0]) - && ($answerblank[2]) - && ($answerblank[0] * $answerblank[2] != 6) - && ($answerblank[0] * $answerblank[2] != 35) - && ($answerblank[0] != $answerblank[2])) - { - @fgrade = (1, 0, 1, 0); - } elsif (($answerblank[0]) - && ($answerblank[3]) - && ($answerblank[0] * $answerblank[3] != 6) - && ($answerblank[0] * $answerblank[3] != 35) - && ($answerblank[0] != $answerblank[3])) - { - @fgrade = (1, 0, 0, 1); - } elsif (($answerblank[1]) - && ($answerblank[2]) - && ($answerblank[1] * $answerblank[2] != 6) - && ($answerblank[1] * $answerblank[2] != 35) - && ($answerblank[1] != $answerblank[2])) - { - @fgrade = (0, 1, 1, 0); - } elsif (($answerblank[1]) - && ($answerblank[3]) - && ($answerblank[1] * $answerblank[3] != 6) - && ($answerblank[1] * $answerblank[3] != 35) - && ($answerblank[1] != $answerblank[3])) - { - @fgrade = (0, 1, 0, 1); - } elsif ($answerblank[0]) { - @fgrade = (1, 0, 0, 0); - } elsif ($answerblank[1]) { - @fgrade = (0, 1, 0, 0); - } elsif ($answerblank[2]) { - @fgrade = (0, 0, 1, 0); - } elsif ($answerblank[3]) { - @fgrade = (0, 0, 0, 1); - } - } - return [@fgrade]; -} - -sub check_boundary_conditions { - my ($correct, $student, $self) = @_; - return product_Rule_cmp(@_); -} - -sub Snxy() { - my %args = @_; - my @x = @{ $args{inputs} }; - my @y = @{ $args{outputs} }; - my $m = $args{m}; - my $n = $args{n}; - my $i = 0; - my $sum = 0; - if ($#x == $#y) { - for ($i = 0; $i <= $#x; $i++) { - $sum = $sum + ($x[$i])**($n) * ($y[$i])**($m); - } - } else { - $sum = 0; - } - return $sum; -} - -### To use the macros your problem must include unionTables.pl, and of course Alfredmacros.pl -### Table integral returns a string that can be included in a Table to output an integral whose upper and lower limits -### of integration can be answer blanks. There are several optional parameters: -### width - change the width of the answer blanks. defaults to 3. -### lowerwidth - change the width of the lower answer blank. defaults to width -### upperwidth - change the width of the upper answer blank. defaults to width. -### upper - the uppper limit of integration, does not have to be an answer blank, defaults to answer blank with width "width" -### lower - the lower limit of integration, does not have to be an answer blank, defaults to answer blank with width "width" -### limits - boolean, if 1 puts the limits of integration above and below the integral symbol, if 0 puts them after the integral symbol. -### default is 1. -### Your code must include unionTables.pl, and of course Alfredmacros.pl -### An example: -### \{BeginTable(center=>0). -### Row([tableintegral(), -### ],separation=>2). -### EndTable(); -### \} -### which will print an integral with answer blank on the upper and lower limits with the default length of 3 -### -### This example prints out a double integral, the first integral with answer blanks with width 10, the second integral -### has 0 for the lower limit of integration and an answer blank with width 5 for the upper limit of integration. -### The default limits of integratin are answer blanks with width 3, in this case the default width was overridden to 5 -### and the default lower limit was changed to a zero. -### \{BeginTable(center=>0). -### Row([tableintegral(width=>10,limits=>'\(0\)'),tableintegral(width=>5,lower=>'\(0\)',limits=>0), -### ],separation=>2). -### EndTable(); -### \} -### An example where the width of the upper and lower answer blanks have different widths. -### \{BeginTable(center=>0). -### Row([tableintegral(lowerwidth=>10,upperwidth=>1) -### ],separation=>2). -### EndTable(); -### \} - -sub tableintegral { - my %arg = @_; - my $width = delete $arg{width} // 3; - my $lowerwidth = delete $arg{lowerwidth} // $width; - my $upperwidth = delete $arg{upperwidth} // $width; - my $lower = delete $arg{lower} // ans_rule($lowerwidth); - my $upper = delete $arg{upper} // ans_rule($upperwidth); - my $limits = delete $arg{limits} // 1; - if ($limits == 1) { - return $upper . $BR . '\(\displaystyle\int\)' . $BR . $lower; - } else { - return '\(\displaystyle\int\)', $upper . $BR . $BR . $lower; - } -} - -# a sum with answer blanks for the summation variable, lower limit, and upper limit -#\{ BeginTable(center=>0). -# Row([tablesum(width=>10), -# ],separation=>2). -# EndTable(); -#\} -# a sum with answer blanks for the upper and lower limits, and the summation variable is i -#\{ BeginTable(center=>0). -# Row([tablesum(width=>10,sumvariable=>'i'), -# ],separation=>2). -# EndTable(); -#\} -# a sum with answer blanks for the upper and lower limits, and summation variable is not used. -#\{ BeginTable(center=>0). -# Row([tablesum(width=>10,usesumvariable=>0), -# ],separation=>2). -# EndTable(); -#\} -# sum from n = 1 to infinity -#\{ BeginTable(center=>0). -# Row([tablesum(sumvariable=>'\(n\)',lower=>'\(1\)', upper=>'\(\hskip 3pt\infty\)') ],separation=>2). -# EndTable(); -#\} - -sub tablesum { - my %arg = @_; - my $width = delete $arg{width} // 3; - my $lowerwidth = delete $arg{lowerwidth} // $width; - my $upperwidth = delete $arg{upperwidth} // $width; - my $lower = delete $arg{lower} // ans_rule($lowerwidth); - my $upper = delete $arg{upper} // ans_rule($upperwidth); - my $limits = delete $arg{limits} // 1; - my $sumvariable = delete $arg{sumvariable} // ans_rule($width); - my $usesumvariable = delete $arg{usesumvariable} // 1; - - if ($usesumvariable == 0) { - if ($limits == 1) { - return $upper . $BR . '\(\displaystyle\sum\)' . $BR . $lower; - } else { - return '\(\displaystyle\int\)', $upper . $BR . $BR . $lower; - } - } else { - if ($limits == 1) { - return $upper . $BR . '\(\displaystyle\sum\)' . $BR . $sumvariable . '\( = \)' . $lower; - } else { - return '\(\displaystyle\int\)', $upper . $BR . $BR . $sumvariable . '\( = \)' . $lower; - } - } -} - -### Create a vertical bar with an upper and lower limit. -sub tableevaluate { - my %arg = @_; - my $width = delete $arg{width} // 3; - my $lowerwidth = delete $arg{lowerwidth} // $width; - my $upperwidth = delete $arg{upperwidth} // $width; - my $lower = delete $arg{lower} // ans_rule($lowerwidth); - my $upper = delete $arg{upper} // ans_rule($upperwidth); - return '\(\Bigg\vert\)', $upper . $BR . $BR . $lower; -} - -### Create a subscripted character -sub tablesubscript { - my %arg = @_; - my $width = delete $arg{width} // 3; - my $lower = delete $arg{lower} // ans_rule($width); - my $variable = delete $arg{variable} // 'c'; - return $variable, $BR . $BR . $lower; -} - -### Create a superscripted character -sub tablesuperscript { - my %arg = @_; - my $width = delete $arg{width} // 3; - my $upper = delete $arg{upper} // ans_rule($width); - my $variable = delete $arg{variable} // 'c'; - return $variable, $upper . $BR . $BR . $BR; -} - -### A fraction -sub tablefrac { - my %arg = @_; - my $width = delete $arg{width} // 3; - my $lower = delete $arg{lower} // ans_rule($width); - my $upper = delete $arg{upper} // ans_rule($width); - my $barwidth = delete $arg{barwidth} // 10 + $width; - my $divisionbar = ""; - for ($count = 1; $count <= $barwidth; $count++) { - $divisionbar = $divisionbar . "-"; - } - return $upper . $BR . $divisionbar . $BR . $lower; -} - diff --git a/macros/univ/BrockPhysicsMacros.pl b/macros/univ/BrockPhysicsMacros.pl deleted file mode 100644 index 61c5d1a210..0000000000 --- a/macros/univ/BrockPhysicsMacros.pl +++ /dev/null @@ -1 +0,0 @@ -# this file defines all Brock-Physics-specific macros. diff --git a/macros/univ/CofIdaho_macros.pl b/macros/univ/CofIdaho_macros.pl deleted file mode 100644 index 351fec2427..0000000000 --- a/macros/univ/CofIdaho_macros.pl +++ /dev/null @@ -1,723 +0,0 @@ - -=pod - -=head1 NAME - - extra macros for Intermediate Algebra problems at The College of Idaho - -=head1 Synposis - macros by R Cruz -- The College of Idaho -=cut - -=head3 Format the instuctor answer - -=pod - -1) SimplifyExponents: Formats an expression without negative exponents - To use: SimplifyExponents(num, den,~~@var,@exp); - where num = numerator's constant - den = denominator's constant - ~~@var = pointer to an array with the list of variables - @exp = array with the exponents for the variables - -2) num_and_unit_checker: Checks for units like "apples" or "oranges" - To use: ANS (num_and_units_checker($correct_answer, "units"); - -3) strict_percent_cmp: Checks percentages have been rounded as required. - To use: ANS(strict_percent_cmp($answer,"%",roundto)); - where $answer is in percent form: xx.x - roundto = "tenths" or "hundredths" - -4) Picky_equation_cmp: Checks both sides of an equation model the word problem. - To use: Picky_equation_cmp("2x+1=5"); - Note: This one allows only the variables that have been used in the CofIdaho - problems. It should be changed so that it is more flexible, or better, - convert it to a MathObject. - -5) SlopeIntercept_equation_cmp: Checks both sides of an equation for the - slope-intercept form of a line. - To use: ANS(SlopeIntercept_equation_cmp($answer)); - where $answer = "y = $m x + $b"; (Use only y and x for variables.) - -6) functionNotation_cmp: Checks for "f(x)= ***" notation - To use: - ANS(functionNotation_cmp("f(x)=2x",["x","f"])); - -7) Checks factors of polynomials. - To use: The answer must be submitted in this form: - ANS(FactorEvaluator($answer,[variable array])); - If the polynomial is prime: - ANS(FactorEvaluator("Does not factor",polynomial,[variable array])); - - Note: Answers must be in the form: monomial(poly)...(poly) with - or without parentheses about the monomial. The polynomial factors must - not contain any other grouping symbols and, in any case, only parenthesis - may be used. This needs to be in the instructions for any set that uses - this macro (in the screenHeader.pg file). - - Note: "StrictFactoringEvaluator" requires leading negatives to be factored out. - This not may not work with all situations. BE SURE TO CHANGE THIS FILE IF THE - FactoringEvaluator IS CHANGED!! - -8) RationalExpEvaluator: Checks for simplified rational expressions. - To use: ANS(RationalExpEvaluation($answer,[variable array])); - or something like: ANS(RationalExpEvaluator($answer,["x","y"])); - - Note: Answers must be of the form: (poly)/(poly) - -9) ReduceFraction: Returns a string that represents a reduced fraction. - To use: $a = SimplifyFraction(numerator expression,denominator espression); -=cut - -################################################################### -# 1) Formats an expression without negative exponents -# Thanks to John Jones at ASU for this macro. - -sub SimplifyExponents { - loadMacros("contextLimitedPowers.pl"); - my $num = shift; - my $den = shift; - my $varref = shift; - my @expos = @_; - my @vars = @$varref; - - Context()->operators->set(@LimitedPowers::OnlyPositiveIntegers); - - my $answer_n = Formula("$num"); - my $answer_d = Formula("$den"); - - for $j (0 .. (scalar(@vars) - 1)) { - $answer_n *= Formula("$vars[$j]^$expos[$j] ") if ($expos[$j] > 0); - $answer_d *= Formula("$vars[$j]^(-1*$expos[$j]) ") if ($expos[$j] < 0); - } - - $answer = $answer_n / $answer_d; - - return ($answer->reduce()); -} - -sub Simplified { - my ($correct, $student, $ah) = @_; - return unless $ah->{score} == 1; #This does not work??? - my $VariablesPlus1 = 2; #Put in the number of variables plus 1 - my $check = $ah->{student_ans}; - if (!($ah->{isPreview}) - && $correct == $student - && $check =~ /(([abxy].*){$VariablesPlus1,})|([\Q^].*[\Q^])/) - { - $ah->{ans_message} = "Simplify your answer"; - } - - return ($correct == $student && ($ah->{student_ans} !~ /(([abxy].*){$VariablesPlus1,})|([\Q^].*[\Q^])/)); -} - -################################################################### -# 2) Checks for units - -sub num_and_unit_checker { - my $correct_ans = shift; #the answer - my $correct_units = shift; #the unit type - my $old_evaluator = num_cmp($correct_ans); - - my $new_evaluator = sub { - my $student_ans = shift; - my $formatted_ans = $student_ans; - $formatted_ans =~ s{$correct_units}{}; - my $ans_hash = $old_evaluator->evaluate($formatted_ans); - if ($student_ans !~ /$correct_units/) { - $ans_hash->{score} = 0; - $ans_hash->setKeys('ans_message' => "Enter your answer with the correct units: $correct_units"); - } - $ans_hash->{original_student_ans} = "$student_ans"; - $ans_hash->{preview_latex_string} = "$student_ans"; - $ans_hash->{student_ans} = "$student_ans"; - $ans_hash->{correct_ans} = "$correct_ans" . " $correct_units"; - - return $ans_hash; - }; - - return $new_evaluator; -} - -################################################################### -# 3) Checks for rounded percents - -sub strict_percent_cmp { - my $correct_ans = shift; #the answer - my $correct_units = shift; #the unit type which should be "%" - my $error = shift; #what to round to - my $errorAmount = .1; - if ($error eq "hundredth") { $errorAmount = .01; } - my $old_evaluator = num_cmp($correct_ans, tol => 0); - - my $new_evaluator = sub { - my $student_ans = shift; - my $formatted_ans = $student_ans; - $formatted_ans =~ s{$correct_units}{}; - my $ans_hash = $old_evaluator->evaluate($formatted_ans); - if ($student_ans !~ /$correct_units/) { - $ans_hash->{score} = 0; - $ans_hash->setKeys('ans_message' => "Enter your answer with the correct units: $correct_units"); - } else { - if ($ans_hash->{score} == 0 - && abs($formatted_ans - $correct_ans) < $errorAmount) - { - $ans_hash->setKeys('ans_message' => "Round your answer to the nearest $error."); - } - } - $ans_hash->{original_student_ans} = "$student_ans"; - $ans_hash->{preview_latex_string} = "$student_ans"; - $ans_hash->{student_ans} = "$student_ans"; - $ans_hash->{correct_ans} = "$correct_ans" . " $correct_units"; - - return $ans_hash; - }; - - return $new_evaluator; -} - -################################################################### -# 4) Checks both sides of an equation model the word problem. - -sub Picky_equation_cmp { - - loadMacros("unionUtils.pl", "answerUtils.pl", "listAnswer.pl", "extraAnswerEvaluators.pl"); - - my $ans = shift; - - my $new_evaluator = sub { - my $student = shift; - - $ans =~ tr/[=]/,/; - $student =~ tr/[=]/,/; - - my $old_evaluator = fun_list_cmp($ans, - vars => [ 'a', 'b', 'c', 'd', 'h', 'l', 'n', 'v', 'w', 'x', 'y', 's', 't', 'A', 'L', 'R', 'C', 'P' ]); - my $ans_hash_old = $old_evaluator->evaluate($student); - - $ans =~ tr/,/=/; - $student =~ tr/,/=/; - $ans_hash_old->{correct_ans} = "$ans"; - $ans_hash_old->{original_student_ans} = "$student"; - $ans_hash_old->{student_ans} = "$student"; - $ans_hash_old->{preview_latex_string} = "$student"; - if ($ans_hash_old->{score} != 1) { - $ans_hash_old->{score} = 0; - # $ans_hash_old->setKeys( 'ans_message' =>"Your equation must model the problem."); - $ans_hash_old->setKeys('ans_message' => "At least one side is incorrect."); - } - if ($student !~ /[=]/) { - if ($ans =~ /[RCP]/) { - @side = split(/[=]/, $ans); - $ans_hash_old->setKeys('ans_message' => "Enter your answer in the form: $side[0] = expression."); - } else { - $ans_hash_old->setKeys('ans_message' => "You must enter an equation."); - } - } - - return $ans_hash_old; - }; - return $new_evaluator; -} - -################################################################### -# 5) Checks both sides of an equation for the slope-intercept form of a line. - -sub SlopeIntercept_equation_cmp { - - loadMacros("unionUtils.pl", "answerUtils.pl", "contextLimitedPolynomial.pl"); - - my $ans = shift; - my $formatAns = $ans; - $formatAns =~ tr/ //; - my @correctSides = split(/[=]/, $formatAns); - - my $new_evaluator = sub { - my $left_evaluator = fun_cmp($correctSides[0], vars => [ 'x', 'y' ]); - my $right_evaluator = fun_cmp($correctSides[1], vars => [ 'x', 'y' ]); - - my $student = shift; - my $formatStudent = $student; - $formatStudent =~ tr/ //; - if ($student !~ /[=]/) { - my $ans_hash = $right_evaluator->evaluate($formatStudent); - $ans_hash->{correct_ans} = "$ans"; - $ans_hash->{original_student_ans} = "$student"; - $ans_hash->{student_ans} = "$student"; - $ans_hash->{preview_latex_string} = "$student"; - $ans_hash->setKeys('ans_message' => "You must enter an equation."); - $ans_hash->{score} = 0; - return $ans_hash; - } else { - my @studentSides = split(/[=]/, $formatStudent); - - my $left_ans_hash = $left_evaluator->evaluate($studentSides[0]); - my $right_ans_hash = $right_evaluator->evaluate($studentSides[1]); - - $left_ans_hash->{correct_ans} = "$ans"; - $left_ans_hash->{original_student_ans} = "$student"; - $left_ans_hash->{student_ans} = "$student"; - $left_ans_hash->{preview_latex_string} = "$student"; - - if ($right_ans_hash->{score} == 0) { $left_ans_hash->{score} = 0; } - - my $perlNumber = "[0-9]+[\.\/]?[0-9]*|\.[0-9]+"; - my $BadForm = - ($studentSides[0] =~ /\w.*\w/ - || $studentSides[1] =~ /[a-zA-Z].*[a-zA-Z]/ - || $studentSides[1] =~ /($perlNumber)[+-]+($perlNumber[a-zA-Z][+-])?($perlNumber)/); - if ($BadForm) { - $left_ans_hash->setKeys( - 'ans_message' => "Enter your answer in the form: $BR y = mx+b, y = b or x = c"); - $left_ans_hash->{score} = 0; - } - - return $left_ans_hash; - } - }; - return $new_evaluator; -} - -################################################################### -# 6) Checks for function notation in an equality. - -sub functionNotation_cmp { - - loadMacros("unionUtils.pl", "answerUtils.pl"); - - my $ans = shift; - my @variables = @_; - - my $formatAns = $ans; - $formatAns =~ tr/ //; - my @correctSides = split(/[=]/, $formatAns); - - my $new_evaluator = sub { - # my $notation_evaluator = fun_cmp($correctSides[0],vars=>@variables); - my $notation_evaluator = ordered_cs_str_cmp($correctSides[0]); - my $notation2_evaluator = unordered_str_cmp($correctSides[0]); - my $formula_evaluator = fun_cmp($correctSides[1], vars => @variables, tol => .001); - - my $student = shift; - my $formatStudent = $student; - $formatStudent =~ tr/ //; - - if ($student !~ /[=]/ || $student !~ /(\w\s*\(\s*\w\s*\))/) { - my $ans_hash = $formula_evaluator->evaluate($formatStudent); - $ans_hash->{correct_ans} = "$ans"; - $ans_hash->{original_student_ans} = "$student"; - $ans_hash->{student_ans} = "$student"; - $ans_hash->{preview_latex_string} = "$student"; - $ans_hash->setKeys('ans_message' => "Your answer must be in function notation."); - return $ans_hash; - } else { - my @studentSides = split(/[=]/, $formatStudent); - - my $notation_ans_hash = $notation_evaluator->evaluate($studentSides[0]); - my $notation2_ans_hash = $notation2_evaluator->evaluate($studentSides[0]); - my $formula_ans_hash = $formula_evaluator->evaluate($studentSides[1]); - - $formula_ans_hash->{correct_ans} = "$ans"; - $formula_ans_hash->{original_student_ans} = "$student"; - $formula_ans_hash->{student_ans} = "$student"; - $formula_ans_hash->{preview_latex_string} = "$student"; - - if ($notation_ans_hash->{score} != 1) { - $formula_ans_hash->{ans_message} = $notation_ans_hash->{ans_message}; - if ($notation2_ans_hash->{score} == 1) { - $formula_ans_hash->setKeys( - 'ans_message' => "Your answer must be in correct function notation."); - } - $formula_ans_hash->{score} = 0; - } - - return $formula_ans_hash; - } - }; - return $new_evaluator; -} - -################################################################### -# 7) Checks factors of polynomials. -# Note: Student's answers must be of the form: monomial(poly)...(poly) with -# or without parentheses about the monomial. The polynomial factors must -# not contain any other grouping symbols and, in any case, only parenthesis -# may be used. This needs to be in the instructions for any set that uses -# this macro (in the screenHeader.pg file). -# Note: "StrictFactoringEvaluator" requires leading negatives to be factored out. -# This not may not work with all situations. BE SURE TO CHANGE THIS FILE IF THE -# FactoringEvaluator IS CHANGED!! -#---------For diagnosing problems-------------------------------------- -# $ans_hash->setKeys( 'ans_message' =>"FYI: Not checking correctly. -# AnswerHashScore: $ans_hash->{score} : -# Student: $#student_factors, $student_ans, -# Formatted: $format_student_ans, -# Student Factors: $student_factors[0], $student_factors[1], -# : Correct: $#factors, $factors[0], $factors[1], -# Number matched: $CorrectFactors"); -#---------------------------------------------------------------------- - -sub FactoringEvaluator { - - Context()->strings->add("Does not factor" => ()); - - my $ans = shift; - my $ans_text = $ans; #For string answers like "Does not factor" - if ($ans =~ /factor/) { - $ans = shift; - } - my @vars = @_; - - my $format_ans = $ans; - $format_ans =~ s/\*/ /g; #Remove any astrix - $format_ans =~ s/[\(]/,\(/g; #Put in the delimiter , - if ($format_ans =~ /^,/) { $format_ans =~ s/,//; } #Remove any leading comma - my @factors = split(/[,]/, $format_ans); #Split off the terms - for $k (0 .. $#factors) { $factors[$k] = Formula($factors[$k])->reduce; } - $ans = Formula($ans)->reduce; - - my $old_evaluator = fun_cmp($ans, var => @vars); - - my $new_evaluator = sub { - local ($factor_eval, $negfactor_eval, $factor_hash, $negfactor_hash); - - my $student_ans = shift; - - #---------For string answers---------------------------------------------- - if ($student_ans =~ /factor/) { - my $old_eval_string = str_cmp($ans_text); - my $ans_hash = $old_eval_string->evaluate($student_ans); - $ans_hash->{correct_ans} = $ans_text; #For better display (no caps) - $ans_hash->{student_ans} = $student_ans; - $ans_hash->{original_student_ans} = $student_ans; - return $ans_hash; - } - #--------------------------------------------------------------------------- - - my $ans_hash = $old_evaluator->evaluate($student_ans); - - #----------The only parentheses are allowed for grouping symbols------------ - #----------and only the minimum set needed to enter the answer correctly.--- - if ($student_ans =~ /[\{\}\[\]]/) { - $ans_hash->{student_ans} = $student_ans; - $ans_hash->{original_student_ans} = $student_ans; - $ans_hash->{score} = 0; - $ans_hash->setKeys('ans_message' => "You may only use parentheses in your answer."); - return $ans_hash; - } - if ($student_ans =~ /[\(][^\)]*[\(]/) { - $ans_hash->{student_ans} = $student_ans; - $ans_hash->{original_student_ans} = $student_ans; - $ans_hash->{score} = 0; - $ans_hash->setKeys('ans_message' => "Your answer has extraneous grouping symbols."); - return $ans_hash; - } - - #-----------Check the factors--------------------------------------------- - - if ($ans_hash->{score} == 1) { - my $format_student_ans = $student_ans; - $format_student_ans =~ s/[\*]/ /g; #Remove any astrix - $format_student_ans =~ s/[\(]/,\(/g; #Put in the delimiter , - if ($format_student_ans =~ /^,/) { $format_student_ans =~ s/,//; } #Remove leading commas - my @student_factors = split(/[,]/, $format_student_ans); #Split off the terms - for $k (0 .. $#student_factors) { $student_factors[$k] = Formula($student_factors[$k]); } - - #########Could this be done with a list?--would have to change the list's error msg. - - my $CorrectFactors = 0; - - foreach $i (0 .. $#factors) { - $factor_eval = fun_cmp($factors[$i], var => @vars); - $negfactor_eval = fun_cmp(-1 * ($factors[$i]), var => @vars); - foreach $j (0 .. $#student_factors) { - $factor_hash = $factor_eval->evaluate($student_factors[$j]); - $negfactor_hash = $negfactor_eval->evaluate($student_factors[$j]); - if ($factor_hash->{score} == 1 || $negfactor_hash->{score} == 1) { - $CorrectFactors = $CorrectFactors + 1; - - #---------This segment is for binomial factors raised to powers---------------- - # Example: (3x+1)^2 is correct, and (9x^2+6x+1) should not be accepted - # SHOULD MAKE THIS MORE GENERAL: TAKE OTHER EXPONENTS BESIDES INTEGERS, - # THE PATTERN SHOULD BE BETTER DEFINED. - #------------------------------------------------------------------------------ - $factor_string = $factors[$i]->string; - $st_factor_string = $student_factors[$j]->string; - if ($factor_string =~ /\(.*[+-]{1}.*\)\^\d+$/ - && $st_factor_string !~ /\(.*[+-]{1}.*\)\^\d+$/) - { - $ans_hash->{score} = 0; - $ans_hash->setKeys('ans_message' => "Factor the expression completely."); - } - #------------------------------------------------------------------------------- - } - } - } - - if ($CorrectFactors != $#factors + 1) { - $ans_hash->{score} = 0; - $ans_hash->setKeys( - 'ans_message' => "Check that your answer is factored - completely and is entered in the - required format." - ); - } - } - - if ($ans_text =~ /factor/) { $ans_hash->{correct_ans} = $ans_text; } #In case the answer is a string - - return $ans_hash; - }; #END of SUB - - Context()->strings->remove("Does not factor" => ()); - return $new_evaluator; -} - -sub StrictFactoringEvaluator { - - my $ans = shift; - my @vars = @_; - - my $format_ans = $ans; - $format_ans =~ s/[\*]//g; #Remove any astrix - $format_ans =~ s/[\(]/,\(/g; #Put in the delimiter , - if ($format_ans =~ /^,/) { $format_ans =~ s/,//; } #Remove any leading commas - my @factors = split(/[,]/, $format_ans); #Split off the terms - for $k (0 .. $#factors) { $factors[$k] = Formula($factors[$k]); } - $ans = Formula($ans)->reduce; - - my $old_evaluator = fun_cmp($ans, var => @vars); - - my $new_evaluator = sub { - local ($factor_eval, $factor_hash); - - my $student_ans = shift; - - #----This could be changed so that it would check prime polyomials here instead - #----of in the problem template. - if ($student_ans =~ /factor/) { - my $string_ans = $ans->string; - my $old_eval_string = std_cs_str_cmp($string_ans); - my $ans_hash = $old_eval_string->evaluate($student_ans); - return $ans_hash; - } - #------------------------------------------------------ - - my $ans_hash = $old_evaluator->evaluate($student_ans); - - if ($ans_hash->{score} == 1) { #Check factors - my $format_student_ans = $student_ans; - $format_student_ans =~ s/[\*]//g; #Remove any astrix - $format_student_ans =~ s/[\(]/,\(/g; #Put in the delimiter , - if ($format_student_ans =~ /^,/) { $format_student_ans =~ s/,//; } #Remove any leading commas - my @student_factors = split(/[,]/, $format_student_ans); #Split off the terms - for $k (0 .. $#student_factors) { $student_factors[$k] = Formula($student_factors[$k]); } - - #########Could this be done with a list?--would have to change the list's error msg. - - my $CorrectFactors = 0; - - foreach $i (0 .. $#factors) { - $factor_eval = fun_cmp($factors[$i], var => @vars); - foreach $j (0 .. $#student_factors) { - $factor_hash = $factor_eval->evaluate($student_factors[$j]); - if ($factor_hash->{score} == 1) { - $CorrectFactors = $CorrectFactors + 1; - } - } - } - - if ($CorrectFactors != $#factors + 1) { - $ans_hash->{score} = 0; - $ans_hash->setKeys('ans_message' => - "Check that your answer is factored completely and is entered in the required format."); - } - } - return $ans_hash; - }; - return $new_evaluator; -} - -################################################################### -# 8) Checks for simplified rational expressions. -# Note: Student's answers must be of the form: (poly)/(poly) -# -#---------For diagnosing problems-------------------------------------- -# $ans_hash->setKeys( 'ans_message' =>"FYI: Not checking correctly. -# Student: $student_num, $student_den,$student_ans; -# Answer: $num,$den,$ans"); -#---------------------------------------------------------------------- - -sub RationalExpEvaluator { - - Context()->strings->add("Does not simplify" => ()); - - my $ans = shift; - my $ans_text = $ans; #Mainly for string answers like "Does not simplify" - if ($ans =~ /not/) { - $ans = shift; - } - my @vars = @_; - - #---------Split off the numerator/denominator - my @factors = split(q[/], $ans); - my $num = Formula($factors[0]); - my $den = ($#factors > 0) ? Formula($factors[1]) : Formula("1"); - - my $old_evaluator = fun_cmp($ans, var => @vars); - - my $new_evaluator = sub { - my $student_ans = shift; - my $student_ans_text = $student_ans; - - #---------For string answers---------------------------------------------- - if ($student_ans_text =~ /not/) { - my $old_eval_string = str_cmp($ans_text); - my $ans_hash = $old_eval_string->evaluate($student_ans_text); - $ans_hash->{correct_ans} = $ans_text; - $ans_hash->{student_ans} = $student_ans_text; - $ans_hash->{original_student_ans} = $student_ans_text; - return $ans_hash; - } - #------------------------------------------------------------------------- - - my $ans_hash = $old_evaluator->evaluate($student_ans); - - if ($ans_hash->{score} == 1) { - #--------Check for a scalar answer in case and the student entered a decimal - if ($student_ans !~ /[a-zA-Z]/ && $ans !~ /[a-zA-Z]/) { - $ans_hash->{correct_ans} = $ans_text; - $ans_hash->{student_ans} = $student_ans_text; - $ans_hash->{original_student_ans} = $ans_hash->{student_ans}; - return $ans_hash; - } - #-------------------------------------------------------------------- - - #--------Split off the numerator/denominator------------------------- - my $student_ans_mo = Formula($student_ans_text); - my ($student_num, $student_den); - my @student_factors; - - # use MO parse tree rather than regex split because of surrounding parens from mathquill - if ($student_ans_mo->{tree}->class eq 'BOP' && $student_ans_mo->{tree}{bop} =~ m!/!) { - $student_num = $student_ans_mo->{tree}{lop}; - $student_den = $student_ans_mo->{tree}{rop}; - @student_factors = ($student_num->string, $student_den->string); - } else { - $student_num = $student_ans_mo; - $student_den = Formula('1'); - @student_factors = ($student_num->string); - } - #-------------------------------------------------------------------- - - if ($#factors != $#student_factors) { - $ans_hash->{score} = 0; - } else { - my $num_eval = fun_cmp($num, var => @vars); - my $num_hash = $num_eval->evaluate($student_num); - $ans_hash->{score} = $num_hash->{score}; - - if ($#factors > 0) { - my $den_eval = fun_cmp($den, var => @vars); - my $den_hash = $den_eval->evaluate($student_den); - $ans_hash->{score} = $den_hash->{score}; - } - } - - $ans_hash->{ans_message} = "Simplify your answer." if ($ans_hash->{score} == 0); - } - - return $ans_hash; - }; - - Context()->strings->remove("Does not simplify" => ()); - return $new_evaluator; -} - -################################################################### -# 9) Writes a fraction in reduced form. -# - -sub ReduceFraction { - my $num = shift; - my $den = shift; - my $n = 1; - my $d = 1; - - ($n, $d) = reduce($num, $den); - my $result = "$n/$d"; - if ($d == 1) { $result = "$n"; } - - return ($result); -} - -################################################################### -# 10) Checks a list of equations. -# Designed for checking a list of asymptotes - -sub equation_cmp_list { - - loadMacros("extraAnswerEvaluators.pl"); - - my $ans = shift; - my @vars = @_; - - my $format_ans = $ans; - $format_ans =~ tr/ //; #Remove any whitespace - my @ans_list = split(/[,]/, $format_ans); #Split off the terms - - # - # my $old_evaluator2 = str_cmp($ans_list[1]); - # Would like to change this to an equation evaluator later - # my $old_evaluator1 = equation_cmp($ans[0],vars=>@vars); - # my $old_evaluator2 = equation_cmp($ans[1],vars=>@vars); - - my $new_evaluator = sub { - - local ($eq_eval, $ans_hash); - - my $student_ans = shift; - chomp $student_ans; - my $format_st = $student_ans; - $format_st =~ tr/ //; #Remove any whitespace - - my @student_list = split(/,/, $format_st); - - my $Correct = -1; - foreach $i (0 .. $#ans_list) #Count the number of matches between the lists - { - my $eq_eval = str_cmp($ans_list[$i]); - foreach $j (0 .. $#student_list) { - $ans_hash = $eq_eval->evaluate($student_list[$j]); - if ($ans_hash->{score} == 1) { $Correct = $Correct + 1; } - } - } - my $Duplicates = -1; - foreach $i (0 .. $#student_list) #Check for duplicates in the student's list - { - my $eq_eval = str_cmp($student_list[$i]); - foreach $j (0 .. $#student_list) { - $ans_hash = $eq_eval->evaluate($student_list[$j]); - if ($ans_hash->{score} == 1) { $Duplicates = $Duplicates + 1; } - } - } - if ($Correct != $#ans_list || $Duplicates != $#student_list) { - $ans_hash->{score} = 0; - if ($Duplicates != $#student_list) { - $ans_hash->setKeys('ans_message' => "You have listed an asymptote more than once."); - } - } else { - $ans_hash->{score} = 1; - } - $ans_hash->{correct_ans} = $ans; - $ans_hash->{student_ans} = $student_ans; - $ans_hash->{original_student_ans} = $ans_hash->{student_ans}; - # $ans_hash->{type} = '', - $ans_hash->{preview_text_string} = $student_ans; - $ans_hash->{preview_latex_string} = $student_ans; - return $ans_hash; - }; - return $new_evaluator; -} - -1; diff --git a/macros/univ/Dartmouthmacros.pl b/macros/univ/Dartmouthmacros.pl deleted file mode 100644 index 09678528b2..0000000000 --- a/macros/univ/Dartmouthmacros.pl +++ /dev/null @@ -1,304 +0,0 @@ -#!/usr/bin/perl - -# this is equivalent to use strict, but can be used within the Safe compartment. -BEGIN { - be_strict; -} - -## Some local macros - -sub trs_mod { - my @inputs = @_; - my $a = $inputs[0]; - my $b = $inputs[1]; - my $zero = 1e-12; - if ($b < 0) { $b = -$b; } - -## Want mod(a,b) but perl and int are flawed - my $modvalue = $a; - # if ($a >= 0 && $a < $b) {$modvalue = $a;} - - while ($modvalue >= $b) { $modvalue = $modvalue - $b; } - while ($modvalue < 0) { $modvalue = $modvalue + $b; } - if (abs($modvalue) <= $zero) { $modvalue = 0; } - if (abs($modvalue - $b) <= $zero) { $modvalue = 0; } -## Fudge for roundoff error - return $modvalue; -} - -## Compute the product of a scalar and a vector (scalar first) -sub scalar_mult_vector { - ## Put the parameters passed into an array of values - my @vector = @_; - - ## Split off the first entry as the scalar, and the rest as the vector - my $scalar = $vector[0]; - my @vectorb = @vector[ (1 .. $#vector) ]; - - ## Initialize scalar multiple as empty vector - my @scalar_multiple = (); - - my $i; - for ($i = 0; $i <= $#vectorb; $i++) { - $scalar_multiple[$i] = $scalar * $vectorb[$i]; - } - return @scalar_multiple; -} - -## Compute the sum of two vectors -## Perl doesn't seem to have builtin array arithmetic -sub vector_sum { - ## Put the parameters passed into an array of values - my @vector = @_; - ## $#vector is the number of elements in vector minus 1 - my $halflength = ($#vector - 1) / 2; - ## Slice the input into two equal length vectors - my @vectora = @vector[ (0 .. $halflength) ]; - my @vectorb = @vector[ ($halflength + 1 .. $#vector) ]; - - ## Initialize vector sum to empty array - my @vector_sum = (); - - my $i; - for ($i = 0; $i <= $#vectora; $i++) { - $vector_sum[$i] = $vectora[$i] + $vectorb[$i]; - } - return @vector_sum; -} - -## Compute the difference of two vectors -sub vector_diff { - ## Put the parameters passed into an array of values - my @vector = @_; - ## $#vector is the number of elements in vector minus 1 - my $halflength = ($#vector - 1) / 2; - ## Slice the input into two equal length vectors - my @vectora = @vector[ (0 .. $halflength) ]; - my @vectorb = @vector[ ($halflength + 1 .. $#vector) ]; - - return vector_sum(@vectora, scalar_mult_vector(-1, @vectorb)); -} - -## Compute the length of a vector -sub vec_length { - ## Put the paramaters passed into an array of values - my @vector = @_; - - ## Initialize maximum value to first element - my $vector_length = 0; - - my $i; - for ($i = 0; $i <= $#vector; $i++) { - $vector_length = $vector_length + $vector[$i] * $vector[$i]; - } - $vector_length = sqrt($vector_length); - return $vector_length; -} - -sub vector_length { - my @vector = @_; - return vec_length(@vector); -} - -## Computes the dot product of two vectors (assumed of the same dimension) -sub dot_product { - ## Put the parameters passed into an array of values - my @vector = @_; - ## $#vector is the number of elements in vector minus 1 - my $halflength = ($#vector - 1) / 2; - ## Split the input into two equal length vectors - my @vectora = @vector[ (0 .. $halflength) ]; - my @vectorb = @vector[ ($halflength + 1 .. $#vector) ]; - - ## Initialize dot product to zero - my $dot = 0; - - my $i; - for ($i = 0; $i <= $#vectora; $i++) { - $dot = $dot + $vectora[$i] * $vectorb[$i]; - } - return $dot; -} - -sub cross_product { - ## Put the parameters passed into an array of values - my @vector = @_; - - ## Slice the input into two equal length vectors - my @vectora = @vector[ (0 .. 2) ]; - my @vectorb = @vector[ (3 .. 5) ]; - - ## Initialize dot product to zero - my @cross = (); - - $cross[0] = $vectora[1] * $vectorb[2] - $vectora[2] * $vectorb[1]; - $cross[1] = $vectora[2] * $vectorb[0] - $vectora[0] * $vectorb[2]; - $cross[2] = $vectora[0] * $vectorb[1] - $vectora[1] * $vectorb[0]; - return @cross; -} - -## Compute the maximum value in a list -#sub max { -# ## Put the paramters passed into an array of values -# my @values = @_; -# -# ## Initialize maximum value to first element -# my $max = $values[0]; -# -# my $i; -# for ($i=1; $i <= $#values; $i++) -# { -# if ($values[$i] > $max) { -# $max = $values[$i]; -# } -# } -# return $max; -#} - -## Compute the minimum value in a list -#sub min { -# ## Put the paramters passed into an array of values -# my @values = @_; -# -# ## Initialize minimum value to first element -# my $min = $values[0]; -# -# my $i; -# for ($i=1; $i <= $#values; $i++) -# { -# if ($values[$i] < $min) { -# $min = $values[$i]; -# } -# } -# return $min -#} - -## clean_scalar_string is invoked to make expressions like "$a x" look -## better when $a = 0, -1, 1 -## Usage: clean_scalar_string(scalar, "quoted string"); -## Example: clean_scalar_string(-1,"\pi") returns "-\pi" -sub clean_scalar_string { - my $local_scalar = shift; - my $local_fixed_object = shift; - my $return_object; - - if ($local_scalar == 0) { $return_object = "0"; } - elsif ($local_scalar == 1) { $return_object = "$local_fixed_object"; } - elsif ($local_scalar == -1) { $return_object = "-$local_fixed_object"; } - else { $return_object = "${local_scalar}${local_fixed_object}"; } - return $return_object; -} - -## Computes the greatest common divisor of two integers -## Example: gcd(-300, 125) returns 25 -sub trs_gcd { - my $a = shift; - my $b = shift; - my $c; - my $abs_a = abs($a); - my $abs_b = abs($b); - if ($abs_b == 0) { return $abs_a; } - else { - $c = $abs_a % $abs_b; - return trs_gcd($abs_b, $c); - } -} - -## reduced_fraction takes a pair of integers $numerator, $denominator -## ($denominator != 0) and returns an array of two elements @fraction -## $fraction[0] is the reduced numerator; $fraction[1] the reduced -## denominator -## Puts the sign of the fraction, if negative, in the numerator -## -## Usage: @fraction = reduced_fraction($numerator, $denominator) -## -sub reduced_fraction { - my $local_numerator = shift; - my $local_denominator = shift; - my $sign_of_num = 1; - my $sign_of_denom = 1; - my $sign_of_quotient; - my @local_fraction = (); - - if ($local_numerator < 0) { $sign_of_num = -1; } - if ($local_denominator < 0) { $sign_of_denom = -1; } - $sign_of_quotient = $sign_of_num * $sign_of_denom; - - my $local_gcd = trs_gcd($local_numerator, $local_denominator); -## reduced numerator - $local_fraction[0] = ($sign_of_quotient * abs($local_numerator)) / $local_gcd; -## reduced denominator - $local_fraction[1] = abs($local_denominator) / $local_gcd; - return @local_fraction; -} - -## Given Cartesian coordinates x and y returns an -## array the zeroth element which is the radius -## and the first element which is the argument -## 0 <= theta < 2*pi -## -## Returns r=0 theta=0 for the origin -## -sub coordinates_polar { - my $x = shift; - my $y = shift; - my @polar = (); - my $radius = 0; - my $theta = 0; - my $pi = acos(-1); - - $radius = sqrt($x**2 + $y**2); - if ($radius != 0) { - if ($x == 0) { - if ($y > 0) { $theta = $pi / 2; } - else { $theta = 3 * $pi / 2; } - } else { - if ($y > 0) { - if ($x > 0) { $theta = atan($y / $x); } - else { $theta = $pi - atan(-$y / $x); } - } else { - if ($x > 0) { $theta = 2 * $pi + atan($y / $x); } - else { $theta = $pi + atan($y / $x); } - } - } - } - @polar = ($radius, $theta); - return @polar; -} - -## Cylindarical coordinates from polar routine -sub coordinates_cylindrical { - my $x = shift; - my $y = shift; - my $z = shift; - my @cylindrical = (coordinates_polar($x, $y), $z); - return @cylindrical; -} - -## Spherical Coordinates from polar routine -## -sub coordinates_spherical { - my $x = shift; - my $y = shift; - my $z = shift; - my $rho = 0; - my $phi = 0; - $rho = sqrt($x * $x + $y * $y + $z * $z); - my @npolar = (); - @npolar = coordinates_polar($x, $y); - my @spherical = (); - - if ($x == 0 && $y == 0) { - if ($z >= 0) { $phi = 0; } - else { $phi = acos(-1); } - @spherical = ($rho, 0, $phi); - } else { - $rho = sqrt($x * $x + $y * $y + $z * $z); - - @spherical = ($rho, $npolar[1], acos($z / $rho)); - } - return @spherical; -} - -1; - diff --git a/macros/univ/MUHelp.pl b/macros/univ/MUHelp.pl deleted file mode 100644 index 20d8faef9a..0000000000 --- a/macros/univ/MUHelp.pl +++ /dev/null @@ -1,49 +0,0 @@ -sub BBRED { - MODES(TeX => '{\\color{red} ', HTML => ''); -} - -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/univ/freemanMacros.pl b/macros/univ/freemanMacros.pl deleted file mode 100644 index 86fcb54f35..0000000000 --- a/macros/univ/freemanMacros.pl +++ /dev/null @@ -1,541 +0,0 @@ -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/univ/hhAdditionalMacros.pl b/macros/univ/hhAdditionalMacros.pl deleted file mode 100644 index 6f430ae29b..0000000000 --- a/macros/univ/hhAdditionalMacros.pl +++ /dev/null @@ -1,437 +0,0 @@ -# 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/univ/littleneck.pl b/macros/univ/littleneck.pl deleted file mode 100644 index bbfb1fa03f..0000000000 --- a/macros/univ/littleneck.pl +++ /dev/null @@ -1,191 +0,0 @@ -#***************************** -# 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); -} From dcbcd6ae8303ac01eb94fe041f87ec624b6e3f02 Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Sat, 8 Oct 2022 08:03:17 -0400 Subject: [PATCH 6/9] WIP: fix merge on PGloadmacros.pm and update macros changed in recent PRs. WIP: fix merge on PGloadmacros.pm and update macros changed in recent PRs. WIP: fix merge on PGloadmacros.pm and update macros changed in recent PRs. --- lib/PGloadfiles.pm | 2 +- macros/core/PGbasicmacros.pl | 2 +- macros/graph/LiveGraphics3D.pl | 96 ++++------------------------------ macros/ui/niceTables.pl | 3 ++ 4 files changed, 14 insertions(+), 89 deletions(-) diff --git a/lib/PGloadfiles.pm b/lib/PGloadfiles.pm index 14efed150f..5b14c199d0 100644 --- a/lib/PGloadfiles.pm +++ b/lib/PGloadfiles.pm @@ -21,7 +21,7 @@ loadMacros(@macroFiles) -loadMacros takes a list of file names and evaluates the contents of each file. +loadMacros takes a list of file names and evaluates the contents of each file. This is used to load macros which define and augment the PG language. The macro files are searched for in the directories specified by the array referenced by $macrosPath, which by default is the current course's macros directory followed diff --git a/macros/core/PGbasicmacros.pl b/macros/core/PGbasicmacros.pl index 6ea4b73887..a689e145ed 100644 --- a/macros/core/PGbasicmacros.pl +++ b/macros/core/PGbasicmacros.pl @@ -2800,7 +2800,7 @@ sub begintable { || $displayMode eq 'HTML_LaTeXMathML' || $displayMode eq 'HTML_img') { - $out .= "\n"; + $out .= '
    '; } else { $out = "Error: PGbasicmacros: begintable: Unknown displayMode: $displayMode.\n"; } diff --git a/macros/graph/LiveGraphics3D.pl b/macros/graph/LiveGraphics3D.pl index a9c6ee5973..4eeed59648 100644 --- a/macros/graph/LiveGraphics3D.pl +++ b/macros/graph/LiveGraphics3D.pl @@ -1,19 +1,9 @@ sub _LiveGraphics3D_init { - - if ($main::envir{use_javascript_for_live3d} - && !$main::LiveGraphics3DHeaderSet) - { - main::HEADER_TEXT(<<'END_HEADER_TEXT'); - - - - - -END_HEADER_TEXT - - $main::LiveGraphics3DHeaderSet = 1; - } - + ADD_JS_FILE('node_modules/x3dom/x3dom.js'); + ADD_JS_FILE('node_modules/jszip/dist/jszip.min.js'); + ADD_JS_FILE('node_modules/jszip-utils/dist/jszip-utils.min.js'); + ADD_JS_FILE('js/apps/LiveGraphics/liveGraphics.js'); + ADD_CSS_FILE('node_modules/x3dom/x3dom.css'); } =head2 LiveGraphics3D.pl @@ -36,7 +26,7 @@ =head2 LiveGraphics3D.pl # Live3Ddata load raw Graphics3D data # LiveGraphics3D access to all parameters # - + # # LiveGraphics3D(options) # @@ -60,8 +50,6 @@ =head2 LiveGraphics3D.pl # the applet with their replacement strings # (see LiveGraphics3D documentation) # - # jar => URL where to find the live.jar file - # # background=>"#RRGGBB" the background color to use (default is white) # # scale => n scaling factor for applet (default is 1.) @@ -70,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 @@ -84,10 +72,7 @@ =head2 LiveGraphics3D.pl sub LiveGraphics3D { my %options = ( - size => [ 250, 250 ], - jar => "live.jar", # "${htmlURL}live.jar", - codebase => findAppletCodebase("live.jar"), - # codebase => "https://demo.webwork.rochester.edu/webwork2_files/applets/", # used for testing + size => [ 250, 250 ], background => "#FFFFFF", scale => 1., tex_size => 500, @@ -116,7 +101,7 @@ sub LiveGraphics3D { }"; } # In html mode check to see if we use javascript or not - } elsif ($main::envir{use_javascript_for_live3d}) { + } else { my ($w, $h) = @{ $options{size} }; $out .= $bHTML if ($main::displayMode eq "Latex2HTML"); # @@ -168,69 +153,6 @@ sub LiveGraphics3D { $out .= "\n
    \n"; $out .= $eHTML if ($main::displayMode eq "Latex2HTML"); # otherwise use the applet - } else { - my ($w, $h) = @{ $options{size} }; - $out .= $bHTML if ($main::displayMode eq "Latex2HTML"); - # - # Put the applet in a table - # - $out .= qq{\n\n}; - $out .= qq{\n
    }; - # - # start the applet - # - $out .= qq{ - - - - }; - # - # include the file or data - # - $out .= qq{\n} - if ($options{archive}); - $out .= qq{\n} - if ($options{file}); - $out .= qq{\n} - if ($options{input}); - # - # include any independent variables - # - if ($options{vars}) { - my @vars = (); - %pval = @{ $options{vars} }; - foreach $p (lex_sort(keys(%pval))) { push(@vars, "${p}->$pval{$p}"); } - $out .= ''; - $out .= "\n"; - } - # - # include dependent variables - # - if ($options{depend}) { - my @depend = (); - $pval = @{ $options{depend} }; - foreach $p (lex_sort(keys(%pval))) { push(@depend, "${p}->$pval{$p}"); } - $out .= ''; - $out .= "\n"; - } - # - # include any extra Live3D parameters - # - if ($options{Live3D}) { - my %pval = @{ $options{Live3D} }; - foreach $p (lex_sort(keys(%pval))) { - $out .= qq{\n}; - } - } - # - # End the applet and table - # - $out .= qq{} if ($options{image}); - $out .= "[Enable Java to make this image interactive]
    "; - $out .= "    "; - $out .= "
    \n"; - $out .= $eHTML if ($main::displayMode eq "Latex2HTML"); - } return $out; diff --git a/macros/ui/niceTables.pl b/macros/ui/niceTables.pl index cfa1e37b76..33380b03bb 100644 --- a/macros/ui/niceTables.pl +++ b/macros/ui/niceTables.pl @@ -205,6 +205,9 @@ =head2 Description =cut +# ^uses loadMacros +loadMacros("PGauxiliaryFunctions.pl"); + sub _niceTables_init { }; # don't reload this file sub DataTable { From 8a82e41332ab9a8b392df282293ea03700be9231 Mon Sep 17 00:00:00 2001 From: Glenn Rice Date: Sat, 22 Oct 2022 11:12:30 -0500 Subject: [PATCH 7/9] Suggested changes. Make the macrosPath directories the same in pg/conf/pg_config.dist.yml as they are in webwork2/conf/defaults.config. Fix markdown lint issues in macros/README.md. The main issue was duplicated headers. No two headers can be the same in markdown. Also remove the comment about LiveGraphics macros as it is no longer valid. Tweak the t/macros/load_macros.t file search and sort setup a bit. --- conf/pg_config.dist.yml | 23 +---------------------- macros/README.md | 25 +++++++++++-------------- t/macros/load_macros.t | 3 ++- 3 files changed, 14 insertions(+), 37 deletions(-) diff --git a/conf/pg_config.dist.yml b/conf/pg_config.dist.yml index e54acafc04..0f5714bd7d 100644 --- a/conf/pg_config.dist.yml +++ b/conf/pg_config.dist.yml @@ -50,28 +50,7 @@ directories: - $pg_root/macros/misc - $pg_root/macros/parsers - $pg_root/macros/ui - - $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 + - $OPL_dir/macros/univ URLs: # The public URL of the html directory above. diff --git a/macros/README.md b/macros/README.md index 4bffdeb3d1..0e30278dbe 100644 --- a/macros/README.md +++ b/macros/README.md @@ -11,7 +11,6 @@ This directory now has a subdirectory structure for clarification. - **parsers** macros that handle parsing - **ui** macros that affect the UI in the PG problem - ## These Have Been Copied - `OPL/BrockPhysics/fixedPrecision.pl` to `PG/macros/contexts` @@ -26,14 +25,14 @@ This directory now has a subdirectory structure for clarification. - `OPL/WHFreeman/freemanMacros.pl` to `PG/macros/univ` - `OPL/Michigan/hhAdditionalMacros.pl` to `PG/macros/univ` -### CollegeOfIdaho +### CollegeOfIdaho copied - `OPL/CollegeOfIdaho/contextInequalitiesAllowStrings.pl` to `PG/macros/contexts` - `OPL/CollegeOfIdaho/contextFunctionAssign.pl` to `PG/macros/contexts` - `OPL/CollegeOfIdaho/parserUtils.pl` to `PG/macros/parsers` - `OPL/CollegeOfIdaho/unorderedAnswer.pl` to `PG/macros/answers` -### FortLewis +### FortLewis copied - `OPL/FortLewis/AnswerFormatHelp.pl` to `PG/macros/answers` - `OPL/FortLewis/ConditionalHint.pl` to `PG/macros/answers` @@ -43,9 +42,9 @@ This directory now has a subdirectory structure for clarification. - `OPL/FortLewis/LiveGraphicsVectorField2D.pl` to `PG/macros/graph` - `OPL/FortLewis/LiveGraphicsVectorField3D.pl` to `PG/macros/graph` - `OPL/FortLewis/MatrixUnimodular.pl` to `PG/macros/math` -- `OPL/FortLewis/PeriodicRandomization.pl` to `PG/macros/core` +- `OPL/FortLewis/PeriodicRerandomization.pl` to `PG/macros/core` -### NAU +### NAU copied - `OPL/NAU/PGnauBinpacking.pl` to `PG/macros/math` - `OPL/NAU/PGnauGraphtheory.pl` to `PG/macros/math` @@ -55,7 +54,7 @@ This directory now has a subdirectory structure for clarification. - `OPL/NAU/PGnauStats.pl` to `PG/macros/math` - `OPL/NAU/PGnauGraphics.pl` to `PG/macros/graph` -### Union +### Union copied - `OPL/Union/answerUtils.pl` to `PG/macros/answers` - `OPL/Union/PGunion.pl` to `PG/macros/misc` @@ -69,7 +68,7 @@ This directory now has a subdirectory structure for clarification. - `OPL/Union/imageChoice.pl` to `PG/macros/graph` - `OPL/FortLewis/AnswerHelp.pl` to `PG/macros/answers` -### PCC +### PCC copied - `OPL/PCC/contextFiniteSolutionSets.pl` to `PG/macros/contexts` - `OPL/PCC/contextForm.pl` to `PG/macros/contexts` @@ -98,7 +97,7 @@ This directory now has a subdirectory structure for clarification. - `OPL/WHFreeman/freemanMacros.pl` to `PG/macros/univ` (not relevant) - `OPL/Michigan/hhAdditionalMacros.pl` to `PG/macros/univ` (not relevant) -### CollegeOfIdaho +### CollegeOfIdaho not moved - `OPL/CollegeOfIdaho/allPlotMacros.pl` (no problems in OPL/Contrib) - `OPL/CollegeOfIdaho/answerUtils.pl` (used newer Union version instead) @@ -130,12 +129,12 @@ This directory now has a subdirectory structure for clarification. - `OPL/CollegeOfIdaho/vectorUtils.pl` (not used in OPL/Contrib) - `OPL/CollegeOfIdaho/weightedGrader.pl` (already in PG/core/weightedGrader) -### FortLewis +### FortLewis not moved - `OPL/FortLewis/JavaView.pl` (not in OPL/Contrib) - `OPL/FortLewis/JavaViewRectangularPlot3D.pl` (not in OPL/Contrib) -### PCC +### PCC not moved - `OPL/PCC/contextAssignmentForm.pl` (no problems in OPL/Contrib) - `OPL/PCC/contextInequalitySetBuilder.pl` (newer copy in `PG/macros/contexts`) @@ -144,7 +143,7 @@ This directory now has a subdirectory structure for clarification. - `OPL/PCC/contextPercent.pl` (newer copy in `PG/macros/contexts`) - `OPL/PCC/parserRoot.pl` (newer copy in `PG/macros/parsers`) -### Union +### Union not moved - `OPL/Union/answerUtils.pl` (not used in OPL/Contrib) - `OPL/Union/courseHeaders.pl` (not used in OPL/Contrib) @@ -173,7 +172,7 @@ This directory now has a subdirectory structure for clarification. - `Contrib/PCC/CollegeAlgebra/FunctionBasics/FunctionTables20.pg` (warnings about PCCmacros.pl) - `Library/Union/setMVfunctions/system-f2.pg` (warning about uninitialized value) -## Macros fixed: +## Macros fixed - `math/algebraMacros.pl` (removed all code, already in `customizeLaTeX.pl`) - `parsers/parserUtils.pl` (removed loadMacros call due to errors. ) @@ -192,7 +191,6 @@ This directory now has a subdirectory structure for clarification. - remove `answers/answerDiscussion.pl` (not used in OPL/Contrib) - Remove `contexts/contextPeriodic.pl`. Labelled as deprecated. No problems in OPL/Contrib. - only place `answerUtils.pl` is used is inside `unorderedAnswer.pl` (combine? refactor?) -- none of the LiveGraphics is working. Search for `LiveGraphics*.pl` - What is the `fracListChecker.pl` macro? In a number of `Contrib/Mizzou` problems. - The following are not in OPL/Contrib: - `contextMatrixExtras.pl` @@ -206,4 +204,3 @@ This directory now has a subdirectory structure for clarification. - `parserFormulaAnyVar.pl` - `parserLinearInequality.pl` - `parserParametricPlane.pl` - diff --git a/t/macros/load_macros.t b/t/macros/load_macros.t index 93359a4607..c8ab7e6575 100644 --- a/t/macros/load_macros.t +++ b/t/macros/load_macros.t @@ -41,12 +41,13 @@ 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 grep { !$baseMacros{$_} && !$brokenMacros{$_} } @macro_files; +@macro_files = sort @macro_files; for (@macro_files) { subtest $_ => sub { From e21c1889a8b33cd12a2d539c70ccfec04c757443 Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Fri, 28 Oct 2022 16:30:32 -0400 Subject: [PATCH 8/9] move other OPL macros to a deprecated folder. perltidy --- conf/pg_config.dist.yml | 3 +- macros/README.md | 16 +- macros/deprecated/Alfredmacros.pl | 376 ++++++++++++ macros/deprecated/BrockPhysicsMacros.pl | 1 + macros/deprecated/CofIdaho_macros.pl | 723 ++++++++++++++++++++++++ macros/deprecated/Dartmouthmacros.pl | 304 ++++++++++ macros/deprecated/MUHelp.pl | 49 ++ macros/deprecated/README.md | 6 + macros/deprecated/freemanMacros.pl | 541 ++++++++++++++++++ macros/deprecated/hhAdditionalMacros.pl | 437 ++++++++++++++ macros/deprecated/littleneck.pl | 191 +++++++ 11 files changed, 2639 insertions(+), 8 deletions(-) create mode 100755 macros/deprecated/Alfredmacros.pl create mode 100644 macros/deprecated/BrockPhysicsMacros.pl create mode 100755 macros/deprecated/CofIdaho_macros.pl create mode 100755 macros/deprecated/Dartmouthmacros.pl create mode 100644 macros/deprecated/MUHelp.pl create mode 100644 macros/deprecated/README.md create mode 100755 macros/deprecated/freemanMacros.pl create mode 100755 macros/deprecated/hhAdditionalMacros.pl create mode 100644 macros/deprecated/littleneck.pl diff --git a/conf/pg_config.dist.yml b/conf/pg_config.dist.yml index 0f5714bd7d..f2f3d85542 100644 --- a/conf/pg_config.dist.yml +++ b/conf/pg_config.dist.yml @@ -50,7 +50,8 @@ directories: - $pg_root/macros/misc - $pg_root/macros/parsers - $pg_root/macros/ui - - $OPL_dir/macros/univ + - $pg_root/macros/deprecated + URLs: # The public URL of the html directory above. diff --git a/macros/README.md b/macros/README.md index 0e30278dbe..7968c9a66f 100644 --- a/macros/README.md +++ b/macros/README.md @@ -6,6 +6,7 @@ This directory now has a subdirectory structure for clarification. - **capa** any CAPA related macros - **contexts** context related macros - **core** macros related to core PG functionality +- **deprecated** macros that have been labelled deprecated - **graph** graphing/graphical related macros. - **math** mathematical related macros - **parsers** macros that handle parsing @@ -14,19 +15,23 @@ This directory now has a subdirectory structure for clarification. ## These Have Been Copied - `OPL/BrockPhysics/fixedPrecision.pl` to `PG/macros/contexts` +- `OPL/BrockPhysics/BrockPhysicsMacros.pl` to `PG/macros/deprecated` +- `OPL/Dartmouth/Dartmouthmacros.pl` to `PG/macros/deprecated` - `OPL/Hope/PGgraphgrid.pl` to `PG/macros/graph` - `OPL/Hope/VectorListCheckers.pl` to `PG/macros/math` - `OPL/LaTech/SI_property_tables.pl` to `PG/macros/math` - `OPL/LaTech/interpMacros.pl` to `PG/macros/math` - +- `OPL/Mizzou/MUHelp.pl` to `PG/macros/deprecated` - `OPL/TCNJ/Generic.pl` to `PG/macros/answers` - `OPL/UBC/regrfnsPG.pl` to `PG/macros/math` - `OPL/UMass-Amherst/algebraMacros.pl` to `PG/macros/math` -- `OPL/WHFreeman/freemanMacros.pl` to `PG/macros/univ` -- `OPL/Michigan/hhAdditionalMacros.pl` to `PG/macros/univ` +- `OPL/WHFreeman/freemanMacros.pl` to `PG/macros/deprecated` +- `OPL/Michigan/hhAdditionalMacros.pl` to `PG/macros/deprecated` +- `OPL/Wiley/littleneck.pl` to `PG/macros/deprecated` ### CollegeOfIdaho copied +- `OPL/CollegeOfIdaho/CofIdaho_macros.pl` to `PG/macros/deprecated` - `OPL/CollegeOfIdaho/contextInequalitiesAllowStrings.pl` to `PG/macros/contexts` - `OPL/CollegeOfIdaho/contextFunctionAssign.pl` to `PG/macros/contexts` - `OPL/CollegeOfIdaho/parserUtils.pl` to `PG/macros/parsers` @@ -77,7 +82,7 @@ This directory now has a subdirectory structure for clarification. - `OPL/PCC/contextRestrictedDomains.pl` to `PG/macros/contexts` - `OPL/PCC/PCCfactor.pl` to `PG/macros/math` - `OPL/PCC/PCCgraphMacros.pl` to `PG/macros/graph` -- `OPL/PCC/PCCmacros.pl` to `PG/macros/univ` +- `OPL/PCC/PCCmacros.pl` to `PG/macros/misc` - `OPL/PCC/pccTables.pl` to `PG/macros/ui` - `OPL/PCC/SolveLinearEquationPCC.pl` to `PG/macros/math` - `OPL/PCC/SystemsOfLinearEquationsProblemPCC.pl` to `PG/macros/math` @@ -93,9 +98,6 @@ This directory now has a subdirectory structure for clarification. - `OPL/UniSiegen/logicMacros.pl` (no problems in OPL/Contrib) - `OPL/Alfred/Alfredmacros.pl` (not relevant) - `OPL/BrockPhysics/BrockPhysicsMacros.pl` (not relevant) -- `OPL/Mizzou/MUHelp.pl` to `PG/macros/univ` (not relevant) -- `OPL/WHFreeman/freemanMacros.pl` to `PG/macros/univ` (not relevant) -- `OPL/Michigan/hhAdditionalMacros.pl` to `PG/macros/univ` (not relevant) ### CollegeOfIdaho not moved diff --git a/macros/deprecated/Alfredmacros.pl b/macros/deprecated/Alfredmacros.pl new file mode 100755 index 0000000000..78ce2a9d0f --- /dev/null +++ b/macros/deprecated/Alfredmacros.pl @@ -0,0 +1,376 @@ +# A group of macros used in the Alfred problem library. + +sub _Alfredmacros_init { } #don't reload these macros. + +# Given a point (x,y) this macro computes the angle with respect to x-axis. The angle will be between 0 and 2pi. +sub inversetrig { + my $refangle = arctan(abs($_[1] / $_[0])); + if ($_[0] == 0) {0} + elsif ($_[0] > 0) { + if ($_[1] == 0) {0} + elsif ($_[1] > 0) { $refangle; } + else { 2 * pi- $refangle; } + } else { + if ($_[1] == 0) {pi} + elsif ($_[1] > 0) { pi- $refangle; } + else { pi + $refangle } + } +} + +## Compute the max and min of an array of numbers + +#This macro prevents students from double clicking in an answer box. This macro #is necessary for multiple integral problems where the answer box is typeset +#into the integration symbols. +sub doubleclickprevent { + TEXT(MODES( + TeX => "", + HTML => "" + )); +} + +#The problems that have the answer box in the limits must be displayed in JS +#math mode. This macro warns the user to use JS math mode if they are not. +sub jsMathwarn { + TEXT(MODES( + TeX => '', + HTML_jsMath => '', + HTML => $HR + . "Warning: to use this problem, you need to" + . "select jsMath mode in the Display Options panel at the left" + . $HR, + )); +} + +sub jsmathmode { + TEXT(MODES( + TeX => '', + HTML_jsMath => '', + HTML => $HR + . "Warning: to use this problem, you need to " + . "select jsMath mode in the Display Options panel at the left" + . $HR, + )); + TEXT(MODES( + TeX => "", + HTML => "" + )); + +} + +sub mathjaxmode { + TEXT(MODES( + TeX => '', + HTML_MathJax => '', + HTML => $HR + . "Warning: to use this problem, you need to " + . "select MathJax mode in the Display Options panel at the left" + . $HR, + )); +} + +#This subroutine includes the Strang's textbook into a problem, you have to +#feed it the chapter and section. It is assumed that the book is in the course +#directory and is labeled strangtextbook. The parameters are +#strang(chapter,section,(optional) section title. +#example \{&strang(16,5,"surface integrals")\}. +$wwstrang = "http://webwork.alfred.edu/webwork2_course_files/strangcalculus"; + +sub strang { + htmlLink( + qq!$wwstrang/Strang-$_[0]-$_[1].pdf!, + "$_[0].$_[1] $_[2] from Gilbert Strang's Calculus", + q/TARGET="new_window"/ + ); +} + +#Inserts a link to a trig table in the problem. +#example \{&trig_table()\} +sub trig_table { + htmlLink(qq!$wwstrang/trig_identities.pdf!, "Trig Identities", q/TARGET="new_window"/); +} + +sub strang_index { + htmlLink(qq!$wwstrang/Index.pdf!, "Index", q/TARGET="new_window"/); +} + +sub strang_TOC { + htmlLink(qq!$wwstrang/TOC.pdf!, "Table of Contents", q/TARGET="new_window"/); +} + +sub product_Rule_cmp { + my ($correct, $student, $self) = @_; + my ($f1stu, $f2stu, $f3stu, $f4stu) = @{$student}; + my ($f1, $f2, $f3, $f4) = @{$correct}; + my @fgrade = (0, 0, 0, 0); + my @fstu = ($f1stu, $f2stu, $f3stu, $f4stu); + my @fcorrect = ($f1, $f2, $f3, $f4); +#we will associate each student answer with a prime number, noting which student answer is in which blank. This allows us to make use of the fundamental theorem of arithmetic. + my @prime = (2, 3, 5, 7); + my @answerblank = (0, 0, 0, 0); + + for ($i = 0; $i < 4; $i++) { + for ($j = 0; $j < 4; $j++) { + if (($fcorrect[$i] == $fstu[$j]) && ($answerblank[$j] == 0)) { { + $answerblank[$j] = $prime[$i]; + $j = + 4 # you have to terminate the inner loop in this case for the special case of f=e^x where f and f' are the same. + } } + } + } + for ($i = 0; $i < 4; $i++) { + if (!$answerblank[$i]) { + $self->setMessage($i + 1, + "All of your answers should be $f, $g, or a derivative of one of these functions"); + } + } + #now we rely on the fact that products of primes are unique. First we check to see if all of the blanks are correct + if ((($answerblank[0] * $answerblank[1] == 6) && ($answerblank[2] * $answerblank[3] == 35)) + || (($answerblank[0] * $answerblank[1] == 35) && ($answerblank[2] * $answerblank[3] == 6))) + { + @fgrade = (1, 1, 1, 1); + } + #now check to see if the first pair of blanks is correct, knowing one pair is not + elsif ($answerblank[0] * $answerblank[1] == 6) { + if (($answerblank[2] == 5) || ($answerblank[2] == 7)) { + @fgrade = (1, 1, 1, 0); + } elsif (($answerblank[3] == 5) || ($answerblank[3] == 7)) { + @fgrade = (1, 1, 0, 1); + } else { + @fgrade = (1, 1, 0, 0); + } + } elsif ($answerblank[0] * $answerblank[1] == 35) { + if (($answerblank[2] == 2) || ($answerblank[2] == 3)) { + @fgrade = (1, 1, 1, 0); + } elsif (($answerblank[3] == 2) || ($answerblank[3] == 3)) { + @fgrade = (1, 1, 0, 1); + } else { + @fgrade = (1, 1, 0, 0); + } + } + #if both sets are not correct, and the first set is not correct, check to see if the last pair are + elsif ($answerblank[2] * $answerblank[3] == 6) { + if (($answerblank[0] == 5) || ($answerblank[0] == 7)) { + @fgrade = (1, 0, 1, 1); + } elsif (($answerblank[1] == 5) || ($answerblank[1] == 7)) { + @fgrade = (0, 1, 1, 1); + } else { + @fgrade = (0, 0, 1, 1); + } + } elsif ($answerblank[2] * $answerblank[3] == 35) { + if (($answerblank[0] == 2) || ($answerblank[0] == 3)) { + @fgrade = (1, 0, 1, 1); + } elsif (($answerblank[1] == 2) || ($answerblank[1] == 3)) { + @fgrade = (0, 1, 1, 1); + } else { + @fgrade = (0, 0, 1, 1); + } + } +#at this point they don't have a matched set of blanks correct. look for a single function in each pair that is right. You have to make sure you only get one for each pair of answer blanks. + else { + if (($answerblank[0]) + && ($answerblank[2]) + && ($answerblank[0] * $answerblank[2] != 6) + && ($answerblank[0] * $answerblank[2] != 35) + && ($answerblank[0] != $answerblank[2])) + { + @fgrade = (1, 0, 1, 0); + } elsif (($answerblank[0]) + && ($answerblank[3]) + && ($answerblank[0] * $answerblank[3] != 6) + && ($answerblank[0] * $answerblank[3] != 35) + && ($answerblank[0] != $answerblank[3])) + { + @fgrade = (1, 0, 0, 1); + } elsif (($answerblank[1]) + && ($answerblank[2]) + && ($answerblank[1] * $answerblank[2] != 6) + && ($answerblank[1] * $answerblank[2] != 35) + && ($answerblank[1] != $answerblank[2])) + { + @fgrade = (0, 1, 1, 0); + } elsif (($answerblank[1]) + && ($answerblank[3]) + && ($answerblank[1] * $answerblank[3] != 6) + && ($answerblank[1] * $answerblank[3] != 35) + && ($answerblank[1] != $answerblank[3])) + { + @fgrade = (0, 1, 0, 1); + } elsif ($answerblank[0]) { + @fgrade = (1, 0, 0, 0); + } elsif ($answerblank[1]) { + @fgrade = (0, 1, 0, 0); + } elsif ($answerblank[2]) { + @fgrade = (0, 0, 1, 0); + } elsif ($answerblank[3]) { + @fgrade = (0, 0, 0, 1); + } + } + return [@fgrade]; +} + +sub check_boundary_conditions { + my ($correct, $student, $self) = @_; + return product_Rule_cmp(@_); +} + +sub Snxy() { + my %args = @_; + my @x = @{ $args{inputs} }; + my @y = @{ $args{outputs} }; + my $m = $args{m}; + my $n = $args{n}; + my $i = 0; + my $sum = 0; + if ($#x == $#y) { + for ($i = 0; $i <= $#x; $i++) { + $sum = $sum + ($x[$i])**($n) * ($y[$i])**($m); + } + } else { + $sum = 0; + } + return $sum; +} + +### To use the macros your problem must include unionTables.pl, and of course Alfredmacros.pl +### Table integral returns a string that can be included in a Table to output an integral whose upper and lower limits +### of integration can be answer blanks. There are several optional parameters: +### width - change the width of the answer blanks. defaults to 3. +### lowerwidth - change the width of the lower answer blank. defaults to width +### upperwidth - change the width of the upper answer blank. defaults to width. +### upper - the uppper limit of integration, does not have to be an answer blank, defaults to answer blank with width "width" +### lower - the lower limit of integration, does not have to be an answer blank, defaults to answer blank with width "width" +### limits - boolean, if 1 puts the limits of integration above and below the integral symbol, if 0 puts them after the integral symbol. +### default is 1. +### Your code must include unionTables.pl, and of course Alfredmacros.pl +### An example: +### \{BeginTable(center=>0). +### Row([tableintegral(), +### ],separation=>2). +### EndTable(); +### \} +### which will print an integral with answer blank on the upper and lower limits with the default length of 3 +### +### This example prints out a double integral, the first integral with answer blanks with width 10, the second integral +### has 0 for the lower limit of integration and an answer blank with width 5 for the upper limit of integration. +### The default limits of integratin are answer blanks with width 3, in this case the default width was overridden to 5 +### and the default lower limit was changed to a zero. +### \{BeginTable(center=>0). +### Row([tableintegral(width=>10,limits=>'\(0\)'),tableintegral(width=>5,lower=>'\(0\)',limits=>0), +### ],separation=>2). +### EndTable(); +### \} +### An example where the width of the upper and lower answer blanks have different widths. +### \{BeginTable(center=>0). +### Row([tableintegral(lowerwidth=>10,upperwidth=>1) +### ],separation=>2). +### EndTable(); +### \} + +sub tableintegral { + my %arg = @_; + my $width = delete $arg{width} // 3; + my $lowerwidth = delete $arg{lowerwidth} // $width; + my $upperwidth = delete $arg{upperwidth} // $width; + my $lower = delete $arg{lower} // ans_rule($lowerwidth); + my $upper = delete $arg{upper} // ans_rule($upperwidth); + my $limits = delete $arg{limits} // 1; + if ($limits == 1) { + return $upper . $BR . '\(\displaystyle\int\)' . $BR . $lower; + } else { + return '\(\displaystyle\int\)', $upper . $BR . $BR . $lower; + } +} + +# a sum with answer blanks for the summation variable, lower limit, and upper limit +#\{ BeginTable(center=>0). +# Row([tablesum(width=>10), +# ],separation=>2). +# EndTable(); +#\} +# a sum with answer blanks for the upper and lower limits, and the summation variable is i +#\{ BeginTable(center=>0). +# Row([tablesum(width=>10,sumvariable=>'i'), +# ],separation=>2). +# EndTable(); +#\} +# a sum with answer blanks for the upper and lower limits, and summation variable is not used. +#\{ BeginTable(center=>0). +# Row([tablesum(width=>10,usesumvariable=>0), +# ],separation=>2). +# EndTable(); +#\} +# sum from n = 1 to infinity +#\{ BeginTable(center=>0). +# Row([tablesum(sumvariable=>'\(n\)',lower=>'\(1\)', upper=>'\(\hskip 3pt\infty\)') ],separation=>2). +# EndTable(); +#\} + +sub tablesum { + my %arg = @_; + my $width = delete $arg{width} // 3; + my $lowerwidth = delete $arg{lowerwidth} // $width; + my $upperwidth = delete $arg{upperwidth} // $width; + my $lower = delete $arg{lower} // ans_rule($lowerwidth); + my $upper = delete $arg{upper} // ans_rule($upperwidth); + my $limits = delete $arg{limits} // 1; + my $sumvariable = delete $arg{sumvariable} // ans_rule($width); + my $usesumvariable = delete $arg{usesumvariable} // 1; + + if ($usesumvariable == 0) { + if ($limits == 1) { + return $upper . $BR . '\(\displaystyle\sum\)' . $BR . $lower; + } else { + return '\(\displaystyle\int\)', $upper . $BR . $BR . $lower; + } + } else { + if ($limits == 1) { + return $upper . $BR . '\(\displaystyle\sum\)' . $BR . $sumvariable . '\( = \)' . $lower; + } else { + return '\(\displaystyle\int\)', $upper . $BR . $BR . $sumvariable . '\( = \)' . $lower; + } + } +} + +### Create a vertical bar with an upper and lower limit. +sub tableevaluate { + my %arg = @_; + my $width = delete $arg{width} // 3; + my $lowerwidth = delete $arg{lowerwidth} // $width; + my $upperwidth = delete $arg{upperwidth} // $width; + my $lower = delete $arg{lower} // ans_rule($lowerwidth); + my $upper = delete $arg{upper} // ans_rule($upperwidth); + return '\(\Bigg\vert\)', $upper . $BR . $BR . $lower; +} + +### Create a subscripted character +sub tablesubscript { + my %arg = @_; + my $width = delete $arg{width} // 3; + my $lower = delete $arg{lower} // ans_rule($width); + my $variable = delete $arg{variable} // 'c'; + return $variable, $BR . $BR . $lower; +} + +### Create a superscripted character +sub tablesuperscript { + my %arg = @_; + my $width = delete $arg{width} // 3; + my $upper = delete $arg{upper} // ans_rule($width); + my $variable = delete $arg{variable} // 'c'; + return $variable, $upper . $BR . $BR . $BR; +} + +### A fraction +sub tablefrac { + my %arg = @_; + my $width = delete $arg{width} // 3; + my $lower = delete $arg{lower} // ans_rule($width); + my $upper = delete $arg{upper} // ans_rule($width); + my $barwidth = delete $arg{barwidth} // 10 + $width; + my $divisionbar = ""; + for ($count = 1; $count <= $barwidth; $count++) { + $divisionbar = $divisionbar . "-"; + } + return $upper . $BR . $divisionbar . $BR . $lower; +} + diff --git a/macros/deprecated/BrockPhysicsMacros.pl b/macros/deprecated/BrockPhysicsMacros.pl new file mode 100644 index 0000000000..61c5d1a210 --- /dev/null +++ b/macros/deprecated/BrockPhysicsMacros.pl @@ -0,0 +1 @@ +# this file defines all Brock-Physics-specific macros. diff --git a/macros/deprecated/CofIdaho_macros.pl b/macros/deprecated/CofIdaho_macros.pl new file mode 100755 index 0000000000..351fec2427 --- /dev/null +++ b/macros/deprecated/CofIdaho_macros.pl @@ -0,0 +1,723 @@ + +=pod + +=head1 NAME + + extra macros for Intermediate Algebra problems at The College of Idaho + +=head1 Synposis + macros by R Cruz -- The College of Idaho +=cut + +=head3 Format the instuctor answer + +=pod + +1) SimplifyExponents: Formats an expression without negative exponents + To use: SimplifyExponents(num, den,~~@var,@exp); + where num = numerator's constant + den = denominator's constant + ~~@var = pointer to an array with the list of variables + @exp = array with the exponents for the variables + +2) num_and_unit_checker: Checks for units like "apples" or "oranges" + To use: ANS (num_and_units_checker($correct_answer, "units"); + +3) strict_percent_cmp: Checks percentages have been rounded as required. + To use: ANS(strict_percent_cmp($answer,"%",roundto)); + where $answer is in percent form: xx.x + roundto = "tenths" or "hundredths" + +4) Picky_equation_cmp: Checks both sides of an equation model the word problem. + To use: Picky_equation_cmp("2x+1=5"); + Note: This one allows only the variables that have been used in the CofIdaho + problems. It should be changed so that it is more flexible, or better, + convert it to a MathObject. + +5) SlopeIntercept_equation_cmp: Checks both sides of an equation for the + slope-intercept form of a line. + To use: ANS(SlopeIntercept_equation_cmp($answer)); + where $answer = "y = $m x + $b"; (Use only y and x for variables.) + +6) functionNotation_cmp: Checks for "f(x)= ***" notation + To use: + ANS(functionNotation_cmp("f(x)=2x",["x","f"])); + +7) Checks factors of polynomials. + To use: The answer must be submitted in this form: + ANS(FactorEvaluator($answer,[variable array])); + If the polynomial is prime: + ANS(FactorEvaluator("Does not factor",polynomial,[variable array])); + + Note: Answers must be in the form: monomial(poly)...(poly) with + or without parentheses about the monomial. The polynomial factors must + not contain any other grouping symbols and, in any case, only parenthesis + may be used. This needs to be in the instructions for any set that uses + this macro (in the screenHeader.pg file). + + Note: "StrictFactoringEvaluator" requires leading negatives to be factored out. + This not may not work with all situations. BE SURE TO CHANGE THIS FILE IF THE + FactoringEvaluator IS CHANGED!! + +8) RationalExpEvaluator: Checks for simplified rational expressions. + To use: ANS(RationalExpEvaluation($answer,[variable array])); + or something like: ANS(RationalExpEvaluator($answer,["x","y"])); + + Note: Answers must be of the form: (poly)/(poly) + +9) ReduceFraction: Returns a string that represents a reduced fraction. + To use: $a = SimplifyFraction(numerator expression,denominator espression); +=cut + +################################################################### +# 1) Formats an expression without negative exponents +# Thanks to John Jones at ASU for this macro. + +sub SimplifyExponents { + loadMacros("contextLimitedPowers.pl"); + my $num = shift; + my $den = shift; + my $varref = shift; + my @expos = @_; + my @vars = @$varref; + + Context()->operators->set(@LimitedPowers::OnlyPositiveIntegers); + + my $answer_n = Formula("$num"); + my $answer_d = Formula("$den"); + + for $j (0 .. (scalar(@vars) - 1)) { + $answer_n *= Formula("$vars[$j]^$expos[$j] ") if ($expos[$j] > 0); + $answer_d *= Formula("$vars[$j]^(-1*$expos[$j]) ") if ($expos[$j] < 0); + } + + $answer = $answer_n / $answer_d; + + return ($answer->reduce()); +} + +sub Simplified { + my ($correct, $student, $ah) = @_; + return unless $ah->{score} == 1; #This does not work??? + my $VariablesPlus1 = 2; #Put in the number of variables plus 1 + my $check = $ah->{student_ans}; + if (!($ah->{isPreview}) + && $correct == $student + && $check =~ /(([abxy].*){$VariablesPlus1,})|([\Q^].*[\Q^])/) + { + $ah->{ans_message} = "Simplify your answer"; + } + + return ($correct == $student && ($ah->{student_ans} !~ /(([abxy].*){$VariablesPlus1,})|([\Q^].*[\Q^])/)); +} + +################################################################### +# 2) Checks for units + +sub num_and_unit_checker { + my $correct_ans = shift; #the answer + my $correct_units = shift; #the unit type + my $old_evaluator = num_cmp($correct_ans); + + my $new_evaluator = sub { + my $student_ans = shift; + my $formatted_ans = $student_ans; + $formatted_ans =~ s{$correct_units}{}; + my $ans_hash = $old_evaluator->evaluate($formatted_ans); + if ($student_ans !~ /$correct_units/) { + $ans_hash->{score} = 0; + $ans_hash->setKeys('ans_message' => "Enter your answer with the correct units: $correct_units"); + } + $ans_hash->{original_student_ans} = "$student_ans"; + $ans_hash->{preview_latex_string} = "$student_ans"; + $ans_hash->{student_ans} = "$student_ans"; + $ans_hash->{correct_ans} = "$correct_ans" . " $correct_units"; + + return $ans_hash; + }; + + return $new_evaluator; +} + +################################################################### +# 3) Checks for rounded percents + +sub strict_percent_cmp { + my $correct_ans = shift; #the answer + my $correct_units = shift; #the unit type which should be "%" + my $error = shift; #what to round to + my $errorAmount = .1; + if ($error eq "hundredth") { $errorAmount = .01; } + my $old_evaluator = num_cmp($correct_ans, tol => 0); + + my $new_evaluator = sub { + my $student_ans = shift; + my $formatted_ans = $student_ans; + $formatted_ans =~ s{$correct_units}{}; + my $ans_hash = $old_evaluator->evaluate($formatted_ans); + if ($student_ans !~ /$correct_units/) { + $ans_hash->{score} = 0; + $ans_hash->setKeys('ans_message' => "Enter your answer with the correct units: $correct_units"); + } else { + if ($ans_hash->{score} == 0 + && abs($formatted_ans - $correct_ans) < $errorAmount) + { + $ans_hash->setKeys('ans_message' => "Round your answer to the nearest $error."); + } + } + $ans_hash->{original_student_ans} = "$student_ans"; + $ans_hash->{preview_latex_string} = "$student_ans"; + $ans_hash->{student_ans} = "$student_ans"; + $ans_hash->{correct_ans} = "$correct_ans" . " $correct_units"; + + return $ans_hash; + }; + + return $new_evaluator; +} + +################################################################### +# 4) Checks both sides of an equation model the word problem. + +sub Picky_equation_cmp { + + loadMacros("unionUtils.pl", "answerUtils.pl", "listAnswer.pl", "extraAnswerEvaluators.pl"); + + my $ans = shift; + + my $new_evaluator = sub { + my $student = shift; + + $ans =~ tr/[=]/,/; + $student =~ tr/[=]/,/; + + my $old_evaluator = fun_list_cmp($ans, + vars => [ 'a', 'b', 'c', 'd', 'h', 'l', 'n', 'v', 'w', 'x', 'y', 's', 't', 'A', 'L', 'R', 'C', 'P' ]); + my $ans_hash_old = $old_evaluator->evaluate($student); + + $ans =~ tr/,/=/; + $student =~ tr/,/=/; + $ans_hash_old->{correct_ans} = "$ans"; + $ans_hash_old->{original_student_ans} = "$student"; + $ans_hash_old->{student_ans} = "$student"; + $ans_hash_old->{preview_latex_string} = "$student"; + if ($ans_hash_old->{score} != 1) { + $ans_hash_old->{score} = 0; + # $ans_hash_old->setKeys( 'ans_message' =>"Your equation must model the problem."); + $ans_hash_old->setKeys('ans_message' => "At least one side is incorrect."); + } + if ($student !~ /[=]/) { + if ($ans =~ /[RCP]/) { + @side = split(/[=]/, $ans); + $ans_hash_old->setKeys('ans_message' => "Enter your answer in the form: $side[0] = expression."); + } else { + $ans_hash_old->setKeys('ans_message' => "You must enter an equation."); + } + } + + return $ans_hash_old; + }; + return $new_evaluator; +} + +################################################################### +# 5) Checks both sides of an equation for the slope-intercept form of a line. + +sub SlopeIntercept_equation_cmp { + + loadMacros("unionUtils.pl", "answerUtils.pl", "contextLimitedPolynomial.pl"); + + my $ans = shift; + my $formatAns = $ans; + $formatAns =~ tr/ //; + my @correctSides = split(/[=]/, $formatAns); + + my $new_evaluator = sub { + my $left_evaluator = fun_cmp($correctSides[0], vars => [ 'x', 'y' ]); + my $right_evaluator = fun_cmp($correctSides[1], vars => [ 'x', 'y' ]); + + my $student = shift; + my $formatStudent = $student; + $formatStudent =~ tr/ //; + if ($student !~ /[=]/) { + my $ans_hash = $right_evaluator->evaluate($formatStudent); + $ans_hash->{correct_ans} = "$ans"; + $ans_hash->{original_student_ans} = "$student"; + $ans_hash->{student_ans} = "$student"; + $ans_hash->{preview_latex_string} = "$student"; + $ans_hash->setKeys('ans_message' => "You must enter an equation."); + $ans_hash->{score} = 0; + return $ans_hash; + } else { + my @studentSides = split(/[=]/, $formatStudent); + + my $left_ans_hash = $left_evaluator->evaluate($studentSides[0]); + my $right_ans_hash = $right_evaluator->evaluate($studentSides[1]); + + $left_ans_hash->{correct_ans} = "$ans"; + $left_ans_hash->{original_student_ans} = "$student"; + $left_ans_hash->{student_ans} = "$student"; + $left_ans_hash->{preview_latex_string} = "$student"; + + if ($right_ans_hash->{score} == 0) { $left_ans_hash->{score} = 0; } + + my $perlNumber = "[0-9]+[\.\/]?[0-9]*|\.[0-9]+"; + my $BadForm = + ($studentSides[0] =~ /\w.*\w/ + || $studentSides[1] =~ /[a-zA-Z].*[a-zA-Z]/ + || $studentSides[1] =~ /($perlNumber)[+-]+($perlNumber[a-zA-Z][+-])?($perlNumber)/); + if ($BadForm) { + $left_ans_hash->setKeys( + 'ans_message' => "Enter your answer in the form: $BR y = mx+b, y = b or x = c"); + $left_ans_hash->{score} = 0; + } + + return $left_ans_hash; + } + }; + return $new_evaluator; +} + +################################################################### +# 6) Checks for function notation in an equality. + +sub functionNotation_cmp { + + loadMacros("unionUtils.pl", "answerUtils.pl"); + + my $ans = shift; + my @variables = @_; + + my $formatAns = $ans; + $formatAns =~ tr/ //; + my @correctSides = split(/[=]/, $formatAns); + + my $new_evaluator = sub { + # my $notation_evaluator = fun_cmp($correctSides[0],vars=>@variables); + my $notation_evaluator = ordered_cs_str_cmp($correctSides[0]); + my $notation2_evaluator = unordered_str_cmp($correctSides[0]); + my $formula_evaluator = fun_cmp($correctSides[1], vars => @variables, tol => .001); + + my $student = shift; + my $formatStudent = $student; + $formatStudent =~ tr/ //; + + if ($student !~ /[=]/ || $student !~ /(\w\s*\(\s*\w\s*\))/) { + my $ans_hash = $formula_evaluator->evaluate($formatStudent); + $ans_hash->{correct_ans} = "$ans"; + $ans_hash->{original_student_ans} = "$student"; + $ans_hash->{student_ans} = "$student"; + $ans_hash->{preview_latex_string} = "$student"; + $ans_hash->setKeys('ans_message' => "Your answer must be in function notation."); + return $ans_hash; + } else { + my @studentSides = split(/[=]/, $formatStudent); + + my $notation_ans_hash = $notation_evaluator->evaluate($studentSides[0]); + my $notation2_ans_hash = $notation2_evaluator->evaluate($studentSides[0]); + my $formula_ans_hash = $formula_evaluator->evaluate($studentSides[1]); + + $formula_ans_hash->{correct_ans} = "$ans"; + $formula_ans_hash->{original_student_ans} = "$student"; + $formula_ans_hash->{student_ans} = "$student"; + $formula_ans_hash->{preview_latex_string} = "$student"; + + if ($notation_ans_hash->{score} != 1) { + $formula_ans_hash->{ans_message} = $notation_ans_hash->{ans_message}; + if ($notation2_ans_hash->{score} == 1) { + $formula_ans_hash->setKeys( + 'ans_message' => "Your answer must be in correct function notation."); + } + $formula_ans_hash->{score} = 0; + } + + return $formula_ans_hash; + } + }; + return $new_evaluator; +} + +################################################################### +# 7) Checks factors of polynomials. +# Note: Student's answers must be of the form: monomial(poly)...(poly) with +# or without parentheses about the monomial. The polynomial factors must +# not contain any other grouping symbols and, in any case, only parenthesis +# may be used. This needs to be in the instructions for any set that uses +# this macro (in the screenHeader.pg file). +# Note: "StrictFactoringEvaluator" requires leading negatives to be factored out. +# This not may not work with all situations. BE SURE TO CHANGE THIS FILE IF THE +# FactoringEvaluator IS CHANGED!! +#---------For diagnosing problems-------------------------------------- +# $ans_hash->setKeys( 'ans_message' =>"FYI: Not checking correctly. +# AnswerHashScore: $ans_hash->{score} : +# Student: $#student_factors, $student_ans, +# Formatted: $format_student_ans, +# Student Factors: $student_factors[0], $student_factors[1], +# : Correct: $#factors, $factors[0], $factors[1], +# Number matched: $CorrectFactors"); +#---------------------------------------------------------------------- + +sub FactoringEvaluator { + + Context()->strings->add("Does not factor" => ()); + + my $ans = shift; + my $ans_text = $ans; #For string answers like "Does not factor" + if ($ans =~ /factor/) { + $ans = shift; + } + my @vars = @_; + + my $format_ans = $ans; + $format_ans =~ s/\*/ /g; #Remove any astrix + $format_ans =~ s/[\(]/,\(/g; #Put in the delimiter , + if ($format_ans =~ /^,/) { $format_ans =~ s/,//; } #Remove any leading comma + my @factors = split(/[,]/, $format_ans); #Split off the terms + for $k (0 .. $#factors) { $factors[$k] = Formula($factors[$k])->reduce; } + $ans = Formula($ans)->reduce; + + my $old_evaluator = fun_cmp($ans, var => @vars); + + my $new_evaluator = sub { + local ($factor_eval, $negfactor_eval, $factor_hash, $negfactor_hash); + + my $student_ans = shift; + + #---------For string answers---------------------------------------------- + if ($student_ans =~ /factor/) { + my $old_eval_string = str_cmp($ans_text); + my $ans_hash = $old_eval_string->evaluate($student_ans); + $ans_hash->{correct_ans} = $ans_text; #For better display (no caps) + $ans_hash->{student_ans} = $student_ans; + $ans_hash->{original_student_ans} = $student_ans; + return $ans_hash; + } + #--------------------------------------------------------------------------- + + my $ans_hash = $old_evaluator->evaluate($student_ans); + + #----------The only parentheses are allowed for grouping symbols------------ + #----------and only the minimum set needed to enter the answer correctly.--- + if ($student_ans =~ /[\{\}\[\]]/) { + $ans_hash->{student_ans} = $student_ans; + $ans_hash->{original_student_ans} = $student_ans; + $ans_hash->{score} = 0; + $ans_hash->setKeys('ans_message' => "You may only use parentheses in your answer."); + return $ans_hash; + } + if ($student_ans =~ /[\(][^\)]*[\(]/) { + $ans_hash->{student_ans} = $student_ans; + $ans_hash->{original_student_ans} = $student_ans; + $ans_hash->{score} = 0; + $ans_hash->setKeys('ans_message' => "Your answer has extraneous grouping symbols."); + return $ans_hash; + } + + #-----------Check the factors--------------------------------------------- + + if ($ans_hash->{score} == 1) { + my $format_student_ans = $student_ans; + $format_student_ans =~ s/[\*]/ /g; #Remove any astrix + $format_student_ans =~ s/[\(]/,\(/g; #Put in the delimiter , + if ($format_student_ans =~ /^,/) { $format_student_ans =~ s/,//; } #Remove leading commas + my @student_factors = split(/[,]/, $format_student_ans); #Split off the terms + for $k (0 .. $#student_factors) { $student_factors[$k] = Formula($student_factors[$k]); } + + #########Could this be done with a list?--would have to change the list's error msg. + + my $CorrectFactors = 0; + + foreach $i (0 .. $#factors) { + $factor_eval = fun_cmp($factors[$i], var => @vars); + $negfactor_eval = fun_cmp(-1 * ($factors[$i]), var => @vars); + foreach $j (0 .. $#student_factors) { + $factor_hash = $factor_eval->evaluate($student_factors[$j]); + $negfactor_hash = $negfactor_eval->evaluate($student_factors[$j]); + if ($factor_hash->{score} == 1 || $negfactor_hash->{score} == 1) { + $CorrectFactors = $CorrectFactors + 1; + + #---------This segment is for binomial factors raised to powers---------------- + # Example: (3x+1)^2 is correct, and (9x^2+6x+1) should not be accepted + # SHOULD MAKE THIS MORE GENERAL: TAKE OTHER EXPONENTS BESIDES INTEGERS, + # THE PATTERN SHOULD BE BETTER DEFINED. + #------------------------------------------------------------------------------ + $factor_string = $factors[$i]->string; + $st_factor_string = $student_factors[$j]->string; + if ($factor_string =~ /\(.*[+-]{1}.*\)\^\d+$/ + && $st_factor_string !~ /\(.*[+-]{1}.*\)\^\d+$/) + { + $ans_hash->{score} = 0; + $ans_hash->setKeys('ans_message' => "Factor the expression completely."); + } + #------------------------------------------------------------------------------- + } + } + } + + if ($CorrectFactors != $#factors + 1) { + $ans_hash->{score} = 0; + $ans_hash->setKeys( + 'ans_message' => "Check that your answer is factored + completely and is entered in the + required format." + ); + } + } + + if ($ans_text =~ /factor/) { $ans_hash->{correct_ans} = $ans_text; } #In case the answer is a string + + return $ans_hash; + }; #END of SUB + + Context()->strings->remove("Does not factor" => ()); + return $new_evaluator; +} + +sub StrictFactoringEvaluator { + + my $ans = shift; + my @vars = @_; + + my $format_ans = $ans; + $format_ans =~ s/[\*]//g; #Remove any astrix + $format_ans =~ s/[\(]/,\(/g; #Put in the delimiter , + if ($format_ans =~ /^,/) { $format_ans =~ s/,//; } #Remove any leading commas + my @factors = split(/[,]/, $format_ans); #Split off the terms + for $k (0 .. $#factors) { $factors[$k] = Formula($factors[$k]); } + $ans = Formula($ans)->reduce; + + my $old_evaluator = fun_cmp($ans, var => @vars); + + my $new_evaluator = sub { + local ($factor_eval, $factor_hash); + + my $student_ans = shift; + + #----This could be changed so that it would check prime polyomials here instead + #----of in the problem template. + if ($student_ans =~ /factor/) { + my $string_ans = $ans->string; + my $old_eval_string = std_cs_str_cmp($string_ans); + my $ans_hash = $old_eval_string->evaluate($student_ans); + return $ans_hash; + } + #------------------------------------------------------ + + my $ans_hash = $old_evaluator->evaluate($student_ans); + + if ($ans_hash->{score} == 1) { #Check factors + my $format_student_ans = $student_ans; + $format_student_ans =~ s/[\*]//g; #Remove any astrix + $format_student_ans =~ s/[\(]/,\(/g; #Put in the delimiter , + if ($format_student_ans =~ /^,/) { $format_student_ans =~ s/,//; } #Remove any leading commas + my @student_factors = split(/[,]/, $format_student_ans); #Split off the terms + for $k (0 .. $#student_factors) { $student_factors[$k] = Formula($student_factors[$k]); } + + #########Could this be done with a list?--would have to change the list's error msg. + + my $CorrectFactors = 0; + + foreach $i (0 .. $#factors) { + $factor_eval = fun_cmp($factors[$i], var => @vars); + foreach $j (0 .. $#student_factors) { + $factor_hash = $factor_eval->evaluate($student_factors[$j]); + if ($factor_hash->{score} == 1) { + $CorrectFactors = $CorrectFactors + 1; + } + } + } + + if ($CorrectFactors != $#factors + 1) { + $ans_hash->{score} = 0; + $ans_hash->setKeys('ans_message' => + "Check that your answer is factored completely and is entered in the required format."); + } + } + return $ans_hash; + }; + return $new_evaluator; +} + +################################################################### +# 8) Checks for simplified rational expressions. +# Note: Student's answers must be of the form: (poly)/(poly) +# +#---------For diagnosing problems-------------------------------------- +# $ans_hash->setKeys( 'ans_message' =>"FYI: Not checking correctly. +# Student: $student_num, $student_den,$student_ans; +# Answer: $num,$den,$ans"); +#---------------------------------------------------------------------- + +sub RationalExpEvaluator { + + Context()->strings->add("Does not simplify" => ()); + + my $ans = shift; + my $ans_text = $ans; #Mainly for string answers like "Does not simplify" + if ($ans =~ /not/) { + $ans = shift; + } + my @vars = @_; + + #---------Split off the numerator/denominator + my @factors = split(q[/], $ans); + my $num = Formula($factors[0]); + my $den = ($#factors > 0) ? Formula($factors[1]) : Formula("1"); + + my $old_evaluator = fun_cmp($ans, var => @vars); + + my $new_evaluator = sub { + my $student_ans = shift; + my $student_ans_text = $student_ans; + + #---------For string answers---------------------------------------------- + if ($student_ans_text =~ /not/) { + my $old_eval_string = str_cmp($ans_text); + my $ans_hash = $old_eval_string->evaluate($student_ans_text); + $ans_hash->{correct_ans} = $ans_text; + $ans_hash->{student_ans} = $student_ans_text; + $ans_hash->{original_student_ans} = $student_ans_text; + return $ans_hash; + } + #------------------------------------------------------------------------- + + my $ans_hash = $old_evaluator->evaluate($student_ans); + + if ($ans_hash->{score} == 1) { + #--------Check for a scalar answer in case and the student entered a decimal + if ($student_ans !~ /[a-zA-Z]/ && $ans !~ /[a-zA-Z]/) { + $ans_hash->{correct_ans} = $ans_text; + $ans_hash->{student_ans} = $student_ans_text; + $ans_hash->{original_student_ans} = $ans_hash->{student_ans}; + return $ans_hash; + } + #-------------------------------------------------------------------- + + #--------Split off the numerator/denominator------------------------- + my $student_ans_mo = Formula($student_ans_text); + my ($student_num, $student_den); + my @student_factors; + + # use MO parse tree rather than regex split because of surrounding parens from mathquill + if ($student_ans_mo->{tree}->class eq 'BOP' && $student_ans_mo->{tree}{bop} =~ m!/!) { + $student_num = $student_ans_mo->{tree}{lop}; + $student_den = $student_ans_mo->{tree}{rop}; + @student_factors = ($student_num->string, $student_den->string); + } else { + $student_num = $student_ans_mo; + $student_den = Formula('1'); + @student_factors = ($student_num->string); + } + #-------------------------------------------------------------------- + + if ($#factors != $#student_factors) { + $ans_hash->{score} = 0; + } else { + my $num_eval = fun_cmp($num, var => @vars); + my $num_hash = $num_eval->evaluate($student_num); + $ans_hash->{score} = $num_hash->{score}; + + if ($#factors > 0) { + my $den_eval = fun_cmp($den, var => @vars); + my $den_hash = $den_eval->evaluate($student_den); + $ans_hash->{score} = $den_hash->{score}; + } + } + + $ans_hash->{ans_message} = "Simplify your answer." if ($ans_hash->{score} == 0); + } + + return $ans_hash; + }; + + Context()->strings->remove("Does not simplify" => ()); + return $new_evaluator; +} + +################################################################### +# 9) Writes a fraction in reduced form. +# + +sub ReduceFraction { + my $num = shift; + my $den = shift; + my $n = 1; + my $d = 1; + + ($n, $d) = reduce($num, $den); + my $result = "$n/$d"; + if ($d == 1) { $result = "$n"; } + + return ($result); +} + +################################################################### +# 10) Checks a list of equations. +# Designed for checking a list of asymptotes + +sub equation_cmp_list { + + loadMacros("extraAnswerEvaluators.pl"); + + my $ans = shift; + my @vars = @_; + + my $format_ans = $ans; + $format_ans =~ tr/ //; #Remove any whitespace + my @ans_list = split(/[,]/, $format_ans); #Split off the terms + + # + # my $old_evaluator2 = str_cmp($ans_list[1]); + # Would like to change this to an equation evaluator later + # my $old_evaluator1 = equation_cmp($ans[0],vars=>@vars); + # my $old_evaluator2 = equation_cmp($ans[1],vars=>@vars); + + my $new_evaluator = sub { + + local ($eq_eval, $ans_hash); + + my $student_ans = shift; + chomp $student_ans; + my $format_st = $student_ans; + $format_st =~ tr/ //; #Remove any whitespace + + my @student_list = split(/,/, $format_st); + + my $Correct = -1; + foreach $i (0 .. $#ans_list) #Count the number of matches between the lists + { + my $eq_eval = str_cmp($ans_list[$i]); + foreach $j (0 .. $#student_list) { + $ans_hash = $eq_eval->evaluate($student_list[$j]); + if ($ans_hash->{score} == 1) { $Correct = $Correct + 1; } + } + } + my $Duplicates = -1; + foreach $i (0 .. $#student_list) #Check for duplicates in the student's list + { + my $eq_eval = str_cmp($student_list[$i]); + foreach $j (0 .. $#student_list) { + $ans_hash = $eq_eval->evaluate($student_list[$j]); + if ($ans_hash->{score} == 1) { $Duplicates = $Duplicates + 1; } + } + } + if ($Correct != $#ans_list || $Duplicates != $#student_list) { + $ans_hash->{score} = 0; + if ($Duplicates != $#student_list) { + $ans_hash->setKeys('ans_message' => "You have listed an asymptote more than once."); + } + } else { + $ans_hash->{score} = 1; + } + $ans_hash->{correct_ans} = $ans; + $ans_hash->{student_ans} = $student_ans; + $ans_hash->{original_student_ans} = $ans_hash->{student_ans}; + # $ans_hash->{type} = '', + $ans_hash->{preview_text_string} = $student_ans; + $ans_hash->{preview_latex_string} = $student_ans; + return $ans_hash; + }; + return $new_evaluator; +} + +1; diff --git a/macros/deprecated/Dartmouthmacros.pl b/macros/deprecated/Dartmouthmacros.pl new file mode 100755 index 0000000000..09678528b2 --- /dev/null +++ b/macros/deprecated/Dartmouthmacros.pl @@ -0,0 +1,304 @@ +#!/usr/bin/perl + +# this is equivalent to use strict, but can be used within the Safe compartment. +BEGIN { + be_strict; +} + +## Some local macros + +sub trs_mod { + my @inputs = @_; + my $a = $inputs[0]; + my $b = $inputs[1]; + my $zero = 1e-12; + if ($b < 0) { $b = -$b; } + +## Want mod(a,b) but perl and int are flawed + my $modvalue = $a; + # if ($a >= 0 && $a < $b) {$modvalue = $a;} + + while ($modvalue >= $b) { $modvalue = $modvalue - $b; } + while ($modvalue < 0) { $modvalue = $modvalue + $b; } + if (abs($modvalue) <= $zero) { $modvalue = 0; } + if (abs($modvalue - $b) <= $zero) { $modvalue = 0; } +## Fudge for roundoff error + return $modvalue; +} + +## Compute the product of a scalar and a vector (scalar first) +sub scalar_mult_vector { + ## Put the parameters passed into an array of values + my @vector = @_; + + ## Split off the first entry as the scalar, and the rest as the vector + my $scalar = $vector[0]; + my @vectorb = @vector[ (1 .. $#vector) ]; + + ## Initialize scalar multiple as empty vector + my @scalar_multiple = (); + + my $i; + for ($i = 0; $i <= $#vectorb; $i++) { + $scalar_multiple[$i] = $scalar * $vectorb[$i]; + } + return @scalar_multiple; +} + +## Compute the sum of two vectors +## Perl doesn't seem to have builtin array arithmetic +sub vector_sum { + ## Put the parameters passed into an array of values + my @vector = @_; + ## $#vector is the number of elements in vector minus 1 + my $halflength = ($#vector - 1) / 2; + ## Slice the input into two equal length vectors + my @vectora = @vector[ (0 .. $halflength) ]; + my @vectorb = @vector[ ($halflength + 1 .. $#vector) ]; + + ## Initialize vector sum to empty array + my @vector_sum = (); + + my $i; + for ($i = 0; $i <= $#vectora; $i++) { + $vector_sum[$i] = $vectora[$i] + $vectorb[$i]; + } + return @vector_sum; +} + +## Compute the difference of two vectors +sub vector_diff { + ## Put the parameters passed into an array of values + my @vector = @_; + ## $#vector is the number of elements in vector minus 1 + my $halflength = ($#vector - 1) / 2; + ## Slice the input into two equal length vectors + my @vectora = @vector[ (0 .. $halflength) ]; + my @vectorb = @vector[ ($halflength + 1 .. $#vector) ]; + + return vector_sum(@vectora, scalar_mult_vector(-1, @vectorb)); +} + +## Compute the length of a vector +sub vec_length { + ## Put the paramaters passed into an array of values + my @vector = @_; + + ## Initialize maximum value to first element + my $vector_length = 0; + + my $i; + for ($i = 0; $i <= $#vector; $i++) { + $vector_length = $vector_length + $vector[$i] * $vector[$i]; + } + $vector_length = sqrt($vector_length); + return $vector_length; +} + +sub vector_length { + my @vector = @_; + return vec_length(@vector); +} + +## Computes the dot product of two vectors (assumed of the same dimension) +sub dot_product { + ## Put the parameters passed into an array of values + my @vector = @_; + ## $#vector is the number of elements in vector minus 1 + my $halflength = ($#vector - 1) / 2; + ## Split the input into two equal length vectors + my @vectora = @vector[ (0 .. $halflength) ]; + my @vectorb = @vector[ ($halflength + 1 .. $#vector) ]; + + ## Initialize dot product to zero + my $dot = 0; + + my $i; + for ($i = 0; $i <= $#vectora; $i++) { + $dot = $dot + $vectora[$i] * $vectorb[$i]; + } + return $dot; +} + +sub cross_product { + ## Put the parameters passed into an array of values + my @vector = @_; + + ## Slice the input into two equal length vectors + my @vectora = @vector[ (0 .. 2) ]; + my @vectorb = @vector[ (3 .. 5) ]; + + ## Initialize dot product to zero + my @cross = (); + + $cross[0] = $vectora[1] * $vectorb[2] - $vectora[2] * $vectorb[1]; + $cross[1] = $vectora[2] * $vectorb[0] - $vectora[0] * $vectorb[2]; + $cross[2] = $vectora[0] * $vectorb[1] - $vectora[1] * $vectorb[0]; + return @cross; +} + +## Compute the maximum value in a list +#sub max { +# ## Put the paramters passed into an array of values +# my @values = @_; +# +# ## Initialize maximum value to first element +# my $max = $values[0]; +# +# my $i; +# for ($i=1; $i <= $#values; $i++) +# { +# if ($values[$i] > $max) { +# $max = $values[$i]; +# } +# } +# return $max; +#} + +## Compute the minimum value in a list +#sub min { +# ## Put the paramters passed into an array of values +# my @values = @_; +# +# ## Initialize minimum value to first element +# my $min = $values[0]; +# +# my $i; +# for ($i=1; $i <= $#values; $i++) +# { +# if ($values[$i] < $min) { +# $min = $values[$i]; +# } +# } +# return $min +#} + +## clean_scalar_string is invoked to make expressions like "$a x" look +## better when $a = 0, -1, 1 +## Usage: clean_scalar_string(scalar, "quoted string"); +## Example: clean_scalar_string(-1,"\pi") returns "-\pi" +sub clean_scalar_string { + my $local_scalar = shift; + my $local_fixed_object = shift; + my $return_object; + + if ($local_scalar == 0) { $return_object = "0"; } + elsif ($local_scalar == 1) { $return_object = "$local_fixed_object"; } + elsif ($local_scalar == -1) { $return_object = "-$local_fixed_object"; } + else { $return_object = "${local_scalar}${local_fixed_object}"; } + return $return_object; +} + +## Computes the greatest common divisor of two integers +## Example: gcd(-300, 125) returns 25 +sub trs_gcd { + my $a = shift; + my $b = shift; + my $c; + my $abs_a = abs($a); + my $abs_b = abs($b); + if ($abs_b == 0) { return $abs_a; } + else { + $c = $abs_a % $abs_b; + return trs_gcd($abs_b, $c); + } +} + +## reduced_fraction takes a pair of integers $numerator, $denominator +## ($denominator != 0) and returns an array of two elements @fraction +## $fraction[0] is the reduced numerator; $fraction[1] the reduced +## denominator +## Puts the sign of the fraction, if negative, in the numerator +## +## Usage: @fraction = reduced_fraction($numerator, $denominator) +## +sub reduced_fraction { + my $local_numerator = shift; + my $local_denominator = shift; + my $sign_of_num = 1; + my $sign_of_denom = 1; + my $sign_of_quotient; + my @local_fraction = (); + + if ($local_numerator < 0) { $sign_of_num = -1; } + if ($local_denominator < 0) { $sign_of_denom = -1; } + $sign_of_quotient = $sign_of_num * $sign_of_denom; + + my $local_gcd = trs_gcd($local_numerator, $local_denominator); +## reduced numerator + $local_fraction[0] = ($sign_of_quotient * abs($local_numerator)) / $local_gcd; +## reduced denominator + $local_fraction[1] = abs($local_denominator) / $local_gcd; + return @local_fraction; +} + +## Given Cartesian coordinates x and y returns an +## array the zeroth element which is the radius +## and the first element which is the argument +## 0 <= theta < 2*pi +## +## Returns r=0 theta=0 for the origin +## +sub coordinates_polar { + my $x = shift; + my $y = shift; + my @polar = (); + my $radius = 0; + my $theta = 0; + my $pi = acos(-1); + + $radius = sqrt($x**2 + $y**2); + if ($radius != 0) { + if ($x == 0) { + if ($y > 0) { $theta = $pi / 2; } + else { $theta = 3 * $pi / 2; } + } else { + if ($y > 0) { + if ($x > 0) { $theta = atan($y / $x); } + else { $theta = $pi - atan(-$y / $x); } + } else { + if ($x > 0) { $theta = 2 * $pi + atan($y / $x); } + else { $theta = $pi + atan($y / $x); } + } + } + } + @polar = ($radius, $theta); + return @polar; +} + +## Cylindarical coordinates from polar routine +sub coordinates_cylindrical { + my $x = shift; + my $y = shift; + my $z = shift; + my @cylindrical = (coordinates_polar($x, $y), $z); + return @cylindrical; +} + +## Spherical Coordinates from polar routine +## +sub coordinates_spherical { + my $x = shift; + my $y = shift; + my $z = shift; + my $rho = 0; + my $phi = 0; + $rho = sqrt($x * $x + $y * $y + $z * $z); + my @npolar = (); + @npolar = coordinates_polar($x, $y); + my @spherical = (); + + if ($x == 0 && $y == 0) { + if ($z >= 0) { $phi = 0; } + else { $phi = acos(-1); } + @spherical = ($rho, 0, $phi); + } else { + $rho = sqrt($x * $x + $y * $y + $z * $z); + + @spherical = ($rho, $npolar[1], acos($z / $rho)); + } + return @spherical; +} + +1; + diff --git a/macros/deprecated/MUHelp.pl b/macros/deprecated/MUHelp.pl new file mode 100644 index 0000000000..20d8faef9a --- /dev/null +++ b/macros/deprecated/MUHelp.pl @@ -0,0 +1,49 @@ +sub BBRED { + MODES(TeX => '{\\color{red} ', HTML => ''); +} + +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); +} From d2c01453e93c38fb4559649f2e3e812120912f53 Mon Sep 17 00:00:00 2001 From: Peter Staab Date: Wed, 30 Nov 2022 05:54:18 -0500 Subject: [PATCH 9/9] update PGbasicmacros.pl --- macros/PGbasicmacros.pl | 3227 ---------------------------------- macros/core/PGbasicmacros.pl | 6 +- 2 files changed, 3 insertions(+), 3230 deletions(-) delete mode 100644 macros/PGbasicmacros.pl diff --git a/macros/PGbasicmacros.pl b/macros/PGbasicmacros.pl deleted file mode 100644 index 49b7d77a84..0000000000 --- a/macros/PGbasicmacros.pl +++ /dev/null @@ -1,3227 +0,0 @@ -################################################################################ -# WeBWorK Online Homework Delivery System -# Copyright © 2000-2022 The WeBWorK Project, https://github.com/openwebwork -# -# 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 - - PGbasicmacros.pl --- located in the courseScripts directory - -=head1 SYNPOSIS - -=head1 DESCRIPTION - -=cut - -#####sub _PGbasicmacros_init { } -### In this file the _init subroutine is defined further down -### It actually initializes something! - -# this is equivalent to use strict, but can be used within the Safe compartment - -BEGIN { - be_strict; -} - -my $displayMode; - -my ( - $PAR, $BR, $BRBR, $LQ, $RQ, - $BM, $EM, $BDM, $EDM, $LTS, - $GTS, $LTE, $GTE, $BEGIN_ONE_COLUMN, $END_ONE_COLUMN, - $SOL, $SOLUTION, $HINT, $COMMENT, $US, - $SPACE, $NBSP, $NDASH, $MDASH, $BLABEL, - $ELABEL, $BBOLD, $EBOLD, $BITALIC, $EITALIC, - $BUL, $EUL, $BCENTER, $ECENTER, $BLTR, - $ELTR, $BKBD, $EKBD, $HR, $LBRACE, - $RBRACE, $LB, $RB, $DOLLAR, $PERCENT, - $CARET, $PI, $E, $LATEX, $TEX, - $APOS, @ALPHABET, $envir, $PG_random_generator, $inputs_ref, - $rh_sticky_answers, $r_ans_rule_count, -); - -our %envir; - -sub _PGbasicmacros_init { - # The big problem is that at compile time in the cached Safe compartment - # main:: has one definition, probably Safe::Root1:: - # At runtime main has another definition Safe::Rootx:: where x is > 1 - - # It is important to - # initialize the my variable version of $displayMode from the "runtime" version - # of main::displayMode - - $displayMode = main::PG_restricted_eval(q!$main::displayMode!); - - # This is initializes the remaining variables in the runtime main:: compartment. - - main::PG_restricted_eval( <<'EndOfFile'); - $displayMode = $displayMode; - - $main::PAR = PAR(); - $main::BR = BR(); - $main::BRBR = BRBR(); - $main::LQ = LQ(); - $main::RQ = RQ(); - $main::BM = BM(); - $main::EM = EM(); - $main::BDM = BDM(); - $main::EDM = EDM(); - $main::LTS = LTS(); - $main::GTS = GTS(); - $main::LTE = LTE(); - $main::GTE = GTE(); - $main::BEGIN_ONE_COLUMN = BEGIN_ONE_COLUMN(); - $main::END_ONE_COLUMN = END_ONE_COLUMN(); - $main::SOL = SOLUTION_HEADING(); - $main::SOLUTION = SOLUTION_HEADING(); - $main::HINT = HINT_HEADING(); - $main::US = US(); - $main::SPACE = SPACE(); - $main::NBSP = NBSP(); - $main::NDASH = NDASH(); - $main::MDASH = MDASH(); - $main::BLABEL = BLABEL(); - $main::ELABEL = ELABEL(); - $main::BBOLD = BBOLD(); - $main::EBOLD = EBOLD(); - $main::BITALIC = BITALIC(); - $main::EITALIC = EITALIC(); - $main::BUL = BUL(); - $main::EUL = EUL(); - $main::BCENTER = BCENTER(); - $main::ECENTER = ECENTER(); - $main::BLTR = BLTR(); - $main::ELTR = ELTR(); - $main::BKBD = BKBD(); - $main::EKBD = EKBD(); - $main::HR = HR(); - $main::LBRACE = LBRACE(); - $main::RBRACE = RBRACE(); - $main::LB = LB(); - $main::RB = RB(); - $main::DOLLAR = DOLLAR(); - $main::PERCENT = PERCENT(); - $main::CARET = CARET(); - $main::PI = PI(); - $main::E = E(); - $main::LATEX = LATEX(); - $main::TEX = TEX(); - $main::APOS = APOS(); - @main::ALPHABET = ('A'..'ZZ'); - %main::STICKY_ANSWERS = (); - -EndOfFile - - # Next we transfer the correct definitions in the main:: compartment to the local my variables - # This can't be done inside the eval above because my variables seem to be invisible inside the eval - - $PAR = PAR(); - $BR = BR(); - $BRBR = BRBR(); - $LQ = LQ(); - $RQ = RQ(); - $BM = BM(); - $EM = EM(); - $BDM = BDM(); - $EDM = EDM(); - $LTS = LTS(); - $GTS = GTS(); - $LTE = LTE(); - $GTE = GTE(); - $BEGIN_ONE_COLUMN = BEGIN_ONE_COLUMN(); - $END_ONE_COLUMN = END_ONE_COLUMN(); - $SOL = SOLUTION_HEADING(); - $SOLUTION = SOLUTION_HEADING(); - $HINT = HINT_HEADING(); - $US = US(); - $SPACE = SPACE(); - $NBSP = NBSP(); - $NDASH = NDASH(); - $MDASH = MDASH(); - $BLABEL = BLABEL(); - $ELABEL = ELABEL(); - $BBOLD = BBOLD(); - $EBOLD = EBOLD(); - $BITALIC = BITALIC(); - $EITALIC = EITALIC(); - $BUL = BUL(); - $EUL = EUL(); - $BCENTER = BCENTER(); - $ECENTER = ECENTER(); - $BLTR = BLTR(); - $ELTR = ELTR(); - $BKBD = BKBD(); - $EKBD = EKBD(); - $HR = HR(); - $LBRACE = LBRACE(); - $RBRACE = RBRACE(); - $LB = LB(); - $RB = RB(); - $DOLLAR = DOLLAR(); - $PERCENT = PERCENT(); - $CARET = CARET(); - $PI = PI(); - $E = E(); - $LATEX = LATEX(); - $TEX = TEX(); - $APOS = APOS(); - @ALPHABET = ('A' .. 'ZZ'); - - $envir = PG_restricted_eval(q!\%main::envir!); - $PG_random_generator = PG_restricted_eval(q!$main::PG_random_generator!); - $inputs_ref = $envir{inputs_ref}; - $rh_sticky_answers = PG_restricted_eval(q!\%main::STICKY_ANSWERS!); - $r_ans_rule_count = PG_restricted_eval(q!\$ans_rule_count!); -} - -=head2 Answer blank macros: - -These produce answer blanks of various sizes or pop up lists or radio answer buttons. -The names for the answer blanks are -generated implicitly. - - ans_rule( width ) - tex_ans_rule( width ) - ans_radio_buttons(value1 => label1, value2, label2 => value3, label3 => ...) - pop_up_list(@list) # list consists of (value => label, PR => "Product rule", ...) - pop_up_list([@list]) # list consists of values - -In the last case, one can use C to produce a -pop-up list containing the three strings listed, and then use str_cmp to check -the answer. - -To indicate the checked position of radio buttons put a '%' in front of the value: C -will have 'No' checked. C works inside math equations in C mode. It does not work in C mode since this mode produces gif pictures. - -The following method is defined in F for entering the answer evaluators corresponding -to answer rules with automatically generated names. The answer evaluators are matched with the -answer rules in the order in which they appear on the page. - - ANS(ans_evaluator1, ans_evaluator2, ...); - -These are more primitive macros which produce answer blanks for specialized cases when complete -control over the matching of answers blanks and answer evaluators is desired. -The names of the answer blanks must be generated manually, and it is best if they do NOT begin -with the default answer prefix (currently AnSwEr). - - labeled_ans_rule(name, width) # an alias for NAMED_ANS_RULE where width defaults to 20 if omitted. - - NAMED_ANS_RULE(name, width) - NAMED_ANS_BOX(name, rows, cols) - NAMED_ANS_RADIO(name, value, label) - NAMED_ANS_RADIO_EXTENSION(name, value, label) - NAMED_ANS_RADIO_BUTTONS(name, value1, label1, value2, label2, ...) - check_box('-name' => answer5, '-value' => 'statement3', '-label' => 'I loved this course!') - NAMED_POP_UP_LIST($name, @list) # list consists of (value => tag, PR => "Product rule", ...) - NAMED_POP_UP_LIST($name, [@list]) # list consists of a list of values (and each tag will be set to the corresponding value) - -(Name is the name of the variable, value is the value given to the variable when this option is selected, -and label is the text printed next to the button or check box. Check box variables can have multiple values.) - -NAMED_ANS_RADIO_BUTTONS creates a sequence of NAMED_ANS_RADIO and NAMED_ANS_RADIO_EXTENSION items which -are output either as an array or, in scalar context, as the array glued together with spaces. It is -usually easier to use this than to manually construct the radio buttons by hand. However, sometimes - extra flexibility is desiredin which case: - -When entering radio buttons using the "NAMED" format, you should use NAMED_ANS_RADIO button for the first button -and then use NAMED_ANS_RADIO_EXTENSION for the remaining buttons. NAMED_ANS_RADIO requires a matching answer evalutor, -while NAMED_ANS_RADIO_EXTENSION does not. The name used for NAMED_ANS_RADIO_EXTENSION should match the name -used for NAMED_ANS_RADIO (and the associated answer evaluator). - -The following method is defined in F for entering the answer evaluators corresponding -to answer rules with automatically generated names. The answer evaluators are matched with the -answer rules in the order in which they appear on the page. - - NAMED_ANS(name1 => ans_evaluator1, name2 => ans_evaluator2, ...); - -These auxiliary macros are defined in PG.pl - - NEW_ANS_NAME( ); # produces a new anonymous answer blank name by appending a number to the prefix (AnSwEr) - # and registers this name as an implicitly labeled answer - # Its use is paired with each answer evaluator being entered using ANS() - - ANS_NUM_TO_NAME(number); # prepends the prefix (AnSwEr) to the number, but does nothing else. - - RECORD_ANS_NAME( name ); # records the order in which the answer blank is rendered - # This is called by all of the constructs above, but must - # be called explicitly if an input blank is constructed explictly - # using HTML code. - -These are legacy macros: - - ANS_RULE( number, width ); # equivalent to NAMED_ANS_RULE( NEW_ANS_NAME( ), width) - ANS_BOX( question_number, height, width ); # equivalent to NAMED_ANS_BOX( NEW_ANS_NAME( ), height, width) - ANS_RADIO( question_number, value, tag ); # equivalent to NAMED_ANS_RADIO( NEW_ANS_NAME( ), value, tag) - ANS_RADIO_OPTION( question_number, value, tag ); # equivalent to NAMED_ANS_RADIO_EXTENSION( ANS_NUM_TO_NAME(number), value, tag) - -=cut - -sub labeled_ans_rule { # syntactic sugar for NAMED_ANS_RULE - my ($name, $col) = @_; - $col = 20 unless not_null($col); - NAMED_ANS_RULE($name, $col); -} - -sub NAMED_ANS_RULE { - my $name = shift; - my $col = shift; - my %options = @_; - $col = 20 unless not_null($col); - my $answer_value = ''; - $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); - - #FIXME -- code factoring needed - if ($answer_value =~ /\0/) { - my @answers = split("\0", $answer_value); - $answer_value = shift(@answers); # use up the first answer - $rh_sticky_answers->{$name} = \@answers; - # store the rest -- beacuse this stores to a main:: variable - # it must be evaluated at run time - $answer_value = '' unless defined($answer_value); - } elsif (ref($answer_value) eq 'ARRAY') { - my @answers = @{$answer_value}; - $answer_value = shift(@answers); # use up the first answer - $rh_sticky_answers->{$name} = \@answers; - # store the rest -- because this stores to a main:: variable - # it must be evaluated at run time - $answer_value = '' unless defined($answer_value); - } - - $answer_value =~ s/\s+/ /g; ## remove excessive whitespace from student answer - $name = RECORD_ANS_NAME($name, $answer_value); - $answer_value = encode_pg_and_html($answer_value); - my $previous_name = "previous_$name"; - $name = ($envir{use_opaque_prefix}) ? "%%IDPREFIX%%$name" : $name; - $previous_name = ($envir{use_opaque_prefix}) ? "%%IDPREFIX%%$previous_name" : $previous_name; - - my $label; - if (defined($options{aria_label})) { - $label = $options{aria_label}; - } else { - $label = generate_aria_label($name); - } - - my $tcol = $col / 2 > 3 ? $col / 2 : 3; ## get max - $tcol = $tcol < 40 ? $tcol : 40; ## get min - - MODES( - TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}", - Latex2HTML => qq!\\begin{rawhtml}\\end{rawhtml}!, - - # Note: codeshard is used in the css to identify input elements that come from pg - HTML => qq!! - . qq!!, - PTX => qq!! - ); -} - -sub NAMED_HIDDEN_ANS_RULE { - # this is used to hold information being passed into and out of applets - # -- preserves state -- identical to NAMED_ANS_RULE except input type "hidden" - my ($name, $col) = @_; - $col = 20 unless not_null($col); - my $answer_value = ''; - $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); - if ($answer_value =~ /\0/) { - my @answers = split("\0", $answer_value); - $answer_value = shift(@answers); # use up the first answer - $rh_sticky_answers->{$name} = \@answers; - # store the rest -- beacuse this stores to a main:: variable - # it must be evaluated at run time - $answer_value = '' unless defined($answer_value); - } elsif (ref($answer_value) eq 'ARRAY') { - my @answers = @{$answer_value}; - $answer_value = shift(@answers); # use up the first answer - $rh_sticky_answers->{$name} = \@answers; - # store the rest -- beacuse this stores to a main:: variable - # it must be evaluated at run time - $answer_value = '' unless defined($answer_value); - } - - $answer_value =~ s/\s+/ /g; ## remove excessive whitespace from student answer - - $name = RECORD_ANS_NAME($name, $answer_value); - $answer_value = encode_pg_and_html($answer_value); - - my $tcol = $col / 2 > 3 ? $col / 2 : 3; ## get max - $tcol = $tcol < 40 ? $tcol : 40; ## get min - - MODES( - TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}", - Latex2HTML => qq!\\begin{rawhtml}\\end{rawhtml}!, - HTML => qq!! - . qq!!, - PTX => '', - ); -} - -sub NAMED_ANS_RULE_OPTION { # deprecated - &NAMED_ANS_RULE_EXTENSION; -} - -sub NAMED_ANS_RULE_EXTENSION { - my $name = shift; # this is the name of the response item - my $col = shift; - my %options = @_; - - my $label; - if (defined($options{aria_label})) { - $label = $options{aria_label}; - } else { - $label = generate_aria_label($name); - } - # $answer_group_name is the name of the parent answer group - # the group name is usually the same as the answer blank name - # when there is only one answer blank. - - my $answer_group_name = $options{answer_group_name} // ''; - unless ($answer_group_name) { - WARN_MESSAGE( - "Error in NAMED_ANSWER_RULE_EXTENSION: every call to this subroutine needs - to have \$options{answer_group_name} defined. For a single answer blank this is - usually the same as the answer blank name. Answer blank name: $name" - ); - } - # warn "from named answer rule extension in PGbasic answer_group_name: |$answer_group_name|"; - my $answer_value = ''; - $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); - if (defined($rh_sticky_answers->{$name})) { - $answer_value = shift(@{ $rh_sticky_answers->{$name} }); - $answer_value = '' unless defined($answer_value); - } - - $answer_value =~ s/\s+/ /g; ## remove excessive whitespace from student answer - # warn "from NAMED_ANSWER_RULE_EXTENSION in PGbasic: - # answer_group_name: |$answer_group_name| name: |$name| answer value: |$answer_value|"; - INSERT_RESPONSE($answer_group_name, $name, $answer_value) - ; #FIXME hack -- this needs more work to decide how to make it work - $answer_value = encode_pg_and_html($answer_value); - - my $tcol = $col / 2 > 3 ? $col / 2 : 3; ## get max - $tcol = $tcol < 40 ? $tcol : 40; ## get min - MODES( - TeX => "\\mbox{\\parbox[t]{${tcol}ex}{\\hrulefill}}", - Latex2HTML => - qq!\\begin{rawhtml}\n\n\\end{rawhtml}\n!, - HTML => qq!! - . qq!!, - PTX => qq!!, - ); -} - -sub ANS_RULE { #deprecated - my ($number, $col) = @_; - my $name = NEW_ANS_NAME($number); - NAMED_ANS_RULE($name, $col); -} - -sub NAMED_ANS_BOX { - my $name = shift; - my $row = shift; - my $col = shift; - my %options = @_; - - $row = 10 unless defined($row); - $col = 80 unless defined($col); - - my $height = .07 * $row; - my $answer_value = ''; - $answer_value = $inputs_ref->{$name} if defined($inputs_ref->{$name}); - $name = RECORD_ANS_NAME($name, $answer_value); - my $label; - if (defined($options{aria_label})) { - $label = $options{aria_label}; - } else { - $label = generate_aria_label($name); - } - # try to escape HTML entities to deal with xss stuff - $answer_value = encode_pg_and_html($answer_value); - my $out = MODES( - TeX => qq!\\vskip $height in \\hrulefill\\quad !, - Latex2HTML => - qq!\\begin{rawhtml}\\end{rawhtml}!, - HTML => qq! - - !, - PTX => '', - ); - $out; -} - -sub ANS_BOX { #deprecated - my ($number, $row, $col) = @_; - my $name = NEW_ANS_NAME(); - NAMED_ANS_BOX($name, $row, $col); -} - -sub NAMED_ANS_RADIO { - my $name = shift; - my $value = shift; - my $tag = shift; - my $extend = shift; - my %options = @_; - - my $checked = ''; - if ($value =~ /^\%/) { - $value =~ s/^\%//; - $checked = 'CHECKED'; - } - if (defined($inputs_ref->{$name})) { - if ($inputs_ref->{$name} eq $value) { - $checked = 'CHECKED'; - } else { - $checked = ''; - } - - } - $name = RECORD_ANS_NAME($name, { $value => $checked }) unless $extend; - INSERT_RESPONSE($options{answer_group_name}, $name, { $value => $checked }) if $extend; - my $label = generate_aria_label($name); - $label .= "option 1 "; - MODES( - TeX => qq!\\item{$tag}\n!, - Latex2HTML => - qq!\\begin{rawhtml}\n\\end{rawhtml}$tag!, - HTML => - qq!!, - PTX => '
  • ' . "$tag" . '
    • ' . "\n", - ); - -} - -sub NAMED_ANS_RADIO_OPTION { #deprecated - &NAMED_ANS_RADIO_EXTENSION; -} - -sub NAMED_ANS_RADIO_EXTENSION { - my $name = shift; - my $value = shift; - my $tag = shift; - my %options = @_; - - my $checked = ''; - if ($value =~ /^\%/) { - $value =~ s/^\%//; - $checked = 'CHECKED'; - } - if (defined($inputs_ref->{$name})) { - if ($inputs_ref->{$name} eq $value) { - $checked = 'CHECKED'; - } else { - $checked = ''; - } - - } - EXTEND_RESPONSE($options{answer_group_name} // $name, $name, $value, $checked); - my $label; - if (defined($options{aria_label})) { - $label = $options{aria_label}; - } else { - $label = generate_aria_label($name); - } - - MODES( - TeX => qq!\\item{$tag}\n!, - Latex2HTML => - qq!\\begin{rawhtml}\n\\end{rawhtml}$tag!, - HTML => - qq!!, - PTX => '
  • ' . "$tag" . '
    • ' . "\n", - ); - -} - -sub NAMED_ANS_RADIO_BUTTONS { - my $name = shift; - my $value = shift; - my $tag = shift; - - my @out = (); - push(@out, NAMED_ANS_RADIO($name, $value, $tag)); - my @buttons = @_; - my $label = generate_aria_label($name); - my $count = 2; - while (@buttons) { - $value = shift @buttons; - $tag = shift @buttons; - push(@out, NAMED_ANS_RADIO_OPTION($name, $value, $tag, aria_label => $label . "option $count ")); - $count++; - } - (wantarray) ? @out : join(" ", @out); -} - -sub ANS_RADIO { - my $number = shift; - my $value = shift; - my $tag = shift; - my $name = NEW_ANS_NAME(); - NAMED_ANS_RADIO($name, $value, $tag); -} - -sub ANS_RADIO_OPTION { - my $number = shift; - my $value = shift; - my $tag = shift; - my $name = ANS_NUM_TO_NAME($number); - NAMED_ANS_RADIO_OPTION($name, $value, $tag); -} - -sub ANS_RADIO_BUTTONS { - my $number = shift; - my $value = shift; - my $tag = shift; - - my @out = (); - push(@out, ANS_RADIO($number, $value, $tag)); - my @buttons = @_; - while (@buttons) { - $value = shift @buttons; - $tag = shift @buttons; - push(@out, ANS_RADIO_OPTION($number, $value, $tag)); - } - (wantarray) ? @out : join(" ", @out); -} - -############################################## -# generate_aria_label( $name ) -# takes the name of an ANS_RULE or ANS_BOX and generates an appropriate -# aria label for screen readers -############################################## - -sub generate_aria_label { - my $name = shift; - my $label = ''; - - # if we dont have an AnSwEr type name then we do the best we can - if ($name !~ /AnSwEr/) { - return maketext('answer') . ' ' . $name; - } - - # check for quiz prefix - if ($name =~ /^Q\d+/ || $name =~ /^MaTrIx_Q\d+/) { - $name =~ s/Q0*(\d+)_//; - $label .= maketext('problem') . ' ' . $1 . ' '; - } - - # get answer number - $name =~ /AnSwEr0*(\d+)/; - $label .= maketext('answer') . ' ' . $1 . ' '; - - # check for Multianswer - if ($name =~ /MuLtIaNsWeR_/) { - $name =~ s/MuLtIaNsWeR_//; - $name =~ /AnSwEr(\d+)_(\d+)/; - $label .= maketext('part') . ' ' . ($2 + 1) . ' '; - } - - # check for Matrix - if ($name =~ /^MaTrIx_/) { - $name =~ /_(\d+)_(\d+)$/; - $label .= maketext('row') . ' ' . ($1 + 1) . ' ' . maketext('column') . ' ' . ($2 + 1) . ' '; - } - - return $label; -} - -############################################## -# contained_in( $elem, $array_reference or null separated string); -# determine whether element is equal -# ( in the sense of eq, not ==, ) to an element in the array. -############################################## -sub contained_in { - my $element = shift; - my @input_list = @_; - my @output_list = (); - # Expand the list -- convert references to arrays to arrays - # Convert null separated strings to arrays - foreach my $item (@input_list) { - if ($item =~ /\0/) { - push @output_list, split('\0', $item); - } elsif (ref($item) =~ /ARRAY/) { - push @output_list, @{$item}; - } else { - push @output_list, $item; - } - } - - my @match_list = grep { $element eq $_ } @output_list; - if (@match_list) { - return 1; - } else { - return 0; - } -} - -########################## -# If multiple boxes are checked then the $inputs_ref->{name }will be a null separated string -# or a reference to an array. -########################## - -sub NAMED_ANS_CHECKBOX { - my $name = shift; - my $value = shift; - my $tag = shift; - - my $checked = ''; - if ($value =~ /^\%/) { - $value =~ s/^\%//; - $checked = 'CHECKED'; - } - - if (defined($inputs_ref->{$name})) { - if (contained_in($value, $inputs_ref->{$name})) { - $checked = 'CHECKED'; - } else { - $checked = ''; - } - - } - $name = RECORD_ANS_NAME($name, { $value => $checked }); - my $label = generate_aria_label($name); - $label .= "option 1 "; - - MODES( - TeX => qq!\\item{$tag}\n!, - Latex2HTML => - qq!\\begin{rawhtml}\n\\end{rawhtml}$tag!, - HTML => - qq!!, - PTX => '
  • ' . "$tag" . '
    • ' . "\n", - ); - -} - -sub NAMED_ANS_CHECKBOX_OPTION { - my $name = shift; - my $value = shift; - my $tag = shift; - my %options = @_; - - my $checked = ''; - if ($value =~ /^\%/) { - $value =~ s/^\%//; - $checked = 'CHECKED'; - } - - if (defined($inputs_ref->{$name})) { - if (contained_in($value, $inputs_ref->{$name})) { - $checked = 'CHECKED'; - } else { - $checked = ''; - } - - } - EXTEND_RESPONSE($name, $name, $value, $checked); - my $label; - if (defined($options{aria_label})) { - $label = $options{aria_label}; - } else { - $label = generate_aria_label($name); - } - - MODES( - TeX => qq!\\item{$tag}\n!, - Latex2HTML => - qq!\\begin{rawhtml}\n\\end{rawhtml}$tag!, - HTML => - qq!!, - PTX => '
  • ' . "$tag" . '
    • ' . "\n", - ); - -} - -sub NAMED_ANS_CHECKBOX_BUTTONS { - my $name = shift; - my $value = shift; - my $tag = shift; - - my @out = (); - push(@out, NAMED_ANS_CHECKBOX($name, $value, $tag)); - my $label = generate_aria_label($name); - my $count = 2; - my @buttons = @_; - while (@buttons) { - $value = shift @buttons; - $tag = shift @buttons; - push(@out, NAMED_ANS_CHECKBOX_OPTION($name, $value, $tag, aria_label => $label . "option $count ")); - $count++; - } - - (wantarray) ? @out : join(" ", @out); -} - -sub ANS_CHECKBOX { - my $number = shift; - my $value = shift; - my $tag = shift; - my $name = NEW_ANS_NAME(); - - NAMED_ANS_CHECKBOX($name, $value, $tag); -} - -sub ANS_CHECKBOX_OPTION { - my $number = shift; - my $value = shift; - my $tag = shift; - my $name = ANS_NUM_TO_NAME($number); - - NAMED_ANS_CHECKBOX_OPTION($name, $value, $tag); -} - -sub ANS_CHECKBOX_BUTTONS { - my $number = shift; - my $value = shift; - my $tag = shift; - - my @out = (); - push(@out, ANS_CHECKBOX($number, $value, $tag)); - - my @buttons = @_; - while (@buttons) { - $value = shift @buttons; - $tag = shift @buttons; - push(@out, ANS_CHECKBOX_OPTION($number, $value, $tag)); - } - - (wantarray) ? @out : join(" ", @out); -} - -sub ans_rule { - my $len = shift; # gives the optional length of the answer blank - $len = 20 unless $len; - my $name = NEW_ANS_NAME(); # increment is done internally - NAMED_ANS_RULE($name, $len); -} - -sub ans_rule_extension { - my $len = shift; - $len = 20 unless $len; - # warn "ans_rule_extension may be misnumbering the answers"; - my $name = NEW_ANS_NAME($$r_ans_rule_count); # don't update the answer name - NAMED_ANS_RULE($name, $len); -} - -sub ans_radio_buttons { - my $name = NEW_ANS_NAME(); - my @radio_buttons = NAMED_ANS_RADIO_BUTTONS($name, @_); - - if ($displayMode eq 'TeX') { - $radio_buttons[0] = "\n\\begin{itemize}\n" . $radio_buttons[0]; - $radio_buttons[$#radio_buttons] .= "\n\\end{itemize}\n"; - } elsif ($displayMode eq 'PTX') { - $radio_buttons[0] = '' . "\n" . $radio_buttons[0]; - $radio_buttons[$#radio_buttons] .= ''; - } - - (wantarray) ? @radio_buttons : join(" ", @radio_buttons); -} - -#added 6/14/2000 by David Etlinger -sub ans_checkbox { - my $name = NEW_ANS_NAME(); - my @checkboxes = NAMED_ANS_CHECKBOX_BUTTONS($name, @_); - - if ($displayMode eq 'TeX') { - $checkboxes[0] = "\n\\begin{itemize}\n" . $checkboxes[0]; - $checkboxes[$#checkboxes] .= "\n\\end{itemize}\n"; - } elsif ($displayMode eq 'PTX') { - $checkboxes[0] = '' . "\n" . $checkboxes[0]; - $checkboxes[$#checkboxes] .= ''; - } - - (wantarray) ? @checkboxes : join(" ", @checkboxes); -} - -## define a version of ans_rule which will work inside TeX math mode or display math mode -- at least for tth mode. -## This is great for displayed fractions. -## This will not work with latex2HTML mode since it creates gif equations. - -sub tex_ans_rule { - my $len = shift; - $len = 20 unless $len; - my $name = NEW_ANS_NAME(); - my $answer_rule = NAMED_ANS_RULE($name, $len); # we don't want to create three answer rules in different modes. - my $out = MODES( - 'TeX' => $answer_rule, - 'Latex2HTML' => '\\fbox{Answer boxes cannot be placed inside typeset equations}', - 'HTML_tth' => '\\begin{rawhtml} ' . $answer_rule . '\\end{rawhtml}', - 'HTML_dpng' => '\\fbox{Answer boxes cannot be placed inside typeset equations}', - 'HTML' => $answer_rule, - 'PTX' => 'Answer boxes cannot be placed inside typeset equations', - ); - - $out; -} - -sub tex_ans_rule_extension { - my $len = shift; - $len = 20 unless $len; - # warn "tex_ans_rule_extension may be missnumbering the answer"; - my $name = NEW_ANS_NAME($$r_ans_rule_count); - my $answer_rule = NAMED_ANS_RULE($name, $len); # we don't want to create three answer rules in different modes. - my $out = MODES( - 'TeX' => $answer_rule, - 'Latex2HTML' => '\fbox{Answer boxes cannot be placed inside typeset equations}', - 'HTML_tth' => '\\begin{rawhtml} ' . $answer_rule . '\\end{rawhtml}', - 'HTML_dpng' => '\fbox{Answer boxes cannot be placed inside typeset equations}', - 'HTML' => $answer_rule, - 'PTX' => 'Answer boxes cannot be placed inside typeset equations', - ); - - $out; -} -# still needs some cleanup. -sub NAMED_TEX_ANS_RULE { - my $name = shift; - my $len = shift; - $len = 20 unless $len; - my $answer_rule = NAMED_ANS_RULE($name, $len); # we don't want to create three answer rules in different modes. - my $out = MODES( - 'TeX' => $answer_rule, - 'Latex2HTML' => '\\fbox{Answer boxes cannot be placed inside typeset equations}', - 'HTML_tth' => '\\begin{rawhtml} ' . $answer_rule . '\\end{rawhtml}', - 'HTML_dpng' => '\\fbox{Answer boxes cannot be placed inside typeset equations}', - 'HTML' => $answer_rule, - 'PTX' => 'Answer boxes cannot be placed inside typeset equations', - ); - - $out; -} - -sub NAMED_TEX_ANS_RULE_EXTENSION { - my $name = shift; - my $len = shift; - $len = 20 unless $len; - my $answer_rule = - NAMED_ANS_RULE_EXTENSION($name, $len); # we don't want to create three answer rules in different modes. - my $out = MODES( - 'TeX' => $answer_rule, - 'Latex2HTML' => '\fbox{Answer boxes cannot be placed inside typeset equations}', - 'HTML_tth' => '\\begin{rawhtml} ' . $answer_rule . '\\end{rawhtml}', - 'HTML_dpng' => '\fbox{Answer boxes cannot be placed inside typeset equations}', - 'HTML' => $answer_rule, - 'PTX' => 'Answer boxes cannot be placed inside typeset equations', - ); - - $out; -} - -sub ans_box { - my $row = shift; - my $col = shift; - $row = 5 unless $row; - $col = 80 unless $col; - my $name = NEW_ANS_NAME(); - NAMED_ANS_BOX($name, $row, $col); -} - -# this is legacy code; use ans_checkbox instead -sub checkbox { - my %options = @_; - qq!$options{'-label'}!; -} - -sub NAMED_POP_UP_LIST { - my $name = shift; - my @list = @_; - if (ref($list[0]) eq 'ARRAY') { - my @list1 = @{ $list[0] }; - @list = map { $_ => $_ } @list1; - } - my $moodle_prefix = ($envir{use_opaque_prefix}) ? "%%IDPREFIX%%" : ''; - - my $answer_value = ''; - $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); - my $out = ""; - if ($displayMode eq 'HTML_MathJax' - || $displayMode eq 'HTML_dpng' - || $displayMode eq 'HTML' - || $displayMode eq 'HTML_tth' - || $displayMode eq 'HTML_jsMath' - || $displayMode eq 'HTML_asciimath' - || $displayMode eq 'HTML_LaTeXMathML' - || $displayMode eq 'HTML_img') - { - $out = qq!\n"; - } elsif ($displayMode eq "Latex2HTML") { - $out = qq! \\begin{rawhtml}\\end{rawhtml}\n"; - } elsif ($displayMode eq "TeX") { - $out .= "\\fbox{?}"; - } elsif ($displayMode eq "PTX") { - $out = '' . "\n"; - my $i; - foreach ($i = 0; $i < @list; $i = $i + 2) { - $out .= '
  • ' . $list[ $i + 1 ] . '
    • ' . "\n"; - } - $out .= '    '; - } - $name = RECORD_ANS_NAME($name, $answer_value); # record answer name - $out; -} - -sub pop_up_list { - my @list = @_; - my $name = NEW_ANS_NAME(); # get new answer name - NAMED_POP_UP_LIST($name, @list); -} - -=head2 answer_matrix - - Usage \[ \{ answer_matrix(rows, columns, width_of_ans_rule, @options) \} \] - - Creates an array of answer blanks and passes it to display_matrix which returns - text which represents the matrix in TeX format used in math display mode. Answers - are then passed back to whatever answer evaluators you write at the end of the problem. - (note, if you have an m x n matrix, you will need mn answer evaluators, and they will be - returned to the evaluaters starting in the top left hand corner and proceed to the left - and then at the end moving down one row, just as you would read them.) - - The options are passed on to display_matrix. - - Note (7/21/2017) The above usage does not work. Omitting the \[ \] works, but also must - load PGmatrixmacros.pl to get display_matrix used below - -=cut - -sub answer_matrix { - my $m = shift; - my $n = shift; - my $width = shift; - my @options = @_; - my @array = (); - for (my $i = 0; $i < $m; $i += 1) { - my @row_array = (); - - for (my $i = 0; $i < $n; $i += 1) { - push @row_array, ans_rule($width); - } - my $r_row_array = \@row_array; - push @array, $r_row_array; - } - # display_matrix hasn't been loaded into the cache safe compartment - # so we need to refer to the subroutine in this way to make - # sure that main is defined correctly. - my $ra_local_display_matrix = PG_restricted_eval(q!\&main::display_matrix!); - &$ra_local_display_matrix(\@array, @options); -} - -sub NAMED_ANS_ARRAY_EXTENSION { - my $name = shift; - my $col = shift; - my %options = @_; - $col = 20 unless $col; - my $answer_value = ''; - - $answer_value = ${$inputs_ref}{$name} if defined(${$inputs_ref}{$name}); - if ($answer_value =~ /\0/) { - my @answers = split("\0", $answer_value); - $answer_value = shift(@answers); - $answer_value = '' unless defined($answer_value); - } elsif (ref($answer_value) eq 'ARRAY') { - my @answers = @{$answer_value}; - $answer_value = shift(@answers); - $answer_value = '' unless defined($answer_value); - } - - my $label; - if (defined($options{aria_label})) { - $label = $options{aria_label}; - } else { - $label = generate_aria_label($name); - } - - # warn "ans_label $options{ans_label} $name $answer_value"; - my $answer_group_name; # the name of the answer evaluator controlling this collection of responses. - # catch deprecated use of ans_label to pass answer_group_name - if (defined($options{ans_label})) { - WARN_MESSAGE( - "Error in NAMED_ANS_ARRAY_EXTENSION: the answer group name should be passed in ", - "\%options using answer_group_name=>\$answer_group_name", - "The use of ans_label=>\$answer_group_name is deprecated.", - "Answer blank name: $name" - ); - $answer_group_name = $options{ans_label}; - } - if (defined($options{answer_group_name})) { - $answer_group_name = $options{answer_group_name}; - } - if ($answer_group_name) { - INSERT_RESPONSE($options{answer_group_name}, $name, $answer_value); - } else { - WARN_MESSAGE("Error: answer_group_name must be defined for $name"); - } - $answer_value = encode_pg_and_html($answer_value); - - MODES( - TeX => "\\mbox{\\parbox[t]{10pt}{\\hrulefill}}\\hrulefill\\quad ", - Latex2HTML => - qq!\\begin{rawhtml}\n\n\\end{rawhtml}\n!, - HTML => qq!!, - PTX => qq!!, - ); -} - -sub ans_array { - my $m = shift; - my $n = shift; - my $col = shift; - $col = 20 unless $col; - my $ans_label = NEW_ANS_NAME(); - my $num = ans_rule_count(); - my @options = @_; - my @array = (); - my $answer_value = ""; - my @response_list = (); - my $name; - $main::vecnum = -1; - CLEAR_RESPONSES($ans_label); - - for (my $i = 0; $i < $n; $i += 1) { - $name = NEW_ANS_ARRAY_NAME_EXTENSION($num, 0, $i); - $array[0][$i] = NAMED_ANS_ARRAY_EXTENSION($name, $col, ans_label => $ans_label); - } - - for (my $j = 1; $j < $m; $j += 1) { - for (my $i = 0; $i < $n; $i += 1) { - $name = NEW_ANS_ARRAY_NAME_EXTENSION($num, $j, $i); - $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name, $col, ans_label => $ans_label); - } - } - my $ra_local_display_matrix = PG_restricted_eval(q!\&main::display_matrix!); - &$ra_local_display_matrix(\@array, @options); -} - -sub ans_array_extension { - my $m = shift; - my $n = shift; - my $col = shift; - $col = 20 unless $col; - my $num = ans_rule_count(); #hack -- ans_rule_count is updated after being used - my @options = @_; - my @response_list = (); - my $name; - my @array = (); - my $ans_label = $main::PG->new_label($num); - - for (my $j = 0; $j < $m; $j += 1) { - for (my $i = 0; $i < $n; $i += 1) { - $name = NEW_ANS_ARRAY_NAME_EXTENSION($num, $j, $i); - $array[$j][$i] = NAMED_ANS_ARRAY_EXTENSION($name, $col, answer_group_name => $ans_label, @options); - } - } - my $ra_local_display_matrix = PG_restricted_eval(q!\&main::display_matrix!); - &$ra_local_display_matrix(\@array, @options); -} - -# end answer blank macros - -=head2 Hints, solutions, and statement macros - - solution('text', 'text2', ...); - SOLUTION('text', 'text2', ...); # equivalent to TEXT(solution(...)); - - hint('text', 'text2', ...); - HINT('text', 'text2', ...); # equivalent to TEXT("$BR$HINT" . hint(@_) . "$BR") if hint(@_); - - statement('text'); - STATEMENT('text'); # equivalent to TEXT(statement(...)); - -statement takes a string, probably from EV3P, and possibly wraps opening and closing -content, paralleling one feature of solution and hint. - -If $envir{showSolutions} is set to 1 then the solution is displayed. - -If $envir{showHints} is set to 1 then the hint is displayed. - -=cut - -# $main::solutionExists is passed to processProblem which displays a "show Solution" button -# when a solution is available for viewing - -sub escapeSolutionHTML { - my $str = join('', @_); - $str = $main::PG->encode_base64($str); - $str; -} - -sub solution { - my @in = @_; - $main::solutionExists = 1; - return $envir->{showSolutions} ? join('', @in) : ''; -} - -sub SOLUTION { - my $solution_body = solution(@_); - return "" if $solution_body eq ""; - - if ($displayMode =~ /HTML/) { - TEXT('
    ', knowlLink(SOLUTION_HEADING(), value => $solution_body, type => 'solution'), '
    '); - } elsif ($displayMode =~ /TeX/) { - TEXT( - "\n%%% BEGIN SOLUTION\n" - , #Marker used in PreTeXt LaTeX extraction; contact alex.jordan@pcc.edu before modifying - "\\par\\smallskip", SOLUTION_HEADING(), $solution_body, "\\par\\medskip", - "\n%%% END SOLUTION\n" #Marker used in PreTeXt LaTeX extraction; contact alex.jordan@pcc.edu before modifying - ); - } elsif ($displayMode =~ /PTX/) { - TEXT('', "\n", $solution_body, "\n", '', "\n\n"); - } else { - TEXT($PAR, $solution_body, $PAR); - } -} - -sub hint { - my @in = @_; - $main::hintExists = 1; - return $envir->{showHints} ? join('', @in) : ''; -} - -sub HINT { - my $hint_body = hint(@_); - return unless $hint_body; - if ($displayMode =~ /HTML/) { - TEXT('
    ', knowlLink(HINT_HEADING(), value => $hint_body, type => 'hint'), '
    '); - } elsif ($displayMode =~ /TeX/) { - TEXT( - "\n%%% BEGIN HINT\n" - , #Marker used in PreTeXt LaTeX extraction; contact alex.jordan@pcc.edu before modifying - "\\par\\smallskip", HINT_HEADING(), $hint_body, "\\par\\medskip", - "\n%%% END HINT\n" #Marker used in PreTeXt LaTeX extraction; contact alex.jordan@pcc.edu before modifying - ); - } elsif ($displayMode =~ /PTX/) { - TEXT('', "\n", $hint_body, "\n", '', "\n\n"); - } else { - TEXT($PAR, HINT_HEADING(), $BR . $hint_body . $PAR); - } -} - -sub statement { - my @in = @_; - my $out = join(' ', @in); - $out; -} - -sub STATEMENT { - if ($displayMode eq 'PTX') { TEXT('', "\n", statement(@_), "\n", '', "\n"); } - else { TEXT(statement(@_)) } -} - -# End hints and solutions and statement macros -################################# - -=head2 Comments to instructors - - COMMENT('text', 'text2', ...); - -Takes the text to be lines of a comment to be shown only -in the Library Browser below the rendered problem. - -The function COMMENT stores the needed html in the variable -pgComment, which gets transfered to the flag 'comment' in PG_FLAGS. - -=cut - -# Add a comment which will display in the Library browser -# Currently, the only output is html - -sub COMMENT { - my @in = @_; - my $out = join("$BR", @in); - $out = '
    ' . $out . '
    '; - PG_restricted_eval(q!$main::pgComment .= "! . $out . q!"!); - return (''); -} - -################################# -# Produces a random number between $begin and $end with increment 1. -# You do not have to worry about integer or floating point types. - -=head2 Pseudo-random number generator - - Usage: - random(0, 5, .1) # produces a random number between 0 and 5 in increments of .1 - non_zero_random(0, 5, .1) # gives a non-zero random number - - list_random(2, 3, 5, 6, 7, 8, 10) # produces random value from the list - list_random(2, 3, (5..8), 10) # does the same thing - - SRAND(seed) # resets the main random generator -- use very cautiously - -SRAND(time) will create a different problem everytime it is called. This makes it difficult -to check the answers :-). - -SRAND($envir->{'inputs_ref'}->{'key'} ) will create a different problem for each login session. -This is probably what is desired. - -=cut - -sub random { - my ($begin, $end, $incr) = @_; - $PG_random_generator->random($begin, $end, $incr); -} - -sub non_zero_random { ##gives a non-zero random number - my (@arguments) = @_; - my $a = 0; - my $i = 100; #safety counter - while ($a == 0 && (0 < $i--)) { - $a = random(@arguments); - } - $a; -} - -sub list_random { - my @li = @_; - return $li[ random(1, scalar(@li)) - 1 ]; -} - -sub SRAND { # resets the main random generator -- use cautiously - my $seed = shift; - $PG_random_generator->srand($seed); -} - -# display macros - -=head2 Display Macros - -These macros produce different output depending on the display mode being used to show -the problem on the screen, or whether the problem is being converted to TeX to produce -a hard copy output. - - MODES ( TeX => "Output this in TeX mode", - HTML => "output this in HTML mode", - HTML_tth => "output this in HTML_tth mode", - HTML_dpng => "output this in HTML_dpng mode", - Latex2HTML => "output this in Latex2HTML mode", - ) - - M3 (tex_version, latex2html_version, html_version) #obsolete - -=cut - -sub M3 { - my ($tex, $l2h, $html) = @_; - MODES(TeX => $tex, Latex2HTML => $l2h, HTML => $html, HTML_tth => $html, HTML_dpng => $html); -} - -# MODES() is now table driven -our %DISPLAY_MODE_FAILOVER = ( - TeX => [], - HTML => [], - PTX => ["HTML"], - HTML_tth => [ "HTML", ], - HTML_dpng => [ "HTML_tth", "HTML", ], - HTML_jsMath => [ "HTML_dpng", "HTML_tth", "HTML", ], - HTML_MathJax => [ "HTML_dpng", "HTML_tth", "HTML", ], - HTML_asciimath => [ "HTML_dpng", "HTML_tth", "HTML", ], - HTML_LaTeXMathML => [ "HTML_dpng", "HTML_tth", "HTML", ], - # legacy modes -- these are not supported, but some problems might try to - # set the display mode to one of these values manually and some macros may - # provide rendered versions for these modes but not the one we want. - Latex2HTML => [ "TeX", "HTML", ], - HTML_img => [ "HTML_dpng", "HTML_tth", "HTML", ], -); - -# This replaces M3. You can add new modes at will to this one. -sub MODES { - my %options = @_; - - # is a string supplied for the current display mode? if so, return it - return $options{$main::displayMode} if defined $options{$main::displayMode}; - - # otherwise, fail over to backup modes - my @backup_modes; - if (exists $DISPLAY_MODE_FAILOVER{$main::displayMode}) { - @backup_modes = @{ $DISPLAY_MODE_FAILOVER{$main::displayMode} }; - foreach my $mode (@backup_modes) { - return $options{$mode} if defined $options{$mode}; - } - } - warn "ERROR in defining MODES: neither display mode '$main::displayMode' nor", - " any fallback modes (", join(", ", @backup_modes), ") supplied."; -} - -# end display macros - -=head2 Display constants - - @ALPHABET ALPHABET() capital letter alphabet -- ALPHABET[0] = 'A' - $PAR PAR() paragraph character (\par or

    ) - $BR BR() line break character - $BRBR BRBR() line break character - $LQ LQ() left double quote - $RQ RQ() right double quote - $BM BM() begin math - $EM EM() end math - $BDM BDM() begin display math - $EDM EDM() end display math - $LTS LTS() strictly less than - $GTS GTS() strictly greater than - $LTE LTE() less than or equal - $GTE GTE() greater than or equal - $BEGIN_ONE_COLUMN BEGIN_ONE_COLUMN() begin one-column mode - $END_ONE_COLUMN END_ONE_COLUMN() end one-column mode - $SOL SOLUTION_HEADING() solution headline - $SOLUTION SOLUTION_HEADING() solution headline - $HINT HINT_HEADING() hint headline - $US US() underscore character - $SPACE SPACE() space character (tex and latex only) - $NBSP NBSP() non breaking space character - $NDASH NDASH() en dash character - $MDASH MDASH() em dash character - $BLABEL BLABEL() begin label (for input) - $ELABEL ELABEL() end label (for input) - $BBOLD BBOLD() begin bold typeface - $EBOLD EBOLD() end bold typeface - $BITALIC BITALIC() begin italic typeface - $EITALIC EITALIC() end italic typeface - $BUL BUL() begin underlined type - $EUL EUL() end underlined type - $BCENTER BCENTER() begin centered environment - $ECENTER ECENTER() end centered environment - $BLTR BLTR() begin left to right environment - $ELTR ELTR() end left to right environment - $BKBD BKBD() begin "keyboard" input text - $EKBD EKBD() end "keyboard" input text - $HR HR() horizontal rule - $LBRACE LBRACE() left brace - $LB LB () left brace - $RBRACE RBRACE() right brace - $RB RB () right brace - $DOLLAR DOLLAR() a dollar sign - $PERCENT PERCENT() a percent sign - $CARET CARET() a caret sign - $PI PI() the number pi - $E E() the number e - $LATEX LATEX() the LaTeX logo - $TEX TEX() the TeX logo - $APOS APOS() an apostrophe - -=cut - -# A utility variable. Notice that "B" = $ALPHABET[1] and -# "ABCD" = @ALPHABET[0..3]. - -sub ALPHABET { - ('A' .. 'ZZ')[@_]; -} - -############################################################### -# Some constants which are different in tex and in HTML -# The order of arguments is TeX, Latex2HTML, HTML -# Adopted Davide Cervone's improvements to PAR, LTS, GTS, LTE, GTE, LBRACE, RBRACE, LB, RB. 7-14-03 AKP -sub PAR { - MODES( - TeX => '\\vskip\\baselineskip ', - Latex2HTML => '\\begin{rawhtml}

    \\end{rawhtml}', - HTML => '

    ', - PTX => "\n\n" - ); -} -#sub BR { MODES( TeX => '\\par\\noindent ', Latex2HTML => '\\begin{rawhtml}
    \\end{rawhtml}', HTML => '
    '); }; -# Alternate definition of BR which is slightly more flexible and gives more white space in printed output -# which looks better but kills more trees. -sub BR { - MODES( - TeX => '\\leavevmode\\\\\\relax ', - Latex2HTML => '\\begin{rawhtml}
    \\end{rawhtml}', - HTML => '
    ', - PTX => "\n\n" - ); -} - -sub BRBR { - MODES( - TeX => '\\leavevmode\\\\\\relax \\leavevmode\\\\\\relax ', - Latex2HTML => '\\begin{rawhtml}

    \\end{rawhtml}', - HTML => '

    ', - PTX => "\n" - ); -} -sub LQ { MODES(TeX => "\\lq\\lq{}", Latex2HTML => '"', HTML => '"', PTX => ''); } -sub RQ { MODES(TeX => "\\rq\\rq{}", Latex2HTML => '"', HTML => '"', PTX => ''); } -sub BM { MODES(TeX => '\\(', Latex2HTML => '\\(', HTML_MathJax => '\\(', HTML => '', PTX => ''); }; # begin math mode -sub EM { MODES(TeX => '\\)', Latex2HTML => '\\)', HTML_MathJax => '\\)', HTML => '', PTX => ''); }; # end math mode - -sub BDM { - MODES(TeX => '\\[', Latex2HTML => '\\[', HTML_MathJax => '\\[', HTML => '

    ', PTX => ''); -}; #begin displayMath mode - -sub EDM { - MODES(TeX => '\\]', Latex2HTML => '\\]', HTML_MathJax => '\\]', HTML => '

    ', PTX => ''); -}; #end displayMath mode - -sub LTS { - MODES(TeX => '<', Latex2HTML => '\\lt ', HTML => '<', HTML_tth => '<', PTX => '\lt'); -}; #only for use in math mode - -sub GTS { - MODES(TeX => '>', Latex2HTML => '\\gt ', HTML => '>', HTML_tth => '>', PTX => '\gt'); -}; #only for use in math mode - -sub LTE { - MODES(TeX => '\\le ', Latex2HTML => '\\le ', HTML => '<', HTML_tth => '\\le ', PTX => '\leq'); -}; #only for use in math mode - -sub GTE { - MODES(TeX => '\\ge ', Latex2HTML => '\\ge ', HTML => '>', HTML_tth => '\\ge ', PTX => '\geq'); -}; #only for use in math mode - -sub BEGIN_ONE_COLUMN { - MODES(TeX => "\\ifdefined\\nocolumns\\else\\end{multicols}\\fi\n", Latex2HTML => " ", HTML => " "); -} - -sub END_ONE_COLUMN { - MODES( - TeX => "\\ifdefined\\nocolumns\\else\\begin{multicols}{2}\n\\columnwidth=\\linewidth\\fi\n", - Latex2HTML => ' ', - HTML => ' ' - ); -} - -sub SOLUTION_HEADING { - MODES( - TeX => '{\\bf ' . maketext('Solution: ') . ' }', - Latex2HTML => '\\par {\\bf ' . maketext('Solution:') . ' }', - HTML => '' . maketext('Solution:') . ' ', - PTX => '' - ); -} - -sub HINT_HEADING { - MODES( - TeX => "{\\bf " . maketext('Hint: ') . "}", - Latex2HTML => "\\par {\\bf " . maketext('Hint:') . " }", - HTML => "" . maketext('Hint:') . " ", - PTX => '' - ); -} -sub US { MODES(TeX => '\\_', Latex2HTML => '\\_', HTML => '_', PTX => '_'); }; # underscore, e.g. file${US}name - -sub SPACE { - MODES(TeX => '\\ ', Latex2HTML => '\\ ', HTML => ' ', PTX => ' '); -}; # force a space in latex, doesn't force extra space in html -sub NBSP { MODES(TeX => '~', Latex2HTML => '~', HTML => ' ', PTX => ''); } -sub NDASH { MODES(TeX => '--', Latex2HTML => '--', HTML => '–', PTX => ''); } -sub MDASH { MODES(TeX => '---', Latex2HTML => '---', HTML => '—', PTX => ''); } -sub BBOLD { MODES(TeX => '{\\bf ', Latex2HTML => '{\\bf ', HTML => '', PTX => ''); } -sub EBOLD { MODES(TeX => '}', Latex2HTML => '}', HTML => '', PTX => ''); } -sub BLABEL { MODES(TeX => '', Latex2HTML => '', HTML => '', PTX => ''); } -sub BITALIC { MODES(TeX => '{\\it ', Latex2HTML => '{\\it ', HTML => '', PTX => ''); } -sub EITALIC { MODES(TeX => '} ', Latex2HTML => '} ', HTML => '', PTX => ''); } -sub BUL { MODES(TeX => '\\underline{', Latex2HTML => '\\underline{', HTML => '', PTX => ''); } -sub EUL { MODES(TeX => '}', Latex2HTML => '}', HTML => '', PTX => ''); } - -sub BCENTER { - MODES( - TeX => '\\begin{center} ', - Latex2HTML => ' \\begin{rawhtml}
    \\end{rawhtml} ', - HTML => '
    ', - PTX => '' - ); -} - -sub ECENTER { - MODES( - TeX => '\\end{center} ', - Latex2HTML => ' \\begin{rawhtml}
    \\end{rawhtml} ', - HTML => '
    ', - PTX => '' - ); -} - -sub BLTR { - MODES( - TeX => ' ', - Latex2HTML => ' \\begin{rawhtml}
    \\end{rawhtml} ', - HTML => '', - PTX => '' - ); -} -sub ELTR { MODES(TeX => ' ', Latex2HTML => ' \\begin{rawhtml}
    \\end{rawhtml} ', HTML => '', PTX => ''); } -sub BKBD { MODES(TeX => '\\texttt{', Latex2HTML => '', HTML => '', PTX => ''); } -sub EKBD { MODES(TeX => '}', Latex2HTML => '', HTML => '', PTX => ''); } - -sub HR { - MODES( - TeX => '\\par\\hrulefill\\par ', - Latex2HTML => '\\begin{rawhtml}
    \\end{rawhtml}', - HTML => '
    ', - PTX => '' - ); -} - -sub LBRACE { - MODES(TeX => '\{', Latex2HTML => '\\lbrace', HTML => '{', HTML_tth => '\\lbrace', PTX => '{'); -}; #not for use in math mode - -sub RBRACE { - MODES(TeX => '\}', Latex2HTML => '\\rbrace', HTML => '}', HTML_tth => '\\rbrace', PTX => '}'); -}; #not for use in math mode - -sub LB { - MODES(TeX => '\{', Latex2HTML => '\\lbrace', HTML => '{', HTML_tth => '\\lbrace', PTX => '{'); -}; #not for use in math mode - -sub RB { - MODES(TeX => '\}', Latex2HTML => '\\rbrace', HTML => '}', HTML_tth => '\\rbrace', PTX => '}'); -}; #not for use in math mode -sub DOLLAR { MODES(TeX => '\\$', Latex2HTML => '$', HTML => '$', PTX => '$'); } -sub PERCENT { MODES(TeX => '\\%', Latex2HTML => '\\%', HTML => '%', PTX => '%'); } -sub CARET { MODES(TeX => '\\verb+^+', Latex2HTML => '\\verb+^+', HTML => '^', PTX => '^'); } -sub PI { 4 * atan2(1, 1); } -sub E { exp(1); } -sub LATEX { MODES(TeX => '\\LaTeX', HTML => '\\(\\mathrm\\LaTeX\\)', PTX => ''); } -sub TEX { MODES(TeX => '\\TeX', HTML => '\\(\\mathrm\\TeX\\)', PTX => ''); } -sub APOS { MODES(TeX => "'", HTML => "'", PTX => "\\'"); } - -############################################################### - -=head2 SPAN and DIV macros - These are functions primarly meant to add - HTML block level DIV or inline SPAN - tags and the relevant closing tags for HTML output. - - At present, these macros require the user to provide TeX and - preTeXt strings which will be used in those modes instead of the - HTML block level DIV or inline SPAN tag. - - If they are missing, they will default to the empty string. - If only one string is given, it will be assumed to be the TeX string. - - At present only the following 4 HTML attributes can be set: - lang, dir, class, style. - Using the style option requires creating valid CSS text. - For safety some parsing/cleanup is done and various sorts of - (apparently) invalid values may be dropped. See the code for - details of what input sanitation is done. - - Since the use of style is particularly dangerous, in order to - enable its use you must set allowStyle to 1 in the hash. It is - possible to prevent the use of some of the other options by - setting certain control like allowLang to 0. - - Usage: - openSpan( options_hash, "tex code", "ptx code" ); - closeSpan("tex code", "ptx code"); - - Usage where TeX and PTX output will be empty by default. - openSpan( options_hash ); - closeSpan(); - - Sample options hashes - - { "lang" => "he", - "dir" => "rtl", - "class" => "largeText class123" } - - { "lang" => "he", - "allowStyle" => 1, - "style" => "background-color: \"#afafaf; float: left;\t height: 12px;" } - -=cut - -sub processDivSpanOptions { - my $option_ref = {}; - $option_ref = shift if ref($_[0]) eq 'HASH'; - - my %options = ( - allowLang => 1, # Setting the lang tag is allowed by default - allowDir => 1, # Setting the dir tag is allowed by default - allowClass => 1, # Setting the class tag is allowed by default - allowStyle => 0, # Setting the style tag is FORBIDDEN by default, use with care! - %{$option_ref}, - ); - - my $LangVal = ""; - if ($options{allowLang} && defined($options{lang})) { - # The standard for how the lang tag should be set is explained in - # https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/lang - # based on the BCP47 standard from https://www.ietf.org/rfc/bcp/bcp47.txt - - # We are going to do only minimal cleanup to the value provided - # making sure that all the characters are in the valid range A-Za-z0-9\- - # but not checking the inner structure - $LangVal = $options{lang}; - if ($LangVal =~ /[^\w\-]/) { - # Clean it up - $LangVal =~ s/[^\w\-]//g; # Drop invalid characters - WARN_MESSAGE( - "processDivSpanOptions received an HTML LANG attribute setting with invalid characters which were removed. The value after cleanup is $LangVal which may not be what was intended. See https://developer.mozilla.org/en-US/docs/Web/HTML/Global_attributes/lang for information on how this value should be set" - ); - } - } - - my $DirVal = ""; - if ($options{allowDir} && defined($options{dir})) { - # the ONLY allowed values are: ltr rtl auto - if (($options{dir} eq "ltr") - || ($options{dir} eq "rtl") - || ($options{dir} eq "auto")) - { - $DirVal = $options{dir}; - } else { - WARN_MESSAGE( - "processDivSpanOptions received an invalid value for the HTML DIR attribute. Only ltr rtl auto are allowed. As a result the DIR attribute has not been set." - ); - } - } - - my $ClassVal = ""; - if ($options{allowClass} && defined($options{class})) { - # Class names which are permitted here must start with a letter [A-Za-z] - # and the rest of the class name can be characters in [A-Za-z0-9\-\_]. - - # A space is used to separate class names - - # The offical W3C documentation allows class names to follow a far more general - # grammar, but this is not being permitted here at present. - # See: https://www.w3.org/TR/css-syntax-3/#token-diagrams - - my $hadBadClassNames = 0; - my @rawList = split(' ', $options{class}); - my @okList; # Will collect valid class names - my $cl; - while (@rawList) { - $cl = shift(@rawList); - if ($cl =~ /^[A-Za-z][\w\-\_]*$/) { - push(@okList, $cl); - } else { - $hadBadClassNames = 1; - # print "Invalid classname $cl dropped\n"; - } - } - if (@okList) { - $ClassVal = join(' ', @okList); - WARN_MESSAGE( - "processDivSpanOptions received some CSS class names which are not permitted by PG for the HTML CLASS attribute. Any invalid names were dropped." - ) if ($hadBadClassNames); - } else { - # No good values arrived - WARN_MESSAGE( - "processDivSpanOptions received ONLY CSS class names which are not permitted by PG for the HTML CLASS attribute. As a result the CLASS attribute has not been set." - ) if ($hadBadClassNames); - } - } - - my $StyleVal = ""; - if ($options{allowStyle} && defined($options{style})) { - # The value is validated in a very minimal sense only - use with great care - - # Replace tab with space - $options{style} =~ s/\t/ /g; - - $StyleVal = $options{style}; - - # Mininal cleanup for safety - $StyleVal =~ s/["']//g; # Drop quotes - if ($StyleVal eq $options{style}) { - # no quotes, so now drop other characters we consider invalid - # ONLY A-Za-z-_ #:; are currently allowed. - $StyleVal =~ s/[^\w\-\_ #:;]//g; - } - - if ($StyleVal ne $options{style}) { - # Did not seem safe - $StyleVal = ""; - WARN_MESSAGE( - "processDivSpanOptions received some characters in the STYLE string which are are not permitted by PG. As a result the entire STYLE string was dropped" - ); - } - } - - # Construct the desired HTML attributes - my $html_attribs = ""; - $html_attribs .= "lang=\"$LangVal\" " if ($LangVal ne ""); - $html_attribs .= "dir=\"$DirVal\" " if ($DirVal ne ""); - $html_attribs .= "class=\"$ClassVal\" " if ($ClassVal ne ""); - $html_attribs .= "style=\"$StyleVal\" " if ($StyleVal ne ""); - return ($html_attribs); -} - -sub openDivSpan { - my $type = shift; # "Span" or "Div"; - if ($type eq "Span" || $type eq "Div") { - # OK - } else { - WARN_MESSAGE("openDivSpan called with an invalid first argument. The entire call was discarded."); - return (); - } - my $option_ref = {}; - my $html_attribs; - if (ref($_[0]) eq 'HASH') { - $option_ref = shift; - $html_attribs = processDivSpanOptions($option_ref); - } - - my $tex_code = shift; # TeX code to be used for this - currently needs to be set by hand - my $ptx_code = shift; # preTeXt code to be used for this - currently needs to be set by hand - - # Fall back to empty TeX / preTeXt code if none was provided. - $tex_code = defined($tex_code) ? $tex_code : ""; - $ptx_code = defined($ptx_code) ? $ptx_code : ""; - - # Make a call to track this as opening a "object" which needs to be closed - # ON HOLD - as the internal balancing support is still work in progress - # internalBalancingIncrement("open${type}"); - - MODES( - TeX => "$tex_code", - Latex2HTML => qq!\\begin{rawhtml}<$type $html_attribs>\\end{rawhtml}!, - HTML => qq!<$type $html_attribs>\n!, - PTX => "$ptx_code", - ); -} - -sub closeDivSpan { - my $type = shift; # "Span" or "Div"; - if ($type eq "Span" || $type eq "Div") { - # OK - } else { - WARN_MESSAGE("closeDivSpan called with an invalid first argument. The entire call was discarded."); - return (); - } - - my $tex_code = shift; # TeX code to be used for this - currently needs to be set by hand - my $ptx_code = shift; # preTeXt code to be used for this - currently needs to be set by hand - - # Fall back to empty TeX / preTeXt code if none was provided. - $tex_code = defined($tex_code) ? $tex_code : ""; - $ptx_code = defined($ptx_code) ? $ptx_code : ""; - - # Make a call to track this as closing a tracked "object" which was reported as opened - # ON HOLD - as the internal balancing support is still work in progress - # internalBalancingDecrement("open${type}"); - - MODES( - TeX => "$tex_code", - Latex2HTML => qq!\\begin{rawhtml}\\end{rawhtml}!, - HTML => qq!\n!, - PTX => "$ptx_code", - ); -} - -sub openSpan { - openDivSpan(("Span", @_)); -} - -sub openDiv { - openDivSpan(("Div", @_)); -} - -sub closeSpan { - closeDivSpan(("Span", @_)); -} - -sub closeDiv { - closeDivSpan(("Div", @_)); -} - -############################################################### -## Evaluation macros - -=head2 TEXT macros - - Usage: - TEXT(@text); - -This is the simplest way to print text from a problem. The strings in the array C<@text> are concatenated -with spaces between them and printed out in the text of the problem. The text is not processed in any other way. -C is defined in PG.pl. - - Usage: - BEGIN_TEXT - text..... - END_TEXT - -This is the most common way to enter text into the problem. All of the text between BEGIN_TEXT and END_TEXT -is processed by the C macro described below and then printed using the C command. The two key words -must appear on lines by themselves. The preprocessing that makes this construction work is done in F. -See C below for details on the processing. - -=cut - -=head2 Evaluation macros - -=head3 EV3 - - TEXT(EV3("This is a formulat \( \int_0^5 x^2 \, dx \) "); - TEXT(EV3(@text)); - - TEXT(EV3(<<'END_TEXT')); - text stuff... - END_TEXT - -The BEGIN_TEXT/END_TEXT construction is translated into the construction above by PGtranslator.pm. END_TEXT must appear -on a line by itself and be left justified. (The << construction is known as a "here document" in UNIX and in PERL.) - -The single quotes around END_TEXT mean that no automatic interpolation of variables takes place in the text. -Using EV3 with strings which have been evaluated by double quotes may lead to unexpected results. - -The evaluation macro E3 first evaluates perl code inside the braces: C<\{ code \}>. -Any perl statment can be put inside the braces. The -result of the evaluation (i.e. the last statement evaluated) replaces the C<\{ code \}> construction. - -Next interpolation of all variables (e.g. C<$var or @array> ) is performed. - -Then mathematical formulas in TeX are evaluated within the -C<\( tex math mode \)> and -C<\[ tex display math mode \] > -constructions, in that order: - -=head3 refreshEquations - - refreshEquations(1); - -Prevents equations generated in "image mode" from being cached. This can be useful for debugging. -It has no effect in the other modes. - -=cut - -sub refreshEquations { - my $in = shift; - if ($displayMode eq "HTML_dpng") { - $envir->{imagegen}->refresh($in); - } -} - -=head3 addToTeXPreamble - - addToTeXPreamble("\newcommand{\myVec}[1]{\vec{#1}} "); - -Defines C<\myVec > for all the equations in the file. You can change the vector notation for an entire PG question -by changing just this line. - -If you place this macro in PGcourse.pl remember to use double backslashes because it is a .pl file. -In .pg files use single backslashes. This is in accordance with the usual rules for backslash -in PG. - -For the moment this change only works in image mode. It does not work in -jsMath or MathJax mode. Stay tuned. - -Adding this command - - \newcommand{\myVec}[1]{\vec{#1}} - -to TeX(hardcopy) portion of the setHeaderCombinedFile.pg ( or to the setHeaderHardcopyFile.pg -for each homework set will take care of the TeX hardcopy version - -You can also modify the TexPreamble file in webwork2/conf/snippets to set the definition -of \myVec for hardcopy for the entire site. - -There are ways you can use course.conf to allow course by course modification by choosing -different TeXPreamble files for different courses - -=cut - -sub addToTeXPreamble { - my $str = shift; - if ($displayMode eq "HTML_dpng") { - $envir->{imagegen}->addToTeXPreamble($str . "\n"); - } elsif ($displayMode eq "TeX" and $envir->{probNum} == 0) { - - # in TeX mode we are typically creating an entire homework set - # and typesetting that so w only want the TeXPreamble to - # appear once -- towards the beginning. - # This is potentially fragile -- if one starts - # typesetting problems separately this will fail. - # The reason for the multicols commands is baroque - # If they are not there then the newcommand gets printed - # inside a multicols environment and its scope doesn't reach the whole file - # It has to do with the way the multicol single col stuff was set up - # when printing hardcopy. --it's weird and there must be a better way. - TEXT("\\ifdefined\\nocolumns\\else \\end{multicols} \\fi\n", - $str, "\n", "\\ifdefined\\nocolumns\\else \\begin{multicols}{2}\\columnwidth=\\linewidth \\fi\n"); - } else { # for jsMath and MathJax mode - my $mathstr = "\\(" . $str . "\\)"; #add math mode. - $mathstr =~ s/\\/\\\\/g; # protect math modes ($str has a true TeX command, - # with single backslashes. The backslashes have not - # been protected by the .pg problem preprocessor - TEXT(EV3($mathstr)); - } -} - -=head3 FEQ - - FEQ($string); # processes and outputs the string - -The mathematical formulas are run through the macro C (Format EQuations) which performs -several substitutions (see below). -In C mode the resulting code is processed by tth to obtain an HTML version -of the formula. (In the future processing by WebEQ may be added here as another option.) -The Latex2HTML mode does nothing -at this stage; it creates the entire problem before running it through -TeX and creating the GIF images of the equations. - -The resulting string is output (and usually fed into TEXT to be printed in the problem). - - Usage: - - $string2 = FEQ($string1); - -This is a filter which is used to format equations by C and C, but can also be used on its own. It is best -understood with an example. - - $string1 = "${a}x^2 + ${b}x + {$c:%.1f}"; $a = 3;, $b = -2; $c = -7.345; - -when interpolated becomes: - - $string1 = '3x^2 + -2x + {-7.345:%0.1f} - -FEQ first changes the number of decimal places displayed, so that the last term becomes -7.3 Then it removes the -extraneous plus and minus signs, so that the final result is what you want: - - $string2 = '3x^2 - 2x -7.3'; - -(The %0.1f construction -is the same formatting convention used by Perl and nearly identical to the one used by the C printf statement. Some common -usage: %0.3f 3 decimal places, fixed notation; %0.3e 3 significant figures exponential notation; %0.3g uses either fixed -or exponential notation depending on the size of the number.) - -Two additional legacy formatting constructions are also supported: - -C will give a number with 3 decimal places and a negative -sign if the number is negative, no sign if the number is positive. Since this is -identical to the behavior of C<{$c:%0.3f}> the use of this syntax is depricated. - -C determines the sign and prints it -whether the number is positive or negative. You can use this -to force an expression such as C<+5.456>. - -=head3 EV2 - - TEXT(EV2(@text)); - - TEXT(EV2(< with C<@text = ("Hello", "World");> becomes, -after interpolation, C<\{ join(" ", Hello World) \}> which then causes an error when evaluated because Hello is a bare word. -C can still be useful if you allow for this, and in particular it works on double quoted strings, which lead to -unexpected results with C. Using single quoted strings with C may lead to unexpected results. - -The unexpected results have to do with the number of times backslashed constructions have to be escaped. It is quite messy. For -more details get a good Perl book and then read the code. :-) - -=cut - -sub ev_substring { - my $string = shift; - my $start_delim = shift; - my $end_delim = shift; - my $actionRef = shift; - my ($eval_out, $PG_eval_errors, $PG_full_error_report) = (); - my $out = ""; - while ($string ne "") { # DPVC -- 2001/12/07 - original "while ($string)" fails to process the string "0" correctly - if ($string =~ /\Q$start_delim\E/s) { - #print "$start_delim $end_delim evaluating_substring=$string
    "; - $string =~ s/^(.*?)\Q$start_delim\E//s - ; # get string up to next \{ ---treats string as a single line, ignoring returns - $out .= $1; - #print "$start_delim $end_delim substring_out=$out
    "; - $string =~ - s/^(.*?)\Q$end_delim\E//s; # get perl code up to \} ---treats string as a single line, ignoring returns - #print "$start_delim $end_delim evaluate_string=$1
    "; - ($eval_out, $PG_eval_errors, $PG_full_error_report) = &$actionRef($1); - $eval_out = "$start_delim $eval_out $end_delim" if $PG_full_error_report; - $out = $out . $eval_out; - #print "$start_delim $end_delim new substring_out=$out


    "; - $out .= "$PAR ERROR $0 in ev_substring, PGbasicmacros.pl:$PAR 

      $@
    $PAR" if $@; - } else { - $out .= $string; # flush the last part of the string - last; - } - - } - $out; -} - -sub safe_ev { - my ($out, $PG_eval_errors, $PG_full_error_report) = &old_safe_ev; # process input by old_safe_ev first - $out = "" unless defined($out) and $out =~ /\S/; - $out =~ s/\\/\\\\/g; # protect any new backslashes introduced. - ($out, $PG_eval_errors, $PG_full_error_report); -} - -sub old_safe_ev { - my $in = shift; - my ($out, $PG_eval_errors, $PG_full_error_report) = PG_restricted_eval("$in;"); - # the addition of the ; seems to provide better error reporting - if ($PG_eval_errors) { - my @errorLines = split("\n", $PG_eval_errors); -#$out = "
    $PAR % ERROR in $0:old_safe_ev, PGbasicmacros.pl: $PAR % There is an error occuring inside evaluation brackets \\{ ...code... \\} $BR % somewhere in an EV2 or EV3 or BEGIN_TEXT block. $BR % Code evaluated:$BR $in $BR % $BR % $errorLines[0]\n % $errorLines[1]$BR % $BR % $BR
    "; - warn " ERROR in old_safe_ev, PGbasicmacros.pl: 
    -		## There is an error occuring inside evaluation brackets \\{ ...code... \\}
-		## somewhere in an EV2 or EV3 or BEGIN_TEXT block.
-		## Code evaluated:
-		## $in
-		##" . join("\n     ", @errorLines) . "
-		##
    $BR - "; - $out = "$PAR $BBOLD $in $EBOLD $PAR"; - } - - ($out, $PG_eval_errors, $PG_full_error_report); -} - -sub FEQ { # Format EQuations - my $in = shift; - # formatting numbers -- the ?{} and !{} constructions - $in =~ s/\?\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &sspf($1, $2) )}/g; - $in =~ s/\!\s*\{([.\-\$\w\d]+):?([%.\da-z]*)\}/${ \( &spf($1, $2) )}/g; - - # more formatting numbers -- {number:format} constructions - $in =~ s/\{(\s*[\+\-\d\.]+[eE]*[\+\-]*\d*):(\%\d*.\d*\w)}/${ \( &spf($1, $2) )}/g; - $in =~ s/\+\s*\-/ - /g; - $in =~ s/\-\s*\+/ - /g; - $in =~ s/\+\s*\+/ + /g; - $in =~ s/\-\s*\-/ + /g; - $in; -} - -sub math_ev3 { - my $in = shift; - return general_math_ev3($in, "inline"); -} - -sub display_math_ev3 { - my $in = shift; - return general_math_ev3($in, "display"); -} - -sub general_math_ev3 { - my $in = shift; - my $mode = shift || "inline"; - - $in = FEQ($in); # Format EQuations - $in =~ s/((^|[^\\])(\\\\)*)%/$1\\%/g; # avoid % becoming TeX comments (unless already escaped) - - ## remove leading and trailing spaces so that HTML mode will - ## not include unwanted spaces as per Davide Cervone. - $in =~ s/^\s+//; - $in =~ s/\s+$//; - ## If it ends with a backslash, there should be another space - ## at the end - if ($in =~ /(^|[^\\])(\\\\)*\\$/) { $in .= ' ' } - - # some modes want the delimiters, some don't - my $in_delim = $mode eq "inline" ? "\\($in\\)" : "\\[$in\\]"; - - my $out; - if ($displayMode eq "HTML_MathJax") { - $out = ''; - } elsif ($displayMode eq "HTML_dpng") { - # for jj's version of ImageGenerator - #$out = $envir->{'imagegen'}->add($in_delim); - # for my version of ImageGenerator - $out = $envir->{'imagegen'}->add($in, $mode); - } elsif ($displayMode eq "HTML_tth") { - $out = tth($in_delim); - ## remove leading and trailing spaces as per Davide Cervone. - $out =~ s/^\s+//; - $out =~ s/\s+$//; - } elsif ($displayMode eq "HTML_img") { - $out = math2img($in, $mode); - } elsif ($displayMode eq "HTML_jsMath") { - $in =~ s/&/&/g; - $in =~ s//>/g; - $out = '' . $in . '' if $mode eq "inline"; - $out = '
    ' . $in . '
    ' if $mode eq "display"; - } elsif ($displayMode eq "HTML_asciimath") { - $in = HTML::Entities::encode_entities($in); - $out = "`$in`" if $mode eq "inline"; - $out = '
    `' . $in . '`
    ' if $mode eq "display"; - } elsif ($displayMode eq "PTX") { - #protect XML control characters - $in =~ s/\&(?!([\w#]+;))/\\amp /g; - $in =~ s/' . "$in" . '' if $mode eq "inline"; - $out = '' . "$in" . '' if $mode eq "display"; - } elsif ($displayMode eq "HTML_LaTeXMathML") { - $in = HTML::Entities::encode_entities($in); - $in = '{' . $in . '}'; - $in =~ s/\{\s*(\\(display|text|script|scriptscript)style)/$1\{/g; - $out = '$$' . $in . '$$' if $mode eq "inline"; - $out = '
    $$\displaystyle{' . $in . '}$$
    ' if $mode eq "display"; - } elsif ($displayMode eq "HTML") { - $in_delim = HTML::Entities::encode_entities($in_delim); - $out = "$in_delim"; - } else { - $out = $in_delim; - } - return $out; -} - -sub EV2 { - my $string = join(" ", @_); - # evaluate code inside of \{ \} (no nesting allowed) - $string = ev_substring($string, "\\{", "\\}", \&old_safe_ev); - $string = ev_substring($string, "\\<", "\\>", \&old_safe_ev); - $string = ev_substring($string, "\\(", "\\)", \&math_ev3); - $string = ev_substring($string, "\\[", "\\]", \&display_math_ev3); - # macros for displaying math - $string =~ s/\\\(/$BM/g; - $string =~ s/\\\)/$EM/g; - $string =~ s/\\\[/$BDM/g; - $string =~ s/\\\]/$EDM/g; - $string; -} - -sub EV3 { - my $string = join(" ", @_); - # evaluate code inside of \{ \} (no nesting allowed) - $string = ev_substring($string, "\\\\{", "\\\\}", \&safe_ev); # handles \{ \} in single quoted strings of PG files - # interpolate variables - my ($evaluated_string, $PG_eval_errors, $PG_full_errors) = - PG_restricted_eval("</>/g; - $evaluated_string = - "
    $PAR % ERROR in $0:EV3, PGbasicmacros.pl: $PAR % There is an error occuring in the following code:$BR $string $BR % $BR % $errorLines[0]\n % $errorLines[1]$BR % $BR % $BR
    "; - $@ = ""; - } - $string = $evaluated_string; - $string = ev_substring($string, "\\(", "\\)", \&math_ev3); - $string = ev_substring($string, "\\[", "\\]", \&display_math_ev3); - $string; -} - -sub EV4 { - if ($displayMode eq "HTML_dpng") { - my $string = join(" ", @_); - my ($evaluated_string, $PG_eval_errors, $PG_full_errors) = - PG_restricted_eval("</>/g; - $evaluated_string = - "
    $PAR % ERROR in $0:EV3, PGbasicmacros.pl:"
-				. "$PAR % There is an error occuring in the following code:$BR "
-				. "$string $BR % $BR % $errorLines[0]\n % $errorLines[1]$BR "
-				. "% $BR % $BR
    "; - } - $string = $evaluated_string; - $string = $envir{'imagegen'}->add($string); - $string; - } else { - EV3(@_); - } -} - -=head3 EV3P - - ###################################################################### - # - # New version of EV3 that allows `...` and ``...`` to insert TeX produced - # by the new Parser (in math and display modes). - # - # Format: EV3P(string, ...); - # EV3P({options}, string, ...); - # - # `x^2/5` will become \(\frac{x^2}{5}\) and then rendered for hardcopy or screen output - # - # where options can include: - # - # processCommands => 0 or 1 Indicates if the student's answer will - # be allowed to process \{...\}. - # Default: 1 - # - # processVariables => 0 1 Indicates whether variable substitution - # should be performed on the student's - # answer. - # Default: 1 - # - # processMath => 0 or 1 Indicates whether \(...\), \[...\], - # `...` and ``...`` will be processed - # in the student's answer. - # Default: 1 - # - # processParser => 0 or 1 Indicates if `...` and ``...`` should - # be processed when math is being - # processed. - # Default: 1 - # - # fixDollars => 0 or 1 Specifies whether dollar signs not followed - # by a letter should be replaced by ${DOLLAR} - # prior to variable substitution (to prevent - # accidental substitution of strange Perl - # values). - # Default: 1 - # - -=cut - -sub EV3P { - my $option_ref = {}; - $option_ref = shift if ref($_[0]) eq 'HASH'; - my %options = ( - processCommands => 1, - processVariables => 1, - processParser => 1, - processMath => 1, - fixDollars => 1, - %{$option_ref}, - ); - my $string = join(" ", @_); - $string = ev_substring($string, "\\\\{", "\\\\}", \&safe_ev) if $options{processCommands}; - if ($options{processVariables}) { - my $eval_string = $string; - $eval_string =~ s/\$(?![a-z\{])/\${DOLLAR}/gi if $options{fixDollars}; - my ($evaluated_string, $PG_eval_errors, $PG_full_errors) = - PG_restricted_eval("</>/g; - $evaluated_string = $BBOLD . "(Error: $error in '$string')" . $EBOLD; - } - $string = $evaluated_string; - } else { - $string =~ s/\\\\/\\/g; - } - - if ($options{processMath}) { - $string = EV3P_parser($string) if $options{processParser}; - $string = ev_substring($string, "\\(", "\\)", \&math_ev3); - $string = ev_substring($string, "\\[", "\\]", \&display_math_ev3); - } - - if ($displayMode eq 'PTX') { $string = PTX_cleanup($string) } - - return $string; -} - -# -# Look through a string for ``...`` or `...` and use -# the parser to produce TeX code for the specified mathematics. -# ``...`` does display math, `...` does in-line math. They -# can also be used within math mode already, in which case they -# use whatever mode is already in effect. -# -sub EV3P_parser { - my $string = shift; - return $string unless $string =~ m/`/; - my $start = ''; - my %end = ('\(' => '\)', '\[' => '\]'); - my @parts = split(/(``.*?``\*?|`.+?`\*?|(?:\\[()\[\]]))/s, $string); - foreach my $part (@parts) { - if ($part =~ m/^(``?)(.*)\1(\*?)$/s) { - my ($delim, $math, $star) = ($1, $2, $3); - my $f = Parser::Formula($math); - if (defined($f)) { - $f = $f->reduce if $star; - $part = $f->TeX; - $part = ($delim eq '`' ? '\(' . $part . '\)' : '\[' . $part . '\]') if (!$start); - } else { - ## FIXME: use context->{error}{ref} to highlight error in $math. - $part = $BBOLD . "(Error: $$Value::context->{error}{message} '$math')" . $EBOLD; - $part = $end{$start} . " " . $part . " " . $start if $start; - } - } elsif ($start) { - $start = '' if $part eq $end{$start}; - } elsif ($end{$part}) { - $start = $part; - } - } - return join('', @parts); -} - -sub PTX_cleanup { - my $string = shift; - # Wrap

    tags where necessary, and other cleanup - # Nothing else should be creating p tags, so assume all p tags created here - # The only supported top-level elements within a statement, hint, or solution in a problem - # are p, blockquote, pre, tabular, image, video - if ($displayMode eq 'PTX') { - #encase entire string in

    - #except not for certain "sub" structures that are also passed through EV3 - $string = "

    " . $string . "

    " unless (($string =~ /^]*\/>$/) or ($string =~ /^$/s)); - - #inside a li, the only permissible children are p, image, video, and tabular - #insert opening and closing p, to be removed later if they enclose an image, video or tabular - #we are not going to look to see if there is a nested list in there - $string =~ s/(]*(?)/$1\n

    /g; - $string =~ s/(<\/li>)/<\/p>\n$1/g; - - #close p right before any blockquote, pre, image, video, or tabular - #and open p immediately following. Later any potential side effects are cleaned up. - $string =~ s/(<(blockquote|pre|image|video|tabular)[^>]*(?)/<\/p>\n$1/g; - $string =~ s/(<\/(blockquote|pre|image|video|tabular)>)/$1\n

    /g; - $string =~ s/(<(blockquote|pre|image|video|tabular)[^>]*(?<=\/)>)/<\/p>\n$1\n

    /g; - - #within a , we may have an issue if there was an image that had '<\p>' and '

    ' wrapped around - #it from the above block. If the '

    ' has a preceding '

    ' within the cell, no problem. Otherwise, - #the '

    ' must go. Likewise at the other end. - $string =~ s/(?s)(.*?)<\/p>\n(]*(?<=\/)>)\n

    (.*?<\/cell>)/$1$2$3/g; - - #remove blank lines; assume the intent was to end a p and start a new one - #but don't put closing and opening p replacing the blank lines if they precede or follow a - #or an

  • - $string =~ s/(\r\n?|\n)(\r\n?|\n)+(?!(|<\/tabular>|
  • |\r\n?|\n))/<\/p>\n

    /g; - $string =~ s/(\r\n?|\n)(\r\n?|\n)+(?=(|<\/tabular>|

  • |\r\n?|\n))/\n/g; - - #remove whitespace following

    - $string =~ s/(?s)(

    )\s*/$1/g; - - #remove whitespace preceding

    - $string =~ s/(?s)\s*(<\/p>)/$1/g; - - #move PTX warnings from the beginning of inside a p to just before the p. - $string =~ s/

    ()/$1\n

    /g; - - #remove doulbe p's we may have created - $string =~ s/

    /

    /g; - $string =~ s/<\/p><\/p>/<\/p>/g; - - #remove empty p - $string =~ s/(\r\n?|\n)?

    <\/p>//g; - - #a tabular cell may have

    and

    but no corresponding width specification in a col. - #if so, remove all

    and

    from all cells. - my $previous; - do { - $previous = $string; - $string =~ - s/(?s)((?:\s| "\n%%% BEGIN PROBLEM PREAMBLE\n" - , #Marker used in PreTeXt LaTeX extraction; contact alex.jordan@pcc.edu before modifying - HTML => "" - ); - $out .= MODES(%{ main::PG_restricted_eval(q!$main::problemPreamble!) }); - $out .= MODES( - TeX => "\n%%% END PROBLEM PREAMBLE\n" - , #Marker used in PreTeXt LaTeX extraction; contact alex.jordan@pcc.edu before modifying - HTML => "" - ); - if ($displayMode eq 'PTX') { $out = '' } - $out; -} - -sub nicestring { - my $thingy = shift; - my @coefs = @{$thingy}; - my $n = scalar(@coefs); - $thingy = shift; - my @others; - if (defined($thingy)) { - @others = @{$thingy}; - } else { - for my $j (1 .. ($n - 2)) { - $others[ $j - 1 ] = "x^" . ($n - $j); - } - if ($n >= 2) { $others[ $n - 2 ] = "x"; } - $others[ $n - 1 ] = ""; - } - my ($j, $k) = (0, 0); - while (($k < $n) && ($coefs[$k] == 0)) { $k++; } - if ($k == $n) { return ("0"); } - my $ans; - if ($coefs[$k] == 1) { $ans = ($others[$k]) ? "$others[$k]" : "1"; } - elsif ($coefs[$k] == -1) { $ans = ($others[$k]) ? "- $others[$k]" : "-1" } - else { $ans = "$coefs[$k] $others[$k]"; } - $k++; - - for $j ($k .. ($n - 1)) { - if ($coefs[$j] != 0) { - if ($coefs[$j] == 1) { - $ans .= ($others[$j]) ? "+ $others[$j]" : "+ 1"; - } elsif ($coefs[$j] == -1) { - $ans .= ($others[$j]) ? "- $others[$j]" : "-1"; - } else { - $ans .= "+ $coefs[$j] $others[$j]"; - } - } - } - return ($ans); -} - -# kludge to clean up path names -## allow underscore character in set and section names and also allows line breaks at / -sub protect_underbar { - my $in = shift; - if ($displayMode eq 'TeX') { - $in =~ s|_|\\\_|g; - $in =~ s|/|\\\-/|g; # allows an optional hyphenation of the path (in tex) - } - $in; -} - -# An example of a macro which prints out a list (with letters) -sub OL { - my @array = @_; - my $i = 0; - my @alpha = ('A' .. 'Z', 'AA' .. 'ZZ'); - my $letter; - my $out = MODES( - TeX => "\\begin{enumerate}\n", - Latex2HTML => " \\begin{rawhtml}
      \\end{rawhtml} ", - HTML => "
      \n", - PTX => '
        ' . "\n", - ); - my $elem; - foreach $elem (@array) { - $letter = shift @alpha; - $out .= MODES( - TeX => "\\item[$ALPHABET[$i].] $elem\n", - Latex2HTML => " \\begin{rawhtml}
      1. \\end{rawhtml} $elem ", - HTML => "
        $letter. $elem\n", - HTML_dpng => "
        $letter. $elem \n", - PTX => "

      2. $elem

        3. \n", - ); - $i++; - } - $out .= MODES( - TeX => "\\end{enumerate}\n", - Latex2HTML => " \\begin{rawhtml}
      \n \\end{rawhtml} ", - HTML => "
      \n", - PTX => '
    ' . "\n", - ); -} - -sub htmlLink { - my $url = shift; - my $text = shift; - my $options = shift; - my $sanitized_url = $url; - $sanitized_url =~ s/&/&/g; - $options = "" unless defined($options); - return "$BBOLD [ the link to '$text' is broken ] $EBOLD" unless defined($url) and $url; - MODES( - TeX => "{\\bf \\underline{$text}}", - HTML => "$text", - PTX => "$text", - ); -} - -# Suggested usage: knowlLink(text, [url => ..., value => ..., type => ...]) -sub knowlLink { - my $display_text = shift; - - # Check that there are an even number of inputs - WARN_MESSAGE( - 'usage: knowlLink($display_text, [url => $url, value => $helpMessage, type => "help/hint/solution/..."]);' - . qq!after the display_text the information requires key/value pairs. - Received @_ !, scalar(@_) % 2 - ) if scalar(@_) % 2; - - my %options = @_; - - my $properties = ''; - if ($options{value}) { - $properties = - 'data-knowl-contents="' - . encode_pg_and_html($options{value}) - . ($options{base64} ? '" data-base64="1"' : '"'); - } elsif ($options{url}) { - $properties = qq!data-knowl-url="$options{url}"!; - } else { - WARN_MESSAGE( - 'usage: knowlLink($display_text, [url => $url, value => $helpMessage, type => "help/hint/solution/..."]);' - ); - } - - $properties .= qq! data-type="$options{type}"! if $options{type}; - - MODES( - TeX => "{\\bf \\underline{$display_text}}", - HTML => qq!$display_text!, - PTX => '' . $display_text . '', - ); -} - -sub iframe { - my $url = shift; - my %options = @_; # keys: height, width, id, name - my $formatted_options = join(" ", map {qq!$_ = "$options{$_}"!} (keys %options)); - return "$BBOLD\[ broken link: $url \] $EBOLD" unless defined($url); - MODES( - TeX => "\\framebox{" . protect_underbar($url) . "}\n", - HTML => qq!\n \n!, - PTX => '', - ); -} - -sub helpLink { - my $type = shift; - my $display_text = shift || $type; - my $helpurl = shift; - return "" if (not defined($envir{'localHelpURL'})); - if (defined $helpurl) { - return knowlLink($display_text, url => $envir{'localHelpURL'} . $helpurl, type => 'help'); - } - my %typeHash = ( - 'angle' => 'Entering-Angles.html', - 'decimal' => 'Entering-Decimals.html', - 'equation' => 'Entering-Equations.html', - 'exponent' => 'Entering-Exponents.html', - 'formula' => 'Entering-Formulas.html', - 'fraction' => 'Entering-Fractions.html', - 'inequalit' => 'Entering-Inequalities.html', - 'limit' => 'Entering-Limits.html', - 'log' => 'Entering-Logarithms.html', - 'number' => 'Entering-Numbers.html', - 'point' => 'Entering-Points.html', - 'vector' => 'Entering-Vectors.html', - 'interval' => 'IntervalNotation.html', - 'unit' => 'Units.html', - 'syntax' => 'Syntax.html', - ); - - my $infoRef = ''; - my $refhold = ''; - for my $ref (keys %typeHash) { - if ($type =~ /$ref/i) { - $infoRef = $typeHash{$ref}; - $refhold = $ref; - last; - } - } - # We use different help files in some cases when BaseTenLog is set - if (PG_restricted_eval(q/$envir{useBaseTenLog}/)) { - $infoRef = 'Entering-Logarithms10.html' if ($refhold eq 'log'); - $infoRef = 'Entering-Formulas10.html' if ($refhold eq 'formula'); - } - - # If infoRef is still '', we give up and just print plain text - return $display_text unless ($infoRef); - return knowlLink($display_text, url => $envir{'localHelpURL'} . $infoRef, type => 'help'); -} - -# This method is deprecated. There is no hope for the problems that use it. Java and flash are dead. -sub appletLink { - warn 'Applet problems that use the appletLink method are no longer supported.'; - MODES( - TeX => "{\\bf WeBWorK does not support appletLink}", - HTML => "
    WeBWorK does not support appletLink
    ", - PTX => 'PreTeXt does not support appletLink', - ); -} - -sub spf { - my ($number, $format) = @_; # attention, the order of format and number are reversed - $format = "%4.3g" unless $format; # default value for format - sprintf($format, $number); -} - -sub sspf { - my ($number, $format) = @_; # attention, the order of format and number are reversed - $format = "%4.3g" unless $format; # default value for format - my $sign = $number >= 0 ? " + " : " - "; - $number = $number >= 0 ? $number : -$number; - $sign . sprintf($format, $number); -} - -=head2 Sorting and other list macros - - Usage: - lex_sort(@list); # outputs list in lexigraphic (alphabetical) order - num_sort(@list); # outputs list in numerical order - uniq( @list); # outputs a list with no duplicates. Order is unspecified. - - PGsort( \&sort_subroutine, @list); - # &sort_subroutine defines order. It's output must be 1 or 0 (true or false) - -=cut - -# uniq gives unique elements of a list: -sub uniq { - my @in = @_; - my %temp = (); - while (@in) { - $temp{ shift(@in) }++; - } - my @out = keys %temp; # sort is causing trouble with Safe.?? - @out; -} - -sub lex_sort { - PGsort(sub { $_[0] lt $_[1] }, @_); -} - -sub num_sort { - PGsort(sub { $_[0] < $_[1] }, @_); -} - -=head2 Macros for handling tables - - Usage: - begintable( number_of_columns_in_table) - row(@dataelements) - endtable() - -Example of useage: - - BEGIN_TEXT - This problem tests calculating new functions from old ones:$BR - From the table below calculate the quantities asked for:$BR - \{begintable(scalar(@firstrow)+1)\} - \{row(" \(x\) ", @firstrow)\} - \{row(" \(f(x)\) ", @secondrow)\} - \{row(" \(g(x)\) ", @thirdrow)\} - \{row(" \(f'(x)\) ", @fourthrow)\} - \{row(" \(g'(x)\) ", @fifthrow)\} - \{endtable()\} - - (The arrays contain numbers which are placed in the table.) - - END_TEXT - -=cut - -sub begintable { - my $number = shift; #number of columns in table - my %options = @_; - warn "begintable(cols) requires a number indicating the number of columns" unless defined($number); - my $out = ""; - if ($displayMode eq 'TeX') { - $out .= "\n\\par\\smallskip\\begin{center}\\begin{tabular}{" . "|c" x $number . "|} \\hline\n"; - } elsif ($displayMode eq 'PTX') { - $out .= "\n" . '' . "\n"; - } elsif ($displayMode eq 'Latex2HTML') { - $out .= "\n\\begin{rawhtml} \n\\end{rawhtml}"; - } elsif ($displayMode eq 'HTML_MathJax' - || $displayMode eq 'HTML_dpng' - || $displayMode eq 'HTML' - || $displayMode eq 'HTML_tth' - || $displayMode eq 'HTML_jsMath' - || $displayMode eq 'HTML_asciimath' - || $displayMode eq 'HTML_LaTeXMathML' - || $displayMode eq 'HTML_img') - { - $out .= ''; - } else { - $out = "Error: PGbasicmacros: begintable: Unknown displayMode: $displayMode.\n"; - } - $out; -} - -sub endtable { - my $out = ""; - if ($displayMode eq 'TeX') { - $out .= "\n\\end {tabular}\\end{center}\\par\\smallskip\n"; - } elsif ($displayMode eq 'PTX') { - $out .= "\n" . '' . "\n"; - } elsif ($displayMode eq 'Latex2HTML') { - $out .= "\n\\begin{rawhtml}
    \n\\end{rawhtml}"; - } elsif ($displayMode eq 'HTML_MathJax' - || $displayMode eq 'HTML_dpng' - || $displayMode eq 'HTML' - || $displayMode eq 'HTML_tth' - || $displayMode eq 'HTML_jsMath' - || $displayMode eq 'HTML_asciimath' - || $displayMode eq 'HTML_LaTeXMathML' - || $displayMode eq 'HTML_img') - { - $out .= ''; - } else { - $out = "Error: PGbasicmacros: endtable: Unknown displayMode: $displayMode.\n"; - } - $out; -} - -sub row { - my @elements = @_; - my $out = ""; - if ($displayMode eq 'TeX') { - while (@elements) { - $out .= shift(@elements) . " &"; - } - chop($out); # remove last & - $out .= "\\\\ \\hline \n"; - # carriage returns must be added manually for tex - } elsif ($displayMode eq 'PTX') { - $out .= '' . "\n"; - while (@elements) { - $out .= '' . shift(@elements) . '' . "\n"; - } - $out .= '' . "\n"; - } elsif ($displayMode eq 'Latex2HTML') { - $out .= "\n\\begin{rawhtml}\n\n\\end{rawhtml}\n"; - while (@elements) { - $out .= - " \n\\begin{rawhtml}\n \n\\end{rawhtml}\n" - . shift(@elements) - . " \n\\begin{rawhtml}\n \n\\end{rawhtml}\n"; - } - $out .= " \n\\begin{rawhtml}\n \n\\end{rawhtml}\n"; - } elsif ($displayMode eq 'HTML_MathJax' - || $displayMode eq 'HTML_dpng' - || $displayMode eq 'HTML' - || $displayMode eq 'HTML_tth' - || $displayMode eq 'HTML_jsMath' - || $displayMode eq 'HTML_asciimath' - || $displayMode eq 'HTML_LaTeXMathML' - || $displayMode eq 'HTML_img') - { - $out .= "\n"; - while (@elements) { - $out .= "" . shift(@elements) . ""; - } - $out .= "\n\n"; - } else { - $out = "Error: PGbasicmacros: row: Unknown displayMode: $displayMode.\n"; - } - $out; -} - -=head2 Macros for displaying images - -Usage: - - image($image, width => 100, height => 100, tex_size => 800, alt => 'alt text', extra_html_tags => 'style="border:solid black 1pt"'); - -where C<$image> can be a local file path, URL, WWPlot object, PGlateximage object, -or PGtikz object, C and C are pixel counts for HTML display, -while C is per 1000 applied to linewidth (for example 800 leads to 0.8\linewidth) - - image([$image1,$image2], width => 100, height => 100, tex_size => 800, alt => ['alt text 1','alt text 2'], extra_html_tags => 'style="border:solid black 1pt"'); - image([$image1,$image2], width => 100, height => 100, tex_size => 800, alt => 'common alt text', extra_html_tags => 'style="border:solid black 1pt"'); - -this produces an array in array context and joins the elements with C<' '> in scalar context - -=cut - -# More advanced macros -sub image { - my $image_ref = shift; - my @opt = @_; - unless (scalar(@opt) % 2 == 0) { - warn "ERROR in image macro. A list of macros must be inclosed in square brackets."; - } - my %in_options = @opt; - my %known_options = ( - width => 100, - height => '', - tex_size => 800, - # default value for alt is undef, since an empty string is the explicit indicator of a decorative image - alt => undef, - extra_html_tags => '', - ); - # handle options - my %out_options = %known_options; - foreach my $opt_name (keys %in_options) { - if (exists($known_options{$opt_name})) { - $out_options{$opt_name} = $in_options{$opt_name} if exists($in_options{$opt_name}); - } else { - die "Option $opt_name not defined for image. " . "Default options are:
    ", - display_options2(%known_options); - } - } - my $width = $out_options{width}; - my $height = $out_options{height}; - my $tex_size = $out_options{tex_size}; - my $alt = $out_options{alt}; - my $width_ratio = $tex_size * (.001); - my @image_list = (); - my @alt_list = (); - - # if height was explicitly given, create string for height attribute to be used in HTML, LaTeX2HTML - # otherwise omit a height attribute and allow the browser to use aspect ratio preservation - my $height_attrib = ''; - $height_attrib = qq{height = "$height"} if ($height); - - if (ref($image_ref) =~ /ARRAY/) { - @image_list = @{$image_ref}; - } else { - push(@image_list, $image_ref); - } - if (ref($alt) =~ /ARRAY/) { - @alt_list = @{$alt}; - } else { - for my $i (@image_list) { push(@alt_list, $alt) } - } - - my @output_list = (); - while (@image_list) { - my $image_item = shift @image_list; - $image_item = insertGraph($image_item) - if (ref $image_item eq 'WWPlot' || ref $image_item eq 'PGlateximage' || ref $image_item eq 'PGtikz'); - my $imageURL = alias($image_item) // ''; - $imageURL = ($envir{use_site_prefix}) ? $envir{use_site_prefix} . $imageURL : $imageURL; - my $out = ""; - - if ($displayMode eq 'TeX') { - my $imagePath = $imageURL; # in TeX mode, alias gives us a path, not a URL - - # We're going to create PDF files with our TeX (using pdflatex), so - # alias should have given us the path to a PNG image. - if ($imagePath) { - $out = "\\includegraphics[width=$width_ratio\\linewidth]{$imagePath}\n"; - } else { - $out = ""; - } - } elsif ($displayMode eq 'Latex2HTML') { - my $wid = ($envir->{onTheFlyImageSize} || 0) + 30; - $out = - qq!\\begin{rawhtml}\n\n - \\end{rawhtml}\n ! - } elsif ($displayMode eq 'HTML_MathJax' - || $displayMode eq 'HTML_dpng' - || $displayMode eq 'HTML' - || $displayMode eq 'HTML_tth' - || $displayMode eq 'HTML_jsMath' - || $displayMode eq 'HTML_asciimath' - || $displayMode eq 'HTML_LaTeXMathML' - || $displayMode eq 'HTML_img') - { - my $altattrib = ''; - if (defined $alt_list[0]) { $altattrib = 'alt="' . encode_pg_and_html(shift @alt_list) . '"' } - $out = - qq!!; - } elsif ($displayMode eq 'PTX') { - my $ptxwidth = 100 * $width / 600; - if (defined $alt) { - $out = qq!$alt!; - } else { - $out = qq!!; - } - } else { - $out = "Error: PGbasicmacros: image: Unknown displayMode: $displayMode.\n"; - } - push(@output_list, $out); - } - return wantarray ? @output_list : join(' ', @output_list); -} - -#This is bare bones code for embedding svg -sub embedSVG { - my $file_name = shift; # just input the file name of the svg image - my $backup_file_name = shift // ''; # a png version - my $str = ''; - if ($backup_file_name) { - $str = q!" oneerror="this.src='! . alias($backup_file_name) . q!'!; - } - return MODES( - HTML => q! - !, - TeX => "\\includegraphics[width=6in]{" . alias($file_name) . "}", - PTX => '', - ); -} - -# This is bare bones code for embedding png files -- what else should be added? (there are .js scripts for example) -sub embedPDF { - my $file_name = shift; # just input the file name of the svg image - #my $backup_file_name = shift//''; # a png version - return MODES( - HTML => q! - !, - TeX => "\\includegraphics[width=6in]{" . alias($file_name) . "}", - PTX => '', - ); -} - -sub video { - my $video_ref = shift; - my @opt = @_; - unless (scalar(@opt) % 2 == 0) { - warn "ERROR in video macro. A list of macros must be inclosed in square brackets."; - } - my %in_options = @opt; - my %known_options = ( - width => 400, - height => 400, - extra_html_tags => '', - ); - # handle options - my %out_options = %known_options; - foreach my $opt_name (keys %in_options) { - if (exists($known_options{$opt_name})) { - $out_options{$opt_name} = $in_options{$opt_name} if exists($in_options{$opt_name}); - } else { - die "Option $opt_name not defined for video. " . "Default options are:
    ", - display_options2(%known_options); - } - } - my $width = $out_options{width}; - my $height = $out_options{height}; - - my @video_list = (); - - if (ref($video_ref) =~ /ARRAY/) { - @video_list = @{$video_ref}; - } else { - push(@video_list, $video_ref); - } - - my @output_list = (); - while (@video_list) { - - my $video = shift @video_list // ''; - my $videoURL = alias($video) // ''; - $video =~ /.*\.(\w*)/; - my $type = $1; - my $out; - my $htmlmessage = maketext("Your browser does not support the video tag."); - - if ($displayMode eq 'TeX') { - - $videoURL = ($envir{use_site_prefix}) ? $envir{use_site_prefix} . $videoURL : $videoURL; - $out = - "\\begin{center} {\\bf " - . maketext("This problem contains a video which must be viewed online.") - . "} \\end{center}"; - - } elsif ($displayMode eq 'Latex2HTML') { - $out = qq!\\begin{rawhtml}\n - \\end{rawhtml}\n ! - } elsif ($displayMode eq 'HTML_MathJax' - || $displayMode eq 'HTML_dpng' - || $displayMode eq 'HTML' - || $displayMode eq 'HTML_tth' - || $displayMode eq 'HTML_jsMath' - || $displayMode eq 'HTML_asciimath' - || $displayMode eq 'HTML_LaTeXMathML' - || $displayMode eq 'HTML_img') - { - $out = qq!\n - ! - } elsif ($displayMode eq 'PTX') { - my $ptxwidth = 100 * $width / 600; - $out = qq!