#!/usr/bin/perl

#####
# .passage2fynd.pl fichier_a_traiter > fichier_sorti
#		script transformant le fichier passage en format pour l'extraction des chemins entre  2 EN
#####
use strict;

my $cmp=0;
my $cmpEN=0;
my $maxEN=0;
my $phr=0;
my $dansR="";
my $dansN=0;
my $dansT=0;
my $GPid=0;
my %lGP;
my %GPcat;
my $gmet=0;
my $sentence;
my $tmpR;
my @tmp;
my @tokens;
my @mots;
my @NE;
my @NEY; ## Tokens commençant par une lettre maj
my $phrase= "";
my $wid=0;

while(<>)
{
	chomp;
	if($dansT>0){				
		if(/<\/T/){ $dansT=0; }
		elsif(/\s+(\")$/){
			$gmet=1;
			$phrase.="\\g ";
			$tokens[$dansT-1]="$1";
		}
		elsif(/\s+(l\'[A-Z].+)$/){
			$phrase.=$1 . " ";
			$tokens[$dansT-1]="$1";
			push(@NEY, $dansT);
		}
		elsif(!/\s+M.*\.$/ && (($dansT-$gmet)>1 && /\s+([A-Z].+)$/)){
			$phrase.=$1 . " ";
			$tokens[$dansT-1]="$1";
			push(@NEY, $dansT);
		}
		elsif(/\s+(.+)$/){
			$phrase.=$1 . " ";
			$tokens[$dansT-1]="$1";
		}
		next;
	}
	if($dansR ne ""){		
		if(/ref="[^"]+F([^"]+)"/){ $tmpR.="\t$1"; }
		
		if(/<\/R/){
			if($dansR ne "JUXT" && $dansR ne "APPOS" && $dansR ne "COORD" && $tmpR=~/\t(\d+)\t(\d+)/){
				my $id1=$1;
				my $id2=$2;
				if(exists($lGP{$id1}) && (! exists($lGP{$id2}) || $lGP{$id1}!=$lGP{$id2})){
					my $prep=$GPcat{($lGP{$id1})};
					$tmpR=~ s/($dansR)\t/$1\_$prep\t/;
				}
			}
			$tmpR .="\n";
			push(@tmp, $tmpR); $dansR=""; 
		}
		next;
	}
	if(/(<Sentence id=\")([^"]+\".+)>/){		
		#$cmp+=$1;
		#if($1>=2){$cmp2+=$1; $phr2++;}
		#print STDERR "$1\n";
		$phr++;
		$sentence="$1$2";
		
	}
	if(/^\s+(<\/Sentence)/){
		#if(@NEY > 0){ &verifieNEY; } ## traitement des séquences commençant par une maj
		if($dansN > 1 && $wid < 200){
			#print STDERR "$wid\n";
			print $sentence . " NE=\"" . $dansN . "\" >" . $phrase . "</Sentence>\n";
			print @NE;
			print @tmp;
			print "$1$'\n";
			$cmp++;
			$cmpEN+=$dansN;
			if($dansN>$maxEN){ $maxEN=$dansN; }
		}
		$dansN = 0;
		@NE=(); @NEY=();
		@tmp =(); $phrase=""; @tokens=(); @mots=(); $gmet=0; %lGP=(); %GPcat=();
	}
	if(/<T id="[^"]+T(\d+)"/){		
		$dansT=$1;
	}

	## Stockage de "prep" de GP
	if($GPid > 0 && /<W id="[^"]+F(\d+)"/){
		$wid=$1;		
		$lGP{$1}=$GPid;
		if(/ pos="prep" lemma="([^"]+)"/){
			$GPcat{$GPid}=$1;
		}
		elsif(! exists($GPcat{$GPid}) && / pos="prel" lemma="([^"]+)"/){
			$GPcat{$GPid}=$1;
		}
	}
	## _PERSON = adj ==> Entité nommée
	if(/<W id="[^"]+F(\d+)" pos="(adj)" lemma="([^"]+)" form="(_PERSON[^"]+)" tokens="([^"]+)"/){
		$wid=$1;		
		my $token = $5;
		my $chW="W\t$wid\t";
		$chW .= &insereTokens($token);
		$chW .= "\t"; 
		$chW .= &insereTokens($token); 
		$chW .= "\t$4\n";		
		push(@tmp, $chW);
		push(@mots, "$token");
		my $chNE = "NEY\t$wid\tindividual\t";
		print STDERR "NEY\t$wid\tindividual\n";
		$chNE .= &insereTokens($token); 
		$chNE .= "\n";		
		push(@NE, $chNE);
		$dansN++;
	}
	## _COMPANY ===> Entité nommée (organization ?)
	elsif(/<W id="[^"]+F(\d+)" pos="([^"]*)" lemma="([^"]+)" form="(_COMPANY)" tokens="([^"]+)"/){		
		$wid=$1;		
		my $token = $5;
		my $chW="W\t$1\t";
		$chW .= &insereTokens($token); 
		$chW .= "\t"; 
		$chW .= &insereTokens($token); 
		$chW .= "\t$4\n";		
		push(@tmp, $chW);
		push(@mots, "$token");
		my $chNE = "NEY\t$1\tcompany\t";
		print STDERR "NEY\t$1\tcompany\n";
		$chNE .= &insereTokens($token); 
		$chNE .= "\n";		
		push(@NE, $chNE);
		$dansN++;
	}
	## _ETR ===> Entité nommée (organization ?)
	#elsif(/<W id="[^"]+F(\d+)" pos="([^"]*)" lemma="([^"]+)" form="(_ETR)" tokens="([^"]+)"/){		#
	#	my $token = $5;
	#	my $chW="W\t$1\t";
	#	$chW .= &insereTokens($token); 
	#	$chW .= "\t"; 
	#	$chW .= &insereTokens($token); 
	#	$chW .= "\t$4\n";		
	#	push(@tmp, $chW);
	#	push(@mots, "$token");
	#	my $chNE = "NEY\t$1\torganization\t";
	#	$chNE .= &insereTokens($token); 
	#	$chNE .= "\n";		
	#	unless($chNE =~ /\&amp\;\#\d+\;/ || length($chNE) > 50){
	#		print STDERR "$chNE"; push(@NE, $chNE);
	#		$dansN++;
	#	}
	#}
	
	## Entité nommée reconnue => insertion de la forme effective
	elsif(/<W id="[^"]+F(\d+)" pos="([^"]*)" lemma="([^"]+)" form="(_ORGANIZATION)" tokens="([^"]+)"/||
	/<W id="[^"]+F(\d+)" pos="([^"]*)" lemma="([^"]+)" form="(_DATE[^"]*)" tokens="([^"]+)"/||
	/<W id="[^"]+F(\d+)" pos="([^"]*)" lemma="([^"]+)" form="(_PERSON[^"]*)" tokens="([^"]+)"/||
	/<W id="[^"]+F(\d+)" pos="([^"]*)" lemma="([^"]+)" form="(_LOCATION[^"]*)" tokens="([^"]+)"/||
	/<W id="[^"]+F(\d+)" pos="([^"]*)" lemma="([^"]+)" form="(_NUMBER[^"]*)" tokens="([^"]+)"/
	){		
		$wid=$1;		
		my $token = $5;
		my $chW="W\t$1\t";
		$chW .= &insereTokens($token); 
		$chW .= "\t"; 
		$chW .= &insereTokens($token); 
		$chW .= "\t$4\n";		
		push(@tmp, $chW);
		push(@mots, "$token");
	}
	## Nom commun
	elsif(/<W id="[^"]+F(\d+)" pos="([^"]*)" lemma="([^"]+)" form="([^"]+)" tokens="([^"]+)"/){		
		push(@tmp, "W\t$1\t$4\t$3\t$2\n");
		push(@mots, "$4");
		$wid=$1;		
	}
	## Nom commun avec '
	elsif(/<W id="[^"]+F(\d+)" pos="[^"]*" lemma='([^']+)' form='([^']+)' tokens="([^"]+)"/){		
		push(@tmp, "W\t$1\t$3\t$2\n");
		push(@mots, "$4");
		$wid=$1;		
	}
	elsif(/<W id="[^"]+F(\d+)" pos="[^"]*" lemma='([^']+)' form="([^"]+)" tokens="([^"]+)"/){		
		push(@tmp, "W\t$1\t$3\t$2\n");
		push(@mots, "$4");
		$wid=$1;		
	}
	if(/<G id="[^"]+G(\d+)" type="GP"/){		
		$GPid=$1;
	}
	if(/<\/G/){		
		$GPid=-1;
	}
	if(/<R type="([^"]+)" id="[^"]+"/){		
		$tmpR="R\t$1";
		$dansR=$1;
	}
	# élément <NE>
	# traitement des types : "individu" "organisation" "location"
	if(/<NE id="[^"]+" lst="[^"]+F(\d+)" type="(individual)"/ || /<NE id="[^"]+" lst="[^"]+F(\d+)" type="(organization)"/ || /<NE id="[^"]+" lst="[^"]+F(\d+)" type="(location)"/){
		my $chNE = "NE\t$1\t$2\t";
		#print STDERR "word=$1";
		my $i = $1-1;
		my $token = $mots[$i];
		my $afp=0;
		#print STDERR "tokens=$token";
		$chNE .= &insereTokens($token); 
		unless($chNE=~/\bAFP\b/){
			$chNE .= "\n";		
			push(@NE, $chNE);
			$dansN++;
		}
	}
}
print "<!-- Nb de phrases contenant plus d'un entité nommé : $cmp / $phr (". $cmp/$phr . ") -->\n";
print STDERR "\n\nNb de phrases contenant plus d'un entité nommé : $cmp / $phr (". $cmp/$phr . ")\n";
print "<!-- Nb moyen d'entités par phrase : $cmpEN / $phr (moyenne = ". $cmpEN/$phr . "/phrase) -->\n";
print STDERR "Nb moyen d'entités par phrase : $cmpEN / $cmp (moyenne = ". $cmpEN/$cmp . "/phrase)\n";
print STDERR "Nb max d'entités : $maxEN\n";

