[BACK]Return to capastats.tcl CVS log [TXT] [DIR] Up to [LON-CAPA] / capa / capa51 / GUITools

Diff for /capa/capa51/GUITools/capastats.tcl between versions 1.10 and 1.17

version 1.10, 2000/01/12 21:00:24 version 1.17, 2000/09/20 19:01:53
Line 1 Line 1
   # capastatistics generator
   #  Copyright (C) 1992-2000 Michigan State University
   #
   #  The CAPA system is free software; you can redistribute it and/or
   #  modify it under the terms of the GNU General Public License as
   #  published by the Free Software Foundation; either version 2 of the
   #  License, or (at your option) any later version.
   #
   #  The CAPA system is distributed in the hope that it will be useful,
   #  but WITHOUT ANY WARRANTY; without even the implied warranty of
   #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   #  General Public License for more details.
   #
   #  You should have received a copy of the GNU General Public
   #  License along with the CAPA system; see the file COPYING.  If not,
   #  write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
   #  Boston, MA 02111-1307, USA.
   #
   #  As a special exception, you have permission to link this program
   #  with the TtH/TtM library and distribute executables, as long as you
   #  follow the requirements of the GNU GPL in regard to all of the
   #  software in the executable aside from TtH/TtM.
   
 ###########################################################  ###########################################################
 # runCapaTools  # runCapaTools
 ###########################################################  ###########################################################
Line 28  proc runCapaTools { classDirConfigFile } Line 51  proc runCapaTools { classDirConfigFile }
   
     $utilsMenu add command -label "Change Class path" -command "CTchangePath $num"      $utilsMenu add command -label "Change Class path" -command "CTchangePath $num"
     $utilsMenu add command -label "Run capastat" -command "CTcapaStat $num"      $utilsMenu add command -label "Run capastat" -command "CTcapaStat $num"
     $utilsMenu add command -label "Run capastat2" -command "CTcapaStat2 $num"      $utilsMenu add command -label "Time Range capastat" -command "CTcapaStat2 $num"
     $utilsMenu add command -label "Summarize Log files" -command "CTlogAnalysis $num"      $utilsMenu add command -label "Summarize Log files" -command "CTlogAnalysis $num"
     $utilsMenu add command -label "Student Course Profile" -command \      $utilsMenu add command -label "Student Course Profile" -command \
  "CTstartStudentCourseProfile $num"   "CTstartStudentCourseProfile $num"
