--- capa/capa51/GUITools/capastats.tcl 2000/02/22 18:10:27 1.13 +++ capa/capa51/GUITools/capastats.tcl 2000/03/22 21:08:02 1.14 @@ -96,24 +96,38 @@ proc CTcapaStat2 { num } { if { [ catch { CTdatestamp $cmdnum - set day [CTgetWhen $cmdnum] - set file [file join $gFile($num) records "subset$setId.db"] - displayStatus "Generating [file tail $file]" both $cmdnum - CTcreateSubset $num $cmdnum $day $setId - updateStatusBar 0.0 $cmdnum - updateStatusMessage "Generating Stats [file tail $file]" $cmdnum - CTscanSetDB $cmdnum $file Q_cnt L_cnt - updateStatusBar 0.0 $cmdnum - updateStatusMessage "Generating Averages [file tail $file]" $cmdnum - CTpercentageScores $cmdnum $setId $L_cnt - CTaverage $cmdnum $Q_cnt $L_cnt faillist dodifflist numyes - if { $L_cnt != 0 } { - CTbargraph $gCT($num) $num [incr gUniqueNumber] $faillist $gFile($num) "Not-Yet-Correct Distribution for set $setId" "Problem \#" "%Wrong" - CTbargraph $gCT($num) $num [incr gUniqueNumber] $dodifflist $gFile($num) "Degree of Difficulty Distribution for set $setId" "Problem \#" "Degree Of Diff." - CTbargraph $gCT($num) $num [incr gUniqueNumber] $numyes $gFile($num) "Number of Yeses received for set $setId" "Problem \#" "\#Students" + if { [set day [CTgetWhen $num $cmdnum $setId]] != ""} { + set start [lindex $day 0] + set startf [clock format [lindex $day 0] -format "%b %d %R %Y"] + set end [lindex $day 1] + set endf [clock format [lindex $day 0] -format "%b %d %R %Y"] + set file [file join $gFile($num) records "subset$setId.db"] + displayStatus "Generating [file tail $file]" both $cmdnum + CTcreateSubset $num $cmdnum $start $end $setId + updateStatusBar 0.0 $cmdnum + updateStatusMessage "Generating Stats [file tail $file]" $cmdnum + CTscanSetDB $cmdnum $file Q_cnt L_cnt + updateStatusBar 0.0 $cmdnum + updateStatusMessage "Generating Averages [file tail $file]" $cmdnum + CTpercentageScores $cmdnum $setId $L_cnt 1 + CTaverage $cmdnum $Q_cnt $L_cnt faillist dodifflist numyes + if { $L_cnt != 0 } { + CTbargraph $gCT($num) $num [incr gUniqueNumber] $faillist \ + $gFile($num) \ + "Not-Yet-Correct, set $setId, for $startf -> $endf" \ + "Problem \#" "%Wrong" + CTbargraph $gCT($num) $num [incr gUniqueNumber] $dodifflist \ + $gFile($num) \ + "Degree of Difficulty, set $setId, for $startf-$endf" \ + "Problem \#" "Deg. Of Diff." + CTbargraph $gCT($num) $num [incr gUniqueNumber] $numyes \ + $gFile($num) \ + "Number of Yeses, set $setId, for $startf -> $endf" \ + "Problem \#" "\#Students" + } + CToutput $num $cmdnum + removeStatus $cmdnum } - removeStatus $cmdnum - CToutput $num $cmdnum } errors ] } { global errorCode errorInfo displayError "$errors\n$errorCode\n$errorInfo" @@ -444,6 +458,7 @@ proc CTanalyzeReport { num } { proc CTanalyzeScorer { num } { global gFile gUniqueNumber gCapaConfig gCT set cmdnum [incr gUniqueNumber] +# puts "CTanalyzeScorer $cmdnum" set gCT(cmd.$cmdnum) analyzescorer if { "" == [set file [tk_getOpenFile -title "Pick a scorer.output file" -filetypes { { {scorer.output} {scorer.output.*} } { {Submissions File} {*submissions*.db} } { {All Files} {*} } }]] } { return } set path [file dirname [file dirname $file]] @@ -471,36 +486,44 @@ proc CTanalyzeScorer { num } { cd $pwd } -proc CTcontinueAnalyze { num path arrayVar } { - global gCT gResponse - upvar $arrayVar question - CTgetQuestions $num question - set numAdded 0 - foreach which $gCT($num.questNum) { - incr numAdded [CTgetStudentResponses $num [lindex $gCT($num.response) \ - [expr $which-1]] $which \ - question] - } - updateStatusBar [expr $gCT($num.done)/double($gCT($num.max))] $num - if { $numAdded > 0 } { CTupdateAnalyzeScorer $num } - set interesting 0 - while {!$interesting} { - incr gCT($num.done) - set stunum $gCT($num.question) - set aline [gets $gCT($num.fileId)] - if { [eof $gCT($num.fileId)] } { CTfinishAnalyzeScorer $num; return } - set interesting [$gCT($num.parse) $aline $num] - } - if { $stunum != $gCT($num.question) } { - set pwd [pwd];cd $path - getSet $gCT($num.question) $gCT($num.setId) "CTcontinueAnalyze $num $path" - cd $pwd - } else { - CTcontinueAnalyze $num $path question +proc CTcontinueAnalyze { cmdnum path arrayData } { +# puts "CTcontinueAnalyze $cmdnum" + global gCT gResponse gGetSet + array set question $arrayData + while {1} { + CTgetQuestions $cmdnum question + set numAdded 0 + foreach which $gCT($cmdnum.questNum) { + # puts $gCT($cmdnum.response) + incr numAdded [CTgetStudentResponses $cmdnum [lindex $gCT($cmdnum.response) \ + [expr $which-1]] $which \ + question] + # puts $numAdded + } + # puts "end" + updateStatusBar [expr $gCT($cmdnum.done)/double($gCT($cmdnum.max))] $cmdnum + if { $numAdded > 0 } { CTupdateAnalyzeScorer $cmdnum } + set interesting 0 + while {!$interesting} { + incr gCT($cmdnum.done) + set stunum $gCT($cmdnum.question) + set aline [gets $gCT($cmdnum.fileId)] + if { [eof $gCT($cmdnum.fileId)] } { CTfinishAnalyzeScorer $cmdnum; return } + set interesting [$gCT($cmdnum.parse) $aline $cmdnum] + } + if { $stunum != $gCT($cmdnum.question) } { + set pwd [pwd];cd $path + getSet $gCT($cmdnum.question) $gCT($cmdnum.setId) \ + "CTcontinueAnalyze $cmdnum $path" + cd $pwd + break + } } +# puts "After Continue Analyze" } proc CTupdateAnalyzeScorer { cmdnum } { +# puts "CTupdateAnalyzeScorer $cmdnum" global gCT gResponse gUniqueNumber gFile set num $gCT($cmdnum.num) set i 0 @@ -508,22 +531,66 @@ proc CTupdateAnalyzeScorer { cmdnum } { set probnum [lindex [split $correct .] 2] set answer [join [lrange [split $correct .] 3 end] .] if { $gResponse($correct) } { - set color($probnum.$answer) green + set color($probnum.$answer) grey90 + set color($probnum.$answer.unpicked) grey10 } else { - set color($probnum.$answer) red + set color($probnum.$answer) grey30 + set color($probnum.$answer.unpicked) grey70 } } set results "" - set oldprobnum [lindex [split [lindex [lsort [array names gResponse $cmdnum.\[0-9\]*]] 0] .] 1] foreach response [lsort -dictionary [array names gResponse $cmdnum.\[0-9\]*]] { + incr i + set responselm [split $response .] + set probnum [lindex $responselm 1] + if { [lindex $responselm 2] == "unpicked" } { + set answerfull [join [lrange $responselm 3 end] .] + set colorstring "$probnum.$answerfull.unpicked" + append answerfull " - Unpicked" + set answertemp [split [join [lrange $responselm 3 end] .] -] + set picked 0 + } else { + set answerfull [join [lrange $responselm 2 end] .] + set colorstring "$probnum.$answerfull" + append answerfull " - Picked" + set answertemp [split [join [lrange $responselm 2 end] .] -] + set picked 1 + } + set answernum [llength $answertemp] + set answer [join [lrange $answertemp 0 [expr $answernum - 2]] -] + if { " Correct" == [lindex $answertemp end] } { + if { $picked } { set pos 0 } { set pos 3 } + } { if { $picked } { set pos 2 } { set pos 1 } } + + if { [catch {set resultsAr($probnum.$answer.y)} ] } { + set resultsAr($probnum.$answer.y) "0 0 0 0" + set resultsAr($probnum.$answer.description) "{} {} {} {}" + set resultsAr($probnum.$answer.color) "green green green green" + } + set resultsAr($probnum.$answer.y) [lreplace $resultsAr($probnum.$answer.y) \ + $pos $pos $gResponse($response)] + set resultsAr($probnum.$answer.description) [lreplace \ + $resultsAr($probnum.$answer.description) \ + $pos $pos $answerfull] + set resultsAr($probnum.$answer.color) [lreplace \ + $resultsAr($probnum.$answer.color) $pos $pos \ + $color($colorstring)] + } + set i 0 + set oldprobnum "" + foreach name [lsort -dictionary [array names resultsAr "*.y"]] { incr i - set probnum [lindex [split $response .] 1] + set name [split $name .] + set namelength [llength $name] + set answer [join [lrange $name 1 [expr $namelength - 2]] .] + set probnum [lindex $name 0] if { $probnum > $oldprobnum } { + if { $oldprobnum != "" } { + lappend results [list 0 0 "Problem Divider" white] + } set oldprobnum $probnum - lappend results [list 0 0 "Problem Divider" white] } - set answer [join [lrange [split $response .] 2 end] .] - lappend results [list $gResponse($response) $i $answer $color($probnum.$answer)] + lappend results [list $resultsAr($probnum.$answer.y) $i $resultsAr($probnum.$answer.description) $resultsAr($probnum.$answer.color)] } if { $results == "" } { return } if { $gCT($cmdnum.graphup)} { @@ -538,10 +605,20 @@ proc CTupdateAnalyzeScorer { cmdnum } { proc CTsaveAnalyzeScorer { num cmdnum } { global gResponse gCT gFile - set file [tk_getSaveFile -initialdir $gFile($num)] - set fileId [open $file w] - puts $fileId [array get gResponse "$cmdnum.*"] - close $fileId + + if { $gCT(spinlock) } { after 50 "CTsaveAnalyzeScorer $num $cmdnum"; return } + + set gCT(spinlock) 1 + if { "Yes" ==[makeSure "Would you like to save the results to a file?"] } { + set file [tk_getSaveFile -initialdir $gFile($num)] + set fileId [open $file w] + puts $fileId [array get gResponse "$cmdnum.*"] + close $fileId + } + set gCT(spinlock) 0 + unset gCT(cmd.$cmdnum) + CToutput $num $cmdnum + } proc CTfinishAnalyzeScorer { cmdnum } { @@ -555,30 +632,70 @@ proc CTfinishAnalyzeScorer { cmdnum } { set answer [join [lrange [split $correct .] 3 end] .] if { $gResponse($correct) } { set color($probnum.$answer) green + set color($probnum.$answer.unpicked) orange } else { set color($probnum.$answer) red + set color($probnum.$answer.unpicked) blue } } foreach response [lsort -dictionary [array names gResponse $cmdnum.\[0-9\]*]] { + incr i + set responselm [split $response .] + set probnum [lindex $responselm 1] + if { [lindex $responselm 2] == "unpicked" } { + set answerfull [join [lrange $responselm 3 end] .] + set colorstring "$probnum.$answerfull.unpicked" + append answerfull " - Unpicked" + set answertemp [split [join [lrange $responselm 3 end] .] -] + set picked 0 + } else { + set answerfull [join [lrange $responselm 2 end] .] + set colorstring "$probnum.$answerfull" + append answerfull " - Picked" + set answertemp [split [join [lrange $responselm 2 end] .] -] + set picked 1 + } + set answernum [llength $answertemp] + set answer [join [lrange $answertemp 0 [expr $answernum - 2]] -] + if { " Correct" == [lindex $answertemp end] } { + if { $picked } { set pos 0 } { set pos 3 } + } { if { $picked } { set pos 2 } { set pos 1 } } + + if { [catch {set resultsAr($probnum.$answer.y)} ] } { + set resultsAr($probnum.$answer.y) "0 0 0 0" + set resultsAr($probnum.$answer.description) "{} {} {} {}" + set resultsAr($probnum.$answer.color) "green green green green" + } + set resultsAr($probnum.$answer.y) [lreplace $resultsAr($probnum.$answer.y) \ + $pos $pos $gResponse($response)] + set resultsAr($probnum.$answer.description) [lreplace \ + $resultsAr($probnum.$answer.description) \ + $pos $pos $answerfull] + set resultsAr($probnum.$answer.color) [lreplace \ + $resultsAr($probnum.$answer.color) $pos $pos \ + $color($colorstring)] + } + set i 0 + foreach name [array names resultsAr "*.y"] { incr i - set probnum [lindex [split $response .] 1] - set answer [join [lrange [split $response .] 2 end] .] - lappend results($probnum) [list $gResponse($response) $i $answer $color($probnum.$answer)] - } + set name [split $name .] + set namelength [llength $name] + set answer [join [lrange $name 1 [expr $namelength - 2]] .] + set probnum [lindex $name 0] + lappend results($probnum) [list $resultsAr($probnum.$answer.y) $i $resultsAr($probnum.$answer.description) $resultsAr($probnum.$answer.color)] + } foreach probnum [lsort -dictionary [array names results]] { CTputs $cmdnum "\nFor Problem $probnum #, Responses:\n" foreach response $results($probnum) { CTputs $cmdnum "[lindex $response 0], [lindex $response 2]\n" } } - if { "Yes" ==[makeSure "Would you like to save the results to a file?"] } { - CTsaveAnalyzeScorer $num $cmdnum - } - unset gCT(cmd.$cmdnum) - CToutput $num $cmdnum + if { [catch {set gCT(spinlock)}] } { set gCT(spinlock) 0 } + CTsaveAnalyzeScorer $num $cmdnum } proc CTparseScorerOutputLine { aline num } { +# puts "CTparseScorerOutputLine $num" global gCT set gCT($num.stunum) [lindex $aline 0] set aline [string range $aline 40 end] @@ -590,6 +707,7 @@ proc CTparseScorerOutputLine { aline num } proc CTparseSubmissionsLine { aline num } { +# puts "CTparseSubmissionsLine $num" global gCT set aline [split $aline \t] set gCT($num.stunum) [lindex $aline 0] @@ -598,8 +716,8 @@ proc CTparseSubmissionsLine { aline num set interesting 0 set current 1 foreach element [lrange $aline 2 end] { - set quest [lindex $element 0] - set response [lindex $element 1] + set quest [lindex [split $element " "] 0] + set response [lindex [split $element " "] 1] if { $quest == "" } break while { $quest > $current } { lappend gCT($num.response) {} @@ -613,6 +731,7 @@ proc CTparseSubmissionsLine { aline num } proc CTgetQuestions { num questionVar } { +# puts "CTgetQuestions $num" global gCT upvar $questionVar question # parray question @@ -632,7 +751,7 @@ proc CTgetQuestions { num questionVar } } } -proc CTgetStudentResponses { num responses which questionVar } { +proc CTgetStudentResponses2 { num responses which questionVar } { global gCT gResponse upvar $questionVar question # parray question @@ -643,7 +762,7 @@ proc CTgetStudentResponses { num respons if { [catch {incr gResponse($num.$which.$question($which.$response))}] } { if {[catch {set gResponse($num.$which.$question($which.$response)) 1}]} { #set gResponse($num.$which.Illegal\ Bubble) 1 - puts "not an option $response $which" +# puts "not an option $response $which" continue } } @@ -656,6 +775,49 @@ proc CTgetStudentResponses { num respons return $i } +proc CTgetStudentResponses { num responses which questionVar } { +# puts "CTgetStudentResponses $num" + global gCT gResponse + upvar $questionVar question +# parray question + set i 0 + if {$responses == ""} { return 0 } + if { [string toupper $responses] == "NONE" } { set responses "" } + set response [split $responses {}] + foreach letter {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z} { + if { [catch {set question($which.correct.$letter)}]} { +# puts "skipping out on $letter" + break + } + incr i + if { [lsearch $response $letter] == -1 } { + # unpicked + if { [catch {incr gResponse($num.$which.unpicked.$question($which.$letter))}] } { + if {[catch {set gResponse($num.$which.unpicked.$question($which.$letter)) 1}]} { + #set gResponse($num.$which.Illegal\ Bubble) 1 +# puts "not an option $letter $which" + continue + } + } + } else { + # picked + if { [catch {incr gResponse($num.$which.$question($which.$letter))}] } { + if {[catch {set gResponse($num.$which.$question($which.$letter)) 1}]} { + #set gResponse($num.$which.Illegal\ Bubble) 1 +# puts "not an option $letter $which" + continue + } + } + } + if { $question($which.correct.$letter) } { + set gResponse($num.correct.$which.$question($which.$letter)) 1 + } else { + set gResponse($num.correct.$which.$question($which.$letter)) 0 + } + } + return $i +} + ########################################################### # CTgraphAnalyzeScorer ########################################################### @@ -675,8 +837,6 @@ proc CTgraphAnalyzeScorer { num } { } unset temp foreach name [array names gResponse $cmdnum.\[0-9\]*] { - puts "[split $name .]" - puts "[lindex [split $name .] 1]" lappend probnums [lindex [split $name .] 1] } set probnums [lsort [lunique $probnums]] @@ -687,8 +847,8 @@ proc CTgraphAnalyzeScorer { num } { set probnum [lindex [split $name .] 1] if { -1 == [lsearch $probnums $probnum] } { set answer [join [lrange [split $name .] 2 end] .] - unset gResponse($name) - unset gResponse($cmdnum.correct.$probnum.$answer) + catch {unset gResponse($name)} + catch {unset gResponse($cmdnum.correct.$probnum.$answer)} } } set gCT($cmdnum.num) $num @@ -832,15 +992,16 @@ proc CTscanSetDB { num file Q_cntVar L_c ########################################################### ########################################################### ########################################################### -proc CTpercentageScores { num setId valid_cnt } { +proc CTpercentageScores { num setId valid_cnt {subset 0}} { global gTotal_weight gTotal_scores - + + if { $subset } { set setstr "subset" } else { set setstr "set" } if { $gTotal_weight($num) > 0 } { set ratio [expr double($gTotal_scores($num)) / double($gTotal_weight($num))] set ratio [expr $ratio * 100.0 ] - CTputs $num "\nScore (total scores / total valid weights) for set$setId.db: [format %7.2f%% $ratio]\n" + CTputs $num "\nScore (total scores / total valid weights) for $setstr$setId.db: [format %7.2f%% $ratio]\n" } - CTputs $num "The number of valid records for set$setId.db is: $valid_cnt\n" + CTputs $num "The number of valid records for $setstr$setId.db is: $valid_cnt\n" } ########################################################### @@ -1289,6 +1450,7 @@ proc CTstudentLoginData { num filename i set U_total 0 set u_total 0 set S_total 0 + set s_total 0 set maxLine [expr double([lindex [exec wc $filename] 0])] set line_cnt 0 set fileId [open $filename "r"] @@ -1308,6 +1470,7 @@ proc CTstudentLoginData { num filename i } elseif {[lindex $ans_char $i] == "N"} { incr N_total } elseif {[lindex $ans_char $i] == "U"} { incr U_total } elseif {[lindex $ans_char $i] == "u"} { incr u_total + } elseif {[lindex $ans_char $i] == "s"} { incr s_total } elseif {[lindex $ans_char $i] == "S"} { incr S_total } } } @@ -2127,11 +2290,52 @@ proc CTbargraph {window num barnum data set gBarGraph($barnum.ylabel) $ylabel set gBarGraph($barnum.color) green set gBarGraph($barnum.bucketscores) 0 - CTautoscaleBargraph $barnum + set gBarGraph($barnum.ymax) [CTautoscaleBargraph $barnum] + set gBarGraph($barnum.ymaxold) $gBarGraph($barnum.ymax) CTdrawBargraph $barnum } ########################################################### +# CTmaxBargraph +########################################################### +########################################################### +########################################################### +proc CTmaxBargraph { barnum } { + global gBarGraph + + set data $gBarGraph($barnum) + set total [llength $data] + set howoften $gBarGraph($barnum.xoften) + set when [expr ($total-1)%$howoften] + set max 0 + set i 0 + set value 0 + if { $gBarGraph($barnum.bucketscores) } { + foreach datum $data { + set value [expr {$value + [lindex $datum 0]}] + if { $i % $howoften == $when } { + if { $value > $max } { set max $value } + set value 0 + } + incr i + } + } else { + set max [lindex [lindex [lsort -decreasing -index 0 -real $data] 0] 0] + } + if { $max > int($max) } { set max [expr int($max+1)] } + set gBarGraph($barnum.ymaxold) [set gBarGraph($barnum.ymax) $max] + return $max +} + +proc CTsort { arg1 arg2 } { + set arg1 [eval expr [join [lindex $arg1 0] +]] + set arg2 [eval expr [join [lindex $arg2 0] +]] + if { $arg1 < $arg2 } { return -1 } + if { $arg1 > $arg2 } { return 1 } + return 0 +} + +########################################################### # CTautoscaleBargraph ########################################################### ########################################################### @@ -2139,12 +2343,16 @@ proc CTbargraph {window num barnum data proc CTautoscaleBargraph { barnum } { global gBarGraph set data $gBarGraph($barnum) - set max [lindex [lindex [lsort -decreasing -index 0 -real $data] 0] 0] + if { [catch {set max [lindex [lindex [lsort -decreasing -index 0 -real $data] 0] 0]}] } { + set max [lindex [lindex [lsort -decreasing -command CTsort $data] 0] 0] + set max [eval expr [join $max +]] + } if { $max > int($max) } { set max [expr int($max+1)] } set gBarGraph($barnum.yoften) [expr int([format "%1.e" [expr $max/10.0]])] if { $gBarGraph($barnum.yoften) == 0 } { set gBarGraph($barnum.yoften) 1 } set total [llength $data] set gBarGraph($barnum.xoften) [expr ($total/25) + 1] + return $max } ########################################################### @@ -2155,7 +2363,8 @@ proc CTautoscaleBargraph { barnum } { proc CTchangeBargraphData { barnum data } { global gBarGraph set gBarGraph($barnum) $data - CTautoscaleBargraph $barnum + set gBarGraph($barnum.ymax) [CTautoscaleBargraph $barnum] + set gBarGraph($barnum.ymaxold) $gBarGraph($barnum.ymax) CTdrawBargraph $barnum } @@ -2212,7 +2421,7 @@ proc CTdrawBargraph { num } { set value 0 if { $gBarGraph($num.bucketscores) } { foreach datum $data { - set value [expr {$value + [lindex $datum 0]}] + set value [eval expr $value + [join [lindex $datum 0] +]] if { $i % $howoften == $when } { if { $value > $max } { set max $value } set value 0 @@ -2220,44 +2429,34 @@ proc CTdrawBargraph { num } { incr i } } else { - set max [lindex [lindex [lsort -decreasing -index 0 -real $data] 0] 0] + if { [catch {set max [lindex [lindex [lsort -decreasing -index 0 -real $data] 0] 0]}] } { + set max [lindex [lindex [lsort -decreasing -command CTsort $data] 0] 0] + set max [eval expr [join $max +]] + } } if { $max > int($max) } { set max [expr int($max+1)] } + if { $gBarGraph($num.ymaxold) != $gBarGraph($num.ymax) } { + set max $gBarGraph($num.ymax) + } if { [catch {set pixelvalue [expr ($graphheight-1)/double($max)]} ] } { set pixelvalue 10 } + set i 0 set value 0 foreach datum $data { - set value [expr {$value + [lindex $datum 0]}] - set which [lindex $datum 1] - set y1 [expr {$graphheight + $titleheight}] - set x2 [expr {$eachwidth * ($i+1) + $textwidth}] - set y2 [expr {($graphheight-1) + $titleheight - $value * $pixelvalue}] - set tag bar.$which.[expr $which-$howoften] - if { [set color [lindex $datum 3]] == "" } {set color $gBarGraph($num.color)} - if { $gBarGraph($num.bucketscores) && ($i % $howoften == $when) } { - if { $i == $when } { -# puts "$value-$which-$howoften" - $canvas create rectangle $textwidth \ - $y1 $x2 $y2 -fill $color -tag $tag - } else { -# puts "$value:$which:$howoften" - $canvas create rectangle [expr {$eachwidth*($i-$howoften+1)+$textwidth}]\ - $y1 $x2 $y2 -fill $color -tag $tag - } - } elseif { !$gBarGraph($num.bucketscores) } { - $canvas create rectangle [expr {$eachwidth * $i + $textwidth}] \ - $y1 $x2 $y2 -fill $color -tag bar.$which.[expr $which-1] - set value 0 - } - if { $i % $howoften == $when } { - $canvas create text [expr {$eachwidth * $i + $textwidth + $eachwidth/2}] \ - [expr $graphheight+(($tickheight)/2)+$titleheight] -text $which - set value 0 +# puts ":$datum:" + if { [llength [lindex $datum 0]] == 1 } { + set value [expr {$value + [lindex $datum 0]}] + CTdrawBargraphBar + incr i + } else { + set value [eval expr $value + [join [lindex $datum 0] +]] + CTdrawBargraphBarN + incr i } - incr i } +# puts "value:$value:" #draw title $canvas create text [expr $textwidth+$titleoffset+($graphwidth/2)] 1 -anchor n\ @@ -2290,6 +2489,88 @@ proc CTdrawBargraph { num } { } } +proc CTdrawBargraphBar { } { + global gBarGraph + uplevel 1 { + set canvas $gBarGraph($num.canvas) + + set which [lindex $datum 1] + set y1 [expr {$graphheight + $titleheight}] + set x2 [expr {$eachwidth * ($i+1) + $textwidth}] + set y2 [expr {($graphheight-1) + $titleheight - $value * $pixelvalue}] + set tag bar.$which.[expr $which-$howoften] + if { [set color [lindex $datum 3]] == "" } {set color $gBarGraph($num.color)} + if { $gBarGraph($num.bucketscores) && ($i % $howoften == $when) } { + if { $i == $when } { + # puts "$value-$which-$howoften" + $canvas create rectangle $textwidth \ + $y1 $x2 $y2 -fill $color -tag $tag + } else { + # puts "$value:$which:$howoften" + $canvas create rectangle [expr {$eachwidth*($i-$howoften+1)+$textwidth}]\ + $y1 $x2 $y2 -fill $color -tag $tag + } + } elseif { !$gBarGraph($num.bucketscores) } { + $canvas create rectangle [expr {$eachwidth * $i + $textwidth}] \ + $y1 $x2 $y2 -fill $color -tag bar.$which.[expr $which-1] + set value 0 + } + if { $i % $howoften == $when } { + $canvas create text [expr {$eachwidth * $i + $textwidth + $eachwidth/2}] \ + [expr $graphheight+(($tickheight)/2)+$titleheight] -text $which + set value 0 + } + } +} + +proc CTdrawBargraphBarN { } { + global gBarGraph + uplevel 1 { + set canvas $gBarGraph($num.canvas) + + set which [lindex $datum 1] + set y1 [expr {$graphheight + $titleheight}] + set x2 [expr {$eachwidth * ($i+1) + $textwidth}] + set tag bar.$which.[expr $which-$howoften] + set subpoint 0 + for {set j 0} {$j < [llength [lindex $datum 0]]} {incr j} { + set subpointincr [lindex [lindex $datum 0] $j] + if { $subpointincr == 0 } { continue } + incr subpoint $subpointincr + set y2 [expr {($graphheight-1) + $titleheight - $subpoint * $pixelvalue}] + set tag bar.$which.[expr $which-$howoften].$j + if { [set color [lindex [lindex $datum 3] $j]] == ""} { + set color $gBarGraph($num.color) + } + if { $gBarGraph($num.bucketscores) && ($i % $howoften == $when) } { + if { $i == $when } { + # puts "$value-$which-$howoften" + $canvas create rectangle $textwidth \ + $y1 $x2 $y2 -fill $color -tag $tag + } else { + # puts "$value:$which:$howoften" + $canvas create rectangle [expr {$eachwidth*($i-$howoften+1)+$textwidth}]\ + $y1 $x2 $y2 -fill $color -tag $tag + } + } elseif { !$gBarGraph($num.bucketscores) } { + set x1 [expr {$eachwidth * $i + $textwidth}] +# puts "y:$y1:$y2:x:$x1:$x2:subpoint:$subpoint" + $canvas create rectangle [expr {$eachwidth * $i + $textwidth}] \ + $y1 $x2 $y2 -fill $color -tag bar.$which.[expr $which-1].$j + set value 0 + } else { + break + } + set y1 $y2 + } + if { $i % $howoften == $when } { + $canvas create text [expr {$eachwidth * $i + $textwidth + $eachwidth/2}] \ + [expr $graphheight+(($tickheight)/2)+$titleheight] -text $which + set value 0 + } + } +} + ########################################################### # CTbargraphDisplayCreate ########################################################### @@ -2346,12 +2627,20 @@ proc CTbargraphDisplayShowresponse { bar set num $gBarGraph($barnum.num) set canvas $gBarGraph($barnum.canvas) - set high [lindex [split [lindex [$canvas gettags current] 0] .] 1] + set tags [split [lindex [$canvas gettags current] 0] .] + set high [lindex $tags 1] + set subpoint [lindex $tags 3] foreach datum $gBarGraph($barnum) { set bar [lindex $datum 1] if { $bar != $high } { continue } if {![winfo exists $canvas.bubble$barnum.l]} {CTbargraphDisplayCreate $barnum} - $canvas.bubble$barnum.l configure -text "[lindex $datum 0] - \"[splitline [lindex $datum 2] 35]\"" + if { [llength [lindex $datum 0]] == 1 } { + $canvas.bubble$barnum.l configure -text "[lindex $datum 0] - \"[splitline [lindex $datum 2] 35]\"" + } else { + set point [lindex [lindex $datum 0] $subpoint] + set text [lindex [lindex $datum 2] $subpoint] + $canvas.bubble$barnum.l configure -text "$point - \"[splitline $text 35]\"" + } wm geometry $canvas.bubble$barnum +[expr 20+[winfo pointerx .]]+[expr 20+[winfo pointery .]] wm deiconify $canvas.bubble$barnum return @@ -2458,10 +2747,12 @@ proc CTchangeBargraph { window num } { set ylabel [frame $change.ylabel] set xoften [frame $change.xoften] set yoften [frame $change.yoften] + set ymax [frame $change.ymax] set color [frame $change.color] set bucket [frame $change.bucket] set font [frame $change.font] - pack $infoFrame $buttonFrame $title $xlabel $ylabel $xoften $yoften $color $bucket + pack $infoFrame $buttonFrame $title $xlabel $ylabel $xoften $yoften $ymax \ + $color $bucket pack configure $title $xlabel $ylabel $xoften $yoften -anchor e -expand 1 -fill both button $buttonFrame.update -text Update -command "CTdrawBargraph $num" bind $change "CTdrawBargraph $num" @@ -2473,7 +2764,8 @@ proc CTchangeBargraph { window num } { $xlabel { X-Axis Label} xlabel $ylabel { Y-Axis Label} ylabel $xoften {Increment on X-Axis} xoften - $yoften {Increment on Y-Axis} yoften" { + $yoften {Increment on Y-Axis} yoften + $ymax { Max Y-Value} ymax" { label $frame.label -text $label set entryFrame [frame $frame.entry] pack $frame.label $entryFrame -side left @@ -2492,7 +2784,7 @@ proc CTchangeBargraph { window num } { pack $color.label $color.color $color.change -side left checkbutton $bucket.bucket -text "Bucket Scores" -variable \ - gBarGraph($num.bucketscores) -command "CTdrawBargraph $num" + gBarGraph($num.bucketscores) -command "CTmaxBargraph $num;CTdrawBargraph $num" pack $bucket.bucket } @@ -2548,15 +2840,101 @@ proc CTdisplayStudent { num window path $canvas create image 1 1 -image $image -anchor nw } +proc updateDate { type cmdnum args } { + global gDateStart gDateEnd + switch $type { + start { set gDateStart($cmdnum.text) [clock format $gDateStart($cmdnum) -format "%a %b %d %R %Y"] } + end { set gDateEnd($cmdnum.text) [clock format $gDateEnd($cmdnum) -format "%a %b %d %R %Y"] } + } +} + ########################################################### # CTgetWhen ########################################################### ########################################################### ########################################################### -proc CTgetWhen { num } { - set day [getString . "Enter a date"] - update - return $day +proc CTgetWhen { num cmdnum setId } { + global gFile gCT gPromptGDR + + set firstsection [exec head [file join $gFile($num) records log$setId.db]] + append firstsection [exec head [file join $gFile($num) records weblog$setId.db]] + set lastsection [exec tail [file join $gFile($num) records log$setId.db]] + append lastsection [exec tail [file join $gFile($num) records weblog$setId.db]] + + set earliest -1 + foreach line [split $firstsection \n] { + if { [catch {set date [clock scan [string range $line 10 33]]}]} {set date -1} + #puts "$date $earliest" + if { $earliest == -1 } { set earliest $date } + if { $date < $earliest } { set earliest $date } + } + if { $earliest == -1 } { + file stat [file join $gFile($num) records log$setId.db] stat + set earliest $stat(ctime) + } + + set latest 0 + foreach line [split $lastsection \n] { + if { [catch {set date [clock scan [string range $line 10 33]]}]} {set date 0} + #puts "$date $latest" + if { $latest == 0 } { set latest $date } + if { $date > $latest } { set latest $date } + } + if { $latest == 0 } { + file stat [file join $gFile($num) records log$setId.db] stat + set latest $stat(mtime) + } + #puts "$latest $earliest" + + set window $gCT($num) + set setWin [toplevel $window.setselect] + + set msgFrame [frame $setWin.msgFrame] + set valFrame [frame $setWin.calFrame] + set buttonFrame [frame $setWin.buttonFrame] + pack $msgFrame $valFrame $buttonFrame + + message $msgFrame.msg -text "Please select a date range:" -aspect 1000 + pack $msgFrame.msg + + global gDateStart gDateEnd + trace variable gDateStart($cmdnum) w "updateDate start $cmdnum" + trace variable gDateEnd($cmdnum) w "updateDate end $cmdnum" + label $valFrame.l1 -textvariable gDateStart($cmdnum.text) + scale $valFrame.start -from $earliest -to $latest -variable gDateStart($cmdnum) -orient h -showvalue 0 -resolution 600 -bigincrement 6000 -length 300 + label $valFrame.l2 -textvariable gDateEnd($cmdnum.text) + scale $valFrame.end -from $earliest -to $latest -variable gDateEnd($cmdnum) -orient h -showvalue 0 -resolution 600 -bigincrement 6000 -length 300 + pack $valFrame.l1 $valFrame.start $valFrame.l2 $valFrame.end + + button $buttonFrame.select -text "Select" -command { set gPromptGDR(ok) 1 } + button $buttonFrame.cancel -text "Cancel" -command { set gPromptGDR(ok) 0 } + pack $buttonFrame.select $buttonFrame.cancel -side left + + bind $setWin "set gPromptGDR(ok) 1" + Centre_Dialog $setWin default + update idletasks + focus $setWin + capaRaise $setWin + capaGrab $setWin + vwait gPromptGDR(ok) + capaGrab release $setWin + destroy $setWin + if { $gPromptGDR(ok) == 1 } { + set dateStart $gDateStart($cmdnum) + set dateEnd $gDateEnd($cmdnum) + if { $dateStart > $dateEnd } { + set temp $dateStart + set dateStart $dateEnd + set dateEnd $temp + } + unset gDateStart + unset gDateEnd + return [list $dateStart $dateEnd] + } else { + unset gDateStart + unset gDateEnd + return "" + } } ########################################################### @@ -2566,22 +2944,23 @@ proc CTgetWhen { num } { ########################################################### proc CTscanDB { num file outId startdate enddate } { global answerArray exist - set fileId [open $file r] + if {[catch {set fileId [open $file r]}]} { retun 0 } set Yes_cnt 0 set No_cnt 0 set line_cnt 0 set prob_cnt 0 set maxLine [lindex [exec wc $file] 0] - puts $maxLine + #puts "maxLine: $maxLine" set aline [gets $fileId] while { ! [eof $fileId] } { incr line_cnt if { ($line_cnt%20) == 0 } { - puts $curdate + #puts $curdate updateStatusBar [expr $line_cnt/double($maxLine)] $num } set length [llength $aline] set date [lrange $aline 1 [expr $length - 2]] + #puts $date set curdate [clock scan $date] if { $curdate < $startdate } { set aline [gets $fileId]; continue } if { $curdate > $enddate } { break } @@ -2590,29 +2969,28 @@ proc CTscanDB { num file outId startdate set usr_ans "$s_num.ans" set usr_try "$s_num.try" if {$prob_cnt == 0} { set prob_cnt [llength $ans_char] } - if { [array names answerArray "$usr_ans.*"] == "" } { + if { [catch {set exist($s_num)}] } { for {set ii 0} { $ii <= $prob_cnt } { incr ii} { set answerArray($usr_ans.$ii) "-" - } - } - if { [array names answerArray "$usr_try.*"] == "" } { - for {set ii 0} { $ii <= $prob_cnt } { incr ii} { set answerArray($usr_try.$ii) 0 } } for {set ii 0} { $ii <= $prob_cnt } { incr ii} { - if { [lindex $ans_char $ii] == "Y" } { - set answerArray($usr_ans.$ii) "Y" - incr answerArray($usr_try.$ii) - } - if { [lindex $ans_char $ii] == "N"} { - if {$answerArray($usr_ans.$ii) != "Y"} { + switch -- [lindex $ans_char $ii] { + Y - y { set answerArray($usr_ans.$ii) "Y" + incr answerArray($usr_try.$ii) } - incr answerArray($usr_try.$ii) + N { + if {$answerArray($usr_ans.$ii) != "Y"} { + set answerArray($usr_ans.$ii) "N" + } + incr answerArray($usr_try.$ii) + } + default {} } } - if { [array names exist $s_num] == "" } { set exist($s_num) $s_num } + if { [array names exist $s_num] == "" } { set exist($s_num) 1 } set aline [gets $fileId] } close $fileId @@ -2624,21 +3002,23 @@ proc CTscanDB { num file outId startdate ########################################################### ########################################################### ########################################################### -proc CTcreateSubset { num cmdnum day setId } { +proc CTcreateSubset { num cmdnum startdate enddate setId } { global gFile gCT answerArray exist set outId [open [file join $gFile($num) records "subset$setId.db"] w] set inId [open [file join $gFile($num) records "set$setId.db"] r] - set startdate [clock scan "$day 12:00 AM"] - set enddate [clock scan "$day 11:59 PM"] - - puts $startdate:$enddate + #puts $startdate:$enddate + #puts [file join $gFile($num) records log$setId.db] + updateStatusMessage "Genearting subset1.db from telnet data." $cmdnum set prob_cntt [CTscanDB $cmdnum [file join $gFile($num) records log$setId.db] $outId $startdate $enddate] - puts $startdate:$enddate + #puts $prob_cntt + #puts $startdate:$enddate + updateStatusMessage "Genearting subset1.db from web data." $cmdnum set prob_cntw [CTscanDB $cmdnum [file join $gFile($num) records weblog$setId.db] $outId $startdate $enddate] - puts $startdate:$enddate - puts "$day 12:00 AM : $day 11:59 PM" + #puts $prob_cntw + #puts $startdate:$enddate +# puts "$day 12:00 AM : $day 11:59 PM" if { $prob_cntt > $prob_cntw } { set prob_cnt $prob_cntt } else {