在Haskell中模拟交互有状态的对象

Question

我正在编写一个Haskell程序，涉及模拟抽象机器，该机器具有内部状态，可以输入和输出。我知道如何使用状态单子实现这一点，这会产生更清晰、更易管理的代码。

我的问题是，当我有两个（或更多）有状态的对象相互交互时，我不知道如何使用相同的技巧。下面是问题的高度简化版本，并概述了我目前的情况。

为了解决这个问题，假设机器的内部状态仅由一个整数寄存器组成，因此它的数据类型为：

data Machine = Register Int
        deriving (Show)

实际机器可能有多个寄存器、程序指针、调用堆栈等等，但现在我们不用担心这些。在之前的问题中，我知道如何使用状态单子来实现该机器，因此我不必显式地传递其内部状态。在这个简化的例子中，导入Control.Monad.State.Lazy后，实现看起来像这样:

addToState :: Int -> State Machine ()
addToState i = do
        (Register x) <- get
        put $ Register (x + i)

getValue :: State Machine Int
getValue = do
        (Register i) <- get
        return i

这让我可以编写类似以下的内容：

program :: State Machine Int
program = do
        addToState 6
        addToState (-4)
        getValue

runProgram = evalState program (Register 0)

这段代码将6加到寄存器中，然后减去4，并返回结果。状态单子模式跟踪机器的内部状态，以便“程序”代码不必显式地跟踪它。

在面向对象风格的命令式语言中，“程序”代码可能看起来像：

def runProgram(machine):
    machine.addToState(6)
    machine.addToState(-4)
    return machine.getValue()

在这种情况下，如果我想模拟两台机器相互交互，我可能会写成：

def doInteraction(machine1, machine2):
    a = machine1.getValue()
    machine1.addToState(-a)
    machine2.addToState(a)
    return machine2.getValue()

这段代码将machine1的状态设置为0，将其值添加到machine2的状态中并返回结果。

我的问题很简单，就是如何用Haskell编写这种命令式代码的典型方式？最初我认为需要链接两个状态单子，但在Benjamin Hodgson的提示下，我意识到应该能够使用单个状态单子来完成，其中状态是包含两个机器的元组。

问题是我不知道如何以漂亮干净的命令式风格实现它。目前我有以下代码，虽然可以工作，但不够优雅且易错：

interaction :: State (Machine, Machine) Int
interaction = do
        (m1, m2) <- get
        let a = evalState (getValue) m1
        let m1' = execState (addToState (-a)) m1
        let m2' = execState (addToState a) m2
        let result = evalState (getValue) m2'
        put $ (m1',m2')
        return result

doInteraction = runState interaction (Register 3, Register 5)

类型签名 interaction :: State (Machine, Machine) Int 是 Python 函数声明 def doInteraction(machine1, machine2): 的一个好的直接翻译，但这段代码是脆弱的，因为我使用显式的 let 绑定将状态线程化通过函数。这要求我每次想要改变其中一台机器的状态时都要引入一个新名称，这反过来又意味着我必须手动跟踪哪个变量表示最新的状态。对于更长时间的交互，这很可能使代码容易出错并且难以编辑。

我希望结果与 Lenses 有关。问题是我不知道如何在两台机器中只运行单个 monadic 操作。Lenses 有一个运算符 <<~，其文档说“运行一个 monadic 操作，并将 Lens 的目标设置为其结果”，但此操作在当前 monad 中运行，其中状态类型为 (Machine, Machine) 而不是 Machine。

所以现在我的问题是，如何以更具命令式 / 面向对象的风格实现上述的 interaction 函数，使用状态 monads（或其他技巧）隐式地跟踪两台机器的内部状态，而无需显式地传递状态？

最后，我意识到，在一个纯函数语言中想要编写面向对象的代码可能是我正在做错事的迹象，因此我非常愿意展示另一种思考模拟多个有状态的东西相互作用问题的方法。基本上，我只想知道在 Haskell 中处理这种问题的“正确方式”。

- N. Virgo

---

我发现了Gabriel Gonzales的[这个页面]（http://www.haskellforall.com/2013/05/program-imperatively-using-haskell.html），它采用了与我想象中不同的方法。它使用一个状态单子，其中状态是包含所有对象的“宇宙”，并使用镜头从该宇宙内挑选和修改对象。这个想法对于我的应用程序似乎有意义，所以如果我在这里得不到任何答案，我想我会通过这种方式来解决问题。 - N. Virgo

没问题，Gonzales提出的方法是正确的。这也是将你的Python代码直接翻译成Haskell的最佳方式。def doInteraction(machine1, machine2)被翻译为doInteraction :: State (Machine, Machine) Int。 - Benjamin Hodgson

