I have the following function:
main = do xs <- getContents
edLines <- ed $ lines xs
putStr $ unlines edLines
Firstly I used the working version main = interact (unlines . ed . lines) but changed the signature of ed since. Now it returns IO [String] instead of just [String] so I can't use this convenient definition any more.
The problem is that now my function ed is still getting evaluated partly but nothing is displayed till I close the stdin via CTRL + D.
Definition of ed:
ed :: Bool -> [EdCmdLine] -> IO EdLines
ed xs = concatM $ map toLinesExt $ scanl (flip $ edLine defHs) (return [Leaf ""]) xs where
toLinesExt :: IO [EdState] -> IO EdLines
toLinesExt rsIO = do
rs#(r:_) <- rsIO -- todo add fallback pattern with (error)
return $ fromEd r ++ [" "]
The scanl is definitely evaluated lazy because edLine is getting evaluated for sure (observable by the side effects).
I think it could have to do with concatM:
concatM :: (Foldable t, Monad m) => t (m [a]) -> m [a]
concatM xsIO = foldr (\accIO xIO -> do {x <- xIO; acc <- accIO; return $ acc ++ x}) (return []) xsIO
All I/O in Haskell is explicitly ordered. The last two lines of your main function desugar into something like
ed (lines xs) >>= (\edLines -> putStr $ unlines edLines)
>>= sequences all of the I/O effects on the left before all of those on the right. You're constructing an I/O action of the form generate line 1 >> ... >> generate line n >> output line 1 >> ... >> output line n.
This isn't really an evaluation order issue, it's a correctness issue. An implementation is free to evaluate in any order it wants, but it can't change the ordering of I/O actions that you specified, any more than it can reorder the elements of a list.
Here's a toy example showing what you need to do:
lineProducingActions :: [IO String]
lineProducingActions = replicate 10 getLine
wrongOrder, correctOrder :: IO ()
wrongOrder = do
xs <- sequence lineProducingActions
mapM_ putStrLn xs
correctOrder = do
let xs = [x >>= putStrLn | x <- lineProducingActions]
sequence_ xs
Note that you can decouple the producer and consumer while getting the ordering you want. You just need to avoid combining the I/O actions in the producer. I/O actions are pure values that can be manipulated just like any other values. They aren't side-effectful expressions that happen immediately as they're written. They happen, rather, in whatever order you glue them together in.
You would need to use unsafeInterleaveIO to schedule some of your IO actions for later. Beware that the IO actions may then be executed in a different order than you might first expect!
However, I strongly recommend not doing that. Change your IO [String] action to print each line as it's produced instead.
Alternately, if you really want to maintain the computation-as-pipeline view, check out one of the many streaming libraries available on Hackage (streamly, pipes, iteratees, conduit, machines, and probably half a dozen others).
Thanks to #benrg answer I was able to solve the issue with the following code:
ed :: [EdCmdLine] -> [IO EdLines]
ed cmds = map (>>= return . toLines . head) $ edHistIO where
toLines :: EdState -> EdLines
toLines r = fromEd r ++ [" "]
edHistIO = edRec defHs cmds (return [initState])
edRec :: [HandleHandler] -> [EdCmdLine] -> IO EdHistory -> [IO EdHistory]
edRec _ [] hist = [hist] -- if CTRL + D
edRec defHs (cmd:cmds) hist = let next = edLine defHs cmd hist in next : edRec defHs cmds next
main = getContents >>= mapM_ (>>= (putStr . unlines)) . ed . lines
Related
So I wrote a program to query a forex API (foreign exchange), and it works like a charm, but when I want to query every currency pair available, it evaluates all API calls as it takes a long time to execute but prints nothing.
import Data.Functor ((<&>))
supportedPairs :: IO (Maybe [(String, String)])
forex :: String -> String -> IO (Maybe (Scientific, UnixTime))
main :: IO ()
main = do
x <- supportedPairs
mapM_ (flip (<&>) print . uncurry forex) (fromJust x)
-- this prints nothing at all
The single calls work just fine like this:
main = do
x <- supportedPairs
u <- (uncurry forex . (flip (!!) 10 . fromJust)) x
print u
-- this prints "Just (438.685041,UnixTime {utSeconds = 1649588583, utMicroSeconds = 0})"
Why doesn't the mapM_ print the results although they are evaluated? If I understood Haskell's laziness correctly, then if the results are not to be printed they should not be evaluated in the first place?
Check the types:
print is ... -> IO ().
Therefore, ... <&> print is IO (IO ()). Note the double IO here.
Hence, mapping over that, will run the "outermost IO" but not the "innermost IO". More concretely, compare this:
main = do
x <- print True >> return 5 -- x is 5
y <- return (print True >> return 5) -- y is an IO action
...
Only the first print True here is executed: the second IO action is used to define y but until we run y it won't be executed.
The final point: here, you do not need <&> since that creates the nested IO's. Use flip (>>=) print (or (=<<) print, or (>>= print)) instead of flip <&> print.
There is the following task:
First line is the number of cases
For each case there is a line with the number of numbers to add
For each case there is also a line with the numbers
For each case I have to print summed numbers
Example:
Input:
2
5
1 2 3 4 5
2
-100 100
Output:
15
0
This is my implementation
import Control.Monad
main = do
linesCount <- readLn :: IO Int
numbers <- replicateM linesCount getCase
mapM_ putStrLn $ map (show.sum) numbers
getCase :: IO [Int]
getCase = do
numbersCount <- readLn :: IO Int -- actually I don't need this variable
numbersString <- getLine
let numbers = map read $ words numbersString
return numbers
It looks like a lot of code for parsing input. Are there any tricks to "compress" it? :)
If you merely want to make code shorter then check out the Stack Exchange community for code golfing. That is primarily for fun and games.
If we are thinking there is too much code it may not be that we need to make it shorter but rather that we need to make it clearer. Achieving this is a matter of experience and good practice. What we want to do is isolate simple concepts which are obviously correct and then combine them in obviously correct ways. Methodologies include top-down design (break the solution into smaller pieces) and bottom-up design (from smaller pieces build up to the solution) and mixes thereof.
A bottom-up piece that hits me straight away is the task of summing a list of numbers. This has a definition in Haskell's Prelude called sum :: (Num a, Foldable t) => t a -> a. Somewhere in the final solution we are going to use this.
Another method is to simplify the problem. We can be lead astray by the way a problem is phrased. Upon closer inspection we might find an equivalent and simpler phrasing.
What information do we actually need from the input? Just the lists of numbers. What is the simplest way to obtain the lists of numbers? The number of lists seems irrelevant because there is no need to have this information before we start looking at the lists. Drop the first line and we are left with:
5
1 2 3 4 5
2
-100 100
Then, the length of each list is also irrelevant because we do not need that information before summing the list. Therefore lets also drop every other line from this point:
1 2 3 4 5
-100 100
Now we just have the lists of numbers separated by line returns where each number is separated by a space.
At this point we have a clear way to break apart the solution in a top-down manner. First we simplify the input. Secondly we parse the lists of numbers. Thirdly we sum the lists. Fourthly we print the sums. This is therefore the skeleton of our solution:
simplifyInput :: String -> [String]
parseNumberList :: String -> [Integer]
-- Note we can use `sum` from Prelude to sum the number lists.
printSums :: [Integer] -> IO ()
main :: IO ()
main = getContents >>= printSums . fmap (sum . parseNumberList) . simplifyInput
Now it is just a matter of implementing each obvious piece of the solution.
simplifyInput :: String -> [String]
simplifyInput = dropEveryOther . drop 1 . lines
where
dropEveryOther :: [a] -> [a]
In writing simplifyInput I discovered that dropping every other line requires some more work. That is okay, we can just break the solution apart again.
dropEveryOther :: [a] -> [a]
dropEveryOther [] = []
dropEveryOther (x:y:xs) = y : dropEveryOther xs
Then continuing...
parseNumberList :: String -> [Integer]
parseNumberList = fmap read . words
printSums :: [Integer] -> IO ()
printSums = putStr . unlines . fmap show
Therefore, in totality:
simplifyInput :: String -> [String]
simplifyInput = dropEveryOther . drop 1 . lines
where
dropEveryOther :: [a] -> [a]
dropEveryOther [] = []
dropEveryOther (_:y:xs) = y : dropEveryOther xs
parseNumberList :: String -> [Integer]
parseNumberList = fmap read . words
printSums :: [Integer] -> IO ()
printSums = putStr . unlines . fmap show
main :: IO ()
main = getContents >>= printSums . fmap (sum . parseNumberList) . simplifyInput
The amount of code we have has gone up (compared to the first solution) but in exchange the code is made obvious. Now you should add some documentation comments so we do not forget our explanation for the solution.
Alec posted a super compressed version of my original code in one of the comments. I decided to post a small breakdown, in case someone gets lost and has no idea what's going on in there :)
Snippets below need to be preceded with valid imports:
import Control.Monad
import Control.Applicative
So we start with Alec's version:
main = readLn >>= flip replicateM_ (getLine >> sum . map read . words <$> getLine >>= print)
He used the flip function in order to remove one set of parenthesis:
main = readLn >>= (`replicateM_` (getLine >> (print =<< sum . map read . words <$> getLine)))
He used the infix notation for replicateM_ in order to partially apply the second parameter of replicateM_, we can replace is with a lambda:
main = readLn >>= \n -> replicateM_ n (getLine >> (print =<< sum . map read . words <$> getLine))
Now let's start extracting some pieces of code into separate meaningful functions:
printBatchResult = print =<< sum . map read . words <$> getLine
main = readLn >>= \n -> replicateM_ n (getLine >> printBatchResult)
We can flip the print =<< for more readability:
printBatchResult = sum . map read . words <$> getLine >>= print
main = readLn >>= \n -> replicateM_ n (getLine >> printBatchResult)
And so on:
printBatchResult = sum . map read . words <$> getLine >>= print
handleBatch = getLine >> printBatchResult
main = readLn >>= \n -> replicateM_ n handleBatch
And again:
sumLine = sum . map read . words
printBatchResult = sumLine <$> getLine >>= print
handleBatch = getLine >> printBatchResult
main = readLn >>= \n -> replicateM_ n handleBatch
And one more time:
sumLine = sum . map read . words
handleNumbersLine = sumLine <$> getLine
printBatchResult = handleNumbersLine >>= print
handleBatch = getLine >> printBatchResult
main = readLn >>= (\n -> replicateM_ n handleBatch)
And finally the last time:
sumLine = sum . map read . words
handleNumbersLine = sumLine <$> getLine
printBatchResult = handleNumbersLine >>= print
handleBatch = getLine >> printBatchResult
handleAllBatches n = replicateM_ n handleBatch
main = readLn >>= handleAllBatches
We can replace <$> with fmap:
sumLine = sum . map read . words
handleNumbersLine = fmap sumLine getLine
printBatchResult = handleNumbersLine >>= print
handleBatch = getLine >> printBatchResult
handleAllBatches n = replicateM_ n handleBatch
main = readLn >>= handleAllBatches
We can also remove every partial application:
sumLine line = (sum . map read . words) line
handleNumbersLine = fmap sumLine getLine
printBatchResult = handleNumbersLine >>= \sum -> print sum
handleBatch = getLine >> printBatchResult
handleAllBatches n = replicateM_ n handleBatch
main = readLn >>= \numberOfBatches -> handleAllBatches numberOfBatches
And finally, add signatures:
sumLine :: String -> Int
sumLine line = (sum . map read . words) line
handleNumbersLine :: IO Int
handleNumbersLine = fmap sumLine getLine
printBatchResult :: IO ()
printBatchResult = handleNumbersLine >>= \sum -> print sum
handleBatch :: IO ()
handleBatch = getLine >> printBatchResult
handleAllBatches :: Int -> IO ()
handleAllBatches n = replicateM_ n handleBatch
main = readLn >>= \numberOfBatches -> handleAllBatches numberOfBatches
Some final comments:
>>= - the bind function from monad converts one monad to another (or the same) and transforms its value. In main function it takes IO Int, transformation lambda and returns IO () - the result of the transformation, which is empty and prints result in the process.
>> - (used in handleBatch) ignores the left parameter (how many numbers there are in a line is (arguably) unnecessary) and just returns the right parameter - which is a function handling a line with numbers.
I want to write a conjugate gradient solver in Haskell and want to use lazy lists to decouple stopping rule and output of information from the iterations. My code essentially looks like this:
data CGState = CGState { cgx :: Image
, cgp :: Image
, cgr :: Image
, cgr2 :: Double
}
cg :: Operator -> Image -> [CGState]
cg = [...]
runCG :: (CGState -> Bool) -> Operator -> Image -> IO Image
runCG stoprule op rhs = do
let steps = takeWhile (not . stoprule) $ cg op rhs
fmap last $ forM (zip [(1::Int)..] steps) $ \(n, cgs) -> do
putStrLn $ show n ++ " " ++ show (sqrt $ cgr2 cgs)
return $ cgx cgs
The idea is to iterate over the list, output some information, but only retain the last iterate. However, when running this code, it does not seem to garbage collect the preceding iterates. My guess is that this is connected to IO: if I rewrite the code like
runCG :: (CGState -> Bool) -> Operator -> Image -> IO Image
runCG stoprule op rhs = do
let steps = takeWhile (not . stoprule) $ cg op rhs
return $ cgx $ last steps
the problem does not occur, i.e. everything but the final iterate gets garbage collected directly.
How can I achieve the same effect while being able to output some information about the iterates?
Right, I think the problem is with fmap in IO: because IO actions are always executed in strict sequence, the fmap only applies the last after the entire result list from forM has been constructed.
Instead you can probably use Control.Monad.foldM, which folds monadically over a list (untested):
runCG stoprule op rhs = do
let steps = takeWhile (not . stoprule) $ cg op rhs
foldM (\ _ (n, cgs) -> do
putStrLn $ show n ++ " " ++ show (sqrt $ cgr2 cgs)
return $ cgx cgs)
undefined -- initial value for fold is ignored as long as steps is nonempty
(zip [(1::Int)..] steps)
Basically I would like to find a way so that a user can enter the number of test cases and then input their test cases. The program can then run those test cases and print out the results in the order that the test cases appear.
So basically I have main which reads in the number of test cases and inputs it into a function that will read from IO that many times. It looks like this:
main = getLine >>= \tst -> w (read :: String -> Int) tst [[]]
This is the method signature of w: w :: Int -> [[Int]]-> IO ()
So my plan is to read in the number of test cases and have w run a function which takes in each test case and store the result into the [[]] variable. So each list in the list will be an output. w will just run recursively until it reaches 0 and print out each list on a separate line. I'd like to know if there is a better way of doing this since I have to pass in an empty list into w, which seems extraneous.
As #bheklilr mentioned you can't update a value like [[]]. The standard functional approach is to pass an accumulator through a a set of recursive calls. In the following example the acc parameter to the loop function is this accumulator - it consists of all of the output collected so far. At the end of the loop we return it.
myTest :: Int -> [String]
myTest n = [ "output line " ++ show k ++ " for n = " ++ show n | k <- [1..n] ]
main = do
putStr "Enter number of test cases: "
ntests <- fmap read getLine :: IO Int
let loop k acc | k > ntests = return $ reverse acc
loop k acc = do
-- we're on the kth-iteration
putStr $ "Enter parameter for test case " ++ show k ++ ": "
a <- fmap read getLine :: IO Int
let output = myTest a -- run the test
loop (k+1) (output:acc)
allOutput <- loop 1 []
print allOutput
As you get more comfortable with this kind of pattern you'll recognize it as a fold (indeed a monadic fold since we're doing IO) and you can implement it with foldM.
Update: To help explain how fmap works, here are equivalent expressions written without using fmap:
With fmap: Without fmap:
n <- fmap read getLine :: IO [Int] line <- getLine
let n = read line :: Int
vals <- fmap (map read . words) getLine line <- getLine
:: IO [Int] let vals = (map read . words) line :: [Int]
Using fmap allows us to eliminate the intermediate variable line which we never reference again anyway. We still need to provide a type signature so read knows what to do.
The idiomatic way is to use replicateM:
runAllTests :: [[Int]] -> IO ()
runAllTests = {- ... -}
main = do
numTests <- readLn
tests <- replicateM numTests readLn
runAllTests tests
-- or:
-- main = readLn >>= flip replicateM readLn >>= runAllTests
Solving a problem from Google Code Jam (2009.1A.A: "Multi-base happiness") I came up with an awkward (code-wise) solution, and I'm interested in how it could be improved.
The problem description, shortly, is: Find the smallest number bigger than 1 for which iteratively calculating the sum of squares of digits reaches 1, for all bases from a given list.
Or description in pseudo-Haskell (code that would solve it if elem could always work for infinite lists):
solution =
head . (`filter` [2..]) .
all ((1 `elem`) . (`iterate` i) . sumSquareOfDigitsInBase)
And my awkward solution:
By awkward I mean it has this kind of code: happy <- lift . lift . lift $ isHappy Set.empty base cur
I memoize results of the isHappy function. Using the State monad for the memoized results Map.
Trying to find the first solution, I did not use head and filter (like the pseudo-haskell above does), because the computation isn't pure (changes state). So I iterated by using StateT with a counter, and a MaybeT to terminate the computation when condition holds.
Already inside a MaybeT (StateT a (State b)), if the condition doesn't hold for one base, there is no need to check the other ones, so I have another MaybeT in the stack for that.
Code:
import Control.Monad.Maybe
import Control.Monad.State
import Data.Maybe
import qualified Data.Map as Map
import qualified Data.Set as Set
type IsHappyMemo = State (Map.Map (Integer, Integer) Bool)
isHappy :: Set.Set Integer -> Integer -> Integer -> IsHappyMemo Bool
isHappy _ _ 1 = return True
isHappy path base num = do
memo <- get
case Map.lookup (base, num) memo of
Just r -> return r
Nothing -> do
r <- calc
when (num < 1000) . modify $ Map.insert (base, num) r
return r
where
calc
| num `Set.member` path = return False
| otherwise = isHappy (Set.insert num path) base nxt
nxt =
sum . map ((^ (2::Int)) . (`mod` base)) .
takeWhile (not . (== 0)) . iterate (`div` base) $ num
solve1 :: [Integer] -> IsHappyMemo Integer
solve1 bases =
fmap snd .
(`runStateT` 2) .
runMaybeT .
forever $ do
(`when` mzero) . isJust =<<
runMaybeT (mapM_ f bases)
lift $ modify (+ 1)
where
f base = do
cur <- lift . lift $ get
happy <- lift . lift . lift $ isHappy Set.empty base cur
unless happy mzero
solve :: [String] -> String
solve =
concat .
(`evalState` Map.empty) .
mapM f .
zip [1 :: Integer ..]
where
f (idx, prob) = do
s <- solve1 . map read . words $ prob
return $ "Case #" ++ show idx ++ ": " ++ show s ++ "\n"
main :: IO ()
main =
getContents >>=
putStr . solve . tail . lines
Other contestants using Haskell did have nicer solutions, but solved the problem differently. My question is about small iterative improvements to my code.
Your solution is certainly awkward in its use (and abuse) of monads:
It is usual to build monads piecemeal by stacking several transformers
It is less usual, but still happens sometimes, to stack several states
It is very unusual to stack several Maybe transformers
It is even more unusual to use MaybeT to interrupt a loop
Your code is a bit too pointless :
(`when` mzero) . isJust =<<
runMaybeT (mapM_ f bases)
instead of the easier to read
let isHappy = isJust $ runMaybeT (mapM_ f bases)
when isHappy mzero
Focusing now on function solve1, let us simplify it.
An easy way to do so is to remove the inner MaybeT monad. Instead of a forever loop which breaks when a happy number is found, you can go the other way around and recurse only if the
number is not happy.
Moreover, you don't really need the State monad either, do you ? One can always replace the state with an explicit argument.
Applying these ideas solve1 now looks much better:
solve1 :: [Integer] -> IsHappyMemo Integer
solve1 bases = go 2 where
go i = do happyBases <- mapM (\b -> isHappy Set.empty b i) bases
if and happyBases
then return i
else go (i+1)
I would be more han happy with that code.
The rest of your solution is fine.
One thing that bothers me is that you throw away the memo cache for every subproblem. Is there a reason for that?
solve :: [String] -> String
solve =
concat .
(`evalState` Map.empty) .
mapM f .
zip [1 :: Integer ..]
where
f (idx, prob) = do
s <- solve1 . map read . words $ prob
return $ "Case #" ++ show idx ++ ": " ++ show s ++ "\n"
Wouldn't your solution be more efficient if you reused it instead ?
solve :: [String] -> String
solve cases = (`evalState` Map.empty) $ do
solutions <- mapM f (zip [1 :: Integer ..] cases)
return (unlines solutions)
where
f (idx, prob) = do
s <- solve1 . map read . words $ prob
return $ "Case #" ++ show idx ++ ": " ++ show s
The Monad* classes exist to remove the need for repeated lifting. If you change your signatures like this:
type IsHappyMemo = Map.Map (Integer, Integer) Bool
isHappy :: MonadState IsHappyMemo m => Set.Set Integer -> Integer -> Integer -> m Bool
This way you can remove most of the 'lift's. However, the longest sequence of lifts cannot be removed, since it is a State monad inside a StateT, so using the MonadState type class will give you the outer StateT, where you need tot get to the inner State. You could wrap your State monad in a newtype and make a MonadHappy class, similar to the existing monad classes.
ListT (from the List package) does a much nicer job than MaybeT in stopping the calculation when necessary.
solve1 :: [Integer] -> IsHappyMemo Integer
solve1 bases = do
Cons result _ <- runList . filterL cond $ fromList [2..]
return result
where
cond num = andL . mapL (isHappy Set.empty num) $ fromList bases
Some elaboration on how this works:
Had we used a regular list the code would had looked like this:
solve1 bases = do
result:_ <- filterM cond [2..]
return result
where
cond num = fmap and . mapM (isHappy Set.empty num) bases
This calculation happens in a State monad, but if we'd like to get the resulting state, we'd have a problem, because filterM runs the monadic predicate it gets for every element of [2..], an infinite list.
With the monadic list, filterL cond (fromList [2..]) represents a list that we can access one item at a time as a monadic action, so our monadic predicate cond isn't actually executed (and affecting the state) unless we consume the corresponding list items.
Similarly, implementing cond using andL makes us not calculate and update the state if we already got a False result from one of the isHappy Set.empty num calculations.