1votos

juego del caballo en ajedrez en Haskell

por josejuan hace 11 meses

Usando la regla de Warnsdorf puede modificarse el algoritmo trivial fácilmente para obtener las soluciones muy rápidamente (ej. 100.000 soluciones de 8x8 en menos de 2 segundos o soluciones de miles de saltos en pocos milisegundos).

el programa lo que hace es que en una matriz de 8*8 se da la posicion x,y y el imprime todos los movimientos del caballo sin repetir casilla

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
import System.Environment 
import Data.List (sort) 
import Data.Set hiding (map) 
 
type Pos = (Int, Int) 
type Board = Set Pos 
 
saltos :: Int → Pos → Board → [(Pos, Board)] 
saltos s (x, y) m = [(p, insert p m) 
                      | (dx, dy) ← [(-1,2),(1,2),(2,1),(2,-1),(1,-2),(-1,-2),(-2,-1),(-2,1)] 
                      , let x' = x + dx, 0 ≤ x', x' < s 
                      , let y' = y + dy, 0 ≤ y', y' < s 
                      , let p  = (x', y'), ¬(p `member` m)] 
 
todos :: Int → [(Pos, Board)] → [[Pos]] 
todos s = concatMap uno ∘ sort ∘ map warnsdorf 
  where warnsdorf (p, m) = (length xs, p, xs) where xs = saltos s p m 
        uno (_, p, xs) = case todos s xs of {[] → [[p]]; rs → map (p:) rs} 
                            
