Return to analyzeScorer.tcl CVS log

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

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

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