6
\$\begingroup\$

I've been getting to grips with some Monads in Haskell recently, and to get some practice I plucked a Mealy Machine out of thin air and decided to implement it using the State Monad (it's a simple machine and a simple implementation, don't worry).

  • The input is a string of characters from +, -, n, e.
    • +, "plus". Output a 1,
    • -, "minus". Output a -1.
    • n, "toggle negated". Until "toggled off", flip the sign of the output from + or -.
    • e, "toggle enabled". Until "toggled back on", output 0 from + or -.
  • The output is just a sequence of the same length as the input, containing 1, 0, and -1s as outputted by the DFA. In the code below, the output is actually the sum of this sequence, acting as a quick checksum. All states are accepting states.

For example, an input of +-n+-e+e+ would result in [1, -1, 0, -1, 1, 0, 0, 0, -1].

To unambiguously define the behaviour, here's a pretty messy state transition diagram:

enter image description here

If "posate" (as the opposite of negate) isn't a word already, it is now! The transitions are labelled with the "english name", the symbol used to represent this transition, and the "output" from the machine. All states are accepting states, I left out the conventional double rings.


At last, the code:

import Control.Monad.Trans.State.Lazy import Control.Monad (foldM) data Input = Plus | Minus | ToggleNegate | ToggleEnabled type Emission = Integer type Accum = [Emission] type Output = [Emission] type Negated = Bool type Enabled = Bool toInput :: Char -> Input toInput '+' = Plus toInput '-' = Minus toInput 'n' = ToggleNegate toInput 'e' = ToggleEnabled toInput _ = error "Invalid input representation" -- Determine new state of state machine along with transition emission step :: (Negated, Enabled, Input) -> (Negated, Enabled, Emission) step (n, e, ToggleNegate) = (not n, e, 0) step (n, e, ToggleEnabled) = (n, not e, 0) step (n, False, i) = (n, False, 0) step (n, e, Plus) = (n, e, if n then -1 else 1) step (n, e, Minus) = (n, e, if n then 1 else -1) -- Helper function for "evaluate"'s foldM mapEmissions :: Accum -> Input -> State (Negated, Enabled) Output mapEmissions accum input = do (negated, enabled) <- get let (negated', enabled', emission) = step (negated, enabled, input) put (negated', enabled') return (accum ++ [emission]) -- Process an input string and return the result -- (False, True) is the start state: (not negated, enabled) evaluate :: [Input] -> Output evaluate inputs = evalState (foldM mapEmissions [] inputs) (False, True) -- Convenience function for output formatting shouldEqual :: String -> Integer -> IO () shouldEqual input expected = do let actual = (sum . evaluate . map toInput) input putStrLn $ "Expected " ++ show expected ++ ", got " ++ show actual ++ ": " ++ input main :: IO () main = do "+-n--n" `shouldEqual` 2 "+e----e++" `shouldEqual` 3 "-n++e++e--+-n++" `shouldEqual` 1 

Code online here.


I'm happy to hear any and all critiques and advice, but in particular:

  • Am I using the State monad idiomatically? Can I write any bits of code more elegantly?
  • Is this an appropriate use for this monad? This isn't a particularly complex task, but I feel like it makes passing around the DFA's state simpler.

Thanks for taking the time to read, and Happy New Year!

\$\endgroup\$

2 Answers 2

6
\$\begingroup\$

Use traverse instead of foldM + accumulate

In a fold, you usually use a function that reduces (or folds) your input into a single result. You, on the other hand, use fold mapEmissions to create a list from an input list. Both lists will have the same number of elements. That's not a fold. That's a map.

So first of all, let's use traverse instead of foldM:

evaluate :: [Input] -> Output evaluate inputs = evalState (traverse emit inputs) (False, True) 

Next, let's figure out how emit should look like:

emit :: Input -> State (Negated, Enabled) Emission emit input = do (negated, enabled) <- get let (negated', enabled', emission) = step (negated, enabled, input) put (negated', enabled') return emission 

Almost the same as mapEmission, and we can use emit to implement mapEmission:

mapEmission accum input = (accum ++) <$> emit input 

Therefore, we should really replace the foldM by traverse.

Consider already existing interfaces

step can be rewritten with another interface that fits the state interface:

type MMState = (Negated, Enabled) -- Mealy Machine State step :: Input -> MMState -> (MMState, Emission) step ToggleNegate (n, e) = ((not n, e ), 0) step ToggleEnabled (n, e) = (( n, not e), 0) step _ (n, False) = ((n, False), 0) step Plus (n, e) = ((n, e ), if n then -1 else 1) step Minus (n, e) = ((n, e ), if n then 1 else -1) 

