有没有一种方法来推广这个TrieMap代码？ [英] Is there a way to generalize this TrieMap code?

问题描述

下面是一个简单的Haskell程序，它计算树上的相等性：

  import Control.Monad 
 import Control。应用
导入Data.Maybe 
 
 data Tree = Leaf |节点树树
 
 eqTree :: Tree  - >树 - > Maybe（）
 eqTree Leaf Leaf = return（）
 eqTree（Node l1 r1）（Node l2 r2）= eqTree l1 l2>> eqTree r1 r2 
 eqTree _ _ = empty 
  

假设您有一个关联树列表 [（Tree，a）] ，并且您想要查找给定树的条目。 （我们可以把它看作类型实例查找问题的简化版）。天真地说，我们必须做O（n * s）的工作，其中n是树的数量，s是每棵树的大小。

如果我们使用trie图来表示我们的关联列表，我们可以做得更好：

 （>。>）= flip（。）
 
数据TreeMap a 
 = TreeMap {
 tm_leaf ::也许a，
 tm_node :: TreeMap（TreeMap a）
} 
 
 lookupTreeMap :: Tree  - > TreeMap a  - >也许
 lookupTreeMap Leaf = tm_leaf 
 lookupTreeMap（Node l r）= tm_node>。> lookupTreeMap l> => lookupTreeMap r 
  

我们的查询现在只需要O（s）。这个算法是前一个的严格泛化，因为我们可以通过创建一个单例 TreeMap（）来测试相等性，然后看看我们是否返回 Just（）。但出于实际的原因，我们不希望这样做，因为它涉及到建立一个TreeMap，然后立即拆除它。

有没有办法将上面的两段代码放到一个可以在 Tree 和 TreeMap 上运行的新函数中？在代码的结构上似乎存在一些相似之处，但如何将差异抽象出来并不明显。

解决方案

编辑：我记得一个关于对数和衍生物的非常有用的事实，我发现它在朋友的沙发上令人讨厌地悬挂着。可悲的是，那位朋友（已故的伟大的Kostas Tourlas）已不在我们身边，但我在另一位朋友的沙发上恶心地挂了他，以纪念他。

关于尝试。 （很多我的伙伴都在早期的这些结构上工作：Ralf Hinze，Thorsten Altenkirch和Peter Hancock在这方面立即想到了。）真正发生的是我们正在计算<$ c类型的指数$ c> t ，记住 t - > x 是一种写作 x ^ t 。

也就是说，我们希望装备一个类型为code> t 的仿函数 Expo t ，例如即 Expo tx 代表 t - > X 。我们应该进一步期望 Expo t 可以适用（zippily）。 编辑： Hancock将这样的函数称为Naperian，因为它们有对数，并且它们与函数相同， pure K combinator和<> 是S.紧接着， Expo t（）必须是同构的（），其中 const（pure（））和 const（）


  class Applicative（Expo t）=> EXPO t其中
 type Expo t :: *  - > * 
 appl :: Expo t x  - > （t  - > x） -  trie查找
 abst ::（t  - > x） - > Expo tx  -  trie construction 
  

另一种说法是 t 是 Expo t 的对数。



（I几乎忘了：微积分的粉丝应该检查 t 是否同构<∂（Expo t）（）。实际上相当有用。编辑：非常有用，稍后我们将它添加到 EXPO 中。）

我们需要一些仿真器套件。

  data I ::（*  - > *）其中
 I :: x  - > I x 
导出（Show，Eq，Functor，Foldable，Traversable）
 
实例应用程序I其中
 pure x = I x 
 I f * I s = I（fs）
  

...及其对数是单位类型

 实例EXPO（）其中
类型Expo（）= I 
 appl（I x）（）= x 
 abst f = I（f（））
  

zippy应用程序的产品非常适用于...

  data（：* :) ::（*  - > *） - > （*  - > *） - > （*  - > *）其中
（：* :) :: f x  - > g x  - > （f：*：g）x 
导出（Show，Eq，Functor，Foldable，Traversable）
 
实例（Applicative p，Applicative q）=>应用（p：*：q）其中
纯x =纯x：*：纯x 
（pf：*：qf）* （ps：*：qs）=（pf * ps）：*：（qf * qs）
  

...和他们的对数是和。

  instance（EXPO s，EXPO t）= >世博会（或者st）其中
