Haskell 中的快速、无坐标 8 路邻居

问题描述 投票：0回答：2

我想计算矩形列表列表中每个元素的 8 路邻居

xss :: [[a]]
，保留原始元素并默认在边界上。特别是，我想编写一个函数 
neighbors :: a -> [[a]] -> [[NonEmpty a]]
，其中每个内部列表的长度为 
9
，头是原始元素。

这是我期望的输出：

ghci> mapM_ print [[1,2,3],[4,5,6],[7,8,9]]
[1,2,3]
[4,5,6]
[7,8,9]
ghci> mapM_ (mapM_ print) $ neighbors 0 [[1,2,3],[4,5,6],[7,8,9]]
[1,0,0,0,0,2,0,4,5]
[2,0,0,0,1,3,4,5,6]
[3,0,0,0,2,0,5,6,0]
[4,0,1,2,0,5,0,7,8]
[5,1,2,3,4,6,7,8,9]
[6,2,3,0,5,0,8,9,0]
[7,0,4,5,0,8,0,0,0]
[8,4,5,6,7,9,0,0,0]
[9,5,6,0,8,0,0,0,0]

我已经阅读了这个老问题的好答案，但它并不能完全满足这些要求，因为它生成对并破坏了原始矩阵的结构。

但是我希望可以写出类似简洁的东西。

我提出了两个非常糟糕的部分解决方案，一个执行大量旋转，另一个不是无坐标的：

