File:  [LON-CAPA] / loncom / interface / statistics / lonproblemanalysis.pm
Revision 1.18: download - view: text, annotated - select for diffs
Fri Dec 13 21:39:19 2002 UTC (21 years, 5 months ago) by albertel
Branches: MAIN
CVS tags: version_0_6_2, version_0_6, HEAD
- using png now

# The LearningOnline Network with CAPA
# (Publication Handler
#
# $Id: lonproblemanalysis.pm,v 1.18 2002/12/13 21:39:19 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# (Navigate problems for statistical reports
# YEAR=2002
# 5/12,7/26,9/7,11/22 Behrouz Minaei
#
###

package Apache::lonproblemanalysis;

use strict;
use Apache::lonnet();
use Apache::lonhtmlcommon();
use GDBM_File;

my $jr;

sub BuildProblemAnalysisPage {
    my ($cacheDB, $r)=@_;

    my %cache;
    unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
        $r->print('Unable to tie database.');
        return;
    }

    my $Ptr = '';
    $Ptr .= '<table border="0"><tbody>';
    $Ptr .= '<tr><td align="right"><b>Select Sections</b>';
    $Ptr .= '</td>'."\n";
    $Ptr .= '<td align="left">'."\n";
    my @sectionsSelected = split(':',$cache{'sectionsSelected'});
    my @sections = split(':',$cache{'sectionList'});
    $Ptr .= &Apache::lonhtmlcommon::MultipleSectionSelect(\@sections,
                                                          \@sectionsSelected,
                                                          'Statistics');
    $Ptr .= '</td></tr>'."\n";
    $Ptr .= '<tr><td align="right"><b>Intervals</b></td>'."\n";
    $Ptr .= '<td align="left">';
    $Ptr .= &IntervalOptions($cache{'Interval'});
    $Ptr .= '</td></tr></table><br>';
    $r->print($Ptr);
    $r->rflush();
#   $r->print($cache{'OptionResponses'}.'<br>');
    $r->print(&OptionResponseTable($cache{'OptionResponses'}, \%cache, $r));

    untie(%cache);

    return;
}

sub BuildAnalyzePage {
    my ($cacheDB, $students, $courseID,$r)=@_;

    $jr = $r;
    my $c = $r->connection;

    my $Str = '</form>';
    my %cache;

    unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
        $Str .= 'Unable to tie database.';
        $r->print($Str);
        return;
    }

    # Remove students who don't have the proper section.
    my @sectionsSelected = split(':',$cache{'sectionsSelected'});

    my $studentCount = scalar @$students;
    for(my $studentIndex=$studentCount-1; $studentIndex>=0;
        $studentIndex--) {
        my $value = $cache{$students->[$studentIndex].':section'};
        my $found = 0;
        foreach (@sectionsSelected) {
            if($_ eq 'none') {
                if($value eq '' || !defined($value) || $value eq ' ') {
                    $found = 1;
                    last;
                }
            } else {
                if($value eq $_) {
                    $found = 1;
                    last;
                }
            }
        }
        if($found == 0) {
            splice(@$students, $studentIndex, 1);
        }
    }
    unless(untie(%cache)) {
        $r->print('Can not untie hash.');
        $r->rflush();
    }

    &Apache::lonhtmlcommon::Close_PrgWin($r);

