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