view release on metacpan or  search on metacpan

tt-wd-errors.perl  view on Meta::CPAN

use File::Basename qw(basename);

##----------------------------------------------------------------------
## Globals
##----------------------------------------------------------------------

our $VERSION = "0.13";

##-- program vars
our $progname     = basename($0);
our $verbose      = 1;

our $outfile      = '-';
our %ioargs       = ( encoding=>undef );
our $n_words      = 4;
our $output_cmts  = 1;

##----------------------------------------------------------------------
## Command-line processing
##----------------------------------------------------------------------
GetOptions(##-- general
	   'help|h' => \$help,
	   'man|m'  => \$man,
	   'version|V' => \$version,
	   'verbose|v=i' => \$verbose,

	   ##-- misc
	   'output|o=s' => \$outfile,
	   'n-words|nwords|words|nw|w|n=i' => \$n_words,
	   'comments|cmts|c!' => \$output_cmts,
	  );

pod2usage({-exitval=>0,-verbose=>0}) if ($help);
pod2usage({-exitval=>0,-verbose=>1}) if ($man);
#pod2usage({-exitval=>0,-verbose=>1,-msg=>'Not enough arguments specified!'}) if (@ARGV < 2);

if ($version) {
  print STDERR "$progname version $VERSION by Bryan Jurish\n";
  exit 0 if ($version);
}

##----------------------------------------------------------------------
## Subs

## $pct = pct($num,$denom)
sub pct {
  my ($num,$denom) = @_;
  $denom ||= 0;
  return ($denom==0 ? 'nan' : (100*$num/$denom));
}

##----------------------------------------------------------------------
## MAIN
##----------------------------------------------------------------------
push(@ARGV,'-') if (!@ARGV);

##-- vars: token frequency
our %tc = qw();  ##-- %tc     = ("$tag $class" => \%data, ...) ##-- errors only
                 ##   + %data = (freq=>$tc_freq, words=>{$w=>$w_freq, ...})
our $N      = 0; ##-- $N  = $total_freq;
our $Nerr   = 0; ##-- $Nerr = $error_freq;                   ##-- == sum($tcdata{$_}{freq})
our $Nempty = 0; ##-- $Nempty = $total_empty_class_freq


##-- load mooteval output
foreach $infile (@ARGV) {
  our $ttin = Lingua::TT::IO->fromFile($infile)
    or die("$0: open failed for '$infile': $!");
  our $infh = $ttin->{fh};
  while (<$infh>) {
    chomp;
    s/\r$//;
    next if (/^\s*$/ || /^\s*\%\%/);

    ($text,$tag,@ans0) = split(/\t/,$_);
    @ans = map { /^[^\[]*\[\_?([^\]\s]+)[\]\s]/ ? $1 : $_ } @ans0;
    %ans = map {($_=>undef)} @ans;
    $cls = '{'.join(' ',sort keys %ans).'}';
    $tc  = "$tag $cls";

    ++$N;
    next if (@ans && exists($ans{$tag}));
    ++$Nerr;
    ++$Nempty if (!@ans);
    ++$tc{$tc}{freq};
    ++$tc{$tc}{words}{$text};
  }
  $ttin->close;
}

##-- output (header)
our $ttout = Lingua::TT::IO->toFile($outfile)
  or die("$0: open failed for '$outfile': $!");
our $outfh = $ttout->{fh};
our $dfmt = "%".length($N)."d";
our $ffmt = "%6.2f %%";
$outfh->print("%% File auto-generated by $0 v$VERSION\n",
	      "%% Command-line: ", join(' ', $0, @ARGV), "\n",
	      "%% Globals:\n",
	      "%%   max_examples_per_class=$n_words\n",
	      "%%   ", sprintf("N[total]     = $dfmt ($ffmt)\n", $N, pct($N,$N)),
	      "%%   ", sprintf("N[+empty]    = $dfmt ($ffmt)\n", ($Nempty), pct($Nempty,$N)),
	      "%%   ", sprintf("N[-empty]    = $dfmt ($ffmt)\n", ($N-$Nempty), pct($N-$Nempty,$N)),
	      "%%   ", sprintf("N[+consist]  = $dfmt ($ffmt)\n", ($N-$Nerr), pct($N-$Nerr,$N)),
	      "%%   ", sprintf("N[-consist]  = $dfmt ($ffmt)\n", ($Nerr), pct($Nerr,$N)),
	      "%%   ", sprintf("N[+strictok] = $dfmt ($ffmt)\n", ($N-$Nerr+$Nempty), pct($N-$Nerr+$Nempty,$N)),
	      "%%   ", sprintf("N[-strictok] = $dfmt ($ffmt)\n", ($Nerr-$Nempty), pct($Nerr-$Nempty,$N)),
	      "%% File Format (TAB-separated):\n",
	      "%%   FREQ TAG  CLASS  EXAMPLE_WORD(FREQ)*\n",
	     ) if ($output_cmts);

##-- output: dump
@words = qw();
foreach $tc (sort {$tc{$b}{freq} <=> $tc{$a}{freq}} keys(%tc)) {
  $data = $tc{$tc};
  ($tag,$cls) = split(/ /,$tc,2);
  if ($n_words > 0) {
    @words = sort {$data->{words}{$b}<=>$data->{words}{$a}} keys(%{$data->{words}});
    splice(@words, $n_words, @words-$n_words) if (@words > $n_words);
  }
  $outfh->print(join("\t", $data->{freq},$tag,$cls,