5

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

这是我的方法：

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

我哪里错了？

4

2 回答 2

7

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

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

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

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

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]

这旨在表示集中在 value 0、 position的所有（正和负）整数倍数的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]
>

现在，aGrid可以表示为行的拉链，每行一个值的拉链：

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
于 2017-10-18T18:17:09.483 回答
3

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

makeGrid构造一个网格，一切都在其中False，包括_left $ _right center. 当您set val True在 上时center，您将center'在哪里创建一个副本val center' == True。但是，这个副本仍然指向 same _right，而后者又仍然指向 same _left，换句话说：

_right center' == _right center

因此：

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

以便：

_val . _left $ _right center' == _val . _left $ _right center == False
于 2017-10-18T16:00:42.733 回答