1votos

Laberinto en Haskell

por AverageUser hace 9 meses

Resuelve laberintos en Haskell, no de la manera mas óptima en términos de pasos ni tampoco en tiempo de ejecución pero es bastante rápido, eso si, como no soy demasiado letrado en Haskell, el código puede ser bastante feo.

Crear un programa que pueda devolver una solución óptima a cualquier laberinto.

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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
module Main where 
import Data.List.Split 
import Data.List 
import System.IO 
 
main  = do 
  putStrLn "Ingrese archivo de laberinto: " 
  input <- getLine 
  file <- openFile input ReadMode 
  infile <- hGetContents file 
  let maze = (readMaze (init infile)) 
   in do 
       printMaze maze 
       printMaze $ clean (explore maze) 'X' 
 
indexOf :: (Num t, Eq a) => a -> [a] -> [t] 
indexOf x xs = procesa x xs 0 
   where procesa _ [] _ = [] 
         procesa e (x:xs) n |e == x    = n : procesa e xs (n+1) 
                            |otherwise = procesa e xs (n+1) 
 
replaceNth :: (Num a, Eq a) => a -> a1 -> [a1] -> [a1] 
replaceNth n newVal (x:xs) 
    | n == 0 = newVal:xs 
    | otherwise = x:replaceNth (n-1) newVal xs 
 
readMaze :: [Char] -> [[Char]] 
readMaze infile = splitOn "\n" infile 
 
printMaze :: [[Char]] -> IO () 
printMaze [] = putStrLn " " 
printMaze (x:xs) = do 
  putStrLn $ intercalate " " [[y] |y <- x] 
  printMaze xs 
 
coorMaze :: [[Char]] -> [Int] -> Char 
coorMaze maze [x,y] |x > (length $ head maze)-1 || y > (length maze)-1 = 'n' 
                    |x < 0 || y < 0                                    = 'n' 
                    |otherwise = (maze !! y) !! x 
 
replaceCoor :: [[Char]] -> [Int] -> Char -> [[Char]] 
replaceCoor maze [x, y] signo = replaceNth y (replaceNth x signo (maze !! y)) maze 
 
