1votos

Número de caminos en una cuadrícula en Haskell

por josejuan hace 6 años

Una forma más elegante y usando como estrategia adicional el evitar caminos muertos (aquellos en que el camino se estrangula a sí mismo) es ésta, pero es menos eficiente porque (creo) hay más accesos al Array y como es funcional (inmutable) se pierde bastante tiempo; a la larga (para N grande) debería ser más eficiente. Algo mejor, será implementarlo imperativamente (aunque se complica la paralelización).

Dada una cuadrícula de NxN nodos, ¿cuantos caminos diferentes hay (sin pasar dos veces por el mismo nodos) al ir de una esquina a su opuesta diagonal?

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
{-# LANGUAGE BangPatterns #-} 
import Data.Array 
import System.Environment(getArgs) 
import Control.Parallel 
import Control.Parallel.Strategies 
import Data.Int 
 
type Pos = (Int8, Int8) 
data Dir = E | U | D | L | R | O deriving Eq 
 
go !g !p !e1 !e2 !e3 !p1 !p2 !p3 !f1 !f2 !f3 = 
  if g!p == O then 1                                 -- fin del trayecto 
  else 
    if g!p /= E then 0                               -- no hay salida 
    else 
      if d' == e1 
      then b `par` c `pseq` (b + c)                  -- recto y a un lado 
      else 
        if d' == e3 
        then a `par` b `pseq` (a + b)                -- recto y al otro lado 
        else a `par` b `par` c `pseq` (a + b + c)    -- por los tres sitios 
 
  where g' s = g//[(p, s)]                           -- marcamos en el nodo la dirección 
        a = f1 (g' e1) p1                            -- por un lado 
        b = f2 (g' e2) p2                            -- seguir recto 
        c = f3 (g' e3) p3                            -- por el otro lado 
        d' = g!p2                                    -- la siguiente de recto (para evitar nudos) 
 
goD !g !p@(x, y) = go g p R D L (x + 1, y) (x, y + 1) (x - 1, y) goR goD goL 
goU !g !p@(x, y) = go g p R U L (x + 1, y) (x, y - 1) (x - 1, y) goR goU goL 
goL !g !p@(x, y) = go g p U L D (x, y - 1) (x - 1, y) (x, y + 1) goU goL goD 
goR !g !p@(x, y) = go g p U R D (x, y - 1) (x + 1, y) (x, y + 1) goU goR goD 
 
count1Paths n = 2 * goD g (1, 2) 
  where n1 = n + 1 
        f x y = if (x == 1 && y == 1) || x == 0 || x == n1 then U else if y == 0 || y == n1 then L else if x == n && y == n then O else E 
        g = array ((0, 0), (n1, n1)) [((x, y), f x y) | x <- [0..n1], y <- [0..n1]] 
 
main = do 
  (n':_) <- getArgs 
  print $ count1Paths $ read n' 

Comenta la solución

Tienes que identificarte para poder publicar tu comentario.