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