--- loncom/homework/default_homework.lcpm	2006/09/29 20:55:33	1.116
+++ loncom/homework/default_homework.lcpm	2006/09/29 23:10:22	1.117
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA 
 # used by lonxml::xmlparse() as input variable $safeinit to Apache::run::run()
 #
-# $Id: default_homework.lcpm,v 1.116 2006/09/29 20:55:33 albertel Exp $
+# $Id: default_homework.lcpm,v 1.117 2006/09/29 23:10:22 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -58,7 +58,7 @@ use strict;
     sub get_next_permutation {
 	if ($num_left == $total) {
 	    $num_left--;
-	    return @order;
+	    return \@order;
 	}
 
 	# Find largest index j with a[j] < a[j+1]
@@ -92,7 +92,7 @@ use strict;
 	}
 
 	$num_left--;
-	return(@order);
+	return(\@order);
     }
     
     sub get_permutations_left {
@@ -126,6 +126,7 @@ sub check_commas {
     return 1;
 }
 
+
 sub caparesponse_check {
     my ($answer,$response)=@_;
     #not properly used yet: calc
@@ -151,10 +152,10 @@ sub caparesponse_check {
     }
     if ($response=~ /^\s|\s$/) {
 	$response=~ s:^\s+|\s+$::g;
-	&LONCAPA_INTENAL_DEBUG("Removed ws now :$response:");
+	#&LONCAPA_INTERNAL_DEBUG("Removed ws now :$response:");
     }
 
-    &LONCAPA_INTERNAL_DEBUG(" type is $type ");
+    #&LONCAPA_INTERNAL_DEBUG(" type is $type ");
     if ($type eq 'cs' || $type eq 'ci') {
 	#for string answers make surec all places spaces occur, there is 
         #really only 1 space, in both the answer and the response
@@ -165,7 +166,7 @@ sub caparesponse_check {
 	$response=~s/[\s,]//g;
     }
     if ($type eq 'float' && $unit=~/\$/) {
-	if ($response!~/^\$/)  { return "NO_UNIT: Missing \$ "; }
+	if ($response!~/^\$/)  { return ('NO_UNIT', undef); }
 	$response=~s/\$//g;
     }
     if ($type eq 'float' && $unit=~/\,/ && (&check_commas($response)<0)) {
@@ -175,10 +176,10 @@ sub caparesponse_check {
     $unit=~s/[\$,]//g;
     if ($type eq 'float') { $response=~s/,//g; }
 
-    if (length($response) > 500) { return "TOO_LONG: Answer too long"; }
+    if (length($response) > 500) { return ('TOO_LONG',undef); }
 
     if ($type eq '' ) {
-	&LONCAPA_INTERNAL_DEBUG("Didn't find a type :$type: defaulting");
+	#&LONCAPA_INTERNAL_DEBUG("Didn't find a type :$type: defaulting");
 	if ( $answer eq ($answer *1.0)) { $type = 2;
 				      } else { $type = 3; }
     } else {
@@ -190,7 +191,7 @@ sub caparesponse_check {
 	elsif ($type eq 'subj')  { $type = 7; }
 	elsif ($type eq 'float') { $type = 2; }
 	elsif ($type eq 'int')   { $type = 1; }
-	else { return "ERROR: Unknown type of answer: $type" }
+	else { return ('ERROR', "Unknown type of answer: $type") }
     }
 
     my $points;
@@ -198,7 +199,7 @@ sub caparesponse_check {
     #formula type setup the sample points
     if ($type eq '8') {
 	($id_list,$points)=split(/@/,$samples);
-	&LONCAPA_INTERNAL_DEBUG("Found :$id_list:$points: points in $samples");
+	#&LONCAPA_INTERNAL_DEBUG("Found :$id_list:$points: points in $samples");
     }
     if ($tol eq '') {
 	$tol=0.0;
@@ -250,7 +251,8 @@ sub caparesponse_check {
     elsif ($result =='15') { $result='UNIT_IRRECONCIBLE'; }
     else  {$result = "ERROR: Unknown Result:$result:$@:";}
 
-    &LONCAPA_INTERNAL_DEBUG("RetError $reterror: Answer $answer: Response $response:  type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|",$reterror);
+    #&LONCAPA_INTERNAL_DEBUG("RetError $reterror: Answer $answer: Response $response:  type-$type|$tol|$tol_type|$sig:$sig_lbound:$sig_ubound|$unit|");
+    #&LONCAPA_INTERNAL_DEBUG(" $answer $response $result ");
     return ($result,$reterror)
 }
 
@@ -321,43 +323,57 @@ sub caparesponse_check_list {
     &LONCAPA_INTERNAL_DEBUG("Final final response :$responselist['-1']:$unit:");
     $unit=~s/\s//;
 
-    #&reset_caparesponse_memoization();
+    foreach my $thisanswer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) {
+	if (!defined($thisanswer)) {
+	    return ('ERROR','answer was undefined');
+	}
+    }
+
+    if ($unit ne '') {
+	foreach my $response (@responselist) {
+	    $response .= " $unit";
+	}
+    }
+
+    my %memoized;
+    if ($LONCAPA::CAPAresponse_answer->{'type'}  eq 'ordered') {
+	for (my $i=0; $i<scalar(@responselist);$i++) {
+	    my $answer   = $LONCAPA::CAPAresponse_answer->{'answers'}[$i];
+	    my $response = $responselist[$i];
+	    my $key = "$answer\0$response";
+	    $memoized{$key} = [&caparesponse_check($answer, $response)];
+	}
+    } else {
+	foreach my $response (@responselist) {
+	    foreach my $answer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) {
+		my $key = "$answer\0$response";
+		$memoized{$key} = [&caparesponse_check($answer, $response)];
+	    }
+	}
+    }
+
     my ($final_award,$final_msg);
     &init_permutation(scalar(@responselist),
 		      $LONCAPA::CAPAresponse_answer->{'type'});
+
+    my (@final_awards,@final_msg);
     while( &get_permutations_left() ) {
-	my @responses_ordered = @responselist[&get_next_permutation()];
+	my $order = &get_next_permutation();
 	my (@awards, @msgs, $i);
 	foreach my $thisanswer (@{ $LONCAPA::CAPAresponse_answer->{'answers'} }) {
-	    my ($msg,$aresult);
-	    if (defined($thisanswer)) {
-		my $response = $responses_ordered[$i];
-		if ($unit eq '') {
-		    $response .= " $unit";
-		}
-		($aresult,$msg)=&caparesponse_check($thisanswer,$response);
-	    } else {
-		$aresult='ERROR';
-		$msg='answer was undefined';
-	    }
-	    #&LONCAPA_INTERNAL_DEBUG("after if $aresult -- $msg");
-	    my ($temp)=split(/:/, $aresult);
-	    push(@awards,$temp);
-	    push(@msgs,$msg);
+	    my $key = "$thisanswer\0".$responselist[$order->[$i]];
+	    push(@awards,$memoized{$key}[0]);
+	    push(@msgs,$memoized{$key}[1]);
 	    $i++;
 	}
 	my ($possible_award,$possible_msg) = 
 	    &LONCAPA_INTERNAL_FINALIZEAWARDS(\@awards,\@msgs);
-	if ($final_award) {
-	    ($final_award,$final_msg) = 
-		&LONCAPA_INTERNAL_FINALIZEAWARDS([$final_award,$possible_award],
-						 [$final_msg,$possible_msg],
-						 undef,1);
-	} else {
-	    ($final_award,$final_msg) = ($possible_award,$possible_msg);
-	}
+	push(@final_awards,$possible_award);
+	push(@final_msg,$possible_msg);
     }
-    #&reset_caparesponse_memoization();
+
+    my ($final_award,$final_msg) = 
+	&LONCAPA_INTERNAL_FINALIZEAWARDS(\@final_awards,\@final_msg,undef,1);
     return ($final_award,$final_msg);
 }