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)