#!/usr/bin/perl

# Programa que calcula a comparação com a dourada
# Última alteração: DMS, 3 de Junho de 2003

use locale;
use POSIX qw(locale_h);
setlocale(LC_CTYPE, "pt_PT") or die;
require '/home/morfolimpiadas/programas/biblioteca_mol.pl';

open LOG, ">>log" or die "Não consegui abrir LOG!\n";
print LOG "comp_dour.pl @ARGV\n";

if ($ARGV[0] eq "-a") { # sobre todos as formas da lista dourada
    shift;
    $comp_absoluta=1;
}
if ($ARGV[0] eq "-v") { # retirando a outra variante
    shift;
    $var=$ARGV[0]; shift;
}
if ($ARGV[0] eq "-r") { # retirando análises raras
    shift;
    $raros=1;
}
if ($ARGV[0] eq "-n") { # retirando INTERJ
    shift;
    $nao_interj=1;
}
if ($ARGV[0] eq "-j") { # escolhendo as análises com lema adjectivo para ADV
    shift;
    $adv_adj=1;
}
if ($ARGV[0] eq "-l") { # retirando análises de PP diferente de M S
    shift;
    $nao_pp=1;
}
if ($ARGV[0] eq "-p") { # retirando género e número de nomes próprios
    shift;
    $nao_prop=1;
}
if ($ARGV[0] eq "-q") { # retirando análises de ADJ quando PP
    shift;
    $nao_adj=1;
}
# Abre a dourada
#open DOURADA, "/home/morfolimpiadas/construcao_dourada/ListaDourada.prv7" or die "Não consegui abrir /home/morfolimpiadas/construcao_dourada/ListaDourada.prv7!\n";
open DOURADA, "exp_dourada" or die "Não consegui abrir exp_dourada!\n";

@dourada=split /\xd7\n/, join "", <DOURADA>;
shift(@dourada);
#pop(@dourada);
close DOURADA;
#print "Primeiro elemento da dourada: $dourada[0]\n";
#print "Segundo elemento da dourada: $dourada[1]\n";
#print "Último elemento da dourada: $dourada[$#dourada]\n";



$tam_dourada=$#dourada+1;

print "tamanho dourada antes dos filtros: $tam_dourada\n";

foreach (@dourada) {
    if ($nao_adj and /\xf7PP\xf7/) {
#	print "Forma: $_\n";
	@analises=grep !/\xf7ADJ\xf7/, split/\n/, join"", $_;
    }
    else {

	@analises= split/\n/, join"", $_;
    }
    @analises=grep /\xf7/, @analises;

    $total="";
# Filtra a dourada...
#   @analises= grep !/(\xf7| )nderiv/, @analises;
    if ($adv_adj) {
	@an_ad= grep /mente\xf7ADV.*deriv/, @analises;
    }
    @analises= grep !/(\xf7| )deriv /, @analises;
    if ($adv_adj) {
	@analises=(@analises,@an_ad);
	@an_ad=();
    }

    @analises= grep !/PP\xf7P/, @analises if ($nao_pp);
    @analises= grep !/PP\xf7S\xf7.\xf7F/, @analises if ($nao_pp);
    @analises= grep !/INTERJ/, @analises if ($nao_interj);
    @analises= grep !/(\xf7| )raro/, @analises if ($raros);
    if ($var eq "bras") {
	@analises= grep !/\xf7lus/, @analises;
	@analises= grep !/lus\s*$/, @analises;
    } elsif ($var eq "lus") {
	@analises= grep !/\xf7bras/, @analises;
	@analises= grep !/bras\s*$/, @analises;
    }

    foreach $a (@analises) {
#	print "Análise: $a\n";
#	if (($a) and ($a!~/\xd7/)) {
	if ($a) {
	    $analise_sem_outros=join "\xf7", (split /\xf7/, $a)[0..8];
	    $total.="$analise_sem_outros\xf7.\xf7".(split /\xf7/, $a)[9]."\n";
#	    print "Total: $total";

	}
    }
    push (@nova, "$total\xd7\n") if ($total);
}


