El siguiente programa evalúa si un número es primo o no:
pl@nereida:~/Lperltesting$ cat -n isprime.pl
1 #!/usr/bin/perl -w
2 use strict;
3
4 my $num = shift;
5 die "Usage: $0 integer\n" unless (defined($num) && $num =~ /^\d+$/);
6
7 if (("1" x $num) =~ /^(11+)\1+$/) {
8 my $factor = length($1);
9 print "$num is $factor x ".$num/$factor."\n";
10 }
11 else {
12 print "$num is prime\n";
13 }
Siguen varias ejecuciones:
pl@nereida:~/Lperltesting$ ./isprime.pl 35.32 Usage: ./isprime.pl integer pl@nereida:~/Lperltesting$ ./isprime.pl 47 47 is prime pl@nereida:~/Lperltesting$ ./isprime.pl 137 137 is prime pl@nereida:~/Lperltesting$ ./isprime.pl 147 147 is 49 x 3 pl@nereida:~/Lperltesting$ ./isprime.pl 137 137 is prime pl@nereida:~/Lperltesting$ ./isprime.pl 49 49 is 7 x 7 pl@nereida:~/Lperltesting$ ./isprime.pl 47 47 is prime
Según dice la entrada Diophantine_equation en la wikipedia:
In mathematics, a Diophantine equation is an indeterminate polynomial equation that allows the variables to be integers only.
La siguiente sesión con el depurador muestra como se puede resolver una ecuación lineal diofántica con coeficientes positivos usando una expresión regular:
DB<1> # Resolvamos 3x + 2y + 5z = 40
DB<2> x ('a'x40) =~ /^((?:...)+)((?:..)+)((?:.....)+)$/
0 'aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa'
1 'aa'
2 'aaaaa'
DB<3> x map { length } ('a'x40) =~ /^((?:...)+)((?:..)+)((?:.....)+)$/
0 33
1 2
2 5
DB<4> @c = (3, 2, 5)
DB<5> x map { length($_) / $c[$i++] } ('a'x40) =~ /^((?:...)+)((?:..)+)((?:.....)+)$/
0 11
1 1
2 1
DB<6> p 3*11+2*1+5*1
40
Usando el verbo (*FAIL) es posible obtener todas las soluciones:
main::(-e:1): 0
DB<1> sub equ { my @c = @_; print "\t3*$c[0]+2*$c[1]+5*$c[2] = ",3*$c[0]+2*$c[1]+5*$c[2],"\n" }
DB<2> sub f { my @c = ((length($1)/3), (length($2)/2), (length($3)/5)); equ(@c); }
DB<3> x ('a'x40) =~ /^((?:...)+)((?:..)+)((?:.....)+)$(?{ f() })(*FAIL)/x
3*11+2*1+5*1 = 40
3*9+2*4+5*1 = 40
3*8+2*3+5*2 = 40
3*7+2*7+5*1 = 40
3*7+2*2+5*3 = 40
3*6+2*6+5*2 = 40
3*6+2*1+5*4 = 40
3*5+2*10+5*1 = 40
3*5+2*5+5*3 = 40
3*4+2*9+5*2 = 40
3*4+2*4+5*4 = 40
3*3+2*13+5*1 = 40
3*3+2*8+5*3 = 40
3*3+2*3+5*5 = 40
3*2+2*12+5*2 = 40
3*2+2*7+5*4 = 40
3*2+2*2+5*6 = 40
3*1+2*16+5*1 = 40
3*1+2*11+5*3 = 40
3*1+2*6+5*5 = 40
3*1+2*1+5*7 = 40
empty array
DB<4>
El siguiente programa recibe en línea de comandos los coeficientes y término inependeinte de una ecuación lineal diofántica con coeficientes positivos y muestra todas las soluciones. El algoritmo primero crea una cadena conteniendo el código Perl que contiene la expresión regular adecuada para pasar luego a evaluarlo:
pl@nereida:~/Lperltesting$ cat -n diophantinesolvergen.pl
1 #!/usr/local/lib/perl/5.10.1/bin//perl5.10.1 -w
2 use v5.10;
3 use strict;
4
5 # Writes a Perl solver for
6 # a1 x1 + a2 x2 + ... + an xn = b
7 # a_i and b integers > 0
8 #
9
10 my $b = pop;
11 my @a = @ARGV;
12 my $debug = 1;
13
14 my $b1 = '1'x$b;
15 my @a1 = map { '1'x$_ } @a;
16 my @index = map { 'length($'.$_.")/".$a[$_-1] } 1..(@a);
17 my $aux = join ",", @index;
18
19 my $regexp = '^';
20 $regexp .= "((?:$_)+)" for @a1;
21
22 $regexp .= '$(?{ f() })(*FAIL)';
23
24 my $solver = <<"SOLVER";
25 my \@stack;
26 sub f {
27 my \@s = ($aux);
28 push \@stack, [ \@s ];
29 }
30
31 q{$b1} =~ m{$regexp}x;
32
33 return \@stack;
34 SOLVER
35
36 print "Solver:\n--------\n$solver\n--------\n" if $debug;
37
38 my @stack = eval $solver;
39
40 say("@$_") for @stack
Sigue un ejemplo de ejecución:
pl@nereida:~/Lperltesting$ ./diophantinesolvergen.pl 3 2 5 40
Solver:
--------
my @stack;
sub f {
my @s = (length($1)/3,length($2)/2,length($3)/5);
push @stack, [ @s ];
}
q{1111111111111111111111111111111111111111} =~ m{^((?:111)+)((?:11)+)((?:11111)+)$(?{ f() })(*FAIL)}x;
return @stack;
--------
11 1 1
9 4 1
8 3 2
7 7 1
7 2 3
6 6 2
6 1 4
5 10 1
5 5 3
4 9 2
4 4 4
3 13 1
3 8 3
3 3 5
2 12 2
2 7 4
2 2 6
1 16 1
1 11 3
1 6 5
1 1 7
En la páginas de Retos Matemáticos de
puede encontrarse el siguiente problema:
¿Qué edad tendrán las tres hijas?
¿Podemos ayudarnos de una expresión regular para resolver el problema? Al ejecutar el siguiente programa:
pl@nereida:~/Lperltesting$ cat -n playspiano.pl
1 #!/usr/local/lib/perl/5.10.1/bin//perl5.10.1 -w
2 use v5.10;
3 use strict;
4 use List::Util qw{sum};
5
6 local our %u;
7 sub f {
8 my @a = @_;
9 @a = sort { $b <=> $a } (length($a[1]), length($a[0])/length($a[1]), 36/length($a[0]) );
10
11 local $" = ", ";
12 say "(@a)\t ".sum(@a) unless exists($u{"@a"});
13 $u{"@a"} = undef;
14 }
15
16 say "SOL\t\tNUMBER";
17 my @a = ('1'x36) =~
18 /^((1+)\2+)(\1+)$
19 (?{ f($1, $2, $3)
20 })
21 (*FAIL)
22 /x;
obtenemos la salida:
pl@nereida:~/Lperltesting$ ./playspiano.pl SOL NUMBER (9, 2, 2) 13 (6, 3, 2) 11 (4, 3, 3) 10 (18, 2, 1) 21 (12, 3, 1) 16 (9, 4, 1) 14 (6, 6, 1) 13
Explique el funcionamiento del programa. A la vista de la salida ¿Cuáles eran las edades de las hijas?
Para una definición del problema vea la sección El Problema de la Mochila 0-1 en los apuntes de LHP
¡Si lo logra merece el premio a la solución mas freak que se haya encontrado para dicho problema!
Véase también: