--- capa/capa51/GUITools/capastats.tcl 1999/09/28 21:25:37 1.1.1.1 +++ capa/capa51/GUITools/capastats.tcl 2000/03/22 21:08:02 1.14 @@ -41,9 +41,11 @@ proc runCapaTools { classDirConfigFile } # $utilsMenu add command -label "Email" -command "" # $utilsMenu add command -label "View Score File" -command "" $utilsMenu add command -label "View Submissions" -command "CTsubmissions $num" + $utilsMenu add command -label "Create a Class Report" -command "CTcreateReport $num" $utilsMenu add command -label "Analyze Class Report" -command "CTanalyzeReport $num" $utilsMenu add command -label "Analyze Responses" -command "CTanalyzeScorer $num" $utilsMenu add command -label "Graph a Responses Analysis" -command "CTgraphAnalyzeScorer $num" + $utilsMenu add command -label "Discussion Stats" -command "CTdiscussStats $num" $utilsMenu add command -label "Quit" -command "CTquit $num" $utilsMenu post 0 0 Centre_Dialog $utilsMenu default @@ -86,30 +88,46 @@ proc CTchangePath { num } { ########################################################### proc CTcapaStat2 { num } { global gFile gCT gUniqueNumber - if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { return } + # if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { return } + if {[set setId [pickSets [CTsetList $gFile($num)] single "Pick A Set" \ + $gCT($num)]] == "Cancel" } { return } set cmdnum [incr gUniqueNumber] set gCT(cmd.$cmdnum) capastat 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" @@ -126,7 +144,9 @@ proc CTcapaStat2 { num } { ########################################################### proc CTcapaStat { num } { global gFile gCT gUniqueNumber - if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { return } +# if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { return } + if {[set setId [pickSets [CTsetList $gFile($num)] single "Pick A Set" \ + $gCT($num)]] == "Cancel" } { return } set cmdnum [incr gUniqueNumber] set gCT(cmd.$cmdnum) capastat if { [ @@ -160,8 +180,9 @@ proc CTcapaStat { num } { ########################################################### proc CTlogAnalysis { num } { global gFile gUniqueNumber gCT - if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { return } - + #if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { return } + if {[set setId [pickSets [CTsetList $gFile($num)] single "Pick A Set" \ + $gCT($num)]] == "Cancel" } { return } set cmdnum [incr gUniqueNumber] set gCT(cmd.$cmdnum) loganalysis CTdatestamp $cmdnum @@ -299,13 +320,14 @@ proc CTitemAnalysisStart { num } { unset gCT(cmd.$cmdnum) return } - if { [set sets [getSetRange $gCT($num) $gFile($num)]] == "" } { +# if { [set sets [getSetRange $gCT($num) [lindex $select 1]]] == "" } \{ + if { [set sets [pickSets [CTsetList [lindex $select 1]] \ + "extended" "Select Sets" $gCT($num)]] == "Cancel" } { unset gCT(cmd.$cmdnum) return } CTdatestamp $cmdnum - if { [ catch {CTitemAnalysisRange $cmdnum [lindex $select 1] \ - [lindex $sets 0] [lindex $sets 1] } errors ] } { + if { [ catch {CTitemAnalysisRange $cmdnum [lindex $select 1] $sets } errors ] } { displayError $errors } unset gCT(cmd.$cmdnum) @@ -333,11 +355,13 @@ proc CTitemCorrelationStart { num } { foreach path [lsort [array names gCapaConfig "$num.*_path"]] { lappend paths [list [lindex [split $path "."] 1] $gCapaConfig($path) ] } - if { [set select [multipleChoice $gCT($num) "Select a class path" $paths ] ] == "" } { + if {[set select [multipleChoice $gCT($num) "Select a class path" $paths]] == ""} { unset gCT(cmd.$cmdnum) return } - if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { + #if { [set setId [getOneSet $gCT($num) [lindex $select 1]]] == "" } \{ + if {[set setId [pickSets [CTsetList [lindex $select 1]] single "Pick A Set" \ + $gCT($num)]] == "Cancel" } { unset gCT(cmd.$cmdnum) return } @@ -361,12 +385,26 @@ proc CTsubmissions { num } { set cmdnum [incr gUniqueNumber] set gCT(cmd.$cmdnum) submissions - if { "" == [set setlist [getSetRange $gCT($num) $gFile($num)]] } { return } + if { [set sets [pickSets [CTsetList $gFile($num)] \ + "extended" "Select Sets" $gCT($num)]] == "Cancel" } { return } +# if { "" == [set setlist [getSetRange $gCT($num) $gFile($num)]] } { return } CTdatestamp $cmdnum CTputs $cmdnum "Submissions for: $s_id, $s_name\n" displayStatus "Getting submissions" spinner $cmdnum - CTsubmissionsLaunch $num $cmdnum telnet $s_id $s_name \ - [lindex $setlist 0] [lindex $setlist 1] + CTsubmissionsLaunch $num $cmdnum telnet $s_id $s_name 0 $sets +} + +########################################################### +# CTcreateReport +########################################################### +########################################################### +########################################################### +proc CTcreateReport { num } { + global gUniqueNumber gCT gFile + + set cmdnum [incr gUniqueNumber] + set gCT(cmd.$cmdnum) createreport + CTcreateReportDialog $num $cmdnum } ########################################################### @@ -420,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]] @@ -447,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 @@ -484,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)} { @@ -514,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 } { @@ -531,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] @@ -566,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] @@ -573,7 +715,9 @@ proc CTparseSubmissionsLine { aline num set gCT($num.response) "" set interesting 0 set current 1 - foreach {quest response} [lrange $aline 2 end] { + foreach element [lrange $aline 2 end] { + set quest [lindex [split $element " "] 0] + set response [lindex [split $element " "] 1] if { $quest == "" } break while { $quest > $current } { lappend gCT($num.response) {} @@ -587,6 +731,7 @@ proc CTparseSubmissionsLine { aline num } proc CTgetQuestions { num questionVar } { +# puts "CTgetQuestions $num" global gCT upvar $questionVar question # parray question @@ -606,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 @@ -617,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 } } @@ -630,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 ########################################################### @@ -649,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]] @@ -661,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 @@ -672,6 +858,24 @@ proc CTgraphAnalyzeScorer { num } { } ########################################################### +# CTdiscussStats +########################################################### +########################################################### +########################################################### +proc CTdiscussStats { num } { + global gCT gUniqueNumber gFile + set cmdnum [incr gUniqueNumber] + set gCT(cmd.$cmdnum) discussstats + set file [file join $gFile($num) discussion logs access.log] + displayStatus "Generating discussion Stats" both $cmdnum + CTdiscussForum $cmdnum $file $gFile($num) discussData 0 + CTputsDiscussResults $cmdnum discussData + CToutput $num $cmdnum + removeStatus $cmdnum + unset gCT(cmd.$cmdnum) +} + +########################################################### # CTquit ########################################################### ########################################################### @@ -788,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" } ########################################################### @@ -903,27 +1108,27 @@ proc CTlogAnalysis2 { num cmdnum setId } set logFile [file join $gFile($num) records "log$setId.db"] if { [file exists $logFile] } { CTputs $cmdnum "Log analysis for telnet session log$setId.db\n" - CTscanLogDB $cmdnum $logFile l(Y) l(N) l(S) l(U) l(u) + CTscanLogDB $cmdnum $logFile l(Y) l(N) l(S) l(U) l(u) l(A) l(F) } else { - set l(Y) [set l(N) [set l(S) [set l(U) [set l(u) 0]]]] + set l(Y) [set l(N) [set l(S) [set l(U) [set l(u) [set l(A) [set l(F) 0]]]]]] } set webLogFile [file join $gFile($num) records "weblog$setId.db" ] if { [file exists $webLogFile] } { CTputs $cmdnum "===============================================\n" CTputs $cmdnum "Log analysis for web session weblog$setId.db\n" - CTscanLogDB $cmdnum $webLogFile w(Y) w(N) w(S) w(U) w(u) + CTscanLogDB $cmdnum $webLogFile w(Y) w(N) w(S) w(U) w(u) w(A) w(F) } else { - set w(Y) [set w(N) [set w(S) [set w(U) [set w(u) 0]]]] + set w(Y) [set w(N) [set w(S) [set w(U) [set w(u) [set w(A) [set w(F) 0]]]]]] } - set telnet_total [expr $l(Y)+$l(N)+$l(S)+$l(U)+$l(u)] - set web_total [expr $w(Y)+$w(N)+$w(S)+$w(U)+$w(u)] + set telnet_total [expr $l(Y)+$l(N)+$l(S)+$l(U)+$l(u)+$l(A)+$l(F)] + set web_total [expr $w(Y)+$w(N)+$w(S)+$w(U)+$w(u)+$w(A)+$w(F)] CTputs $cmdnum "============== SUMMARY ====================\n" - CTputs $cmdnum " #Y #N #S #U #u Total\n" - CTputs $cmdnum [format "telnet: %6d %6d %6d %6d %6d %6d\n" \ - $l(Y) $l(N) $l(S) $l(U) $l(u) $telnet_total ] - CTputs $cmdnum [format " web: %6d %6d %6d %6d %6d %6d\n" \ - $w(Y) $w(N) $w(S) $w(U) $w(u) $web_total] - foreach v { Y N S U u } { + CTputs $cmdnum " #Y #N #S #U #u #A #F Total\n" + CTputs $cmdnum [format "telnet: %6d %6d %6d %6d %6d %6d %6d %6d\n" \ + $l(Y) $l(N) $l(S) $l(U) $l(u) $l(A) $l(F) $telnet_total ] + CTputs $cmdnum [format " web: %6d %6d %6d %6d %6d %6d %6d %6d\n" \ + $w(Y) $w(N) $w(S) $w(U) $w(u) $w(A) $w(F) $web_total] + foreach v { Y N S U u A F} { set sum($v) [expr $l($v) + $w($v)] if { $sum($v) > 0 } { set ratio($v) [expr 100.0*$w($v)/double($sum($v))] @@ -937,8 +1142,8 @@ proc CTlogAnalysis2 { num cmdnum setId } } else { set ratio(web) 0.0 } - CTputs $cmdnum [format " %%web: % 6.1f % 6.1f % 6.1f % 6.1f % 6.1f % 6.1f\n" \ - $ratio(Y) $ratio(N) $ratio(S) $ratio(U) $ratio(u) $ratio(web) ] + CTputs $cmdnum [format " %%web: % 6.1f % 6.1f % 6.1f % 6.1f % 6.1f % 6.1f % 6.1f % 6.1f\n" \ + $ratio(Y) $ratio(N) $ratio(S) $ratio(U) $ratio(u) $ratio(A) $ratio(F) $ratio(web) ] } @@ -947,12 +1152,14 @@ proc CTlogAnalysis2 { num cmdnum setId } ########################################################### ########################################################### ########################################################### -proc CTscanLogDB { num file Y_lVar N_lVar S_lVar U_lVar u_lVar } { +proc CTscanLogDB { num file Y_lVar N_lVar S_lVar U_lVar u_lVar A_lVar F_lVar } { upvar $Y_lVar Y_l upvar $N_lVar N_l upvar $S_lVar S_l upvar $U_lVar U_l upvar $u_lVar u_l + upvar $A_lVar A_l + upvar $F_lVar F_l set line_cnt 0 @@ -972,10 +1179,12 @@ proc CTscanLogDB { num file Y_lVar N_lVa if { ! [info exists count] } { for { set i 0 } { $i < [llength $ans_char] } { incr i } { set count(Y.$i) 0; set count(N.$i) 0; set count(S.$i) 0 - set count(U.$i) 0; set count(u.$i) 0 + set count(U.$i) 0; set count(u.$i) 0; set count(A.$i) 0 + set count(F.$i) 0 } set count(Y.total) 0; set count(N.total) 0; set count(S.total) 0 - set count(U.total) 0; set count(u.total) 0 + set count(U.total) 0; set count(u.total) 0; set count(A.total) 0 + set count(F.total) 0 } set i -1 foreach char $ans_char { @@ -983,7 +1192,8 @@ proc CTscanLogDB { num file Y_lVar N_lVa if { $char == "-" } { continue } if { [catch {incr count($char.$i)}] } { set count(Y.$i) 0; set count(N.$i) 0; set count(S.$i) 0 - set count(U.$i) 0; set count(u.$i) 0 + set count(U.$i) 0; set count(u.$i) 0; set count(A.$i) 0 + set count(F.$i) 0 incr count($char.$i) } incr count($char.total) @@ -992,19 +1202,23 @@ proc CTscanLogDB { num file Y_lVar N_lVa } close $fileId removeStatus $num - CTputs $num "Prob #: #Y #N #S #U #u\n" + CTputs $num "Prob #: #Y #N #S #U #u #A #F\n" for { set i 0 } { $i < [llength $ans_char] } { incr i } { - CTputs $num [format " %2d: %6d %6d %6d %6d %6d\n" [expr $i + 1] \ - $count(Y.$i) $count(N.$i) $count(S.$i) $count(U.$i) $count(u.$i) ] + CTputs $num [format " %2d: %6d %6d %6d %6d %6d %6d %6d\n" [expr $i + 1] \ + $count(Y.$i) $count(N.$i) $count(S.$i) $count(U.$i) $count(u.$i) \ + $count(A.$i) $count(F.$i) ] } CTputs $num "===========================================\n" - CTputs $num [format " Total: %6d %6d %6d %6d %6d\n" $count(Y.total) $count(N.total) \ - $count(S.total) $count(U.total) $count(u.total) ] + CTputs $num [format " Total: %6d %6d %6d %6d %6d %6d %6d\n" $count(Y.total) \ + $count(N.total) $count(S.total) $count(U.total) $count(u.total) \ + $count(A.total) $count(F.total) ] set Y_l $count(Y.total) set N_l $count(N.total) set S_l $count(S.total) set U_l $count(U.total) set u_l $count(u.total) + set A_l $count(A.total) + set F_l $count(F.total) return } @@ -1048,13 +1262,14 @@ proc CTcollectSetScores { num path id on set char [lindex $ans_char $i] if { $char == "N" || $char == "n"} { set found 1 } if { $char == "Y" || $char == "y"} { - incr score [lindex $weights $i];set found 1 + catch {incr score [lindex $weights $i]} + set found 1 } if { $char >= 0 && $char <= 9 } { incr score $char;set found 1 } if { $char == "E" } { - incr valid_weights "-[lindex $weights $i]" + catch {incr valid_weights "-[lindex $weights $i]"} } } incr total_scores $score @@ -1235,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"] @@ -1254,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 } } } @@ -1294,8 +1511,8 @@ proc CTrunCommand { num cmdnum fileId {f ########################################################### ########################################################### ########################################################### -proc CTitemAnalysisRange { num classpath setIdStart setIdEnd } { - for { set i $setIdStart } { $i <= $setIdEnd } { incr i } { +proc CTitemAnalysisRange { num classpath sets } { + foreach i $sets { if { [ catch { CTitemAnalysis $num $classpath $i } errors ] } { displayError $errors } @@ -1365,23 +1582,25 @@ proc CTitemAnalysis { num classpath setI incr valid_cnt set score 0 for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } { - + #Can't use incr because the numbers might be doubles if { [lindex $ans_char $ii] == "Y" || \ [lindex $ans_char $ii] == "y" } { - incr score [lindex $weights $ii] - set Y_cnt($ii) [expr $Y_cnt($ii) + 1] - set Y_total [expr $Y_total + 1] + catch {incr score [lindex $weights $ii]} + set Y_cnt($ii) [expr {$Y_cnt($ii) + 1}] + set Y_total [expr {$Y_total + 1}] } if { [lindex $ans_char $ii] == "N" || \ [lindex $ans_char $ii] == "n" } { - set N_cnt($ii) [expr $N_cnt($ii) + 1] - set N_total [expr $N_total + 1] + set N_cnt($ii) [expr {$N_cnt($ii) + 1}] + set N_total [expr {$N_total + 1}] } if { [lindex $ans_char $ii] >= 0 && \ [lindex $ans_char $ii] <= 9 } { incr score [lindex $ans_char $ii] - set yes_part [expr [lindex $ans_char $ii] / \ - double([lindex $weights $ii]) ] + if {[catch {set yes_part [expr [lindex $ans_char $ii] / \ + double([lindex $weights $ii])]}]} { + set yes_part 1 + } set no_part [expr 1.0 - $yes_part] set Y_cnt($ii) [expr $Y_cnt($ii) + $yes_part] set Y_total [expr $Y_total + $yes_part] @@ -1483,11 +1702,11 @@ proc CTitemCorrelation { num classpath s updateStatusBar [expr {$line_cnt/double($maxLine)}] $num } if { $line_cnt == 2 } { - set aline [string trim $aline] + set aline [string trimright $aline] set weights [split $aline {}] } if { $line_cnt > 3} { - set aline [string trim $aline] + set aline [string trimright $aline] set data [string range $aline 10 end] set ans_str [lindex [split $data ","] 0] set ans_char_list [split $ans_str {} ] @@ -1519,14 +1738,14 @@ proc CTitemCorrelation { num classpath s ## $ans_char($ii) is one of 0 .. 9, Y, y, N, n ## $ans_char($jj) is one of 0 .. 9, Y, y, N, n if { $ans_char($ii) == "Y" || $ans_char($ii) == "y" } { - set x_data [lindex $weights $ii] + if {[set x_data [lindex $weights $ii]]==""} {set x_data 0} } elseif { $ans_char($ii) == "N" || $ans_char($ii) == "n" } { set x_data 0 } else { ## must be in 0 .. 9 set x_data $ans_char($ii) } if { $ans_char($jj) == "Y" || $ans_char($jj) == "y" } { - set y_data [lindex $weights $jj] + if {[set y_data [lindex $weights $jj]]==""} {set y_data 0} } elseif { $ans_char($jj) == "N" || $ans_char($jj) == "n" } { set y_data 0 } else { ## must be in 0 .. 9 @@ -1548,9 +1767,10 @@ proc CTitemCorrelation { num classpath s close $fileId removeStatus $num # print out the correlation matrix -# parray sum_x -# parray sum_y -# parray prod_xy + #parray sum_x + #parray sum_y + #parray prod_xy + #puts $question_cnt CTputs $num " " for { set ii 1 } { $ii < $question_cnt } { incr ii } { CTputs $num [format " %2d" [expr {$ii+1}] ] @@ -1593,27 +1813,28 @@ proc CTitemCorrelation { num classpath s ########################################################### ########################################################### ########################################################### -proc CTsubmissionsLaunch { num cmdnum type s_id s_nm start end } { +proc CTsubmissionsLaunch { num cmdnum type s_id s_nm index setlist } { global gCT gFile gUniqueNumber gCapaConfig - CTputs $cmdnum "$type submissions for $s_nm for set $start\n" + set curset [lindex $setlist $index] + CTputs $cmdnum "$type submissions for $s_nm for set $curset\n" if { $type == "telnet" } { - set command "grep -i $s_id [file join $gFile($num) records submissions$start.db]" + set command "grep -i $s_id [file join $gFile($num) records submissions$curset.db]" set followtype web } else { set command "grep -i $s_id [file join $gFile($num) \ - records websubmissions$start.db]" + records websubmissions$curset.db]" set followtype telnet - incr start + incr index } set done 0 set followcmd "" - while { !$done && ($start <= ($end+1)) } { - if { $start <= $end } { + while { !$done && ($index <= [llength $setlist]) } { + if { [lindex $setlist $index] != "" } { set followcmd "CTsubmissionsLaunch $num $cmdnum $followtype $s_id {$s_nm} \ - $start $end" + $index \"$setlist\"" } - if { ! [catch {set fileId [open "|$command" "r"]} ] } { set done 1 } + if { ![catch {set fileId [open "|$command" "r"]} error ] } { set done 1 } } fconfigure $fileId -blocking 0 fileevent $fileId readable "CTrunCommand $num $cmdnum $fileId {$followcmd}" @@ -1665,7 +1886,7 @@ proc CTreportDist { num file percentage } set aline [gets $fileId] } - CTputs $num "Scores #acheived\n" + CTputs $num "Scores #achieved\n" set scorelist "" set templist [array names totals *.score] foreach temp $templist {lappend possiblescores [lindex [split $temp .] 0]} @@ -1742,7 +1963,7 @@ proc CTgradeDistribution { num classpath removeStatus $num displayStatus "Pondering data . . ." spinner $num CTputs $num " There are $valid_cnt entries in file $filename\n" - CTputs $num "Score #acheived\n" + CTputs $num "Score #achieved\n" set scorelist "" foreach score [lsort -integer [array names total_score]] { CTputs $num [format "%5d:%6d\n" $score $total_score($score)] @@ -1829,7 +2050,7 @@ proc CTgradeDistributionRange { num clas set total_score($i) 0 } foreach sNum [array names studentScores] { incr total_score($studentScores($sNum)) } - CTputs $num "Scores #acheived\n" + CTputs $num "Scores #achieved\n" set scorelist "" foreach score [lsort -integer [array names total_score]] { CTputs $num [format "%5d:%6d\n" $score $total_score($score)] @@ -1910,7 +2131,7 @@ proc CToutput { num cmdnum } { pack $buttonFrame.wrap $buttonFrame.save $buttonFrame.print \ $buttonFrame.dismiss -side left } - set index [$gCT($num.output) index end] + set index [$gCT($num.output) index end-1c] foreach line $gCT(output.$cmdnum) { eval $gCT($num.output) insert end $line } @@ -2069,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 ########################################################### ########################################################### @@ -2081,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 } ########################################################### @@ -2097,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 } @@ -2154,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 @@ -2162,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\ @@ -2232,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 ########################################################### @@ -2288,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 @@ -2400,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" @@ -2415,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 @@ -2434,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 } @@ -2482,21 +2832,109 @@ proc CTdisplayStudent { num window path label $infoFrame.label -text $id pack $infoFrame.label - - set canvas [canvas $imageFrame.canvas] + + set height [image height $image] + set width [image width $image] + set canvas [canvas $imageFrame.canvas -height $height -width $width] pack $canvas $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 "" + } } ########################################################### @@ -2506,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 } @@ -2530,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) + } + N { + if {$answerArray($usr_ans.$ii) != "Y"} { + set answerArray($usr_ans.$ii) "N" + } + incr answerArray($usr_try.$ii) } - 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 @@ -2564,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 { @@ -2605,3 +3045,295 @@ proc CTcreateSubset { num cmdnum day set catch {unset answerArray} catch {unset exist} } + +########################################################### +# CTdiscussForum +########################################################### +########################################################### +########################################################### +proc CTdiscussForum { num file dir resultVar {specificSet 0}} { + global gCT + upvar $resultVar result + + if { $specificSet == 0 } { + set start 1 + } else { + set start $specificSet + } + set fileId [open $file r] + set maxLine [lindex [exec wc $file] 0] + set aline [gets $fileId] + set last 0 + set line_cnt 0 + while {![eof $fileId]} { + incr line_cnt + if { ($line_cnt%20) == 0 } { updateStatusBar [expr $line_cnt/double($maxLine)] $num } + foreach {stunum capaid name email action set prob date time blank} [split $aline "|"] {} + if {$specificSet && ($specificSet == $set)} {set aline [gets $fileId];continue} + if { $action == "ViewProblem" } { + if { [catch {incr count($set,$prob)}]} { + set count($set,$prob) 1 + if { $set > $last } { set last $set } + if { [catch {set max($set)}]} { set max($set) 0 } + if { $prob > $max($set)} { set max($set) $prob } + if { [catch {set posts($set,$prob) [llength [glob $dir/discussion/$set/[format "%06d" $prob]-*-*-*.msg]]}]} { set posts($set,$prob) 0 } + } + set ever($name) 1 + set names($set,$name) 1 + set nameprob($set,$prob,$name) 1 + } + set aline [gets $fileId] + } + + updateStatusMessage "Summarizing Data" $num + updateStatusBar 0 $num + for {set i 1} { $i <= $last } { incr i } { + updateStatusBar [expr $i/$last] $num + set total($i) 0 + for {set j 1} { $j <= $max($i) } { incr j } { + set message "" + if {[catch { set result($num.$i.$j.posts) $posts($i,$j) }]} { + set result($num.$i.$j.posts) 0 + } + if {[catch {set result($num.$i.$j.views) $count($i,$j)}]} { + set result($num.$i.$j.views) 0 + } + catch {incr total($i) $count($i,$j)} + if { [catch { set result($num.$i.$j.ratio) \ + [expr $result($num.$i.$j.views)/double($result($num.$i.$j.posts))]} error]} { + set result($num.$i.$j.ratio) 0.0 + } + set result($num.$i.$j.viewers) [llength [array names nameprob $i,$j,*]] + } + set result($num.$i.views) $total($i) + set result($num.$i.max) $max($i) + } + + for {set i 1} { $i<=$last } { incr i } { + set result($num.$i.viewers) [llength [array names names $i,*]] + } + close $fileId + set result($num.viewers) [llength [array names ever]] + set result($num.last) $last + #IDEAS: + # : how many views are repeats + # : Student Course Profile, add #ViewProblems #Posts + # : add some portion of these stats to analyze log files? +} + +########################################################### +# CTputsDiscussResults +########################################################### +########################################################### +proc CTputsDiscussResults { num resultsVar } { + upvar $resultsVar result + for {set i 1} { $i <= $result($num.last) } { incr i } { + CTputs $num "For Set $i #Visitors:$result($num.$i.viewers) did #views:$result($num.$i.views)\n" + CTputs $num "Prob# #Posts #Views Ratio #UniqueStu\n" + CTputs $num "------------------------------------\n" + for {set j 1} { $j <= $result($num.$i.max)} { incr j } { + CTputs $num [format "%5d %6d %6d %5s %6d\n" $j \ + $result($num.$i.$j.posts) $result($num.$i.$j.views) \ + [if {$result($num.$i.$j.ratio) == 0.0} {set temp " "} \ + {format %.1f $result($num.$i.$j.ratio)}] \ + $result($num.$i.$j.viewers)] + } + } + CTputs $num "Overall Unique #viewers: $result($num.viewers)\n" +} + +########################################################### +# CTcreateReportDialog +########################################################### +########################################################### +########################################################### +proc CTcreateReportDialog { num cmdnum } { + global gCT gFile + + + set gCT(summary.section.$cmdnum) 1 + set gCT(summary.set.$cmdnum) 1 + + set summary [toplevel $gCT($num).summary] + set whoFrame [frame $summary.whoFrame -borderwidth 4 -relief groove] + set whichFrame [frame $summary.whichFrame -borderwidth 4 -relief groove] + set sortFrame [frame $summary.sortFrame] + set file2Frame [frame $summary.file2Frame] + set buttonFrame [frame $summary.buttonFrame] + pack $whoFrame $whichFrame $sortFrame $file2Frame $buttonFrame -side top + pack configure $whoFrame $whichFrame -padx 10 -pady 10 + + set sectionFrame [frame $whoFrame.section] + set allFrame [frame $whoFrame.all] + pack $sectionFrame $allFrame -side top + + set gCT(summary.who.$cmdnum) section + + radiobutton $sectionFrame.section -text \ + "For students in default section:" -variable gCT(summary.who.$cmdnum) \ + -value section + entry $sectionFrame.entry -textvariable gCT(summary.section.$cmdnum) -width 3 + pack $sectionFrame.section $sectionFrame.entry -side left + + radiobutton $allFrame.all -text "For all students in the class" \ + -variable gCT(summary.who.$cmdnum) -value all + pack $allFrame.all + + set sectionFrame [frame $whichFrame.section] + set allFrame [frame $whichFrame.all] + pack $sectionFrame $allFrame -side top + + set gCT(summary.which.$cmdnum) specific + + radiobutton $sectionFrame.section -text "For set:" \ + -variable gCT(summary.which.$cmdnum) -value specific + entry $sectionFrame.entry -textvariable gCT(summary.set.$cmdnum) -width 3 + pack $sectionFrame.section $sectionFrame.entry -side left + + radiobutton $allFrame.all -text "For all sets up to:" -variable \ + gCT(summary.which.$cmdnum) -value upto + entry $allFrame.entry -textvariable gCT(summary.set.$cmdnum) -width 3 + pack $allFrame.all $allFrame.entry -side left + + set firstFrame [frame $sortFrame.firstFrame -borderwidth 4 -relief groove] + set secondFrame [frame $sortFrame.secondFrame -borderwidth 4 \ + -relief groove] + pack $firstFrame $secondFrame -side left + + set gCT(summary.first.$cmdnum) name + + label $firstFrame.label -text "Sorting Order - Primary" + radiobutton $firstFrame.name -text "Student Name" -variable \ + gCT(summary.first.$cmdnum) -value name + radiobutton $firstFrame.number -text "Student Number" -variable \ + gCT(summary.first.$cmdnum) -value number + radiobutton $firstFrame.section -text "Section" -variable \ + gCT(summary.first.$cmdnum) -value section + radiobutton $firstFrame.grade -text "Grade" -variable gCT(summary.first.$cmdnum) \ + -value grade + pack $firstFrame.label $firstFrame.name $firstFrame.number \ + $firstFrame.section $firstFrame.grade -side top -anchor w + + set gCT(summary.second.$cmdnum) number + + label $secondFrame.label -text "Sorting Order - Secondary" + radiobutton $secondFrame.name -text "Student Name" -variable \ + gCT(summary.second.$cmdnum) -value name + radiobutton $secondFrame.number -text "Student Number" -variable \ + gCT(summary.second.$cmdnum) -value number + radiobutton $secondFrame.section -text "Section" -variable \ + gCT(summary.second.$cmdnum) -value section + radiobutton $secondFrame.grade -text "Grade" -variable gCT(summary.second.$cmdnum) \ + -value grade + pack $secondFrame.label $secondFrame.name $secondFrame.number \ + $secondFrame.section $secondFrame.grade -side top -anchor w + + set defaultFrame [frame $file2Frame.defaultFrame] + set fileFrame [frame $file2Frame.fileFrame] + pack $defaultFrame $fileFrame -side top + + set gCT(summary.filename.$cmdnum) default + + radiobutton $defaultFrame.default -text "Grader Chooses File Name" \ + -variable gCT(summary.filename.$cmdnum) -value default + pack $defaultFrame.default + + radiobutton $fileFrame.label -text "Specified Output File:" \ + -variable gCT(summary.filename.$cmdnum) -value specified + set entryFrame [frame $fileFrame.entryFrame] + button $fileFrame.select -text "Select File" \ + -command "CTselectOutputFile $cmdnum" + pack $fileFrame.label $entryFrame $fileFrame.select -side left + entry $entryFrame.entry -textvariable gCT(summary.file.$cmdnum) \ + -xscrollcommand "$entryFrame.scroll set" + scrollbar $entryFrame.scroll -orient h -command \ + "$entryFrame.entry xview" + pack $entryFrame.entry $entryFrame.scroll + pack configure $entryFrame.scroll -fill x + + button $buttonFrame.create -text "Create" -command \ + "removeWindowEntry Summary + destroy $summary + CTcreateSummaryReport $num $cmdnum" + button $buttonFrame.cancel -text "Cancel" -command \ + "removeWindowEntry Summary + destroy $summary" + pack $buttonFrame.create $buttonFrame.cancel -side left + + Centre_Dialog $summary default +} + +########################################################### +# CTselectOutputFile +########################################################### +########################################################### +########################################################### +proc CTselectOutputFile { num } { + global gCT + set gCT(summary.filename.$num) specified + if { "" != [ set temp [tk_getSaveFile] ] } {set gCT(summary.file.$num) $temp} +} + +########################################################### +# CTcreateSummaryReport +########################################################### +########################################################### +########################################################### +proc CTcreateSummaryReport { num cmdnum } { + global gCT gFile + + displayStatus "Opening File" both $cmdnum + + switch $gCT(summary.who.$cmdnum) { + all { + set file ClassSet$gCT(summary.set.$cmdnum).rpt + } + section { + set file Sec$gCT(summary.section.$cmdnum)Set$gCT(summary.set.$cmdnum).rpt + } + default { + displayError "An error has occurred while creating a summary \ + report $gCT(summary.section.$cmdnum)" + return + } + } + + if { $gCT(summary.filename.$cmdnum) == "specified" } { + set file $gCT(summary.file.$cmdnum) + } + if { $file == "" } { + removeStatus + displayError "Must specify a valid filename" + return + } + updateStatusMessage "Creating Summary" $cmdnum + + set cwd [pwd] + cd $gFile($num) + set error [ catch {CTcreateSummary $file $cmdnum} ] + cd $cwd + + removeStatus $cmdnum + + if {!$error && "Yes" == [makeSure \ + "Created summary file $file, would you like to see it?"]} { + set fileId [open [file join $gFile($num) $file] r] + CTputs $cmdnum [read $fileId] + CToutput $num $cmdnum + } +} + +########################################################### +# CTsetList +########################################################### +########################################################### +########################################################### +proc CTsetList { file } { + set list "" + for { set i 0 } { $i < 100 } { incr i } { + if { [file readable [file join $file records set$i.db]] } { + lappend list $i + } + } + return $list +}