#!/usr/bin/perl

use strict;
#use warnings;
use utf8;

my $word  = "_U_";
my $lemma = "_U_";
my $pos   = "_U_";
my $msd   = "_U_";
my $depRel    = "_U_";
my $analysis  = "_U_";
my $newCohort = 1;
my $sentCounter = 0;
my $wordCounter = 0;
my $lang = 'sme';
my %dep_rel = ();
my $inDir = 'input';
my $outDir = 'out_xml_'.$lang;
my $corpus_name = $lang.'_corpus';
my $realLemma = "_U_";
my $ismeFile = "/Users/cipriangerstenberger/main/gt/sme/bin/isme-norm\.fst";

system("mkdir -p $outDir");
opendir(DIR, $inDir) || die $!;

my $t = 'tmp';
my $gs = 'c_gtest.script';
system("mkdir -vp $t");
open (GSFILE, '>', "$t/$gs");
print GSFILE "load $ismeFile\n"."apply up < tmp/in\.gtest\n"."quit\n"; 
close GSFILE;

open (LSFILE, '>', "$t/levenshtein_file.txt");

init_dep();

while (my $inFile = readdir(DIR)) {
    # only files
    next unless (-f "$inDir/$inFile");
    # find files ending in .dep
    next unless ($inFile =~ m/^(.*)\.dep$/);
    my $outFile = $1;
    my $ctag = '';
    my $isDer = '';

    if ($outFile =~ /.*gold.*/) {
      $ctag = 'g';
    }
    if ($outFile =~ /.*turi.*/) {
      $ctag = 't';
    }

    $outFile = $outFile."\.xml";
    #print "$outFile: $tlang $slang and $domain\n";
    #system("head -3 $inDir/$inFile");
    
    $sentCounter = 1;

    open (OUTFILE, '>', "$outDir/$outFile");
    open (INFILE,"$inDir/$inFile") || die "Can't Open File: $inFile\n";

    # from cwb-encode -h 
    #  -U <str>  insert <str> for missing columns [default: "_U_"]

    print OUTFILE '<?xml version="1.0" encoding="UTF-8"?>'."\n";
    print OUTFILE '<text title="'.$outFile.'" lang="'.$lang.'">'."\n";
    print OUTFILE '  <sentence id="'.$ctag.'_'.$sentCounter.'">'."\n";

    while (<INFILE>) {
        chomp;
        if (/^\"</) { #new lemma
            #print "new Lemma: $_\n";
            ($word) = $_ =~ /<(.+)>/;
	    $word =~ s/_/ /g;
            $newCohort = 1;
	    $wordCounter++;
        } 
        else { #no new lemma
            if (/^\t+(\"[^\"]+\")(.*)$/) { #analysis
                $lemma = lemma_trim($1);
                $analysis = trim($2);
		
                $lemma = unhtmlize($lemma);
                $word = unhtmlize($word);

                ($pos,$msd,$depRel,$isDer) = get_msd(trim($2));
		
		$depRel = $dep_rel{$depRel};
		if ($depRel eq "" || $depRel eq "\?") {
		  $depRel = "_U_";
		}
		
                $pos = unhtmlize($pos);

		if ($isDer eq "ye") {
		  $lemma = $realLemma;
		}
		
                if ($newCohort) {
#                    print OUTFILE "    <w id=\"".$ctag."_".$sentCounter."_".$wordCounter."\" word=\"".$word."\" lemma=\"".$lemma."\" pos=\"".$pos."\" msd=\"".$msd."\" depRel=\"".$depRel."\"/>\n";
                    print OUTFILE "    <w id=\"".$ctag."_".$sentCounter."_".$wordCounter."\" word=\"".$word."\" lemma=\"".$lemma."\" pos=\"".$pos."\" msd=\"".$msd."\"/>\n";
                }
                reset_var();
            } #analysis 
            else { #newline in the input => new sentence
                print OUTFILE '  </sentence>'."\n";
                $sentCounter++;
                $wordCounter=0;
                if (! eof)  { print OUTFILE '  <sentence id="'.$ctag.'_'.$sentCounter.'">'."\n" }
            } #newline
        } #else no new lemma
    } #while

    print OUTFILE '</text>';
    print "$inDir/$inFile done!\n";
    close INFILE;
    close OUTFILE;

}
close LSFILE;
closedir(DIR);
exit 0;


# subroutines
sub trim($);
sub ltrim($);
sub rtrim($);
sub lemma_trim($);
sub  unhtmlize($);
sub reset_vars();
sub get_msd();

sub get_msd()
{
  local($a) = @_;
  #remove sem- and other tags
  $a =~ s/Use\/[^\s]+ //g;
  $a =~ s/Sem\/[^\s]+ //g;
  #remove syntax labels
  $a =~ s/ <[^>]+>/ /g;
  #split the function
  my ($r, $fct) = split(/\@/, $a, 2);
  my $rest = trim($r);
  my $sfct = trim($fct);
  my $isDer = 'no';

  my ($vPOS, $vMSD) = $rest =~m/^([^\s]+)(.*)$/;
  
  # process pseudo-pos
  if (($vPOS =~ m/V\*/) & ($vMSD =~ m/ V /))  {
    $isDer = 'ye';
    ($vPOS,$vMSD) = generate_correct_lemma($vPOS, $vMSD);
  }
  
  $vMSD =~ s/^\s+//;
  $vMSD =~ s/\s+$//;
  $vMSD =~ s/ /\./g;
  $vMSD =~ s/\//_/g;

  if ($sfct eq "" || $sfct eq "\?")  {
    $sfct = "_U_";
  }
  if ($vMSD eq "" || $vMSD eq "\?")  {
    $vMSD = "_U_";
  }
  if ($vPOS eq "" || $vPOS eq "\?")  {
    $vPOS = "_U_";
  }

  #print STDERR "h ".$h."s ".$s."p ".$p."\n";
  return ($vPOS,$vMSD,$sfct,$isDer);
}

sub generate_correct_lemma()
{
  my ($ps,$md) = @_;
  my $i = rindex($md," V ");
  my $dHist = substr($md,0,$i);
  my $realMSD = substr($md,$i+3);

  $dHist =~ s/^\s+//;
  $dHist =~ s/\s+$//;
  $dHist =~ s/ /\+/g;
  $dHist =~ s/\*//g;

  my $str4gen = $lemma.'+V+'.$dHist.'+V+Inf';

  open (XFILE, '>', "$t/in.gtest");
  print XFILE $str4gen."\n"; 
  close XFILE;
  
  $realLemma = `xfst -q -utf8 < $t/$gs`;
  $realLemma =~ s/^\s+//;
  $realLemma =~ s/\s+$//;
  $realLemma =~ s/\n/===/;
  #$realLemma = "___".$realLemma."___";
  #$realLemma = "___".$realLemma."===".$str4gen."___";


  if ($realLemma =~ m/^([^=]+)===([^=]+)$/)  {
    #print STDERR "$word _lm_ ".$realLemma."\n";
    
    my $lvstn1 = levenshtein($word, $1);
    my $lvstn2 = levenshtein($word, $2);
    
    if ($lvstn1 > $lvstn2) {
      $realLemma = $2;
    } else {
      $realLemma = $1;
    }
    
    print LSFILE "$word : $1 _ $lvstn1\n"; 
    print LSFILE "$word : $2 _ $lvstn2\n"; 
    print LSFILE "___ $realLemma\n"; 
    print LSFILE "_________________\n"; 
  }

  
  $realMSD =~ s/^\s+//;
  $realMSD =~ s/\s+$//;
  $realMSD =~ s/ /\./g;
  $realMSD =~ s/\//_/g;

  #print STDERR "_lm_ ".$lemma." _dHist_ ".$dHist." _realMSD_ ".$realMSD." ___".$md."___\n";

  #return ($xpos,$xmsd);
  return ("V",$realMSD)
}


sub reset_var()
{
  $word  = "_U_";
  $pos   = "_U_";
  $lemma = "_U_";
  $depRel    = "_U_";
  $analysis  = "_U_";
  $newCohort = 0;
}


# remove quotation marks from the lemma, replace spaces by underscore and # by the empty string
sub unhtmlize($)
{
    my $string = shift;
    $string =~ s/&/&amp;/g;
    $string =~ s/</&lt;/g;
    $string =~ s/>/&gt;/g;
    $string =~ s/\"//g;
    return $string;
}


# Perl trim function to remove whitespace from the start and end of the string
sub dtrim($)
{
    my $string = shift;
    $string =~ s/^\$//;
    return $string;
}

# remove quotation marks from the lemma, replace spaces by underscore and # by the empty string
sub lemma_trim($)
{
    my $string = shift;
    $string =~ s/\"$//;
    $string =~ s/ /_/g;
    $string =~ s/#//g;
    return $string;
}

# Perl trim function to remove whitespace from the start and end of the string
sub trim($)
{
    my $string = shift;
    $string =~ s/^\s+//;
    $string =~ s/\s+$//;
    return $string;
}



sub init_dep()
{
%dep_rel = (
        "_U_" => "_U_",
        ">N" => "MOD",
        "<ADVL" => "ADV",
        "<ADVL-Acc" => "ADV-Acc",
        "<ADVL-Adv" => "ADV-Adv",
        "<ADVL-Com" => "ADV-Com",
        "<ADVL-Ess" => "ADV-Ess",
        "<ADVL-Gen" => "ADV-Gen",
        "<ADVL-Ill" => "ADV-Ill",
        "<ADVL-Loc" => "ADV-Loc",
        "<ADVL-Nom" => "ADV-Nom",
        "ADVL>" => "ADV",
        "ADVL>-Acc" => "ADV-Acc",
        "ADVL>-Adv" => "ADV-Adv",
        "ADVL>-Com" => "ADV-Com",
        "ADVL>-Ess" => "ADV-Ess",
        "ADVL>-Gen" => "ADV-Gen",
        "ADVL>-Ill" => "ADV-Ill",
        "ADVL>-Loc" => "ADV-Loc",
        "ADVL>-Nom" => "ADV-Nom",
        "ADVL>CS" => "ADV",
        "FS-ADVL>" => "ADV",
        "-FADVL>" => "ADV",
        "SUBJ>" => "SBJ",
        "-FADVL>" => "ADV",
        "-FADVL>-Adv"  => "ADV-Adv",
        "-FADVL>-Com"  => "ADV-Com",
        "-FADVL>-Gen"  => "ADV-Gen",
        "-FADVL>-Ill"  => "ADV-Ill",
        "-FADVL>-Loc"  => "ADV-Loc",
        "-FADVL>-Nom"  => "ADV-Nom",
        "-F<ADVL" => "ADV",
        "-F<ADVL-Acc"  => "ADV-Acc",
        "-F<ADVL-Adv"  => "ADV-Adv",
        "-F<ADVL-Com"  => "ADV-Com",
        "-F<ADVL-Gen"  => "ADV-Gen",
        "-F<ADVL-Ill"  => "ADV-Ill",
        "-F<ADVL-Loc"  => "ADV-Loc",
        "-F<ADVL-Nom"  => "ADV-Nom",
        "FMV" => "+MV",
        "CVP" => "CVP",
        "<OBJ" => "OBJ",
        "IMV" => "-MV",
        "CNP" => "CNP",
        "HNOUN" => "FRG",
        "<SPRED" => "SPR",
        "FAUX" => "+AV",
        "<SUBJ" => "SBJ",
        ">P" => "MOD",
        "FS-<ADVL" => "ADV",
        "FS-N<" => "+V",
        "FS-IMV" => "-MV",
        ">A" => "ADV",
        "OBJ>" => "OBJ",
        ">Num" => "MOD",
        "FS-OBJ" => "OBJ",
        "Num<" => "MOD",
        "FS-N<IMV" => "-MV",
        "-F<OBJ" => "OBJ",
        "PCLE" => "PCL",
        "HAB>" => "HAB",
        "P<" => "MOD",
        "FMVdic" => "+MV",
        ">ADVL" => "ADV",
        "IAUX" => "-AV",
        "N<" => "MOD",
        "SPRED>" => "SPR",
        "FS-VFIN<" => "ADV",
        "FS-IAUX" => "-AV",
        "COMP-CS<" => "CMP",
        ">CC" => "MOD",
        "-FOBJ>" => "OBJ",
        "<OPRED" => "OPR",
        "X" => "X",
        "APP-N<" => "APP",
        "ICL-SUBJ" => "SBJ",
        ">Pron" => "MOD",
        "-FSUBJ>" => "SBJ",
        "ICL-OBJ" => "OBJ",
        "FS-N<IAUX" => "-AV",
        "Pron<" => "MOD",
        "INTERJ" => "INT",
        "OPRED>" => "OPR",
        "A<" => "MOD",
        "S<" => "MOD",
        "<HAB" => "HAB",
        "VOC" => "VOC",
        "<PPRED" => "PPR",
        "ADVL<" => "MOD",
        "APP-ADVL<" => "APP",
        "APP-Pron<" => "APP",
        "FS-<SUBJ" => "SBJ",
        "IMVdic" => "-MV",
        "FS-P<" => "+MV",
        "+FMAINV" => "+MV"
       );
}

# Return the Levenshtein distance (also called Edit distance) 
# between two strings
#
# The Levenshtein distance (LD) is a measure of similarity between two
# strings, denoted here by s1 and s2. The distance is the number of
# deletions, insertions or substitutions required to transform s1 into
# s2. The greater the distance, the more different the strings are.
#
# The algorithm employs a promimity matrix, which denotes the 
# distances between substrings of the two given strings. Read the 
# embedded comments for more info. If you want a deep understanding 
# of the algorithm, printthe matrix for some test strings 
# and study it
#
# The beauty of this system is that nothing is magical - the distance
# is intuitively understandable by humans
#
# The distance is named after the Russian scientist Vladimir
# Levenshtein, who devised the algorithm in 1965
#
sub levenshtein
{
    # $s1 and $s2 are the two strings
    # $len1 and $len2 are their respective lengths
    #
    my ($s1, $s2) = @_;
    my ($len1, $len2) = (length $s1, length $s2);

    # If one of the strings is empty, the distance is the length
    # of the other string
    #
    return $len2 if ($len1 == 0);
    return $len1 if ($len2 == 0);

    my %mat;

    # Init the distance matrix
    #
    # The first row to 0..$len1
    # The first column to 0..$len2
    # The rest to 0
    #
    # The first row and column are initialized so to denote distance
    # from the empty string
    #
    for (my $i = 0; $i <= $len1; ++$i)
    {
        for (my $j = 0; $j <= $len2; ++$j)
        {
            $mat{$i}{$j} = 0;
            $mat{0}{$j} = $j;
        }

        $mat{$i}{0} = $i;
    }

    # Some char-by-char processing is ahead, so prepare
    # array of chars from the strings
    #
    my @ar1 = split(//, $s1);
    my @ar2 = split(//, $s2);

    for (my $i = 1; $i <= $len1; ++$i)
    {
        for (my $j = 1; $j <= $len2; ++$j)
        {
            # Set the cost to 1 iff the ith char of $s1
            # equals the jth of $s2
            # 
            # Denotes a substitution cost. When the char are equal
            # there is no need to substitute, so the cost is 0
            #
            my $cost = ($ar1[$i-1] eq $ar2[$j-1]) ? 0 : 1;

            # Cell $mat{$i}{$j} equals the minimum of:
            #
            # - The cell immediately above plus 1
            # - The cell immediately to the left plus 1
            # - The cell diagonally above and to the left + the cost
            #
            # We can either insert a new char, delete a char of
            # substitute an existing char (with an associated cost)
            #
            $mat{$i}{$j} = min([$mat{$i-1}{$j} + 1,
                                $mat{$i}{$j-1} + 1,
                                $mat{$i-1}{$j-1} + $cost]);
        }
    }

    # Finally, the distance equals the rightmost bottom cell
    # of the matrix
    #
    # Note that $mat{$x}{$y} denotes the distance between the 
    # substrings 1..$x and 1..$y
    #
    return $mat{$len1}{$len2};
}


# minimal element of a list
#
sub min
{
    my @list = @{$_[0]};
    my $min = $list[0];

    foreach my $i (@list)
    {
        $min = $i if ($i < $min);
    }

    return $min;
}