使用惰性State来模拟抽象机器对我来说似乎非常奇怪。您确定不想使用通常的“严格”State吗？我在“严格”一词周围加上引号，因为它的严格性仅来自对成对操作执行案例分析，而不是执行任何奇怪的操作。惰性State才是奇怪的。 - dfeuer

你不需要使用惰性状态来让机器懒惰地消耗输入，而是为了惰性地产生结果（只运行机器足够长的时间以产生所需部分的结果）。在任何情况下，你的机器都可以随时停止。通常建议你坚持使用严格状态，除非你真正需要惰性状态。 - dfeuer

@dfeuer 我明白了，谢谢你的帮助。也许有一天我会需要它，例如如果我想让一台机器生成一个无限的输出流供另一台机器消费，并由第二台机器决定何时停止。但是今天我不需要，所以我会切换到严格版本。 - N. Virgo

Answer 1

我认为最佳实践是应该创建一个System数据类型来包装您的两台计算机，然后最好使用lens。

{-# LANGUAGE TemplateHaskell, FlexibleContexts #-}

import Control.Lens
import Control.Monad.State.Lazy

-- With these records, it will be very easy to add extra machines or registers
-- without having to refactor any of the code that follows
data Machine = Machine { _register :: Int } deriving (Show)
data System = System { _machine1, _machine2 :: Machine } deriving (Show)

-- This is some TemplateHaskell magic that makes special `register`, `machine1`,
-- and `machine2` functions.
makeLenses ''Machine
makeLenses ''System


doInteraction :: MonadState System m => m Int
doInteraction = do
    a <- use (machine1.register)
    machine1.register -= a
    machine2.register += a
    use (machine2.register)

此外，为了测试这段代码，我们可以在GHCi中检查它是否符合我们的期望：

ghci> runState doInteraction (System (Machine 3) (Machine 4))
(7,System {_machine1 = Machine {_register = 0}, _machine2 = Machine {_register = 7}})

优点：

• By using records and lens, there will be no refactoring if I decide to add extra fields. For example, say I want a third machine, then all I do is change System:

  data System = System
    { _machine1, _machine2, _machine3 :: Machine } deriving (Show)
  

  But nothing else in my existing code will change - just now I will be able to use machine3 like I use machine1 and machine2.

• By using lens, I can scale more easily to nested structures. Note that I just avoided the very simple addToState and getValue functions completely. Since a Lens is actually just a function, machine1.register is just regular function composition. For example, lets say I want a machine to now have an array of registers, then getting or setting particular registers is still simple. We just modify Machine and doInteraction:

  import Data.Array.Unboxed (UArray)
  data Machine = Machine { _registers :: UArray Int Int } deriving (Show)
  
  -- code snipped
  
  doInteraction2 :: MonadState System m => m Int
  doInteraction2 = do
      Just a <- preuse (machine1.registers.ix 2) -- get 3rd reg on machine1
      machine1.registers.ix 2 -= a               -- modify 3rd reg on machine1
      machine2.registers.ix 1 += a               -- modify 2nd reg on machine2
      Just b <- preuse (machine2.registers.ix 1) -- get 2nd reg on machine2
      return b
  

  Note that this is equivalent to having a function like the following in Python:

  def doInteraction2(machine1,machine2):
    a = machine1.registers[2]
    machine1.registers[2] -= a
    machine2.registers[1] += a
    b = machine2.registers[1]
    return b
  

  You can again test this out on GHCi:

  ghci> import Data.Array.IArray (listArray)
  ghci> let regs1 = listArray (0,3) [0,0,6,0]
  ghci> let regs2 = listArray (0,3) [0,7,3,0]
  ghci> runState doInteraction (System (Machine regs1) (Machine regs2))
  (13,System {_machine1 = Machine {_registers = array (0,3) [(0,0),(1,0),(2,0),(3,0)]}, _machine2 = Machine {_registers = array (0,3) [(0,0),(1,13),(2,3),(3,0)]}})
  

编辑

原始问题中要求将一个状态机（State Machine a）嵌入到一个状态系统（State System a）中。像往常一样，如果您仔细挖掘，lens库就提供了这样的功能。 zoom（以及其姐妹函数magnify）提供了从State/Reader中“放大”和“缩小”的工具（只能从 State 中放大并从 Reader 中缩小）。

然后，如果我们希望在保持getValue和addToState作为黑盒子的情况下实现doInteraction，我们可以得到以下结果：

getValue :: State Machine Int
addToState :: Int -> State Machine ()

doInteraction3 :: State System Int
doInteraction3 = do
  a <- zoom machine1 getValue     -- call `getValue` with state `machine1`
  zoom machine1 (addToState (-a)) -- call `addToState (-a)` with state `machine1` 
  zoom machine2 (addToState a)    -- call `addToState a` with state `machine2`
  zoom machine2 getValue          -- call `getValue` with state `machine2`

需要注意的是，如果我们这样做，我们必须真正致力于特定状态单子变换器（而不是通用的MonadState），因为并不是所有存储状态的方式都可以以这种方式进行“缩放”。话虽如此，RWST是另一个由zoom支持的状态单子变换器。

- Alec

---

谢谢，这很接近我想要做的事情。我一直在学习镜头，我已经接近这个程度了。我卡住的地方是，在你写machine2.register += a的地方，我想写类似于machine2 ~. addToState a的东西，其中~.基本上会执行runState addToState [value pointed at by the lens]，然后用新状态替换镜头指向的值，并返回结果值。原因是实际上我不仅想从寄存器中添加和减去，而且还要执行复杂的操作，既改变机器的状态，又返回一个值。 - N. Virgo

@Nathaniel 通过 <~ 可以实现你想要的吗？然后你可以做这样的事情 machine1.register <~ randomIO.... 如果这不是你的意思，能否给出一个更精确的例子？ - Alec

也许这是一个更清晰的表述方式：想象一下，我想在系统中只调用一个机器上的 runProgram 方法，并且不仅希望更新该机器的状态，还希望获取程序返回的结果。我该怎么做呢？ - N. Virgo

@Nathaniel 我已经编辑了我的答案，以符合我认为你所需要的。我很好奇是否还有其他人有更简单的方法... - Alec

太好了，这似乎正是我想要的。我不确定无法使用MonadState会带来什么影响，但现在看起来似乎还没有问题。（我会过一段时间再接受。） - N. Virgo

Answer 2

一种选择是将状态转换成操作 Machine 值的纯函数：

getValue :: Machine -> Int
getValue (Register x) = x

addToState :: Int -> Machine -> Machine
addToState i (Register x) = Register (x + i)

然后，您可以根据需要将它们提升到State，在多台机器上编写如下所示的State操作：

doInteraction :: State (Machine, Machine) Int
doInteraction = do
  a <- gets $ getValue . fst
  modify $ first $ addToState (-a)
  modify $ second $ addToState a
  gets $ getValue . snd

其中first（相应地，second）是来自Control.Arrow的函数，此处使用以下类型：

(a -> b) -> (a, c) -> (b, c)

也就是说，它修改了元组的第一个元素。

然后，runState doInteraction (Register 3, Register 5) 如预期地产生 (8, (Register 0, Register 8))。

（一般来说，我认为你可以使用镜头对子值进行“缩放”，但我不熟悉足以提供示例。）

- Jon Purdy

Answer 3

您也可以使用Gabriel Gonzales的Pipes库来实现您所展示的场景。该库的教程是存在的Haskell文档中最好的一篇。下面展示了一个简单的例子（未经测试）：

-- machine 1 adds its input to current state
machine1 :: (MonadIO m) => Pipe i o m ()
machine1 = flip evalStateT 0 $ forever $ do
               -- gets pipe input
               a <- lift await
               -- get current local state
               s <- get
               -- <whatever>
               let r = a + s
               -- update state
               put r
               -- fire down pipeline
               yield r

-- machine 2 multiplies its input by current state
machine2 :: (MonadIO m) => Pipe i o m ()
machine2 = flip evalStateT 0 $ forever $ do
               -- gets pipe input
               a <- lift await
               -- get current local state
               s <- get
               -- <whatever>
               let r = a * s
               -- update state
               put r
               -- fire down pipeline
               yield r

您可以使用 >-> 运算符进行组合。例如，运行：

run :: IO ()
run :: runEffect $ P.stdinLn >-> machine1 >-> machine2 >-> P.stdoutLn

请注意，可以使用双向管道来实现两台计算机之间的通信，但操作稍微复杂一些。使用其他一些管道生态系统，您还可以拥有异步管道，以模拟机器的非确定性或并行操作。

我相信使用conduit库也可以实现相同效果，但我没有太多经验。

- OllieB

---

这看起来非常不错。它似乎更符合协程的模式，而不是我想象中更基于对象的模型。（粗略地说，这种区别在于，在协程中，有状态对象可以自己选择下一步要做什么，而在面向对象编程中，这个选择由调用函数来决定。）协程是大多数命令式语言中缺少的超级有用的特性，所以我很高兴知道Haskell中存在这种特性。 - N. Virgo

是的，这是一种不同的模型。它允许您独立编写机器的行为，并通过组合它们来建模它们的交互，而不是在顶层编写程序。当然，这可能并不是您想要的，但很高兴它存在。我发现它在执行有状态的 DSP 管道时非常有用，因为它允许您一次只专注于一个算法。 - OllieB