Annotation of capa/capa51/GUITools/capastats.tcl, revision 1.1.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>
![[BACK]](/icons/back.gif){kind=icon}
Return to capastats.tcl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / capa / capa51 / GUITools