# Sample of giving partial credit for a "checkbox_multiple_choice" question
# using answerHints.pl. It will not give partial credit when no box is marked.

# Code by Nathan Wallach taniwallach@gmail.com, tani@technion.ac.il

DOCUMENT();

loadMacros(
  "PGstandard.pl",
  "PGchoicemacros.pl",
  "answerHints.pl",
);

TEXT(beginproblem());

$mc1 = new_checkbox_multiple_choice();

# The correct answer strings:
#   In this sample problem, there are 3 correct answers.
$mc1->qa ("",
    "Correct 1 \( b^2 + a^2 \)",
    "Correct 2 \( (a+b)^2 - 2ab \)",
    "Correct 3 \( (a-b)^2 + 2ab \)",
);

# Incorrect answers to show:
#   In this sample problem, there are 5 incorrect answers.
$mc1->extra(
    "Incorrect 1 \( (a+b)^2 \)",
    "Incorrect 2 \( (a-b)^2 \)",
    "Incorrect 3 \( (a+b)^2 + 2ab \)",
    "Incorrect 4 \( (a-b)^2 - 2ab \)",
    "Incorrect 5 \( a + b \)",
);

# ===============================================================

BEGIN_TEXT

Let \( a,b \in \mathbb{R} \).
Select all expressions below which are equivalent to
\( a^2 + b^2 \).

$PAR

\{ $mc1->print_a() \}

$PAR

Partial credit is given, except when no boxes are marked.

END_TEXT

ANS( checkbox_cmp( $mc1->correct_ans() )->withPostFilter(sub { 
  my $ans = shift; 

  # ======================================================

  # Settings - fix by hand according to the problem

    # number of total "items" (checkboxes)
    my $numItems = 8;

    # Credit for correct answers which the student marked:
    $pointsForCorrectAndMarked = (1.0 / $numItems);

    # Credit for incorrect answers which the student did not mark:
    $pointsForIncorrectAndUnmarked = (1.0 / $numItems);

    # The two types of credit need to be equal, but should be set so a
    # fully correct answer earns a total of 1.0 "points" (100%).

    # Sample alternate values for this sample problem
    $pointsForCorrectAndMarked = 0.3;
    $pointsForIncorrectAndUnmarked = 0.02;

  # ======================================================

  # I could not get this approach to give partial credit when nothing is marked

  # As such, you may want to consider also not giving partial credit
  # when all answers are marked.

  # This can be done by responding appropriately for the answer string for all
  # answers marked, as in the sample below (8 answers).

#  # So we are also not giving partial credit if everything is marked
#  if ( $ans->{student_ans} eq "ABCDEFGH" ) {
#    return $ans;
#  }

  my @stud_chars = split //, $ans->{student_ans};
  my @corr_chars = split //, $ans->{correct_ans};
  my @only_corr = ();
  my @only_stud = ();
  my @both = ();
  while ( scalar(@stud_chars) > 0 && scalar(@corr_chars) > 0 ) {
    $first_s = ord( $stud_chars[0] );
    $first_c = ord( $corr_chars[0] );
    if ( $first_s == $first_c ) {
      push( @both, shift( @stud_chars ) );
      shift( @corr_chars );
    } elsif ( $first_s < $first_c ) {
      push( @only_stud, shift( @stud_chars ) );
    } else {
      push( @only_corr, shift( @corr_chars ) );
    }
  }
  @only_stud = ( @only_stud, @stud_chars);
  @only_corr = ( @only_corr, @corr_chars);

  @stud_chars = split //, $ans->{student_ans};
  @corr_chars = split //, $ans->{correct_ans};

  $ans->{score}  = $pointsForCorrectAndMarked * scalar( @both ); # These were marked and are correct
    # so earn credit by $pointsForCorrectAndMarked

  my $unmarked_and_incorrect = $numItems - scalar( @both ) - scalar( @only_stud ) - scalar( @only_corr );
  $ans->{score} += $pointsForIncorrectAndUnmarked * $unmarked_and_incorrect; # These were NOT marked and should not be
    # so earn credit by $pointsForIncorrectAndUnmarked

  my $debugOn = 0; # change to 1 to get the debug message

  if ( $debugOn ) {
    unless( @only_stud ) { push( @only_stud, "*none*" ); }
    unless( @only_corr ) { push( @only_corr, "*none*" ); }
    unless( @both ) { push( @both, "*none*" ); }
    unless( @stud_chars ) { push( @stud_chars, "*none*" ); }
    unless( @corr_chars ) { push( @corr_chars, "*none*" ); }

    # For debugging
    $ans->{ans_message} = 
             "student marked: "           . join(",",@stud_chars) . " (" . (0 + @stud_chars) . " answers)"
      . "${BR}correct answers: "          . join(",",@corr_chars) . " (" . (0 + @corr_chars) . " answers)"
      . "${BR}both: "                     . join(",",@both)       . " (" . (0 + @both)       . " answers)"
      . "${BR}only student: "             . join(",",@only_stud)  . " (" . (0 + @only_stud)  . " answers)"
      . "${BR}only correct: "             . join(",",@only_corr)  . " (" . (0 + @only_corr)  . " answers)"
      . "${BR}# unmarked and incorrect: $unmarked_and_incorrect answers";
  }

  return $ans; 
}) );

ENDDOCUMENT();