Return to analyzeScorer.tcl CVS log

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

Annotation of capa/capa51/GUITools/analyzeScorer.tcl, revision 1.3

1.2       albertel    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
1.3     ! albertel    6: #  modify it under the terms of the GNU General Public License as
1.2       albertel    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
1.3     ! albertel   13: #  General Public License for more details.
1.2       albertel   14: #
1.3     ! albertel   15: #  You should have received a copy of the GNU General Public
1.2       albertel   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: 
1.1       albertel   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