• Publicidad

Opcionalidad y contextos en las 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.

Notapor explorer » 2009-02-16 16:00 @708

¿Puedes poner un párrafo de ejemplo de entrada?
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

Publicidad

Notapor ana gonzález ledesma » 2009-02-16 16:50 @743

Código: Seleccionar todo
<TimeStamp>A7DEC642-183B-4602-A141-E09B422AD58E</TimeStamp>[
@Title: el agujero de Patricia
@File: efamcv01
@Participants: PAT, Patricia, (woman, B, 2, hair dresser, participant, Madrid)
       ROS, Rosa, (woman, B, 3, teacher, participant, Madrid)
       GUI, Guillermo, (man, A, 3, linguistic, participant, Madrid)
       CHE, Chechu, (man, A, 3, student, participant, Ferrol)
       MIG, Miguel, (man, B, 2, hair dresser, participant, Madrid)
@Date: 10/03/2001
@Place: Madrid
@Situation: chat between friends at a party, not hidden, researcher participant
@Topic: holidays, friends and gossip
@Source: C-ORAL-ROM
@Class: informal, family/private, conversation
@Length: 9'15"
@Words: 1656
@Acoustic_quality: A
@Transcriber: Guillermo
@Revisor: Inma; Ana, Manuel, Guillermo and Jesús (prosody)
@Comments:
]
 
*ROS: con los [/] con el walkman de / Chechu // # 
*PAT: ya ?
*ROS: bueno / qué habéis hecho este fin de semana ? o sea qué habéis hecho / últimamente ? que no está puesto / joder //
*PAT: sí está puesto // me ha dicho que sí //
*GUI: ¡bah! / no seáis también ... si no pasa nada // o sea te [/] te molesta el aparato ?
*CHE: hhh //
%act: (1) laugh
*PAT: sí //
*GUI: cómo sois / de verdad //
*MIG: te molesta el aparato ?
*PAT: <hhh> //
%act: (1) laugh
*ROS: [<] <hhh> //
%act: (1) laugh
*GUI: pero tú habla igual / si el aparato no ...
*PAT: no muerde ?
*GUI: no //
*MIG: claro que no //
%alt: (1) cao
*GUI: ni el feminismo / <tampoco> //
*MIG: [<] <¡jo!> / tengo un hambre ...
*PAT: no // de todas formas es que yo luego / cuando + pero yo [/] yo hhh +
*ROS: tú no podrías trabajar en el Gran Hermano / ése / tía / porque todo el día estarías pendiente de la <cámara> ...
*PAT: [<] <y es que además> yo cuando me oigo / me parece que tengo una voz de <pito> ...
ana gonzález ledesma
Perlero nuevo
Perlero nuevo
 
Mensajes: 17
Registrado: 2006-11-02 10:25 @475

Notapor zipf » 2009-02-16 17:01 @750

Hola Ana

ana gonzález ledesma escribiste:El mensaje de error que me da Perl cuando paso el programa es el siguiente:
Código: Seleccionar todo
variable length lookbehind not implemented in regex m/?<=DOSBARRAS|UNABARRA, ...

En la línea 93, esto es, justo cuando empieza la primera expresión.


Esto es lo que comentó explorer. En mi primera respuesta hay dos errores. Por un lado, la sintaxis de "positive lookbehind" no se puede utilizar en Perl con expresiones de longitud variable (sí se puede utilizar en .NET).
Pero sí puedes utilizar la secuencia \K (lo explico en otra de mis respuestas) en Perl 5.10. En Perl 5.8 esto requiere usar el módulo Regexp::Keep (hay que incluir la línea "use Regexp::Keep;").
Puedes ver un ejemplo en mi respuesta anterior:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
$string =~ s/\b$context\s+\K($word)\b/<md>$1<\/md>/ig;
Coloreado en 0.002 segundos, usando GeSHi 1.0.8.4


Todo lo que va antes de \K se ignora en la sustitución.

El otro error que hay en mi primer mensaje sobre este tema es que olvidé poner $_ y el operador de sustitución en la cláusula if del último fragmento de código.

ana gonzález ledesma escribiste:Una última cosa, en las últimas expresiones regulares he puesto para optimizar (?<=!\s$othermd|$signos\s) pero no sé si esto se puede hacer o no, y en la documentacion que ayer mi dio zipf no sale.


¿En qué consiste la optimización? Si lo que quieres es usar "negative lookbehind", debes usar ?<! y ?!.
Consulta la sección "Look-Around Assertions" de http://perldoc.perl.org/perlre.html. Aquí también se explica cómo funciona \K.

