用于平衡二叉树根的单程透镜

Question

我有一个平衡二叉树，其类型包括树的深度：

data Nat = Zero | Succ Nat
data Tree (n :: Nat) a where
  Leaf :: Tree Zero a
  Branch :: a -> (Tree n a, Tree n a) -> Tree (Succ n) a

我想要一种方法运行任意函数 f :: Tree n a -> Tree n a 在任何 Tree m a、m 的根的深度 n 的子树上≥n.

我能够使用一种类型 class 来实现这种提取和替换根子树的方法：

mapRoot :: X m n => (Tree n a -> Tree n a) -> Tree m a -> Tree m a
mapRoot f t = putRoot (f (getRoot t)) t

class X m n where 
  getRoot :: Tree m a -> Tree n a
  putRoot :: Tree n a -> Tree m a -> Tree m a

instance X m Zero where
  getRoot t = Leaf
  putRoot Leaf t = t

instance X m n => X (Succ m) (Succ n) where
  getRoot (Branch a (l,r)) = (Branch a (getRoot l, getRoot r))
  putRoot (Branch a (l,r)) (Branch _ (l',r')) = Branch a (putRoot l l', putRoot r r')

虽然这可行，但它需要两次遍历根子树，如果可能的话，我想一次完成。

这几乎可以通过使用惰性评估（打结）实现：

mapRoot' :: Y m n => (Tree n a -> Tree n a) -> Tree m a -> Tree m a
mapRoot' f t = t' where
  (r, t') = swapRoot t r'
  r' = f r 

class Y m n where
  swapRoot :: (Tree m a, Tree n a) -> (Tree n a, Tree m a)

instance Y m Zero where 
  swapRoot t leaf = (leaf, t)

instance Y m n => Y (Succ m) (Succ n) where
  swapRoot (Branch a (l,r)) (Branch a' (l',r')) = (Branch a (lx,rx), Branch a' (lx',rx')) where
    (lx,lx') = swapRoot l l'
    (rx,rx') = swapRoot r r'

但是如果你真的尝试运行 mapRoot' 你会发现它并没有停止；这是因为 swapRoot 在它的第二个参数中不是懒惰的（它不可能是，因为 Tree n a 是一个 GADT）。

然而，给定 getRoot 和 putRoot，我有根子树的 a 透镜，这让我怀疑还有其他的，包括一个可用于在单次传递中实现 mapRoot 的方法。

这样的镜头是什么？

Answer 1

您的 "tying the knot" 方法很合理 - 您只需要将所有参数放在正确的位置，这样函数就可以足够惰性了。

data (:<=) (n :: Nat) (m :: Nat) where 
  LTEQ_0 :: 'Zero :<= n 
  LTEQ_Succ :: !(n :<= m) -> 'Succ n :<= 'Succ m

mapRoot :: n :<= m -> (Tree n a -> Tree n a) -> Tree m a -> Tree m a 
mapRoot p0 f0 t0 = restore (f0 root) where 
  (root, restore) = go p0 t0 

  go :: n :<= m -> Tree m a -> (Tree n a, Tree n a -> Tree m a) 
  go LTEQ_0 t = (Leaf, const t) 
  go (LTEQ_Succ p) (Branch a (l,r)) = 
    case (go p l, go p r) of 
      ((l', fl), (r', fr)) -> 
        ( Branch a (l', r')
        , \(Branch a1 (l1, r1)) -> Branch a1 (fl l1, fr r1)
        )

请注意，go returns 一对 - 根树，以及一个获取处理过的根并返回结果的函数。这使得结果 Tree n a 不依赖于输入 Tree n a 是明确的（对于程序和运行时！）。

此外，为了简洁起见，我已将您的 class 替换为 GADT。

用于平衡二叉树根的单程透镜

Single pass lens for the root of a balanced binary tree

haskell

haskell-lens

gadt