capa/capa51/GUITools/capastats.tcl - view

File: [LON-CAPA] / capa / capa51 / GUITools / capastats.tcl
Revision 1.1: download - view: text, annotated - select for diffs
Tue Sep 28 21:25:37 1999 UTC (24 years, 9 months ago) by albertel
Branches: MAIN
CVS tags: HEAD

Initial revision

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