Saludos
Enrique
zipf
Perlero nuevo
Perlero nuevo
 
Mensajes: 10
Registrado: 2008-11-24 08:07 @380

Notapor explorer » 2009-02-16 17:48 @783

Hay una serie de errores en el código de Ana, como por ejemplo, está haciendo el close MARCADOR, pero MARCADOR nunca lo ha abierto.

Esta es una versión revisada y más limpia. Lamentablemente no puedo probarla porque me faltan ficheros de prueba. Seguro que algo andará mal, pero quiero que lo veas por si alguna parte te puede dar más inspiración.

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
#!/usr/bin/perl
#title: standforddream.pl
#
#use Modern::Perl;

use strict;
use warnings;
use open IN => ":crlf";             # Indicamos que los ficheros de entrada están en formato MSDOS
use locale;

## Leer los marcadores ambiguos
open LISTA, '<listafinalambiguoscategoriales.txt' or die $!;
my @marcadores_ambiguos = <LISTA>;
chomp @marcadores_ambiguos;         # Es posible que sobre
close LISTA;

@marcadores_ambiguos
    = sort {
        length($b) <=> length($a)
                    ||
                $a <=> $b           # ¿Error? Quizás sea 'cmp'
      }
      @marcadores_ambiguos;


## Lista de otros marcadores
open LISTATOTALMDS, '<listatotalyredefinitivamdsencontrados.txt' or die $!;
my @marcadores_otros = <LISTATOTALMDS>;
chomp @marcadores_otros;            # Es posible que sobre
close LISTATOTALMDS;

@marcadores_otros
    = sort {
        length($b) <=> length($a)
                    ||
                $a <=> $b           # ¿Error? Quizás sea 'cmp'
      } (@marcadores_otros);


## Crear expresión regular de los otros marcadores
my $other_md = join '|', reverse sort @marcadores_otros;
$other_md    = qr($other_md);


## Directorios de trabajo
my $directorio_entrada = './coralrom';
my $directorio_salida  = './coralromconambiguosetiquetados';


## Constantes
my $barra      = 'UNABARRA';        # tone unit /
my $dosbarras  = 'DOSBARRAS';       # final de utterance //
my $r1         = 'REFORMULADORUNO'; # reformuladores de uno, dos y tres. [/] [//] [///], porque no sé qué versión voy a utilizar por si acaso
my $r2         = 'REFORMULADORDOS';
my $r3         = 'REFORMULADORTRES';
my $question   = 'INTERROGATION';   # final de utterance interrogación ?
my $suspension = 'TRESPUNTOS';      # final de utterances suspensión ...
#my $overlaps   = '[<]';             # asegurarte de que es así qué vas a hacer con los solapamientos los quitas?
my $ppioturn   = 'DOSPUNTOS';       # ppio de turno : ¿esto es un metacaracter?
my $pause      = 'PAUSE';           # pausa larga ¿es metacaracter?
my $interrup   = 'INTERRUPCION';    # interrupción, + o +/. porque todavía no sé qué versión voy a utilizar.

my $signos     = qr($dosbarras|$barra|$r1|$r2|$r3|$question|$suspension|$ppioturn|$pause|$interrup);


## Listado de ficheros a tratar
my @lista_archivos;
opendir D, $directorio_entrada or die "Error en opendir";
while (my $nombre_archivo = readdir(D)) {
    if ($nombre_archivo =~ /\.txt$/) {        # Solo quiero los que acaben en .txt p.e.
        push @lista_archivos, $nombre_archivo;
    }
}
closedir D;

