diff --git a/LICENSE b/LICENSE index f254c920e4..98bc5d4468 100644 --- a/LICENSE +++ b/LICENSE @@ -2,7 +2,7 @@ Online Homework Delivery System Version 2.* - Copyright 2000-2016, The WeBWorK Project + Copyright 2000-2017, The WeBWorK Project All rights reserved. This program is free software; you can redistribute it and/or modify diff --git a/README b/README index ffe443ec39..2326906afb 100644 --- a/README +++ b/README @@ -6,6 +6,6 @@ http://webwork.maa.org/wiki/Category:Release_Notes - Copyright 2000-2014, The WeBWorK Project + Copyright 2000-2017, The WeBWorK Project http://webwork.maa.org All rights reserved. diff --git a/VERSION b/VERSION index 42b59c9e24..2fe7285f81 100644 --- a/VERSION +++ b/VERSION @@ -1,4 +1,4 @@ -$PG_VERSION ='2.12'; -$PG_COPYRIGHT_YEARS = '1996-2016'; +$PG_VERSION ='PG-2.13'; +$PG_COPYRIGHT_YEARS = '1996-2017'; 1; diff --git a/lib/PGcore.pm b/lib/PGcore.pm index a73b22c4c9..cc041d9fe1 100755 --- a/lib/PGcore.pm +++ b/lib/PGcore.pm @@ -112,7 +112,8 @@ sub initialize { WARNING_messages => $self->{WARNING_messages}, DEBUG_messages => $self->{DEBUG_messages}, ); - $self->{maketext} = WeBWorK::Localize::getLoc($self->{envir}->{language}); + #$self->{maketext} = WeBWorK::Localize::getLoc($self->{envir}->{language}); + $self->{maketext} = $self->{envir}->{language_subroutine}; #$self->debug_message("PG alias created", $self->{PG_alias} ); $self->{PG_loadMacros} = new PGloadfiles($self->{envir}); $self->{flags} = { @@ -490,6 +491,8 @@ sub record_array_name { # currently the same as record ans name $label; } + + sub extend_ans_group { # modifies the group type my $self = shift; my $label = shift; @@ -506,6 +509,7 @@ sub extend_ans_group { # modifies the group type } $label; } + sub record_unlabeled_ans_name { my $self = shift; $self->{unlabeled_answer_blank_count}++; @@ -720,8 +724,11 @@ sub insertGraph { =cut sub maketext { - my $self = shift; - &{ $self->{maketext}}(@_); + my $self = shift; + # uncomment this to check to see if strings are run through + # maketext. + # return 'xXx'. &{ $self->{maketext}}(@_).'xXx'; + &{ $self->{maketext}}(@_); } sub includePGtext { my $self = shift; diff --git a/lib/Parser/Differentiation.pm b/lib/Parser/Differentiation.pm index 3cd6554064..2e914ea17f 100644 --- a/lib/Parser/Differentiation.pm +++ b/lib/Parser/Differentiation.pm @@ -100,7 +100,8 @@ sub Parser::BOP::divide::D { $BOP->new($equation,'*', $self->{lop}->copy($equation),$self->{rop}->D($x)) ), - $BOP->new($equation,'^',$self->{rop},$self->Item("Number")->new($equation,2)) + $BOP->new($equation,'^',$self->{rop}->copy($equation), + $self->Item("Number")->new($equation,2)) ); return $self->reduce; } diff --git a/lib/Parser/Legacy/NumberWithUnits.pm b/lib/Parser/Legacy/NumberWithUnits.pm index 4a78cc5ec8..22052634fa 100644 --- a/lib/Parser/Legacy/NumberWithUnits.pm +++ b/lib/Parser/Legacy/NumberWithUnits.pm @@ -7,6 +7,12 @@ package Parser::Legacy::ObjectWithUnits; +# Refrences to problem specific copies of %Units::fundamental_units +# and %Units::known_units. These should be passed to any Units function call. +# They are set by the initializeUnits sub +my $fundamental_units = ''; +my $known_units = ''; + sub name {'object'}; sub cmp_class {'an Object with Units'}; sub makeValue { @@ -15,10 +21,46 @@ sub makeValue { Value::makeValue($value,%options); } +sub initializeUnits { + $fundamental_units = shift; + $known_units = shift; +} + sub new { my $self = shift; my $class = ref($self) || $self; my $context = (Value::isContext($_[0]) ? shift : $self->context); - my $num = shift; my $units = shift; + my $num = shift; + # we need to check if units is the options hash + my $units = shift; + my $options; + + if (ref($units) eq 'HASH') { + $options = $units; + $units = ''; + } else { + $options = shift; + } + + # register a new unit/s if needed + if (defined($options->{newUnit})) { + my @newUnits; + if (ref($options->{newUnit}) eq 'ARRAY') { + @newUnits = @{$options->{newUnit}}; + } else { + @newUnits = ($options->{newUnit}); + } + + foreach my $newUnit (@newUnits) { + if (ref($newUnit) eq 'HASH') { + add_unit($newUnit->{name}, $newUnit->{conversion}); + } else { + add_unit($newUnit); + } + } + } + + + Value::Error("You must provide a ".$self->name) unless defined($num); ($num,$units) = splitUnits($num) unless $units; Value::Error("You must provide units for your ".$self->name) unless $units; @@ -37,17 +79,18 @@ sub new { # # Find the units for the formula and split that off # -my $aUnit = '(?:'.getUnitNames().')(?:\s*(?:\^|\*\*)\s*[-+]?\d+)?'; -my $unitPattern = $aUnit.'(?:\s*[/* ]\s*'.$aUnit.')*'; -my $unitSpace = "($aUnit) +($aUnit)"; sub splitUnits { + my $aUnit = '(?:'.getUnitNames().')(?:\s*(?:\^|\*\*)\s*[-+]?\d+)?'; + my $unitPattern = $aUnit.'(?:\s*[/* ]\s*'.$aUnit.')*'; + my $unitSpace = "($aUnit) +($aUnit)"; my $string = shift; - my ($num,$units) = $string =~ m!^(.*?(?:[)}\]0-9a-z]|\d\.))\s*($unitPattern)\s*$!o; + my ($num,$units) = $string =~ m!^(.*?(?:[)}\]0-9a-z]|\d\.))\s*($unitPattern)\s*$!; if ($units) { while ($units =~ s/$unitSpace/$1*$2/) {}; $units =~ s/ //g; $units =~ s/\*\*/^/g; } + return ($num,$units); } @@ -57,10 +100,14 @@ sub splitUnits { # sub getUnitNames { local ($a,$b); + my $units = \%Units::known_units; + if ($known_units) { + $units = $known_units; + } join('|',sort { return length($b) <=> length($a) if length($a) != length($b); return $a cmp $b; - } keys(%Units::known_units)); + } keys(%$units)); } # @@ -68,7 +115,14 @@ sub getUnitNames { # sub getUnits { my $units = shift; - my %Units = Units::evaluate_units($units); + my $options = {}; + if ($fundamental_units) { + $options->{fundamental_units} = $fundamental_units; + } + if ($known_units) { + $options->{known_units} = $known_units; + } + my %Units = Units::evaluate_units($units,$options); if ($Units{ERROR}) { $Units{ERROR} =~ s/ at ([^ ]+) line \d+(\n|.)*//; $Units{ERROR} =~ s/^UNIT ERROR:? *//; @@ -104,6 +158,7 @@ sub cmp_parse { # # Check that the units are defined and legal # + my ($num,$units) = splitUnits($ans->{student_ans}); unless (defined($num) && defined($units) && $units ne '') { $self->cmp_Error($ans,"Your answer doesn't look like ".lc($self->cmp_class)); @@ -157,6 +212,31 @@ sub adjustCorrectValue { sub cmp_reparse {Value::cmp_parse(@_)} +sub add_fundamental_unit { + my $unit = shift; + $fundamental_units->{$unit} = 0; +} + +sub add_unit { + my $unit = shift; + my $hash = shift; + + unless (ref($hash) eq 'HASH') { + $hash = {'factor' => 1, + "$unit" => 1 }; + } + + # make sure that if this unit is defined in terms of any other units + # then those units are fundamental units. + foreach my $subUnit (keys %$hash) { + if (!defined($fundamental_units->{$subUnit})) { + add_fundamental_unit($subUnit); + } + } + + $known_units->{$unit} = $hash; +} + ###################################################################### # diff --git a/lib/Rserve.pm b/lib/Rserve.pm new file mode 100644 index 0000000000..68060a6c4a --- /dev/null +++ b/lib/Rserve.pm @@ -0,0 +1,67 @@ +package Rserve; + +use strict; +use warnings; + +my $rserve_loaded = eval { + require Statistics::R::IO::Rserve; + 1 +}; + +sub access { + die 'Statistics::R::IO::Rserve could not be loaded. Have you installed the module?' + unless $rserve_loaded; + + Statistics::R::IO::Rserve->new(@_) +}; + + +## Evaluates an R expression guarding it inside an R `try` function +## +## Returns the result as a REXP if no exceptions were raised, or +## `die`s with the text of the exception message. +sub try_eval { + my ($rserve, $query) = @_; + + my $result = $rserve->eval("try({ $query }, silent=TRUE)"); + die $result->to_pl->[0] if _inherits($result, 'try-error'); + # die $result->to_pl->[0] if $result->inherits('try-error'); + + $result +} + + +## Returns a REXP's Perl representation, dereferencing it if it's an +## array reference +## +## `REXP::to_pl` returns a string scalar for Symbol, undef for Null, +## and an array reference to contents for all vector types. This +## function is a utility wrapper to make it easy to assign a Vector's +## representation to an array variable, while still working sensibly +## for non-arrays. +sub unref_rexp { + my $rexp = shift; + + my $value = $rexp->to_pl; + if (ref($value) eq ref([])) { + @{$value} + } else { + $value + } +} + + +## Reimplements method C of class L +## until I figure out why calling it directly doesn't work in the safe +## compartment +sub _inherits { + my ($rexp, $class) = @_; + + my $attributes = $rexp->attributes; + return unless $attributes && $attributes->{'class'}; + + grep {/^$class$/} @{$attributes->{'class'}->to_pl} +} + + +1; diff --git a/lib/Units.pm b/lib/Units.pm index 4dcaa37938..0a076c5c83 100644 --- a/lib/Units.pm +++ b/lib/Units.pm @@ -787,19 +787,34 @@ our %known_units = ('m' => { sub process_unit { - my $string = shift; + my $string = shift; + + my $options = shift; + + my $fundamental_units = \%fundamental_units; + my $known_units = \%known_units; + + if (defined($options->{fundamental_units})) { + $fundamental_units = $options->{fundamental_units}; + } + + if (defined($options->{known_units})) { + $known_units = $options->{known_units}; + } + + die ("UNIT ERROR: No units were defined.") unless defined($string); # #split the string into numerator and denominator --- the separator is / my ($numerator,$denominator) = split( m{/}, $string ); - $denominator = "" unless defined($denominator); - my %numerator_hash = process_term($numerator); - my %denominator_hash = process_term($denominator); + $denominator = "" unless defined($denominator); + my %numerator_hash = process_term($numerator,{fundamental_units => $fundamental_units, known_units => $known_units}); + my %denominator_hash = process_term($denominator,{fundamental_units => $fundamental_units, known_units => $known_units}); - my %unit_hash = %fundamental_units; + my %unit_hash = %$fundamental_units; my $u; foreach $u (keys %unit_hash) { if ( $u eq 'factor' ) { @@ -815,7 +830,20 @@ sub process_unit { sub process_term { my $string = shift; - my %unit_hash = %fundamental_units; + my $options = shift; + + my $fundamental_units = \%fundamental_units; + my $known_units = \%known_units; + + if (defined($options->{fundamental_units})) { + $fundamental_units = $options->{fundamental_units}; + } + + if (defined($options->{known_units})) { + $known_units = $options->{known_units}; + } + + my %unit_hash = %$fundamental_units; if ($string) { #split the numerator or denominator into factors -- the separators are * @@ -824,7 +852,7 @@ sub process_term { my $f; foreach $f (@factors) { - my %factor_hash = process_factor($f); + my %factor_hash = process_factor($f,{fundamental_units => $fundamental_units, known_units => $known_units}); my $u; foreach $u (keys %unit_hash) { @@ -847,12 +875,24 @@ sub process_factor { my $string = shift; #split the factor into unit and powers - my ($unit_name,$power) = split(/\^/, $string); - $power = 1 unless defined($power); - my %unit_hash = %fundamental_units; + my $options = shift; + + my $fundamental_units = \%fundamental_units; + my $known_units = \%known_units; + + if (defined($options->{fundamental_units})) { + $fundamental_units = $options->{fundamental_units}; + } + + if (defined($options->{known_units})) { + $known_units = $options->{known_units}; + } - if ( defined( $known_units{$unit_name} ) ) { - my %unit_name_hash = %{$known_units{$unit_name}}; # $reference_units contains all of the known units. + my ($unit_name,$power) = split(/\^/, $string); + $power = 1 unless defined($power); + my %unit_hash = %$fundamental_units; + if ( defined( $known_units->{$unit_name} ) ) { + my %unit_name_hash = %{$known_units->{$unit_name}}; # $reference_units contains all of the known units. my $u; foreach $u (keys %unit_hash) { if ( $u eq 'factor' ) { @@ -871,9 +911,22 @@ sub process_factor { # This is the "exported" subroutine. Use this to evaluate the units given in an answer. sub evaluate_units { - my $unit = shift; - my %output = eval(q{process_unit( $unit)}); - %output = %fundamental_units if $@; # this is what you get if there is an error. + my $unit = shift; + my $options = shift; + + my $fundamental_units = \%fundamental_units; + my $known_units = \%known_units; + + if (defined($options->{fundamental_units}) && $options->{fundamental_units}) { + $fundamental_units = $options->{fundamental_units}; + } + + if (defined($options->{known_units}) && $options->{fundamental_units}) { + $known_units = $options->{known_units}; + } + + my %output = eval(q{process_unit( $unit, {fundamental_units => $fundamental_units, known_units => $known_units})}); + %output = %$fundamental_units if $@; # this is what you get if there is an error. $output{'ERROR'}=$@ if $@; %output; } diff --git a/lib/Value/AnswerChecker.pm b/lib/Value/AnswerChecker.pm index 4d3a435a3c..433db03cb7 100644 --- a/lib/Value/AnswerChecker.pm +++ b/lib/Value/AnswerChecker.pm @@ -157,7 +157,7 @@ sub cmp_parse { $ans->{student_ans} = preformat($ans->{student_formula}->substitute()->string); contextSet($context,%{$oldFags}); last; }; - warn "Unkown student answer format |$ans->{formatStudentAnswer}|"; + warn "Unknown student answer format |$ans->{formatStudentAnswer}|"; } if ($self->cmp_collect($ans)) { $self->cmp_preprocess($ans); @@ -396,24 +396,31 @@ sub ans_matrix { $self->{ans_name} = $ename; $self->{ans_rows} = $rows; $self->{ans_cols} = $cols; + # warn "ans_matrix: ename=$ename answer_group_name=$options{answer_group_name}"; my @array = (); foreach my $i (0..$rows-1) { my @row = (); foreach my $j (0..$cols-1) { my $label; if ($options{aria_label}) { - $label = $options{aria_label}.'row '.($i+1).' col '.($j+1); + $label = $options{aria_label}.'row '.($i+1).' col '.($j+1); } else { - $label = pgCall('generate_aria_label',ANS_NAME($ename,$i,$j)); + $label = pgCall('generate_aria_label',ANS_NAME($ename,$i,$j)); } + my $answer_group_name = $options{answer_group_name}//$name; if ($i == 0 && $j == 0) { - if ($extend) { - push(@row,&$named_extension($name,$size,ans_label=>$name,aria_label=>$label)); - } else { - push(@row,&$named_ans_rule($name,$size,aria_label=>$label)); - } - } else { - push(@row,&$named_extension(ANS_NAME($ename,$i,$j),$size,ans_label=>$name,aria_label=>$label)); + if ($extend) { + push(@row,&$named_extension($name,$size, + answer_group_name=> $answer_group_name, + aria_label=>$label) + ); + } else { + push(@row,&$named_ans_rule($name,$size,aria_label=>$label)); + } + } else { + push(@row,&$named_extension(ANS_NAME($ename,$i,$j),$size, + answer_group_name => $answer_group_name, + aria_label=>$label)); } } push(@array,[@row]); @@ -1016,7 +1023,7 @@ sub typeMatch { my $self = shift; my $other = shift; my $ans = shift; return 0 unless ref($other) && !$other->isFormula; return $other->type eq 'Matrix' || - ($other->type =~ m/^(Point|list)$/ && + ($other->type =~ m/^(Point|List)$/ && $other->{open}.$other->{close} eq $self->{open}.$self->{close}); } diff --git a/lib/Value/Matrix.pm b/lib/Value/Matrix.pm index 8d4f3331a8..f2253c72a7 100644 --- a/lib/Value/Matrix.pm +++ b/lib/Value/Matrix.pm @@ -412,6 +412,14 @@ sub wwMatrixLR { return $self->{lrM}; } +sub wwColumnVector { + my $self = shift; + my $v = shift; + my $V = $self->new($v); + $V = $V->transpose if Value::classMatch($v,'Vector'); + return $V->wwMatrix; +} + ################################### # @@ -458,7 +466,7 @@ sub kleene { sub normalize { my $self = shift; - my $v = $self->new(shift)->wwMatrix; + my $v = $self->wwColumnVector(shift); my ($M,$b) = $self->wwMatrix->normalize($v); return ($self->new($M),$self->new($b)); } @@ -466,7 +474,7 @@ sub normalize { sub solve {shift->solve_LR(@_)} sub solve_LR { my $self = shift; - my $v = $self->new(shift)->wwMatrix; + my $v = $self->wwColumnVector(shift); my ($d,$b,$M) = $self->wwMatrixLR->solve_LR($v); return ($d,$self->new($b),$self->new($M)); } @@ -485,8 +493,8 @@ sub order_LR { sub solve_GSM { my $self = shift; - my $x0 = $self->new(shift)->wwMatrix; - my $b = $self->new(shift)->wwMatrix; + my $x0 = $self->wwColumnVector(shift); + my $b = $self->wwColumnVector(shift); my $e = shift; my $v = $self->wwMatrix->solve_GSM($x0,$b,$e); $v = $self->new($v) if defined($v); @@ -495,8 +503,8 @@ sub solve_GSM { sub solve_SSM { my $self = shift; - my $x0 = $self->new(shift)->wwMatrix; - my $b = $self->new(shift)->wwMatrix; + my $x0 = $self->wwColumnVector(shift); + my $b = $self->wwColumnVector(shift); my $e = shift; my $v = $self->wwMatrix->solve_SSM($x0,$b,$e); $v = $self->new($v) if defined($v); @@ -505,8 +513,8 @@ sub solve_SSM { sub solve_RM { my $self = shift; - my $x0 = $self->new(shift)->wwMatrix; - my $b = $self->new(shift)->wwMatrix; + my $x0 = $self->wwColumnVector(shift); + my $b = $self->wwColumnVector(shift); my $w = shift; my $e = shift; my $v = $self->wwMatrix->solve_RM($x0,$b,$w,$e); $v = $self->new($v) if defined($v); diff --git a/lib/Value/Set.pm b/lib/Value/Set.pm index a9a7d0555f..f98a9f9d19 100644 --- a/lib/Value/Set.pm +++ b/lib/Value/Set.pm @@ -95,7 +95,7 @@ sub promote { # sub add { my ($self,$l,$r) = Value::checkOpOrderWithPromote(@_); - $self->Package("Union")->new($l,$r); + return Value::Union::form($self->context,$l,$r); } sub dot {my $self = shift; $self->add(@_)} diff --git a/lib/Value/Union.pm b/lib/Value/Union.pm index 421eb70e46..cf3ef7d77a 100644 --- a/lib/Value/Union.pm +++ b/lib/Value/Union.pm @@ -268,6 +268,15 @@ sub isReduced { if ($x->intersects($y)) {$error = "overlaps"; last} if (($x + $y)->reduce->type ne 'Union') {$error = "uncombined intervals"; last} } + if ($S->length) { + foreach my $x (@{$sU->{data}}) { + my $y = ($x + $S)->reduce; + if ($y->type ne 'Union' && ($y->type ne 'Set' || $y->length == $S->length)) { + $error = "uncombined sets"; + last; + } + } + } $error = "overlaps in sets" if !$error && $S->intersects($U); $error = "uncombined sets" if !$error && $Sn > 1 && !$self->getFlag('reduceSets'); $error = "repeated elements in set" if !$error && !$S->isReduced; diff --git a/lib/WeBWorK/PG/Translator.pm b/lib/WeBWorK/PG/Translator.pm index 1ad5578958..c3028b3b9f 100644 --- a/lib/WeBWorK/PG/Translator.pm +++ b/lib/WeBWorK/PG/Translator.pm @@ -1852,18 +1852,18 @@ sub PG_answer_eval { sub default_preprocess_code { my $evalString = shift//''; # BEGIN_TEXT and END_TEXT must occur on a line by themselves. - $evalString =~ s/\n\s*END_TEXT[\s;]*\n/\nEND_TEXT\n/g; - $evalString =~ s/\n\s*END_PGML[\s;]*\n/\nEND_PGML\n/g; - $evalString =~ s/\n\s*END_PGML_SOLUTION[\s;]*\n/\nEND_PGML_SOLUTION\n/g; - $evalString =~ s/\n\s*END_PGML_HINT[\s;]*\n/\nEND_PGML_HINT\n/g; - $evalString =~ s/\n\s*END_SOLUTION[\s;]*\n/\nEND_SOLUTION\n/g; - $evalString =~ s/\n\s*END_HINT[\s;]*\n/\nEND_HINT\n/g; - $evalString =~ s/\n\s*BEGIN_TEXT[\s;]*\n/\nTEXT\(EV3P\(<<'END_TEXT'\)\);\n/g; - $evalString =~ s/\n\s*BEGIN_PGML[\s;]*\n/\nTEXT\(PGML::Format2\(<<'END_PGML'\)\);\n/g; - $evalString =~ s/\n\s*BEGIN_PGML_SOLUTION[\s;]*\n/\nSOLUTION\(PGML::Format2\(<<'END_PGML_SOLUTION'\)\);\n/g; - $evalString =~ s/\n\s*BEGIN_PGML_HINT[\s;]*\n/\nHINT\(PGML::Format2\(<<'END_PGML_HINT'\)\);\n/g; - $evalString =~ s/\n\s*BEGIN_SOLUTION[\s;]*\n/\nSOLUTION\(EV3P\(<<'END_SOLUTION'\)\);\n/g; - $evalString =~ s/\n\s*BEGIN_HINT[\s;]*\n/\nHINT\(EV3P\(<<'END_HINT'\)\);\n/g; + $evalString =~ s/\n\h*END_TEXT[\h;]*\n/\nEND_TEXT\n/g; + $evalString =~ s/\n\h*END_PGML[\h;]*\n/\nEND_PGML\n/g; + $evalString =~ s/\n\h*END_PGML_SOLUTION[\h;]*\n/\nEND_PGML_SOLUTION\n/g; + $evalString =~ s/\n\h*END_PGML_HINT[\h;]*\n/\nEND_PGML_HINT\n/g; + $evalString =~ s/\n\h*END_SOLUTION[\h;]*\n/\nEND_SOLUTION\n/g; + $evalString =~ s/\n\h*END_HINT[\h;]*\n/\nEND_HINT\n/g; + $evalString =~ s/\n\h*BEGIN_TEXT[\h;]*\n/\nTEXT\(EV3P\(<<'END_TEXT'\)\);\n/g; + $evalString =~ s/\n\h*BEGIN_PGML[\h;]*\n/\nTEXT\(PGML::Format2\(<<'END_PGML'\)\);\n/g; + $evalString =~ s/\n\h*BEGIN_PGML_SOLUTION[\h;]*\n/\nSOLUTION\(PGML::Format2\(<<'END_PGML_SOLUTION'\)\);\n/g; + $evalString =~ s/\n\h*BEGIN_PGML_HINT[\h;]*\n/\nHINT\(PGML::Format2\(<<'END_PGML_HINT'\)\);\n/g; + $evalString =~ s/\n\h*BEGIN_SOLUTION[\h;]*\n/\nSOLUTION\(EV3P\(<<'END_SOLUTION'\)\);\n/g; + $evalString =~ s/\n\h*BEGIN_HINT[\h;]*\n/\nHINT\(EV3P\(<<'END_HINT'\)\);\n/g; $evalString =~ s/ENDDOCUMENT.*/ENDDOCUMENT();/s; # remove text after ENDDOCUMENT $evalString =~ s/\\/\\\\/g; # \ can't be used for escapes because of TeX conflict diff --git a/macros/MatrixUnits.pl b/macros/MatrixUnits.pl index 0b714e9e7f..810d06f5ee 100644 --- a/macros/MatrixUnits.pl +++ b/macros/MatrixUnits.pl @@ -217,7 +217,7 @@ sub GL4Z_perl { foreach my $i (1..4) { $a[$i][3] = $c * $a[$i][1] + $d * $a[$i][2]; } - my $n = random(-1,1,2); + $n = random(-1,1,2); $a[1][3] = $a[1][3] + $n; my $f = random(-1,1,2); @@ -269,7 +269,7 @@ sub SL4Z_perl { foreach my $i (1..4) { $a[$i][3] = $c * $a[$i][1] + $d * $a[$i][2]; } - my $n = random(-1,1,2); + $n = random(-1,1,2); $a[1][3] = $a[1][3] + $n; my $f = random(-1,1,2); diff --git a/macros/PG.pl b/macros/PG.pl index 9baff67f0c..b36e3f617e 100644 --- a/macros/PG.pl +++ b/macros/PG.pl @@ -5,15 +5,15 @@ # initialize PGcore and PGrandom -$main::VERSION ="WW2"; +$main::VERSION ="PG-2.13+"; sub _PG_init{ - $main::VERSION ="WW2.9+"; + $main::VERSION ="PG-2.13+"; # # Set up MathObject context for use in problems # that don't load MathObjects.pl # - %main::context = {}; + %main::context = (); Parser::Context->current(\%main::context); } @@ -300,16 +300,18 @@ sub CLEAR_RESPONSES { } ''; } + +#FIXME -- examine the difference between insert_response and extend_response sub INSERT_RESPONSE { my $ans_label = shift; my $response_label = shift; my $ans_value = shift; my $selected = shift; - # warn "\n\nanslabel $ans_label responselabel $response_label value $ans_value"; + # warn "\n\nin PG.pl\nanslabel $ans_label responselabel $response_label value $ans_value"; if (defined ($PG->{PG_ANSWERS_HASH}->{$ans_label}) ) { my $responsegroup = $PG->{PG_ANSWERS_HASH}->{$ans_label}->{response}; $responsegroup->append_response($response_label, $ans_value, $selected); - #warn "\n$responsegroup responses are now ", $responsegroup->responses; + # warn "There are ", scalar($responsegroup->responses), " $responsegroup responses." ; } ''; } @@ -319,14 +321,15 @@ sub EXTEND_RESPONSE { # for radio buttons and checkboxes my $response_label = shift; my $ans_value = shift; my $selected = shift; - # warn "\n\nanslabel $ans_label responselabel $response_label value $ans_value"; + # warn "\n\nin PG.pl \nanslabel $ans_label responselabel $response_label value $ans_value"; if (defined ($PG->{PG_ANSWERS_HASH}->{$ans_label}) ) { my $responsegroup = $PG->{PG_ANSWERS_HASH}->{$ans_label}->{response}; $responsegroup->extend_response($response_label, $ans_value,$selected); - #warn "\n$responsegroup responses are now ", pretty_print($response_group); + # warn "\n$responsegroup responses are now ", pretty_print($response_group); } ''; } + sub ENDDOCUMENT { # check that answers match # gather up PG_FLAGS elements diff --git a/macros/PGML.pl b/macros/PGML.pl index 002f137603..d773fcdbd1 100644 --- a/macros/PGML.pl +++ b/macros/PGML.pl @@ -37,7 +37,7 @@ package PGML::Parse; my $linebreak = ' ?(?=\n)'; my $heading = '#+'; my $rule = '(?:---+|===+)'; -my $list = '(?:^|(?<=[\t ]))(?:[-+o*]|(?:\d|[ivx]+|[IVX]+|[a-zA-Z])[.)]) +'; +my $list = '(?:^|(?<=[\t ]))(?:[-+o*]|(?:\d|[ivxl]+|[IVXL]+|[a-zA-Z])[.)]) +'; my $align = '>> *| *<<'; my $code = '```'; my $pre = ': '; @@ -153,27 +153,27 @@ sub All { my $self = shift; my $token = shift; return $self->Begin($token) if substr($token,0,1) eq "[" && $BlockDefs{$token}; for ($token) { - /\t/ && do {return $self->Indent($token)}; - /\d+\. / && do {return $self->Bullet($token,"numeric")}; - /[ivx]+[.)] / && do {return $self->Bullet($token,"roman")}; - /[a-z][.)] / && do {return $self->Bullet($token,"alpha")}; - /[IVX]+[.)] / && do {return $self->Bullet($token,"Roman")}; - /[A-Z][.)] / && do {return $self->Bullet($token,"Alpha")}; - /[-+o*] / && do {return $self->Bullet($token,"bullet")}; - /\{/ && do {return $self->Brace($token)}; - /\[]/ && do {return $self->NOOP($token)}; - /\[\|/ && do {return $self->Verbatim($token)}; - /\[./ && do {return $self->Answer($token)}; - /_/ && do {return $self->Emphasis($token)}; - /\*/ && do {return $self->Star($token)}; - /[\"\']/ && do {return $self->Quote($token)}; - /^ ?$/ && do {return $self->ForceBreak($token)}; - /#/ && do {return $self->Heading($token)}; - /-|=/ && do {return $self->Rule($token)}; - /<Center($token)}; - />>/ && do {return $self->Align($token)}; - /```/ && do {return $self->Code($token)}; - /: / && do {return $self->Preformatted($token)}; + /\t/ && do {return $self->Indent($token)}; + /\d+\. / && do {return $self->Bullet($token,"numeric")}; + /[ivxl]+[.)] / && do {return $self->Bullet($token,"roman")}; + /[a-z][.)] / && do {return $self->Bullet($token,"alpha")}; + /[IVXL]+[.)] / && do {return $self->Bullet($token,"Roman")}; + /[A-Z][.)] / && do {return $self->Bullet($token,"Alpha")}; + /[-+o*] / && do {return $self->Bullet($token,"bullet")}; + /\{/ && do {return $self->Brace($token)}; + /\[]/ && do {return $self->NOOP($token)}; + /\[\|/ && do {return $self->Verbatim($token)}; + /\[./ && do {return $self->Answer($token)}; + /_/ && do {return $self->Emphasis($token)}; + /\*/ && do {return $self->Star($token)}; + /[\"\']/ && do {return $self->Quote($token)}; + /^ ?$/ && do {return $self->ForceBreak($token)}; + /#/ && do {return $self->Heading($token)}; + /-|=/ && do {return $self->Rule($token)}; + /<Center($token)}; + />>/ && do {return $self->Align($token)}; + /```/ && do {return $self->Code($token)}; + /: / && do {return $self->Preformatted($token)}; $self->Text($token); } } @@ -732,7 +732,19 @@ sub combineTopItems { my $id = $top->{combine}{$prev->{type}}; my $value; my $inside = 0; if ($id) { if (ref($id) eq 'HASH') {($id,$value) = %$id; $inside = 1} else {$value = $prev->{$id}} - if ($top->{$id} eq $value) { + my $topList = (Value::isa($top,'PGML::Block') ? substr(($top->topItem || {})->{token} || '',0,2) : ''); + my $prevList = (Value::isa($prev,'PGML::Block') ? substr(($prev->topItem || {})->{token} || '',0,2) : ''); + if ( + $top->{$id} eq $value || + ($top->{type} eq 'list' && $top->{bullet} eq 'roman' && + $prev->{type} eq 'list' && $prev->{bullet} eq 'alpha' && + (($topList eq 'i.' && $prevList eq 'h.') || ($topList eq 'v.' && $prevList eq 'u.') || + ($topList eq 'x.' && $prevList eq 'w.') || ($topList eq 'l.' && $prevList eq 'k.'))) || + ($top->{type} eq 'list' && $top->{bullet} eq 'Roman' && + $prev->{type} eq 'list' && $prev->{bullet} eq 'Alpha' && + (($topList eq 'I.' && $prevList eq 'H.') || ($topList eq 'V.' && $prevList eq 'U.') || + ($topList eq 'X.' && $prevList eq 'W.') || ($topList eq 'L.' && $prevList eq 'K.'))) + ) { # # Combine identical blocks # @@ -743,7 +755,7 @@ sub combineTopItems { $prev->pushItem(@{$top->{stack}}); $prev->combineTopItems($i) if $prev->{type} ne 'text' && $prev->topItem($i)->{combine}; return; - } elsif ($top->{type} eq 'indent' & $prev->{type} eq 'indent' && + } elsif ($top->{type} eq 'indent' && $prev->{type} eq 'indent' && $top->{indent} > $prev->{indent} && $prev->{indent} > 0) { # # Move larger indentations into smaller ones @@ -754,6 +766,15 @@ sub combineTopItems { $prev->pushItem($top); $prev->combineTopItems; return; + } elsif ($id eq 'indent' && $top->{type} eq 'indent' && $prev->{type} eq 'list') { + $prev = $prev->topItem; + if ($top->{indent} > $value && $value > 0) { + splice(@{$self->{stack}},$i,1); + if ($par) {splice(@{$self->{stack}},$i,1); $prev->pushItem($par)} + $top->{indent} -= $value; + $prev->pushItem($top); + $prev->combineTopItems; + } } } return; @@ -1067,8 +1088,8 @@ sub Align { } my %bullet = ( - bullet => 'ul', - numeric => 'ol', + bullet => 'ul type="disc"', + numeric => 'ol type="1"', alpha => 'ol type="a"', Alpha => 'ol type="A"', roman => 'ol type="i"', @@ -1440,6 +1461,7 @@ sub LaTeX { package main; sub _PGML_init { + PG_restricted_eval('sub PGML {PGML::Format2(@_)}'); loadMacros("MathObjects.pl"); my $context = Context(); # prevent Typeset context from becoming active loadMacros("contextTypeset.pl"); diff --git a/macros/PGbasicmacros.pl b/macros/PGbasicmacros.pl index a1cee513dd..7f2ce4847b 100644 --- a/macros/PGbasicmacros.pl +++ b/macros/PGbasicmacros.pl @@ -447,7 +447,7 @@ sub NAMED_ANS_RULE_OPTION { # deprecated } sub NAMED_ANS_RULE_EXTENSION { - my $name = shift; + my $name = shift; # this is the name of the response item my $col = shift; my %options = @_; @@ -457,7 +457,13 @@ sub NAMED_ANS_RULE_EXTENSION { } else { $label = generate_aria_label($name); } - + # this is the name of the parent answer group + 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. 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} ) ) { @@ -466,7 +472,9 @@ sub NAMED_ANS_RULE_EXTENSION { } # $answer_value =~ tr/\\$@`//d; #`## make sure student answers can not be interpolated by e.g. EV3 $answer_value =~ s/\s+/ /g; ## remove excessive whitespace from student answer - INSERT_RESPONSE($name,$name,$answer_value); #FIXME hack -- this needs more work to decide how to make it work + # 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 @@ -664,25 +672,25 @@ sub generate_aria_label { # check for quiz prefix if ($name =~ /^Q\d+/ || $name =~ /^MaTrIx_Q\d+/) { $name =~ s/Q0*(\d+)_//; - $label .= maketext('problem ').$1.' '; + $label .= maketext('problem').' '.$1.' '; } # get answer number $name =~ /AnSwEr0*(\d+)/; - $label .= maketext('answer ').$1.' '; + $label .= maketext('answer').' '.$1.' '; # check for Multianswer if ($name =~ /MuLtIaNsWeR_/) { $name =~ s/MuLtIaNsWeR_//; $name =~ /AnSwEr(\d+)_(\d+)/; - $label .= maketext('part ').($2+1).' '; + $label .= maketext('part').' '.($2+1).' '; } # check for Matrix if ($name =~ /^MaTrIx_/) { $name =~ /_(\d+)_(\d+)$/; - $label .= maketext('row ').($1+1) - .maketext(' column ').($2+1).' '; + $label .= maketext('row').' '.($1+1) + .' '.maketext('column').' '.($2+1).' '; } return $label; @@ -1092,8 +1100,23 @@ sub NAMED_ANS_ARRAY_EXTENSION{ # $answer_value =~ tr/\\$@`//d; #`## make sure student answers can not be interpolated by e.g. EV3 # warn "ans_label $options{ans_label} $name $answer_value"; - if (defined($options{ans_label}) ) { - INSERT_RESPONSE($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); @@ -1268,14 +1291,14 @@ sub hint { if ($displayMode =~ /TeX/) { my $afterAnswerDate = ( time() > $envir{answerDate} ); if ($printHintForInstructor) { - $out = join(' ', $BITALIC," (Instructor hint preview: show the student hint after $showHint attempts. The current number of attempts is $attempts. )$BR", $EITALIC, @in); + $out = join(' ', $BITALIC,maketext("(Instructor hint preview: show the student hint after the following number of attempts:"), $showHint,$BR, $EITALIC, @in); } elsif ( $displayHint and $afterAnswerDate ) { # only display hints after the answer date. $out = join(' ',@in); } } elsif ($displayMode =~/HTML/) { if ($printHintForInstructor) { # always print hints for instructor types in HTML mode - $out = join(' ', $BITALIC," (Instructor hint preview: show the student hint after $showHint attempts. The current number of attempts is $attempts. )$BR", $EITALIC, @in); + $out = join(' ', $BITALIC,maketext("(Instructor hint preview: show the student hint after the following number of attempts:"), $showHint,"$BR", $EITALIC, @in); } elsif ( $displayHint and ( $attempts > $showHint ) ) { ## the second test above prevents a hint being shown if a doctored form is submitted $out = join(' ',@in); diff --git a/macros/PGmatrixmacros.pl b/macros/PGmatrixmacros.pl index f2c80ed44b..070646c63a 100644 --- a/macros/PGmatrixmacros.pl +++ b/macros/PGmatrixmacros.pl @@ -13,7 +13,7 @@ =head1 SYNPOSIS =head1 DESCRIPTION Almost all of the macros in the file are very rough at best. The most useful is display_matrix. -Many of the other macros work with vectors and matrices stored as anonymous arrays. +Many of the other macros work with vectors and matrices stored as anonymous arrays. Frequently it may be more useful to use the Matrix objects defined RealMatrix.pm and Matrix.pm and the constructs listed there. @@ -29,7 +29,7 @@ sub _PGmatrixmacros_init { } # this subroutine zero_check is not very well designed below -- if it is used much it should receive -# more work -- particularly for checking relative tolerance. More work needs to be done if this is +# more work -- particularly for checking relative tolerance. More work needs to be done if this is # actually used. sub zero_check{ @@ -62,30 +62,30 @@ sub vec_dot{ } sub proj_vec { my $vec = shift; - warn "First input must be a column matrix" unless ref($vec) eq 'Matrix' and ${$vec->dim()}[1] == 1; - my $matrix = shift; # the matrix represents a set of vectors spanning the linear space + warn "First input must be a column matrix" unless ref($vec) eq 'Matrix' and ${$vec->dim()}[1] == 1; + my $matrix = shift; # the matrix represents a set of vectors spanning the linear space # onto which we want to project the vector. warn "Second input must be a matrix" unless ref($matrix) eq 'Matrix' and ${$matrix->dim()}[1] == ${$vec->dim()}[0]; $matrix * transpose($matrix) * $vec; } - + sub vec_cmp{ #check to see that the submitted vector is a non-zero multiple of the correct vector my $correct_vector = shift; my %options = @_; my $ans_eval = sub { my $in = shift @_; - + my $ans_hash = new AnswerHash; my @in = split("\0",$in); - my @correct_vector=@$correct_vector; + my @correct_vector=@$correct_vector; $ans_hash->{student_ans} = "( " . join(", ", @in ) . " )"; $ans_hash->{correct_ans} = "( " . join(", ", @correct_vector ) . " )"; return($ans_hash) unless @$correct_vector == @in; # make sure the vectors are the same dimension - + my $correct_length = vec_dot($correct_vector,$correct_vector); my $in_length = vec_dot(\@in,\@in); - return($ans_hash) if $in_length == 0; + return($ans_hash) if $in_length == 0; if (defined($correct_length) and $correct_length != 0) { my $constant = vec_dot($correct_vector,\@in)/$correct_length; @@ -94,14 +94,14 @@ sub vec_cmp{ #check to see that the submitted vector is a non-zero multiple o $difference[$i]=$constant*$correct_vector[$i] - $in[$i]; } $ans_hash->{score} = zero_check(\@difference); - + } else { $ans_hash->{score} = 1 if vec_dot(\@in,\@in) == 0; } $ans_hash; - + }; - + $ans_eval; } @@ -159,7 +159,7 @@ =head4 display_matrix =cut -sub display_matrix_mm{ # will display a matrix in tex format. +sub display_matrix_mm{ # will display a matrix in tex format. # the matrix can be either of type array or type 'Matrix' return display_matrix(@_, 'force_tex'=>1); } @@ -174,7 +174,7 @@ sub display_matrix { $ra_matrix = convert_to_array_ref($ra_matrix); my $styleParams = defined($main::defaultDisplayMatrixStyle) ? $main::defaultDisplayMatrixStyle : "(s)"; - + set_default_options(\%opts, '_filter_name' => 'display_matrix', 'force_tex' => 0, @@ -186,11 +186,11 @@ sub display_matrix { 'allow_unknown_options'=> 1, 'num_format' => "%.0f", ); - + my ($numRows, $numCols, @myRows); my $original_matrix = $ra_matrix; if (ref($ra_matrix) eq 'Value::Matrix') { - $ra_matrix = $ra_matrix->wwMatrix->array_ref; # translate + $ra_matrix = $ra_matrix->wwMatrix->array_ref; # translate } if (ref($ra_matrix) eq 'Matrix' ) { #handle Real::Matrix1 type matrices: #FIXME deprectated ($numRows, $numCols) = $ra_matrix->dim(); @@ -215,7 +215,7 @@ sub display_matrix { } } } - + my $out; my $j; my $alignString=''; # alignment as a string for dvi/pdf @@ -247,7 +247,7 @@ sub display_matrix { my $cnt = 1; # we count rows in in case an element is boxed # vertical lines put in with first row $j = shift @myRows; - $out .= dm_mat_row($j, $alignList, %opts, 'isfirst'=>$numRows, + $out .= dm_mat_row($j, $alignList, %opts, 'isfirst'=>$numRows, 'cnt' => $cnt); $cnt++ unless ($j eq 'hline'); $out .= dm_mat_right($numRows, %opts); @@ -289,9 +289,9 @@ sub dm_begin_matrix { or $main::displayMode eq 'HTML_LaTeXMathML' or $main::displayMode eq 'HTML' or $main::displayMode eq 'HTML_img') { - $out .= qq!\n!; + $out .= qq!
\n!; } - else { + else { $out = "Error: dm_begin_matrix: Unknown displayMode: $main::displayMode.\n"; } $out; @@ -308,7 +308,7 @@ sub dm_special_tops { $brh = "\\begin{rawhtml}"; $erh = "\\end{rawhtml}"; } - + if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { for $j (@top_labels) { if ($main::displayMode ne 'HTML_MathJax') { @@ -391,7 +391,7 @@ sub dm_mat_right { $erh = "\\end{rawhtml}"; } - + if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { return ""; } @@ -405,7 +405,7 @@ sub dm_mat_right { or $main::displayMode eq 'HTML' or $main::displayMode eq 'HTML_img') { $out .= "$brh'; } } - + my @elements = @{$elements}; my $out = ""; my ($brh, $erh) = ("",""); # Start and end raw html @@ -608,15 +608,15 @@ =head4 side_labels for presenting tableaus. Entries are set in mathmode side_labels( @array ); - - \( \{lp_display_mm([$matrix3->value], + + \( \{lp_display_mm([$matrix3->value], top_labels=>[qw(x_1 x_2 x_3 x_4 obj b)] ) \} - \{side_labels( qw(\text{cash} \text{hours} \text{profits} ) ) - \} + \{side_labels( qw(\text{cash} \text{hours} \text{profits} ) ) + \} \) -=cut +=cut sub side_labels { my @labels; @@ -625,10 +625,10 @@ sub side_labels { } else { @labels = @_; } - my $outputstring = "\\begin{array}{c}"; + my $outputstring = "\\begin{array}{c}"; foreach my $label (@labels) { $outputstring .= "$label \\\\ \n"; - } + } $outputstring .= "\\end{array}"; } @@ -648,7 +648,7 @@ =head4 mbox output; and valign which sets vertical alignment on web page output. =cut - + sub mbox { my $inList = shift; my %opts; @@ -687,12 +687,12 @@ sub mbox { } return $out; } - + =head4 ra_flatten_matrix Usage: ra_flatten_matrix($A) - + where $A is a matrix object The output is a reference to an array. The matrix is placed in the array by iterating over columns on the inside @@ -716,7 +716,7 @@ sub ra_flatten_matrix{ } # This subroutine is probably obsolete and not generally useful. It was patterned after the APL -# constructs for multiplying matrices. It might come in handy for non-standard multiplication of +# constructs for multiplying matrices. It might come in handy for non-standard multiplication of # of matrices (e.g. mod 2) for indice matrices. sub apl_matrix_mult{ my $ra_a= shift; @@ -768,10 +768,10 @@ =head4 create2d_matrix create2d_matrix("1 2 4, 5 6 8"); produces the anonymous array [[1,2,4],[5,6,8] ] - + Matrix(create2d_matrix($string)); -=cut +=cut sub create2d_matrix { my $string = shift; @@ -797,17 +797,17 @@ sub check_matrix_from_ans_box_cmp{ $string = shift @_; my $studentMatrix; # eval { $studentMatrix = Matrix(create2d_matrix($string)); die "I give up";}; #caught by op_mask - $studentMatrix = Matrix(create2d_matrix($string)); die "I give up"; + $studentMatrix = Matrix(create2d_matrix($string)); die "I give up"; # main::DEBUG_MESSAGE(ref($studentMatrix). "$studentMatrix with error "); - # errors are returned as warnings. Can't seem to trap them. - my $rh_answer = new AnswerHash( + # errors are returned as warnings. Can't seem to trap them. + my $rh_answer = new AnswerHash( score => ($correctMatrix <=> $studentMatrix)?0:1, #fuzzy equals is zero for correct correct_ans => $correctMatrix, student_ans => $string, preview_text_string => $string, preview_latex_string => $studentMatrix->TeX, ans_message => "", - type => 'matrix_from_ans_box', + type => 'matrix_from_ans_box', ); $rh_answer; }; @@ -818,18 +818,18 @@ sub check_matrix_from_ans_box_cmp{ =head2 convert_to_array_ref { $output_matrix = convert_to_array_ref($input_matrix) - -Converts a MathObject matrix (ref($input_matrix eq 'Value::Matrix') -or a MatrixReal1 matrix (ref($input_matrix eq 'Matrix')to + +Converts a MathObject matrix (ref($input_matrix eq 'Value::Matrix') +or a MatrixReal1 matrix (ref($input_matrix eq 'Matrix')to a reference to an array (e.g [[4,6],[3,2]]). -This adaptor allows all of the Linear Programming subroutines to be used with +This adaptor allows all of the Linear Programming subroutines to be used with MathObject arrays. $mathobject_matrix->value outputs an array (usually an array of array references) so placing it inside square bracket produces and array reference (of array references) which is what lp_display_mm() is seeking. -=cut +=cut sub convert_to_array_ref { my $input = shift; @@ -875,7 +875,7 @@ sub convert_to_array_ref { # sub format_question{ # my $ra_matrix = shift; # my $out = qq! y'(t) = ! . displayMatrix($B). q! y(t)! -# +# # } 1; diff --git a/macros/RserveClient.pl b/macros/RserveClient.pl new file mode 100644 index 0000000000..ce01dc09f5 --- /dev/null +++ b/macros/RserveClient.pl @@ -0,0 +1,204 @@ +=head1 NAME + +RserveClient.pl - Macros for evaluating R code on an Rserve server + +=head1 SYNPOSIS + +=head1 SYNOPSIS + + loadMacros('RserveClient.pl'); + + rserve_start(); + my @rnorm = rserve_eval("rnorm(15, mean=$m, sd=$sd)"); + rserve_eval(data(stackloss)); + my @coeff = rserve_eval('lm(stack.loss ~ stack.x, stackloss)$coeff'); + rserve_finish(); + + +=head1 DESCRIPTION + +The macros in this file provide access to facilities of L, +optionally located on another server, by using the +L protocol. + +B Before you can use these macros, you will need to +configure the location of your Rserve host by adding it to +C<$pg{specialPGEnvironmentVars}{Rserve}{host}>, for instance by +appending the following line to F: + + $pg{specialPGEnvironmentVars}{Rserve} = {host => "localhost"}; + +Without this configuration in place, Rserve macros will only print out +a warning about missing configuration and return C. + +=head1 MACROS + +The macros in this file set up a connection to the R server and +pass a string parameter to R for evaluation. The resulting +vector is returned as a perl array object. + +=over 4 + +=item rserve_eval REXPR + +Evaluates an R expression, given as text string in REXPR, on the +L server and returns its result +as a Perl representation of the L object. +Multiple calls within the same problem share the R session and the +object workspace. + +=item rserve_query + +Evaluates an R expression, given as text string in REXPR, in a +single-use session on the L +server and returns its result as a Perl representation of the +L object. + +This function is different from C in that each call is +completely self-enclosed and its R session is discarded after it +returns. + +=item rserve_start, rserve_finish + +Start up and close the current connection to the Rserve server. In +normal use, these functions are completely optional because the first +call to C will call start the session if one is not +already open. Similarly, the current session will be closed in its +destructor when the current question goes out of scope. + +Other than backward compatibility, the only reason for using these +functions is to start a new clean session within a single problem, +which shouldn't be a common occurrence. + +=item rserve_start_plot [IMG_TYPE, [WIDTH, HEIGHT]] + +Opens a new R graphics device to capture subsequent graphics output in +a temporary file on the R server. IMG_TYPE can be 'png', 'jpg', or +'pdf', with 'png' as the default. If left unspecified, WIDTH and +HEIGHT, will use the R graphics device's default size. Returns the +name of the remote file. + + +=item rserve_finish_plot REMOTE_NAME + +Closes the R graphics capture to file REMOTE_NAME, transfers the file +to WebWork's temporary file area, and returns the name of the local +file that can then be used by the image macro. + +=item rserve_get_file REMOTE_NAME, [LOCAL_NAME] + +Transfer the file REMOTE_NAME from the R server to WebWork's temporary +file area, and returns the name of the local file that can then be +used by the C macro. If LOCAL_NAME is not specified, the +filename portion of the REMOTE_NAME is used. + +=back + + +=head1 DEPENDENCIES + +Requires perl 5.010 or newer and CPAN module Statistics::R::IO, which +has to be loaded in WebWork's Safe compartment by adding it to +${pg}{modules}. + + +=cut + + +my $rserve; # Statistics::R::IO::Rserve instance + + +sub _rserve_warn_no_config { + my @trace = split /\n/, Value::traceback(); + my ($function, $line, $file) = $trace[0] =~ /^\s*in ([^ ]+) at line (\d+) of (.*)/; + + $PG->warning_message('Calling ' . $function . + ' is disabled unless Rserve host is configured in $pg{specialPGEnvironmentVars}{Rserve}{host}') +} + + +sub rserve_start { + _rserve_warn_no_config && return unless $Rserve->{host}; + + $rserve = Rserve::access(server => $Rserve->{host}, _usesocket => 1); + + # Keep R's RNG reproducible for this problem + $rserve->eval("set.seed($problemSeed)") +} + + +sub rserve_finish { + $rserve->close() if $rserve; + undef $rserve +} + + +sub rserve_eval { + _rserve_warn_no_config && return unless $Rserve->{host}; + + my $query = shift; + + rserve_start unless $rserve; + + my $result = Rserve::try_eval($rserve, $query); + Rserve::unref_rexp($result) +} + + +sub rserve_query { + _rserve_warn_no_config && return unless $Rserve->{host}; + + my $query = shift; + $query = "set.seed($problemSeed)\n" . $query; + my $rserve_client = Rserve::access(server => $Rserve->{host}, _usesocket => 1); + my $result = Rserve::try_eval($rserve_client, $query); + $rserve_client->close; + Rserve::unref_rexp($result) +} + + +sub rserve_start_plot { + _rserve_warn_no_config && return unless $Rserve->{host}; + + my $device = shift // 'png'; + my $width = shift // ''; + my $height = shift // ''; + + die "Unsupported image type $device" unless $device =~ /^(png|pdf|jpg)$/; + my $remote_image = (rserve_eval("tempfile(fileext='.$device')"))[0]; + + $device =~ s/jpg/jpeg/; + + rserve_eval("$device('$remote_image', width = ${width}, height = ${height})"); + + $remote_image +} + + +sub rserve_finish_plot { + _rserve_warn_no_config && return unless $Rserve->{host}; + + my $remote_image = shift or die "Missing remote image name"; + + rserve_eval("dev.off()"); + + rserve_get_file($remote_image) +} + + +sub rserve_get_file { + _rserve_warn_no_config && return unless $Rserve->{host}; + + my $remote = shift or die "Missing remote file name"; + my $local = shift // $PG->fileFromPath($remote); + + $local = $PG->surePathToTmpFile($local); + + $rserve->get_file($remote, $local); + + $local +} + + +1; diff --git a/macros/bizarroArithmetic.pl b/macros/bizarroArithmetic.pl index ee1c66447f..3881ffe49d 100644 --- a/macros/bizarroArithmetic.pl +++ b/macros/bizarroArithmetic.pl @@ -66,7 +66,8 @@ =head1 DESCRIPTION $student = Formula("$student"); $correct = Formula("$correct"); return 0 unless ($correct == $student); Context()->flags->set(bizarroDiv=>1); - delete $correct->{test_values}, $student->{test_values}; + delete $correct->{test_values}; + delete $student->{test_values}; my $OK = (($correct == $student) or ($student == $correct)); Context()->flags->set(bizarroDiv=>0); Value::Error("Your answer is correct, but please simplify it further") unless $OK; diff --git a/macros/compoundProblem.pl b/macros/compoundProblem.pl index 84cfbaa159..26bd3ef1e4 100644 --- a/macros/compoundProblem.pl +++ b/macros/compoundProblem.pl @@ -288,7 +288,7 @@ sub getStatus { 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} || "Go on to Next Part")); + $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}; @@ -467,7 +467,7 @@ sub reset { # sub resetCheckbox { my $self = shift; - my $label = shift || " Go back to Part 1 (when you submit your answers)."; + 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'; } @@ -477,7 +477,7 @@ sub resetCheckbox { # sub nextCheckbox { my $self = shift; - my $label = shift || " Go on to next part (when you submit your answers)."; + 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!; @@ -488,7 +488,7 @@ sub nextCheckbox { # sub nextButton { my $self = shift; - my $label = quoteHTML(shift || "Go on to Next Part"); + my $label = quoteHTML(shift || $main::PG->maketext("Go on to next part")); my $par = shift; $par = ($par ? $main::PAR : ''); $par . qq!!; @@ -499,7 +499,7 @@ sub nextButton { # sub nextForced { my $self = shift; - my $label = shift || "Submit your answers again to go on to the next part."; + 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!; @@ -580,7 +580,7 @@ sub grader { $status->{raw} = $result->{score}; $status->{score} = $result->{score}*$weight; $status->{new_ans_rule_count} = $main::ans_rule_count; - if (defined(%main::images_created)) { + if (%main::images_created) { $status->{imageName} = (keys %main::images_created)[0]; $status->{new_images_created} = $main::images_created{$status->{imageName}}; } @@ -599,15 +599,15 @@ sub grader { # $result->{type} = "compoundProblem ($result->{type})"; $result->{msg} .= '

Note: ' if $result->{msg}; - $result->{msg} .= 'This problem has more than one part.' - . '
'.$space.'Your score for this attempt is for this part only;' - . '
'.$space.'your overall score is for all the parts combined.' + $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} .= '

You may not change your answers when going on to the next part!' + $result->{msg} .= '

'.$main::PG->maketext("You may not change your answers when going on to the next part!").'' if $self->{nextNoChange} && $self->{answersChanged}; # diff --git a/macros/contextFraction.pl b/macros/contextFraction.pl index ab06c62a07..25ce008832 100644 --- a/macros/contextFraction.pl +++ b/macros/contextFraction.pl @@ -618,6 +618,8 @@ sub reduce { package context::Fraction::Real; our @ISA = ('Value::Real'); +sub cmp_defaults {Value::Real::cmp_defaults(@_)} + # # Allow Real to convert Fractions to Reals # @@ -831,6 +833,16 @@ sub atan2 { return $self->inherit($other)->make(CORE::atan2($l->eval,$r->eval)); } +################################################## +# +# Differentiation +# + +sub D { + my $self = shift; + return $self->make(0,1); +} + ################################################## # # Utility diff --git a/macros/contextInequalities.pl b/macros/contextInequalities.pl index 84e74ddd4e..983aed14fd 100644 --- a/macros/contextInequalities.pl +++ b/macros/contextInequalities.pl @@ -146,10 +146,10 @@ sub Init { '!=' => {precedence => .5, associativity => 'left', type => 'bin', string => ' != ', TeX => '\ne ', class => 'Inequalities::BOP::inequality', eval => 'evalNotEqualTo'}, - 'and' => {precedence => .45, associateivity => 'left', type => 'bin', string => " and ", + 'and' => {precedence => .45, associativity => 'left', type => 'bin', string => " and ", TeX => '\hbox{ and }', class => 'Inequalities::BOP::and'}, - 'or' => {precedence => .4, associateivity => 'left', type => 'bin', string => " or ", + 'or' => {precedence => .4, associativity => 'left', type => 'bin', string => " or ", TeX => '\hbox{ or }', class => 'Inequalities::BOP::or'}, ); $context->operators->set( diff --git a/macros/contextLimitedFactor.pl b/macros/contextLimitedFactor.pl index f25016f5e5..abf7f7ceca 100644 --- a/macros/contextLimitedFactor.pl +++ b/macros/contextLimitedFactor.pl @@ -41,7 +41,8 @@ sub _contextLimitedFactor_init { $correct = $correct->{original_formula} if defined $correct->{original_formula}; # check for equivalence when bizarro arithmetic is enforced Context()->flags->set(bizarroSub=> 1,bizarroAdd=> 1, bizarroDiv=> 1); - delete $correct->{test_values}, $student->{test_values}; + delete $correct->{test_values}; + delete $student->{test_values}; my $OK = ($correct == $student); Context()->flags->set(bizarroSub=> 0,bizarroAdd=> 0, bizarroDiv=> 0); my $factorableObject = Context()->flag("factorableObject"); diff --git a/macros/contextLimitedRadical.pl b/macros/contextLimitedRadical.pl index 2e67ef4f00..2538101080 100644 --- a/macros/contextLimitedRadical.pl +++ b/macros/contextLimitedRadical.pl @@ -90,7 +90,7 @@ sub _contextLimitedRadical_init { $context->flags->set(limits => [0,5]); # no negatives in the radicals $context->flags->set(reduceConstantFunctions=>0, reduceConstants=>0, - formatStudentAnswer =>parsed, + formatStudentAnswer =>"parsed", checkSqrt => 0, checkRoot => 0); LimitedPowers::OnlyPositiveIntegers($context); # don't allow powers of 1/2, 1/3, etc @@ -102,7 +102,8 @@ sub _contextLimitedRadical_init { $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}; + delete $correct->{test_values}; + delete $student->{test_values}; my $OK = (($correct == $student) or ($student == $correct)); # check if equal when sqrt's are replaced by 1 Context()->flags->set(checkSqrt => 0, checkRoot => 0, bizarroAdd => 0, bizarroSub => 0, bizarroMul => 0, bizarroDiv => 0); Value::Error("You must simplify your answer further") unless $OK; diff --git a/macros/contextPiecewiseFunction.pl b/macros/contextPiecewiseFunction.pl index a86e316d7b..d18e227156 100644 --- a/macros/contextPiecewiseFunction.pl +++ b/macros/contextPiecewiseFunction.pl @@ -771,10 +771,10 @@ sub TeX { my $period = ($self->{final_period} ? "." : ""); foreach my $If (@{$self->{data}}) { my ($I,$f) = @{$If}; - push(@cases,'\displaystyle{'.$f->TeX."}&\\text{if}\\ ".$I->TeX); + push(@cases,'\displaystyle{'.$f->TeX."}&\\text{".$main::PG->maketext("if")."}\\ ".$I->TeX); } if (scalar(@cases)) { - push(@cases,'\displaystyle{'.$self->{otherwise}->TeX.'}&\text{otherwise}') if defined $self->{otherwise}; + push(@cases,'\displaystyle{'.$self->{otherwise}->TeX.'}&\text{'.$main::PG->maketext("otherwise").'}') if defined $self->{otherwise}; return '\begin{cases}'.join('\cr'."\n",@cases).$period.'\end{cases}'; } else { return $self->{otherwise}->TeX; diff --git a/macros/niceTables.pl b/macros/niceTables.pl index dea1d15c95..79e9884f5b 100644 --- a/macros/niceTables.pl +++ b/macros/niceTables.pl @@ -213,7 +213,7 @@ sub DataTable { $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};}; + {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 @@ -411,7 +411,6 @@ sub DataTable { }; }; - my @alignmentcolumns; 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 @@ -515,9 +514,9 @@ sub DataTable { {my $colspan = (${$dataref->[$i][$j]}{colspan} eq '') ? '' : 'colspan = "'.${$dataref->[$i][$j]}{colspan}.'" '; if (uc(${$dataref->[$i][$j]}{header}) eq 'TH') {$table .= '

';} - elsif (uc(${$dataref->[$i][$j]}{header}) ~~ ['CH','COLUMN','COL']) + elsif (grep { uc(${$dataref->[$i][$j]}{header}) eq $_ } ('CH','COLUMN','COL')) {$table .= '';} - elsif (uc(${$dataref->[$i][$j]}{header}) ~~ ['RH','ROW']) + elsif (grep { uc(${$dataref->[$i][$j]}{header}) eq $_ } ('RH','ROW')) {$table .= '';} elsif (uc(${$dataref->[$i][$j]}{header}) eq 'TD') {$table .= '';} @@ -576,7 +575,9 @@ sub DataTable { { if ($rowcolor[$i] ne '') {$textable .= '\rowcolor'.$rowcolor[$i];}; for my $j (0..$numcols[$i]) - {if (uc(${$dataref->[$i][$j]}{header}) ~~ ['TH','CH','COLUMN','COL','RH','ROW'] or ($headerrow[$i] == 1) and !(uc(${$dataref->[$i][$j]}{header}) ~~ ['TD'])) {${$dataref->[$i][$j]}{tex} = '\bfseries '.${$dataref->[$i][$j]}{tex}}; + + {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 .= '}'}; diff --git a/macros/parserDifferenceQuotient.pl b/macros/parserDifferenceQuotient.pl index 4cfa51afba..b9440518e2 100644 --- a/macros/parserDifferenceQuotient.pl +++ b/macros/parserDifferenceQuotient.pl @@ -1,6 +1,6 @@ ################################################################################ # WeBWorK Online Homework Delivery System -# Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ +# 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 @@ -33,19 +33,34 @@ =head1 DESCRIPTION alphabetically is used to form the dx. Otherwise, you can specify the variable used for dx as the second argument to DifferenceQuotient(). You could use a variable like h instead of -dx if you prefer. +dx if you prefer. This is specified in the second argument. +If you want to identify division by zero when a value other than +zero is substituted in for dx (or h), then the third argument is a +number to be substituted into the variable named in the second +argument. The third argument is optional and the default value +0 is used when the third argument is omitted. =head1 USAGE + # simplify (f(x+dx)-f(x)) / dx for f(x)=x^2 $df = DifferenceQuotient("2x+dx"); ANS($df->cmp); + # simplify (f(x+h)-f(x)) / h for f(x) = x^2 $df = DifferenceQuotient("2x+h","h"); ANS($df->cmp); - + + # simplify (f(t+dt)-f(t)) / dt for f(t)=a/t Context()->variables->are(t=>'Real',a=>'Real'); ANS(DifferenceQuotient("-a/[t(t+dt)]","dt")->cmp); + # simplify (f(x)-f(c)) / (x-c) for f(x)=x^2 at c=3 + $df = DifferenceQuotient("x+3","x",3); + + # simplify (x^2 - 4) / (x-2) + $df = DifferenceQuotient("x+2","x",2); + ANS($df->cmp); + =cut loadMacros('MathObjects.pl'); @@ -65,6 +80,7 @@ sub new { my $current = (Value::isContext($_[0]) ? shift : $self->context); my $formula = shift; my $dx = shift || $current->flag('diffQuotientVar') || 'd'.($current->variables->names)[-1]; + my $zp = shift || 0; # division by zero point # # Make a copy of the context to which we add a variable for 'dx' # @@ -72,6 +88,7 @@ sub new { $context->variables->add($dx=>'Real') unless ($context->variables->get($dx)); $q = bless $context->Package("Formula")->new($context,$formula), $class; $q->{'dx'} = $dx; + $q->{'zp'} = $zp; # the division by zero point return $q; } @@ -83,10 +100,10 @@ sub new { )} sub cmp_postprocess { - my $self = shift; my $ans = shift; my $dx = $self->{'dx'}; + my $self = shift; my $ans = shift; my $dx = $self->{'dx'}; my $zp = $self->{'zp'}; return if $ans->{score} == 0 || $ans->{isPreview}; $main::__student_value__ = $ans->{student_value}; - my ($value,$err) = main::PG_restricted_eval('$__student_value__->substitute(\''.$dx.'\'=>0)->reduce'); + my ($value,$err) = main::PG_restricted_eval('$__student_value__->substitute(\''.$dx.'\'=>\''.$zp.'\')->reduce'); $self->cmp_Error($ans,"It looks like you didn't finish simplifying your answer") if $err && $err =~ m/division by zero/i; } diff --git a/macros/parserFormulaWithUnits.pl b/macros/parserFormulaWithUnits.pl index 687e2d9bd2..9a625ece97 100644 --- a/macros/parserFormulaWithUnits.pl +++ b/macros/parserFormulaWithUnits.pl @@ -36,6 +36,35 @@ =head1 USAGE $x = Formula("x"); ANS(FormulaWithUnits($a*$x+1,"ft")->cmp); +We now call on the Legacy version, which is used by +num_cmp to handle numbers with units. + +New units can be added at run time by using the newUnit option + + $a = FormulaWithUnits("3x apples",{newUnit=>'apples'}); + +A new unit can either be a string, in which case the string is added as a +new unit with no relation to other units, or as a hashreference + + $newUnit = {name => 'bear', + conversion => {factor =>3, m=>1}}; + $a = FormulaWithUnits("3x bear", {newUnit=>$newUnit}); + +You can also define your own conversion hash. In the above example one bear +is three meters. (See Units.pm for examples). + +Finally, the newUnit option can also be an array ref containing any number of +new units to add. A common reason for doing this would be to add the plural +version of the unit as an equilvalent unit. E.G. + + $newUnits = ['apple',{name=>'apples',conversion=>{factor=>1,apple=>1}}]; + $a = FormulaWithUnits("3x apples",{newUnit=>$newUnits}); + +In this case both 3x apple and 3x apples would be accepted as answers. + +Note: English pluralization is suprisingly hard, so WeBWorK will make no +attempt to display a grammerically correct result. + =cut loadMacros('MathObjects.pl'); @@ -44,9 +73,24 @@ =head1 USAGE # Now uses the version in Parser::Legacy::NumberWithUnits # to avoid duplication of common code. # +our %fundamental_units = %Units::fundamental_units; +our %known_units = %Units::known_units; sub _parserFormulaWithUnits_init { + # We make copies of these hashes here because these copies will be unique to # the problem. The hashes in Units are shared between problems. We pass + # the hashes for these local copies to the NumberWithUnits package to use + # for all of its stuff. + + + Parser::Legacy::ObjectWithUnits::initializeUnits(\%fundamental_units,\%known_units); + main::PG_restricted_eval('sub FormulaWithUnits {Parser::Legacy::FormulaWithUnits->new(@_)}'); } +sub parserFormulaWithUnits::fundamental_units { + return \%fundamental_units; +} +sub parserFormulaWithUnits::known_units { + return \%known_units; +} 1; diff --git a/macros/parserMultiAnswer.pl b/macros/parserMultiAnswer.pl index d0d6160ef5..898158d7f1 100644 --- a/macros/parserMultiAnswer.pl +++ b/macros/parserMultiAnswer.pl @@ -450,9 +450,16 @@ sub ans_rule { my $label = main::generate_aria_label($answerPrefix.$name."_0"); return $data->named_ans_rule($name,$size,@_,aria_label=>$label); } - return $data->named_ans_rule_extension($self->NEW_NAME($name),$size,@_) - if ($self->{singleResult} && $self->{part} > 1); - return $data->named_ans_rule($name,$size,@_); + if ($self->{singleResult} && $self->{part} > 1) { + my $extension_ans_rule = + $data->named_ans_rule_extension( + $name,$size, answer_group_name => $self->{answerName}, + @_); + # warn "extension rule created: $extension_ans_rule for ", ref($data); + return $extension_ans_rule; + } else { + return $data->named_ans_rule($name,$size,@_); + } } # @@ -466,10 +473,14 @@ sub ans_array { my $name = $self->ANS_NAME($self->{part}++); if ($self->{singleResult} && $self->{part} == 1) { my $label = main::generate_aria_label($answerPrefix.$name."_0"); - return $data->named_ans_array($name,$size,@_,aria_label=>$label); + return $data->named_ans_array($name,$size, + answer_group_name => $self->{answerName}, + @_,aria_label=>$label); } if ($self->{singleResult} && $self->{part} > 1) { - $HTML = $data->named_ans_array_extension($self->NEW_NAME($name),$size,@_); + $HTML = $data->named_ans_array_extension($self->NEW_NAME($name),$size, + answer_group_name => $self->{answerName}, @_); + # warn "array extension rule created: $HTML for ", ref($data); } else { $HTML = $data->named_ans_array($name,$size,@_); } diff --git a/macros/parserNumberWithUnits.pl b/macros/parserNumberWithUnits.pl index e99cad595d..dd958d555a 100644 --- a/macros/parserNumberWithUnits.pl +++ b/macros/parserNumberWithUnits.pl @@ -37,12 +37,60 @@ =head1 DESCRIPTION We now call on the Legacy version, which is used by num_cmp to handle numbers with units. +New units can be added at run time by using the newUnit option + + $a = NumberWithUnits("3 apples",{newUnit=>'apples'}); + +A new unit can either be a string, in which case the string is added as a +new unit with no relation to other units, or as a hashreference + + $newUnit = {name => 'bear', + conversion => {factor =>3, m=>1}}; + $a = NumberWithUnits("3 bear", {newUnit=>$newUnit}); + +You can also define your own conversion hash. In the above example one bear +is three meters. (See Units.pm for examples). + +Finally, the newUnit option can also be an array ref containing any number of +new units to add. A common reason for doing this would be to add the plural +version of the unit as an equilvalent unit. E.G. + + $newUnits = ['apple',{name=>'apples',conversion=>{factor=>1,apple=>1}}]; + $a = NumberWithUnits("3 apples",{newUnit=>$newUnits}); + +In this case both 3 apple and 3 apples would be considered correct. + +Note: English pluralization is suprisingly hard, so WeBWorK will make no +attempt to display a grammerically correct result. + =cut loadMacros('MathObjects.pl'); +our %fundamental_units = %Units::fundamental_units; +our %known_units = %Units::known_units; + sub _parserNumberWithUnits_init { - main::PG_restricted_eval('sub NumberWithUnits {Parser::Legacy::NumberWithUnits->new(@_)}'); + # We make copies of these hashes here because these copies will be unique to # the problem. The hashes in Units are shared between problems. We pass + # the hashes for these local copies to the NumberWithUnits package to use + # for all of its stuff. + + + Parser::Legacy::ObjectWithUnits::initializeUnits(\%fundamental_units,\%known_units); + # main::PG_restricted_eval('sub NumberWithUnits {Parser::Legacy::NumberWithUnits->new(@_)}'); + +} +sub NumberWithUnits {Parser::Legacy::NumberWithUnits->new(@_)}; +sub parserNumberWithUnits::fundamental_units { + return \%fundamental_units; +} +sub parserNumberWithUnits::known_units { + return \%known_units; +} +sub parserNumberWithUnits::add_unit { + my $newUnit = shift; + my $Units= Parser::Legacy::ObjectWithUnits::add_unit($newUnit->{name}, $newUnit->{conversion}); + return %$Units; } 1; diff --git a/macros/parserPopUp.pl b/macros/parserPopUp.pl index b334ebeb81..c2e7621904 100644 --- a/macros/parserPopUp.pl +++ b/macros/parserPopUp.pl @@ -168,7 +168,7 @@ sub MENU { $menu = qq!"; diff --git a/macros/parserRadioButtons.pl b/macros/parserRadioButtons.pl index db8d27ddf3..dc13f18103 100644 --- a/macros/parserRadioButtons.pl +++ b/macros/parserRadioButtons.pl @@ -32,7 +32,9 @@ =head1 DESCRIPTION where "choices" are the strings for the items in the radio buttons, "correct" is the choice that is the correct answer for the group (or its index, with 0 being the first one), and options are chosen from -among those listed below. +among those listed below. If the correct answer is a number, it is +interpretted as an index, even if the array of choices are also +numbers. (See the C below for more details.) The entries in the choices array can either be strings that are the text to use for the choice buttons, or C<{label=>text}> where C
$erh"; - + $out.= dm_image_delimeter($numrows, $opts{'right'}); return $out; } @@ -419,7 +419,7 @@ sub dm_mat_right { sub dm_end_matrix { my %opts = @_; - + my $out = ""; if ($main::displayMode eq 'TeX' or $opts{'force_tex'}) { $out .= "\\end{array}\\right$opts{right}"; @@ -481,13 +481,13 @@ sub dm_tth_delimeter { my ($top, $mid, $bot, $extra); my ($j, $out); - if($char eq "(") { ($top, $mid, $bot, $extra) = ('æ','ç','è','ç');} - elsif($char eq ")") { ($top, $mid, $bot, $extra) = ('ö','÷','ø','÷');} - elsif($char eq "|") { ($top, $mid, $bot, $extra) = ('ê','ê','ê','ê');} - elsif($char eq "[") { ($top, $mid, $bot, $extra) = ('é','ê','ë','ê');} - elsif($char eq "]") { ($top, $mid, $bot, $extra) = ('ù','ú','û','ú');} - elsif($char eq "{") { ($top, $mid, $bot, $extra) = ('ì','ï','î','í');} - elsif($char eq "}") { ($top, $mid, $bot, $extra) = ('ü','ï','þ','ý');} + if($char eq "(") { ($top, $mid, $bot, $extra) = ('æ','ç','è','ç');} + elsif($char eq ")") { ($top, $mid, $bot, $extra) = ('ö','÷','ø','÷');} + elsif($char eq "|") { ($top, $mid, $bot, $extra) = ('ê','ê','ê','ê');} + elsif($char eq "[") { ($top, $mid, $bot, $extra) = ('é','ê','ë','ê');} + elsif($char eq "]") { ($top, $mid, $bot, $extra) = ('ù','ú','û','ú');} + elsif($char eq "{") { ($top, $mid, $bot, $extra) = ('ì','ï','î','í');} + elsif($char eq "}") { ($top, $mid, $bot, $extra) = ('ü','ï','þ','ý');} else { warn "Unknown delimiter in dm_tth_delimeter";} # old version @@ -520,7 +520,7 @@ sub dm_mat_row { return '
'.${$dataref->[$i][$j]}{data}.''.${$dataref->[$i][$j]}{data}.''.${$dataref->[$i][$j]}{data}.''.${$dataref->[$i][$j]}{data}.'