findEntry :: [[Char]] -> [Int] 
findEntry maze = procesa maze (concat walls) 
   where walls = [map (\x -> [0, x]) [0..(length maze)-1], 
                  map (\x -> [(length (head maze))-1, x]) [0..(length maze)-1], 
                  map (\x -> [x, 0]) [0..(length (head maze))-1], 
                  map (\x -> [x,(length maze)-1]) [0..(length (head maze))-1] 
         procesa maze (x:xs) |'E' == (coorMaze maze x) = x 
                             |otherwise                = procesa maze xs 
 
options :: [[Char]] -> [Int] -> [Char] 
options maze [x, y] = [coorMaze maze [x, y-1], 
                       coorMaze maze [x, y+1], 
                       coorMaze maze [x-1, y], 
                       coorMaze maze [x+1, y]] 
 
clean :: [[Char]] -> Char -> [[Char]] 
clean maze signo = map (\x -> [if z == signo then ' ' else z |z <- x]) maze 
 
nextCoor :: [Int] -> [Char] -> [Int] 
nextCoor [x, y] op = let place = head $ indexOf ' ' op 
                      in case place of 
                         0 -> [x, y-1] 
                         1 -> [x, y+1] 
                         2 -> [x-1, y] 
                         _ -> [x+1, y] 
 
findStart :: [[Char]] -> [Int] 
findStart maze = nextCoor entry (options maze entry) 
   where entry = findEntry maze 
 
move :: [[Char]] -> [[Int]] -> ([[Char]], [[Int]]) 
move maze coorli |free == [] = (replaceCoor maze (head coorli) 'X', 
                                tail coorli) 
                 |otherwise  = (replaceCoor maze (head coorli) '.', 
                                (nextCoor (head coorli) op) : coorli) 
          where op   = options maze (head coorli) 
                free = [z |z <- op, z == ' '] 
 
exit :: [[Char]] -> [[Int]] -> Bool 
exit maze coorli = 0 /= length [x |x <- op, x == 'O'] 
   where op = options maze $ head coorli 
 
explore :: [[Char]] -> [[Char]] 
explore maze = pro maze [findStart maze] 
  where pro maze coorli |exit maze coorli = replaceCoor maze (head coorli) '.' 
                        |otherwise        = let m = move maze coorli 
                                              in pro (fst m) (snd m) 
 
{- 
los archivos de laberinto deben estar en la misma carpeta del programa: 
es importante que el archivo este limpio, es decir que no contenga ningun 
caracter extra a parte del laberinto. 
 
si no les resulta cargar el archivo hagan una lista de strings tipo: 
["###E##", 
 "#   ##", 
 "#O####"] 
 
paredes = '#' 
caminos = ' ' 
Entrada = 'E' 
Salida  = 'O' (una O no un cero) 
 
# # # E # # # # 
# # #   # # # # 
#         # # # 
# # # #   # # # 
# # # #       # 
# #       #   # 
# #   # # #   # 
# # O # # # # # 
 
... 
 
# # # E # # # # 
# # # . # # # # 
#     . . # # # 
# # # # . # # # 
# # # # .     # 
# # . . . #   # 
# # . # # #   # 
# # O # # # # # 
------------------------------------------------ 
# E # # # # # # # # # # # # # # # # # # # # # # # 
#                                               # 
#   # # # # # # # # # # # # # # # # # # # # #   # 
#                                           #   # 
# # # # # # # # # # # # # # # # # # # # #   #   # 
#                                           #   # 
#   # # # # # # # # # # # # # # # # # # # # # # # 
#   # #                     # # # #             # 
#   # #   # # #   # # # #     # # #   # # # #   # 
#   # #   # # #           #     # #     # # #   # 
#   # #   # # # # # # #   # #     # #   # # #   # 
#   # #   # # # # # # #   # # #         # # #   # 
#         # #       # #   # # # # # # # # # #   # 
# # # # # # #   #   # #           #             # 
#   #       #   #   # # # # # #   # # # # #   # # 
#   #   #   #   #                               # 
#   #   #   #   # # # # # # # # # # # # # #   # # 
#   #   #   #   #                             # # 
#   #   #   #   #   # # # # # # # # # # # # # # # 
#       #       #                 #           # # 
# #   # # # #   # # # # # # # #   #   # # #   # # 
# #   # # # #   # # # # # # # # # #   # # #   # # 
# #       # #                   # #   # # #   # # 
# # # #     # # # # # # # # #         # # #   # # 
# # # # # # # # # # # # # # # # # # # # # # O # # 
 
 
... 
 
# E # # # # # # # # # # # # # # # # # # # # # # # 
# .                                             # 
# . # # # # # # # # # # # # # # # # # # # # #   # 
# . . . . . . . . . . . . . . . . . . . . . #   # 
# # # # # # # # # # # # # # # # # # # # # . #   # 
# . . . . . . . . . . . . . . . . . . . . . #   # 
# . # # # # # # # # # # # # # # # # # # # # # # # 
# . # # . . . . .           # # # #             # 
# . # # . # # # . # # # #     # # #   # # # #   # 
# . # # . # # # . . . . . #     # #     # # #   # 
# . # # . # # # # # # # . # #     # #   # # #   # 
# . # # . # # # # # # # . # # #         # # #   # 
# . . . . # # . . . # # . # # # # # # # # # #   # 
# # # # # # # . # . # # . . . . . #             # 
#   #       # . # . # # # # # # . # # # # #   # # 
#   #   #   # . # . . . . . . . .               # 
#   #   #   # . # # # # # # # # # # # # # #   # # 
#   #   #   # . #                             # # 
#   #   #   # . #   # # # # # # # # # # # # # # # 
#       #     . #                 # . . . . . # # 
# #   # # # # . # # # # # # # #   # . # # # . # # 
# #   # # # # . # # # # # # # # # # . # # # . # # 
# #       # # . . . . . . . . . # # . # # # . # # 
# # # #     # # # # # # # # # . . . . # # # . # # 
# # # # # # # # # # # # # # # # # # # # # # O # # 
 
-} 
2 comentarios
0votos

Escrito por AverageUser hace 9 meses

Aquí una versión un poco (solo un poco) mas ordenada y con explicaciones.

{{
module Main where
import Data.List.Split
import Data.List
import System.IO

main = do
putStrLn "Ingrese archivo de laberinto: "
input <- getLine
file <- openFile ("mazes/"++input) ReadMode
infile <- hGetContents file
let maze = readMaze infile
in do
printMaze maze
printMaze $ clean (explore maze) 'X'


-- Devuelve el(los) lugar(es) donde un elemento esta en una lista.
indexOf :: (Num t, Eq a) => a -> [a] -> [t]
indexOf x xs = procesa x xs 0
where procesa [] = []
procesa e (x:xs) n |e == x = n : procesa e xs (n+1)
|otherwise = procesa e xs (n+1)

-- reemplaza un elemento de la posición n por newVal en la lista xs
replaceNth :: (Num a, Eq a) => a -> a1 -> [a1] -> [a1]
replaceNth n newVal (x:xs)
|n == 0 = newVal:xs
|otherwise = x:replaceNth (n-1) newVal xs

-- lee un archivo con el laberinto paredes = '#', entrada = 'E', salida = 'O'
readMaze :: [Char] -> [[Char]]
readMaze infile = splitOn "\n" $ init infile

-- Imprime el laberinto de una forma visualmente agradable.
printMaze :: [[Char]] -> IO ()
printMaze [] = putStrLn " "
printMaze (x:xs) = do
putStrLn $ intercalate " " [[y] |y <- x]
printMaze xs

-- Recibe un laberinto y una coordenada [x,y] y devuelve el símbolo que hay en
-- esa posición del laberinto, devuelve 'n' si la coordenada es mas grande o
-- mas pequeña que los bordes del laberinto.
coorMaze :: [[Char]] -> [Int] -> Char
coorMaze maze [x,y] |x > (length $ head maze)-1 || y > (length maze)-1 = 'n'
|x < 0 || y < 0 = 'n'
|otherwise = (maze !! y) !! x

-- Recibe un laberinto una coordenada [x,y] y un símbolo (Char) y devuelve el
-- laberinto con el signo ingresado en la posición indicada.
replaceCoor :: [[Char]] -> [Int] -> Char -> [[Char]]
replaceCoor maze [x, y] symbol = replaceNth y newY maze
where newY = replaceNth x symbol $ maze !! y

-- Filtra las coordenadas correspondientes a las paredes o bordes del laberinto,
-- luego revisa si en alguna de ellas esta el signo 'E' que indica la entrada.
findEntry :: [[Char]] -> [Int]
findEntry maze = procesa maze (concat walls)
where walls = [map (\x -> [0, x]) [0..(length maze)-1],
map (\x -> [(length (head maze))-1, x]) [0..(length maze)-1],
map (\x -> [x, 0]) [0..(length (head maze))-1],
map (\x -> [x,(length maze)-1]) [0..(length (head maze))-1]
]
procesa maze (x:xs) |'E' == (coorMaze maze x) = x
|otherwise = procesa maze xs

-- Dado un laberinto y una coordenada, devuelve una lista con los signos que
-- hay a su alrededor (las opciones de movimiento.)
options :: [[Char]] -> [Int] -> [Char]
options maze [x, y] = [coorMaze maze [x, y-1], -- top wall
coorMaze maze [x, y+1], -- bot wall
coorMaze maze [x-1, y], -- left wall
coorMaze maze [x+1, y]] -- right wall

-- Dado un laberinto, reemplaza por espacios ' ' todos los lugares donde se
-- encuentre un símbolo dado (symbol)
clean :: [[Char]] -> Char -> [[Char]]
clean maze symbol = map (\x -> [if z == symbol then ' ' else z |z <- x]) maze

-- Dada una coordenada y las opciones de esta en un laberinto, devuelve la
-- siguiente coordenada donde podría avanzar.
nextCoor :: [Int] -> [Char] -> [Int]
nextCoor [x, y] op = let place = head $ indexOf ' ' op
in case place of
0 -> [x, y-1]
1 -> [x, y+1]
2 -> [x-1, y]
_ -> [x+1, y]

-- Encuentra la coordenada de partida (primera coordenada vacía frente de una entrada)
findStart :: [[Char]] -> [Int]
findStart maze = nextCoor entry (options maze
0votos

Escrito por AverageUser hace 9 meses

no me funciono poner la solución como código...

https://github.com/Average-user/Maze-Solving

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.