haskell - 用状态单子打结

Question

我正在处理一个涉及打结的 Haskell 项目：我正在解析图形的序列化表示，其中每个节点都位于文件的某个偏移量处，并且可能通过其偏移量引用另一个节点。do rec所以我需要在解析时建立一个从偏移量到节点的映射，我可以在一个块中反馈给自己。

我有这个工作，并且有点合理地抽象成一个StateT-esque monad 转换器：

{-# LANGUAGE DoRec, GeneralizedNewtypeDeriving #-}

import qualified Control.Monad.State as S

data Knot s = Knot { past :: s, future :: s }

newtype RecStateT s m a = RecStateT (S.StateT (Knot s) m a) deriving
  ( Alternative
  , Applicative
  , Functor
  , Monad
  , MonadCont
  , MonadError e
  , MonadFix
  , MonadIO
  , MonadPlus
  , MonadReader r
  , MonadTrans
  , MonadWriter w )

runRecStateT :: RecStateT s m a -> Knot s -> m (a, Knot s)
runRecStateT (RecStateT st) = S.runStateT st

tie :: MonadFix m => RecStateT s m a -> s -> m (a, s)
tie m s = do
  rec (a, Knot s' _) <- runRecStateT m (Knot s s')
  return (a, s')

get :: Monad m => RecStateT s m (Knot s)
get = RecStateT S.get

put :: Monad m => s -> RecStateT s m ()
put s = RecStateT $ S.modify $ \ ~(Knot _ s') -> Knot s s'

该tie函数是魔法发生的地方：调用runRecStateT产生一个值和一个状态，我将其作为它自己的未来提供。请注意，它get允许您读取过去和未来的状态，但put只允许您修改“现在”。

问题 1：一般来说，这似乎是实现这种打结模式的一种不错的方式吗？或者更好的是，是否有人对此实施了通用解决方案，而我在窥探 Hackage 时忽略了这一点？我用头撞了一下Contmonad，因为它看起来可能更优雅（参见Dan Burton的类似帖子），但我就是无法解决。

完全主观的问题 2：我对我的调用代码最终看起来的方式并不完全兴奋：

do
  Knot past future <- get
  let {- ... -} = past
      {- ... -} = future
      node = {- ... -}
  put $ {- ... -}
  return node

显然，这里省略了实现细节，重要的一点是我必须在 let 绑定past中获取和future状态，模式匹配它们（或显式使先前的模式变得惰性）以提取我关心的任何内容，然后构建我的节点，更新我的状态，最后返回节点。似乎不必要地冗长，而且我特别不喜欢意外地使提取and状态的模式变得严格是多么容易。那么，有人能想到更好的界面吗？pastfuture

Answer 1

我在题为Assembly: Circular Programming with Recursive do上写了一篇关于这个主题的文章，我在其中描述了使用打结构建汇编程序的两种方法。像您的问题一样，汇编程序必须能够解析文件中稍后可能出现的标签地址。

Answer 2

关于实现，我将它作为一个 Reader monad（用于未来）和一个 State monad（用于过去/现在）的组合。原因是您只设置了一次未来（在 中tie），然后不要更改它。

{-# LANGUAGE DoRec, GeneralizedNewtypeDeriving #-}

import Control.Monad.State
import Control.Monad.Reader
import Control.Applicative

newtype RecStateT s m a = RecStateT (StateT s (ReaderT s m) a) deriving
  ( Alternative
  , Applicative
  , Functor
  , Monad
  , MonadPlus
  )

tie :: MonadFix m => RecStateT s m a -> s -> m (a, s)
tie (RecStateT m) s = do
  rec (a, s') <- flip runReaderT s' $ flip runStateT s m
  return (a, s')

getPast :: Monad m => RecStateT s m s
getPast = RecStateT get

getFuture :: Monad m => RecStateT s m s
getFuture = RecStateT ask

putPresent :: Monad m => s -> RecStateT s m ()
putPresent = RecStateT . put

关于您的第二个问题，了解您的数据流会有所帮助（即有一个最小的代码示例）。严格的模式总是导致循环是不正确的。确实，您需要小心，以免创建非生产循环，但确切的限制取决于您正在构建的内容和方式。

Answer 3

我一直在玩一些东西，我想我想出了一些……有趣的东西。我称它为“Seer”monad，它提供（除了 Monad 操作之外）两个原始操作：

see  :: Monoid s => Seer s s
send :: Monoid s => s -> Seer s ()

和运行操作：

runSeer :: Monoid s => Seer s a -> a

这个单子的工作方式是see允许一个先知看到一切，并send允许一个先知“发送”信息给所有其他的先知让他们看到。每当任何一个 Seer 执行see操作时，他们都能够看到所有已发送的信息，以及所有将要发送的信息。换句话说，在给定的运行中，see无论何时何地调用它，总是会产生相同的结果。另一种说法see是你如何获得对“打结”结的工作参考。

这实际上与 using 非常相似，只是fix所有子部分都是增量和隐式添加的，而不是显式添加的。显然，在存在悖论的情况下，先知将无法正常工作，需要足够的惰性。例如，see >>= send可能会导致信息爆炸，使您陷入时间循环。

一个愚蠢的例子：

import Control.Seer
import qualified Data.Map as M
import Data.Map (Map, (!))

bar :: Seer (Map Int Char) String
bar = do
  m <- see
  send (M.singleton 1 $ succ (m ! 2))
  send (M.singleton 2 'c')
  return [m ! 1, m ! 2]

正如我所说，我只是在玩弄，所以我不知道这是否比你所拥有的更好，或者它是否有任何好处！但它很漂亮，也很相关，如果你的“结”状态是 a Monoid，那么它可能对你有用。公平警告：我Seer使用Tardis.

https://github.com/DanBurton/tardis/blob/master/Control/Seer.hs

Answer 4

我最近遇到了类似的问题，但我选择了不同的方法。递归数据结构可以表示为数据类型函子上的类型固定点。然后可以将加载数据分为两部分：

• 将数据加载到仅通过某种标识符引用其他节点的结构中。在示例中Loader Int (NodeF Int)，它构造了一个类型值的映射NodeF Int Int。
• 通过用实际数据替换标识符来创建递归数据结构来打结。在示例中，生成的数据结构具有 type Fix (NodeF Int)，为了方便起见，它们稍后被转换Node Int为。

它缺乏适当的错误处理等，但这个想法应该很清楚。

-- Public Domain

import Control.Monad
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromJust)

-- Fixed point operator on types and catamohism/anamorphism methods
-- for constructing/deconstructing them:

newtype Fix f = Fix { unfix :: f (Fix f) }

catam :: Functor f => (f a -> a) -> (Fix f -> a)
catam f = f . fmap (catam f) . unfix

anam :: Functor f => (a -> f a) -> (a -> Fix f)
anam f = Fix . fmap (anam f) . f

anam' :: Functor f => (a -> f a) -> (f a -> Fix f)
anam' f = Fix . fmap (anam f)

-- The loader itself

-- A representation of a loader. Type parameter 'k' represents the keys by
-- which the nodes are represented. Type parameter 'v' represents a functor
-- data type representing the values.
data Loader k v = Loader (Map k (v k))

-- | Creates an empty loader.
empty :: Loader k v
empty = Loader $ Map.empty

-- | Adds a new node into a loader.
update :: (Ord k) => k -> v k -> Loader k v -> Loader k v
update k v = update' k (const v)

-- | Modifies a node in a loader.
update' :: (Ord k) => k -> (Maybe (v k) -> (v k)) -> Loader k v -> Loader k v
update' k f (Loader m) = Loader $ Map.insertWith (const (f . Just)) k (f Nothing) $ m

-- | Does the actual knot-tying. Creates a new data structure
-- where the references to nodes are replaced by the actual data.
tie :: (Ord k, Functor v) => Loader k v -> Map k (Fix v)
tie (Loader m) = Map.map (anam' $ \k -> fromJust (Map.lookup k m)) m


-- -----------------------------------------------------------------
-- Usage example:

data NodeF n t = NodeF n [t]
instance Functor (NodeF n) where
    fmap f (NodeF n xs) = NodeF n (map f xs)

-- A data structure isomorphic to Fix (NodeF n), but easier to work with.
data Node n = Node n [Node n]
  deriving Show
-- The isomorphism that does the conversion.
nodeunfix :: Fix (NodeF n) -> Node n
nodeunfix = catam (\(NodeF n ts) -> Node n ts)

main :: IO ()
main = do
    -- Each node description consist of an integer ID and a list of other nodes
    -- it references.
    let lss = 
            [ (1, [4])
            , (2, [1])
            , (3, [2, 1])
            , (4, [3, 2, 1])
            , (5, [5])
            ]
    print lss
    -- Fill a new loader with the data:
    let
        loader = foldr f empty lss
        f (label, dependsOn) = update label (NodeF label dependsOn)
    -- Tie the knot:
    let tied' = tie loader
    -- And convert Fix (NodeF n) into Node n:
    let tied = Map.map nodeunfix tied'

    -- For each node print the label of the first node it references
    -- and the count of all referenced nodes.
    print $ Map.map (\(Node n ls@((Node n1 _) : _)) -> (n1, length ls)) tied

Answer 5

我对 Monad 的使用量有点不知所措。我可能不理解过去/未来的事情，但我猜你只是想表达惰性+固定点绑定。（如果我错了，请纠正我。）RWSR=W 的 Monad 用法有点有趣，但是当你可以用 . 做同样的事情时，你不需要State和。如果 Monads 不能让事情变得更容易，那么使用 Monads 是没有意义的。（无论如何，只有极少数 Monad 代表时间顺序。）loopfmap

我打结的一般解决方案：

1. 我将所有内容解析为节点列表，
2. 将该列表转换Data.Vector为 O(1) 访问装箱（=惰性）值的列表，
3. let使用or函数将该结果绑定到名称fix，mfix
4. 并在解析器中访问名为 Vector 的名称。（见1。）

---

那个example解决方案在你的博客中，你写的地方。像这样：

data Node = Node {
  value :: Int,
  next  :: Node
} deriving Show
…
tie = …
parse = …
data ParserState = …
…
example :: Node
example =
  let (_, _, m) = tie parse $ ParserState 0 [(0, 1), (1, 2), (2, 0)]
  in (m Map.! 0)

我会这样写：

{-# LANGUAGE ViewPatterns, NamedFieldPuns #-}
import Data.Vector as Vector

example :: Node
example =
   let node :: Int -> Node
       node = (Vector.!) $ Vector.fromList $
                   [ Node{value,next}
                   | (value,node->next) <- [(0, 1), (1, 2), (2, 0)]
                   ]
   in (node 0)

或更短：

{-# LANGUAGE ViewPatterns, NamedFieldPuns #-}
import Data.Vector as Vector

example :: Node
example = (\node->(Vector.fromList[ Node{value,next}
                                  | (value,node->next) <- [(0, 1), (1, 2), (2, 0)]
                                  ] Vector.!)) `fix` 0