Question

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

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

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

的位置

当你从一个位置跳过时，你将它减去一个并再次完成。让我们跳到列表的第一个元素。像这样：

现在您处于(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)

Haskell - 操作列表

1 个答案: