1votos

juego del caballo en ajedrez en Haskell

por josejuan hace 5 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 5 meses

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

Escrito por josejuan hace 5 meses

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

Escrito por AverageUser hace 5 meses

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

Escrito por Kenshin Urashima hace 5 meses

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

Escrito por AverageUser hace 5 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.