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