WeBWorK Main Forum

Answer checker for 'appropriate' precision

Answer checker for 'appropriate' precision

by Zak Zarychta -
Number of replies: 5

Below is an MWE that checks for appropriate numerical precision. This is achieved with the Math::SigFigs perl module. The same module will be able to be called in problem files to calculate to 'appropriate' numerical precision sums, and differences (to least dp), and, products and ratios (to least sf). It will also be possible to count significant figures and format numbers to a set number of significant figures from the output of perl math functions.

Caveat 

This is still a work in progress and doesn't have all the behaviour that I'd like. I also have not extensively tested the method. 

After installing the perl module Math::SigFigs with the advice found in this post  https://webwork.maa.org/moodle/mod/forum/discuss.php?d=8389 (with thanks to Glen Rice) I hacked together a custom answer checker. 

what the checker does:

Given an answer passed to the answer checker the student input will be graded correct if 

  • the correct answer ($correct from answerHash) and student answer ($student from answerHash) numerically match AND
  • the significant figures in the correct answer ($correct in the answer hash) and the entered student string ($ansHash->{original_student_ans} from the answer hash) also numerically match.

Test cases:

 for 1.23456789876548 that is rounded to 5 dp using sprintf and passed to the answer checker 

Desired behaviour

  • 1.23457 is graded correct.
  • 1.234570 is graded incorrect with the custom message. "Your answer should be expressed to the 'appropriate' numerical precision".
  • 123457E-5 is graded correct.
  • 123457.0E-5 is graded incorrect with the custom message.
  • 0.0000123457E5 is graded correct.
  • 0.00001234570E5 is graded incorrect with the custom message.

Undesired behaviour - these are mathematically correct but are graded incorrect with the custom message.

  • 123457 * 10^-5
  • 123457 * 10**-5 
  • 0.0000123457*10^5
  • 0.0000123457*10**5 

Clearly in a future iteration it would be nice to correct the undesired behaviour stated above. I've a feeling that it has something to do with how WeBWorK parses the number by using regex similar to the discussion in advanced contexts linked below? Maybe someone could enlighten me on this. 

AFAIK the answer checker will only be useful to the WeBWorK default tolerance which I think is 5 decimal places. This can be increased with the Context()->{format}{number} in the MWE below. I haven't tested this to its limit but I think that it would be 15 dp from what I've read about how perl treats floating point arithmetic. More about Context()->{format}{number} here

https://webwork.maa.org/wiki/Modifying_Contexts_(advanced)#:~:text=The%20format%20is%20determined%20by,g%20%2C%20possibly%20followed%20by%20%23%20.

Please if anyone spots further bugs/undesired behaviour or has some useful suggestions or changes on how to improve this method please let me know. Or better still if you have the time, write the bug fix or improvement in, and post on this thread.

#######################################################################################################

DOCUMENT();
loadMacros(
"PGstandard.pl",
"MathObjects.pl"
);
TEXT(beginproblem());
Context("Numeric");
#Context()->{format}{number} = "%.5f";
$val = 1.23456789876548;
$prec = 5;
$ans = Real(sprintf("%.${prec}f", $val));
ANS( Real($ans)->cmp(
	(checker=>sub {
	    ($correct, $student, $ansHash) = @_;
	    $correct_sf = Math::SigFigs::CountSigFigs($correct);
	    $student_sf = Math::SigFigs::CountSigFigs($ansHash->{original_student_ans});
	    Value->Error("Your answer should be expressed to the 'appropriate' numerical precision") if (($correct == $student) && ($correct_sf  != $student_sf));
        return (($correct == $student) && ($correct_sf  == $student_sf) ? 1 : 0)
        }),
    ) 
);
Context()->texStrings;
BEGIN_TEXT
$PAR
express $val to $prec dp \{ ans_rule(25) \}
$PAR
ans = $ans
END_TEXT
Context()->normalStrings;
$showPartialCorrectAnswers = 1;
ENDDOCUMENT();
In reply to Zak Zarychta

Re: Answer checker for 'appropriate' precision

by Zak Zarychta -

Hi all,

below is an improved method from the above for arithmetically calculating products, ratios, sums and differences to appropriate numerical precision

This currently works to the perl limit of 16 digits.

The method is 'hacky' and I would welcome any suggestions for improvements.

Also, let me know if you spot a mistake in the method or bug in use.

Zak


DOCUMENT();
loadMacros(
"PGstandard.pl",
"MathObjects.pl"
);
sub log10 {
    my $n = shift;
    my $log10 = log($n)/log(10); 
	return $log10;
  }
