With the following code:
(lazy_test.hs)
-- Testing lazy evaluation of monadically constructed lists, using State.
import Control.Monad.State
nMax = 5
foo :: Int -> State [Int] Bool
foo n = do
modify $ \st -> n : st
return (n `mod` 2 == 1)
main :: IO ()
main = do
let ress = for [0..nMax] $ \n -> runState (foo n) []
sts = map snd $ dropWhile (not . fst) ress
print $ head sts
for = flip map
I can set nMax to 5, or 50,000,000, and I get approximately the same run time:
nMax = 5:
$ stack ghc lazy_test.hs
[1 of 1] Compiling Main ( lazy_test.hs, lazy_test.o )
Linking lazy_test ...
$ time ./lazy_test
[1]
real 0m0.019s
user 0m0.002s
sys 0m0.006s
nMax = 50,000,000:
$ stack ghc lazy_test.hs
[1 of 1] Compiling Main ( lazy_test.hs, lazy_test.o )
Linking lazy_test ...
$ time ./lazy_test
[1]
real 0m0.020s
user 0m0.002s
sys 0m0.005s
which is as I expect, given my understanding of lazy evaluation mechanics.
However, if I switch from State to StateT:
(lazy_test2.hs)
-- Testing lazy evaluation of monadically constructed lists, using StateT.
import Control.Monad.State
nMax = 5
foo :: Int -> StateT [Int] IO Bool
foo n = do
modify $ \st -> n : st
return (n `mod` 2 == 1)
main :: IO ()
main = do
ress <- forM [0..nMax] $ \n -> runStateT (foo n) []
let sts = map snd $ dropWhile (not . fst) ress
print $ head sts
for = flip map
then I see an extreme difference between the respective run times:
nMax = 5:
$ stack ghc lazy_test2.hs
[1 of 1] Compiling Main ( lazy_test2.hs, lazy_test2.o )
Linking lazy_test2 ...
$ time ./lazy_test2
[1]
real 0m0.019s
user 0m0.002s
sys 0m0.004s
nMax = 50,000,000:
$ stack ghc lazy_test2.hs
[1 of 1] Compiling Main ( lazy_test2.hs, lazy_test2.o )
Linking lazy_test2 ...
$ time ./lazy_test2
[1]
real 0m29.758s
user 0m25.488s
sys 0m4.231s
And I'm assuming that's because I'm losing lazy evaluation of the monadically constructed list, when I switch to the StateT-based implementation.
Is that correct?
Can I recover lazy evaluation of a monadically constructed list, while keeping with the StateT-based implementation?
In your example, you're only running one foo action per runState, so your use of State and/or StateT is essentially irrelevant. You can replace the use of foo with the equivalent:
import Control.Monad
nMax = 50000000
main :: IO ()
main = do
ress <- forM [0..nMax] $ \n -> return (n `mod` 2 == 1, [n])
let sts = map snd $ dropWhile (not . fst) ress
print $ head sts
and it behaves the same way.
The issue is the strictness of the IO monad. If you ran this computation in the Identity monad instead:
import Control.Monad
import Data.Functor.Identity
nMax = 50000000
main :: IO ()
main = do
let ress = runIdentity $ forM [0..nMax] $ \n -> return (n `mod` 2 == 1, [n])
let sts = map snd $ dropWhile (not . fst) ress
print $ head sts
then it would run lazily.
If you want to run lazily in the IO monad, you need to do it explicitly with unsafeInterleaveIO, so the following would work:
import System.IO.Unsafe
import Control.Monad
nMax = 50000000
main :: IO ()
main = do
ress <- lazyForM [0..nMax] $ \n -> return (n `mod` 2 == 1, [n])
let sts = map snd $ dropWhile (not . fst) ress
print $ head sts
lazyForM :: [a] -> (a -> IO b) -> IO [b]
lazyForM (x:xs) f = do
y <- f x
ys <- unsafeInterleaveIO (lazyForM xs f)
return (y:ys)
lazyForM [] _ = return []
The other answer by K A Buhr explains why State vs StateT is not the pertinent factor (IO is), and also points out how your example is strangely constructed (in that the State(T) part isn't actually used as each number uses a new state []). But aside from those points, I'm not sure I would say "losing lazy evaluation of the monadically constructed list", because if we understand something like "lazy evaluation = evaluated only when needed", then foo does indeed need to run on every element on the input list in order to perform all the effects, so lazy evaluation is not being "lost". You are getting what you asked for. (It just so happens that foo doesn't perform any IO, and perhaps someone else can comment with if it's ever possible for a compiler/GHC to optimize it away on this basis, but you can easily see why GHC does the naive thing here.)
This is a common, well-known problem in Haskell. There are various libraries (best known of which are streaming, pipes, conduit) which solve the problem by giving you streams (basically lists) which are lazy in the effects too. If I recreate your example in a streaming style,
import Data.Function ((&))
import Control.Monad.State
import Streaming
import qualified Streaming.Prelude as S
foo :: Int -> StateT [Int] IO Bool
foo n =
(n `mod` 2 == 1) <$ modify (n:)
nMax :: Int
nMax = 5000000
main :: IO ()
main = do
mHead <- S.head_ $ S.each [0..nMax]
& S.mapM (flip runStateT [] . foo)
& S.dropWhile (not . fst)
print $ snd <$> mHead
then both versions run practically instantaneously. To make the difference more apparent, imagine that foo also called print "hi". Then the streaming version, being lazy in the effects, would print only twice, whereas your original versions would both print nMax times. As they're lazy in the effects, then the whole list doesn't need to be traversed in order to short-circuit and finish early.
I'm learning Haskell for two years now and I'm still confused, whats the best (fastest) way to read tons of numbers from a single input line.
For learning I registered into hackerearth.com trying to solve every challenge in Haskell. But now I'm stuck with a challenge because I run into timeout issues. My program is just too slow for beeing accepted by the site.
Using the profiler I found out it takes 80%+ of the time for parsing a line with lots of integers. The percentage gets even higher when the number of values in the line increases.
Now this is the way, I'm reading numbers from an input line:
import qualified Data.ByteString.Char8 as C8
main = do
scores <- fmap (map (fst . fromJust . C8.readInt) . C8.words) C8.getLine :: IO [Int]
Is there any way to get the data faster into the variable?
BTW: The biggest testcase consist of a line with 200.000 9-digits values. Parsing takes incredible long (> 60s).
It's always difficult to declare a particular approach "the fastest", since there's almost always some way to squeeze out more performance. However, an approach using Data.ByteString.Char8 and the general method you suggest should be among the fastest methods for reading numbers. If you encounter a case where performance is poor, the problem likely lies elsewhere.
To give some concrete results, I generated a 191Meg file of 20 million 9-digit numbers, space-separate on a single line. I then tried several general methods of reading a line of numbers and printing their sum (which, for the record, was 10999281565534666). The obvious approach using String:
reader :: IO [Int]
reader = map read . words <$> getLine
sum' xs = sum xs -- work around GHC ticket 10992
main = print =<< sum' <$> reader
took 52secs; a similar approach using Text:
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Read as T
readText = map parse . T.words <$> T.getLine
where parse s = let Right (n, _) = T.decimal s in n
ran in 2.4secs (but note that it would need to be modified to handle negative numbers!); and the same approach using Char8:
import qualified Data.ByteString.Char8 as C
readChar8 :: IO [Int]
readChar8 = map parse . C.words <$> C.getLine
where parse s = let Just (n, _) = C.readInt s in n
ran in 1.4secs. All examples were compiled with -O2 on GHC 8.0.2.
As a comparison benchmark, a scanf-based C implementation:
/* GCC 5.4.0 w/ -O3 */
#include <stdio.h>
int main()
{
long x, acc = 0;
while (scanf(" %ld", &x) == 1) {
acc += x;
}
printf("%ld\n", acc);
return 0;
}
ran in about 2.5secs, on par with the Text implementation.
You can squeeze a bit more performance out of the Char8 implementation. Using a hand-rolled parser:
readChar8' :: IO [Int]
readChar8' = parse <$> C.getLine
where parse = unfoldr go
go s = do (n, s1) <- C.readInt s
let s2 = C.dropWhile C.isSpace s1
return (n, s2)
runs in about 0.9secs -- I haven't tried to determine why there's a difference, but the compiler must be missing an opportunity to perform some optimization of the words-to-readInt pipeline.
Haskell Code for Reference
Make some numbers with Numbers.hs:
-- |Generate 20M 9-digit numbers:
-- ./Numbers 20000000 100000000 999999999 > data1.txt
import qualified Data.ByteString.Char8 as C
import Control.Monad
import System.Environment
import System.Random
main :: IO ()
main = do [n, a, b] <- map read <$> getArgs
nums <- replicateM n (randomRIO (a,b))
let _ = nums :: [Int]
C.putStrLn (C.unwords (map (C.pack . show) nums))
Find their sum with Sum.hs:
import Data.List
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Read as T
import qualified Data.Char8 as C
import qualified Data.ByteString.Char8 as C
import System.Environment
-- work around https://ghc.haskell.org/trac/ghc/ticket/10992
sum' xs = sum xs
readString :: IO [Int]
readString = map read . words <$> getLine
readText :: IO [Int]
readText = map parse . T.words <$> T.getLine
where parse s = let Right (n, _) = T.decimal s in n
readChar8 :: IO [Int]
readChar8 = map parse . C.words <$> C.getLine
where parse s = let Just (n, _) = C.readInt s in n
readHand :: IO [Int]
readHand = parse <$> C.getLine
where parse = unfoldr go
go s = do (n, s1) <- C.readInt s
let s2 = C.dropWhile C.isSpace s1
return (n, s2)
main = do [method] <- getArgs
let reader = case method of
"string" -> readString
"text" -> readText
"char8" -> readChar8
"hand" -> readHand
print =<< sum' <$> reader
where:
./Sum string <data1.txt # 54.3 secs
./Sum text <data1.txt # 2.29 secs
./Sum char8 <data1.txt # 1.34 secs
./Sum hand <data1.txt # 0.91 secs
As part of my Haskell journey, I am implementing a raytracer and I need to be able to draw sequences of random numbers at several places in the code. Typically I would like to be able to get say 64 samples for each pixels and pixels are computed in parallel.
I was looking at the state monad to achieve that and I was guided by this answer Sampling sequences of random numbers in Haskell but the code I wrote does not terminate and it's memory consumption explodes.
Here is the abstracted part of the code:
I was hopping to be able to call sampleUniform several time in the code to get new lists of random numbers but if I do runhaskell test.hs, it outputs the first character of the lis [ and then it is stuck in an apparently infinite loop.
module Main (main
, computeArray) where
import Control.Monad
import Control.Monad.State (State, evalState, get, put)
import System.Random (StdGen, mkStdGen, random)
import Control.Applicative ((<$>))
type Rnd a = State StdGen a
runRandom :: Rnd a -> Int -> a
runRandom action seed = evalState action $ mkStdGen seed
rand :: Rnd Double
rand = do
gen <- get
let (r, gen') = random gen
put gen'
return r
{- Uniform distributions -}
uniform01 :: Rnd [Double]
uniform01 = mapM (\_ -> rand) $ repeat ()
{- Get n samples uniformly distributed between 0 and 1 -}
sampleUniform :: Int -> Rnd [Double]
sampleUniform n = liftM (take n) uniform01
computeArray :: Rnd [Bool]
computeArray = do
samples1 <- sampleUniform 10
samples2 <- sampleUniform 10
let dat = zip samples1 samples2
return $ uncurry (<) <$> dat
main :: IO ()
main = do
let seed = 48
let res = runRandom computeArray seed
putStrLn $ show res
uniform01 threads your state through an infinite number of computations, which means that although it produces its result lazily, there is no hope of retrieving a final state at the end to use for the next sampling. liftM (take n) only affects the final value, not the state effects used to compute it. Therefore as written, you can only use uniform01/sampleUniform once.
Instead you can thread the state through only as many rand actions as you use, e.g. with
sampleUniform n = mapM (\_ -> rand) $ replicate n ()
or simpler
sampleUniform n = sequence $ replicate n rand
I have a function in my main block
map anyHeavyFunction [list]
I'd like to show a progress bar during the computation process or add additional actions (pause, stop process etc.), but because map is a pure function I can't do it directly. I can guess I have to use monads, but what monad is appropriate? IO, State?
I know there is at least one library on hackage that has some pre-made monad transformers for this task, but I normally turn to the pipes package to roll my own when I need one. I am using pipes-4.0.0 it is going to be on hackage this weekend, but you can grab it form the github repo before that.
I also used terminal-progress-bar package so that it makes a nice terminal animation as well.
{-# language BangPatterns #-}
import Pipes
import qualified Pipes.Prelude as P
import Control.Monad.IO.Class
import System.ProgressBar
import System.IO ( hSetBuffering, BufferMode(NoBuffering), stdout )
-- | Takes the total size of the stream to be processed as l and the function
-- to map as fn
progress l = loop 0
where
loop n = do
liftIO $ progressBar (msg "Working") percentage 40 n l
!x <- await -- bang pattern to make strict
yield x
loop (n+1)
main = do
-- Force progress bar to print immediately
hSetBuffering stdout NoBuffering
let n = 10^6
let heavy x = last . replicate n $ x -- time wasting function
r <- P.toListM $ each [1..100] >-> P.map heavy >-> progress 100
putStrLn ""
return r
This animates:
> Working [=>.......................] 7%
> Working [=====>...................] 20%
Every update erases the last bar so it only take up one line on the terminal. Then it finishes like so:
> main
Working [=========================] 100%
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100]
Here's a (kind of) simple answer that I'm not satisfied with. It is based on the fact that #shellenberg wanted to apply a heavy function on each element of a (supposedly long) list. If it suffices to move the "progress bar" once for every element of the list, then the following can be turned into a general solution.
First of all, you need to pick the monad in which you'll work. This depends on what exactly your "progress bar" is. For this discussion, let's say that the IO monad is enough and that we want to alternately display the characters -, /, | and \. You'll also (most probably) need some kind of state S (here it is only the number of elements processed so far, therefore S is Int), so the real monad used will be StateT S IO.
Suppose your original program is:
m = 100000 -- how many elements the list has
-- Your (pure) function
anyHeavyFunction :: Int -> Bool
anyHeavyFunction n =
length [1..n] + length [n+1..4217] == 4217
-- Your list
list :: [Int]
list = take m $ repeat 4217
-- The main program
main :: IO ()
main = do
let l = map anyHeavyFunction list
if and l
then putStrLn "OK"
else putStrLn "WRONG"
(Notice that, very conveniently, the heavy function takes the same time for each element of the list.)
This is how you could convert it to display the crude "progress bar":
import Control.Monad.State
import System.IO (hFlush, stdout)
m = 100000 -- how many elements the list has
k = 5000 -- how often you want to "tick"
tick :: a -> StateT Int IO a
tick x = do
s <- get
put $ s+1
when (s `mod` k == 0) $ liftIO $ do
let r = (s `div` k) `mod` 4
putChar $ "-/|\\" !! r
putChar '\b'
hFlush stdout
x `seq` return x
-- Your (pure) function
anyHeavyFunction :: Int -> Bool
anyHeavyFunction n =
length [1..n] + length [n+1..4217] == 4217
-- Your list
list :: [Int]
list = take m $ repeat 4217
-- The main program
main :: IO ()
main = do
l <- flip evalStateT 0 $ mapM (tick . anyHeavyFunction) list
if and l
then putStrLn "OK"
else putStrLn "WRONG"
An interesting point: The seq in tick forces evaluation of the result for each element of the list. This is enough, if the result has a basic type (Bool here). Otherwise, it's not clear what you would want to do -- remember Haskell is lazy!
If one wants a finer progress bar or if one is not satisfied with the assumption that one "tick" will be counted for each element of the list, then I believe it's necessary to incorporate the ticking in the logic of the heavy function. This makes it ugly... I'd like to see what kind of general solutions can be suggested to that. I'm all in for Haskell, but I think it just sucks for such things as progress bars... There's no free lunch; you can't be pure and lazy and have your progress bars made easy!
EDIT: A version which uses the ProgressBar module suggested by #Davorak. It certainly looks nicer than my rotating bar.
import Control.Monad.State
import System.ProgressBar
import System.IO (hSetBuffering, BufferMode(NoBuffering), stdout)
m = 100000 -- how many elements the list has
k = 5000 -- how often you want to "tick"
tick :: a -> StateT Int IO a
tick x = do
s <- get
put $ s+1
when (s `mod` k == 0) $ liftIO $ do
progressBar (msg "Working") percentage 40 (toInteger s) (toInteger m)
x `seq` return x
-- Your (pure) function
anyHeavyFunction :: Int -> Bool
anyHeavyFunction n =
length [1..n] + length [n+1..4217] == 4217
-- Your list
list :: [Int]
list = take m $ repeat 4217
-- The main program
main :: IO ()
main = do
hSetBuffering stdout NoBuffering
l <- flip evalStateT 0 $ mapM (tick . anyHeavyFunction) list
if and l
then putStrLn "OK"
else putStrLn "WRONG"
The idea is the same, the drawbacks too.
You could use parMap to apply the expensive function in parallel (if the dependencies permit) and a list of TVars corresponding to each list (or chunk of) element(s) and set them once the respective function application has completed. A separate thread could check on the values and update the display (obviously some IO action would happen here).
module Main where
import Control.Parallel(par,pseq)
import Text.Printf
import Control.Exception
import System.CPUTime
import Data.List
import IO
import Data.Char
import Control.DeepSeq
time :: IO t -> IO t
time a = do
start <- getCPUTime
v <- a
end <- getCPUTime
let diff = (fromIntegral (end - start)) / (10^12)
printf "Computation time: %0.3f sec\n" (diff :: Double)
return v
learquivo :: FilePath -> IO ([[Int]])
learquivo s = do
content <- readFile s
return (read content)
main :: IO ()
main = do
t5 <- getCPUTime
content <- learquivo "mkList1.txt"
let !mapasort = rnf $ map sort content
t6 <- getCPUTime
let diffft6t5 = (fromIntegral (t6 - t5)) / (10^12)
printf "Computation time Mapasort: %0.3f sec\n" (diffft6t5 :: Double)
How to tell if it evaluates all elements of content?
let !mapasort = rnf $ map sort content
I used the line in winghci:
*Main> let !mapasort = rnf $ map sort content
But, returned:
*Main> mapasort ()
Thanks
I see two questions:
1) Why is mapsort evaluating to unit, ().
Because the rnf function always returns (). See the documentation.
2) Is everything evaluated
Yes. The DeepSeq instance (which is where rnf lives) for list just calls the deepseq instance for each element in the list:
rnf [] = ()
rnf (x:xs) = rnf x `seq` rnf xs
Your elements all Ints, which have a correct NFData instance.
And I'd add two more questions:
3) How should this benchmarking be done correctly?
Using Criterion. There are many Criterion advocates here on SO, you can find answers that would serve as good examples with a search.
4) How should this evaluation be forced for non-benchmarking purposes?
Using the parallel package.
import Control.Parallel.Strategies
...
let !mapsort = (map sort content) `using` (evalList rdeepseq)
or still using rnf:
let mapsort = map sort content
!_ = rnf mapsort