=pod
=encoding UTF-8
pullpos.pl
script para corregir errores de lematización por plural en los POS-taggers
http://www.tecling.com/pullpos
Copyright (C) 2020 - 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 .
Script para la detección de plurales
Ver artículo:
Nazar, Rogelio; Galdames, Amparo (2019). Formalización de reglas para la detección del plural en castellano en el caso de unidades no diccionarizadas. Linguamática, vol. 11, núm 2, pp. 17-32.
https://linguamatica.com/index.php/linguamatica/article/view/285/457
La ejecución de este script se da en dos etapas. A la primera lo llamamos "training",
pero consiste simplemente en la adquisición de parejas de nombres singular/plural.
En este caso se necesita un listado de formas extraido de un corpus (listado.txt),
una forma por línea. Un tabulador se interpreta como final de línea.
Generar este listado a partir de un corpus es tarea sencilla
pero eventualmente proporcionaremos en esta página un script para esto también.
La segunda etapa es la del post-proceso de un corpus ya etiquetado.
Una vez que se tiene un modelo. En la página web de este proyecto
presentamos un modelo que viene por defecto.
En cuanto a los etiquetadores, de momento solo hemos probado
con TreeTagger y UDPipe y esos son los que sabe leer.
Para leer otros etiquetadores, será necesario hacer ajustes.
Cuando se producen discrepancias con el etiquetado, el script
deja un asterisco.
Este es, por ejemplo, el etiquetado de UDPipe
(el formato CONLL):
# # newpar
# # sent_id = 1
# # text = EDITORIAL ¿ Son eficaces los antidepresivos ?
# 1 EDITORIAL editorialmente ADV ADV _ 4 advmod _ _
# 2 ¿ ¿ PUNCT PUNCT PunctSide=Ini|PunctType=Qest 4 punct _ _
# 3 Son ser AUX AUX Mood=Ind|Number=Plur|Person=3|Tense=Pres|VerbForm=Fin 4 cop _ _
# 4 eficaces eficaz ADJ ADJ Number=Plur 0 root _ _
# 5 los el DET DET Definite=Def|Gender=Masc|Number=Plur|PronType=Art 6 det _ _
# 6 antidepresivos antidepresivo ADJ ADJ Gender=Masc|Number=Plur 4 nsubj _ _
Y este el de TreeTagger:
#EDITORIAL ADJ editorial
# ¿ FS ?
# Son VSfin ser
# eficaces ADJ eficaz
# los ART el
# antidepresivos NC antidepresivo
# ? FS ?
Aquí hay disponible una interfaz web que procesa texto libre
con distintos etiquetadores:
http://www.tecling.com/porcus
Modo de uso:
perl pullpos.pl input [mode] [conll] [random]
input: /ruta/del/fichero/a/analizar
mode: 0 para test, 1 para train (por defecto: 0)
conll: si es 0 se asume que el formato no es CONLL (por defecto: 1)
random: si es 1, los resultados saldrán en orden aleatorio (por defecto: 0)
Para la versión 2020, contamos con la colaboración de Nicolás Acosta.
=cut
use strict;
# Estos son los parámetros de ejecución:
# Si la ejecución es "train"
my $train = $ARGV[1]; # si es 0, se ejecuta el testing mode
# my $formas = "frecEsTenTenF5_utf8-linux.txt"; # listado de formas
my $formas = "cleanFormas2018.csv"; # listado de formas
my $umbral = 7; # umbral de frecuencia mínima del lema
# Si, en cambio, es "test"
my $modelo = "train20oct2018-19hs.csv"; # este es el modelo de ejecución (resultado del train)
my $input = $ARGV[0]; # el archivo input
my $conll = $ARGV[2]; # si el archivo está en formato CONLL
my $random = $ARGV[3]; # si queremos el listado en orden aleatorio.
if (!$input){
die "¡No se especificó un archivo para analizar!
Modo de uso:
perl pullpos.pl input
input: /ruta/del/fichero/a/analizar
mode: 0 para test, 1 para train (por defecto: 0)
conll: si es 0 se asume que el formato no es CONLL (por defecto: 1)
random: si es 1, los resultados saldrán en orden aleatorio (por defecto: 0)
";
}
# Variables por defecto
$train = 0 if (!$train | $train !~ /[0-1]/);
$conll = 1 if (!$conll | $conll !~ /[0-1]/);
$random = 0 if (!$random | $conll !~ /[0-1]/);
# Las siguientes son informaciones lingüísticas varias
# (remitimos al artículo para mayor detalle).
my $rex = 'r?[eai]rl[oa]s?|[éá]ndo[nl][eoa]s|entamos|eramos|eremos|erimos|aremos|onamos|[nmcb][eia]mos|[eai]rnos|[ií]amos|rsel[ao]s|[aei]rles|[aei]mos';
my $prefijos = 'anti|auto|extra|hetero|hiper|hipo|inter|macro|meta|micro|mono|neuro|poli|post|pre|p?seudo|psico|radio|sub|super|trans';
my $nonplurals = '(us|[oipeas][lrxtfsd]is|[íó][dtf][aei][dnl]es)';
my $englishmorph = 'ys[ei]s|nces|tr?ics|ions|[nl]ess|ties|tions|en[td]s|[ae]cts|sters|oids|ishes|ous|ers|[csr]ies|ants|[aoe]ss';
my %cache;
my %fail; # un registro los casos fallidos
my $ch = 'A-zÁÉÍÓÚáéíóúÑñÜüçÇïÖö'; # un caracter
my $voc = 'AÁaáeEÉeéIÍiíOÓoóUÚuú'; # una vocal
my @stoplist = (
'más',
'país',
'nos',
'Es',
'tres',
'después',
'menos',
'Además',
'además',
'través',
'mientras',
'viernes',
'mes',
'lunes',
'tenemos',
'Carlos',
'jueves',
'martes',
'miércoles',
'Luis',
'seis',
'pues',
'crisis',
'hemos',
'Más',
'Tras',
'ambos',
'gracias',
'podemos',
'Mientras',
'interés',
'Después',
'atrás',
'demás',
'Dios',
'somos',
'queremos',
'Nicolás',
'Jesús',
'Nos',
'análisis',
'Tenemos',
'Cambiemos',
'tus',
'Dos',
'mas',
'Morales',
'debemos',
'Andrés',
'gas',
'lejos',
'hs',
'sabemos',
'detrás',
'Antes',
'Vamos',
'Hemos',
'Tres',
'Marcos',
'puedes',
'hacemos',
'Gracias',
'ganas',
'jamás',
'vemos',
'tienes',
'Queremos',
'Somos',
'París',
'quizás',
'Lucas',
'Reyes',
'estás',
'Matías',
'encontramos',
'Caracas',
'Londres',
'Malvinas',
'tuvimos',
'hicimos',
'vas',
'Vargas',
'podamos',
'País',
'virus',
'Pues',
'dosis',
'vos',
'Tamaulipas',
'estrés',
'venimos',
'has',
'Tomás',
'Sabemos',
'gratis',
'Lunes',
'Andes',
'Viernes',
);
my $stoplist = join '|', @stoplist;
my %transfer = (
'áceos' => 'áceo',
'aces' => 'az',
'ades' => 'ad',
'adas' => 'ada',
'an[ae]s' => 'án',
'unes' => 'ún',
'antes' => 'ante',
'ares' => 'ar',
'arias' => 'aria',
'bles' => 'ble',
'cias' => 'cia',
'dos' => 'do',
'eanos' => 'eano',
'eces' => 'ez',
'ejos' => 'ejo',
'entes' => 'ente',
'eones'=> 'eón',
'eos' => 'eo',
'geas' => 'gea',
'ian[ao]s' => 'iano',
'ias' => 'ia',
'ices' => 'iz',
'íces' => 'íz',
'ic[oa]s' => 'ico',
'idades' => 'idad',
'id[oa]s' => 'ido',
'inas' => 'ina',
'ines' => 'ín',
'iones' => 'ión',
'ísim[ao]s' => 'ísimo',
'ismos' => 'ismo',
'istas' => 'ista',
'itos' => 'ito',
'ivas' => 'iva',
'iv[oa]s' => 'ivo',
'les' => 'l',
'manos' => 'mano',
'mientos' => 'miento',
'ógi[ao]s' => 'ógico',
'oides' => 'oide',
'ólog[ao]s' => 'ólogo',
'omas' => 'oma',
'ones' => 'ón',
'or[ea]s' => 'or',
'os[ao]s' => 'oso',
'rías' => 'ría',
'rios' => 'rio',
'ríos' => 'río',
'sías' => 'sía',
'stas' => 'sta',
'stros' => 'stro',
'tías' => 'tía',
'udes' => 'ud',
'uras' => 'ura',
'úmenes' => 'umen'
);
my @rules = (
'(['.$ch.']+)s',
'(['.$ch.']+)es',
'(['.$ch.']+['.$voc.'](i|y))e?s',
'(['.$ch.']+[A-z'.$voc.'](i|y))e?s',
'(['.$ch.']+(s|x))es',
'(['.$ch.']+[lrndzj])es',
'(['.$ch.']+[bcfghkmñpqtvwy])e?s',
'(['.$ch.']+che?)s?',
'(['.$ch.']+(?!ch)[bcdfghjklmnñpqrtvwxyz]{2})s'
);
my %forlem; # Primera lista de asociación forma-lema creada durante el entrenamiento
my %sing; # Frecuencia del singular (no son lemas en realidad, porque es el singular sin discriminar por género)
my %plural; # Frecuencia del plural
my %ground; # Almacena las razones que lo llevan a tomar una decisión
################################################################
# TRAIN
if ($train) {
print "\nTraining mode...";
open( my $fh, '<', $formas );
while ( my $line = <$fh> ) {
chomp $line;
$line =~ s/[\/\\_\-]+//g;
$line = lc $line;
my ($form, $frec) = split /\t/, $line;
next if ($form =~ /($rex)$/);
if ($form =~ /s$/) {
# Una primera distinción se hace en función
# de la s final, pero luego vendrán más controles
$plural{$form} += $frec;
} else {
$sing{$form} += $frec;
}
}
close $fh;
my $c;
foreach my $form (sort keys %plural) {
$c++;
warn "\n$c\t$form" if ($c =~ /0000$/);
my $lem = &rules($form);
if ($lem) {
$forlem{$form."\t".$lem} = $ground{$form};
} else {
$fail{$form}++;
}
}
if (0) {
undef $c;
foreach my $k (sort {$forlem{$b} <=> $forlem{$a} } keys %forlem) {
next if (!$forlem{$k});
$c++;
my ($form, $lem) = split /\t/, $k;
print "\n$c\t$k\t$plural{$form}\t$sing{$lem}\t$forlem{$k}";
}
exit; # comentar esta línea para acceder a los elementos rechazados
}
undef $c;
print "\nElementos rechazados:";
foreach my $f (sort keys %fail) {
$c++;
print "\n$f";
}
exit;
} # end if train
################################################################
# TEST
# Esta es la del post-proceso de un corpus etiquetado
print "\nTesting mode...";
my %pos; # Etiqueta gramatical puesta por el tagger (para comprobar que sea correcta)
my %result; # Elementos reconocidos
my %oov; # Elementos no reconocidos, para dejar un aviso
my %other; # Este es un hash de dos dimensiones y agrupa todos los elementos que no
# son reconocidos como plurales
# english; # Formas en inglés
# verbos; # Formas verbales
# noplural # Elementos no plurales
open( my $fh, '<', $modelo ) or die "\nNo puedo abrir el modelo!!! [$modelo]";
while ( my $line = <$fh> ) {
chomp $line;
my @f = split /\t/, $line;
next if (!$f[2] || !$f[3]);
$forlem{$f[2]} = $f[3];
$sing{$f[3]} = $f[5]; #se guarda la frecuencia del singular
$plural{$f[2]} = $f[4];# se guarda la frecuencia del plural
}
close $fh;
my %lemtag; # Lema que asigna el tagger, para compararlo con el del script
my %incorpus; # Registro del vocabulario encontrado en el mismo corpus analizado
open( $fh, '<', $input ) or die "\nNo encuentro archivo [$input]";
while ( my $line = <$fh> ) {
next if ($line =~ /# text/);
chomp $line;
$line = lc $line;
next if (!$line);
my @f = split /\t/, $line;
# si es el formato conll, descartamos la primera
if ($conll) {
shift @f;
}
$f[0] =~ s/[0-9'\(\)\*,=<>\^\{\]\[\}\.%\$\+\"]+//g;
next if (length($f[0]) < 4);
if ($conll) {
$lemtag{$f[0]} = $f[1];
$pos{$f[0]} = $f[2];
} else {
if ($f[2] eq "") {
$lemtag{$f[0]} = $f[0];
} else {
$lemtag{$f[0]} = $f[2];
}
$pos{$f[0]} = $f[1];
}
# Si las palabras están juntas por / hay que separarlas y repetir el proceso por cada una.
my @slash = split /[\/\\\-]+/, $f[0];
foreach my $form (@slash) {
my $lem;
$incorpus{$form}++;
if ($form =~ /s$/) {
next if ($cache{$form});
next if ($form =~ /$stoplist/); # omitimos las palabras no plurales en @stoplist
$cache{$form}++; # Para que no repita las mismas operaciones
if ($form =~ /($rex)$/) { # Elimina formas verbales
$ground{$form} .= "[$1] ";
$other{verbos}{$form}++;
next;
}
if ($form =~ /($englishmorph)$/) {
$ground{$form} .= "[$1] ";
$other{english}{$form}++;
next;
}
# Descarta casos de no plurales
if ($form =~ /$nonplurals$/) {
$other{noplural}{$form}++;
$ground{$form} .= "[$1] ";
next;
}
$lem = &rules($form);
# Comprueba que el lema propuesto está documentado en corpus
if ($lem) {
# print "\n\n\nRules says $form -> $lem \n\n ($ground{$form})";
&sanciona($form,$lem);
next;
} elsif ($forlem{$form}) {
# print "\nEstá en el listado de parejas forma-lema ($ground{$form}).";
$lem = &lematiza($form);
if ($lem) {
&sanciona($form,$lem);
next;
}
} elsif ($form =~ s/^($prefijos)//) {
my $pre = $1;
# print "\nNo está pero reconozco un prefijo: $pre";
$lem = &lematiza($form);
if ($lem) {
&sanciona($pre.$form,$pre.$lem);
next;
}
}
if (!$forlem{$form}) {
undef $ground{$form};
$lem = &rules($form, 1);
if ($lem) {
$result{$form}++;
$forlem{$form} = $lem;
$oov{$form} = "UNKNOWN";
} else {
# print "\nNo es plural: $form ";
$other{noplural}{$form}++;
}
}
} else {
# print "\nNo termina en s: lo cargo al hash sing";
$sing{$form}++;
}
}
}
close $fh;
my $total;
print "\nForma\tLema\tError\tGround\tFrecuencia\tPOSTag\tLemTag\tDiferencia\tEval\tOOV";
my @r = keys %result;
unless ($random) {
@r = sort @r;
}
foreach my $i (@r) {
my $diferencia;
$diferencia = "*" if ($lemtag{$i} ne $forlem{$i});
print "\n$i\t[$forlem{$i}]\t\t$ground{$i}\t$incorpus{$i}\t$pos{$i}\t$lemtag{$i}\t$diferencia\t\t$oov{$i}";
$total += $incorpus{$i};
}
print "\nTotal casos corregidos: $total";
foreach my $firstkey ( sort keys %other ) {
print "\n\n$firstkey:\n";
my @r = keys %{$other{$firstkey}};
unless ($random) {
@r = sort @r;
}
foreach my $i (@r) {
my $diferencia;
$diferencia = "*" if ($lemtag{$i} ne $i);
print "\n$firstkey\t$i\t$incorpus{$i}\t$ground{$i}\t$diferencia\t$lemtag{$i}";
}
}
sub lematiza {
my $forma = $_[0];
return if ( $ground{$forma} =~ /Sust:/);
my $return;
#print "\nEntra $forma";
if ($forlem{$forma}) {
$return = $forlem{$forma};
$ground{$forma} .= "Listado ";
if ($pos{$forma} ne "nc" && $pos{$forma} !~ /\*\*\*/) {
my $fem = $forlem{$forma};
$fem =~ s/o$/a/;
if (!$sing{$fem}) {
$pos{$forma} = "$pos{$forma} -> nc !!!";
# Si tiene plural pero no femenino, es un nombre común
}
}
}
return $return;
}
sub rules {
my $form = $_[0];
return if ( $ground{$form} =~ /(Sust|Rules):/);
my $orig = $form;
my ($lem, $rec);
foreach my $r (sort keys %transfer) {
my $v = $transfer{$r};
if ( $form =~ s/$r$/$v/ ) {
$lem = $form;
# print "\n Sust: ($orig, $lem, $r, $v) ";
$ground{$orig} .= "Sust: [$cache{$orig}]($orig, $lem, $r, $v) ";
return $lem if ($_[1]);
$rec = &decide($orig, $lem, $r);
if ($rec) {
return $lem;
}
}
}
if (!$lem) {
foreach my $r (@rules) {
if ($form =~ /$r$/) {
$lem = $1;
# print "\nRule\t$r\t$lem";
$ground{$orig} .= "Rules: ($orig, $lem, $r) ";
$rec = &decide($orig, $lem, $r);
if ($rec) {
return $lem;
}
}
}
}
}
sub decide {
my ($form, $lem, $rule) = @_;
# Si está en el vocabulario encontrado en el mismo corpus
# (Esto solo es útil en modo "test")
if ($incorpus{$lem}) {
return $lem;
}
return if ($form eq $lem || !$lem || !$sing{$lem});
my $rate = sprintf("%.7f", $plural{$form}/$sing{$lem});
if (
$rate > 0.00001
# Controlamos que no exista una disparidad muy grande
# entre la frecuencia del lema y de la forma.
&& $rate < 240
) {
if ($ARGV[0] eq "train") {
$ground{$form} = $rate;
} else {
$ground{$form} .= "Decide ($lem: $rate) ";
}
return $lem;
}
}
sub femdetect {
# Detecta formas en femenino.
# Nos llega un supuesto lema y si termina en 'a', controlamos
# que no sea un adjetivo
my ($form, $lem) = @_;
my $origlem = $lem;
if ($lem =~ /a$/ ) {
#print "\n\n\n##########\nForma femenina detecteda: $forma / $forlem{$forma}";
my $fem = $lem;
$fem =~ s/a$//;
my $trigger;
my $o = $fem."o";
if ($lem =~ /ada$/ && $sing{$o}) {
# Si la forma termina en 'ada' es probable que sea 'ado'
# (con excepciones: "empanada")
$trigger = "0. Lema con ada pasa a o ($sing{$o}) ";
$lem = $o;
} elsif ((2* $sing{$o}) > $sing{$lem} || $sing{$o} > 300) {
$trigger = "1. Lema con o [$o:$sing{$o}] > lema con a $sing{$lem} ";
$lem = $o;
} elsif ($sing{$fem} > $sing{$lem}) {
#print "\nLema con o [$forma]: $sing{$forma}\n##########\n\n\n";
$trigger = "2. Lema sin o [$o:$sing{$o}] > lema con a $sing{$lem} ";
$lem = $fem."o";
} else {
$trigger = "3. Lema con a [$lem:$sing{$lem}] > $o ($sing{$o}) y ($fem) $sing{$fem} ";
}
if ($trigger) {
#print "\nLema de $forma: [$forma] \n##########\n\n\n";
if ($pos{$form} ne "adj" && $pos{$form} !~ /!!!/) {
#print "\nCorrige etiqueta: $pos{$forma} -> adj";
$pos{$form} = "$pos{$form} -> adj !!!";
}
$ground{$form} .= " $trigger ";
}
}
if ($lem ne $origlem) {
$ground{$form} .= "Forma femenina. ";
}
return $lem;
}
sub sanciona {
my ($form, $lem) = @_;
$lem = &femdetect($form, $lem);
$result{$form}++;
$forlem{$form} = $lem;
}