Question

Given a matrix m,a starting position p1 and a final point p2.
The objective is to compute how many ways there are to reach the final matrix (p2=1 and others=0). For this, every time you skip into a position you decrements by one.
you can only skip from one position to another by at most two positions, horizontal or vertical. For example:

   m =             p1=(3,1)  p2=(2,3)
   [0 0 0]
   [1 0 4]
   [2 0 4]

You can skip to the positions [(3,3),(2,1)]

When you skip from one position you decrement it by one and does it all again. Let’s skip to the first element of the list. Like this:

    m=              
    [0 0 0]
    [1 0 4]
    [1 0 4]

Now you are in position (3,3) and you can skip to the positions [(3,1),(2,3)]

And doing it until the final matrix:

[0 0 0]
[0 0 0]
[1 0 0]

In this case the amount of different ways to get the final matrix is 20.
I’ve created the functions below:

import Data.List
type Pos = (Int,Int)
type Matrix = [[Int]]    

moviments::Pos->[Pos]
moviments (i,j)= [(i+1,j),(i+2,j),(i-1,j),(i-2,j),(i,j+1),(i,j+2),(i,j-1),(i,j-2)]

decrementsPosition:: Pos->Matrix->Matrix
decrementsPosition(1,c) (m:ms) = (decrements c m):ms
decrementsPosition(l,c) (m:ms) = m:(decrementsPosition (l-1,c) ms)

decrements:: Int->[Int]->[Int]
decrements 1 (m:ms) = (m-1):ms
decrements n (m:ms) = m:(decrements (n-1) ms)

size:: Matrix->Pos
size m = (length m,length.head $ m)

finalMatrix::Pos->Pos->Matrix
finalMatrix (m,n) p = [[if (l,c)==p then 1 else 0 | c<-[1..n]]| l<-[1..m]]

possibleMov:: Pos->Matrix->[Pos]
possibleMov p mat = checks0 ([(a,b)|a<-(dim m),b<-(dim n)]  `intersect` xs) mat
                          where xs = movements p
                               (m,n) = size mat

dim:: Int->[Int]
dim 1 = [1]
dim n = n:dim (n-1)

checks0::[Pos]->Matrix->[Pos]
checks0 [] m =[]
checks0 (p:ps) m = if ((takeValue m p) == 0) then checks0 ps m
                                               else p:checks0 ps m

takeValue:: Matrix->Pos->Int
takeValue x (i,j)= (x!!(i-1))!!(j-1)

Any idea how do I create a function ways?

 ways:: Pos->Pos->Matrix->Int  

Answer 1

Explore the possible paths in parallel. From the starting position, make all possible moves. Each of the resulting configurations can be reached in exactly one way. Then, from each of the resulting configurations, make all possible moves. Add the counts of the new configurations that can be reached from several of the previous configurations. Repeat that step until there is only one nonzero element in the grid. Cull impossible paths early.

For the bookkeeping which configuration can be reached in how many ways from the initial configuration, the easiest way is to use a Map. I chose to represent the grid as an (unboxed) array, since

• they are easier to handle for indexing and updating than lists of lists
• they use less space and indexing is faster

The code:

module Ways where

import qualified Data.Map.Strict as M
import Data.Array.Unboxed
import Data.List
import Data.Maybe

type Grid = UArray (Int,Int) Int
type Position = (Int,Int)
type Configuration = (Position, Grid)
type State = M.Map Configuration Integer

buildGrid :: [[Int]] -> Grid
buildGrid xss
    | null xss || maxcol == 0   = error "Cannot create empty grid"
    | otherwise = listArray ((1,1),(rows,maxcol)) $ pad cols xss
      where
        rows = length xss
        cols = map length xss
        maxcol = maximum cols
        pad (c:cs) (r:rs) = r ++ replicate (maxcol - c) 0 ++ pad cs rs
        pad _ _ = []

targets :: Position -> [Position]
targets (i,j) = [(i+d,j) | d <- [-2 .. 2], d /= 0] ++ [(i,j+d) | d <- [-2 .. 2], d /= 0]

moves :: Configuration -> [Configuration]
moves (p,g) = [(p', g') | p' <- targets p
                        , inRange (bounds g) p'
                        , g!p' > 0, let g' = g // [(p, g!p-1)]]

moveCount :: (Configuration, Integer) -> [(Configuration, Integer)]
moveCount (c,k) = [(c',k) | c' <- moves c]

step :: (Grid -> Bool) -> State -> State
step okay mp = foldl' ins M.empty . filter (okay . snd . fst) $ M.assocs mp >>= moveCount
  where
    ins m (c,k) = M.insertWith (+) c k m

iter :: Int -> (a -> a) -> a -> a
iter 0 _ x = x
iter k f x = let y = f x in y `seq` iter (k-1) f y

ways :: Position -> Position -> [[Int]] -> Integer
ways start end grid
    | any (< 0) (concat grid)   = 0
    | invalid   = 0
    | otherwise = fromMaybe 0 $ M.lookup target finish
      where
        ini = buildGrid grid
        bds = bounds ini
        target = (end, array bds [(p, if p == end then 1 else 0) | p <- range bds])
        invalid = not (inRange bds start && inRange bds end && ini!start > 0 && ini!end > 0)
        okay g = g!end > 0
        rounds = sum (concat grid) - 1
        finish = iter rounds (step okay) (M.singleton (start,ini) 1)