main = do                   
  (s:x:y:n:z:_) ← map read ↥ getArgs 
  print ∘ take z ∘ dropWhile ((<n) ∘ length) $ todos s [((x,y), singleton (x,y))] 
 
 
{- 
 
[josejuan@centella centella]$ time -f "%E, %M" ../caballo 8 0 0 64 1 
[[(0,0),(1,2),(0,4),(1,6),(3,7),(5,6),(7,7),(6,5),(5,7),(7,6),(6,4),(7,2),(6,0),(4,1) 
,(2,0),(0,1),(1,3),(0,5),(1,7),(2,5),(0,6),(2,7),(4,6),(6,7),(7,5),(6,3),(7,1),(5,0) 
,(3,1),(1,0),(0,2),(2,1),(4,0),(5,2),(7,3),(6,1),(4,2),(3,0),(1,1),(0,3),(2,2),(1,4) 
,(3,3),(5,4),(3,5),(2,3),(4,4),(3,2),(5,1),(7,0),(6,2),(4,3),(2,4),(3,6),(1,5),(0,7) 
,(2,6),(3,4),(5,3),(4,5),(6,6),(4,7),(5,5),(7,4)]] 
0:00.00, 3736 
 
[josejuan@centella centella]$ time -f "%E, %M" ../caballo 8 0 0 64 100000 > /dev/null 
0:01.54, 5352 
 
[josejuan@centella centella]$ time -f "%E, %M" ../caballo 20 0 0 400 1 
[[(0,0),(1,2),(0,4),(1,6),(0,8),(1,10),(0,12),(1,14),(0,16),(1,18),(3,19),(5,18),(7,19),(9,18),(11,19),(13,18),(15,19),(17,18),(19,19),(18,17),(17,19),(19,18),(18,16) 
,(19,14),(18,12),(19,10),(18,8),(19,6),(18,4),(19,2),(18,0),(16,1),(14,0),(12,1),(10,0),(8,1),(6,0),(4,1),(2,0),(0,1),(1,3),(0,5),(1,7),(0,9),(1,11),(0,13),(1,15) 
,(0,17),(1,19),(2,17),(0,18),(2,19),(4,18),(6,19),(7,17),(8,19),(6,18),(4,19),(2,18),(0,19),(1,17),(0,15),(2,16),(3,18),(5,19),(4,17),(3,15),(1,16),(0,14),(2,13) 
,(3,11),(1,12),(0,10),(2,9),(3,7),(1,8),(0,6),(2,5),(3,3),(2,1),(0,2),(1,0),(3,1),(5,0),(6,2),(7,0),(5,1),(3,0),(1,1),(0,3),(2,2),(1,4),(2,6),(0,7),(1,5),(2,3),(4,2) 
,(3,4),(4,6),(2,7),(1,9),(0,11),(1,13),(2,11),(3,9),(5,8),(4,10),(3,8),(2,10),(3,12),(2,14),(3,16),(5,17),(7,18),(9,19),(8,17),(6,16),(4,15),(3,17),(2,15),(3,13) 
,(4,11),(2,12),(3,14),(4,16),(5,14),(4,12),(3,10),(2,8),(4,9),(5,11),(4,13),(5,15),(6,17),(8,18),(10,19),(9,17),(7,16),(6,14),(5,16),(4,14),(5,12),(6,10),(7,12),(5,13) 
,(6,15),(8,16),(7,14),(6,12),(5,10),(4,8),(3,6),(2,4),(3,2),(4,0),(5,2),(4,4),(5,6),(3,5),(4,3),(5,5),(4,7),(5,9),(6,7),(7,9),(6,11),(7,13),(8,15),(9,13),(8,11),(9,9) 
,(7,10),(6,8),(8,7),(6,6),(5,4),(7,5),(6,3),(7,1),(9,0),(8,2),(6,1),(8,0),(10,1),(12,0),(14,1),(16,0),(18,1),(19,3),(17,2),(19,1),(17,0),(15,1),(13,0),(11,1),(9,2) 
,(7,3),(6,5),(5,3),(4,5),(5,7),(7,8),(8,6),(7,4),(9,3),(7,2),(6,4),(7,6),(8,4),(10,3),(9,1),(8,3),(9,5),(10,7),(8,8),(6,9),(7,7),(8,5),(9,7),(8,9),(7,11),(6,13),(7,15) 
,(8,13),(9,11),(10,9),(8,10),(9,8),(10,6),(9,4),(10,2),(11,0),(12,2),(11,4),(13,3),(11,2),(10,4),(9,6),(11,5),(12,3),(13,1),(15,0),(14,2),(13,4),(11,3),(10,5),(11,7) 
,(12,5),(14,4),(13,2),(15,3),(16,5),(17,3),(15,2),(17,1),(19,0),(18,2),(16,3),(15,5),(13,6),(12,4),(14,3),(16,2),(17,4),(19,5),(18,3),(16,4),(17,6),(19,7),(18,5),(17,7) 
,(19,8),(18,6),(19,4),(17,5),(15,4),(13,5),(11,6),(10,8),(9,10),(8,12),(9,14),(10,12),(11,10),(12,8),(14,7),(12,6),(14,5),(16,6),(18,7),(19,9),(17,8),(15,7),(13,8) 
,(14,6),(12,7),(11,9),(10,11),(12,10),(11,8),(10,10),(9,12),(8,14),(9,16),(10,18),(12,19),(11,17),(10,15),(11,13),(12,11),(13,9),(15,8),(13,7),(15,6),(16,8),(14,9) 
,(16,10),(18,9),(19,11),(17,10),(15,9),(16,7),(17,9),(18,11),(19,13),(17,12),(18,10),(19,12),(18,14),(19,16),(18,18),(16,19),(14,18),(16,17),(17,15),(18,13),(19,15) 
,(17,14),(16,12),(14,11),(12,12),(10,13),(9,15),(10,17),(11,15),(12,17),(10,16),(11,14),(12,16),(11,18),(13,19),(15,18),(14,16),(13,14),(15,13),(16,11),(14,10),(12,9) 
,(11,11),(13,10),(14,8),(16,9),(15,11),(13,12),(12,14),(11,12),(10,14),(11,16),(12,18),(13,16),(15,15),(14,13),(13,11),(15,10),(17,11),(16,13),(14,12),(12,13),(13,15) 
,(14,17),(16,16),(15,14),(13,13),(12,15),(13,17),(14,15),(15,17),(14,19),(16,18),(17,16),(19,17),(18,19),(17,17),(15,16),(14,14),(16,15),(17,13),(15,12),(16,14),(18,15)]] 
0:00.00, 5332 
 
[josejuan@centella centella]$ n=111; time -f "%E, %M" ../caballo $n 0 0 $(($n**2)) 1 > /dev/null; echo "$(($n**2)) saltos" 
0:00.38, 75724 
12321 saltos 
 
 
-} 
5 comentarios
0votos

Escrito por AverageUser hace 11 meses

Que buena solución, la mía se queda muuuuuuuuuuuuuy por detrás.
0votos

Escrito por josejuan hace 11 meses

Recuerda @Average-user que se la debemos a Warnsdorf, hay muchos Warnsdorf de los que aprender :D
0votos

Escrito por AverageUser hace 11 meses

Cierto, tambien se lo debemos a Euler y Hamilton, ya que estos empezaron a cuestionarse estos problemas.
0votos

Escrito por Kenshin Urashima hace 11 meses

Malvada programacion funcional, nos opaca a lo pobres mortales.
1votos

Escrito por AverageUser hace 11 meses

Al final, es cosa de cambiar el "switch", puede costar al comienzo, pero se logra.

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.