有没有办法概括这个TrieMap代码？

Question

下面是一个简单的Haskell程序,它计算树上的等式:

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

假设您有一个树的关联列表[(Tree, a)],并且您想要找到给定树的条目.(人们可以将其视为类型类实例查找问题的简化版本.)天真地,我们必须做O(n*s)工作,其中n是树的数量,s是每棵树的大小.

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

(>.>) = 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

我们的查找现在只需要O(s).这个算法是前一个算法的严格推广,因为我们可以通过创建一个单例TreeMap ()然后看看我们是否返回来测试相等性Just ().但是出于实际原因,我们不想这样做,因为它涉及构建一个TreeMap,然后立即将其拆除.

有没有一种方法,以上面的两段代码概括成可以同时运行一个新的功能Tree和TreeMap？代码的结构似乎有些相似,但是如何将差异抽象出去并不明显.

Answer 1

编辑:我记得一个关于对数和衍生物的非常有用的事实,我发现它虽然令人厌恶地挂在朋友的沙发上.可悲的是,那位朋友(已故伟大的Kostas Tourlas)已不再和我们在一起了,但是我通过恶心地挂在另一个朋友的沙发上来纪念他.

让我们提醒自己尝试.(很多同事在早期就开始研究这些结构:Ralf Hinze,Thorsten Altenkirch和Peter Hancock在这方面立刻想到了.)真正发生的是我们正在计算一种类型的指数t,记住t -> x是一种写作方式x^ t.

也就是说,我们希望装备一种t具有仿函数Expo t这样Expo t x表示t -> x.我们应该进一步期待Expo t应用(zippily).编辑:汉考克称这种仿函数"Naperian",因为他们有对数,而且他们以同样的方式作为功能应用性,与pure被K个组合子和<*>为S.这是直接的是Expo t ()必须与同构(),与const (pure ())和const ()做(工作不多.

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

把它的另一种方式是,t是对数的Expo t.

(我几乎忘记了:微积分的粉丝应该检查它t是否同构? (Expo t) ().这种同构可能实际上非常有用.编辑:它非常有用,我们将把它添加到EXPO以后.)

我们需要一些函子套件.身份仿函数是zippiy应用...

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)

......它的对数是单位类型

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

zippy applicatives的产品适用于zippily ...

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)

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

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)

zippy applicatives的成分是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)

他们的对数是产品.

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

如果我们打开足够的东西,我们现在可以写

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

将TreeMap a在问题类型,是

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

恰好Expo Tree (Maybe a),与lookupTreeMap作为flip appl.

现在,考虑到这一点Tree并且Tree -> x是相当不同的事情,让我感到奇怪的是希望代码"在两者上"工作.树相等性测试是查找的一个特例,只是树相等性测试是作用于树的任何旧函数.然而,巧合巧合是:为了测试平等,我们必须将每棵树变成自己的自我识别器.编辑:这正是log-diff iso的作用.

产生相等性测试的结构是匹配的一些概念.像这样:

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

也就是说,我们希望Matched a b以某种方式表示一对a和一b对匹配.我们应该能够提取对(忘记它们匹配),我们应该能够接受任何一对并尝试匹配它们.

不出所料,我们可以非常成功地为单位类型做到这一点.

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

对于产品,我们分组工作,组件不匹配是唯一的危险.

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'

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

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

有趣的是,我们现在可以轻松地获得树木的平等测试

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

(顺便提一下,Functor捕获匹配概念的子类是

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

可悲的是被忽视了.在道德上,对于每一个这样的人f,我们应该有

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

一个有趣的练习是显示if (Traversable f, HalfZippable f),然后免费monad on f有一阶统一算法.)

我想我们可以像这样构建"单例关联列表":

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

我们可以尝试将它们与这个小工具结合起来,利用所有Expo ts 的瑕疵......

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

......但是,再一次,Monoid实例的完全愚蠢Maybe x继续阻碍清洁设计.

我们至少可以管理

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

一个有趣的运动是融合abst与match,也许这就是真正的问题是开车.让我们重构一下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

因为(),新的是什么

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

对于总和,我们需要标记成功的匹配,并用辉煌的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'))

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

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

所以我们可以看到构造函数和它的匹配器之间存在连接.

家庭作业:保险丝abst用match',有效地制表的全过程.

编辑:写入match',我们将每个子匹配器停放在对应于子结构的trie的位置.当你想到特定位置的东西时,你应该想到拉链和微积分.让我提醒你.

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

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)

现在我们可以定义

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

通常的微积分定律适用,组成给链规则提供空间解释.

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

坚持认为这Expo t是可以区分的,这不会伤害我们,所以让我们扩展EXPO课程.什么是"有洞的特里"？这是一个缺少输出条目的特里输入.这是关键.

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

现在,hole和eloh将见证同构.

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

单位情况不是很令人兴奋,但总和案例开始显示结构:

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

看到？A Left被映射到左边有一个洞的特里结构; a Right映射到右侧带孔的trie.

现在为产品.

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

对一对的特里是一个塞在左三元组内的右三角,因此通过在左元素的特定子组中为右元素创建一个洞来找到特定对的洞.

对于树木,我们制作另一个包装纸.

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

那么,我们如何将一棵树变成它的特里识别器呢？首先,我们抓住它的"除了我之外的所有人",我们填写所有这些输出False,然后插入True缺少的条目.

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

家庭作业提示: D f :*: I是一个comonad.

没有朋友!