Diff for /loncom/homework/grades.pm between versions 1.268 and 1.269

version 1.268, 2005/05/26 21:26:24 version 1.269, 2005/06/03 18:23:19
Line 152  sub get_display_part { Line 152  sub get_display_part {
     }      }
     return $display;      return $display;
 }  }
   
 #--- Show resource title  #--- Show resource title
 #--- and parts and response type  #--- and parts and response type
 sub showResourceInfo {  sub showResourceInfo {
Line 1351  sub gradeBox { Line 1352  sub gradeBox {
     my $result='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n";      my $result='<input type="hidden" name="WGT'.$counter.'_'.$partid.'" value="'.$wgt.'" />'."\n";
   
     my $display_part=&get_display_part($partid,undef,$symb);      my $display_part=&get_display_part($partid,undef,$symb);
       my @partids = ("$partid");
       my %last_resets = ();
       &get_last_resets($symb,$env{'request.course.id'},\%last_resets,\@partids);
       my $aggtries;
       if ($last_resets{$partid}) {
           $aggtries = &get_num_tries($record,$last_resets{$partid},$partid);
       } else {
           $aggtries = $$record{'resource.'.$partid.'.tries'};
       }
     $result.='<table border="0"><tr><td>'.      $result.='<table border="0"><tr><td>'.
  '<b>Part: </b>'.$display_part.' <b>Points: </b></td><td>'."\n";   '<b>Part: </b>'.$display_part.' <b>Points: </b></td><td>'."\n";
   
Line 1389  sub gradeBox { Line 1399  sub gradeBox {
     $result.='<input type="hidden" name="stores'.$counter.'_'.$partid.'" value="" />'."\n".      $result.='<input type="hidden" name="stores'.$counter.'_'.$partid.'" value="" />'."\n".
  '<input type="hidden" name="oldpts'.$counter.'_'.$partid.'" value="'.$score.'" />'."\n".   '<input type="hidden" name="oldpts'.$counter.'_'.$partid.'" value="'.$score.'" />'."\n".
  '<input type="hidden" name="solved'.$counter.'_'.$partid.'" value="'.   '<input type="hidden" name="solved'.$counter.'_'.$partid.'" value="'.
  $$record{'resource.'.$partid.'.solved'}.'" />'."\n";   $$record{'resource.'.$partid.'.solved'}.'" />'."\n".
           '<input type="hidden" name="totaltries'.$counter.'_'.$partid.'" value="'.
           $$record{'resource.'.$partid.'.tries'}.'" />'."\n".
           '<input type="hidden" name="aggtries'.$counter.'_'.$partid.'" value="'.
           $aggtries.'" />'."\n";
     $result.='</td></tr></table>'."\n";      $result.='</td></tr></table>'."\n";
     return $result;      return $result;
 }  }
Line 1598  KEYWORDS Line 1612  KEYWORDS
     }      }
   
     my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname);      my %record = &Apache::lonnet::restore($symb,$env{'request.course.id'},$udom,$uname);
   
     my ($partlist,$handgrade,$responseType) = &response_type($url,$symb);      my ($partlist,$handgrade,$responseType) = &response_type($url,$symb);
   
     # Display student info      # Display student info
Line 2122  sub saveHandGrade { Line 2135  sub saveHandGrade {
     my @parts_graded;      my @parts_graded;
     my %newrecord  = ();      my %newrecord  = ();
     my ($pts,$wgt) = ('','');      my ($pts,$wgt) = ('','');
       my %aggregate = ();
       my $aggregateflag = 0;
     foreach my $new_part (split(/:/,$env{'form.partlist'.$newflg})) {      foreach my $new_part (split(/:/,$env{'form.partlist'.$newflg})) {
  #collaborator may vary for different parts   #collaborator may vary for different parts
  if ($submitter && $new_part ne $part) { next; }   if ($submitter && $new_part ne $part) { next; }
Line 2141  sub saveHandGrade { Line 2156  sub saveHandGrade {
     }      }
     $newrecord{'resource.'.$new_part.'.regrader'}=      $newrecord{'resource.'.$new_part.'.regrader'}=
  "$env{'user.name'}:$env{'user.domain'}";   "$env{'user.name'}:$env{'user.domain'}";
               my @partids = ("$new_part");
               my %last_resets = ();
               &get_last_resets($symb,$env{'request.course.id'},\%last_resets,\@partids);
               my ($totaltries,$aggtries,$solvedstatus);
               $totaltries = $record{'resource.'.$part.'.tries'};
               if ($last_resets{$new_part}) {
                   $aggtries = &get_num_tries(\%record,$last_resets{$new_part},$new_part);
               } else {
                   $aggtries = $totaltries;
               }
               $solvedstatus = $record{'resource.'.$new_part.'.solved'};
               if ($aggtries > 0) {
                   &decrement($symb,$new_part,\%aggregate,$aggtries,$totaltries,$solvedstatus);
                   $aggregateflag = 1;
               }
  } elsif ($dropMenu eq '') {   } elsif ($dropMenu eq '') {
     $pts = ($env{'form.GD_BOX'.$newflg.'_'.$new_part} ne '' ?       $pts = ($env{'form.GD_BOX'.$newflg.'_'.$new_part} ne '' ? 
     $env{'form.GD_BOX'.$newflg.'_'.$new_part} :       $env{'form.GD_BOX'.$newflg.'_'.$new_part} : 
Line 2189  sub saveHandGrade { Line 2219  sub saveHandGrade {
  &Apache::lonnet::cstore(\%newrecord,$symb,   &Apache::lonnet::cstore(\%newrecord,$symb,
  $env{'request.course.id'},$domain,$stuname);   $env{'request.course.id'},$domain,$stuname);
     }      }
       if ($aggregateflag) {
           &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
                     $env{'course.'.$env{'request.course.id'}.'.domain'},
                     $env{'course.'.$env{'request.course.id'}.'.num'});
       }
     return '',$pts,$wgt;      return '',$pts,$wgt;
 }  }
   
   # ----------- Provides number of tries since last reset.
   sub get_num_tries {
       my ($record,$last_reset,$part) = @_;
       my $timestamp = '';
       my $num_tries = 0;
       if ($$record{'version'}) {
           for (my $version=$$record{'version'};$version>=1;$version--) {
               if (exists($$record{$version.':resource.'.$part.'.solved'})) {
                   $timestamp = $$record{$version.':timestamp'};
                   if ($timestamp > $last_reset) {
                       $num_tries ++;
                   } else {
                       last;
                   }
               }
           }
       }
       return $num_tries;
   }
   
   # ----------- Determine decrements required in aggregate totals 
   sub decrement_aggs {
       my ($symb,$part,$aggregate,$aggtries,$totaltries,$solvedstatus) = @_;
       my %decrement = (
                           attempts => 0,
                           users => 0,
                           correct => 0
                       );
       $decrement{'attempts'} = $aggtries;
       if ($solvedstatus =~ /^correct/) {
           $decrement{'correct'} = 1;
       }
       if ($aggtries == $totaltries) {
           $decrement{'users'} = 1;
       }
       foreach my $type (keys (%decrement)) {
           $$aggregate{$symb."\0".$part."\0".$type} = -$decrement{$type};
       }
       return;
   }
   
   # ----------- Determine timestamps for last reset of aggregate totals for parts  
   sub get_last_resets {
       my ($symb,$courseid,$last_resets,$partids) =@_;
       my $cdom = $env{'course.'.$courseid.'.domain'};
       my $cname = $env{'course.'.$courseid.'.num'};
       my %resethash = &Apache::lonnet::restore($symb,'nohist_resourcetracker',$cdom,$cname);
       if ($resethash{'version'}) {
           foreach my $part (@{$partids}) {
               $$last_resets{$part} = '';
               for (my $version=$resethash{'version'};$version>=1;$version--) {
                   if (exists($resethash{$version.':'.$part."\0".'prev_attempts'})) {
                       $$last_resets{$part} = $resethash{$version.':timestamp'};
                       last;
                   }
               }
           }
       }
       return;
   }
   
 # ----------- Handles creating versions for portfolio files as answers  # ----------- Handles creating versions for portfolio files as answers
 sub version_portfiles {  sub version_portfiles {
     my ($record, $parts_graded, $courseid, $symb, $domain, $stuname, $v_flag) = @_;      my ($record, $parts_graded, $courseid, $symb, $domain, $stuname, $v_flag) = @_;
Line 2381  sub viewgrades_js { Line 2477  sub viewgrades_js {
     if (selval[2].selected) {      if (selval[2].selected) {
  document.classgrade["GD_"+user+'_'+partid+"_tries"].value = "0";   document.classgrade["GD_"+user+'_'+partid+"_tries"].value = "0";
     }      }
  }          }
     }      }
   
     function resetEntry(numpart) {      function resetEntry(numpart) {
Line 2514  sub viewgrades { Line 2610  sub viewgrades {
  '<table border=0><tr bgcolor="#deffff"><td>&nbsp;<b>No.</b>&nbsp;</td>'.   '<table border=0><tr bgcolor="#deffff"><td>&nbsp;<b>No.</b>&nbsp;</td>'.
  '<td>'.&nameUserString('header')."</td>\n";   '<td>'.&nameUserString('header')."</td>\n";
     my (@parts) = sort(&getpartlist($url,$symb));      my (@parts) = sort(&getpartlist($url,$symb));
       my @partids = ();
     foreach my $part (@parts) {      foreach my $part (@parts) {
  my $display=&Apache::lonnet::metadata($url,$part.'.display');   my $display=&Apache::lonnet::metadata($url,$part.'.display');
  $display =~ s|^Number of Attempts|Tries<br />|; # makes the column narrower   $display =~ s|^Number of Attempts|Tries<br />|; # makes the column narrower
  if  (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }   if  (!$display) { $display = &Apache::lonnet::metadata($url,$part.'.name'); }
  my ($partid) = &split_part_type($part);   my ($partid) = &split_part_type($part);
           push(@partids, $partid);
  my $display_part=&get_display_part($partid,$url,$symb);   my $display_part=&get_display_part($partid,$url,$symb);
  if ($display =~ /^Partial Credit Factor/) {   if ($display =~ /^Partial Credit Factor/) {
     $result.='<td><b>Score Part:</b> '.$display_part.      $result.='<td><b>Score Part:</b> '.$display_part.
Line 2532  sub viewgrades { Line 2630  sub viewgrades {
     }      }
     $result.='</tr>';      $result.='</tr>';
   
       # retrieve last reset information
       my %last_resets = ();
       &get_last_resets($symb,$env{'request.course.id'},\%last_resets,\@partids);
   
     #get info for each student      #get info for each student
     #list all the students - with points and grade status      #list all the students - with points and grade status
     my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1');      my (undef,undef,$fullname) = &getclasslist($env{'form.section'},'1');
Line 2539  sub viewgrades { Line 2641  sub viewgrades {
     foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {      foreach (sort {lc($$fullname{$a}) cmp lc($$fullname{$b}) } keys %$fullname) {
  $ctr++;   $ctr++;
  $result.=&viewstudentgrade($url,$symb,$env{'request.course.id'},   $result.=&viewstudentgrade($url,$symb,$env{'request.course.id'},
    $_,$$fullname{$_},\@parts,\%weight,$ctr);     $_,$$fullname{$_},\@parts,\%weight,$ctr,\%last_resets);
     }      }
     $result.='</table></td></tr></table>';      $result.='</table></td></tr></table>';
     $result.='<input type="hidden" name="total" value="'.$ctr.'" />'."\n";      $result.='<input type="hidden" name="total" value="'.$ctr.'" />'."\n";
Line 2556  sub viewgrades { Line 2658  sub viewgrades {
   
 #--- call by previous routine to display each student  #--- call by previous routine to display each student
 sub viewstudentgrade {  sub viewstudentgrade {
     my ($url,$symb,$courseid,$student,$fullname,$parts,$weight,$ctr) = @_;      my ($url,$symb,$courseid,$student,$fullname,$parts,$weight,$ctr,$last_resets) = @_;
     my ($uname,$udom) = split(/:/,$student);      my ($uname,$udom) = split(/:/,$student);
     $student=~s/:/_/;      $student=~s/:/_/;
     my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname);      my %record=&Apache::lonnet::restore($symb,$courseid,$udom,$uname);
       my %aggregates = (); 
     my $result='<tr bgcolor="#ffffdd"><td align="right">'.      my $result='<tr bgcolor="#ffffdd"><td align="right">'.
  '<input type="hidden" name="ctr'.($ctr-1).'" value="'.$student.'" />'.   '<input type="hidden" name="ctr'.($ctr-1).'" value="'.$student.'" />'.
  "\n".$ctr.'&nbsp;</td><td>&nbsp;'.   "\n".$ctr.'&nbsp;</td><td>&nbsp;'.
Line 2569  sub viewstudentgrade { Line 2672  sub viewstudentgrade {
     foreach my $apart (@$parts) {      foreach my $apart (@$parts) {
  my ($part,$type) = &split_part_type($apart);   my ($part,$type) = &split_part_type($apart);
  my $score=$record{"resource.$part.$type"};   my $score=$record{"resource.$part.$type"};
  $result.='<td align="middle">';          $result.='<td align="middle">';
           my ($aggtries,$totaltries);
           unless (exists($aggregates{$part})) {
               $totaltries = $record{'resource.'.$part.'.tries'};
               if ($$last_resets{$part}) {  
                   $aggtries = &get_num_tries(\%record,$$last_resets{$part},$part);
               } else {
                   $aggtries = $totaltries;
               } 
               $result.='<input type="hidden" name="'.
                   'GD_'.$student.'_'.$part.'_aggtries" value="'.$aggtries.'" />'."\n";
               $result.='<input type="hidden" name="'.
                   'GD_'.$student.'_'.$part.'_totaltries" value="'.$totaltries.'" />'."\n";
               $aggregates{$part} = 1;
           }
  if ($type eq 'awarded') {   if ($type eq 'awarded') {
     my $pts = $score eq '' ? '' : $score*$$weight{$part};      my $pts = $score eq '' ? '' : $score*$$weight{$part};
     $result.='<input type="hidden" name="'.      $result.='<input type="hidden" name="'.
Line 2684  sub editgrades { Line 2801  sub editgrades {
     $noupdate.=$line."<td colspan=\"$numcols\"><font color=\"red\">Not allowed to modify student</font></td></tr>";      $noupdate.=$line."<td colspan=\"$numcols\"><font color=\"red\">Not allowed to modify student</font></td></tr>";
     next;      next;
  }   }
           my %aggregate = ();
           my $aggregateflag = 0;
  foreach (@partid) {   foreach (@partid) {
     my $old_aw    = $env{'form.GD_'.$user.'_'.$_.'_awarded_s'};      my $old_aw    = $env{'form.GD_'.$user.'_'.$_.'_awarded_s'};
     my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1);      my $old_part_pcr = $old_aw/($weight{$_} ne '0' ? $weight{$_}:1);
     my $old_part  = $old_aw eq '' ? '' : $old_part_pcr;      my $old_part  = $old_aw eq '' ? '' : $old_part_pcr;
     my $old_score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}};      my $old_score = $scoreptr{$env{'form.GD_'.$user.'_'.$_.'_solved_s'}};
   
     my $awarded   = $env{'form.GD_'.$user.'_'.$_.'_awarded'};      my $awarded   = $env{'form.GD_'.$user.'_'.$_.'_awarded'};
     my $pcr       = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1);      my $pcr       = $awarded/($weight{$_} ne '0' ? $weight{$_} : 1);
     my $partial   = $awarded eq '' ? '' : $pcr;      my $partial   = $awarded eq '' ? '' : $pcr;
Line 2712  sub editgrades { Line 2830  sub editgrades {
  $newrecord{'resource.'.$_.'.awarded'} = 0;   $newrecord{'resource.'.$_.'.awarded'} = 0;
  $newrecord{'resource.'.$_.'.regrader'}="$env{'user.name'}:$env{'user.domain'}";   $newrecord{'resource.'.$_.'.regrader'}="$env{'user.name'}:$env{'user.domain'}";
  $updateflag = 1;   $updateflag = 1;
                   if ($env{'form.GD_'.$user.'_'.$_.'_aggtries'} > 0) {
                       my $aggtries = $env{'form.GD_'.$user.'_'.$_.'_aggtries'};
                       my $totaltries = $env{'form.GD_'.$user.'_'.$_.'_totaltries'};
                       my $solvedstatus = $env{'form.GD_'.$user.'_'.$_.'_solved_s'};
                       &decrement_aggs($symb,$_,\%aggregate,$aggtries,$totaltries,$solvedstatus);
                       $aggregateflag = 1;
                   }
     } elsif (!($old_part eq $partial && $old_score eq $score)) {      } elsif (!($old_part eq $partial && $old_score eq $score)) {
  $updateflag = 1;   $updateflag = 1;
  $newrecord{'resource.'.$_.'.awarded'}  = $partial if $partial ne '';   $newrecord{'resource.'.$_.'.awarded'}  = $partial if $partial ne '';
Line 2751  sub editgrades { Line 2876  sub editgrades {
     $noupdate.='<tr bgcolor="#ffffde"><td align="right">&nbsp;'.$noupdateCtr.'&nbsp;</td>'.$line;      $noupdate.='<tr bgcolor="#ffffde"><td align="right">&nbsp;'.$noupdateCtr.'&nbsp;</td>'.$line;
     $noupdateCtr++;      $noupdateCtr++;
  }   }
           if ($aggregateflag) {
               &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
                         $env{'course.'.$env{'request.course.id'}.'.domain'},
                         $env{'course.'.$env{'request.course.id'}.'.num'});
           }
     }      }
     if ($noupdate) {      if ($noupdate) {
 # my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3;  # my $numcols=(scalar(@partid)*(scalar(@parts)-1)*2)+3;
Line 3571  sub updateGradeByPage { Line 3701  sub updateGradeByPage {
   
     my %newrecord=();      my %newrecord=();
     my @displayPts=();      my @displayPts=();
               my %aggregate = ();
               my $aggregateflag = 0;
     foreach my $partid (@{$parts}) {      foreach my $partid (@{$parts}) {
  my $newpts = $env{'form.GD_BOX'.$question.'_'.$partid};   my $newpts = $env{'form.GD_BOX'.$question.'_'.$partid};
  my $oldpts = $env{'form.oldpts'.$question.'_'.$partid};   my $oldpts = $env{'form.oldpts'.$question.'_'.$partid};
Line 3597  sub updateGradeByPage { Line 3729  sub updateGradeByPage {
     $newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}";      $newrecord{'resource.'.$partid.'.regrader'} = "$env{'user.name'}:$env{'user.domain'}";
     $changeflag++;      $changeflag++;
     $newpts = '';      $newpts = '';
                       
                       my $aggtries =  $env{'form.aggtries'.$question.'_'.$partid};
                       my $totaltries = $env{'form.totaltries'.$question.'_'.$partid};
                       my $solvedstatus = $env{'form.solved'.$question.'_'.$partid};
                       if ($aggtries > 0) {
                           &decrement_aggs($symbx,$partid,\%aggregate,$aggtries,$totaltries,$solvedstatus);
                           $aggregateflag = 1;
                       }
  }   }
  my $display_part=&get_display_part($partid,undef,   my $display_part=&get_display_part($partid,undef,
    $curRes->symb());     $curRes->symb());
Line 3622  sub updateGradeByPage { Line 3762  sub updateGradeByPage {
  &Apache::lonnet::cstore(\%newrecord,$symbx,$env{'request.course.id'},   &Apache::lonnet::cstore(\%newrecord,$symbx,$env{'request.course.id'},
  $udom,$uname);   $udom,$uname);
     }      }
               if ($aggregateflag) {
                   &Apache::lonnet::cinc('nohist_resourcetracker',\%aggregate,
                         $env{'course.'.$env{'request.course.id'}.'.domain'},
                         $env{'course.'.$env{'request.course.id'}.'.num'});
               }
   
     $studentTable.='<td valign="top">'.$displayPts[0].'</td>'.      $studentTable.='<td valign="top">'.$displayPts[0].'</td>'.
  '<td valign="top">'.$displayPts[1].'</td>'.   '<td valign="top">'.$displayPts[1].'</td>'.

Removed from v.1.268  
changed lines
  Added in v.1.269


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>