### jason code for checing is there data in cache
#    my $error =
#        &Apache::loncoursedata::DownloadStudentCourseDataSeparate($students,
#                                                                  'true',
#                                                                  $cacheDB,
#                                                                  'true',
#                                                                  'true',
#                                                                  $courseID,
#                                                                  $r, $c);
#    if($error ne 'OK') {
#        $r->print($error.'<br>Error downloading course data<br>');
#        return;
#    }

    unless(tie(%cache,'GDBM_File',$cacheDB,&GDBM_READER(),0640)) {
        $Str .= 'Unable to tie database.';
        $r->print($Str);
        return;
    }

    my ($problemId, $part, $responseId)=split(':',$cache{'AnalyzeInfo'});
    my $uri      = $cache{$problemId.':source'};
    my $problem  = $cache{$problemId.':problem'};
    my $title    = $cache{$problemId.':title'};
    my $interval = $cache{'Interval'};
    my $heading = 'Restore this particular Option Response Problem '.
                  'Results, Please wait...';

    my %ConceptData;
    $ConceptData{"Interval"} = $interval;

    #Initialize the option response true answers
    my ($analyzeData) = &InitAnalysis($uri, $part, $responseId, $problem,
                                      $students->[0], $courseID);
    if(defined($analyzeData->{'error'})) {
        $Str .= $analyzeData->{'error'}.'<br>Incorrect part requested.<br>';
        $r->print($Str);
        return;
    }

    $r->print($Str);
    $Str = '';
    if($c->aborted()) {  untie(%cache); return; }

    #compute the intervals
    &Interval($part, $problem, $interval, $analyzeData->{'concepts'},
              \%ConceptData);

    $title =~ s/\ /"_"/eg;
    $Str .= '<br><b>'.$uri.'</b>';

    $r->print($Str);
    $Str = '';
    if($c->aborted()) {  untie(%cache); return; }

    &Apache::lonhtmlcommon::Create_PrgWin($r, $title, $heading);

    my $count=0;
    #Java script Progress window
    for(my $index=0; $index<(scalar @$students); $index++) {
        if($c->aborted()) {  untie(%cache); return; }
        $count++;
        my $displayString = $count.'/'.$studentCount.': '.$_;
        &Apache::lonhtmlcommon::Update_PrgWin($displayString, $r);
	&OpStatus($problemId, $students->[$index], \%ConceptData,
                  $analyzeData->{'foil_to_concept'}, $analyzeData,
		  \%cache, $courseID);
    }
    &Apache::lonhtmlcommon::Close_PrgWin($r);

    $Str .= '<br>';
    for (my $k=0; $k<$interval; $k++ ) {
        if($c->aborted()) {  untie(%cache); return $Str; }
	$Str .= &DrawGraph($k, $title, $analyzeData->{'concepts'},
                           \%ConceptData);
        $r->print($Str);
        $Str = '';
    }
    for (my $k=0; $k<$interval; $k++ ) {
        if($c->aborted()) {  untie(%cache); return $Str; }
	$Str .= &DrawTable($k, $analyzeData->{'concepts'}, \%ConceptData);
        $r->print($Str);
        $Str = '';
    }
    my $Answ=&Apache::lonnet::ssi($uri);
    $Str .= '<br><b>Here you can see the Problem:</b><br>'.$Answ;
    $Str .= '<form>';
    $r->print($Str);

    untie(%cache);

    return;
}

#---- Problem Analysis Web Page ----------------------------------------------

sub IntervalOptions {
    my ($selectedInterval)=@_;

    my $interval = 1;
    for(my $n=1; $n<=7; $n++) {
        if($selectedInterval == $n) {
            $interval = $n;
        }
    }

    my $Ptr = '<select name="Interval">'."\n";
    for(my $n=1; $n<=7;$ n++) {
	$Ptr .= '<option';
        if($interval == $n) {
            $Ptr .= ' selected';
        }
	$Ptr .= '>'.$n."</option>"."\n";
    }
    $Ptr .= '</select>'."\n";

    return $Ptr;
}

