#!/usr/bin/tclsh # findworderror - corpus search 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 # Find incorrectly annotated instances of word by comparing # the tagged file with a correct file. # For example # # findworderror en correctfile taggedfile # # will find all instances of the word "en" which are incorrectly # annotated in taggedfile source "printform.tcl" if {$argc < 1} { puts stderr "Usage: finderror word \[correctfile\] \[taggedfile\]" exit 1 } else { set word [lindex $argv 0] if {$argc < 3} { set file2 "tri.tagged" } else { set file2 [lindex $argv 2] } if {$argc < 2} { set file1 "maxent.test" } else { set file1 [lindex $argv 1] } } set totalfound 0 set f1 [open $file1 r] set f2 [open $file2 r] while {[gets $f1 line1] >= 0 && [gets $f2 line2] >= 0} { set list1 [split $line1] set list2 [split $line2] set slength [llength $list1] set found 0 for {set i 0} {$i < $slength} {incr i} { set item1 [lindex $list1 $i] set item2 [lindex $list2 $i] regexp {^(.*)/(.*)/(.*)$} $item1 all1 word1 pos1 st1 regexp {^(.*)/(.*)/(.*)$} $item2 all2 word2 pos2 st2 set stl [lsort -integer -unique [split $st2 "-"]] set stl0 [lindex $stl 0] if {[string equal $word $word1] && ![string equal $st1 $st2]} { if {[catch {set total($st1-$stl0)}]} { set total($st1-$stl0) 1 } else { set total($st1-$stl0) [expr $total($st1-$stl0)+1] } set list1 [lreplace $list1 $i $i "$word1/$pos1/>$st1<"] set list2 [lreplace $list2 $i $i "$word2/$pos2/*$st2*"] incr found incr totalfound } } if {$found > 0} { puts "< [join $list1]" puts "> [join $list2]" puts "" } } foreach w [array names total] { set l [split $w "-"] set t1 [lindex $l 0] set t2 [lindex $l 1] puts "$total($w) $t1-$printform($t1) $t2-$printform($t2)" } close $f1 close $f2 puts stderr "$totalfound errors found"