Subsecciones

Patrones Recursivos

Perl 5.10 introduce la posibilidad de definir subpatrones en una sección del patrón. Citando la versión del documento perlretut para perl5.10:

This feature (introduced in Perl 5.10) significantly extends the power of Perl’s pattern matching. By referring to some other capture group anywhere in the pattern with the construct (?group-ref), the pattern within the referenced group is used as an independent subpattern in place of the group reference itself. Because the group reference may be contained within the group it refers to, it is now possible to apply pattern matching to tasks that hitherto required a recursive parser.

...

In (?...) both absolute and relative backreferences may be used. The entire pattern can be reinserted with (?R) or (?0). If you prefer to name your buffers, you can use (?&name) to recurse into that buffer.

Palíndromos

Véase un ejemplo que reconoce los palabra-palíndromos (esto es, la lectura directa y la inversa de la cadena pueden diferir en los signos de puntuación):

casiano@millo:~/Lperltesting$ cat -n palindromos.pl
     1  #!/usr/local/lib/perl/5.10.1/bin//perl5.10.1 -w
     2  use v5.10;
     3
     4  my $regexp = qr/^(\W*
     5                       (?:
     6                             (\w) (?1) \g{-1}  # palindromo estricto
     7                           |
     8                             \w?               # no recursiva
     9                       )
    10                    \W*)$/ix;
    11
    12  my $input = <>;
    13  chomp($input);
    14  if ($input =~ $regexp) {
    15    say "$input is a palindrome";
    16  }
    17  else {
    18    say "does not match";
    19  }

Ejercicio 1.2.3   ¿Cuál es el efecto del modificador i en la regexp qr/^(\W* (?: (\w) (?1) \g{-1} | \w? ) \W*)$/ix?

Siguen algunos ejemplos de ejecución1.5

pl@nereida:~/Lperltesting$ ./palindromos.pl
A man, a plan, a canal: Panama!
A man, a plan, a canal: Panama! is a palindrome
pl@nereida:~/Lperltesting$ ./palindromos.pl
A man, a plan, a cam, a yak, a yam, a canal – Panama!
A man, a plan, a cam, a yak, a yam, a canal – Panama! is a palindrome
pl@nereida:~/Lperltesting$ ./palindromos.pl
A man, a plan, a cat, a ham, a yak, a yam, a hat, a canal – Panama!
A man, a plan, a cat, a ham, a yak, a yam, a hat, a canal – Panama! is a palindrome
pl@nereida:~/Lperltesting$ ./palindromos.pl
saippuakauppias
saippuakauppias is a palindrome
pl@nereida:~/Lperltesting$ ./palindromos.pl
dfghjgfd
does not match
pl@nereida:~/Lperltesting$ ./palindromos.pl
...,;;;;
...,;;;; is a palindrome

Lo que dice perlre sobre recursividad

(?PARNO) (?-PARNO) (?+PARNO) (?R) (?0)

Similar to (??{ code }) (véase la sección 1.2.9) except it does not involve compiling any code, instead it treats the contents of a capture buffer as an independent pattern that must match at the current position. Capture buffers contained by the pattern will have the value as determined by the outermost recursion.

PARNO is a sequence of digits (not starting with 0) whose value reflects the paren-number of the capture buffer to recurse to.

(?R) recurses to the beginning of the whole pattern. (?0) is an alternate syntax for (?R).

If PARNO is preceded by a plus or minus sign then it is assumed to be relative, with negative numbers indicating preceding capture buffers and positive ones following. Thus (?-1) refers to the most recently declared buffer, and (?+1) indicates the next buffer to be declared.

Note that the counting for relative recursion differs from that of relative backreferences, in that with recursion unclosed buffers are included.
Hay una diferencia fundamental entre \g{-1} y (?-1). El primero significa lo que casó con el último paréntesis. El segundo significa que se debe llamar a la expresión regular que define el último paréntesis. Véase un ejemplo:
pl@nereida:~/Lperltesting$ perl5.10.1 -wdE 0
main::(-e:1):   0
  DB<1>  x ($a = "12 aAbB 34") =~ s/([aA])(?-1)(?+1)([bB])/-\1\2-/g
