#!/usr/bin/tclsh # evalkmaxent - supertagger evaluation script # Copyright (C) 2004-2007 Richard Moot (Richard.Moot@labri.fr) # Copyright (C) 2004-2007 CNRS (http://www.cnrs.fr) # Copyright (C) 2004-2007 INRIA (http://www.inria.fr) # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # This library 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 # Lesser General Public License for more details. # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # evaluate maximum entropy annotation produced by the Edinburgh # maximum entropy tools against the correct training data # 20061121 updated to keep track of information by word as well # # 20060126 updated to give a more honest evaluation of the sentence # metric for this script, ensuring that all correct supertags occur # together in the same solution (instead of every word getting # assigned the correct supertag at least once). # # 20060131 added missing -integer argument to the lsort command, which # resulted in incorrect operation of the ord_intersect function. # # 20060131 updated the errors.log transcript to work in the case of # multiple solutions as well. # load the print formula array source "printform.tcl" # ord_intersect # # do set intersection of two ordered sets (in ordered list # representation); returns an ordered set containing the elements # occurring in both lists. proc ord_intersect {list1 list2} { if {[llength $list1]==0} { return {} } elseif {[llength $list2]==0} { return {} } else { set i1 [lindex $list1 0] set i2 [lindex $list2 0] if {$i1 < $i2} { return [ord_intersect [lrange $list1 1 end] $list2] } elseif {$i1 > $i2} { return [ord_intersect $list1 [lrange $list2 1 end]] } else { return [concat $i1 [ord_intersect [lrange $list1 1 end] [lrange $list2 1 end]]] } } } if {$argc < 2} { puts stderr "Usage: evalkmaxent correctfile taggedfile" exit 1 } else { set file1 [lindex $argv 0] set file2 [lindex $argv 1] } set totalsent 0 set correctsent 0 set totalitems 0 set totalcorrect 0 set totalniitems 0 set totalnicorrect 0 set cutoff 50 set f1 [open $file1 r] set f2 [open $file2 r] set f3 [open "evaluation.log" w] set f4 [open "errors.log" w] while {[gets $f1 line1] >= 0 && [gets $f2 line2] >= 0} { incr totalsent set list1 [split $line1] set list2 [split $line2] set slength [llength $list1] set scorrect 0 for {set i 0} {$i < $slength} {incr i} { incr totalitems set item1 [lindex $list1 $i] set item2 [lindex $list2 $i] regexp {^(.*)/(.*)/(.*)$} $item1 all1 word1 pos1 st1 regexp {^(.*)/(.*)/(.*)$} $item2 all2 word2 pos2 st2 set stl [split $st2 "-"] set len [llength $stl] regexp {^([A-Z,a-z]+)([0-9]*)$} $pos1 all3 post dontcare if {[string compare $pos1 $pos2]!=0} { puts stderr "Sentences not aligned: $pos1 $pos2" break } # check if the correct solution occurs if {[lsearch $stl $st1] == -1} { set val 0 # print error log puts -nonewline $f4 "$st1-$printform($st1) \[" foreach j [lsort -integer -unique $stl] { puts -nonewline $f4 " $j-$printform($j)" } puts $f4 " \]" } else { set val 1 } puts $f3 "$st1 $st2 $val" # increment counters set totalcorrect [expr $totalcorrect+$val] set scorrect [expr $scorrect+$val] if {[string compare $post "let"] != 0} { incr totalniitems set totalnicorrect [expr $totalnicorrect+$val] } if {[catch {set total($post)}]} { set total($post) 1 set totalc($post) $val } else { set total($post) [expr $total($post)+1] set totalc($post) [expr $totalc($post)+$val] } if {[catch {set totalw($word1)}]} { set totalw($word1) 1 set totalwc($word1) $val } else { set totalw($word1) [expr $totalw($word1)+1] set totalwc($word1) [expr $totalwc($word1)+$val] } } # check for correct sequence: start by looking at the which # sequences contain the correct supertag for the first word, then # continue doing set intersection with correct solutions to the # subsequent words set st1 [lindex [split [lindex $list1 0] "/"] end] set stl [split [lindex [split [lindex $list2 0] "/"] end] "-"] set correct [lsort -integer [lsearch -all $stl $st1]] for {set i 1} {$i < $slength} {incr i} { set st1 [lindex [split [lindex $list1 $i] "/"] end] set stl [split [lindex [split [lindex $list2 $i] "/"] end] "-"] set correct [ord_intersect $correct [lsort -integer [lsearch -all $stl $st1]]] } if {$slength > 0} { puts $f3 " - Sentence $totalsent, $slength words, [expr 100*double($scorrect)/double($slength)] correct" puts -nonewline stderr "Sentence $totalsent" puts $f3 "Sentence $totalsent" if {$correct != {}} { incr correctsent puts stderr " (solution $correct)" puts $f3 "(solution $correct)" } else { puts stderr " (incorrect)" puts $f3 "(incorrect)" } } } # output final results to stdout puts "" puts " ================================ " puts " = results by word = " puts " ================================ " puts "" set co $cutoff foreach w [lsort [array names totalw]] { set t $totalw($w) set true_bayesian [expr 100*(double($t)/double($t+$co))*(double($totalwc($w))/double($t)) + (double($co)/double($t+$co))*(double($totalcorrect)/double($totalitems))] set evalitem [expr 100*double($totalwc($w))/double($t)] if {$totalwc($w) > $cutoff} { puts "$totalwc($w)\t$w\t\t$evalitem\t$true_bayesian" } } puts "" puts " ================================ " puts " = results by category = " puts " ================================ " puts "" foreach i [lsort [array names total]] { set t $total($i) if {$t >= $cutoff} { set evalitem [expr 100*double($totalc($i))/double($t)] if {$evalitem <= 20} { set string "*AWFUL!*" } elseif {$evalitem <= 40} { set string "*BAD*" } elseif {$evalitem <= 60} { set string "*POOR*" } elseif {$evalitem <= 80} { set string "*MEDIOCRE*" } elseif {$evalitem <= 90} { set string "*GOOD*" } else { set string "*EXCELLENT!*" } puts "$i (Total $t) $evalitem $string" } } puts "" puts " ================================ " puts " = totals = " puts " ================================ " puts "" if {$totalsent > 0} { puts "$totalsent sentences, $correctsent correct ([expr double($correctsent)*100/double($totalsent)]%)" } if {$totalitems > 0} { puts "$totalitems words, $totalcorrect correct ([expr double($totalcorrect)*100/double($totalitems)]%)" } if {$totalniitems > 0} { puts "$totalniitems words, $totalnicorrect correct ([expr double($totalnicorrect)*100/double($totalniitems)]%)" } puts "" close $f1 close $f2 close $f3 close $f4 # create the sortederrors.log file on the basis of errors.log exec sort errors.log | uniq -c | sort -nr > sortederrors.log