Annotation of capa/capa51/GUITools/capastats.tcl, revision 1.1

1.1     ! albertel    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: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>