capa/capa51/GUITools/capastats.tcl - view

File: [LON-CAPA] / capa / capa51 / GUITools / capastats.tcl
Revision 1.2: download - view: text, annotated - select for diffs
Fri Oct 15 14:29:34 1999 UTC (24 years, 7 months ago) by albertel
Branches: MAIN
CVS tags: HEAD

-Added some discussion forum stats

1: ########################################################### 2: # runCapaTools 3: ########################################################### 4: ########################################################### 5: ########################################################### 6: proc runCapaTools { classDirConfigFile } { 7: global gUniqueNumber gWindowMenu gFile gCT 8: 9: set num [incr gUniqueNumber] 10: 11: set classDir [file dirname $classDirConfigFile] 12: set gFile($num) $classDir 13: 14: set utilsMenu [menu .utilsMenu$num -tearoff 0 -type tearoff -font 8x13bold \ 15: -disabledforeground grey85 ] 16: set gCT($num) $utilsMenu 17: 18: set pathLength [string length $gFile($num)] 19: if { $pathLength > 22 } { 20: set pathSubset ...[string range $gFile($num) [expr $pathLength - 22 ] end] 21: } else { 22: set pathSubset $gFile($num) 23: } 24: $utilsMenu add command -label "CapaUtils Ver 1.1" -foreground grey85 -background \ 25: black -state disabled 26: $utilsMenu add command -label $pathSubset -foreground white -background \ 27: grey30 -state disabled 28: 29: $utilsMenu add command -label "Change Class path" -command "CTchangePath $num" 30: $utilsMenu add command -label "Run capastat" -command "CTcapaStat $num" 31: $utilsMenu add command -label "Run capastat2" -command "CTcapaStat2 $num" 32: $utilsMenu add command -label "Summarize Log files" -command "CTlogAnalysis $num" 33: $utilsMenu add command -label "Student Course Profile" -command \ 34: "CTstartStudentCourseProfile $num" 35: $utilsMenu add command -label "CAPA IDs for one student" \ 36: -command "CToneStudentCapaID $num" 37: $utilsMenu add command -label "All CAPA IDs" -command "CTclassCapaID $num" 38: $utilsMenu add command -label "Item Analysis" -command "CTitemAnalysisStart $num" 39: $utilsMenu add command -label "Item Correlation" \ 40: -command "CTitemCorrelationStart $num" 41: # $utilsMenu add command -label "Email" -command "" 42: # $utilsMenu add command -label "View Score File" -command "" 43: $utilsMenu add command -label "View Submissions" -command "CTsubmissions $num" 44: $utilsMenu add command -label "Analyze Class Report" -command "CTanalyzeReport $num" 45: $utilsMenu add command -label "Analyze Responses" -command "CTanalyzeScorer $num" 46: $utilsMenu add command -label "Graph a Responses Analysis" -command "CTgraphAnalyzeScorer $num" 47: $utilsMenu add command -label "Discussion Stats" -command "CTdiscussStats $num" 48: $utilsMenu add command -label "Quit" -command "CTquit $num" 49: $utilsMenu post 0 0 50: Centre_Dialog $utilsMenu default 51: set geometry [wm geometry $utilsMenu] 52: wm geometry $utilsMenu +0+[lindex [split $geometry +] end] 53: parseCapaConfig $num $gFile($num) 54: parseCapaUtilsConfig $num $gFile($num) 55: } 56: 57: #menu commands 58: 59: ########################################################### 60: # CTchangePath 61: ########################################################### 62: ########################################################### 63: ########################################################### 64: #FIXME need to wait unit all running commands are done 65: proc CTchangePath { num } { 66: global gFile gCapaConfig 67: set path [tk_getOpenFile -title "Please select a capa.config file" -filetypes \ 68: { { {Capa Config} {capa.config} } }] 69: if { $path == "" } { return } 70: set gFile($num) [file dirname $path] 71: foreach temp [array names gCapaConfig "$num.*"] { unset gCapaConfig($temp) } 72: parseCapaConfig $num $gFile($num) 73: parseCapaUtilsConfig $num $gFile($num) 74: set pathLength [string length $gFile($num)] 75: if { $pathLength > 22 } { 76: set pathSubset ...[string range $gFile($num) [expr $pathLength - 22 ] end] 77: } else { 78: set pathSubset $gFile($num) 79: } 80: .utilsMenu$num entryconfigure 1 -label $pathSubset 81: } 82: 83: ########################################################### 84: # CTcapaStat2 85: ########################################################### 86: ########################################################### 87: ########################################################### 88: proc CTcapaStat2 { num } { 89: global gFile gCT gUniqueNumber 90: if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { return } 91: set cmdnum [incr gUniqueNumber] 92: set gCT(cmd.$cmdnum) capastat 93: if { [ 94: catch { 95: CTdatestamp $cmdnum 96: set day [CTgetWhen $cmdnum] 97: set file [file join $gFile($num) records "subset$setId.db"] 98: displayStatus "Generating [file tail $file]" both $cmdnum 99: CTcreateSubset $num $cmdnum $day $setId 100: updateStatusBar 0.0 $cmdnum 101: updateStatusMessage "Generating Stats [file tail $file]" $cmdnum 102: CTscanSetDB $cmdnum $file Q_cnt L_cnt 103: updateStatusBar 0.0 $cmdnum 104: updateStatusMessage "Generating Averages [file tail $file]" $cmdnum 105: CTpercentageScores $cmdnum $setId $L_cnt 106: CTaverage $cmdnum $Q_cnt $L_cnt faillist dodifflist numyes 107: if { $L_cnt != 0 } { 108: CTbargraph $gCT($num) $num [incr gUniqueNumber] $faillist $gFile($num) "Not-Yet-Correct Distribution for set $setId" "Problem \#" "%Wrong" 109: CTbargraph $gCT($num) $num [incr gUniqueNumber] $dodifflist $gFile($num) "Degree of Difficulty Distribution for set $setId" "Problem \#" "Degree Of Diff." 110: CTbargraph $gCT($num) $num [incr gUniqueNumber] $numyes $gFile($num) "Number of Yeses received for set $setId" "Problem \#" "\#Students" 111: } 112: removeStatus $cmdnum 113: CToutput $num $cmdnum 114: } errors ] } { 115: global errorCode errorInfo 116: displayError "$errors\n$errorCode\n$errorInfo" 117: unset gCT(cmd.$cmdnum) 118: } else { 119: unset gCT(cmd.$cmdnum) 120: } 121: } 122: 123: ########################################################### 124: # CTcapaStat 125: ########################################################### 126: ########################################################### 127: ########################################################### 128: proc CTcapaStat { num } { 129: global gFile gCT gUniqueNumber 130: if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { return } 131: set cmdnum [incr gUniqueNumber] 132: set gCT(cmd.$cmdnum) capastat 133: if { [ 134: catch { 135: CTdatestamp $cmdnum 136: set file [file join $gFile($num) records "set$setId.db"] 137: displayStatus "Generating Stats [file tail $file]" both $cmdnum 138: CTscanSetDB $cmdnum $file Q_cnt L_cnt 139: updateStatusBar 0.0 $cmdnum 140: updateStatusMessage "Generating Averages [file tail $file]" $cmdnum 141: CTpercentageScores $cmdnum $setId $L_cnt 142: CTaverage $cmdnum $Q_cnt $L_cnt faillist dodifflist numyes 143: CTbargraph $gCT($num) $num [incr gUniqueNumber] $faillist $gFile($num) "Not-Yet-Correct Distribution for set $setId" "Problem \#" "%Wrong" 144: CTbargraph $gCT($num) $num [incr gUniqueNumber] $dodifflist $gFile($num) "Degree of Difficulty Distribution for set $setId" "Problem \#" "Degree Of Diff." 145: CTbargraph $gCT($num) $num [incr gUniqueNumber] $numyes $gFile($num) "Number of Yeses received for set $setId" "Problem \#" "\#Students" 146: removeStatus $cmdnum 147: CToutput $num $cmdnum 148: } errors ] } { 149: global errorCode errorInfo 150: displayError "$errors\n$errorCode\n$errorInfo" 151: unset gCT(cmd.$cmdnum) 152: } else { 153: unset gCT(cmd.$cmdnum) 154: } 155: } 156: 157: ########################################################### 158: # CTlogAnalysis 159: ########################################################### 160: ########################################################### 161: ########################################################### 162: proc CTlogAnalysis { num } { 163: global gFile gUniqueNumber gCT 164: if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { return } 165: 166: set cmdnum [incr gUniqueNumber] 167: set gCT(cmd.$cmdnum) loganalysis 168: CTdatestamp $cmdnum 169: if { [ catch { CTlogAnalysis2 $num $cmdnum $setId } errors ] } { 170: displayError $errors 171: unset gCT(cmd.$cmdnum) 172: } else { 173: unset gCT(cmd.$cmdnum) 174: } 175: CToutput $num $cmdnum 176: } 177: 178: ########################################################### 179: # CTstartStudentCourseProfile 180: ########################################################### 181: ########################################################### 182: ########################################################### 183: proc CTstartStudentCourseProfile { num } { 184: global gFile gCT 185: getOneStudent $gCT($num) $gFile($num) s_id s_name 186: if { $s_id == "" } { return } 187: CTstudentCourseProfile $num $s_id $s_name 188: } 189: 190: ########################################################### 191: # CTstudentCourseProfile 192: ########################################################### 193: ########################################################### 194: ########################################################### 195: proc CTstudentCourseProfile { num s_id s_name {loginAnalysis 2} } { 196: global gFile gUniqueNumber gCapaConfig gCT 197: 198: set cmdnum [incr gUniqueNumber] 199: set gCT(cmd.$cmdnum) studentcourseprofile 200: displayStatus "Collecting homework scores for $s_name" both $cmdnum 201: CTdatestamp $cmdnum 202: CTputs $cmdnum "$s_name\n" 203: if { [ catch { CTcollectSetScores $cmdnum $gFile($num) $s_id 1 \ 204: $gCapaConfig($num.homework_scores_limit_set) } error ] } { 205: global errorCode errorInfo 206: displayError "$error \n $errorCode \n $errorInfo" 207: } 208: foreach type { quiz exam supp others } { 209: updateStatusMessage "Collecting $type scores for $s_name" $cmdnum 210: catch { 211: if { [file isdirectory $gCapaConfig($num.[set type]_path)] } { 212: CTcollectSetScores $cmdnum $gCapaConfig($num.[set type]_path) $s_id 1 \ 213: $gCapaConfig($num.[set type]_scores_limit_set) 214: } 215: } 216: } 217: removeStatus $cmdnum 218: if { ($loginAnalysis == 2 && "Yes" == [makeSure \ 219: "Do you wish to do a Login Analysis? It may take a while." ]) 220: || ($loginAnalysis == 1) } { 221: displayStatus "Analyzing login data." both $cmdnum 222: if { [catch { CTloginAnalysis $cmdnum $gFile($num) $s_id \ 223: $gCapaConfig($num.homework_scores_limit_set) } error] } { 224: displayError error 225: } 226: if { [catch { CTstudentSetAnalysis $cmdnum $gFile($num) $s_id \ 227: $gCapaConfig($num.homework_scores_limit_set) } error] } { 228: displayError error 229: } 230: removeStatus $cmdnum 231: } 232: CTdisplayStudent $cmdnum $gCT($num) $gFile($num) $s_id 233: unset gCT(cmd.$cmdnum) 234: CToutput $num $cmdnum 235: } 236: 237: ########################################################### 238: # CToneStudentCapaID 239: ########################################################### 240: ########################################################### 241: ########################################################### 242: proc CToneStudentCapaID { num } { 243: global gFile gUniqueNumber gCapaConfig gCT 244: 245: getOneStudent $gCT($num) $gFile($num) s_id s_name 246: if { $s_id == "" } { return } 247: 248: set cmdnum [incr gUniqueNumber] 249: set gCT(cmd.$cmdnum) onestudentcapaid 250: set setlist [getSetRange $gCT($num) $gFile($num)] 251: set command "$gCapaConfig($num.allcapaid_command) -i -stu $s_id -s [lindex $setlist 0] -e [lindex $setlist 1] -c $gFile($num)" 252: if { "Yes" == [makeSure "CMD: $command\n Do you wish to execute this command?"] } { 253: CTdatestamp $cmdnum 254: CTputs $cmdnum "CapaIDs for: $s_id, $s_name\n" 255: displayStatus "Getting CapaIDs" spinner $cmdnum 256: set fileId [open "|$command" "r"] 257: fconfigure $fileId -blocking 0 258: fileevent $fileId readable "CTrunCommand $num $cmdnum $fileId" 259: } 260: } 261: 262: ########################################################### 263: # CTclassCapaID 264: ########################################################### 265: ########################################################### 266: ########################################################### 267: proc CTclassCapaID { num } { 268: global gFile gUniqueNumber gCapaConfig gCT 269: 270: set cmdnum [incr gUniqueNumber] 271: set gCT(cmd.$cmdnum) classcapaid 272: set setlist [getSetRange $gCT($num) $gFile($num)] 273: if { $setlist == "" } { return } 274: set command "$gCapaConfig($num.allcapaid_command) -i -s [lindex $setlist 0] -e [lindex $setlist 1] -c $gFile($num)" 275: if { "Yes" == [makeSure "CMD: $command\n Do you wish to execute this command?"] } { 276: CTdatestamp $cmdnum 277: displayStatus "Getting all CapaIDs" spinner $cmdnum 278: set fileId [open "|$command" "r"] 279: fconfigure $fileId -blocking 0 280: fileevent $fileId readable "CTrunCommand $num $cmdnum $fileId" 281: } 282: } 283: 284: ########################################################### 285: # CTitemAnalysisStart 286: ########################################################### 287: ########################################################### 288: ########################################################### 289: proc CTitemAnalysisStart { num } { 290: global gFile gUniqueNumber gCapaConfig gCT 291: 292: set cmdnum [incr gUniqueNumber] 293: set gCT(cmd.$cmdnum) itemanalysis 294: set paths "" 295: lappend paths [list "classpath" $gFile($num)] 296: foreach path [lsort [array names gCapaConfig "$num.*_path"]] { 297: lappend paths [list [lindex [split $path "."] 1] $gCapaConfig($path) ] 298: } 299: if {[set select [multipleChoice $gCT($num) "Select a class path" $paths ] ] == ""} { 300: unset gCT(cmd.$cmdnum) 301: return 302: } 303: if { [set sets [getSetRange $gCT($num) $gFile($num)]] == "" } { 304: unset gCT(cmd.$cmdnum) 305: return 306: } 307: CTdatestamp $cmdnum 308: if { [ catch {CTitemAnalysisRange $cmdnum [lindex $select 1] \ 309: [lindex $sets 0] [lindex $sets 1] } errors ] } { 310: displayError $errors 311: } 312: unset gCT(cmd.$cmdnum) 313: CToutput $num $cmdnum 314: } 315: 316: ########################################################### 317: # CTitemCorrelationStart 318: ########################################################### 319: ########################################################### 320: ########################################################### 321: proc CTitemCorrelationStart { num } { 322: global gFile gUniqueNumber gCapaConfig gCT 323: 324: ## FIXME: 325: ## Let user specify how many categories to calculate correlation 326: ## For each category, the user can specify problem numbers to 327: ## be in that category 328: ## Then, the correlations between each category is calculated 329: ## 330: set cmdnum [incr gUniqueNumber] 331: set gCT(cmd.$cmdnum) itemanalysis 332: set paths "" 333: lappend paths [list "classpath" $gFile($num)] 334: foreach path [lsort [array names gCapaConfig "$num.*_path"]] { 335: lappend paths [list [lindex [split $path "."] 1] $gCapaConfig($path) ] 336: } 337: if { [set select [multipleChoice $gCT($num) "Select a class path" $paths ] ] == "" } { 338: unset gCT(cmd.$cmdnum) 339: return 340: } 341: if { [set setId [getOneSet $gCT($num) $gFile($num)]] == "" } { 342: unset gCT(cmd.$cmdnum) 343: return 344: } 345: CTdatestamp $cmdnum 346: if { [ catch { CTitemCorrelation $cmdnum [lindex $select 1] \ 347: $setId } errors ] } { displayError $errors } 348: unset gCT(cmd.$cmdnum) 349: CToutput $num $cmdnum 350: } 351: 352: ########################################################### 353: # CTsubmissions 354: ########################################################### 355: ########################################################### 356: ########################################################### 357: proc CTsubmissions { num } { 358: global gCT gFile gUniqueNumber gCapaConfig 359: 360: getOneStudent $gCT($num) $gFile($num) s_id s_name 361: if { $s_id == "" } { return } 362: 363: set cmdnum [incr gUniqueNumber] 364: set gCT(cmd.$cmdnum) submissions 365: if { "" == [set setlist [getSetRange $gCT($num) $gFile($num)]] } { return } 366: CTdatestamp $cmdnum 367: CTputs $cmdnum "Submissions for: $s_id, $s_name\n" 368: displayStatus "Getting submissions" spinner $cmdnum 369: CTsubmissionsLaunch $num $cmdnum telnet $s_id $s_name \ 370: [lindex $setlist 0] [lindex $setlist 1] 371: } 372: 373: ########################################################### 374: # CTanalyzeReport 375: ########################################################### 376: ########################################################### 377: ########################################################### 378: proc CTanalyzeReport { num } { 379: global gUniqueNumber gCT gFile 380: 381: set cmdnum [incr gUniqueNumber] 382: set gCT(cmd.$cmdnum) analyzereport 383: 384: set reportFile [tk_getOpenFile -title "Please select the Report file" \ 385: -filetypes { {{Capa Reports} {*.rpt}} {{All Files} {*}} }] 386: if { $reportFile == "" } { return } 387: set percentage [tk_dialog $gCT($num).dialog "How would you like scores displayed?" \ 388: "How would you like scores displayed?" "" "" "Points Earned" \ 389: "Percentage" "Cancel"] 390: if { $percentage == 2 } { return } 391: set pwd [pwd];cd $gFile($num) 392: set sectionList [pickSections [getExistingSections] "Select Sections To Analyze:" $gCT($num) ] 393: CTdatestamp $cmdnum 394: CTputs $cmdnum "Analyzing Report File $reportFile\n" 395: CTputs $cmdnum " For Sections $sectionList\n" 396: CTputs $cmdnum " Report Created at [clock format [file mtime $reportFile]]\n" 397: cd $pwd 398: set scorelist [CTreportDist $cmdnum $reportFile $percentage $sectionList] 399: set label [lindex "{Grade} {Grade(%)}" $percentage] 400: set ptsearned 0 401: set totalnumstu 0 402: foreach element $scorelist { 403: set numstu [lindex $element 0] 404: set score [lindex $element 1] 405: set ptsearned [expr $ptsearned + ($numstu*$score)] 406: incr totalnumstu $numstu 407: } 408: set average [expr $ptsearned / double($totalnumstu)] 409: set avgmsg [format "Average: %.2f" $average] 410: CTputs $cmdnum $avgmsg\n 411: CTbargraph $gCT($num) $num $cmdnum $scorelist $gFile($num) "Score Distribution for [file tail $reportFile] $avgmsg" $label "\# Students" SCP 412: unset gCT(cmd.$cmdnum) 413: CToutput $num $cmdnum 414: } 415: 416: ########################################################### 417: # CTanalyzeScorer 418: ########################################################### 419: ########################################################### 420: ########################################################### 421: proc CTanalyzeScorer { num } { 422: global gFile gUniqueNumber gCapaConfig gCT 423: set cmdnum [incr gUniqueNumber] 424: set gCT(cmd.$cmdnum) analyzescorer 425: if { "" == [set file [tk_getOpenFile -title "Pick a scorer.output file" -filetypes { { {scorer.output} {scorer.output.*} } { {Submissions File} {*submissions*.db} } { {All Files} {*} } }]] } { return } 426: set path [file dirname [file dirname $file]] 427: if { "" == [set gCT($cmdnum.questNum) [getString $gCT($num) "Which questions?"]]} { 428: return 429: } 430: set gCT($cmdnum.max) [lindex [exec wc -l $file] 0] 431: set gCT($cmdnum.done) 1 432: set gCT($cmdnum.graphup) 0 433: set gCT($cmdnum.num) $num 434: displayStatus "Getting student reponses" both $cmdnum 435: set gCT($cmdnum.fileId) [open $file r] 436: if { [regexp {scorer\.output\.([0-9]|([0-9][0-9]))} $file] } { 437: set gCT($cmdnum.setId) [string range [file extension $file] 1 end] 438: set gCT($cmdnum.parse) CTparseScorerOutputLine 439: set aline [gets $gCT($cmdnum.fileId)] 440: } else { 441: set gCT($cmdnum.setId) [lindex [split [file tail $file] s.] 4] 442: set gCT($cmdnum.parse) CTparseSubmissionsLine 443: } 444: set aline [gets $gCT($cmdnum.fileId)] 445: $gCT($cmdnum.parse) $aline $cmdnum 446: set pwd [pwd];cd $path 447: getSet $gCT($cmdnum.question) $gCT($cmdnum.setId) "CTcontinueAnalyze $cmdnum $path" 448: cd $pwd 449: } 450: 451: proc CTcontinueAnalyze { num path arrayVar } { 452: global gCT gResponse 453: upvar $arrayVar question 454: CTgetQuestions $num question 455: set numAdded 0 456: foreach which $gCT($num.questNum) { 457: incr numAdded [CTgetStudentResponses $num [lindex $gCT($num.response) \ 458: [expr $which-1]] $which \ 459: question] 460: } 461: updateStatusBar [expr $gCT($num.done)/double($gCT($num.max))] $num 462: if { $numAdded > 0 } { CTupdateAnalyzeScorer $num } 463: set interesting 0 464: while {!$interesting} { 465: incr gCT($num.done) 466: set stunum $gCT($num.question) 467: set aline [gets $gCT($num.fileId)] 468: if { [eof $gCT($num.fileId)] } { CTfinishAnalyzeScorer $num; return } 469: set interesting [$gCT($num.parse) $aline $num] 470: } 471: if { $stunum != $gCT($num.question) } { 472: set pwd [pwd];cd $path 473: getSet $gCT($num.question) $gCT($num.setId) "CTcontinueAnalyze $num $path" 474: cd $pwd 475: } else { 476: CTcontinueAnalyze $num $path question 477: } 478: } 479: 480: proc CTupdateAnalyzeScorer { cmdnum } { 481: global gCT gResponse gUniqueNumber gFile 482: set num $gCT($cmdnum.num) 483: set i 0 484: foreach correct [array names gResponse "$cmdnum.correct.*"] { 485: set probnum [lindex [split $correct .] 2] 486: set answer [join [lrange [split $correct .] 3 end] .] 487: if { $gResponse($correct) } { 488: set color($probnum.$answer) green 489: } else { 490: set color($probnum.$answer) red 491: } 492: } 493: set results "" 494: set oldprobnum [lindex [split [lindex [lsort [array names gResponse $cmdnum.\[0-9\]*]] 0] .] 1] 495: foreach response [lsort -dictionary [array names gResponse $cmdnum.\[0-9\]*]] { 496: incr i 497: set probnum [lindex [split $response .] 1] 498: if { $probnum > $oldprobnum } { 499: set oldprobnum $probnum 500: lappend results [list 0 0 "Problem Divider" white] 501: } 502: set answer [join [lrange [split $response .] 2 end] .] 503: lappend results [list $gResponse($response) $i $answer $color($probnum.$answer)] 504: } 505: if { $results == "" } { return } 506: if { $gCT($cmdnum.graphup)} { 507: CTchangeBargraphData $cmdnum $results 508: } else { 509: CTbargraph $gCT($num) $num $cmdnum $results $gFile($num) "Reponse Distribution" "Which Response" "\#Picked" "Showresponse" 510: set gCT($cmdnum.graphup) 1 511: } 512: 513: update idletasks 514: } 515: 516: proc CTsaveAnalyzeScorer { num cmdnum } { 517: global gResponse gCT gFile 518: set file [tk_getSaveFile -initialdir $gFile($num)] 519: set fileId [open $file w] 520: puts $fileId [array get gResponse "$cmdnum.*"] 521: close $fileId 522: } 523: 524: proc CTfinishAnalyzeScorer { cmdnum } { 525: global gCT gResponse gUniqueNumber gFile 526: 527: set num $gCT($cmdnum.num) 528: set i 0 529: removeStatus $cmdnum 530: foreach correct [array names gResponse "$cmdnum.correct.*"] { 531: set probnum [lindex [split $correct .] 2] 532: set answer [join [lrange [split $correct .] 3 end] .] 533: if { $gResponse($correct) } { 534: set color($probnum.$answer) green 535: } else { 536: set color($probnum.$answer) red 537: } 538: } 539: foreach response [lsort -dictionary [array names gResponse $cmdnum.\[0-9\]*]] { 540: incr i 541: set probnum [lindex [split $response .] 1] 542: set answer [join [lrange [split $response .] 2 end] .] 543: lappend results($probnum) [list $gResponse($response) $i $answer $color($probnum.$answer)] 544: } 545: foreach probnum [lsort -dictionary [array names results]] { 546: CTputs $cmdnum "\nFor Problem $probnum #, Responses:\n" 547: foreach response $results($probnum) { 548: CTputs $cmdnum "[lindex $response 0], [lindex $response 2]\n" 549: } 550: } 551: if { "Yes" ==[makeSure "Would you like to save the results to a file?"] } { 552: CTsaveAnalyzeScorer $num $cmdnum 553: } 554: unset gCT(cmd.$cmdnum) 555: CToutput $num $cmdnum 556: } 557: 558: proc CTparseScorerOutputLine { aline num } { 559: global gCT 560: set gCT($num.stunum) [lindex $aline 0] 561: set aline [string range $aline 40 end] 562: set length [llength [split [lrange $aline 3 end] ,] ] 563: set gCT($num.response) [lrange [split [lrange $aline 3 end] ,] 0 \ 564: [expr {$length-2}]] 565: set gCT($num.question) [lindex [lindex [split $aline ,] end] 0] 566: return 1 567: } 568: 569: proc CTparseSubmissionsLine { aline num } { 570: global gCT 571: set aline [split $aline \t] 572: set gCT($num.stunum) [lindex $aline 0] 573: set gCT($num.question) $gCT($num.stunum) 574: set gCT($num.response) "" 575: set interesting 0 576: set current 1 577: foreach {quest response} [lrange $aline 2 end] { 578: if { $quest == "" } break 579: while { $quest > $current } { 580: lappend gCT($num.response) {} 581: incr current 582: } 583: if { [lsearch $gCT($num.questNum) $quest] != -1} { set interesting 1 } 584: lappend gCT($num.response) [string toupper $response] 585: incr current 586: } 587: return $interesting 588: } 589: 590: proc CTgetQuestions { num questionVar } { 591: global gCT 592: upvar $questionVar question 593: # parray question 594: foreach quest $gCT($num.questNum) { 595: foreach line $question($quest.quest) { 596: if { [regexp {^ *([A-Z])\)(.*)} $line temp letter rest] } { 597: set question($quest.$letter) $rest 598: if { [string first $letter $question($quest.ans)] != -1} { 599: set question($quest.correct.$letter) 1 600: set question($quest.$letter) "$rest - Correct" 601: } else { 602: set question($quest.correct.$letter) 0 603: set question($quest.$letter) "$rest - Incorrect" 604: } 605: } 606: } 607: } 608: } 609: 610: proc CTgetStudentResponses { num responses which questionVar } { 611: global gCT gResponse 612: upvar $questionVar question 613: # parray question 614: set i 0 615: foreach response [split $responses {}] { 616: if { $response == "" || $response == " "} { continue } 617: incr i 618: if { [catch {incr gResponse($num.$which.$question($which.$response))}] } { 619: if {[catch {set gResponse($num.$which.$question($which.$response)) 1}]} { 620: #set gResponse($num.$which.Illegal\ Bubble) 1 621: puts "not an option $response $which" 622: continue 623: } 624: } 625: if { $question($which.correct.$response) } { 626: set gResponse($num.correct.$which.$question($which.$response)) 1 627: } else { 628: set gResponse($num.correct.$which.$question($which.$response)) 0 629: } 630: } 631: return $i 632: } 633: 634: ########################################################### 635: # CTgraphAnalyzeScorer 636: ########################################################### 637: ########################################################### 638: ########################################################### 639: proc CTgraphAnalyzeScorer { num } { 640: global gFile gUniqueNumber gCapaConfig gCT gResponse 641: set cmdnum [incr gUniqueNumber] 642: set gCT(cmd.$cmdnum) graphanalyzescorer 643: if { "" == [set file [tk_getOpenFile -title "Pick a Output file" -filetypes { { {All Files} {*} } } -initialdir $gFile($num)]] } { return } 644: set fileId [open $file r] 645: set temp [read $fileId [file size $file]] 646: close $fileId 647: foreach {name value} $temp { 648: set name [join "$cmdnum [lrange [split $name .] 1 end]" .] 649: set gResponse($name) $value 650: } 651: unset temp 652: foreach name [array names gResponse $cmdnum.\[0-9\]*] { 653: puts "[split $name .]" 654: puts "[lindex [split $name .] 1]" 655: lappend probnums [lindex [split $name .] 1] 656: } 657: set probnums [lsort [lunique $probnums]] 658: event generate . <1> -x 1 -y 1 659: event generate . <ButtonRelease-1> 660: if { "" == [set probnums [multipleChoice $gCT($num) "Select which problems" $probnums 0]] } { return } 661: foreach name [array names gResponse $cmdnum.\[0-9\]*] { 662: set probnum [lindex [split $name .] 1] 663: if { -1 == [lsearch $probnums $probnum] } { 664: set answer [join [lrange [split $name .] 2 end] .] 665: unset gResponse($name) 666: unset gResponse($cmdnum.correct.$probnum.$answer) 667: } 668: } 669: set gCT($cmdnum.num) $num 670: set gCT($cmdnum.graphup) 0 671: CTupdateAnalyzeScorer $cmdnum 672: unset gCT(cmd.$cmdnum) 673: } 674: 675: ########################################################### 676: # CTdiscussStats 677: ########################################################### 678: ########################################################### 679: ########################################################### 680: proc CTdiscussStats { num } { 681: global gCT gUniqueNumber gFile 682: set cmdnum [incr gUniqueNumber] 683: set gCT(cmd.$cmdnum) discussstats 684: set file [file join $gFile($num) discussion logs access.log] 685: displayStatus "Generating discussion Stats" both $cmdnum 686: CTdiscussForum $cmdnum $file $gFile($num) 687: CToutput $num $cmdnum 688: removeStatus $cmdnum 689: unset gCT(cmd.$cmdnum) 690: } 691: 692: ########################################################### 693: # CTquit 694: ########################################################### 695: ########################################################### 696: ########################################################### 697: proc CTquit { num } { 698: global gCT 699: destroy $gCT($num) 700: } 701: 702: #menu command helpers 703: ########################################################### 704: # CTscanSetDB 705: ########################################################### 706: ########################################################### 707: ########################################################### 708: proc CTscanSetDB { num file Q_cntVar L_cntVar } { 709: global gMaxSet gTotal_try gYes_cnt gyes_cnt gStudent_cnt gStudent_try \ 710: gTotal_weight gTotal_scores gEntry gScore gNewStudent_cnt 711: upvar $Q_cntVar Q_cnt 712: upvar $L_cntVar L_cnt 713: 714: set line_cnt 0 715: set valid_cnt 0 716: 717: for { set ii 0 } { $ii <= $gMaxSet } { incr ii } { 718: set gTotal_try($num.$ii) 0 719: set gYes_cnt($num.$ii) 0 720: set gyes_cnt($num.$ii) 0 721: for { set jj 0 } { $jj <= $gMaxSet } { incr jj } { 722: set gStudent_cnt($num.$ii.$jj) 0 723: set gStudent_try($num.$ii.$jj) 0 724: } 725: set gNewStudent_cnt($num.$ii) 0 726: } 727: set gTotal_weight($num) 0 728: set gTotal_scores($num) 0 729: 730: set maxLine [lindex [exec wc $file] 0] 731: set tries "" 732: set fileId [open $file "r"] 733: set aline [gets $fileId] 734: while { ! [eof $fileId] } { 735: incr line_cnt 736: if { ($line_cnt%20) == 0 } { 737: updateStatusBar [expr $line_cnt/double($maxLine)] $num 738: } 739: if { $line_cnt == 2 } { 740: set aline [string trim $aline] 741: set weight [split $aline {}] 742: } 743: if { $line_cnt > 3 } { 744: catch { 745: set aline [string trim $aline] 746: set prefix [lindex [split $aline ,] 0] 747: set s_num [lindex [split $aline " "] 0] 748: set ans_str [lindex [split $prefix " "] 1] 749: set ans_char [split $ans_str {} ] 750: set tries [lrange [split $aline ,] 1 end] 751: for { set valid 0; set ii 0 } { $ii < [llength $ans_char] } { incr ii } { 752: if {([lindex $ans_char $ii] != "-")&&([lindex $ans_char $ii] != "E") 753: && ([lindex $ans_char $ii] != "e") } { set valid 1 } 754: } 755: if { $valid } { 756: for {set score 0; set ii 0} { $ii < [llength $tries] } { incr ii } { 757: set triesii 0 758: incr gTotal_weight($num) [lindex $weight $ii] 759: if { [lindex $ans_char $ii] == "Y" } { 760: set triesii [string trim [lindex $tries $ii]] 761: incr gYes_cnt($num.$ii) 762: incr score [lindex $weight $ii] 763: incr gNewStudent_cnt($num.$ii) 764: } elseif { [lindex $ans_char $ii] == "y" } { 765: set triesii [string trim [lindex $tries $ii]] 766: incr triesii 767: incr gyes_cnt($num.$ii) 768: incr score [lindex $weight $ii] 769: incr gNewStudent_cnt($num.$ii) 770: } elseif { ( [lindex $ans_char $ii] > 0 ) && \ 771: ( [lindex $ans_char $ii] <= 9) } { 772: set triesii [string trim [lindex $tries $ii]] 773: incr score [lindex $ans_char $ii] 774: incr gYes_cnt($num.$ii) 775: incr gNewStudent_cnt($num.$ii) 776: } elseif { ( [lindex $ans_char $ii] == 0 ) } { 777: set triesii [string trim [lindex $tries $ii]] 778: incr gNewStudent_cnt($num.$ii) 779: } elseif {([lindex $ans_char $ii]=="n") || \ 780: ([lindex $ans_char $ii]=="N")} { 781: set triesii [string trim [lindex $tries $ii]] 782: if { [lindex $ans_char $ii] == "n" } { incr triesii } 783: incr gNewStudent_cnt($num.$ii) 784: } 785: set gStudent_try($num.$valid_cnt.$ii) $triesii 786: incr gTotal_try($num.$ii) $triesii 787: incr gStudent_cnt($num.$ii.$triesii) 788: } 789: incr gTotal_scores($num) $score 790: set gEntry($num.$valid_cnt) "$aline" 791: set gScore($num.$valid_cnt) $score 792: incr valid_cnt 793: } 794: } 795: } 796: set aline [gets $fileId] 797: } 798: close $fileId 799: set Q_cnt [llength $tries] 800: set L_cnt $valid_cnt 801: return 802: } 803: 804: ########################################################### 805: # CTpercentageScores 806: ########################################################### 807: ########################################################### 808: ########################################################### 809: proc CTpercentageScores { num setId valid_cnt } { 810: global gTotal_weight gTotal_scores 811: 812: if { $gTotal_weight($num) > 0 } { 813: set ratio [expr double($gTotal_scores($num)) / double($gTotal_weight($num))] 814: set ratio [expr $ratio * 100.0 ] 815: CTputs $num "\nScore (total scores / total valid weights) for set$setId.db: [format %7.2f%% $ratio]\n" 816: } 817: CTputs $num "The number of valid records for set$setId.db is: $valid_cnt\n" 818: } 819: 820: ########################################################### 821: # CTaverage 822: ########################################################### 823: ########################################################### 824: ########################################################### 825: proc CTaverage { num q_cnt l_cnt faillistVar dodifflistVar numyesVar} { 826: upvar $faillistVar faillist $dodifflistVar dodifflist $numyesVar numyes 827: global gMaxTries gStudent_cnt gStudent_try gTotal_try gYes_cnt gyes_cnt \ 828: gNewStudent_cnt 829: 830: set maxIter [expr $q_cnt * 4] 831: 832: for { set ii 0 } { $ii < $q_cnt } { incr ii } { 833: updateStatusBar [expr $ii/double($maxIter)] $num 834: set s_cnt($ii) 0 835: set avg($ii) 0.0 836: set max_try($ii) 0 837: for { set jj 1 } { $jj < $gMaxTries } { incr jj } { 838: if { $gStudent_cnt($num.$ii.$jj) > 0 } { 839: set avg($ii) [expr $avg($ii) + ($jj * $gStudent_cnt($num.$ii.$jj))] 840: incr s_cnt($ii) $gStudent_cnt($num.$ii.$jj) 841: } 842: } 843: set s_cnt($ii) $gNewStudent_cnt($num.$ii) 844: if { $s_cnt($ii) > 0 } { set avg($ii) [expr $avg($ii) / $s_cnt($ii)] } 845: } 846: 847: for { set ii 0 } { $ii < $q_cnt } { incr ii } { 848: updateStatusBar [expr ($ii+$q_cnt)/double($maxIter)] $num 849: set sd($ii) 0.0 850: set sum 0.0 851: for { set jj 0 } { $jj < $l_cnt } { incr jj } { 852: if { $gStudent_try($num.$jj.$ii) > $max_try($ii) } { 853: set max_try($ii) $gStudent_try($num.$jj.$ii) 854: } 855: if { $gStudent_try($num.$jj.$ii) > 0 } { 856: set sq [expr ( $gStudent_try($num.$jj.$ii) - $avg($ii) ) * \ 857: ( $gStudent_try($num.$jj.$ii) - $avg($ii)) ] 858: set sum [expr $sum + $sq] 859: } 860: if { $s_cnt($ii) > 1 } { 861: set sd($ii) [expr $sum / ( $s_cnt($ii) - 1.0 )] 862: } 863: if { $sd($ii) > 0 } { set sd($ii) [ expr sqrt($sd($ii)) ] } 864: } 865: } 866: 867: for { set ii 0 } { $ii < $q_cnt } { incr ii } { 868: updateStatusBar [expr ($ii+(2*$q_cnt))/double($maxIter)] $num 869: set sd3($ii) 0.0 870: set sum 0.0 871: for { set jj 0 } { $jj < $l_cnt } { incr jj } { 872: if { $gStudent_try($num.$jj.$ii) > 0 } { 873: set tmp1 [expr $gStudent_try($num.$jj.$ii) - $avg($ii)] 874: set tmp2 [expr $tmp1 * $tmp1 * $tmp1] 875: set sum [expr $sum + $tmp2] 876: } 877: if { ( $s_cnt($ii) > 0 ) && ( $sd($ii) != 0.0 ) } { 878: set sd3($ii) [expr $sum / $s_cnt($ii) ] 879: set sd3($ii) [expr $sd3($ii) / ($sd($ii) * $sd($ii) * $sd($ii)) ] 880: } 881: } 882: } 883: CTputs $num "This is the statistics for each problem: \n" 884: CTputs $num "Prob\# MxTries avg. s.d. s.k. \#Stdnts" 885: CTputs $num " \#Yes \#yes Tries DoDiff %Wrong\n" 886: set numyes [set dodifflist [set faillist ""]] 887: # parray s_cnt 888: for { set ii 0 } { $ii < $q_cnt } { incr ii } { 889: updateStatusBar [expr ($ii+(3*$q_cnt))/double($maxIter)] $num 890: if { $gTotal_try($num.$ii) > 0 } { 891: set dod [expr $gTotal_try($num.$ii)/(0.1 + $gYes_cnt($num.$ii) \ 892: + $gyes_cnt($num.$ii))] 893: } else { 894: set dod 0.0 895: } 896: if {[catch {set success [expr 100.0*($s_cnt($ii)-($gYes_cnt($num.$ii)+ \ 897: $gyes_cnt($num.$ii)))/$s_cnt($ii)]}]} { 898: set success 0.0 899: set s_cnt($ii) 0 900: } 901: CTputs $num [format "P %2d" [expr int($ii + 1)] ] 902: CTputs $num [format "%6d %8.2f %7.2f %6.2f %5d %5d %5d %5d %5.1f %6.2f\n"\ 903: $max_try($ii) $avg($ii) $sd($ii) $sd3($ii) $s_cnt($ii) \ 904: $gYes_cnt($num.$ii) $gyes_cnt($num.$ii) \ 905: $gTotal_try($num.$ii) $dod $success] 906: if { $success < 0 } { set success 0 } 907: lappend faillist [list $success [expr int($ii + 1)]] 908: lappend dodifflist [list $dod [expr int($ii + 1)]] 909: lappend numyes [list [expr $gYes_cnt($num.$ii)+$gyes_cnt($num.$ii)] \ 910: [expr int($ii + 1)]] 911: } 912: } 913: 914: ########################################################### 915: # CTlogAnalysis2 916: ########################################################### 917: ########################################################### 918: ########################################################### 919: proc CTlogAnalysis2 { num cmdnum setId } { 920: global gFile 921: set logFile [file join $gFile($num) records "log$setId.db"] 922: if { [file exists $logFile] } { 923: CTputs $cmdnum "Log analysis for telnet session log$setId.db\n" 924: CTscanLogDB $cmdnum $logFile l(Y) l(N) l(S) l(U) l(u) 925: } else { 926: set l(Y) [set l(N) [set l(S) [set l(U) [set l(u) 0]]]] 927: } 928: set webLogFile [file join $gFile($num) records "weblog$setId.db" ] 929: if { [file exists $webLogFile] } { 930: CTputs $cmdnum "===============================================\n" 931: CTputs $cmdnum "Log analysis for web session weblog$setId.db\n" 932: CTscanLogDB $cmdnum $webLogFile w(Y) w(N) w(S) w(U) w(u) 933: } else { 934: set w(Y) [set w(N) [set w(S) [set w(U) [set w(u) 0]]]] 935: } 936: set telnet_total [expr $l(Y)+$l(N)+$l(S)+$l(U)+$l(u)] 937: set web_total [expr $w(Y)+$w(N)+$w(S)+$w(U)+$w(u)] 938: CTputs $cmdnum "============== SUMMARY ====================\n" 939: CTputs $cmdnum " #Y #N #S #U #u Total\n" 940: CTputs $cmdnum [format "telnet: %6d %6d %6d %6d %6d %6d\n" \ 941: $l(Y) $l(N) $l(S) $l(U) $l(u) $telnet_total ] 942: CTputs $cmdnum [format " web: %6d %6d %6d %6d %6d %6d\n" \ 943: $w(Y) $w(N) $w(S) $w(U) $w(u) $web_total] 944: foreach v { Y N S U u } { 945: set sum($v) [expr $l($v) + $w($v)] 946: if { $sum($v) > 0 } { 947: set ratio($v) [expr 100.0*$w($v)/double($sum($v))] 948: } else { 949: set ratio($v) 0.0 950: } 951: } 952: set overall_entries [expr $telnet_total + $web_total] 953: if { $overall_entries > 0 } { 954: set ratio(web) [expr 100.0*(double($web_total)/double($overall_entries))] 955: } else { 956: set ratio(web) 0.0 957: } 958: CTputs $cmdnum [format " %%web: % 6.1f % 6.1f % 6.1f % 6.1f % 6.1f % 6.1f\n" \ 959: $ratio(Y) $ratio(N) $ratio(S) $ratio(U) $ratio(u) $ratio(web) ] 960: } 961: 962: 963: ########################################################### 964: # CTscanLogDB 965: ########################################################### 966: ########################################################### 967: ########################################################### 968: proc CTscanLogDB { num file Y_lVar N_lVar S_lVar U_lVar u_lVar } { 969: upvar $Y_lVar Y_l 970: upvar $N_lVar N_l 971: upvar $S_lVar S_l 972: upvar $U_lVar U_l 973: upvar $u_lVar u_l 974: 975: set line_cnt 0 976: 977: displayStatus "Analyzing [file tail $file]" both $num 978: set maxLine [lindex [exec wc $file] 0] 979: set fileId [open $file "r"] 980: 981: set aline [gets $fileId] 982: while { ! [eof $fileId] } { 983: incr line_cnt 984: if { ($line_cnt%20) == 0 } { 985: updateStatusBar [expr $line_cnt/double($maxLine)] $num 986: } 987: set aline [string trim $aline] 988: set ans_str [string range $aline 35 end] 989: set ans_char [split $ans_str {}] 990: if { ! [info exists count] } { 991: for { set i 0 } { $i < [llength $ans_char] } { incr i } { 992: set count(Y.$i) 0; set count(N.$i) 0; set count(S.$i) 0 993: set count(U.$i) 0; set count(u.$i) 0 994: } 995: set count(Y.total) 0; set count(N.total) 0; set count(S.total) 0 996: set count(U.total) 0; set count(u.total) 0 997: } 998: set i -1 999: foreach char $ans_char { 1000: incr i 1001: if { $char == "-" } { continue } 1002: if { [catch {incr count($char.$i)}] } { 1003: set count(Y.$i) 0; set count(N.$i) 0; set count(S.$i) 0 1004: set count(U.$i) 0; set count(u.$i) 0 1005: incr count($char.$i) 1006: } 1007: incr count($char.total) 1008: } 1009: set aline [gets $fileId] 1010: } 1011: close $fileId 1012: removeStatus $num 1013: CTputs $num "Prob #: #Y #N #S #U #u\n" 1014: for { set i 0 } { $i < [llength $ans_char] } { incr i } { 1015: CTputs $num [format " %2d: %6d %6d %6d %6d %6d\n" [expr $i + 1] \ 1016: $count(Y.$i) $count(N.$i) $count(S.$i) $count(U.$i) $count(u.$i) ] 1017: } 1018: CTputs $num "===========================================\n" 1019: CTputs $num [format " Total: %6d %6d %6d %6d %6d\n" $count(Y.total) $count(N.total) \ 1020: $count(S.total) $count(U.total) $count(u.total) ] 1021: set Y_l $count(Y.total) 1022: set N_l $count(N.total) 1023: set S_l $count(S.total) 1024: set U_l $count(U.total) 1025: set u_l $count(u.total) 1026: return 1027: } 1028: 1029: ########################################################### 1030: # CTcollectSetScores 1031: ########################################################### 1032: ########################################################### 1033: ########################################################### 1034: proc CTcollectSetScores { num path id on_screen limit } { 1035: set id [ string toupper $id ] 1036: set total_scores 0 1037: set total_weights 0 1038: set set_idx 0 1039: set done 0 1040: while { ! $done } { 1041: incr set_idx 1042: if { $set_idx > $limit } { set done 1; continue } 1043: updateStatusBar [expr $set_idx/double($limit)] $num 1044: set filename [file join $path records "set$set_idx.db"] 1045: if { ![file readable $filename ] } { continue } 1046: set fileId [open $filename "r"] 1047: set line_cnt 0 1048: set found 0 1049: set aline [ gets $fileId ] 1050: while { ! [eof $fileId] && ! $found } { 1051: incr line_cnt 1052: if { $line_cnt > 3 } { 1053: set aline [string trim $aline] 1054: set prefix [lindex [split $aline ","] 0] 1055: set s_num [string toupper [lindex [split $aline " "] 0] ] 1056: set ans_str [lindex [split $prefix " "] 1] 1057: if { $id == $s_num } { 1058: set ans_char [split $ans_str {} ] 1059: set valid 0 1060: foreach char $ans_char { if { $char != "-" } { set valid 1; break } } 1061: if { ! $valid } { 1062: set score "-" 1063: } else { 1064: set score 0 1065: for {set i 0} { $i < [llength $ans_char] } { incr i } { 1066: set char [lindex $ans_char $i] 1067: if { $char == "N" || $char == "n"} { set found 1 } 1068: if { $char == "Y" || $char == "y"} { 1069: incr score [lindex $weights $i];set found 1 1070: } 1071: if { $char >= 0 && $char <= 9 } { 1072: incr score $char;set found 1 1073: } 1074: if { $char == "E" } { 1075: incr valid_weights "-[lindex $weights $i]" 1076: } 1077: } 1078: incr total_scores $score 1079: } 1080: } 1081: } elseif { $line_cnt == 2 } { 1082: set aline [string trim $aline] 1083: set weights [split $aline {} ] 1084: set valid_weights 0 1085: foreach weight $weights { incr valid_weights $weight } 1086: } else { 1087: #do nothing for line 1 and 3 1088: } 1089: set aline [ gets $fileId ] 1090: } 1091: close $fileId 1092: incr total_weights $valid_weights 1093: set set_weights([expr $set_idx - 1]) $valid_weights 1094: if { $found } { 1095: set set_scores([expr $set_idx - 1]) $score 1096: } else { 1097: set set_scores([expr $set_idx - 1]) "-" 1098: } 1099: } 1100: set abscent_cnt 0 1101: set present_cnt 0 1102: set summary_str "" 1103: if { $on_screen } { CTputs $num " " } 1104: foreach i [lsort -integer [array names set_scores]] { 1105: if { $set_scores($i) == "-" || $set_scores($i) == "" } { 1106: if { $on_screen } { CTputs $num " - " } 1107: append summary_str "x/$set_weights($i) " 1108: incr abscent_cnt 1109: } else { 1110: if { $on_screen } { CTputs $num [format " %3d" $set_scores($i)] } 1111: append summary_str "$set_scores($i)/$set_weights($i) " 1112: incr present_cnt 1113: } 1114: } 1115: if { $on_screen } { 1116: CTputs $num "\n [file tail $path]:" 1117: foreach i [lsort -integer [array names set_scores]] { CTputs $num " ---" } 1118: CTputs $num "\n " 1119: if { [info exists set_weights] } { 1120: set num_set_weights [llength [array names set_weights]] 1121: } else { 1122: set num_set_weights 0 1123: } 1124: for {set i 0} {$i < $num_set_weights} {incr i} { 1125: if { [info exists set_weights($i)] } { 1126: CTputs $num [format " %3d" $set_weights($i)] 1127: } else { 1128: set num_set_weights $i 1129: } 1130: } 1131: CTputs $num "\n" 1132: if { $total_weights != 0 } { 1133: set ratio [expr 100.0 * $total_scores / double($total_weights) ] 1134: CTputs $num [format " %5d\n" $total_scores] 1135: if { [info exists set_scores] } { 1136: CTputs $num [format " ------- = %3.2f%%, scores absent in %d/%d\n" \ 1137: $ratio $abscent_cnt [llength [array names set_scores]]] 1138: } else { 1139: CTputs $num [format " ------- = %3.2f%%, scores absent in %d/%d\n" \ 1140: $ratio $abscent_cnt 0 ] 1141: } 1142: } else { 1143: set ratio "-" 1144: CTputs $num [format " %5d\n" $total_scores] 1145: if { [info exists set_scores] } { 1146: CTputs $num [format " ------- = %s%%, scores absent in %d/%d\n" \ 1147: $ratio $abscent_cnt [llength [array names set_scores]]] 1148: } else { 1149: CTputs $num [format " ------- = %s%%, scores absent in %d/%d\n" \ 1150: $ratio $abscent_cnt 0 ] 1151: } 1152: } 1153: 1154: CTputs $num [format " %5d\n" $total_weights] 1155: } 1156: return [list $total_scores $total_weights $abscent_cnt \ 1157: [llength [array names set_scores] ] $summary_str] 1158: } 1159: 1160: ########################################################### 1161: # CTloginAnalysis 1162: ########################################################### 1163: ########################################################### 1164: ########################################################### 1165: proc CTloginAnalysis { num path id limit } { 1166: 1167: CTputs $num "Login analysis: telnet session web session\n\n" 1168: CTputs $num " set #: #Y #N #S #U #u #Y #N #S #U #u\n" 1169: set set_idx 0 1170: set done 0 1171: while { ! $done } { 1172: incr set_idx 1173: if { $set_idx > $limit } { set done 1; continue } 1174: CTputs $num [format " %2d: " $set_idx] 1175: set filename [file join $path records "log$set_idx.db"] 1176: updateStatusMessage "Analyzing [file tail $filename]" $num 1177: updateStatusBar 0.0 $num 1178: if { [file readable $filename] } { 1179: set result [CTstudentLoginData $num $filename $id] 1180: CTputs $num [eval format \"%4d %4d %4d %4d %4d\" $result] 1181: set no_log 0 1182: } else { 1183: CTputs $num "========================" 1184: set no_log 1 1185: } 1186: CTputs $num " " 1187: set filename [file join $path records "weblog$set_idx.db"] 1188: updateStatusMessage "Analyzing [file tail $filename]" $num 1189: updateStatusBar 0.0 $num 1190: if { [file readable $filename] } { 1191: set result [CTstudentLoginData $num $filename $id] 1192: CTputs $num [eval format \"%4d %4d %4d %4d %4d\" $result] 1193: set no_weblog 0 1194: } else { 1195: CTputs $num "========================" 1196: set no_weblog 1 1197: } 1198: CTputs $num "\n" 1199: if { $no_log && $no_weblog } { set done 1 } 1200: } 1201: } 1202: 1203: ########################################################### 1204: # CTstudentSetAnalysis 1205: ########################################################### 1206: ########################################################### 1207: ########################################################### 1208: proc CTstudentSetAnalysis { num path id limit } { 1209: set set_idx 0 1210: set id [string toupper $id] 1211: CTputs $num " set \#:\n" 1212: set done 0 1213: while { ! $done } { 1214: incr set_idx 1215: if { $set_idx > $limit } { set done 1; continue } 1216: set filename [file join $path records "set$set_idx.db"] 1217: updateStatusMessage "Analyzing [file tail $filename]" $num 1218: if { ![file readable $filename] } { continue } 1219: CTputs $num [format " %2d: " $set_idx] 1220: set fileId [open $filename "r"] 1221: set line_cnt 0 1222: set found 0 1223: set aline [gets $fileId] 1224: while { ! [eof $fileId] && !$found } { 1225: incr line_cnt 1226: if { $line_cnt > 3 } { 1227: set aline [string trim $aline] 1228: set s_id [string toupper [string range $aline 0 8]] 1229: if {$id == $s_id} { 1230: set found 1 1231: set breakpt [string first "," $aline] 1232: set data [list [string range $aline 10 [expr $breakpt - 1] ] \ 1233: [string range $aline [expr $breakpt + 1] end ] ] 1234: CTputs $num "[lindex $data 0]\n [lindex $data 1]\n" 1235: } 1236: } 1237: set aline [gets $fileId] 1238: } 1239: close $fileId 1240: if { ! $found } { CTputs $num "\n\n" } 1241: } 1242: } 1243: 1244: ########################################################### 1245: # CTstudentLoginData 1246: ########################################################### 1247: ########################################################### 1248: ########################################################### 1249: proc CTstudentLoginData { num filename id } { 1250: 1251: set Y_total 0 1252: set N_total 0 1253: set U_total 0 1254: set u_total 0 1255: set S_total 0 1256: set maxLine [expr double([lindex [exec wc $filename] 0])] 1257: set line_cnt 0 1258: set fileId [open $filename "r"] 1259: set aline [gets $fileId] 1260: while { ![eof $fileId] } { 1261: incr line_cnt 1262: if { $line_cnt%300 == 0 } { 1263: updateStatusBar [expr $line_cnt/$maxLine] $num 1264: } 1265: set aline [string trim $aline] 1266: set s_id [string toupper [string range $aline 0 8]] 1267: set id [string toupper $id] 1268: if {$id == $s_id} { 1269: set ans_char [split [string range $aline 35 end] {} ] 1270: for {set i 0} {$i< [llength $ans_char]} {incr i} { 1271: if {[lindex $ans_char $i] == "Y"} { incr Y_total 1272: } elseif {[lindex $ans_char $i] == "N"} { incr N_total 1273: } elseif {[lindex $ans_char $i] == "U"} { incr U_total 1274: } elseif {[lindex $ans_char $i] == "u"} { incr u_total 1275: } elseif {[lindex $ans_char $i] == "S"} { incr S_total } 1276: } 1277: } 1278: set aline [gets $fileId] 1279: } 1280: close $fileId 1281: return [list $Y_total $N_total $S_total $U_total $u_total] 1282: } 1283: 1284: ########################################################### 1285: # CTrunCommand 1286: ########################################################### 1287: ########################################################### 1288: ########################################################### 1289: proc CTrunCommand { num cmdnum fileId {followup "" }} { 1290: global gCT 1291: 1292: set data [read $fileId] 1293: updateStatusSpinner $cmdnum 1294: if { $data != "" } { 1295: CTputs $cmdnum $data 1296: } 1297: if { [eof $fileId] } { 1298: fileevent $fileId readable "" 1299: catch {close $fileId} 1300: if { $followup == "" } { 1301: CToutput $num $cmdnum 1302: removeStatus $cmdnum 1303: unset gCT(cmd.$cmdnum) 1304: } else { 1305: eval $followup 1306: } 1307: } 1308: } 1309: 1310: ########################################################### 1311: # CTitemAnalysisRange 1312: ########################################################### 1313: ########################################################### 1314: ########################################################### 1315: proc CTitemAnalysisRange { num classpath setIdStart setIdEnd } { 1316: for { set i $setIdStart } { $i <= $setIdEnd } { incr i } { 1317: if { [ catch { CTitemAnalysis $num $classpath $i } errors ] } { 1318: displayError $errors 1319: } 1320: } 1321: } 1322: 1323: ########################################################### 1324: # CTitemAnalysis 1325: ########################################################### 1326: ########################################################### 1327: ########################################################### 1328: proc CTitemAnalysis { num classpath setId } { 1329: global gMaxSet 1330: set done 0 1331: 1332: set total_scores 0 1333: set total_weights 0 1334: set upper_percent 0.0 1335: set lower_percent 0.0 1336: 1337: set Y_total 0 1338: set N_total 0 1339: for { set ii 0} { $ii<$gMaxSet } {incr ii} { 1340: set Y_cnt($ii) 0 1341: set N_cnt($ii) 0 1342: set Ycnt_upper($ii) 0.0 1343: set Ycnt_lower($ii) 0.0 1344: } 1345: 1346: set filename [file join $classpath records "set$setId.db"] 1347: if { ! [file readable $filename] } { 1348: CTputs $num "FILE: $filename does not exist!\n" 1349: return 1350: } 1351: 1352: displayStatus "Analyzing [file tail $filename]" both $num 1353: set maxLine [lindex [exec wc $filename] 0] 1354: 1355: set fileId [open "$filename" "r"] 1356: set valid_cnt 0 1357: set line_cnt 0 1358: set ans_char "" 1359: set aline [gets $fileId] 1360: while {![eof $fileId]} { 1361: incr line_cnt 1362: if { ($line_cnt%20) == 0 } { 1363: updateStatusBar [expr $line_cnt/double($maxLine)] $num 1364: } 1365: if { $line_cnt == 2 } { 1366: set aline [string trim $aline] 1367: set weights [split $aline {}] 1368: # set valid_weights 0 1369: # for { set ii 0 } { $ii < [llength $weights] } { incr ii } { 1370: # incr valid_weights [lindex $weights $ii] 1371: # } 1372: } elseif { $line_cnt > 3} { 1373: set aline [string trim $aline] 1374: set prefix [lindex [split $aline ","] 0] 1375: set s_num [string toupper [lindex [split $aline " " ] 0 ] ] 1376: set ans_str [lindex [split $prefix " "] 1] 1377: set ans_char [split $ans_str {} ] 1378: set valid 0 1379: for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } { 1380: if { [lindex $ans_char $ii] != "-"} { set valid 1 } 1381: } 1382: if { $valid } { 1383: incr valid_cnt 1384: set score 0 1385: for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } { 1386: 1387: if { [lindex $ans_char $ii] == "Y" || \ 1388: [lindex $ans_char $ii] == "y" } { 1389: incr score [lindex $weights $ii] 1390: set Y_cnt($ii) [expr $Y_cnt($ii) + 1] 1391: set Y_total [expr $Y_total + 1] 1392: } 1393: if { [lindex $ans_char $ii] == "N" || \ 1394: [lindex $ans_char $ii] == "n" } { 1395: set N_cnt($ii) [expr $N_cnt($ii) + 1] 1396: set N_total [expr $N_total + 1] 1397: } 1398: if { [lindex $ans_char $ii] >= 0 && \ 1399: [lindex $ans_char $ii] <= 9 } { 1400: incr score [lindex $ans_char $ii] 1401: set yes_part [expr [lindex $ans_char $ii] / \ 1402: double([lindex $weights $ii]) ] 1403: set no_part [expr 1.0 - $yes_part] 1404: set Y_cnt($ii) [expr $Y_cnt($ii) + $yes_part] 1405: set Y_total [expr $Y_total + $yes_part] 1406: set N_cnt($ii) [expr $N_cnt($ii) + $no_part] 1407: set N_total [expr $N_total + $no_part] 1408: } 1409: # if { [lindex $ans_char $ii] == "E"} { 1410: # incr valid_weights -[lindex $weights $ii] 1411: # } 1412: } 1413: set s_db([format "%08d%s" $score $s_num]) $ans_str 1414: } 1415: } 1416: set aline [gets $fileId] 1417: } 1418: close $fileId 1419: removeStatus $num 1420: for { set ii 0 } { $ii < $gMaxSet } { incr ii } { 1421: set Ycnt_upper($ii) 0 1422: set Ycnt_lower($ii) 0 1423: } 1424: displayStatus "Pondering data . . ." spinner $num 1425: set upperpart_cnt [expr int(0.27 * double($valid_cnt))] 1426: set lowerpart_limit [expr $valid_cnt - $upperpart_cnt] 1427: set line_cnt 0 1428: foreach sort_key [lsort -decreasing [array names s_db]] { 1429: incr line_cnt 1430: if { ($line_cnt%20) == 0 } { updateStatusSpinner $num } 1431: set ans_str $s_db($sort_key) 1432: set ans_char [split $ans_str {} ] 1433: for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } { 1434: if { [lindex $ans_char $ii] == "Y" || \ 1435: [lindex $ans_char $ii] == "y" || \ 1436: [lindex $ans_char $ii] == [lindex $weights $ii] } { 1437: if { $line_cnt <= $upperpart_cnt } { 1438: incr Ycnt_upper($ii) 1439: } elseif { $line_cnt > $lowerpart_limit } { 1440: incr Ycnt_lower($ii) 1441: } 1442: } 1443: } 1444: } 1445: CTputs $num " There are $valid_cnt entries in file $filename\n" 1446: CTputs $num [format " The upper 27%% has %d records, the lower 27%% has %d records\n"\ 1447: $upperpart_cnt [expr $valid_cnt - $lowerpart_limit] ] 1448: CTputs $num " question \# DoDiff. Disc. Factor (%upper - %lower) \[\#records,\#records\]\n"; 1449: 1450: for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } { 1451: updateStatusSpinner $num 1452: set tmp_total [expr $N_cnt($ii) + $Y_cnt($ii)] 1453: if { $tmp_total > 0 } { 1454: set diff [expr 100.0*($N_cnt($ii) / double($N_cnt($ii) + $Y_cnt($ii)))] 1455: } else { 1456: set diff "-" 1457: } 1458: set upper_percent [expr 100.0 * ($Ycnt_upper($ii) /double($upperpart_cnt))] 1459: set lower_percent [expr 100.0 * ($Ycnt_lower($ii) /double($upperpart_cnt))] 1460: set disc [expr $upper_percent - $lower_percent] 1461: CTputs $num [format " %2d: " [expr $ii + 1]] 1462: CTputs $num [format "%6.1f %5.1f (%6.1f - %6.1f) \[%8d,%8d\]\n" \ 1463: $diff $disc $upper_percent $lower_percent $Ycnt_upper($ii) \ 1464: $Ycnt_lower($ii) ] 1465: } 1466: removeStatus $num 1467: } 1468: 1469: ########################################################### 1470: # CTitemCorrelation 1471: ########################################################### 1472: # INPUTS: class name with full path, set number 1473: # 1474: # r = \frac{\sum{x_i y_i} - \frac{(\sum x_i)(\sum y_i)}{n}} 1475: # {\sqrt{(\sum x_i^2 - \frac{}{}}} 1476: # 1477: # corr = (sum of prod_xy - (sum_x*sum_y / n) ) / sqrt( (sum of sqr_x - (sum_x*sum_x/n))* 1478: # 1479: ########################################################### 1480: ########################################################### 1481: proc CTitemCorrelation { num classpath setId } { 1482: global gMaxSet 1483: 1484: set filename [file join $classpath records "set$setId.db"] 1485: if { ! [file readable $filename] } { 1486: CTputs $num "FILE: $filename does not exist!\n" 1487: return 1488: } 1489: 1490: displayStatus "Analyzing [file tail $filename]" both $num 1491: set maxLine [lindex [exec wc $filename] 0] 1492: 1493: set initialized 0 1494: set question_cnt 0 1495: set fileId [open "$filename" "r"] 1496: set line_cnt 0 1497: set aline [gets $fileId] 1498: while {![eof $fileId]} { 1499: incr line_cnt 1500: if { ($line_cnt%20) == 0 } { 1501: updateStatusBar [expr {$line_cnt/double($maxLine)}] $num 1502: } 1503: if { $line_cnt == 2 } { 1504: set aline [string trim $aline] 1505: set weights [split $aline {}] 1506: } 1507: if { $line_cnt > 3} { 1508: set aline [string trim $aline] 1509: set data [string range $aline 10 end] 1510: set ans_str [lindex [split $data ","] 0] 1511: set ans_char_list [split $ans_str {} ] 1512: set try_str [string range $aline [expr {[string first "," $data] +1}] end ] 1513: set question_cnt [llength $ans_char_list] 1514: for { set ii 0 } { $ii < $question_cnt } { incr ii } { 1515: set ans_char($ii) [lindex $ans_char_list $ii] 1516: } 1517: if { $question_cnt > $initialized } { 1518: for {set ii 0} {$ii < [expr {$question_cnt - 1}]} {incr ii} { 1519: set start [expr {($initialized>($ii+1)) ? $initialized : ($ii+1)}] 1520: for { set jj $start } { $jj < $question_cnt } { incr jj } { 1521: set index_key "$ii.$jj" 1522: set prod_xy($index_key) 0.0 1523: set sum_x($index_key) 0 1524: set sum_y($index_key) 0 1525: set sum_x2($index_key) 0 1526: set sum_y2($index_key) 0 1527: set valid_cnt($index_key) 0 1528: } 1529: } 1530: set initialized $question_cnt 1531: } 1532: for { set ii 0 } { $ii < [expr {$question_cnt - 1}] } { incr ii } { 1533: for { set jj [expr {$ii+1}] } { $jj < $question_cnt } { incr jj } { 1534: set index_key "$ii.$jj" 1535: if { $ans_char($ii) != "-" && $ans_char($ii) != "E" && \ 1536: $ans_char($jj) != "-" && $ans_char($jj) != "E" } { 1537: ## $ans_char($ii) is one of 0 .. 9, Y, y, N, n 1538: ## $ans_char($jj) is one of 0 .. 9, Y, y, N, n 1539: if { $ans_char($ii) == "Y" || $ans_char($ii) == "y" } { 1540: set x_data [lindex $weights $ii] 1541: } elseif { $ans_char($ii) == "N" || $ans_char($ii) == "n" } { 1542: set x_data 0 1543: } else { ## must be in 0 .. 9 1544: set x_data $ans_char($ii) 1545: } 1546: if { $ans_char($jj) == "Y" || $ans_char($jj) == "y" } { 1547: set y_data [lindex $weights $jj] 1548: } elseif { $ans_char($jj) == "N" || $ans_char($jj) == "n" } { 1549: set y_data 0 1550: } else { ## must be in 0 .. 9 1551: set y_data $ans_char($jj) 1552: } 1553: set prod_xy($index_key) [expr {$x_data * $y_data + 1554: $prod_xy($index_key)} ] 1555: incr sum_x($index_key) $x_data 1556: incr sum_y($index_key) $y_data 1557: incr sum_x2($index_key) [expr {$x_data * $x_data}] 1558: incr sum_y2($index_key) [expr {$y_data * $y_data}] 1559: incr valid_cnt($index_key) 1 1560: } 1561: } 1562: } 1563: } 1564: set aline [gets $fileId] 1565: } 1566: close $fileId 1567: removeStatus $num 1568: # print out the correlation matrix 1569: # parray sum_x 1570: # parray sum_y 1571: # parray prod_xy 1572: CTputs $num " " 1573: for { set ii 1 } { $ii < $question_cnt } { incr ii } { 1574: CTputs $num [format " %2d" [expr {$ii+1}] ] 1575: } 1576: CTputs $num "\n" 1577: # -------------------------------------- 1578: for { set ii 0 } { $ii < [expr {$question_cnt -1}] } { incr ii } { 1579: CTputs $num [format " %2d:" [expr {$ii+1}] ] 1580: for { set jj 0 } { $jj < $ii } { incr jj } { CTputs $num " " } 1581: for { set jj [expr {$ii+1}] } { $jj < $question_cnt } { incr jj } { 1582: set index_key "$ii.$jj" 1583: if { $valid_cnt($index_key) != "0" } { 1584: set upper_part [ expr { $prod_xy($index_key) - 1585: ( ($sum_x($index_key) * $sum_y($index_key)) 1586: / double($valid_cnt($index_key)))}] 1587: set lower_part [expr {$sum_x2($index_key) - 1588: ($sum_x($index_key) * $sum_x($index_key) 1589: / double($valid_cnt($index_key)))} ] 1590: set lower_part [expr {$lower_part * ($sum_y2($index_key) - 1591: ($sum_y($index_key) * 1592: $sum_y($index_key) 1593: /double($valid_cnt($index_key))))}] 1594: set lower_part [expr {sqrt($lower_part)}] 1595: if { $lower_part != 0.0 } { 1596: set ratio [expr {$upper_part / double($lower_part)}] 1597: CTputs $num [format " % .2f" $ratio] 1598: } else { 1599: CTputs $num " INF " 1600: } 1601: } else { 1602: CTputs $num " ----" 1603: } 1604: } 1605: CTputs $num "\n" 1606: } 1607: } 1608: 1609: ########################################################### 1610: # CTsubmissionsLaunch 1611: ########################################################### 1612: ########################################################### 1613: ########################################################### 1614: proc CTsubmissionsLaunch { num cmdnum type s_id s_nm start end } { 1615: global gCT gFile gUniqueNumber gCapaConfig 1616: 1617: CTputs $cmdnum "$type submissions for $s_nm for set $start\n" 1618: if { $type == "telnet" } { 1619: set command "grep -i $s_id [file join $gFile($num) records submissions$start.db]" 1620: set followtype web 1621: } else { 1622: set command "grep -i $s_id [file join $gFile($num) \ 1623: records websubmissions$start.db]" 1624: set followtype telnet 1625: incr start 1626: } 1627: set done 0 1628: set followcmd "" 1629: while { !$done && ($start <= ($end+1)) } { 1630: if { $start <= $end } { 1631: set followcmd "CTsubmissionsLaunch $num $cmdnum $followtype $s_id {$s_nm} \ 1632: $start $end" 1633: } 1634: if { ! [catch {set fileId [open "|$command" "r"]} ] } { set done 1 } 1635: } 1636: fconfigure $fileId -blocking 0 1637: fileevent $fileId readable "CTrunCommand $num $cmdnum $fileId {$followcmd}" 1638: } 1639: 1640: ########################################################### 1641: # CTreportDist 1642: ########################################################### 1643: ########################################################### 1644: ########################################################### 1645: proc CTreportDist { num file percentage sectionlist } { 1646: set fileId [open $file "r"] 1647: set aline [gets $fileId] 1648: set which [expr [llength [split $aline "\t"]] - 2] 1649: set maximum [lindex [lrange [split $aline "\t"] $which end] 1] 1650: if { $percentage } { 1651: for {set i 0} {$i<=100} {incr i} { 1652: set totals($i.score) 0 1653: set totals($i.stunum) "" 1654: } 1655: } else { 1656: for { set i 0 } { $i <= $maximum } { incr i } { 1657: set totals($i.score) 0 1658: set totals($i.stunum) "" 1659: } 1660: } 1661: while { ![eof $fileId]} { 1662: set temp [lrange [split $aline "\t"] $which end] 1663: set score [lindex $temp 0] 1664: regsub -- "-" $score "0" score 1665: set max [lindex $temp 1] 1666: set temp [lindex [split $aline "\t"] 1] 1667: set section [lindex $temp 1] 1668: set stunum [lindex $temp 0] 1669: if { ([lsearch $sectionlist $section] != -1) && ($max!=0) } { 1670: if { $percentage } { 1671: set percent [expr int($score/double($max)*100)] 1672: incr totals($percent.score) 1673: lappend totals($percent.stunum) $stunum 1674: } else { 1675: if { $max > $maximum } { 1676: for {set i [expr $maximum+1]} {$i<=$max} {incr i} {set totals($i) 0} 1677: set maximum $max 1678: } 1679: set score [string trim $score] 1680: incr totals($score.score) 1681: lappend totals($score.stunum) $stunum 1682: } 1683: } 1684: set aline [gets $fileId] 1685: } 1686: CTputs $num "Scores #acheived\n" 1687: set scorelist "" 1688: set templist [array names totals *.score] 1689: foreach temp $templist {lappend possiblescores [lindex [split $temp .] 0]} 1690: foreach score [lsort -integer $possiblescores] { 1691: CTputs $num [format "%5d:%6d\n" $score $totals($score.score)] 1692: lappend scorelist [list $totals($score.score) $score $totals($score.stunum)] 1693: } 1694: return $scorelist 1695: } 1696: 1697: ########################################################### 1698: # CTgradeDistribution 1699: ########################################################### 1700: ########################################################### 1701: ########################################################### 1702: proc CTgradeDistribution { num classpath setId } { 1703: set filename [file join $classpath records "set$setId.db"] 1704: if { ! [file readable $filename] } { 1705: CTputs $num "FILE: $filename does not exist!\n" 1706: return 1707: } 1708: 1709: displayStatus "Analyzing [file tail $filename]" both $num 1710: set maxLine [lindex [exec wc $filename] 0] 1711: set fileId [open "$filename" "r"] 1712: set valid_cnt 0 1713: set line_cnt 0 1714: set aline [gets $fileId] 1715: while {![eof $fileId]} { 1716: incr line_cnt 1717: if { ($line_cnt%20) == 0 } { 1718: updateStatusBar [expr $line_cnt/double($maxLine)] $num 1719: } 1720: if { $line_cnt == 2 } { 1721: set aline [string trim $aline] 1722: set weights [split $aline {}] 1723: set valid_weights 0 1724: foreach weight $weights { incr valid_weights $weight } 1725: for { set i 0 } { $i <= $valid_weights } { incr i } { 1726: set total_score($i) 0 1727: } 1728: } elseif { $line_cnt > 3} { 1729: set aline [string trim $aline] 1730: set prefix [lindex [split $aline ","] 0] 1731: set s_num [string toupper [lindex [split $aline " " ] 0 ] ] 1732: set ans_str [lindex [split $prefix " "] 1] 1733: set ans_char [split $ans_str {} ] 1734: set valid 0 1735: for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } { 1736: if { [lindex $ans_char $ii] != "-"} { set valid 1 } 1737: } 1738: if { $valid } { 1739: incr valid_cnt 1740: set score 0 1741: for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } { 1742: if { [lindex $ans_char $ii] == "Y" || \ 1743: [lindex $ans_char $ii] == "y" } { 1744: incr score [lindex $weights $ii] 1745: } 1746: if { [lindex $ans_char $ii] >= 0 && \ 1747: [lindex $ans_char $ii] <= 9 } { 1748: incr score [lindex $ans_char $ii] 1749: } 1750: } 1751: if { [catch {incr total_score($score)} ] } { 1752: puts "$aline:$prefix:$s_num:$ans_str:$ans_char" 1753: } 1754: 1755: } 1756: } 1757: set aline [gets $fileId] 1758: } 1759: close $fileId 1760: removeStatus $num 1761: displayStatus "Pondering data . . ." spinner $num 1762: CTputs $num " There are $valid_cnt entries in file $filename\n" 1763: CTputs $num "Score #acheived\n" 1764: set scorelist "" 1765: foreach score [lsort -integer [array names total_score]] { 1766: CTputs $num [format "%5d:%6d\n" $score $total_score($score)] 1767: lappend scorelist [list $total_score($score) $score] 1768: } 1769: removeStatus $num 1770: return $scorelist 1771: } 1772: 1773: ########################################################### 1774: # CTgetStudentScores 1775: ########################################################### 1776: ########################################################### 1777: ########################################################### 1778: proc CTgetStudentScores { studentScoresVar classpath setId num } { 1779: upvar $studentScoresVar studentScores 1780: 1781: set filename [file join $classpath records "set$setId.db"] 1782: if { ! [file readable $filename] } { 1783: CTputs $num "FILE: $filename does not exist!\n" 1784: error 1785: } 1786: 1787: displayStatus "Analyzing [file tail $filename]" both $num 1788: set maxLine [lindex [exec wc $filename] 0] 1789: set fileId [open "$filename" "r"] 1790: set valid_cnt 0 1791: set line_cnt 0 1792: set aline [gets $fileId] 1793: set aline [gets $fileId] 1794: set weights [split [string trim $aline] {}] 1795: set valid_weights 0 1796: foreach weight $weights { incr valid_weights $weight } 1797: set aline [gets $fileId] 1798: set aline [gets $fileId] 1799: while {![eof $fileId]} { 1800: incr line_cnt 1801: if { ($line_cnt%20) == 0 } { 1802: updateStatusBar [expr $line_cnt/double($maxLine)] $num 1803: } 1804: set aline [string trim $aline] 1805: set prefix [lindex [split $aline ","] 0] 1806: set s_num [string toupper [lindex [split $aline " " ] 0 ] ] 1807: set ans_str [lindex [split $prefix " "] 1] 1808: set ans_char [split $ans_str {} ] 1809: set valid 0 1810: for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } { 1811: if { [lindex $ans_char $ii] != "-"} { set valid 1 } 1812: } 1813: if { $valid } { 1814: incr valid_cnt 1815: if {[array names studentScores $s_num] == ""} {set studentScores($s_num) 0} 1816: for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } { 1817: if { [lindex $ans_char $ii] == "Y" || [lindex $ans_char $ii] == "y" } { 1818: incr studentScores($s_num) [lindex $weights $ii] 1819: } 1820: if { [lindex $ans_char $ii] >= 0 && [lindex $ans_char $ii] <= 9 } { 1821: incr studentScores($s_num) [lindex $ans_char $ii] 1822: } 1823: } 1824: } 1825: set aline [gets $fileId] 1826: } 1827: close $fileId 1828: removeStatus $num 1829: return $valid_weights 1830: } 1831: 1832: ########################################################### 1833: # CTgradeDistributionRange 1834: ########################################################### 1835: ########################################################### 1836: ########################################################### 1837: proc CTgradeDistributionRange { num classpath setIdstart setIdend } { 1838: set totalpoints 0 1839: for {set setId $setIdstart} {$setId <= $setIdend} {incr setId} { 1840: set points [CTgetStudentScores studentScores $classpath $setId $num] 1841: incr totalpoints $points 1842: # parray studentScores 1843: } 1844: 1845: displayStatus "Pondering data . . ." spinner $num 1846: for { set i 0 } { $i <= $totalpoints } { incr i } { 1847: set total_score($i) 0 1848: } 1849: foreach sNum [array names studentScores] { incr total_score($studentScores($sNum)) } 1850: CTputs $num "Scores #acheived\n" 1851: set scorelist "" 1852: foreach score [lsort -integer [array names total_score]] { 1853: CTputs $num [format "%5d:%6d\n" $score $total_score($score)] 1854: lappend scorelist [list $total_score($score) $score] 1855: } 1856: removeStatus $num 1857: return $scorelist 1858: } 1859: 1860: #common Input dialogs 1861: 1862: #common output methods 1863: proc CTdatestamp { cmdnum } { 1864: CTputs $cmdnum [clock format [clock seconds]]\n 1865: } 1866: 1867: ########################################################### 1868: # CTputs 1869: ########################################################### 1870: ########################################################### 1871: ########################################################### 1872: proc CTputs { num message {tag normal} } { 1873: global gCT 1874: 1875: lappend gCT(output.$num) [list $message $tag] 1876: } 1877: 1878: ########################################################### 1879: # CToutputWrap 1880: ########################################################### 1881: ########################################################### 1882: ########################################################### 1883: proc CToutputWrap { num } { 1884: global gCT 1885: if { $gCT($num.wrap) } { 1886: $gCT($num.output) configure -wrap char 1887: } else { 1888: $gCT($num.output) configure -wrap none 1889: } 1890: } 1891: 1892: ########################################################### 1893: # CToutput 1894: ########################################################### 1895: ########################################################### 1896: ########################################################### 1897: proc CToutput { num cmdnum } { 1898: global gCT 1899: 1900: if { ![winfo exists $gCT($num).output] } { 1901: set outputWin [toplevel $gCT($num).output] 1902: 1903: set buttonFrame [frame $outputWin.button] 1904: set textFrame [frame $outputWin.text] 1905: set bottomFrame [frame $outputWin.bottom] 1906: pack $buttonFrame $textFrame $bottomFrame 1907: pack configure $buttonFrame -anchor e -expand 0 -fill x 1908: pack configure $textFrame -expand 1 -fill both 1909: pack configure $bottomFrame -expand 0 -fill x 1910: 1911: set gCT($num.output) [text $textFrame.text \ 1912: -yscrollcommand "$textFrame.scroll set" \ 1913: -xscrollcommand "$bottomFrame.scroll set"] 1914: scrollbar $textFrame.scroll -command "$textFrame.text yview" 1915: pack $gCT($num.output) $textFrame.scroll -side left 1916: pack configure $textFrame.text -expand 1 -fill both 1917: pack configure $textFrame.scroll -expand 0 -fill y 1918: 1919: scrollbar $bottomFrame.scroll -command "$textFrame.text xview" -orient h 1920: pack $bottomFrame.scroll -expand 0 -fill x 1921: 1922: set gCT($num.wrap) 1 1923: checkbutton $buttonFrame.wrap -text "Wrap" -command "CToutputWrap $num" \ 1924: -variable gCT($num.wrap) 1925: button $buttonFrame.save -text "Save Text" -command "CTsaveText $num" 1926: button $buttonFrame.print -text "Print Text" -command "CTprintText $num" 1927: button $buttonFrame.dismiss -text "Dismiss" -command "destroy $outputWin" 1928: pack $buttonFrame.wrap $buttonFrame.save $buttonFrame.print \ 1929: $buttonFrame.dismiss -side left 1930: } 1931: set index [$gCT($num.output) index end] 1932: foreach line $gCT(output.$cmdnum) { 1933: eval $gCT($num.output) insert end $line 1934: } 1935: unset gCT(output.$cmdnum) 1936: raise $gCT($num).output 1937: $gCT($num.output) see $index 1938: update idletasks 1939: } 1940: 1941: ########################################################### 1942: # CTsaveText 1943: ########################################################### 1944: # saves the contents of a text window 1945: ########################################################### 1946: # Arguments: num (the unique number of the path, and window) 1947: # Returns : nothing 1948: # Globals : 1949: ########################################################### 1950: proc CTsaveText { num } { 1951: global gFile gCT 1952: 1953: set window $gCT($num.output) 1954: if {![winfo exists $window]} { return } 1955: set dir $gFile($num) 1956: set file "" 1957: 1958: if { $dir == "" || $dir == "."} { set dir [pwd] } 1959: set file [tk_getSaveFile -title "Enter the name to Save As" \ 1960: -initialdir "$dir" ] 1961: if { $file == "" } { 1962: displayError "File not saved" 1963: return 1964: } 1965: set fileId [open $file w] 1966: puts -nonewline $fileId [$window get 0.0 end-1c] 1967: close $fileId 1968: } 1969: 1970: ########################################################### 1971: # CTprintText 1972: ########################################################### 1973: # prints the contents of the text window, creates a temp file named 1974: # quiztemp.txt 1975: ########################################################### 1976: # Arguments: num (the unique number of the path, and window) 1977: # Returns : nothing 1978: # Globals : gFile gCT 1979: ########################################################### 1980: proc CTprintText { num } { 1981: global gFile gCT 1982: 1983: set window $gCT($num.output) 1984: if { ![winfo exists $window]} { return } 1985: catch {parseCapaConfig $num $gFile($num)} 1986: set lprCommand [getLprCommand [file join $gFile($num) managertemp.txt] $num] 1987: if {$lprCommand == "Cancel"} { return } 1988: 1989: set fileId [open [file join $gFile($num) managertemp.txt] w] 1990: puts -nonewline $fileId [$window get 0.0 end-1c] 1991: close $fileId 1992: 1993: set errorMsg "" 1994: if { [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]} { 1995: displayError "An error occurred while printing: $errorMsg" 1996: } else { 1997: displayMessage "Print job sent to the printer.\n $output" 1998: } 1999: exec rm -f [file join $gFile($num) mangertemp.txt] 2000: } 2001: 2002: ########################################################### 2003: # CTprintCanvas 2004: ########################################################### 2005: ########################################################### 2006: ########################################################### 2007: proc CTprintCanvas { num window path } { 2008: 2009: if { ![winfo exists $window]} { return } 2010: catch {parseCapaConfig $num $gFile($num)} 2011: set lprCommand [getLprCommand [file join $path managertemp.txt] $num] 2012: if {$lprCommand == "Cancel"} { return } 2013: 2014: set rotate 0 2015: 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 } 2016: $window postscript -file [file join $path managertemp.txt] -rotate $rotate 2017: 2018: set errorMsg "" 2019: if { [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]} { 2020: displayError "An error occurred while printing: $errorMsg" 2021: } else { 2022: displayMessage "Print job sent to the printer.\n $output" 2023: } 2024: exec rm -f [file join $path mangertemp.txt] 2025: } 2026: 2027: ########################################################### 2028: # CTsaveCanvas 2029: ########################################################### 2030: ########################################################### 2031: ########################################################### 2032: proc CTsaveCanvas { window path } { 2033: if { ![winfo exists $window] } { return } 2034: set dir $path 2035: set file "" 2036: 2037: if { $dir == "" } { set dir [pwd] } 2038: set file [tk_getSaveFile -title "Enter the name to Save As" \ 2039: -initialdir "$dir" ] 2040: if { $file == "" } { 2041: displayError "File not saved" 2042: return 2043: } 2044: $window postscript -file $file 2045: } 2046: 2047: ########################################################### 2048: # CTbargraph 2049: ########################################################### 2050: ########################################################### 2051: ########################################################### 2052: proc CTbargraph {window num barnum data {path ""} {title "" } {xlabel ""} {ylabel ""} 2053: {suffix ""} } { 2054: global gBarGraph 2055: set height 300 2056: set width 500 2057: 2058: global gWindowMenu 2059: 2060: set bargraph [toplevel $window.bargraph$barnum] 2061: if { $title != "" } { wm title $bargraph $title } 2062: $gWindowMenu add command -label "$title $barnum" -command "capaRaise $bargraph" 2063: 2064: set buttonFrame [frame $bargraph.buttons] 2065: set canvasFrame [frame $bargraph.canvas] 2066: pack $buttonFrame $canvasFrame -side top 2067: pack configure $canvasFrame -expand 1 -fill both 2068: 2069: set canvas [canvas $canvasFrame.canvas -height $height -width $width -background white] 2070: pack $canvas -expand 1 -fill both 2071: bind $canvas <Configure> "CTdrawBargraph $barnum" 2072: 2073: button $buttonFrame.change -text "Change Graph" -command "CTchangeBargraph $window $barnum" 2074: button $buttonFrame.save -text "Save Graph" -command "CTsaveCanvas $canvas $path" 2075: button $buttonFrame.print -text "Print Graph" -command "CTprintCanvas $num $canvas $path" 2076: button $buttonFrame.dismiss -text "Dismiss" -command "CTdestroyBargraph $barnum" 2077: pack $buttonFrame.change $buttonFrame.save $buttonFrame.print \ 2078: $buttonFrame.dismiss -side left 2079: bind $bargraph <Destroy> "CTdestroyBargraph $barnum" 2080: 2081: set gBarGraph($barnum.num) $num 2082: set gBarGraph($barnum.suffix) $suffix 2083: set gBarGraph($barnum) $data 2084: set gBarGraph($barnum.canvas) $canvas 2085: set gBarGraph($barnum.title) $title 2086: set gBarGraph($barnum.xlabel) $xlabel 2087: set gBarGraph($barnum.ylabel) $ylabel 2088: set gBarGraph($barnum.color) green 2089: set gBarGraph($barnum.bucketscores) 0 2090: CTautoscaleBargraph $barnum 2091: CTdrawBargraph $barnum 2092: } 2093: 2094: ########################################################### 2095: # CTautoscaleBargraph 2096: ########################################################### 2097: ########################################################### 2098: ########################################################### 2099: proc CTautoscaleBargraph { barnum } { 2100: global gBarGraph 2101: set data $gBarGraph($barnum) 2102: set max [lindex [lindex [lsort -decreasing -index 0 -real $data] 0] 0] 2103: if { $max > int($max) } { set max [expr int($max+1)] } 2104: set gBarGraph($barnum.yoften) [expr int([format "%1.e" [expr $max/10.0]])] 2105: if { $gBarGraph($barnum.yoften) == 0 } { set gBarGraph($barnum.yoften) 1 } 2106: set total [llength $data] 2107: set gBarGraph($barnum.xoften) [expr ($total/25) + 1] 2108: } 2109: 2110: ########################################################### 2111: # CTchangeBargraphData 2112: ########################################################### 2113: ########################################################### 2114: ########################################################### 2115: proc CTchangeBargraphData { barnum data } { 2116: global gBarGraph 2117: set gBarGraph($barnum) $data 2118: CTautoscaleBargraph $barnum 2119: CTdrawBargraph $barnum 2120: } 2121: 2122: ########################################################### 2123: # CTdestroyBargraph 2124: ########################################################### 2125: ########################################################### 2126: ########################################################### 2127: proc CTdestroyBargraph { num } { 2128: global gBarGraph 2129: 2130: if { [catch {set window [winfo toplevel $gBarGraph($num.canvas)]}]} { return } 2131: set window2 [file rootname $window].changeBarGraph$num 2132: foreach name [array names gBarGraph "$num.*" ] { 2133: unset gBarGraph($name) 2134: } 2135: unset gBarGraph($num) 2136: destroy $window 2137: catch {destroy $window2} 2138: } 2139: 2140: ########################################################### 2141: # CTdrawBargraph 2142: ########################################################### 2143: ########################################################### 2144: ########################################################### 2145: proc CTdrawBargraph { num } { 2146: global gBarGraph 2147: 2148: set data $gBarGraph($num) 2149: set canvas $gBarGraph($num.canvas) 2150: set suffix $gBarGraph($num.suffix) 2151: 2152: set height [winfo height $canvas] 2153: set width [winfo width $canvas] 2154: set titleoffset 0 2155: set titleheight 15 2156: set labelheight 15 2157: set tickheight 15 2158: set textheight [expr $labelheight+$tickheight] 2159: set textwidth 40 2160: set graphheight [expr $height - $textheight - $titleheight] 2161: set graphwidth [expr $width - $textwidth] 2162: $canvas delete all 2163: 2164: #draw data 2165: set total [llength $data] 2166: set eachwidth [expr $graphwidth/$total] 2167: # set howoften [expr ($total/$gBarGraph($num.numlabels)) + 1] 2168: set howoften $gBarGraph($num.xoften) 2169: set when [expr ($total-1)%$howoften] 2170: set max 0 2171: set i 0 2172: set value 0 2173: if { $gBarGraph($num.bucketscores) } { 2174: foreach datum $data { 2175: set value [expr {$value + [lindex $datum 0]}] 2176: if { $i % $howoften == $when } { 2177: if { $value > $max } { set max $value } 2178: set value 0 2179: } 2180: incr i 2181: } 2182: } else { 2183: set max [lindex [lindex [lsort -decreasing -index 0 -real $data] 0] 0] 2184: } 2185: if { $max > int($max) } { set max [expr int($max+1)] } 2186: if { [catch {set pixelvalue [expr ($graphheight-1)/double($max)]} ] } { 2187: set pixelvalue 10 2188: } 2189: set i 0 2190: set value 0 2191: foreach datum $data { 2192: set value [expr {$value + [lindex $datum 0]}] 2193: set which [lindex $datum 1] 2194: set y1 [expr {$graphheight + $titleheight}] 2195: set x2 [expr {$eachwidth * ($i+1) + $textwidth}] 2196: set y2 [expr {($graphheight-1) + $titleheight - $value * $pixelvalue}] 2197: set tag bar.$which.[expr $which-$howoften] 2198: if { [set color [lindex $datum 3]] == "" } {set color $gBarGraph($num.color)} 2199: if { $gBarGraph($num.bucketscores) && ($i % $howoften == $when) } { 2200: if { $i == $when } { 2201: puts "$value-$which-$howoften" 2202: $canvas create rectangle $textwidth \ 2203: $y1 $x2 $y2 -fill $color -tag $tag 2204: } else { 2205: puts "$value:$which:$howoften" 2206: $canvas create rectangle [expr {$eachwidth*($i-$howoften+1)+$textwidth}]\ 2207: $y1 $x2 $y2 -fill $color -tag $tag 2208: } 2209: } elseif { !$gBarGraph($num.bucketscores) } { 2210: $canvas create rectangle [expr {$eachwidth * $i + $textwidth}] \ 2211: $y1 $x2 $y2 -fill $color -tag bar.$which.[expr $which-1] 2212: set value 0 2213: } 2214: if { $i % $howoften == $when } { 2215: $canvas create text [expr {$eachwidth * $i + $textwidth + $eachwidth/2}] \ 2216: [expr $graphheight+(($tickheight)/2)+$titleheight] -text $which 2217: set value 0 2218: } 2219: incr i 2220: } 2221: 2222: #draw title 2223: $canvas create text [expr $textwidth+$titleoffset+($graphwidth/2)] 1 -anchor n\ 2224: -text $gBarGraph($num.title) 2225: #draw axis 2226: $canvas create line $textwidth [expr {$graphheight + $titleheight}] \ 2227: $textwidth [expr {$titleheight + 1}] 2228: #label xaxis 2229: $canvas create text [expr ($textwidth+($graphwidth/2))] \ 2230: [expr $titleheight+$graphheight+$tickheight+($labelheight/2)] \ 2231: -text $gBarGraph($num.xlabel) 2232: #label yaxis 2233: $canvas create text 1 1 -anchor nw -text $gBarGraph($num.ylabel) 2234: #draw tickmarks 2235: # set delta [format "%1.e" [expr ($max)/double($gBarGraph($num.numticks))]] 2236: set delta $gBarGraph($num.yoften) 2237: set start 0.0 2238: while { $start < $max } { 2239: set center [expr {($graphheight-1)*(($start)/$max)+$titleheight+1}] 2240: $canvas create line $textwidth $center [expr $textwidth - 20] $center 2241: $canvas create text [expr $textwidth-3] $center -anchor ne -text [expr int($max-$start)] 2242: set start [expr $start + $delta] 2243: } 2244: if { [llength [lindex $data 0]] > 2} { 2245: $canvas bind current <1> "CTbargraphClick$suffix $num" 2246: bind $canvas <Enter> "CTbargraphDisplayCreate $num" 2247: bind $canvas <Leave> "CTbargraphDisplayRemove $num" 2248: bind $canvas <Motion> "CTbargraphDisplayMove $num" 2249: $canvas bind all <Enter> "CTbargraphDisplay$suffix $num" 2250: } 2251: } 2252: 2253: ########################################################### 2254: # CTbargraphDisplayCreate 2255: ########################################################### 2256: ########################################################### 2257: ########################################################### 2258: proc CTbargraphDisplayCreate { barnum } { 2259: global gBarGraph gCT gFile 2260: set canvas $gBarGraph($barnum.canvas) 2261: if {[winfo exists $canvas.bubble$barnum]} { return } 2262: set bubble [toplevel $canvas.bubble$barnum] 2263: wm overrideredirect $bubble 1 2264: wm positionfrom $bubble program 2265: wm withdraw $bubble 2266: pack [label $bubble.l -highlightthickness 0 -relief raised -bd 1 -background yellow] 2267: } 2268: ########################################################### 2269: # CTbargraphDisplayRemove 2270: ########################################################### 2271: ########################################################### 2272: ########################################################### 2273: proc CTbargraphDisplayRemove { barnum } { 2274: global gBarGraph gCT gFile 2275: set canvas $gBarGraph($barnum.canvas) 2276: catch {destroy $canvas.bubble$barnum} 2277: } 2278: ########################################################### 2279: # CTbargraphDisplayBlank 2280: ########################################################### 2281: ########################################################### 2282: ########################################################### 2283: proc CTbargraphDisplayBlank { barnum } { 2284: global gBarGraph gCT gFile 2285: set canvas $gBarGraph($barnum.canvas) 2286: catch {$canvas.bubble$barnum.l configure -text ""} 2287: } 2288: ########################################################### 2289: # CTbargraphDisplayMove 2290: ########################################################### 2291: ########################################################### 2292: ########################################################### 2293: proc CTbargraphDisplayMove { barnum } { 2294: global gBarGraph gCT gFile 2295: set canvas $gBarGraph($barnum.canvas) 2296: catch {wm geometry $canvas.bubble$barnum +[expr 20+[winfo pointerx .]]+[expr 20+[winfo pointery .]]} 2297: if {[$canvas gettags current] == ""} {CTbargraphDisplayRemove $barnum} 2298: } 2299: ########################################################### 2300: # CTbargraphDisplayShowresponse 2301: ########################################################### 2302: ########################################################### 2303: ########################################################### 2304: proc CTbargraphDisplayShowresponse { barnum } { 2305: global gBarGraph gCT gFile 2306: set num $gBarGraph($barnum.num) 2307: set canvas $gBarGraph($barnum.canvas) 2308: 2309: set high [lindex [split [lindex [$canvas gettags current] 0] .] 1] 2310: foreach datum $gBarGraph($barnum) { 2311: set bar [lindex $datum 1] 2312: if { $bar != $high } { continue } 2313: if {![winfo exists $canvas.bubble$barnum.l]} {CTbargraphDisplayCreate $barnum} 2314: $canvas.bubble$barnum.l configure -text "[lindex $datum 0] - \"[splitline [lindex $datum 2] 35]\"" 2315: wm geometry $canvas.bubble$barnum +[expr 20+[winfo pointerx .]]+[expr 20+[winfo pointery .]] 2316: wm deiconify $canvas.bubble$barnum 2317: return 2318: } 2319: CTbargraphDisplayRemove $barnum 2320: } 2321: ########################################################### 2322: # CTbargraphDisplaySCP 2323: ########################################################### 2324: ########################################################### 2325: ########################################################### 2326: proc CTbargraphDisplaySCP { barnum } { 2327: global gBarGraph gCT gFile 2328: set num $gBarGraph($barnum.num) 2329: set canvas $gBarGraph($barnum.canvas) 2330: 2331: set high [lindex [split [lindex [$canvas gettags current] 0] .] 1] 2332: foreach datum $gBarGraph($barnum) { 2333: set bar [lindex $datum 1] 2334: if { $bar != $high } { continue } 2335: if {![winfo exists $canvas.bubble$barnum.l]} {CTbargraphDisplayCreate $barnum} 2336: $canvas.bubble$barnum.l configure -text "[lindex $datum 0]" 2337: wm geometry $canvas.bubble$barnum +[expr 20+[winfo pointerx .]]+[expr 20+[winfo pointery .]] 2338: wm deiconify $canvas.bubble$barnum 2339: return 2340: } 2341: CTbargraphDisplayRemove $barnum 2342: } 2343: 2344: ########################################################### 2345: # CTbargraphClickSCP 2346: ########################################################### 2347: ########################################################### 2348: ########################################################### 2349: proc CTbargraphClickSCP { barnum } { 2350: global gBarGraph gCT gFile 2351: 2352: set num $gBarGraph($barnum.num) 2353: set canvas $gBarGraph($barnum.canvas) 2354: set bucket $gBarGraph($barnum.bucketscores) 2355: 2356: set high [lindex [split [lindex [$canvas gettags current] 0] .] 1] 2357: set low [lindex [split [lindex [$canvas gettags current] 0] .] 2] 2358: set stunums "" 2359: if { $high == "" || $low == "" } { return } 2360: foreach datum $gBarGraph($barnum) { 2361: set bar [lindex $datum 1] 2362: if { $bar > $high || $bar <= $low } { continue } 2363: set stunums [concat $stunums [lindex $datum 2]] 2364: } 2365: if { $stunums == "" } { return } 2366: if {"" == [set stuSCP [multipleChoice $gCT($num) "Select a student" $stunums 0]]} { 2367: return 2368: } 2369: set loginAnalysis [expr {"Yes" == [makeSure "Do you wish to do a Login Analysis? It may take a while." ]}] 2370: foreach s_id $stuSCP { 2371: CTstudentCourseProfile $num $s_id \ 2372: [findByStudentNumber $s_id $gFile($num)] $loginAnalysis 2373: } 2374: } 2375: 2376: ########################################################### 2377: # CTbargraphClickShowresponse 2378: ########################################################### 2379: ########################################################### 2380: ########################################################### 2381: proc CTbargraphClickShowresponse { barnum } { 2382: global gBarGraph gCT gFile gUniqueNumber 2383: 2384: set num $gBarGraph($barnum.num) 2385: set canvas $gBarGraph($barnum.canvas) 2386: set bucket $gBarGraph($barnum.bucketscores) 2387: 2388: if { [catch {set datanum $gBarGraph($barnum.shownum1)}] } { 2389: set datanum [set gBarGraph($barnum.shownum1) [incr gUniqueNumber]] 2390: set winnum [set gBarGraph($barnum.shownum2) [incr gUniqueNumber]] 2391: } else { 2392: set winnum $gBarGraph($barnum.shownum2) 2393: } 2394: set gCT($winnum) "" 2395: set high [lindex [split [lindex [$canvas gettags current] 0] .] 1] 2396: foreach datum $gBarGraph($barnum) { 2397: set bar [lindex $datum 1] 2398: if { $bar != $high } { continue } 2399: CTputs $datanum "[lindex $datum 0] responses \"[lindex $datum 2]\"\n" 2400: } 2401: CToutput $winnum $datanum 2402: } 2403: 2404: ########################################################### 2405: # CTchangeBargraph 2406: ########################################################### 2407: ########################################################### 2408: ########################################################### 2409: proc CTchangeBargraph { window num } { 2410: global gBarGraph 2411: 2412: set change [toplevel $window.changeBarGraph$num] 2413: 2414: set infoFrame [frame $change.info] 2415: set buttonFrame [frame $change.button] 2416: set title [frame $change.title] 2417: set xlabel [frame $change.xlabel] 2418: set ylabel [frame $change.ylabel] 2419: set xoften [frame $change.xoften] 2420: set yoften [frame $change.yoften] 2421: set color [frame $change.color] 2422: set bucket [frame $change.bucket] 2423: set font [frame $change.font] 2424: pack $infoFrame $buttonFrame $title $xlabel $ylabel $xoften $yoften $color $bucket 2425: pack configure $title $xlabel $ylabel $xoften $yoften -anchor e -expand 1 -fill both 2426: button $buttonFrame.update -text Update -command "CTdrawBargraph $num" 2427: bind $change <Return> "CTdrawBargraph $num" 2428: button $buttonFrame.dismiss -text Dismiss -command "destroy $change" 2429: pack $buttonFrame.update $buttonFrame.dismiss -side left 2430: 2431: foreach {frame label var 2432: } "$title { Title} title 2433: $xlabel { X-Axis Label} xlabel 2434: $ylabel { Y-Axis Label} ylabel 2435: $xoften {Increment on X-Axis} xoften 2436: $yoften {Increment on Y-Axis} yoften" { 2437: label $frame.label -text $label 2438: set entryFrame [frame $frame.entry] 2439: pack $frame.label $entryFrame -side left 2440: pack configure $entryFrame -expand 1 -fill both 2441: entry $entryFrame.entry -textvariable gBarGraph($num.$var) \ 2442: -xscrollcommand "$entryFrame.scroll set" 2443: scrollbar $entryFrame.scroll -orient h -command \ 2444: "$entryFrame.entry xview" 2445: pack $entryFrame.entry $entryFrame.scroll -fill x 2446: } 2447: 2448: label $color.label -text "Color of Bars" 2449: label $color.color -relief ridge -background $gBarGraph($num.color) \ 2450: -text " " 2451: button $color.change -text "Change" -command "CTchangeBargraphColor $color $num" 2452: pack $color.label $color.color $color.change -side left 2453: 2454: checkbutton $bucket.bucket -text "Bucket Scores" -variable \ 2455: gBarGraph($num.bucketscores) -command "CTdrawBargraph $num" 2456: pack $bucket.bucket 2457: } 2458: 2459: ########################################################### 2460: # CTchangeBargraphColor 2461: ########################################################### 2462: ########################################################### 2463: ########################################################### 2464: proc CTchangeBargraphColor { color num } { 2465: global gBarGraph 2466: set temp [tk_chooseColor -initialcolor $gBarGraph($num.color)] 2467: if { $temp != "" } { 2468: $color.color configure -background [set gBarGraph($num.color) $temp] 2469: } 2470: CTdrawBargraph $num 2471: } 2472: 2473: ########################################################### 2474: # CTdisplayStudent 2475: ########################################################### 2476: ########################################################### 2477: ########################################################### 2478: proc CTdisplayStudent { num window path id } { 2479: 2480: if { ![file exists [file join $path photo gif $id.gif]] } { 2481: if { [file exists [file join $path photo jpg $id.jpg]] } { 2482: exec /usr/local/bin/djpeg -outfile [file join $path photo gif $id.gif] \ 2483: [file join $path photo jpg $id.jpg] 2484: } else { 2485: return 2486: } 2487: } 2488: set image [image create photo] 2489: $image read [file join $path photo gif $id.gif] 2490: 2491: set imageWin [toplevel $window.image$num] 2492: 2493: set buttonFrame [frame $imageWin.button] 2494: set infoFrame [frame $imageWin.info] 2495: set imageFrame [frame $imageWin.image] 2496: pack $buttonFrame $infoFrame $imageFrame 2497: 2498: button $buttonFrame.dismiss -command "destroy $imageWin" -text Dismiss 2499: pack $buttonFrame.dismiss 2500: 2501: label $infoFrame.label -text $id 2502: pack $infoFrame.label 2503: 2504: set canvas [canvas $imageFrame.canvas] 2505: pack $canvas 2506: $canvas create image 1 1 -image $image -anchor nw 2507: } 2508: 2509: ########################################################### 2510: # CTgetWhen 2511: ########################################################### 2512: ########################################################### 2513: ########################################################### 2514: proc CTgetWhen { num } { 2515: set day [getString . "Enter a date"] 2516: update 2517: return $day 2518: } 2519: 2520: ########################################################### 2521: # CTscanDB 2522: ########################################################### 2523: ########################################################### 2524: ########################################################### 2525: proc CTscanDB { num file outId startdate enddate } { 2526: global answerArray exist 2527: set fileId [open $file r] 2528: set Yes_cnt 0 2529: set No_cnt 0 2530: set line_cnt 0 2531: set prob_cnt 0 2532: set maxLine [lindex [exec wc $file] 0] 2533: puts $maxLine 2534: set aline [gets $fileId] 2535: while { ! [eof $fileId] } { 2536: incr line_cnt 2537: if { ($line_cnt%20) == 0 } { 2538: puts $curdate 2539: updateStatusBar [expr $line_cnt/double($maxLine)] $num 2540: } 2541: set length [llength $aline] 2542: set date [lrange $aline 1 [expr $length - 2]] 2543: set curdate [clock scan $date] 2544: if { $curdate < $startdate } { set aline [gets $fileId]; continue } 2545: if { $curdate > $enddate } { break } 2546: set s_num [string toupper [lindex $aline 0]] 2547: set ans_char [split [lindex $aline end] ""] 2548: set usr_ans "$s_num.ans" 2549: set usr_try "$s_num.try" 2550: if {$prob_cnt == 0} { set prob_cnt [llength $ans_char] } 2551: if { [array names answerArray "$usr_ans.*"] == "" } { 2552: for {set ii 0} { $ii <= $prob_cnt } { incr ii} { 2553: set answerArray($usr_ans.$ii) "-" 2554: } 2555: } 2556: if { [array names answerArray "$usr_try.*"] == "" } { 2557: for {set ii 0} { $ii <= $prob_cnt } { incr ii} { 2558: set answerArray($usr_try.$ii) 0 2559: } 2560: } 2561: for {set ii 0} { $ii <= $prob_cnt } { incr ii} { 2562: if { [lindex $ans_char $ii] == "Y" } { 2563: set answerArray($usr_ans.$ii) "Y" 2564: incr answerArray($usr_try.$ii) 2565: } 2566: if { [lindex $ans_char $ii] == "N"} { 2567: if {$answerArray($usr_ans.$ii) != "Y"} { 2568: set answerArray($usr_ans.$ii) "Y" 2569: } 2570: incr answerArray($usr_try.$ii) 2571: } 2572: } 2573: if { [array names exist $s_num] == "" } { set exist($s_num) $s_num } 2574: set aline [gets $fileId] 2575: } 2576: close $fileId 2577: return $prob_cnt 2578: } 2579: 2580: ########################################################### 2581: # CTcreateSubset 2582: ########################################################### 2583: ########################################################### 2584: ########################################################### 2585: proc CTcreateSubset { num cmdnum day setId } { 2586: global gFile gCT answerArray exist 2587: 2588: set outId [open [file join $gFile($num) records "subset$setId.db"] w] 2589: set inId [open [file join $gFile($num) records "set$setId.db"] r] 2590: 2591: set startdate [clock scan "$day 12:00 AM"] 2592: set enddate [clock scan "$day 11:59 PM"] 2593: 2594: puts $startdate:$enddate 2595: set prob_cntt [CTscanDB $cmdnum [file join $gFile($num) records log$setId.db] $outId $startdate $enddate] 2596: puts $startdate:$enddate 2597: set prob_cntw [CTscanDB $cmdnum [file join $gFile($num) records weblog$setId.db] $outId $startdate $enddate] 2598: puts $startdate:$enddate 2599: puts "$day 12:00 AM : $day 11:59 PM" 2600: if { $prob_cntt > $prob_cntw } { 2601: set prob_cnt $prob_cntt 2602: } else { 2603: set prob_cnt $prob_cntw 2604: } 2605: 2606: puts $outId [gets $inId] 2607: puts $outId [gets $inId] 2608: puts $outId [gets $inId] 2609: foreach s_num [lsort [array names exist]] { 2610: set usr_ans $s_num.ans 2611: set usr_try $s_num.try 2612: puts -nonewline $outId "$s_num " 2613: for { set ii 0 } { $ii< $prob_cnt } { incr ii } { 2614: puts -nonewline $outId $answerArray($usr_ans.$ii) 2615: } 2616: for { set ii 0 } { $ii< $prob_cnt } { incr ii } { 2617: puts -nonewline $outId [format ",%2d" $answerArray($usr_try.$ii)] 2618: } 2619: puts $outId "" 2620: } 2621: close $outId 2622: close $inId 2623: catch {unset answerArray} 2624: catch {unset exist} 2625: } 2626: 2627: ########################################################### 2628: # CTdiscussForum 2629: ########################################################### 2630: ########################################################### 2631: ########################################################### 2632: proc CTdiscussForum { num file dir } { 2633: global gCT gFile 2634: 2635: set fileId [open $file r] 2636: set maxLine [lindex [exec wc $file] 0] 2637: set aline [gets $fileId] 2638: set last 0 2639: set line_cnt 0 2640: while {![eof $fileId]} { 2641: incr line_cnt 2642: if { ($line_cnt%20) == 0 } { updateStatusBar [expr $line_cnt/double($maxLine)] $num } 2643: foreach {stunum capaid name email action set prob date time} [split $aline "|"] {} 2644: if { $action == "ViewProblem" } { 2645: if { [catch {incr count($set,$prob)}]} { 2646: set count($set,$prob) 1 2647: if { $set > $last } { set last $set } 2648: if { [catch {set max($set)}]} { set max($set) 0 } 2649: if { $prob > $max($set)} { set max($set) $prob } 2650: if { [catch {set posts($set,$prob) [llength [glob $dir/discussion/$set/[format "%06d" $prob]-*-*-*.msg]]}]} { set posts($set,$prob) 0 } 2651: } 2652: set ever($name) 1 2653: set names($set,$name) 1 2654: set nameprob($set,$prob,$name) 1 2655: } 2656: set aline [gets $fileId] 2657: } 2658: 2659: updateStatusMessage "Generating Output" $num 2660: updateStatusBar 0 $num 2661: for {set i 1} { $i <= $last } { incr i } { 2662: updateStatusBar [expr $i/$last] $num 2663: #if { [catch {set max($i)}]} { break } 2664: set total($i) 0 2665: for {set j 1} { $j < $max($i) } { incr j } { 2666: set message "" 2667: if {[catch {set message "Set [format %2d $i] Problem [format %3d $j] [format %3d $posts($i,$j)] reponses, viewed [format %4d $count($i,$j)] times, "} ]} { continue } 2668: incr total($i) $count($i,$j) 2669: if { [catch { set ratio [expr $count($i,$j)/double($posts($i,$j))]} error]} { 2670: append message "ratio [format %5s [format %3.1f 0]]" 2671: } else { 2672: append message "ratio [format %5s [format %3.1f $ratio]]" 2673: } 2674: append message " from [format %3d [llength [array names nameprob $i,$j,*]]] viewers\n" 2675: CTputs $num $message 2676: } 2677: CTputs $num "Total views for set $i: $total($i)\n" 2678: } 2679: 2680: for {set i 1} { 1 } { incr i } { 2681: if { [catch {set max($i)}]} { break } 2682: CTputs $num "For set $i Num viewers:[llength [array names names $i,*]] causing $total($i) views.\n" 2683: } 2684: close $fileId 2685: CTputs $num "Total # of unique visitors [llength [array names ever]]\n" 2686: #IDEAS: stick into capastats 2687: # : howmany viws are repeats 2688: # : Student Course Profile, add #ViewProblems #Posts 2689: # : add some portion of these stats to analyze log files? 2690: }