sub OptionResponseTable {
    my ($optionResponses,$cache,$r)=@_;

    my @optionResponses=split(':::', $optionResponses);
    my %partCount;
    my %sequences;
    my @orderedSequences=();
    foreach(@optionResponses) {
        my ($sequence, $problemId, $part, undef)=split(':',$_);
        $partCount{$problemId.':'.$part}++;
        if(!defined($sequences{$sequence})) {
            push(@orderedSequences, $sequence);
            $sequences{$sequence} = $_;
        } else {
            $sequences{$sequence} .= ':::'.$_;
        }
    }

    my $Str = '';

    foreach my $sequence (@orderedSequences) {
        my @optionProblems = split(':::', $sequences{$sequence});

        $Str .= '<b>'.$cache->{$sequence.':title'}.'</b>'."\n";
        $Str .= "<table border=2><tr><th> \# </th><th> Problem Title </th>";
        $Str .= '<th> Resource </th><th> Analysis  </th></tr>'."\n";

        my $count = 1;
        foreach(@optionProblems) {
            my (undef, $problemId, $part, $response)=
                split(':',$optionProblems[$count-1]);
#                split(':',$sequences{$sequence});
            my $uri = $cache->{$problemId.':source'};
            my $title = $cache->{$problemId.':title'};

            my $Temp = '<a href="'.$uri.'" target="_blank">'.$title.'</a>';
            $Str .= '<tr>';
            $Str .= '<td> '.$count.' </td>';
            $Str .= '<td bgcolor="#DDFFDD">'.$Temp.'</td>';
            $Str .= '<td bgcolor="#EEFFCC">'.$uri.'</td>';
            if($partCount{$problemId.':'.$part} < 2) {
                $Str .= '<td><input type="submit" name="Analyze:::';
                $Str .= $problemId.':'.$part.'" value="';
                $Str .= 'Part '.$part;
                $Str .= '" /></td></tr>'."\n";
            } else {
                my $value = $problemId.':'.$part.':'.$response;
                $Str .= '<td><input type="submit" name="Analyze:::'.$value;
                $Str .= '" value="';
                $Str .= 'Part '.$part.' Response '.$response;
                $Str .= '" /></td></tr>'."\n";
            }
            $count++;
        }
        $Str .= '</table><br>'."\n";
    }

    return $Str;
}

#---- END Problem Analysis Web Page ------------------------------------------

#---- Analyze Web Page -------------------------------------------------------

# Joson code for reading data from cache
=pod
sub OpStatus {
    my ($problemID, $student, $ConceptData, $foil_to_concept,
        $analyzeData, $cache)=@_;

    my $ids = $analyzeData->{'parts'};

    my @True = ();
    my @False = ();
    my $flag=0;

    my $tries=0;

    foreach my $id (@$ids) {
	my ($part, $response) = split(/\./, $id);
        my $time=$cache->{$student.':'.$problemID.':'.$part.':timestamp'};
        my @submissions = split(':::', $cache->{$student.':'.$problemID.':'.
                                                $part.':'.$response.
                                                ':submission'});
        foreach my $Resp (@submissions) {
            my %submission=&Apache::lonnet::str2hash($Resp);
            foreach (keys(%submission)) {
                if($submission{$_}) {
                    my $answer = $analyzeData->{$id.'.foil.value.'.$_};
                    if($submission{$_} eq $answer) {
                        &Decide("true", $foil_to_concept->{$_},
                                $time, $ConceptData);
                    } else {
                        &Decide("false", $foil_to_concept->{$_},
                                $time, $ConceptData);
                    }
                }
            }
        }
    }

    return;
}
=cut


#restore the student submissions and finding the result

sub OpStatus {
    my ($problemID, $student, $ConceptData, $foil_to_concept,
        $analyzeData, $cache, $courseID)=@_;

    my $ids = $analyzeData->{'parts'};
    my ($uname,$udom)=split(/\:/,$student);
    my $symb  = $cache->{$problemID.':problem'};

    my @True = ();
    my @False = ();
    my $flag=0;
    my $tries=0;

    foreach my $id (@$ids) {
	my ($part, $response) = split(/\./, $id);
    	my %reshash=&Apache::lonnet::restore($symb,$courseID,$udom,$uname);
    	if ($reshash{'version'}) {
            my $tries=0;
            for (my $version=1;$version<=$reshash{'version'};$version++) {
	    	my $time=$reshash{"$version:timestamp"};
	    	foreach my $key (sort(split(/\:/,$reshash{$version.':keys'}))) {
                    if (($key=~/\.(\w+)\.(\w+)\.submission$/)) {
		        my $Id1 = $1; my $Id2 = $2;
		        #check if this is a repeat submission, if so skip it
          	        if ($reshash{"$version:resource.$Id1.previous"}) { next; }
		        #if no solved this wasn't a real submission, ignore it
		        if (!defined($reshash{"$version:resource.$Id1.solved"})) {
			    &Apache::lonxml::debug("skipping ");
			    next;
		        }
		        my $Resp = $reshash{"$version:$key"};
		        my %submission=&Apache::lonnet::str2hash($Resp);
		        foreach (keys %submission) {
			    my $Ansr = $analyzeData->{"$Id1.$Id2.foil.value.$_"};
                    	    if($submission{$_} eq $Ansr) {
                        	&Decide("true", $foil_to_concept->{$_},
                                	$time, $ConceptData);
                    	    } else {
                        	&Decide("false", $foil_to_concept->{$_},
					$time, $ConceptData);
                    	    }
		        }
	            }
	        }
            }
        }
    }

    return;
}