类型世博会（或者st）=世博会s：*：世博会t 
 appl（sf：*：tf）（左s）= appl sf s 
 appl sf：*：tf）（Right t）= appl tf t 
 abst f = abst（f。Left）：*：abst（f。Right）
   
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 $ b $ （：< :) ::（*  - > *） - > （*  - > *） - > （*  - > *）其中
 C :: f（g x） - > （f：<：g）x 
导出（Show，Eq，Functor，Foldable，Traversable）
 
实例（Applicative p，Applicative q）=>应用（p：<：q）其中
纯x = C（纯（纯x））
 C pqf * C pqs = C（纯（*）* pqf * pqs）
  

及其对数是产品。

  instance（EXPO s，EXPO t）=> EXPO（s，t）其中
类型Expo（s，t）= Expo s：<：Expo t 
 appl（C stf）（s，t）= appl（appl stf s）t 
 abst f = C（abst $ \\ s  - > abst $ \\ t  - > f（s，t））
  

如果我们接通了足够的东西，我们现在可以写出：

pre $ newtype Tree = Tree或者（）（Tree，Tree））
deriving（Show，Eq）
pattern Leaf = Tree（Left（））
模式Node lr = Tree（Right（l，r））

新类型ExpoTree x = ExpoTree（世博会（或者（）（树，树））x b $ b b导出（Show，Eq，Functor，Applicative）

实例EXPO树
型博览会树= ExpoTree
appl（ExpoTree f）（Tree t）= appl ft
abst f = ExpoTree（abst（f。树））


问题中的 TreeMap a 类型为

 数据TreeMap a 
 = TreeMap {
 tm_leaf ::也许a，
 tm_node :: TreeMap（TreeMap a） 
} 
  

正好是世博会结构树（可能是a），其中 lookupTreeMap 是 flip appl 。

现在，假设树和树 - > x 是完全不同的东西，它让我觉得奇怪的是希望代码在两者上工作。树相等性测试是查找的一个特例，只是树相等性测试是任何在树上作用的旧函数。然而巧合巧合：为了测试平等，我们必须将每棵树变成自己的自我认识者。 编辑：这正是log-diff iso
的功能。

引起平等测试的结构是一些概念匹配。像这样：

  class匹配ab其中
类型匹配的ab :: * 
匹配::匹配的ab - > （a，b）
 match :: a  - > b  - >也许（匹配的ab）
  

也就是说，我们期望匹配的ab 以某种方式表示一对匹配的 a 和 b 。我们应该能够提取这对（忘记它们匹配），我们应该能够采取任何一对，并尝试匹配它们。

不出所料，我们可以做（）（）其中
类型Matched（）（）这个单元类型，相当成功。

  =（）
 matched（）=（（），（））
 match（）（）= Just（）
  

对于产品，我们使用组件方式，而组件不匹配是唯一的危险。

  instance （匹配s'，匹配t t'）=>匹配（s，t）（s'，t'）其中
类型匹配（s，t）（s'，t'）=（匹配s s'，匹配t t'）
匹配（s'，t'）=（（s，t），（s'，t'））其中
（s，s'）=匹配ss'
（t，t'）=匹配tt '
 match（s，t）（s'，t'）=（，）< $>匹配s''< *>匹配t'
  

总和提供了一些不匹配的机会。

  instance（Matching s s'，Matching t t'）=> 
匹配（或者st）（或者s't'）其中
类型匹配（或者st）（或者s't'）
 =任一匹配的s s匹配的t t '）
匹配（Left ss'）=（Left s，Left s'）其中（s，s'）=匹配ss'
匹配（Right tt'）=（Right t，Right t' ）其中（t，t'）=匹配tt'
 match（Left s）（Left s'）= Left< $>匹配s'
匹配（Right t）（Right t'）= Right< $> match t t'
 match _ _ = Nothing 
  

有趣的是，我们可以获得平等测试对于树木而言，现在可以轻松地进行树匹配

 实例匹配树树其中
类型匹配树树=树
匹配t =（t，t）
 match（Tree t1）（Tree t2）= Tree< $>匹配t1 t2 
  

<顺便提一句， Functor 子类，捕获匹配的概念，是

  class HalfZippable f其中 - 半拉链来自Roland Backhouse 
 halfZip ::（fa，fb） - > Maybe（f（a，b））
  

在道德上，对于每一个 f ，我们都应该有

 匹配（fa）（fb）= f（匹配ab）
  