## Procesamiento de todos los ficheros
for my $archivo (@lista_archivos) {

    my $archivo_entrada = "$directorio_entrada/$archivo";

    ## Leemos el fichero y lo prefiltramos
    my @lineas;

    open F, "<$archivo_entrada" or die "Problemas en archivo de entrada $archivo_entrada: $!\n";

    while (<F>) {

        if (/^\*/) {                    # Solo si empieza por '*'
            s/\?/INTERROGATION/g;
            s/\[\/\]/REFORMULADORUNO/g;
            s/\[\/\/\]/REFORMULADORDOS/g;
            s/\[\/\/\/\]/REFORMULADORTRES/g;
            s/\/\//DOSBARRAS/g;
            s/\//UNABARRA/g;
            s/\.\.\./TRESPUNTOS/g;
            s/\:/DOSPUNTOS/g;
            s/\+/INTERRUPCION/g;
            s/#/PAUSE/g;
            s/\[<\]//g;
            s/<//g;
            s/>//g;
            s/\&/AMPERSAN/g;
            s/ +/ /g;
        }

        push @lineas, $_;

    }

    close F;


    ## Buscamos marcadores en todas las líneas
    for my $linea (@lineas) {
        foreach my $marcador_ambiguo (@marcadores_ambiguos) {

            if ($linea =~ s/(?<=$signos) ($marcador_ambiguo) (?=\s$signos\s)/<MD>$1<\/MD>/ig) {
                #print "--- he encontrado $md en la línea $_\n";
                open  SALIDA_EVALUACION,">>./SALIDA_EVALUACION/SEGURO/$marcador_ambiguo.txt" or die "$marcador_ambiguo no se ha abierto\n";
                print SALIDA_EVALUACION "$archivo_entrada/$linea\n";
                close SALIDA_EVALUACION;
            }

            if ($linea =~ s/(?<=\s$other_md\s) ($marcador_ambiguo) (?=\s$signos\s)/<MD>$1<\/MD>/ig) {
                #print "--- he encontrado $md en la línea $_\n";
                open  SALIDA_EVALUACION,">>./SALIDA_EVALUACION/SEGURO/$marcador_ambiguo.txt" or die "$marcador_ambiguo no se ha abierto\n";
                print SALIDA_EVALUACION "$archivo_entrada/$_\n";
                close SALIDA_EVALUACION;
            }

            if ($linea =~ s/(?<=\s$signos\s) ($marcador_ambiguo) (?=\s$other_md\s)/<MD>$1<\/MD>/ig) {
                #print "--- he encontrado $md en la línea $_\n";
                open  SALIDA_EVALUACION,">>./SALIDA_EVALUACION/SEGURO/$marcador_ambiguo.txt" or die "$marcador_ambiguo no se ha abierto\n";
                print SALIDA_EVALUACION "$archivo_entrada/$_\n";
                close SALIDA_EVALUACION;
            }

            if ($linea =~ s/(?<=\s$other_md\s) ($marcador_ambiguo) (?=\s$other_md\s)/<MD>$1<\/MD>/ig) {
                #print "--- he encontrado $md en la línea $_\n";
                open  SALIDA_EVALUACION,">>./SALIDA_EVALUACION/SEGURO/$marcador_ambiguo.txt" or die "$marcador_ambiguo no se ha abierto\n";
                print SALIDA_EVALUACION "$archivo_entrada/$_\n";
                close SALIDA_EVALUACION;
            }

            if ($linea =~ s/(?<=!\s$other_md\s|\s$signos\s) ($marcador_ambiguo) (?=\s$signos\s|\s$other_md\s)/<MD>$1<\/MD>/ig) { #(?<=!\s$othermd\s|\s$signos\s)ESTO SE PUEDE PONER ASÍ??? PARA AHORRAR?
                #print "--- he encontrado $md en la línea $_\n";
                open  SALIDA_EVALUACION,">>./SALIDA_EVALUACION/PROBABLE/$marcador_ambiguo.txt" or die "$marcador_ambiguo no se ha abierto\n";
                print SALIDA_EVALUACION "$archivo_entrada/$_\n";
                close SALIDA_EVALUACION;
            }

            if ($linea =~ s/(?<=\s$other_md|$signos\s) ($marcador_ambiguo) (?=!$signos|$other_md)/<MD>$1<\/MD>/ig) {
                #print "--- he encontrado $md en la línea $_\n";
                open  SALIDA_EVALUACION,">>./SALIDA_EVALUACION/CTXTPROBABLE/$marcador_ambiguo.txt" or die "$marcador_ambiguo no se ha abierto\n";
                print SALIDA_EVALUACION "$archivo_entrada/$_\n";
                close SALIDA_EVALUACION;
            }

            if ($linea =~ s/(?<=!\s$other_md|$signos\s) ($marcador_ambiguo) (?=!$signos|$other_md)/<OTRACATEGORIA>$1<\/OTRACATEGORIA>/ig) {
                #print "--- he encontrado $md en la línea $_\n";
                open  SALIDA_EVALUACION,">>./SALIDA_EVALUACION/CTXCATEGORIAL/$marcador_ambiguo.txt" or die "$marcador_ambiguo no se ha abierto\n";
                print SALIDA_EVALUACION "$archivo_entrada/$_\n";
                close SALIDA_EVALUACION;
            }

        }
    }

    ## Grabación del resultado
    my $archivo_salida = "$directorio_salida/$archivo";
    print "Haciendo: $archivo_salida\n";

    open  G, ">$archivo_salida" or die "Problemas con el archivo de salida  $archivo_salida $!";
    print G join "\n", @lineas;
    close G;

}
Coloreado en 0.005 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

Anterior

Volver a Básico

¿Quién está conectado?

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