Problema con expresiones regulares

Foros de discusión -> Básico

Dom Jun 01, 2008 11:14 am

xagutxu_perez
Perlero Nuevo

Registrado: 04 Abr 2008
Mensajes: 43

Problema con expresiones regulares

Hola a todos:

Hay algo que falla en la siguiente expresión regular que estoy utilizando, pero no sé qué. A ver si me podéis echar una manita...

Tengo un string $anb_klaseak, que he hecho leyendo un fichero con:

Perl:

open(SS,"/xagutxu/corp_anb_klaseak.txt");
my $anb_klaseak;
while(my $rang=<SS>)
{
$anb_klaseak = $anb_klaseak.$rang;
}
close(SS);

Y el string resultante, $anb_klaseak, es:

Código:

<1><ANB_TAL_002><9856>
(LOT JNT EMEN)
(LOT MEN KAUS AM)
<2><ANB_TAL_002><5508>
(IZE ARR BIZ-)
(IZE ARR BIZ- ABS MG)
<3><ANB_TAL_002><3434>
(IZE ARR)
(IZE ARR ABS MG)

Ahora, quiero ver si en este string aparecen bloques leídos de otro fichero. Un bloque es, por ejemplo, de la forma:

Código:

(LOT JNT EMEN)
(LOT MEN KAUS AM)

o puede ser, también:

Código:

(IZE ARR BIZ-)
(IZE ARR BIZ- ABS MG)

Pero cuando pongo la condición:

Perl:

if ($anb_klaseak =~ m/$bloque/)

no me reconoce como que $anb_klaseak contenga $bloque, y no sé por qué. ¿Puede ser porque $bloque contiene paréntesis y Perl piensa que es parte de la expresión regular?

Gracias,

Xagutxu

Dom Jun 01, 2008 11:35 am

explorer
Moderador

Registrado: 24 Jul 2005
Mensajes: 4222
Ubicación: Valladolid, España

Efectivamente, hay que 'escapar' los caracteres que pueden influir en la búsqueda del patrón, confundiéndoles con una expresión regular.

Puedes usar esto:

Perl:

#!/usr/bin/perl
use warnings;
use strict;

my $anb_klaseak = <<'EOF';
<1><ANB_TAL_002><9856>
(LOT JNT EMEN)
(LOT MEN KAUS AM)
<2><ANB_TAL_002><5508>
(IZE ARR BIZ-)
(IZE ARR BIZ- ABS MG)
<3><ANB_TAL_002><3434>
(IZE ARR)
(IZE ARR ABS MG)
EOF

print "$anb_klaseak\n";;

my $bloque = <<'EOF';
(LOT JNT EMEN)
(LOT MEN KAUS AM)
EOF

print "$bloque\n";

if ( $anb_klaseak =~ /\Q$bloque\E/ ) {
print "¡Bai!\n";
}

También puedes definir $bloque como una auténtica expresión regular:

Perl:

$bloque = qr(\Q$bloque\E);
print "$bloque\n";

if ( $anb_klaseak =~ $bloque ) {
print "¡Bai!\n";
}

Pero... realmente... ¿estamos buscando un patrón? No. Estamos buscando un string dentro de otro. Para eso es para lo que sirve la función index():

Perl:

if ( index( $anb_klaseak, $bloque ) ) {
print "¡Bai!\n";
}

Lun Jun 02, 2008 7:13 am

xagutxu_perez
Perlero Nuevo

Registrado: 04 Abr 2008
Mensajes: 43

Habrá algo más que no está bien...

Hola, Explorer, he estado haciendo pruebas, y no consigo el resultado esperado...

Probando con index(), para ver si reconoce que una cadena está dentro de la otra, ni siquiera así me da una respuesta correcta. Sale siempre -1.

De todas formas, sale algo curioso, que quizás pueda ser la razón del fallo. Cuando hago:

Perl:

$bloque = qr(\Q$bloque\E);

Y luego imprimo $bloque:

Código:

(?-xism:\
$LOT\ JNT\ AURK$\
)(ADI\ SIN\ ADOIN\)\

