#!/usr/bin/perl
# Authors     : Enrique Amig and Jess Gimnez
# Date        : July 11, 2005
# Description : Responsible for setting up the QARLA Evaluation Framework,
#               given a config IQ.config containing information about the
#               source file, set of system files, and set of reference files.
#               As a result, XML report files for each given metric are
#               generated for each pair (ref-ref) (ref-sys) (sys-ref) (sys-sys).
#
# Usage: IQsetup IQsetup.config IQeval.config
#                   (input)        (output)
#
# ------------------------------------------------------------------------
# ------------------------------------------------------------------------

#Copyright (C) 2005 Enrique Amig and Jess Gimnez

#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

# ------------------------------------------------------------------------

use strict;
use Data::Dumper;
use IQ::METRICS;
use IQ::IQXML;
use POSIX qw(ceil floor);

my $NARG = 1;
my $DUMMY = "*****";
my $Kdef = .1;  #10% default value

sub get_out
{
   $0 =~ /\/([^\/]*$)/;
   print STDERR "Usage : ", $1, "  [options]  <IQsetup.config>  <IQeval.config>\n";
   print STDERR "                                (input)          (output)\n\n";
   print STDERR "  - print         : print similarities onto IQeval.config (default disabled)\n";
   print STDERR "  - remake        : remake reports\n";
   print STDERR "  - V <0|1|2>     : verbosity\n";
   print STDERR "                    0 - non-verbose (default)\n";
   print STDERR "                    1 - low verbosity\n";
   print STDERR "                    2 - medium verbosity\n";
   print STDERR "\nExample: $1 IQsetup.config IQeval.config\n\n";
   exit;
}

sub criterion {
  my $A = substr($a, 0, 1); 
  my $B = substr($b, 0, 1);
  if ($A eq $B) { my @lA = split(/[RDS]/, $a); my @lB = split(/[RDS]/, $b); return ($lA[1] <=> $lB[1]); }
  else { return ($A cmp $B); } 
}

sub round {
    my($number) = shift;
    return int($number + .5);
}

sub delete_error {
   #description _ performs a 'delete' distortion on the input string,
   #              by deleting K% words at random from it
   #param1  _ input string
   #param2  _ K (%error)
   #@return _ output string

   my $in = shift;
   my $K = shift;

   my @entry = split(/ /, $in);
   my $N = ceil(scalar(@entry) * $K);
   my %Hrand;
   srand();
   while (scalar(keys %Hrand) < $N) { $Hrand{round(rand(scalar(@entry) - 1))} = 1; }

   my $i = 0;
   my @out;
   while ($i < scalar(@entry)) {
      if (!($Hrand{$i})) { push(@out, $entry[$i]); }
      $i++;
   }

   return join(" ", @out);
}

sub insert_error {
   #description _ performs an 'insert' distortion on the input string,
   #              by inserting K% DUMMY words at random positions
   #param1  _ input string
   #param2  _ K (%error)
   #@return _ output string

   my $in = shift;
   my $K = shift;

   my @entry = split(/ /, $in);
   my $N = ceil(scalar(@entry) * $K);
   my %Hrand;
   srand();
   while (scalar(keys %Hrand) < $N) { $Hrand{round(rand(scalar(@entry) - 1))} = 1; }

   my $i = 0;
   my @out;
   while ($i < scalar(@entry)) {
      if ($Hrand{$i}) { push(@out, $DUMMY); }
      push(@out, $entry[$i]);
      $i++;
   }

   return join(" ", @out);
}

sub replace_error {
   #description _ performs a 'replace' distortion on the input string,
   #              by replacing K% words at random from it with a DUMMY word
   #param1  _ input string
   #param2  _ K (%error)
   #@return _ output string

   my $in = shift;
   my $K = shift;

   my @entry = split(/ /, $in);
   my $N = ceil(scalar(@entry) * $K);
   my %Hrand;
   srand();
   while (scalar(keys %Hrand) < $N) { $Hrand{round(rand(scalar(@entry) - 1))} = 1; }

   my $i = 0;
   my @out;
   while ($i < scalar(@entry)) {
      if ($Hrand{$i}) { push(@out, $DUMMY); }
      else { push(@out, $entry[$i]); }
      $i++;
   }

   return join(" ", @out);
}

