Return to analyzeScorer.tcl CVS log

Up to [LON-CAPA] / capa / capa51 / GUITools

- fixed license notices the reference the GNU GPL rather than the GNU LGPL

    1: # early verision of a reverse mapping of a randomized multiple choice 
    2: # question analyzer
    3: #  Copyright (C) 1992-2000 Michigan State University
    4: #
    5: #  The CAPA system is free software; you can redistribute it and/or
    6: #  modify it under the terms of the GNU General Public License as
    7: #  published by the Free Software Foundation; either version 2 of the
    8: #  License, or (at your option) any later version.
    9: #
   10: #  The CAPA system is distributed in the hope that it will be useful,
   11: #  but WITHOUT ANY WARRANTY; without even the implied warranty of
   12: #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   13: #  General Public License for more details.
   14: #
   15: #  You should have received a copy of the GNU General Public
   16: #  License along with the CAPA system; see the file COPYING.  If not,
   17: #  write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
   18: #  Boston, MA 02111-1307, USA.
   19: #
   20: #  As a special exception, you have permission to link this program
   21: #  with the TtH/TtM library and distribute executables, as long as you
   22: #  follow the requirements of the GNU GPL in regard to all of the
   23: #  software in the executable aside from TtH/TtM.
   24: 
   25: 
   26: proc parseScorerOutputLine { aline studentVar } {
   27:     upvar $studentVar student
   28:     set student(stunum) [lindex $aline 0]
   29:     set aline [string range $aline 40 end]
   30:     set length  [llength [split [lrange $aline 3 end] ,] ]
   31:     set student(response) [lrange [split [lrange $aline 3 end] ,] 0 [expr {$length-2}]]
   32:     set student(question) [lindex [lindex [split $aline ,] end] 0]
   33: #    parray student
   34: }
   35: 
   36: proc getQuestions { num pid set questnum questionVar } {
   37:     upvar $questionVar question
   38:     global gCapaConfig
   39:     catch {unset question}
   40:     set result [exec $gCapaConfig($num.answers_command) $pid {} 1 $set]
   41:     set capture [set i 0]
   42:     puts "$questnum:$i"
   43:     foreach line [split $result "\n"] {
   44: 	switch [lindex [split $line :] 0] {
   45: 	    BQES {
   46: 		incr i
   47: 		if { [lsearch $questnum $i] != -1 } { set capture 1 }
   48: 	    }
   49: 	    EQES { set capture 0 }
   50: 	    ANS {
   51: 		if { [lsearch $questnum $i] != -1 } { 
   52: 		    set question($i.ans) [split [lindex [split $line :] 1] {} ]
   53: 		}
   54: 	    }
   55: 	    default { if { $capture } { lappend question($i.text) $line } }
   56: 	}
   57:     }
   58:     foreach quest $questnum {
   59: 	foreach line $question($quest.text) {
   60: 	    if { [regexp {^ *([A-Z])\)(.*)} $line temp letter rest] } {
   61: 		set question($quest.$letter) $rest
   62: 		if { [lsearch $question($quest.ans) $letter] != -1} {
   63: 		    set question($quest.correct.$letter) 1
   64: 		} else {
   65: 		    set question($quest.correct.$letter) 0
   66: 		}
   67: 	    }
   68: 	}
   69:     }
   70:     parray question
   71: }
   72: 
   73: #FIXME not parsing all student responses?
   74: proc getStudentResponses { responses which questionVar responseArVar } {
   75:     upvar $questionVar question $responseArVar responseAr
   76:     set i 0
   77:     foreach response [split $responses {}] {
   78: 	if { $response == "" || $response == " "} { continue } 
   79: 	incr i
   80: 	if { [catch {incr responseAr($which.$question($which.$response))}] } {
   81: 	    if {[catch {set responseAr($which.$question($which.$response)) 1}]} {
   82:                 set responseAr($which.Illegal\ Bubble) 1
   83:             }
   84: 	}
   85:     }
   86:     puts $i
   87: }
   88: 
   89: set fileId [open "records/scorer.output.1" r]
   90: set setId 1
   91: set questionNum "1"
   92: source /nfs/capa1/capadvt/CAPA_SRC/5.0/GUITools/common.tcl
   93: set aline [gets $fileId]
   94: set aline [gets $fileId]
   95: parseCapaConfig 1 .
   96: set k 0
   97: while { ! [eof $fileId] } {
   98:     parseScorerOutputLine $aline student
   99:     getQuestions 1 $student(question) $setId $questionNum question
  100:     foreach which $questionNum {
  101: 	getStudentResponses [lindex $student(response) [expr $which-1]] $which question \
  102: 	    responses
  103:     }
  104:     foreach which $questionNum {
  105: 	foreach elem [array names responses "$which.*"] {
  106: 	    puts -nonewline "$responses($elem) "
  107: 	}
  108:     }
  109:    incr k
  110:     if { $k%20 == 0 } { parray responses }
  111:     puts ""
  112:     set aline [gets $fileId]
  113: }
  114: parray responses