capa/capa51/GUITools/capastats.tcl - view

File: [LON-CAPA] / capa / capa51 / GUITools / capastats.tcl
Revision 1.3: download - view: text, annotated - select for diffs
Mon Oct 18 20:58:33 1999 UTC (25 years ago) by albertel
Branches: MAIN
CVS tags: HEAD

- Added logging of InfoFile accesses to capadiscuss
- Fixed some string variable handling problems, when a string variable
  isn't set by a /LET it is left with a s_str field equal to NULL,
  some other portions of the code didn't check for this case before
  doing strlen(), etc.

########################################################### # runCapaTools ########################################################### ########################################################### ########################################################### proc runCapaTools { classDirConfigFile } { global gUniqueNumber gWindowMenu gFile gCT set num [incr gUniqueNumber] set classDir [file dirname $classDirConfigFile] set gFile($num) $classDir set utilsMenu [menu .utilsMenu$num -tearoff 0 -type tearoff -font 8x13bold \ -disabledforeground grey85 ] set gCT($num) $utilsMenu set pathLength [string length $gFile($num)] if { $pathLength > 22 } { set pathSubset ...[string range $gFile($num) [expr $pathLength - 22 ] end] } else { set pathSubset $gFile($num) } $utilsMenu add command -label "CapaUtils Ver 1.1" -foreground grey85 -background \ black -state disabled $utilsMenu add command -label $pathSubset -foreground white -background \ grey30 -state disabled $utilsMenu add command -label "Change Class path" -command "CTchangePath $num" $utilsMenu add command -label "Run capastat" -command "CTcapaStat $num" $utilsMenu add command -label "Run capastat2" -command "CTcapaStat2 $num" $utilsMenu add command -label "Summarize Log files" -command "CTlogAnalysis $num" $utilsMenu add command -label "Student Course Profile" -command \ "CTstartStudentCourseProfile $num" $utilsMenu add command -label "CAPA IDs for one student" \ -command "CToneStudentCapaID $num" $utilsMenu add command -label "All CAPA IDs" -command "CTclassCapaID $num" $utilsMenu add command -label "Item Analysis" -command "CTitemAnalysisStart $num" $utilsMenu add command -label "Item Correlation" \ -command "CTitemCorrelationStart $num" # $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 "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 set geometry [wm geometry $utilsMenu] wm geometry $utilsMenu +0+[lindex [split $geometry +] end] parseCapaConfig $num $gFile($num) parseCapaUtilsConfig $num $gFile($num) } #menu commands ########################################################### # CTchangePath ########################################################### ########################################################### ########################################################### #FIXME need to wait unit all running commands are done proc CTchangePath { num } { global gFile gCapaConfig set path [tk_getOpenFile -title "Please select a capa.config file" -filetypes \ { { {Capa Config} {capa.config} } }] if { $path == "" } { return } set gFile($num) [file dirname $path] foreach temp [array names gCapaConfig "$num.*"] { unset gCapaConfig($temp) } parseCapaConfig $num $gFile($num) parseCapaUtilsConfig $num $gFile($num) set pathLength [string length $gFile($num)] if { $pathLength > 22 } { set pathSubset ...[string range $gFile($num) [expr $pathLength - 22 ] end] } else { set pathSubset $gFile($num) } .utilsMenu$num entryconfigure 1 -label $pathSubset } ########################################################### # CTcapaStat2 ########################################################### ########################################################### ########################################################### proc CTcapaStat2 { num } { global gFile gCT gUniqueNumber if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { 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" } removeStatus $cmdnum CToutput $num $cmdnum } errors ] } { global errorCode errorInfo displayError "$errors\n$errorCode\n$errorInfo" unset gCT(cmd.$cmdnum) } else { unset gCT(cmd.$cmdnum) } } ########################################################### # CTcapaStat ########################################################### ########################################################### ########################################################### proc CTcapaStat { num } { global gFile gCT gUniqueNumber if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { return } set cmdnum [incr gUniqueNumber] set gCT(cmd.$cmdnum) capastat if { [ catch { CTdatestamp $cmdnum set file [file join $gFile($num) records "set$setId.db"] displayStatus "Generating Stats [file tail $file]" both $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 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" removeStatus $cmdnum CToutput $num $cmdnum } errors ] } { global errorCode errorInfo displayError "$errors\n$errorCode\n$errorInfo" unset gCT(cmd.$cmdnum) } else { unset gCT(cmd.$cmdnum) } } ########################################################### # CTlogAnalysis ########################################################### ########################################################### ########################################################### proc CTlogAnalysis { num } { global gFile gUniqueNumber gCT if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { return } set cmdnum [incr gUniqueNumber] set gCT(cmd.$cmdnum) loganalysis CTdatestamp $cmdnum if { [ catch { CTlogAnalysis2 $num $cmdnum $setId } errors ] } { displayError $errors unset gCT(cmd.$cmdnum) } else { unset gCT(cmd.$cmdnum) } CToutput $num $cmdnum } ########################################################### # CTstartStudentCourseProfile ########################################################### ########################################################### ########################################################### proc CTstartStudentCourseProfile { num } { global gFile gCT getOneStudent $gCT($num) $gFile($num) s_id s_name if { $s_id == "" } { return } CTstudentCourseProfile $num $s_id $s_name } ########################################################### # CTstudentCourseProfile ########################################################### ########################################################### ########################################################### proc CTstudentCourseProfile { num s_id s_name {loginAnalysis 2} } { global gFile gUniqueNumber gCapaConfig gCT set cmdnum [incr gUniqueNumber] set gCT(cmd.$cmdnum) studentcourseprofile displayStatus "Collecting homework scores for $s_name" both $cmdnum CTdatestamp $cmdnum CTputs $cmdnum "$s_name\n" if { [ catch { CTcollectSetScores $cmdnum $gFile($num) $s_id 1 \ $gCapaConfig($num.homework_scores_limit_set) } error ] } { global errorCode errorInfo displayError "$error \n $errorCode \n $errorInfo" } foreach type { quiz exam supp others } { updateStatusMessage "Collecting $type scores for $s_name" $cmdnum catch { if { [file isdirectory $gCapaConfig($num.[set type]_path)] } { CTcollectSetScores $cmdnum $gCapaConfig($num.[set type]_path) $s_id 1 \ $gCapaConfig($num.[set type]_scores_limit_set) } } } removeStatus $cmdnum if { ($loginAnalysis == 2 && "Yes" == [makeSure \ "Do you wish to do a Login Analysis? It may take a while." ]) || ($loginAnalysis == 1) } { displayStatus "Analyzing login data." both $cmdnum if { [catch { CTloginAnalysis $cmdnum $gFile($num) $s_id \ $gCapaConfig($num.homework_scores_limit_set) } error] } { displayError error } if { [catch { CTstudentSetAnalysis $cmdnum $gFile($num) $s_id \ $gCapaConfig($num.homework_scores_limit_set) } error] } { displayError error } removeStatus $cmdnum } CTdisplayStudent $cmdnum $gCT($num) $gFile($num) $s_id unset gCT(cmd.$cmdnum) CToutput $num $cmdnum } ########################################################### # CToneStudentCapaID ########################################################### ########################################################### ########################################################### proc CToneStudentCapaID { num } { global gFile gUniqueNumber gCapaConfig gCT getOneStudent $gCT($num) $gFile($num) s_id s_name if { $s_id == "" } { return } set cmdnum [incr gUniqueNumber] set gCT(cmd.$cmdnum) onestudentcapaid set setlist [getSetRange $gCT($num) $gFile($num)] set command "$gCapaConfig($num.allcapaid_command) -i -stu $s_id -s [lindex $setlist 0] -e [lindex $setlist 1] -c $gFile($num)" if { "Yes" == [makeSure "CMD: $command\n Do you wish to execute this command?"] } { CTdatestamp $cmdnum CTputs $cmdnum "CapaIDs for: $s_id, $s_name\n" displayStatus "Getting CapaIDs" spinner $cmdnum set fileId [open "|$command" "r"] fconfigure $fileId -blocking 0 fileevent $fileId readable "CTrunCommand $num $cmdnum $fileId" } } ########################################################### # CTclassCapaID ########################################################### ########################################################### ########################################################### proc CTclassCapaID { num } { global gFile gUniqueNumber gCapaConfig gCT set cmdnum [incr gUniqueNumber] set gCT(cmd.$cmdnum) classcapaid set setlist [getSetRange $gCT($num) $gFile($num)] if { $setlist == "" } { return } set command "$gCapaConfig($num.allcapaid_command) -i -s [lindex $setlist 0] -e [lindex $setlist 1] -c $gFile($num)" if { "Yes" == [makeSure "CMD: $command\n Do you wish to execute this command?"] } { CTdatestamp $cmdnum displayStatus "Getting all CapaIDs" spinner $cmdnum set fileId [open "|$command" "r"] fconfigure $fileId -blocking 0 fileevent $fileId readable "CTrunCommand $num $cmdnum $fileId" } } ########################################################### # CTitemAnalysisStart ########################################################### ########################################################### ########################################################### proc CTitemAnalysisStart { num } { global gFile gUniqueNumber gCapaConfig gCT set cmdnum [incr gUniqueNumber] set gCT(cmd.$cmdnum) itemanalysis set paths "" lappend paths [list "classpath" $gFile($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 ] ] == ""} { unset gCT(cmd.$cmdnum) return } if { [set sets [getSetRange $gCT($num) $gFile($num)]] == "" } { unset gCT(cmd.$cmdnum) return } CTdatestamp $cmdnum if { [ catch {CTitemAnalysisRange $cmdnum [lindex $select 1] \ [lindex $sets 0] [lindex $sets 1] } errors ] } { displayError $errors } unset gCT(cmd.$cmdnum) CToutput $num $cmdnum } ########################################################### # CTitemCorrelationStart ########################################################### ########################################################### ########################################################### proc CTitemCorrelationStart { num } { global gFile gUniqueNumber gCapaConfig gCT ## FIXME: ## Let user specify how many categories to calculate correlation ## For each category, the user can specify problem numbers to ## be in that category ## Then, the correlations between each category is calculated ## set cmdnum [incr gUniqueNumber] set gCT(cmd.$cmdnum) itemanalysis set paths "" lappend paths [list "classpath" $gFile($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 ] ] == "" } { unset gCT(cmd.$cmdnum) return } if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { unset gCT(cmd.$cmdnum) return } CTdatestamp $cmdnum if { [ catch { CTitemCorrelation $cmdnum [lindex $select 1] \ $setId } errors ] } { displayError $errors } unset gCT(cmd.$cmdnum) CToutput $num $cmdnum } ########################################################### # CTsubmissions ########################################################### ########################################################### ########################################################### proc CTsubmissions { num } { global gCT gFile gUniqueNumber gCapaConfig getOneStudent $gCT($num) $gFile($num) s_id s_name if { $s_id == "" } { return } set cmdnum [incr gUniqueNumber] set gCT(cmd.$cmdnum) submissions 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] } ########################################################### # CTanalyzeReport ########################################################### ########################################################### ########################################################### proc CTanalyzeReport { num } { global gUniqueNumber gCT gFile set cmdnum [incr gUniqueNumber] set gCT(cmd.$cmdnum) analyzereport set reportFile [tk_getOpenFile -title "Please select the Report file" \ -filetypes { {{Capa Reports} {*.rpt}} {{All Files} {*}} }] if { $reportFile == "" } { return } set percentage [tk_dialog $gCT($num).dialog "How would you like scores displayed?" \ "How would you like scores displayed?" "" "" "Points Earned" \ "Percentage" "Cancel"] if { $percentage == 2 } { return } set pwd [pwd];cd $gFile($num) set sectionList [pickSections [getExistingSections] "Select Sections To Analyze:" $gCT($num) ] CTdatestamp $cmdnum CTputs $cmdnum "Analyzing Report File $reportFile\n" CTputs $cmdnum " For Sections $sectionList\n" CTputs $cmdnum " Report Created at [clock format [file mtime $reportFile]]\n" cd $pwd set scorelist [CTreportDist $cmdnum $reportFile $percentage $sectionList] set label [lindex "{Grade} {Grade(%)}" $percentage] set ptsearned 0 set totalnumstu 0 foreach element $scorelist { set numstu [lindex $element 0] set score [lindex $element 1] set ptsearned [expr $ptsearned + ($numstu*$score)] incr totalnumstu $numstu } set average [expr $ptsearned / double($totalnumstu)] set avgmsg [format "Average: %.2f" $average] CTputs $cmdnum $avgmsg\n CTbargraph $gCT($num) $num $cmdnum $scorelist $gFile($num) "Score Distribution for [file tail $reportFile] $avgmsg" $label "\# Students" SCP unset gCT(cmd.$cmdnum) CToutput $num $cmdnum } ########################################################### # CTanalyzeScorer ########################################################### ########################################################### ########################################################### proc CTanalyzeScorer { num } { global gFile gUniqueNumber gCapaConfig gCT set cmdnum [incr gUniqueNumber] 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]] if { "" == [set gCT($cmdnum.questNum) [getString $gCT($num) "Which questions?"]]} { return } set gCT($cmdnum.max) [lindex [exec wc -l $file] 0] set gCT($cmdnum.done) 1 set gCT($cmdnum.graphup) 0 set gCT($cmdnum.num) $num displayStatus "Getting student reponses" both $cmdnum set gCT($cmdnum.fileId) [open $file r] if { [regexp {scorer\.output\.([0-9]|([0-9][0-9]))} $file] } { set gCT($cmdnum.setId) [string range [file extension $file] 1 end] set gCT($cmdnum.parse) CTparseScorerOutputLine set aline [gets $gCT($cmdnum.fileId)] } else { set gCT($cmdnum.setId) [lindex [split [file tail $file] s.] 4] set gCT($cmdnum.parse) CTparseSubmissionsLine } set aline [gets $gCT($cmdnum.fileId)] $gCT($cmdnum.parse) $aline $cmdnum set pwd [pwd];cd $path getSet $gCT($cmdnum.question) $gCT($cmdnum.setId) "CTcontinueAnalyze $cmdnum $path" 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 CTupdateAnalyzeScorer { cmdnum } { global gCT gResponse gUniqueNumber gFile set num $gCT($cmdnum.num) set i 0 foreach correct [array names gResponse "$cmdnum.correct.*"] { set probnum [lindex [split $correct .] 2] set answer [join [lrange [split $correct .] 3 end] .] if { $gResponse($correct) } { set color($probnum.$answer) green } else { set color($probnum.$answer) red } } 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 probnum [lindex [split $response .] 1] if { $probnum > $oldprobnum } { 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)] } if { $results == "" } { return } if { $gCT($cmdnum.graphup)} { CTchangeBargraphData $cmdnum $results } else { CTbargraph $gCT($num) $num $cmdnum $results $gFile($num) "Reponse Distribution" "Which Response" "\#Picked" "Showresponse" set gCT($cmdnum.graphup) 1 } update idletasks } 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 } proc CTfinishAnalyzeScorer { cmdnum } { global gCT gResponse gUniqueNumber gFile set num $gCT($cmdnum.num) set i 0 removeStatus $cmdnum foreach correct [array names gResponse "$cmdnum.correct.*"] { set probnum [lindex [split $correct .] 2] set answer [join [lrange [split $correct .] 3 end] .] if { $gResponse($correct) } { set color($probnum.$answer) green } else { set color($probnum.$answer) red } } foreach response [lsort -dictionary [array names gResponse $cmdnum.\[0-9\]*]] { 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)] } 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 } proc CTparseScorerOutputLine { aline num } { global gCT set gCT($num.stunum) [lindex $aline 0] set aline [string range $aline 40 end] set length [llength [split [lrange $aline 3 end] ,] ] set gCT($num.response) [lrange [split [lrange $aline 3 end] ,] 0 \ [expr {$length-2}]] set gCT($num.question) [lindex [lindex [split $aline ,] end] 0] return 1 } proc CTparseSubmissionsLine { aline num } { global gCT set aline [split $aline \t] set gCT($num.stunum) [lindex $aline 0] set gCT($num.question) $gCT($num.stunum) set gCT($num.response) "" set interesting 0 set current 1 foreach {quest response} [lrange $aline 2 end] { if { $quest == "" } break while { $quest > $current } { lappend gCT($num.response) {} incr current } if { [lsearch $gCT($num.questNum) $quest] != -1} { set interesting 1 } lappend gCT($num.response) [string toupper $response] incr current } return $interesting } proc CTgetQuestions { num questionVar } { global gCT upvar $questionVar question # parray question foreach quest $gCT($num.questNum) { foreach line $question($quest.quest) { if { [regexp {^ *([A-Z])\)(.*)} $line temp letter rest] } { set question($quest.$letter) $rest if { [string first $letter $question($quest.ans)] != -1} { set question($quest.correct.$letter) 1 set question($quest.$letter) "$rest - Correct" } else { set question($quest.correct.$letter) 0 set question($quest.$letter) "$rest - Incorrect" } } } } } proc CTgetStudentResponses { num responses which questionVar } { global gCT gResponse upvar $questionVar question # parray question set i 0 foreach response [split $responses {}] { if { $response == "" || $response == " "} { continue } incr i 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" continue } } if { $question($which.correct.$response) } { set gResponse($num.correct.$which.$question($which.$response)) 1 } else { set gResponse($num.correct.$which.$question($which.$response)) 0 } } return $i } ########################################################### # CTgraphAnalyzeScorer ########################################################### ########################################################### ########################################################### proc CTgraphAnalyzeScorer { num } { global gFile gUniqueNumber gCapaConfig gCT gResponse set cmdnum [incr gUniqueNumber] set gCT(cmd.$cmdnum) graphanalyzescorer if { "" == [set file [tk_getOpenFile -title "Pick a Output file" -filetypes { { {All Files} {*} } } -initialdir $gFile($num)]] } { return } set fileId [open $file r] set temp [read $fileId [file size $file]] close $fileId foreach {name value} $temp { set name [join "$cmdnum [lrange [split $name .] 1 end]" .] set gResponse($name) $value } 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]] event generate . <1> -x 1 -y 1 event generate . <ButtonRelease-1> if { "" == [set probnums [multipleChoice $gCT($num) "Select which problems" $probnums 0]] } { return } foreach name [array names gResponse $cmdnum.\[0-9\]*] { 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) } } set gCT($cmdnum.num) $num set gCT($cmdnum.graphup) 0 CTupdateAnalyzeScorer $cmdnum unset gCT(cmd.$cmdnum) } ########################################################### # 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 ########################################################### ########################################################### ########################################################### proc CTquit { num } { global gCT destroy $gCT($num) } #menu command helpers ########################################################### # CTscanSetDB ########################################################### ########################################################### ########################################################### proc CTscanSetDB { num file Q_cntVar L_cntVar } { global gMaxSet gTotal_try gYes_cnt gyes_cnt gStudent_cnt gStudent_try \ gTotal_weight gTotal_scores gEntry gScore gNewStudent_cnt upvar $Q_cntVar Q_cnt upvar $L_cntVar L_cnt set line_cnt 0 set valid_cnt 0 for { set ii 0 } { $ii <= $gMaxSet } { incr ii } { set gTotal_try($num.$ii) 0 set gYes_cnt($num.$ii) 0 set gyes_cnt($num.$ii) 0 for { set jj 0 } { $jj <= $gMaxSet } { incr jj } { set gStudent_cnt($num.$ii.$jj) 0 set gStudent_try($num.$ii.$jj) 0 } set gNewStudent_cnt($num.$ii) 0 } set gTotal_weight($num) 0 set gTotal_scores($num) 0 set maxLine [lindex [exec wc $file] 0] set tries "" set fileId [open $file "r"] set aline [gets $fileId] while { ! [eof $fileId] } { incr line_cnt if { ($line_cnt%20) == 0 } { updateStatusBar [expr $line_cnt/double($maxLine)] $num } if { $line_cnt == 2 } { set aline [string trim $aline] set weight [split $aline {}] } if { $line_cnt > 3 } { catch { set aline [string trim $aline] set prefix [lindex [split $aline ,] 0] set s_num [lindex [split $aline " "] 0] set ans_str [lindex [split $prefix " "] 1] set ans_char [split $ans_str {} ] set tries [lrange [split $aline ,] 1 end] for { set valid 0; set ii 0 } { $ii < [llength $ans_char] } { incr ii } { if {([lindex $ans_char $ii] != "-")&&([lindex $ans_char $ii] != "E") && ([lindex $ans_char $ii] != "e") } { set valid 1 } } if { $valid } { for {set score 0; set ii 0} { $ii < [llength $tries] } { incr ii } { set triesii 0 incr gTotal_weight($num) [lindex $weight $ii] if { [lindex $ans_char $ii] == "Y" } { set triesii [string trim [lindex $tries $ii]] incr gYes_cnt($num.$ii) incr score [lindex $weight $ii] incr gNewStudent_cnt($num.$ii) } elseif { [lindex $ans_char $ii] == "y" } { set triesii [string trim [lindex $tries $ii]] incr triesii incr gyes_cnt($num.$ii) incr score [lindex $weight $ii] incr gNewStudent_cnt($num.$ii) } elseif { ( [lindex $ans_char $ii] > 0 ) && \ ( [lindex $ans_char $ii] <= 9) } { set triesii [string trim [lindex $tries $ii]] incr score [lindex $ans_char $ii] incr gYes_cnt($num.$ii) incr gNewStudent_cnt($num.$ii) } elseif { ( [lindex $ans_char $ii] == 0 ) } { set triesii [string trim [lindex $tries $ii]] incr gNewStudent_cnt($num.$ii) } elseif {([lindex $ans_char $ii]=="n") || \ ([lindex $ans_char $ii]=="N")} { set triesii [string trim [lindex $tries $ii]] if { [lindex $ans_char $ii] == "n" } { incr triesii } incr gNewStudent_cnt($num.$ii) } set gStudent_try($num.$valid_cnt.$ii) $triesii incr gTotal_try($num.$ii) $triesii incr gStudent_cnt($num.$ii.$triesii) } incr gTotal_scores($num) $score set gEntry($num.$valid_cnt) "$aline" set gScore($num.$valid_cnt) $score incr valid_cnt } } } set aline [gets $fileId] } close $fileId set Q_cnt [llength $tries] set L_cnt $valid_cnt return } ########################################################### # CTpercentageScores ########################################################### ########################################################### ########################################################### proc CTpercentageScores { num setId valid_cnt } { global gTotal_weight gTotal_scores 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 "The number of valid records for set$setId.db is: $valid_cnt\n" } ########################################################### # CTaverage ########################################################### ########################################################### ########################################################### proc CTaverage { num q_cnt l_cnt faillistVar dodifflistVar numyesVar} { upvar $faillistVar faillist $dodifflistVar dodifflist $numyesVar numyes global gMaxTries gStudent_cnt gStudent_try gTotal_try gYes_cnt gyes_cnt \ gNewStudent_cnt set maxIter [expr $q_cnt * 4] for { set ii 0 } { $ii < $q_cnt } { incr ii } { updateStatusBar [expr $ii/double($maxIter)] $num set s_cnt($ii) 0 set avg($ii) 0.0 set max_try($ii) 0 for { set jj 1 } { $jj < $gMaxTries } { incr jj } { if { $gStudent_cnt($num.$ii.$jj) > 0 } { set avg($ii) [expr $avg($ii) + ($jj * $gStudent_cnt($num.$ii.$jj))] incr s_cnt($ii) $gStudent_cnt($num.$ii.$jj) } } set s_cnt($ii) $gNewStudent_cnt($num.$ii) if { $s_cnt($ii) > 0 } { set avg($ii) [expr $avg($ii) / $s_cnt($ii)] } } for { set ii 0 } { $ii < $q_cnt } { incr ii } { updateStatusBar [expr ($ii+$q_cnt)/double($maxIter)] $num set sd($ii) 0.0 set sum 0.0 for { set jj 0 } { $jj < $l_cnt } { incr jj } { if { $gStudent_try($num.$jj.$ii) > $max_try($ii) } { set max_try($ii) $gStudent_try($num.$jj.$ii) } if { $gStudent_try($num.$jj.$ii) > 0 } { set sq [expr ( $gStudent_try($num.$jj.$ii) - $avg($ii) ) * \ ( $gStudent_try($num.$jj.$ii) - $avg($ii)) ] set sum [expr $sum + $sq] } if { $s_cnt($ii) > 1 } { set sd($ii) [expr $sum / ( $s_cnt($ii) - 1.0 )] } if { $sd($ii) > 0 } { set sd($ii) [ expr sqrt($sd($ii)) ] } } } for { set ii 0 } { $ii < $q_cnt } { incr ii } { updateStatusBar [expr ($ii+(2*$q_cnt))/double($maxIter)] $num set sd3($ii) 0.0 set sum 0.0 for { set jj 0 } { $jj < $l_cnt } { incr jj } { if { $gStudent_try($num.$jj.$ii) > 0 } { set tmp1 [expr $gStudent_try($num.$jj.$ii) - $avg($ii)] set tmp2 [expr $tmp1 * $tmp1 * $tmp1] set sum [expr $sum + $tmp2] } if { ( $s_cnt($ii) > 0 ) && ( $sd($ii) != 0.0 ) } { set sd3($ii) [expr $sum / $s_cnt($ii) ] set sd3($ii) [expr $sd3($ii) / ($sd($ii) * $sd($ii) * $sd($ii)) ] } } } CTputs $num "This is the statistics for each problem: \n" CTputs $num "Prob\# MxTries avg. s.d. s.k. \#Stdnts" CTputs $num " \#Yes \#yes Tries DoDiff %Wrong\n" set numyes [set dodifflist [set faillist ""]] # parray s_cnt for { set ii 0 } { $ii < $q_cnt } { incr ii } { updateStatusBar [expr ($ii+(3*$q_cnt))/double($maxIter)] $num if { $gTotal_try($num.$ii) > 0 } { set dod [expr $gTotal_try($num.$ii)/(0.1 + $gYes_cnt($num.$ii) \ + $gyes_cnt($num.$ii))] } else { set dod 0.0 } if {[catch {set success [expr 100.0*($s_cnt($ii)-($gYes_cnt($num.$ii)+ \ $gyes_cnt($num.$ii)))/$s_cnt($ii)]}]} { set success 0.0 set s_cnt($ii) 0 } CTputs $num [format "P %2d" [expr int($ii + 1)] ] CTputs $num [format "%6d %8.2f %7.2f %6.2f %5d %5d %5d %5d %5.1f %6.2f\n"\ $max_try($ii) $avg($ii) $sd($ii) $sd3($ii) $s_cnt($ii) \ $gYes_cnt($num.$ii) $gyes_cnt($num.$ii) \ $gTotal_try($num.$ii) $dod $success] if { $success < 0 } { set success 0 } lappend faillist [list $success [expr int($ii + 1)]] lappend dodifflist [list $dod [expr int($ii + 1)]] lappend numyes [list [expr $gYes_cnt($num.$ii)+$gyes_cnt($num.$ii)] \ [expr int($ii + 1)]] } } ########################################################### # CTlogAnalysis2 ########################################################### ########################################################### ########################################################### proc CTlogAnalysis2 { num cmdnum setId } { global gFile 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) l(A) l(F) } else { 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) w(A) w(F) } else { 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)+$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 #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))] } else { set ratio($v) 0.0 } } set overall_entries [expr $telnet_total + $web_total] if { $overall_entries > 0 } { set ratio(web) [expr 100.0*(double($web_total)/double($overall_entries))] } else { set ratio(web) 0.0 } 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) ] } ########################################################### # CTscanLogDB ########################################################### ########################################################### ########################################################### 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 displayStatus "Analyzing [file tail $file]" both $num set maxLine [lindex [exec wc $file] 0] set fileId [open $file "r"] set aline [gets $fileId] while { ! [eof $fileId] } { incr line_cnt if { ($line_cnt%20) == 0 } { updateStatusBar [expr $line_cnt/double($maxLine)] $num } set aline [string trim $aline] set ans_str [string range $aline 35 end] set ans_char [split $ans_str {}] 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(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(A.total) 0 set count(F.total) 0 } set i -1 foreach char $ans_char { incr i 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(A.$i) 0 set count(F.$i) 0 incr count($char.$i) } incr count($char.total) } set aline [gets $fileId] } close $fileId removeStatus $num 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 %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 %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 } ########################################################### # CTcollectSetScores ########################################################### ########################################################### ########################################################### proc CTcollectSetScores { num path id on_screen limit } { set id [ string toupper $id ] set total_scores 0 set total_weights 0 set set_idx 0 set done 0 while { ! $done } { incr set_idx if { $set_idx > $limit } { set done 1; continue } updateStatusBar [expr $set_idx/double($limit)] $num set filename [file join $path records "set$set_idx.db"] if { ![file readable $filename ] } { continue } set fileId [open $filename "r"] set line_cnt 0 set found 0 set aline [ gets $fileId ] while { ! [eof $fileId] && ! $found } { incr line_cnt if { $line_cnt > 3 } { set aline [string trim $aline] set prefix [lindex [split $aline ","] 0] set s_num [string toupper [lindex [split $aline " "] 0] ] set ans_str [lindex [split $prefix " "] 1] if { $id == $s_num } { set ans_char [split $ans_str {} ] set valid 0 foreach char $ans_char { if { $char != "-" } { set valid 1; break } } if { ! $valid } { set score "-" } else { set score 0 for {set i 0} { $i < [llength $ans_char] } { incr i } { 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 } if { $char >= 0 && $char <= 9 } { incr score $char;set found 1 } if { $char == "E" } { incr valid_weights "-[lindex $weights $i]" } } incr total_scores $score } } } elseif { $line_cnt == 2 } { set aline [string trim $aline] set weights [split $aline {} ] set valid_weights 0 foreach weight $weights { incr valid_weights $weight } } else { #do nothing for line 1 and 3 } set aline [ gets $fileId ] } close $fileId incr total_weights $valid_weights set set_weights([expr $set_idx - 1]) $valid_weights if { $found } { set set_scores([expr $set_idx - 1]) $score } else { set set_scores([expr $set_idx - 1]) "-" } } set abscent_cnt 0 set present_cnt 0 set summary_str "" if { $on_screen } { CTputs $num " " } foreach i [lsort -integer [array names set_scores]] { if { $set_scores($i) == "-" || $set_scores($i) == "" } { if { $on_screen } { CTputs $num " - " } append summary_str "x/$set_weights($i) " incr abscent_cnt } else { if { $on_screen } { CTputs $num [format " %3d" $set_scores($i)] } append summary_str "$set_scores($i)/$set_weights($i) " incr present_cnt } } if { $on_screen } { CTputs $num "\n [file tail $path]:" foreach i [lsort -integer [array names set_scores]] { CTputs $num " ---" } CTputs $num "\n " if { [info exists set_weights] } { set num_set_weights [llength [array names set_weights]] } else { set num_set_weights 0 } for {set i 0} {$i < $num_set_weights} {incr i} { if { [info exists set_weights($i)] } { CTputs $num [format " %3d" $set_weights($i)] } else { set num_set_weights $i } } CTputs $num "\n" if { $total_weights != 0 } { set ratio [expr 100.0 * $total_scores / double($total_weights) ] CTputs $num [format " %5d\n" $total_scores] if { [info exists set_scores] } { CTputs $num [format " ------- = %3.2f%%, scores absent in %d/%d\n" \ $ratio $abscent_cnt [llength [array names set_scores]]] } else { CTputs $num [format " ------- = %3.2f%%, scores absent in %d/%d\n" \ $ratio $abscent_cnt 0 ] } } else { set ratio "-" CTputs $num [format " %5d\n" $total_scores] if { [info exists set_scores] } { CTputs $num [format " ------- = %s%%, scores absent in %d/%d\n" \ $ratio $abscent_cnt [llength [array names set_scores]]] } else { CTputs $num [format " ------- = %s%%, scores absent in %d/%d\n" \ $ratio $abscent_cnt 0 ] } } CTputs $num [format " %5d\n" $total_weights] } return [list $total_scores $total_weights $abscent_cnt \ [llength [array names set_scores] ] $summary_str] } ########################################################### # CTloginAnalysis ########################################################### ########################################################### ########################################################### proc CTloginAnalysis { num path id limit } { CTputs $num "Login analysis: telnet session web session\n\n" CTputs $num " set #: #Y #N #S #U #u #Y #N #S #U #u\n" set set_idx 0 set done 0 while { ! $done } { incr set_idx if { $set_idx > $limit } { set done 1; continue } CTputs $num [format " %2d: " $set_idx] set filename [file join $path records "log$set_idx.db"] updateStatusMessage "Analyzing [file tail $filename]" $num updateStatusBar 0.0 $num if { [file readable $filename] } { set result [CTstudentLoginData $num $filename $id] CTputs $num [eval format \"%4d %4d %4d %4d %4d\" $result] set no_log 0 } else { CTputs $num "========================" set no_log 1 } CTputs $num " " set filename [file join $path records "weblog$set_idx.db"] updateStatusMessage "Analyzing [file tail $filename]" $num updateStatusBar 0.0 $num if { [file readable $filename] } { set result [CTstudentLoginData $num $filename $id] CTputs $num [eval format \"%4d %4d %4d %4d %4d\" $result] set no_weblog 0 } else { CTputs $num "========================" set no_weblog 1 } CTputs $num "\n" if { $no_log && $no_weblog } { set done 1 } } } ########################################################### # CTstudentSetAnalysis ########################################################### ########################################################### ########################################################### proc CTstudentSetAnalysis { num path id limit } { set set_idx 0 set id [string toupper $id] CTputs $num " set \#:\n" set done 0 while { ! $done } { incr set_idx if { $set_idx > $limit } { set done 1; continue } set filename [file join $path records "set$set_idx.db"] updateStatusMessage "Analyzing [file tail $filename]" $num if { ![file readable $filename] } { continue } CTputs $num [format " %2d: " $set_idx] set fileId [open $filename "r"] set line_cnt 0 set found 0 set aline [gets $fileId] while { ! [eof $fileId] && !$found } { incr line_cnt if { $line_cnt > 3 } { set aline [string trim $aline] set s_id [string toupper [string range $aline 0 8]] if {$id == $s_id} { set found 1 set breakpt [string first "," $aline] set data [list [string range $aline 10 [expr $breakpt - 1] ] \ [string range $aline [expr $breakpt + 1] end ] ] CTputs $num "[lindex $data 0]\n [lindex $data 1]\n" } } set aline [gets $fileId] } close $fileId if { ! $found } { CTputs $num "\n\n" } } } ########################################################### # CTstudentLoginData ########################################################### ########################################################### ########################################################### proc CTstudentLoginData { num filename id } { set Y_total 0 set N_total 0 set U_total 0 set u_total 0 set S_total 0 set maxLine [expr double([lindex [exec wc $filename] 0])] set line_cnt 0 set fileId [open $filename "r"] set aline [gets $fileId] while { ![eof $fileId] } { incr line_cnt if { $line_cnt%300 == 0 } { updateStatusBar [expr $line_cnt/$maxLine] $num } set aline [string trim $aline] set s_id [string toupper [string range $aline 0 8]] set id [string toupper $id] if {$id == $s_id} { set ans_char [split [string range $aline 35 end] {} ] for {set i 0} {$i< [llength $ans_char]} {incr i} { if {[lindex $ans_char $i] == "Y"} { incr Y_total } 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 } } } set aline [gets $fileId] } close $fileId return [list $Y_total $N_total $S_total $U_total $u_total] } ########################################################### # CTrunCommand ########################################################### ########################################################### ########################################################### proc CTrunCommand { num cmdnum fileId {followup "" }} { global gCT set data [read $fileId] updateStatusSpinner $cmdnum if { $data != "" } { CTputs $cmdnum $data } if { [eof $fileId] } { fileevent $fileId readable "" catch {close $fileId} if { $followup == "" } { CToutput $num $cmdnum removeStatus $cmdnum unset gCT(cmd.$cmdnum) } else { eval $followup } } } ########################################################### # CTitemAnalysisRange ########################################################### ########################################################### ########################################################### proc CTitemAnalysisRange { num classpath setIdStart setIdEnd } { for { set i $setIdStart } { $i <= $setIdEnd } { incr i } { if { [ catch { CTitemAnalysis $num $classpath $i } errors ] } { displayError $errors } } } ########################################################### # CTitemAnalysis ########################################################### ########################################################### ########################################################### proc CTitemAnalysis { num classpath setId } { global gMaxSet set done 0 set total_scores 0 set total_weights 0 set upper_percent 0.0 set lower_percent 0.0 set Y_total 0 set N_total 0 for { set ii 0} { $ii<$gMaxSet } {incr ii} { set Y_cnt($ii) 0 set N_cnt($ii) 0 set Ycnt_upper($ii) 0.0 set Ycnt_lower($ii) 0.0 } set filename [file join $classpath records "set$setId.db"] if { ! [file readable $filename] } { CTputs $num "FILE: $filename does not exist!\n" return } displayStatus "Analyzing [file tail $filename]" both $num set maxLine [lindex [exec wc $filename] 0] set fileId [open "$filename" "r"] set valid_cnt 0 set line_cnt 0 set ans_char "" set aline [gets $fileId] while {![eof $fileId]} { incr line_cnt if { ($line_cnt%20) == 0 } { updateStatusBar [expr $line_cnt/double($maxLine)] $num } if { $line_cnt == 2 } { set aline [string trim $aline] set weights [split $aline {}] # set valid_weights 0 # for { set ii 0 } { $ii < [llength $weights] } { incr ii } { # incr valid_weights [lindex $weights $ii] # } } elseif { $line_cnt > 3} { set aline [string trim $aline] set prefix [lindex [split $aline ","] 0] set s_num [string toupper [lindex [split $aline " " ] 0 ] ] set ans_str [lindex [split $prefix " "] 1] set ans_char [split $ans_str {} ] set valid 0 for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } { if { [lindex $ans_char $ii] != "-"} { set valid 1 } } if { $valid } { incr valid_cnt set score 0 for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } { 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] } 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] } 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]) ] 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] set N_cnt($ii) [expr $N_cnt($ii) + $no_part] set N_total [expr $N_total + $no_part] } # if { [lindex $ans_char $ii] == "E"} { # incr valid_weights -[lindex $weights $ii] # } } set s_db([format "%08d%s" $score $s_num]) $ans_str } } set aline [gets $fileId] } close $fileId removeStatus $num for { set ii 0 } { $ii < $gMaxSet } { incr ii } { set Ycnt_upper($ii) 0 set Ycnt_lower($ii) 0 } displayStatus "Pondering data . . ." spinner $num set upperpart_cnt [expr int(0.27 * double($valid_cnt))] set lowerpart_limit [expr $valid_cnt - $upperpart_cnt] set line_cnt 0 foreach sort_key [lsort -decreasing [array names s_db]] { incr line_cnt if { ($line_cnt%20) == 0 } { updateStatusSpinner $num } set ans_str $s_db($sort_key) set ans_char [split $ans_str {} ] for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } { if { [lindex $ans_char $ii] == "Y" || \ [lindex $ans_char $ii] == "y" || \ [lindex $ans_char $ii] == [lindex $weights $ii] } { if { $line_cnt <= $upperpart_cnt } { incr Ycnt_upper($ii) } elseif { $line_cnt > $lowerpart_limit } { incr Ycnt_lower($ii) } } } } CTputs $num " There are $valid_cnt entries in file $filename\n" CTputs $num [format " The upper 27%% has %d records, the lower 27%% has %d records\n"\ $upperpart_cnt [expr $valid_cnt - $lowerpart_limit] ] CTputs $num " question \# DoDiff. Disc. Factor (%upper - %lower) \[\#records,\#records\]\n"; for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } { updateStatusSpinner $num set tmp_total [expr $N_cnt($ii) + $Y_cnt($ii)] if { $tmp_total > 0 } { set diff [expr 100.0*($N_cnt($ii) / double($N_cnt($ii) + $Y_cnt($ii)))] } else { set diff "-" } set upper_percent [expr 100.0 * ($Ycnt_upper($ii) /double($upperpart_cnt))] set lower_percent [expr 100.0 * ($Ycnt_lower($ii) /double($upperpart_cnt))] set disc [expr $upper_percent - $lower_percent] CTputs $num [format " %2d: " [expr $ii + 1]] CTputs $num [format "%6.1f %5.1f (%6.1f - %6.1f) \[%8d,%8d\]\n" \ $diff $disc $upper_percent $lower_percent $Ycnt_upper($ii) \ $Ycnt_lower($ii) ] } removeStatus $num } ########################################################### # CTitemCorrelation ########################################################### # INPUTS: class name with full path, set number # # r = \frac{\sum{x_i y_i} - \frac{(\sum x_i)(\sum y_i)}{n}} # {\sqrt{(\sum x_i^2 - \frac{}{}}} # # corr = (sum of prod_xy - (sum_x*sum_y / n) ) / sqrt( (sum of sqr_x - (sum_x*sum_x/n))* # ########################################################### ########################################################### proc CTitemCorrelation { num classpath setId } { global gMaxSet set filename [file join $classpath records "set$setId.db"] if { ! [file readable $filename] } { CTputs $num "FILE: $filename does not exist!\n" return } displayStatus "Analyzing [file tail $filename]" both $num set maxLine [lindex [exec wc $filename] 0] set initialized 0 set question_cnt 0 set fileId [open "$filename" "r"] set line_cnt 0 set aline [gets $fileId] while {![eof $fileId]} { incr line_cnt if { ($line_cnt%20) == 0 } { updateStatusBar [expr {$line_cnt/double($maxLine)}] $num } if { $line_cnt == 2 } { set aline [string trim $aline] set weights [split $aline {}] } if { $line_cnt > 3} { set aline [string trim $aline] set data [string range $aline 10 end] set ans_str [lindex [split $data ","] 0] set ans_char_list [split $ans_str {} ] set try_str [string range $aline [expr {[string first "," $data] +1}] end ] set question_cnt [llength $ans_char_list] for { set ii 0 } { $ii < $question_cnt } { incr ii } { set ans_char($ii) [lindex $ans_char_list $ii] } if { $question_cnt > $initialized } { for {set ii 0} {$ii < [expr {$question_cnt - 1}]} {incr ii} { set start [expr {($initialized>($ii+1)) ? $initialized : ($ii+1)}] for { set jj $start } { $jj < $question_cnt } { incr jj } { set index_key "$ii.$jj" set prod_xy($index_key) 0.0 set sum_x($index_key) 0 set sum_y($index_key) 0 set sum_x2($index_key) 0 set sum_y2($index_key) 0 set valid_cnt($index_key) 0 } } set initialized $question_cnt } for { set ii 0 } { $ii < [expr {$question_cnt - 1}] } { incr ii } { for { set jj [expr {$ii+1}] } { $jj < $question_cnt } { incr jj } { set index_key "$ii.$jj" if { $ans_char($ii) != "-" && $ans_char($ii) != "E" && \ $ans_char($jj) != "-" && $ans_char($jj) != "E" } { ## $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] } 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] } elseif { $ans_char($jj) == "N" || $ans_char($jj) == "n" } { set y_data 0 } else { ## must be in 0 .. 9 set y_data $ans_char($jj) } set prod_xy($index_key) [expr {$x_data * $y_data + $prod_xy($index_key)} ] incr sum_x($index_key) $x_data incr sum_y($index_key) $y_data incr sum_x2($index_key) [expr {$x_data * $x_data}] incr sum_y2($index_key) [expr {$y_data * $y_data}] incr valid_cnt($index_key) 1 } } } } set aline [gets $fileId] } close $fileId removeStatus $num # print out the correlation matrix # parray sum_x # parray sum_y # parray prod_xy CTputs $num " " for { set ii 1 } { $ii < $question_cnt } { incr ii } { CTputs $num [format " %2d" [expr {$ii+1}] ] } CTputs $num "\n" # -------------------------------------- for { set ii 0 } { $ii < [expr {$question_cnt -1}] } { incr ii } { CTputs $num [format " %2d:" [expr {$ii+1}] ] for { set jj 0 } { $jj < $ii } { incr jj } { CTputs $num " " } for { set jj [expr {$ii+1}] } { $jj < $question_cnt } { incr jj } { set index_key "$ii.$jj" if { $valid_cnt($index_key) != "0" } { set upper_part [ expr { $prod_xy($index_key) - ( ($sum_x($index_key) * $sum_y($index_key)) / double($valid_cnt($index_key)))}] set lower_part [expr {$sum_x2($index_key) - ($sum_x($index_key) * $sum_x($index_key) / double($valid_cnt($index_key)))} ] set lower_part [expr {$lower_part * ($sum_y2($index_key) - ($sum_y($index_key) * $sum_y($index_key) /double($valid_cnt($index_key))))}] set lower_part [expr {sqrt($lower_part)}] if { $lower_part != 0.0 } { set ratio [expr {$upper_part / double($lower_part)}] CTputs $num [format " % .2f" $ratio] } else { CTputs $num " INF " } } else { CTputs $num " ----" } } CTputs $num "\n" } } ########################################################### # CTsubmissionsLaunch ########################################################### ########################################################### ########################################################### proc CTsubmissionsLaunch { num cmdnum type s_id s_nm start end } { global gCT gFile gUniqueNumber gCapaConfig CTputs $cmdnum "$type submissions for $s_nm for set $start\n" if { $type == "telnet" } { set command "grep -i $s_id [file join $gFile($num) records submissions$start.db]" set followtype web } else { set command "grep -i $s_id [file join $gFile($num) \ records websubmissions$start.db]" set followtype telnet incr start } set done 0 set followcmd "" while { !$done && ($start <= ($end+1)) } { if { $start <= $end } { set followcmd "CTsubmissionsLaunch $num $cmdnum $followtype $s_id {$s_nm} \ $start $end" } if { ! [catch {set fileId [open "|$command" "r"]} ] } { set done 1 } } fconfigure $fileId -blocking 0 fileevent $fileId readable "CTrunCommand $num $cmdnum $fileId {$followcmd}" } ########################################################### # CTreportDist ########################################################### ########################################################### ########################################################### proc CTreportDist { num file percentage sectionlist } { set fileId [open $file "r"] set aline [gets $fileId] set which [expr [llength [split $aline "\t"]] - 2] set maximum [lindex [lrange [split $aline "\t"] $which end] 1] if { $percentage } { for {set i 0} {$i<=100} {incr i} { set totals($i.score) 0 set totals($i.stunum) "" } } else { for { set i 0 } { $i <= $maximum } { incr i } { set totals($i.score) 0 set totals($i.stunum) "" } } while { ![eof $fileId]} { set temp [lrange [split $aline "\t"] $which end] set score [lindex $temp 0] regsub -- "-" $score "0" score set max [lindex $temp 1] set temp [lindex [split $aline "\t"] 1] set section [lindex $temp 1] set stunum [lindex $temp 0] if { ([lsearch $sectionlist $section] != -1) && ($max!=0) } { if { $percentage } { set percent [expr int($score/double($max)*100)] incr totals($percent.score) lappend totals($percent.stunum) $stunum } else { if { $max > $maximum } { for {set i [expr $maximum+1]} {$i<=$max} {incr i} {set totals($i) 0} set maximum $max } set score [string trim $score] incr totals($score.score) lappend totals($score.stunum) $stunum } } set aline [gets $fileId] } CTputs $num "Scores #acheived\n" set scorelist "" set templist [array names totals *.score] foreach temp $templist {lappend possiblescores [lindex [split $temp .] 0]} foreach score [lsort -integer $possiblescores] { CTputs $num [format "%5d:%6d\n" $score $totals($score.score)] lappend scorelist [list $totals($score.score) $score $totals($score.stunum)] } return $scorelist } ########################################################### # CTgradeDistribution ########################################################### ########################################################### ########################################################### proc CTgradeDistribution { num classpath setId } { set filename [file join $classpath records "set$setId.db"] if { ! [file readable $filename] } { CTputs $num "FILE: $filename does not exist!\n" return } displayStatus "Analyzing [file tail $filename]" both $num set maxLine [lindex [exec wc $filename] 0] set fileId [open "$filename" "r"] set valid_cnt 0 set line_cnt 0 set aline [gets $fileId] while {![eof $fileId]} { incr line_cnt if { ($line_cnt%20) == 0 } { updateStatusBar [expr $line_cnt/double($maxLine)] $num } if { $line_cnt == 2 } { set aline [string trim $aline] set weights [split $aline {}] set valid_weights 0 foreach weight $weights { incr valid_weights $weight } for { set i 0 } { $i <= $valid_weights } { incr i } { set total_score($i) 0 } } elseif { $line_cnt > 3} { set aline [string trim $aline] set prefix [lindex [split $aline ","] 0] set s_num [string toupper [lindex [split $aline " " ] 0 ] ] set ans_str [lindex [split $prefix " "] 1] set ans_char [split $ans_str {} ] set valid 0 for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } { if { [lindex $ans_char $ii] != "-"} { set valid 1 } } if { $valid } { incr valid_cnt set score 0 for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } { if { [lindex $ans_char $ii] == "Y" || \ [lindex $ans_char $ii] == "y" } { incr score [lindex $weights $ii] } if { [lindex $ans_char $ii] >= 0 && \ [lindex $ans_char $ii] <= 9 } { incr score [lindex $ans_char $ii] } } if { [catch {incr total_score($score)} ] } { puts "$aline:$prefix:$s_num:$ans_str:$ans_char" } } } set aline [gets $fileId] } close $fileId removeStatus $num displayStatus "Pondering data . . ." spinner $num CTputs $num " There are $valid_cnt entries in file $filename\n" CTputs $num "Score #acheived\n" set scorelist "" foreach score [lsort -integer [array names total_score]] { CTputs $num [format "%5d:%6d\n" $score $total_score($score)] lappend scorelist [list $total_score($score) $score] } removeStatus $num return $scorelist } ########################################################### # CTgetStudentScores ########################################################### ########################################################### ########################################################### proc CTgetStudentScores { studentScoresVar classpath setId num } { upvar $studentScoresVar studentScores set filename [file join $classpath records "set$setId.db"] if { ! [file readable $filename] } { CTputs $num "FILE: $filename does not exist!\n" error } displayStatus "Analyzing [file tail $filename]" both $num set maxLine [lindex [exec wc $filename] 0] set fileId [open "$filename" "r"] set valid_cnt 0 set line_cnt 0 set aline [gets $fileId] set aline [gets $fileId] set weights [split [string trim $aline] {}] set valid_weights 0 foreach weight $weights { incr valid_weights $weight } set aline [gets $fileId] set aline [gets $fileId] while {![eof $fileId]} { incr line_cnt if { ($line_cnt%20) == 0 } { updateStatusBar [expr $line_cnt/double($maxLine)] $num } set aline [string trim $aline] set prefix [lindex [split $aline ","] 0] set s_num [string toupper [lindex [split $aline " " ] 0 ] ] set ans_str [lindex [split $prefix " "] 1] set ans_char [split $ans_str {} ] set valid 0 for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } { if { [lindex $ans_char $ii] != "-"} { set valid 1 } } if { $valid } { incr valid_cnt if {[array names studentScores $s_num] == ""} {set studentScores($s_num) 0} for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } { if { [lindex $ans_char $ii] == "Y" || [lindex $ans_char $ii] == "y" } { incr studentScores($s_num) [lindex $weights $ii] } if { [lindex $ans_char $ii] >= 0 && [lindex $ans_char $ii] <= 9 } { incr studentScores($s_num) [lindex $ans_char $ii] } } } set aline [gets $fileId] } close $fileId removeStatus $num return $valid_weights } ########################################################### # CTgradeDistributionRange ########################################################### ########################################################### ########################################################### proc CTgradeDistributionRange { num classpath setIdstart setIdend } { set totalpoints 0 for {set setId $setIdstart} {$setId <= $setIdend} {incr setId} { set points [CTgetStudentScores studentScores $classpath $setId $num] incr totalpoints $points # parray studentScores } displayStatus "Pondering data . . ." spinner $num for { set i 0 } { $i <= $totalpoints } { incr i } { set total_score($i) 0 } foreach sNum [array names studentScores] { incr total_score($studentScores($sNum)) } CTputs $num "Scores #acheived\n" set scorelist "" foreach score [lsort -integer [array names total_score]] { CTputs $num [format "%5d:%6d\n" $score $total_score($score)] lappend scorelist [list $total_score($score) $score] } removeStatus $num return $scorelist } #common Input dialogs #common output methods proc CTdatestamp { cmdnum } { CTputs $cmdnum [clock format [clock seconds]]\n } ########################################################### # CTputs ########################################################### ########################################################### ########################################################### proc CTputs { num message {tag normal} } { global gCT lappend gCT(output.$num) [list $message $tag] } ########################################################### # CToutputWrap ########################################################### ########################################################### ########################################################### proc CToutputWrap { num } { global gCT if { $gCT($num.wrap) } { $gCT($num.output) configure -wrap char } else { $gCT($num.output) configure -wrap none } } ########################################################### # CToutput ########################################################### ########################################################### ########################################################### proc CToutput { num cmdnum } { global gCT if { ![winfo exists $gCT($num).output] } { set outputWin [toplevel $gCT($num).output] set buttonFrame [frame $outputWin.button] set textFrame [frame $outputWin.text] set bottomFrame [frame $outputWin.bottom] pack $buttonFrame $textFrame $bottomFrame pack configure $buttonFrame -anchor e -expand 0 -fill x pack configure $textFrame -expand 1 -fill both pack configure $bottomFrame -expand 0 -fill x set gCT($num.output) [text $textFrame.text \ -yscrollcommand "$textFrame.scroll set" \ -xscrollcommand "$bottomFrame.scroll set"] scrollbar $textFrame.scroll -command "$textFrame.text yview" pack $gCT($num.output) $textFrame.scroll -side left pack configure $textFrame.text -expand 1 -fill both pack configure $textFrame.scroll -expand 0 -fill y scrollbar $bottomFrame.scroll -command "$textFrame.text xview" -orient h pack $bottomFrame.scroll -expand 0 -fill x set gCT($num.wrap) 1 checkbutton $buttonFrame.wrap -text "Wrap" -command "CToutputWrap $num" \ -variable gCT($num.wrap) button $buttonFrame.save -text "Save Text" -command "CTsaveText $num" button $buttonFrame.print -text "Print Text" -command "CTprintText $num" button $buttonFrame.dismiss -text "Dismiss" -command "destroy $outputWin" pack $buttonFrame.wrap $buttonFrame.save $buttonFrame.print \ $buttonFrame.dismiss -side left } set index [$gCT($num.output) index end] foreach line $gCT(output.$cmdnum) { eval $gCT($num.output) insert end $line } unset gCT(output.$cmdnum) raise $gCT($num).output $gCT($num.output) see $index update idletasks } ########################################################### # CTsaveText ########################################################### # saves the contents of a text window ########################################################### # Arguments: num (the unique number of the path, and window) # Returns : nothing # Globals : ########################################################### proc CTsaveText { num } { global gFile gCT set window $gCT($num.output) if {![winfo exists $window]} { return } set dir $gFile($num) set file "" if { $dir == "" || $dir == "."} { set dir [pwd] } set file [tk_getSaveFile -title "Enter the name to Save As" \ -initialdir "$dir" ] if { $file == "" } { displayError "File not saved" return } set fileId [open $file w] puts -nonewline $fileId [$window get 0.0 end-1c] close $fileId } ########################################################### # CTprintText ########################################################### # prints the contents of the text window, creates a temp file named # quiztemp.txt ########################################################### # Arguments: num (the unique number of the path, and window) # Returns : nothing # Globals : gFile gCT ########################################################### proc CTprintText { num } { global gFile gCT set window $gCT($num.output) if { ![winfo exists $window]} { return } catch {parseCapaConfig $num $gFile($num)} set lprCommand [getLprCommand [file join $gFile($num) managertemp.txt] $num] if {$lprCommand == "Cancel"} { return } set fileId [open [file join $gFile($num) managertemp.txt] w] puts -nonewline $fileId [$window get 0.0 end-1c] close $fileId set errorMsg "" if { [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]} { displayError "An error occurred while printing: $errorMsg" } else { displayMessage "Print job sent to the printer.\n $output" } exec rm -f [file join $gFile($num) mangertemp.txt] } ########################################################### # CTprintCanvas ########################################################### ########################################################### ########################################################### proc CTprintCanvas { num window path } { if { ![winfo exists $window]} { return } catch {parseCapaConfig $num $gFile($num)} set lprCommand [getLprCommand [file join $path managertemp.txt] $num] if {$lprCommand == "Cancel"} { return } set rotate 0 if { [tk_messageBox -title "Print in landscape mode" -message "Would you like to print in landscape mode?" -icon question -type yesno] == "yes" } { set rotate 1 } $window postscript -file [file join $path managertemp.txt] -rotate $rotate set errorMsg "" if { [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]} { displayError "An error occurred while printing: $errorMsg" } else { displayMessage "Print job sent to the printer.\n $output" } exec rm -f [file join $path mangertemp.txt] } ########################################################### # CTsaveCanvas ########################################################### ########################################################### ########################################################### proc CTsaveCanvas { window path } { if { ![winfo exists $window] } { return } set dir $path set file "" if { $dir == "" } { set dir [pwd] } set file [tk_getSaveFile -title "Enter the name to Save As" \ -initialdir "$dir" ] if { $file == "" } { displayError "File not saved" return } $window postscript -file $file } ########################################################### # CTbargraph ########################################################### ########################################################### ########################################################### proc CTbargraph {window num barnum data {path ""} {title "" } {xlabel ""} {ylabel ""} {suffix ""} } { global gBarGraph set height 300 set width 500 global gWindowMenu set bargraph [toplevel $window.bargraph$barnum] if { $title != "" } { wm title $bargraph $title } $gWindowMenu add command -label "$title $barnum" -command "capaRaise $bargraph" set buttonFrame [frame $bargraph.buttons] set canvasFrame [frame $bargraph.canvas] pack $buttonFrame $canvasFrame -side top pack configure $canvasFrame -expand 1 -fill both set canvas [canvas $canvasFrame.canvas -height $height -width $width -background white] pack $canvas -expand 1 -fill both bind $canvas <Configure> "CTdrawBargraph $barnum" button $buttonFrame.change -text "Change Graph" -command "CTchangeBargraph $window $barnum" button $buttonFrame.save -text "Save Graph" -command "CTsaveCanvas $canvas $path" button $buttonFrame.print -text "Print Graph" -command "CTprintCanvas $num $canvas $path" button $buttonFrame.dismiss -text "Dismiss" -command "CTdestroyBargraph $barnum" pack $buttonFrame.change $buttonFrame.save $buttonFrame.print \ $buttonFrame.dismiss -side left bind $bargraph <Destroy> "CTdestroyBargraph $barnum" set gBarGraph($barnum.num) $num set gBarGraph($barnum.suffix) $suffix set gBarGraph($barnum) $data set gBarGraph($barnum.canvas) $canvas set gBarGraph($barnum.title) $title set gBarGraph($barnum.xlabel) $xlabel set gBarGraph($barnum.ylabel) $ylabel set gBarGraph($barnum.color) green set gBarGraph($barnum.bucketscores) 0 CTautoscaleBargraph $barnum CTdrawBargraph $barnum } ########################################################### # CTautoscaleBargraph ########################################################### ########################################################### ########################################################### proc CTautoscaleBargraph { barnum } { global gBarGraph set data $gBarGraph($barnum) 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.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] } ########################################################### # CTchangeBargraphData ########################################################### ########################################################### ########################################################### proc CTchangeBargraphData { barnum data } { global gBarGraph set gBarGraph($barnum) $data CTautoscaleBargraph $barnum CTdrawBargraph $barnum } ########################################################### # CTdestroyBargraph ########################################################### ########################################################### ########################################################### proc CTdestroyBargraph { num } { global gBarGraph if { [catch {set window [winfo toplevel $gBarGraph($num.canvas)]}]} { return } set window2 [file rootname $window].changeBarGraph$num foreach name [array names gBarGraph "$num.*" ] { unset gBarGraph($name) } unset gBarGraph($num) destroy $window catch {destroy $window2} } ########################################################### # CTdrawBargraph ########################################################### ########################################################### ########################################################### proc CTdrawBargraph { num } { global gBarGraph set data $gBarGraph($num) set canvas $gBarGraph($num.canvas) set suffix $gBarGraph($num.suffix) set height [winfo height $canvas] set width [winfo width $canvas] set titleoffset 0 set titleheight 15 set labelheight 15 set tickheight 15 set textheight [expr $labelheight+$tickheight] set textwidth 40 set graphheight [expr $height - $textheight - $titleheight] set graphwidth [expr $width - $textwidth] $canvas delete all #draw data set total [llength $data] set eachwidth [expr $graphwidth/$total] # set howoften [expr ($total/$gBarGraph($num.numlabels)) + 1] set howoften $gBarGraph($num.xoften) set when [expr ($total-1)%$howoften] set max 0 set i 0 set value 0 if { $gBarGraph($num.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)] } 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 } incr i } #draw title $canvas create text [expr $textwidth+$titleoffset+($graphwidth/2)] 1 -anchor n\ -text $gBarGraph($num.title) #draw axis $canvas create line $textwidth [expr {$graphheight + $titleheight}] \ $textwidth [expr {$titleheight + 1}] #label xaxis $canvas create text [expr ($textwidth+($graphwidth/2))] \ [expr $titleheight+$graphheight+$tickheight+($labelheight/2)] \ -text $gBarGraph($num.xlabel) #label yaxis $canvas create text 1 1 -anchor nw -text $gBarGraph($num.ylabel) #draw tickmarks # set delta [format "%1.e" [expr ($max)/double($gBarGraph($num.numticks))]] set delta $gBarGraph($num.yoften) set start 0.0 while { $start < $max } { set center [expr {($graphheight-1)*(($start)/$max)+$titleheight+1}] $canvas create line $textwidth $center [expr $textwidth - 20] $center $canvas create text [expr $textwidth-3] $center -anchor ne -text [expr int($max-$start)] set start [expr $start + $delta] } if { [llength [lindex $data 0]] > 2} { $canvas bind current <1> "CTbargraphClick$suffix $num" bind $canvas <Enter> "CTbargraphDisplayCreate $num" bind $canvas <Leave> "CTbargraphDisplayRemove $num" bind $canvas <Motion> "CTbargraphDisplayMove $num" $canvas bind all <Enter> "CTbargraphDisplay$suffix $num" } } ########################################################### # CTbargraphDisplayCreate ########################################################### ########################################################### ########################################################### proc CTbargraphDisplayCreate { barnum } { global gBarGraph gCT gFile set canvas $gBarGraph($barnum.canvas) if {[winfo exists $canvas.bubble$barnum]} { return } set bubble [toplevel $canvas.bubble$barnum] wm overrideredirect $bubble 1 wm positionfrom $bubble program wm withdraw $bubble pack [label $bubble.l -highlightthickness 0 -relief raised -bd 1 -background yellow] } ########################################################### # CTbargraphDisplayRemove ########################################################### ########################################################### ########################################################### proc CTbargraphDisplayRemove { barnum } { global gBarGraph gCT gFile set canvas $gBarGraph($barnum.canvas) catch {destroy $canvas.bubble$barnum} } ########################################################### # CTbargraphDisplayBlank ########################################################### ########################################################### ########################################################### proc CTbargraphDisplayBlank { barnum } { global gBarGraph gCT gFile set canvas $gBarGraph($barnum.canvas) catch {$canvas.bubble$barnum.l configure -text ""} } ########################################################### # CTbargraphDisplayMove ########################################################### ########################################################### ########################################################### proc CTbargraphDisplayMove { barnum } { global gBarGraph gCT gFile set canvas $gBarGraph($barnum.canvas) catch {wm geometry $canvas.bubble$barnum +[expr 20+[winfo pointerx .]]+[expr 20+[winfo pointery .]]} if {[$canvas gettags current] == ""} {CTbargraphDisplayRemove $barnum} } ########################################################### # CTbargraphDisplayShowresponse ########################################################### ########################################################### ########################################################### proc CTbargraphDisplayShowresponse { barnum } { global gBarGraph gCT gFile set num $gBarGraph($barnum.num) set canvas $gBarGraph($barnum.canvas) set high [lindex [split [lindex [$canvas gettags current] 0] .] 1] 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]\"" wm geometry $canvas.bubble$barnum +[expr 20+[winfo pointerx .]]+[expr 20+[winfo pointery .]] wm deiconify $canvas.bubble$barnum return } CTbargraphDisplayRemove $barnum } ########################################################### # CTbargraphDisplaySCP ########################################################### ########################################################### ########################################################### proc CTbargraphDisplaySCP { barnum } { global gBarGraph gCT gFile set num $gBarGraph($barnum.num) set canvas $gBarGraph($barnum.canvas) set high [lindex [split [lindex [$canvas gettags current] 0] .] 1] 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]" wm geometry $canvas.bubble$barnum +[expr 20+[winfo pointerx .]]+[expr 20+[winfo pointery .]] wm deiconify $canvas.bubble$barnum return } CTbargraphDisplayRemove $barnum } ########################################################### # CTbargraphClickSCP ########################################################### ########################################################### ########################################################### proc CTbargraphClickSCP { barnum } { global gBarGraph gCT gFile set num $gBarGraph($barnum.num) set canvas $gBarGraph($barnum.canvas) set bucket $gBarGraph($barnum.bucketscores) set high [lindex [split [lindex [$canvas gettags current] 0] .] 1] set low [lindex [split [lindex [$canvas gettags current] 0] .] 2] set stunums "" if { $high == "" || $low == "" } { return } foreach datum $gBarGraph($barnum) { set bar [lindex $datum 1] if { $bar > $high || $bar <= $low } { continue } set stunums [concat $stunums [lindex $datum 2]] } if { $stunums == "" } { return } if {"" == [set stuSCP [multipleChoice $gCT($num) "Select a student" $stunums 0]]} { return } set loginAnalysis [expr {"Yes" == [makeSure "Do you wish to do a Login Analysis? It may take a while." ]}] foreach s_id $stuSCP { CTstudentCourseProfile $num $s_id \ [findByStudentNumber $s_id $gFile($num)] $loginAnalysis } } ########################################################### # CTbargraphClickShowresponse ########################################################### ########################################################### ########################################################### proc CTbargraphClickShowresponse { barnum } { global gBarGraph gCT gFile gUniqueNumber set num $gBarGraph($barnum.num) set canvas $gBarGraph($barnum.canvas) set bucket $gBarGraph($barnum.bucketscores) if { [catch {set datanum $gBarGraph($barnum.shownum1)}] } { set datanum [set gBarGraph($barnum.shownum1) [incr gUniqueNumber]] set winnum [set gBarGraph($barnum.shownum2) [incr gUniqueNumber]] } else { set winnum $gBarGraph($barnum.shownum2) } set gCT($winnum) "" set high [lindex [split [lindex [$canvas gettags current] 0] .] 1] foreach datum $gBarGraph($barnum) { set bar [lindex $datum 1] if { $bar != $high } { continue } CTputs $datanum "[lindex $datum 0] responses \"[lindex $datum 2]\"\n" } CToutput $winnum $datanum } ########################################################### # CTchangeBargraph ########################################################### ########################################################### ########################################################### proc CTchangeBargraph { window num } { global gBarGraph set change [toplevel $window.changeBarGraph$num] set infoFrame [frame $change.info] set buttonFrame [frame $change.button] set title [frame $change.title] set xlabel [frame $change.xlabel] set ylabel [frame $change.ylabel] set xoften [frame $change.xoften] set yoften [frame $change.yoften] 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 configure $title $xlabel $ylabel $xoften $yoften -anchor e -expand 1 -fill both button $buttonFrame.update -text Update -command "CTdrawBargraph $num" bind $change <Return> "CTdrawBargraph $num" button $buttonFrame.dismiss -text Dismiss -command "destroy $change" pack $buttonFrame.update $buttonFrame.dismiss -side left foreach {frame label var } "$title { Title} title $xlabel { X-Axis Label} xlabel $ylabel { Y-Axis Label} ylabel $xoften {Increment on X-Axis} xoften $yoften {Increment on Y-Axis} yoften" { label $frame.label -text $label set entryFrame [frame $frame.entry] pack $frame.label $entryFrame -side left pack configure $entryFrame -expand 1 -fill both entry $entryFrame.entry -textvariable gBarGraph($num.$var) \ -xscrollcommand "$entryFrame.scroll set" scrollbar $entryFrame.scroll -orient h -command \ "$entryFrame.entry xview" pack $entryFrame.entry $entryFrame.scroll -fill x } label $color.label -text "Color of Bars" label $color.color -relief ridge -background $gBarGraph($num.color) \ -text " " button $color.change -text "Change" -command "CTchangeBargraphColor $color $num" pack $color.label $color.color $color.change -side left checkbutton $bucket.bucket -text "Bucket Scores" -variable \ gBarGraph($num.bucketscores) -command "CTdrawBargraph $num" pack $bucket.bucket } ########################################################### # CTchangeBargraphColor ########################################################### ########################################################### ########################################################### proc CTchangeBargraphColor { color num } { global gBarGraph set temp [tk_chooseColor -initialcolor $gBarGraph($num.color)] if { $temp != "" } { $color.color configure -background [set gBarGraph($num.color) $temp] } CTdrawBargraph $num } ########################################################### # CTdisplayStudent ########################################################### ########################################################### ########################################################### proc CTdisplayStudent { num window path id } { if { ![file exists [file join $path photo gif $id.gif]] } { if { [file exists [file join $path photo jpg $id.jpg]] } { exec /usr/local/bin/djpeg -outfile [file join $path photo gif $id.gif] \ [file join $path photo jpg $id.jpg] } else { return } } set image [image create photo] $image read [file join $path photo gif $id.gif] set imageWin [toplevel $window.image$num] set buttonFrame [frame $imageWin.button] set infoFrame [frame $imageWin.info] set imageFrame [frame $imageWin.image] pack $buttonFrame $infoFrame $imageFrame button $buttonFrame.dismiss -command "destroy $imageWin" -text Dismiss pack $buttonFrame.dismiss label $infoFrame.label -text $id pack $infoFrame.label set canvas [canvas $imageFrame.canvas] pack $canvas $canvas create image 1 1 -image $image -anchor nw } ########################################################### # CTgetWhen ########################################################### ########################################################### ########################################################### proc CTgetWhen { num } { set day [getString . "Enter a date"] update return $day } ########################################################### # CTscanDB ########################################################### ########################################################### ########################################################### proc CTscanDB { num file outId startdate enddate } { global answerArray exist set fileId [open $file r] 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 set aline [gets $fileId] while { ! [eof $fileId] } { incr line_cnt if { ($line_cnt%20) == 0 } { puts $curdate updateStatusBar [expr $line_cnt/double($maxLine)] $num } set length [llength $aline] set date [lrange $aline 1 [expr $length - 2]] set curdate [clock scan $date] if { $curdate < $startdate } { set aline [gets $fileId]; continue } if { $curdate > $enddate } { break } set s_num [string toupper [lindex $aline 0]] set ans_char [split [lindex $aline end] ""] 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.*"] == "" } { 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"} { set answerArray($usr_ans.$ii) "Y" } incr answerArray($usr_try.$ii) } } if { [array names exist $s_num] == "" } { set exist($s_num) $s_num } set aline [gets $fileId] } close $fileId return $prob_cnt } ########################################################### # CTcreateSubset ########################################################### ########################################################### ########################################################### proc CTcreateSubset { num cmdnum day 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 set prob_cntt [CTscanDB $cmdnum [file join $gFile($num) records log$setId.db] $outId $startdate $enddate] puts $startdate:$enddate 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" if { $prob_cntt > $prob_cntw } { set prob_cnt $prob_cntt } else { set prob_cnt $prob_cntw } puts $outId [gets $inId] puts $outId [gets $inId] puts $outId [gets $inId] foreach s_num [lsort [array names exist]] { set usr_ans $s_num.ans set usr_try $s_num.try puts -nonewline $outId "$s_num " for { set ii 0 } { $ii< $prob_cnt } { incr ii } { puts -nonewline $outId $answerArray($usr_ans.$ii) } for { set ii 0 } { $ii< $prob_cnt } { incr ii } { puts -nonewline $outId [format ",%2d" $answerArray($usr_try.$ii)] } puts $outId "" } close $outId close $inId 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} [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: stick into capastats # : howmany viws 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" }