0votos

SENO sin lazos en Haskell

por josejuan hace 6 años

El problema pide MANTENER LA RUTA, pero quitando los lazos que puedan producirse. Si estamos en un laberinto, quizás para salir hayamos dado algunas vueltas de más. El algoritmo debe quitar los lazos ¡pero mantener la ruta!. Mi solución es concisa, pero en real usaría Dijkstra para minimizar la ruta.

Eliminar los lazos en una ruta.

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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
-- Dada la lista ordenada de coordenadas por las que se pasa, "paths" 
-- obtiene TODAS las formas de llegar de la primera celda a la última: 
paths :: [(Int, Int)] -> [[(Int, Int)]] 
paths [] = [] 
paths q = q : concatMap (paths.j) d 
  where i = (filter ((>1).length) . ap (map.flip elemIndices) nub) q 
        d = concatMap (\z -> [(a, b) | a <- z, b <- z, a < b]) i 
        j (a, b) = (liftM2(++)head(head.tail.tail)) (splitPlaces [a, b - a, l] q) 
        l = length q 
 
-- NOTA: coste exponencial (al nº de lazos), mucho mejor usar Dijkstra, claro... :P 
 
 
-- Por tanto, el camino más corto (sin lazos) es: 
shortest :: [(Int, Int)] -> [(Int, Int)] 
shortest = head.sortBy((.length).compare.length).paths 
 
 
 
-- Dada una entrada como la del enunciado "SEENNEE..." convierte a coordenadas 
compass = [(0, -1), (0, 1), (-1, 0), (1, 0)] 
nseo = "NSEO" 
 
walk c [] = [c] 
walk s@(x, y) (p:ps) = s: walk (x + u, y + v) ps 
  where (u, v) = compass!!(fromJust$elemIndex p nseo) 
 
 
 
-- La inversa de "walk" 
unwalk [] = [] 
unwalk (_:[]) = [] 
unwalk ((x, y):ps@((u, v):_)) = nseo!!(fromJust$elemIndex (u - x, v - y) compass) : unwalk ps 
 
 
-- Y un alias para obtener el más corto podría ser: 
shortCut = unwalk.shortest.walk (0, 0) 
 
 
-- Dos helpers para imprimir rutas podrían ser: 
draw :: String -> String 
draw = drawPath.walk (0, 0) 
 
drawPath :: [(Int, Int)] -> String 
drawPath p = unlines [[if (x, y) `elem` p then '*' else '·' | x <- [wi..wf]] | y <- [hi..hf]] 
  where wi = minimum xc 
        wf = maximum xc 
        hi = minimum yc 
        hf = maximum yc 
        xc = map fst p 
        yc = map snd p 
 
{-- 
 
*Main> sample 
"OONNNNEESSOOOO" 
 
*Main> putStrLn $ draw sample 
***·· 
*·*·· 
***** 
··*·· 
***·· 
 
*Main> putStrLn $ draw $ shortCut sample 
··*** 
··*·· 
***·· 
 
*Main> sample2 
"OONNNNEESSOOOOSSSSEEEEENNNNNOOOOOO" 
 
*Main> putStrLn $ draw sample2 
·***··· 
******* 
******· 
*··*·*· 
****·*· 
*····*· 
******· 
 
*Main> putStrLn $ draw $ shortCut sample2 
··**** 
··*··· 
··*··· 
***··· 
 
*Main> _ 
 
 
Código completo en: 
         https://gist.github.com/3930758 
--} 

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.