mosesdecoder/scripts/ems/support/report-experiment-scores.perl

#!/usr/bin/env perl
#
# This file is part of moses.  Its use is licensed under the GNU Lesser General
# Public License version 2.1 or, at your option, any later version.

# $Id: report-experiment-scores.perl 407 2008-11-10 14:43:31Z philipp $

use warnings;
use strict;

my $email;

my %TYPE;
$TYPE{"nist-bleu"}   = "BLEU";
$TYPE{"multi-bleu"}  = "BLEU";
$TYPE{"nist-bleu-c"} = "BLEU-c";
$TYPE{"multi-bleu-c"}= "BLEU-c";
$TYPE{"ibm-bleu"}    = "IBM";
$TYPE{"ibm-bleu-c"}  = "IBM-c";
$TYPE{"meteor"} = "METEOR";
$TYPE{"bolt-bleu"}     = "BLEU";
$TYPE{"bolt-bleu-c"}   = "BLEU-c";
$TYPE{"bolt-ter"}      = "TER";
$TYPE{"bolt-ter-c"}    = "TER-c";
$TYPE{"multi-bleu-detok"}  = "BLEU";
$TYPE{"multi-bleu-c-detok"}= "BLEU-c";

$TYPE{"sacre-bleu"}  = "BLEU";
$TYPE{"sacre-bleu-c"}= "BLEU-c";

my %SCORE;
my %AVERAGE;
foreach (@ARGV) {
    if (/^email='(\S+)'/) {
	$email = $1;
    }
}
foreach (@ARGV) {
    if (/^set=(\S+),type=(\S+),file=(\S+)$/) {
	&process($1,$2,$3);
    }
}
foreach my $set (sort keys %SCORE) {
    my $score = $SCORE{$set};
    chop($score);
    print "$set: $score\n";
}
if ((scalar keys %SCORE) > 1) {
    print  "avg:";
    my $first = 1;
    foreach my $type (sort keys %AVERAGE) {
      print " ;" unless $first; $first = 0;
      printf " %.02f $TYPE{$type}",$AVERAGE{$type}/(scalar keys %SCORE);
    }
    print  "\n";
}

sub process {
    my ($set,$type,$file) = @_;
    $SCORE{$set} .= "; " if defined($SCORE{$set});
    if (! -e $file) {
	    print STDERR "ERROR (score $type for set $set): file '$file' does not exist!\n";
    }
    elsif ($type eq 'nist-bleu' || $type eq 'nist-bleu-c') {
	    $SCORE{$set} .= &extract_nist_bleu($file,$type)." ";
    }
    elsif ($type eq 'ibm-bleu' || $type eq 'ibm-bleu-c') {
	    $SCORE{$set} .= &extract_ibm_bleu($file,$type)." ";
    }
    elsif ($type eq 'multi-bleu' || $type eq 'multi-bleu-c'
	|| $type eq 'multi-bleu-detok' || $type eq 'multi-bleu-c-detok') {
        $SCORE{$set} .= &extract_multi_bleu($file,$type)." ";
    }
    elsif ($type eq 'sacre-bleu' || $type eq 'sacre-bleu-c') {
        $SCORE{$set} .= &extract_sacre_bleu($file,$type)." ";
    }
    elsif ($type eq 'meteor') {
	    $SCORE{$set} .= &extract_meteor($file,$type)." ";
    }
    elsif ($type =~ /^bolt-(.+)$/) {
      $SCORE{$set} .= &extract_bolt($file,$1)." ";
    }
}

sub extract_sacre_bleu {
    my ($file,$type) = @_;
    my ($bleu,$ratio);
    #print STDERR "type=$type, file=$file \n";

    foreach (my $line = `cat $file`) {
        chomp($line);
        #print STDERR "line=$line \n";
        my @toks = split(" ", $line);
        $bleu = $toks[2];
        $ratio = $toks[9];
    }
    my $output = sprintf("%.02f ",$bleu);
    $output .= sprintf("(%.03f) ",$ratio) if $ratio;

    $AVERAGE{"sacre-bleu"} += $bleu;

    return $output.$TYPE{$type};
}

sub extract_nist_bleu {
    my ($file,$type) = @_;
    my ($bleu,$ratio);
    foreach (`cat $file`) {
	$bleu = $1*100 if /BLEU score = (\S+)/;
	$ratio = int(1000*$1)/1000 if /length ratio: (\S+)/;
    }
    if (!defined($bleu)) {
	print STDERR "ERROR (extract_nist_bleu): could not find BLEU score in file '$file'\n";
	return "";
    }
    my $output = sprintf("%.02f ",$bleu);
    $output .= sprintf("(%.03f) ",$ratio) if $ratio;

    $AVERAGE{$type} += $bleu;

    return $output.$TYPE{$type};
}

sub extract_ibm_bleu {
    my ($file,$type) = @_;
    my ($bleu,$ratio);
    foreach (`cat $file`) {
	$bleu = $1*100 if /BLEUr\dn4c?,(\S+)/;
	$ratio = int(1000*(1/$1))/1000 if /Ref2SysLen,(\S+)/;
    }
    if (!$bleu) {
	print STDERR "ERROR (extract_ibm_bleu): could not find BLEU score in file '$file'\n";
	return "";
    }
    my $output = sprintf("%.02f ",$bleu);
    $output .= sprintf("(%.03f) ",$ratio) if $ratio;

    $AVERAGE{$type} += $bleu;

    return $output.$TYPE{$type};
}

sub extract_multi_bleu {
    my ($file,$type) = @_;
    my ($bleu,$ratio);
    foreach (`cat $file`) {
	$bleu = $1 if /BLEU = (\S+), /;
	$ratio = $1 if / ration?=(\S+),/;
    }
    my $output = sprintf("%.02f ",$bleu);
    $output .= sprintf("(%.03f) ",$ratio) if $ratio;

    $AVERAGE{"multi-bleu"} += $bleu;

    return $output.$TYPE{$type};
}

sub extract_bolt {
  my ($file,$type) = @_;
  my $score;
  foreach (`cat $file`) {
    $score = $1 if $type eq 'bleu' && /Lowercase BLEU\s+([\d\.]+)/;
    $score = $1 if $type eq 'bleu-c' && /Cased BLEU\s+([\d\.]+)/;
    $score = $1 if $type eq 'ter' && /Lowercase TER\s+([\d\.]+)/;
    $score = $1 if $type eq 'ter-c' && /Cased TER\s+([\d\.]+)/;
  }
  my $output = sprintf("%.02f ",$score*100);
  $AVERAGE{"bolt-".$type} += $score*100;
  return $output.$TYPE{"bolt-".$type};
}
sub extract_meteor {
    my ($file,$type) = @_;
    my ($meteor, $precision);
    foreach (`cat $file`) {
	    $meteor = $1*100 if /Final score:\s*(\S+)/;
	    $precision = $1 if /Precision:\s*(\S+)/;
    }
    my $output = sprintf("%.02f ",$meteor);
    $output .= sprintf("(%.03f) ",$precision) if $precision;
    $AVERAGE{"meteor"} += $meteor;

    return $output.$TYPE{$type};

}