[bcn-pm] Concurs de Sant Jordi

Jordi Delgado jdelgado a lsi.upc.edu
dll abr 26 07:45:23 PDT 2010


Hola,

Al final em vaig decidir a participar al concurs, i no vaig quedar massa be.
Els meus enviaments no van superar el jutge, tot i que ara explicare les raons.

Adjunto l'enunciat del problema, "El Cavall Saltador", que es una variant del problema
"The Knight's Tour" (http://en.wikipedia.org/wiki/Knight%27s_tour). Podeu veure
els resultats del concurs i el codi dels guanyadors (molt bo) a 
http://sant-jordi.jutge.org/

Hi ha la solucio que qualsevol que hagi fet un curs d'algorismica pensa: un
backtracking (els guanyadors implementaven aixo). I aixo vaig fer:

# Entrada de dades: Format lliure
local $/=undef;
$entrada = <STDIN>;
@entrada = split /\s+/,$entrada;
$mida = $entrada[0];
$prohibits = 0;
foreach $i (1..$mida) {
  @tmp = split(//, $entrada[$i]);
  foreach (@tmp) {
    s/\*/**/;
    ++$prohibits if (/\*\*/);
  }
  push(@matriu,[@tmp]);
}
($ox,$oy) = @entrada[-2,-1];
$matriu[--$ox][--$oy] = '01';
# Fi entrada de dades.

sub intenta {
  my $check = $_[1] >= 0 && $_[1] < $mida && $_[2] >= 0 && $_[2] < $mida;
  if ($check && $matriu[$_[1]][$_[2]] eq '.') {
    my $t = 1 + $_[0];
    $matriu[$_[1]][$_[2]] = ($t < 10) ? "0$t" : $t;
    &buscar($t,$_[1],$_[2]);
    $matriu[$_[1]][$_[2]] = '.';
  }
}

sub buscar {
  if ($_[0] == ($mida * $mida - $prohibits)) {
    foreach $x (0..$#matriu) {
      printf("%s\n", join(' ', @{$matriu[$x]})) };
    exit 0;
  }
  else {
    foreach $m (-2,-1,+1,+2) {
      intenta($_[0], $_[1]+$m, $_[2]+$_) foreach (-(3-abs($m)),(3-abs($m))); }
  }
}

buscar(1,$ox,$oy);

print "sense solucio\n";



Aixo, he sabut despres, es el que va fer tothom. El jutge no s'ho va empassar ja que,
tot i superar satisfactoriament els jocs de proves, em deia "Time Limit Exceeded"
(en algun joc de proves, superava el temps permes per trobar una solucio; aixi
s'incentiven les solucions eficients).

Problema: El temps d'execucio es compara amb el temps que triga un programa
solucio escrit en C++ (!!). Aixi, un pot pensar, "es clar que supero el limit de
temps, Perl es mes lent que C++". Pero: hi havia programes Java i Python que havien
implementat un backtracking sense superar la limitacio de temps. Els algorismes
de backtracking son molt sensibles a l'ordre en el que es generen les solucions, aixi
que potser vaig tenir mala sort i en algun joc de proves l'algorisme trigava mes
del compte (ara be, m'han  dit que en un futur pensen ponderar aquests temps limit
per algun factor que sera funcio del llenguatge en el que implementes la solucio).
Sigui com sigui, aquesta solucio, tot i ser correcte, no va colar.

Vaig provar la solucio heuristica de Warnsdorff que funciona prou be, tot i que
no funciona be sempre. Pot ser que no trobi solucio quan n'hi ha. L'algorisme,
pero, funciona en temps lineal (vegeu http://en.wikipedia.org/wiki/Knight%27s_tour).
Vaig pensar: "amb sort, aquest heuristic funcionara be amb els jocs de proves que tenen,
tampoc cal que funcioni be sempre! :-)" i ... no! Hi havia un joc de proves amb el que
el meu programa deia que no hi havia solucio, quan si que n'hi havia. El programa es:

# Entrada de dades: Format lliure
local $/=undef;
$entrada = <STDIN>;
@entrada = split /\s+/,$entrada;
$mida = $entrada[0];
$prohibits = 0;
foreach $i (1..$mida) {
  @tmp = split(//, $entrada[$i]);
  foreach (@tmp) {
    s/\*/**/;
    ++$prohibits if (/\*\*/);
  }
  push(@matriu,[@tmp]);
}
($ox,$oy) = @entrada[-2,-1];
--$ox;
--$oy;
# Fi entrada de dades.

$lliures = $mida * $mida - $prohibits;
foreach $m (+1,+2,-1,-2) {
    push(@seguents, [$m,$_]) foreach (-(3-abs($m)),(3-abs($m))); }

sub valid {
  my $check = $_[0] >= 0 && $_[0] < $mida && $_[1] >= 0 && $_[1] < $mida;
  $check =  $matriu[$_[0]][$_[1]] eq '.' if $check;
  return ($check ? 1 : 0);
}

sub num_possibles_moviments {
  my ($x,$y) = @_;
  return 1000 if not valid($x,$y);
  my $s = 0;
  $s += valid($x + $_->[0], $y + $_->[1]) foreach (@seguents);
  return $s
}

$posX = $ox;
$posY = $oy;
foreach (1..$lliures) {
  $matriu[$posX][$posY] = ($_ < 10) ? "0$_" : $_;
  my @pos = map [$posX + $_->[0], $posY + $_->[1], num_possibles_moviments($posX + $_->[0], $posY + $_->[1])], @seguents;
  my $min_index = 0;
  $min_index = ($pos[$_]->[2] < $pos[$min_index]->[2]) ? $_ : $min_index foreach (0..$#pos); ## AQUI!!!
  last if $pos[$min_index]->[2] == 1000 && $_ < $lliures;
  ($posX, $posY) = ($pos[$min_index]->[0],$pos[$min_index]->[1]);
  $final = $_;
}

if ($final < $lliures) {
  print "sense solucio\n";
}
else {
  foreach $x (0..$#matriu) {
    printf("%s\n", join(' ', @{$matriu[$x]})) };
}

I aquesta es la historia. Em consola saber que el programa hagues funcionat be amb TOTS els
jocs de prova (cosa que he sabut a posteriori, quan ja era massa tard) si hagues canviat
el '<' de la linia marcada amb un 'AQUI!!!' per un '<='.

Moraleja:

a) No es poden comparar peres amb pomes. No pot ser que el jutge accepti un algorisme
implementat en C/C++ i NO accepti EL MATEIX algorisme implementat en Perl amb l'excusa
dels limits de temps (no obris el concurs a altres llenguatges si ha de passar aixo).
El que m'estranya, i atribueixo a arbitrarietats propies del backtracking, es que una
implementacio en Python del mateix backtracking si que passes. Entenc que Perl i Python
son si fa o no fa igual de rapids (o lents).

b) Vaig ser l'unic (de mes de 60) que va utilitzar Perl. Conclusio: Perl no es massa
popular a la FIB. Es aixo un problema?? No ho se!

Sigui com sigui, gracies per la vostra atencio si heu arribat fins aqui. El codi Perl
que vaig fer NO es un exemple de bon codi, pero fer-lo guarro formava part del joc.

Ens veiem...

Salut!

Jordi
-------------- next part --------------
A non-text attachment was scrubbed...
Name: P43694_ca.pdf
Type: application/pdf
Size: 25789 bytes
Desc: not available
URL: <http://mail.pm.org/pipermail/barcelona-pm/attachments/20100426/ac31265e/attachment-0001.pdf>


Més informació sobre la llista de correu Barcelona-pm