sub pow {
	my $n = shift;
	if	( abs($n)  >  1 ) {
		$pow = int(log10(abs($n)));
		} else {
		$pow = int(log10(abs($n)) - 1);
		}
	return($pow);
	}
sub countDP {
	my $n = shift;
	my $sf = Math::SigFigs::CountSigFigs($n);
	my $pow = pow($n);
	my $dp = $sf - $pow - 1;
	return($dp);
	}
 
TEXT(beginproblem());
Context()->flags->set(
  zeroLevel    => 1E-12,
  zeroLevelTol => 1E-10
  );
  
Context("Numeric");
$n1E3 = random (0,9);
$n1E2 = random (0,9);
$n1E1 = random (0,9);
$n1E0 = random (0,9);
$n1Em1 = random (0,9);
$n1Em2 = random (0,9);
$n1Em3 = random (0,9);
$n1Em4 = random (0,9);
$n1Em5 = random (0,9);
$n1Em6 = random (0,9);
$n1Em7 = random (0,9);
$n1Em8 = random (0,9);
$n1Em9 = random (0,9);
$n1Em10 = random (0,9);
$n1Em11 = random (0,9);
$n1Em12 = random (0,9);
$n1 = $n1E3*10**3 + $n1E2*10**2 + $n1E1*10**1 + $n1E0*10**0 + $n1Em1*10**(-1) + $n1Em1*10**(-1) + $n1Em2*10**(-2) + $n1Em3*10**(-3) + 
$n1Em4*10**(-4) + $n1Em5*10**(-5) + $n1Em6*10**(-6) + $n1Em7*10**(-7) + $n1Em7*10**(-7) + $n1Em8*10**(-8) + $n1Em9*10**(-9) + 
$n1Em10*10**(-10) + $n1Em11*10**(-11) + $n1Em9*10**(-12);
$n2E3 = random (0,9);
$n2E2 = random (0,9);
$n2E1 = random (0,9);
$n2E0 = random (0,9);
$n2Em1 = random (0,9);
$n2Em2 = random (0,9);
$n2Em3 = random (0,9);
$n2Em4 = random (0,9);
$n2Em5 = random (0,9);
$n2Em6 = random (0,9);
$n2Em7 = random (0,9);
$n2Em8 = random (0,9);
$n2Em9 = random (0,9);
$n2Em10 = random (0,9);
$n2Em11 = random (0,9);
$n2Em12 = random (0,9);
$n2 = $n2E3*10**3 + $n2E2*10**2 + $n2E1*10**1 + $n2E0*10**0 + $n2Em1*10**(-1) + $n2Em1*10**(-1) + $n2Em2*10**(-2) + $n2Em3*10**(-3) + 
$n2Em4*10**(-4) + $n2Em5*10**(-5) + $n2Em6*10**(-6) + $n2Em7*10**(-7) + $n2Em7*10**(-7) + $n2Em8*10**(-8) + $n2Em9*10**(-9) + 
$n2Em10*10**(-10) + $n2Em11*10**(-11) + $n2Em9*10**(-12);
$p1 = 0; $p2 = 0;
while($p1 == $p2){
    $p1 = random(1,12);
    $p2 = random(1,12);
}
$num1 = (sprintf("%.${p1}f", $n1));
$num2 = (sprintf("%.${p2}f", $n2));
#$num1 = (sprintf("%.12f", $n1));
#$num2 = (sprintf("%.12f", $n2));
#calculate answer to appropriate precision
$ans = Math::SigFigs::divSF($num1,$num2);
# count the decimal places in the answer that will be passed to the answer checker
$ansDP = countDP($ans);

#adjust the display precision in line with the calculated answer.
(Context()->{format}{number} = "%.${ansDP}f");
# Custom answer checker
#	compares $correct (formatted correct answer from $ans) with $student (student entered answer) AND
#	numerical precision or $correct with $student
ANS( Compute($ans)->cmp(
		#adjust tolerance to that of the calculated answer
        (tolType => "absolute", tolerance => 0.5*10**-$ansDP),
    	(checker=>sub {
	    ($correct, $student, $ansHash) = @_;
	    $correct_sf = Math::SigFigs::CountSigFigs($correct);
	    $student_sf = Math::SigFigs::CountSigFigs($ansHash->{original_student_ans});
        Value->Error("Your answer should be expressed to the 'appropriate' numerical precision") if (($correct == $student) && ($correct_sf  != $student_sf));
        return (($correct == $student) && ($correct_sf  == $student_sf) ? 1 : 0)
        }),
    ) 
);

Context()->texStrings;
BEGIN_TEXT
$PAR
Calculate $num1 / $num2 to the correct numerical precision
$BR
\{ ans_rule(25) \}
$PAR
ans = $ans
END_TEXT
Context()->normalStrings;
$showPartialCorrectAnswers = 1;

