Haskell中的精确流量控制

Question

理念

您好！我试图在Haskell中实现一个基于数据流意识形态的图像处理库。我遇到了与处理控制流程有关的问题。

主要思想是引入time。 time是一个Float，可以在代码中的任何位置访问（您可以将其视为状态monad，但有点有趣）。有趣的是，我们可以对结果使用timeShift操作，影响相应操作的时间。

最好用一个例子来解释这种情况。让我们使用以下数据流图：

--               timeShift(*2) --
--              /                 \
-- readImage --                    addImages -> out
--              \                 /
--                blur ----------

和它的伪代码（这不是类型检查 - 如果我们在这里使用或者记号，它不重要，这个想法应该是明确的）：

test = do
    f      <- frame
    a      <- readImage $ "test" + show f + ".jpg"
    aBlur  <- blur a
    a'     <- a.timeShift(*2)
    out    <- addImage aBlur a'

main = print =<< runStateT test 5

5是我们想要运行time函数的test。 timeShift函数会影响其左侧的所有操作（在数据流图中） - 在这种情况下，函数readImage将运行两次 - 对于两个分支 - 较低的一个将使用框架{{ 1}}和上一帧5。

问题

我在这里提供了一个非常简单的实现，效果很好，但我想解决一些注意事项。问题是，我想保持所有IO操作的顺序。以底部为例，这将阐明我的意思。

示例实施

下面是算法和代码的示例实现，它构造了以下数据流图：

5*2 = 10

代码：

-- A --- blur --- timeShift(*2) --
--                                \
--                                 addImages -> out
--                                /
-- B --- blur --------------------

输出结果为：

import Control.Monad.State

-- for simplicity, lets assume an Image is just a String
type Image = String

imagesStr = ["a0","b1","c2","d3","e4","f5","g6","h7","i8","j9","k10","l11","m12","n13","o14","p15","q16","r17","s18","t19","u20","v21","w22","x23","y24","z25"]
images = "abcdefghjiklmnoprstuwxyz"

--------------------------------
-- Ordinary Image processing functions

blurImg' :: Image -> Image
blurImg' img = "(blur " ++ img ++ ")"

addImage' :: Image -> Image -> Image
addImage' img1 img2 = "(add " ++ img1 ++ " " ++ img2 ++ ")"

--------------------------------
-- Functions processing Images in States

readImage1 :: StateT Int IO Image
readImage1 = do
    t <- get
    liftIO . putStrLn $ "[1] reading image with time: " ++ show t
    return $ imagesStr !! t

readImage2 :: StateT Int IO Image
readImage2 = do
    t <- get
    liftIO . putStrLn $ "[2] reading image with time: " ++ show t
    return $ imagesStr !! t

blurImg :: StateT Int IO Image -> StateT Int IO Image
blurImg img = do
    i <- img
    liftIO $ putStrLn "blurring"
    return $ blurImg' i

addImage :: StateT Int IO Image -> StateT Int IO Image -> StateT Int IO Image
addImage img1 img2 = do
    i1 <- img1
    i2 <- img2
    liftIO $ putStrLn "adding images"
    return $ addImage' i1 i2


timeShift :: StateT Int IO Image -> (Int -> Int) -> StateT Int IO Image
timeShift img f = do
    t <- get
    put (f t)
    i <- img
    put t
    return i

test = out where
    i1   = readImage1
    j1   = readImage2

    i2   = blurImg i1
    j2   = blurImg j1

    i3   = timeShift i2 (*2)
    out  = addImage i3 j2


main = do
    print =<< runStateT test 5
    print "end"

应该是：

[1] reading image with time: 10
blurring
[2] reading image with time: 5
blurring
adding images
("(add (blur k10) (blur f5))",5)
"end"

请注意，正确的输出为[1] reading image with time: 10 [2] reading image with time: 5 blurring blurring adding images ("(add (blur k10) (blur f5))",5) "end" - 这意味着我们将图片("(add (blur k10) (blur f5))",5)添加到k10 - 分别来自第10帧和第5帧。< / p>

