

=pod
 eventive.pl
 Script que acepta una lista de nombres y detecta los nombres eventivos

    Copyright (C) 2017  Rogelio Nazar

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.


=cut

use strict;
$|++;

my $file = $ARGV[0]; # el programa acepta como entrada un fichero de texto
# que contiene una palabra (sustantivo) por línea.

if (!$file || ! -e $file) {
	print "\nNo se encuentra archivo input. Uso: \n perl eventive.pl input.txt";
	die ;
}

my $store = "/media/disk2/kindStore/contexts/";
=pod
# esta es la carpeta en donde se encuentran los contextos de aparición
# de cada una de esas palabras. Un fichero es un conjunto de 
# Estos contextos han sido generados con el programa Kwico
# http://www.tecling.com/kwico

# Los contextos fueron generados utilizando el corpus EsTenTen
# pero no hay razón para pensar que no vaya a obtenerse un 
# resultado similar utilizando otros corpus. 

# Hay que fijarse bien en el formato que tienen. 
# Por ejemplo: 

1       maneja/VLfin/manejar la/ART/el población/NC/población (/LP/( tanto/ADV/tanto la/ART/el joven/NC/joven que/CQUE/que está/VEfin/estar de/PREP/de  ###      fiesta/NC/fiesta       ###     en/PREP/en dichos/QU/dicho espacios/NC/espacio ,/CM/, como/CSUBX/como la/ART/el adulta/ADJ/adulto -sus/NC/<unknown> padres/NC/padre ,/CM/,
2       que/CQUE/que las/ART/el personas/NC/persona compartan/VLfin/compartir no/NEG/no sólo/ADV/sólo las/PPC/él drogas/VLfin/drogar y/CC/y la/ART/el   ###      fiesta/NC/fiesta       ###     ,/CM/, sino/CCAD/sino también/ADV/también la/ART/el cultura/NC/cultura  En/PREP/en primer/ORD/nu|primero lugar/NC/lugar ,/CM/,
3       sería/VSfin/ser no/NEG/no montar/VLinf/montar ninguno/QU/ninguno de/PREP/de mis/PPO/mi numeritos/NC/<unknown> durante/PREP/durante todas/QU/todo las/ART/el     ###      fiestas/NC/fiesta      ###      Mi/PPO/mi|mío familia/NC/familia estaría/VEfin/estar orgullosa/ADJ/orgulloso de/PREP/de mí/PPX/yo y/CC/y ,/CM/, la/ART/el
4       Tartas/NC/tarta blancas/ADJ/blanco de/PREP/de cumpleaños/NC/cumpleaños ,/CM/, compartidas/VLadj/compartir con/PREP/con mis/PPO/mi primos/NC/primo en/PREP/en    ###      fiestas/NC/fiesta      ###     familiares/ADJ/familiar ;/SEMICOLON/; roscones/NC/<unknown> de/PREP/de Reyes/NP/Rey con/PREP/con diminutas/ADJ/diminuto sorpresas/NC/sorpresa de/PREP/de porcelana/NC/porcelana
5       de/PREP/de la/ART/el obsesión/NC/obsesión  "/QT/" Aunque/CSUBX/aunque ya/ADV/ya no/NEG/no acude/VLfin/acudir a/PREP/a   ###      fiestas/NC/fiesta      ###     por/PREP/por aquello/DM/aquel de/PREP/de que/CQUE/que ya/ADV/ya no/NEG/no puede/VMfin/poder permanecer/VLinf/permanecer mucho/QU/mucho rato/NC/rato


Por tanto, cada línea va precedida de un número que la identifica, y luego el contexto de aparición aparece etiquetado
(EsTenTen trae etiquetado de TreeTagger).

Da igual qué etiquetado trae. Este programa solo utiliza el lema. 
Lo único que importa es cumplir con las expectativas de formato que tiene el script. 

=cut


open(FILE, "<", $file) or print "No puedo abrir el fichero ".$file and die;
my @file = <FILE>;
close FILE;

my %atributos = (
	# se podría probar con más o mejores atributos.
 "Días de la semana" => '(lunes|martes|miércoles|jueves|viernes|sábado|domingo)',
 "Meses" => '(enero|febrero|marzo|abril|mayo|junio|julio|agosto|septiembre|octubre|noviembre|diciembre)',
 "Verbos aspectuales" => ' (ocurrir|comenz|inici|efectu|celebr|hubo|hubieron|habrán?)', 
 "Otros" => ' (durante|duración|constante|menudo|frecuente|rápido|lento|antes|después)', 
 "Medidas temporales" => ' (semana|día|mes|año|hora|minuto)'
);

my $umbralinferior = 18; #un umbral totalmente arbitrario
# por debajo de un 18% de elementos predictores, dirá que no es eventivo

my $ctos = scalar (@file);
my $thead = "\n
<html>
<head>
<META HTTP-EQUIV='Content-Type' CONTENT='text/html; charset=utf-8'>
<title>tecling.com/neven</title>
<head>
<body>
<br>$ctos sustantivos en total.
<br/>
Ordenamos los sustantivos de acuerdo con su probabilidad de ser eventivos. 
Marcamos en rojo aquellos que no son considerados eventivos.
<br/>
<table border=1>
<tr><td>Input</td><td>Contextos</td><td>Total Hits</td><td>Porcentaje</td>";

foreach my $att (sort keys %atributos) {
	$thead .= "<td>$att</td><td>%</td>";
}

$thead .= "<td colspan=7>Ejemplos</td></tr>";
my %filas;

foreach my $filename (@file) {
	chomp $filename;
	chomp $filename;
	$filename =~ s/[\t,; ]+$//g;
	$filename =~ s/^[\t,; ]+//g;
	# chop $filename; 
	next if (!$filename);
	# print " $filename; ";
	my $open = $store.$filename;
	my $fila;
	if ( ! -e $open) {
		$fila = "<tr><td>$filename</td><td colspan=20>No se encontraron los contextos de este sustantivo. </td></tr>";
		$filas{$fila} = -1;
		next;
	}
	# Si no encuentra los contextos dará este mensaje de error.

	#    	if (! -e $open || ! -s $open ) {
	# 		print "\n<br/>The input term <i>$filename</i> could not be found in the corpus.";
	# 		next;
	# 	}

	my %check;
	my %hits; 
	my $total;
	my $totalhits;
	open(my $fh, '<', $open );
	while ( my $line = <$fh> ) {
		$line = lc $line;
		$total++;
		foreach my $att (sort keys %atributos) {
			my $reg = $atributos{$att};
		        if ( $line =~/$reg/){
				$hits{$att}++;
				$check{$1}++;
				$totalhits++;
			} 
		}
	} 
	close $fh;
	my $kill; # si en el caso de algún parámetro el porcentaje es menor a 2, lo eliminamos
		# (todos los verbos eventivos deberían tener valores mayores a 2)
	my $glopercent = sprintf("%.2f", (100*$totalhits/$total));
	my $color = "fff";
	$color = "f00" if $glopercent < $umbralinferior; 
	$fila = "\n<tr><td>$filename</td><td>$total</td><td>$totalhits</td><td bgcolor='#$color'>$glopercent</td>";
	foreach my $att (sort keys %atributos) {
		$color = "fff";
		my $percent = sprintf("%.2f", (100*$hits{$att}/$total));
		if ($percent < 2 && $att ne "Días de la semana") { # esto no es ideal!
			$color = "f00"; 
			$kill++
		}
		$fila .=  "<td > $hits{$att}</td><td bgcolor='#$color'>$percent</td>";
		
	}
	if ($kill) {
		$glopercent = 0;
	}
	my $c;
	foreach my $i ( sort { $check{$b} <=> $check{$a} } keys %check ) {
		$fila .=  "<td>$i $check{$i}</td>";
		last if ($c > 5);
		$c++;
	}
	$fila .=  "</tr>";
	$filas{$fila} = $glopercent;
}

# una vez que terminamos de calcular, imprimimos todas las filas de la tabla
# ordenadas por el puntaje que han obtenido

print $thead;
foreach my $fila ( sort { $filas{$b} <=> $filas{$a} } keys %filas ) {
	print "\n$fila";
}
print "\n</table>
<br/>Ok!";

