I am struggling to wrap my head around this function**
-- split at whitespace
-- f "hello world" -> ["hello","world"]
f = takeWhile (not . null) . evalState (repeatM $ modify (drop 1)
>> State (break (== ' '))) . (' ' :)
where repeatM = sequence . repeat
I am already struggling with understanding the state monad and the lack of Type signatures and the point free style make it even more confusing.
What is going on here?
** taken from here
break (== ' ') :: String -> (String, String) produces the longest prefix of the input string without whitespaces on the left, and the remaining suffix on the right. Clearly we want to somehow iterate this process to split a string into its words.
State (break (== ' ')) :: State String String views that function as a stateful computation. Remember State :: (s -> (a, s)) -> State s a, so the output state is the right component. So the initial state is the input string, and break (== ' ') viewed imperatively as a State action, returns the first word and updates the state to the remaining suffix.
Now compose that with modify (drop 1) to drop the next space, and repeat. Note that it appends to the input (' ' :) at the beginning, and starts with modify
(sequence . repeat) (modify (drop 1) >> State (break (== ' ')))
:: State String [String]
= do
-- current_state = " hello wold"
modify (drop 1)
-- current_state = "hello world"
s1 <- State (break (== ' ')) -- s1 = "hello"
-- current_state = " world"
modify (drop 1)
-- current_state = "world"
s2 <- State (break (== ' ')) -- s2 = "world"
-- current_state = ""
modify (drop 1)
-- current_state = ""
s3 <- State (break (== ' ')) -- s3 = ""
-- current_state = ""
...
repeat constructs an infinite list of the same two-step action modify (drop 1) >> State (break (== ' '))
sequence takes a list of actions and runs them, collecting the result in a list. Here I am handwaving, but because this is the lazy state monad (there is a strict one, and this is not it), things work out so that sequence can run an infinite list of action and produce the resulting infinite list of results on demand.
So you get an infinite computation as shown above, producing the infinite list of results of all State (break (== ' ')) steps.
["hello", "world", "", "", ...]
takeWhile (not . null) is hopefully self descriptive: it takes elements from the list while they're not empty.
["hello", "world"]
Related
I have written a Haskell code as:
loop = do
x <- getLine
if x == "0"
then return ()
else do arr <- replicateM (read x :: Int) getLine
let blocks = map (read :: String -> Int) $ words $ unwords arr
putStr "Case X : output = "; -- <- What should X be?
print $ solve $ blockPair blocks;
loop
main = loop
This terminates at 0 input. I also want to print the case number eg. Case 1, 2 ...
Sample run:
1
10 20 30
Case 1: Output = ...
1
6 8 10
Case 2: Output = ...
0
Does anyone know how this can be done? Also, If possible can you suggest me a way to print the output line at the very end?
Thanks in advance.
For the first part of your question, the current case number is an example of some "state" that you want to maintain during the course of your program's execution. In other languages, you'd use a mutable variable, no doubt.
In Haskell, there are several ways to deal with state. One of the simplest (though it is sometimes a little ugly) is to pass the state explicitly as a function parameter, and this will work pretty well given the way you've already structured your code:
main = loop 1
loop n = do
...
putStr ("Case " ++ show n ++ ": Output = ...")
...
loop (n+1) -- update "state" for next loop
The second part of your question is a little more involved. It looks like you wanted a hint instead of a solution. To get you started, let me show you an example of a function that reads lines until the user enters end and then returns the list of all the lines up to but not including end (together with a main function that does something interesting with the lines using mostly pure code):
readToEnd :: IO [String]
readToEnd = do
line <- getLine
if line == "end"
then return []
else do
rest <- readToEnd
return (line:rest)
main = do
lines <- readToEnd
-- now "pure" code makes complex manipulations easy:
putStr $ unlines $
zipWith (\n line -> "Case " ++ show n ++ ": " ++ line)
[1..] lines
Edit: I guess you wanted a more direct answer instead of a hint, so the way you would adapt the above approach to reading a list of blocks would be to write something like:
readBlocks :: IO [[Int]]
readBlocks = do
n <- read <$> getLine
if n == 0 then return [] else do
arr <- replicateM n getLine
let block = map read $ words $ unwords arr
blocks <- readBlocks
return (block:blocks)
and then main would look like this:
main = do
blocks <- readBlocks
putStr $ unlines $
zipWith (\n line -> "Case " ++ show n ++ ": " ++ line)
[1..] (map (show . solve . blockPair) blocks)
This is similar in spirit to K. A. Buhr's answer (the crucial move is still passing state as a parameter), but factored differently to demonstrate a neat trick. Since IO actions are just normal Haskell values, you can use the loop to build the action which will print the output without executing it:
loop :: (Int, IO ()) -> IO ()
loop (nCase, prnAccum) = do
x <- getLine
if x == "0"
then prnAccum
else do inpLines <- replicateM (read x) getLine
let blocks = map read $ words $ unwords inpLines
prnAccumAndNext = do
prnAccum
putStr $ "Case " ++ show nCase ++ " : output = "
print $ solve $ blockPair blocks
loop (nCase + 1, prnAccumAndNext)
main = loop (1, return ())
Some remarks on the solution above:
prnAccum, the action which prints the results, is threaded through the recursive loop calls just like nCase (I packaged them both in a pair as a matter of style, but it would have worked just as fine if they were passed as separate arguments).
Note how the updated action, prnAccumAndNext, is not directly in the main do block; it is defined in a let block instead. That explains why it is not executed on each iteration, but only at the end of the loop, when the final prnAccum is executed.
As luqui suggests, I have removed the type annotations you used with read. The one at the replicateM call is certainly not necessary, and the other one isn't as well as long as blockPair takes a list of Int as an argument, as it seems to be the case.
Nitpicking: I removed the semicolons, as they are not necessary. Also, if arr refers to "array" it isn't a very appropriate name (as it is a list, and not an array), so I took the liberty to change it into something more descriptive. (You can find some other ideas for useful tricks and style adjustments in K. A. Buhr's answer.)
I'm experiencing some problems and can't find their reason. I am currently using the most recent version of GHCi portable - but to face the truth: It is my first time using Haskell, so as usual the problem is probably the user and not so much the system...
Problems that arise include:
I am not completely sure I got the difference between let x = 0 and x <- 0 right. I understand that let is to be used with pure functions, <- with side effects (IO)? Someone please explain that to me once again.
I have mismatchings between types, namely String and (String,[Char]) (and sometimes others...). The compiler tells me that String was expected, although I clearly defined the function as (String,String). What's going on? Did I somewhere make a mistake with the pattern matching?
The recursion does not work as expected (i.e. doesn't work at all apparently). If someone could help me with that, I would be very grateful.
Here's what I want to do:
I am trying to write a little program that implements a finite state machine accepting a word. That means it takes a set of states, one of which is the start state, a list of accepting states, and a number of transition rules. (The alphabets which represent the possible input and states are somewhat implicit.) I don't want to go into too much detail about FSMs here.
However, this is how I figured a way to define such a FSM could look:
"a(b+|c+)"
"start"
["b","c"]
[
("start", [('a',"a"), ('_',"reject")]),
("a", [ ('b',"b"), ('c',"c"), ('_',"reject")]),
("b", [ ('b',"b"), ('_',"reject")]),
("c", [ ('c',"c"), ('_',"reject")]),
("reject", [ ('_',"reject")])
]
In the first line, we have short description of what the FSM is supposed to accept (in form of a regex in this case). It is only used to display it once.
The second line defines the start state, the third line a list of accepting states.
All following lines together are the transition rules. In this example, if we are in state "start" and read an input 'a', the next state is "a", if we read anything else, it is "reject". (I am aware that I have not yet implemented the '_' meaning an else and the program will crash if an input is read for which no transition is defined.)
So here comes the program:
module FSM where
import System.IO
main :: IO ()
main = do
putStr "Enter file name: "
fileName <- getLine
(description, startState, acceptingStates, stateTransitions) <- (readDef fileName)
putStrLn ("FSM description: " ++ description)
putStr "Enter FSM input: "
input <- getLine
let input = reverse input
putStrLn "----------------"
let (finalState, oldStates) = changeState input startState stateTransitions
putStrLn (oldStates ++ finalState)
checkAcception finalState acceptingStates
--reads the specified .fsm file and returns
-- the description of the FSM (first line),
-- the start state (second line),
-- the list of accepting states (third line),
-- and the list of tuples containing all states and transitions (remaining lines)
readDef :: String -> IO (String, String, [String], [(String, [(Char,String)])])
readDef fileName = do
contents <- readFile (fileName ++ ".fsm")
let lineList = lines contents
let description = read (head lineList)
let startState = read (lineList !! 1)
let acceptingStates = read (lineList !! 2)
let stateTransitions = read (filter (/='\t') (concat (drop 3 lineList)))
return (description, startState, acceptingStates, stateTransitions)
--recursive function that takes the input, start state, and state transitions
--and computes the new state by a call to itself with the old state and a part of the input
changeState :: String -> String -> [(String, [(Char,String)])] -> (String, String)
changeState startState [] _ = (startState, "")
changeState startState (x:xs) stateTransitions = do
let (currentState, oldStates) = changeState xs startState stateTransitions
let newState = findKey x (findKey currentState stateTransitions)
let oldStates = (oldStates ++ currentState ++ " -(" ++ [x] ++ ")-> ")
return (newState, oldStates)
--helper function to find a key in a list of tuples and return the corresponding value
--(because we are not using the map notation in the .fsm file)
findKey :: (Eq k) => k -> [(k,v)] -> v
findKey key xs = snd . head . filter (\(k,v) -> key == k) $ xs
--checks for a given state whether or not it is in the list of accepting states
checkAcception :: String -> [String] -> IO ()
checkAcception finalState acceptingStates = do
let accept = any (==finalState) acceptingStates
if accept
then putStrLn "Input accepted!!"
else putStrLn "Input rejected!!"
The idea is to have the user choose a file from which the definition is loaded (readDef, works like a charm). He is then prompted to enter some input the FSM works on.
The recursive changeState then does the actual work (doesn't work as well...).
Finally, the sequence of states and transitions is displayed and it is checked whether the final state is an accepting state (checkAcceptance).
Now, don't try to optimize what I have written. I know, the way the definition is modeled can be improved and many of the lines I wrote can be written far shorter using some high order Haskell foo. But please just help me with the issues listed above (and of course help me make it work).
Thanks a lot in advance.
One last thing: I'm trying some Haskell for a seminar at my university, so if someone from the Software Architecture Group googled my code and reads this: Hi :)
You can get things to compile by just changing the second clause of the changeState function to:
changeState startState (x:xs) stateTransitions =
let (currentState, oldStates) = changeState xs startState stateTransitions
newState = findKey x (findKey currentState stateTransitions)
oldStates2 = (oldStates ++ currentState ++ " -(" ++ [x] ++ ")-> ")
in (newState, oldStates2)
We've 1) removed the do, 2) combined the let clauses and 3) renamed the second occurrence of the oldState variable to oldState2. In Haskell we don't redefine variables - we just create a variable with a new name. Complete code is available here: http://lpaste.net/118404
When you write:
(new, old) = changeState ...
you are saying that changeState is a pure function. If you define changeState with do ... return (...) you are saying it is a monadic computation and when you call it you need to use the arrow <- in a do block:
(new, old) <- changeState ...
Since changeState is a pure function (doesn't need to do IO) you might as well keep it as a pure function, so there is no reason to use do and return.
The problem is that do notation and the return function don't do what you think they do. In Haskell: return doesn't signify that a function should end (even though it's most commonly seen at the end of functions); it just means that the argument should be wrapped in a Monad. Because the type of your function with all arguments applied is (String,String) the compiler thought you were trying to use something like this: (won't actually compile without GHC extensions, and will throw exceptions if used because I used undefined)
instance Monad ((,) String) where
(>>=) = undefined :: (String,a) -> (a -> (String,b)) -> (String,b)
return = undefined :: a -> (String,a)
But the compiler already knew that (String,String) -> (String,String) doesn't match a -> (String,a) so it didn't get as far as checking whether or not the instance exists.
Fixing this problem revealed another one: you define oldStates twice in the same function, which doesn't work in Haskell unless the two definitions are in different scopes.
This is your function modified to compile properly, but I haven't tested it.
changeState :: String -> String -> [(String, [(Char,String)])] -> (String, String)
changeState startState [] _ = (startState, "")
changeState startState (x:xs) stateTransitions = let
(currentState, oldStates) = changeState xs startState stateTransitions
newState = findKey x (findKey currentState stateTransitions)
oldStates' = (oldStates ++ currentState ++ " -(" ++ [x] ++ ")-> ")
in (newState, oldStates')
I want to lazily read user input and do something with it line by line. But if user ends a line with , (comma) followed by any number of spaces (including zero), I want give him opportunity to finish his input on the next line.
And here is what I've got:
import System.IO
import Data.Char
chop :: String -> [String]
chop = f . map (++ "\n") . lines
where f [] = []
f [x] = [x]
f (x : y : xs) = if (p . tr) x
then f ((x ++ y) : xs)
else x : f (y : xs)
p x = (not . null) x && ((== ',') . last) x
tr xs | all isSpace xs = ""
tr (x : xs) = x :tr xs
main :: IO ()
main =
do putStrLn "Welcome to hell, version 0.1.3!"
putPrompt
mapM_ process . takeWhile (/= "quit\n") . chop =<< getContents
where process str = putStr str >> putPrompt
putPrompt = putStr ">>> " >> hFlush stdout
Sorry, it doesn't work at all. Bloody mess.
P.S. I want to preserve \n characters on end of every chunk. Currently I add them manually with map (++ "\n") after lines.
How about changing the type of chop a little:
readMultiLine :: IO [String]
readMultiLine = do
ln <- getLine
if (endswith (rstrip ln) ",") then
liftM (ln:) readMultiLine
else
return [ln]
Now you know that if the last list is not empty, then the user didn't finish typing (the last input ended with ',').
Of course, either import Data.String.Utils, or write your own. Could be as simple as:
endswith xs ys = (length xs >= length ys)
&& (and $ zipWith (==) (reverse xs) (reverse ys))
rstrip = reverse . dropWhile isSpace . reverse
But I missed the point at first. Here's the actual thing.
unfoldM :: (Monad m) => (a -> Maybe (m b, m a)) -> a -> m [b]
unfoldM f z = case f z of
Nothing -> return []
Just (x, y) -> liftM2 (:) x $ y >>= unfoldM f
main = unfoldM (\x -> if (x == ["quit"]) then Nothing
else Just (print x, readMultiLine)) =<< readMultiLine
The reason is, you need to be able to insert the "action" to be done on input between reading one multi-line input and the next. Here print x is the action inserted between two readMultiLine
Since you have questions about getContents, let me add. Even though getContents provides a lazy String, its effectful changes to the world are ordered with the subsequent effects of processing the list. But the processing of the list attempts to insert effects between effects of reading particular list items. To do that, you need a function that exposes the chain of effects, so you can insert your own effects between them.
You can do this using pipes, preserving the laziness of the user's input
import Data.Char (isSpace)
import Pipes
import qualified Pipes.Prelude as Pipes
endsWithComma :: String -> Bool
endsWithComma str =
case (dropWhile isSpace $ reverse str) of
',':_ -> True
_ -> False
finish :: Monad m => Pipe String String m ()
finish = do
str <- await
yield str
if endsWithComma str
then do
str' <- await
yield str'
else finish
user :: Producer String IO ()
user = Pipes.stdinLn >-> finish
You can then hook up the user Producer to any downstream Consumer. For example, to echo the stream back out you can write:
main = runEffect (user >-> Pipes.stdoutLn)
To learn more about pipes you can read the tutorial.
Sorry, I wrote something wrong in a comment and I thought that now that I understood what you were trying to do, I'd give an answer with a little more substance. The core idea is that you're going to need a state buffer while you loop through the string, as far as I can tell. You have f :: [String] -> [String] but you'll need an extra string of buffer before you can solve this puzzle.
So let me assume an answer which looks like:
chop = joinCommas "" . map (++ "\n") . lines
Then the structure of joinCommas is going to look like:
import Data.List (isSuffixOf)
-- override with however you want to handle the ",\n" between lines.
joinLines = (++)
incomplete = isSuffixOf ",\n"
joinCommas :: String -> [String] -> [String]
joinCommas prefix (line : rest)
| incomplete prefix = joinCommas (joinLines prefix line) rest
| otherwise = prefix : joinCommas line rest
joinCommas prefix []
| incomplete prefix = error "Incomplete input"
| otherwise = [prefix]
The prefix stores up lines until it doesn't end with ",\n" at which point it emits the prefix and continues with the rest of the lines. On EOF we process the last line unless that line is incomplete.
My goal is to find the number of times a substring exists within a string.
The substring I'm looking for will be of type "[n]", where n can be any variable.
My attempt involved splitting the string up using the words function,
then create a new list of strings if the 'head' of a string was '[' and
the 'last' of the same string was ']'
The problem I ran into was that I entered a String which when split using
the function words, created a String that looked like this "[2],"
Now, I still want this to count as an occurrence of the type "[n]"
An example would be I would want this String,
asdf[1]jkl[2]asdf[1]jkl
to return 3.
Here's the code I have:
-- String that will be tested on references function
txt :: String
txt = "[1] and [2] both feature characters who will do whatever it takes to " ++
"get to their goal, and in the end the thing they want the most ends " ++
"up destroying them. In case of [2], this is a whale..."
-- Function that will take a list of Strings and return a list that contains
-- any String of the type [n], where n is an variable
ref :: [String] -> [String]
ref [] = []
ref xs = [x | x <- xs, head x == '[', last x == ']']
-- Function takes a text with references in the format [n] and returns
-- the total number of references.
-- Example : ghci> references txt -- -> 3
references :: String -> Integer
references txt = len (ref (words txt))
If anyone can enlighten me on how to search for a substring within a string
or how to parse a string given a substring, that would be greatly appreciated.
I would just use a regular expression, and write it like this:
import Text.Regex.Posix
txt :: String
txt = "[1] and [2] both feature characters who will do whatever it takes to " ++
"get to their goal, and in the end the thing they want the most ends " ++
"up destroying them. In case of [2], this is a whale..."
-- references counts the number of references in the input string
references :: String -> Int
references str = str =~ "\\[[0-9]*\\]"
main = putStrLn $ show $ references txt -- outputs 3
regex is huge overkill for such a simple problem.
references = length . consume
consume [] = []
consume ('[':xs) = let (v,rest) = consume' xs in v:consume rest
consume (_ :xs) = consume xs
consume' [] = ([], [])
consume' (']':xs) = ([], xs)
consume' (x :xs) = let (v,rest) = consume' xs in (x:v, rest)
consume waits for a [ , then calls consume', which gathers everything until a ].
Here's a solution with
sepCap.
import Replace.Megaparsec
import Text.Megaparsec
import Text.Megaparsec.Char
import Data.Either
import Data.Maybe
txt = "[1] and [2] both feature characters who will do whatever it takes to " ++
"get to their goal, and in the end the thing they want the most ends " ++
"up destroying them. In case of [2], this is a whale..."
pattern = single '[' *> anySingle <* single ']' :: Parsec Void String Char
length $ rights $ fromJust $ parseMaybe (sepCap pattern) txt
3
I'm trying to implement a lexer in Haskell. For easy console input and output, I've used an intermediate data type Transition Table.
type TransitionTable = [(Int, Transitions String Int)]
type Transitions a b = [(a, b)]
I want to take input from the user for all the states and transitions. I do not want to take the total number of states before hand. I want it to keep taking input for the transitions of each state until the user types "--" . If the user types "---", the current state is discarded and the input terminates.
After a lot of attempts I came up with this, which I think is horrible code.
-- |A function to emulate the while loop for easy IO functionality.
-- Defination:- while #comparator #func #start:
-- *comparator #arg: A function which returns True or False on the basis of #arg.
-- The loop stops when False is returned.
-- *func: The function which is executed repeadly.
-- It is responsible for returning the next #arg for the comparator on the basis of the current #arg.
-- *start: The starting value of #arg to pass to the comparator.
while :: (Monad m) => (a -> Bool) -> (a -> m a) -> a -> m a
while comparator func start =
if comparator start then do
nxt <- func start
while comparator func nxt
else
return start
-- |A modification of putStr which flushes out stdout. Corrents buffer problems.
myPutStr :: String -> IO ()
myPutStr str = putStr str >> hFlush stdout >> return ()
-- Takes input from the console to generate a TransitionTable.
inputTransitionTable :: IO TransitionTable
inputTransitionTable = do
putStrLn "Type -- for next state and --- for completing input entering."
retVal <- while notFinished takeInfo (0, [])
return (snd retVal)
where
-- Returns True when input entry is over.
notFinished (i, _) = i > -1
-- Takes the current state number and the incomplete corrosponding transition table which is populated
-- with user input. Input ends when user enters "---". State number is set to -1 when input is over.
takeInfo (i, states) = do
putStrLn ("Adding transitions to state " ++ show i ++ ": ")
retVal <- while entryNotFinished takeStateInfo ("", [])
let (inpStr, stateInfo) = retVal
case inpStr == "---" of
True -> return (-1, states)
False -> return (i+1, states ++ [(i, stateInfo)])
-- Checks if input entry is over. Returns False if finished.
entryNotFinished (s, _)
| s == "--" || s == "---" = False
| otherwise = True
-- Takes the input state number along with the corresponding transitions.
-- Input ends when the user enters "--".
takeStateInfo (str, state_info) = do
myPutStr "\tEnter transitions symbol: "
symbol <- getLine
if symbol == "--" || symbol == "---" then
return (symbol, state_info)
else do
myPutStr "\t\tEnter the transition state number: "
state' <- getLine
let state = read state' :: Int
return (str, (symbol, state):state_info)
Basically this is how it runs:
*Main> x <- inputTransitionTable
Type -- for next state and --- for completing input entering.
Adding transitions to state 0:
Enter transitions symbol: a
Enter the transition state number: 1
Enter transitions symbol: b
Enter the transition state number: 2
Enter transitions symbol: --
Adding transitions to state 1:
Enter transitions symbol: a
Enter the transition state number: 2
Enter transitions symbol: b
Enter the transition state number: 3
Enter transitions symbol: --
Adding transitions to state 2:
Enter transitions symbol: a
Enter the transition state number: 3
Enter transitions symbol: --
Adding transitions to state 3:
Enter transitions symbol: --
Adding transitions to state 4:
Enter transitions symbol: ---
(0.03 secs, 344420 bytes)
-- Output
*Main> prettyPrintTransitionTable x
State Transitions
0 ("b",2) ("a",1)
1 ("b",3) ("a",2)
2 ("a",3)
3
Is there a better way to do this?
It could be as simple as this, if you add the "deriving Read" declarations and don't care about interaction.
main = do
allInput <- getContents -- scarfs all stdin up to eof
let inLines = lines allInput
let (tableLines, _:otherlines) = break (== "endtable") inLines
let table = ((read $ unlines tableLines) :: TransitionTable)
-- process otherlines here
As others have suggested, for a tasks related to parsing you should look at Parsec. While I have no experience with it, I can still suggest an alternative way of writing your parsing application.
module Main where
import Control.Monad (liftM)
computeTransitions :: [String] -> [(Int, [(String, Int)])]
computeTransitions is = foldl folder [] is
where
getState states = if null states then (0, []) else last states
getTransition transitions = if null transitions then 0 else (snd $ head transitions)
prepend state transition = let (c, ts) = state in (c, transition:ts)
swapLastState states state = if null states then [state] else init states ++ [state]
folder states i =
let currentState = getState states
currentTransition = getTransition (snd currentState)
in case i == "--" of False -> swapLastState states (prepend currentState (i, currentTransition + 1))
True -> states ++ [((fst currentState) + 1, [])]
main = do
inputLines <- liftM (takeWhile (/="---")) (liftM lines getContents)
let result = computeTransitions inputLines
mapM_ (\(s, t) -> putStrLn $ show s ++ "\t" ++ show t) result
I don't know if in your requirements was to print out the intermediary messages, but the computation of the transitions can be transformed to a fold operation (or foldM if you want to print intermediary messages); and instead of the "while" loop I've used the takeWhile function lifted to the Monadic space (so I can apply it on the type IO [String]).
Also note that getContents is lazy in evaluation, and in combination with lines will perform as a "while read line".
Edit:
With #pat's suggestion (and what hlint came up with), here is the refactored version:
module Main where
import Control.Monad (liftM)
computeTransitions :: [String] -> [(Int, [(String, Int)])]
computeTransitions = foldl folder []
where
getState [] = (0, [])
getState states = last states
getTransition [] = 0
getTransition ((_, t):_) = t
prepend (c,ts) transition = (c, transition:ts)
swapLastState [] state = [state]
swapLastState states state = init states ++ [state]
folder states i =
let currentState = getState states
currentTransition = getTransition (snd currentState)
in if i == "--"
then states ++ [(fst currentState + 1, [])]
else swapLastState states (prepend currentState (i, currentTransition + 1))
main = do
inputLines <- liftM (takeWhile (/="---") . lines) getContents
mapM_ (\(s, t) -> putStrLn $ show s ++ "\t" ++ show t) (computeTransitions inputLines)