0  1
  DB<2> p $a
12 -aB- 34

En perlre también se comenta sobre este punto:

If there is no corresponding capture buffer defined, then it is a fatal error. Recursing deeper than 50 times without consuming any input string will also result in a fatal error. The maximum depth is compiled into perl, so changing it requires a custom build.

Paréntesis Equilibrados

El siguiente programa (inspirado en uno que aparece en perlre) reconoce una llamada a una función foo() que puede contener una secuencia de expresiones con paréntesis equilibrados como argumento:

    1 pl@nereida:~/Lperltesting$ cat perlrebalancedpar.pl
    2 #!/usr/local/lib/perl/5.10.1/bin//perl5.10.1  -w
    3 use v5.10;
    4 use strict;
    5 
    6 my $regexp = qr{ (                      # paren group 1 (full function)
    7                 foo
    8                    (                    # paren group 2 (parens)
    9                      \(
   10                         (               # paren group 3 (contents of parens)
   11                            (?:
   12                                 [^()]+  # Non-parens
   13                               |
   14                                 (?2) # Recurse to start of paren group 2
   15                            )*
   16                         )               # 3
   17                      \)
   18                     )                   # 2
   19               )                         # 1
   20     }x;
   21 
   22 my $input = <>;
   23 chomp($input);
   24 my @res = ($input =~ /$regexp/);
   25 if (@res) {
   26   say "<$&> is balanced\nParen: (@res)";
   27 }
   28 else {
   29   say "does not match";
   30 }
Al ejecutar obtenemos:

pl@nereida:~/Lperltesting$  ./perlrebalancedpar.pl
foo(bar(baz)+baz(bop))
<foo(bar(baz)+baz(bop))> is balanced
Paren: (foo(bar(baz)+baz(bop)) (bar(baz)+baz(bop)) bar(baz)+baz(bop))

Como se comenta en perlre es conveniente usar índices relativos si se quiere tener una expresión regular reciclable:

The following shows how using negative indexing can make it easier to embed recursive patterns inside of a qr// construct for later use:

   1. my $parens = qr/(\((?:[^()]++|(?-1))*+\))/;
   2. if (/foo $parens \s+ + \s+ bar $parens/x) {
   3.   # do something here...
   4. }
Véase la sección 1.2.6 para comprender el uso de los operadores posesivos como ++.

Capturando los bloques de un programa

El siguiente programa presenta una heurística para determinar los bloques de un programa:

    1   pl@nereida:~/Lperltesting$ cat blocks.pl
    2   #!/usr/local/lib/perl/5.10.1/bin//perl5.10.1 -w
    3   use v5.10;
    4   use strict;
    5   #use re 'debug';
    6   
    7   my $rb = qr{(?x)
    8       (
    9         \{               # llave abrir
   10            (?:
   11                [^{}]++   # no llaves
   12            |
   13                 [^{}]*+  # no llaves
   14                 (?1)     # recursivo
   15                 [^{}]*+  # no llaves
   16            )*+
   17          \}              # llave cerrar
   18       )
   19     };
   20   
   21   local $/ = undef;
   22   my $input = <>;
   23   my@blocks = $input =~ m{$rb}g;
   24   my $i = 0;
   25   say($i++.":\n$_\n===") for @blocks;

Veamos una ejecución. Le daremos como entrada el siguiente programa: Al ejecutar el programa con esta entrada obtenemos:

pl@nereida:~/Lperltesting$ cat -n blocks.c
     1  main() { /* 1 */
     2    { /* 2 */ }
     3    { /* 3 */ }
     4  }
     5
     6  f(){  /* 4 */
     7    {   /* 5 */
     8      { /* 6 */ }
     9    }
    10    {   /* 7 */
    11      { /* 8 */ }
    12    }
    13  }
    14
    15  g(){ /* 9 */
    16  }
    17
    18  h() {
    19  {{{}}}
    20  }
    21  /* end h */