进一步要求 我正在寻找一个解决方案，它允许用户编写简单的代码（比如在f5函数中 - 它当然可以在Monad中），但我不希望它们处理时移手工逻辑。

结论

唯一的区别是IO动作执行的顺序。我希望保留IO操作的顺序，就像它们在test函数中编写一样。我试图使用test，Countinuations和一些有趣的状态来实现这个想法，但没有成功。

Answer 1

Haskell中的数据流和功能反应式编程库通常用Applicative或Arrow来编写。这些是比Monad s更不通用的计算的抽象 - Applicative和Arrow类型类没有为计算结构提供依赖于其他计算结果的方法。结果，仅暴露这些类型类的库可以独立于执行那些计算而推断库中的计算结构。我们将根据Applicative类型类

来解决您的问题

class Functor f => Applicative f where
    -- | Lift a value.
    pure :: a -> f a    
    -- | Sequential application.
    (<*>) :: f (a -> b) -> f a -> f b

Applicative允许库用户使用pure进行新计算，使用fmap（来自Functor）对现有计算进行操作，并将计算与{{1}一起组合使用一次计算的结果作为另一种计算的输入。它不允许库用户进行进行另一次计算的计算，然后直接使用该计算的结果;用户无法编写<*>。此限制将使我们的库无法进入problem I described in my other answer。

变形金刚，免费和ApT变压器

您的示例问题非常复杂，因此我们将提出一些高级Haskell技巧，并制作一些我们自己的新技巧。我们要提取的前两个技巧是transformers和free数据类型。变形金刚是一种类型，它采用与join :: f (f a) -> f a s，Functor或Applicative类似的类型，并生成相同类型的新类型。

变形金刚通常看起来像以下Monad示例。 Double可以使用Double或Functor或Applicative，并制作一个始终包含两个值而不是一个

的版本

Monad

免费数据类型是做两件事的变形金刚。首先，给定底层类型的一些更简单的属性，获得转换类型的新兴奋属性。 newtype Double f a = Double {runDouble :: f (a, a)} Free提供Monad任意Monad，免费Functor，Applicative提供Ap任何Applicative。另一件事＆＃34;免费＆＃34;类型是"free" the implementation of the interpreter as much as possible。以下是免费Functor，Applicative，免费Ap，Monad和免费monad transfomer Free的类型。免费的monad变压器提供了一个monad变压器，用于免费的＆＃34;给出FreeT

Functor

这是我们目标的草图 - 我们希望提供一个-- Free Applicative data Ap f a where Pure :: a -> Ap f a Ap :: f a -> Ap f (a -> b) -> Ap f b -- Base functor of the free monad transformer data FreeF f a b = Pure a | Free (f b) -- Free monad transformer newtype FreeT f m a = FreeT {runFreeT :: m (FreeF f a (FreeT f m a)} -- The free monad is the free monad transformer applied to the Identity monad type Free f = FreeT f Identity 界面来组合计算，在底部允许Applicative计算。我们希望＆＃34;免费＆＃34;尽可能多的解释器，以便它可以有希望重新排序计算。为此，我们将结合免费的Monad和免费的monad变换器。

我们想要一个Applicative界面，最简单的界面是我们可以获得的＃34;免费＆＃34;，它与＃34的目标很好地对齐;释放互操作者＆＃34 34;越多越好。这表明我们的类型看起来像

Applicative

某些Ap f a Functor和任何f的

。我们希望基础计算超过一些a，而Monad s是仿函数，但我们希望＆＃34;免费＆＃34;翻译尽可能多。我们将免费的monad变换器作为Monad的底层函子，给我们

Ap

某些Ap (FreeT f m) a Functor，某些f Monad以及任何m的

。我们知道a Monad可能会m，但我们会尽可能保持代码的通用性。我们只需要为IO提供Functor。所有FreeT都是Applicatives，因此Functors本身可用于Ap，我们会写出类似

的内容

f

这使得编译器适合，因此我们将内部的type ApT m a = Ap (FreeT (ApT m) m) a 移动并定义

Ap

我们将为此得出一些实例，并在插曲后讨论其真实动机。

插曲

要运行所有此代码，您需要以下内容。 newtype ApT m a = ApT {unApT :: FreeT (Ap (ApT m)) m a} 和Map仅用于共享计算，稍后会更多。

Control.Concurrent

填充它

我在上一节误导了你，假装发现{-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Main where import Control.Monad.Trans.Class import Control.Monad.IO.Class import Control.Monad.Trans.Reader import Control.Applicative import Control.Applicative.Free hiding (Pure) import qualified Control.Applicative.Free as Ap (Ap(Pure)) import Control.Monad.Trans.Free import qualified Data.Map as Map import Control.Concurrent 对这个问题产生了共鸣。我实际上通过尝试任何事情和所有内容来尝试将ApT ic计算填充到ApT并且能够在它出现时控制它们的顺序时发现Monad。很长一段时间，我一直试图解决如何实现Applicative（下面）来编写mapApM（我的flipImage的替代品）。这里有blur ApT变形金刚的荣耀。它旨在用作Monad的{​​{1}}，并且使用Functor作为Ap作为Ap的{​​{1}}，可以神奇地将值填入Functor，这似乎不可能。

FreeT

它可以从Applicative派生更多实例，这些只是我们需要的实例。它无法导出newtype ApT m a = ApT {unApT :: FreeT (Ap (ApT m)) m a} deriving (Functor, Applicative, Monad, MonadIO) ，但我们可以自己做到：

FreeT

MonadTrans真正的美丽是我们可以编写一些看似不可能的代码，如

instance MonadTrans ApT where
    lift = ApT . lift

runApT :: ApT m a -> m (FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a))
runApT = runFreeT . unApT

外部的ApT消失，甚至消失在仅stuffM :: (Functor m, Monad m) => m (ApT m a) -> ApT m a stuffMAp :: (Functor m, Monad m) => m (ApT m a) -> Ap (ApT m) a 的{​​{1}}中。

这是因为下面的函数循环，每个函数都可以将上面函数的输出填充到它下面的函数的输入中。第一个函数以m开头，最后一个以一个结束。 （这些定义不是程序的一部分）

Ap

这让我们写

Applicative

用于处理变压器堆栈的一些实用功能

ApT m a

我们想开始编写我们的示例图像处理器，但首先我们需要采取另一种转移来满足硬性要求。

硬性要求 - 输入共享

您的第一个示例显示

liftAp' :: ApT m a ->
           Ap (ApT m) a
liftAp' = liftAp

fmapReturn :: (Monad m) =>
               Ap (ApT m) a ->
               Ap (ApT m) (FreeT (Ap (ApT m)) m a)
fmapReturn = fmap return

free' :: Ap (ApT m) (FreeT (Ap (ApT m)) m a) ->
         FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a)
free' = Free

pure' :: a ->
         FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a)