@dourada=@nova;
$tam_dourada=$#dourada+1;
print "tamanho dourada depois dos filtros: $tam_dourada\n";


# Abre o ficheiro  e filtra-o com base na lista dourada

while ($fx=$ARGV[0]) {
    $i++; $nome="tokens$i"; $nome_sist="sistema$i"; $alt{$nome}=$ARGV[0];
    if ($fx!~/\./) {
	$fx=&Max((grep /$ARGV[0]\.def/, &DirConteudo(".")));
    }
    print "Ficheiro $fx...\n";
    open F1, $fx or die "Não consegui abrir o ficheiro $fx!";
    @$nome=split /\xd7\n/, join "", grep ! /TEXTO/, <F1>;
    close F1;
    pop @$nome;

    @dourada_antiga=@dourada;
    @$nome=&FiltraLista($tam_dourada,@dourada,@$nome);
# Aqui vão todas as formas, mesmo repetidas...
    @$nome=&UniqLista(@$nome);

    print $#$nome+1," formas em $nome depois de uniq\n";

# Aqui crio um hash com as formas:

    foreach (@$nome) {
	($p)=($_=~/^(.+?)\xf7/);
	$$nome{$p}=1;
    }
    print "$nome: ".(scalar keys %$nome)." formas diferentes\n";
    shift;
    push (@lista_sist, $nome);
}

# Aqui temos @$nome com as formas e %$nome com as formas

if (not $comp_absoluta) {

# Depois de ter ido buscar as formas, 
# recria o hash da dourada

    foreach (@dourada) {
	($p)=($_=~/^(.+?)\xf7/);
	$nova_dourada{$p}=1;
    }
    print "Nova dourada: ".(scalar keys %nova_dourada)." formas diferentes\n";
    @nova_dourada=@dourada;


} else {

    foreach (@dourada_antiga) {
	($p)=($_=~/^(.+?)\xf7/);
	$nova_dourada{$p}=1;
    }
    @nova_dourada=@dourada_antiga;
}

@lista_sist=("nova_dourada",@lista_sist);
print "Lista: @lista_sist\n";

# Enche os hashes relativos à dourada e ao sistema

foreach $nome_sist (@lista_sist) {

    @outros=(); @guarda=(); @ang=();
    foreach (@$nome_sist) { #filtra as com PP
	if  ($nao_adj and /\xf7PP\xf7/) {
#	    push (@guarda, $_);
	    @ang=grep !/\xf7ADJ\xf7/, split/\n/, join"", $_;
#	    print "Os mudados:", join "\n", @ang;
	    push (@outros, join "\n", @ang);
	}
	else {
	    push (@outros, $_);
	}

    }

    @analises= grep !/\xd7/, split/\n/, join"", @outros;




    print "Numero de análises em $nome_sist $#analises \n";

    @analises= grep !/(\xf7| )raro/, @analises if ($raros);
#    @analises= grep !/(\xf7| )nderiv/, @analises;

    if ($adv_adj) {
	@an_ad= grep /mente\xf7ADV.*deriv/, @analises;
#	print "@an_ad\n";
    }
    @analises= grep !/(\xf7| )deriv /, @analises;
    if ($adv_adj) {
	@analises=(@analises,@an_ad);
	@an_ad=();
    }

    @analises= grep !/PP\xf7P/, @analises if ($nao_pp);
    @analises= grep !/PP\xf7S\xf7.\xf7F/, @analises if ($nao_pp);

    @analises= grep !/INTERJ/, @analises if ($nao_interj);
    if ($var eq "bras") {
	@analises= grep !/\xf7lus/, @analises;
	@analises= grep !/lus\s*$/, @analises;
    } elsif ($var eq "lus") {
	@analises= grep !/\xf7bras/, @analises;
	@analises= grep !/bras\s*$/, @analises;
    }
#    print "$nome_sist $#analises\n";

    $analises_sist="$nome_sist"."_an";
    push (@lista_an, $analises_sist);

    foreach $a (@analises) {
	if ( ((split /\xf7/, $a)[1] eq "PROP") and ($nao_prop)) {
	    @bocados=(split /\xf7/, $a);
	    @bocados[3..9]=(".",".",".",".",".",".",".");
	    $a=join "\xf7", @bocados;
#	    $a=join "\xf7", (split /\xf7/, $a)[0,1], ".",".",".",".",".",".",".",".",(split /\xf7/, $a)[10,11,12,13];
	} 
# trata dos lemas com clíticos...
	$a=~s/V\+CL\xf7(\w+)\+(\w\w+?)\xf7/V+CL\xf7$1+clit\xf7/;

#	print "A $nome_sist: $a\n";
	$analise_sem_outros=join "\xf7", (split /\xf7/, $a)[0,1,3..9]; # todos menos lema e outros
#	$analise_sem_outros=join "\xf7", (split /\xf7/, $a)[0,1]; # formaxpos
# 	$analise_sem_outros=join "\xf7", (split /\xf7/, $a)[0,2]; # formaxlema
# 	$analise_sem_outros=join "\xf7", (split /\xf7/, $a)[0..2]; # formaxposxlema
#	$analise_sem_outros=join "\xf7", (split /\xf7/, $a)[0..9];

# trata dos lemas com "/";
        $analise_sem_outros=~s#\xf7(\w+)\/\w+(\xf7|$)#\xf7$1$2#;


	$$analises_sist{$analise_sem_outros}=1;
    }

}