sub swapping_error {
   #description _ performs a 'swapping' distortion on the input string,
   #              by swapping K% words at random from it
   #param1  _ input string
   #param2  _ K (%error)
   #@return _ output string

   my $in = shift;
   my $K = shift;

   my @entry = split(/ /, $in);
   my $N = ceil(scalar(@entry) * $K);
   if ($N > (scalar(@entry) / 2)) { $N--; }
   my %Hrand1;
   my %Hrand2;
   srand();
   while (scalar(keys %Hrand1) < $N) { $Hrand1{round(rand(scalar(@entry) - 1))} = 1; }
   while (scalar(keys %Hrand2) < $N) {
      my $n = round(rand(scalar(@entry) - 1));
      if (!(exists($Hrand1{$n}))) { $Hrand2{$n} = 1; }
   }
   my @l = keys %Hrand2;
   my $i = 0;
   foreach my $k (keys %Hrand1) { $Hrand1{$k} = @l[$i]; $i++; }

   $i = 0;
   my @out;
   while ($i < scalar(@entry)) { push(@out, $DUMMY); $i++; }
   $i = 0;
   while ($i < scalar(@entry)) {
      if (exists($Hrand1{$i})) {
         $out[$i] = $entry[$Hrand1{$i}];
         $out[$Hrand1{$i}] = $entry[$i];
      }
      else {
         if (!exists($Hrand2{$i})) { $out[$i] = $entry[$i]; }
      }
      $i++;
   }

   return join(" ", @out);
}

sub find_nsegments {
   #description _ returns the number of lines in a given file
   #param1  _ filename
   #@return _ <n> number of lines

   my $file = shift;

   my $N = 0;

   open(AUX, "< $file") or die "couldn't open file: $file\n";
   while (<AUX>) { $N++; }
   close(AUX);

   return $N;
}

# ------------------------------------- MAIN ------------------------------------------
my $NARG = 2;

# check number of arguments
my $ARGLEN = scalar(@ARGV);
if ($ARGLEN < $NARG) { get_out(); }

my $IQsetup_config;
my $IQeval_config;
my $print = 0;
my $remake = 0;
my $doALL = 0;
my $verbose = 0;

my $ARGOK = 0;
my $i = 0;
while (($i < $ARGLEN) and (!$ARGOK)) {
   my $opt = shift(@ARGV);
   if (($opt eq "-PRINT") or ($opt eq "-print")) { $print = 1; }
   elsif (($opt eq "-REMAKE") or ($opt eq "-remake")) { $remake = 1; }
   elsif (($opt eq "-V") or ($opt eq "-v")) { $verbose = shift(@ARGV); }
   elsif (($opt eq "-doall") or ($opt eq "-doALL")) { $doALL = 1; }
   else {
      if ($opt ne "") {
         $IQsetup_config = $opt;
         if (scalar(@ARGV)) { $IQeval_config = shift(@ARGV); $ARGOK = 1; }
      }
   }
   $i++;
}

if (!($ARGOK)) { get_out(); }

if ($verbose) {
   $0 =~ /\/([^\/]*$)/;
   print STDERR "----------------------------------------------------------------------------------------\n$METRICS::appname v$METRICS::appversion ($1).\n(C) $METRICS::appyear TALP / UNED.\nWritten by Jesus Gimenez and Enrique Amigo.\n----------------------------------------------------------------------------------------\n";
}

# ------------------------------------- read config file --------------------------

if ($verbose) { print STDERR "READING IQsetup config file <$IQsetup_config>..."; }

open(QF, "< $IQsetup_config") or die "couldn't open input file: $IQsetup_config\n";
open(QI, "> $IQeval_config") or die "couldn't open output file: $IQeval_config\n";

