Annotation of capa/capa51/GUITools/capastats.tcl, revision 1.2
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
! 686: CTdiscussForum $cmdnum $file $gFile($num)
! 687: CToutput $num $cmdnum
! 688: removeStatus $cmdnum
! 689: unset gCT(cmd.$cmdnum)
! 690: }
! 691:
! 692: ###########################################################
1.1 albertel 693: # CTquit
694: ###########################################################
695: ###########################################################
696: ###########################################################
697: proc CTquit { num } {
698: global gCT
699: destroy $gCT($num)
700: }
701:
702: #menu command helpers
703: ###########################################################
704: # CTscanSetDB
705: ###########################################################
706: ###########################################################
707: ###########################################################
708: proc CTscanSetDB { num file Q_cntVar L_cntVar } {
709: global gMaxSet gTotal_try gYes_cnt gyes_cnt gStudent_cnt gStudent_try \
710: gTotal_weight gTotal_scores gEntry gScore gNewStudent_cnt
711: upvar $Q_cntVar Q_cnt
712: upvar $L_cntVar L_cnt
713:
714: set line_cnt 0
715: set valid_cnt 0
716:
717: for { set ii 0 } { $ii <= $gMaxSet } { incr ii } {
718: set gTotal_try($num.$ii) 0
719: set gYes_cnt($num.$ii) 0
720: set gyes_cnt($num.$ii) 0
721: for { set jj 0 } { $jj <= $gMaxSet } { incr jj } {
722: set gStudent_cnt($num.$ii.$jj) 0
723: set gStudent_try($num.$ii.$jj) 0
724: }
725: set gNewStudent_cnt($num.$ii) 0
726: }
727: set gTotal_weight($num) 0
728: set gTotal_scores($num) 0
729:
730: set maxLine [lindex [exec wc $file] 0]
731: set tries ""
732: set fileId [open $file "r"]
733: set aline [gets $fileId]
734: while { ! [eof $fileId] } {
735: incr line_cnt
736: if { ($line_cnt%20) == 0 } {
737: updateStatusBar [expr $line_cnt/double($maxLine)] $num
738: }
739: if { $line_cnt == 2 } {
740: set aline [string trim $aline]
741: set weight [split $aline {}]
742: }
743: if { $line_cnt > 3 } {
744: catch {
745: set aline [string trim $aline]
746: set prefix [lindex [split $aline ,] 0]
747: set s_num [lindex [split $aline " "] 0]
748: set ans_str [lindex [split $prefix " "] 1]
749: set ans_char [split $ans_str {} ]
750: set tries [lrange [split $aline ,] 1 end]
751: for { set valid 0; set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
752: if {([lindex $ans_char $ii] != "-")&&([lindex $ans_char $ii] != "E")
753: && ([lindex $ans_char $ii] != "e") } { set valid 1 }
754: }
755: if { $valid } {
756: for {set score 0; set ii 0} { $ii < [llength $tries] } { incr ii } {
757: set triesii 0
758: incr gTotal_weight($num) [lindex $weight $ii]
759: if { [lindex $ans_char $ii] == "Y" } {
760: set triesii [string trim [lindex $tries $ii]]
761: incr gYes_cnt($num.$ii)
762: incr score [lindex $weight $ii]
763: incr gNewStudent_cnt($num.$ii)
764: } elseif { [lindex $ans_char $ii] == "y" } {
765: set triesii [string trim [lindex $tries $ii]]
766: incr triesii
767: incr gyes_cnt($num.$ii)
768: incr score [lindex $weight $ii]
769: incr gNewStudent_cnt($num.$ii)
770: } elseif { ( [lindex $ans_char $ii] > 0 ) && \
771: ( [lindex $ans_char $ii] <= 9) } {
772: set triesii [string trim [lindex $tries $ii]]
773: incr score [lindex $ans_char $ii]
774: incr gYes_cnt($num.$ii)
775: incr gNewStudent_cnt($num.$ii)
776: } elseif { ( [lindex $ans_char $ii] == 0 ) } {
777: set triesii [string trim [lindex $tries $ii]]
778: incr gNewStudent_cnt($num.$ii)
779: } elseif {([lindex $ans_char $ii]=="n") || \
780: ([lindex $ans_char $ii]=="N")} {
781: set triesii [string trim [lindex $tries $ii]]
782: if { [lindex $ans_char $ii] == "n" } { incr triesii }
783: incr gNewStudent_cnt($num.$ii)
784: }
785: set gStudent_try($num.$valid_cnt.$ii) $triesii
786: incr gTotal_try($num.$ii) $triesii
787: incr gStudent_cnt($num.$ii.$triesii)
788: }
789: incr gTotal_scores($num) $score
790: set gEntry($num.$valid_cnt) "$aline"
791: set gScore($num.$valid_cnt) $score
792: incr valid_cnt
793: }
794: }
795: }
796: set aline [gets $fileId]
797: }
798: close $fileId
799: set Q_cnt [llength $tries]
800: set L_cnt $valid_cnt
801: return
802: }
803:
804: ###########################################################
805: # CTpercentageScores
806: ###########################################################
807: ###########################################################
808: ###########################################################
809: proc CTpercentageScores { num setId valid_cnt } {
810: global gTotal_weight gTotal_scores
811:
812: if { $gTotal_weight($num) > 0 } {
813: set ratio [expr double($gTotal_scores($num)) / double($gTotal_weight($num))]
814: set ratio [expr $ratio * 100.0 ]
815: CTputs $num "\nScore (total scores / total valid weights) for set$setId.db: [format %7.2f%% $ratio]\n"
816: }
817: CTputs $num "The number of valid records for set$setId.db is: $valid_cnt\n"
818: }
819:
820: ###########################################################
821: # CTaverage
822: ###########################################################
823: ###########################################################
824: ###########################################################
825: proc CTaverage { num q_cnt l_cnt faillistVar dodifflistVar numyesVar} {
826: upvar $faillistVar faillist $dodifflistVar dodifflist $numyesVar numyes
827: global gMaxTries gStudent_cnt gStudent_try gTotal_try gYes_cnt gyes_cnt \
828: gNewStudent_cnt
829:
830: set maxIter [expr $q_cnt * 4]
831:
832: for { set ii 0 } { $ii < $q_cnt } { incr ii } {
833: updateStatusBar [expr $ii/double($maxIter)] $num
834: set s_cnt($ii) 0
835: set avg($ii) 0.0
836: set max_try($ii) 0
837: for { set jj 1 } { $jj < $gMaxTries } { incr jj } {
838: if { $gStudent_cnt($num.$ii.$jj) > 0 } {
839: set avg($ii) [expr $avg($ii) + ($jj * $gStudent_cnt($num.$ii.$jj))]
840: incr s_cnt($ii) $gStudent_cnt($num.$ii.$jj)
841: }
842: }
843: set s_cnt($ii) $gNewStudent_cnt($num.$ii)
844: if { $s_cnt($ii) > 0 } { set avg($ii) [expr $avg($ii) / $s_cnt($ii)] }
845: }
846:
847: for { set ii 0 } { $ii < $q_cnt } { incr ii } {
848: updateStatusBar [expr ($ii+$q_cnt)/double($maxIter)] $num
849: set sd($ii) 0.0
850: set sum 0.0
851: for { set jj 0 } { $jj < $l_cnt } { incr jj } {
852: if { $gStudent_try($num.$jj.$ii) > $max_try($ii) } {
853: set max_try($ii) $gStudent_try($num.$jj.$ii)
854: }
855: if { $gStudent_try($num.$jj.$ii) > 0 } {
856: set sq [expr ( $gStudent_try($num.$jj.$ii) - $avg($ii) ) * \
857: ( $gStudent_try($num.$jj.$ii) - $avg($ii)) ]
858: set sum [expr $sum + $sq]
859: }
860: if { $s_cnt($ii) > 1 } {
861: set sd($ii) [expr $sum / ( $s_cnt($ii) - 1.0 )]
862: }
863: if { $sd($ii) > 0 } { set sd($ii) [ expr sqrt($sd($ii)) ] }
864: }
865: }
866:
867: for { set ii 0 } { $ii < $q_cnt } { incr ii } {
868: updateStatusBar [expr ($ii+(2*$q_cnt))/double($maxIter)] $num
869: set sd3($ii) 0.0
870: set sum 0.0
871: for { set jj 0 } { $jj < $l_cnt } { incr jj } {
872: if { $gStudent_try($num.$jj.$ii) > 0 } {
873: set tmp1 [expr $gStudent_try($num.$jj.$ii) - $avg($ii)]
874: set tmp2 [expr $tmp1 * $tmp1 * $tmp1]
875: set sum [expr $sum + $tmp2]
876: }
877: if { ( $s_cnt($ii) > 0 ) && ( $sd($ii) != 0.0 ) } {
878: set sd3($ii) [expr $sum / $s_cnt($ii) ]
879: set sd3($ii) [expr $sd3($ii) / ($sd($ii) * $sd($ii) * $sd($ii)) ]
880: }
881: }
882: }
883: CTputs $num "This is the statistics for each problem: \n"
884: CTputs $num "Prob\# MxTries avg. s.d. s.k. \#Stdnts"
885: CTputs $num " \#Yes \#yes Tries DoDiff %Wrong\n"
886: set numyes [set dodifflist [set faillist ""]]
887: # parray s_cnt
888: for { set ii 0 } { $ii < $q_cnt } { incr ii } {
889: updateStatusBar [expr ($ii+(3*$q_cnt))/double($maxIter)] $num
890: if { $gTotal_try($num.$ii) > 0 } {
891: set dod [expr $gTotal_try($num.$ii)/(0.1 + $gYes_cnt($num.$ii) \
892: + $gyes_cnt($num.$ii))]
893: } else {
894: set dod 0.0
895: }
896: if {[catch {set success [expr 100.0*($s_cnt($ii)-($gYes_cnt($num.$ii)+ \
897: $gyes_cnt($num.$ii)))/$s_cnt($ii)]}]} {
898: set success 0.0
899: set s_cnt($ii) 0
900: }
901: CTputs $num [format "P %2d" [expr int($ii + 1)] ]
902: CTputs $num [format "%6d %8.2f %7.2f %6.2f %5d %5d %5d %5d %5.1f %6.2f\n"\
903: $max_try($ii) $avg($ii) $sd($ii) $sd3($ii) $s_cnt($ii) \
904: $gYes_cnt($num.$ii) $gyes_cnt($num.$ii) \
905: $gTotal_try($num.$ii) $dod $success]
906: if { $success < 0 } { set success 0 }
907: lappend faillist [list $success [expr int($ii + 1)]]
908: lappend dodifflist [list $dod [expr int($ii + 1)]]
909: lappend numyes [list [expr $gYes_cnt($num.$ii)+$gyes_cnt($num.$ii)] \
910: [expr int($ii + 1)]]
911: }
912: }
913:
914: ###########################################################
915: # CTlogAnalysis2
916: ###########################################################
917: ###########################################################
918: ###########################################################
919: proc CTlogAnalysis2 { num cmdnum setId } {
920: global gFile
921: set logFile [file join $gFile($num) records "log$setId.db"]
922: if { [file exists $logFile] } {
923: CTputs $cmdnum "Log analysis for telnet session log$setId.db\n"
924: CTscanLogDB $cmdnum $logFile l(Y) l(N) l(S) l(U) l(u)
925: } else {
926: set l(Y) [set l(N) [set l(S) [set l(U) [set l(u) 0]]]]
927: }
928: set webLogFile [file join $gFile($num) records "weblog$setId.db" ]
929: if { [file exists $webLogFile] } {
930: CTputs $cmdnum "===============================================\n"
931: CTputs $cmdnum "Log analysis for web session weblog$setId.db\n"
932: CTscanLogDB $cmdnum $webLogFile w(Y) w(N) w(S) w(U) w(u)
933: } else {
934: set w(Y) [set w(N) [set w(S) [set w(U) [set w(u) 0]]]]
935: }
936: set telnet_total [expr $l(Y)+$l(N)+$l(S)+$l(U)+$l(u)]
937: set web_total [expr $w(Y)+$w(N)+$w(S)+$w(U)+$w(u)]
938: CTputs $cmdnum "============== SUMMARY ====================\n"
939: CTputs $cmdnum " #Y #N #S #U #u Total\n"
940: CTputs $cmdnum [format "telnet: %6d %6d %6d %6d %6d %6d\n" \
941: $l(Y) $l(N) $l(S) $l(U) $l(u) $telnet_total ]
942: CTputs $cmdnum [format " web: %6d %6d %6d %6d %6d %6d\n" \
943: $w(Y) $w(N) $w(S) $w(U) $w(u) $web_total]
944: foreach v { Y N S U u } {
945: set sum($v) [expr $l($v) + $w($v)]
946: if { $sum($v) > 0 } {
947: set ratio($v) [expr 100.0*$w($v)/double($sum($v))]
948: } else {
949: set ratio($v) 0.0
950: }
951: }
952: set overall_entries [expr $telnet_total + $web_total]
953: if { $overall_entries > 0 } {
954: set ratio(web) [expr 100.0*(double($web_total)/double($overall_entries))]
955: } else {
956: set ratio(web) 0.0
957: }
958: CTputs $cmdnum [format " %%web: % 6.1f % 6.1f % 6.1f % 6.1f % 6.1f % 6.1f\n" \
959: $ratio(Y) $ratio(N) $ratio(S) $ratio(U) $ratio(u) $ratio(web) ]
960: }
961:
962:
963: ###########################################################
964: # CTscanLogDB
965: ###########################################################
966: ###########################################################
967: ###########################################################
968: proc CTscanLogDB { num file Y_lVar N_lVar S_lVar U_lVar u_lVar } {
969: upvar $Y_lVar Y_l
970: upvar $N_lVar N_l
971: upvar $S_lVar S_l
972: upvar $U_lVar U_l
973: upvar $u_lVar u_l
974:
975: set line_cnt 0
976:
977: displayStatus "Analyzing [file tail $file]" both $num
978: set maxLine [lindex [exec wc $file] 0]
979: set fileId [open $file "r"]
980:
981: set aline [gets $fileId]
982: while { ! [eof $fileId] } {
983: incr line_cnt
984: if { ($line_cnt%20) == 0 } {
985: updateStatusBar [expr $line_cnt/double($maxLine)] $num
986: }
987: set aline [string trim $aline]
988: set ans_str [string range $aline 35 end]
989: set ans_char [split $ans_str {}]
990: if { ! [info exists count] } {
991: for { set i 0 } { $i < [llength $ans_char] } { incr i } {
992: set count(Y.$i) 0; set count(N.$i) 0; set count(S.$i) 0
993: set count(U.$i) 0; set count(u.$i) 0
994: }
995: set count(Y.total) 0; set count(N.total) 0; set count(S.total) 0
996: set count(U.total) 0; set count(u.total) 0
997: }
998: set i -1
999: foreach char $ans_char {
1000: incr i
1001: if { $char == "-" } { continue }
1002: if { [catch {incr count($char.$i)}] } {
1003: set count(Y.$i) 0; set count(N.$i) 0; set count(S.$i) 0
1004: set count(U.$i) 0; set count(u.$i) 0
1005: incr count($char.$i)
1006: }
1007: incr count($char.total)
1008: }
1009: set aline [gets $fileId]
1010: }
1011: close $fileId
1012: removeStatus $num
1013: CTputs $num "Prob #: #Y #N #S #U #u\n"
1014: for { set i 0 } { $i < [llength $ans_char] } { incr i } {
1015: CTputs $num [format " %2d: %6d %6d %6d %6d %6d\n" [expr $i + 1] \
1016: $count(Y.$i) $count(N.$i) $count(S.$i) $count(U.$i) $count(u.$i) ]
1017: }
1018: CTputs $num "===========================================\n"
1019: CTputs $num [format " Total: %6d %6d %6d %6d %6d\n" $count(Y.total) $count(N.total) \
1020: $count(S.total) $count(U.total) $count(u.total) ]
1021: set Y_l $count(Y.total)
1022: set N_l $count(N.total)
1023: set S_l $count(S.total)
1024: set U_l $count(U.total)
1025: set u_l $count(u.total)
1026: return
1027: }
1028:
1029: ###########################################################
1030: # CTcollectSetScores
1031: ###########################################################
1032: ###########################################################
1033: ###########################################################
1034: proc CTcollectSetScores { num path id on_screen limit } {
1035: set id [ string toupper $id ]
1036: set total_scores 0
1037: set total_weights 0
1038: set set_idx 0
1039: set done 0
1040: while { ! $done } {
1041: incr set_idx
1042: if { $set_idx > $limit } { set done 1; continue }
1043: updateStatusBar [expr $set_idx/double($limit)] $num
1044: set filename [file join $path records "set$set_idx.db"]
1045: if { ![file readable $filename ] } { continue }
1046: set fileId [open $filename "r"]
1047: set line_cnt 0
1048: set found 0
1049: set aline [ gets $fileId ]
1050: while { ! [eof $fileId] && ! $found } {
1051: incr line_cnt
1052: if { $line_cnt > 3 } {
1053: set aline [string trim $aline]
1054: set prefix [lindex [split $aline ","] 0]
1055: set s_num [string toupper [lindex [split $aline " "] 0] ]
1056: set ans_str [lindex [split $prefix " "] 1]
1057: if { $id == $s_num } {
1058: set ans_char [split $ans_str {} ]
1059: set valid 0
1060: foreach char $ans_char { if { $char != "-" } { set valid 1; break } }
1061: if { ! $valid } {
1062: set score "-"
1063: } else {
1064: set score 0
1065: for {set i 0} { $i < [llength $ans_char] } { incr i } {
1066: set char [lindex $ans_char $i]
1067: if { $char == "N" || $char == "n"} { set found 1 }
1068: if { $char == "Y" || $char == "y"} {
1069: incr score [lindex $weights $i];set found 1
1070: }
1071: if { $char >= 0 && $char <= 9 } {
1072: incr score $char;set found 1
1073: }
1074: if { $char == "E" } {
1075: incr valid_weights "-[lindex $weights $i]"
1076: }
1077: }
1078: incr total_scores $score
1079: }
1080: }
1081: } elseif { $line_cnt == 2 } {
1082: set aline [string trim $aline]
1083: set weights [split $aline {} ]
1084: set valid_weights 0
1085: foreach weight $weights { incr valid_weights $weight }
1086: } else {
1087: #do nothing for line 1 and 3
1088: }
1089: set aline [ gets $fileId ]
1090: }
1091: close $fileId
1092: incr total_weights $valid_weights
1093: set set_weights([expr $set_idx - 1]) $valid_weights
1094: if { $found } {
1095: set set_scores([expr $set_idx - 1]) $score
1096: } else {
1097: set set_scores([expr $set_idx - 1]) "-"
1098: }
1099: }
1100: set abscent_cnt 0
1101: set present_cnt 0
1102: set summary_str ""
1103: if { $on_screen } { CTputs $num " " }
1104: foreach i [lsort -integer [array names set_scores]] {
1105: if { $set_scores($i) == "-" || $set_scores($i) == "" } {
1106: if { $on_screen } { CTputs $num " - " }
1107: append summary_str "x/$set_weights($i) "
1108: incr abscent_cnt
1109: } else {
1110: if { $on_screen } { CTputs $num [format " %3d" $set_scores($i)] }
1111: append summary_str "$set_scores($i)/$set_weights($i) "
1112: incr present_cnt
1113: }
1114: }
1115: if { $on_screen } {
1116: CTputs $num "\n [file tail $path]:"
1117: foreach i [lsort -integer [array names set_scores]] { CTputs $num " ---" }
1118: CTputs $num "\n "
1119: if { [info exists set_weights] } {
1120: set num_set_weights [llength [array names set_weights]]
1121: } else {
1122: set num_set_weights 0
1123: }
1124: for {set i 0} {$i < $num_set_weights} {incr i} {
1125: if { [info exists set_weights($i)] } {
1126: CTputs $num [format " %3d" $set_weights($i)]
1127: } else {
1128: set num_set_weights $i
1129: }
1130: }
1131: CTputs $num "\n"
1132: if { $total_weights != 0 } {
1133: set ratio [expr 100.0 * $total_scores / double($total_weights) ]
1134: CTputs $num [format " %5d\n" $total_scores]
1135: if { [info exists set_scores] } {
1136: CTputs $num [format " ------- = %3.2f%%, scores absent in %d/%d\n" \
1137: $ratio $abscent_cnt [llength [array names set_scores]]]
1138: } else {
1139: CTputs $num [format " ------- = %3.2f%%, scores absent in %d/%d\n" \
1140: $ratio $abscent_cnt 0 ]
1141: }
1142: } else {
1143: set ratio "-"
1144: CTputs $num [format " %5d\n" $total_scores]
1145: if { [info exists set_scores] } {
1146: CTputs $num [format " ------- = %s%%, scores absent in %d/%d\n" \
1147: $ratio $abscent_cnt [llength [array names set_scores]]]
1148: } else {
1149: CTputs $num [format " ------- = %s%%, scores absent in %d/%d\n" \
1150: $ratio $abscent_cnt 0 ]
1151: }
1152: }
1153:
1154: CTputs $num [format " %5d\n" $total_weights]
1155: }
1156: return [list $total_scores $total_weights $abscent_cnt \
1157: [llength [array names set_scores] ] $summary_str]
1158: }
1159:
1160: ###########################################################
1161: # CTloginAnalysis
1162: ###########################################################
1163: ###########################################################
1164: ###########################################################
1165: proc CTloginAnalysis { num path id limit } {
1166:
1167: CTputs $num "Login analysis: telnet session web session\n\n"
1168: CTputs $num " set #: #Y #N #S #U #u #Y #N #S #U #u\n"
1169: set set_idx 0
1170: set done 0
1171: while { ! $done } {
1172: incr set_idx
1173: if { $set_idx > $limit } { set done 1; continue }
1174: CTputs $num [format " %2d: " $set_idx]
1175: set filename [file join $path records "log$set_idx.db"]
1176: updateStatusMessage "Analyzing [file tail $filename]" $num
1177: updateStatusBar 0.0 $num
1178: if { [file readable $filename] } {
1179: set result [CTstudentLoginData $num $filename $id]
1180: CTputs $num [eval format \"%4d %4d %4d %4d %4d\" $result]
1181: set no_log 0
1182: } else {
1183: CTputs $num "========================"
1184: set no_log 1
1185: }
1186: CTputs $num " "
1187: set filename [file join $path records "weblog$set_idx.db"]
1188: updateStatusMessage "Analyzing [file tail $filename]" $num
1189: updateStatusBar 0.0 $num
1190: if { [file readable $filename] } {
1191: set result [CTstudentLoginData $num $filename $id]
1192: CTputs $num [eval format \"%4d %4d %4d %4d %4d\" $result]
1193: set no_weblog 0
1194: } else {
1195: CTputs $num "========================"
1196: set no_weblog 1
1197: }
1198: CTputs $num "\n"
1199: if { $no_log && $no_weblog } { set done 1 }
1200: }
1201: }
1202:
1203: ###########################################################
1204: # CTstudentSetAnalysis
1205: ###########################################################
1206: ###########################################################
1207: ###########################################################
1208: proc CTstudentSetAnalysis { num path id limit } {
1209: set set_idx 0
1210: set id [string toupper $id]
1211: CTputs $num " set \#:\n"
1212: set done 0
1213: while { ! $done } {
1214: incr set_idx
1215: if { $set_idx > $limit } { set done 1; continue }
1216: set filename [file join $path records "set$set_idx.db"]
1217: updateStatusMessage "Analyzing [file tail $filename]" $num
1218: if { ![file readable $filename] } { continue }
1219: CTputs $num [format " %2d: " $set_idx]
1220: set fileId [open $filename "r"]
1221: set line_cnt 0
1222: set found 0
1223: set aline [gets $fileId]
1224: while { ! [eof $fileId] && !$found } {
1225: incr line_cnt
1226: if { $line_cnt > 3 } {
1227: set aline [string trim $aline]
1228: set s_id [string toupper [string range $aline 0 8]]
1229: if {$id == $s_id} {
1230: set found 1
1231: set breakpt [string first "," $aline]
1232: set data [list [string range $aline 10 [expr $breakpt - 1] ] \
1233: [string range $aline [expr $breakpt + 1] end ] ]
1234: CTputs $num "[lindex $data 0]\n [lindex $data 1]\n"
1235: }
1236: }
1237: set aline [gets $fileId]
1238: }
1239: close $fileId
1240: if { ! $found } { CTputs $num "\n\n" }
1241: }
1242: }
1243:
1244: ###########################################################
1245: # CTstudentLoginData
1246: ###########################################################
1247: ###########################################################
1248: ###########################################################
1249: proc CTstudentLoginData { num filename id } {
1250:
1251: set Y_total 0
1252: set N_total 0
1253: set U_total 0
1254: set u_total 0
1255: set S_total 0
1256: set maxLine [expr double([lindex [exec wc $filename] 0])]
1257: set line_cnt 0
1258: set fileId [open $filename "r"]
1259: set aline [gets $fileId]
1260: while { ![eof $fileId] } {
1261: incr line_cnt
1262: if { $line_cnt%300 == 0 } {
1263: updateStatusBar [expr $line_cnt/$maxLine] $num
1264: }
1265: set aline [string trim $aline]
1266: set s_id [string toupper [string range $aline 0 8]]
1267: set id [string toupper $id]
1268: if {$id == $s_id} {
1269: set ans_char [split [string range $aline 35 end] {} ]
1270: for {set i 0} {$i< [llength $ans_char]} {incr i} {
1271: if {[lindex $ans_char $i] == "Y"} { incr Y_total
1272: } elseif {[lindex $ans_char $i] == "N"} { incr N_total
1273: } elseif {[lindex $ans_char $i] == "U"} { incr U_total
1274: } elseif {[lindex $ans_char $i] == "u"} { incr u_total
1275: } elseif {[lindex $ans_char $i] == "S"} { incr S_total }
1276: }
1277: }
1278: set aline [gets $fileId]
1279: }
1280: close $fileId
1281: return [list $Y_total $N_total $S_total $U_total $u_total]
1282: }
1283:
1284: ###########################################################
1285: # CTrunCommand
1286: ###########################################################
1287: ###########################################################
1288: ###########################################################
1289: proc CTrunCommand { num cmdnum fileId {followup "" }} {
1290: global gCT
1291:
1292: set data [read $fileId]
1293: updateStatusSpinner $cmdnum
1294: if { $data != "" } {
1295: CTputs $cmdnum $data
1296: }
1297: if { [eof $fileId] } {
1298: fileevent $fileId readable ""
1299: catch {close $fileId}
1300: if { $followup == "" } {
1301: CToutput $num $cmdnum
1302: removeStatus $cmdnum
1303: unset gCT(cmd.$cmdnum)
1304: } else {
1305: eval $followup
1306: }
1307: }
1308: }
1309:
1310: ###########################################################
1311: # CTitemAnalysisRange
1312: ###########################################################
1313: ###########################################################
1314: ###########################################################
1315: proc CTitemAnalysisRange { num classpath setIdStart setIdEnd } {
1316: for { set i $setIdStart } { $i <= $setIdEnd } { incr i } {
1317: if { [ catch { CTitemAnalysis $num $classpath $i } errors ] } {
1318: displayError $errors
1319: }
1320: }
1321: }
1322:
1323: ###########################################################
1324: # CTitemAnalysis
1325: ###########################################################
1326: ###########################################################
1327: ###########################################################
1328: proc CTitemAnalysis { num classpath setId } {
1329: global gMaxSet
1330: set done 0
1331:
1332: set total_scores 0
1333: set total_weights 0
1334: set upper_percent 0.0
1335: set lower_percent 0.0
1336:
1337: set Y_total 0
1338: set N_total 0
1339: for { set ii 0} { $ii<$gMaxSet } {incr ii} {
1340: set Y_cnt($ii) 0
1341: set N_cnt($ii) 0
1342: set Ycnt_upper($ii) 0.0
1343: set Ycnt_lower($ii) 0.0
1344: }
1345:
1346: set filename [file join $classpath records "set$setId.db"]
1347: if { ! [file readable $filename] } {
1348: CTputs $num "FILE: $filename does not exist!\n"
1349: return
1350: }
1351:
1352: displayStatus "Analyzing [file tail $filename]" both $num
1353: set maxLine [lindex [exec wc $filename] 0]
1354:
1355: set fileId [open "$filename" "r"]
1356: set valid_cnt 0
1357: set line_cnt 0
1358: set ans_char ""
1359: set aline [gets $fileId]
1360: while {![eof $fileId]} {
1361: incr line_cnt
1362: if { ($line_cnt%20) == 0 } {
1363: updateStatusBar [expr $line_cnt/double($maxLine)] $num
1364: }
1365: if { $line_cnt == 2 } {
1366: set aline [string trim $aline]
1367: set weights [split $aline {}]
1368: # set valid_weights 0
1369: # for { set ii 0 } { $ii < [llength $weights] } { incr ii } {
1370: # incr valid_weights [lindex $weights $ii]
1371: # }
1372: } elseif { $line_cnt > 3} {
1373: set aline [string trim $aline]
1374: set prefix [lindex [split $aline ","] 0]
1375: set s_num [string toupper [lindex [split $aline " " ] 0 ] ]
1376: set ans_str [lindex [split $prefix " "] 1]
1377: set ans_char [split $ans_str {} ]
1378: set valid 0
1379: for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
1380: if { [lindex $ans_char $ii] != "-"} { set valid 1 }
1381: }
1382: if { $valid } {
1383: incr valid_cnt
1384: set score 0
1385: for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
1386:
1387: if { [lindex $ans_char $ii] == "Y" || \
1388: [lindex $ans_char $ii] == "y" } {
1389: incr score [lindex $weights $ii]
1390: set Y_cnt($ii) [expr $Y_cnt($ii) + 1]
1391: set Y_total [expr $Y_total + 1]
1392: }
1393: if { [lindex $ans_char $ii] == "N" || \
1394: [lindex $ans_char $ii] == "n" } {
1395: set N_cnt($ii) [expr $N_cnt($ii) + 1]
1396: set N_total [expr $N_total + 1]
1397: }
1398: if { [lindex $ans_char $ii] >= 0 && \
1399: [lindex $ans_char $ii] <= 9 } {
1400: incr score [lindex $ans_char $ii]
1401: set yes_part [expr [lindex $ans_char $ii] / \
1402: double([lindex $weights $ii]) ]
1403: set no_part [expr 1.0 - $yes_part]
1404: set Y_cnt($ii) [expr $Y_cnt($ii) + $yes_part]
1405: set Y_total [expr $Y_total + $yes_part]
1406: set N_cnt($ii) [expr $N_cnt($ii) + $no_part]
1407: set N_total [expr $N_total + $no_part]
1408: }
1409: # if { [lindex $ans_char $ii] == "E"} {
1410: # incr valid_weights -[lindex $weights $ii]
1411: # }
1412: }
1413: set s_db([format "%08d%s" $score $s_num]) $ans_str
1414: }
1415: }
1416: set aline [gets $fileId]
1417: }
1418: close $fileId
1419: removeStatus $num
1420: for { set ii 0 } { $ii < $gMaxSet } { incr ii } {
1421: set Ycnt_upper($ii) 0
1422: set Ycnt_lower($ii) 0
1423: }
1424: displayStatus "Pondering data . . ." spinner $num
1425: set upperpart_cnt [expr int(0.27 * double($valid_cnt))]
1426: set lowerpart_limit [expr $valid_cnt - $upperpart_cnt]
1427: set line_cnt 0
1428: foreach sort_key [lsort -decreasing [array names s_db]] {
1429: incr line_cnt
1430: if { ($line_cnt%20) == 0 } { updateStatusSpinner $num }
1431: set ans_str $s_db($sort_key)
1432: set ans_char [split $ans_str {} ]
1433: for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
1434: if { [lindex $ans_char $ii] == "Y" || \
1435: [lindex $ans_char $ii] == "y" || \
1436: [lindex $ans_char $ii] == [lindex $weights $ii] } {
1437: if { $line_cnt <= $upperpart_cnt } {
1438: incr Ycnt_upper($ii)
1439: } elseif { $line_cnt > $lowerpart_limit } {
1440: incr Ycnt_lower($ii)
1441: }
1442: }
1443: }
1444: }
1445: CTputs $num " There are $valid_cnt entries in file $filename\n"
1446: CTputs $num [format " The upper 27%% has %d records, the lower 27%% has %d records\n"\
1447: $upperpart_cnt [expr $valid_cnt - $lowerpart_limit] ]
1448: CTputs $num " question \# DoDiff. Disc. Factor (%upper - %lower) \[\#records,\#records\]\n";
1449:
1450: for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
1451: updateStatusSpinner $num
1452: set tmp_total [expr $N_cnt($ii) + $Y_cnt($ii)]
1453: if { $tmp_total > 0 } {
1454: set diff [expr 100.0*($N_cnt($ii) / double($N_cnt($ii) + $Y_cnt($ii)))]
1455: } else {
1456: set diff "-"
1457: }
1458: set upper_percent [expr 100.0 * ($Ycnt_upper($ii) /double($upperpart_cnt))]
1459: set lower_percent [expr 100.0 * ($Ycnt_lower($ii) /double($upperpart_cnt))]
1460: set disc [expr $upper_percent - $lower_percent]
1461: CTputs $num [format " %2d: " [expr $ii + 1]]
1462: CTputs $num [format "%6.1f %5.1f (%6.1f - %6.1f) \[%8d,%8d\]\n" \
1463: $diff $disc $upper_percent $lower_percent $Ycnt_upper($ii) \
1464: $Ycnt_lower($ii) ]
1465: }
1466: removeStatus $num
1467: }
1468:
1469: ###########################################################
1470: # CTitemCorrelation
1471: ###########################################################
1472: # INPUTS: class name with full path, set number
1473: #
1474: # r = \frac{\sum{x_i y_i} - \frac{(\sum x_i)(\sum y_i)}{n}}
1475: # {\sqrt{(\sum x_i^2 - \frac{}{}}}
1476: #
1477: # corr = (sum of prod_xy - (sum_x*sum_y / n) ) / sqrt( (sum of sqr_x - (sum_x*sum_x/n))*
1478: #
1479: ###########################################################
1480: ###########################################################
1481: proc CTitemCorrelation { num classpath setId } {
1482: global gMaxSet
1483:
1484: set filename [file join $classpath records "set$setId.db"]
1485: if { ! [file readable $filename] } {
1486: CTputs $num "FILE: $filename does not exist!\n"
1487: return
1488: }
1489:
1490: displayStatus "Analyzing [file tail $filename]" both $num
1491: set maxLine [lindex [exec wc $filename] 0]
1492:
1493: set initialized 0
1494: set question_cnt 0
1495: set fileId [open "$filename" "r"]
1496: set line_cnt 0
1497: set aline [gets $fileId]
1498: while {![eof $fileId]} {
1499: incr line_cnt
1500: if { ($line_cnt%20) == 0 } {
1501: updateStatusBar [expr {$line_cnt/double($maxLine)}] $num
1502: }
1503: if { $line_cnt == 2 } {
1504: set aline [string trim $aline]
1505: set weights [split $aline {}]
1506: }
1507: if { $line_cnt > 3} {
1508: set aline [string trim $aline]
1509: set data [string range $aline 10 end]
1510: set ans_str [lindex [split $data ","] 0]
1511: set ans_char_list [split $ans_str {} ]
1512: set try_str [string range $aline [expr {[string first "," $data] +1}] end ]
1513: set question_cnt [llength $ans_char_list]
1514: for { set ii 0 } { $ii < $question_cnt } { incr ii } {
1515: set ans_char($ii) [lindex $ans_char_list $ii]
1516: }
1517: if { $question_cnt > $initialized } {
1518: for {set ii 0} {$ii < [expr {$question_cnt - 1}]} {incr ii} {
1519: set start [expr {($initialized>($ii+1)) ? $initialized : ($ii+1)}]
1520: for { set jj $start } { $jj < $question_cnt } { incr jj } {
1521: set index_key "$ii.$jj"
1522: set prod_xy($index_key) 0.0
1523: set sum_x($index_key) 0
1524: set sum_y($index_key) 0
1525: set sum_x2($index_key) 0
1526: set sum_y2($index_key) 0
1527: set valid_cnt($index_key) 0
1528: }
1529: }
1530: set initialized $question_cnt
1531: }
1532: for { set ii 0 } { $ii < [expr {$question_cnt - 1}] } { incr ii } {
1533: for { set jj [expr {$ii+1}] } { $jj < $question_cnt } { incr jj } {
1534: set index_key "$ii.$jj"
1535: if { $ans_char($ii) != "-" && $ans_char($ii) != "E" && \
1536: $ans_char($jj) != "-" && $ans_char($jj) != "E" } {
1537: ## $ans_char($ii) is one of 0 .. 9, Y, y, N, n
1538: ## $ans_char($jj) is one of 0 .. 9, Y, y, N, n
1539: if { $ans_char($ii) == "Y" || $ans_char($ii) == "y" } {
1540: set x_data [lindex $weights $ii]
1541: } elseif { $ans_char($ii) == "N" || $ans_char($ii) == "n" } {
1542: set x_data 0
1543: } else { ## must be in 0 .. 9
1544: set x_data $ans_char($ii)
1545: }
1546: if { $ans_char($jj) == "Y" || $ans_char($jj) == "y" } {
1547: set y_data [lindex $weights $jj]
1548: } elseif { $ans_char($jj) == "N" || $ans_char($jj) == "n" } {
1549: set y_data 0
1550: } else { ## must be in 0 .. 9
1551: set y_data $ans_char($jj)
1552: }
1553: set prod_xy($index_key) [expr {$x_data * $y_data +
1554: $prod_xy($index_key)} ]
1555: incr sum_x($index_key) $x_data
1556: incr sum_y($index_key) $y_data
1557: incr sum_x2($index_key) [expr {$x_data * $x_data}]
1558: incr sum_y2($index_key) [expr {$y_data * $y_data}]
1559: incr valid_cnt($index_key) 1
1560: }
1561: }
1562: }
1563: }
1564: set aline [gets $fileId]
1565: }
1566: close $fileId
1567: removeStatus $num
1568: # print out the correlation matrix
1569: # parray sum_x
1570: # parray sum_y
1571: # parray prod_xy
1572: CTputs $num " "
1573: for { set ii 1 } { $ii < $question_cnt } { incr ii } {
1574: CTputs $num [format " %2d" [expr {$ii+1}] ]
1575: }
1576: CTputs $num "\n"
1577: # --------------------------------------
1578: for { set ii 0 } { $ii < [expr {$question_cnt -1}] } { incr ii } {
1579: CTputs $num [format " %2d:" [expr {$ii+1}] ]
1580: for { set jj 0 } { $jj < $ii } { incr jj } { CTputs $num " " }
1581: for { set jj [expr {$ii+1}] } { $jj < $question_cnt } { incr jj } {
1582: set index_key "$ii.$jj"
1583: if { $valid_cnt($index_key) != "0" } {
1584: set upper_part [ expr { $prod_xy($index_key) -
1585: ( ($sum_x($index_key) * $sum_y($index_key))
1586: / double($valid_cnt($index_key)))}]
1587: set lower_part [expr {$sum_x2($index_key) -
1588: ($sum_x($index_key) * $sum_x($index_key)
1589: / double($valid_cnt($index_key)))} ]
1590: set lower_part [expr {$lower_part * ($sum_y2($index_key) -
1591: ($sum_y($index_key) *
1592: $sum_y($index_key)
1593: /double($valid_cnt($index_key))))}]
1594: set lower_part [expr {sqrt($lower_part)}]
1595: if { $lower_part != 0.0 } {
1596: set ratio [expr {$upper_part / double($lower_part)}]
1597: CTputs $num [format " % .2f" $ratio]
1598: } else {
1599: CTputs $num " INF "
1600: }
1601: } else {
1602: CTputs $num " ----"
1603: }
1604: }
1605: CTputs $num "\n"
1606: }
1607: }
1608:
1609: ###########################################################
1610: # CTsubmissionsLaunch
1611: ###########################################################
1612: ###########################################################
1613: ###########################################################
1614: proc CTsubmissionsLaunch { num cmdnum type s_id s_nm start end } {
1615: global gCT gFile gUniqueNumber gCapaConfig
1616:
1617: CTputs $cmdnum "$type submissions for $s_nm for set $start\n"
1618: if { $type == "telnet" } {
1619: set command "grep -i $s_id [file join $gFile($num) records submissions$start.db]"
1620: set followtype web
1621: } else {
1622: set command "grep -i $s_id [file join $gFile($num) \
1623: records websubmissions$start.db]"
1624: set followtype telnet
1625: incr start
1626: }
1627: set done 0
1628: set followcmd ""
1629: while { !$done && ($start <= ($end+1)) } {
1630: if { $start <= $end } {
1631: set followcmd "CTsubmissionsLaunch $num $cmdnum $followtype $s_id {$s_nm} \
1632: $start $end"
1633: }
1634: if { ! [catch {set fileId [open "|$command" "r"]} ] } { set done 1 }
1635: }
1636: fconfigure $fileId -blocking 0
1637: fileevent $fileId readable "CTrunCommand $num $cmdnum $fileId {$followcmd}"
1638: }
1639:
1640: ###########################################################
1641: # CTreportDist
1642: ###########################################################
1643: ###########################################################
1644: ###########################################################
1645: proc CTreportDist { num file percentage sectionlist } {
1646: set fileId [open $file "r"]
1647: set aline [gets $fileId]
1648: set which [expr [llength [split $aline "\t"]] - 2]
1649: set maximum [lindex [lrange [split $aline "\t"] $which end] 1]
1650: if { $percentage } {
1651: for {set i 0} {$i<=100} {incr i} {
1652: set totals($i.score) 0
1653: set totals($i.stunum) ""
1654: }
1655: } else {
1656: for { set i 0 } { $i <= $maximum } { incr i } {
1657: set totals($i.score) 0
1658: set totals($i.stunum) ""
1659: }
1660: }
1661: while { ![eof $fileId]} {
1662: set temp [lrange [split $aline "\t"] $which end]
1663: set score [lindex $temp 0]
1664: regsub -- "-" $score "0" score
1665: set max [lindex $temp 1]
1666: set temp [lindex [split $aline "\t"] 1]
1667: set section [lindex $temp 1]
1668: set stunum [lindex $temp 0]
1669: if { ([lsearch $sectionlist $section] != -1) && ($max!=0) } {
1670: if { $percentage } {
1671: set percent [expr int($score/double($max)*100)]
1672: incr totals($percent.score)
1673: lappend totals($percent.stunum) $stunum
1674: } else {
1675: if { $max > $maximum } {
1676: for {set i [expr $maximum+1]} {$i<=$max} {incr i} {set totals($i) 0}
1677: set maximum $max
1678: }
1679: set score [string trim $score]
1680: incr totals($score.score)
1681: lappend totals($score.stunum) $stunum
1682: }
1683: }
1684: set aline [gets $fileId]
1685: }
1686: CTputs $num "Scores #acheived\n"
1687: set scorelist ""
1688: set templist [array names totals *.score]
1689: foreach temp $templist {lappend possiblescores [lindex [split $temp .] 0]}
1690: foreach score [lsort -integer $possiblescores] {
1691: CTputs $num [format "%5d:%6d\n" $score $totals($score.score)]
1692: lappend scorelist [list $totals($score.score) $score $totals($score.stunum)]
1693: }
1694: return $scorelist
1695: }
1696:
1697: ###########################################################
1698: # CTgradeDistribution
1699: ###########################################################
1700: ###########################################################
1701: ###########################################################
1702: proc CTgradeDistribution { num classpath setId } {
1703: set filename [file join $classpath records "set$setId.db"]
1704: if { ! [file readable $filename] } {
1705: CTputs $num "FILE: $filename does not exist!\n"
1706: return
1707: }
1708:
1709: displayStatus "Analyzing [file tail $filename]" both $num
1710: set maxLine [lindex [exec wc $filename] 0]
1711: set fileId [open "$filename" "r"]
1712: set valid_cnt 0
1713: set line_cnt 0
1714: set aline [gets $fileId]
1715: while {![eof $fileId]} {
1716: incr line_cnt
1717: if { ($line_cnt%20) == 0 } {
1718: updateStatusBar [expr $line_cnt/double($maxLine)] $num
1719: }
1720: if { $line_cnt == 2 } {
1721: set aline [string trim $aline]
1722: set weights [split $aline {}]
1723: set valid_weights 0
1724: foreach weight $weights { incr valid_weights $weight }
1725: for { set i 0 } { $i <= $valid_weights } { incr i } {
1726: set total_score($i) 0
1727: }
1728: } elseif { $line_cnt > 3} {
1729: set aline [string trim $aline]
1730: set prefix [lindex [split $aline ","] 0]
1731: set s_num [string toupper [lindex [split $aline " " ] 0 ] ]
1732: set ans_str [lindex [split $prefix " "] 1]
1733: set ans_char [split $ans_str {} ]
1734: set valid 0
1735: for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
1736: if { [lindex $ans_char $ii] != "-"} { set valid 1 }
1737: }
1738: if { $valid } {
1739: incr valid_cnt
1740: set score 0
1741: for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
1742: if { [lindex $ans_char $ii] == "Y" || \
1743: [lindex $ans_char $ii] == "y" } {
1744: incr score [lindex $weights $ii]
1745: }
1746: if { [lindex $ans_char $ii] >= 0 && \
1747: [lindex $ans_char $ii] <= 9 } {
1748: incr score [lindex $ans_char $ii]
1749: }
1750: }
1751: if { [catch {incr total_score($score)} ] } {
1752: puts "$aline:$prefix:$s_num:$ans_str:$ans_char"
1753: }
1754:
1755: }
1756: }
1757: set aline [gets $fileId]
1758: }
1759: close $fileId
1760: removeStatus $num
1761: displayStatus "Pondering data . . ." spinner $num
1762: CTputs $num " There are $valid_cnt entries in file $filename\n"
1763: CTputs $num "Score #acheived\n"
1764: set scorelist ""
1765: foreach score [lsort -integer [array names total_score]] {
1766: CTputs $num [format "%5d:%6d\n" $score $total_score($score)]
1767: lappend scorelist [list $total_score($score) $score]
1768: }
1769: removeStatus $num
1770: return $scorelist
1771: }
1772:
1773: ###########################################################
1774: # CTgetStudentScores
1775: ###########################################################
1776: ###########################################################
1777: ###########################################################
1778: proc CTgetStudentScores { studentScoresVar classpath setId num } {
1779: upvar $studentScoresVar studentScores
1780:
1781: set filename [file join $classpath records "set$setId.db"]
1782: if { ! [file readable $filename] } {
1783: CTputs $num "FILE: $filename does not exist!\n"
1784: error
1785: }
1786:
1787: displayStatus "Analyzing [file tail $filename]" both $num
1788: set maxLine [lindex [exec wc $filename] 0]
1789: set fileId [open "$filename" "r"]
1790: set valid_cnt 0
1791: set line_cnt 0
1792: set aline [gets $fileId]
1793: set aline [gets $fileId]
1794: set weights [split [string trim $aline] {}]
1795: set valid_weights 0
1796: foreach weight $weights { incr valid_weights $weight }
1797: set aline [gets $fileId]
1798: set aline [gets $fileId]
1799: while {![eof $fileId]} {
1800: incr line_cnt
1801: if { ($line_cnt%20) == 0 } {
1802: updateStatusBar [expr $line_cnt/double($maxLine)] $num
1803: }
1804: set aline [string trim $aline]
1805: set prefix [lindex [split $aline ","] 0]
1806: set s_num [string toupper [lindex [split $aline " " ] 0 ] ]
1807: set ans_str [lindex [split $prefix " "] 1]
1808: set ans_char [split $ans_str {} ]
1809: set valid 0
1810: for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
1811: if { [lindex $ans_char $ii] != "-"} { set valid 1 }
1812: }
1813: if { $valid } {
1814: incr valid_cnt
1815: if {[array names studentScores $s_num] == ""} {set studentScores($s_num) 0}
1816: for { set ii 0 } { $ii < [llength $ans_char] } { incr ii } {
1817: if { [lindex $ans_char $ii] == "Y" || [lindex $ans_char $ii] == "y" } {
1818: incr studentScores($s_num) [lindex $weights $ii]
1819: }
1820: if { [lindex $ans_char $ii] >= 0 && [lindex $ans_char $ii] <= 9 } {
1821: incr studentScores($s_num) [lindex $ans_char $ii]
1822: }
1823: }
1824: }
1825: set aline [gets $fileId]
1826: }
1827: close $fileId
1828: removeStatus $num
1829: return $valid_weights
1830: }
1831:
1832: ###########################################################
1833: # CTgradeDistributionRange
1834: ###########################################################
1835: ###########################################################
1836: ###########################################################
1837: proc CTgradeDistributionRange { num classpath setIdstart setIdend } {
1838: set totalpoints 0
1839: for {set setId $setIdstart} {$setId <= $setIdend} {incr setId} {
1840: set points [CTgetStudentScores studentScores $classpath $setId $num]
1841: incr totalpoints $points
1842: # parray studentScores
1843: }
1844:
1845: displayStatus "Pondering data . . ." spinner $num
1846: for { set i 0 } { $i <= $totalpoints } { incr i } {
1847: set total_score($i) 0
1848: }
1849: foreach sNum [array names studentScores] { incr total_score($studentScores($sNum)) }
1850: CTputs $num "Scores #acheived\n"
1851: set scorelist ""
1852: foreach score [lsort -integer [array names total_score]] {
1853: CTputs $num [format "%5d:%6d\n" $score $total_score($score)]
1854: lappend scorelist [list $total_score($score) $score]
1855: }
1856: removeStatus $num
1857: return $scorelist
1858: }
1859:
1860: #common Input dialogs
1861:
1862: #common output methods
1863: proc CTdatestamp { cmdnum } {
1864: CTputs $cmdnum [clock format [clock seconds]]\n
1865: }
1866:
1867: ###########################################################
1868: # CTputs
1869: ###########################################################
1870: ###########################################################
1871: ###########################################################
1872: proc CTputs { num message {tag normal} } {
1873: global gCT
1874:
1875: lappend gCT(output.$num) [list $message $tag]
1876: }
1877:
1878: ###########################################################
1879: # CToutputWrap
1880: ###########################################################
1881: ###########################################################
1882: ###########################################################
1883: proc CToutputWrap { num } {
1884: global gCT
1885: if { $gCT($num.wrap) } {
1886: $gCT($num.output) configure -wrap char
1887: } else {
1888: $gCT($num.output) configure -wrap none
1889: }
1890: }
1891:
1892: ###########################################################
1893: # CToutput
1894: ###########################################################
1895: ###########################################################
1896: ###########################################################
1897: proc CToutput { num cmdnum } {
1898: global gCT
1899:
1900: if { ![winfo exists $gCT($num).output] } {
1901: set outputWin [toplevel $gCT($num).output]
1902:
1903: set buttonFrame [frame $outputWin.button]
1904: set textFrame [frame $outputWin.text]
1905: set bottomFrame [frame $outputWin.bottom]
1906: pack $buttonFrame $textFrame $bottomFrame
1907: pack configure $buttonFrame -anchor e -expand 0 -fill x
1908: pack configure $textFrame -expand 1 -fill both
1909: pack configure $bottomFrame -expand 0 -fill x
1910:
1911: set gCT($num.output) [text $textFrame.text \
1912: -yscrollcommand "$textFrame.scroll set" \
1913: -xscrollcommand "$bottomFrame.scroll set"]
1914: scrollbar $textFrame.scroll -command "$textFrame.text yview"
1915: pack $gCT($num.output) $textFrame.scroll -side left
1916: pack configure $textFrame.text -expand 1 -fill both
1917: pack configure $textFrame.scroll -expand 0 -fill y
1918:
1919: scrollbar $bottomFrame.scroll -command "$textFrame.text xview" -orient h
1920: pack $bottomFrame.scroll -expand 0 -fill x
1921:
1922: set gCT($num.wrap) 1
1923: checkbutton $buttonFrame.wrap -text "Wrap" -command "CToutputWrap $num" \
1924: -variable gCT($num.wrap)
1925: button $buttonFrame.save -text "Save Text" -command "CTsaveText $num"
1926: button $buttonFrame.print -text "Print Text" -command "CTprintText $num"
1927: button $buttonFrame.dismiss -text "Dismiss" -command "destroy $outputWin"
1928: pack $buttonFrame.wrap $buttonFrame.save $buttonFrame.print \
1929: $buttonFrame.dismiss -side left
1930: }
1931: set index [$gCT($num.output) index end]
1932: foreach line $gCT(output.$cmdnum) {
1933: eval $gCT($num.output) insert end $line
1934: }
1935: unset gCT(output.$cmdnum)
1936: raise $gCT($num).output
1937: $gCT($num.output) see $index
1938: update idletasks
1939: }
1940:
1941: ###########################################################
1942: # CTsaveText
1943: ###########################################################
1944: # saves the contents of a text window
1945: ###########################################################
1946: # Arguments: num (the unique number of the path, and window)
1947: # Returns : nothing
1948: # Globals :
1949: ###########################################################
1950: proc CTsaveText { num } {
1951: global gFile gCT
1952:
1953: set window $gCT($num.output)
1954: if {![winfo exists $window]} { return }
1955: set dir $gFile($num)
1956: set file ""
1957:
1958: if { $dir == "" || $dir == "."} { set dir [pwd] }
1959: set file [tk_getSaveFile -title "Enter the name to Save As" \
1960: -initialdir "$dir" ]
1961: if { $file == "" } {
1962: displayError "File not saved"
1963: return
1964: }
1965: set fileId [open $file w]
1966: puts -nonewline $fileId [$window get 0.0 end-1c]
1967: close $fileId
1968: }
1969:
1970: ###########################################################
1971: # CTprintText
1972: ###########################################################
1973: # prints the contents of the text window, creates a temp file named
1974: # quiztemp.txt
1975: ###########################################################
1976: # Arguments: num (the unique number of the path, and window)
1977: # Returns : nothing
1978: # Globals : gFile gCT
1979: ###########################################################
1980: proc CTprintText { num } {
1981: global gFile gCT
1982:
1983: set window $gCT($num.output)
1984: if { ![winfo exists $window]} { return }
1985: catch {parseCapaConfig $num $gFile($num)}
1986: set lprCommand [getLprCommand [file join $gFile($num) managertemp.txt] $num]
1987: if {$lprCommand == "Cancel"} { return }
1988:
1989: set fileId [open [file join $gFile($num) managertemp.txt] w]
1990: puts -nonewline $fileId [$window get 0.0 end-1c]
1991: close $fileId
1992:
1993: set errorMsg ""
1994: if { [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]} {
1995: displayError "An error occurred while printing: $errorMsg"
1996: } else {
1997: displayMessage "Print job sent to the printer.\n $output"
1998: }
1999: exec rm -f [file join $gFile($num) mangertemp.txt]
2000: }
2001:
2002: ###########################################################
2003: # CTprintCanvas
2004: ###########################################################
2005: ###########################################################
2006: ###########################################################
2007: proc CTprintCanvas { num window path } {
2008:
2009: if { ![winfo exists $window]} { return }
2010: catch {parseCapaConfig $num $gFile($num)}
2011: set lprCommand [getLprCommand [file join $path managertemp.txt] $num]
2012: if {$lprCommand == "Cancel"} { return }
2013:
2014: set rotate 0
2015: 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 }
2016: $window postscript -file [file join $path managertemp.txt] -rotate $rotate
2017:
2018: set errorMsg ""
2019: if { [catch {set output [ eval "exec $lprCommand" ] } errorMsg ]} {
2020: displayError "An error occurred while printing: $errorMsg"
2021: } else {
2022: displayMessage "Print job sent to the printer.\n $output"
2023: }
2024: exec rm -f [file join $path mangertemp.txt]
2025: }
2026:
2027: ###########################################################
2028: # CTsaveCanvas
2029: ###########################################################
2030: ###########################################################
2031: ###########################################################
2032: proc CTsaveCanvas { window path } {
2033: if { ![winfo exists $window] } { return }
2034: set dir $path
2035: set file ""
2036:
2037: if { $dir == "" } { set dir [pwd] }
2038: set file [tk_getSaveFile -title "Enter the name to Save As" \
2039: -initialdir "$dir" ]
2040: if { $file == "" } {
2041: displayError "File not saved"
2042: return
2043: }
2044: $window postscript -file $file
2045: }
2046:
2047: ###########################################################
2048: # CTbargraph
2049: ###########################################################
2050: ###########################################################
2051: ###########################################################
2052: proc CTbargraph {window num barnum data {path ""} {title "" } {xlabel ""} {ylabel ""}
2053: {suffix ""} } {
2054: global gBarGraph
2055: set height 300
2056: set width 500
2057:
2058: global gWindowMenu
2059:
2060: set bargraph [toplevel $window.bargraph$barnum]
2061: if { $title != "" } { wm title $bargraph $title }
2062: $gWindowMenu add command -label "$title $barnum" -command "capaRaise $bargraph"
2063:
2064: set buttonFrame [frame $bargraph.buttons]
2065: set canvasFrame [frame $bargraph.canvas]
2066: pack $buttonFrame $canvasFrame -side top
2067: pack configure $canvasFrame -expand 1 -fill both
2068:
2069: set canvas [canvas $canvasFrame.canvas -height $height -width $width -background white]
2070: pack $canvas -expand 1 -fill both
2071: bind $canvas <Configure> "CTdrawBargraph $barnum"
2072:
2073: button $buttonFrame.change -text "Change Graph" -command "CTchangeBargraph $window $barnum"
2074: button $buttonFrame.save -text "Save Graph" -command "CTsaveCanvas $canvas $path"
2075: button $buttonFrame.print -text "Print Graph" -command "CTprintCanvas $num $canvas $path"
2076: button $buttonFrame.dismiss -text "Dismiss" -command "CTdestroyBargraph $barnum"
2077: pack $buttonFrame.change $buttonFrame.save $buttonFrame.print \
2078: $buttonFrame.dismiss -side left
2079: bind $bargraph <Destroy> "CTdestroyBargraph $barnum"
2080:
2081: set gBarGraph($barnum.num) $num
2082: set gBarGraph($barnum.suffix) $suffix
2083: set gBarGraph($barnum) $data
2084: set gBarGraph($barnum.canvas) $canvas
2085: set gBarGraph($barnum.title) $title
2086: set gBarGraph($barnum.xlabel) $xlabel
2087: set gBarGraph($barnum.ylabel) $ylabel
2088: set gBarGraph($barnum.color) green
2089: set gBarGraph($barnum.bucketscores) 0
2090: CTautoscaleBargraph $barnum
2091: CTdrawBargraph $barnum
2092: }
2093:
2094: ###########################################################
2095: # CTautoscaleBargraph
2096: ###########################################################
2097: ###########################################################
2098: ###########################################################
2099: proc CTautoscaleBargraph { barnum } {
2100: global gBarGraph
2101: set data $gBarGraph($barnum)
2102: set max [lindex [lindex [lsort -decreasing -index 0 -real $data] 0] 0]
2103: if { $max > int($max) } { set max [expr int($max+1)] }
2104: set gBarGraph($barnum.yoften) [expr int([format "%1.e" [expr $max/10.0]])]
2105: if { $gBarGraph($barnum.yoften) == 0 } { set gBarGraph($barnum.yoften) 1 }
2106: set total [llength $data]
2107: set gBarGraph($barnum.xoften) [expr ($total/25) + 1]
2108: }
2109:
2110: ###########################################################
2111: # CTchangeBargraphData
2112: ###########################################################
2113: ###########################################################
2114: ###########################################################
2115: proc CTchangeBargraphData { barnum data } {
2116: global gBarGraph
2117: set gBarGraph($barnum) $data
2118: CTautoscaleBargraph $barnum
2119: CTdrawBargraph $barnum
2120: }
2121:
2122: ###########################################################
2123: # CTdestroyBargraph
2124: ###########################################################
2125: ###########################################################
2126: ###########################################################
2127: proc CTdestroyBargraph { num } {
2128: global gBarGraph
2129:
2130: if { [catch {set window [winfo toplevel $gBarGraph($num.canvas)]}]} { return }
2131: set window2 [file rootname $window].changeBarGraph$num
2132: foreach name [array names gBarGraph "$num.*" ] {
2133: unset gBarGraph($name)
2134: }
2135: unset gBarGraph($num)
2136: destroy $window
2137: catch {destroy $window2}
2138: }
2139:
2140: ###########################################################
2141: # CTdrawBargraph
2142: ###########################################################
2143: ###########################################################
2144: ###########################################################
2145: proc CTdrawBargraph { num } {
2146: global gBarGraph
2147:
2148: set data $gBarGraph($num)
2149: set canvas $gBarGraph($num.canvas)
2150: set suffix $gBarGraph($num.suffix)
2151:
2152: set height [winfo height $canvas]
2153: set width [winfo width $canvas]
2154: set titleoffset 0
2155: set titleheight 15
2156: set labelheight 15
2157: set tickheight 15
2158: set textheight [expr $labelheight+$tickheight]
2159: set textwidth 40
2160: set graphheight [expr $height - $textheight - $titleheight]
2161: set graphwidth [expr $width - $textwidth]
2162: $canvas delete all
2163:
2164: #draw data
2165: set total [llength $data]
2166: set eachwidth [expr $graphwidth/$total]
2167: # set howoften [expr ($total/$gBarGraph($num.numlabels)) + 1]
2168: set howoften $gBarGraph($num.xoften)
2169: set when [expr ($total-1)%$howoften]
2170: set max 0
2171: set i 0
2172: set value 0
2173: if { $gBarGraph($num.bucketscores) } {
2174: foreach datum $data {
2175: set value [expr {$value + [lindex $datum 0]}]
2176: if { $i % $howoften == $when } {
2177: if { $value > $max } { set max $value }
2178: set value 0
2179: }
2180: incr i
2181: }
2182: } else {
2183: set max [lindex [lindex [lsort -decreasing -index 0 -real $data] 0] 0]
2184: }
2185: if { $max > int($max) } { set max [expr int($max+1)] }
2186: if { [catch {set pixelvalue [expr ($graphheight-1)/double($max)]} ] } {
2187: set pixelvalue 10
2188: }
2189: set i 0
2190: set value 0
2191: foreach datum $data {
2192: set value [expr {$value + [lindex $datum 0]}]
2193: set which [lindex $datum 1]
2194: set y1 [expr {$graphheight + $titleheight}]
2195: set x2 [expr {$eachwidth * ($i+1) + $textwidth}]
2196: set y2 [expr {($graphheight-1) + $titleheight - $value * $pixelvalue}]
2197: set tag bar.$which.[expr $which-$howoften]
2198: if { [set color [lindex $datum 3]] == "" } {set color $gBarGraph($num.color)}
2199: if { $gBarGraph($num.bucketscores) && ($i % $howoften == $when) } {
2200: if { $i == $when } {
2201: puts "$value-$which-$howoften"
2202: $canvas create rectangle $textwidth \
2203: $y1 $x2 $y2 -fill $color -tag $tag
2204: } else {
2205: puts "$value:$which:$howoften"
2206: $canvas create rectangle [expr {$eachwidth*($i-$howoften+1)+$textwidth}]\
2207: $y1 $x2 $y2 -fill $color -tag $tag
2208: }
2209: } elseif { !$gBarGraph($num.bucketscores) } {
2210: $canvas create rectangle [expr {$eachwidth * $i + $textwidth}] \
2211: $y1 $x2 $y2 -fill $color -tag bar.$which.[expr $which-1]
2212: set value 0
2213: }
2214: if { $i % $howoften == $when } {
2215: $canvas create text [expr {$eachwidth * $i + $textwidth + $eachwidth/2}] \
2216: [expr $graphheight+(($tickheight)/2)+$titleheight] -text $which
2217: set value 0
2218: }
2219: incr i
2220: }
2221:
2222: #draw title
2223: $canvas create text [expr $textwidth+$titleoffset+($graphwidth/2)] 1 -anchor n\
2224: -text $gBarGraph($num.title)
2225: #draw axis
2226: $canvas create line $textwidth [expr {$graphheight + $titleheight}] \
2227: $textwidth [expr {$titleheight + 1}]
2228: #label xaxis
2229: $canvas create text [expr ($textwidth+($graphwidth/2))] \
2230: [expr $titleheight+$graphheight+$tickheight+($labelheight/2)] \
2231: -text $gBarGraph($num.xlabel)
2232: #label yaxis
2233: $canvas create text 1 1 -anchor nw -text $gBarGraph($num.ylabel)
2234: #draw tickmarks
2235: # set delta [format "%1.e" [expr ($max)/double($gBarGraph($num.numticks))]]
2236: set delta $gBarGraph($num.yoften)
2237: set start 0.0
2238: while { $start < $max } {
2239: set center [expr {($graphheight-1)*(($start)/$max)+$titleheight+1}]
2240: $canvas create line $textwidth $center [expr $textwidth - 20] $center
2241: $canvas create text [expr $textwidth-3] $center -anchor ne -text [expr int($max-$start)]
2242: set start [expr $start + $delta]
2243: }
2244: if { [llength [lindex $data 0]] > 2} {
2245: $canvas bind current <1> "CTbargraphClick$suffix $num"
2246: bind $canvas <Enter> "CTbargraphDisplayCreate $num"
2247: bind $canvas <Leave> "CTbargraphDisplayRemove $num"
2248: bind $canvas <Motion> "CTbargraphDisplayMove $num"
2249: $canvas bind all <Enter> "CTbargraphDisplay$suffix $num"
2250: }
2251: }
2252:
2253: ###########################################################
2254: # CTbargraphDisplayCreate
2255: ###########################################################
2256: ###########################################################
2257: ###########################################################
2258: proc CTbargraphDisplayCreate { barnum } {
2259: global gBarGraph gCT gFile
2260: set canvas $gBarGraph($barnum.canvas)
2261: if {[winfo exists $canvas.bubble$barnum]} { return }
2262: set bubble [toplevel $canvas.bubble$barnum]
2263: wm overrideredirect $bubble 1
2264: wm positionfrom $bubble program
2265: wm withdraw $bubble
2266: pack [label $bubble.l -highlightthickness 0 -relief raised -bd 1 -background yellow]
2267: }
2268: ###########################################################
2269: # CTbargraphDisplayRemove
2270: ###########################################################
2271: ###########################################################
2272: ###########################################################
2273: proc CTbargraphDisplayRemove { barnum } {
2274: global gBarGraph gCT gFile
2275: set canvas $gBarGraph($barnum.canvas)
2276: catch {destroy $canvas.bubble$barnum}
2277: }
2278: ###########################################################
2279: # CTbargraphDisplayBlank
2280: ###########################################################
2281: ###########################################################
2282: ###########################################################
2283: proc CTbargraphDisplayBlank { barnum } {
2284: global gBarGraph gCT gFile
2285: set canvas $gBarGraph($barnum.canvas)
2286: catch {$canvas.bubble$barnum.l configure -text ""}
2287: }
2288: ###########################################################
2289: # CTbargraphDisplayMove
2290: ###########################################################
2291: ###########################################################
2292: ###########################################################
2293: proc CTbargraphDisplayMove { barnum } {
2294: global gBarGraph gCT gFile
2295: set canvas $gBarGraph($barnum.canvas)
2296: catch {wm geometry $canvas.bubble$barnum +[expr 20+[winfo pointerx .]]+[expr 20+[winfo pointery .]]}
2297: if {[$canvas gettags current] == ""} {CTbargraphDisplayRemove $barnum}
2298: }
2299: ###########################################################
2300: # CTbargraphDisplayShowresponse
2301: ###########################################################
2302: ###########################################################
2303: ###########################################################
2304: proc CTbargraphDisplayShowresponse { barnum } {
2305: global gBarGraph gCT gFile
2306: set num $gBarGraph($barnum.num)
2307: set canvas $gBarGraph($barnum.canvas)
2308:
2309: set high [lindex [split [lindex [$canvas gettags current] 0] .] 1]
2310: foreach datum $gBarGraph($barnum) {
2311: set bar [lindex $datum 1]
2312: if { $bar != $high } { continue }
2313: if {![winfo exists $canvas.bubble$barnum.l]} {CTbargraphDisplayCreate $barnum}
2314: $canvas.bubble$barnum.l configure -text "[lindex $datum 0] - \"[splitline [lindex $datum 2] 35]\""
2315: wm geometry $canvas.bubble$barnum +[expr 20+[winfo pointerx .]]+[expr 20+[winfo pointery .]]
2316: wm deiconify $canvas.bubble$barnum
2317: return
2318: }
2319: CTbargraphDisplayRemove $barnum
2320: }
2321: ###########################################################
2322: # CTbargraphDisplaySCP
2323: ###########################################################
2324: ###########################################################
2325: ###########################################################
2326: proc CTbargraphDisplaySCP { barnum } {
2327: global gBarGraph gCT gFile
2328: set num $gBarGraph($barnum.num)
2329: set canvas $gBarGraph($barnum.canvas)
2330:
2331: set high [lindex [split [lindex [$canvas gettags current] 0] .] 1]
2332: foreach datum $gBarGraph($barnum) {
2333: set bar [lindex $datum 1]
2334: if { $bar != $high } { continue }
2335: if {![winfo exists $canvas.bubble$barnum.l]} {CTbargraphDisplayCreate $barnum}
2336: $canvas.bubble$barnum.l configure -text "[lindex $datum 0]"
2337: wm geometry $canvas.bubble$barnum +[expr 20+[winfo pointerx .]]+[expr 20+[winfo pointery .]]
2338: wm deiconify $canvas.bubble$barnum
2339: return
2340: }
2341: CTbargraphDisplayRemove $barnum
2342: }
2343:
2344: ###########################################################
2345: # CTbargraphClickSCP
2346: ###########################################################
2347: ###########################################################
2348: ###########################################################
2349: proc CTbargraphClickSCP { barnum } {
2350: global gBarGraph gCT gFile
2351:
2352: set num $gBarGraph($barnum.num)
2353: set canvas $gBarGraph($barnum.canvas)
2354: set bucket $gBarGraph($barnum.bucketscores)
2355:
2356: set high [lindex [split [lindex [$canvas gettags current] 0] .] 1]
2357: set low [lindex [split [lindex [$canvas gettags current] 0] .] 2]
2358: set stunums ""
2359: if { $high == "" || $low == "" } { return }
2360: foreach datum $gBarGraph($barnum) {
2361: set bar [lindex $datum 1]
2362: if { $bar > $high || $bar <= $low } { continue }
2363: set stunums [concat $stunums [lindex $datum 2]]
2364: }
2365: if { $stunums == "" } { return }
2366: if {"" == [set stuSCP [multipleChoice $gCT($num) "Select a student" $stunums 0]]} {
2367: return
2368: }
2369: set loginAnalysis [expr {"Yes" == [makeSure "Do you wish to do a Login Analysis? It may take a while." ]}]
2370: foreach s_id $stuSCP {
2371: CTstudentCourseProfile $num $s_id \
2372: [findByStudentNumber $s_id $gFile($num)] $loginAnalysis
2373: }
2374: }
2375:
2376: ###########################################################
2377: # CTbargraphClickShowresponse
2378: ###########################################################
2379: ###########################################################
2380: ###########################################################
2381: proc CTbargraphClickShowresponse { barnum } {
2382: global gBarGraph gCT gFile gUniqueNumber
2383:
2384: set num $gBarGraph($barnum.num)
2385: set canvas $gBarGraph($barnum.canvas)
2386: set bucket $gBarGraph($barnum.bucketscores)
2387:
2388: if { [catch {set datanum $gBarGraph($barnum.shownum1)}] } {
2389: set datanum [set gBarGraph($barnum.shownum1) [incr gUniqueNumber]]
2390: set winnum [set gBarGraph($barnum.shownum2) [incr gUniqueNumber]]
2391: } else {
2392: set winnum $gBarGraph($barnum.shownum2)
2393: }
2394: set gCT($winnum) ""
2395: set high [lindex [split [lindex [$canvas gettags current] 0] .] 1]
2396: foreach datum $gBarGraph($barnum) {
2397: set bar [lindex $datum 1]
2398: if { $bar != $high } { continue }
2399: CTputs $datanum "[lindex $datum 0] responses \"[lindex $datum 2]\"\n"
2400: }
2401: CToutput $winnum $datanum
2402: }
2403:
2404: ###########################################################
2405: # CTchangeBargraph
2406: ###########################################################
2407: ###########################################################
2408: ###########################################################
2409: proc CTchangeBargraph { window num } {
2410: global gBarGraph
2411:
2412: set change [toplevel $window.changeBarGraph$num]
2413:
2414: set infoFrame [frame $change.info]
2415: set buttonFrame [frame $change.button]
2416: set title [frame $change.title]
2417: set xlabel [frame $change.xlabel]
2418: set ylabel [frame $change.ylabel]
2419: set xoften [frame $change.xoften]
2420: set yoften [frame $change.yoften]
2421: set color [frame $change.color]
2422: set bucket [frame $change.bucket]
2423: set font [frame $change.font]
2424: pack $infoFrame $buttonFrame $title $xlabel $ylabel $xoften $yoften $color $bucket
2425: pack configure $title $xlabel $ylabel $xoften $yoften -anchor e -expand 1 -fill both
2426: button $buttonFrame.update -text Update -command "CTdrawBargraph $num"
2427: bind $change <Return> "CTdrawBargraph $num"
2428: button $buttonFrame.dismiss -text Dismiss -command "destroy $change"
2429: pack $buttonFrame.update $buttonFrame.dismiss -side left
2430:
2431: foreach {frame label var
2432: } "$title { Title} title
2433: $xlabel { X-Axis Label} xlabel
2434: $ylabel { Y-Axis Label} ylabel
2435: $xoften {Increment on X-Axis} xoften
2436: $yoften {Increment on Y-Axis} yoften" {
2437: label $frame.label -text $label
2438: set entryFrame [frame $frame.entry]
2439: pack $frame.label $entryFrame -side left
2440: pack configure $entryFrame -expand 1 -fill both
2441: entry $entryFrame.entry -textvariable gBarGraph($num.$var) \
2442: -xscrollcommand "$entryFrame.scroll set"
2443: scrollbar $entryFrame.scroll -orient h -command \
2444: "$entryFrame.entry xview"
2445: pack $entryFrame.entry $entryFrame.scroll -fill x
2446: }
2447:
2448: label $color.label -text "Color of Bars"
2449: label $color.color -relief ridge -background $gBarGraph($num.color) \
2450: -text " "
2451: button $color.change -text "Change" -command "CTchangeBargraphColor $color $num"
2452: pack $color.label $color.color $color.change -side left
2453:
2454: checkbutton $bucket.bucket -text "Bucket Scores" -variable \
2455: gBarGraph($num.bucketscores) -command "CTdrawBargraph $num"
2456: pack $bucket.bucket
2457: }
2458:
2459: ###########################################################
2460: # CTchangeBargraphColor
2461: ###########################################################
2462: ###########################################################
2463: ###########################################################
2464: proc CTchangeBargraphColor { color num } {
2465: global gBarGraph
2466: set temp [tk_chooseColor -initialcolor $gBarGraph($num.color)]
2467: if { $temp != "" } {
2468: $color.color configure -background [set gBarGraph($num.color) $temp]
2469: }
2470: CTdrawBargraph $num
2471: }
2472:
2473: ###########################################################
2474: # CTdisplayStudent
2475: ###########################################################
2476: ###########################################################
2477: ###########################################################
2478: proc CTdisplayStudent { num window path id } {
2479:
2480: if { ![file exists [file join $path photo gif $id.gif]] } {
2481: if { [file exists [file join $path photo jpg $id.jpg]] } {
2482: exec /usr/local/bin/djpeg -outfile [file join $path photo gif $id.gif] \
2483: [file join $path photo jpg $id.jpg]
2484: } else {
2485: return
2486: }
2487: }
2488: set image [image create photo]
2489: $image read [file join $path photo gif $id.gif]
2490:
2491: set imageWin [toplevel $window.image$num]
2492:
2493: set buttonFrame [frame $imageWin.button]
2494: set infoFrame [frame $imageWin.info]
2495: set imageFrame [frame $imageWin.image]
2496: pack $buttonFrame $infoFrame $imageFrame
2497:
2498: button $buttonFrame.dismiss -command "destroy $imageWin" -text Dismiss
2499: pack $buttonFrame.dismiss
2500:
2501: label $infoFrame.label -text $id
2502: pack $infoFrame.label
2503:
2504: set canvas [canvas $imageFrame.canvas]
2505: pack $canvas
2506: $canvas create image 1 1 -image $image -anchor nw
2507: }
2508:
2509: ###########################################################
2510: # CTgetWhen
2511: ###########################################################
2512: ###########################################################
2513: ###########################################################
2514: proc CTgetWhen { num } {
2515: set day [getString . "Enter a date"]
2516: update
2517: return $day
2518: }
2519:
2520: ###########################################################
2521: # CTscanDB
2522: ###########################################################
2523: ###########################################################
2524: ###########################################################
2525: proc CTscanDB { num file outId startdate enddate } {
2526: global answerArray exist
2527: set fileId [open $file r]
2528: set Yes_cnt 0
2529: set No_cnt 0
2530: set line_cnt 0
2531: set prob_cnt 0
2532: set maxLine [lindex [exec wc $file] 0]
2533: puts $maxLine
2534: set aline [gets $fileId]
2535: while { ! [eof $fileId] } {
2536: incr line_cnt
2537: if { ($line_cnt%20) == 0 } {
2538: puts $curdate
2539: updateStatusBar [expr $line_cnt/double($maxLine)] $num
2540: }
2541: set length [llength $aline]
2542: set date [lrange $aline 1 [expr $length - 2]]
2543: set curdate [clock scan $date]
2544: if { $curdate < $startdate } { set aline [gets $fileId]; continue }
2545: if { $curdate > $enddate } { break }
2546: set s_num [string toupper [lindex $aline 0]]
2547: set ans_char [split [lindex $aline end] ""]
2548: set usr_ans "$s_num.ans"
2549: set usr_try "$s_num.try"
2550: if {$prob_cnt == 0} { set prob_cnt [llength $ans_char] }
2551: if { [array names answerArray "$usr_ans.*"] == "" } {
2552: for {set ii 0} { $ii <= $prob_cnt } { incr ii} {
2553: set answerArray($usr_ans.$ii) "-"
2554: }
2555: }
2556: if { [array names answerArray "$usr_try.*"] == "" } {
2557: for {set ii 0} { $ii <= $prob_cnt } { incr ii} {
2558: set answerArray($usr_try.$ii) 0
2559: }
2560: }
2561: for {set ii 0} { $ii <= $prob_cnt } { incr ii} {
2562: if { [lindex $ans_char $ii] == "Y" } {
2563: set answerArray($usr_ans.$ii) "Y"
2564: incr answerArray($usr_try.$ii)
2565: }
2566: if { [lindex $ans_char $ii] == "N"} {
2567: if {$answerArray($usr_ans.$ii) != "Y"} {
2568: set answerArray($usr_ans.$ii) "Y"
2569: }
2570: incr answerArray($usr_try.$ii)
2571: }
2572: }
2573: if { [array names exist $s_num] == "" } { set exist($s_num) $s_num }
2574: set aline [gets $fileId]
2575: }
2576: close $fileId
2577: return $prob_cnt
2578: }
2579:
2580: ###########################################################
2581: # CTcreateSubset
2582: ###########################################################
2583: ###########################################################
2584: ###########################################################
2585: proc CTcreateSubset { num cmdnum day setId } {
2586: global gFile gCT answerArray exist
2587:
2588: set outId [open [file join $gFile($num) records "subset$setId.db"] w]
2589: set inId [open [file join $gFile($num) records "set$setId.db"] r]
2590:
2591: set startdate [clock scan "$day 12:00 AM"]
2592: set enddate [clock scan "$day 11:59 PM"]
2593:
2594: puts $startdate:$enddate
2595: set prob_cntt [CTscanDB $cmdnum [file join $gFile($num) records log$setId.db] $outId $startdate $enddate]
2596: puts $startdate:$enddate
2597: set prob_cntw [CTscanDB $cmdnum [file join $gFile($num) records weblog$setId.db] $outId $startdate $enddate]
2598: puts $startdate:$enddate
2599: puts "$day 12:00 AM : $day 11:59 PM"
2600: if { $prob_cntt > $prob_cntw } {
2601: set prob_cnt $prob_cntt
2602: } else {
2603: set prob_cnt $prob_cntw
2604: }
2605:
2606: puts $outId [gets $inId]
2607: puts $outId [gets $inId]
2608: puts $outId [gets $inId]
2609: foreach s_num [lsort [array names exist]] {
2610: set usr_ans $s_num.ans
2611: set usr_try $s_num.try
2612: puts -nonewline $outId "$s_num "
2613: for { set ii 0 } { $ii< $prob_cnt } { incr ii } {
2614: puts -nonewline $outId $answerArray($usr_ans.$ii)
2615: }
2616: for { set ii 0 } { $ii< $prob_cnt } { incr ii } {
2617: puts -nonewline $outId [format ",%2d" $answerArray($usr_try.$ii)]
2618: }
2619: puts $outId ""
2620: }
2621: close $outId
2622: close $inId
2623: catch {unset answerArray}
2624: catch {unset exist}
2625: }
1.2 ! albertel 2626:
! 2627: ###########################################################
! 2628: # CTdiscussForum
! 2629: ###########################################################
! 2630: ###########################################################
! 2631: ###########################################################
! 2632: proc CTdiscussForum { num file dir } {
! 2633: global gCT gFile
! 2634:
! 2635: set fileId [open $file r]
! 2636: set maxLine [lindex [exec wc $file] 0]
! 2637: set aline [gets $fileId]
! 2638: set last 0
! 2639: set line_cnt 0
! 2640: while {![eof $fileId]} {
! 2641: incr line_cnt
! 2642: if { ($line_cnt%20) == 0 } { updateStatusBar [expr $line_cnt/double($maxLine)] $num }
! 2643: foreach {stunum capaid name email action set prob date time} [split $aline "|"] {}
! 2644: if { $action == "ViewProblem" } {
! 2645: if { [catch {incr count($set,$prob)}]} {
! 2646: set count($set,$prob) 1
! 2647: if { $set > $last } { set last $set }
! 2648: if { [catch {set max($set)}]} { set max($set) 0 }
! 2649: if { $prob > $max($set)} { set max($set) $prob }
! 2650: if { [catch {set posts($set,$prob) [llength [glob $dir/discussion/$set/[format "%06d" $prob]-*-*-*.msg]]}]} { set posts($set,$prob) 0 }
! 2651: }
! 2652: set ever($name) 1
! 2653: set names($set,$name) 1
! 2654: set nameprob($set,$prob,$name) 1
! 2655: }
! 2656: set aline [gets $fileId]
! 2657: }
! 2658:
! 2659: updateStatusMessage "Generating Output" $num
! 2660: updateStatusBar 0 $num
! 2661: for {set i 1} { $i <= $last } { incr i } {
! 2662: updateStatusBar [expr $i/$last] $num
! 2663: #if { [catch {set max($i)}]} { break }
! 2664: set total($i) 0
! 2665: for {set j 1} { $j < $max($i) } { incr j } {
! 2666: set message ""
! 2667: if {[catch {set message "Set [format %2d $i] Problem [format %3d $j] [format %3d $posts($i,$j)] reponses, viewed [format %4d $count($i,$j)] times, "} ]} { continue }
! 2668: incr total($i) $count($i,$j)
! 2669: if { [catch { set ratio [expr $count($i,$j)/double($posts($i,$j))]} error]} {
! 2670: append message "ratio [format %5s [format %3.1f 0]]"
! 2671: } else {
! 2672: append message "ratio [format %5s [format %3.1f $ratio]]"
! 2673: }
! 2674: append message " from [format %3d [llength [array names nameprob $i,$j,*]]] viewers\n"
! 2675: CTputs $num $message
! 2676: }
! 2677: CTputs $num "Total views for set $i: $total($i)\n"
! 2678: }
! 2679:
! 2680: for {set i 1} { 1 } { incr i } {
! 2681: if { [catch {set max($i)}]} { break }
! 2682: CTputs $num "For set $i Num viewers:[llength [array names names $i,*]] causing $total($i) views.\n"
! 2683: }
! 2684: close $fileId
! 2685: CTputs $num "Total # of unique visitors [llength [array names ever]]\n"
! 2686: #IDEAS: stick into capastats
! 2687: # : howmany viws are repeats
! 2688: # : Student Course Profile, add #ViewProblems #Posts
! 2689: # : add some portion of these stats to analyze log files?
! 2690: }
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