Я хочу сделать двоичное дерево застежкой-молнией экземпляр comonad, но я не могу понять, как правильно реализовать duplicate.
Вот моя попытка:
{-# LANGUAGE DeriveFunctor #-}
import Data.Function
import Control.Arrow
import Control.Comonad
data BinTree a
= Leaf a
| Branch a (BinTree a) (BinTree a)
deriving (Functor, Show, Eq)
data Dir = L | R
deriving (Show, Eq)
-- an incomplete binary tree, aka data context
data Partial a = Missing Dir (BinTree a) a
deriving (Show, Eq, Functor)
-- BTZ for BinTree Zipper
newtype BTZ a = BTZ { getBTZ :: ([Partial a], BinTree a) }
deriving (Show, Eq)
instance Functor BTZ where
fmap f (BTZ (cs,t)) = BTZ (map (fmap f) cs, fmap f t)
-- | replace every node label with the zipper focusing on that node
dup :: BinTree a -> BinTree (BTZ a)
dup (Leaf v) = Leaf (BTZ ([], Leaf v))
dup [email protected](Branch v tl tr) = Branch (BTZ ([],t)) tlZ trZ
where
tlZ = fmap (BTZ . first (++ [Missing L tr v]) . getBTZ) (dup tl)
trZ = fmap (BTZ . first (++ [Missing R tl v]) . getBTZ) (dup tr)
-- | extract root label
rootVal :: BinTree a -> a
rootVal (Leaf v) = v
rootVal (Branch v _ _) = v
-- | move zipper focus around
goUp, goLeft, goRight :: BTZ a -> BTZ a
goUp (BTZ ([], _)) = error "already at root"
goUp (BTZ (Missing wt t2 v:xs, t1)) = case wt of
L -> BTZ (xs, Branch v t1 t2)
R -> BTZ (xs, Branch v t2 t1)
goLeft z = let (cs,t) = getBTZ z in
case t of
Leaf _ -> error "already at leaf"
Branch v t1 t2 -> BTZ (Missing L t2 v:cs, t1)
goRight z = let (cs,t) = getBTZ z in
case t of
Leaf _ -> error "already at leaf"
Branch v t1 t2 -> BTZ (Missing R t1 v:cs, t2)
instance Comonad BTZ where
extract (BTZ (_,t)) =
case t of
Leaf v -> v
Branch v _ _ -> v
duplicate [email protected](BTZ (cs, bt)) = case bt of
Leaf _ -> BTZ (csZ, Leaf z) -- extract . duplicate = id
Branch v tl tr ->
-- for each subtree, use "dup" to build zippers,
-- and attach the current focusing root(bt) and rest of the data context to it
let tlZ = fmap (BTZ . first (++Missing L tr v :cs) . getBTZ) (dup tl)
trZ = fmap (BTZ . first (++Missing R tl v :cs) . getBTZ) (dup tr)
in BTZ (csZ, Branch z tlZ trZ)
where
-- go up and duplicate, we'll have a "BTZ (BTZ a)"
-- from which we can grab "[Partial (BTZ a)]" out
-- TODO: not sure if it works
upZippers = take (length cs-1) . tail $ iterate goUp z
csZ = fmap (head . fst . getBTZ . duplicate) upZippers
main :: IO ()
main = do
let tr :: BTZ Int
tr = rootVal $ dup (Branch 1 (Leaf 2) (Branch 3 (Leaf 4) (Leaf 5)))
equalOnTr :: Eq a => (BTZ Int -> a) -> (BTZ Int -> a) -> Bool
equalOnTr = (==) `on` ($ tr)
print $ (extract . duplicate) `equalOnTr` id
print $ (fmap extract . duplicate) `equalOnTr` id
print $ (duplicate . duplicate) `equalOnTr` (fmap duplicate . duplicate)
Некоторое объяснение:
-
BinTree a- это тип данных двоичного дерева, и каждое дерево node содержит метку. -
Partial a- это двоичное дерево с левым или правым поддеревом. СтекPartial aв моем коде играет роль контекста данных. -
BTZобозначает застежкуBinTree, которую я хочу сделать экземпляромComonad, она состоит из контекста данных и поддерева фокусировки.
Чтобы сделать его экземпляром Comonad, я планирую реализовать extract и duplicate и проверить, сохранены ли свойства comonad, взяв некоторые случайные двоичные деревья.
extract прост, просто вынимая поддеревье фокусировки.
Функция dup служит вспомогательной функцией, которая заменяет каждую метку node
с застежкой на дереве, фокусирующей на этом node.
Для duplicate z метка node должна быть самой z, так что extract . duplicate == id выполняется. Для не-листовых узлов я использую dup для работы с их поддеревьями, как если бы у них не было родителей, а текущий фокус z и остальная часть контекста данных добавляются к этим застежкам-молчетам впоследствии.
До сих пор выполнялись первые два свойства comonad (extract . duplicate = id и fmap extract . duplicate), но я не знаю, что делать с контекстом данных. То, что я сейчас делаю, это сделать молнию z и продолжать расти. По пути мы берем верхнюю часть каждого стека контекста данных для создания нового стека контекста данных, который звучит правильно, а также имеет правильный тип ([Partial (BTZ a)]. Но мой подход не может удовлетворить третий закон.
Учитывая определение типа данных бинарного дерева на молнии выше, возможно ли сделать это примером Комонада? Если ответ "да", что-то не так с моим подходом?