你如何在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的答案解释了为什么你现在的方法不起作用.

在功能语言中实现此功能的一种常见方法是使用 拉链 (不要与其zip相关或相关功能).

该想法是拉链是聚焦于特定部分(例如,网格中的单元)的数据结构的表示.您可以将变换应用于拉链以"移动"此焦点,并且您可以应用不同的变换来查询或"改变"相对于焦点的数据结构.这两种类型的转换都是纯粹的功能 - 它们作用于不可变的拉链,只是创建一个新的副本.

在这里,您可以从带有位置信息的无限列表的拉链开始:

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]

这是为了表示聚焦于值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]
>

现在,a Grid可以表示为行的拉链,每行都有一个值的拉链:

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

Answer 2

关键的见解是：当您进行修改时set val True，您并不是在原地进行修改，而是创建了一个副本。

makeGrid构建一个网格，其中一切都存在False，包括_left $ _right center。当您set val True在 上时center，您正在创建一个副本center'where val center' == True。然而，这个副本仍然指向相同的_right，而后者又仍然指向相同的_left，换句话说：

_right center' == _right center

因此：

_left $ _right center' == _left $ _right center == center

以便：

_val . _left $ _right center' == _val . _left $ _right center == False