ENDDOCUMENT();

In reply to Zak Zarychta

Re: Answer checker for 'appropriate' precision

by Steven Fiedler -
Hi Zak,
This is an adaption of code I developed to tackle a somewhat similar task. The routines on top can of course be offloaded into a macro if desired. I personally like keeping the answer checker routine in the main pg problem as it permits one to tune the partial credit.

DOCUMENT();
loadMacros("PGstandard.pl","PGML.pl");

Context("LimitedNumeric");

sub addSF{
  my $n1=shift;  my $n2=shift;
  return Math::SigFigs::addSF($n1,$n2);
}

sub subSF{
  my $n1=shift;  my $n2=shift;
  return Math::SigFigs::subSF($n1,$n2);
}

sub multSF{
  my $n1=shift;  my $n2=shift;
  return Math::SigFigs::multSF($n1,$n2);
}

sub divSF{
  my $n1=shift;  my $n2=shift;
  return Math::SigFigs::divSF($n1,$n2);
}

sub CountSigFigs{
  my $num=shift;
  return Math::SigFigs::CountSigFigs($num);
}


$num1="1.2000";
$num2="2345.00";
$add_ans=addSF($num1,$num2);
$sub_ans=subSF($num1,$num2);
$mult_ans=multSF($num1,$num2);
$div_ans=divSF($num1,$num2);

BEGIN_PGML
[$num1] + [$num2] = [___]  [``\hspace{1em}``] The answer is [$add_ans]

[$num1] - [$num2] = [___]  [``\hspace{1em}``] The answer is [$sub_ans]

[$num1] * [$num2] = [___]  [``\hspace{1em}``] The answer is [$mult_ans]

[$num1] / [$num2] = [___]  [``\hspace{1em}``] The answer is [$div_ans]
END_PGML

chk_ans($add_ans);
chk_ans($sub_ans);
chk_ans($mult_ans);
chk_ans($div_ans);


sub chk_ans{
  my $ans=shift;
  $ans->{correct_ans_latex_string}=$ans;
  ANS(Real($ans)->cmp(checker=> sub {  
    my ($cdum,$student,$ansHash) = @_;
    my $orig_sval = $ansHash->{original_student_ans};
    my $orig_cval=$ans->{correct_ans_latex_string};
    $correct=Real($orig_cval);
    $ansHash->{student_ans} = $orig_sval; #The "Entered" column
    $ansHash->{preview_latex_string}=$orig_sval; #The "Preview" column
    $ansHash->{preview_text_string} = $orig_sval;  #"Answer Preview" popup
    if($student == $correct){
        $nsf_sval=CountSigFigs($orig_sval);  #num sig figs in $sval
        $nsf_corr = CountSigFigs($orig_cval);#Num sigfigs in corr_string
        if($nsf_sval==$nsf_corr) { $ansHash->{score} = 1;  }
        else{
          $ansHash->{ans_message}="Incorrect number of sig figs.";
          $ansHash->{score} = 0.5;
        }#end else
    }#endif $student==$correct
        
    return $ansHash->{score};

    }#end ANS sub{}
   ) #end cmp()
); #end ANS()

}

ENDDOCUMENT();
In reply to Steven Fiedler

Re: Answer checker for 'appropriate' precision

by Zak Zarychta -
Steven,
thanks for your input! Nice to know there's some convergent thinking about this.
By any chance does your method work with numbers expressed like A*10**n or A*10*^n

For example,
for the sum 3.05211 + 1.852 = 4.904 (to 3 d.p.)
my method will accept 4.904E0, 0.4904E1 etc
and correctly reject 4.9040, 0.49040E1
However, it will not accept 4.904*10**0, 4.904*10^0, 0.4904*10**1 or 0.4904*10^1
In reply to Zak Zarychta

Re: Answer checker for 'appropriate' precision

by Steven Fiedler -
Sorry about the delay, I've been ill.

The behavior you are observing is likely due to the input accepted by the Math::SigFigs module itself. This can be checked by directly running a small perl script on directly on your computer or VM. Below is one example, followed by the output. Both the carrot and double asterisk notation return absent values.

As a work-around, I suppose you could use regex to parse the original_student_ans value to search and replace the carrot and double asterisk symbols.

Program: prog.pl
--------------------------------------
use Math::SigFigs qw(:all);

$n1="2.34E3";
$n2="1.1";
$n3="4.56*10^2";
$n4="4.56*10**2";
$nsf1=CountSigFigs($n1);
print "$n1 has $nsf1 sig figs\n";
$sum12=addSF($n1,$n2);
print "$n1 + $n2 is $sum12\n\n";