print STDERR "\n\nTerminé !\n\n";

sub insereTokens{
	#print STDERR "$_[0]\n";
	my $token=$_[0];
	my $ch="";
	while(1){
			if($token =~ /[^T]+T(\d+)/){
				my $i=$1-1;
				$token = $';
				if($ch ne ""){ $ch .= " "; }
				#print STDERR "$tokens[$i]\n";
				$ch .= "$tokens[$i]";
			}else{ last;}
	}
	
	return $ch;
} 

sub verifieNEY{
	my $tokenID;
	my $motID=-1;
	#print STDERR "$sentence\n@NEY" . "\n";
	
	foreach(@NEY){
		$tokenID=$_;
		my $i=1;
		foreach(@mots){
			if(/[^T]+T($tokenID)\b/){
				$motID = $i;
				#last; ### pour récupérer l'indice le + grand ex. [(l'_w1)(Université_w2)_t1]
			}
			$i++;
		}
		if($motID>=0){
			foreach(@NE){
				if(/\t($motID)\t/){
					$motID = -1;
					#print STDERR "NE déjà traité\n";
					last;
				}
			}
			if($motID>=0){
				#print STDERR "NE non traité ($motID)\n";
				my $chNE = "NEY\t$motID\tinconnu\t$tokens[$tokenID-1]\n";
				push(@NE, $chNE);
				$dansN++;
			}
		}
		else{ print STDERR "mot ID non trouvé\n"; }
	}
} 






