• Publicidad

Problema con expresiones regulares

¿Apenas comienzas con Perl? En este foro podrás encontrar y hacer preguntas básicas de Perl con respuestas aptas a tu nivel.

Problema con expresiones regulares

Notapor xagutxu_perez » 2008-06-01 12:14 @551

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:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
open(SS,"/xagutxu/corp_anb_klaseak.txt");
my $anb_klaseak;
while(my $rang=<SS>)
{
        $anb_klaseak = $anb_klaseak.$rang;     
}
close(SS);
Coloreado en 0.003 segundos, usando GeSHi 1.0.8.4


Y el string resultante, $anb_klaseak, es:

Código: Seleccionar todo
<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: Seleccionar todo
(LOT JNT EMEN)
(LOT MEN KAUS AM)


o puede ser, también:

Código: Seleccionar todo
(IZE ARR BIZ-)
(IZE ARR BIZ- ABS MG)


Pero cuando pongo la condición:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
if ($anb_klaseak =~ m/$bloque/)
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


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
xagutxu_perez
Perlero nuevo
Perlero nuevo
 
Mensajes: 43
Registrado: 2008-04-04 03:56 @206

Publicidad

Notapor explorer » 2008-06-01 12:35 @566

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:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
#!/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";
}
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4


También puedes definir $bloque como una auténtica expresión regular:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
$bloque = qr(\Q$bloque\E);
print "$bloque\n";

if ( $anb_klaseak =~ $bloque ) {
    print "¡Bai!\n";
}
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

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():
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
if ( index( $anb_klaseak, $bloque ) ) {
    print "¡Bai!\n";
}
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

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

Notapor xagutxu_perez » 2008-06-02 08:13 @384

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:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
$bloque = qr(\Q$bloque\E);
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


Y luego imprimo $bloque:

Código: Seleccionar todo
(?-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:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
$bloque =~ s/^(\S)//;
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


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
xagutxu_perez
Perlero nuevo
Perlero nuevo
 
Mensajes: 43
Registrado: 2008-04-04 03:56 @206

Notapor explorer » 2008-06-02 11:23 @516

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
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
if ( $anb_klaseak =~ /\Q$bloque\E/ )
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


se podía escribir con qr():

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
$bloque = qr(\Q$bloque\E);
if ( $anb_klif ( $anb_klaseak =~ $bloque ) {
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4

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:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
#!/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";
}
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4

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:\....
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

no sé...

Notapor xagutxu_perez » 2008-06-02 15:43 @696

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:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
open(SS,"/xagutxu/corp_anb_klaseak.txt");
my $anb_klaseak;
while(my $rang=<SS>)
{
        $anb_klaseak = $anb_klaseak.$rang;    
}
close(SS);
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


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

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
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);
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


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

Código: Seleccionar todo
/<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:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
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);
}
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4


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"...
xagutxu_perez
Perlero nuevo
Perlero nuevo
 
Mensajes: 43
Registrado: 2008-04-04 03:56 @206

Notapor explorer » 2008-06-02 19:24 @850

Analicemos la situación. Supongamos que test.txt es esto:
Código: Seleccionar todo
/<Baina>/<HAS_MAI>/
(LOT JNT AURK)
(ADI SIN ADOIN)
/<du>/<HAS_MIN>/
(ADI SIN ADOIN)
(ADJ ARR)


Entonces, con tu código,
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
#!/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);
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4

la salida es:
Código: Seleccionar todo
$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:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
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";
}
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4
la salida es:
Código: Seleccionar todo
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. :-)

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:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
#!/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);
 
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
que es casi lo mismo que tienes tu, salvo reducida la escritura del operador concatenación.

De la segunda parte:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
# 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);
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4
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:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
# 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";
}
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4
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: Seleccionar todo
<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: Seleccionar todo
/<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: Seleccionar todo
$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:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
#!/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";
}
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4

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:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
#!/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";
}
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4
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
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
#!/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";
}
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4
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:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
my @bloques = $tests =~ m{^/.*?\n(.*?)(?=^/|\z)}sigmo;
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
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.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España

Notapor xagutxu_perez » 2008-06-03 07:25 @351

Gracias, Explorer, ¡eres un fiera!

Ahora va todo bien...
xagutxu_perez
Perlero nuevo
Perlero nuevo
 
Mensajes: 43
Registrado: 2008-04-04 03:56 @206


Volver a Básico

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 2 invitados