foreach $an_sist (@lista_an) {
    print "$an_sist ".(scalar keys %$an_sist)." análises diferentes \n";
#    print LOG "$an_sist ".(scalar keys %$an_sist)." análises diferentes \n";
}


foreach $sist (@lista_an) {

    foreach $aso (keys %$sist) {
	$sistemas{$aso}.=" $sist" if ($$sist{$aso});
    }
}

print "Nos ".(scalar @lista_sist)." sistemas há ". scalar (keys %sistemas)." análises diferentes\n";

$i++; 
foreach $aso (keys %sistemas) {

    $num=split / +/, $sistemas{$aso};
    $num--;			# num é o número de sistemas em que a forma aparece
#    print "$aso: $num sistemas\n";
    $todos{$aso}++ if $num eq $i;
    if ($num eq 3) {$tres{$aso}++}
    elsif ($num eq 2) {$dois{$aso}++}
    elsif ($num eq 1) {$unicas{$aso}++}
    elsif ($num eq 4) {$quatro{$aso}++}
    elsif ($num eq 5) {$cinco{$aso}++}
    elsif ($num eq 6) {$seis{$aso}++}

}

print "Análises comuns". scalar (keys %todos)."\n";
$comuns= scalar (keys %todos);
$dourada= scalar (keys %nova_dourada_an);
$tokens= scalar (keys %tokens1_an);
print "$dourada $tokens $comuns\n";
print LOG "$dourada $tokens $comuns ";

$precisao= $comuns/$tokens;
$cobertura=$comuns/$dourada;
print "Precisao: $precisao; cobertura: $cobertura\n";
$prec=sprintf "%3.2f", $precisao*100;
$cob=sprintf "%3.2f", $cobertura*100;
print "Precisao: $prec; cobertura: $cob\n";
print LOG "$prec $cob\n\n";
close LOG;

open DEBUG, ">debug_unicas.txt" or die "Não consegui abrir o debug.txt!\n";

foreach $fo (sort keys %unicas) {
    ($id)=($sistemas{$fo}=~s/^ //); 
    print DEBUG "$fo $sistemas{$fo} \n";
}
close DEBUG;

open DEBUG, ">debug_comuns.txt" or die "Não consegui abrir o debug.txt!\n";

foreach $fo (sort keys %todos) {
    ($id)=($sistemas{$fo}=~s/^ //); 
    print DEBUG "$fo $sistemas{$fo} $alt{$id} \n";
}
close DEBUG;

sub UniqLista {
    local $p;
    local @nlista=();
    foreach (@_) {
	($p)=($_=~/^(.+?)\xf7/);
	if ($ja{$p}) {	
	    next;
	} else {
	    push @nlista, $_;
	    $ja{$p}=1;
	}
    }
    return @nlista;
}