Computation Progress
'+ - ''+ - ''); - popwin.document.close(); - -ENDPOP +########################################################## +########################################################## +## +## HTML output routines +## +########################################################## +########################################################## +sub output_html_by_sequence { + my ($r) = @_; + my $c = $r->connection(); + $r->print(&html_preamble()); + # + foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) { + last if ($c->aborted); + next if ($seq->{'num_assess'} < 1); + $r->print("".$seq->{'title'}."
". + '| '."\n".
+ ' |
| '."\n".
+ ' |
". + $ENV{'course.'.$ENV{'request.course.id'}.'.description'}. + "
\n"; + my ($starttime,$endtime) = &Apache::lonstathelpers::get_time_limits(); + if (defined($starttime) || defined($endtime)) { + # Inform the user what the time limits on the data are. + $Str .= ''.&mt('Statistics on submissions from [_1] to [_2]', + &Apache::lonlocal::locallocaltime($starttime), + &Apache::lonlocal::locallocaltime($endtime) + ).'
'; + } + $Str .= "".&mt('Compiled on [_1]', + &Apache::lonlocal::locallocaltime(time))."
"; + return $Str; } -# close Progress Line -sub Close_PrgWin { - my ($r)=@_; - $r->print(''); - $r->rflush(); + +############################################### +############################################### +## +## Misc HTML output routines +## +############################################### +############################################### +sub statistics_html_table_data { + my ($data,$options) = @_; + my $row = ''; + foreach my $field (@Fields) { + next if ($options =~ /no $field->{'name'}/); + next if ($field->{'selected'} ne 'yes'); + $row .= 'sequences=$cache->{'orderedSequences'}"); -# $r->print("
".$cache->{$sequence.':title'}); - next; + +sub statistics_table_header { + my ($options) = @_; + my $header_row; + foreach my $field (@Fields) { + next if ($options =~ /no $field->{'name'}/); + next if ($field->{'selected'} ne 'yes'); + $header_row .= '
problems=$cache->{$sequence.':problems'}"); - my $problem = $cache->{$problemID.':problem'}; -# $r->print("
$problemID === $problem"); - my $LatestVersion = $cache->{$name.':version:'.$problem}; - # Output dashes for all the parts of this problem if there - # is no version information about the current problem. - #if(!$LatestVersion) { - # foreach my $part (split(/\:/,$cache->{$sequence.':'. - # $problemID. - # ':parts'})) { - # $codes .= "-,"; - # $attempts .= "0,"; - # } - # next; - #} - - my %partData=undef; - $partData{'count'}=0; - # Initialize part data, display skips correctly - # Skip refers to when a student made no submissions on that - # part/problem. - foreach my $part (split(/\:/,$cache->{$sequence.':'. - $problemID. - ':parts'})) { - $tempProblemOrder++; - $partData{'count'}++; -# $r->print("
parts=$cache->{$sequence.':'.$problemID.':parts'}"); - $partData{$part.':order'}=$tempProblemOrder; - $partData{$part.':tries'}=0; - $partData{$part.':code'}='-'; - } +sub sequence_html_header { + my $Str .= '
'.$name.'---'.$ptr.'==='.$DoDiff); - - my $Fac = ($partData{$_.':tries'}) ? - ($partData{$_.':awarded'}/$partData{$_.':tries'}) : 0; - my $DisF; - if($Fac > 0 && $Fac < 1) { - $DisF = sprintf( "%.4f", $Fac ); - } else { - $DisF = $Fac; - } +sub make_single_stat_plot { + my ($r,$datafield) = @_; + # + my $title; my $yaxis; + foreach my $field (@Fields) { + next if ($field->{'name'} ne $datafield); + $title = $field->{'long_title'}; + $yaxis = $field->{'title'}; + last; + } + if ($title eq '' || $yaxis eq '') { + # datafield is something we do not know enough about to plot + $r->print('
'. + &mt('Unable to plot the requested statistic.'). + '
'); + return; + } + # + # Build up the data sets to plot + my @Labels; + my @Data; + my $max = 1; + foreach my $data (@StatsArray) { + push(@Labels,$data->{'problem_num'}); + push(@Data,$data->{$datafield}); + if ($data->{$datafield}>$max) { + $max = $data->{$datafield}; + } + } + foreach (1,2,3,4,5,10,15,20,25,40,50,75,100,150,200,250,300,500,600,750, + 1000,1500,2000,2500,3000,3500,4000,5000,7500,10000,15000,20000) { + if ($max <= $_) { + $max = $_; + last; + } + } + if ($max > 20000) { + $max = 10000*(int($max/10000)+1); + } + # + $r->print("".&Apache::loncommon::DrawBarGraph($title, + 'Problem Number', + $yaxis, + $max, + undef, # colors + \@Labels, + \@Data)."
\n"); + return; +} - if ($Discuss->{"$name:$problem"}) { - $TotDiscuss++; - $Discussed=1; - } - my $time = $cache->{"$name:$LatestVersion:$problem:timestamp"}; - $discrim .= $tempSequenceOrder.'@'.$pOrder.'='.$DisF.'+'.$Yes; - $ptr .= '&'.$partData{$_.':tries'}. - '&'.$partData{$_.':wrong'}. - '&'.$partData{$_.':code'}; - push (@$list, $ptr."&$Discussed"); -# $r->print(''.$_.$name.'---'.$ptr); - -#### if ($DoDiff>0.85) { +sub degrees_plot { + my ($r)=@_; + my $count = scalar(@StatsArray); + my $width = 50 + 10*$count; + $width = 300 if ($width < 300); + my $height = 300; + my $plot = ''; + my $ymax = 0; + my $ymin = 0; + my @Disc; my @Diff; my @Labels; + foreach my $data (@StatsArray) { + push(@Labels,$data->{'problem_num'}); + my $disc = $data->{'deg_of_disc'}; + my $diff = $data->{'deg_of_diff'}; + push(@Disc,$disc); + push(@Diff,$diff); + # + $ymin = $disc if ($ymin > $disc); + $ymin = $diff if ($ymin > $diff); + $ymax = $disc if ($ymax < $disc); + $ymax = $diff if ($ymax < $diff); + } + # + # Make sure we show relevant information. + if ($ymin < 0) { + if (abs($ymin) < 0.05) { + $ymin = 0; + } else { + $ymin = -1; + } + } + if ($ymax > 0) { + if (abs($ymax) < 0.05) { + $ymax = 0; + } else { + $ymax = 1; + } + } + # + my $xmax = $Labels[-1]; + if ($xmax > 50) { + if ($xmax % 10 != 0) { + $xmax = 10 * (int($xmax/10)+1); + } + } else { + if ($xmax % 5 != 0) { + $xmax = 5 * (int($xmax/5)+1); + } + } + # + my $discdata .= ''.join(',',@Labels).''.$/. + ''.join(',',@Disc).''.$/; + # + my $diffdata .= ''.join(',',@Labels).''.$/. + ''.join(',',@Diff).''.$/; + # + my $title = 'Degree of Discrimination\nand Degree of Difficulty'; + if ($xmax > 50) { + $title = 'Degree of Discrimination and Degree of Difficulty'; + } + # + $plot=<<"END"; +
'.&Apache::lonxml::xmlparse($r,'web',$plot).'
'.$/; + $r->print($plotresult); + return; +} - $TimeTot += $time; +sub tries_data_plot { + my ($r)=@_; + my $count = scalar(@StatsArray); + my $width = 50 + 10*$count; + $width = 300 if ($width < 300); + my $height = 300; + my $plot = ''; + my @STD; my @Mean; my @Max; my @Min; + my @Labels; + my $ymax = 5; + foreach my $data (@StatsArray) { + my $max = $data->{'mean_tries'} + $data->{'std_tries'}; + $ymax = $max if ($ymax < $max); + $ymax = $max if ($ymax < $max); + push(@Labels,$data->{'problem_num'}); + push(@STD,$data->{'std_tries'}); + push(@Mean,$data->{'mean_tries'}); + } + # + # Make sure we show relevant information. + my $xmax = $Labels[-1]; + if ($xmax > 50) { + if ($xmax % 10 != 0) { + $xmax = 10 * (int($xmax/10)+1); + } + } else { + if ($xmax % 5 != 0) { + $xmax = 5 * (int($xmax/5)+1); + } + } + $ymax = int($ymax)+1+2; + # + my $std_data .= ''.join(',',@Labels).''.$/. + ''.join(',',@Mean).''.$/; + # + my $std_error_data .= ''.join(',',@Labels).''.$/. + ''.join(',',@Mean).''.$/. + ''.join(',',@STD).''.$/; + # + my $title = 'Mean and S.D. of Tries'; + if ($xmax > 25) { + $title = 'Mean and Standard Deviation of Tries'; + } + # + $plot=<<"END"; +'.&Apache::lonxml::xmlparse($r,'web',$plot).'
'.$/; + $r->print($plotresult); + return; +} - if ($Yes==1 && $partData{$_.':tries'}==1) { - $TotFirst++; - } -# my $Acts= $Activity->{$name.':'.$problem}; -# if ($Acts) { -# my $Pt=&ProcAct( $Acts, $time ); - #my ($spe,$beg) = split(/\+/,$Pt); -# my $spe= $Pt; -# if ($Yes==1) {$spent_yes += $spe;} -# $spent += $spe; - #$Beg += $beg; -# $r->print(''.$name.'---'.$problem.'---'.$spe); -# } - $TotalOpend++; - $ProbTot++; +sub plot_dropdown { + my $current = ''; + # + if (defined($ENV{'form.plot'})) { + $current = $ENV{'form.plot'}; + } + # + my @Additional_Plots = ( + { graphable=>'yes', + name => 'degrees', + title => 'Difficulty Indexes' }, + { graphable=>'yes', + name => 'tries statistics', + title => 'Tries Statistics' }); + # + my $Str= "\n".''."\n"; + return $Str; +} - $tempProblemOrder++; - } +############################################### +############################################### +## +## Excel output routines +## +############################################### +############################################### +sub Excel_output { + my ($r) = @_; + $r->print('
'.&mt('Preparing Excel Spreadsheet').'
'); + ## + ## Compute the statistics + &compute_all_statistics($r); + my $c = $r->connection; + return if ($c->aborted()); + ## + ## Create the excel workbook + my $filename = '/prtspool/'. + $ENV{'user.name'}.'_'.$ENV{'user.domain'}.'_'. + time.'_'.rand(1000000000).'.xls'; + my ($starttime,$endtime) = &Apache::lonstathelpers::get_time_limits(); + # + # Create sheet + my $excel_workbook = Spreadsheet::WriteExcel->new('/home/httpd'.$filename); + # + # Check for errors + if (! defined($excel_workbook)) { + $r->log_error("Error creating excel spreadsheet $filename: $!"); + $r->print(&mt("Problems creating new Excel file. ". + "This error has been logged. ". + "Please alert your LON-CAPA administrator.")); + return 0; + } + # + # The excel spreadsheet stores temporary data in files, then put them + # together. If needed we should be able to disable this (memory only). + # The temporary directory must be specified before calling 'addworksheet'. + # File::Temp is used to determine the temporary directory. + $excel_workbook->set_tempdir($Apache::lonnet::tmpdir); + # + # Add a worksheet + my $sheetname = $ENV{'course.'.$ENV{'request.course.id'}.'.description'}; + if (length($sheetname) > 31) { + $sheetname = substr($sheetname,0,31); + } + my $excel_sheet = $excel_workbook->addworksheet( + &Apache::loncommon::clean_excel_name($sheetname)); + # + my $format = &Apache::loncommon::define_excel_formats($excel_workbook); + ## + ## Begin creating excel sheet + ## + my ($rows_output,$cols_output) = (0,0); + # + # Put the course description in the header + $excel_sheet->write($rows_output,$cols_output++, + $ENV{'course.'.$ENV{'request.course.id'}.'.description'}, + $format->{'h1'}); + $cols_output += 3; + # + # Put a description of the sections listed + my $sectionstring = ''; + $excel_sheet->write($rows_output,$cols_output++, + &Apache::lonstathelpers::sections_description + (@Apache::lonstatistics::SelectedSections), + $format->{'h3'}); + $cols_output += scalar(@Apache::lonstatistics::SelectedSections); + # + # Time restrictions + my $time_string; + if (defined($starttime)) { + # call localtime but not lonlocal:locallocaltime because excel probably + # cannot handle localized text. Probably. + $time_string .= 'Data collected from '.localtime($time_string); + if (defined($endtime)) { + $time_string .= ' to '.localtime($endtime); + } + $time_string .= '.'; + } elsif (defined($endtime)) { + # See note above about lonlocal:locallocaltime + $time_string .= 'Data collected before '.localtime($endtime).'.'; + } + if (defined($time_string)) { + $excel_sheet->write($rows_output,$cols_output++,$time_string); + $cols_output+= 5; + } + # + # Put the date in there too + $excel_sheet->write($rows_output,$cols_output++, + 'Compiled on '.localtime(time)); + # + $rows_output++; + $cols_output=0; + ## + ## Sequence Statistics + ## + &write_headers($excel_sheet,$format,\$rows_output,\$cols_output, + \@SeqFields); + foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) { + next if ($seq->{'num_assess'} < 1); + my $data = $SeqStat{$seq->{'symb'}}; + $cols_output=0; + foreach my $field (@SeqFields) { + next if ($field->{'selected'} ne 'yes'); + $excel_sheet->write($rows_output,$cols_output++, + $data->{$field->{'name'}}); } + $rows_output++; + $cols_output=0; } - my $pstr; - if($totalTries) { - my $DisFac = ($totalAwarded/$totalTries); - my $DisFactor = sprintf( "%.4f", $DisFac ); - my $TS = sprintf( "%.2f", $spent ); - my $TS_yes = sprintf( "%.2f", $spent_yes ); - $pstr=$DisFactor.':'.$name.':'.$ProbTot.':'.$TotalOpend.':'. - $totalTries.':'.$ProbSolved.':'.$TotFirst.':'. - $TS_yes.':'.$TS.':'.$TotDiscuss; - (%$discriminant)->{$pstr}=$discrim; + ## + ## Resource Statistics + ## + $rows_output++; + $cols_output=0; + &write_headers($excel_sheet,$format,\$rows_output,\$cols_output, + \@Fields); + # + foreach my $data (@StatsArray) { + $cols_output=0; + foreach my $field (@Fields) { + next if ($field->{'selected'} ne 'yes'); + next if ($field->{'name'} eq 'problem_num'); + $excel_sheet->write($rows_output,$cols_output++, + $data->{$field->{'name'}}); + } + $rows_output++; + $cols_output=0; } + # + $excel_workbook->close(); + # + # Tell the user where to get their excel file + $r->print(''. + ''. + &mt('Your Excel Spreadsheet').''."\n"); + $r->rflush(); + return; } +## +## &write_headers +## +sub write_headers { + my ($excel_sheet,$format,$rows_output,$cols_output,$Fields) = @_; + ## + ## First the long titles + foreach my $field (@{$Fields}) { + next if ($field->{'name'} eq 'problem_num'); + next if ($field->{'selected'} ne 'yes'); + if (exists($field->{'long_title'})) { + $excel_sheet->write($$rows_output,${$cols_output}, + $field->{'long_title'}, + $format->{'bold'}); + } else { + $excel_sheet->write($$rows_output,${$cols_output},''); + } + ${$cols_output}+= 1; + } + ${$cols_output} =0; + ${$rows_output}+=1; + ## + ## Then the short titles + foreach my $field (@{$Fields}) { + next if ($field->{'selected'} ne 'yes'); + next if ($field->{'name'} eq 'problem_num'); + # Use english for excel as I am not sure how well excel handles + # other character sets.... + $excel_sheet->write($$rows_output,$$cols_output, + $field->{'title'}, + $format->{'bold'}); + $$cols_output+=1; + } + ${$cols_output} =0; + ${$rows_output}+=1; + return; +} + +################################################## +################################################## +## +## Statistics Gathering and Manipulation Routines +## +################################################## +################################################## +sub compute_statistics_on_sequence { + my ($seq) = @_; + my @Data; + foreach my $res (@{$seq->{'contents'}}) { + next if ($res->{'type'} ne 'assessment'); + foreach my $part (@{$res->{'parts'}}) { + # + # This is where all the work happens + my $data = &get_statistics($seq,$res,$part,scalar(@StatsArray)+1); + push (@Data,$data); + push (@StatsArray,$data); + } + } + return @Data; +} +sub compute_all_statistics { + my ($r) = @_; + if (@StatsArray > 0) { + # Assume we have already computed the statistics + return; + } + my $c = $r->connection; + foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) { + last if ($c->aborted); + next if ($seq->{'num_assess'} < 1); + &compute_sequence_statistics($seq); + &compute_statistics_on_sequence($seq); + } +} -sub MySort { - my $pos=shift; - if ( $pos > 0 ) { - if ($ENV{'form.order'} eq 'Descending') {$b <=> $a;} - else { $a <=> $b; } +sub sort_data { + my ($sortkey) = @_; + return if (! @StatsArray); + # + # Sort the data + my $sortby = undef; + foreach my $field (@Fields) { + if ($sortkey eq $field->{'name'}) { + $sortby = $field->{'name'}; + } + } + if (! defined($sortby) || $sortby eq '' || $sortby eq 'problem_num') { + $sortby = 'container'; + } + if ($sortby ne 'container') { + # $sortby is already defined, so we can charge ahead + if ($sortby =~ /^(title|part)$/i) { + # Alpha comparison + @StatsArray = sort { + lc($a->{$sortby}) cmp lc($b->{$sortby}) || + lc($a->{'title'}) cmp lc($b->{'title'}) || + lc($a->{'part'}) cmp lc($b->{'part'}); + } @StatsArray; + } else { + # Numerical comparison + @StatsArray = sort { + my $retvalue = 0; + if ($b->{$sortby} eq 'nan') { + if ($a->{$sortby} ne 'nan') { + $retvalue = -1; + } else { + $retvalue = 0; + } + } + if ($a->{$sortby} eq 'nan') { + if ($b->{$sortby} ne 'nan') { + $retvalue = 1; + } + } + if ($retvalue eq '0') { + $retvalue = $b->{$sortby} <=> $a->{$sortby} || + lc($a->{'title'}) <=> lc($b->{'title'}) || + lc($a->{'part'}) <=> lc($b->{'part'}); + } + $retvalue; + } @StatsArray; + } } - else { -# if ($ENV{'form.order'} eq 'Descending') {$b cmp $a;} -# else { $a cmp $b; } - $a cmp $b; + # + # Renumber the data set + my $count; + foreach my $data (@StatsArray) { + $data->{'problem_num'} = ++$count; } + return; } +######################################################## +######################################################## +=pod -sub BuildStatisticsTable { - my ($cache,$upper,$lower,$list,$headings,$students,$r,$color)=@_; - my $NoElements = scalar @$list; - my @list=sort(@$list); +=item &get_statistics() -#6666666 -# my $file="/home/httpd/perl/tmp/183d.txt"; -# open(OUT, ">$file"); -#6666666 -## &Apache::lonstatistics::Create_PrgWin($r); -##777777 -## my (%Activity) = &LoadActivityLog(); -## $r->print(''); -## my ($doDiffFile) = &LoadDoDiffFile(); +Wrapper routine from the call to loncoursedata::get_problem_statistics. +Calls lonstathelpers::get_time_limits() to limit the data set by time +and &compute_discrimination_factor -##777777 -## $Str .= &Classify($discriminantFactor, $students); +Inputs: $sequence, $resource, $part, $problem_num - my $p_count = 0; - my $dummy; - my $p_val; - my $ResId; - my %TempCache; - my $cIdx=0; +Returns: Hash reference with statistics data from +loncoursedata::get_problem_statistics. - foreach my $sequence (split(':', $cache->{'orderedSequences'})) { - if($cache->{'ProblemStatisticsMaps'} ne 'All Maps' && - $cache->{'ProblemStatisticsMaps'} ne $cache->{$sequence.':title'}) { - next; - } - &CreateProblemStatisticsTableHeading($cache->{'DisplayFormat'}, - $cache->{$sequence.':source'}, - $cache->{$sequence.':title'}, - $headings,$r); - my ($tar,$Tries,$Wrongs,$Code,$Disc)=split(/\&/, - $list[$cIdx]); - my ($SqOrd,$PrOrd,$Prob)=split(/\:/,$tar); - $sequence+=100; - while ($SqOrd==$sequence && $cIdx<$NoElements) { - my %storestats=(); - my $pOrd=$PrOrd; - my $Temp = $Prob; - my $MxTries = 0; - my $TotalTries = 0; - my $YES = 0; - my $Incorrect = 0; - my $Override = 0; - my $StdNo = 0; - my $DiscNo=0; - my @StdLst; - while ($pOrd==$PrOrd && $cIdx<$NoElements) - { - $cIdx++; - $StdNo++; - $StdLst[ $StdNo ] = $Tries; - $TotalTries += $Tries; - if ( $MxTries < $Tries ) { $MxTries = $Tries; } - if ( $Code eq 'C' ){ $YES++; } - elsif( $Code eq 'I' ) { $Incorrect++; } - elsif( $Code eq 'O' ) { $Override++; } - elsif( $Code eq '-' ) { $StdNo--; } - ($tar,$Tries,$Wrongs,$Code,$Disc)=split(/\&/, - $list[$cIdx]); - ($SqOrd,$PrOrd,$Prob)=split(/\:/,$tar); - } - - $p_count++; - my $Dummy; - ($ResId,$Dummy)=split(/\*/,$Temp); - -###################### - $Temp = ''.$cache->{$ResId.':title'}.$Dummy.''; - - #$r->print('
rid='.$ResId); - #$r->print('
src='.$cache->{$ResId.':source'}); - #$r->print('
tit='.$cache->{$ResId.':title'}); - - my $res = &Apache::lonnet::declutter($cache->{$ResId.':source'}); - my $urlres=$res; - - $ResId=~/(\d+)\.(\d+)/; - my $Map = &Apache::lonnet::declutter( $cache->{'map_id_'.$1} ); - $urlres=$Map; -####################### - -# $res = ''.$res.''; - #$Map = ''.$res.''; - -#------------------------ Compute the Average of Tries about one problem - my $Average = ($StdNo) ? $TotalTries/$StdNo : 0; - - $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___timestamp'}=time; - $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___stdno'}=$StdNo; - $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___avetries'}=$Average; - -#-------------------------------- Compute percentage of Wrong tries - my $Wrong = ( $StdNo ) ? 100 * ( $Incorrect / $StdNo ) : 0; - -#-------------------------------- Compute Standard Deviation - my $StdDev = 0; - if ( $StdNo > 1 ) { - for ( my $n = 0; $n < $StdNo; $n++ ) { - my $Dif = $StdLst[ $n ]-$Average; - $StdDev += $Dif*$Dif; - } - $StdDev /= ( $StdNo - 1 ); - $StdDev = sqrt( $StdDev ); - } - -#-------------------------------- Compute Degree of Difficulty - my $DoDiff = 0; - if( $TotalTries > 0 ) { - $DoDiff = 1 - ( ( $YES + $Override ) / $TotalTries ); -# $DoDiff = ($TotalTries)/($YES + $Override+ 0.1); - } - - $storestats{$ENV{'request.course.id'}.'___'.$urlres.'___difficulty'}=$DoDiff; - -#-------------------------------- Compute the Skewness - my $Skewness = 0; - my $Sum = 0; - if ( $StdNo > 0 && $StdDev > 0 ) { - for ( my $n = 0; $n < $StdNo; $n++ ) { - my $Dif = $StdLst[ $n ]-$Average; - $Skewness += $Dif*$Dif*$Dif; - } - $Skewness /= $StdNo; - $Skewness /= $StdDev*$StdDev*$StdDev; - } - -#--------------------- Compute the Discrimination Factors - my ($Up1,$Up2)=split(/\:/,$upper->{$sequence.'@'.$pOrd}); - my ($Lw1,$Lw2)=split(/\:/,$lower->{$sequence.'@'.$pOrd}); - - my $Dis1 = $Up1 - $Lw1; - my $Dis2 = $Up2 - $Lw2; - my $_D1 = sprintf("%.2f", $Dis1); - my $_D2 = sprintf("%.2f", $Dis2); - -#----------------- Some restition in presenting the float numbers - my $Avg = sprintf( "%.2f", $Average ); - my $Wrng = sprintf( "%.1f", $Wrong ); - my $SD = sprintf( "%.1f", $StdDev ); - my $DoD = sprintf( "%.2f", $DoDiff ); - my $Sk = sprintf( "%.1f", $Skewness ); - my $join = $sequence.'@'.$pOrd.'&'.$Temp.'&'.$StdNo.'&'. - $TotalTries.'&'.$MxTries.'&'.$Avg.'&'. - $YES.'&'.$Override.'&'.$Wrng.'&'.$DoD.'&'. - $SD.'&'.$Sk.'&'.$_D1.'&'.$_D2.'&'. - $DiscNo.'&'.$Prob; - -#####{$sequence.'@'.$pOrd} - $TempCache{'CacheTable:'.($p_count-1)}=$join; - -#6666666 -# $r->print('
'.$out.'&'.$DoD); -# print (OUT $out.'@'.$DoD.'&'); -#6666666 - - $urlres=~/^(\w+)\/(\w+)/; - if ($StdNo) { - &Apache::lonnet::put('resevaldata',\%storestats,$1,$2); - } -#-------------------------------- Row of statistical table - &TableRow($cache,$join,$cIdx,($p_count-1),$r,$color, - \%TempCache); - } - $TempCache{'ProblemCount'}=$p_count; - &CloseTable($cache,$r); - } -### &Close_PrgWin(); -#666666 -# close( OUT ); -#666666 - return \%TempCache; -} - - -sub CacheStatisticsTable { - my ($state,$cache,$Header,$r,$color)=@_; - my @list = (); - my $Useful; - my $UnUseful; - my %TempCache; - my %myHeader = reverse( %$Header ); - my $pos = $myHeader{$state}; - if ($pos > 0) {$pos++;} - my $p_count = $cache->{'ProblemCount'}; - - for ( my $k=0; $k<$p_count;$k++) { - my $key=$cache->{'CacheTable:'.$k}; - my @Temp=split(/\&/,$key); - if ( $pos == 0 ) { - ($UnUseful,$Useful)=split(/\>/,$Temp[$pos]); - } - else { - $Useful = $Temp[$pos]; - } - $list[$k]=$Useful.'@'.$key; - $r->print('
'.$list[$k]); +=cut + +######################################################## +######################################################## +sub get_statistics { + my ($sequence,$resource,$part,$problem_num) = @_; + # + my ($starttime,$endtime) = &Apache::lonstathelpers::get_time_limits(); + my $symb = $resource->{'symb'}; + my $courseid = $ENV{'request.course.id'}; + # + my $data = &Apache::loncoursedata::get_problem_statistics + (\@Apache::lonstatistics::SelectedSections, + $Apache::lonstatistics::enrollment_status, + $symb,$part,$courseid,$starttime,$endtime); + $data->{'part'} = $part; + $data->{'problem_num'} = $problem_num; + $data->{'container'} = $sequence->{'title'}; + $data->{'title'} = $resource->{'title'}; + $data->{'title.link'} = $resource->{'src'}.'?symb='. + &Apache::lonnet::escape($resource->{'symb'}); + # + if ($SelectedFields{'deg_of_disc'}) { + $data->{'deg_of_disc'} = + &compute_discrimination_factor($resource,$part,$sequence); + } + # + # Store in metadata if computations were done for all students + if ($data->{'num_students'} > 1) { + my @Sections = @Apache::lonstatistics::SelectedSections; + my $sections = '"'.join(' ',@Sections).'"'; + $sections =~ s/&+/_/g; # Ensure no special characters + $data->{'sections'}=$sections; + $data->{'course'} = $ENV{'request.course.id'}; + my $urlres=(&Apache::lonnet::decode_symb($resource->{'symb'}))[2]; + $data->{'urlres'}=$urlres; + my %storestats = + &LONCAPA::lonmetadata::dynamic_metadata_storage($data); + my ($dom,$user) = $urlres=~/^(\w+)\/(\w+)/; + &Apache::lonnet::put('nohist_resevaldata',\%storestats,$dom,$user); } + return $data; +} +############################################### +############################################### - @list = sort MySort (@list); +=pod - my $nIndex=0; +=item &compute_discrimination_factor() - return \%TempCache; -} +Inputs: $Resource, $Sequence +Returns: integer between -1 and 1 -=pod +=cut - if ( $Pos == 0 ) { - foreach my $sequence (split(':', $cache->{'orderedSequences'})) { - if($cache->{'ProblemStatisticsMaps'} ne 'All Maps' && - $cache->{'ProblemStatisticsMaps'} ne $cache->{$sequence.':title'}) { - next; - } - &CreateProblemStatisticsTableHeading($cache->{'DisplayFormat'}, - $cache->{$sequence.':source'}, - $cache->{$sequence.':title'}, - $headings,$r); - - my ($tar,$Tries,$Wrongs,$Code,$Disc)=split(/\&/, - $list[$cIdx]); - my ($SqOrd,$PrOrd,$Prob)=split(/\:/,$tar); - $sequence+=100; - while ($SqOrd==$sequence && $cIdx<$NoElements) { - my %storestats=(); - my @lpr=split(/\&/,$pr); - for (my $i=1; $i<=$#lpr; $i++) { - my($Pre, $Post) = split(/\@/,$list[$nIndex]); - #$r->print('
'.$Pre.'---'.$Post); - &TableRow($cache,$Post,$i,$nIndex,$color,\%GraphDat); - $nIndex++; - } - &CloseTable($cache); - } - } - else { - &CreateProblemStatisticsTableHeading($cache->{'DisplayFormat'}, - $cache->{$sequence.':source'}, - $cache->{$sequence.':title'}, - $headings,$r); - for ( my $nIndex = 0; $nIndex < $p_count; $nIndex++ ) { - my($Pre, $Post) = split(/\@/,$list[$nIndex]); - &TableRow($cache,$Post,$nIndex,$nIndex,$color,\%GraphDat); - } - &CloseTable($cache); +############################################### +############################################### +sub compute_discrimination_factor { + my ($resource,$part,$sequence) = @_; + my @Resources; + foreach my $res (@{$sequence->{'contents'}}) { + next if ($res->{'symb'} eq $resource->{'symb'}); + push (@Resources,$res->{'symb'}); + } + # + # rank + my ($starttime,$endtime) = &Apache::lonstathelpers::get_time_limits(); + my $ranking = + &Apache::loncoursedata::rank_students_by_scores_on_resources + (\@Resources, + \@Apache::lonstatistics::SelectedSections, + $Apache::lonstatistics::enrollment_status,undef, + $starttime,$endtime); + # + # compute their percent scores on the problems in the sequence, + my $number_to_grab = int(scalar(@{$ranking})/4); + my $num_students = scalar(@{$ranking}); + my @BottomSet = map { $_->[&Apache::loncoursedata::RNK_student()]; + } @{$ranking}[0..$number_to_grab]; + my @TopSet = + map { + $_->[&Apache::loncoursedata::RNK_student()]; + } @{$ranking}[($num_students-$number_to_grab)..($num_students-1)]; + my ($bottom_sum,$bottom_max) = + &Apache::loncoursedata::get_sum_of_scores($resource,$part,\@BottomSet, + undef,$starttime,$endtime); + my ($top_sum,$top_max) = + &Apache::loncoursedata::get_sum_of_scores($resource,$part,\@TopSet, + undef,$starttime,$endtime); + my $deg_of_disc; + if ($top_max == 0 || $bottom_max==0) { + $deg_of_disc = 'nan'; + } else { + $deg_of_disc = ($top_sum/$top_max) - ($bottom_sum/$bottom_max); } + #&Apache::lonnet::logthis(' '.$top_sum.'/'.$top_max. + # ' - '.$bottom_sum.'/'.$bottom_max); + return $deg_of_disc; +} - return \%TempCache; +############################################### +############################################### +## +## Compute KR-21 +## +## To compute KR-21, you need the following information: +## +## K=the number of items in your test +## M=the mean score on the test +## s=the standard deviation of the scores on your test +## +## then: +## +## KR-21 rk= [K/(K-1)] * [1- (M*(K-M))/(K*s^2))] +## +############################################### +############################################### +sub compute_sequence_statistics { + my ($seq) = @_; + my $symb = $seq->{'symb'}; + my @Resources; + foreach my $res (@{$seq->{'contents'}}) { + next if ($res->{'type'} ne 'assessment'); + push (@Resources,$res->{'symb'}); + } + my ($starttime,$endtime) = &Apache::lonstathelpers::get_time_limits(); + # + # First compute statistics based on student scores + my ($smin,$smax,$sMean,$sSTD,$scount,$sMAX) = + &Apache::loncoursedata::score_stats + (\@Apache::lonstatistics::SelectedSections, + $Apache::lonstatistics::enrollment_status, + \@Resources,$starttime,$endtime,undef); + $SeqStat{$symb}->{'title'} = $seq->{'title'}; + $SeqStat{$symb}->{'scoremax'} = $smax; + $SeqStat{$symb}->{'scoremin'} = $smin; + $SeqStat{$symb}->{'scoremean'} = $sMean; + $SeqStat{$symb}->{'scorestd'} = $sSTD; + $SeqStat{$symb}->{'scorecount'} = $scount; + $SeqStat{$symb}->{'max_possible'} = $sMAX; + # + # Compute statistics based on the number of correct problems + # 'correct' is taken to mean + my ($cmin,$cmax,$cMean,$cSTD,$ccount)= + &Apache::loncoursedata::count_stats + (\@Apache::lonstatistics::SelectedSections, + $Apache::lonstatistics::enrollment_status, + \@Resources,$starttime,$endtime,undef); + my $K = $seq->{'num_assess_parts'}; + my $kr_21; + if ($K > 1 && $cSTD > 0) { + $kr_21 = ($K/($K-1)) * (1 - $cMean*($K-$cMean)/($K*$cSTD**2)); + } else { + $kr_21 = 'nan'; + } + $SeqStat{$symb}->{'countmax'} = $cmax; + $SeqStat{$symb}->{'countmin'} = $cmin; + $SeqStat{$symb}->{'countstd'} = $cSTD; + $SeqStat{$symb}->{'countmean'} = $cMean; + $SeqStat{$symb}->{'count'} = $ccount; + $SeqStat{$symb}->{'items'} = $K; + $SeqStat{$symb}->{'KR-21'}=$kr_21; + return; } -=cut -sub TableRow { - my ($cache,$Str,$Idx,$RealIdx,$r,$color,$GraphDat)=@_; - my($PrOrd,$Temp,$StdNo,$TotalTries,$MxTries,$Avg,$YES,$Override, - $Wrng,$DoD,$SD,$Sk,$_D1,$_D2,$DiscNo,$Prob)=split(/\&/,$Str); - my $Ptr; - if($cache->{'DisplayFormat'} eq 'Display CSV Format') { - my ($ResId,$Dummy)=split(/\*/,$Prob); - $Ptr="\n".'
'. - "\n".'"'.($RealIdx+1).'",'. - "\n".'"'.$cache->{$ResId.':title'}.$Dummy.'",'. - "\n".'"'.$cache->{$ResId.':source'}.'",'. - "\n".'"'.$StdNo.'",'. - "\n".'"'.$TotalTries.'",'. - "\n".'"'.$MxTries.'",'. - "\n".'"'.$Avg.'",'. - "\n".'"'.$YES.'",'. - "\n".'"'.$Override.'",'. - "\n".'"'.$Wrng.'",'. - "\n".'"'.$DoD.'",'. - "\n".'"'.$SD.'",'. - "\n".'"'.$Sk.'",'. - "\n".'"'.$_D1.'",'. - "\n".'"'.$_D2.'"'. - "\n".'"'.$DiscNo.'"'; +=pod - $r->print("\n".$Ptr); - } else { - $Ptr="\n".'
$nIndex) $sortedList[$nIndex]"); - ($Problem,$tmp)=split(/\=/,$sortedList[$nIndex]); - @Dis=split(/\+/,$tmp); - my $Temp = $Problem; - do { - $nIndex++; - $nStudent++; - $Sum1 += $Dis[0]; - $Sum2 += $Dis[1]; - ($Problem,$tmp)=split(/\=/,$sortedList[$nIndex]); - @Dis=split(/\+/,$tmp); - } while ( $Problem eq $Temp && $nIndex < $Count ); - $Proc{$Temp}=($Sum1/$nStudent).':'.($Sum2/$nStudent); -# $r->print("
$nIndex) $Temp --> ($nStudent) $Proc{$Temp}"); - $Sum1=0; - $Sum2=0; - $nStudent=0; - } - - return %Proc; -} - -#------- Creating Discimination factor -sub Discriminant { - my ($discriminant,$r)=@_; -#$Apache::lonxml::debug=1; -#&Apache::lonhomework::showhash(%$discriminant); -#$Apache::lonxml::debug=0; - my @discriminantKeys=keys(%$discriminant); - my $Count = scalar @discriminantKeys; - - my $UpCnt = int(0.27*$Count); - my $low=0; - my $up=$Count-$UpCnt; - my @UpList=(); - my @LowList=(); - - $Count=0; - foreach my $key (sort(@discriminantKeys)) { - $Count++; - if($low < $UpCnt || $Count > $up) { - $low++; - my $str=$discriminant->{$key}; - foreach(split(/\&/,$str)){ - if($_) { - if($low<$UpCnt) { push(@LowList,$_); } - else { push(@UpList,$_); } - } - } - } - } - my %DisUp = &ProcessDiscriminant(\@UpList,$r); - my %DisLow = &ProcessDiscriminant(\@LowList,$r); +=item Max Tries +Largest number of tries for solving the problem by a student. - return (\%DisUp, \%DisLow); -} +=item Mean +Average number of tries. [ Tries / #Stdnts ] -#---- END Problem Statistics Web Page ---------------------------------------- +=item #YES +Number of students solved the problem correctly. -#---- Problem Statistics Graph Web Page -------------------------------------- +=item #yes +Number of students solved the problem by override. -# ------------------------------------------- Prepare data for Graphical chart +=item %Wrong +Percentage of students who tried to solve the problem +but is still incorrect. [ 100*((#Stdnts-(#YES+#yes))/#Stdnts) ] -sub BuildDiffGraph { - my ($r)=@_; +=item DoDiff +Degree of Difficulty of the problem. +[ 1 - ((#YES+#yes) / Tries) ] - my $graphData = &GetGraphData('DiffGraph', $r); - $r->print('
');
+=item S.D.
+Standard Deviation of the tries.
+[ sqrt(sum((Xi - Mean)^2)) / (#Stdnts-1)
+where Xi denotes every student\'s tries ]
- return;
-}
+=item Skew.
+Skewness of the students tries.
+[(sqrt( sum((Xi - Mean)^3) / #Stdnts)) / (S.D.^3)]
-sub BuildWrongGraph {
- my ($r)=@_;
+=item Dis.F.
+Discrimination Factor: A Standard for evaluating the
+problem according to a Criterion- my $graphData = &GetGraphData('WrongGraph', $r); - $r->print('
');
+=item [Criterion to group students into %27 Upper Students -
+and %27 Lower Students]
+1st Criterion for Sorting the Students:
+Sum of Partial Credit Awarded / Total Number of Tries
+2nd Criterion for Sorting the Students:
+Total number of Correct Answers / Total Number of Tries
- return;
-}
+=item Disc.
+Number of Students had at least one discussion.
+=back
-sub GetGraphData {
- my ($ylab,$r,%GraphDat)=@_;
- my $Col;
- my $data='';
- my $count = 0;
- my $Max = 0;
- my $cid=$ENV{'request.course.id'};
- my $GraphDB = "/home/httpd/perl/tmp/$ENV{'user.name'}".
- "_$ENV{'user.domain'}_$cid\_graph.db";
- foreach (keys %GraphDat) {delete $GraphDat{$_};}
- if (-e "$GraphDB") {
- if (tie(%GraphDat,'GDBM_File',"$GraphDB",&GDBM_READER,0640)) {
- if ( $ylab eq 'DoDiff Graph' ) {
- $ylab = 'Degree-of-Difficulty';
- $Col = 0;
- }
- else {
- $ylab = 'Wrong-Percentage';
- $Col = 1;
- }
- foreach (sort NumericSort keys %GraphDat) {
- my @Temp=split(/\:/,$GraphDat{$_});
- my $inf = $Temp[$Col];
- if ( $Max < $inf ) {$Max = $inf;}
- $data .= $inf.',';
- $count++;
- }
- if ( $Max > 1 ) {
- $Max += (10 - $Max % 10);
- $Max = int($Max);
- }
- else { $Max = 1; }
- untie(%GraphDat);
- my $Course = $ENV{'course.'.$cid.'.description'};
- $Course =~ s/\ /"_"/eg;
- my $GData=$Course.'&'.'Problems'.'&'.$ylab.'&'.
- $Max.'&'.$count.'&'.$data;
- }
- else {
- $r->print("Unable to tie hash to db file");
- }
- }
-}
+=cut
+############################################################
+############################################################
1;
__END__