Misioneros y caníbales, en Perl
Anoche leía una anotación de Eric S. Raymond
sobre sus experiencias aprendiendo Haskell, y me recordó en primer lugar mis intentos con la tecnología secreta alienígena, y luego una anotación vieja mía donde se trataba el puzzle de los misioneros y los caníbales.
La asociación entre ambos temas es porque alguien propuso una solución en Haskell
(completamente marciana, por supuesto), y he acabado ojeando mi implementación en Ruby
.
La verdad es que está bastante limpio el código, pero me sigue pareciendo raro. No he llegado a ser un programador de Ruby
, lo admito.
Me he preguntado cómo se vería en Perl
, y como no me gusta hacer crucigramas, aquí está la solución.
#!/usr/bin/perl =begin Tres misioneros y tres caníbales quieren cruzar un río. Solo hay una canoa que puede ser usada por una o dos personas, ya sean misioneros o caníbales. Hay que tener cuidado en que en ningún momento el número de caníbales supere al de misioneros en ninguna de las dos orillas, o se los comerán. Juan J. Martínez <reidrac*en*usebox.net> =cut use strict; use warnings; use Clone qw(clone); # comprueba si un estado es válido con las reglas del juego sub estadoValido { my @estado = @_; # el número de personajes tiene que ser correcto en cada lado if($estado[0][0] gt 3 || $estado[1][0] gt 3 || $estado[0][1] gt 3 || $estado[1][1] gt 3 || $estado[0][0] lt 0 || $estado[1][0] lt 0 || $estado[0][1] lt 0 || $estado[1][1] lt 0) { return 0; } # el numero de misioneros debe ser >= que el de caníbales return 0 if $estado[0][0] lt $estado[0][1] && $estado[0][0] gt 0; return 0 if $estado[1][0] lt $estado[1][1] && $estado[1][0] gt 0; return 1; } # aplica el viaje al estado sub aplicaViaje { my $viaje = shift; # tenemos que hacer un "deep copy", sino se usarán referencias en # los vectores internos, y no es lo que queremos my @estado = @{clone(shift)}; $estado[$estado[2]][0] -= $viaje->[0]; $estado[$estado[2]][1] -= $viaje->[1]; # la canoa cambia de orilla siempre en cada viaje $estado[2] = $estado[2] ? 0 : 1; $estado[$estado[2]][0] += $viaje->[0]; $estado[$estado[2]][1] += $viaje->[1]; return @estado; } # muestra un viaje en pantalla de una forma elegante (!) sub muestra { my $estado = shift; print "M: $estado->[0][0] C: $estado->[0][1] |"; print ($estado->[2] ? "~~~~~~~~~~ \\____/" : "\\____/ ~~~~~~~~~~"); print "| M: $estado->[1][0] C: $estado->[1][1]\n"; } # compara en profundidad una estructura con vectores sub compara { my ($a, $b) = @_; return 0 if scalar(@$a) ne scalar(@$b); for (my $i = 0 ; $i < scalar(@$a) ; $i++) { if(ref($a->[$i]) eq 'ARRAY') { return 0 if !compara($a->[$i], $b->[$i]); } elsif ($a->[$i] ne $b->[$i]) { return 0; } } return 1; } # busca un viaje en un vector de viajes sub usado { my ($nuevo, @previos) = @_; foreach (@previos) { return 1 if compara($_, $nuevo); } return 0; } # estado inicial my $inicio = [[3, 3], [0, 0], 0]; # estado final my $fin = [[0, 0], [3, 3], 1]; # viajes posibles my @viajes = ([1, 0], [0, 1], [1, 1], [2, 0], [0, 2]); # guardamos los estados válidos my @recorrido; # los viajes que nos quedan de entre los posibles en cada estado válido my @restantes; # los viajes válidos restantes en el estado actual my @parcial = @viajes; # hasta que no lleguemos a la solución while (!compara($inicio, $fin)) { # si nos quedamos sin viajes válidos en un estado, será el estado 0 # y no habrá solución para el problema (no pasará!) if (!scalar(@parcial)) { print "D'oh! no hay solución!\n"; exit 1; } # mientras nos quedan viajes válidos, vamos probando while (scalar(@parcial)) { my $viaje = shift(@parcial); # creamos un nuevo estado my @nuevo = aplicaViaje($viaje, $inicio); # si el estado es válido y no lo hemos usado, es un candidato if (estadoValido(@nuevo) && !usado(\@nuevo, @recorrido)) { # guardamos el estado anterior push(@recorrido, [@$inicio]); # guardamos los viajes válidos que nos quedan push(@restantes, [@parcial]); # el nuevo estado pasa a estado actual $inicio = \@nuevo; @parcial = @viajes; last; } } # si nos queamos sin viajes válidos pero tenemos almacenados estados # anteriores, podemos volver atrás y probar con otra rama if (!scalar(@parcial) && scalar(@recorrido)) { # recuperamos el estado anterior $inicio = pop(@recorrido); # recuperamos los viajes válidos que faltaban por probar my $p = pop(@restantes); @parcial = @$p; } } # si hemos resuelto el juego, mostramos el resultado if (compara($inicio, $fin)) { print "Resultado: \n"; # mostramos los estados anteriores foreach(@recorrido) { muestra($_); } # y el último estado válido muestra($inicio); } exit 0; # EOF
Las reglas del juego son las mismas, y la solución implementa backtracking de la misma forma que lo hice en Ruby
.
Además del problema de las referencias en los vectores que ya tuve en Ruby
, y que en el caso de Perl
he solucionado con Clone
, he tenido la pega de que no hay una función para comparar estructuras en profundidad, y me he tenido que hacer una (compara
; aunque seguro que había un módulo que hacía lo mismo, como el clone
, que no lo he implementado :P).
Lo que sí es cierto es que su aspecto me resulta más familiar que en Ruby
:D.
Al final llegamos a la misma solución, y el código es prácticamente igual, salvo algún perl-ism que he empleado por costumbre (se puede descargar el fuente para probarlo: misio_can.pl).
¿Alquien más se anima a resolver el puzzle en su lenguaje favorito?
Los comentarios están cerrados: los comentarios se cierran automáticamente una vez pasados 30 días. Si quieres comentar algo acerca de la anotación, puedes hacerlo por e-mail.