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时我忽略了吗？我有一段时间对着Cont monad击败了我的头，因为它似乎更优雅（见Dan Burton的similar post），但我无法解决它。

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

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

这里省略了实现细节，显然，重要的是我必须得到past和future状态，在let绑定中将它们与进行模式匹配（或者显式地使前一个模式变得懒惰）提取我关心的任何东西，然后构建我的节点，更新我的状态，最后返回节点。看起来不必要地冗长，我特别不喜欢意外地制作提取past和future状态严格的模式是多么容易。那么，任何人都可以想到更好的界面吗？

Answer 1

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

Answer 2

关于实施，我将把它作为一个读者monad（未来）和一个状态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

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

这实际上非常类似于仅使用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]

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

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

Answer 4

我对Monad的使用量感到不知所措。我可能不了解过去/未来的事情，但我猜你只是想表达懒惰+修复点绑定。（如我错了请纠正我。）使用R = W的RWS Monad用法很有趣，但是当您对State执行相同操作时，您不需要loop和fmap。使用Monads是没有意义的，如果他们不简化。（无论如何，只有极少数Monad代表时间顺序。）

我解决结的一般解决方案：

我解析一切到节点列表
将该列表转换为Data.Vector，以便O（1）访问盒装（=懒惰）值，
使用let或fix或mfix函数将结果绑定到名称，
并在解析器中访问名为Vector的文件。（参见 1。）

blog中的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

Answer 5

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

仅通过某种标识符将数据加载到仅引用其他节点的结构中。在示例中，Loader Int (NodeF Int)构建了NodeF Int Int类型值的地图。
通过将标识符替换为实际数据来创建递归数据结构来打结。在示例中，结果数据结构的类型为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

用状态monad绑结

5 个答案: