Annotation of loncom/interface/statistics/lonproblemanalysis.pm, revision 1.25
1.1 stredwic 1: # The LearningOnline Network with CAPA
2: #
1.25 ! matthew 3: # $Id: lonproblemanalysis.pm,v 1.24 2003/09/29 21:13:23 matthew Exp $
1.1 stredwic 4: #
5: # Copyright Michigan State University Board of Trustees
6: #
7: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
8: #
9: # LON-CAPA is free software; you can redistribute it and/or modify
10: # it under the terms of the GNU General Public License as published by
11: # the Free Software Foundation; either version 2 of the License, or
12: # (at your option) any later version.
13: #
14: # LON-CAPA is distributed in the hope that it will be useful,
15: # but WITHOUT ANY WARRANTY; without even the implied warranty of
16: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17: # GNU General Public License for more details.
18: #
19: # You should have received a copy of the GNU General Public License
20: # along with LON-CAPA; if not, write to the Free Software
21: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
22: #
23: # /home/httpd/html/adm/gpl.txt
24: #
25: # http://www.lon-capa.org/
26: #
27:
1.11 minaeibi 28: package Apache::lonproblemanalysis;
1.1 stredwic 29:
30: use strict;
31: use Apache::lonnet();
1.25 ! matthew 32: use Apache::loncommon();
1.7 stredwic 33: use Apache::lonhtmlcommon();
1.23 matthew 34: use Apache::loncoursedata();
35: use Apache::lonstatistics;
36: use Apache::lonlocal;
1.2 stredwic 37:
1.1 stredwic 38: sub BuildProblemAnalysisPage {
1.23 matthew 39: my ($r,$c)=@_;
1.24 matthew 40: $r->print('<h2>'.&mt('Option Response Problem Analysis').'</h2>');
1.25 ! matthew 41: $r->print(&CreateInterface());
1.23 matthew 42: if (exists($ENV{'form.problemchoice'})) {
1.25 ! matthew 43: $r->print('<hr />');
! 44: &Apache::lonstatistics::Gather_Full_Student_Data($r);
1.23 matthew 45: #
1.25 ! matthew 46: my ($symb,$part,$resid) = &get_problem_symb(
1.23 matthew 47: &Apache::lonnet::unescape($ENV{'form.problemchoice'})
48: );
49: $r->print('<hr />');
50: my $resource = &get_resource_from_symb($symb);
51: if (defined($resource)) {
1.25 ! matthew 52: my %Data = &get_problem_data($resource->{'src'});
! 53: my $ORdata = $Data{$part.'.'.$resid};
! 54: ##
! 55: ## Render the problem for display
! 56: my $base;
! 57: ($base,undef) = ($resource->{'src'} =~ m|(.*/)[^/]*$|);
! 58: $base = "http://".$ENV{'SERVER_NAME'}.$base;
! 59: $r->print('</form>'.
! 60: '<table bgcolor="ffffff"><tr><td>'.
! 61: '<base href="'.$base.'" />'.
! 62: # &Apache::loncommon::get_student_view
! 63: # ($symb,$ENV{'user.name'},$ENV{'user.domain'},$ENV{'request.course.id'},'web').
1.23 matthew 64: &Apache::lonnet::ssi_body($resource->{'src'}).
1.25 ! matthew 65: '</td></tr></table>'.
! 66: '<form name="Statistics" method="post" action="/adm/statistics">');
! 67: ##
! 68: ## Analyze the problem
! 69: my @Data = &Apache::loncoursedata::get_optionresponse_data
! 70: (undef,$symb,$resid);
! 71: my $analysis_html = &DoTriesAnalysis(\@Data,$ORdata);
! 72: $r->print($analysis_html);
1.23 matthew 73: } else {
74: $r->print('resource is undefined');
1.7 stredwic 75: }
1.23 matthew 76: $r->print('<ol>');
1.25 ! matthew 77: $r->print("<li /><strike>render problem</strike>\n");
! 78: $r->print("<li /><strike>Get student response data</strike>\n");
1.23 matthew 79: $r->print("<li />image tag for plot\n");
80: $r->print("<li />plot key\n");
81: $r->print('</ol>');
82: $r->print('<hr />');
1.25 ! matthew 83: } else {
! 84: $r->print('<h3>No Problem Selected</h3>');
1.1 stredwic 85: }
1.23 matthew 86: # Okay, they asked for data, so make sure we get the latest data.
87: $r->print(&OptionResponseProblemSelector());
1.1 stredwic 88: }
89:
1.25 ! matthew 90:
! 91: sub DoTriesAnalysis {
! 92: my ($Data,$ORdata) = @_;
! 93: my $mintries = 1;
! 94: my $maxtries = 3;
! 95: my %ResponseData = &analyze_option_data_by_tries($Data,
! 96: $mintries,$maxtries);
! 97: my @Foils = sort(keys(%ResponseData));
! 98: my %Row_Label;
! 99: foreach my $foilid (@Foils) {
! 100: my $value = $ORdata->{'Foiltext'}->{$foilid};
! 101: &Apache::lonnet::logthis('row label '.$foilid.' = '.$value);
! 102: $Row_Label{$foilid} = $ORdata->{'Foiltext'}->{$foilid};
! 103: }
! 104: my @Rows;
! 105: $Rows[0] = ['<td> </td>'];
! 106: for (my $i=$mintries;$i<=$maxtries;$i++) {
! 107: push (@{$Rows[0]},
! 108: '<th colspan="3">'.&mt('Attempt').' '.$i.'</th>');
! 109: }
! 110: $Rows[1] = ['<th>'.&mt('Foil').'</th>'];
! 111: for (my $i=$mintries;$i<=$maxtries;$i++) {
! 112: push (@{$Rows[1]},('<th>'.&mt('Correct').'</th>',
! 113: '<th>'.&mt('Incorrect').'</th>',
! 114: '<th>'.&mt('Percent Correct').'</th>',
! 115: ));
! 116: }
! 117: my @PlotData;
! 118: my @CumulativePlotData;
! 119: my $index = 1;
! 120: foreach my $foilid (@Foils) {
! 121: my @Data = ('<td>'.$index.' '.$Row_Label{$foilid}.'</td>');
! 122: for (my $i=$mintries;$i<=$maxtries;$i++) {
! 123: push(@Data,
! 124: ('<td>'.$ResponseData{$foilid}->[$i]->{'correct'}.'</td>',
! 125: '<td>'.$ResponseData{$foilid}->[$i]->{'incorrect'}.
! 126: '</td>',
! 127: '<td>'.
! 128: sprintf("%4.2f",
! 129: $ResponseData{$foilid}->[$i]->{'percent_corr'}).
! 130: '</td>'));
! 131: #
! 132: # Gather the per-attempt data
! 133: push (@{$PlotData[$i]->{'good'}},
! 134: $ResponseData{$foilid}->[$i]->{'percent_corr'});
! 135: push (@{$PlotData[$i]->{'bad'}},
! 136: 100-$ResponseData{$foilid}->[$i]->{'percent_corr'});
! 137: }
! 138: for (my $i=0;$i<=$maxtries;$i++) {
! 139: push (@{$CumulativePlotData[$i]->{'good'}},
! 140: $CumulativePlotData[-1]->{'good'}+
! 141: $ResponseData{$foilid}->[$i]->{'correct'});
! 142: push (@{$CumulativePlotData[$i]->{'bad'}},
! 143: $CumulativePlotData[-1]->{'bad'}+
! 144: $ResponseData{$foilid}->[$i]->{'incorrect'});
! 145: }
! 146: push(@Rows,\@Data);
! 147: } continue {
! 148: $index++;
! 149: }
! 150: my @Data = ('<td></td>');
! 151: for (my $i=$mintries;$i<=$maxtries;$i++) {
! 152: push(@Data,'<td colspan="3">'.&DrawGraph('Attempt '.$i,'Foil Number',
! 153: 'Percent Correct',100,
! 154: $PlotData[$i]->{'good'},
! 155: $PlotData[$i]->{'bad'}).'</td>');
! 156: }
! 157: push (@Rows,\@Data);
! 158: my $table = '<table border="1" >'."\n";
! 159: for (my $i=0; $i <=$#Rows;$i++) {
! 160: $table .= '<tr>'.join('',@{$Rows[$i]})."</tr>\n";
! 161: }
! 162: $table .= '</table>';
! 163: return ($table);
! 164: }
! 165:
! 166: sub analyze_option_data_by_tries {
! 167: my ($data,$mintries,$maxtries) = @_;
! 168: my %Trydata;
! 169: $mintries = 1 if (! defined($mintries) || $mintries < 1);
! 170: $maxtries = $mintries if (! defined($maxtries) || $maxtries < $mintries);
! 171: foreach my $row (@$data) {
! 172: my ($grading,$submission,$time,$tries) = @$row;
! 173: my @Foilgrades = split('&',$grading);
! 174: my @Foilsubs = split('&',$submission);
! 175: for (my $numtries = 1; $numtries <= $maxtries; $numtries++) {
! 176: if ($tries == $numtries) {
! 177: foreach my $foilgrade (@Foilgrades) {
! 178: my ($foilid,$correct) = split('=',$foilgrade);
! 179: if ($correct) {
! 180: $Trydata{$foilid}->[$numtries]->{'correct'}++;
! 181: } else {
! 182: $Trydata{$foilid}->[$numtries]->{'incorrect'}++;
! 183: }
! 184: }
! 185: }
! 186: }
! 187: }
! 188: foreach my $foilid (keys(%Trydata)) {
! 189: foreach my $tryhash (@{$Trydata{$foilid}}) {
! 190: next if ((! exists($tryhash->{'correct'}) &&
! 191: ! exists($tryhash->{'incorrect'})) ||
! 192: ($tryhash->{'correct'} < 1 &&
! 193: $tryhash->{'incorrect'} < 1));
! 194: $tryhash->{'percent_corr'} = 100 *
! 195: ($tryhash->{'correct'} /
! 196: ($tryhash->{'correct'} + $tryhash->{'incorrect'})
! 197: );
! 198: }
! 199: }
! 200: return %Trydata;
! 201: }
! 202:
! 203: sub DrawGraph {
! 204: my ($title,$xlabel,$ylabel,$MaxY,$values1,$values2)=@_;
! 205: $title = '' if (! defined($title));
! 206: $xlabel = '' if (! defined($xlabel));
! 207: $ylabel = '' if (! defined($ylabel));
! 208: $title = &Apache::lonnet::escape($title);
! 209: $xlabel = &Apache::lonnet::escape($xlabel);
! 210: $ylabel = &Apache::lonnet::escape($ylabel);
! 211: #
! 212: my $sendValues1 = join(',', @$values1);
! 213: my $sendValues2;
! 214: if (defined($values2)) {
! 215: $sendValues2 = join(',', @$values2);
! 216: }
! 217:
! 218: my $sendCount = scalar(@$values1);
! 219: $MaxY =1 if ($MaxY < 1);
! 220: if ( int($MaxY) < $MaxY ) {
! 221: $MaxY++;
! 222: $MaxY = int($MaxY);
! 223: }
! 224: my @GData = ($title,$xlabel,$ylabel,$MaxY,$sendCount,$sendValues1);
! 225: if (defined($sendValues2)) {
! 226: push (@GData,$sendValues2);
! 227: }
! 228: return '<IMG src="/cgi-bin/graph.png?'.
! 229: (join('&', @GData)).'" border="1" />';
! 230: }
! 231:
! 232:
! 233:
1.23 matthew 234: sub get_problem_symb {
235: my $problemstring = shift();
1.25 ! matthew 236: my ($symb,$partid,$resid) = ($problemstring=~ /^(.*):([^:]*):([^:]*)$/);
! 237: return ($symb,$partid,$resid);
1.1 stredwic 238: }
239:
1.23 matthew 240: sub CreateInterface {
1.7 stredwic 241: my $Str = '';
1.23 matthew 242: $Str .= '<table cellspacing="5">'."\n";
243: $Str .= '<tr>';
244: $Str .= '<td align="center"><b>'.&mt('Sections').'</b></td>';
245: $Str .= '<td align="center"><b>'.&mt('Enrollment Status').'</b></td>';
246: $Str .= '<td align="center"><b>'.&mt('Sequences and Folders').'</b></td>';
247: $Str .= '</tr>'."\n";
248: #
249: $Str .= '<tr><td align="center">'."\n";
250: $Str .= &Apache::lonstatistics::SectionSelect('Section','multiple',5);
251: $Str .= '</td><td align="center">';
252: $Str .= &Apache::lonhtmlcommon::StatusOptions(undef,undef,5);
253: $Str .= '</td><td align="center">';
254: my $only_seq_with_assessments = sub {
255: my $s=shift;
256: if ($s->{'num_assess'} < 1) {
257: return 0;
258: } else {
259: return 1;
260: }
261: };
262: $Str .= &Apache::lonstatistics::MapSelect('Maps','multiple,all',5,
263: $only_seq_with_assessments);
264: $Str .= '</td></tr>'."\n";
265: $Str .= '</table>'."\n";
266: $Str .= '<input type="submit" name="ProblemAnalysis" value="'.
267: &mt('Analyze Problem').'" />';
268: $Str .= ' 'x5;
269: $Str .= '<input type="submit" name="ClearCache" value="'.
270: &mt('Clear Caches').'" />';
271: $Str .= ' 'x5;
272: return ($Str);
273: }
274:
275: sub OptionResponseProblemSelector {
276: my $Str;
277: $Str = "\n<table>\n";
278: foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
279: next if ($seq->{'num_assess'}<1);
280: my $seq_str = '';
281: foreach my $res (@{$seq->{'contents'}}) {
282: # &Apache::lonnet::logthis('checking '.$res->{'title'});
283: # next if ($res->{'type'} ne 'assessment');
284: foreach my $part (@{$res->{'parts'}}) {
285: my $partdata = $res->{'partdata'}->{$part};
286: if (! exists($partdata->{'option'}) ||
287: $partdata->{'option'} == 0) {
288: next;
289: }
290: for (my $i=0;$i<scalar(@{$partdata->{'ResponseTypes'}});$i++){
291: my $respid = $partdata->{'ResponseIds'}->[$i];
292: my $resptype = $partdata->{'ResponseTypes'}->[$i];
293: if ($resptype eq 'option') {
1.25 ! matthew 294: my $value = &Apache::lonnet::escape($res->{'symb'}.':'.$part.':'.$respid);
1.23 matthew 295: my $checked = '';
296: if ($ENV{'form.problemchoice'} eq $value) {
297: $checked = 'checked ';
298: }
299: $seq_str .= '<tr><td>'.
300: '<input type="radio" name="problemchoice" value="'.$value.'" '.$checked.'/>'.
301: '</td><td>'.
302: '<a href="'.$res->{'src'}.'">'.$res->{'title'}.'</a> ';
303: if ($partdata->{'option'} > 1) {
304: $seq_str .= &mt('response').' '.$respid;
305: }
306: $seq_str .= "</td></tr>\n";
1.11 minaeibi 307: }
308: }
309: }
310: }
1.23 matthew 311: if ($seq_str ne '') {
312: $Str .= '<tr><td> </td><td><b>'.$seq->{'title'}.'</b></td>'.
313: "</tr>\n".$seq_str;
314: }
1.11 minaeibi 315: }
1.23 matthew 316: $Str .= "</table>\n";
317: return $Str;
1.11 minaeibi 318: }
319:
1.23 matthew 320: sub get_resource_from_symb {
321: my ($symb) = @_;
322: foreach my $seq (&Apache::lonstatistics::Sequences_with_Assess()) {
323: foreach my $res (@{$seq->{'contents'}}) {
324: if ($res->{'symb'} eq $symb) {
325: return $res;
1.2 stredwic 326: }
1.1 stredwic 327: }
328: }
1.23 matthew 329: return undef;
1.1 stredwic 330: }
331:
1.25 ! matthew 332: sub get_problem_data {
! 333: my ($url) = @_;
! 334: # my $Answ=&Apache::lonnet::ssi($URI,('grade_target' => 'analyze',
! 335: # 'grade_username' => $sname,
! 336: # 'grade_domain' => $sdom,
! 337: # 'grade_courseid' => $cid,
! 338: # 'grade_symb' => $symb));
! 339: my $Answ=&Apache::lonnet::ssi($url,('grade_target' => 'analyze'));
1.23 matthew 340: (my $garbage,$Answ)=split(/_HASH_REF__/,$Answ,2);
1.25 ! matthew 341: my %Answer;
1.23 matthew 342: %Answer=&Apache::lonnet::str2hash($Answ);
1.25 ! matthew 343: # &Apache::lonnet::logthis('keys of %Answer = '.join(', ',(keys(%Answer))));
! 344: # &Apache::lonnet::logthis('$Answer{parts} = '.
! 345: # join(', ',@{$Answer{'parts'}}));
! 346: my %Partdata;
! 347: foreach my $part (@{$Answer{'parts'}}) {
! 348: while (my($key,$value) = each(%Answer)) {
! 349: next if ($key !~ /^$part/);
! 350: $key =~ s/^$part\.//;
! 351: if (ref($value) eq 'ARRAY') {
! 352: if ($key eq 'options') {
! 353: $Partdata{$part}->{'Options'}=$value;
! 354: } elsif ($key eq 'concepts') {
! 355: $Partdata{$part}->{'Concepts'}=$value;
! 356: } elsif ($key =~ /^concept\.(.*)$/) {
! 357: my $concept = $1;
! 358: foreach my $foil (@$value) {
! 359: $Partdata{$part}->{$foil}->{'Concept'}=$concept;
! 360: }
! 361: }
! 362: &Apache::lonnet::logthis($part.' '.$key.' (array) = '.
! 363: join(', ',@$value));
! 364: } else {
! 365: $value =~ s/^\s*//g;
! 366: $value =~ s/\s*$//g;
! 367: if ($key=~ /^foil\.text\.(.*)$/) {
! 368: my $foil = $1;
! 369: $Partdata{$part}->{'Foiltext'}->{$foil}=$value;
! 370: } elsif ($key =~ /^foil\.value\.(.*)$/) {
! 371: my $foil = $1;
! 372: $Partdata{$part}->{'FoilValues'}->{$foil}=$value;
! 373: }
! 374: &Apache::lonnet::logthis($part.' '.$key.' = '.$value);
! 375: }
! 376: }
1.23 matthew 377: }
378:
1.25 ! matthew 379: # my $parts='';
! 380: # foreach my $elm (@{$Answer{"parts"}}) {
! 381: # $parts.="$elm,";
! 382: # }
! 383: # chop($parts);
! 384: # my $conc='';
! 385: # foreach my $elm (@{$Answer{"$parts.concepts"}}) {
! 386: # $conc.="$elm@";
! 387: # }
! 388: # chop($conc);
! 389: #
! 390: # @Concepts=split(/\@/,$conc);
! 391: # foreach my $concept (@{$Answer{"$parts.concepts"}}) {
! 392: # foreach my $foil (@{$Answer{"$parts.concept.$concept"}}) {
! 393: # $foil_to_concept{$foil} = $concept;
! 394: # #$ConceptData{$foil} = $Answer{"$parts.foil.value.$foil"};
! 395: # }
! 396: # }
! 397: # return $symb;
! 398: return %Partdata;
1.1 stredwic 399: }
400:
1.23 matthew 401: 1;
1.1 stredwic 402:
403: __END__
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>