I'm trying to write a safe timing-out evaluation function in Haskell. The code goes as follows
import System.Timeout
compute, compute' :: Int -> Int
compute i = sum [1..300000 + i]
compute' i = last $ repeat i
timedComp :: Int -> a -> IO (Maybe a)
timedComp timeLeft toCompute =
timeout timeLeft go
where
go = toCompute `seq` return toCompute
main = do
res <- timedComp 10000 (compute 0)
print res
res' <- timedComp 10000 (compute' 0)
print res'
(I know that I only evaluate to WHNF.)
When I run main, I get only one Nothing on output and then the program hangs. I tried to compile and run the program multi-threaded but it doesn't help. Tried on both GHC 7.6.3 and 7.8.3. Any suggestions?
There's a limitation in the GHC implementation of Haskell threads: context switches occur only during allocation. As a consequence, tight loops which perform no allocation at all can prevent the scheduler to run, switching to other threads.
This is one of such examples: compute' i = last $ repeat i looks as if it's allocating list cells, but unfortunately GHC is able to optimize it as a trivial infinite loop, removing all allocation -- GHC Core looks roughly as f x = f x. This triggers the scheduler shortcoming.
Reid Barton suggests the option -fno-omit-yields to work around this. This will cause GHC not to optimize so much.
Related
I'm relatively new to Polysemy, and I'm trying to wrap my head around how to use NonDet correctly. Specifically, let's say I've got this computation
generate :: Member NonDet r => Sem r Int
generate = msum $ fmap pure [0..]
computation :: (Member NonDet r, Member (Final IO) r) => Sem r ()
computation = do
n <- generate
guard (n == 100)
embedFinal $ print n
It's a horribly inefficient way to print the number 100, but it demonstrates the problem I'm having. Now, I want to run this effect only insofar as to get the first success. That is, I want to run this effect long enough to "find" the number 100 and print it, and then I want to stop.
My first attempt
attempt1 :: IO ()
attempt1 = void . runFinal . runNonDet #[] $ computation
This one fails to short-circuit. It prints 100 but then hangs forever, looking for the number 100 again. That makes sense; after all, I didn't actually tell it I only wanted one solution. So let's try that.
My second attempt
runNonDetOnce :: Sem (NonDet ': r) a -> Sem r (Maybe a)
runNonDetOnce = fmap listToMaybe . runNonDet
attempt2 :: IO ()
attempt2 = void . runFinal . runNonDetOnce $ computation
All we're doing here is discarding all but the head of the list. Understandably, this didn't change anything. Haskell already wasn't evaluating the list, so discarding an unused value changes nothing. Like attempt1, this solution hangs forever after printing 100.
My third attempt
attempt3 :: IO ()
attempt3 = void . runFinal . runNonDetMaybe $ computation
So I tried using runNonDetMaybe. This one, unfortunately, just exits without printing anything. Figuring out why that is took a bit, but I have a theory. The documentation says
Unlike runNonDet, uses of <|> will not execute the second branch at all if the first option succeeds.
So it's greedy and doesn't backtrack after success, basically. Thus, it runs my computation like this.
computation = do
n <- generate -- Ah yes, n = 0. Excellent!
guard (n == 100) -- Wait, 0 /= 100! Failure! We can't backtrack, so abort.
embedFinal $ print n
Non-Solutions
In this small example, we could just alter the computation a bit, like so
computation :: (Member NonDet r, Member (Final IO) r) => Sem r ()
computation = msum $ fmap (\n -> guard (n == 100) >> embedFinal (print n)) [0..]
So rather than generate a number and then check it later, we simply move generate inside of computation. With this computation, attempt3 succeeds, since we can get to the "correct" answer without backtracking. This works in this small example, but it's infeasible for a larger codebase. Unless someone has a good systematic way of avoiding backtracking, I don't see a good way to generalize this solution to computations that span over multiple files in a large program.
The other non-solution is to cheat using IO.
computation :: (Member NonDet r, Member (Final IO) r) => Sem r ()
computation = do
n <- generate
guard (n == 100)
embedFinal $ print n
embedFinal $ exitSuccess
Now attempt1 and attempt2 succeed, since we simply forcibly exit the program after success. But, aside from feeling incredibly sloppy, this doesn't generalize either. I want to stop running the current computation after finding 100, not the whole program.
So, to summarize, I want the computation given in the first code snippet above to be run using Polysemy in some way that causes it to backtrack (in NonDet) until it finds one successful value (in the example above, n = 100) and then stop running side effects and end the computation. I tried delving into the source code of runNonDetMaybe and co in this hopes of being able to reproduce something similar to it that has the effect I want, but my Polysemy skills are not nearly to the level of understanding all of the Weaving and decomp shenanigans happening there. I hope someone here who has more expertise with this library than I do can point me in the right direction to running NonDet with the desired effects.
Now attempt1 and attempt2 succeed, since we simply forcibly exit the program after success. But, aside from feeling incredibly sloppy, this doesn't generalize either. I want to stop running the current computation after finding 100, not the whole program.
Rather than exitSuccess, a closely related idea is to throw an exception that you can catch in the interpreter.
I have a function that returns an IO action,
f :: Int -> IO Int
I would like to compute this function in parallel for multiple values of the argument. My naive implementation was as follows:
import Control.Parallel.Strategies
vals = [1..10]
main = do
results <- mapM f vals
let results' = results `using` parList rseq
mapM_ print results'
My reasoning for this was that the first mapM binds something of type IO [Int] to results, results' applies a parallel strategy to the contained list, and the mapM_ finally requests the actual values by printing them - but what is to be printed is already sparked in parallel, so the program should parallelize.
After being happy that it does indeed use all my CPUs, I noticed that the program is less effective (as in wall clock time) when being run with +RTS -N8 than without any RTS flags. The only explanation I can think of is that the first mapM has to sequence - i.e. perform - all the IO actions already, but that would not lead to ineffectivity, but make the N8 execution as effective as the unparallelized one, because all the work is done by the master thread. Running the program with +RTS -N8 -s yields SPARKS: 36 (11 converted, 0 overflowed, 0 dud, 21 GC'd, 4 fizzled), which surely isn't optimal, but unfortunately I can't make any sense of it.
I suppose I've found one of the beginner's stepping stones in Haskell parallelization or the internals of the IO monad. What am I doing wrong?
Background info: f n is a function that returns the solution for Project Euler problem n. Since many of them have data to read, I put the result into the IO monad. An example of how it may look like is
-- Problem 13: Work out the first ten digits of the sum of one-hundred 50-digit numbers.
euler 13 = fmap (first10 . sum) numbers
where
numbers = fmap (map read . explode '\n') $ readFile "problem_13"
first10 n
| n < 10^10 = n -- 10^10 is the first number with 11 digits
| otherwise = first10 $ n `div` 10
The full file can be found here (It's a bit long, but the first few "euler X" functions should be representative enough), the main file where I do the parallelism is this one.
Strategies are for parallel execution of pure computations. If it really is mandatory that your f returns an IO value, then consider using the async package instead. It provides useful combinators for running IO actions concurrently.
For your use case, mapConcurrently looks useful:
import Control.Concurrent.Async
vals = [1..10]
main = do
results <- mapConcurrently f vals
mapM_ print results
(I haven't tested though, because I don't know what your f is exactly.)
Try the parallel-io package. It allows you to change any mapM_ into parallel_.
Recently I was trying to determine the time needed to calculate a waveform using the vector storage type.
I wanted to do so without requiring to print the length or something like that. Finally I came up with the following two definitions. It seems simple enough, and from what I can tell it prints a non-zero computation time as expected the first time I run the function, but I'm wondering if there are any laziness caveats here that I've missed.
import System.IO
import System.CPUTime
import qualified Data.Vector.Storable as V
timerIO f = do
start <- getCPUTime
x <- f
let !y = x
end <- getCPUTime
let diff = (fromIntegral (end - start)) / (10^12)
print $ "Computation time: " ++ show diff ++ " sec\n"
timer f = timerIO $ do return f
main :: IO ()
main = do
let sr = 1000.0
time = V.map (/ sr) $ V.enumFromN 0 120000 :: V.Vector Float
wave = V.map (\x -> sin $ x * 2 * pi * 10) time :: V.Vector Float
timer wave
timer wave
prints,
Computation time: 0.16001 sec
Computation time: 0.0 sec
Are there any hidden bugs here? I'm really not sure that the let with strictness flag is really the best way to go here. Is there a more concise way to write this? Are there any standard functions that already do this that I should know about?
Edit: I should mention that I had read about criterion but in this case I was not looking for a robust way to calculate average timing for profiling-only purposes; rather I was looking for a simple / low-overhead way to integrate single timers into my program for tracing the timing of some computations during normal running of the application. Criterion is cool, but this was a slightly different use case.
If evaluating to weak head normal form is enough - for strict Vectors or UArrays it is -, then your timing code works well¹, however, instead of the bang pattern in the let-binding, you could put a bang on the monadic bind,
start <- getCPUTime
!x <- f
end <- getCPUTime
which to me looks nicer, or you could use Control.Exception.evaluate
start <- getCPUTime
evaluate f
end <- getCPUTime
which has the advantage of (supposed) portability, whereas bang patterns are a GHC extension. If WHNF is not enough, you would need to force full evaluation, for example using rnf or deepseq, like
start <- getCPUTime
!x <- rnf `fmap` f
end <- getCPUTime
However, repeatedly timing the same computation with that is hairy. If, as in your example, you give the thing a name, and call it
timer wave
timer wave
the compiler shares the computation, so it's only done once and all but the first timer calls return zero (or very close to zero) times. If you call it with code instead of a name,
timer (V.map (\x -> sin $ x * 2 * pi * 10) time :: V.Vector Float)
timer (V.map (\x -> sin $ x * 2 * pi * 10) time :: V.Vector Float)
the compiler can still share the computation, if it does common subexpression elimination. And although GHC doesn't do much CSE, it does some and I'm rather confident it would spot and share this (when compiling with optimisations). To reliably make the compiler repeat the computations, you need to hide the fact that they are the same from it (or use some low-level internals), which is not easy to do without influencing the time needed for the computation.
¹ It works well if the computation takes a significant amount of time. If it takes only a short time, the jitter introduced by outside influences (CPU load, scheduling, ...) will make single timings far too unreliable. Then you should do multiple measurements, and for that, as has been mentioned elsewhere, the criterion library is an excellent way to relieve you of the burden of writing robust timing code.
Are you familiar with the deepseq package? It's used by the criterion package for pretty much the purpose you describe.
Speaking of which, you may want to consider whether criterion itself does what you need anyway.
Is there a simple method to compute time of function execution in Haskell?
Simplest things is to just do :set +s in ghci, and then you can see the execution time of anything you run, along with memory usage.
The criterion package was made specifically to do this well.
See if http://hackage.haskell.org/package/timeit suits your needs.
function execution time benchmark is included in Criterion.Measurement
for example, if I want to capture the time of someIOFunction :: IO ()
import Criterion.Measurement
main = secs <$> time_ someIOFunction >>= print
Criterion is the most sophisticated method, although I found it difficult to start, and it seems targeted to benchmarking programs. I wanted to compute the time of execution and use that data within my program and it doesn't seem to address this need, at least it's not immediately apparent.
TimeIt is very simple and does what I wanted, except it does not handle pure functions well. The time returned for a pure function is the thunk allocation time (AFAIK) and even with using seq it can be difficult to get what you want.
What is working for me is based on TimeIt.
import System.TimeIt
timeItTPure :: (a -> ()) -> a -> IO (Double,a)
timeItTPure p a = timeItT $ p a `seq` return a
In timeItTPure p a, p is the function responsible for evaluating the result of a pure calculation, a, as deeply as needed to get the good evaluation timing. Maybe this is a simple pattern match, maybe it's counting the length of a list, maybe its seq every element in the list, maybe its a deepseq, etc.
The use of seq is tricky. Note, the below function does not perform as desired. Haskell is a mysterious thing.
badTimeItTPure a = timeItT . return $ seq (p a) a
https://github.com/chrissound/FuckItTimer
start' <- start
timerc start' "begin"
print "hello"
timerc start' "after printing hello"
benchmark
timerc start' "end"
end <- getVals start'
forM_ (timert end) putStrLn
Outputs:
"hello"
begin -> after printing hello: 0.000039555s
after printing hello -> end: 1.333936928s
This seems to work fine for my very simple usecase.
I have:
main :: IO ()
main = do
iniciofibonaccimap <- getCPUTime
let fibonaccimap = map fib listaVintesete
fimfibonaccimap <- getCPUTime
let difffibonaccimap = (fromIntegral (fimfibonaccimap - iniciofibonaccimap)) / (10^12)
printf "Computation time fibonaccimap: %0.3f sec\n" (difffibonaccimap :: Double)
listaVintesete :: [Integer]
listaVintesete = replicate 100 27
fib :: Integer -> Integer
fib 0 = 0
fib 1 = 1
fib n = fib (n-1) + fib (n-2)
But
*Main> main
Computation time fibonaccimap: 0.000 sec
I do not understand why this happens.
Help-me thanks.
As others have said, this is due to lazy evaluation. To force evaluation you should use the deepseq package and BangPatterns:
{-# LANGUAGE BangPatterns #-}
import Control.DeepSeq
import Text.Printf
import System.CPUTime
main :: IO ()
main = do
iniciofibonaccimap <- getCPUTime
let !fibonaccimap = rnf $ map fib listaVintesete
fimfibonaccimap <- getCPUTime
let difffibonaccimap = (fromIntegral (fimfibonaccimap - iniciofibonaccimap)) / (10^12)
printf "Computation time fibonaccimap: %0.3f sec\n" (difffibonaccimap :: Double)
...
In the above code you should notice three things:
It compiles (modulo the ... of functions you defined above). When you post code for questions please make sure it runs (iow, you should include imports)
The use of rnf from deepseq. This forces the evaluation of each element in the list.
The bang pattern on !fibonaccimap, meaning "do this now, don't wait". This forces the list to be evaluated to weak-head normal form (whnf, basically just the first constructor (:)). Without this the rnf function would itself remain unevaluated.
Resulting in:
$ ghc --make ds.hs
$ ./ds
Computation time fibonaccimap: 6.603 sec
If you're intending to do benchmarking you should also use optimization (-O2) and the Criterion package instead of getCPUTime.
Haskell is lazy. The computation you request in the line
let fibonaccimap = map fib listaVintesete
doesn't actually happen until you somehow use the value of fibonaccimap. Thus to measure the time used, you'll need to introduce something that will force the program to perform the actual computation.
ETA: I originally suggested printing the last element to force evaluation. As TomMD points out, this is nowhere near good enough -- I strongly recommend reading his response here for an actually working way to deal with this particular piece of code.
I suspect you are a "victim" of lazy evaluation. Nothing forces the evaluation of fibonaccimap between the timing calls, so it's not computed.
Edit
I suspect you're trying to benchmark your code, and in that case it should be pointed out that there are better ways to do this more reliably.
10^12 is an integer, which forces the value of fromIntegral to be an integer, which means difffibonaccimap is assigned a rounded value, so it's 0 if the time is less than half a second. (That's my guess, anyway. I don't have time to look into it.)
Lazy evaluation has in fact bitten you, as the other answers have said. Specifically, 'let' doesn't force the evaluation of an expression, it just scopes a variable. The computation won't actually happen until its value is demanded by something, which probably won't happen until an actual IO action needs its value. So you need to put your print statement between your getCPUTime evaluations. Of course, this will also get the CPU time used by print in there, but most of print's time is waiting on IO. (Terminals are slow.)