haskell - 如何在 Haskell 中构建无限网格状数据结构？

Question

我试图通过打结来形成一个无限网格状的数据结构。

这是我的方法:

import Control.Lens

data Grid a = Grid {_val :: a,
                    _left :: Grid a,
                    _right :: Grid a,
                    _down :: Grid a,
                    _up :: Grid a}

makeLenses ''Grid

makeGrid :: Grid Bool -- a grid with all Falses
makeGrid = formGrid Nothing Nothing Nothing Nothing

formGrid :: Maybe (Grid Bool) -> Maybe (Grid Bool) -> Maybe (Grid Bool) -> Maybe (Grid Bool) -> Grid Bool
formGrid ls rs ds us = center
  where
    center = Grid False leftCell rightCell downCell upCell
    leftCell = case ls of
                Nothing -> formGrid Nothing (Just center) Nothing Nothing
                Just l ->  l
    rightCell = case rs of
                Nothing -> formGrid (Just center) Nothing Nothing Nothing
                Just r ->  r
    upCell = case us of
                Nothing -> formGrid Nothing Nothing (Just center) Nothing
                Just u ->  u
    downCell = case ds of
                Nothing -> formGrid Nothing Nothing Nothing (Just center)
                Just d ->  d

由于某种原因，这不起作用。正如这里所见:

*Main> let testGrid = (set val True) . (set (right . val) True) $ makeGrid
*Main> _val $ _right $ _left testGrid
False
*Main> _val $ _left $ _right testGrid
False
*Main> _val $ testGrid
True

我哪里出错了？

Answer 1

@Fyodor 的回答解释了为什么您当前的方法行不通。

在函数式语言中实现这一点的一种常见方法是使用 zippers(不要与 zip 或相关函数混淆)。

这个想法是 zipper 是数据结构的表示专注于特定部分(例如，网格中的单元格)。你可以对 zipper 应用变换以“移动”此焦点，并且您可以应用不同的转换来查询或“改变”数据结构相对于焦点。这两种类型的转换都是纯粹的功能性——它们作用于一个不可变的 zipper ，并且只是创建一个新副本。

在这里，您可以从一个带有位置的无限列表的 zipper 开始信息:

data Zipper a = Zipper [a] a Int [a] deriving (Functor)
  -- Zipper ls x n rs represents the doubly-infinite list (reverse ls ++
  -- [x] ++ rs) viewed at offset n
instance (Show a) => Show (Zipper a) where
  show (Zipper ls x n rs) =
    show (reverse (take 3 ls)) ++ " " ++ show (x,n) ++ " " ++ show (take 3 rs)

这个Zipper旨在表示双重无限列表(即在两个方向上都是无限的列表)。一个例子将是:

> Zipper [-10,-20..] 0 0 [10,20..]
[-30,-20,-10] (0,0) [10,20,30]

这旨在表示所有列表(正面和负面)10 的整数倍集中在值 0、位置 0，它实际上使用两个 Haskell 无限列表，每个方向一个。

你可以定义将焦点向前或向后移动的函数:

back, forth :: Zipper a -> Zipper a
back (Zipper (l:ls) x n rs)  = Zipper ls l (n-1) (x:rs)
forth (Zipper ls x n (r:rs)) = Zipper (x:ls) r (n+1) rs

这样:

> forth $ Zipper [-10,-20..] 0 0 [10,20..]
[-20,-10,0] (10,1) [20,30,40]
> back $ back $ Zipper [-10,-20..] 0 0 [10,20..]
[-50,-40,-30] (-20,-2) [-10,0,10]
>

现在，Grid 可以表示为行的 zipper ，每行一个值的 zipper :

newtype Grid a = Grid (Zipper (Zipper a)) deriving (Functor)
instance Show a => Show (Grid a) where
  show (Grid (Zipper ls x n rs)) =
    unlines $ zipWith (\a b -> a ++ " " ++ b)
              (map show [n-3..n+3])
              (map show (reverse (take 3 ls) ++ [x] ++ (take 3 rs)))

连同一组焦点移动功能:

up, down, right, left :: Grid a -> Grid a
up (Grid g) = Grid (back g)
down (Grid g) = Grid (forth g)
left (Grid g) = Grid (fmap back g)
right (Grid g) = Grid (fmap forth g)

