使用 Monad/ST 在可变图中传递非并发消息答案

【问题标题】：Using Monad/ST for non-concurrent message passing in a mutable graph使用 Monad/ST 在可变图中传递非并发消息
【发布时间】：2014-09-11 00:07:38
【问题描述】：

我正在尝试为以下情况制定数据结构。

图形结构

我计划制作一个带有未加权有向边的节点图：Graph = [Node]

每个节点都有：

一些 TBD 内部（持久）状态
传入消息队列
它可以发送的消息类型由接受的函数确定当前节点状态（有失败的可能性）
边列表

Node { nodeState :: NodeState, inbox :: Queue NodeMessage, nodeMessage :: (NodeState -> Maybe NodeMessage), connections::[NodeEdge] }

每条边都是为目标节点捕获待处理消息的中间步骤

NodeEdge { pendingMessage:: Maybe NodeMessage, targetNode :: Node }

消息传递

消息传递是分阶段进行的，并且是不同步的（尽管队列可以并行处理以减少计算时间）。

第 1 阶段：检查每个节点的收件箱，处理所有消息并更新 NodeState（如果相关）。
第 2 阶段：让每个节点运行 nodeMessage，如果这导致 Just NodeMessage，则向每个连接发送 NodeMessage ([NodeEdge])
第 3 阶段：检查每个节点边缘，如果有消息，则将其添加到目标节点的消息队列中。

莫纳特/ST

我最初的计划是为每个节点分配一个 ID（可能是一个简单的 Int）并将每个节点存储在 Map Int 节点中。我之前没有尝试过 ST Monad，但我想我可以使用 ST s (M.Map Int Node) 之类的东西。对于任何给定阶段，每个节点的消息发送活动都可以在 O(k log N) 中处理。

另一方面，如果节点/边能够更新其边/节点的可变状态，那么任何单个队列都可以在 O(k) 中处理。

虽然 ST/Map 方法看起来相当直观，但让整个图可变却超出了我的能力范围。

有什么建议/提示/推荐阅读吗？

【问题讨论】：

您似乎希望您的图表对于某些函数是纯的，但对于其他函数是可变的。您可以通过简单地使用 2 种图形类型来实现这一点，或者（更多打字但更漂亮）编写 data NodeEdge f = NodeEdge (Maybe NodeMessage) (f (Node f)) 并让 f==Identity 用于不可变图形和 f==STRef s 用于可变图形。但是，如果您关心性能，您应该简单地使用更有效的表示形式（例如以IntSet 作为“列表”的邻接列表/矩阵）。
完全不熟悉邻接表。看看它们是如何工作的会很有趣。我应该看看任何特定的包裹吗？保留 2 个图表似乎有点混乱，但我的外观选项并没有变得更干净。为了性能，我决定使用数组。

标签： haskell state st-monad

【解决方案1】：

我不会将此答案标记为正确，因为它并没有真正回答问题。但是，这是我要使用的解决方案。

因为我的图表中的节点数永远不会改变，我意识到我可以使用数组。我实际上正在重新考虑使用可变数据类型——即使我得到了一个更简单的工作流程来更新数组，但我从懒惰中获得的好处更少，而且我最终编写了大量的命令式代码。我实际上正在考虑使用 Array 和 State Monad，而不是 ST。

这是我使用 STArray 编写的一些测试代码。这个问题的“正确”答案将是专门用于 Graphs 的类似数据类型 - 也许有一个 STGraph 库？

无论如何 - 这是使用 STArray 的示例代码：

import Control.Monad.ST
import Data.Array.ST
import Data.Array

import qualified Data.Dequeue as DQ

type Id = Int

data Node = Node {
    nodeId :: Id,
    nodeState :: NodeState,
    nodeInbox :: DQ.BankersDequeue NodeMessage,
    nodeMessage :: (NodeState -> Maybe NodeMessage),
    connections :: [NodeEdge] }

instance Show Node where
    show x = "Node: " ++ (show . nodeId $ x) ++ " :: Inbox: " ++ (show . nodeInbox $ x) ++ " :: " ++ (show . connections $ x)

data NodeEdge = NodeEdge { pendingMessage:: Maybe NodeMessage, targetNode :: Id } deriving Show

data NodeState = NodeState { stateLevel :: Int } deriving Show

data NodeMessage = NodeMessage { value :: Int } deriving Show

es = [[NodeEdge Nothing 1,NodeEdge Nothing 2],[NodeEdge Nothing 0,NodeEdge Nothing 2],[NodeEdge Nothing 0,NodeEdge Nothing 1]]
ns = take 3 $ map (\x -> Node x (NodeState 0) (DQ.fromList []) (\_ -> Nothing) (es !! x)) $ [0,1..]

testArray :: Array Int Node
testArray = listArray (0,2) ns

testSTarr = do  arr <- newListArray (0,2) ns :: ST s (STArray s Int Node)
                a <- readArray arr 1
                let i = targetNode . head $ connections a
                b <- readArray arr i
                let m = NodeMessage 2
                    ms = DQ.pushBack (nodeInbox b) m
                    b' = b { nodeInbox = ms }
                writeArray arr (nodeId b) b'
                return arr

testSTarr' x = do a <- readArray x 0
                  return a

bp = testSTarr >>= testSTarr'

main = do
            print $ runST bp 
            return ()

【讨论】：