sub DrawGraph {
    my ($k,$Src,$Concepts,$ConceptData)=@_;
    my $Max=0;
    my @data1;
    my @data2;

    # Adjust Data and find the Max
    for (my $n=0; $n<(scalar @$Concepts); $n++ ) {
	my $tmp=$Concepts->[$n];
	$data1[$n]=$ConceptData->{$tmp.'.'.$k.'.true'};
	$data2[$n]=$ConceptData->{$tmp.'.'.$k.'.false'};
	my $Sum=$data1[$n]+$data2[$n];
	if($Max < $Sum) {
            $Max=$Sum;
        }
    }
    for (my $n=0; $n<(scalar @$Concepts); $n++ ) {
	if ($data1[$n]+$data2[$n]<$Max) {
	    $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
	}
    }
    my $P_No = (scalar @data1);

    if($Max > 1) { 
	$Max += (10 - $Max % 10);
	$Max = int($Max);
    } else {
        $Max = 1;
    }

    my $Titr=($ConceptData->{'Interval'}>1) ? $Src.'_interval_'.($k+1) : $Src;
#    $GData=$Titr.'&Concepts'.'&'.'Answers'.'&'.$Max.'&'.$P_No.'&'.$data1.'&'.$data2;
    my $GData = '';
    $GData  = $Titr.'&Concepts&Answers&'.$Max.'&'.$P_No.'&';
    $GData .= (join(',',@data1)).'&'.(join(',',@data2));

    return '<IMG src="/cgi-bin/graph.png?'.$GData.'" border=1/>';
}

sub DrawTable {
    my ($k,$Concepts,$ConceptData)=@_;
    my $Max=0;
    my @data1;
    my @data2;
    my $Correct=0;
    my $Wrong=0;
    for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
	my $tmp=$Concepts->[$n];
	$data1[$n]=$ConceptData->{$tmp.'.'.$k.'.true'};
	$Correct+=$data1[$n];
	$data2[$n]=$ConceptData->{$tmp.'.'.$k.'.false'};
	$Wrong+=$data2[$n];
	my $Sum=$data1[$n]+$data2[$n];
	if($Max < $Sum) {
            $Max=$Sum;
        }
    }
    for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
	if ($data1[$n]+$data2[$n]<$Max) {
	    $data2[$n]+=$Max-($data1[$n]+$data2[$n]);
	}
    }
    my $P_No = (scalar @data1);
    my $Str = '';
#    $Str .= '<br><b>From: ['.localtime($ConceptData->{'Int.'.($k-1)});
#    $Str .= '] To: ['.localtime($ConceptData->{"Int.$k"}).']</b>';
    $Str .= "\n".'<table border=2>'.
            "\n".'<tr>'.
            "\n".'<th> # </th>'.
            "\n".'<th> Concept </th>'.
            "\n".'<th> Correct </th>'.
            "\n".'<th> Wrong </th>'.
            "\n".'</tr>';

    for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
	$Str .= '<tr>'."\n";
        $Str .= '<td>'.($n+1).'</td>'."\n";
        my ($currentConcept) = split('::',$Concepts->[$n]);
        $Str .= '<td bgcolor="EEFFCC">'.$currentConcept;
        $Str .= '</td>'."\n";
        $Str .= '<td bgcolor="DDFFDD">'.$data1[$n].'</td>'."\n";
        $Str .= '<td bgcolor="FFDDDD">'.$data2[$n].'</td>'."\n";
        $Str .= '</tr>'."\n";
    }
    $Str .= '<td></td><td><b>From:['.localtime($ConceptData->{'Int.'.$k});
    $Str .= '] To: ['.localtime($ConceptData->{'Int.'.($k+1)}-1);
    $Str .= ']</b></td><td>'.$Correct.'</td><td>'.$Wrong.'</td>';
    $Str .= '</table>'."\n";

    return $Str;
