#!/usr/bin/perl
# Authors     : Enrique Amig and Jess Gimnez
# Date        : July 11, 2005
# Description : Responsible for evaluating a set of systems inside the QARLA Evaluation Framework,
#               given a proper config file containing information about the
#               source file, set of system files, and set of reference files.
#
# Usage: IQeval [options] IQeval.config
#                           (input)
#
# ------------------------------------------------------------------------
# ------------------------------------------------------------------------

#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::QARLA;

my $NARG = 1;

sub get_out
{
   $0 =~ /\/([^\/]*$)/;
   print STDERR "Usage : ", $1, "  [options]  <IQeval.config>\n\n";
   print STDERR "  - doKING              : compute KING score (default disabled)\n";
   print STDERR "  - doKINGtt            : compute KING-TT score (default disabled)\n";
   print STDERR "  - doQUEEN             : compute QUEEN score (default disabled)\n";
   print STDERR "  - doQUEENtt           : compute QUEEN-TT score (default disabled)\n";
   print STDERR "  - doJACK              : compute JACK score (default disabled)\n";
   print STDERR "  - doJACKtt            : compute JACK-TT score (default disabled)\n";
   print STDERR "  - doIQ                : compute IQ score (default disabled)\n";
   print STDERR "  - doIQtt              : compute IQ-TT score (default disabled)\n";
   print STDERR "  - doOQ                : compute individual metric scores outside QARLA (default disabled)\n";
   print STDERR "  - optimizeKING        : find a metric set of suboptimal KING score (default disabled)\n";
   print STDERR "  - optimizeKINGtt      : find a metric set of suboptimal KING-TT score (default disabled)\n";
   print STDERR "  - doPking             : compute P_King (default disabled)\n";
   print STDERR "  - doPorange           : compute P_Orange (default disabled)\n";
   print STDERR "\n";
   print STDERR "  - M <metrics>         : set of metrics (setname according to IQeval.config)\n";
   print STDERR "                          ['metrics' by default]\n";
   print STDERR "  - S <systems>         : set of systems (setname according to IQeval.config)\n";
   print STDERR "                          ['systems' by default]\n";
   print STDERR "  - R <references>      : set of references (setname according to IQeval.config)\n";
   print STDERR "                          ['references' by default]\n";
   print STDERR "  - T <segments>        : set of segments (setname according to IQeval.config)\n";
   print STDERR "                          ['segments' by default]\n";
   print STDERR "  - G <sys|seg>         : level of granularity\n";
   print STDERR "                          sys - system-level scores (default)\n";
   print STDERR "                          seg - segment-level scores\n";
   print STDERR "\n";
   print STDERR "  - doref               : include reference scores as well (default disabled)\n";
   print STDERR "  - remake              : remake metric computations\n";
   print STDERR "  - O <0|1>             : output format\n";
   print STDERR "                          0 - score matrix (default)\n";
   print STDERR "                          1 - ranking lists (on a metric basis)\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 -V 1 -doOQ -G seg -O 1 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); } 
}

# -- main program --
my $NARG = 1;

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


my $M = "metrics";
my $S = "systems";
my $R = "references";
my $T = "segments";
my $G = "sys";
my $O = 0;
my $doKING = 0;
my $doKINGtt = 0;
my $doQUEEN = 0;
my $doQUEENtt = 0;
my $doJACK = 0;
my $doJACKtt = 0;
my $doIQ = 0;
my $doIQtt = 0;
my $doOQ = 0;
my $doREF = 0;
my $optimizeKING = 0;
my $optimizeKINGtt = 0;
my $doPking = 0;
my $doPorange = 0;
my $remake = 0;
my $verbose = 0;
my $IQeval_config;