一个有趣的练习是展示如果（Traversable f，HalfZippable f），那么 f 上的空闲monad具有一阶统一算法。）

我想我们可以像这样构建单身关联列表：

  mapOne :: forall a。 （Tree，a） - >世博会树（也许a）
 mapOne（t，a）= abst f其中
 f ::树 - >也许是
fu =纯a< *匹配tu 
  

我们可以尝试将它们与这个小工具利用所有世博会的活力t s ...

  instance Monoid x => Monoid（ExpoTree x）其中
 mempty =纯粹空白
 mappend t u = mappend< $> t * u 
  

...但是，又一次， Monoid的绝对愚蠢> >可能x 继续令整洁的设计失望。





我们至少可以管理

  instance替代m =>替代方案（ExpoTree：<：m）其中
 empty = C（纯空）
 C f< |> C g = C（（<>）$ f f g）
  

一个有趣的练习是将 abst 与匹配融合在一起，也许这就是问题所在。 。让我们重构匹配。

  class EXPO b =>匹配b在哪里
类型匹配b :: * 
匹配::匹配a b  - > （a，b）
匹配':: a  - >代理b  - >世博b（也许（匹配的ab））
 
数据代理x = Poxy  - 我还没有参加GHC 8，而西蒙需要一手牌
  

对于（），最新消息是
（）（）（）（）（）（）（）（）（）{pre $ {code $> ）


对于总和，我们需要标记成功的匹配，并用辉煌的格拉斯哥人填写不成功的部分 pure nothing 。

  instance（Matching s s'，Matching t t '）=> 
匹配（或者st）（或者s't'）其中
  - 跳过旧东西
匹配'（Left s）（Poxy :: Proxy（或者s't'））= 
（（Left< $>）< $> match's（Poxy :: Proxy s'））：*：pure Nothing 
 match'（Right t）（Poxy :: Proxy （'s't'））= 
 pure Nothing：*：（（Right <$>）< $> match't（Poxy :: Proxy t'））
  

对于对，我们需要按顺序构建匹配，如果
第一个组件失败，则提前退出。

  instance（Matching s s'，Matching t t'）=> Matching（s，t）（s'，t'）where 
  -  skip old stuff 
 match'（s，t）（Poxy :: Proxy（s'，t'））
 = C（更多< $> match's（Poxy :: Proxy s'））其中
 more Nothing = pure Nothing 
 more（Just s）=（（，）s <$ >）< $> match't（Poxy :: Proxy t'）
  

所以我们可以看到，
$ b 家庭作业：保险丝 abst with 匹配' ，有效地列出整个过程。

编辑：编写 match'，我们将每个子匹配器停放在子结构对应的trie的位置。当你考虑特定位置的事情时，你应该考虑拉链和微分算术。让我提醒你。

我们需要函数常量和副产品来管理洞在哪里的选择。

  data K :: *  - > （*  - > *）其中
 K :: a  - > K a x 
导出（Show，Eq，Functor，Foldable，Traversable）
 
 data（：+ :) ::（*  - > *） - > （*  - > *） - > （*  - > *）其中
 Inl :: f x  - > （f：+：g）x 
 Inr :: g x  - > （f：+：g）x 
派生（Show，Eq，Functor，Foldable，Traversable）
  

现在我们可以定义

  class（Functor f，Functor（D f））=>差分f其中
 type D f ::（*  - > *）
 plug ::（D f：*：I）x  - > fx 
  - 应该有其他方法，但插件现在可以做
  

微积分法则适用，组成给予链式规则的空间解释。

 实例Differentiable（ K a）其中
类型D（K a）= K Void 
 plug（K bad：*：I x）= K（荒谬的不好）
 
 instance可区分的I其中
 type DI = K（）
 plug（K（）：*：I x）= I x 
 
 instance（Differentiable f，Differentiable g）=>微分（f：+：g）其中
类型D（f：+：g）= D f：+：D g 
 plug（Inl f'：*：I x）= Inl （插件（g'：*：I x））
 
实例（可微分f（f'）：*：I x））
 plug（Inr g'：*：I x）= Inr ，可微分g）=>差分（f：*：g）其中
类型D（f：*：g）=（D f：*：g）：+：（f：*：D g）
 plug（Inl f'：*：g）：*：I x）= plug（f'：*：I x）：*：g 
 plug（Inr（f：*：g'）：*：I x）= f：*：plug（g'：*：I x）
 
 instance（Differentiable f，Differentiable g）=>可微分（f：<：g）其中
类型D（f：<：g）=（D f：<：g）：*：D g 
 plug（（C f'g ：*：I x）= C（plug（f'g：*：I（plug（g'：*：I x））））
  

我们坚持认为 Expo t 是可微的，所以让我们扩展 EXPO 类。什么是洞有洞？这是一个缺少完全可能的输入之一的输出条目的线索。这是关键。

  class（Differentiable（Expo t），Applicative（Expo t））=> EXPO t其中
 type Expo t :: *  - > * 
 appl :: Expo t x  - > t  - > x 
 abst ::（t  - > x） - >世博会x 
 hole :: t  - > D（Expo t）（）
 eloh :: D（Expo t）（） - > t 
  

现在， hole 和<$ c

 实例EXPO（）其中
类型
 Expo（）= I 
  - 跳过旧东西
 hole（）= K（）
 eloh（K（））=（）
  

单位个案并不令人兴奋，但总和个案开始显示结构：

  instance（EXPO s，EXPO t）=>世博会（或者st）其中
类型世博会（或者st）=世博会s：*：世博会t 
洞（左s）= inl（洞s：*：纯（））
洞（右）= Inr（纯（）：*：hole t）
 eloh（Inl（f'：*：_））= Left（eloh f'）
 eloh（Inr（_：* ：g'））= Right（eloh g'）
  

一个 Left 被映射到左边有一个洞的树;一个右被映射到右边有一个洞的树。

现在是产品。

  instance（EXPO s，EXPO t）=> EXPO（s，t）其中
型Expo（s，t）= Expo s：<：Expo t 
 hole（s，t）= C（const（pure（））< $> ;洞s）：*：洞t 
 eloh（C f'：*：g'）=（eloh（const（）f'），eloh g'）
 code> 

一对特里结构是一个正确的结构，塞在左边的特里结构中，因此特定结对的孔是通过



对于树，我们创建另一个包装。

  newtype DExpoTree x = DExpoTree（D（Expo（Either（）（Tree，Tree）））x）
导出（Show，Eq，Functor）
  

那么，我们如何将一棵树变成它的trie识别器？首先，我们抓住除我之外的所有人，然后用 False 填充所有这些输出，然后插入 True


  matchMe :: EXPO t => t  - > Expo t Bool 
 matchMe t = plug（（const False< $> hole t）：*：I True）
  

家庭作业提示：



缺席的朋友！

Below is a simple Haskell program which computes equalities on trees:

import Control.Monad
import Control.Applicative
import Data.Maybe

data Tree = Leaf | Node Tree Tree

eqTree :: Tree -> Tree -> Maybe ()
eqTree Leaf         Leaf         = return ()
eqTree (Node l1 r1) (Node l2 r2) = eqTree l1 l2 >> eqTree r1 r2
eqTree _ _ = empty

Suppose you have an association list of trees [(Tree, a)], and you'd like to find the entry for a given tree. (One can think of this as a simplified version of the type class instance lookup problem.) Naively, we would have to do O(n*s) work, where n is the number of trees, and s is the size of each tree.

We can do better if we use a trie map to represent our association list:

(>.>) = flip (.)

data TreeMap a
    = TreeMap {
        tm_leaf :: Maybe a,
        tm_node :: TreeMap (TreeMap a)
      }

lookupTreeMap :: Tree -> TreeMap a -> Maybe a
lookupTreeMap Leaf       = tm_leaf
lookupTreeMap (Node l r) = tm_node >.> lookupTreeMap l >=> lookupTreeMap r

Our lookup now only takes O(s). This algorithm is a strict generalization of the previous one, since we can test for equality by creating a singleton TreeMap () and then seeing if we get back Just (). But for practical reasons, we'd prefer not to do this, since it involves building up a TreeMap and then immediately tearing it down.

Is there a way to generalize the two pieces of code above into a new function that can operate on both Tree and TreeMap? There seems to be some similarity in how the code is structured, but it is not obvious how to abstract the differences away.

解决方案

Edit: I remembered a very helpful fact about logarithms and derivatives which I discovered whilst disgustingly hung over on a friend's sofa. Sadly, that friend (the late great Kostas Tourlas) is no longer with us, but I commemorate him by being disgustingly hung over on a different friend's sofa.

Let's remind ourselves about tries. (Lots of my mates were working on these structures in the early noughties: Ralf Hinze, Thorsten Altenkirch and Peter Hancock spring instantly to mind in that regard.) What's really going on is that we're computing the exponential of a type t, remembering that t -> x is a way of writing x ^ t.

That is, we expect to equip a type t with a functor Expo t such that Expo t x represents t -> x. We should further expect Expo t to be applicative (zippily). Edit: Hancock calls such functors "Naperian", because they have logarithms, and they're applicative in the same way as functions, with pure being the K combinator and <*> being S. It is immediate that Expo t () must be isomorphic with (), with const (pure ()) and const () doing the (not much) work.

class Applicative (Expo t) => EXPO t where
  type Expo t :: * -> *
  appl  :: Expo t x -> (t -> x)       -- trie lookup
  abst  :: (t -> x) -> Expo t x       -- trie construction

Another way of putting it is that t is the logarithm of Expo t.

(I nearly forgot: fans of calculus should check that t is isomorphic to ∂ (Expo t) (). This isomorphism might actually be rather useful. Edit: it's extremely useful, and we shall add it to EXPO later.)

We'll need some functor kit stuff. The identity functor is zippiy applicative...

data I     ::                         (* -> *) where
  I   :: x -> I x
  deriving (Show, Eq, Functor, Foldable, Traversable)

instance Applicative I where
  pure x = I x
  I f <*> I s = I (f s)

...and its logarithm is the unit type

instance EXPO () where
  type Expo () = I
  appl (I x) () = x
  abst f        = I (f ())

Products of zippy applicatives are zippily applicative...

data (:*:) :: (* -> *) -> (* -> *) -> (* -> *) where
  (:*:) :: f x -> g x -> (f :*: g) x
  deriving (Show, Eq, Functor, Foldable, Traversable)

instance (Applicative p, Applicative q) => Applicative (p :*: q) where
  pure x = pure x :*: pure x
  (pf :*: qf) <*> (ps :*: qs) = (pf <*> ps) :*: (qf <*> qs)

...and their logarithms are sums.

instance (EXPO s, EXPO t) => EXPO (Either s t) where
  type Expo (Either s t) = Expo s :*: Expo t
  appl (sf :*: tf) (Left s)  = appl sf s
  appl (sf :*: tf) (Right t) = appl tf t
  abst f = abst (f . Left) :*: abst (f . Right)

Compositions of zippy applicatives are zippily applicative...

data (:<:) :: (* -> *) -> (* -> *) -> (* -> *) where
  C :: f (g x) -> (f :<: g) x
  deriving (Show, Eq, Functor, Foldable, Traversable)

instance (Applicative p, Applicative q) => Applicative (p :<: q) where
  pure x          = C (pure (pure x))
  C pqf <*> C pqs = C (pure (<*>) <*> pqf <*> pqs)

and their logarithms are products.

instance (EXPO s, EXPO t) => EXPO (s, t) where
  type Expo (s, t) = Expo s :<: Expo t
  appl (C stf) (s, t) = appl (appl stf s) t
  abst f = C (abst $ \ s -> abst $ \ t -> f (s, t))

If we switch on enough stuff, we may now write

newtype Tree    = Tree (Either () (Tree, Tree))
  deriving (Show, Eq)
pattern Leaf     = Tree (Left ())
pattern Node l r = Tree (Right (l, r))

newtype ExpoTree x = ExpoTree (Expo (Either () (Tree, Tree)) x)
  deriving (Show, Eq, Functor, Applicative)

instance EXPO Tree where
  type Expo Tree = ExpoTree
  appl (ExpoTree f) (Tree t) = appl f t
  abst f = ExpoTree (abst (f . Tree))

The TreeMap a type in the question, being

data TreeMap a
    = TreeMap {
        tm_leaf :: Maybe a,
        tm_node :: TreeMap (TreeMap a)
      }

is exactly Expo Tree (Maybe a), with lookupTreeMap being flip appl.

Now, given that Tree and Tree -> x are rather different things, it strikes me as odd to want code to work "on both". The tree equality test is a special case of the lookup only in that the tree equality test is any old function which acts on a tree. There is a coincidence coincidence, however: to test equality, we must turn each tree into own self-recognizer. Edit: that's exactly what the log-diff iso does.

The structure which gives rise to an equality test is some notion of matching. Like this:

class Matching a b where
  type Matched a b :: *
  matched :: Matched a b -> (a, b)
  match   :: a -> b -> Maybe (Matched a b)

That is, we expect Matched a b to represent somehow a pair of an a and a b which match. We should be able to extract the pair (forgetting that they match), and we should be able to take any pair and try to match them.

Unsurprisingly, we can do this for the unit type, quite successfully.

instance Matching () () where
  type Matched () () = ()
  matched () = ((), ())
  match () () = Just ()

For products, we work componentwise, with component mismatch being the only danger.

instance (Matching s s', Matching t t') => Matching (s, t) (s', t') where
  type Matched (s, t) (s', t') = (Matched s s', Matched t t')
  matched (ss', tt') = ((s, t), (s', t')) where
    (s, s') = matched ss'
    (t, t') = matched tt'
  match (s, t) (s', t') = (,) <$> match s s' <*> match t t'

Sums offer some chance of mismatch.

instance (Matching s s', Matching t t') =>
    Matching (Either s t) (Either s' t') where
  type Matched (Either s t) (Either s' t')
    = Either (Matched s s') (Matched t t')
  matched (Left  ss') = (Left s,  Left s')  where (s, s') = matched ss'
  matched (Right tt') = (Right t, Right t') where (t, t') = matched tt'
  match (Left s)  (Left s')  = Left  <$> match s s'
  match (Right t) (Right t') = Right <$> match t t'
  match _         _          = Nothing

Amusingly, we can obtain an equality test for trees now as easily as

instance Matching Tree Tree where
  type Matched Tree Tree = Tree
  matched t = (t, t)
  match (Tree t1) (Tree t2) = Tree <$> match t1 t2

(Incidentally, the Functor subclass that captures a notion of matching, being

class HalfZippable f where  -- "half zip" comes from Roland Backhouse
  halfZip :: (f a, f b) -> Maybe (f (a, b))

is sadly neglected. Morally, for each such f, we should have

Matched (f a) (f b) = f (Matched a b)

A fun exercise is to show that if (Traversable f, HalfZippable f), then the free monad on f has a first-order unification algorithm.)

I suppose we can build "singleton association lists" like this:

mapOne :: forall a. (Tree, a) -> Expo Tree (Maybe a)
mapOne (t, a) = abst f where
  f :: Tree -> Maybe a
  f u = pure a <* match t u

And we could try combining them with this gadget, exploiting the zippiness of all the Expo ts...

instance Monoid x => Monoid (ExpoTree x) where
  mempty = pure mempty
  mappend t u = mappend <$> t <*> u

...but, yet again, the utter stupidity of the Monoid instance for Maybe x continues to frustrate clean design.

We can at least manage

instance Alternative m => Alternative (ExpoTree :<: m) where
  empty = C (pure empty)
  C f <|> C g = C ((<|>) <$> f <*> g)

An amusing exercise is to fuse abst with match, and perhaps that's what the question is really driving at. Let's refactor Matching.

class EXPO b => Matching a b where
  type Matched a b :: *
  matched :: Matched a b -> (a, b)
  match'  :: a -> Proxy b -> Expo b (Maybe (Matched a b))

data Proxy x = Poxy  -- I'm not on GHC 8 yet, and Simon needs a hand here

For (), what's new is

instance Matching () () where
  -- skip old stuff
  match' () (Poxy :: Proxy ()) = I (Just ())

For sums, we need to tag successful matches, and fill in the unsuccessful parts with a magnificently Glaswegian pure Nothing.

instance (Matching s s', Matching t t') =>
    Matching (Either s t) (Either s' t') where
  -- skip old stuff
  match' (Left s) (Poxy :: Proxy (Either s' t')) =
    ((Left <$>) <$> match' s (Poxy :: Proxy s')) :*: pure Nothing
  match' (Right t) (Poxy :: Proxy (Either s' t')) =
    pure Nothing :*: ((Right <$>) <$> match' t (Poxy :: Proxy t'))

For pairs, we need to build matching in sequence, dropping out early if the first component fails.

instance (Matching s s', Matching t t') => Matching (s, t) (s', t') where
  -- skip old stuff
  match' (s, t) (Poxy :: Proxy (s', t'))
    = C (more <$> match' s (Poxy :: Proxy s')) where
    more Nothing  = pure Nothing
    more (Just s) = ((,) s <$>) <$> match' t (Poxy :: Proxy t')

So we can see that there is a connection between a constructor and the trie for its matcher.

Homework: fuse abst with match', effectively tabulating the entire process.

Edit: writing match', we parked each sub-matcher in the position of the trie corresponding to the sub-structure. And when you think of things in particular positions, you should think of zippers and differential calculus. Let me remind you.

We'll need functorial constants and coproducts to manage choice of "where the hole is".

data K     :: * ->                    (* -> *) where
  K :: a -> K a x
  deriving (Show, Eq, Functor, Foldable, Traversable)

data (:+:) :: (* -> *) -> (* -> *) -> (* -> *) where
  Inl :: f x -> (f :+: g) x
  Inr :: g x -> (f :+: g) x
  deriving (Show, Eq, Functor, Foldable, Traversable)

And now we may define

class (Functor f, Functor (D f)) => Differentiable f where
  type D f :: (* -> *)
  plug :: (D f :*: I) x -> f x
  -- there should be other methods, but plug will do for now

The usual laws of calculus apply, with composition giving a spatial interpretation to the chain rule.

instance Differentiable (K a) where
  type D (K a) = K Void
  plug (K bad :*: I x) = K (absurd bad)

instance Differentiable I where
  type D I = K ()
  plug (K () :*: I x) = I x

instance (Differentiable f, Differentiable g) => Differentiable (f :+: g) where
  type D (f :+: g) = D f :+: D g
  plug (Inl f' :*: I x) = Inl (plug (f' :*: I x))
  plug (Inr g' :*: I x) = Inr (plug (g' :*: I x))

instance (Differentiable f, Differentiable g) => Differentiable (f :*: g) where
  type D (f :*: g) = (D f :*: g) :+: (f :*: D g)
  plug (Inl (f' :*: g) :*: I x) = plug (f' :*: I x) :*: g
  plug (Inr (f :*: g') :*: I x) = f :*: plug (g' :*: I x)

instance (Differentiable f, Differentiable g) => Differentiable (f :<: g) where
  type D (f :<: g) = (D f :<: g) :*: D g
  plug ((C f'g :*: g') :*: I x) = C (plug (f'g :*: I (plug (g' :*: I x))))

It will not harm us to insist that Expo t is differentiable, so let us extend the EXPO class. What's a "trie with a hole"? It's a trie which is missing the output entry for exactly one of the possible inputs. And that's the key.

class (Differentiable (Expo t), Applicative (Expo t)) => EXPO t where
  type Expo t :: * -> *
  appl  :: Expo t x -> t -> x
  abst  :: (t -> x) -> Expo t x
  hole  :: t -> D (Expo t) ()
  eloh  :: D (Expo t) () -> t

Now, hole and eloh will witness the isomorphism.

instance EXPO () where
  type Expo () = I
  -- skip old stuff
  hole ()     = K ()
  eloh (K ()) = ()

The unit case wasn't very exciting, but the sum case begins to show structure:

instance (EXPO s, EXPO t) => EXPO (Either s t) where
  type Expo (Either s t) = Expo s :*: Expo t
  hole (Left s)  = Inl (hole s  :*: pure ())
  hole (Right t) = Inr (pure () :*: hole t)
  eloh (Inl (f' :*: _)) = Left (eloh f')
  eloh (Inr (_ :*: g')) = Right (eloh g')

See? A Left is mapped to a trie with a hole on the left; a Right is mapped to a trie with a hole on the right.

Now for products.

instance (EXPO s, EXPO t) => EXPO (s, t) where
  type Expo (s, t) = Expo s :<: Expo t
  hole (s, t) = C (const (pure ()) <$> hole s) :*: hole t
  eloh (C f' :*: g') = (eloh (const () <$> f'), eloh g')

A trie for a pair is a right trie stuffed inside a left trie, so the hole for a particular pair is found by making a hole for the right element in the particular subtrie for the left element.

For trees, we make another wrapper.

newtype DExpoTree x = DExpoTree (D (Expo (Either () (Tree, Tree))) x)
  deriving (Show, Eq, Functor)

So, how do we turn a tree into its trie recognizer? First, we grab its "everyone but me" trie, and we fill in all those outputs with False, then we plug in True for the missing entry.

matchMe :: EXPO t => t -> Expo t Bool
matchMe t = plug ((const False <$> hole t) :*: I True)

Homework hint: D f :*: I is a comonad.

Absent friends!

这篇关于有没有一种方法来推广这个TrieMap代码？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！