#$Apache::lonxml::debug=1;
#&Apache::lonhomework::showhash(%ConceptData);
#$Apache::lonxml::debug=0;
}

#---- END Analyze Web Page ----------------------------------------------

sub Decide {
    #deciding the true or false answer belongs to each interval
    my ($type,$concept,$time,$ConceptData)=@_; 
    my $k=0;
    while($time > $ConceptData->{'Int.'.($k+1)} && 
           $k < $ConceptData->{'Interval'}) {
        $k++;
    }
    $ConceptData->{$concept.'.'.$k.'.'.$type}++;

    return;
}

sub InitAnalysis {
    my ($uri,$part,$responseId,$problem,$student,$courseID)=@_;
    my ($name,$domain)=split(/\:/,$student);

    my %analyzeData;
    # Render the student's view of the problem.  $Answ is the problem 
    # Stringafied
    my $Answ=&Apache::lonnet::ssi($uri,('grade_target'   => 'analyze',
                                        'grade_username' => $name,
                                        'grade_domain'   => $domain,
                                        'grade_courseid' => $courseID,
                                        'grade_symb'     => $problem));
    my ($Answer)=&Apache::lonnet::str2hashref($Answ);

    my $found = 0;
    my @parts=();
    if(defined($responseId)) {
        foreach (@{$Answer->{'parts'}}) {
            if($_ eq $part.'.'.$responseId) {
                push(@parts, $_);
                $found = 1;
                last;
            }
        }
    } else {
        foreach (@{$Answer->{'parts'}}) {
            if($_ =~ /$part/) {
                push(@parts, $_);
                $found = 1;
                last;
            }
        }
    }

    if($found == 0) {
        $analyzeData{'error'} = 'No parts matching selected values';
        return \%analyzeData;
    }

    my @Concepts=();
    my %foil_to_concept;
    foreach my $currentPart (@parts) {
        if(defined($Answer->{$currentPart.'.concepts'})) {
            foreach my $concept (@{$Answer->{$currentPart.'.concepts'}}) {
                push(@Concepts, $concept);
                foreach my $foil (@{$Answer->{$currentPart.'.concept.'.
                                            $concept}}) {
                    $analyzeData{$currentPart.'.foil.value.'.$foil} =
                        $Answer->{$currentPart.'.foil.value.'.$foil};
                    $foil_to_concept{$foil} = $concept;
                }
            }
        } else {
            foreach (keys(%$Answer)) {
                if(/$currentPart.foil\.value\.(.*)$/) {
                    push(@Concepts, $1);
                    $foil_to_concept{$1} = $1;
                    $analyzeData{$currentPart.'.foil.value.'.$1} =
                        $Answer->{$currentPart.'.foil.value.'.$1};
                }
            }
        }
    }

    $analyzeData{'parts'} = \@parts;
    $analyzeData{'concepts'} = \@Concepts;
    $analyzeData{'foil_to_concept'} = \%foil_to_concept;

    return \%analyzeData;
}

sub Interval {
    my ($part,$symb,$interval,$Concepts,$ConceptData)=@_;
    my $Int=$interval;
    my $due = &Apache::lonnet::EXT('resource.'.$part.'.duedate',$symb);
    my $opn = &Apache::lonnet::EXT('resource.'.$part.'.opendate',$symb);
    my $add=int(($due-$opn)/$Int);
    $ConceptData->{'Int.0'}=$opn;
    for(my $i=1; $i<$Int; $i++) {
	$ConceptData->{'Int.'.$i}=$opn+$i*$add;
    }
    $ConceptData->{'Int.'.$Int}=$due;
    for(my $i=0; $i<$Int; $i++) {
	for(my $n=0; $n<(scalar @$Concepts); $n++ ) {
	    my $tmp=$Concepts->[$n];
	    $ConceptData->{$tmp.'.'.$i.'.true'}=0;
	    $ConceptData->{$tmp.'.'.$i.'.false'}=0;
	}
    }
}
1;
__END__

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