如何在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

關鍵的洞察是：當你set val True，你沒有修改，但創建一個副本。

makeGrid構建一個網格，其中一切都是False，包括_left $ _right center。當你set val True在center上時，你正在創建一個副本center'，其中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 

Answer 2

@ Fyodor的回答解釋了爲什麼你現在的方法不行。在功能性的語言實現這個的

一種常見方式是使用 zippers （不要與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] 
> 

現在，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) 

可以定義爲聚焦元件的獲取和設置：

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