Line 96  proc CTcapaStat2 { num } { Line 119  proc CTcapaStat2 { num } {
     if { [      if { [
   catch {    catch {
       CTdatestamp $cmdnum        CTdatestamp $cmdnum
       set day [CTgetWhen $cmdnum]        if { [set day [CTgetWhen $num $cmdnum $setId]] != ""} { 
       set file [file join $gFile($num) records "subset$setId.db"]    set start [lindex $day 0]
       displayStatus "Generating [file tail $file]" both $cmdnum        set startf [clock format [lindex $day 0] -format "%b %d %R %Y"]
       CTcreateSubset $num $cmdnum $day $setId    set end [lindex $day 1]
       updateStatusBar 0.0 $cmdnum    set endf [clock format [lindex $day 1] -format "%b %d %R %Y"]
       updateStatusMessage "Generating Stats [file tail $file]" $cmdnum    set file [file join $gFile($num) records "subset$setId.db"]
       CTscanSetDB $cmdnum $file Q_cnt L_cnt    displayStatus "Generating [file tail $file]" both $cmdnum    
       updateStatusBar 0.0 $cmdnum    CTcreateSubset $num $cmdnum $start $end $setId
       updateStatusMessage "Generating Averages [file tail $file]" $cmdnum    updateStatusBar 0.0 $cmdnum
       CTpercentageScores $cmdnum $setId $L_cnt    updateStatusMessage "Generating Stats [file tail $file]" $cmdnum
       CTaverage $cmdnum $Q_cnt $L_cnt faillist dodifflist numyes    CTscanSetDB $cmdnum $file Q_cnt L_cnt
       if { $L_cnt != 0 } {    updateStatusBar 0.0 $cmdnum
   CTbargraph $gCT($num) $num [incr gUniqueNumber] $faillist $gFile($num) "Not-Yet-Correct Distribution for set $setId" "Problem \#" "%Wrong"    updateStatusMessage "Generating Averages [file tail $file]" $cmdnum
   CTbargraph $gCT($num) $num [incr gUniqueNumber] $dodifflist $gFile($num) "Degree of Difficulty Distribution for set $setId" "Problem \#" "Degree Of Diff."    CTpercentageScores $cmdnum $setId $L_cnt 1
   CTbargraph $gCT($num) $num [incr gUniqueNumber] $numyes $gFile($num) "Number of Yeses received for set $setId" "Problem \#" "\#Students"    CTaverage $cmdnum $Q_cnt $L_cnt faillist dodifflist numyes
     if { $L_cnt != 0 } {
         CTbargraph $gCT($num) $num [incr gUniqueNumber] $faillist \
     $gFile($num) \
        "Not-Yet-Correct, set $setId, for $startf -> $endf" \
     "Problem \#" "%Wrong"
         CTbargraph $gCT($num) $num [incr gUniqueNumber] $dodifflist \
     $gFile($num) \
                "Degree of Difficulty, set $setId, for $startf-$endf" \
     "Problem \#" "Deg. Of Diff."
         CTbargraph $gCT($num) $num [incr gUniqueNumber] $numyes \
     $gFile($num) \
                "Number of Yeses, set $setId, for $startf -> $endf" \
     "Problem \#" "\#Students"
     }
     CToutput $num $cmdnum
     removeStatus $cmdnum
       }        }
       removeStatus $cmdnum  
       CToutput $num $cmdnum  
   } errors ] } {    } errors ] } {
  global errorCode errorInfo   global errorCode errorInfo
  displayError "$errors\n$errorCode\n$errorInfo"   displayError "$errors\n$errorCode\n$errorInfo"
Line 444  proc CTanalyzeReport { num } { Line 481  proc CTanalyzeReport { num } {
 proc CTanalyzeScorer { num } {  proc CTanalyzeScorer { num } {
     global gFile gUniqueNumber gCapaConfig gCT          global gFile gUniqueNumber gCapaConfig gCT    
     set cmdnum [incr gUniqueNumber]      set cmdnum [incr gUniqueNumber]
   #    puts "CTanalyzeScorer $cmdnum"
     set gCT(cmd.$cmdnum) analyzescorer      set gCT(cmd.$cmdnum) analyzescorer
     if { "" == [set file [tk_getOpenFile -title "Pick a scorer.output file" -filetypes { { {scorer.output} {scorer.output.*} } { {Submissions File} {*submissions*.db} } { {All Files} {*} } }]] } { return }      if { "" == [set file [tk_getOpenFile -title "Pick a scorer.output file" -filetypes { { {scorer.output} {scorer.output.*} } { {Submissions File} {*submissions*.db} } { {All Files} {*} } }]] } { return }
     set path [file dirname [file dirname $file]]      set path [file dirname [file dirname $file]]
Line 471  proc CTanalyzeScorer { num } { Line 509  proc CTanalyzeScorer { num } {
     cd $pwd      cd $pwd
 }  }
   
 proc CTcontinueAnalyze { num path arrayVar } {  proc CTcontinueAnalyze { cmdnum path arrayData } {
     global gCT gResponse  #    puts "CTcontinueAnalyze $cmdnum"
     upvar $arrayVar question      global gCT gResponse gGetSet
     CTgetQuestions $num question      array set question $arrayData
     set numAdded 0      while {1} {
     foreach which $gCT($num.questNum) {   CTgetQuestions $cmdnum question
  incr numAdded [CTgetStudentResponses $num [lindex $gCT($num.response) \   set numAdded 0
        [expr $which-1]] $which \   foreach which $gCT($cmdnum.questNum) {
    question]      # puts $gCT($cmdnum.response)
     }      incr numAdded [CTgetStudentResponses $cmdnum [lindex $gCT($cmdnum.response) \
     updateStatusBar [expr $gCT($num.done)/double($gCT($num.max))] $num        [expr $which-1]] $which \
     if { $numAdded > 0 } { CTupdateAnalyzeScorer $num }         question]
     set interesting 0      # puts $numAdded
     while {!$interesting} {   }
  incr gCT($num.done)   #    puts "end"
  set stunum $gCT($num.question)   updateStatusBar [expr $gCT($cmdnum.done)/double($gCT($cmdnum.max))] $cmdnum
  set aline [gets $gCT($num.fileId)]   if { $numAdded > 0 } { CTupdateAnalyzeScorer $cmdnum }
  if { [eof $gCT($num.fileId)] } { CTfinishAnalyzeScorer $num; return }   set interesting 0
  set interesting [$gCT($num.parse) $aline $num]   while {!$interesting} {
     }      incr gCT($cmdnum.done)
     if { $stunum != $gCT($num.question) } {      set stunum $gCT($cmdnum.question)
  set pwd [pwd];cd $path      set aline [gets $gCT($cmdnum.fileId)]
  getSet $gCT($num.question) $gCT($num.setId) "CTcontinueAnalyze $num $path"      if { [eof $gCT($cmdnum.fileId)] } { CTfinishAnalyzeScorer $cmdnum; return }
  cd $pwd      set interesting [$gCT($cmdnum.parse) $aline $cmdnum]
     } else {   }
  CTcontinueAnalyze $num $path question   if { $stunum != $gCT($cmdnum.question) } {
       set pwd [pwd];cd $path
       getSet $gCT($cmdnum.question) $gCT($cmdnum.setId) \
    "CTcontinueAnalyze $cmdnum $path"
       cd $pwd
       break
    } 
     }      }
   #    puts "After Continue Analyze"
 }  }
   
 proc CTupdateAnalyzeScorer { cmdnum } {  proc CTupdateAnalyzeScorer { cmdnum } {
   #    puts "CTupdateAnalyzeScorer $cmdnum"
     global gCT gResponse gUniqueNumber gFile      global gCT gResponse gUniqueNumber gFile
     set num $gCT($cmdnum.num)      set num $gCT($cmdnum.num)
     set i 0      set i 0
Line 508  proc CTupdateAnalyzeScorer { cmdnum } { Line 554  proc CTupdateAnalyzeScorer { cmdnum } {
  set probnum [lindex [split $correct .] 2]   set probnum [lindex [split $correct .] 2]
  set answer [join [lrange [split $correct .] 3 end] .]   set answer [join [lrange [split $correct .] 3 end] .]
  if { $gResponse($correct) } {   if { $gResponse($correct) } {
     set color($probnum.$answer) green      set color($probnum.$answer) grey90
       set color($probnum.$answer.unpicked) grey10
  } else {   } else {
     set color($probnum.$answer) red      set color($probnum.$answer) grey30
       set color($probnum.$answer.unpicked) grey70
  }   }
     }      }
     set results ""      set results ""
     set oldprobnum [lindex [split [lindex [lsort [array names gResponse $cmdnum.\[0-9\]*]] 0] .] 1]  
     foreach response [lsort -dictionary [array names gResponse $cmdnum.\[0-9\]*]] {      foreach response [lsort -dictionary [array names gResponse $cmdnum.\[0-9\]*]] {
           incr i
    set responselm [split $response .]
    set probnum [lindex $responselm 1]
    if { [lindex $responselm 2] == "unpicked" } {
       set answerfull [join [lrange $responselm 3 end] .]
       set colorstring "$probnum.$answerfull.unpicked"
       append answerfull " - Unpicked"
       set answertemp [split [join [lrange $responselm 3 end] .] -]
       set picked 0
    } else {
       set answerfull [join [lrange $responselm 2 end] .]
       set colorstring "$probnum.$answerfull"
       append answerfull " - Picked"
       set answertemp [split [join [lrange $responselm 2 end] .] -]
       set picked 1
    }
    set answernum [llength $answertemp]
    set answer [join [lrange $answertemp 0 [expr $answernum - 2]] -]
    if { " Correct" == [lindex $answertemp end] } {
       if { $picked } { set pos 0 } { set pos 3 }
    } { if { $picked } { set pos 2 } { set pos 1 } }
   
    if { [catch {set resultsAr($probnum.$answer.y)} ] } {
       set resultsAr($probnum.$answer.y) "0 0 0 0"
       set resultsAr($probnum.$answer.description) "{} {} {} {}"
       set resultsAr($probnum.$answer.color) "green green green green"
    } 
    set resultsAr($probnum.$answer.y) [lreplace $resultsAr($probnum.$answer.y) \
          $pos $pos $gResponse($response)]
    set resultsAr($probnum.$answer.description) [lreplace \
    $resultsAr($probnum.$answer.description) \
    $pos $pos $answerfull]
    set resultsAr($probnum.$answer.color) [lreplace \
                                           $resultsAr($probnum.$answer.color) $pos $pos \
    $color($colorstring)]
       }
       set i 0
       set oldprobnum ""
       foreach name [lsort -dictionary [array names resultsAr "*.y"]] {
  incr i   incr i
  set probnum [lindex [split $response .] 1]   set name [split $name .]
    set namelength [llength $name]
    set answer [join [lrange $name 1 [expr $namelength - 2]] .]
    set probnum [lindex $name 0]
  if { $probnum > $oldprobnum } {   if { $probnum > $oldprobnum } {
       if { $oldprobnum != "" } {
    lappend results [list 0 0 "Problem Divider" white]
       }
     set oldprobnum $probnum      set oldprobnum $probnum
     lappend results [list 0 0 "Problem Divider" white]  
  }   }
  set answer [join [lrange [split $response .] 2 end] .]   lappend results [list $resultsAr($probnum.$answer.y) $i $resultsAr($probnum.$answer.description) $resultsAr($probnum.$answer.color)]
  lappend results [list $gResponse($response) $i $answer $color($probnum.$answer)]  
     }      }
     if { $results == "" } { return }      if { $results == "" } { return }
     if { $gCT($cmdnum.graphup)} {      if { $gCT($cmdnum.graphup)} {
Line 538  proc CTupdateAnalyzeScorer { cmdnum } { Line 628  proc CTupdateAnalyzeScorer { cmdnum } {
   
 proc CTsaveAnalyzeScorer { num cmdnum } {  proc CTsaveAnalyzeScorer { num cmdnum } {
     global gResponse gCT gFile      global gResponse gCT gFile
     set file [tk_getSaveFile -initialdir $gFile($num)]  
     set fileId [open $file w]      if { $gCT(spinlock) } { after 50 "CTsaveAnalyzeScorer $num $cmdnum"; return } 
     puts $fileId [array get gResponse "$cmdnum.*"]  
     close $fileId      set gCT(spinlock) 1
       if { "Yes" ==[makeSure "Would you like to save the results to a file?"] } {
    set file [tk_getSaveFile -initialdir $gFile($num)]
    set fileId [open $file w]
    puts $fileId [array get gResponse "$cmdnum.*"]
    close $fileId
       }
       set gCT(spinlock) 0
       unset gCT(cmd.$cmdnum)
       CToutput $num $cmdnum
   
 }  }
   
 proc CTfinishAnalyzeScorer { cmdnum } {  proc CTfinishAnalyzeScorer { cmdnum } {
Line 555  proc CTfinishAnalyzeScorer { cmdnum } { Line 655  proc CTfinishAnalyzeScorer { cmdnum } {
  set answer [join [lrange [split $correct .] 3 end] .]   set answer [join [lrange [split $correct .] 3 end] .]
  if { $gResponse($correct) } {   if { $gResponse($correct) } {
     set color($probnum.$answer) green      set color($probnum.$answer) green
       set color($probnum.$answer.unpicked) orange
  } else {   } else {
     set color($probnum.$answer) red      set color($probnum.$answer) red
       set color($probnum.$answer.unpicked) blue
  }   }
     }      }
     foreach response [lsort -dictionary [array names gResponse $cmdnum.\[0-9\]*]] {      foreach response [lsort -dictionary [array names gResponse $cmdnum.\[0-9\]*]] {
           incr i
    set responselm [split $response .]
    set probnum [lindex $responselm 1]
    if { [lindex $responselm 2] == "unpicked" } {
       set answerfull [join [lrange $responselm 3 end] .]
       set colorstring "$probnum.$answerfull.unpicked"
       append answerfull " - Unpicked"
       set answertemp [split [join [lrange $responselm 3 end] .] -]
       set picked 0
    } else {
       set answerfull [join [lrange $responselm 2 end] .]
       set colorstring "$probnum.$answerfull"
       append answerfull " - Picked"
       set answertemp [split [join [lrange $responselm 2 end] .] -]
       set picked 1
    }
    set answernum [llength $answertemp]
    set answer [join [lrange $answertemp 0 [expr $answernum - 2]] -]
    if { " Correct" == [lindex $answertemp end] } {
       if { $picked } { set pos 0 } { set pos 3 }
    } { if { $picked } { set pos 2 } { set pos 1 } }
   
    if { [catch {set resultsAr($probnum.$answer.y)} ] } {
       set resultsAr($probnum.$answer.y) "0 0 0 0"
       set resultsAr($probnum.$answer.description) "{} {} {} {}"
       set resultsAr($probnum.$answer.color) "green green green green"
    } 
    set resultsAr($probnum.$answer.y) [lreplace $resultsAr($probnum.$answer.y) \
          $pos $pos $gResponse($response)]
    set resultsAr($probnum.$answer.description) [lreplace \
    $resultsAr($probnum.$answer.description) \
    $pos $pos $answerfull]
    set resultsAr($probnum.$answer.color) [lreplace \
                                           $resultsAr($probnum.$answer.color) $pos $pos \
    $color($colorstring)]
       }
       set i 0
       foreach name [array names resultsAr "*.y"] {
  incr i   incr i
  set probnum [lindex [split $response .] 1]   set name [split $name .]
  set answer [join [lrange [split $response .] 2 end] .]   set namelength [llength $name]
  lappend results($probnum) [list $gResponse($response) $i $answer $color($probnum.$answer)]   set answer [join [lrange $name 1 [expr $namelength - 2]] .]
     }       set probnum [lindex $name 0]
    lappend results($probnum) [list $resultsAr($probnum.$answer.y) $i $resultsAr($probnum.$answer.description) $resultsAr($probnum.$answer.color)]
       }
     foreach probnum [lsort -dictionary [array names results]] {      foreach probnum [lsort -dictionary [array names results]] {
  CTputs $cmdnum "\nFor Problem $probnum #, Responses:\n"   CTputs $cmdnum "\nFor Problem $probnum #, Responses:\n"
  foreach response $results($probnum) {   foreach response $results($probnum) {
     CTputs $cmdnum "[lindex $response 0], [lindex $response 2]\n"      CTputs $cmdnum "[lindex $response 0], [lindex $response 2]\n"
  }   }
     }      }
     if { "Yes" ==[makeSure "Would you like to save the results to a file?"] } {      if { [catch {set gCT(spinlock)}] } { set gCT(spinlock) 0 }
  CTsaveAnalyzeScorer $num $cmdnum      CTsaveAnalyzeScorer $num $cmdnum
     }  
     unset gCT(cmd.$cmdnum)  
     CToutput $num $cmdnum  
 }  }
   
 proc CTparseScorerOutputLine { aline num } {  proc CTparseScorerOutputLine { aline num } {
   #    puts "CTparseScorerOutputLine $num"
     global gCT      global gCT
     set gCT($num.stunum) [lindex $aline 0]      set gCT($num.stunum) [lindex $aline 0]
     set aline [string range $aline 40 end]      set aline [string range $aline 40 end]
Line 590  proc CTparseScorerOutputLine { aline num Line 730  proc CTparseScorerOutputLine { aline num
 }  }
   
 proc CTparseSubmissionsLine { aline num } {  proc CTparseSubmissionsLine { aline num } {
   #    puts "CTparseSubmissionsLine $num"
     global gCT      global gCT
     set aline [split $aline \t]      set aline [split $aline \t]
     set gCT($num.stunum) [lindex $aline 0]      set gCT($num.stunum) [lindex $aline 0]
Line 597  proc CTparseSubmissionsLine { aline num Line 738  proc CTparseSubmissionsLine { aline num
     set gCT($num.response) ""      set gCT($num.response) ""
     set interesting 0      set interesting 0
     set current 1      set current 1
     foreach {quest response} [lrange $aline 2 end] {      foreach element [lrange $aline 2 end] {
    set quest [lindex [split $element " "] 0]
    set response [lindex [split $element " "] 1]
  if { $quest == "" } break   if { $quest == "" } break
  while { $quest > $current } {   while { $quest > $current } {
     lappend gCT($num.response) {}      lappend gCT($num.response) {}
Line 611  proc CTparseSubmissionsLine { aline num Line 754  proc CTparseSubmissionsLine { aline num
 }  }
   
 proc CTgetQuestions { num questionVar } {  proc CTgetQuestions { num questionVar } {
   #    puts "CTgetQuestions $num"
     global gCT      global gCT
     upvar $questionVar question      upvar $questionVar question
 #    parray question  #    parray question
Line 630  proc CTgetQuestions { num questionVar } Line 774  proc CTgetQuestions { num questionVar }
     }      }
 }  }
   
 proc CTgetStudentResponses { num responses which questionVar } {  proc CTgetStudentResponses2 { num responses which questionVar } {
     global gCT gResponse      global gCT gResponse
     upvar $questionVar question      upvar $questionVar question
 #    parray question  #    parray question
Line 641  proc CTgetStudentResponses { num respons Line 785  proc CTgetStudentResponses { num respons
  if { [catch {incr gResponse($num.$which.$question($which.$response))}] } {   if { [catch {incr gResponse($num.$which.$question($which.$response))}] } {
     if {[catch {set gResponse($num.$which.$question($which.$response)) 1}]} {      if {[catch {set gResponse($num.$which.$question($which.$response)) 1}]} {
                 #set gResponse($num.$which.Illegal\ Bubble) 1                  #set gResponse($num.$which.Illegal\ Bubble) 1
  puts "not an option $response $which"  # puts "not an option $response $which"
  continue   continue
             }                  }    
  }   }
Line 654  proc CTgetStudentResponses { num respons Line 798  proc CTgetStudentResponses { num respons
     return $i      return $i
 }  }
   
   proc CTgetStudentResponses { num responses which questionVar } {
   #    puts "CTgetStudentResponses $num"
       global gCT gResponse
       upvar $questionVar question
   #    parray question
       set i 0
       if {$responses == ""} { return 0 } 
       if { [string toupper $responses] == "NONE" } { set responses "" }
       set response [split $responses {}]
       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} {
    if { [catch {set question($which.correct.$letter)}]} { 
   #    puts "skipping out on $letter"
       break 
    }
    incr i
    if { [lsearch $response $letter] == -1 } {
       # unpicked
       if { [catch {incr gResponse($num.$which.unpicked.$question($which.$letter))}] } {
    if {[catch {set gResponse($num.$which.unpicked.$question($which.$letter)) 1}]} {
       #set gResponse($num.$which.Illegal\ Bubble) 1
   #    puts "not an option $letter $which"
       continue
    }    
       }
    } else {
       # picked
       if { [catch {incr gResponse($num.$which.$question($which.$letter))}] } {
    if {[catch {set gResponse($num.$which.$question($which.$letter)) 1}]} {
       #set gResponse($num.$which.Illegal\ Bubble) 1
   #    puts "not an option $letter $which"
       continue
    }    
       }
    }
    if { $question($which.correct.$letter) } {
       set gResponse($num.correct.$which.$question($which.$letter)) 1
    } else {
       set gResponse($num.correct.$which.$question($which.$letter)) 0
    }
       }
       return $i
   }
   
 ###########################################################  ###########################################################
 # CTgraphAnalyzeScorer  # CTgraphAnalyzeScorer
 ###########################################################  ###########################################################
Line 673  proc CTgraphAnalyzeScorer { num } { Line 860  proc CTgraphAnalyzeScorer { num } {
     }      }
     unset temp      unset temp
     foreach name [array names gResponse $cmdnum.\[0-9\]*] {      foreach name [array names gResponse $cmdnum.\[0-9\]*] {
  puts "[split $name .]"  
  puts "[lindex [split $name .] 1]"  
  lappend probnums [lindex [split $name .] 1]   lappend probnums [lindex [split $name .] 1]
     }       } 
     set probnums [lsort [lunique $probnums]]      set probnums [lsort [lunique $probnums]]
Line 685  proc CTgraphAnalyzeScorer { num } { Line 870  proc CTgraphAnalyzeScorer { num } {
  set probnum [lindex [split $name .] 1]   set probnum [lindex [split $name .] 1]
  if { -1 == [lsearch $probnums $probnum] } {   if { -1 == [lsearch $probnums $probnum] } {
     set answer [join [lrange [split $name .] 2 end] .]      set answer [join [lrange [split $name .] 2 end] .]
     unset gResponse($name)      catch {unset gResponse($name)}
     unset gResponse($cmdnum.correct.$probnum.$answer)      catch {unset gResponse($cmdnum.correct.$probnum.$answer)}
  }   }
     }      }
     set gCT($cmdnum.num) $num      set gCT($cmdnum.num) $num
Line 830  proc CTscanSetDB { num file Q_cntVar L_c Line 1015  proc CTscanSetDB { num file Q_cntVar L_c
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 proc CTpercentageScores { num setId valid_cnt } {  proc CTpercentageScores { num setId valid_cnt {subset 0}} {
     global gTotal_weight gTotal_scores       global gTotal_weight gTotal_scores 
       
       if { $subset } { set setstr "subset" } else { set setstr "set" }
     if { $gTotal_weight($num) > 0 } {      if { $gTotal_weight($num) > 0 } {
  set ratio [expr double($gTotal_scores($num)) / double($gTotal_weight($num))]   set ratio [expr double($gTotal_scores($num)) / double($gTotal_weight($num))]
  set ratio [expr $ratio * 100.0 ]   set ratio [expr $ratio * 100.0 ]
  CTputs $num "\nScore (total scores / total valid weights) for set$setId.db: [format %7.2f%% $ratio]\n"    CTputs $num "\nScore (total scores / total valid weights) for $setstr$setId.db: [format %7.2f%% $ratio]\n" 
     }      }
     CTputs $num "The number of valid records for set$setId.db is: $valid_cnt\n"      CTputs $num "The number of valid records for $setstr$setId.db is: $valid_cnt\n"
 }  }
   
 ###########################################################  ###########################################################
Line 1099  proc CTcollectSetScores { num path id on Line 1285  proc CTcollectSetScores { num path id on
     set char [lindex $ans_char $i]      set char [lindex $ans_char $i]
     if { $char == "N" || $char == "n"} { set found 1 }      if { $char == "N" || $char == "n"} { set found 1 }
     if { $char == "Y" || $char == "y"} {       if { $char == "Y" || $char == "y"} { 
  incr score [lindex $weights $i];set found 1   catch {incr score [lindex $weights $i]}
    set found 1
     }      }
     if { $char >= 0 && $char <= 9 } {       if { $char >= 0 && $char <= 9 } { 
  incr score $char;set found 1   incr score $char;set found 1
     }      }
     if { $char == "E" } {      if { $char == "E" } {
  incr valid_weights "-[lindex $weights $i]"   catch {incr valid_weights "-[lindex $weights $i]"}
     }      }
  }   }
  incr total_scores $score   incr total_scores $score
Line 1286  proc CTstudentLoginData { num filename i Line 1473  proc CTstudentLoginData { num filename i
     set U_total 0       set U_total 0 
     set u_total 0       set u_total 0 
     set S_total 0      set S_total 0
       set s_total 0
     set maxLine [expr double([lindex [exec wc $filename] 0])]      set maxLine [expr double([lindex [exec wc $filename] 0])]
     set line_cnt 0      set line_cnt 0
     set fileId [open $filename "r"]      set fileId [open $filename "r"]
Line 1305  proc CTstudentLoginData { num filename i Line 1493  proc CTstudentLoginData { num filename i
  } elseif {[lindex $ans_char $i] == "N"} { incr N_total    } elseif {[lindex $ans_char $i] == "N"} { incr N_total 
  } elseif {[lindex $ans_char $i] == "U"} { incr U_total    } elseif {[lindex $ans_char $i] == "U"} { incr U_total 
  } elseif {[lindex $ans_char $i] == "u"} { incr u_total    } elseif {[lindex $ans_char $i] == "u"} { incr u_total 
    } elseif {[lindex $ans_char $i] == "s"} { incr s_total 
  } elseif {[lindex $ans_char $i] == "S"} { incr S_total }   } elseif {[lindex $ans_char $i] == "S"} { incr S_total }
     }      }
  }   }
Line 1572  proc CTitemCorrelation { num classpath s Line 1761  proc CTitemCorrelation { num classpath s
  ## $ans_char($ii) is one of 0 .. 9, Y, y, N, n   ## $ans_char($ii) is one of 0 .. 9, Y, y, N, n
  ## $ans_char($jj) is one of 0 .. 9, Y, y, N, n   ## $ans_char($jj) is one of 0 .. 9, Y, y, N, n
  if { $ans_char($ii) == "Y" || $ans_char($ii) == "y" } {   if { $ans_char($ii) == "Y" || $ans_char($ii) == "y" } {
     set x_data [lindex $weights $ii]      if {[set x_data [lindex $weights $ii]]==""} {set x_data 0}
  } elseif { $ans_char($ii) == "N" || $ans_char($ii) == "n" } {   } elseif { $ans_char($ii) == "N" || $ans_char($ii) == "n" } {
     set x_data 0      set x_data 0
  } else { ## must be in 0 .. 9   } else { ## must be in 0 .. 9
     set x_data $ans_char($ii)      set x_data $ans_char($ii)
  }   }
  if { $ans_char($jj) == "Y" || $ans_char($jj) == "y" } {   if { $ans_char($jj) == "Y" || $ans_char($jj) == "y" } {
     set y_data [lindex $weights $jj]      if {[set y_data [lindex $weights $jj]]==""} {set y_data 0}
  } elseif { $ans_char($jj) == "N" || $ans_char($jj) == "n" } {   } elseif { $ans_char($jj) == "N" || $ans_char($jj) == "n" } {
     set y_data 0      set y_data 0
  } else { ## must be in 0 .. 9   } else { ## must be in 0 .. 9
Line 1720  proc CTreportDist { num file percentage Line 1909  proc CTreportDist { num file percentage
  }   }
  set aline [gets $fileId]   set aline [gets $fileId]
     }      }
     CTputs $num "Scores #acheived\n"      CTputs $num "Scores #achieved\n"
     set scorelist ""      set scorelist ""
     set templist [array names totals *.score]      set templist [array names totals *.score]
     foreach temp $templist {lappend possiblescores [lindex [split $temp .] 0]}      foreach temp $templist {lappend possiblescores [lindex [split $temp .] 0]}
Line 1797  proc CTgradeDistribution { num classpath Line 1986  proc CTgradeDistribution { num classpath
     removeStatus $num      removeStatus $num
     displayStatus "Pondering data . . ." spinner $num      displayStatus "Pondering data . . ." spinner $num
     CTputs $num " There are $valid_cnt entries in file $filename\n"      CTputs $num " There are $valid_cnt entries in file $filename\n"
     CTputs $num "Score #acheived\n"      CTputs $num "Score #achieved\n"
     set scorelist ""      set scorelist ""
     foreach score [lsort -integer [array names total_score]] {      foreach score [lsort -integer [array names total_score]] {
  CTputs $num [format "%5d:%6d\n" $score $total_score($score)]   CTputs $num [format "%5d:%6d\n" $score $total_score($score)]
Line 1884  proc CTgradeDistributionRange { num clas Line 2073  proc CTgradeDistributionRange { num clas
  set total_score($i) 0   set total_score($i) 0
     }      }
     foreach sNum [array names studentScores] { incr total_score($studentScores($sNum)) }      foreach sNum [array names studentScores] { incr total_score($studentScores($sNum)) }
     CTputs $num "Scores #acheived\n"      CTputs $num "Scores #achieved\n"
     set scorelist ""      set scorelist ""
     foreach score [lsort -integer [array names total_score]] {      foreach score [lsort -integer [array names total_score]] {
  CTputs $num [format "%5d:%6d\n" $score $total_score($score)]   CTputs $num [format "%5d:%6d\n" $score $total_score($score)]
Line 2124  proc CTbargraph {window num barnum data Line 2313  proc CTbargraph {window num barnum data
     set gBarGraph($barnum.ylabel) $ylabel      set gBarGraph($barnum.ylabel) $ylabel
     set gBarGraph($barnum.color) green      set gBarGraph($barnum.color) green
     set gBarGraph($barnum.bucketscores) 0      set gBarGraph($barnum.bucketscores) 0
     CTautoscaleBargraph $barnum      set gBarGraph($barnum.ymax) [CTautoscaleBargraph $barnum]
       set gBarGraph($barnum.ymaxold) $gBarGraph($barnum.ymax)
     CTdrawBargraph $barnum      CTdrawBargraph $barnum
 }  }
   
 ###########################################################  ###########################################################
   # CTmaxBargraph
   ###########################################################
   ###########################################################
   ###########################################################
   proc CTmaxBargraph { barnum } {
       global gBarGraph
   
       set data $gBarGraph($barnum)
       set total [llength $data]
       set howoften $gBarGraph($barnum.xoften)
       set when [expr ($total-1)%$howoften]
       set max 0
       set i 0
       set value 0
       if { $gBarGraph($barnum.bucketscores) } {
    foreach datum $data {
       set value [expr {$value + [lindex $datum 0]}]
       if { $i % $howoften == $when } {
    if { $value > $max } { set max $value }
    set value 0
       }
       incr i
    }
       } else {
    set max [lindex [lindex [lsort -decreasing -index 0 -real $data] 0] 0]
       }
       if { $max > int($max) } { set max [expr int($max+1)] }
       set gBarGraph($barnum.ymaxold) [set gBarGraph($barnum.ymax) $max]
       return $max
   }
   
   proc CTsort { arg1 arg2 } {
       set arg1 [eval expr [join [lindex $arg1 0] +]]
       set arg2 [eval expr [join [lindex $arg2 0] +]]
       if { $arg1 < $arg2 } { return -1 }
       if { $arg1 > $arg2 } { return 1 }
       return 0
   }
   
   ###########################################################
 # CTautoscaleBargraph  # CTautoscaleBargraph
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
Line 2136  proc CTbargraph {window num barnum data Line 2366  proc CTbargraph {window num barnum data
 proc CTautoscaleBargraph { barnum } {  proc CTautoscaleBargraph { barnum } {
     global gBarGraph      global gBarGraph
     set data $gBarGraph($barnum)      set data $gBarGraph($barnum)
     set max [lindex [lindex [lsort -decreasing -index 0 -real $data] 0] 0]      if { [catch {set max [lindex [lindex [lsort -decreasing -index 0 -real $data] 0] 0]}] } {
    set max [lindex [lindex [lsort -decreasing -command CTsort $data] 0] 0]
    set max [eval expr [join $max +]]
       }
     if { $max > int($max) } { set max [expr int($max+1)] }      if { $max > int($max) } { set max [expr int($max+1)] }
     set gBarGraph($barnum.yoften) [expr int([format "%1.e" [expr $max/10.0]])]      set gBarGraph($barnum.yoften) [expr int([format "%1.e" [expr $max/10.0]])]
     if { $gBarGraph($barnum.yoften) == 0 } { set gBarGraph($barnum.yoften) 1 }      if { $gBarGraph($barnum.yoften) == 0 } { set gBarGraph($barnum.yoften) 1 }
     set total [llength $data]      set total [llength $data]
     set gBarGraph($barnum.xoften) [expr ($total/25) + 1]      set gBarGraph($barnum.xoften) [expr ($total/25) + 1]
       return $max
 }  }
   
 ###########################################################  ###########################################################
Line 2152  proc CTautoscaleBargraph { barnum } { Line 2386  proc CTautoscaleBargraph { barnum } {
 proc CTchangeBargraphData { barnum data } {  proc CTchangeBargraphData { barnum data } {
     global gBarGraph      global gBarGraph
     set gBarGraph($barnum) $data      set gBarGraph($barnum) $data
     CTautoscaleBargraph $barnum      set gBarGraph($barnum.ymax) [CTautoscaleBargraph $barnum]
       set gBarGraph($barnum.ymaxold) $gBarGraph($barnum.ymax)
     CTdrawBargraph $barnum      CTdrawBargraph $barnum
 }  }
   
Line 2209  proc CTdrawBargraph { num } { Line 2444  proc CTdrawBargraph { num } {
     set value 0      set value 0
     if { $gBarGraph($num.bucketscores) } {      if { $gBarGraph($num.bucketscores) } {
  foreach datum $data {   foreach datum $data {
     set value [expr {$value + [lindex $datum 0]}]      set value [eval expr $value + [join [lindex $datum 0] +]]
     if { $i % $howoften == $when } {      if { $i % $howoften == $when } {
  if { $value > $max } { set max $value }   if { $value > $max } { set max $value }
  set value 0   set value 0
Line 2217  proc CTdrawBargraph { num } { Line 2452  proc CTdrawBargraph { num } {
     incr i      incr i
  }   }
     } else {      } else {
  set max [lindex [lindex [lsort -decreasing -index 0 -real $data] 0] 0]   if { [catch {set max [lindex [lindex [lsort -decreasing -index 0 -real $data] 0] 0]}] } {
       set max [lindex [lindex [lsort -decreasing -command CTsort $data] 0] 0]
       set max [eval expr [join $max +]]
    }
     }      }
     if { $max > int($max) } { set max [expr int($max+1)] }      if { $max > int($max) } { set max [expr int($max+1)] }
       if { $gBarGraph($num.ymaxold) != $gBarGraph($num.ymax) } { 
    set max $gBarGraph($num.ymax)
       }
     if { [catch {set pixelvalue [expr ($graphheight-1)/double($max)]} ] } {      if { [catch {set pixelvalue [expr ($graphheight-1)/double($max)]} ] } {
  set pixelvalue 10   set pixelvalue 10
     }      }
   
     set i 0      set i 0
     set value 0      set value 0
     foreach datum $data {      foreach datum $data {
  set value [expr {$value + [lindex $datum 0]}]  # puts ":$datum:"
  set which [lindex $datum 1]   if { [llength [lindex $datum 0]] == 1 } {
  set y1 [expr {$graphheight + $titleheight}]      set value [expr {$value + [lindex $datum 0]}]
  set x2 [expr {$eachwidth * ($i+1) + $textwidth}]       CTdrawBargraphBar
  set y2 [expr {($graphheight-1) + $titleheight - $value * $pixelvalue}]      incr i
  set tag bar.$which.[expr $which-$howoften]   } else {
  if { [set color [lindex $datum 3]] == "" } {set color $gBarGraph($num.color)}      set value [eval expr $value + [join [lindex $datum 0] +]]
  if { $gBarGraph($num.bucketscores) && ($i % $howoften == $when) } {      CTdrawBargraphBarN
     if { $i == $when } {      incr i
 # puts "$value-$which-$howoften"  
  $canvas create rectangle $textwidth \  
     $y1 $x2 $y2 -fill $color -tag $tag  
     } else {  
 # puts "$value:$which:$howoften"  
  $canvas create rectangle [expr {$eachwidth*($i-$howoften+1)+$textwidth}]\  
     $y1 $x2 $y2 -fill $color -tag $tag  
     }  
  } elseif { !$gBarGraph($num.bucketscores) } {  
     $canvas create rectangle [expr {$eachwidth * $i + $textwidth}] \  
  $y1 $x2 $y2 -fill $color -tag bar.$which.[expr $which-1]  
     set value 0  
  }  
  if { $i % $howoften == $when } {  
     $canvas create text [expr {$eachwidth * $i + $textwidth + $eachwidth/2}] \  
  [expr $graphheight+(($tickheight)/2)+$titleheight] -text $which  
     set value 0  
  }   }
  incr i  
     }      }
   #    puts "value:$value:"
   
     #draw title      #draw title
     $canvas create text [expr $textwidth+$titleoffset+($graphwidth/2)] 1 -anchor n\      $canvas create text [expr $textwidth+$titleoffset+($graphwidth/2)] 1 -anchor n\
Line 2287  proc CTdrawBargraph { num } { Line 2512  proc CTdrawBargraph { num } {
     }      }
 }  }
   
   proc CTdrawBargraphBar { } {
       global gBarGraph
       uplevel 1 {
    set canvas $gBarGraph($num.canvas)
   
    set which [lindex $datum 1]
    set y1 [expr {$graphheight + $titleheight}]
    set x2 [expr {$eachwidth * ($i+1) + $textwidth}] 
    set y2 [expr {($graphheight-1) + $titleheight - $value * $pixelvalue}]
    set tag bar.$which.[expr $which-$howoften]
    if { [set color [lindex $datum 3]] == "" } {set color $gBarGraph($num.color)}
    if { $gBarGraph($num.bucketscores) && ($i % $howoften == $when) } {
       if { $i == $when } {
    # puts "$value-$which-$howoften"
    $canvas create rectangle $textwidth \
       $y1 $x2 $y2 -fill $color -tag $tag
       } else {
    # puts "$value:$which:$howoften"
    $canvas create rectangle [expr {$eachwidth*($i-$howoften+1)+$textwidth}]\
       $y1 $x2 $y2 -fill $color -tag $tag
       }
    } elseif { !$gBarGraph($num.bucketscores) } {
       $canvas create rectangle [expr {$eachwidth * $i + $textwidth}] \
    $y1 $x2 $y2 -fill $color -tag bar.$which.[expr $which-1]
       set value 0
    }
    if { $i % $howoften == $when } {
       $canvas create text [expr {$eachwidth * $i + $textwidth + $eachwidth/2}] \
    [expr $graphheight+(($tickheight)/2)+$titleheight] -text $which
       set value 0
    }
       }
   }
   
   proc CTdrawBargraphBarN { } {
       global gBarGraph
       uplevel 1 {
    set canvas $gBarGraph($num.canvas)
   
    set which [lindex $datum 1]
    set y1 [expr {$graphheight + $titleheight}]
    set x2 [expr {$eachwidth * ($i+1) + $textwidth}] 
    set tag bar.$which.[expr $which-$howoften]
    set subpoint 0
    for {set j 0} {$j < [llength [lindex $datum 0]]} {incr j} {
       set subpointincr [lindex [lindex $datum 0] $j]
       if { $subpointincr == 0 } { continue }
       incr subpoint $subpointincr
       set y2 [expr {($graphheight-1) + $titleheight - $subpoint * $pixelvalue}]
       set tag bar.$which.[expr $which-$howoften].$j
       if { [set color [lindex [lindex $datum 3] $j]] == ""}  {
    set color $gBarGraph($num.color)
       }
       if { $gBarGraph($num.bucketscores) && ($i % $howoften == $when) } {
    if { $i == $when } {
       # puts "$value-$which-$howoften"
       $canvas create rectangle $textwidth \
    $y1 $x2 $y2 -fill $color -tag $tag
    } else {
       # puts "$value:$which:$howoften"
       $canvas create rectangle [expr {$eachwidth*($i-$howoften+1)+$textwidth}]\
    $y1 $x2 $y2 -fill $color -tag $tag
    }
       } elseif { !$gBarGraph($num.bucketscores) } {
    set x1 [expr {$eachwidth * $i + $textwidth}]
   # puts "y:$y1:$y2:x:$x1:$x2:subpoint:$subpoint"
    $canvas create rectangle [expr {$eachwidth * $i + $textwidth}] \
       $y1 $x2 $y2 -fill $color -tag bar.$which.[expr $which-1].$j
    set value 0
       } else {
    break
       }
       set y1 $y2
    }
    if { $i % $howoften == $when } {
       $canvas create text [expr {$eachwidth * $i + $textwidth + $eachwidth/2}] \
    [expr $graphheight+(($tickheight)/2)+$titleheight] -text $which
       set value 0
    }
       }
   }
   
 ###########################################################  ###########################################################
 # CTbargraphDisplayCreate  # CTbargraphDisplayCreate
 ###########################################################  ###########################################################
Line 2343  proc CTbargraphDisplayShowresponse { bar Line 2650  proc CTbargraphDisplayShowresponse { bar
     set num $gBarGraph($barnum.num)      set num $gBarGraph($barnum.num)
     set canvas $gBarGraph($barnum.canvas)      set canvas $gBarGraph($barnum.canvas)
           
     set high [lindex [split [lindex [$canvas gettags current] 0] .] 1]      set tags [split [lindex [$canvas gettags current] 0] .]
       set high [lindex $tags 1]
       set subpoint [lindex $tags 3]
     foreach datum $gBarGraph($barnum) {      foreach datum $gBarGraph($barnum) {
  set bar [lindex $datum 1]   set bar [lindex $datum 1]
  if { $bar != $high } { continue }   if { $bar != $high } { continue }
  if {![winfo exists $canvas.bubble$barnum.l]} {CTbargraphDisplayCreate $barnum}   if {![winfo exists $canvas.bubble$barnum.l]} {CTbargraphDisplayCreate $barnum}
  $canvas.bubble$barnum.l configure -text "[lindex $datum 0] - \"[splitline [lindex $datum 2] 35]\""   if { [llength [lindex $datum 0]] == 1 } {
       $canvas.bubble$barnum.l configure -text "[lindex $datum 0] - \"[splitline [lindex $datum 2] 35]\""
    } else {
       set point [lindex [lindex $datum 0] $subpoint]
       set text [lindex [lindex $datum 2] $subpoint]
       $canvas.bubble$barnum.l configure -text "$point - \"[splitline $text 35]\""
    }
  wm geometry $canvas.bubble$barnum +[expr 20+[winfo pointerx .]]+[expr 20+[winfo pointery .]]   wm geometry $canvas.bubble$barnum +[expr 20+[winfo pointerx .]]+[expr 20+[winfo pointery .]]
  wm deiconify $canvas.bubble$barnum   wm deiconify $canvas.bubble$barnum
  return   return
Line 2455  proc CTchangeBargraph { window num } { Line 2770  proc CTchangeBargraph { window num } {
     set ylabel [frame $change.ylabel]      set ylabel [frame $change.ylabel]
     set xoften [frame $change.xoften]      set xoften [frame $change.xoften]
     set yoften [frame $change.yoften]      set yoften [frame $change.yoften]
       set ymax   [frame $change.ymax]
     set color [frame $change.color]      set color [frame $change.color]
     set bucket [frame $change.bucket]      set bucket [frame $change.bucket]
     set font [frame $change.font]      set font [frame $change.font]
     pack $infoFrame $buttonFrame $title $xlabel $ylabel $xoften $yoften $color $bucket      pack $infoFrame $buttonFrame $title $xlabel $ylabel $xoften $yoften $ymax \
    $color $bucket
     pack configure $title $xlabel $ylabel $xoften $yoften -anchor e -expand 1 -fill both      pack configure $title $xlabel $ylabel $xoften $yoften -anchor e -expand 1 -fill both
     button $buttonFrame.update -text Update -command "CTdrawBargraph $num"      button $buttonFrame.update -text Update -command "CTdrawBargraph $num"
     bind $change <Return> "CTdrawBargraph $num"      bind $change <Return> "CTdrawBargraph $num"
Line 2470  proc CTchangeBargraph { window num } { Line 2787  proc CTchangeBargraph { window num } {
        $xlabel    {       X-Axis Label} xlabel          $xlabel    {       X-Axis Label} xlabel 
        $ylabel    {       Y-Axis Label} ylabel          $ylabel    {       Y-Axis Label} ylabel 
        $xoften    {Increment on X-Axis} xoften          $xoften    {Increment on X-Axis} xoften 
        $yoften    {Increment on Y-Axis} yoften" {         $yoften    {Increment on Y-Axis} yoften
          $ymax      {        Max Y-Value} ymax" {
  label $frame.label -text $label   label $frame.label -text $label
  set entryFrame [frame $frame.entry]   set entryFrame [frame $frame.entry]
  pack $frame.label $entryFrame -side left   pack $frame.label $entryFrame -side left
Line 2489  proc CTchangeBargraph { window num } { Line 2807  proc CTchangeBargraph { window num } {
     pack $color.label $color.color $color.change -side left      pack $color.label $color.color $color.change -side left
           
     checkbutton $bucket.bucket -text "Bucket Scores" -variable \      checkbutton $bucket.bucket -text "Bucket Scores" -variable \
  gBarGraph($num.bucketscores) -command "CTdrawBargraph $num"   gBarGraph($num.bucketscores) -command "CTmaxBargraph $num;CTdrawBargraph $num"
     pack $bucket.bucket      pack $bucket.bucket
 }  }
   
Line 2537  proc CTdisplayStudent { num window path Line 2855  proc CTdisplayStudent { num window path
   
     label $infoFrame.label -text $id      label $infoFrame.label -text $id
     pack $infoFrame.label      pack $infoFrame.label
       
     set canvas [canvas $imageFrame.canvas]      set height [image height $image]
       set width [image width $image]
       set canvas [canvas $imageFrame.canvas -height $height -width $width]
     pack $canvas      pack $canvas
     $canvas create image 1 1 -image $image -anchor nw      $canvas create image 1 1 -image $image -anchor nw
 }  }
   
   proc updateDate { type cmdnum args } {
       global gDateStart gDateEnd
       switch $type {
    start { set gDateStart($cmdnum.text) [clock format $gDateStart($cmdnum) -format "%a %b %d %R %Y"] }
    end { set gDateEnd($cmdnum.text) [clock format $gDateEnd($cmdnum) -format "%a %b %d %R %Y"] }
       }
   }
   
 ###########################################################  ###########################################################
 # CTgetWhen  # CTgetWhen
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 proc CTgetWhen { num } {  proc CTgetWhen { num cmdnum setId } {
     set day [getString . "Enter a date"]      global gFile gCT gPromptGDR
     update  
     return $day      catch {set firstsection [exec head [file join $gFile($num) records log$setId.db]]}
       catch {append firstsection [exec head [file join $gFile($num) records weblog$setId.db]]}
       catch {set lastsection [exec tail [file join $gFile($num) records log$setId.db]]}
       catch {append lastsection [exec tail [file join $gFile($num) records weblog$setId.db]]}
   
       set earliest -1
       foreach line [split $firstsection \n] {
    if { [catch {set date [clock scan [string range $line 10 33]]}]} {set date -1}
    #puts "$date $earliest"
    if { $earliest == -1 } { set earliest $date }
    if { $date < $earliest } { set earliest $date }
       }
       if { $earliest == -1 } { 
    catch {
       file stat [file join $gFile($num) records log$setId.db] stat
       set earliest $stat(ctime)
    }
    catch {
       file stat [file join $gFile($num) records log$setId.db] stat
       if {($earliest ==-1) || ($stat(ctime) < $earliest)} {
    set earliest $stat(ctime)
       }
    }
       }
       set latest 0 
       foreach line [split $lastsection \n] {
    if { [catch {set date [clock scan [string range $line 10 33]]}]} {set date 0}
    #puts "$date $latest"
    if { $latest == 0 } { set latest $date }
    if { $date > $latest } { set latest $date }
       }
       if { $latest == 0 } { 
    catch {
       file stat [file join $gFile($num) records log$setId.db] stat
       set latest $stat(mtime)
    }
    catch {
       file stat [file join $gFile($num) records log$setId.db] stat
       if { $latest == 0 } { set latest $date }
       if { $stat(mtime) > $latest } { set latest $date }
    }
       }
       #puts "$latest $earliest"
   
       set window $gCT($num)
       set setWin [toplevel $window.setselect]
       
       set msgFrame [frame $setWin.msgFrame]
       set valFrame [frame $setWin.calFrame]
       set buttonFrame [frame $setWin.buttonFrame]
       pack $msgFrame $valFrame $buttonFrame
   
       message $msgFrame.msg -text "Please select a date range:" -aspect 1000
       pack $msgFrame.msg
       
       global gDateStart gDateEnd
       trace variable gDateStart($cmdnum) w "updateDate start $cmdnum"
       trace variable gDateEnd($cmdnum) w "updateDate end $cmdnum"
       label $valFrame.l1 -textvariable gDateStart($cmdnum.text)
       scale $valFrame.start -from $earliest -to $latest -variable gDateStart($cmdnum) -orient h -showvalue 0 -resolution 600 -bigincrement 6000 -length 300
       label $valFrame.l2 -textvariable gDateEnd($cmdnum.text)
       scale $valFrame.end -from $earliest -to $latest -variable gDateEnd($cmdnum) -orient h -showvalue 0 -resolution 600 -bigincrement 6000 -length 300
       pack $valFrame.l1 $valFrame.start $valFrame.l2 $valFrame.end
   
       button $buttonFrame.select -text "Select" -command { set gPromptGDR(ok) 1 }
       button $buttonFrame.cancel -text "Cancel" -command { set gPromptGDR(ok) 0 }
       pack $buttonFrame.select $buttonFrame.cancel -side left
   
       bind $setWin <Return> "set gPromptGDR(ok) 1"
       Centre_Dialog $setWin default
       update idletasks
       focus $setWin
       capaRaise $setWin
       capaGrab $setWin
       vwait gPromptGDR(ok)
       capaGrab release $setWin
       destroy $setWin
       if { $gPromptGDR(ok) == 1 } {
    set dateStart $gDateStart($cmdnum)
    set dateEnd $gDateEnd($cmdnum)
    if { $dateStart > $dateEnd } { 
       set temp $dateStart
       set dateStart $dateEnd
       set dateEnd $temp 
    }
    unset gDateStart
    unset gDateEnd
    return [list $dateStart $dateEnd]
       } else {
    unset gDateStart
    unset gDateEnd
    return ""
       }
 }  }
   
 ###########################################################  ###########################################################
Line 2561  proc CTgetWhen { num } { Line 2981  proc CTgetWhen { num } {
 ###########################################################  ###########################################################
 proc CTscanDB { num file outId startdate enddate } {  proc CTscanDB { num file outId startdate enddate } {
     global answerArray exist      global answerArray exist
     set fileId [open $file r]      if {[catch {set fileId [open $file r]}]} { return 0 }
     set Yes_cnt 0       set Yes_cnt 0 
     set No_cnt 0      set No_cnt 0
     set line_cnt 0      set line_cnt 0
     set prob_cnt 0      set prob_cnt 0
     set maxLine [lindex [exec wc $file] 0]      set maxLine [lindex [exec wc $file] 0]
     puts $maxLine      #puts "maxLine: $maxLine"
     set aline [gets $fileId]      set aline [gets $fileId]
     while { ! [eof $fileId] } {      while { ! [eof $fileId] } {
  incr line_cnt   incr line_cnt
  if { ($line_cnt%20) == 0 } {   if { ($line_cnt%20) == 0 } {
     puts $curdate      #puts $curdate
     updateStatusBar [expr $line_cnt/double($maxLine)] $num      updateStatusBar [expr $line_cnt/double($maxLine)] $num
  }   }
  set length [llength $aline]   set length [llength $aline]
  set date [lrange $aline 1 [expr $length - 2]]   set date [lrange $aline 1 [expr $length - 2]]
    #puts $date
  set curdate [clock scan $date]   set curdate [clock scan $date]
  if { $curdate < $startdate } { set aline [gets $fileId]; continue }   if { $curdate < $startdate } { set aline [gets $fileId]; continue }
  if { $curdate > $enddate } { break }   if { $curdate > $enddate } { break }
Line 2585  proc CTscanDB { num file outId startdate Line 3006  proc CTscanDB { num file outId startdate
  set usr_ans "$s_num.ans"   set usr_ans "$s_num.ans"
  set usr_try "$s_num.try"   set usr_try "$s_num.try"
  if {$prob_cnt == 0} { set prob_cnt [llength $ans_char] }   if {$prob_cnt == 0} { set prob_cnt [llength $ans_char] }
  if { [array names answerArray "$usr_ans.*"] == "" } {   if { [catch {set exist($s_num)}] } {
     for {set ii 0} { $ii <= $prob_cnt } { incr ii} {      for {set ii 0} { $ii <= $prob_cnt } { incr ii} {
  set answerArray($usr_ans.$ii) "-"   set answerArray($usr_ans.$ii) "-"
     }  
  }  
  if { [array names answerArray "$usr_try.*"] == "" } {  
     for {set ii 0} { $ii <= $prob_cnt } { incr ii} {  
  set answerArray($usr_try.$ii) 0   set answerArray($usr_try.$ii) 0
     }      }
  }   }
  for {set ii 0} { $ii <= $prob_cnt } { incr ii} {   for {set ii 0} { $ii <= $prob_cnt } { incr ii} {
     if { [lindex $ans_char $ii] == "Y" } {      switch -- [lindex $ans_char $ii] {
  set answerArray($usr_ans.$ii) "Y"   Y - y {
  incr answerArray($usr_try.$ii)  
     }  
     if { [lindex $ans_char $ii] == "N"} {  
  if {$answerArray($usr_ans.$ii) != "Y"} {  
     set answerArray($usr_ans.$ii) "Y"      set answerArray($usr_ans.$ii) "Y"
       incr answerArray($usr_try.$ii)    
  }   }
  incr answerArray($usr_try.$ii)   N {
       if {$answerArray($usr_ans.$ii) != "Y"} {
    set answerArray($usr_ans.$ii) "N"
       }
       incr answerArray($usr_try.$ii)
    }
    default {}
     }      }
  }   }
  if { [array names exist $s_num] == "" } { set exist($s_num) $s_num }   if { [array names exist $s_num] == "" } { set exist($s_num) 1 }
  set aline [gets $fileId]   set aline [gets $fileId]
     }      }
     close $fileId      close $fileId
Line 2619  proc CTscanDB { num file outId startdate Line 3039  proc CTscanDB { num file outId startdate
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 ###########################################################  ###########################################################
 proc CTcreateSubset { num cmdnum day setId } {  proc CTcreateSubset { num cmdnum startdate enddate setId } {
     global gFile gCT answerArray exist      global gFile gCT answerArray exist
   
     set outId [open [file join $gFile($num) records "subset$setId.db"] w]      set outId [open [file join $gFile($num) records "subset$setId.db"] w]
     set inId [open [file join $gFile($num) records "set$setId.db"] r]      set inId [open [file join $gFile($num) records "set$setId.db"] r]
           
     set startdate [clock scan "$day 12:00 AM"]      #puts $startdate:$enddate
     set enddate [clock scan "$day 11:59 PM"]      #puts [file join $gFile($num) records log$setId.db]
       updateStatusMessage "Genearting subset1.db from telnet data." $cmdnum
     puts $startdate:$enddate  
     set prob_cntt [CTscanDB $cmdnum [file join $gFile($num) records log$setId.db] $outId $startdate $enddate]      set prob_cntt [CTscanDB $cmdnum [file join $gFile($num) records log$setId.db] $outId $startdate $enddate]
     puts $startdate:$enddate      #puts $prob_cntt
       #puts $startdate:$enddate
       updateStatusMessage "Genearting subset1.db from web data." $cmdnum
     set prob_cntw [CTscanDB $cmdnum [file join $gFile($num) records weblog$setId.db] $outId $startdate $enddate]      set prob_cntw [CTscanDB $cmdnum [file join $gFile($num) records weblog$setId.db] $outId $startdate $enddate]
     puts $startdate:$enddate      #puts $prob_cntw
     puts "$day 12:00 AM : $day 11:59 PM"      #puts $startdate:$enddate
   #    puts "$day 12:00 AM : $day 11:59 PM"
     if { $prob_cntt > $prob_cntw } {      if { $prob_cntt > $prob_cntw } {
  set prob_cnt $prob_cntt    set prob_cnt $prob_cntt 
     } else {       } else { 
Line 2683  proc CTdiscussForum { num file dir resul Line 3105  proc CTdiscussForum { num file dir resul
     while {![eof $fileId]} {      while {![eof $fileId]} {
  incr line_cnt   incr line_cnt
  if { ($line_cnt%20) == 0 } { updateStatusBar [expr $line_cnt/double($maxLine)] $num }   if { ($line_cnt%20) == 0 } { updateStatusBar [expr $line_cnt/double($maxLine)] $num }
  foreach {stunum capaid name email action set prob date time} [split $aline "|"] {}   foreach {stunum capaid name email action set prob date time blank} [split $aline "|"] {}
  if {$specificSet && ($specificSet == $set)} {set aline [gets $fileId];continue}   if {$specificSet && ($specificSet == $set)} {set aline [gets $fileId];continue}
  if { $action == "ViewProblem" } {   if { $action == "ViewProblem" } {
     if { [catch {incr count($set,$prob)}]} {      if { [catch {incr count($set,$prob)}]} {
Line 2730  proc CTdiscussForum { num file dir resul Line 3152  proc CTdiscussForum { num file dir resul
     close $fileId      close $fileId
     set result($num.viewers) [llength [array names ever]]      set result($num.viewers) [llength [array names ever]]
     set result($num.last) $last      set result($num.last) $last
     #IDEAS: stick into capastats      #IDEAS:
     #     : howmany viws are repeats      #     : how many views are repeats
     #     : Student Course Profile, add #ViewProblems #Posts      #     : Student Course Profile, add #ViewProblems #Posts
     #     : add some portion of these stats to analyze log files?      #     : add some portion of these stats to analyze log files?
 }  }
Removed from v.1.10  
changed lines
  Added in v.1.17

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>