pure' = Pure

return' :: (Monad m) =>
           FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a) ->
           m (FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a))
return' = return

freeT :: m (FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a)) ->
         FreeT (Ap (ApT m)) m a
freeT = FreeT

apT :: FreeT (Ap (ApT m)) m a ->
       ApT m a
apT = ApT

暗示-- Get rid of an Ap by stuffing it into an ApT. stuffAp :: (Monad m) => Ap (ApT m) a -> ApT m a stuffAp = ApT . FreeT . return . Free . fmap return -- Stuff ApT into Free stuffApTFree :: (Monad m) => ApT m a -> FreeF (Ap (ApT m)) a (FreeT (Ap (ApT m)) m a) stuffApTFree = Free . fmap return . liftAp -- Get rid of an m by stuffing it into an ApT stuffM :: (Functor m, Monad m) => m (ApT m a) -> ApT m a stuffM = ApT . FreeT . fmap stuffApTFree -- Get rid of an m by stuffing it into an Ap stuffMAp :: (Functor m, Monad m) => m (ApT m a) -> Ap (ApT m) a stuffMAp = liftAp . stuffM 与mapFreeT :: (Functor f, Functor m, Monad m) => (m a -> m b) -> FreeT f m a -> FreeT f m b mapFreeT f fa = do a <- fa FreeT . fmap Pure . f . return $ a mapApT :: (Functor m, Monad m) => (m a -> m b) -> ApT m a -> ApT m b mapApT f = ApT . mapFreeT f . unApT mapApM :: (Functor m, Monad m) => (m a -> m b) -> Ap (ApT m) a -> Ap (ApT m) b mapApM f = liftAp . mapApT f . stuffAp 之间应分享-- timeShift(*2) -- -- / \ -- readImage -- addImages -> out -- \ / -- blur ---------- 的结果。我认为这意味着readImage的结果每次只应计算一次。

