Haskell - 操纵列表

Question

给定矩阵m，起始位置p1和终点p2。 目标是计算有多少种方法可以达到最终矩阵（p2 = 1，其他= 0）。为此，每次跳到某个位置时，都会减1。 您最多只能在两个位置（水平或垂直）从一个位置跳到另一个位置。例如：

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

可以跳到位置[(3,3),(2,1)]

当您从一个位置跳到你减一，然后重新做这一切。我们跳到列表的第一个元素。就像这样：

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

现在你是在(3,3)位置，你可以跳到位置[(3,1),(2,3)]

而且做起来，直到最后的矩阵：

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

在这种情况下，不同的量获得最终矩阵的方法是20。 我创建了以下功能：

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) 

任何想法，我怎么创建一个函数的方法呢？

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

Answer 1

并行探索可能的路径。从起始位置开始，尽一切可能的举措。每种产生的配置都可以通过一种方式达到。然后，从每个产生的配置中，做出所有可能的动作。添加可以从几个以前的配置中获得的新配置的计数。重复该步骤，直到网格中只有一个非零元素。尽早修复不可能的路径。

对于从初始配置中可以达到多少种配置的簿记，最简单的方法是使用Map。我选择了代表网格作为（未装箱）阵列，由于

• 它们更容易处理用于索引和更新比列表的列表
• 他们使用更少的空间和索引更快

代码：

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)