print QI "# *****************************************************\n";
print QI "# *                                                   *\n";
print QI "# * NOTE: This file has been automatically generated. *\n";
print QI "# *       It is intended to be modified by the user   *\n";
print QI "# *       to define new metric sets, system sets,     *\n";
print QI "# *       reference sets and segment sets.            *\n";
print QI "# *                                                   *\n";
print QI "# *****************************************************\n";

my $src;
my %Hsystems;
my %Hrefs;
my %Hmetrics;
my @references;
my @systems;
my $Nsegments = 0;
#my @realsystems;
#my @fakesystems;
my $name;
my $IQMT = "";
#my @K;
#my $NSYSTEM = 0;  #default value (better if dividable into 4)
my $s = 0; my $m = 0;
while (my $line = <QF>) {
  chomp($line);
  if ($line ne "") {
     #print QI "$line\n";
     my @entry = split(/ *= */, $line);
     if (!($line =~ /^\#.*/)) { # line's not a comment
        if ($entry[0] eq "NAME") { print QI "$line\n"; $name = $entry[1]; }
        elsif ($entry[0] eq "source") {
           print QI "$line\n";
           $src = $entry[1];
           $Nsegments = find_nsegments($src);
        }
        elsif ($entry[0] eq "system") {
           print QI "$line\n";
           $systems[$s] = "S".$s;
           #$realsystems[$s] = $systems[$s];
           $Hsystems{$systems[$s]} = $entry[1];
           $s++;
        }
        elsif ($entry[0] eq "ref") {
           print QI "$line\n";
           $references[$m] = "R".$m;
           $Hrefs{$references[$m]} = $entry[1];
           $m++;
        }
        elsif ($entry[0] eq "IQMT") { print QI "$line\n"; $IQMT = $entry[1]; }
        #elsif ($entry[0] eq "N") { $NSYSTEM = $entry[1]; }
        #elsif ($entry[0] =~ "^K[0-9]*") { push(@K, $entry[1]); }
        elsif ($entry[0] =~ /^doBLEU.*/) {        
           my @subentry = split(/[ ]+/, $entry[0]);
           shift(@subentry);
           if (scalar(@subentry)) {
              foreach my $n (@subentry) {
	         if ($n eq "1") { $Hmetrics{"$METRICS::BLEUEXT-1"} = 1; }
	         elsif ($n eq "2") { $Hmetrics{"$METRICS::BLEUEXT-2"} = 1; }
	         elsif ($n eq "3") { $Hmetrics{"$METRICS::BLEUEXT-3"} = 1; }
   	         elsif ($n eq "4") { $Hmetrics{"$METRICS::BLEUEXT-4"} = 1; }
	      }
  	   }
           else {
	      $Hmetrics{"$METRICS::BLEUEXT-1"} = 1;
  	      $Hmetrics{"$METRICS::BLEUEXT-2"} = 1;
	      $Hmetrics{"$METRICS::BLEUEXT-3"} = 1;
	      $Hmetrics{"$METRICS::BLEUEXT-4"} = 1;
	   }
        }
        elsif ($entry[0] =~ /^doGTM.*/) {
           my @subentry = split(/[ ]+/, $entry[0]);
           shift(@subentry);
           if (scalar(@subentry)) { 
              foreach my $e (@subentry) {
	         if ($e eq "1") { $Hmetrics{"$METRICS::GTMEXT-1"} = 1; }
	         elsif ($e eq "2") { $Hmetrics{"$METRICS::GTMEXT-2"} = 1; }
	         elsif ($e eq "3") { $Hmetrics{"$METRICS::GTMEXT-3"} = 1; }
  	      }
	   }
           else {
	      $Hmetrics{"$METRICS::GTMEXT-1"} = 1;
	      $Hmetrics{"$METRICS::GTMEXT-2"} = 1;
	      $Hmetrics{"$METRICS::GTMEXT-3"} = 1;
  	   }
        }
        elsif ($entry[0] =~ /^doMETEOR.*/) {
           my @subentry = split(/[ ]+/, $entry[0]);
           shift(@subentry);
           if (scalar(@subentry)) { 
              foreach my $n (@subentry) {
	         if ($n eq "exact") { $Hmetrics{"$METRICS::METEXT-exact"} = 1; }
	         elsif ($n eq "stem") { $Hmetrics{"$METRICS::METEXT-stem"} = 1; }
	         elsif ($n eq "wnstm") { $Hmetrics{"$METRICS::METEXT-wnstm"} = 1; }
   	         elsif ($n eq "wnsyn") { $Hmetrics{"$METRICS::METEXT-wnsyn"} = 1; }
	      }
  	   }
           else {
	      $Hmetrics{"$METRICS::METEXT-exact"} = 1;
	      $Hmetrics{"$METRICS::METEXT-stem"} = 1;
  	      $Hmetrics{"$METRICS::METEXT-wnstm"} = 1;
	      $Hmetrics{"$METRICS::METEXT-wnsyn"} = 1;
  	   }
        }
        elsif ($entry[0] =~ /^doNIST.*/) {
           my @subentry = split(/[ ]+/, $entry[0]);
           shift(@subentry);
           if (scalar(@subentry)) { 
              foreach my $n (@subentry) {
	         if ($n eq "1") { $Hmetrics{"$METRICS::NISTEXT-1"} = 1; }
	         elsif ($n eq "2") { $Hmetrics{"$METRICS::NISTEXT-2"} = 1; }
  	         elsif ($n eq "3") { $Hmetrics{"$METRICS::NISTEXT-3"} = 1; }
	         elsif ($n eq "4") { $Hmetrics{"$METRICS::NISTEXT-4"} = 1; }
	         elsif ($n eq "5") { $Hmetrics{"$METRICS::NISTEXT-5"} = 1; }
  	      }
	   }
           else {
	      $Hmetrics{"$METRICS::NISTEXT-1"} = 1;
  	      $Hmetrics{"$METRICS::NISTEXT-2"} = 1;
	      $Hmetrics{"$METRICS::NISTEXT-3"} = 1;
  	      $Hmetrics{"$METRICS::NISTEXT-4"} = 1;
	      $Hmetrics{"$METRICS::NISTEXT-5"} = 1;
	   }
        }
        elsif ($entry[0] =~ /^doROUGE.*/) {
           my @subentry = split(/[ ]+/, $entry[0]);
           shift(@subentry);
           if (scalar(@subentry)) { 
              foreach my $n (@subentry) {
	         if ($n eq "1") { $Hmetrics{"$METRICS::ROUGEXT-1"} = 1; }
	         elsif ($n eq "2") { $Hmetrics{"$METRICS::ROUGEXT-2"} = 1; }
	         elsif ($n eq "3") { $Hmetrics{"$METRICS::ROUGEXT-3"} = 1; }
 	         elsif ($n eq "4") { $Hmetrics{"$METRICS::ROUGEXT-4"} = 1; }
	         elsif ($n eq "L") { $Hmetrics{"$METRICS::ROUGEXT-L"} = 1; }
	         elsif ($n eq "S") { $Hmetrics{"$METRICS::ROUGEXT-Ss"} = 1; }
	         elsif ($n eq "SU") { $Hmetrics{"$METRICS::ROUGEXT-SUs"} = 1; }
	         elsif ($n eq "W") { $Hmetrics{"$METRICS::ROUGEXT-W-1.2"} = 1; }
	      }
   	   }
           else {
	      $Hmetrics{"$METRICS::ROUGEXT-1"} = 1;
	      $Hmetrics{"$METRICS::ROUGEXT-2"} = 1;
  	      $Hmetrics{"$METRICS::ROUGEXT-3"} = 1;
	      $Hmetrics{"$METRICS::ROUGEXT-4"} = 1;
	      $Hmetrics{"$METRICS::ROUGEXT-L"} = 1;
	      $Hmetrics{"$METRICS::ROUGEXT-Ss"} = 1;
	      $Hmetrics{"$METRICS::ROUGEXT-SUs"} = 1;
	      $Hmetrics{"$METRICS::ROUGEXT-W-1.2"} = 1;
	   }
        }
        elsif ($entry[0] eq "doWER") { $Hmetrics{"1-$METRICS::WEREXT"} = 1; }
        elsif ($entry[0] eq "doPER") { $Hmetrics{"1-$METRICS::PEREXT"} = 1; }
     }
  }
}

close(QF);

if ($verbose) { print STDERR " [DONE]\n"; }

if ($IQMT eq "") { die "[ERROR] IQMT path undefined!!\n"; }
elsif ($src eq "") { die "[ERROR] source undefined!!\n"; }
elsif (scalar(@references) == 0) { die "[ERROR] set of references undefined!!\n"; }
elsif (scalar(@systems) == 0) { die "[ERROR] set of systems undefined!!\n"; }
elsif (scalar(keys %Hmetrics) == 0) { die "[ERROR] set of metrics undefined!!\n"; }

#my $i = 0;
#while ($i < $NSYSTEM) {  $systems[$s] = "D".$i; $fakesystems[$i] = "D".$i; $Hsystems{$systems[$s]} = "$name-dummy-".$i.".txt"; $s++; $i++; }

if (scalar(@references)) { print QI "references= ", join(" ", @references), "\n"; }
foreach my $m (@references) { print QI "references_$m= $m\n"; }
if (scalar(@systems)) { print QI "systems= ", join(" ", @systems), "\n"; }
foreach my $s (@systems) { print QI "systems_$s= $s\n"; }
#if (scalar(@realsystems)) { print QI "realsystems= ", join(" ", @realsystems), "\n"; }
#if (scalar(@fakesystems)) { print QI "fakesystems= ", join(" ", @fakesystems), "\n"; }
if ($Nsegments == 0) { die "[ERROR] empty source file!! (Nsegments = ", $Nsegments + 0, ")\n"; }
else { print QI "segments= 1-$Nsegments\n"; }

print QI "metrics=", join(" ", sort keys %Hmetrics), "\n";
foreach my $m (sort keys %Hmetrics) { print QI "metrics_$m=$m\n"; }

if ($verbose) {
   print STDERR "----------------------------------------------------------------------------------------\n";
   print STDERR "IQMT path = $IQMT\n";
   print STDERR "----------------------------------------------------------------------------------------\n";
   print STDERR "SYSTEMS\n";
   print STDERR "-------\n";
   foreach my $r (sort criterion keys %Hsystems) { print STDERR "$r = ", $Hsystems{$r}, "\n"; }
   print STDERR "REFERENCES\n";
   print STDERR "----------\n";
   foreach my $r (sort criterion keys %Hrefs) { print STDERR "$r = ", $Hrefs{$r}, "\n"; }
   print STDERR "----------------------------------------------------------------------------------------\n";
   print STDERR "SOURCE = $src\n";
   print STDERR "SEGMENTS = 1-$Nsegments\n";
   print STDERR "METRICS = ", join(" ", sort keys %Hmetrics), "\n";
   print STDERR "----------------------------------------------------------------------------------------\n";
}

#if (scalar(@K) == 0) { push(@K, $Kdef); }
#print STDERR Dumper(\@K);

#if ($NSYSTEM > 0) {
#   # --------------------- create fake systems ---------------------------------------
#   print STDERR "GENERATING fake segments...[N = $NSYSTEM]...";
#   srand();
#
#   my @F;
#   #open reference files
#   foreach my $r (sort keys %Hrefs) {
#      my $FILE = new IO::File("< ".$Hrefs{$r}) or die "Couldn't open input file: ".$$Hrefs{$r}."\n";
#      push(@F, $FILE);
#   }
#
#   #open system files
#   $i = 0;
#   my @T;
#   my $GO = 0;
#   while ($i < $NSYSTEM) {
#      if (!(-e "$name-dummy-".$i.".txt")) {
#         my $FILE = new IO::File("> $name-dummy-".$i.".txt") or die "Couldn't open system file: ".$name-dummy-".$i.".txt\n";   
#         push(@T, $FILE);
#         $GO = 1;
#      }
#      $i++;
#   }
#
#   my $n = 0;
#   if ($GO) {
#      while (defined(my $line0 = $F[0]->getline())) {
#         chomp($line0);
#         my @LINE;
#         my $i = 1;
#         $LINE[0] = $line0;
#         while ($i < scalar(@F)) { my $line = $F[$i]->getline(); chomp($line); push(@LINE, $line); $i++; }
#         my $N = 0;
#         while ($N < $NSYSTEM) {
#            $i = 0;
#            while (($i < scalar(@LINE)) and ($N < $NSYSTEM)) {
#	       my $k = 0;
#   	       while (($k < scalar(@K)) and ($N < $NSYSTEM)) {
#                  $T[$N]->print(delete_error($LINE[$i], $K[$k])."\n"); $N++;
#                  if ($N < $NSYSTEM) { $T[$N]->print(insert_error($LINE[$i], $K[$k])."\n"); $N++; }
#                  if ($N < $NSYSTEM) { $T[$N]->print(replace_error($LINE[$i], $K[$k])."\n"); $N++; }
#                  if ($N < $NSYSTEM) { $T[$N]->print(swapping_error($LINE[$i], $K[$k])."\n"); $N++; }
#                  $k++;
#               }
#               $i++;
#            }
#         }
#         $n++;
#         if ($n % 10 == 0) { print STDERR "."; }
#         if ($n % 100 == 0) { print STDERR "$n"; }
#      }
#      print STDERR "..$n segments [DONE]\n";
#   }
#
#   #close reference files
#   foreach my $f (@F) { $f->close(); }
#   #close system files
#   foreach my $f (@T) { $f->close(); }
#}

# ----------------------------------------------------------------------------------

if ($verbose) { print STDERR "COMPUTING SIMILARITIES...\n"; }

$IQMT = $IQMT."/tools";
$IQMT =~ s/\/+/\//g;

#evaluate each reference against each reference
foreach my $r1 (sort criterion keys %Hrefs) {
   foreach my $r2 (sort criterion keys %Hrefs) {
      if ($r1 ne $r2) {
         METRICS::doMetrics($src, $Hrefs{$r1}, $Hrefs{$r2}, $remake, $r1, $r2, $IQMT, \%Hmetrics, $verbose);
         if ($print) { METRICS::read_write_metrics(*QI, $r1, $r2, \%Hmetrics, $verbose); }
      }
   }
}

#evaluate each system against each reference
foreach my $t (sort criterion keys %Hsystems) {
   foreach my $r (sort criterion keys %Hrefs) {
      METRICS::doMetrics($src, $Hsystems{$t}, $Hrefs{$r}, $remake, $t, $r, $IQMT, \%Hmetrics, $verbose);
      if ($print) { METRICS::read_write_metrics(*QI, $t, $r, \%Hmetrics, $verbose); }
   }
}

if ($doALL) { # do extrawork for KING and JACK computation
   #evaluate each reference against each system
   foreach my $r (sort criterion keys %Hrefs) {
      foreach my $t (sort criterion keys %Hsystems) {
         METRICS::doMetrics($src, $Hrefs{$r}, $Hsystems{$t}, $remake, $r, $t, $IQMT, \%Hmetrics, $verbose);
         if ($print) { METRICS::read_write_metrics(*QI, $r, $t, \%Hmetrics, $verbose); }
      }
   }

   #evaluate each system against each system
   foreach my $t1 (sort criterion keys %Hsystems) {
      foreach my $t2 (sort criterion keys %Hsystems) {
          if ($t1 ne $t2) {
             METRICS::doMetrics($src, $Hsystems{$t1}, $Hsystems{$t2}, $remake, $t1, $t2, $IQMT, \%Hmetrics, $verbose);
             if ($print) { METRICS::read_write_metrics(*QI, $t1, $t2, \%Hmetrics, $verbose); }
         }
      }
   }
}

close(QI);

if ($verbose) { print STDERR "WRITTEN IQeval config file <$IQeval_config>... [DONE]\n"; }
