Menu
▾
▴
openwebwork-cvs — WeBWorK CVS activity
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(58) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
(53) |
Feb
(56) |
Mar
|
Apr
|
May
(30) |
Jun
(78) |
Jul
(121) |
Aug
(155) |
Sep
(77) |
Oct
(61) |
Nov
(45) |
Dec
(94) |
| 2006 |
Jan
(116) |
Feb
(33) |
Mar
(11) |
Apr
(23) |
May
(60) |
Jun
(89) |
Jul
(130) |
Aug
(109) |
Sep
(124) |
Oct
(63) |
Nov
(82) |
Dec
(45) |
| 2007 |
Jan
(31) |
Feb
(35) |
Mar
(123) |
Apr
(36) |
May
(18) |
Jun
(134) |
Jul
(133) |
Aug
(241) |
Sep
(126) |
Oct
(31) |
Nov
(15) |
Dec
(5) |
| 2008 |
Jan
(11) |
Feb
(6) |
Mar
(16) |
Apr
(29) |
May
(43) |
Jun
(149) |
Jul
(27) |
Aug
(29) |
Sep
(37) |
Oct
(20) |
Nov
(4) |
Dec
(6) |
| 2009 |
Jan
(34) |
Feb
(30) |
Mar
(16) |
Apr
(6) |
May
(1) |
Jun
(32) |
Jul
(22) |
Aug
(7) |
Sep
(18) |
Oct
(50) |
Nov
(22) |
Dec
(8) |
| 2010 |
Jan
(17) |
Feb
(15) |
Mar
(10) |
Apr
(9) |
May
(67) |
Jun
(30) |
Jul
|
Aug
|
Sep
(2) |
Oct
|
Nov
(1) |
Dec
|
|
From: jj v. a. <we...@ma...> - 2005-08-13 16:45:48
|
Log Message:
-----------
Moved a chunk of duplicated code to its own function, and tweaked the setting
of the context in a few cases.
Modified Files:
--------------
pg/macros:
extraAnswerEvaluators.pl
Revision Data
-------------
Index: extraAnswerEvaluators.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/extraAnswerEvaluators.pl,v
retrieving revision 1.9
retrieving revision 1.10
diff -Lmacros/extraAnswerEvaluators.pl -Lmacros/extraAnswerEvaluators.pl -u -r1.9 -r1.10
--- macros/extraAnswerEvaluators.pl
+++ macros/extraAnswerEvaluators.pl
@@ -156,6 +156,60 @@
}
}
+sub mode2context {
+ my $mode = shift;
+ my $options = @_;
+ my $context;
+ for ($mode) {
+ /^strict$/i and do {
+ $context = $Parser::Context::Default::context{LimitedNumeric}->copy;
+ $context->operators->redefine(',');
+ last;
+ };
+ /^arith$/i and do {
+ $context = $Parser::Context::Default::context{LegacyNumeric}->copy;
+ $context->functions->disable('All');
+ last;
+ };
+ /^frac$/i and do {
+ $context = $Parser::Context::Default::context{'LimitedNumeric-Fraction'}->copy;
+ $context->operators->redefine(',');
+ last;
+ };
+ if(defined($options{'complex'}) &&
+ ($options{'complex'} =~ /(yes|ok)/i)) {
+ $context = $Parser::Context::Default::context{Complex}->copy;
+ last;
+ }
+
+ # default
+ $context = $Parser::Context::Default::context{LegacyNumeric}->copy;
+ }
+ $options{tolType} = $options{tolType} || 'relative';
+ $options{tolerance} = $options{tolerance} || $options{tol} ||
+ $options{reltol} || $options{relTol} || $options{abstol} || 1;
+ $options{zeroLevel} = $options{zeroLevel} || $options{zeroLevelTol} ||
+ $main::numZeroLevelTolDefault;
+ if ($options{tolType} eq 'absolute' or defined($options{tol})
+ or defined($options{abstol})) {
+ $context->flags->set(
+ tolerance => $options{tolerance},
+ tolType => 'absolute',
+ );
+ } else {
+ $context->flags->set(
+ tolerance => .01*$options{tolerance},
+ tolType => 'relative',
+ );
+ }
+ $context->flags->set(
+ zeroLevel => $options{zeroLevel},
+ zeroLevelTol => $options{zeroLevelTol},
+ );
+ $context->{format}{number} = $options{'format'} || $main::numFormatDefault;
+ return($context);
+}
+
=head3 interval_cmp ()
Compares an interval or union of intervals. Typical invocations are
@@ -225,85 +279,43 @@
my $mode = $opts{mode} || 'std';
my %options = (debug => $opts{debug});
- my $ans_type = ''; # set to List, Union, Interval, or String below
+ my $ans_type = ''; # set to List, Union, or String below
#
# Get an apppropriate context based on the mode
#
my $oldContext = Context();
- my ($context, $ans_eval);
- for ($mode) {
- /^strict$/i and do {
- $context = $Parser::Context::Default::context{LimitedNumeric}->copy;
- $context->operators->set(',' => {class=> 'Parser::BOP::comma'});
- last;
- };
- /^arith$/i and do {
- $context = $Parser::Context::Default::context{LegacyNumeric}->copy;
- $context->functions->disable('All');
- last;
- };
- /^frac$/i and do {
- $context = $Parser::Context::Default::context{'LimitedNumeric-Fraction'}->copy;
- $context->operators->set(',' => {class=> 'Parser::BOP::comma'});
- last;
- };
-
- # default
- $context = $Parser::Context::Default::context{LegacyNumeric}->copy;
- }
+ my $context = mode2context($mode, %opts);
if(defined($opts{unions}) and $opts{unions} eq 'no' ) {
# This is really a list of points, not intervals at all
$ans_type = 'List';
$context->parens->redefine('(');
$context->parens->redefine('[');
- $context->parens->redefine('{', from=>'Interval');
- $correct_ans =~ s/u/,/gi;
+ $context->parens->redefine('{');
+ $context->operators->redefine('u',using=>',');
+ $context->operators->set(u=>{string=>", ", TeX=>',\,'});
} else {
$context->parens->redefine('(', from=>'Interval');
$context->parens->redefine('[', from=>'Interval');
$context->parens->redefine('{', from=>'Interval');
+
+ #$context->constants->redefine('R',from=>'Interval');
my $infinity = Value::Infinity->new();
$context->constants->add(
- R => Value::Interval->new('(',-$infinity,$infinity,')'),
- );
- $correct_ans =~ tr/u/U/;
+ R => Value::Interval->new('(',-$infinity,$infinity,')'),
+ );
$context->operators->redefine('U',from=>"Interval");
$context->operators->redefine('u',from=>"Interval",using=>"U");
- if($correct_ans =~ /U/) {
- $ans_type = 'Union';
- } else {
- $ans_type = 'Interval';
- }
+ $ans_type = 'Union';
}
- # Take optional arguments intended for Interval, List, or Union
+ # Take optional arguments intended for List, or Union
for my $o qw( showCoordinateHints showHints partialCredit showLengthHints ) {
$options{$o} = $opts{$o} || 0;
}
- # Tolerances
- $opts{tolType} = $opts{tolType} || 'relative';
- $opts{tolerance} = $opts{tolerance} || $opts{tol} ||
- $opts{reltol} || $opts{relTol} || $opts{abstol} || 1;
- $opts{zeroLevel} = $opts{zeroLevel} || $opts{zeroLevelTol} ||
- $main::numZeroLevelTolDefault;
- if ($opts{tolType} eq 'absolute' or defined($opts{tol})
- or defined($opts{abstol})) {
- $context->flags->set(
- tolerance => $opts{tolerance},
- tolType => 'absolute',
- );
- } else {
- $context->flags->set(
- tolerance => .01*$opts{tolerance},
- tolType => 'relative',
- );
- }
- $context->flags->set(
- zeroLevel => $opts{zeroLevel},
- zeroLevelTol => $opts{zeroLevelTol},
- );
$options{ordered} = 1 if(defined($opts{ordered}) and $opts{ordered});
+ $options{showUnionReduceWarnings}= $opts{showUnionReduceWarnings} || 1;
+ $options{studentsMustReduceUnions} = $opts{studentsMustReduceUnions} || 0;
if (defined($opts{'sloppy'}) && $opts{'sloppy'} eq 'yes') {
$options{requireParenMatch} = 0;
}
@@ -325,14 +337,12 @@
$ans_type = 'String' if $string eq uc($correct_ans);
}
}
- $context->{format}{number} = $opts{'format'} || $main::numFormatDefault;
+ my $ans_eval;
Context($context);
if($ans_type eq 'List') {
$ans_eval = List($correct_ans)->cmp(%options);
} elsif($ans_type eq 'Union') {
$ans_eval = Union($correct_ans)->cmp(%options);
- } elsif($ans_type eq 'Interval') {
- $ans_eval = Interval($correct_ans)->cmp(%options);
} elsif($ans_type eq 'String') {
$ans_eval = List($correct_ans)->cmp(%options);
} else {
@@ -400,33 +410,8 @@
# Get an apppropriate context based on the mode
#
my $oldContext = Context();
- my $context;
- for ($mode) {
- /^strict$/i and do {
- $context = $Parser::Context::Default::context{LimitedNumeric}->copy;
- $context->operators->set(',' => {class=> 'Parser::BOP::comma'});
- last;
- };
- /^arith$/i and do {
- $context = $Parser::Context::Default::context{LegacyNumeric}->copy;
- $context->functions->disable('All');
- last;
- };
- /^frac$/i and do {
- $context = $Parser::Context::Default::context{'LimitedNumeric-Fraction'}->copy;
- $context->operators->set(',' => {class=> 'Parser::BOP::comma'});
- last;
- };
- if(defined($num_params{'complex'}) &&
- ($num_params{'complex'} =~ /(yes|ok)/i)) {
- $context = $Parser::Context::Default::context{Complex}->copy;
- last;
- }
+ my $context = mode2context($mode, %num_params);
- # default
- $context = $Parser::Context::Default::context{LegacyNumeric}->copy;
- }
- $context->{format}{number} = $num_params{'format'} || $main::numFormatDefault;
#$context->strings->clear;
if ($num_params{strings}) {
foreach my $string (@{$num_params{strings}}) {
@@ -437,27 +422,6 @@
}
}
- $num_params{tolType} = $num_params{tolType} || 'relative';
- $num_params{tolerance} = $num_params{tolerance} || $num_params{tol} ||
- $num_params{reltol} || $num_params{relTol} || $num_params{abstol} || 1;
- $num_params{zeroLevel} = $num_params{zeroLevel} || $num_params{zeroLevelTol} ||
- $main::numZeroLevelTolDefault;
- if ($num_params{tolType} eq 'absolute' or defined($num_params{tol})
- or defined($num_params{abstol})) {
- $context->flags->set(
- tolerance => $num_params{tolerance},
- tolType => 'absolute',
- );
- } else {
- $context->flags->set(
- tolerance => .01*$num_params{tolerance},
- tolType => 'relative',
- );
- }
- $context->flags->set(
- zeroLevel => $num_params{zeroLevel},
- zeroLevelTol => $num_params{zeroLevelTol},
- );
$options{ordered} = 1 if(defined($num_params{ordered}) and $opts{ordered});
# These didn't exist before in number_list_cmp so they behaved like
# in List()->cmp. Now they can be optionally set
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-13 16:32:14
|
Log Message:
-----------
Added sort methods to Union and Set that return objects with their
data sorted.
Modified Files:
--------------
pg/lib/Value:
AnswerChecker.pm
Set.pm
Union.pm
Revision Data
-------------
Index: Set.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Set.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -Llib/Value/Set.pm -Llib/Value/Set.pm -u -r1.4 -r1.5
--- lib/Value/Set.pm
+++ lib/Value/Set.pm
@@ -110,12 +110,11 @@
# (return the resulting set or nothing for empty set)
#
sub subSetSet {
- my @l = sort {$a <=> $b} (@{$_[0]->data});
- my @r = sort {$a <=> $b} (@{$_[1]->data});
+ my @l = $_[0]->sort->value; my @r = $_[1]->sort->value;
my @entries = ();
while (scalar(@l) && scalar(@r)) {
if ($l[0] < $r[0]) {push(@entries,shift(@l))}
- else {if ($l[0] == $r[0]) {shift(@l)}; shift(@r)}
+ else {while ($l[0] == $r[0]) {shift(@l)}; shift(@r)}
}
push(@entries,@l);
return () unless scalar(@entries);
@@ -179,8 +178,7 @@
}
if ($l->getFlag('reduceSetsForComparison')) {$l = $l->reduce; $r = $r->reduce}
if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
- my @l = sort {$a <=> $b} $l->value;
- my @r = sort {$a <=> $b} $r->value;
+ my @l = $l->sort->value; my @r = $r->sort->value;
while (scalar(@l) && scalar(@r)) {
my $cmp = shift(@l) <=> shift(@r);
return $cmp if $cmp;
@@ -194,13 +192,20 @@
sub reduce {
my $self = shift;
return $self if $self->{isReduced} || $self->length < 2;
- my @data = (sort {$a <=> $b} ($self->value));
- my @set = ();
+ my @data = $self->sort->value; my @set = ();
while (scalar(@data)) {
push(@set,shift(@data));
shift(@data) while (scalar(@data) && $set[-1] == $data[0]);
}
- return $pkg->make(@set)->with(isReduced=>1);
+ return $self->make(@set)->with(isReduced=>1);
+}
+
+#
+# Sort the data for a set
+#
+sub sort {
+ my $self = shift;
+ return $self->make(sort {$a <=> $b} $self->value);
}
###########################################################################
Index: AnswerChecker.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v
retrieving revision 1.56
retrieving revision 1.57
diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.56 -r1.57
--- lib/Value/AnswerChecker.pm
+++ lib/Value/AnswerChecker.pm
@@ -253,8 +253,8 @@
my $reduced = $student->reduce;
return "Your$nth union can be written in a simpler form"
unless $reduced->type eq 'Union' && $reduced->length == $student->length;
- my @R = sort {$a <=> $b} $reduced->value;
- my @S = sort {$a <=> $b} $student->value;
+ my @R = $reduced->sort->value;
+ my @S = $student->sort->value;
foreach my $i (0..$#R) {
return "Your$nth union can be written in a simpler form"
unless $R[$i] == $S[$i];
Index: Union.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Union.pm,v
retrieving revision 1.17
retrieving revision 1.18
diff -Llib/Value/Union.pm -Llib/Value/Union.pm -u -r1.17 -r1.18
--- lib/Value/Union.pm
+++ lib/Value/Union.pm
@@ -186,10 +186,12 @@
my ($l,$r,$flag) = @_;
if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
$r = promote($r);
- if ($l->getFlag('reduceUnionsForComparison')) {$l = $l->reduce; $r = $r->reduce}
+ if ($l->getFlag('reduceUnionsForComparison')) {
+ $l = $l->reduce; $l = $pkg->make($l) unless $l->type eq 'Union';
+ $r = $r->reduce; $r = $pkg->make($r) unless $r->type eq 'Union';
+ }
if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
- my @l = sort {$a <=> $b} $l->value;
- my @r = sort {$a <=> $b} $r->value;
+ my @l = $l->sort->value; my @r = $r->sort->value;
while (scalar(@l) && scalar(@r)) {
my $cmp = shift(@l) <=> shift(@r);
return $cmp if $cmp;
@@ -212,7 +214,7 @@
else {push(@intervals,$x)}
}
my @union = (); my @set = (); my $prevX;
- @intervals = (sort {$a <=> $b} @intervals);
+ @intervals = (CORE::sort {$a <=> $b} @intervals);
ELEMENT: foreach my $x (@singletons) {
next if defined($prevX) && $prevX == $x; $prevX = $x;
foreach my $I (@intervals) {
@@ -245,6 +247,15 @@
############################################
#
+# Sort a union lexicographically
+#
+sub sort {
+ my $self = shift;
+ $self->make(CORE::sort {$a <=> $b} $self->value);
+}
+
+############################################
+#
# Generate the various output formats
#
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-13 15:55:35
|
Log Message:
-----------
Moved the union and set reduction checks from cmp_equal to cmp_compare
so that the messages can be produced even in lists of unions.
Improved the message facilities for the list comparison so that
cmp_compare can make errors that refer to the number of the entry in
the student's answer (otherwise an extra "There was a problem with
your nth value" message needs to be prepended, which looks bad if it
can be avoided).
Use the "extra" answer checker to report syntax error messages in unordered
lists.
Modified Files:
--------------
pg/lib/Value:
AnswerChecker.pm
Context.pm
Revision Data
-------------
Index: AnswerChecker.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v
retrieving revision 1.55
retrieving revision 1.56
diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.55 -r1.56
--- lib/Value/AnswerChecker.pm
+++ lib/Value/AnswerChecker.pm
@@ -166,16 +166,16 @@
# by the answer evaluator, or the overloaded == operator.
#
-our $CMP_ERROR = 2; # a fatal error was detected
+our $CMP_ERROR = 2; # a fatal error was detected
+our $CMP_WARNING = 3; # a warning was produced
sub cmp_compare {
- my $self = shift; my $other = shift; my $ans = shift;
+ my $self = shift; my $other = shift; my $ans = shift; my $nth = shift || '';
return eval {$self == $other} unless ref($ans->{checker}) eq 'CODE';
- my $equal = eval {&{$ans->{checker}}($self,$other,$ans)};
+ my $equal = eval {&{$ans->{checker}}($self,$other,$ans,$nth,@_)};
if (!defined($equal) && $@ ne '' && (!$$Value::context->{error}{flag} || $ans->{showAllErrors})) {
- $$Value::context->setError(["<I>An error occurred while checking your answer:</I>\n".
- '<DIV STYLE="margin-left:1em">%s</DIV>',$@],'');
- $$Value::context->{error}{flag} = $CMP_ERROR;
+ $$Value::context->setError(["<I>An error occurred while checking your$nth answer:</I>\n".
+ '<DIV STYLE="margin-left:1em">%s</DIV>',$@],'',undef,undef,$CMP_ERROR);
warn "Please inform your instructor that an error occurred while checking your answer";
}
return $equal;
@@ -242,27 +242,26 @@
sub cmp_contextFlags {return ()}
#
-# For reducing Unions, Sets and Intervals
+# Check for unreduced reduced Unions and Sets
#
sub cmp_checkUnionReduce {
- my $self = shift; my $ans = shift;
+ my $self = shift; my $student = shift; my $ans = shift; my $nth = shift || '';
return unless $ans->{studentsMustReduceUnions} &&
$ans->{showUnionReduceWarnings} &&
- !$ans->{isPreview};
- my $student = $ans->{student_value};
- return unless defined($student) && !Value::isFormula($student);
+ !$ans->{isPreview} && !Value::isFormula($student);
if ($student->type eq 'Union' && $student->length >= 2) {
my $reduced = $student->reduce;
- return "Your union can be written in a simpler form"
+ return "Your$nth union can be written in a simpler form"
unless $reduced->type eq 'Union' && $reduced->length == $student->length;
- my @R = $reduced->value; my @S = sort {$a <=> $b} $student->value;
+ my @R = sort {$a <=> $b} $reduced->value;
+ my @S = sort {$a <=> $b} $student->value;
foreach my $i (0..$#R) {
- return "Your union can be written in a simpler form"
+ return "Your$nth union can be written in a simpler form"
unless $R[$i] == $S[$i];
}
} elsif ($student->type eq 'Set') {
my $reduced = $student->reduce;
- return "Your set must have no redundant elements"
+ return "Your$nth set should have no redundant elements"
unless $reduced->length == $student->length;
}
return;
@@ -813,14 +812,15 @@
$other->type =~ m/^(Interval|Union|Set)$/;
}
+
#
-# Check for unreduced unions and sets
+# Check for unreduced sets and unions
#
-sub cmp_equal {
- my $self = shift; my $ans = shift;
- my $error = $self->cmp_checkUnionReduce($ans);
- if ($error) {$self->cmp_Error($ans,$error); return}
- $self->SUPER::cmp_equal($ans);
+sub cmp_compare {
+ my $self = shift; my $student = shift; my $ans = shift;
+ my $error = $self->cmp_checkUnionReduce($student,$ans,@_);
+ if ($error) {$$Value::context->setError($error,'',undef,undef,$CMP_WARNING); return 0}
+ $self->SUPER::cmp_compare($student,$ans,@_);
}
#
@@ -877,17 +877,24 @@
#
# Use the list checker if the student answer is a set
# otherwise use the standard compare (to get better
-# error messages). But check for unreduced unions
-# and sets first.
+# error messages).
#
sub cmp_equal {
my ($self,$ans) = @_;
- my $error = $self->cmp_checkUnionReduce($ans);
- if ($error) {$self->cmp_Error($ans,$error); return}
return Value::List::cmp_equal(@_) if $ans->{student_value}->type eq 'Set';
$self->SUPER::cmp_equal($ans);
}
+#
+# Check for unreduced sets and unions
+#
+sub cmp_compare {
+ my $self = shift; my $student = shift; my $ans = shift;
+ my $error = $self->cmp_checkUnionReduce($student,$ans,@_);
+ if ($error) {$$Value::context->setError($error,'',undef,undef,$CMP_WARNING); return 0}
+ $self->SUPER::cmp_compare($student,$ans,@_);
+}
+
#############################################################
package Value::Union;
@@ -915,14 +922,16 @@
entry_type => 'an interval or set',
)}
+sub cmp_equal {Value::List::cmp_equal(@_)}
+
#
# Check for unreduced sets and unions
#
-sub cmp_equal {
- my $self = shift; my $ans = shift;
- my $error = $self->cmp_checkUnionReduce($ans);
- if ($error) {$self->cmp_Error($ans,$error); return}
- Value::List::cmp_equal($self,$ans);
+sub cmp_compare {
+ my $self = shift; my $student = shift; my $ans = shift;
+ my $error = $self->cmp_checkUnionReduce($student,$ans,@_);
+ if ($error) {$$Value::context->setError($error,'',undef,undef,$CMP_WARNING); return 0}
+ $self->SUPER::cmp_compare($student,$ans,@_);
}
#############################################################
@@ -941,7 +950,6 @@
showParenHints => undef,
partialCredit => undef,
ordered => 0,
- showEqualErrors => $options{ordered},
entry_type => undef,
list_type => undef,
typeMatch => $element,
@@ -962,7 +970,6 @@
sub cmp {
my $self = shift;
my $cmp = $self->SUPER::cmp(@_);
- $cmp->{rh_ans}{showUnionReduceWarnings} = 0;
if ($cmp->{rh_ans}{removeParens}) {
$self->{open} = $self->{close} = '';
$cmp->ans_hash(correct_ans => $self->stringify)
@@ -1059,7 +1066,7 @@
# Give hints about extra or missing answers
#
if ($showLengthHints) {
- $value =~ s/ or /s or /; # fix "interval or union"
+ $value =~ s/( or|,) /s$1 /g; # fix "interval or union"
push(@errors,"There should be more ${value}s in your $stype")
if ($score < $maxscore && $score == $m);
push(@errors,"There should be fewer ${value}s in your $stype")
@@ -1114,40 +1121,53 @@
$i++; $$Value::context->clearError;
$entry = Value::makeValue($entry);
$entry = Value::Formula->new($entry) if !Value::isValue($entry);
+
+ #
+ # Some words differ if ther eis only one entry in the student's list
+ #
+ my $nth = ''; my $answer = 'answer';
+ my $class = $ans->{list_type} || $self->cmp_class;
+ if ($m > 1) {
+ $nth = ' '.$self->NameForNumber($i);
+ $class = $ans->{cmp_class};
+ $answer = 'value';
+ }
+
+ #
+ # See if the entry matches the correct answer
+ # and perform syntax checking if not
+ #
if ($ordered) {
if (scalar(@correct)) {
- if (shift(@correct)->cmp_compare($entry,$ans)) {$score++; next ENTRY}
+ if (shift(@correct)->cmp_compare($entry,$ans,$nth,$value)) {$score++; next ENTRY}
} else {
- $extra->cmp_compare($entry,$ans); # do syntax check
+ $extra->cmp_compare($entry,$ans,$nth,$value); # do syntax check
}
if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return}
} else {
foreach my $k (0..$#correct) {
- if ($correct[$k]->cmp_compare($entry,$ans)) {
+ if ($correct[$k]->cmp_compare($entry,$ans,$nth,$value)) {
splice(@correct,$k,1);
$score++; next ENTRY;
}
if ($error->{flag} == $CMP_ERROR) {$self->cmp_error($ans); return}
}
+ $$Value::context->clearError;
+ $extra->cmp_compare($entry,$ans,$nth,$value); # do syntax check
}
#
# Give messages about incorrect answers
#
- my $nth = ''; my $answer = 'answer';
- my $class = $ans->{list_type} || $self->cmp_class;
- if ($m > 1) {
- $nth = ' '.$self->NameForNumber($i);
- $class = $ans->{cmp_class};
- $answer = 'value';
- }
- if ($error->{flag} && $ans->{showEqualErrors}) {
- my $message = $error->{message}; $message =~ s/\s+$//;
- push(@errors,"<SMALL>There is a problem with your$nth $value:</SMALL>",
- '<DIV STYLE="margin-left:1em">'.$message.'</DIV>');
- } elsif ($showTypeWarnings && !$typeMatch->typeMatch($entry,$ans) &&
+ if ($showTypeWarnings && !$typeMatch->typeMatch($entry,$ans) &&
!($ans->{ignoreStrings} && $entry->class eq 'String')) {
push(@errors,"Your$nth $answer isn't ".lc($class).
" (it looks like ".lc($entry->showClass).")");
+ } elsif ($error->{flag} && $ans->{showEqualErrors}) {
+ my $message = $error->{message}; $message =~ s/\s+$//;
+ if ($m > 1 && $error->{flag} != $CMP_WARNING) {
+ push(@errors,"<SMALL>There is a problem with your$nth $value:</SMALL>",
+ '<DIV STYLE="margin-left:1em">'.$message.'</DIV>');
+ } else {push(@errors,$message)}
} elsif ($showHints && $m > 1) {
push(@errors,"Your$nth $value is incorrect");
}
Index: Context.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Context.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -Llib/Value/Context.pm -Llib/Value/Context.pm -u -r1.6 -r1.7
--- lib/Value/Context.pm
+++ lib/Value/Context.pm
@@ -110,7 +110,7 @@
#
sub setError {
my $error = (shift)->{error};
- my ($message,$string,$pos,$more) = @_;
+ my ($message,$string,$pos,$more,$flag) = @_;
my @args = ();
($message,@args) = @{$message} if ref($message) eq 'ARRAY';
$error->{original} = $message;
@@ -121,7 +121,7 @@
$error->{message} = $message;
$error->{string} = $string;
$error->{pos} = $pos;
- $error->{flag} = 1;
+ $error->{flag} = $flag || 1;
}
#########################################################################
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-13 15:43:14
|
Log Message:
-----------
Fixed problem with call to $equation->Error (due to change in
error-handling that allows for translation of error messages).
Modified Files:
--------------
pg/macros:
contextString.pl
Revision Data
-------------
Index: contextString.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/contextString.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -Lmacros/contextString.pl -Lmacros/contextString.pl -u -r1.2 -r1.3
--- macros/contextString.pl
+++ macros/contextString.pl
@@ -26,7 +26,7 @@
my @strings = grep {not defined($context->strings->get($_)->{alias})}
$context->strings->names;
my $strings = join(', ',@strings[0..$#strings-1]).' or '.$strings[-1];
- $equation->Error("Your answer should be one of %s",$strings);
+ $equation->Error(["Your answer should be one of %s",$strings]);
}
package contextString::Formula;
|
|
From: jj v. a. <we...@ma...> - 2005-08-13 05:52:30
|
Log Message:
-----------
If a problem file sets $refreshCachedImages=1 inside the pg file, then
cached copies of on the fly graphics are ignored and the graphic is
regenerated.
Modified Files:
--------------
pg/macros:
dangerousMacros.pl
Revision Data
-------------
Index: dangerousMacros.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/dangerousMacros.pl,v
retrieving revision 1.35
retrieving revision 1.36
diff -Lmacros/dangerousMacros.pl -Lmacros/dangerousMacros.pl -u -r1.35 -r1.36
--- macros/dangerousMacros.pl
+++ macros/dangerousMacros.pl
@@ -377,10 +377,13 @@
my $fileName = $graph->imageName . $extension;
my $filePath = convertPath("gif/$fileName");
$filePath = &surePathToTmpFile( $filePath );
+ my $refreshCachedImages = PG_restricted_eval(q!$refreshCachedImages!);
# Check to see if we already have this graph, or if we have to make it
if( not -e $filePath # does it exist?
or ((stat "$templateDirectory"."$main::envir{fileName}")[9] > (stat $filePath)[9]) # source has changed
- or $graph->imageName =~ /Undefined_Set/) { # problems from SetMaker and its ilk should always be redone
+ or $graph->imageName =~ /Undefined_Set/ # problems from SetMaker and its ilk should always be redone
+ or $refreshCachedImages
+ ) {
#createFile($filePath, $main::tmp_file_permission, $main::numericalGroupID);
local(*OUTPUT); # create local file handle so it won't overwrite other open files.
open(OUTPUT, ">$filePath")||warn ("$0","Can't open $filePath<BR>","");
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-13 01:39:02
|
Log Message:
-----------
Added differentiation of (single-variable) functions created with
parserFunction.
Modified Files:
--------------
pg/macros:
parserFunction.pl
Revision Data
-------------
Index: parserFunction.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/parserFunction.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -Lmacros/parserFunction.pl -Lmacros/parserFunction.pl -u -r1.1 -r1.2
--- macros/parserFunction.pl
+++ macros/parserFunction.pl
@@ -78,7 +78,7 @@
@_, class => 'parserFunction', argCount => scalar(@argNames),
argNames => [@argNames], argTypes => [@argTypes],
function => $formula->perlFunction(undef,[@argNames]),
- type => $formula->typeRef,
+ formula => $formula, type => $formula->typeRef,
}
);
main::PG_restricted_eval("sub main::$name {Parser::Function->call('$name',\@_)}");
@@ -120,6 +120,20 @@
}
#
+# Compute the derivative of (single-variable) functions
+# using the chain rule.
+#
+sub D {
+ my $self = shift; my $def = $self->{def};
+ $self->Error("Can't differentiate function '%s'",$self->{name})
+ unless $def->{argCount} == 1;
+ my $x = $def->{argNames}[0];
+ my $Df = $def->{formula}->D($x);
+ my $g = $self->{params}[0];
+ return (($Df->substitute($x=>$g))*($g->D(@_)))->{tree}->reduce;
+}
+
+#
# Get the name for a number
#
sub NameForNumber {
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-13 01:37:32
|
Log Message:
-----------
Fixed typo in previous update.
Modified Files:
--------------
pg/lib/Parser/BOP:
equality.pm
multiply.pm
power.pm
underscore.pm
Revision Data
-------------
Index: power.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/power.pm,v
retrieving revision 1.10
retrieving revision 1.11
diff -Llib/Parser/BOP/power.pm -Llib/Parser/BOP/power.pm -u -r1.10 -r1.11
--- lib/Parser/BOP/power.pm
+++ lib/Parser/BOP/power.pm
@@ -64,7 +64,7 @@
#
sub TeX {
my ($self,$precedence,$showparens,$position,$outerRight) = @_;
- my $TeX; my $bop = $self->{def}; $position = '' unless defind($position);
+ my $TeX; my $bop = $self->{def}; $position = '' unless defined($position);
my $extraParens = $self->{equation}{context}->flag('showExtraParens');
my $addparens =
defined($precedence) &&
Index: multiply.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/multiply.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -Llib/Parser/BOP/multiply.pm -Llib/Parser/BOP/multiply.pm -u -r1.7 -r1.8
--- lib/Parser/BOP/multiply.pm
+++ lib/Parser/BOP/multiply.pm
@@ -77,7 +77,7 @@
sub TeX {
my ($self,$precedence,$showparens,$position,$outerRight) = @_;
- my $TeX; my $bop = $self->{def}; my $cdot; $position = '' unless defind($position);
+ my $TeX; my $bop = $self->{def}; my $cdot; $position = '' unless defined($position);
my $mult = (defined($bop->{TeX}) ? $bop->{TeX} : $bop->{string});
($mult,$cdot) = @{$mult} if ref($mult) eq 'ARRAY';
$cdot = '\cdot ' unless $cdot;
Index: underscore.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/underscore.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -Llib/Parser/BOP/underscore.pm -Llib/Parser/BOP/underscore.pm -u -r1.8 -r1.9
--- lib/Parser/BOP/underscore.pm
+++ lib/Parser/BOP/underscore.pm
@@ -74,7 +74,7 @@
#
sub TeX {
my ($self,$precedence,$showparens,$position,$outerRight) = @_;
- my $TeX; my $bop = $self->{def}; $position = '' unless defind($position);
+ my $TeX; my $bop = $self->{def}; $position = '' unless defined($position);
my $addparens =
defined($precedence) &&
($showparens eq 'all' || $precedence > $bop->{precedence} ||
Index: equality.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/equality.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -Llib/Parser/BOP/equality.pm -Llib/Parser/BOP/equality.pm -u -r1.6 -r1.7
--- lib/Parser/BOP/equality.pm
+++ lib/Parser/BOP/equality.pm
@@ -55,7 +55,7 @@
#
sub string {
my ($self,$precedence,$showparens,$position,$outerRight) = @_;
- my $string; my $bop = $self->{def}; $position = '' unless defind($position);
+ my $string; my $bop = $self->{def}; $position = '' unless defined($position);
my $extraParens = $self->{equation}{context}->flag('showExtraParens');
my $addparens =
defined($precedence) &&
@@ -73,7 +73,7 @@
sub TeX {
my ($self,$precedence,$showparens,$position,$outerRight) = @_;
- my $TeX; my $bop = $self->{def}; $position = '' unless defind($position);
+ my $TeX; my $bop = $self->{def}; $position = '' unless defined($position);
my $extraParens = $self->{equation}{context}->flag('showExtraParens');
my $addparens =
defined($precedence) &&
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-13 00:39:42
|
Log Message:
-----------
Added sets to the differentiation information (no derivatives allowed)
Modified Files:
--------------
pg/lib/Parser:
Differentiation.pm
Revision Data
-------------
Index: Differentiation.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Differentiation.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -Llib/Parser/Differentiation.pm -Llib/Parser/Differentiation.pm -u -r1.6 -r1.7
--- lib/Parser/Differentiation.pm
+++ lib/Parser/Differentiation.pm
@@ -662,6 +662,11 @@
$self->Error("Can't differentiate intervals");
}
+sub Value::Set::D {
+ shift; shift; my $self = shift;
+ $self->Error("Can't differentiate sets");
+}
+
sub Value::Union::D {
shift; shift; my $self = shift;
$self->Error("Can't differentiate unions");
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-13 00:33:31
|
Log Message:
-----------
Fixed a typo in an error message.
Modified Files:
--------------
pg/lib/Value:
Set.pm
Revision Data
-------------
Index: Set.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Set.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Llib/Value/Set.pm -Llib/Value/Set.pm -u -r1.3 -r1.4
--- lib/Value/Set.pm
+++ lib/Value/Set.pm
@@ -39,7 +39,7 @@
foreach my $x (@{$p}) {
$x = Value::makeValue($x);
$isFormula = 1 if Value::isFormula($x);
- Value::Error("An element of sets can't be %s",Value::showClass($x))
+ Value::Error("An element of a set can't be %s",Value::showClass($x))
unless Value::isRealNumber($x);
}
}
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-13 00:23:53
|
Log Message:
-----------
Added ability for Unions and Sets to simplify themselves
(automatically or on demand), and added flags to the Context and
answer checkers to control these features. The new Context flags
are
reduceUnions tells whether unions are automatically
reduced when they are created.
reduceUnionsForComparison tells whether unions are reduced
before comparing them for equality
or inequality (etc) if they aren't
reduced already.
reduceSets tells whether redundent elements are
removed from sets as they are created.
reduceSetsForComparison tells whether sets are reduced before
comparing them.
All of these default to true.
The Interval, Set, Union, and List answer checkers not have two new
flags for controlling these values:
studentsMustReduceUnions tells whether unions and sets will be
counted as incorrect when they are not
reduced to non-overlapping intervals
and at most one set with no repeated
entries.
showUnionReduceWarnings tells whether an error message will
be produced for non-reduced unions and
sets, or if they will be marked wrong
silently. (Not available in Lists.)
Both of these are true by default, since most professors probably want
their students to write intervals in reduced form. (Is this true?)
This corresponds the the current behavior of the interval checkers,
which require the student's answer to be the same set of intervals as
in the professor's, but with the addition of an error message when the
student answer is not reduced.
Modified Files:
--------------
pg/lib:
Value.pm
pg/lib/Parser:
Value.pm
pg/lib/Value:
AnswerChecker.pm
Interval.pm
Set.pm
Union.pm
Revision Data
-------------
Index: Value.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value.pm,v
retrieving revision 1.41
retrieving revision 1.42
diff -Llib/Value.pm -Llib/Value.pm -u -r1.41 -r1.42
--- lib/Value.pm
+++ lib/Value.pm
@@ -28,6 +28,14 @@
#
infiniteWord => 'infinity',
#
+ # For intervals and unions:
+ #
+ ignoreEndpointTypes => 0,
+ reduceSets => 1,
+ reduceSetsForComparison => 1,
+ reduceUnions => 1,
+ reduceUnionsForComparison => 1,
+ #
# For fuzzy reals:
#
useFuzzyReals => 1,
@@ -36,13 +44,13 @@
zeroLevel => 1E-14,
zeroLevelTol => 1E-12,
#
- # For functions
+ # For Formulas:
#
- limits => [-2,2],
- num_points => 5,
- granularity => 1000,
- resolution => undef,
- max_adapt => 1E8,
+ limits => [-2,2],
+ num_points => 5,
+ granularity => 1000,
+ resolution => undef,
+ max_adapt => 1E8,
checkUndefinedPoints => 0,
max_undefined => undef,
},
@@ -93,6 +101,19 @@
push(@{$$context->{data}{values}},'method','precedence');
+#
+# Get the value of a flag from the object itself,
+# or from the context, or from the default context
+# or from the given default, whichever is found first.
+#
+sub getFlag {
+ my $self = shift; my $name = shift;
+ return $self->{$name} if ref($self) && defined($self->{$name});
+ return $self->{context}{flags}{$name} if ref($self) && defined($self->{context}{flags}{$name});
+ return $$Value::context->{flags}{$name} if defined($$Value::context->{flags}{$name});
+ return shift;
+}
+
#############################################################
#
Index: Value.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Value.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -Llib/Parser/Value.pm -Llib/Parser/Value.pm -u -r1.14 -r1.15
--- lib/Parser/Value.pm
+++ lib/Parser/Value.pm
@@ -37,14 +37,22 @@
value => $value, type => $type, isConstant => 1,
ref => $ref, equation => $equation,
}, $class;
- $c->{canBeInterval} = 1
+ $c->check;
+ return $c;
+}
+
+#
+# Set flags for the object
+#
+sub check {
+ my $self = shift;
+ my $type = $self->{type}; my $value = $self->{value};
+ $self->{canBeInterval} = 1
if $value->{canBeInterval} ||
($value->class =~ m/Point|List/ &&
$type->{length} == 2 && $type->{entryType}{name} eq 'Number');
-
- $c->{isZero} = $value->isZero;
- $c->{isOne} = $value->isOne;
- return $c;
+ $self->{isZero} = $value->isZero;
+ $self->{isOne} = $value->isOne;
}
#
@@ -53,6 +61,16 @@
sub eval {return (shift)->{value}}
#
+# Call the Value object's reduce method and reset the flags
+#
+sub reduce {
+ my $self = shift;
+ $self->{value} = $self->{value}->reduce;
+ $self->check;
+ return $self;
+}
+
+#
# Return the item's list of coordinates
# (for points, vectors, matrices, etc.)
#
Index: Set.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Set.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -Llib/Value/Set.pm -Llib/Value/Set.pm -u -r1.2 -r1.3
--- lib/Value/Set.pm
+++ lib/Value/Set.pm
@@ -45,17 +45,18 @@
}
return $self->formula($p) if $isFormula;
my $def = $$Value::context->lists->get('Set');
- bless {
- data => $p, canBeInterval => 1,
- open => $def->{open}, close => $def->{close}
- }, $class;
+ my $set = bless {data => $p, canBeInterval => 1,
+ open => $def->{open}, close => $def->{close}}, $class;
+ $set = $set->reduce if $self->getFlag('reduceSets');
+ return $set;
}
#
# Set the canBeInterval flag
#
sub make {
- my $self = shift; my $def = $$Value::context->lists->get('Set');
+ my $self = shift;
+ my $def = $$Value::context->lists->get('Set');
$self = $self->SUPER::make(@_);
$self->{canBeInterval} = 1;
$self->{open} = $def->{open}; $self->{close} = $def->{close};
@@ -88,15 +89,7 @@
my ($l,$r,$flag) = @_;
if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
$r = promote($r); if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
- return Value::Union->new($l,$r)
- unless Value::class($l) eq 'Set' && Value::class($r) eq 'Set';
- my @combined = (sort {$a <=> $b} (@{$l->data},@{$r->data}));
- my @entries = ();
- while (scalar(@combined)) {
- push(@entries,shift(@combined));
- shift(@combined) while (scalar(@combined) && $entries[-1] == $combined[0]);
- }
- return $pkg->make(@entries);
+ Value::Union::form($l,$r);
}
sub dot {my $self = shift; $self->add(@_)}
@@ -184,8 +177,10 @@
if ($l->length == 1 && $a == $b) || $a != $c;
return ($flag? 1: -1);
}
+ if ($l->getFlag('reduceSetsForComparison')) {$l = $l->reduce; $r = $r->reduce}
if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
- my @l = sort {$a <=> $b} @{$l->data}; my @r = sort {$a <=> $b} @{$r->data};
+ my @l = sort {$a <=> $b} $l->value;
+ my @r = sort {$a <=> $b} $r->value;
while (scalar(@l) && scalar(@r)) {
my $cmp = shift(@l) <=> shift(@r);
return $cmp if $cmp;
@@ -193,6 +188,21 @@
return scalar(@l) - scalar(@r);
}
+#
+# Remove redundant values
+#
+sub reduce {
+ my $self = shift;
+ return $self if $self->{isReduced} || $self->length < 2;
+ my @data = (sort {$a <=> $b} ($self->value));
+ my @set = ();
+ while (scalar(@data)) {
+ push(@set,shift(@data));
+ shift(@data) while (scalar(@data) && $set[-1] == $data[0]);
+ }
+ return $pkg->make(@set)->with(isReduced=>1);
+}
+
###########################################################################
1;
Index: AnswerChecker.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v
retrieving revision 1.54
retrieving revision 1.55
diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.54 -r1.55
--- lib/Value/AnswerChecker.pm
+++ lib/Value/AnswerChecker.pm
@@ -21,6 +21,8 @@
showTypeWarnings => 1,
showEqualErrors => 1,
ignoreStrings => 1,
+ studentsMustReduceUnions => 1,
+ showUnionReduceWarnings => 1,
)}
sub cmp {
@@ -62,6 +64,12 @@
showExtraParens => 1, # make student answer painfully unambiguous
reduceConstants => 0, # don't combine student constants
reduceConstantFunctions => 0, # don't reduce constant functions
+ ($ans->{studentsMustReduceUnions} ?
+ (reduceUnions => 0, reduceSets => 0,
+ reduceUnionsForComparison => $ans->{showUnionReduceWarnings},
+ reduceSetsForComparison => $ans->{showUnionReduceWarnings}) :
+ (reduceUnions => 1, reduceSets => 1,
+ reduceUnionsForComparison => 1, reduceSetsForComparison => 1)),
($ans->{requireParenMatch}? (): ignoreEndpointTypes => 1), # for Intervals
$self->cmp_contextFlags($ans), # any additional ones from the object itself
);
@@ -234,6 +242,33 @@
sub cmp_contextFlags {return ()}
#
+# For reducing Unions, Sets and Intervals
+#
+sub cmp_checkUnionReduce {
+ my $self = shift; my $ans = shift;
+ return unless $ans->{studentsMustReduceUnions} &&
+ $ans->{showUnionReduceWarnings} &&
+ !$ans->{isPreview};
+ my $student = $ans->{student_value};
+ return unless defined($student) && !Value::isFormula($student);
+ if ($student->type eq 'Union' && $student->length >= 2) {
+ my $reduced = $student->reduce;
+ return "Your union can be written in a simpler form"
+ unless $reduced->type eq 'Union' && $reduced->length == $student->length;
+ my @R = $reduced->value; my @S = sort {$a <=> $b} $student->value;
+ foreach my $i (0..$#R) {
+ return "Your union can be written in a simpler form"
+ unless $R[$i] == $S[$i];
+ }
+ } elsif ($student->type eq 'Set') {
+ my $reduced = $student->reduce;
+ return "Your set must have no redundant elements"
+ unless $reduced->length == $student->length;
+ }
+ return;
+}
+
+#
# create answer rules of various types
#
sub ans_rule {shift; pgCall('ans_rule',@_)}
@@ -779,6 +814,16 @@
}
#
+# Check for unreduced unions and sets
+#
+sub cmp_equal {
+ my $self = shift; my $ans = shift;
+ my $error = $self->cmp_checkUnionReduce($ans);
+ if ($error) {$self->cmp_Error($ans,$error); return}
+ $self->SUPER::cmp_equal($ans);
+}
+
+#
# Check for wrong enpoints and wrong type of endpoints
#
sub cmp_postprocess {
@@ -832,12 +877,15 @@
#
# Use the list checker if the student answer is a set
# otherwise use the standard compare (to get better
-# error messages
+# error messages). But check for unreduced unions
+# and sets first.
#
sub cmp_equal {
my ($self,$ans) = @_;
- Value::List::cmp_equal(@_) if $ans->{student_value}->type eq 'Set';
- Value::cmp_equal(@_);
+ my $error = $self->cmp_checkUnionReduce($ans);
+ if ($error) {$self->cmp_Error($ans,$error); return}
+ return Value::List::cmp_equal(@_) if $ans->{student_value}->type eq 'Set';
+ $self->SUPER::cmp_equal($ans);
}
#############################################################
@@ -867,7 +915,15 @@
entry_type => 'an interval or set',
)}
-sub cmp_equal {Value::List::cmp_equal(@_)}
+#
+# Check for unreduced sets and unions
+#
+sub cmp_equal {
+ my $self = shift; my $ans = shift;
+ my $error = $self->cmp_checkUnionReduce($ans);
+ if ($error) {$self->cmp_Error($ans,$error); return}
+ Value::List::cmp_equal($self,$ans);
+}
#############################################################
@@ -906,6 +962,7 @@
sub cmp {
my $self = shift;
my $cmp = $self->SUPER::cmp(@_);
+ $cmp->{rh_ans}{showUnionReduceWarnings} = 0;
if ($cmp->{rh_ans}{removeParens}) {
$self->{open} = $self->{close} = '';
$cmp->ans_hash(correct_ans => $self->stringify)
@@ -1010,6 +1067,17 @@
}
#
+ # If all the entries are in error, don't give individual messages
+ #
+ if ($score == 0) {
+ my $i = 0;
+ while ($i <= $#errors) {
+ if ($errors[$i++] =~ m/^Your .* is incorrect$/)
+ {splice(@errors,--$i,1)}
+ }
+ }
+
+ #
# Finalize the score
#
$score = 0 if ($score != $maxscore && !$partialCredit);
@@ -1212,7 +1280,7 @@
# Use the list checker if the formula is a list or union
# Otherwise use the normal checker
#
- if ($self->type =~ m/^(List|Union)$/) {
+ if ($self->type =~ m/^(List|Union|Set)$/) {
Value::List::cmp_equal($self,$ans);
} else {
$self->SUPER::cmp_equal($ans);
Index: Interval.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Interval.pm,v
retrieving revision 1.23
retrieving revision 1.24
diff -Llib/Value/Interval.pm -Llib/Value/Interval.pm -u -r1.23 -r1.24
--- lib/Value/Interval.pm
+++ lib/Value/Interval.pm
@@ -161,7 +161,7 @@
my ($l,$r,$flag) = @_;
if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
$r = promote($r); if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
- return Value::Union->new($l,$r);
+ Value::Union::form($l,$r);
}
sub dot {my $self = shift; $self->add(@_)}
Index: Union.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Union.pm,v
retrieving revision 1.16
retrieving revision 1.17
diff -Llib/Value/Union.pm -Llib/Value/Union.pm -u -r1.16 -r1.17
--- lib/Value/Union.pm
+++ lib/Value/Union.pm
@@ -30,7 +30,8 @@
return $x if $x->type =~ m/Interval|Union|Set/;
Value::Error("Formula does not return an Interval, Set or Union");
}
- return $self->new(promote($x));
+ $x = promote($x); $x = $pkg->make($x) unless $x->type eq 'Union';
+ return $x;
}
Value::Error("Empty unions are not allowed") if scalar(@_) == 0;
my @intervals = (); my $isFormula = 0;
@@ -55,7 +56,9 @@
}
}
return $self->formula(@intervals) if $isFormula;
- bless {data => [@intervals], canBeInterval => 1}, $class;
+ my $union = form(@intervals);
+ $union = $self->make($union) unless $union->type eq 'Union';
+ return $union;
}
#
@@ -70,12 +73,15 @@
#
# Make a union or interval or set, depending on how
-# many there are in the union
+# many there are in the union, and mark the
+#
#
sub form {
- return @_[0] if scalar(@_) == 1;
+ return $_[0] if scalar(@_) == 1;
return Value::Set->new() if scalar(@_) == 0;
- $pkg->new(@_);
+ my $union = $pkg->make(@_);
+ $union = $union->reduce if $union->getFlag('reduceUnions');
+ return $union;
}
#
@@ -112,8 +118,9 @@
my $x = shift;
return Value::Set->new($x,@_)
if scalar(@_) > 0 || ref($x) eq 'ARRAY' || Value::isRealNumber($x);
- return $x if Value::class($x) =~ m/Interval|Union|Set/;
- return Value::Interval::promote($x) if Value::class($x) eq 'List';
+ return $x if Value::class($x) eq 'Union';
+ $x = Value::Interval::promote($x) if Value::class($x) eq 'List';
+ return $pkg->make($x) if Value::class($x) =~ m/Interval|Set/;
Value::Error("Can't convert %s to an Interval, Set or Union",Value::showClass($x));
}
@@ -129,9 +136,7 @@
my ($l,$r,$flag) = @_;
if ($l->promotePrecedence($r)) {return $r->add($l,!$flag)}
$r = promote($r); if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
- $l = $pkg->make($l) if ($l->class ne 'Union');
- $r = $pkg->make($r) if ($r->class ne 'Union');
- return $pkg->make(@{$l->data},@{$r->data});
+ form(@{$l->data},@{$r->data});
}
sub dot {my $self = shift; $self->add(@_)}
@@ -142,9 +147,7 @@
my ($l,$r,$flag) = @_;
if ($l->promotePrecedence($r)) {return $r->sub($l,!$flag)}
$r = promote($r); if ($flag) {my $tmp = $l; $l = $r; $r = $tmp}
- my $ll = [($l->class eq 'Union')? $l->value: $l];
- my $rr = [($r->class eq 'Union')? $r->value: $r];
- form(subUnionUnion($ll,$rr));
+ form(subUnionUnion($l->data,$r->data));
}
#
@@ -183,8 +186,10 @@
my ($l,$r,$flag) = @_;
if ($l->promotePrecedence($r)) {return $r->compare($l,!$flag)}
$r = promote($r);
+ if ($l->getFlag('reduceUnionsForComparison')) {$l = $l->reduce; $r = $r->reduce}
if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
- my @l = sort {$a <=> $b} $l->value; my @r = sort {$a <=> $b} $r->value;
+ my @l = sort {$a <=> $b} $l->value;
+ my @r = sort {$a <=> $b} $r->value;
while (scalar(@l) && scalar(@r)) {
my $cmp = shift(@l) <=> shift(@r);
return $cmp if $cmp;
@@ -192,7 +197,51 @@
return scalar(@l) - scalar(@r);
}
-# @@@ simplify (combine intervals, if possible) @@@
+############################################
+#
+# Reduce unions to simplest form
+#
+
+sub reduce {
+ my $self = shift;
+ return $self if $self->{isReduced} || $self->length < 2;
+ my @singletons = (); my @intervals = ();
+ foreach my $x ($self->value) {
+ if ($x->type eq 'Set') {push(@singletons,$x->value)}
+ elsif ($x->{data}[0] == $x->{data}[1]) {push(@singletons,$x->{data}[0])}
+ else {push(@intervals,$x)}
+ }
+ my @union = (); my @set = (); my $prevX;
+ @intervals = (sort {$a <=> $b} @intervals);
+ ELEMENT: foreach my $x (@singletons) {
+ next if defined($prevX) && $prevX == $x; $prevX = $x;
+ foreach my $I (@intervals) {
+ my ($a,$b) = $I->value;
+ last if $x < $a;
+ if ($x > $a && $x < $b) {next ELEMENT}
+ elsif ($x == $a) {$I->{open} = '['; next ELEMENT}
+ elsif ($x == $b) {$I->{close} = ']'; next ELEMENT}
+ }
+ push(@set,$x);
+ }
+ while (scalar(@intervals) > 1) {
+ my $I = shift(@intervals); my $J = $intervals[0];
+ my ($a,$b) = $I->value; my ($c,$d) = $J->value;
+ if ($b < $c || ($b == $c && $I->{close} eq ')' && $J->{open} eq '(')) {
+ push(@union,$I);
+ } else {
+ if ($a < $c) {$J->{data}[0] = $a; $J->{open} = $I->{open}}
+ else {$J->{open} = '[' if $I->{open} eq '['}
+ if ($b > $d) {$J->{data}[1] = $b; $J->{close} = $I->{close}}
+ else {$J->{close} = ']' if $b == $d && $I->{close} eq ']'}
+ }
+ }
+ push(@union,@intervals);
+ push(@union,Value::Set->make(@set)) unless scalar(@set) == 0;
+ return Value::Set->new() if scalar(@union) == 0;
+ return $union[0] if scalar(@union) == 1;
+ return $pkg->make(@union)->with(isReduced=>1);
+}
############################################
#
|
|
From: jj v. a. <we...@ma...> - 2005-08-12 23:31:23
|
Log Message:
-----------
Print titles with underscores replaced by non-breaking spaces. It makes
the names of courses and problem sets look nicer for students. Also
removed a function which was already commented out, and not needed.
Modified Files:
--------------
webwork-modperl/lib/WeBWorK:
ContentGenerator.pm
Revision Data
-------------
Index: ContentGenerator.pm
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/lib/WeBWorK/ContentGenerator.pm,v
retrieving revision 1.145
retrieving revision 1.146
diff -Llib/WeBWorK/ContentGenerator.pm -Llib/WeBWorK/ContentGenerator.pm -u -r1.145 -r1.146
--- lib/WeBWorK/ContentGenerator.pm
+++ lib/WeBWorK/ContentGenerator.pm
@@ -878,7 +878,7 @@
my $r = $self->r;
#print "\n<!-- BEGIN " . __PACKAGE__ . "::title -->\n";
- print $r->urlpath->name;
+ print underscore2nbsp($r->urlpath->name);
#print "<!-- END " . __PACKAGE__ . "::title -->\n";
return "";
@@ -1666,24 +1666,23 @@
sub sp2nbsp {
my ($str) = @_;
return unless defined $str;
- #$str =~ s/ / /g;
$str =~ s/\s/ /g;
return $str;
}
-# FIXME -- I don't think we need both this and the one above.
-# Remove this comment block after some time.(2/6/05)
-# =item space2nbsp($string)
-#
-# Replace spaces in the string with html non-breaking spaces.
-#
-# =cut
-#
-# sub space2nbsp {
-# my $str = shift;
-# $str =~ s/\s/ /g;
-# return($str);
-# }
+=item underscore2nbsp($string)
+
+A copy of $string is returned with each underscore character replaced by the
+C< > entity.
+
+=cut
+
+sub underscore2nbsp {
+ my ($str) = @_;
+ return unless defined $str;
+ $str =~ s/_/ /g;
+ return $str;
+}
=item errorOutput($error, $details)
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-12 23:20:15
|
Log Message:
-----------
Fixed use of undefined value for $position in TeX and String methods.
Modified Files:
--------------
pg/lib/Parser:
BOP.pm
UOP.pm
pg/lib/Parser/BOP:
equality.pm
multiply.pm
power.pm
underscore.pm
Revision Data
-------------
Index: BOP.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP.pm,v
retrieving revision 1.12
retrieving revision 1.13
diff -Llib/Parser/BOP.pm -Llib/Parser/BOP.pm -u -r1.12 -r1.13
--- lib/Parser/BOP.pm
+++ lib/Parser/BOP.pm
@@ -272,7 +272,7 @@
#
sub string {
my ($self,$precedence,$showparens,$position,$outerRight) = @_;
- my $string; my $bop = $self->{def};
+ my $string; my $bop = $self->{def}; $position = '' unless defined($position);
my $extraParens = $self->{equation}{context}->flag('showExtraParens');
my $addparens =
defined($precedence) &&
@@ -294,7 +294,7 @@
#
sub TeX {
my ($self,$precedence,$showparens,$position,$outerRight) = @_;
- my $TeX; my $bop = $self->{def};
+ my $TeX; my $bop = $self->{def}; $position = '' unless defined($position);
my $extraParens = $self->{equation}{context}->flag('showExtraParens');
my $addparens =
defined($precedence) &&
Index: UOP.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/UOP.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -Llib/Parser/UOP.pm -Llib/Parser/UOP.pm -u -r1.13 -r1.14
--- lib/Parser/UOP.pm
+++ lib/Parser/UOP.pm
@@ -178,7 +178,7 @@
#
sub string {
my ($self,$precedence,$showparens,$position,$outerRight) = @_;
- my $string; my $uop = $self->{def};
+ my $string; my $uop = $self->{def}; $position = '' unless defined($position);
my $addparens = defined($precedence) &&
($precedence >= $uop->{precedence} || $position eq 'right' || $outerRight);
if ($uop->{associativity} eq "right") {
@@ -195,7 +195,7 @@
#
sub TeX {
my ($self,$precedence,$showparens,$position,$outerRight) = @_;
- my $TeX; my $uop = $self->{def};
+ my $TeX; my $uop = $self->{def}; $position = '' unless defined($position);
my $fracparens = ($uop->{nofractionparens}) ? "nofractions" : "";
my $addparens = defined($precedence) &&
($precedence >= $uop->{precedence} || $position eq 'right' || $outerRight);
Index: power.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/power.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -Llib/Parser/BOP/power.pm -Llib/Parser/BOP/power.pm -u -r1.9 -r1.10
--- lib/Parser/BOP/power.pm
+++ lib/Parser/BOP/power.pm
@@ -64,7 +64,7 @@
#
sub TeX {
my ($self,$precedence,$showparens,$position,$outerRight) = @_;
- my $TeX; my $bop = $self->{def};
+ my $TeX; my $bop = $self->{def}; $position = '' unless defind($position);
my $extraParens = $self->{equation}{context}->flag('showExtraParens');
my $addparens =
defined($precedence) &&
Index: multiply.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/multiply.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -Llib/Parser/BOP/multiply.pm -Llib/Parser/BOP/multiply.pm -u -r1.6 -r1.7
--- lib/Parser/BOP/multiply.pm
+++ lib/Parser/BOP/multiply.pm
@@ -77,7 +77,7 @@
sub TeX {
my ($self,$precedence,$showparens,$position,$outerRight) = @_;
- my $TeX; my $bop = $self->{def}; my $cdot;
+ my $TeX; my $bop = $self->{def}; my $cdot; $position = '' unless defind($position);
my $mult = (defined($bop->{TeX}) ? $bop->{TeX} : $bop->{string});
($mult,$cdot) = @{$mult} if ref($mult) eq 'ARRAY';
$cdot = '\cdot ' unless $cdot;
Index: underscore.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/underscore.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -Llib/Parser/BOP/underscore.pm -Llib/Parser/BOP/underscore.pm -u -r1.7 -r1.8
--- lib/Parser/BOP/underscore.pm
+++ lib/Parser/BOP/underscore.pm
@@ -74,7 +74,7 @@
#
sub TeX {
my ($self,$precedence,$showparens,$position,$outerRight) = @_;
- my $TeX; my $bop = $self->{def};
+ my $TeX; my $bop = $self->{def}; $position = '' unless defind($position);
my $addparens =
defined($precedence) &&
($showparens eq 'all' || $precedence > $bop->{precedence} ||
Index: equality.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/BOP/equality.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -Llib/Parser/BOP/equality.pm -Llib/Parser/BOP/equality.pm -u -r1.5 -r1.6
--- lib/Parser/BOP/equality.pm
+++ lib/Parser/BOP/equality.pm
@@ -55,7 +55,7 @@
#
sub string {
my ($self,$precedence,$showparens,$position,$outerRight) = @_;
- my $string; my $bop = $self->{def};
+ my $string; my $bop = $self->{def}; $position = '' unless defind($position);
my $extraParens = $self->{equation}{context}->flag('showExtraParens');
my $addparens =
defined($precedence) &&
@@ -73,7 +73,7 @@
sub TeX {
my ($self,$precedence,$showparens,$position,$outerRight) = @_;
- my $TeX; my $bop = $self->{def};
+ my $TeX; my $bop = $self->{def}; $position = '' unless defind($position);
my $extraParens = $self->{equation}{context}->flag('showExtraParens');
my $addparens =
defined($precedence) &&
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-12 23:00:32
|
Log Message:
-----------
Made the 'R' constant in Interval context show up as a bold R in TeX
mode.
Modified Files:
--------------
pg/lib/Parser/Context:
Default.pm
Revision Data
-------------
Index: Default.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Context/Default.pm,v
retrieving revision 1.29
retrieving revision 1.30
diff -Llib/Parser/Context/Default.pm -Llib/Parser/Context/Default.pm -u -r1.29 -r1.30
--- lib/Parser/Context/Default.pm
+++ lib/Parser/Context/Default.pm
@@ -299,6 +299,7 @@
$intervalContext->constants->add(
R => Value::Interval->new('(',-$infinity,$infinity,')'),
);
+$intervalContext->constants->set(R => {TeX => '{\bf R}'});
#########################################################################
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-12 22:54:25
|
Log Message:
-----------
Detect preview mode correctly for either WW1 or WW2.
Modified Files:
--------------
pg/lib/Value:
AnswerChecker.pm
Revision Data
-------------
Index: AnswerChecker.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v
retrieving revision 1.53
retrieving revision 1.54
diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.53 -r1.54
--- lib/Value/AnswerChecker.pm
+++ lib/Value/AnswerChecker.pm
@@ -65,7 +65,8 @@
($ans->{requireParenMatch}? (): ignoreEndpointTypes => 1), # for Intervals
$self->cmp_contextFlags($ans), # any additional ones from the object itself
);
- $ans->{isPreview} = $self->getPG('$inputs_ref->{previewAnswers}');
+ my $inputs = $self->getPG('$inputs_ref',{action=>""});
+ $ans->{isPreview} = $inputs->{previewAnswers} || ($inputs->{action} =~ m/^Preview/);
$ans->{cmp_class} = $self->cmp_class($ans) unless $ans->{cmp_class};
$ans->{error_message} = $ans->{ans_message} = ''; # clear any old messages
$ans->{preview_latex_string} = $ans->{preview_text_string} = '';
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-12 22:53:38
|
Log Message:
-----------
Adjust spacing.
Modified Files:
--------------
pg/lib/Value:
WeBWorK.pm
Revision Data
-------------
Index: WeBWorK.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/WeBWorK.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -Llib/Value/WeBWorK.pm -Llib/Value/WeBWorK.pm -u -r1.9 -r1.10
--- lib/Value/WeBWorK.pm
+++ lib/Value/WeBWorK.pm
@@ -95,7 +95,7 @@
zeroLevelTol => $ww->{numZeroLevelTolDefault},
num_points => $ww->{functNumOfPoints} + 2,
max_adapt => $ww->{functMaxConstantOfIntegration},
- useBaseTenLog => $ww->{useBaseTenLog},
+ useBaseTenLog => $ww->{useBaseTenLog},
);
$context->{format}{number} = $ww->{numFormatDefault} if $ww->{numFormatDefault} ne '';
$context;
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-12 22:52:58
|
Log Message:
-----------
Mark function as constant if it is.
Modified Files:
--------------
pg/lib/Parser:
Function.pm
Revision Data
-------------
Index: Function.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Function.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -Llib/Parser/Function.pm -Llib/Parser/Function.pm -u -r1.13 -r1.14
--- lib/Parser/Function.pm
+++ lib/Parser/Function.pm
@@ -19,6 +19,7 @@
name => $name, params => $params,
def => $def, ref => $ref, equation => $equation,
}, $def->{class};
+ $fn->{isConstant} = $constant;
$fn->_check;
$fn = $context->{parser}{Value}->new($equation,[$fn->eval])
if $constant && $context->flag('reduceConstantFunctions');
|
|
From: jj v. a. <we...@ma...> - 2005-08-12 18:54:08
|
Log Message:
-----------
Update interval notation information for students based on recent
improvements in the Parser.
Modified Files:
--------------
webwork-modperl/htdocs/helpFiles:
IntervalNotation.html
Revision Data
-------------
Index: IntervalNotation.html
===================================================================
RCS file: /webwork/cvs/system/webwork-modperl/htdocs/helpFiles/IntervalNotation.html,v
retrieving revision 1.2
retrieving revision 1.3
diff -Lhtdocs/helpFiles/IntervalNotation.html -Lhtdocs/helpFiles/IntervalNotation.html -u -r1.2 -r1.3
--- htdocs/helpFiles/IntervalNotation.html
+++ htdocs/helpFiles/IntervalNotation.html
@@ -11,15 +11,18 @@
<ul>
-<li> If an endpoint is included, then use <tt>[</tt> or <tt>]</tt>. If not, then use <tt>(</tt> or <tt>)</tt>. For example, the interval from
--3 to 7 that includes 7 but not -3 is expressed <tt>(-3,7]</tt>.
+<li> If an endpoint is included, then use <tt>[</tt> or <tt>]</tt>.
+If not, then use <tt>(</tt> or <tt>)</tt>. For example, the interval
+from -3 to 7 that includes 7 but not -3 is expressed <tt>(-3,7]</tt>.
<br>
<br>
-<li> For infinite intervals, use <tt>Inf</tt> for <font size="+2">∞</font> (infinity) and/or
-<tt>-Inf</tt> for <font size="+2">-∞</font> (-Infinity). For example, the infinite interval containing all points greater than
-or equal to 6 is expressed <tt>[6,Inf)</tt>.
+<li> For infinite intervals, use <tt>Inf</tt>
+for <font size="+2">∞</font> (infinity) and/or
+<tt>-Inf</tt> for <font size="+2">-∞</font> (-Infinity). For
+example, the infinite interval containing all points greater than or
+equal to 6 is expressed <tt>[6,Inf)</tt>.
<br>
<br>
@@ -30,6 +33,21 @@
<br>
<br>
+<li> You can use <code>R</code> as a shorthand for all real numbers.
+ So, it is equivalent to entering <code>(-Inf, Inf)</code>.
+
+<br>
+<br>
+
+<li> You can use set difference notation. So, for all real numbers
+ except 3, you can use <code>R-{3}</code> or
+ <code>(-Inf, 3)U(3,Inf)</code> (they are the same). Similarly,
+ <code>[1,10)-{3,4}</code> is the same as <code>[1,3)U(3,4)U(4,10)</code>.
+
+<br>
+<br>
+
+
<li> WeBWorK will not interpret <tt>[2,4]U[3,5]</tt> as equivalent to <tt>[2,5]</tt>.
All sets should be expressed in their simplest interval notation form, with no
overlapping intervals.
|
|
From: jj v. a. <we...@ma...> - 2005-08-12 18:41:46
|
Log Message:
-----------
Completed conversion of interval_cmp to use Parser objects. Also, minor
updates to number_list_cmp.
Modified Files:
--------------
pg/macros:
extraAnswerEvaluators.pl
Revision Data
-------------
Index: extraAnswerEvaluators.pl
===================================================================
RCS file: /webwork/cvs/system/pg/macros/extraAnswerEvaluators.pl,v
retrieving revision 1.8
retrieving revision 1.9
diff -Lmacros/extraAnswerEvaluators.pl -Lmacros/extraAnswerEvaluators.pl -u -r1.8 -r1.9
--- macros/extraAnswerEvaluators.pl
+++ macros/extraAnswerEvaluators.pl
@@ -1,16 +1,5 @@
loadMacros('Parser.pl');
-# This is extraAnswerEvaluators.pl
-
-# Most of the work is done in special namespaces
-# At the end, we provide one global function, the interval answer evaluator
-
-# To do:
-# Convert these to AnswerEvaluator objects
-# Better error checking/messages
-# Simplify checks so we don't make so much use of num_cmp and cplx_cmp.
-# When they change, these functions may have to change.
-
=head1 NAME
extraAnswerEvaluators.pl -- located in the courseScripts directory
@@ -46,407 +35,15 @@
=cut
-
-{
- package Intervals;
-
- # We accept any of the following as infinity (case insensitive)
- @infinitywords = ("i", "inf", "infty", "infinity");
- $infinityre = join '|', @infinitywords;
- $infinityre = "^([-+m]?)($infinityre)\$";
-
- sub new {
- my $class = shift;
- my $base_string = shift;
- my $self = {};
- $self->{'original'} = $base_string;
- return bless $self, $class;
- }
-
- # Not object oriented. It just returns the structure
- sub new_interval { # must call with 4 arguments
- my($l,$r,$lec, $rec) = @_;
- return [[$l,$r],[$lec,$rec]];
- }
-
- # error routine copied from AlgParser
- sub error {
- my($self, @args) = @_;
- # we cheat to use error from algparser
- my($ap) = new AlgParser();
- $ap->inittokenizer($self->{'original'});
- $ap->error(@args);
- $self->{htmlerror} = $ap->{htmlerror};
- $self->{error_msg} = $ap->{error_msg};
- }
-
- # Determine if num_cmp detected a parsing/syntax type error
-
- sub has_errors {
- my($ah) = shift;
-
- if($ah->{'student_ans'} =~ /error/) {
- return 1;
- }
- my($am) = $ah->{'ans_message'};
- if($am =~ /error/) {
- return 2;
- }
- if($am =~ /must enter/) {
- return 3;
- }
- if($am =~ /does not evaluate/) {
- return 4;
- }
- return 0;
- }
-
-
- ## Parse a string into a bunch of intervals
- ## We do it by hand to avoid problems of nested parentheses
- ## This also builds a normalized version of the string, one with values,
- ## and a latex version.
- ##
- ## Return value simply says whether or not this was successful
- sub parse_intervals {
- my($self) = shift;
- my(%opts) = @_;
- my($str) = $self->{'original'};
- my(@ans_list) = ();
- delete($opts{'sloppy'});
- delete($opts{'ordered'});
- my($unions) = 1;
- if (defined($opts{'unions'}) and ($opts{'unions'} eq 'no')) {
- $unions = 0;
- }
- # Sometimes we use this for lists of points
- delete($opts{'unions'});
- my($b1str,$b2str) = (', ', ', ');
- if($unions) {
- ($b1str,$b2str) = (' U ', ' \cup ');
- }
-
- my($tmp_ae) = main::num_cmp(1, %opts);
- $self->{'normalized'} = '';
- $self->{'value'} = '';
- $self->{'latex'} = '';
- $self->{'htmlerror'} = '';
- $self->{'error_msg'} = '';
- my($pmi) = 0;
- my(@cur) = ("","");
- my($lb,$rb) = (0,0);
- my($level,$spot,$hold,$char,$lr) = (0,0,0,"a",0);
-
- while ($spot < length($str)) {
- $char = substr($str,$spot,1);
- if ($char=~ /[\[(,)\]]/) { # Its a special character
- if ($char eq ",") {
- if ($level == 1) { # Level 1 comma
- if ($lr == 1) {
- $self->error("Not a valid interval; too many commas.",[$spot]);
- return 0;
- } else {
- $lr=1;
- $cur[0] = substr($str,$hold, $spot-$hold);
- if($pmi = pminf($cur[0])) {
- if($pmi<0) {
- $self->{'value'} .= '-';
- $self->{'normalized'} .= '-';
- $self->{'latex'} .= '-';
- }
- $self->{'value'} .= 'Infinity, ';
- $self->{'normalized'} .= 'Infinity, ';
- $self->{'latex'} .= '\infty, ';
- } else {
- my($tmp_ah) = $tmp_ae->evaluate($cur[0]);
- if(has_errors($tmp_ah)) {
- $self->error("I could not parse your input correctly",[$hold, $spot]);
- return 0;
- }
- $self->{'normalized'} .= $tmp_ah->{'preview_text_string'}.", ";
- $self->{'value'} .= $tmp_ah->{'student_ans'}.", ";
- $self->{'latex'} .= $tmp_ah->{'preview_latex_string'}.", ";
- }
- $hold = $spot+1;
- }
- }
- } # end of comma
- elsif ($char eq "[" or $char eq "(") { #opening
- if ($level==0) {
- $lr = 0;
- if(scalar(@ans_list)) { # this is not the first interval
- $self->{'normalized'} .= $b1str;
- $self->{'value'} .= $b1str;
- $self->{'latex'} .= $b2str;
- }
- $self->{'normalized'} .= "$char";
- $self->{'value'} .= "$char";
- $self->{'latex'} .= "$char";
- $hold=$spot+1;
- if ($char eq "[") {
- $lb = 1;
- } else {
- $lb = 0;
- }
- }
- $level++;
- } # end of open paren
- else { # must be closed paren
- if ($level == 0) {
- $self->error("Not a valid interval; extra $char when I expected a new interval to open.",[$spot]);
- return 0;
- } elsif ($level == 1) {
- if ($lr != 1) {
- $self->error("Not a valid interval; closing an interval without a right component.", [$spot]);
- return 0;
- } else {
- $cur[1] = substr($str, $hold, $spot-$hold);
- if($pmi = pminf($cur[1])) {
- if($pmi<0) {
- $self->{'value'} .= '-';
- $self->{'normalized'} .= '-';
- $self->{'latex'} .= '-';
- }
- $self->{'value'} .= "Infinity$char";
- $self->{'normalized'} .= "Infinity$char";
- $self->{'latex'} .= '\infty'."$char";
- } else {
- my($tmp_ah) = $tmp_ae->evaluate($cur[1]);
- if(has_errors($tmp_ah)) {
- $self->error("I could not parse your input correctly",[$hold, $spot]);
- return 0;
- }
- $self->{'normalized'} .= $tmp_ah->{'preview_text_string'}."$char";
- $self->{'value'} .= $tmp_ah->{'student_ans'}."$char";
- $self->{'latex'} .= $tmp_ah->{'preview_latex_string'}."$char";
- }
- if ($char eq "]") {
- $rb = 1;
- } else {
- $rb = 0;
- }
- push @ans_list, new_interval($cur[0], $cur[1], $lb, $rb);
- }
- }
- $level--;
- }
- }
- $spot++;
- }
-
- if($level>0) {
- $self->error("Your expression ended in the middle of an interval.",
- [$hold, $spot]);
- return 0;
- }
- $self->{'parsed'} = \@ans_list;
- return 1;
- }
-
- # Is the argument an exceptable +/- infinity
- # Its sort of multiplies the input by 0 using 0 * oo = 1, 0 * (-oo) = -1.
- sub pminf {
- my($val) = shift;
- $val = "\L$val"; # lowercase
- $val =~ s/ //g; # remove space
- if ($val =~ /$infinityre/) {
- if (($1 eq '-') or ($1 eq 'm')) {
- return -1;
- } else {
- return 1;
- }
- }
- return 0;
- }
-
- # inputs are now of type Intervals, and then options
-
- sub cmp_intervals {
- my($in1) = shift;
- my($in2) = shift;
- my(%opts) = @_;
- my($strict_ordering) = 0;
- if (defined($opts{'ordering'}) && $opts{'ordering'} eq 'strict') {
- $strict_ordering = 1;
- }
- delete($opts{'ordering'});
-
- my($issloppy) = 0;
- if (defined($opts{'sloppy'}) && $opts{'sloppy'} eq 'yes') {
- $issloppy = 1;
- }
- delete($opts{'sloppy'});
-
- delete($opts{'unions'});
-
-
- my(@i1) = @{$in1->{'parsed'}};
- my(@i2) = @{$in2->{'parsed'}};
-
- my($j,$pm10,$pm11,$pm20,$pm21);
- # Same number of intervals?
- if (scalar(@i1) != scalar(@i2)) {
- return 0;
- }
- for ($j=0; $j<scalar(@i1);$j++) {
- my($lbound) = 0;
- my($ubound) = scalar(@i1)-1;
- my($lookformatch) = 1;
- if ($strict_ordering) {
- $lbound = $j;
- $ubound = $j;
- }
- for ($k=$lbound; $lookformatch && $k<=$ubound; $k++) {
- # Do they all have correct inclusions ()[]?
- if (! $issloppy and ($i1[$j]->[1][0] != $i2[$k]->[1][0] or
- $i1[$j]->[1][1] != $i2[$k]->[1][1])) {
- next;
- }
- $pm10 = pminf($i1[$j]->[0][0]);
- $pm11 = pminf($i1[$j]->[0][1]);
- $pm20 = pminf($i2[$k]->[0][0]);
- $pm21 = pminf($i2[$k]->[0][1]);
- if ($pm10 != $pm20) {
- next;
- }
- if ($pm11 != $pm21) {
- next;
- }
- # Now we deal with only numbers, no infinities
- if ($pm10 == 0) {
-# $opts{'correctAnswer'} = $i1[$j]->[0][0];
- my $ae = main::num_cmp($i1[$j]->[0][0], %opts);
- my $result = $ae->evaluate($i2[$k]->[0][0]);
- if ($result->{score} == 0) {
- next;
- }
- }
- if ($pm11 == 0) {
-# $opts{'correctAnswer'} = $i1[$j]->[0][1];
- my $ae = main::num_cmp($i1[$j]->[0][1], %opts);
- my $result = $ae->evaluate($i2[$k]->[0][1]);
- if ($result->{score} == 0) {
- next;
- }
- }
- $lookformatch=0;
- }
- if ($lookformatch) { # still looking ...
- return 0;
- }
- }
- return 1;
- }
-
- sub show_int {
- my($intt) = shift;
- my($intstring) = "";
- return "|$intt->[0]->[0]%%$intt->[0]->[1]|";
- }
-
-
-
-} # End of package Intervals
-
-{
- package Interval_evaluator;
-
- sub nicify_string {
- my $str = shift;
-
- $str = uc($str);
- $str =~ s/\s//g; # remove white space
- $str;
- }
-
- ##### The answer evaluator
-
- sub interval_cmp {
-
- my $right_ans = shift;
- my %opts = @_;
-
- $opts{'mode'} = 'std' unless defined($opts{'mode'});
- $opts{'tolType'} = 'relative' unless defined($opts{'tolType'});
-
- my $ans_eval = sub {
- my $student = shift;
-
- my $ans_hash = new AnswerHash(
- 'score'=>0,
- 'correct_ans'=>$right_ans,
- 'student_ans'=>$student,
- 'original_student_ans' => $student,
- # 'type' => undef,
- 'ans_message'=>'',
- 'preview_text_string'=>'',
- 'preview_latex_string'=>'',
- );
- # Handle string matches separately
- my($studentisstring, $correctisstring, $tststr) = (0,0,"");
- my($nicestud, $nicecorrect) = (nicify_string($student),
- nicify_string($right_ans));
- if(defined($opts{'strings'})) {
- for $tststr (@{$opts{'strings'}}) {
- $tststr = nicify_string($tststr);
- if(($tststr eq $nicestud)) {$studentisstring=1;}
- if(($tststr eq $nicecorrect)) {$correctisstring=1;}
- }
- if($studentisstring) {
- $ans_hash->{'preview_text_string'} = $student;
- $ans_hash->{'preview_latex_string'} = $student;
- }
- }
- my($student_int, $correct_int);
- if(!$studentisstring) {
- $student_int = new Intervals($student);
- if(! $student_int->parse_intervals(%opts)) {
- # Error in student input
- $ans_hash->{'student_ans'} = "error: $student_int->{htmlerror}";
- $ans_hash->{'ans_message'} = "$student_int->{error_msg}";
- return $ans_hash;
- }
-
- $ans_hash->{'student_ans'} = $student_int->{'value'};
- $ans_hash->{'preview_text_string'} = $student_int->{'normalized'};
- $ans_hash->{'preview_latex_string'} = $student_int->{'latex'};
- }
-
- if(!$correctisstring) {
- $correct_int = new Intervals($right_ans);
- if(! $correct_int->parse_intervals(%opts)) {
- # Cannot parse instuctor's answer!
- $ans_hash->{'ans_message'} = "Tell your professor that there is an error in this problem.";
- return $ans_hash;
- }
- }
- if($correctisstring || $studentisstring) {
- if($nicestud eq $nicecorrect) {
- $ans_hash -> setKeys('score' => 1);
- }
- } else {
- if (Intervals::cmp_intervals($correct_int, $student_int, %opts)) {
- $ans_hash -> setKeys('score' => 1);
- }
- }
-
- return $ans_hash;
- };
-
- return $ans_eval;
- }
-
-}
-
{
package Equation_eval;
-
+
sub split_eqn {
my $instring = shift;
-
- split /=/, $instring;
+
+ split /=/, $instring;
}
-
+
sub equation_cmp {
my $right_ans = shift;
@@ -609,52 +206,82 @@
This becomes an important feature when you are really checking lists of
ordered pairs.
+Now we use the Parser package for checking intervals (or lists of
+points if unions=>'no'). So, one can specify the Parser options
+showCoordinateHints, showHints, partialCredit, and/or showLengthHints
+as optional arguments:
+
+ interval_cmp("(1,2), (2,3), (4,-1)", unions=>'no', partialCredit=>1)
+
+Also, set differences and 'R' for all real numbers now work too since they work
+for Parser Intervals and Unions.
+
=cut
-sub interval_cmp2 {
+sub interval_cmp {
my $correct_ans = shift;
my %opts = @_;
- my $mode = $num_params{mode} || 'std';
+ my $mode = $opts{mode} || 'std';
my %options = (debug => $opts{debug});
- my $ans_type = ''; # set to List, Union, or Interval below
+ my $ans_type = ''; # set to List, Union, Interval, or String below
#
# Get an apppropriate context based on the mode
#
my $oldContext = Context();
my ($context, $ans_eval);
+ for ($mode) {
+ /^strict$/i and do {
+ $context = $Parser::Context::Default::context{LimitedNumeric}->copy;
+ $context->operators->set(',' => {class=> 'Parser::BOP::comma'});
+ last;
+ };
+ /^arith$/i and do {
+ $context = $Parser::Context::Default::context{LegacyNumeric}->copy;
+ $context->functions->disable('All');
+ last;
+ };
+ /^frac$/i and do {
+ $context = $Parser::Context::Default::context{'LimitedNumeric-Fraction'}->copy;
+ $context->operators->set(',' => {class=> 'Parser::BOP::comma'});
+ last;
+ };
+
+ # default
+ $context = $Parser::Context::Default::context{LegacyNumeric}->copy;
+ }
+
if(defined($opts{unions}) and $opts{unions} eq 'no' ) {
# This is really a list of points, not intervals at all
- $context = $Parser::Context::Default::context{Vector}->copy;
$ans_type = 'List';
- $options{showCoordinateHints} = 0;
- $options{showHints} = 0;
- $options{partialCredit}=0;
- $options{showLengthHints} = 0;
+ $context->parens->redefine('(');
+ $context->parens->redefine('[');
+ $context->parens->redefine('{', from=>'Interval');
+ $correct_ans =~ s/u/,/gi;
} else {
- $context = $Parser::Context::Default::context{Numeric}->copy;
- $context->parens->set(
- '(' => {type => 'Interval'},
- '[' => {type => 'Interval'},
- '{' => {type => 'Interval'},
+ $context->parens->redefine('(', from=>'Interval');
+ $context->parens->redefine('[', from=>'Interval');
+ $context->parens->redefine('{', from=>'Interval');
+ my $infinity = Value::Infinity->new();
+ $context->constants->add(
+ R => Value::Interval->new('(',-$infinity,$infinity,')'),
);
$correct_ans =~ tr/u/U/;
+ $context->operators->redefine('U',from=>"Interval");
+ $context->operators->redefine('u',from=>"Interval",using=>"U");
if($correct_ans =~ /U/) {
- $context->operators->add('u'=> {precedence => 0.5, associativity => 'left',
- type => 'bin', isUnion => 1, string => ' U ', TeX => '\cup ',
- class => 'Parser::BOP::union'});
$ans_type = 'Union';
- $options{showHints} = 0;
- $options{showLengthHints} = 0;
- $options{showEndpointHints}=0;
- $options{partialCredit}=0;
} else {
$ans_type = 'Interval';
- $options{showEndpointHints}=0;
}
}
+ # Take optional arguments intended for Interval, List, or Union
+ for my $o qw( showCoordinateHints showHints partialCredit showLengthHints ) {
+ $options{$o} = $opts{$o} || 0;
+ }
+ # Tolerances
$opts{tolType} = $opts{tolType} || 'relative';
$opts{tolerance} = $opts{tolerance} || $opts{tol} ||
$opts{reltol} || $opts{relTol} || $opts{abstol} || 1;
@@ -680,6 +307,7 @@
if (defined($opts{'sloppy'}) && $opts{'sloppy'} eq 'yes') {
$options{requireParenMatch} = 0;
}
+ # historically we allow more infinities
$context->strings->add(
'i' => {alias=>'infinity'},
'infty' => {alias=>'infinity'},
@@ -688,6 +316,16 @@
'minf' => {alias=>'minfinity'},
'mi' => {alias=>'minfinity'},
);
+ # Add any strings
+ if ($opts{strings}) {
+ foreach my $string (@{$opts{strings}}) {
+ $string = uc($string);
+ $context->strings->add($string) unless
+ defined($context->strings->get($string));
+ $ans_type = 'String' if $string eq uc($correct_ans);
+ }
+ }
+ $context->{format}{number} = $opts{'format'} || $main::numFormatDefault;
Context($context);
if($ans_type eq 'List') {
$ans_eval = List($correct_ans)->cmp(%options);
@@ -695,27 +333,14 @@
$ans_eval = Union($correct_ans)->cmp(%options);
} elsif($ans_type eq 'Interval') {
$ans_eval = Interval($correct_ans)->cmp(%options);
+ } elsif($ans_type eq 'String') {
+ $ans_eval = List($correct_ans)->cmp(%options);
} else {
warn "Bug -- should not be here in interval_cmp";
}
Context($oldContext);
return($ans_eval);
-
-
- # ToDo:
- # modes?
- # strings
- # infinities
- #@infinitywords = ("i", "inf", "infty", "infinity");
- #$infinityre = join '|', @infinitywords;
- #$infinityre = "^([-+m]?)($infinityre)\$";
-
-
-}
-
-sub interval_cmp {
- Interval_evaluator::interval_cmp(@_);
}
=head3 number_list_cmp ()
@@ -756,6 +381,11 @@
will mark "none" as correct.
+One can also specify optionnal arguments for Parser's List checker: showHints,
+partialCredit, and showLengthHints, as in:
+
+ number_list_cmp("cos(3), sqrt(111)", partialCredit=>1)
+
=cut
sub number_list_cmp {
@@ -797,11 +427,13 @@
$context = $Parser::Context::Default::context{LegacyNumeric}->copy;
}
$context->{format}{number} = $num_params{'format'} || $main::numFormatDefault;
- $context->strings->clear;
+ #$context->strings->clear;
if ($num_params{strings}) {
foreach my $string (@{$num_params{strings}}) {
my %tex = ($string =~ m/(-?)inf(inity)?/i)? (TeX => "$1\\infty"): ();
- $context->strings->add(uc($string) => {%tex});
+ $string = uc($string);
+ $context->strings->add($string => {%tex}) unless
+ defined($context->strings->get($string));
}
}
@@ -829,9 +461,9 @@
$options{ordered} = 1 if(defined($num_params{ordered}) and $opts{ordered});
# These didn't exist before in number_list_cmp so they behaved like
# in List()->cmp. Now they can be optionally set
- $options{showHints}= $num_params{showHints} || 0;
- $options{showLengthHints}= $num_params{showHints} || 0;
- $options{partialCredit}= $num_params{showHints} || 0;
+ for my $o qw( showHints partialCredit showLengthHints ) {
+ $options{$o} = $num_params{$o} || 0;
+ }
Context($context);
my $ans_eval = List($list)->cmp(%options);
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-12 17:38:25
|
Log Message:
-----------
Avoid problem with undefined value being passed to protectHTML.
Modified Files:
--------------
pg/lib/Value:
AnswerChecker.pm
Revision Data
-------------
Index: AnswerChecker.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v
retrieving revision 1.52
retrieving revision 1.53
diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.52 -r1.53
--- lib/Value/AnswerChecker.pm
+++ lib/Value/AnswerChecker.pm
@@ -480,6 +480,7 @@
#
sub protectHTML {
my $string = shift;
+ return unless defined($string);
return $string if eval ('$main::displayMode') eq 'TeX';
$string =~ s/&/\&/g;
$string =~ s/</\</g;
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-12 17:08:00
|
Log Message:
-----------
Changed how Intervals implement the requireParenMatch flag for the
interval and union answer checker. (Use a Context flag rather than a
flag on the interval itself.) Moved the getFlag method from
Formula.pm to Value.pm so it can be used by any object class. New
feature where classes can add more context flags to set (and reset
after the answer checker runs).
Modified Files:
--------------
pg/lib/Value:
AnswerChecker.pm
Formula.pm
Interval.pm
Revision Data
-------------
Index: AnswerChecker.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/AnswerChecker.pm,v
retrieving revision 1.51
retrieving revision 1.52
diff -Llib/Value/AnswerChecker.pm -Llib/Value/AnswerChecker.pm -u -r1.51 -r1.52
--- lib/Value/AnswerChecker.pm
+++ lib/Value/AnswerChecker.pm
@@ -62,6 +62,8 @@
showExtraParens => 1, # make student answer painfully unambiguous
reduceConstants => 0, # don't combine student constants
reduceConstantFunctions => 0, # don't reduce constant functions
+ ($ans->{requireParenMatch}? (): ignoreEndpointTypes => 1), # for Intervals
+ $self->cmp_contextFlags($ans), # any additional ones from the object itself
);
$ans->{isPreview} = $self->getPG('$inputs_ref->{previewAnswers}');
$ans->{cmp_class} = $self->cmp_class($ans) unless $ans->{cmp_class};
@@ -92,7 +94,7 @@
}
} else {
$self->cmp_error($ans);
- $self->cmp_collect($ans);
+ $self->cmp_collect($ans); ## FIXME: why is this here a second time?
}
contextSet($context,%{$flags}); # restore context values
Parser::Context->current(undef,$current); # put back the old context
@@ -228,6 +230,7 @@
# filled in by sub-classes
#
sub cmp_postprocess {}
+sub cmp_contextFlags {return ()}
#
# create answer rules of various types
@@ -773,15 +776,6 @@
$other->type =~ m/^(Interval|Union|Set)$/;
}
-sub cmp_compare {
- my $self = shift; my $other = shift; my $ans = shift;
- my $oldignore = $self->{requireParenMatch};
- $self->{ignoreEndpointTypes} = !$ans->{requireParenMatch};
- my $equal = $self->SUPER::cmp_compare($other,$ans);
- $self->{ignoreEndpointTypes} = $oldignore;
- return $equal;
-}
-
#
# Check for wrong enpoints and wrong type of endpoints
#
@@ -840,8 +834,7 @@
#
sub cmp_equal {
my ($self,$ans) = @_;
- Value::List::cmp_equal(@_)
- if $ans->{student_value}->type eq 'Set';
+ Value::List::cmp_equal(@_) if $ans->{student_value}->type eq 'Set';
Value::cmp_equal(@_);
}
@@ -897,7 +890,7 @@
extra => $element,
requireParenMatch => 1,
removeParens => 1,
- );
+ );
}
#
Index: Formula.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Formula.pm,v
retrieving revision 1.32
retrieving revision 1.33
diff -Llib/Value/Formula.pm -Llib/Value/Formula.pm -u -r1.32 -r1.33
--- lib/Value/Formula.pm
+++ lib/Value/Formula.pm
@@ -45,12 +45,15 @@
sub blank {$pkg->SUPER::new('')}
#
-# with() changes tree element not formula itself
-# (maybe the wrong choice?)
+# with() changes tree element as well
+# as the formula itself.
#
sub with {
my $self = shift; my %hash = @_;
- foreach my $id (keys(%hash)) {$self->{tree}{$id} = $hash{$id}}
+ foreach my $id (keys(%hash)) {
+ $self->{tree}{$id} = $hash{$id};
+ $self->{$id} = $hash{$id};
+ }
return $self;
}
@@ -465,19 +468,6 @@
return $m + $n*int(rand()*(int(($M-$m)/$n)+1));
}
-#
-# Get the value of a flag from the object itself,
-# or from the context, or from the default context
-# or from the given default, whichever is found first.
-#
-sub getFlag {
- my $self = shift; my $name = shift;
- return $self->{$name} if defined($self->{$name});
- return $self->{context}{flags}{$name} if defined($self->{context}{flags}{$name});
- return $$Value::context->{flags}{$name} if defined($$Value::context->{flags}{$name});
- return shift;
-}
-
############################################
#
# Check if the value of a formula is constant
Index: Interval.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Interval.pm,v
retrieving revision 1.22
retrieving revision 1.23
diff -Llib/Value/Interval.pm -Llib/Value/Interval.pm -u -r1.22 -r1.23
--- lib/Value/Interval.pm
+++ lib/Value/Interval.pm
@@ -219,8 +219,9 @@
$r = promote($r); if ($flag) {my $tmp = $l; $l = $r; $r = $tmp};
my ($la,$lb) = @{$l->data}; my ($ra,$rb) = @{$r->data};
my $cmp = $la <=> $ra; return $cmp if $cmp;
- $cmp = $l->{open} cmp $r->{open}; return $cmp if $cmp && !$l->{ignoreEndpointTypes};
- $cmp = $lb <=> $rb; return $cmp if $cmp || $l->{ignoreEndpointTypes};
+ my $ignoreEndpointTypes = $l->getFlag('ignoreEndpointTypes');
+ $cmp = $l->{open} cmp $r->{open}; return $cmp if $cmp && !$ignoreEndpointTypes;
+ $cmp = $lb <=> $rb; return $cmp if $cmp || $ignoreEndpointTypes;
return $l->{close} cmp $r->{close};
}
|
|
From: Sam H. v. a. <we...@ma...> - 2005-08-12 15:51:36
|
Log Message:
-----------
renamed weird $QuellSubroutineOutput to $DenySubroutineOutput. This will
better match $AllowSubroutineOutput.
Modified Files:
--------------
webwork2/lib/WeBWorK:
Constants.pm
Debug.pm
Revision Data
-------------
Index: Debug.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/Debug.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -Llib/WeBWorK/Debug.pm -Llib/WeBWorK/Debug.pm -u -r1.5 -r1.6
--- lib/WeBWorK/Debug.pm
+++ lib/WeBWorK/Debug.pm
@@ -64,14 +64,14 @@
our $Logfile = "" unless defined $Logfile;
-=item $QuellSubroutineOutput
+=item $DenySubroutineOutput
If defined, prevent subroutines matching the following regular expression from
logging.
=cut
-our $QuellSubroutineOutput;
+our $DenySubroutineOutput;
=item $AllowSubroutineOutput
@@ -104,7 +104,7 @@
if ($Enabled) {
my ($package, $filename, $line, $subroutine) = caller(1);
return if defined $AllowSubroutineOutput and not $subroutine =~ m/$AllowSubroutineOutput/;
- return if defined $QuellSubroutineOutput and $subroutine =~ m/$QuellSubroutineOutput/;
+ return if defined $DenySubroutineOutput and $subroutine =~ m/$DenySubroutineOutput/;
my ($sec, $msec) = gettimeofday;
my $date = time2str("%a %b %d %H:%M:%S.$msec %Y", $sec);
Index: Constants.pm
===================================================================
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/Constants.pm,v
retrieving revision 1.28
retrieving revision 1.29
diff -Llib/WeBWorK/Constants.pm -Llib/WeBWorK/Constants.pm -u -r1.28 -r1.29
--- lib/WeBWorK/Constants.pm
+++ lib/WeBWorK/Constants.pm
@@ -41,9 +41,9 @@
# logging.
#
# For example, this pattern prevents the dispatch() function from logging:
-# $WeBWorK::Debug::QuellSubroutineOutput = qr/^WeBWorK::dispatch$/;
+# $WeBWorK::Debug::DenySubroutineOutput = qr/^WeBWorK::dispatch$/;
#
-$WeBWorK::Debug::QuellSubroutineOutput = undef;
+$WeBWorK::Debug::DenySubroutineOutput = undef;
# If defined, allow only subroutines matching the following regular expression
# to log.
|
|
From: Sam H. v. a. <we...@ma...> - 2005-08-12 02:46:11
|
Log Message:
-----------
added HiRes timing data to WeBWorK::Debug, removed WeBWorK::Timing. all
existing calls to the WeBWorK::Timing methods now pass the same messages=20
to debug().
added an option to WeBWorK::Debug to allow only certain subroutines to
log debug messages, in addition to the existing option to bar certain
subroutines from doing so.
Modified Files:
--------------
webwork2/lib:
WeBWorK.pm
webwork2/lib/WeBWorK:
Constants.pm
ContentGenerator.pm
DB.pm
Debug.pm
URLPath.pm
webwork2/lib/WeBWorK/ContentGenerator:
GatewayQuiz.pm
Grades.pm
Hardcopy.pm
Instructor.pm
Problem.pm
ProblemSet.pm
ProblemSets.pm
webwork2/lib/WeBWorK/ContentGenerator/Instructor:
ProblemSetList.pm
Scoring.pm
SetsAssignedToUser.pm
Stats.pm
StudentProgress.pm
UsersAssignedToSet.pm
webwork2/lib/WeBWorK/DB/Schema:
SQL.pm
WW1Hash.pm
Removed Files:
-------------
webwork2/lib/WeBWorK:
Timing.pm
Revision Data
-------------
Index: DB.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/DB.pm,v
retrieving revision 1.65
retrieving revision 1.66
diff -Llib/WeBWorK/DB.pm -Llib/WeBWorK/DB.pm -u -r1.65 -r1.66
--- lib/WeBWorK/DB.pm
+++ lib/WeBWorK/DB.pm
@@ -140,7 +140,7 @@
use warnings;
use Carp;
use Data::Dumper;
-use WeBWorK::Timing;
+use WeBWorK::Debug;
use WeBWorK::Utils qw(runtime_use);
=20
########################################################################=
########
@@ -328,7 +328,7 @@
#=20
# yay!
=09
- $WeBWorK::timer->continue(__PACKAGE__ . "::hashDatabaseOK: about to get=
orphaned UserSets") if defined $WeBWorK::timer;
+ debug(__PACKAGE__ . "::hashDatabaseOK: about to get orphaned UserSets")=
;
=09
# ... so instead, we're going to do things manually
=09
@@ -344,7 +344,7 @@
or return 0, @results, "Failed to connect to set_user database.";
=09
=20
- # get PSVNs for global user (=EFN)
+ # get PSVNs for global user (=D4N)
# this reads from "login<>global_user"
my @globalUserPSVNs =3D $self->{set_user}->getPSVNsForUser($globalUser=
ID);
#warn "found ", scalar @globalUserPSVNs, " PSVNs for the global user.\=
n";
@@ -360,7 +360,7 @@
}
=09
=20
- # get PSVNs for each setID (=EFN*M)
+ # get PSVNs for each setID (=D4N*M)
# this reads from "set<>$_"
my @okPSVNs =3D map { $self->{set_user}->getPSVNsForSet($_) } @globalU=
serSetIDs;
#warn "found ", scalar @okPSVNs, " PSVNs for sets assigned to the glob=
al user.\n";
@@ -407,7 +407,7 @@
}
}
=09
- $WeBWorK::timer->continue(__PACKAGE__ . "::hashDatabaseOK: done getting=
orphaned UserSets") if defined $WeBWorK::timer;
+ debug(__PACKAGE__ . "::hashDatabaseOK: done getting orphaned UserSets")=
;
=09
if (keys %orphanUserSets) {
foreach my $setID (keys %orphanUserSets) {
@@ -2033,25 +2033,25 @@
if (ref $self->{set_user} eq "WeBWorK::DB::Schema::WW1Hash"
and ref $self->{set} eq "WeBWorK::DB::Schema::GlobalTableEmulator") {
#warn __PACKAGE__.": using a terrible hack.\n";
- $WeBWorK::timer->continue("DB: getsNoFilter start") if defined($WeBWor=
K::timer);
+ debug("DB: getsNoFilter start");
my @MergedSets =3D $self->{set_user}->getsNoFilter(@userSetIDs);
- $WeBWorK::timer->continue("DB: getsNoFilter end") if defined($WeBWorK:=
:timer);
+ debug("DB: getsNoFilter end");
return @MergedSets;
}
=09
- $WeBWorK::timer->continue("DB: getUserSets start") if defined($WeBWorK:=
:timer);
+ debug("DB: getUserSets start");
my @UserSets =3D $self->getUserSets(@userSetIDs); # checked
=09
- $WeBWorK::timer->continue("DB: pull out set IDs start") if defined($WeB=
WorK::timer);
+ debug("DB: pull out set IDs start");
my @globalSetIDs =3D map { $_->[1] } @userSetIDs;
- $WeBWorK::timer->continue("DB: getGlobalSets start") if defined($WeBWor=
K::timer);
+ debug("DB: getGlobalSets start");
my @GlobalSets =3D $self->getGlobalSets(@globalSetIDs); # checked
=09
- $WeBWorK::timer->continue("DB: calc common fields start") if defined($W=
eBWorK::timer);
+ debug("DB: calc common fields start");
my %globalSetFields =3D map { $_ =3D> 1 } $self->newGlobalSet->FIELDS;
my @commonFields =3D grep { exists $globalSetFields{$_} } $self->newUse=
rSet->FIELDS;
=09
- $WeBWorK::timer->continue("DB: merge start") if defined($WeBWorK::timer=
);
+ debug("DB: merge start");
for (my $i =3D 0; $i < @UserSets; $i++) {
my $UserSet =3D $UserSets[$i];
my $GlobalSet =3D $GlobalSets[$i];
@@ -2063,7 +2063,7 @@
$UserSet->$field($GlobalSet->$field);
}
}
- $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer=
);
+ debug("DB: merge done!");
=09
return @UserSets;
}
@@ -2093,11 +2093,9 @@
if (ref $self->{set_user} eq "WeBWorK::DB::Schema::WW1Hash"
and ref $self->{set} eq "WeBWorK::DB::Schema::GlobalTableEmulator") {
#warn __PACKAGE__.": using a terrible hack.\n";
-# $WeBWorK::timer->continue("DB: getsNoFilter start")=20
-# if defined($WeBWorK::timer);
+# debug("DB: getsNoFilter start");
# my @MergedSets =3D $self->{set_user}->getsNoFilter(@versionedUserSetID=
s);
-# $WeBWorK::timer->continue("DB: getsNoFilter end")=20
-# if defined($WeBWorK::timer);
+# debug("DB: getsNoFilter end");
# return @MergedSets;
croak 'getMergedVersionedSets: using WW1Hash DB Schema! Versioned ' .
'sets are not supported in this context.';
@@ -2105,28 +2103,23 @@
=20
# we merge the nonversioned ("template") user sets (user_id, set_id) and
# the global data into the versioned user sets=09
- $WeBWorK::timer->continue("DB: getUserSets start (nonversioned)")=20
- if defined($WeBWorK::timer);
+ debug("DB: getUserSets start (nonversioned)");
my @TemplateUserSets =3D $self->getUserSets(@nonversionedUserSetIDs)=
;
- $WeBWorK::timer->continue("DB: getUserSets start (versioned)")=20
- if defined($WeBWorK::timer);
+ debug("DB: getUserSets start (versioned)");
# these are the actual user sets that we want to use
my @versionedUserSets =3D $self->getUserSets(@versionedUserSetIDs);
=09
- $WeBWorK::timer->continue("DB: pull out set IDs start")=20
- if defined($WeBWorK::timer);
+ debug("DB: pull out set IDs start");
my @globalSetIDs =3D map { $_->[1] } @userSetIDs;
- $WeBWorK::timer->continue("DB: getGlobalSets start")=20
- if defined($WeBWorK::timer);
+ debug("DB: getGlobalSets start");
my @GlobalSets =3D $self->getGlobalSets(@globalSetIDs);
=09
- $WeBWorK::timer->continue("DB: calc common fields start")=20
- if defined($WeBWorK::timer);
+ debug("DB: calc common fields start");
my %globalSetFields =3D map { $_ =3D> 1 } $self->newGlobalSet->FIELD=
S;
my @commonFields =3D=20
grep { exists $globalSetFields{$_} } $self->newUserSet->FIELDS;
=09
- $WeBWorK::timer->continue("DB: merge start") if defined($WeBWorK::ti=
mer);
+ debug("DB: merge start");
for (my $i =3D 0; $i < @TemplateUserSets; $i++) {
next unless( defined $versionedUserSets[$i] and=20
(defined $TemplateUserSets[$i] or
@@ -2143,7 +2136,7 @@
$TemplateUserSets[$i]->$field ne '');
}
}
- $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::ti=
mer);
+ debug("DB: merge done!");
=09
return @versionedUserSets;
}
@@ -2248,19 +2241,19 @@
and defined $userProblemIDs[$i]->[2];
}
=09
- $WeBWorK::timer->continue("DB: getUserProblems start") if defined($WeBW=
orK::timer);
+ debug("DB: getUserProblems start");
my @UserProblems =3D $self->getUserProblems(@userProblemIDs); # checked
=09
- $WeBWorK::timer->continue("DB: pull out set/problem IDs start") if defi=
ned($WeBWorK::timer);
+ debug("DB: pull out set/problem IDs start");
my @globalProblemIDs =3D map { [ $_->[1], $_->[2] ] } @userProblemIDs;
- $WeBWorK::timer->continue("DB: getGlobalProblems start") if defined($We=
BWorK::timer);
+ debug("DB: getGlobalProblems start");
my @GlobalProblems =3D $self->getGlobalProblems(@globalProblemIDs); # c=
hecked
=09
- $WeBWorK::timer->continue("DB: calc common fields start") if defined($W=
eBWorK::timer);
+ debug("DB: calc common fields start");
my %globalProblemFields =3D map { $_ =3D> 1 } $self->newGlobalProblem->=
FIELDS;
my @commonFields =3D grep { exists $globalProblemFields{$_} } $self->ne=
wUserProblem->FIELDS;
=09
- $WeBWorK::timer->continue("DB: merge start") if defined($WeBWorK::timer=
);
+ debug("DB: merge start");
for (my $i =3D 0; $i < @UserProblems; $i++) {
my $UserProblem =3D $UserProblems[$i];
my $GlobalProblem =3D $GlobalProblems[$i];
@@ -2275,7 +2268,7 @@
$UserProblem->$field($GlobalProblem->$field);
}
}
- $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::timer=
);
+ debug("DB: merge done!");
=09
return @UserProblems;
}
@@ -2295,8 +2288,7 @@
and defined $userProblemIDs[$i]->[3] );
}
=09
- $WeBWorK::timer->continue("DB: getUserProblems start")=20
- if defined($WeBWorK::timer);
+ debug("DB: getUserProblems start");
=20
# these are triples [user_id, set_id, problem_id]
my @nonversionedProblemIDs =3D map {[$_->[0],$_->[1],$_->[3]]} @user=
ProblemIDs;
@@ -2311,24 +2303,20 @@
# both of these, replacing global values with template values and not=
=20
# taking either in the event that the versioned problem already has a=
=20
# value for the field in question
- $WeBWorK::timer->continue("DB: pull out set/problem IDs start")=20
- if defined($WeBWorK::timer);
+ debug("DB: pull out set/problem IDs start");
my @globalProblemIDs =3D map { [ $_->[1], $_->[2] ] } @nonversionedP=
roblemIDs;
- $WeBWorK::timer->continue("DB: getGlobalProblems start")=20
- if defined($WeBWorK::timer);
+ debug("DB: getGlobalProblems start");
my @GlobalProblems =3D $self->getGlobalProblems( @globalProblemIDs )=
;
- $WeBWorK::timer->continue("DB: getTemplateProblems start")=20
- if defined($WeBWorK::timer);
+ debug("DB: getTemplateProblems start");
my @TemplateProblems =3D $self->getUserProblems( @nonversionedProble=
mIDs );
=09
- $WeBWorK::timer->continue("DB: calc common fields start")=20
- if defined($WeBWorK::timer);
+ debug("DB: calc common fields start");
=20
my %globalProblemFields =3D map { $_ =3D> 1 } $self->newGlobalProble=
m->FIELDS;
my @commonFields =3D=20
grep { exists $globalProblemFields{$_} } $self->newUserProblem->FIELDS;
=09
- $WeBWorK::timer->continue("DB: merge start") if defined($WeBWorK::ti=
mer);
+ debug("DB: merge start");
for (my $i =3D 0; $i < @versionUserProblems; $i++) {
my $UserProblem =3D $versionUserProblems[$i];
my $GlobalProblem =3D $GlobalProblems[$i];
@@ -2346,7 +2334,7 @@
$TemplateProblem->$field ne '' );
}
}
- $WeBWorK::timer->continue("DB: merge done!") if defined($WeBWorK::ti=
mer);
+ debug("DB: merge done!");
=20
return @versionUserProblems;
}
Index: ContentGenerator.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator.pm,v
retrieving revision 1.144
retrieving revision 1.145
diff -Llib/WeBWorK/ContentGenerator.pm -Llib/WeBWorK/ContentGenerator.pm =
-u -r1.144 -r1.145
--- lib/WeBWorK/ContentGenerator.pm
+++ lib/WeBWorK/ContentGenerator.pm
@@ -48,8 +48,9 @@
use CGI::Pretty qw(*ul *li escapeHTML);
use Date::Format;
use URI::Escape;
-use WeBWorK::Template qw(template);
+use WeBWorK::Debug;
use WeBWorK::PG;
+use WeBWorK::Template qw(template);
=20
########################################################################=
#######
=20
@@ -1304,7 +1305,7 @@
=20
sub optionsMacro {
my ($self, %options) =3D @_;
-=09
+ debug("HELLO WORLD!");
my @options_to_show =3D @{$options{options_to_show}} if exists $options=
{options_to_show};
@options_to_show =3D "displayMode" unless @options_to_show;
my %options_to_show; @options_to_show{@options_to_show} =3D (); # make =
hash for easy lookups
--- lib/WeBWorK/Timing.pm
+++ /dev/null
@@ -1,248 +0,0 @@
-########################################################################=
########
-# WeBWorK Online Homework Delivery System
-# Copyright =A9 2000-2003 The WeBWorK Project, http://openwebwork.sf.net=
/
-# $CVSHeader: webwork2/lib/WeBWorK/Timing.pm,v 1.11 2005/07/29 21:25:24 =
gage Exp $
-#=20
-# This program is free software; you can redistribute it and/or modify i=
t under
-# the terms of either: (a) the GNU General Public License as published b=
y the
-# Free Software Foundation; either version 2, or (at your option) any la=
ter
-# version, or (b) the "Artistic License" which comes with this package.
-#=20
-# This program is distributed in the hope that it will be useful, but WI=
THOUT
-# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or =
FITNESS
-# FOR A PARTICULAR PURPOSE. See either the GNU General Public License o=
r the
-# Artistic License for more details.
-########################################################################=
########
-
-package WeBWorK::Timing;
-
-=3Dhead1 NAME
-
-WeBWorK::Timing - Log timing data.
-
-head1 SYNOPSIS
-
- use WeBWorK::Timing;
-=20
- # Enable timing
- $WeBWorK::Timing::Enable =3D 1;
-=20
- # Log to a file instead of STDERR
- $WeBWorK::Timing::Logfile =3D "/path/to/timing.log";
-=20
- my $timer =3D WeBWorK::Timing->new("do some processesing");
- $timer->start;
- do_some_processing();
- $timer->continue("
- do_some_more_processing();
- $timer->stop;
- $timer->save;
-=20
- my $timer0 =3D WeBWorK::Timing->new("main task");
- my $timer1 =3D WeBWorK::Timing->new("subtask 1");
- my $timer2 =3D WeBWorK::Timing->new("subtask 1");
-=20
- $timer0->start;
- $timer1->start;
- sub_task(1);
- $timer1->stop;
- $timer2->start;
- sub_task(2);
- $timer2->stop;
- $timer0->stop;
-
- # timing data is saved when objects go out of scope
-
-=3Dcut
-
-use strict;
-use warnings;
-use Time::HiRes qw(gettimeofday tv_interval);
-
-our $TASK_COUNT =3D 0; # number of tasks processed in this child process
-
-########################################################################=
########
-
-=3Dhead1 CONFIGURATION VARIABLES
-
-=3Dover
-
-=3Ditem $Enabled
-
-If true, timing messages will be output. If false, they will be ignored.
-
-=3Dcut
-
-our $Enabled =3D 0 unless defined $Enabled;
-
-=3Ditem $Logfile
-
-If non-empty, timing output will be sent to the file named rather than S=
TDERR.
-
-=3Dcut
-
-our $Logfile =3D "" unless defined $Logfile;
-
-=3Dback
-
-=3Dcut
-
-########################################################################=
########
-
-=3Dhead1 CONSTRUCTOR
-
-=3Dover
-
-=3Ditem new($task)
-
-C<new> creates a new timing object, with the task given in $task.
-
-=3Dcut
-
-sub new {
- my ($invocant, $task) =3D @_;
- my $self =3D {
- id =3D> $TASK_COUNT++,
- task =3D> $task,
- ctime =3D> scalar gettimeofday(),
- saved =3D> 0,
- };
- return bless $self, ref $invocant || $invocant
-}
-
-=3Dback
-
-=3Dcut
-
-########################################################################=
########
-
-=3Dhead1 METHODS
-
-=3Dover
-
-=3Ditem start(), begin()
-
-Marks the current time as the start time for the task.
-
-=3Dcut
-
-sub start {
- my ($self) =3D @_;
- $self->{start} =3D gettimeofday();
-}
-
-sub begin { shift->start(@_); }
-
-=3Ditem continue($data)
-
-Stores the current time as an intermediate time, associated with the str=
ing
-given in $data.
-
-=3Dcut
-
-sub continue {
- my ($self, $data) =3D @_;
- push @{$self->{steps}}, [ scalar gettimeofday(), $data ];
-}
-
-=3Ditem stop(), finish(), end()
-
-Marks the current time as the stop time for the task.
-
-=3Dcut
-
-sub stop {
- my ($self) =3D @_;
- $self->{stop} =3D gettimeofday();
-}
-
-sub finish { shift->stop(@_); }
-sub end { shift->stop(@_); }
-
-=3Ditem save()
-
-Writes the timing data for this task to the standard error stream. If sa=
ve is
-not called explicitly, it is called when the object goes out of scope.
-
-=3Dcut
-
-sub save {
- my ($self) =3D @_;
-=09
- if ($Enabled) {
- local($|=3D1); #flush after each print
- my $fh;
- if ($Logfile ne "") {=20
- if (open my $tmpFH, ">>", $Logfile) {
- $fh =3D $tmpFH;
- } else {
- warn "Failed to open timing log '$Logfile' in append mode: $!";
- $fh =3D *STDERR;
- }
- } else {
- $fh =3D *STDERR;
- }
- =09
- my $id =3D $self->{id};
- my $task =3D $self->{task};
- my $now =3D gettimeofday();
- =09
- my $diff =3D sprintf("%.6f", 0);
- if ($self->{start}) {
- my $start =3D sprintf("%.6f", $self->{start});
- print $fh "TIMING $$ $id $start ($diff) $task: START\n";
- } else {
- my $ctime =3D sprintf("%.6f", $self->{ctime});
- print $fh "TIMING $$ $id $ctime ($diff) $task: START (assumed)\n";
- }
- =09
- if ($self->{steps}) {
- my @steps =3D @{$self->{steps}};
- foreach my $step (@steps) {
- my ($time, $data) =3D @$step;
- $time =3D sprintf("%.6f", $time);
- my $start =3D sprintf("%.6f", $self->{start});
- my $diff =3D sprintf("%.6f", $time-$start);
- print $fh "TIMING $$ $id $time ($diff) $task: $data\n";
- }
- }
- =09
- if ($self->{stop}) {
- my $stop =3D sprintf("%.6f", $self->{stop});
- my $start =3D sprintf("%.6f", $self->{start});
- my $diff =3D sprintf("%.6f", $stop-$start);
- print $fh "TIMING $$ $id $stop ($diff) $task: END\n";
- } else {
- $now =3D sprintf("%.6f", $now);
- my $start =3D sprintf("%.6f", $self->{start});
- my $diff =3D sprintf("%.6f", $now-$start);
- print $fh "TIMING $$ $id $now ($diff) $task: END (assumed)\n";
- }
- }
-=09
- $self->{saved} =3D 1;
-}
-
-sub DESTROY {
- my ($self) =3D shift;
-=09
- $self->save unless $self->{saved};
-}
-
-=3Dback
-
-=3Dcut
-
-########################################################################=
########
-
-=3Dhead1 AUTHOR
-
-Written by Sam Hathaway, sh002i (at) math.rochester.edu.
-
-=3Dhead1 SEE ALSO
-
-The F<timing> utility can be used to parse and sort log output.
-
-=3Dcut
-
-1;
Index: Debug.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/Debug.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -Llib/WeBWorK/Debug.pm -Llib/WeBWorK/Debug.pm -u -r1.4 -r1.5
--- lib/WeBWorK/Debug.pm
+++ lib/WeBWorK/Debug.pm
@@ -40,6 +40,7 @@
=20
use strict;
use warnings;
+use Time::HiRes qw/gettimeofday/;
=20
########################################################################=
########
=20
@@ -65,12 +66,22 @@
=20
=3Ditem $QuellSubroutineOutput
=20
-Prevent subroutines matching the following regular expression from loggi=
ng.
+If defined, prevent subroutines matching the following regular expressio=
n from
+logging.
=20
=3Dcut
=20
our $QuellSubroutineOutput;
=20
+=3Ditem $AllowSubroutineOutput
+
+If defined, allow only subroutines matching the following regular expres=
sion to
+log.
+
+=3Dcut
+
+our $AllowSubroutineOutput;
+
=3Dback
=20
=3Dcut
@@ -92,11 +103,14 @@
=09
if ($Enabled) {
my ($package, $filename, $line, $subroutine) =3D caller(1);
+ return if defined $AllowSubroutineOutput and not $subroutine =3D~ m/$A=
llowSubroutineOutput/;
return if defined $QuellSubroutineOutput and $subroutine =3D~ m/$Quell=
SubroutineOutput/;
=09
- my $finalMessage =3D "$subroutine: " . join("", @message);
+ my ($sec, $msec) =3D gettimeofday;
+ my $date =3D time2str("%a %b %d %H:%M:%S.$msec %Y", $sec);
+ my $finalMessage =3D "[$date] $subroutine: " . join("", @message);
$finalMessage .=3D "\n" unless $finalMessage =3D~ m/\n$/;
- $finalMessage =3D "[" . time2str("%a %b %d %H:%M:%S %Y", time) . "] " =
.$finalMessage;
+ =09
if ($WeBWorK::Debug::Logfile ne "") {
if (open my $fh, ">>", $Logfile) {
print $fh $finalMessage;
Index: URLPath.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/URLPath.pm,v
retrieving revision 1.24
retrieving revision 1.25
diff -Llib/WeBWorK/URLPath.pm -Llib/WeBWorK/URLPath.pm -u -r1.24 -r1.25
--- lib/WeBWorK/URLPath.pm
+++ lib/WeBWorK/URLPath.pm
@@ -24,12 +24,17 @@
=20
use strict;
use warnings;
+use WeBWorK::Debug;
=20
-sub debug {
-# my ($label, $indent, @message) =3D @_;
-# print STDERR " "x$indent;
-# print STDERR "$label: " if $label ne "";
-# print STDERR @message;
+{
+ no warnings "redefine";
+=09
+ sub debug {
+ my ($label, $indent, @message) =3D @_;
+ my $header =3D " "x$indent;
+ $header .=3D "$label: " if $label ne "";
+ WeBWorK::Debug::debug($header, @message);
+ }
}
=20
=3Dhead1 VIRTUAL HEIRARCHY
@@ -897,10 +902,10 @@
=20
sub visitPathTypeNode($$$$) {
my ($nodeID, $path, $argsRef, $indent) =3D @_;
- debug("visitPathTypeNode", $indent, "visiting node $nodeID with path $p=
ath\n");
+ debug("visitPathTypeNode", $indent, "visiting node $nodeID with path $p=
ath");
=09
unless (exists $pathTypes{$nodeID}) {
- debug("visitPathTypeNode", $indent, "node $nodeID doesn't exist in nod=
e list: failed\n");
+ debug("visitPathTypeNode", $indent, "node $nodeID doesn't exist in nod=
e list: failed");
die "node $nodeID doesn't exist in node list: failed";
}
=09
@@ -913,7 +918,7 @@
if ($path =3D~ s/($match)//) {
# it matches! store captured strings in $argsRef and remove the matche=
d
# characters from $path. waste a lot of lines on sanity checking... ;)
- debug("", 0, "success!\n");
+ debug("", 0, "success!");
my @capture_values =3D $1 =3D~ m/$match/;
if (@capture_names) {
my $nexpected =3D @capture_names;
@@ -935,13 +940,13 @@
my $old =3D $argsRef->{$name};
warn "encountered argument $name again, old value: $old new value: =
$value -- replacing.";
}
- debug("visitPathTypeNode", $indent, "setting argument $name =3D> $va=
lue.\n");
+ debug("visitPathTypeNode", $indent, "setting argument $name =3D> $va=
lue.");
$argsRef->{$name} =3D $value;
}
}
} else {
# it doesn't match. bail out now with return value 0
- debug("", 0, "failed.\n");
+ debug("", 0, "failed.");
return 0;
}
=09
@@ -949,16 +954,16 @@
=09
# if there's no more path left, then this node is the one! return $node=
ID
if ($path eq "") {
- debug("visitPathTypeNode", $indent, "no path left, type is $nodeID\n")=
;
+ debug("visitPathTypeNode", $indent, "no path left, type is $nodeID");
return $nodeID;
}
=09
# otherwise, we have to send the remaining path to the node's children
- debug("visitPathTypeNode", $indent, "but path remains: $path\n");
+ debug("visitPathTypeNode", $indent, "but path remains: $path");
my @kids =3D @{ $node{kids} };
if (@kids) {
foreach my $kid (@kids) {
- debug("visitPathTypeNode", $indent, "trying child $kid:\n");
+ debug("visitPathTypeNode", $indent, "trying child $kid:");
my $result =3D visitPathTypeNode($kid, $path, $argsRef, $indent+1);
# we return in two situations:
# if $result is -1, then the kid matched but couldn't consume the res=
t of the path
@@ -966,9 +971,9 @@
# these are all true values (assuming that "0" isn't a valid node ID)=
, so we say:
return $result if $result;
}
- debug("visitPathTypeNode", $indent, "no children claimed the remaining=
path: failed.\n");
+ debug("visitPathTypeNode", $indent, "no children claimed the remaining=
path: failed.");
} else {
- debug("visitPathTypeNode", $indent, "no children to claim the remainin=
g path: failed.\n");
+ debug("visitPathTypeNode", $indent, "no children to claim the remainin=
g path: failed.");
}
=09
# in both of the above cases, we matched but couldn't provide children =
that
Index: Constants.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/Constants.pm,v
retrieving revision 1.27
retrieving revision 1.28
diff -Llib/WeBWorK/Constants.pm -Llib/WeBWorK/Constants.pm -u -r1.27 -r1.=
28
--- lib/WeBWorK/Constants.pm
+++ lib/WeBWorK/Constants.pm
@@ -37,24 +37,21 @@
#=20
$WeBWorK::Debug::Logfile =3D "";
=20
-# Prevent subroutines matching the following regular expression from log=
ging.
+# If defined, prevent subroutines matching the following regular express=
ion from
+# logging.
#=20
# For example, this pattern prevents the dispatch() function from loggin=
g:
# $WeBWorK::Debug::QuellSubroutineOutput =3D qr/^WeBWorK::dispatch$/=
;
#=20
$WeBWorK::Debug::QuellSubroutineOutput =3D undef;
=20
-########################################################################=
########
-# WeBWorK::Timing
-########################################################################=
########
-
-# If true, WeBWorK::Timing will print timing data.
+# If defined, allow only subroutines matching the following regular expr=
ession
+# to log.
#=20
-$WeBWorK::Timing::Enabled =3D 0;
-
-# If non-empty, timing data will be sent to the file named rather than S=
TDERR.
+# For example, this pattern allow only some function being worked on to =
log:
+# $WeBWorK::Debug::AllowSubroutineOutput =3D qr/^WeBWorK::SomePkg::m=
yFunc$/;
#=20
-$WeBWorK::Timing::Logfile =3D "";
+$WeBWorK::Debug::AllowSubroutineOutput =3D undef;
=20
########################################################################=
########
# WeBWorK::ContentGenerator::Hardcopy
Index: WeBWorK.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK.pm,v
retrieving revision 1.72
retrieving revision 1.73
diff -Llib/WeBWorK.pm -Llib/WeBWorK.pm -u -r1.72 -r1.73
--- lib/WeBWorK.pm
+++ lib/WeBWorK.pm
@@ -51,10 +51,9 @@
use WeBWorK::DB;
use WeBWorK::Debug;
use WeBWorK::Request;
-use WeBWorK::Timing;
use WeBWorK::Upload;
use WeBWorK::URLPath;
-use WeBWorK::Utils qw(runtime_use writeTimingLogEntry);
+use WeBWorK::Utils qw(runtime_use);
use Date::Format;
=20
use constant AUTHEN_MODULE =3D> "WeBWorK::ContentGenerator::Login";
@@ -164,13 +163,6 @@
=09
debug(("-" x 80) . "\n");
=09
- # create a package-global timing object
- # FIXME: this is used by other modules!
- # FIXME: this is not thread-safe!
- my $label =3D defined $displayArgs{courseID} ? $displayArgs{courseID} :=
"ROOT";
- $WeBWorK::timer =3D WeBWorK::Timing->new($label);
- $WeBWorK::timer->start;
-=09
debug("We need to get a course environment (with or without a courseID!=
)\n");
my $ce =3D eval { new WeBWorK::CourseEnvironment({
#webworkRoot =3D> $r->dir_config("webwork_root"),
@@ -296,11 +288,6 @@
debug(("-" x 80) . "\n");
debug("Finally, we'll load the display module...\n");
=09
- # The "production timer" uses a finer grained HiRes timing module
- # rather than the standard unix "time".
- #my $localStartTime =3D time;
- my $productionTimer =3D WeBWorK::Timing->new($label);
- $productionTimer->start();
runtime_use($displayModule);
=09
debug("...instantiate it...\n");
@@ -315,17 +302,8 @@
debug("-------------------- call to ${displayModule}::go\n");
=09
debug("returning result: " . (defined $result ? $result : "UNDEF") . "\=
n");
- #$WeBWorK::timer->continue("[" . time2str("%a %b %d %H:%M:%S %Y", time)=
. "]" . "[" . $r->uri . "]");
- #$WeBWorK::timer->stop();
- #$WeBWorK::timer->save();
-=09
- #my $localStopTime =3D time;
- $productionTimer->stop();
- #my $timeDiff =3D $localStopTime - $localStartTime;
- my $productionTimeDiff =3D $productionTimer->{stop} - $productionTim=
er->{start};=20
- writeTimingLogEntry($ce,"[".$r->uri."]", sprintf("runTime =3D %.3f sec"=
, $productionTimeDiff)." ".$ce->{dbLayoutName},"" );
- return $result;
=09
+ return $result;
}
=20
sub mungeParams {
Index: Problem.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Probl=
em.pm,v
retrieving revision 1.178
retrieving revision 1.179
diff -Llib/WeBWorK/ContentGenerator/Problem.pm -Llib/WeBWorK/ContentGener=
ator/Problem.pm -u -r1.178 -r1.179
--- lib/WeBWorK/ContentGenerator/Problem.pm
+++ lib/WeBWorK/ContentGenerator/Problem.pm
@@ -27,13 +27,13 @@
use warnings;
use CGI qw();
use File::Path qw(rmtree);
+use WeBWorK::Debug;
use WeBWorK::Form;
use WeBWorK::PG;
use WeBWorK::PG::ImageGenerator;
use WeBWorK::PG::IO;
use WeBWorK::Utils qw(readFile writeLog writeCourseLog encodeAnswers dec=
odeAnswers ref2string makeTempDirectory);
use WeBWorK::DB::Utils qw(global2user user2global findDefaults);
-use WeBWorK::Timing;
use URI::Escape;
=20
use WeBWorK::Utils::Tasks qw(fake_set fake_problem);
@@ -592,7 +592,7 @@
=09
##### translation #####
=20
- $WeBWorK::timer->continue("begin pg processing") if defined($WeBWorK::t=
imer);
+ debug("begin pg processing");
my $pg =3D WeBWorK::PG->new(
$ce,
$effectiveUser,
@@ -610,7 +610,7 @@
},
);
=09
- $WeBWorK::timer->continue("end pg processing") if defined($WeBWorK::tim=
er);
+ debug("end pg processing");
=09
##### fix hint/solution options #####
=09
@@ -822,7 +822,7 @@
}
=09
##### answer processing #####
- $WeBWorK::timer->continue("begin answer processing") if defined($WeBWor=
K::timer);
+ debug("begin answer processing");
# if answers were submitted:
my $scoreRecordedMessage;
my $pureProblem;
@@ -926,7 +926,7 @@
}
}
=09
- $WeBWorK::timer->continue("end answer processing") if defined($WeBWorK:=
:timer);
+ debug("end answer processing");
=09
##### output #####
# custom message for editor
Index: GatewayQuiz.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Gatew=
ayQuiz.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -Llib/WeBWorK/ContentGenerator/GatewayQuiz.pm -Llib/WeBWorK/ContentG=
enerator/GatewayQuiz.pm -u -r1.11 -r1.12
--- lib/WeBWorK/ContentGenerator/GatewayQuiz.pm
+++ lib/WeBWorK/ContentGenerator/GatewayQuiz.pm
@@ -34,7 +34,6 @@
use WeBWorK::PG::IO;
use WeBWorK::Utils qw(writeLog writeCourseLog encodeAnswers decodeAnswer=
s ref2string makeTempDirectory);
use WeBWorK::DB::Utils qw(global2user user2global findDefaults);
-use WeBWorK::Timing;
=20
use WeBWorK::ContentGenerator::Instructor qw(assignSetVersionToUser);
=20
@@ -1016,8 +1015,7 @@
# answer processing
####################################
=20
- $WeBWorK::timer->continue("begin answer processing")=20
- if defined($WeBWorK::timer);
+ debug("begin answer processing");=20
=20
my @scoreRecordedMessage =3D ('') x scalar(@problems);
=20
@@ -1165,8 +1163,7 @@
# warn("in submitanswers conditional\n");
=20
} # end if submitAnswers conditional
- $WeBWorK::timer->continue("end answer processing")=20
- if defined( $WeBWorK::timer );
+ debug("end answer processing");
=20
# additional set-level database manipulation: this is all for versioned=20
# sets/gateway tests
Index: ProblemSets.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Probl=
emSets.pm,v
retrieving revision 1.60
retrieving revision 1.61
diff -Llib/WeBWorK/ContentGenerator/ProblemSets.pm -Llib/WeBWorK/ContentG=
enerator/ProblemSets.pm -u -r1.60 -r1.61
--- lib/WeBWorK/ContentGenerator/ProblemSets.pm
+++ lib/WeBWorK/ContentGenerator/ProblemSets.pm
@@ -26,6 +26,7 @@
use strict;
use warnings;
use CGI qw();
+use WeBWorK::Debug;
use WeBWorK::Utils qw(readFile sortByName);
=20
# what do we consider a "recent" problem set?
@@ -135,10 +136,10 @@
my @setIDs =3D $db->listUserSets($effectiveUser);
=09
my @userSetIDs =3D map {[$effectiveUser, $_]} @setIDs;
- $WeBWorK::timer->continue("Begin collecting merged sets") if defined($W=
eBWorK::timer);
+ debug("Begin collecting merged sets");
my @sets =3D $db->getMergedSets( @userSetIDs );
=09
- $WeBWorK::timer->continue("Begin fixing merged sets") if defined($WeBWo=
rK::timer);
+ debug("Begin fixing merged sets");
=09
# Database fix (in case of undefined published values)
# this may take some extra time the first time but should NEVER need to=
be run twice
@@ -157,7 +158,7 @@
=20
# gateways/versioned sets require dealing with output data slightly=20
# differently, so check for those here=09
- $WeBWorK::timer->continue("Begin set-type check") if defined($WeBWorK::=
timer);
+ debug("Begin set-type check");
my $existVersions =3D 0;
foreach ( @sets ) {
if ( defined( $_->assignment_type() ) &&=20
@@ -200,12 +201,12 @@
);
}
=20
- $WeBWorK::timer->continue("Begin sorting merged sets") if defined($WeBW=
orK::timer);
+ debug("Begin sorting merged sets");
=09
@sets =3D sortByName("set_id", @sets) if $sort eq "name";
@sets =3D sort byUrgency @sets if $sort eq "status";
=09
- $WeBWorK::timer->continue("End preparing merged sets") if defined($WeBW=
orK::timer);
+ debug("End preparing merged sets");
=09
foreach my $set (@sets) {
die "set $set not defined" unless $set;
Index: ProblemSet.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Probl=
emSet.pm,v
retrieving revision 1.65
retrieving revision 1.66
diff -Llib/WeBWorK/ContentGenerator/ProblemSet.pm -Llib/WeBWorK/ContentGe=
nerator/ProblemSet.pm -u -r1.65 -r1.66
--- lib/WeBWorK/ContentGenerator/ProblemSet.pm
+++ lib/WeBWorK/ContentGenerator/ProblemSet.pm
@@ -28,8 +28,8 @@
use warnings;
use CGI qw(*ul *li);
use WeBWorK::PG;
-use WeBWorK::Timing;
use URI::Escape;
+use WeBWorK::Debug;
use WeBWorK::Utils qw(sortByName);
=20
sub initialize {
@@ -147,7 +147,7 @@
print CGI::start_ul();
=20
# FIXME: setIDs contain no info on published/unpublished so unpublished=
sets are still printed
- $WeBWorK::timer->continue("Begin printing sets from listUserSets()") if=
defined $WeBWorK::timer;
+ debug("Begin printing sets from listUserSets()");
foreach my $setID (@setIDs) {
my $setPage =3D $urlpath->newFromModule("WeBWorK::ContentGenerator::Pr=
oblemSet",
courseID =3D> $courseID, setID =3D> $setID);
@@ -157,17 +157,17 @@
}}, $setID)
) ;
}
- $WeBWorK::timer->continue("End printing sets from listUserSets()") if d=
efined $WeBWorK::timer;
+ debug("End printing sets from listUserSets()");
=20
# FIXME: when database calls are faster, this will get rid of unpublish=
ed sibling links
- #$WeBWorK::timer->continue("Begin printing sets from getMergedSets()") =
if defined $WeBWorK::timer;=09
+ #debug("Begin printing sets from getMergedSets()");=09
#my @userSetIDs =3D map {[$eUserID, $_]} @setIDs;
#my @sets =3D $db->getMergedSets(@userSetIDs);
#foreach my $set (@sets) {
# my $setPage =3D $urlpath->newFromModule("WeBWorK::ContentGenerator::P=
roblemSet", courseID =3D> $courseID, setID =3D> $set->set_id);
# print CGI::li(CGI::a({href=3D>$self->systemLink($setPage)}, $set->set=
_id)) unless !(defined $set && ($set->published || $authz->hasPermissions=
($user, "view_unpublished_sets"));
#}
- #$WeBWorK::timer->continue("Begin printing sets from getMergedSets()") =
if defined $WeBWorK::timer;
+ #debug("Begin printing sets from getMergedSets()");
=09
print CGI::end_ul();
print CGI::end_li();
Index: Hardcopy.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Hardc=
opy.pm,v
retrieving revision 1.57
retrieving revision 1.58
diff -Llib/WeBWorK/ContentGenerator/Hardcopy.pm -Llib/WeBWorK/ContentGene=
rator/Hardcopy.pm -u -r1.57 -r1.58
--- lib/WeBWorK/ContentGenerator/Hardcopy.pm
+++ lib/WeBWorK/ContentGenerator/Hardcopy.pm
@@ -43,12 +43,11 @@
use CGI qw();
use File::Path qw(rmtree);
use WeBWorK::Form;
+use WeBWorK::Debug;
use WeBWorK::PG;
use WeBWorK::Utils qw(readFile makeTempDirectory);
use Apache::Constants qw(:common REDIRECT);
=20
-our $HardcopyTimer =3D new WeBWorK::Timing if $WeBWorK::Timing::Enabled;
-
=3Dhead1 CONFIGURATION VARIABLES
=20
=3Dover
@@ -73,7 +72,8 @@
my $authz =3D $r->authz;
my $userID =3D $r->param("user");
=09
- $HardcopyTimer->start if $WeBWorK::Timing::Enabled;;
+ debug("begin hardcopy processing");
+=09
my $singleSet =3D $r->urlpath->arg("setID");
my @sets =3D $r->param("hcSet");
my @users =3D $r->param("hcUser");
@@ -188,19 +188,18 @@
sub body {
my ($self) =3D @_;
=09
- $HardcopyTimer->continue("Hardcopy: printing generation errors") if def=
ined($HardcopyTimer);
+ debug("Hardcopy: printing generation errors");
+=09
if ($self->{generationError}) {
if (ref $self->{generationError} eq "ARRAY") {
my ($disposition, @rest) =3D @{$self->{generationError}};
if ($disposition eq "PGFAIL") {
$self->multiErrorOutput(@{$self->{errors}});
- $HardcopyTimer->continue("Hardcopy: end printing generation errors")=
if defined($HardcopyTimer);
- $HardcopyTimer->save if defined($HardcopyTimer);
+ debug("Hardcopy: end printing generation errors");
return "";
} elsif ($disposition eq "FAIL") {
print $self->errorOutput(@rest);
- $HardcopyTimer->continue("Hardcopy: end printing generation errors")=
if defined($HardcopyTimer);
- $HardcopyTimer->save if defined($HardcopyTimer);
+ debug("Hardcopy: end printing generation errors");
return "";
} elsif ($disposition eq "RETRY") {
print $self->errorOutput(@rest);
@@ -209,13 +208,11 @@
}
} else {
# not something we were expecting...
- $HardcopyTimer->continue("Hardcopy: end printing generation errors") =
if defined($HardcopyTimer);
- $HardcopyTimer->save if defined($HardcopyTimer);
+ debug("Hardcopy: end printing generation errors");
die $self->{generationError};
}
}
- $HardcopyTimer->continue("Hardcopy: end printing generation errors") if=
defined($HardcopyTimer);
- $HardcopyTimer->save if defined($HardcopyTimer);
+ debug("Hardcopy: end printing generation errors");
=20
if (@{$self->{warnings}}) {
# FIXME: this code will only be reached if there was also a
@@ -454,9 +451,9 @@
my $pdfFileURL =3D undef;
if ($self->{hardcopy_format} eq 'pdf' ) {
my $errors =3D '';
- $HardcopyTimer->continue("begin latex2pdf") if defined($HardcopyTimer)=
;
+ debug("Hardcopy: format log file");
$pdfFileURL =3D eval { $self->latex2pdf($tex, $tempDir, $fileName) };
- $HardcopyTimer->continue("end latex2pdf") if defined($HardcopyTimer);
+ debug("end latex2pdf");
if ($@) {
$errors =3D $@;
#$errors =3D~ s/\n/<br>/g; # make this readable on HTML FIXME make t=
his a Utils. filter (Error2HTML)
@@ -581,12 +578,12 @@
if (-e $logFile) {
push @textErrorMessage , "pdflatex ran, but did not succeed. This sug=
gests an error in the TeX\n", CGI::br();
push @textErrorMessage , "version of one of the problems, or a proble=
m with the pdflatex system.\n",CGI::br();
- $HardcopyTimer->continue("Hardcopy: read log file") if defined($Hardc=
opyTimer);
+ debug("Hardcopy: read log file");
my $logFileContents =3D eval { readTexErrorLog($logFile) };
$logFileContents .=3D CGI::hr().CGI::hr();
- $HardcopyTimer->continue("Hardcopy: format log file") if defined($Har=
dcopyTimer);
+ debug("Hardcopy: format log file");
$logFileContents .=3D eval { formatTexFile($texFile) };
- $HardcopyTimer->continue("Hardcopy: end processing log file") if defi=
ned($HardcopyTimer);
+ debug("Hardcopy: end processing log file");
if ($@) {
push @textErrorMessage, "Additionally, the pdflatex log file could n=
ot be read, though it exists.\n", CGI::br();
} else {
@@ -745,7 +742,7 @@
}
=20
sub getProblemTeX {
- $HardcopyTimer ->continue("hardcopy: begin processing problem") if d=
efined($HardcopyTimer);
+ debug("hardcopy: begin processing problem");
my ($self, $effectiveUser, $setName, $problemNumber, $pgFile) =3D @_;
my $r =3D $self->r;
my $ce =3D $r->ce;
@@ -880,7 +877,7 @@
$pg->{body_text} .=3D $correctTeX;
}
}
- $HardcopyTimer ->continue("hardcopy: end processing problem") if define=
d($HardcopyTimer);
+ debug("hardcopy: end processing problem");
return $pg->{body_text};
}
=20
Index: Instructor.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instr=
uctor.pm,v
retrieving revision 1.48
retrieving revision 1.49
diff -Llib/WeBWorK/ContentGenerator/Instructor.pm -Llib/WeBWorK/ContentGe=
nerator/Instructor.pm -u -r1.48 -r1.49
--- lib/WeBWorK/ContentGenerator/Instructor.pm
+++ lib/WeBWorK/ContentGenerator/Instructor.pm
@@ -29,6 +29,7 @@
use CGI qw();
use File::Find;
use WeBWorK::DB::Utils qw(initializeUserProblem);
+use WeBWorK::Debug;
use WeBWorK::Utils;
=20
=3Dhead1 METHODS
@@ -286,13 +287,13 @@
my $db =3D $self->{db};
my @userIDs =3D $db->listUsers;
=20
- $WeBWorK::timer->continue("$setID: getting user list") if defined $WeBW=
orK::timer;
+ debug("$setID: getting user list");
my @userRecords =3D $db->getUsers(@userIDs);
- $WeBWorK::timer->continue("$setID: (done with that)") if defined $WeBWo=
rK::timer;
+ debug("$setID: (done with that)");
=09
- $WeBWorK::timer->continue("$setID: getting problem list") if defined $W=
eBWorK::timer;
+ debug("$setID: getting problem list");
my @GlobalProblems =3D grep { defined $_ } $db->getAllGlobalProblems($s=
etID);
- $WeBWorK::timer->continue("$setID: (done with that)") if defined $WeBWo=
rK::timer;
+ debug("$setID: (done with that)");
=09
my @results;
=09
@@ -302,20 +303,20 @@
my $userID =3D $User->user_id;
$UserSet->user_id($userID);
$UserSet->set_id($setID);
- $WeBWorK::timer->continue("$setID: adding UserSet for $userID") if def=
ined $WeBWorK::timer;
+ debug("$setID: adding UserSet for $userID");
eval { $db->addUserSet($UserSet) };
if ($@) {
next if $@ =3D~ m/user set exists/;
die $@;
}
- $WeBWorK::timer->continue("$setID: (done with that)") if defined $WeBW=
orK::timer;
+ debug("$setID: (done with that)");
=09
- $WeBWorK::timer->continue("$setID: adding UserProblems for $userID") i=
f defined $WeBWorK::timer;
+ debug("$setID: adding UserProblems for $userID");
foreach my $GlobalProblem (@GlobalProblems) {
my @result =3D $self->assignProblemToUser($userID, $GlobalProblem);
push @results, @result if @result;
}
- $WeBWorK::timer->continue("$setID: (done with that)") if defined $WeBW=
orK::timer;
+ debug("$setID: (done with that)");
}
=09
return @results;
Index: Grades.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Grade=
s.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -Llib/WeBWorK/ContentGenerator/Grades.pm -Llib/WeBWorK/ContentGenera=
tor/Grades.pm -u -r1.14 -r1.15
--- lib/WeBWorK/ContentGenerator/Grades.pm
+++ lib/WeBWorK/ContentGenerator/Grades.pm
@@ -27,9 +27,9 @@
use strict;
use warnings;
use CGI qw();
-use WeBWorK::Utils qw(readDirectory list2hash max);
+use WeBWorK::Debug;
use WeBWorK::DB::Record::Set;
-
+use WeBWorK::Utils qw(readDirectory list2hash max);
=20
sub initialize {
my ($self) =3D @_;
@@ -268,15 +268,15 @@
my $total =3D 0;
my $num_of_attempts =3D 0;
=09
- $WeBWorK::timer->continue("Begin collecting problems for set $setName"=
) if defined($WeBWorK::timer);
+ debug("Begin collecting problems for set $setName");
my @problemRecords =3D $db->getAllUserProblems( $studentName, $setName=
);
- $WeBWorK::timer->continue("End collecting problems for set $setName") =
if defined($WeBWorK::timer);
+ debug("End collecting problems for set $setName");
=09
# FIXME the following line doesn't sort the problemRecords
#my @problems =3D sort {$a <=3D> $b } map { $_->problem_id } @problemR=
ecords;
- $WeBWorK::timer->continue("Begin sorting problems for set $setName") i=
f defined($WeBWorK::timer);
+ debug("Begin sorting problems for set $setName");
@problemRecords =3D sort {$a->problem_id <=3D> $b->problem_id } @prob=
lemRecords;
- $WeBWorK::timer->continue("End sorting problems for set $setName") if =
defined($WeBWorK::timer);
+ debug("End sorting problems for set $setName");
my $num_of_problems =3D @problemRecords;
my $max_problems =3D defined($num_of_problems) ? $num_of_problems =
: 0;=20
=09
Index: UsersAssignedToSet.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instr=
uctor/UsersAssignedToSet.pm,v
retrieving revision 1.17
retrieving revision 1.18
diff -Llib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm -Lli=
b/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm -u -r1.17 -r1=
.18
--- lib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/UsersAssignedToSet.pm
@@ -27,6 +27,7 @@
use strict;
use warnings;
use CGI qw();
+use WeBWorK::Debug;
=20
sub initialize {
my ($self) =3D @_;
@@ -52,10 +53,10 @@
if ref $db->{set} eq "WeBWorK::DB::Schema::GlobalTableEmulator";
=20
if (defined $r->param('assignToAll')) {
- $WeBWorK::timer->continue("assignSetToAllUsers($setID)") if defined $W=
eBWorK::timer;
+ debug("assignSetToAllUsers($setID)");
$self->addmessage(CGI::div({class=3D>'ResultsWithoutError'}, "Problems=
have been assigned to all current users."));
$self->assignSetToAllUsers($setID);
- $WeBWorK::timer->continue("done assignSetToAllUsers($setID)") if defin=
ed $WeBWorK::timer;
+ debug("done assignSetToAllUsers($setID)");
} elsif (defined $r->param('unassignFromAll') and defined($r->param('un=
assignFromAllSafety')) and $r->param('unassignFromAllSafety')=3D=3D1) {
%selectedUsers =3D ( $globalUserID =3D> 1 );
$self->addmessage(CGI::div({class=3D>'ResultsWithoutError'}, "Problems=
for all students have been unassigned."));
@@ -76,9 +77,9 @@
foreach my $selectedUser (@users) {
if (exists $selectedUsers{$selectedUser}) {
unless ($setUsers{$selectedUser}) { # skip users already in the set
- $WeBWorK::timer->continue("assignSetToUser($selectedUser, ...)") if=
defined $WeBWorK::timer;
+ debug("assignSetToUser($selectedUser, ...)");
$self->assignSetToUser($selectedUser, $setRecord);
- $WeBWorK::timer->continue("done assignSetToUser($selectedUser, ...)=
") if defined $WeBWorK::timer;
+ debug("done assignSetToUser($selectedUser, ...)");
}
} else {
next if $selectedUser eq $globalUserID;
Index: Stats.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instr=
uctor/Stats.pm,v
retrieving revision 1.55
retrieving revision 1.56
diff -Llib/WeBWorK/ContentGenerator/Instructor/Stats.pm -Llib/WeBWorK/Con=
tentGenerator/Instructor/Stats.pm -u -r1.55 -r1.56
--- lib/WeBWorK/ContentGenerator/Instructor/Stats.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/Stats.pm
@@ -27,9 +27,11 @@
use strict;
use warnings;
use CGI qw();
-use WeBWorK::Utils qw(readDirectory list2hash max sortByName);
-use WeBWorK::DB::Record::Set;
+use WeBWorK::Debug;
use WeBWorK::ContentGenerator::Grades;
+use WeBWorK::DB::Record::Set;
+use WeBWorK::Utils qw(readDirectory list2hash max sortByName);
+
# The table format has been borrowed from the Grades.pm module
sub initialize {
my $self =3D shift;=20
@@ -300,10 +302,10 @@
=09
my $max_num_problems =3D 0;
# get user records
- $WeBWorK::timer->continue("Begin obtaining user records for set $setNam=
e") if defined($WeBWorK::timer);
+ debug("Begin obtaining problem records for user $student set $setName")=
;
my @userRecords =3D $db->getUsers(@studentList);
- $WeBWorK::timer->continue("End obtaining user records for set $setName"=
) if defined($WeBWorK::timer);
- $WeBWorK::timer->continue("begin main loop") if defined($WeBWorK::ti=
mer);
+ debug("End obtaining user records for set $setName");
+ debug("begin main loop");
my @augmentedUserRecords =3D ();
my $number_of_active_students;
=20
@@ -332,10 +334,10 @@
my %h_problemData =3D ();
my $probNum =3D 0;
=09
- $WeBWorK::timer->continue("Begin obtaining problem records for user $s=
tudent set $setName") if defined($WeBWorK::timer);
+ debug("Begin obtaining problem records for user $student set $setName"=
);
=09
my @problemRecords =3D sort {$a->problem_id <=3D> $b->problem_id } $db=
->getAllUserProblems( $student, $setName );
- $WeBWorK::timer->continue("End obtaining problem records for user $stu=
dent set $setName") if defined($WeBWorK::timer);
+ debug("End obtaining problem records for user $student set $setName");
my $num_of_problems =3D @problemRecords;
$max_num_problems =3D ($max_num_problems>=3D $num_of_problems) ? $max_=
num_problems : $num_of_problems;
########################################
@@ -459,7 +461,7 @@
push( @augmentedUserRecords, $temp_hash );
=20
}=09
- $WeBWorK::timer->continue("end mainloop") if defined($WeBWorK::timer);
+ debug("end mainloop");
=09
@augmentedUserRecords =3D sort { &$sort_method($a,$b)
||
Index: Scoring.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instr=
uctor/Scoring.pm,v
retrieving revision 1.48
retrieving revision 1.49
diff -Llib/WeBWorK/ContentGenerator/Instructor/Scoring.pm -Llib/WeBWorK/C=
ontentGenerator/Instructor/Scoring.pm -u -r1.48 -r1.49
--- lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/Scoring.pm
@@ -26,10 +26,9 @@
use strict;
use warnings;
use CGI qw();
+use WeBWorK::Debug;
use WeBWorK::Utils qw(readFile);
use WeBWorK::DB::Utils qw(initializeUserProblem);
-use WeBWorK::Timing;
-
=20
our @userInfoColumnHeadings =3D ("STUDENT ID", "login ID", "LAST NAME", =
"FIRST NAME", "SECTION", "RECITATION");
our @userInfoFields =3D ("student_id", "user_id","last_name", "first_nam=
e", "section", "recitation");
@@ -63,7 +62,7 @@
my $recordSingleSetScores =3D $r->param('recordSingleSetScores');
=09
# pre-fetch users
- $WeBWorK::timer->continue("pre-fetching users") if defined($WeBWorK::t=
imer);
+ debug("pre-fetching users");
my @Users =3D $db->getUsers($db->listUsers);
my %Users;
foreach my $User (@Users) {
@@ -80,7 +79,7 @@
=20
keys %Users;
#my @userInfo =3D (\%Users, \@sortedUserIDs);
- $WeBWorK::timer->continue("done pre-fetching users") if defined($WeBWo=
rK::timer);
+ debug("done pre-fetching users");
=09
my $scoringType =3D ($recordSingleSetScores) ?'everything':=
'totals';
my (@everything, @normal,@full,@info,@totalsColumn);
@@ -114,13 +113,9 @@
}=20
=09
# Obtaining list of sets:
- #$WeBWorK::timer->continue("Begin listing sets") if defined $WeBWorK::t=
imer;
my @setNames =3D $db->listGlobalSets();
- #$WeBWorK::timer->continue("End listing sets") if defined $WeBWorK::tim=
er;
my @set_records =3D ();
- #$WeBWorK::timer->continue("Begin obtaining sets") if defined $WeBWorK:=
:timer;
@set_records =3D $db->getGlobalSets( @setNames);=20
- #$WeBWorK::timer->continue("End obtaining sets: ".@set_records) if defi=
ned $WeBWorK::timer;
=09
=09
# store data
@@ -275,7 +270,6 @@
die "global set $setID not found. " unless $setRecord;
#my %users;
#my %userStudentID=3D();
- #$WeBWorK::timer->continue("Begin getting users for set $setID") if def=
ined($WeBWorK::timer);
#foreach my $userID ($db->listUsers()) {
# my $userRecord =3D $db->getUser($userID); # checked
# die "user record for $userID not found" unless $userID;
@@ -285,7 +279,6 @@
# $users{$userRecord->student_id} =3D $userRecord;
# $userStudentID{$userID} =3D $userRecord->student_id;
#}
- #$WeBWorK::timer->continue("End getting users for set $setID") if defin=
ed($WeBWorK::timer);=09
=09
my %Users =3D %$UsersRef; # user objects hashed on user ID
my @sortedUserIDs =3D @$sortedUserIDsRef; # user IDs sorted by student =
ID
@@ -372,13 +365,13 @@
return @scoringData if $format eq "info";
=09
# pre-fetch global problems
- $WeBWorK::timer->continue("pre-fetching global problems for set $setID"=
) if defined($WeBWorK::timer);
+ debug("pre-fetching global problems for set $setID");
my %GlobalProblems =3D map { $_->problem_id =3D> $_ }
$db->getAllGlobalProblems($setID);
- $WeBWorK::timer->continue("done pre-fetching global problems for set $s=
etID") if defined($WeBWorK::timer);
+ debug("done pre-fetching global problems for set $setID");
=09
# pre-fetch user problems
- $WeBWorK::timer->continue("pre-fetching user problems for set $setID") =
if defined($WeBWorK::timer);
+ debug("pre-fetching user problems for set $setID");
my %UserProblems; # $UserProblems{$userID}{$problemID}
=20
# Gateway change here: for non-gateway (non-versioned) sets, we just g=
et each user's
@@ -415,7 +408,7 @@
$UserProblems{$userID} =3D \%CurrUserProblems;
}
}
- $WeBWorK::timer->continue("done pre-fetching user problems for set $set=
ID") if defined($WeBWorK::timer);
+ debug("done pre-fetching user problems for set $setID");
=09
# Write the problem data
my $dueDateString =3D $self->formatDateTime($setRecord->due_date);
@@ -520,7 +513,7 @@
=20
}
}
- $WeBWorK::timer->continue("End set $setID") if defined($WeBWorK::timer=
);
+ debug("End set $setID");
return @scoringData;
}
=20
Index: StudentProgress.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instr=
uctor/StudentProgress.pm,v
retrieving revision 1.17
retrieving revision 1.18
diff -Llib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm -Llib/W=
eBWorK/ContentGenerator/Instructor/StudentProgress.pm -u -r1.17 -r1.18
--- lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/StudentProgress.pm
@@ -26,9 +26,10 @@
use strict;
use warnings;
use CGI qw();
-use WeBWorK::Utils qw(readDirectory list2hash max sortByName);
-use WeBWorK::DB::Record::Set;
+use WeBWorK::Debug;
use WeBWorK::ContentGenerator::Grades;
+use WeBWorK::DB::Record::Set;
+use WeBWorK::Utils qw(readDirectory list2hash max sortByName);
use WeBWorK::Utils::SortRecords qw/sortRecords/;
=20
=20
@@ -350,10 +351,10 @@
=09
my $max_num_problems =3D 0;
# get user records
- $WeBWorK::timer->continue("Begin obtaining user records for set $setNam=
e") if defined($WeBWorK::timer);
+ debug("Begin obtaining user records for set $setName");
my @userRecords =3D $db->getUsers(@studentList);
- $WeBWorK::timer->continue("End obtaining user records for set $setName"=
) if defined($WeBWorK::timer);
- $WeBWorK::timer->continue("begin main loop") if defined($WeBWorK::ti=
mer);
+ debug("End obtaining user records for set $setName");
+ debug("begin main loop");
my @augmentedUserRecords =3D ();
my $number_of_active_students;
=20
@@ -417,10 +418,10 @@
my %h_problemData =3D ();
my $probNum =3D 0;
=09
- $WeBWorK::timer->continue("Begin obtaining problem records for user $s=
tudent set $setName") if defined($WeBWorK::timer);
+ debug("Begin obtaining problem records for user $student set $setName"=
);
=09
my @problemRecords =3D sort {$a->problem_id <=3D> $b->problem_id } $db=
->getAllUserProblems( $student, $sN );
- $WeBWorK::timer->continue("End obtaining problem records for user $stu=
dent set $setName") if defined($WeBWorK::timer);
+ debug("End obtaining problem records for user $student set $setName");
my $num_of_problems =3D @problemRecords;
$max_num_problems =3D ($max_num_problems>=3D $num_of_problems) ? $max_=
num_problems : $num_of_problems;
########################################
@@ -628,7 +629,7 @@
=20
} # this closes the loop through all student records
=09
- $WeBWorK::timer->continue("end mainloop") if defined($WeBWorK::timer);
+ debug("end mainloop");
=09
@augmentedUserRecords =3D sort {
&$sort_method($a,$b,$primary_sort_method_name)
Index: SetsAssignedToUser.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instr=
uctor/SetsAssignedToUser.pm,v
retrieving revision 1.20
retrieving revision 1.21
diff -Llib/WeBWorK/ContentGenerator/Instructor/SetsAssignedToUser.pm -Lli=
b/WeBWorK/ContentGenerator/Instructor/SetsAssignedToUser.pm -u -r1.20 -r1=
.21
--- lib/WeBWorK/ContentGenerator/Instructor/SetsAssignedToUser.pm
+++ lib/WeBWorK/ContentGenerator/Instructor/SetsAssignedToUser.pm
@@ -27,6 +27,7 @@
use strict;
use warnings;
use CGI qw();
+use WeBWorK::Debug;
=20
sub initialize {
my ($self) =3D @_;
@@ -49,9 +50,9 @@
=09
if (defined $r->param("assignToAll")) {
$self->assignAllSetsToUser($userID);
- $WeBWorK::timer->continue("assignAllSetsToUser($userID)") if defined $=
WeBWorK::timer;
+ debug("assignAllSetsToUser($userID)");
$self->addmessage(CGI::div({class=3D>'ResultsWithoutError'}, "User has=
been assigned to all current sets."));
- $WeBWorK::timer->continue("done assignAllSetsToUsers($userID)") if def=
ined $WeBWorK::timer;
+ debug("done assignAllSetsToUsers($userID)");
} elsif (defined $r->param('unassignFromAll') and defined($r->param('un=
assignFromAllSafety')) and $r->param('unassignFromAllSafety')=3D=3D1) {
if ($userID ne $globalUserID) {
$self->addmessage(CGI::div({class=3D>'ResultsWithoutError'}, "User h=
as been unassigned from all sets."));
@@ -79,9 +80,9 @@
# does the user want it to be assigned to the selected user
if (exists $selectedSets{$setID}) {
unless ($userSets{$setID}) { # skip users already in the set
- $WeBWorK::timer->continue("assignSetToUser($userID, $setID)") if d=
efined $WeBWorK::timer;
+ debug("assignSetToUser($userID, $setID)");
$self->assignSetToUser($userID, $setRecord);
- $WeBWorK::timer->continue("done assignSetToUser($userID, $setID)")=
if defined $WeBWorK::timer;
+ debug("done assignSetToUser($userID, $setID)");
}
} else {
# user asked to NOT have the set assigned to the selected user
Index: ProblemSetList.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /webwork/cvs/system/webwork2/lib/WeBWorK/ContentGenerator/Instr=
uctor/ProblemSetList.pm,v
retrieving revision 1.83
retrieving revision 1.84
diff -Llib/WeBWorK/ContentGenerator/Instruc...
[truncated message content] |
|
From: dpvc v. a. <we...@ma...> - 2005-08-12 01:24:28
|
Log Message:
-----------
Removed erroneous dollar sign.
Modified Files:
--------------
pg/lib/Value:
WeBWorK.pm
Revision Data
-------------
Index: WeBWorK.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/WeBWorK.pm,v
retrieving revision 1.8
retrieving revision 1.9
diff -Llib/Value/WeBWorK.pm -Llib/Value/WeBWorK.pm -u -r1.8 -r1.9
--- lib/Value/WeBWorK.pm
+++ lib/Value/WeBWorK.pm
@@ -97,7 +97,7 @@
max_adapt => $ww->{functMaxConstantOfIntegration},
useBaseTenLog => $ww->{useBaseTenLog},
);
- $context->{format}{number} = $ww->{numFormatDefault} if $ww->{$numFormatDefault} ne '';
+ $context->{format}{number} = $ww->{numFormatDefault} if $ww->{numFormatDefault} ne '';
$context;
}
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-12 01:20:07
|
Log Message:
-----------
Added redefine() function to complement undefine() for various
Context() values. For example
Context()->operators->undefine('+');
makes '+' undefined, but
Context()->operators->redefine('+');
will put it back. You can specify a context from which to take the
redefinition, and a name in that context, as in
Context()->operators->redefine('U',from=>"Interval");
Context()->operators->redefine('u',from=>"Interval",using=>"U");
Context()->operators->redefine('U',from=>$content);
where $content is a reference to a Context object.
The undefine() function lets you undefine several items at once, as in
Context()->operators->undefine('+','-');
For redefine, you must put multiple names in square brackets because
of the optional parmeters:
Context()->operators->redefine(['+','-']);
Modified Files:
--------------
pg/lib/Parser/Context:
Functions.pm
Operators.pm
pg/lib/Value/Context:
Data.pm
Revision Data
-------------
Index: Functions.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Context/Functions.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -Llib/Parser/Context/Functions.pm -Llib/Parser/Context/Functions.pm -u -r1.6 -r1.7
--- lib/Parser/Context/Functions.pm
+++ lib/Parser/Context/Functions.pm
@@ -19,12 +19,31 @@
# Remove a function from the list by assigning it
# the undefined function. This means it will still
# be recognized by the parser, but will generate an
-# error message whenever it is used.
+# error message whenever it is used. The old class
+# is saved so that it can be redefined again.
#
sub undefine {
my $self = shift;
my @data = ();
- foreach my $x (@_) {push(@data,$x => {class => 'Parser::Function::undefined'})}
+ foreach my $x (@_) {
+ push(@data,$x => {
+ oldClass => $self->get($x)->{class},
+ class => 'Parser::Function::undefined',
+ });
+ }
+ $self->set(@data);
+}
+
+sub redefine {
+ my $self = shift; my $X = shift;
+ return $self->SUPER::redefine($X,@_) if scalar(@_) > 0;
+ $X = [$X] unless ref($X) eq 'ARRAY';
+ my @data = ();
+ foreach my $x (@{$X}) {
+ my $oldClass = $self->get($x)->{oldClass};
+ push(@data,$x => {class => $oldClass, oldClass => undef})
+ if $oldClass;
+ }
$self->set(@data);
}
@@ -71,6 +90,7 @@
sub enable {Enable(@_)}
sub Enable {
my $context = Parser::Context->current;
+ my $functions = $Parser::Context::Default::fullContext->{functions};
if (ref($_[0]) ne "") {$context = (shift)->{context}}
my @names = @_; my ($list,$name);
while ($name = shift(@names)) {
@@ -79,10 +99,8 @@
unless (defined($list)) {warn "Undefined function or category '$name'"; next}
if ($list->[0] eq '_alias_')
{unshift @names, @{$list}[1..scalar(@{$list})-1]; next}
- my @fn; foreach my $f (@{$list}) {
- push @fn, $f =>
- {class => $Parser::Context::Default::fullContext->{functions}{$f}{class}};
- }
+ my @fn; foreach my $f (@{$list})
+ {push @fn, $f => {class => $functions->{$f}{class}}}
$context->functions->set(@fn);
}
}
Index: Operators.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Context/Operators.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Llib/Parser/Context/Operators.pm -Llib/Parser/Context/Operators.pm -u -r1.3 -r1.4
--- lib/Parser/Context/Operators.pm
+++ lib/Parser/Context/Operators.pm
@@ -26,14 +26,33 @@
my @data = ();
foreach my $x (@_) {
if ($self->{context}{operators}{$x}{type} eq 'unary') {
- push(@data,$x => {class => 'Parser::UOP::undefined'});
+ push(@data,$x => {
+ class => 'Parser::UOP::undefined',
+ oldClass => $self->get($x)->{class},
+ });
} else {
- push(@data,$x => {class => 'Parser::BOP::undefined'});
+ push(@data,$x => {
+ class => 'Parser::BOP::undefined',
+ oldClass => $self->get($x)->{class},
+ });
}
}
$self->set(@data);
}
+sub redefine {
+ my $self = shift; my $X = shift;
+ return $self->SUPER::redefine($X,@_) if scalar(@_) > 0;
+ $X = [$X] unless ref($X) eq 'ARRAY';
+ my @data = ();
+ foreach my $x (@{$X}) {
+ my $oldClass = $self->get($x)->{oldClass};
+ push(@data,$x => {class => $oldClass, oldClass => undef})
+ if $oldClass;
+ }
+ $self->set(@data);
+}
+
#########################################################################
1;
Index: Data.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Value/Context/Data.pm,v
retrieving revision 1.6
retrieving revision 1.7
diff -Llib/Value/Context/Data.pm -Llib/Value/Context/Data.pm -u -r1.6 -r1.7
--- lib/Value/Context/Data.pm
+++ lib/Value/Context/Data.pm
@@ -142,6 +142,28 @@
#
sub undefine {my $self = shift; $self->remove(@_)}
+#
+# Redefine items from the default context, or a given one
+#
+sub redefine {
+ my $self = shift; my $X = shift;
+ my %options = (using => undef, from => "Full", @_);
+ my $Y = $options{using}; my $from = $options{from};
+ $from = $Parser::Context::Default::context{$from} unless ref($from);
+ $Y = $X if !defined($Y) && !ref($X);
+ $X = [$X] unless ref($X) eq 'ARRAY';
+ my @data = (); my @remove = ();
+ foreach my $x (@{$X}) {
+ my $y = defined($Y)? $Y: $x;
+ Value::Error("No definition for %s '%s' in the given context",$self->{name},$y)
+ unless $from->{$self->{dataName}}{$y};
+ push(@remove,$x) if $self->get($x);
+ push(@data,$x => $from->{$self->{dataName}}{$y});
+ }
+ $self->remove(@remove);
+ $self->add(@data);
+}
+
#
# Get hash for an item
|
|
From: dpvc v. a. <we...@ma...> - 2005-08-12 01:13:53
|
Log Message:
-----------
Fixed bug with missing fields in initialization.
Modified Files:
--------------
pg/lib/Parser/Context:
Parens.pm
Revision Data
-------------
Index: Parens.pm
===================================================================
RCS file: /webwork/cvs/system/pg/lib/Parser/Context/Parens.pm,v
retrieving revision 1.3
retrieving revision 1.4
diff -Llib/Parser/Context/Parens.pm -Llib/Parser/Context/Parens.pm -u -r1.3 -r1.4
--- lib/Parser/Context/Parens.pm
+++ lib/Parser/Context/Parens.pm
@@ -13,6 +13,8 @@
$self->{name} = 'parenthesis';
$self->{Name} = 'Parenthesis';
$self->{namePattern} = '[^\s]+';
+ $self->{open} = '^$';
+ $self->{close} = '^$';
}
#
|
2 messages has been excluded from this view by a project administrator.