No sé de dónde sale ese (?-xism:\. Intento quitar el primer carácter, por si hubiera algo que no se ve, con:

Perl:

$bloque =~ s/^(\S)//;

Pero no me sirve de nada. Y otra pregunta: ¿Por qué, cuando imprimo $bloque = qr(\Q$bloque\E) me sale en diferentes filas, y por qué me sale en el principio de la última fila un ')' en vez de un '\'? ¿Es lógico?

Gracias otra vez,

Xagutxu

Lun Jun 02, 2008 10:23 am

explorer
Moderador

Registrado: 24 Jul 2005
Mensajes: 4222
Ubicación: Valladolid, España

No has entendido mi explicación. Siento haber sido tan espeso y complejo. Intentaré explicarme mejor.

La primera solución, usando expresiones regulares, es la mostrada arriba. El truco estaba en agregar '\Q' y '\E' a la expresión regular. De esa manera se 'escapaban' todos los caracteres extraños o especiales a una expresión regular.

La segunda solución incidía en que en vez de escribir

Perl:

if ( $anb_klaseak =~ /\Q$bloque\E/ )

se podía escribir con qr():

Perl:

$bloque = qr(\Q$bloque\E);
if ( $anb_klif ( $anb_klaseak =~ $bloque ) {

pero el efecto es el mismo: se escapan los caracteres, se crea $bloque como una expresión regular, y luego, en el 'if', se escribe de una forma más cómoda. Si, en este momento, pintas el contenido de $bloque, entonces es lo que ves con (?-xism:.... Ha sido convertido en una expresión regular, y esos caracteres forman el comienzo de esa expresión regular. Pero eso no nos importa. Lo que importa es que nos ha escapado los caracteres y que se ha convertido en una exp. reg.

La tercera solución, parte de la PRIMERA (no de la segunda), y a mí sí que me funciona. Te la pongo para que veas cómo es:

Perl:

#!/usr/bin/perl
use warnings;
use strict;

my $anb_klaseak = <<'EOF';
<1><ANB_TAL_002><9856>
(LOT JNT EMEN)
(LOT MEN KAUS AM)
<2><ANB_TAL_002><5508>
(IZE ARR BIZ-)
(IZE ARR BIZ- ABS MG)
<3><ANB_TAL_002><3434>
(IZE ARR)
(IZE ARR ABS MG)
EOF
print "$anb_klaseak\n";;

my $bloque = <<'EOF';
(LOT JNT EMEN)
(LOT MEN KAUS AM)
EOF
print "$bloque\n";

if ( index($anb_klaseak, $bloque) > -1 ) {
print "Bai!\n";
}

index() devuelve un valor superior a -1 si encuentra la cadena $bloque dentro de $anb_klaseak. Ese valor es la posición donde lo encuentra. Si no lo encuentra, devuelve '-1'.

Sobre la última pregunta que haces, el paréntesis de cierre se refiere al primer paréntesis de (?-xism:\....

Lun Jun 02, 2008 2:43 pm

xagutxu_perez
Perlero Nuevo

Registrado: 04 Abr 2008
Mensajes: 43

no sé...

Hola, Explorer:

La verdad es que creo que he entendido bien tu explicación, pero quizás el error se encuentra en otra parte, o estoy perdido del todo... Quizás en el EOF, que creo que yo no puedo hacerlo tal y como tú lo expones. Repasando rápidamente:

Leo $anb_klaseak de un fichero:

Perl:

open(SS,"/xagutxu/corp_anb_klaseak.txt");
my $anb_klaseak;
while(my $rang=<SS>)
{
$anb_klaseak = $anb_klaseak.$rang;
}
close(SS);

Y leo lo que va a ser $bloque de otro fichero (voy haciendo un array de elementos que comienzan con la secuencia "/<"):

Perl:

open(AE,"/xagutxu/test.txt");
while(my $reng=<AE>)
{
if ($reng !~ m/^\/\</)
{
$auxiliar = $auxiliar.$reng;
}
else
{
push (@auxi, $auxiliar);
$auxiliar = "";
$auxiliar = $auxiliar.$reng;
}
}
close (AE);

Así, tengo que @auxi es un array de elementos de la forma:

Código:

/<Baina>/<HAS_MAI>/
(LOT JNT AURK)
(ADI SIN ADOIN) #fin de bloque
/<du>/<HAS_MIN>/
(ADI SIN ADOIN)
(ADJ ARR) #fin de bloque
...

Con un foreach, quito la primera línea de cada elemento del array, y obtengo $bloque, que es lo que quiero comparar, en cada iteración, con $anb_klaseak:

Perl:

foreach my $elemento (@auxi)
{
my @fila_array = split (/\n/, $elemento);
foreach my $fila (@fila_array)
{
if ($kontador != 0)
{
$bloque = $bloque."\n".$fila;
}
$kontador++;
}
my $result = index ($anb_klaseak, $bloque);
}

Y $result siempre es -1, aunque, en principio, aparezca en $anb_klaseak...

Estoy haciendo algo mal, ¿no? Aparte de que el programa es un poco "sucio"...

Lun Jun 02, 2008 6:24 pm

explorer
Moderador

Registrado: 24 Jul 2005
Mensajes: 4222
Ubicación: Valladolid, España

Analicemos la situación. Supongamos que test.txt es esto:

Código:

/<Baina>/<HAS_MAI>/
(LOT JNT AURK)
(ADI SIN ADOIN)
/<du>/<HAS_MIN>/
(ADI SIN ADOIN)
(ADJ ARR)

Entonces, con tu código,

Perl:

#!/usr/bin/perl
use warnings;
use strict;

my @auxi;
my $auxiliar;

open AE, "<test.txt" or die;
while( my $reng = <AE> ) {

if ($reng !~ m/^\/\</) {
$auxiliar = $auxiliar.$reng;
}
else {
push (@auxi, $auxiliar);
$auxiliar = "";
$auxiliar = $auxiliar.$reng;
}
}
close AE;

use Data::Dumper;
print Dumper(\@auxi);

la salida es:

Código:

$VAR1 = [
undef,
'/<Baina>/<HAS_MAI>/
(LOT JNT AURK)
(ADI SIN ADOIN)
'
];

Es decir:
* Falta un registro (el último)
* Sobra un registro (el primero, fantasma, el undef).

Aquí tenemos un problema.

Veamos la segunda parte, la creación de $bloque:

Perl:

my $kontador;
my $bloque;
foreach my $elemento ( @auxi ) {

my @fila_array = split (/\n/, $elemento);
foreach my $fila ( @fila_array ) {

if ( $kontador != 0 ) {
$bloque = $bloque."\n".$fila;
}
$kontador++;
}
print Dumper($bloque);
#my $result = index ($anb_klaseak, $bloque);
#print $result . "\n";
}

la salida es:

Código:

Use of uninitialized value in split at ./kk.pl line 29.
$VAR1 = undef;
Use of uninitialized value in numeric ne (!=) at ./kk.pl line 32.
Use of uninitialized value in concatenation (.) or string at ./kk.pl line 33.
$VAR1 = '
(LOT JNT AURK)
(ADI SIN ADOIN)';

Así que, aparte de las salidas de error, lo importante es el contenido de $bloque, que vemos que tiene un retorno de carro en demasía, al principio.

Así que aquí tenemos otro problema.

En cuanto a que el código sea más o menos sucio, eso depende de quien lo vaya a mantener. Smile

Aquí te voy a dar una serie de soluciones al problema planteado, que, naturalmente, no son únicas, y además, son aplicables a muchos otros casos similares. Están adaptadas para el foro en que estamos (Básico).

Por el principio:

Perl:

#!/usr/bin/perl
use warnings;
use strict;

# Lectura del principal
my $anb_klaseak;

open(SS,"<corp_anb_klaseak.txt") or die;
while( my $rang = <SS> ) {
$anb_klaseak .= $rang;
}
close(SS);

que es casi lo mismo que tienes tu, salvo reducida la escritura del operador concatenación.

De la segunda parte:

Perl:

# Lectura de los test
my @auxi;
my $auxiliar;

open(AE, "<test.txt") or die;
while( my $reng = <AE> ) {
if ( $reng =~ m/^\/\</ and $auxiliar ) {
push(@auxi, $auxiliar);
$auxiliar = $reng;
}
else {
$auxiliar .= $reng;
}
}
push(@auxi, $auxiliar) if $auxiliar;

close AE;

use Data::Dumper;
print Dumper(\@auxi);

que también es casi lo mismo que el tuyo, con los siguientes cambios:
* Cambiado !~ por =~ (es más fácil de leer)
* Hacer el último push() después del bucle, por si queda algún test por añadir al @auxi.

Y la tercera parte:

Perl:

# Búsqueda de los test dentro del principal
foreach my $elemento ( @auxi ) {

my @fila_array = split (/\n/, $elemento);
my $bloque;
my $kontador = 0;

foreach my $fila ( @fila_array ) {

if ( $kontador > 0 ) {
if ( $bloque ) {
$bloque = $bloque . "\n" . $fila;
}
else {
$bloque = $fila;
}
}
$kontador++;
}
print Dumper($bloque);
my $result = index ($anb_klaseak, $bloque);
print "=> $result <= \n";
}

que, igual que antes, sigue siendo lo mismo que lo tuyo, pero con los cambios:
* añadida una comprobación más, para saber si $bloque está vacío o no. Esto lo hacemos para evitar el caso de poner un retorno de carro solitario, al principio
* agregamos una salida Dumper, para ver realmente lo que tenemos. Recuerda: Data::Dumper es tu amigo.

Entonces, dado el texto principal

Código:

<1><ANB_TAL_002><9856>
(LOT JNT AURK)
(ADI SIN ADOIN)
<2><ANB_TAL_002><5508>
(IZE ARR BIZ-)
(IZE ARR BIZ- ABS MG)
<3><ANB_TAL_002><3434>
(IZE ARR)
(IZE ARR ABS MG)

y dado el fichero de test

Código:

/<Baina>/<HAS_MAI>/
(LOT JNT AURK)
(ADI SIN ADOIN)
/<du>/<HAS_MIN>/
(ADI SIN ADOIN)
(ADJ ARR)

entonces la salida del programa es

Código:

$VAR1 = [
'/<Baina>/<HAS_MAI>/
(LOT JNT AURK)
(ADI SIN ADOIN)
',
'/<du>/<HAS_MIN>/
(ADI SIN ADOIN)
(ADJ ARR)
'
];

$VAR1 = '(LOT JNT AURK)
(ADI SIN ADOIN)';
=> 23 <=
$VAR1 = '(ADI SIN ADOIN)
(ADJ ARR)';
=> -1 <=

Observa como los elementos de @auxi se separan bien. Y que index() encuentra el primer test (23), pero no el segundo (-1), lo cual es correcto, según el ejemplo que hemos escogido.

Otra forma de hacer el programa podría ser esta:

Perl:

#!/usr/bin/perl
use Data::Dumper;
use warnings;
use strict;

my $anb_klaseak;
{
local $/ = undef; # Modo 'slurp'

# Lectura del principal
open(SS,"<corp_anb_klaseak.txt") or die;
$anb_klaseak = <SS>;
close(SS);
print $anb_klaseak, "\n";
}

# Lectura de los test
my @auxi;
my $auxiliar;
open(AE, "<test.txt") or die;
while ( my $linea = <AE> ) {
if ( $linea =~ m{/<} ) { # Si estamos a principio de bloque
if ( $auxiliar ) { # Si tenemos un bloque anterior
push @auxi, $auxiliar; # lo guardamos
$auxiliar = "";
} # Si no tenemos un bloque anterior, no hacemos nada
} else { # Si es una línea de un bloque, vamos guardando
$auxiliar .= $linea;
}
}
close AE;
push @auxi, $auxiliar if $auxiliar; # Guardamos último bloque, si lo hubiera
print Dumper(\@auxi);

# Búsqueda de los test dentro del principal
foreach my $bloque ( @auxi ) {
my $result = index($anb_klaseak, $bloque);
print "=> $result <= \n";
}

Las diferencias son:
* usamos el modo 'slurp' para leernos todo el fichero principal, de golpe
* la lectura de los test la modificamos un poco, para quitarles la primera línea
* con lo que la búsqueda se convierte en algo trivial.

Otra forma:

Perl:

#!/usr/bin/perl
use warnings;
use strict;

local $/;
my $anb_klaseak = do{ open(SS,"<corp_anb_klaseak.txt") or die; <SS>; };
my $tests = do{ open(AE,"<test.txt") or die; <AE>; };

my @auxi = split( /^\/<.*?$/simo, $tests );

foreach my $bloque ( @auxi ) {
$bloque =~ s/^\s*//;
next if !$bloque;
print '=> '. index($anb_klaseak, $bloque) . " <= \n";
}

leyendo los ficheros completos, a memoria, y luego dividiendo los tests por las cabeceras. Como esto genera valores vacíos en algunas ocasiones, las quitamos con la expresión regular del último bucle.

Aún puede quedar un poco más reducido, con

Perl:

#!/usr/bin/perl
use File::Slurp;
use warnings;
use strict;

my $anb_klaseak = read_file('corp_anb_klaseak.txt');
my $tests = read_file('test.txt' );

my @bloques = $tests =~ m{^/.*?\n([^/]+)}sigmo;

foreach my $bloque ( @bloques ) {
print '=> '. index($anb_klaseak, $bloque) . " <= \n";
}

Usando un módulo para leer ficheros, queda más corto. Y una expresión regular nos divide los bloques, quitándonos las cabeceras. Pero esto solo funciona si sabemos que los test no contienen el carácter '/'.

Para más seguridad, se puede usar entonces la siguiente expresión regular:

Perl:

my @bloques = $tests =~ m{^/.*?\n(.*?)(?=^/|\z)}sigmo;

que quiere decir:
"Saca todos los @bloques desde $tests, que estén compuestos por un número de caracteres mínimo ((.*?)) entre una línea que comienza por '/' (^/.*?\n) y una línea con un '/' al principio (^/) o (|) fin de string (\z)". El '?=' indica que esta última comprobación no forma parte del actual patrón encontrado, por lo que nos servirá para encontrar el patrón siguiente.

Mar Jun 03, 2008 6:25 am

xagutxu_perez
Perlero Nuevo

Registrado: 04 Abr 2008
Mensajes: 43



Gracias, Explorer, ¡eres un fiera! Ahora va todo bien...

	Foros de discusión -> Básico	Todas las horas son GMT - 6 Horas
Página 1 de 1