#!/usr/bin/perl -s

use strict;
use warnings;

use Data::Dumper;
use NAT::Client;

our ($id);
die("I Need a *LOCAL* Corpus\n") unless $id;

## Load the markers files
my $marksPT = load_marks("Markers.PT");
my $marksEN = load_marks("Markers.EN");

## Load the Probabilistic Translation Dictionry
my $server = NAT::Client->new(Local => $id);

my ($P,$E);

$/ = "\n\$\n";
open A, $ARGV[0];
open B, $ARGV[1];

while(defined($P = <A>)) {
  $E = <B>;
  next if $E=~m!^\s*$!;
  next if $P=~m!^\s*$!;
  process_pair($P,$E);
}



sub process_pair {
    my ($PT,$EN) = @_;

    my $pt_tree = split_by_marks($marksPT, lc($PT));
    my $en_tree = split_by_marks($marksEN, lc($EN));

    $pt_tree = combine_marks($pt_tree);
    $en_tree = combine_marks($en_tree);

    my ($i,$j,$matrix)=(0,0,[]);

    # Preenche Probabilidades
    for my $cA (@$pt_tree) {
        $j = 0;
        for my $cB (@$en_tree) {
            my $prob = chunk_similarity($server, $cA, $cB);

            $matrix->[$i][$j] = $prob;
            $j++;
        }
        $i++;
    }

    my $trads = {};
    my $sizes = {};
    my ($sizePT,$sizeEN)=($i,$j);

    # Extrai segmentos
    if ($sizePT > $sizeEN) {
		my $last = undef;
        for $i (0..$sizePT-1) {
            my $max = 0;
            for $j (0..$sizeEN-1) {
                if ($matrix->[$i][$j]>$matrix->[$i][$max]) {
                    last if ($max != 0 && $j!=$max+1);
                    $max = $j;
                }
            }
			my $s = stringify($en_tree->[$max]);
			if (exists($trads->{$s}) && (!defined($last) || $last == $max)) {
	            $trads->{ $s } .= stringify($pt_tree->[$i]);
	            $sizes->{ $s } ++;
			}
			if (!exists($trads->{$s})) {
	            $trads->{ $s } = stringify($pt_tree->[$i]);
	            $sizes->{ $s } ++;				
			}
			$last = $max;

        }

        for (keys %$trads) {
          print "$trads->{$_} ==$sizes->{$_}:1== $_\n";
        }

    }
    else {
		my $last = undef;
        for $j (0..$sizeEN-1) {
            my $max = 0;
            for $i (0..$sizePT-1) {
                if ($matrix->[$i][$j]>$matrix->[$max][$j]) {
                    last if ($max != 0 && $i!=$max+1);
                    $max = $i;
                }
            }
			my $s = stringify($pt_tree->[$max]);
			if (exists($trads->{$s}) && (!defined($last) || $last == $max)) {
            	$trads->{ $s } .= stringify($en_tree->[$j]);
            	$sizes->{ $s } ++;
			}
			if (!exists($trads->{$s})) {
            	$trads->{ $s } = stringify($en_tree->[$j]);
            	$sizes->{ $s } ++;
			}
			$last = $max;
        }

        for (keys %$trads) {
          print "$_ ==1:$sizes->{$_}== $trads->{$_}\n";
        }

    }
}

sub stringify {
    my $array = shift;
    my @array = @$array;
    if ($array[0] && $array[1]) {
        return "[[ $array[0] ][ $array[1] ]]";
    }
    elsif ($array[1]) {
        return "[[  ][ $array[1] ]]";
    }
    else {
        return "[[  ][ $array[0] ]]";
    }
}


sub chunk_similarity {
  my ($server, $cA, $cB) = @_;

  my $mP = 0;
  if ($cA->[0] && $cB->[0]) {
    $mP = mark_similarity($server, $cA->[0],$cB->[0]);
  }

  my $bP = 0;
  if ($cA->[1] && $cB->[1]) {
    $bP = body_similarity($server, $cA->[1], $cB->[1]);
  }

  if ($bP) {
    return .10*$mP+.90*$bP;
  }
  else {
    return .90*$mP+.10*$bP;
  }
}

sub body_similarity {
  my ($server, $sA, $sB) = @_;
  my $prob = 0;
  my $size = 0;
  my @wA = split /\s/, $sA;
  my %wA; @wA{@wA}=@wA;

  my @wB = split /\s/, $sB;
  my %wB; @wB{@wB}=@wB;

  if (scalar(@wA)<scalar(@wB)) {
    for my $w (@wA) {
      my $trans = $server->ptd({direction => '~>'}, $w);
      $trans = $trans->[1];
      for my $t (sort {$trans->{$b} <=> $trans->{$a}} keys %$trans) {
        if (exists($wB{$t})) {
          $prob += $trans->{$t};
          last;
        }
      }
    }
    $size = scalar(@wA);
  }
  else {
    for my $w (@wB) {
      my $trans = $server->ptd({direction => '<~'}, $w);
      $trans = $trans->[1];
      for my $t (sort {$trans->{$b} <=> $trans->{$a}} keys %$trans) {
        if (exists($wA{$t})) {
          $prob += $trans->{$t};
          last;
        }
      }
    }
    $size = scalar(@wB);
  }
  return $prob/$size;
}

sub mark_similarity {
  return body_similarity(@_);
}


sub combine_marks {
  my $list = shift;
  my $previous = "";
  my $done = [];
  for my $item (@$list) {
    if ($item->[0] eq '[MARKS]') {
      $previous = join(" ", @$item[1..$#$item]);
    } else {
      push @$done, [$previous,join(" ",@$item)];
      $previous = "";
    }
  }
  push @$done, [$previous]   if ($previous);
  return $done;
}


sub split_by_marks {
  my ($marks, $string) = @_;
  my @string = split /\s+/, $string;

  my $word;
  my $nS = [];
  my @S;
  while ($word = shift @string) {
    my $length = 2 + $#string;

    my $found = 0;
    my $cmark;
    for my $mark (@$marks) {
      my $mlength = scalar(@$mark);
      next if $mlength > $length;

      if ($word eq $mark->[0]) {
        $found = 1;
        for my $i (1..$mlength-1) {
          $found = 0 if $string[$i-1] ne $mark->[$i]
        }
        if ($found) {
          $cmark = $mark;
          last;
        }
      }
    }

    if ($found) {
      my $mlength = scalar(@$cmark) - 1;
      my @x = ($word);
      push @x, shift @string while $mlength--;
      if (@$nS) {
        push @S, $nS;
        $nS = [];
        unshift @x, '[MARKS]';
        push @S, \@x;
      } else {
        unshift @x, '[MARKS]' unless @S;
        # get last and add
        my $lastMark = pop @S;
        push @$lastMark, @x;
        push @S, $lastMark;
      }
    } else {
      push @$nS, $word;
    }
  }
  push @S, $nS if (@$nS);

  return \@S;
}

sub load_marks {
  my $marks_file = shift;
  my $marks;

  open M, $marks_file or die "Can not open file $marks_file: $!";
  while (<M>) {
    chomp;
    next if m.^\#.;
    push @$marks, $_;
  }

  $marks = [sort {length($b) <=> length($a)} @$marks];

  return [map { [split /\s+/] } @$marks]
}
