The gist of my question is that I have a deterministic state automata that is transitioning according to a list of moves, and I want this sequence of transition to serve as a "computational context" for another function. This other function would observe the state machine at each transition, and do some computation with it, vaguely reminiscent of a model-view pattern. Trivially this other function might simply read the current state the machine is in, and print it to screen.

My implementation of the state machine:

data FA n s = FA { initSt1 :: n, endSt1 :: [n], trans1 :: n -> s -> n }

-- | Checks if sequence of transitions arrives at terminal nodes
evalFA :: Eq n => FA n s -> [s] -> Bool
evalFA fa@(FA _ sfs _ ) = (`elem` sfs) . (runFA fa)

-- | Outputs final state reached by sequence of transitons
runFA :: FA n s -> [s] -> n
runFA (FA s0 sfs trans) = foldl trans s0

And example:

type State = String
data Trans = A | B | C | D | E

fa :: FA State Trans
fa = FA ("S1") ["S4","S5"] t1

-- | Note non-matched transitions automatically goes to s0
t1 :: State -> Trans -> State
t1 "S1" E = "S1"
t1 "S1" A = "S2"
t1 "S2" B = "S3"
t1 "S2" C = "S4"
t1 "S3" D = "S5"
t1 _  _   = "S1"

runFA fa [A,B]   -- | S3

I'm going to split this answer in two parts. The first part will answer your original question and the second part will answer the non-deterministic FSA question you raised in the comments.

Pipes

You can use pipes to interleave effects between computations. First, I'll begin with the slightly modified version of your code:

data FA n s = FA { initSt1 :: n, endSt1 :: [n], trans1 :: n -> s -> n }

data State = S1 | S2 | S3 | S4 | S5 deriving (Eq, Show)
data Trans = A | B | C | D | E deriving (Read)

fa :: FA State Trans
fa = FA (S1) [S4,S5] t1

-- | Note non-matched transitions automatically goes to s0
t1 :: State -> Trans -> State
t1 S1 E = S1
t1 S1 A = S2
t1 S2 B = S3
t1 S2 C = S4
t1 S3 D = S5
t1 _  _ = S1

The only difference is that I'm using an enumeration instead of a String for the State.

Next, I will implement your transitions as a Pipe:

runFA :: (Monad m, Proxy p) => FA n s -> () -> Pipe (StateP n p) s n m r
runFA (FA _ _ trans) () = forever $ do
    s <- request ()
    n <- get
    put (trans n s)
    respond n

Let's look closely at the type of the Pipe:

() -> Pipe (StateP n p) s n m r
                   ^    ^ ^
                   |    | |
 'n' is the state -+    | |
                        | |
          's's come in -+ +- 'n's go out

So you can think of this as an effectful scanl. It receives a stream of ss using request and outputs a stream of ns using respond. It can actually interleave effects directly if we want, but I will instead outsource effects to other processing stages.

When we formulate it as a Pipe, we have the luxury of choosing what our input and output streams will be. For example, we can connect the input to the impure stdin and connect the output to the impure stdout:

import Control.Proxy
import Control.Proxy.Trans.State

main = runProxy $ execStateK (initSt1 fa) $
    stdinS >-> takeWhileD (/= "quit") >-> mapD read >-> runFA fa >-> printD

That's a processing pipeline that you can read as saying:

Execute the following Pipe with an initial state of initSt
Stream values from standard intput
Keep streaming until one of those values is "quit"
Apply read to all values to convert them to Transes
Run them through our scanning finite-state automaton
Print the States that the automaton emits

Let's try it:

>>> main
A
S1
B
S2
C
S3
A
S1
quit
S2
>>>

Notice how it also returns out the the final State that our automaton was in. You could then fmap your test over this computation to see if it ended in a terminal node:

>>> fmap (`elem` [S1, S2]) main
A
S1
B
S2
C
S3
A
S1
quit
True

Alternatively, we can connect our automaton to pure inputs and outputs, too:

import Control.Proxy.Trans.Writer
import Data.Functor.Identity

main = print $ runIdentity $ runProxy $ runWriterK $ execStateK (initSt1 fa) $
    fromListS [A, C, E, A] >-> runFA fa >-> liftP . toListD

That pipeline says:

Run this within a pure computation (i.e. `runIdentity) and print the pure result
Use Writer to log all the states we have visited
Use State to keep track of our current state
Feed a list of predefined transitions purely
Run those transitions through our FSA
Log the outputs to the Writer, using liftP to specify that we targeting Writer

Let's try this, too:

>>> main
(S2,[S1,S2,S4,S1])

That outputs the final state and the list of visited states.

ListT

Now, there was a second question that you raised, which is how do you do effectful non-deterministic computations. Daniel was actually incorrect: You can interleave effects with non-determinism using pipes, too! The trick is to use ProduceT, which is the pipes implementation of ListT.

First, I will show how to use ProduceT:

fsa :: (Proxy p) => State -> Trans -> ProduceT p IO State
fsa state trans = do
    lift $ putStrLn $ "At State: " ++ show state
    state' <- eachS $ case (state, trans) of
        (S1, A) -> [S2, S3]
        (S2, B) -> [S4, S5]
        (S3, B) -> [S5, S2]
        (S4, C) -> [S2, S3]
        (S5, C) -> [S3, S4]
        (_ , _) -> [S1]
    return state'

The above code says:

Print the current state
Bind many possible transitions non-deterministically
Return the new selected state

To avoid manual state passing, I will wrap fsa in StateT:

import qualified Control.Monad.Trans.State as S

fsa2 :: (Proxy p) => Trans -> S.StateT State (ProduceT p IO) State
fsa2 trans = do
    s <- S.get
    s' <- lift $ fsa s trans
    S.put s'
    return s'

Now I can run the generator on multiple transitions easily by using mapM. When I'm done, I compile it to a Producer using runRespondT:

use1 :: (Proxy p) => () -> Producer p State IO ()
use1 () = runRespondT $ (`S.execStateT` S1) $ do
    mapM_ fsa2 [A, B, C]  -- Run the generator using four transitions

This produces a pipe whose effects are to print the states it is traversing and it outputs a stream of final states it encounters. I'll hook up the output to a printing stage so we can observe both simultaneously:

>>> runProxy $ use1 >-> printD
At State: S1
At State: S2
At State: S4
S2
S3
At State: S5
S3
S4
At State: S3
At State: S5
S3
S4
At State: S2
S1

We can observe the automaton's path it takes and how it backtracks. It print outs where it currently is after each step and then emits all 7 of its final states as soon as it arrives at them.

Sorry if this post is a little bit unpolished, but it's the best I can do in a hurry.

Pipes

ListT

Recommended topics

Hot tags