blur并不足以捕捉到这一点。我们将创建一个新的类型类来表示计算，其输出可以分成多个相同的流。

timeShift(*2)

我们将制作一个将此功能添加到现有readImage

的转换器

Applicative

并为其提供一些实用功能和实例

-- The class of things where input can be shared and divided among multiple parts
class Applicative f => Divisible f where
    (<\>) :: (f a -> f b) -> f a -> f b

图像处理器

随着我们所有变压器的到位，我们可以开始编写我们的图像处理器。在我们的堆栈底部，我们有来自前面部分的Applicative

-- A transformer that adds input sharing
data LetT f a where
    NoLet :: f a -> LetT f a
    Let   :: LetT f b -> (LetT f b -> LetT f a) -> LetT f a

计算需要能够从环境中读取时间，因此我们将为此添加-- A transformer that adds input sharing data LetT f a where NoLet :: f a -> LetT f a Let :: LetT f b -> (LetT f b -> LetT f a) -> LetT f a liftLetT :: f a -> LetT f a liftLetT = NoLet mapLetT :: (f a -> f b) -> LetT f a -> LetT f b mapLetT f = go where go (NoLet a) = NoLet (f a) go (Let b g) = Let b (go . g) instance (Applicative f) => Functor (LetT f) where fmap f = mapLetT (fmap f) -- I haven't checked that these obey the Applicative laws. instance (Applicative f) => Applicative (LetT f) where pure = NoLet . pure NoLet f <*> a = mapLetT (f <*>) a Let c h <*> a = Let c ((<*> a) . h) instance (Applicative f) => Divisible (LetT f) where (<\>) = flip Let

ApT

最后，我们希望能够共享计算，因此我们会在顶部添加Ap (ApT IO) 转换器，为我们的图像处理器提供整个类型ReaderT

ReaderT Int (Ap (ApT IO))

我们会从LetT读取图片。 IP制作有趣的互动示例。

type Image = String
type IP = LetT (ReaderT Int (Ap (ApT IO)))

我们可以改变投入的时间

IO

一起添加多个图像

getLine

翻转图片假装使用某些卡在readImage :: Int -> IP Image readImage n = liftLetT $ ReaderT (\t -> liftAp . liftIO $ do putStrLn $ "[" ++ show n ++ "] reading image for time: " ++ show t --getLine return $ "|image [" ++ show n ++ "] for time: " ++ show t ++ "|" ) 中的图书馆。我无法弄清楚如何timeShift :: (Int -> Int) -> IP a -> IP a timeShift f = mapLetT shift where shift (ReaderT g) = ReaderT (g . f) 字符串......

addImages :: Applicative f => [f Image] -> f Image
addImages = foldl (liftA2 (++)) (pure [])

解释LetT

