Как вы строите бесконечную сетку, подобную структуре данных в 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

@ Ответ Федора объясняет, почему ваш нынешний подход не сработает.

Одним из распространенных способов достижения этого в функциональных языках является использование застежек-молний(не путать с 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

Answer 2

Ключевое понимание: когда вы 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