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