This makes emit even easier:

emit :: Input -> State MMState Emission emit input = state (step input) 

Note that MMState makes it easier to change the other types, as there is less repetition.

It's completely up to you to write step like this, though.

Encapsulate possible errors in the type (if possible)

In toInput consider Maybe Input or Either String Input instead of error:

toInput :: Char -> Either String Input toInput '+' = pure Plus toInput '-' = pure Minus toInput 'n' = pure ToggleNegate toInput 'e' = pure ToggleEnabled toInput c = Left $ "Unrecognised character: " ++ [c] 

Use Int instead of Integer if the values are small

Instead of Integer we should use Int as Emission. Integer can be arbitrarily large, but your output values are either -1, 0 or 1. Int is much more suitable for that.

Other comments

Other than that, well done. You followed good practice by including type signatures, and your code is easy to read and to follow. The only real hurdle was foldM instead of traverse.

However, your single instruction type is called Input, whereas your complete output type is called Output. That naming is somewhat unbalanced.


Overall, we end up with:

import Control.Monad.Trans.State.Lazy data Input = Plus | Minus | ToggleNegate | ToggleEnabled type Emission = Int type Output = [Emission] type Negated = Bool type Enabled = Bool type MMState = (Negated, Enabled) -- Mealy Machine State toInput :: Char -> Either String Input toInput '+' = pure Plus toInput '-' = pure Minus toInput 'n' = pure ToggleNegate toInput 'e' = pure ToggleEnabled toInput c = Left $ "Unrecognised character: " ++ [c] step :: Input -> MMState -> (MMState, Emission) step ToggleNegate (n, e) = ((not n, e), 0) step ToggleEnabled (n, e) = (( n, not e), 0) step _ (n, False) = ((n, False), 0) step Plus (n, e) = ((n, e), if n then -1 else 1) step Minus (n, e) = ((n, e), if n then 1 else -1) emit :: Input -> State MMState Emission emit input = state (step input) evaluate :: [Input] -> Output evaluate inputs = evalState (traverse emit inputs) (False, True) 

By the way, we can now use emit on any traversable, so we could relax evaluate's type to

evaluate :: Traversable t => t Input -> t Emission evaluate inputs = evalState (traverse emit inputs) (False, True) 

But that's up to you.

\$\endgroup\$
3
  • \$\begingroup\$ Whoops, I'd forgotten that mapM also mapped the monad instance through the list, I'd assumed it processed each element independently... I've not read up on applicatives yet, but how you're using them here is a major incentive to do so! The new step function is really good too, and some day I'll get out of the bad habit of just error'ing everything. Thank you for the really thorough review that taught me new things! \$\endgroup\$ Commented Jan 2, 2018 at 14:42
  • \$\begingroup\$ @hnefatl nowadays mapM = traverse, since every Monad is also an Applicative. So if you know mapM, you already know traverse. \$\endgroup\$ Commented Jan 2, 2018 at 14:45
  • \$\begingroup\$ I would eliminate Input and make step's type signature Char -> StateT MMState (Either String) Emission, then use lens to write lines such as step 'n' = (_1 %= not) $> 0. \$\endgroup\$ Commented Jan 2, 2018 at 19:17
1
\$\begingroup\$

Looks pretty good to me.

The only thing I'd be wary of is the return (accum ++ [emission]) which means building the ouput will have complexity O(n²) where n is the size of the output. To remedy that, you could store the output in reversed order i.e. have return (emission : accum) instead and call reverse in evaluate.

You could also decide to structure this outputting mechanism as a Writer in which case you probably want to use the Endo [a] monoid aka Difference Lists for the same efficiency reasons.

\$\endgroup\$
3
  • 1
    \$\begingroup\$ Or use mapM/traverse instead of foldM. \$\endgroup\$ Commented Jan 2, 2018 at 7:49
  • \$\begingroup\$ I was under the impression that a sequence of appends in Haskell was only more O(n) if the list is forced to be evaluated during the sequence, as it's lazy. To use Writer along with State I'd need a monad transformer, right? I've not yet read up on those. \$\endgroup\$ Commented Jan 2, 2018 at 14:32
  • 2
    \$\begingroup\$ @hnefatl A sequence of appends is fine if you use a ++ b ++ c ++ d = a ++ (b ++ (c ++ d)). But due to the fold, we end up with ((a ++ b) ++ c) ++ d. Remember that (x:xs) ++ ys = x : xs ++ ys and you can see why the latter is a problem (we need to inspect a several times). \$\endgroup\$ Commented Jan 2, 2018 at 16:56

You must log in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.