pl@nereida:~/Lperltesting$ perl5.10.1 blocks.pl blocks.c
0:
{ /* 1 */
  { /* 2 */ }
  { /* 3 */ }
}
===
1:
{  /* 4 */
  {   /* 5 */
    { /* 6 */ }
  }
  {   /* 7 */
    { /* 8 */ }
  }
}
===
2:
{ /* 9 */
}
===
3:
{
{{{}}}
}
===

Reconocimiento de Lenguajes Recursivos: Un subconjunto de LATEX

La posibilidad de combinar en las expresiones regulares Perl 5.10 la recursividad con los constructos (?<name>...) y ?&name) así como las secciones (?(DEFINE) ...) permiten la escritura de expresiones regulares que reconocen lenguajes recursivos. El siguiente ejemplo muestra un reconocedor de un subconjunto del lenguaje LATEX (véase la entrada LaTeX en la wikipedia):

    1 pl@nereida:~/Lperltesting$ cat latex5_10.pl
    2 #!/usr/local/lib/perl/5.10.1/bin//perl5.10.1 -w
    3 use strict;
    4 use v5.10;
    5 
    6 my $regexp = qr{
    7     \A(?&File)\z
    8 
    9     (?(DEFINE)
   10         (?<File>     (?&Element)*+\s*
   11         )
   12 
   13         (?<Element>  \s* (?&Command)
   14                   |  \s* (?&Literal)
   15         )
   16 
   17         (?<Command>  \\ \s* (?<L>(?&Literal)) \s* (?<Op>(?&Options)?) \s* (?<A>(?&Args))
   18            (?{
   19               say "command: <$+{L}> options: <$+{Op}> args: <$+{A}>"
   20            })
   21         )
   22 
   23         (?<Options>  \[ \s* (?:(?&Option) (?:\s*,\s* (?&Option) )*)? \s* \]
   24         )
   25 
   26         (?<Args>     (?: \{ \s* (?&Element)* \s* \} )*
   27         )
   28 
   29         (?<Option>   \s* [^][$&%#_{}~^\s,]+
   30         )
   31 
   32         (?<Literal>  \s* ([^][$&%#_{}~^\s]+)
   33         )
   34     )
   35 }xms;
   36 
   37 my $input = do{ local $/; <>};
   38 if ($input =~ $regexp) {
   39   say "$@: matches:\n$&";
   40 }
   41 else {
   42   say "does not match";
   43 }

Añadimos una acción semántica al final de la aceptación de un <Command>.

         (?<Command>  \\ \s* (?<L>(?&Literal)) \s* (?<Op>(?&Options)?) \s* (?<A>(?&Args)?)
            (?{
               say "command: <$+{L}> options: <$+{Op}> args: <$+{A}>"
            })
         )
Esta acción es ejecutada pero no afecta al proceso de análisis. (véase la sección 1.2.8 para mas información sobre las acciones semánticas en medio de una regexp). La acción se limita a mostrar que ha casado con cada una de las tres componentes: el comando, las opciones y los argumentos.

Los paréntesis adicionales, como en (?<L>(?&Literal)) son necesarios para guardar lo que casó.

Cuando se ejecuta produce la siguiente salida1.6:

pl@nereida:~/Lperltesting$ cat prueba.tex
\documentclass[a4paper,11pt]{article}
\usepackage{latexsym}
\author{D. Conway}
\title{Parsing \LaTeX{}}
\begin{document}
\maketitle
\tableofcontents
\section{Description}
...is easy \footnote{But not\\ \emph{necessarily} simple}.
In fact it's easy peasy to do.
\end{document}

pl@nereida:~/Lperltesting$ ./latex5_10.pl prueba.tex
command: <documentclass> options: <[a4paper,11pt]> args: <{article}>
command: <usepackage> options: <> args: <{latexsym}>
command: <author> options: <> args: <{D. Conway}>
command: <LaTeX> options: <> args: <{}>
command: <title> options: <> args: <{Parsing \LaTeX{}}>
command: <begin> options: <> args: <{document}>
command: <maketitle> options: <> args: <>
command: <tableofcontents> options: <> args: <>
command: <section> options: <> args: <{Description}>
command: <emph> options: <> args: <{necessarily}>
command: <footnote> options: <> args: <{But not\\ \emph{necessarily} simple}>
command: <end> options: <> args: <{document}>
: matches:
\documentclass[a4paper,11pt]{article}
\usepackage{latexsym}
\author{D. Conway}
\title{Parsing \LaTeX{}}
\begin{document}
\maketitle
\tableofcontents
\section{Description}
...is easy \footnote{But not\\ \emph{necessarily} simple}.
In fact it's easy peasy to do.
\end{document}
La siguiente entrada prueba3.tex no pertenece al lenguaje definido por el patrón regular, debido a la presencia de la cadena $In$ en la última línea:
pl@nereida:~/Lperltesting$ cat prueba3.tex
\documentclass[a4paper,11pt]{article}
\usepackage{latexsym}
\author{D. Conway}
\title{Parsing \LaTeX{}}
\begin{document}
\maketitle
\tableofcontents
\section{Description}
\comm{a}{b}
...is easy \footnote{But not\\ \emph{necessarily} simple}.
$In$ fact it's easy peasy to do.
\end{document}

pl@nereida:~/Lperltesting$ ./latex5_10.pl prueba3.tex
command: <documentclass> options: <[a4paper,11pt]> args: <{article}>
command: <usepackage> options: <> args: <{latexsym}>
command: <author> options: <> args: <{D. Conway}>
command: <LaTeX> options: <> args: <{}>
command: <title> options: <> args: <{Parsing \LaTeX{}}>
command: <begin> options: <> args: <{document}>
command: <maketitle> options: <> args: <>
command: <tableofcontents> options: <> args: <>
command: <section> options: <> args: <{Description}>
command: <comm> options: <> args: <{a}{b}>
command: <emph> options: <> args: <{necessarily}>
command: <footnote> options: <> args: <{But not\\ \emph{necessarily} simple}>
does not match

Ejercicio 1.2.4   Obsérvese el uso del cuantificador posesivo en:
 10          (?<File>     (?&Element)*+\s*
 11          )
¿Que ocurrre si se quita el posesivo y se vuelve a ejecutar $ ./latex5_10.pl prueba3.tex?

Reconocimiento de Expresiones Aritméticas

Véase el nodo Complex regex for maths formulas en perlmonks para la formulación del problema. Un monje pregunta:

Hiya monks,

Im having trouble getting my head around a regular expression to match sequences. I need to catch all exceptions where a mathematical expression is illegal...

There must be either a letter or a digit either side of an operator parenthesis must open and close next to letters or digits, not next to operators, and do not have to exist variables must not be more than one letter Nothing other than a-z,A-Z,0-9,+,-,*,/,(,) can be used

Can anyone offer a hand on how best to tackle this problem?

many thanks

La solución parte de que una expresión es o bien un término o bien un término seguido de una operador y un término, esto es:

que puede ser unificado como termino (op termino)*.

Un término es un número o un identificador o una expresión entre paréntesis, esto es:

La siguiente expresión regular recursiva sigue esta idea:

pl@nereida:~/Lperltesting$ cat -n simpleexpressionsna.pl
    1   #!/usr/local/lib/perl/5.10.1/bin//perl5.10.1
    2   use v5.10;
    3   use strict;
    4   use warnings;
    5 
    6   local our ($skip, $term, $expr);
    7   $skip = qr/\s*/;
    8   $expr = qr{ (?<EXPR>
    9                      (?<TERM>              # An expression is a TERM  ...
   10                             $skip (?<ID>[a-zA-Z]+)
   11                           | $skip (?<INT>[1-9]\d*)
   12                           | $skip \(
   13                             $skip  (?&EXPR)
   14                             $skip \)
   15                      ) (?: $skip           # possibly followed by a sequence of ...
   16                            (?<OP>[-+*/])
   17                            (?&TERM)        # ... operand TERM pairs
   18                        )*
   19               )
   20             }x;
   21   my $re = qr/^ $expr $skip \z/x;
   22   sub is_valid { shift =~ /$re/o }
   23 
   24   my @test = ( '(a + 3)', '(3 * 4)+(b + x)', '(5 - a)*z',
   25                 '((5 - a))*((((z)))+2)', '3 + 2', '!3 + 2', '3 + 2!',
   26                 '3 a', '3 3', '3 * * 3',
   27                 '2 - 3 * 4',  '2 - 3 + 4',
   28               );
   29   foreach (@test) {
   30     say("$_:");
   31     say(is_valid($_) ? "\n<$_> is valid" : "\n<$_> is not valid")
   32   }
Podemos usar acciones semánticas empotradas para ver la forma en la que trabaja la expresión regular (véase la sección 1.2.8):

pl@nereida:~/Lperltesting$ cat -n simpleexpressions.pl
    1   #!/usr/local/lib/perl/5.10.1/bin//perl5.10.1
    2   use v5.10;
    3   use strict;
    4   use warnings;
    5 
    6   use re 'eval'; # to allow Eval-group at runtime
    7 
    8   local our ($skip, $term, $expr);
    9   $skip = qr/\s*/;
   10   $expr = qr{ (?<EXPR>
   11                      (?<TERM>              # An expression is a TERM  ...
   12                             $skip (?<ID>[a-zA-Z]+)  (?{ print "[ID $+{ID}] "  })
   13                           | $skip (?<INT>[1-9]\d*)  (?{ print "[INT $+{INT}] " })
   14                           | $skip \(                (?{ print "[(] " })
   15                             $skip  (?&EXPR)
   16                             $skip \)                (?{ print "[)] " })
   17                      ) (?: $skip           # possibly followed by a sequence of ...
   18                            (?<OP>[-+*/])            (?{ print "[OP $+{OP}] " })
   19                            (?&TERM)        # ... operand TERM pairs
   20                        )*
   21               )
   22             }x;
   23   my $re = qr/^ $expr $skip \z/x;
   24   sub is_valid { shift =~ /$re/o }
   25 
   26   my @test = ( '(a + 3)', '(3 * 4)+(b + x)', '(5 - a)*z',
   27                 '((5 - a))*((((z)))+2)', '3 + 2', '!3 + 2', '3 + 2!',
   28                 '3 a', '3 3', '3 * * 3',
   29                 '2 - 3 * 4',  '2 - 3 + 4',
   30               );
   31   foreach (@test) {
   32     say("$_:");
   33     say(is_valid($_) ? "\n<$_> is valid" : "\n<$_> is not valid")
   34   }

Ejecución:

pl@nereida:~/Lperltesting$ ./simpleexpressions.pl
(a + 3):
[(] [ID a] [OP +] [INT 3] [)]
<(a + 3)> is valid
(3 * 4)+(b + x):
[(] [INT 3] [OP *] [INT 4] [)] [OP +] [(] [ID b] [OP +] [ID x] [)]
<(3 * 4)+(b + x)> is valid
(5 - a)*z:
[(] [INT 5] [OP -] [ID a] [)] [OP *] [ID z]
<(5 - a)*z> is valid
((5 - a))*((((z)))+2):
[(] [(] [INT 5] [OP -] [ID a] [)] [)] [OP *] [(] [(] [(] [(] [ID z] [)] [)] [)] [OP +] [INT 2] [)]
<((5 - a))*((((z)))+2)> is valid
3 + 2:
[INT 3] [OP +] [INT 2]
<3 + 2> is valid
!3 + 2:

<!3 + 2> is not valid
3 + 2!:
[INT 3] [OP +] [INT 2]
<3 + 2!> is not valid
3 a:
[INT 3]
<3 a> is not valid
3 3:
[INT 3]
<3 3> is not valid
3 * * 3:
[INT 3] [OP *]
<3 * * 3> is not valid
2 - 3 * 4:
[INT 2] [OP -] [INT 3] [OP *] [INT 4]
<2 - 3 * 4> is valid
2 - 3 + 4:
[INT 2] [OP -] [INT 3] [OP +] [INT 4]
<2 - 3 + 4> is valid

Casiano Rodríguez León
2012-01-30