0votos

Laberinto numérico en Haskell

por josejuan hace 2 años

Si se ignoran completamente las propiedades numéricas del problema (lo cual puede ser mucho ignorar) el problema es completamente isomorfo a una búsqueda del camino más corto entre dos nodos en un grafo y bastaría usar cualquier algoritmo genérico. Aquí no obstante se implementa usando un heap. Se pone otro ejemplo que resuelve el mismo tipo de problemas pero con cadenas de caracteres.

Búsqueda de la longitud del camino más corto en un laberinto numérico.

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
{-# LANGUAGE ScopedTypeVariables #-} 
import qualified Data.Heap as Heap 
import qualified Data.Set as Set 
import Control.Monad.Trans.State 
import Data.Function 
import Control.Monad 
 
 
 
-- Sólo por eficiencia, definimos un tipo de lista cuya relación de orden es su longitud 
data Path a = Path { unPath :: [a], pathSize :: !Int } deriving (Show) 
 
path :: [a] → Path a 
path xs = Path xs (length xs) 
 
instance Eq  (Path a) where (≡)     = (≡)     `on` pathSize 
instance Ord (Path a) where compare = compare `on` pathSize 
 
 
 
 
-- Dado un nodo inicial y la lista generadora de nodos adyacentes, obtiene 
-- el camino mínimo al nodo final, la función "expandidora" debería generalizarse 
operacionesOptimas :: ∀ a ∘ Ord a ⇒ [(𝐒, a → a)] → a → a → [(𝐒, a)] 
operacionesOptimas operaciones inicial final = reverse $ evalState solve (heap0, set0) 
  where solve = do 
                  Path xs@((_,n):_) _ ← state $ λ(h, s) → let 𝐽 (xs, h') = Heap.view h in (xs, (h', s)) 
                  if n ≡ final 
                    then η xs 
                    else do 
                            ↰_operaciones $ λ(name, f) → do 
                              let n' = f n 
                              s ← snd ↥ get 
                              when (n' `Set.notMember` s) $ modify $ λ(h, s) →  
                                (Heap.insert (path ((name, n'):xs)) h, Set.insert n' s) 
                            solve 
        heap0 = Heap.singleton (path [("Inicial", inicial)]) :: Heap.MinHeap (Path (𝐒, a)) 
        set0  = Set.singleton inicial 
 
 
 
 
-- Por ejemplo 
caminoMinimo :: ℤ → ℤ → [(𝐒, ℤ)] 
caminoMinimo a = operacionesOptimas [("* 2", (× 2)) 
                                    ,("/ 2", λx → case x `divMod` 2 of { (r, 0) → r; _ → a }) 
                                    ,("+ 2", (+ 2))] a 
 
longitudCaminoMinimo = length ∘ caminoMinimo 
 
-- Con cadenas de caracteres 
caminoMinimo' :: 𝐒 → 𝐒 → [(𝐒, 𝐒)] 
caminoMinimo' a = operacionesOptimas ( [("quitar "  ⧺ [c], filter (≢c)) | c ← "ABC"] 
                                     ⧺ [("delante " ⧺ [c], (c:))        | c ← "ABC"] 
                                     ⧺ [("detras"   ⧺ [c], (⧺[c]))      | c ← "ABC"]) a 
1 comentario
0votos

Escrito por josejuan hace 2 años

Ejemplo de salida:
> mapM_ print $ caminoMinimo 2 9
("Inicial",2)
("/ 2",1)
("+ 2",3)
("+ 2",5)
("+ 2",7)
("+ 2",9)
> mapM_ print $ caminoMinimo' "CCBBCC" "BBACA"
("Inicial","CCBBCC")
("detrasA","CCBBCCA")
("quitar C","BBA")
("detrasC","BBAC")
("detrasA","BBACA")
> 

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.