您可以为焦点元素定义 getter 和 setter:

set :: a -> Grid a -> Grid a
set y (Grid (Zipper ls row n rs)) = (Grid (Zipper ls (set' row) n rs))
  where set' (Zipper ls' x m rs') = Zipper ls' y m rs'

get :: Grid a -> a
get (Grid (Zipper _ (Zipper _ x _ _) _ _)) = x

添加一个将焦点向后移动的功能可能会很方便到原点以用于显示目的:

recenter :: Grid a -> Grid a
recenter g@(Grid (Zipper _ (Zipper _ _ m _) n _))
  | n > 0 = recenter (up g)
  | n < 0 = recenter (down g)
  | m > 0 = recenter (left g)
  | m < 0 = recenter (right g)
  | otherwise = g

最后，使用一个创建全False网格的函数:

falseGrid :: Grid Bool
falseGrid =
  let falseRow = Zipper falses False 0 falses
      falses = repeat False
      falseRows = repeat falseRow
  in  Grid (Zipper falseRows falseRow 0 falseRows)

你可以做这样的事情:

> let (&) = flip ($)
> let testGrid = falseGrid & set True & right & set True & recenter
> testGrid
-3 [False,False,False] (False,0) [False,False,False]
-2 [False,False,False] (False,0) [False,False,False]
-1 [False,False,False] (False,0) [False,False,False]
0 [False,False,False] (True,0) [True,False,False]
1 [False,False,False] (False,0) [False,False,False]
2 [False,False,False] (False,0) [False,False,False]
3 [False,False,False] (False,0) [False,False,False]

> testGrid & right & left & get
True
> testGrid & left & right & get
True
> testGrid & get
True
>

完整示例:

{-# LANGUAGE DeriveFunctor #-}

module Grid where

data Zipper a = Zipper [a] a Int [a] deriving (Functor)
  -- Zipper ls x n rs represents the doubly-infinite list (reverse ls ++
  -- [x] ++ rs) viewed at offset n
instance (Show a) => Show (Zipper a) where
  show (Zipper ls x n rs) =
    show (reverse (take 3 ls)) ++ " " ++ show (x,n) ++ " " ++ show (take 3 rs)

back, forth :: Zipper a -> Zipper a
back (Zipper (l:ls) x n rs)  = Zipper ls l (n-1) (x:rs)
forth (Zipper ls x n (r:rs)) = Zipper (x:ls) r (n+1) rs

newtype Grid a = Grid (Zipper (Zipper a)) deriving (Functor)
instance Show a => Show (Grid a) where
  show (Grid (Zipper ls x n rs)) =
    unlines $ zipWith (\a b -> a ++ " " ++ b)
              (map show [n-3..n+3])
              (map show (reverse (take 3 ls) ++ [x] ++ (take 3 rs)))

up, down, right, left :: Grid a -> Grid a
up (Grid g) = Grid (back g)
down (Grid g) = Grid (forth g)
left (Grid g) = Grid (fmap back g)
right (Grid g) = Grid (fmap forth g)

set :: a -> Grid a -> Grid a
set y (Grid (Zipper ls row n rs)) = (Grid (Zipper ls (set' row) n rs))
  where set' (Zipper ls' x m rs') = Zipper ls' y m rs'

get :: Grid a -> a
get (Grid (Zipper _ (Zipper _ x _ _) _ _)) = x

recenter :: Grid a -> Grid a
recenter g@(Grid (Zipper _ (Zipper _ _ m _) n _))
  | n > 0 = recenter (up g)
  | n < 0 = recenter (down g)
  | m > 0 = recenter (left g)
  | m < 0 = recenter (right g)
  | otherwise = g

falseGrid :: Grid Bool
falseGrid =
  let falseRow = Zipper falses False 0 falses
      falses = repeat False
      falseRows = repeat falseRow
  in  Grid (Zipper falseRows falseRow 0 falseRows)

(&) = flip ($)

testGrid :: Grid Bool
testGrid = falseGrid & set True & right & set True & recenter

main = do
  print $ testGrid & get
  print $ testGrid & left & get
  print $ testGrid & left & right & get
  print $ testGrid & right & left & get