dramforever

coding, thoughts and stuff irl

有关 monad 的一些想法 (1)

2016-12-02

前传

和 sxysxy 神犇做了个交♂易,我来发布一些关于 monad 的教程。借用林则徐的两句名言来描述我现在的心情:(这里省略14个字)

树上最近公共祖先 LCA

给定一个有根树(无向无环联通图,其中指定一个特殊节点为根节点),给出许多操作 (u, v),求 uv 的路径上,既是 u 的祖先,也是 v 的祖先的节点 lca(u, v) 从根节点到 u 的路径(这条路径是唯一的)上的点都是 u 的祖先(包括根和 u

Functor 的 LCA

一个 LCA 的查询系列是一个世界 LCA 里的一个程序,这个程序跑在一个可以求 LCA 的环境中。我们不妨先试试一下只有一个操作的情况。

data F_LCA a
  = F_LCA
    { f_lcaQuery :: (Int, Int)
    , f_lcaValue :: Int -> a
    }

这个操作可以查询一次 LCA,并用这个 LCA 的结果得到另一个结果。

如果要实现一个可以查询 LCA 的东西,我们可以接受一个 F_LCA,并做如下操作:

可以看到的是,我们的 LCA a 中,隐隐地包含着一个类型为 a 的最终结果。而这个最终结果,我们是可以直接去改它的:

class Functor f where
  fmap :: (a -> b) -> f a -> f b

也就是

fmap :: (a -> b) -> F_LCA a -> F_LCA b

fmap f qr 应该将 qr 扩充,其原本结果是 t 的,要变成 f t。但是在这样的同时,fmap 不应修改 F_LCA 所进行的询问本身。

instance Functor F_LCA where
  fmap f (F_LCA q v) = F_LCA q (f . v)

为了支持超过 fmap 的东西,显然需要查询 LCA 这个基本操作。

f_query :: Int -> Int -> F_LCA Int
f_query x y = F_LCA (x, y) (\u -> u)

然后已经可以用了

ghci> let qr = show `fmap` f_query 2 4
qr :: F_LCA String      -- 想查询 LCA,返回一个 String
ghci> f_lcaQuery qr
(2,4)                   -- 看起来有人想查询 lca(2, 4)
it :: (Int, Int)
ghci> f_lcaValue qr 1   -- 结果是 1,看看怎么样
"1"                     -- 不错嘛
it :: String

Applicative 的 LCA

为了实现查询(0 次或)多次 LCA,我们自然地想到,可以把 query 变成一个列表,并让 value 接受一个列表,里面放上所有查询结果。

data A_LCA a
  = A_LCA
    { a_lcaQueries :: [(Int, Int)]
    , a_lcaValue :: [Int] -> a
    }

对最终结果的计算,应该是这样的:

显然它还是个 Functor

instance Functor A_LCA where
  f `fmap` (A_LCA q v) = A_LCA q (f . v)

与之前不同的是,我们的 A_LCA 可以进行这样的组合:

别忘了咱还能不查询 LCA 直接给出结果

这样,Applicative 简直完美:

class Functor f => Applicative f where
  pure :: a -> f a
  (<*>) :: f (a -> b) -> f a -> f b

pure x 直接给出结果 x

f <*> xf 给出的结果 f1,和 x 组合的结果 x1 拼一块,给出结果 f1 x1

“拼一块”那个组合,可以这么实现

(pure (++) <*> foo) <*> bar
pure (++) <*> foo <*> bar -- 因为左结合
(++) <$> foo <*> bar -- <$> 就是 fmap
                     -- 其实是一样的,想想为什么

A_LCAApplicative 实现并不难写

instance Applicative A_LCA where
  pure x = A_LCA [] (const x)
  A_LCA q1 f <*> A_LCA q2 x
    = let newVal xs
            = case splitAt (length q1) xs of

在这里,我们把列表按长度分成两半。因为我们可以认为,a_lcaValue 被调用时传入的列表是可以和查询列表 a_lcaQueries 对应的。

                (m, n) -> f m (x n)
      in A_LCA (q1 ++ q2) newVal

当然,基础的操作:

a_query :: Int -> Int -> A_LCA Int
a_query x y = A_LCA [(x, y)] (\[u] -> u)

没有问题,也是可以用的

ghci> let qr = (,,) <$> a_query 6 7 <*> a_query 8 10 <*> a_query 9 5
qr :: A_LCA (Int, Int, Int)
ghci> a_lcaQueries qr
[(6,7),(8,10),(9,5)]
it :: [(Int, Int)]
ghci> a_lcaValue qr [1, 2, 3]
(1,2,3)
it :: (Int, Int, Int)

这个对应着什么?当然就是离线 LCA 了。

Monad 的 LCA

每次查询输入的是 (x, y),可惜不一定查询的是 lca(u, v)

询问 (u, v) 由下列规则产生(OIER都知道是怎样的吧>_<)
u=min((x+lastans)mod n+1,(y+lastans)mod n+1);
v=max((x+lastans)mod n+1,(y+lastans)mod n+1);
lastans表示上一个询问的答案,一开始lastans为0

当然你知道,更险恶的是这个:

注意出题人为了方便,input的第二行最后多了个空格。

最一般的情况,我们可能每个查询,其实是依赖于前面的结果的。最一般的依赖,是一个函数。

depend :: f a -> (a -> f b) -> f (a, b)

我可以在一个已经造好的程序,后面续上一个函数,从前面程序的结果,映射到我后面需要续上的程序。你得把两个结果都给我。

其实可以直接让你算最后一个值就可以了,显然你前面必须算过才能得出最后这个:

(>>=) :: f a -> (a -> f b) -> f b

用这个可以定义 depend

u `depend` f = u >>= (\k -> (\p -> (k, p)) <$> f k)

现在是 2016 年底了,Monad 很只剩下一个必须定义的方法:

class Applicative m => Monad m where
  (>>=) :: m a -> (a -> m b) -> m b

对了,一般是 Monad m 而不是 Monad f

data M_LCA a
  = FinalResult a
  | Query (Int, Int) (Int -> M_LCA a)

每一个不是直接给出结果的程序,必定有其第一个查询的 LCA。以后的查询,依赖于这个第一次查询的结果。

我真懒:

  deriving (Functor)

你需要在文件顶上加上一个这个

{-# LANGUAGE DeriveFunctor #-}

每次我告诉你我要 Query 的时候,你信心满满地告诉我答案,等待着你的却是更多的 Query,直到得到 FinalResult。完美。

instance Applicative M_LCA where
  pure = FinalResult

真・最终结果

  (<*>) = ap

ap 我待会儿解释

instance Monad M_LCA where
  FinalResult a >>= f

如果我们已经知道结果是什么了,lastans 就确定是 a 了,把它传进去就行了。

    = f a
  Query uv a >>= f

否则,我们假装已经得到了这一次的查询结果

    = Query uv (\k ->

然后,告诉 a,看它返回的续上的程序是什么。我们这就得到了一个少一次查询的 M_LCA a,可以递归调用 (>>=)

        a k >>= f)

整理一下

instance Monad M_LCA where
  FinalResult a >>= f = f a
  Query uv a >>= f
    = Query uv (\k -> a k >>= f)

基本操作并没有什么不好写的

m_query :: Int -> Int -> M_LCA Int
m_query x y = Query (x, y) (\u -> FinalResult u)

不过这个好像没法直接查看查询输出结果了?咱写个 interactive 的。

run :: M_LCA a -> IO a
run (FinalResult x) = pure x
run (Query uv f) = do
  putStrLn $ "Result of " ++ show uv ++ "?"
  r <- read <$> getLine
  run (f r)

do(>>=) 的对应是这样的

do { x <- e; ... } = e >>= \x -> ...
do { e ; ... } = e >>= \_ -> ...
do { e } = e

do block 简写成一行了,展开大概是这样的

do { a ; b ; c }
= do a
     b
     c

试试吧,我们先查询 k = lca(2, 3),然后查询 lca(k, k + 1)

m_test :: M_LCA Int
m_test = do
  k <- m_query 2 3
  m_query k (k + 1)

展开成 (>>=) 是这样的:

m_test = m_query 2 3 >>= \k -> m_query k (k + 1)

ghci> run m_test
Result of (2,3)?
54                        -- 键盘输入
Result of (54,55)?
0                         -- 键盘输入
0                         -- 结果输出

看起来不错

为了帮助你理解 M_LCA,我们也可以把 m_test 完全展开:

m_test = Query (2, 3) (\k -> Query (k, k + 1) FinalResult)

当然,像这样的就是前面给的那个险恶的东西的处理办法了

foo = Query (x1, y1) (\lastans1 ->
        Query ( (lastans + x2) `mod` (n + 1)
              , (lastans + y2) `mod` (n + 1))
              (\lastans2 -> ...))

你已经成功定义了一个有意思的 Monad 了。

事实上,这个 Monad 用常规方法不好定义,所以咱们在 M_LCA 里手动发明了一波 free monad。这个可以以后讲。

练习

代码在这里