-- | Add a ring of default elements around a 2d array.
augment :: a -> [[a]] -> [[a]]
augment d m = map (pad d) . pad (replicate ncols d) $ m
  where
    pad d' = reverse . (d' :) . reverse . (d' :)
    ncols = foldr (max . length) 0 m

-- | Neighbors in a 2d array, with default.
neighbors1 :: a -> [[a]] -> [[[a]]]
neighbors1 d m = map transpose $ transpose $ map ($ augment d m) [middle, upL, up, upR, left, right, downL, down, downR]
  where
    rot   = transpose . reverse
    right = map (drop 2) . both (drop 1)
    up    = rot . rot . rot . right . rot
    left  = rot . rot . right . rot . rot
    down  = rot . right . rot . rot . rot
    downR = map (drop 2) . drop 2
    upR   = rot . rot . rot . downR . rot
    upL   = rot . rot . downR . rot . rot
    downL = rot . downR . rot . rot . rot
    middle = map (both (drop 1)) . both (drop 1)
    both f = reverse . f . reverse . f

-- | Includes center element as head.
-- O(mn*log(mn))  Data.Map.Strict
-- O(mn)          Data.HashMap.Strict
neighbors :: a -> [[a]] -> [[[a]]]
neighbors d zss = unmaybe [[map (vals !?) (nbs x y) | y <- [0..n-1]] | x <- [0..m-1]]
  where
    unmaybe = (map . map . map) (fromMaybe d)
    (m, n) = (length zss, maybe 0 length $ listToMaybe zss)
    nbs x y = (x,y) : [(i,j) | i <- [x-1..x+1], j <- [y-1..y+1], (i,j) /= (x,y)]
    vals = M.fromAscList [((i,j),z) | (i,zs) <- zip [0..] zss, (j,z) <- zip [0..] zs]

另请注意，

augment
功能有点恶心。也许用
zipWith const
可以做得更优雅？但我不知道怎么做。我还尝试使用 
Maybe
而不是默认值，这也是可以接受的，但是一旦我有了 
[Maybe [Maybe a]]
形式的数组，我就无法弄清楚如何对其进行操作。

haskell matrix
2个回答
1
投票

通过一些“聪明”的簿记，我们可以扫描列表，从而迭代地构造邻居：

import Data.List.NonEmpty (NonEmpty ((:|)))

scanRow' :: [a] -> [NonEmpty a]
scanRow' (x1 : x2 : xs) = go x1 x2 xs
  where
    go l x [] = []
    go l x (r : rs) = (x :| [l, r]) : go x r rs
scanRow' [] = []

因此，如果我们评估 

scanRow' [0,1,2,3,0]
，我们会得到：

[1,0,2]
[2,1,3]
[3,2,0]

剩下要做的唯一一件事就是添加上方和下方行的元素，我们可以通过构造一个新版本的 

scanRow
来实现这一点，该版本采用顶行和底行的三个元素，并为两者前进一跳其中，例如：

scanRow :: [a] -> [a] -> [a] -> [NonEmpty a]
scanRow (x1 : x2 : xs) = go x1 x2 xs
  where
    go l x [] t b = []
    go l x (r : rs) t@(_ : ts) b@(_ : bs) = (x :| (take 3 t ++ l : r : take 3 b)) : go x r rs ts bs
scanRow _ = const (const [])

所以这给了我们

scanRow [0,4,5,6,0] [0,1,2,3,0] [0,7,8,9,0]
：

[4,0,1,2,0,5,0,7,8]
[5,1,2,3,4,6,7,8,9]
[6,2,3,0,5,0,8,9,0]

所以我们现在需要一个函数将每行的列表传递给 

scanRow
:

addDefault :: a -> [a] -> [a]
addDefault x xs = x : xs ++ [x]

neighbors d (r : rs) = go t0 (addDefault d r) (map (addDefault d) rs ++ [t0])
  where
    t0 = repeat d
    go t r (b : bs) = scanRow r t b ++ go r b bs
    go _ _ [] = []

对于 3×3 矩阵，我们可以得到：

ghci> neighbors 0 [[1,2,3],[4,5,6],[7,8,9]]
[
  1 :| [0,0,0,0,2,0,4,5],
  2 :| [0,0,0,1,3,4,5,6],
  3 :| [0,0,0,2,0,5,6,0],
  4 :| [0,1,2,0,5,0,7,8],
  5 :| [1,2,3,4,6,7,8,9],
  6 :| [2,3,0,5,0,8,9,0],
  7 :| [0,4,5,0,8,0,0,0],
  8 :| [4,5,6,7,9,0,0,0],
  9 :| [5,6,0,8,0,0,0,0]
]

因此，这将在矩阵中移动，但不必计算所有邻居列表，或者至少在不需要时不需要计算。例如，如果我们只对第五个元素感兴趣并打印该元素，则其他项目将不会得到充分评估。它也不需要同时内存中的所有行：该方法需要内存中的三行，其余的可以被垃圾收集，或者保持不评估。

0
投票

您可以通过压缩矩阵及其自身的移位副本来收集邻居。

为了看得更清楚，这是矩阵的类型。

type Matrix a = [[a]]

定义两个矩阵的压缩

matrixZipWith :: (a -> b -> c) -> Matrix a -> Matrix b -> Matrix c
matrixZipWith = zipWith . zipWith

输出 

Matrix c
的索引 (i,j) 处的元素是两个输入 
Matrix a
和 
Matrix b
的相同索引 (i,j) 处的元素的组合。

我们可以迭代

matrixZipWith
来获得N个矩阵的压缩。事实证明，压缩是转置的推广。

-- NonEmpty-Matrix transposition
transposeNEM :: NonEmpty (Matrix a) -> Matrix (NonEmpty a)
transposeNEM (x :| xs) = matrixZipWith (:|) x (transposeLM xs)

-- List-Matrix transposition
transposeLM :: [Matrix a] -> Matrix [a]
transposeLM (x : xs) = matrixZipWith (:) x (transposeLM xs)
transposeLM [] = repeat (repeat [])

在您的定义中，您将 8 个移位操作定义为 

right
和 
downR
移位的旋转。相反，直接根据行/列插入定义 
up
、
down
、
left
、
right
，并将它们组合以获得对角线位移。将所有移位放在一个列表中，将它们应用到输入矩阵，然后将其全部压缩（=转置）。

neighbors :: a -> [[a]] -> [[NonEmpty a]]
neighbors d m = transposeNE2 (fmap ($ m) (id :|
    [ up   . left, up  , up   . right
    ,        left,              right
    , down . left, down, down . right]))
  where
    down = (++ [repeat d]) . drop 1
    up = (repeat d :)
    right = map ((++ [d]) . drop 1)
    left = map (d :)

完整代码：

import Data.List.NonEmpty (NonEmpty(..))

type Matrix a = [[a]]

matrixZipWith :: (a -> b -> c) -> Matrix a -> Matrix b -> Matrix c
matrixZipWith = zipWith . zipWith

transposeNEM :: NonEmpty (Matrix a) -> Matrix (NonEmpty a)
transposeNEM (x :| xs) = matrixZipWith (:|) x (transposeLM xs)

transposeLM :: [Matrix a] -> Matrix [a]
transposeLM (x : xs) = matrixZipWith (:) x (transposeLM xs)
transposeLM [] = repeat (repeat [])

neighbors :: a -> [[a]] -> [[NonEmpty a]]
neighbors d m = transposeNE2 (fmap ($ m) (id :|
    [ up   . left, up  , up   . right
    ,        left,              right
    , down . left, down, down . right]))
  where
    down = (++ [repeat d]) . drop 1
    up = (repeat d :)
    right = map ((++ [d]) . drop 1)
    left = map (d :)

main :: IO ()
main = mapM_ (mapM_ print) $ neighbors 0 [[1,2,3],[4,5,6],[7,8,9]]
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.