my $ARGOK = 0;
my $i = 0;
while (($i < $ARGLEN) and (!$ARGOK)) {
   my $opt = shift(@ARGV);
   if ($opt =~ /^\-.+/) {
      if (($opt eq "-M") or ($opt eq "-m")) { $M = shift(@ARGV); }
      elsif (($opt eq "-S") or ($opt eq "-s")) { $S = shift(@ARGV); }
      elsif (($opt eq "-R") or ($opt eq "-r")) { $R = shift(@ARGV); }
      elsif (($opt eq "-T") or ($opt eq "-t")) { $T = shift(@ARGV); }
      elsif (($opt eq "-G") or ($opt eq "-g")) { $G = shift(@ARGV); }
      elsif (($opt eq "-O") or ($opt eq "-o")) { $O = shift(@ARGV); }
      elsif (($opt eq "-doKING") or ($opt eq "-doking")) { $doKING = 1; }
      elsif (($opt eq "-doKINGtt") or ($opt eq "-dokingtt")) { $doKINGtt = 1; }
      elsif (($opt eq "-doQUEEN") or ($opt eq "-doqueen")) { $doQUEEN = 1; }
      elsif (($opt eq "-doQUEENtt") or ($opt eq "-doqueentt")) { $doQUEENtt = 1; }
      elsif (($opt eq "-doJACK") or ($opt eq "-dojack")) { $doJACK = 1; }
      elsif (($opt eq "-doJACKtt") or ($opt eq "-dojacktt")) { $doJACKtt = 1; }
      elsif (($opt eq "-doIQ") or ($opt eq "-doiq")) { $doIQ = 1; }
      elsif (($opt eq "-doIQtt") or ($opt eq "-doiqtt")) { $doIQtt = 1; }
      elsif (($opt eq "-doOQ") or ($opt eq "-dooq")) { $doOQ = 1; }
      elsif (($opt eq "-doPking") or ($opt eq "-dopking")) { $doPking = 1; }
      elsif (($opt eq "-doPorange") or ($opt eq "-doporange")) { $doPorange = 1; }
      elsif (($opt eq "-optimizeKING") or ($opt eq "-optimizeking")) { $optimizeKING = 1; }
      elsif (($opt eq "-optimizeKINGtt") or ($opt eq "-optimizekingtt")) { $optimizeKINGtt = 1; }
      elsif (($opt eq "-doREF") or ($opt eq "-doref")) { $doREF = 1; }
      elsif (($opt eq "-REMAKE") or ($opt eq "-remake")) { $remake = 1; }
      elsif (($opt eq "-V") or ($opt eq "-v")) { $verbose = shift(@ARGV); }
      else { die "[IQMT] INVALID OPTION <$opt>!!!\n"; }
   }
   else {
      if ($opt ne "") { $IQeval_config = $opt; $ARGOK = 1; }
   }
   $i++;
}

if (($G ne "sys") and ($G ne "seg")) { die "[ERROR] invalid granularity <$G>!!\n"; }

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

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

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

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

open(QF, "<$IQeval_config") or die "couldn't open file: $IQeval_config\n";
my %TOOLS;
my @metrics;
my %Hmetrics;
my @systems;
my @references;
my @segments;
my $SEGMENTS;
my $src;
my %Hrefs;
my %Hsystems;
my $IQMT = "";
my $doSP = 0;
my $LANG = "ENG";

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 =~ /^\#.*/)) {
         if ($entry[0] eq "source") { $src = $entry[1]; }
         elsif ($entry[0] eq "ref") { $Hrefs{"R".$m} = $entry[1]; $m++;  }
         elsif ($entry[0] eq "system") { $Hsystems{"S".$s} = $entry[1]; $s++;  }
         elsif ($entry[0] eq "LANG") { $LANG = $entry[1]; }
         elsif ($entry[0] eq $M) { # metrics
            @metrics = split(" ", $entry[1]);
            my $i = 0;
            while ($i < scalar(@metrics)) {
               $Hmetrics{$metrics[$i]} = 1;  $i++;
            }
         }
         elsif ($entry[0] eq $S) { @systems = split(" ", $entry[1]); } # systems
         elsif ($entry[0] eq $R) { @references = split(" ", $entry[1]); } # references
         elsif ($entry[0] eq $T) { # segments
            $SEGMENTS = $entry[1];
            my @subentry = split(/\, */, $SEGMENTS);
            foreach my $range (@subentry) {
               my @subsubentry = split("-", $range);
               if (scalar(@subsubentry == 1)) { push(@segments, $subsubentry[0]); }
               elsif (scalar(@subsubentry == 2)) {
                  my $i = $subsubentry[0];
                  while ($i <= $subsubentry[1]) { push(@segments, $i); $i++; }
               }
               else { die "[ERROR] invalid segment range!!\n"; }
	    }
         }
         elsif ($entry[0] eq "IQMT") { $IQMT = $entry[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"; }
elsif (scalar(@segments) == 0) { die "[ERROR] set of segments undefined!!\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 = $SEGMENTS\n";
   print STDERR "REFERENCES = ", join(" ", sort criterion @references), "\n";
   print STDERR "SYSTEMS = ", join(" ", sort criterion @systems), "\n";
   print STDERR "METRICS = ", join(" ", sort keys %Hmetrics), "\n";
   print STDERR "----------------------------------------------------------------------------------------\n";
}

# ----------------------------------------------------------------------------------
if (!(-e "./$COMMON::TMP")) { system "mkdir ./$COMMON::TMP"; } #TEMPORARY DIRECTORY
srand(); #random seed initialization
# ----------------------------------------------------------------------------------

if (!($doOQ or $doKING or $doKINGtt or $doQUEEN or $doQUEENtt or $doJACK or $doJACKtt or $doIQ or $doIQtt or $doPking or $doPorange or $optimizeKING or $optimizeKINGtt)) { die "[IQMT] NOTHING TO DO!! [-doOQ | -doKING | -doKINGtt | -doQUEEN | -doQUEENtt | -doJACK | -doJACKtt | -doIQ | -doIQtt | -doPking | -doPorange | optimizeKING | optimizeKINGtt ]\n"; }

# ------------- COMPUTE SCORES outside QARLA ----------------------------

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

my $parser;

if ($doOQ) {
   #SYSTEMS
   if ($verbose) { print STDERR "[SYSTEMS OUTSIDE QARLA] - computing scores...\n"; }
   foreach my $t (sort criterion @systems) {
      METRICS::doMultiMetrics($src, $Hsystems{$t}, \%Hrefs, \@references, $remake, $t, $IQMT, \%Hmetrics, $parser, $LANG, $verbose);
   }
   #REFERENCES
   if ($doREF) {
      if ($verbose) { print STDERR "[REFERENCES OUTSIDE QARLA] - computing scores...\n"; }
      foreach my $R (sort criterion @references) {
         my @refs;
         foreach my $r (sort criterion @references) { if ($r ne $R) { push(@refs, $r); } }
         METRICS::doMultiMetrics($src, $Hrefs{$R}, \%Hrefs, \@refs, $remake, $R, $IQMT, \%Hmetrics, $parser, $LANG, $verbose);
      }
   }
}

# ------------- START QARLA -- load similarities -----------------------

my $IQ;
my $NSEGMENTS = 0;

if ($doJACK or $doJACKtt) {
   ($IQ, $NSEGMENTS) = QARLA::start(\@metrics, \@segments, \@systems, \@references, 1, $verbose);
}
else {
   if ($doKING or $doKINGtt or $doQUEEN or $doQUEENtt or $doIQ or $doIQtt or $optimizeKING or $optimizeKINGtt) { #load scores
      ($IQ, $NSEGMENTS) = QARLA::start(\@metrics, \@segments, \@systems, \@references, 0, $verbose);
   }
}

# ------------- PRINT REPORT --------------------------------------------

if ($doOQ or $doQUEEN or $doQUEENtt or $doIQ or $doIQtt) {

   if ($O == 0) { #score matrix
      my @header;
      if ($doOQ) {
         foreach my $m (sort @metrics) { push(@header, sprintf("%-10s", $m)); }
      }
      if ($doQUEEN) { push(@header, sprintf("%-10s", "QUEEN")); }
      if ($doQUEENtt) { push(@header, sprintf("%-10s", "QUEEN-TT")); }
      if ($doIQ) { push(@header, sprintf("%-10s", "IQ")); }
      if ($G eq "sys") { printf "%-10s %s\n", "SYS", join(" ", @header); } # G == 'sys'
      else { printf "%-18s %s\n", "SYS:SEG", join(" ", @header); } # G == 'seg'
      print "\n";

      if ($verbose) { print STDERR "\n[PRINTING]...\n"; }
      foreach my $t (sort criterion @systems) {
         my %OQ;
         if ($doOQ) {
            my @auxSYS = ($t);
            $NSEGMENTS = METRICS::read_metrics(\@metrics, \@auxSYS, \@references, \@segments, \%OQ, $G, $verbose);
         }
         METRICS::print_metrics(\%OQ, $IQ, $t, $G, \@metrics, \@segments, \@references, $doOQ, $doQUEEN, $doQUEENtt, $doIQ, $doIQtt, $NSEGMENTS, $verbose);
      }
      if ($doREF) {
         foreach my $R (sort criterion @references) {
            my @refs;
            foreach my $r (sort criterion @references) { if ($r ne $R) { push(@refs, $r); } }
            my %OQ;
            my @auxREF = ($R);
            $NSEGMENTS = METRICS::read_metrics(\@metrics, \@auxREF, \@refs, \@segments, \%OQ, $G, $verbose);
            METRICS::print_metrics(\%OQ, $IQ, $R, $G, \@metrics, \@segments, \@refs, $doOQ, $doQUEEN, $doQUEENtt, $doIQ, $doIQtt, $NSEGMENTS, $verbose);
	 }
      }
   }
   elsif ($O == 1) { #ranking lists
      my %OQ;
      if ($verbose) { print STDERR "\n[PRINTING]...\n"; }
      if ($doOQ) {
         $NSEGMENTS = METRICS::read_metrics(\@metrics, \@systems, \@references, \@segments, \%OQ, $G, $verbose);
         if ($doREF) {
            foreach my $R (sort criterion @references) {
               my @refs;
               foreach my $r (sort criterion @references) { if ($r ne $R) { push(@refs, $r); } }
               my @auxREF = ($R);
               $NSEGMENTS = METRICS::read_metrics(\@metrics, \@auxREF, \@refs, \@segments, \%OQ, $G, $verbose);
	    }
         }
      }
      METRICS::print_rankings(\%OQ, $IQ, $G, \@metrics, \@segments, \@systems, \@references, $doOQ, $doQUEEN, $doQUEENtt, $doIQ, $doIQtt, $NSEGMENTS, $verbose);
   }
   else { die "[ERROR] UNKNOWN OUTPUT MODE <$O>!!\n"; }
}

if ($doPking or $doPorange) {
   if ($verbose) { print STDERR "[COMPUTING P_orange and/or P_king...]\n"; }
   my ($Pking, $Porange) = METRICS::compute_Pking_Porange($src, \%Hsystems, \%Hrefs, \%Hmetrics, \@systems, \@references, \@segments, \@metrics, $IQMT, $parser, $LANG, $remake, $verbose);

    foreach my $m (sort @{$M}) { printf "%-20s = %6.4f\n", "P_King[$m]", $Pking->{$m}; }

    foreach my $m (sort @{$M}) { printf "%-20s = %6.4f\n", "P_Orange[$m]", $Porange->{$m}; }

}

if ($doKING) {
   my $K = QARLA::KING($IQ, \@metrics, \@segments, \@systems, \@references, $verbose);
   printf "KING = %10.4f\n", $K;
}

if ($doKINGtt) {
   my $K = QARLA::KING_TT($IQ, \@metrics, \@segments, \@systems, \@references, $verbose);
   printf "KING-TT = %10.4f\n", $K;
}

if ($doJACK) {
   my $J = QARLA::JACK($IQ, \@metrics, \@segments, \@systems, \@references, $verbose);
   printf "JACK = %10.4f\n", $J;
}

if ($doJACKtt) {
   my $J = QARLA::JACK_TT($IQ, \@metrics, \@segments, \@systems, \@references, $verbose);
   printf "JACKtt = %10.4f\n", $J;
}

if ($optimizeKING) {
   my ($set, $maxK) = QARLA::find_OPTIMAL_KING_simple($IQ, \@metrics, \@segments, \@systems, \@references, $verbose);
   print "\n-------------------------------------------------------\n";
   print "metrics_SUBOPTIMAL = ", join(" ", @{$set}),"\n";
   print "KING_SUBOPTIMAL = ", sprintf("%6.4f", $maxK), "\n";
   open(QF, ">>$IQeval_config") or die "couldn't open file: $IQeval_config\n";
   print QF "metrics_SUBOPTIMAL= ", join(" ", @{$set}),"\n";
   print QF "KING_SUBOPTIMAL= ", sprintf("%6.4f", $maxK), "\n";
   close(QF);
}

if ($optimizeKINGtt) {
   my ($set, $maxK) = QARLA::find_OPTIMAL_KING_TT_simple($IQ, \@metrics, \@segments, \@systems, \@references, $verbose);
   print "\n-------------------------------------------------------\n";
   print "metrics_SUBOPTIMAL = ", join(" ", @{$set}),"\n";
   print "KING_SUBOPTIMAL = ", sprintf("%6.4f", $maxK), "\n";
   open(QF, ">>$IQeval_config") or die "couldn't open file: $IQeval_config\n";
   print QF "metrics_SUBOPTIMAL= ", join(" ", @{$set}),"\n";
   print QF "KING_SUBOPTIMAL= ", sprintf("%6.4f", $maxK), "\n";
   close(QF);
}


# ******************************************************************************
# ******************************************************************************