我们的IO共享结果位于变换器堆栈的顶部。我们需要解释它以获得它下面的计算。要解释blur，我们需要一种方法来分享inIO :: (IO a -> IO b) -> IP a -> IP b inIO = mapLetT . mapReaderT . mapApM flipImage :: IP [a] -> IP [a] flipImage = inIO flip' where flip' ma = do a <- ma putStrLn "flipping" return . reverse $ a 提供的LetT中的结果，以及从堆栈顶部删除LetT转换器的插页器。< / p>

要共享计算，我们需要将它们存储在某处，IO在memoize中进行LetT计算，确保它只在多个线程中发生一次。

memoize

为了解释IO，我们需要将基础IO的求值程序合并到memoize :: (Ord k) => (k -> IO a) -> IO (k -> IO a) memoize definition = do cache <- newMVar Map.empty let populateCache k map = do case Map.lookup k map of Just a -> return (map, a) Nothing -> do a <- definition k return (Map.insert k a map, a) let fromCache k = do map <- readMVar cache case Map.lookup k map of Just a -> return a Nothing -> modifyMVar cache (populateCache k) return fromCache 绑定的定义中。由于计算结果取决于从Let读取的环境，我们将在此步骤中处理ApT IO。更复杂的方法是使用变换器类，但Let的变换器类是另一个问题的主题。

ReaderT

解释ApT

我们的口译员使用以下ReaderT来避免需要一直查看Applicative，compileIP :: (forall x. ApT IO x -> IO x) -> IP a -> IO (Int -> ApT IO a) compileIP eval (NoLet (ReaderT f)) = return (stuffAp . f) compileIP eval (Let b lf) = do cb <- compileIP eval b mb <- memoize (eval . cb) compileIP eval . lf . NoLet $ ReaderT (liftAp . lift . mb) 和State。

AsT

Interpereting FreeT比看起来更难。目标是获取FreeF中的数据并将其放入data State m a where InPure :: a -> State m a InAp :: State m b -> State m (b -> State m a) -> State m a InM :: m a -> State m a instance Functor m => Functor (State m) where fmap f (InPure a) = InPure (f a) fmap f (InAp b sa) = InAp b (fmap (fmap (fmap f)) sa) fmap f (InM m) = InM (fmap f m) 和Ap中的数据并将其放入Ap.Pure。 InPure每次进入更深层Ap时，实际上需要用更大的类型调用自己;该函数不断提出另一个论点。第一个参数InAp提供了一种简化这些爆炸类型的方法。

interpretAp

Ap从t，interpretAp :: (Functor m) => (a -> State m b) -> Ap m a -> State m b interpretAp t (Ap.Pure a) = t a interpretAp t (Ap mb ap) = InAp sb sf where sb = InM mb sf = interpretAp (InPure . (t .)) $ ap 和interperetApT以及ApT

中获取数据

FreeT

通过这些简单的口译，我们可以制定解释结果的策略。每个策略都是解释器FreeF到新State m的功能，可能会产生副作用。策略选择执行副作用的顺序决定了副作用的顺序。我们将制定两个示例策略。

第一个策略只对准备好计算的所有内容执行一步，并在结果准备就绪时合并。这可能就是你想要的策略。

interpretApT :: (Functor m, Monad m) => ApT m a -> m (State (ApT m) a)
interpretApT = (fmap inAp) . runApT
    where
        inAp (Pure a) = InPure a
        inAp (Free ap) = interpretAp (InM . ApT) $ ap

这个其他策略一旦知道就会执行所有计算。它一次完成所有这些。

State

许多其他策略都是可能的。

我们可以通过运行策略来评估策略，直到它产生单个结果。

State

执行intepreter

要执行解释器，我们需要一些示例数据。以下是一些有趣的例子。

