#!/usr/bin/perl

use strict;
use warnings;

use Data::Dumper;

my $marksPT = load_marks("Markers.PT");

my $line;

my $segmentos;

$/="\n\$\n";

while(defined($line = <>)) {
  chomp($line);
  my $pt_tree = split_by_marks($marksPT, lc($line));
  $pt_tree = combine_marks($pt_tree);

  for (@$pt_tree) {
    if ($_->[0] && $_->[1]) {
      print "$_->[0] | $_->[1]\n";
    }
    elsif ($_->[0]) {
      print "$_->[0] |\n";
    }
    else {
      print "| $_->[1]\n";
    }
  }
  print "\n";
}


sub chunk_similarity {
  my ($server, $cA, $cB) = @_;
  #my $mP = mark_similarity($server, $cA->[0],$cB->[0]);
  #my $bP = 0;
  #if ($cA->[1] && $cB->[1]) {
  #  $bP = body_similarity($server, $cA->[1],$cB->[1]);
  #}
  #return $mP*.5 + $bP*.5;

  if ($cA->[1] && $cB->[1]) {
    #return body_similarity($server,
    #                       "$cA->[0] $cA->[1]",
    #                       "$cB->[0] $cB->[1]");

    return body_similarity($server, $cA->[1], $cB->[1]);

  } else {
    return body_similarity($server, $cA->[0], $cB->[0]);
  }
}

sub body_similarity {
  my ($server, $sA, $sB) = @_;
  my $prob = 0;
  my @wA = split /\s/, $sA;
  my %wA; @wA{@wA}=@wA;
  my @wB = split /\s/, $sB;
  my %wB; @wB{@wB}=@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;
      }
    }
  }

  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;
      }
    }
  }

  #$prob /= (scalar(@wA)+scalar(@wB));

  my $min = $prob;
  my $max = $prob;

  if (scalar(@wA) < scalar(@wB)) {
    $min /= 2*scalar(@wA);
    $max /= 2*scalar(@wB);
  } else {
    $min /= 2*scalar(@wB);
    $max /= 2*scalar(@wA);
  }

  return ($min,$max);
}

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]
}
