{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
import Control.Comonad
import Data.Functor.Reverse
import Data.List (unfoldr)
Сначала какой-то контекст (ха-ха). У меня есть zipper по непустым спискам.
data LZipper a = LZipper (Reverse [] a) a [a]
deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable)
mkZipper :: a -> [a] -> LZipper a
mkZipper = LZipper (Reverse [])
Вы можете шагнуть в любом направлении вдоль застежки-молнии, но вы можете упасть с конца.
fwd, bwd :: LZipper a -> Maybe (LZipper a)
fwd (LZipper _ _ []) = Nothing
fwd (LZipper (Reverse xs) e (y:ys)) = Just $ LZipper (Reverse (e:xs)) y ys
bwd (LZipper (Reverse []) _ _) = Nothing
bwd (LZipper (Reverse (x:xs)) e ys) = Just $ LZipper (Reverse xs) x (e:ys)
Дублирование застежки-молнии показывает вам все способы, которыми вы могли бы смотреть на нее, с упором на то, как вы смотрите на нее в настоящее время.
instance Comonad LZipper where
extract (LZipper _ x _) = x
duplicate z = LZipper (Reverse $ unfoldr (step bwd) z) z (unfoldr (step fwd) z)
where step move = fmap (\y -> (y, y)) . move
Например:
ghci> duplicate (mkZipper 'a' "bc")
LZipper (Reverse [])
(LZipper (Reverse "") 'a' "bc")
[LZipper (Reverse "a") 'b' "c",LZipper (Reverse "ba") 'c' ""]
-- Abc -> *Abc* aBc abC
ghci> fmap duplicate (fwd $ mkZipper 'a' "bc")
Just (LZipper (Reverse [LZipper (Reverse "") 'a' "bc"])
(LZipper (Reverse "a") 'b' "c")
[LZipper (Reverse "ba") 'c' ""])
-- aBc -> Abc *aBc* abC
(Я использую капители и звездочки, чтобы указать фокус точки на молнии.)
Я пытаюсь работать с двумерными сетками с фокусом, представленным как молния молнии. Каждая внутренняя молния представляет собой ряд сетки. Моя конечная цель - найти пути через сетку, перепрыгивая от соседа к соседству.
Перемещение по сетке поддерживает инвариант, что все строки сфокусированы на одном и том же индексе. Это позволяет легко сосредоточиться на любом из ваших соседей.
type Grid a = LZipper (LZipper a)
up, down, left, right :: Grid a -> Maybe (Grid a)
up = bwd
down = fwd
left = traverse bwd
right = traverse fwd
extractGrid :: Grid a -> a
extractGrid = extract . extract
mkGrid :: (a, [a]) -> [(a, [a])] -> Grid a
mkGrid (x, xs) xss = mkZipper (mkZipper x xs) $ map (uncurry mkZipper) xss
Примеры:
ghci> let myGrid = mkGrid ('a', "bc") [('d', "ef"), ('g', "hi")]
ghci> myGrid
LZipper (Reverse [])
(LZipper (Reverse "") 'a' "bc")
[LZipper (Reverse "") 'd' "ef",LZipper (Reverse "") 'g' "hi"]
-- +-------+
-- | A b c |
-- | d e f |
-- | g h i |
-- +-------+
ghci> return myGrid >>= right >>= down
Just (LZipper (Reverse [LZipper (Reverse "a") 'b' "c"])
(LZipper (Reverse "d") 'e' "f")
[LZipper (Reverse "g") 'h' "i"])
-- +-------+
-- | a b c |
-- | d E f |
-- | g h i |
-- +-------+
То, что я хочу, эквивалентно LZipper duplicate для сетки: функция, которая принимает сетку и создает сетку всех способов, которыми вы могли бы смотреть на сетку, с акцентом на текущий способ, которым вы глядя на него.
duplicateGrid :: Grid a -> Grid (Grid a)
Что я ожидаю:
duplicateGrid myGrid
+-------------------------------+
| ********* +-------+ +-------+ |
| * A b c * | a B c | | a b C | |
| * d e f * | d e f | | d e f | |
| * g h i * | g h i | | g h i | |
| ********* +-------+ +-------+ |
| +-------+ +-------+ +-------+ |
| | a b c | | a b c | | a b c | |
| | D e f | | d E f | | d e F | |
| | g h i | | g h i | | g h i | |
| +-------+ +-------+ +-------+ |
| +-------+ +-------+ +-------+ |
| | a b c | | a b c | | a b c | |
| | d e f | | d e f | | d e f | |
| | G h i | | g H i | | g h I | |
| +-------+ +-------+ +-------+ |
+-------------------------------+
Я попробовал duplicateGrid = duplicate . duplicate. У этого есть правильный тип, но (предполагая, что я правильно интерпретировал вывод show, который я, вероятно, не сделал), он дает мне сетки, сосредоточенные где-то в первом столбце:
(duplicate . duplicate) myGrid
+-------------------------------+
| ********* +-------+ +-------+ |
| * A b c * | a b c | | a b c | |
| * d e f * | D e f | | d e f | |
| * g h i * | g h i | | G h i | |
| ********* +-------+ +-------+ |
| +-------+ +-------+ +-------+ |
| | A b c | | a b c | | a b c | |
| | d e f | | D e f | | d e f | |
| | g h i | | g h i | | G h i | |
| +-------+ +-------+ +-------+ |
| +-------+ +-------+ +-------+ |
| | A b c | | a b c | | a b c | |
| | d e f | | D e f | | d e f | |
| | g h i | | g h i | | G h i | |
| +-------+ +-------+ +-------+ |
+-------------------------------+
Я также пробовал duplicateGrid = duplicate . fmap duplicate. Предполагая еще раз, что я способен интерпретировать вывод show, это дало мне то, что содержало неправильные сетки, и фокусы строк были несогласованы, так что перемещение вниз также привело бы вас к следующему:
(duplicate . fmap duplicate) myGrid
+-------------------------------+
| ********* +-------+ +-------+ |
| * A b c * | D e f | | G h i | |
| * a B c * | d E f | | g H i | |
| * a b C * | d e F | | g h I | |
| ********* +-------+ +-------+ |
| +-------+ ********* +-------+ |
| | A b c | * D e f * | G h i | |
| | a B c | * d E f * | g H i | |
| | a b C | * d e F * | g h I | |
| +-------+ ********* +-------+ |
| +-------+ +-------+ ********* |
| | A b c | | D e f | * G h i * |
| | a B c | | d E f | * g H i * |
| | a b C | | d e F | * g h I * |
| +-------+ +-------+ ********* |
+-------------------------------+
Похоже, это был бы простой вопрос для тех, кто знает, но это заставляет мою голову вращаться. Полагаю, я мог бы запустить кривую функцию, которая называет up, down, left и right, но я чувствую, что comonadic машины должны быть в состоянии сделать это для меня. Какова правильная реализация duplicateGrid?