stepFB :: (Functor m, Monad m) => State (ApT m) a -> m (State (ApT m) a)
stepFB (InM ma)   = interpretApT ma
stepFB (InPure a) = return (InPure a)
stepFB (InAp b f) = do
    sf <- stepFB f
    sb <- stepFB b
    case (sf, sb) of
        (InPure f, InPure b) -> return (f b)
        otherwise            -> return (InAp sb sf)

allFB :: (Functor m, Monad m) => State (ApT m) a -> m (State (ApT m) a) allFB (InM ma) = interpretApT ma allFB (InPure a) = return (InPure a) allFB (InAp b f) = do sf <- allFB f sb <- allFB b case (sf, sb) of (InPure f, InPure b) -> return (f b) otherwise -> allFB (InAp sb sf) 解释器需要知道用于绑定值的评估器，因此我们只定义一次评估器。单个untilPure :: (Monad m) => ((State f a) -> m (State f a)) -> State f a -> m a untilPure s = go where go state = case state of (InPure a) -> return a otherwise -> s state >>= go 通过查找解释器的初始example1 = (\i -> addImages [timeShift (*2) i, flipImage i]) <\> readImage 1 example1' = (\i -> addImages [timeShift (*2) i, flipImage i, flipImage . timeShift (*2) $ i]) <\> readImage 1 example1'' = (\i -> readImage 2) <\> readImage 1 example2 = addImages [timeShift (*2) . flipImage $ readImage 1, flipImage $ readImage 2] 来启动评估。

LetT

我们将编译interpretApT，这基本上是您的示例，并在第5时间运行。

State

产生几乎所需的结果，所有读数都在翻转之前发生。

evaluator :: ApT IO x -> IO x
evaluator = (>>= untilPure stepFB) . interpretApT

Answer 2

Monad无法重新排序构成img1和img2的组件步骤

addImage :: (Monad m) => m [i] -> m [i] -> m [i]
addImage img1 img2 = do
    i1 <- img1
    i2 <- img2
    return $ i1 ++ i2

如果存在任何m [i]，其结果取决于副作用。任何MonadIO m都有m [i]，其结果取决于副作用，因此您无法对img1和img2的组件步骤重新排序。

以上的desugars

addImage :: (Monad m) => m [i] -> m [i] -> m [i]
addImage img1 img2 =
    img1 >>=
        (\i1 ->
            img2 >>=
                (\i2 ->
                    return (i1 ++ i2)
                )
        )

让我们关注第一个>>=（记住(>>=) :: forall a b. m a -> (a -> m b) -> m b）。专门针对我们的类型，这是(>>=) :: m [i] -> ([i] -> m [i]) -> m [i]。如果我们要实现它，我们必须编写像

这样的东西

(img1 :: m [i]) >>= (f :: [i] -> m [i]) = ... 

为了对f做任何事情，我们需要传递[i]。我们唯一正确的[i]卡在img1 :: m [i]内。我们需要img1的结果才能对f执行任何操作。现在有两种可能性。我们可以或无法确定img1的结果而不执行其副作用。我们将检查这两种情况，从我们不能的时候开始。

不能

当我们无法确定img1的结果而没有执行其副作用时，我们只有一个选择 - 我们必须执行img1及其所有副作用。我们现在有[i]，但所有img1的副作用都已执行。在img2的某些副作用之前，我们无法执行img1的任何副作用，因为img1的副作用已经发生。

可以

如果我们可以确定img1的结果而不执行其副作用，我们很幸运。我们找到img1的结果并将其传递给f，获得一个新的m [i]来保存我们想要的结果。我们现在可以检查img1和新m [i]的副作用并对它们进行重新排序（尽管这里有一个关于>>=的关联法则的巨大警告。）

手头的问题

因为这适用于我们的情况，对于任何MonadIO，存在以下内容，如果不执行其副作用就无法确定其结果，将我们牢牢地置于不能的情况下我们无法重新排序副作用。

counterExample :: (MonadIO m) => m String
counterExample = liftIO getLine

还有许多其他反例，例如readImage1或readImage2等必须实际从IO读取图像的内容。