Haskell 平衡二叉树根的单程透镜

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

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

我想要一种在任何

树ma

，

m

&geq<代码>n

我能够通过使用类型类提取和替换根子树来实现这一点：

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'

，你会发现它不会停止；这是因为

swapRoot

在其第二个参数中并不懒惰（它不可能懒惰，因为

treena

是一个GADT）

然而，给定

getRoot

和

putRoot

，我有一个根子树的镜头，这让我怀疑还有其他的，包括一个可以在一次过程中实现

mapRoot

什么是这样一个镜头？

您的“打结”方法是正确的-您只需要将所有参数放在正确的位置，这样函数就可以充分延迟

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)
        )

---

<代码>数据（我可以问你为什么选择GATT而不是嵌套类型？DFue:我想我需要在编译时做一些比较自然的事情，而不是嵌套的配对……但是我会考虑的。事实上，我想我误解了你。当你说“子树”的时候，你真的在谈论树的最上面的部分吗？（即，所有节点向下延伸到特定深度）？dfeuer：是的，这就是我试图通过“根深度n的子树”来指定的。我已经对此进行了更多的研究，并对其进行了一些额外的思考。我的结论是，对于这个确切的函数，您最初的两次实现很可能是最好的一次，最多有一点摇摆。固有的困难是您没有关于

f

s消耗和生产率之间关系的信息。如果

f

被认为是

FMAPG

，这将是不同的。我更喜欢这一点，而不是我想出的将我的GADT与

swapRoot（分支a（l，r））t=…匹配的方法，其中~（a'，（l'，r'）=（\（分支a p）->（a，p））t

因为缺乏依赖性现在是显式的。这里的

案例看起来太严格了。我认为它会导致两个过程（一个显式；一个隐式）@dfeuer我同意这种情况是严格的-但在这种情况下这不是很理想吗？由于
go
是严格的，它必须同时计算根树和函数，并从转换后的树中重新计算最终结果，这意味着它必须只进行一次传递。也许我误解了什么。@user2407038，我实际上认为OP是或对于这个精确函数和这个精确类型，原始代码可能是最好的。当传递一个足够延迟的函数时（例如，应用
fmap
），它只执行一次实际的传递。我不认为你的函数在使用非惰性函数时会表现得更好，我认为使用惰性函数会更糟。不过，我想我可能遗漏了一些东西。你的函数似乎在树上执行了一次传递，然后在完成之后执行了第二次重建。原始代码交错在hese.dfeuer:user2407038方法与我的原始方法相比的另一个优点是，我还可以对其进行调整。
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)
        )