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