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

# early verision of a reverse mapping of a randomized multiple choice 
# question analyzer
#  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.


proc parseScorerOutputLine { aline studentVar } {
    upvar $studentVar student
    set student(stunum) [lindex $aline 0]
    set aline [string range $aline 40 end]
    set length  [llength [split [lrange $aline 3 end] ,] ]
    set student(response) [lrange [split [lrange $aline 3 end] ,] 0 [expr {$length-2}]]
    set student(question) [lindex [lindex [split $aline ,] end] 0]
#    parray student
}

proc getQuestions { num pid set questnum questionVar } {
    upvar $questionVar question
    global gCapaConfig
    catch {unset question}
    set result [exec $gCapaConfig($num.answers_command) $pid {} 1 $set]
    set capture [set i 0]
    puts "$questnum:$i"
    foreach line [split $result "\n"] {
	switch [lindex [split $line :] 0] {
	    BQES {
		incr i
		if { [lsearch $questnum $i] != -1 } { set capture 1 }
	    }
	    EQES { set capture 0 }
	    ANS {
		if { [lsearch $questnum $i] != -1 } { 
		    set question($i.ans) [split [lindex [split $line :] 1] {} ]
		}
	    }
	    default { if { $capture } { lappend question($i.text) $line } }
	}
    }
    foreach quest $questnum {
	foreach line $question($quest.text) {
	    if { [regexp {^ *([A-Z])\)(.*)} $line temp letter rest] } {
		set question($quest.$letter) $rest
		if { [lsearch $question($quest.ans) $letter] != -1} {
		    set question($quest.correct.$letter) 1
		} else {
		    set question($quest.correct.$letter) 0
		}
	    }
	}
    }
    parray question
}

#FIXME not parsing all student responses?
proc getStudentResponses { responses which questionVar responseArVar } {
    upvar $questionVar question $responseArVar responseAr
    set i 0
    foreach response [split $responses {}] {
	if { $response == "" || $response == " "} { continue } 
	incr i
	if { [catch {incr responseAr($which.$question($which.$response))}] } {
	    if {[catch {set responseAr($which.$question($which.$response)) 1}]} {
                set responseAr($which.Illegal\ Bubble) 1
            }
	}
    }
    puts $i
}

set fileId [open "records/scorer.output.1" r]
set setId 1
set questionNum "1"
source /nfs/capa1/capadvt/CAPA_SRC/5.0/GUITools/common.tcl
set aline [gets $fileId]
set aline [gets $fileId]
parseCapaConfig 1 .
set k 0
while { ! [eof $fileId] } {
    parseScorerOutputLine $aline student
    getQuestions 1 $student(question) $setId $questionNum question
    foreach which $questionNum {
	getStudentResponses [lindex $student(response) [expr $which-1]] $which question \
	    responses
    }
    foreach which $questionNum {
	foreach elem [array names responses "$which.*"] {
	    puts -nonewline "$responses($elem) "
	}
    }
   incr k
    if { $k%20 == 0 } { parray responses }
    puts ""
    set aline [gets $fileId]
}
parray responses