#!/usr/bin/tclsh # finderror - 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 # finderror compares a tagged file to a correctly annotated file # to find errors of a type specified by the user. This helps finding # instances of frequent errors and may give ideas as to how to # remedy this situation. if {$argc < 2} { puts stderr "Usage: finderror tagno1 tagno2 \[correctfile\] \[taggedfile\]" exit 1 } else { set tag1 [lindex $argv 0] set tag2 [lindex $argv 1] if {$argc < 4} { set file2 "tri.tagged" } else { set file2 [lindex $argv 3] } if {$argc < 3} { set file1 "maxent.test" } else { set file1 [lindex $argv 2] } } 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 "-"]] if {($st1 == $tag1 && [lsearch $stl $tag1] == -1 && [lsearch $stl $tag2] != -1) || ($st1 == $tag2 && [lsearch $stl $tag2] == -1 && [lsearch $stl $tag1] != -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 "" } } close $f1 close $f2 puts stderr "$totalfound errors found"