$nsf3=CountSigFigs($n3);
print "$n3 has $nsf3 sig figs\n";
$sum23=addSF($n2,$n3);
print "$n2 + $n3 is $sum23\n\n";

$nsf4=CountSigFigs($n4);
print "$n4 has $nsf4 sig figs\n";
$sum24=addSF($n2,$n4);
print "$n2 + $n4 is $sum24\n\n";

Output
----------
$ perl ./prog.pl
2.34E3 has 3 sig figs
2.34E3 + 1.1 is 2340

4.56*10^2 has sig figs
1.1 + 4.56*10^2 is

4.56*10**2 has sig figs
1.1 + 4.56*10**2 is
In reply to Steven Fiedler

Re: Answer checker for 'appropriate' precision

by Steven Fiedler -
To head off student frustration, I modified my earlier code to convert student answers written in scientific notation from the double asterisk and caret format to the "E" format. This was accomplished by adding an answer prefilter, which calls a subroutine containing a couple simple regex expressions. Such an approach now also permits these sig fig type problems to use a Limited Numeric context, which is useful to disallow trivial solutions from cutting and pasting the original problem, as well as filtering extraneous non-numeric input. Below is the code and screenshot.

Steven

DOCUMENT();
loadMacros("PGstandard.pl","PGML.pl");

Context("LimitedNumeric");

sub addSF{
my ($n1,$n2)=@_;
return Math::SigFigs::addSF($n1,$n2);
}

sub subSF{
my ($n1,$n2)=@_;
return Math::SigFigs::subSF($n1,$n2);
}

sub multSF{
my ($n1,$n2)=@_;
return Math::SigFigs::multSF($n1,$n2);
}

sub divSF{
my ($n1,$n2)=@_;
return Math::SigFigs::divSF($n1,$n2);
}

sub CountSigFigs{
my $num=shift;
return Math::SigFigs::CountSigFigs($num);
}

sub sci_notation{
my $number = shift;
$number =~ s/(~~*10~~*~~*)/E/;
$number =~ s/(~~*10~~^)/E/;

return $number;
}

$num1="1.2000";
$num2="2345.00";
$add_ans=addSF($num1,$num2);
$sub_ans=subSF($num1,$num2);
$mult_ans=multSF($num1,$num2);
$div_ans=divSF($num1,$num2);

BEGIN_PGML
[$num1] + [$num2] = [___] [``\hspace{1em}``] The answer is [$add_ans]

[$num1] - [$num2] = [___] [``\hspace{1em}``] The answer is [$sub_ans]

[$num1] * [$num2] = [___] [``\hspace{1em}``] The answer is [$mult_ans]

[$num1] / [$num2] = [___] [``\hspace{1em}``] The answer is [$div_ans]
END_PGML

chk_ans($add_ans);
chk_ans($sub_ans);
chk_ans($mult_ans);
chk_ans($div_ans);


sub chk_ans{
#Subroutine used to capture nontruncated correct values
my $ans=shift;
$ans->{correct_ans_latex_string}=$ans;

ANS(Real($ans)->cmp(checker=> sub {
my ($correct,$student,$ansHash) = @_;
my $orig_sval = $ansHash->{original_student_ans};
$orig_sval=sci_notation($orig_sval); #Converts numbers to "E" format

$student=Real($orig_sval);
my $orig_cval=$ans->{correct_ans_latex_string};
$ansHash->{student_ans} = $orig_sval; #The "Entered" column
$ansHash->{preview_latex_string}=$orig_sval; #The "Preview" column
$ansHash->{preview_text_string} = $orig_sval; #"Answer Preview" popup
if($student == $correct){
$nsf_sval=CountSigFigs($orig_sval); #num sig figs in $sval
$nsf_corr = CountSigFigs($orig_cval);#Num sigfigs in corr_string
if($nsf_sval==$nsf_corr) { $ansHash->{score} = 1; }
else{
$ansHash->{ans_message}="Incorrect number of sig figs.";
$ansHash->{score} = 0.5;
}#end else
}#endif $student==$correct

return $ansHash->{score};

}#end ANS sub{}
) #end cmp()
->withPreFilter(
#Prefilter used to capture student answer and convert numbers
# written in scientific notation to "E" format. This permits the use
# of the Limited Numeric context
sub{
my $ans=shift;
$tmp=$ans->{student_ans};
$ans->{student_ans} = sci_notation($tmp);
return $ans;
}

)
); #end ANS()

}#end sub chk_ans

ENDDOCUMENT();


Attachment Screenshot_2024-01-10_17-04-28am.png