I was trying to find prime numbers from a given list of numbers.
So far I have piece of code that works, but if I uncomment some lines and comment some others, I don't see any difference in speed.
I am almost sure that I have to force evaluation in separate thread, as I think I start thread but code is not evaluated there due to laziness. But I couldn't find a way to force that evaluation. I was working based on examples here. So I made functions parMap and strMap which are parallel map and strict [parallel] map. In parMap there are 2 lines commented, so if you uncomment them, and comment out other 4 lines that are currently not commented, well, you cant notice any difference in speed, although it should be non-parallel and slower then. I also ignore program args for now in main function.
So basically my question is - is it possible to achieve, that for each number in list that is given to parMap, a new thread is spawned and so everything works faster?
here goes the code:
module W7T5
(
main
) where
import Control.Concurrent
import Control.Parallel (par, pseq)
import System.Environment
main = do
args' <- getArgs
let
-- args = map (\x -> read x :: Int) args'
args = [2000000..2000200]
tfPrime = parMap isPrime' args
-- tfPrime = strMap isPrime' args
argsNtf = zip args tfPrime
primes' = filter (\(num, tfPrime) -> tfPrime) argsNtf
primes = map fst primes'
putStrLn ("Init list: " ++ show args)
putStrLn ("Primes : " ++ show primes)
-- Map in parallel
parMap :: NFData a => (a -> b) -> [a] -> [b]
parMap _ [] =
[]
--parMap f (x:xs) = -- sadly without any parallelisation it's not slower
-- (f x) :parMap f xs
parMap f (x:xs) =
par r (r:parMap f xs)
where
r = f x
-- Map in parallel strictly
strMap :: (a -> b) -> [a] -> [b]
strMap f xs =
forceList xs `seq` map f xs
forceList :: [a] -> ()
forceList (x:xs) =
xs `pseq` forceList xs
forceList _ =
()
isPrime' :: Int -> Bool
isPrime' 0 = True
isPrime' 1 = True
isPrime' 2 = True
isPrime' num =
all (/=0) [mod num x | x <- [2..(num-1)]]
You can run the program with
runhaskell W7T5.hs 1 2 3 4
For speed (which is the point of parallelism), Haskell programs should be compiled (with ghc) rather than interpreted (with runghc). I don't know how to actually use runghc for multithreading, if that's possible at all.
ghc W7T5 -threaded -with-rts -N2
./W7T5
The parMap implementation isn't correct: the computation (r : parMap f xs) returns immediately and just thunks the tail, which will only be sparked when it will be demanded (but by then it will be too late). The one below sparks both the head and tail before consing them, so by the time the caller see the constructor, the rest of the list is being evaluated in the background.
parMap :: (a -> b) -> [a] -> [b]
parMap f [] = []
parMap f (x : xs) = rs `par` r `par` (r : rs)
where
r = f x
rs = parMap f xs
When you compile your program, you'll probably not see the same buffering behavior as with an interpreter, because executables use line buffering by default. Buffering can be turned off using System.IO.hSetBuffering
import System.IO
main = do
hSetBuffering stdout NoBuffering
...
Related
I'm working with this code I wrote, and for some reason threadscope keeps telling me that it's almost never using more than one core at a time. I think the problem is that in order to get the second line it needs to fully evaluate the first line, but I can't figure out an easy way to get it to read in 11 lines at a time.
module Main where
import Control.Parallel
import Control.Parallel.Strategies
import System.IO
import Data.List.Split
import Control.DeepSeq
process :: [String] -> [String]
process lines = do
let xs = map (\x -> read x :: Double) lines
ys = map (\x -> 1.0 / (1.0 + (exp (-x)))) xs
retlines = map (\x -> (show x ) ++ "\n") ys
retlines
main :: IO ()
main = do
c <- getContents
let xs = lines c
ys = (process xs) `using` parBuffer 11 rdeepseq
putStr (foldr (++) [] ys)
If I am reading this code right, parBuffer n only sparks the first n elements -- all the rest are evaluated in the usual Haskell way.
parBuffer :: Int -> Strategy a -> Strategy [a]
parBuffer n strat = parBufferWHNF n . map (withStrategy strat)
parBufferWHNF :: Int -> Strategy [a]
parBufferWHNF n0 xs0 = return (ret xs0 (start n0 xs0))
where -- ret :: [a] -> [a] -> [a]
ret (x:xs) (y:ys) = y `par` (x : ret xs ys)
ret xs _ = xs
-- start :: Int -> [a] -> [a]
start 0 ys = ys
start !_n [] = []
start !n (y:ys) = y `par` start (n-1) ys
Note in particular that start 0 ys = ys and not, say, start 0 ys = evaluateThePreviousChunk `pseq` start n0 ys or something that would start up more sparks. The documentation definitely doesn't make this clear -- I don't think "rolling buffer strategy" obviously implies this behavior, and I agree it's a bit surprising, to the point that I wonder whether this is just a bug in the parallel library that nobody caught yet.
You probably want parListChunk instead.
I need some kind of fold which can terminate if I already have the data I want.
For example I need to find first 3 numbers which are greater than 5. I decided to use Either for termination and my code looks like this:
terminatingFold :: ([b] -> a -> Either [b] [b]) -> [a] -> [b]
terminatingFold f l = reverse $ either id id $ fold [] l
where fold acc [] = Right acc
fold acc (x:xs) = f acc x >>= flip fold xs
first3NumsGreater5 acc x =
if length acc >= 3
then Left acc
else Right (if x > 5 then (x : acc) else acc)
Are there some more clever/generic approaches?
The result of your function is a list, and it would be desirable if it were produced lazily, that is, extracting one item from the result should only require evaluating the input list up until the item is found there.
Unfolds are under-appreciated for these kinds of tasks. Instead of focusing on "consuming" the input list, let's think of it as a seed from which (paired with some internal accumulator) we can produce the result, element by element.
Let's define a Seed type that contains a generic accumulator paired with the as-yet unconsumed parts of the input:
{-# LANGUAGE NamedFieldPuns #-}
import Data.List (unfoldr)
data Seed acc input = Seed {acc :: acc, pending :: [input]}
Now let's reformulate first3NumsGreater5 as a function that either produces the next output element from the Seed, of signals that there aren't any more elements:
type Counter = Int
first3NumsGreater5 :: Seed Counter Int -> Maybe (Int, Seed Counter Int)
first3NumsGreater5 (Seed {acc, pending})
| acc >= 3 =
Nothing
| otherwise =
case dropWhile (<= 5) pending of
[] -> Nothing
x : xs -> Just (x, Seed {acc = succ acc, pending = xs})
Now our main function can be written in terms of unfoldr:
unfoldFromList ::
(Seed acc input -> Maybe (output, Seed acc input)) ->
acc ->
[input] ->
[output]
unfoldFromList next acc pending = unfoldr next (Seed {acc, pending})
Putting it to work:
main :: IO ()
main = print $ unfoldFromList first3NumsGreater5 0 [0, 6, 2, 7, 9, 10, 11]
-- [6,7,9]
Normally an early termination-capable fold is foldr with the combining function which is non-strict in its second argument. But, its information flow is right-to-left (if any), while you want it left-to-right.
A possible solution is to make foldr function as a left fold, which can then be made to stop early:
foldlWhile :: Foldable t
=> (a -> Bool) -> (r -> a -> r) -> r
-> t a -> r
foldlWhile t f a xs = foldr cons (\acc -> acc) xs a
where
cons x r acc | t x = r (f acc x)
| otherwise = acc
You will need to tweak this for t to test the acc instead of x, to fit your purposes.
This function is foldlWhile from https://wiki.haskell.org/Foldl_as_foldr_alternative, re-written a little. foldl'Breaking from there might fit the bill a bit better.
foldr with the lazy reducer function can express corecursion perfectly fine just like unfoldr does.
And your code is already lazy: terminatingFold (\acc x -> Left acc) [1..] => []. That's why I'm not sure if this answer is "more clever", as you've requested.
edit: following a comment by #danidiaz, to make it properly lazy you'd have to code it as e.g.
first3above5 :: (Foldable t, Ord a, Num a)
=> t a -> [a]
first3above5 xs = foldr cons (const []) xs 0
where
cons x r i | x > 5 = if i==2 then [x]
else x : r (i+1)
| otherwise = r i
This can be generalized further by abstracting the test and the count.
Of course it's just reimplementing take 3 . filter (> 5), but shows how to do it in general with foldr.
The following problem is to sum consecutive integers in an array. Here is one solution:
import Data.List (group)
sumConsecutives :: [Int] -> [Int]
sumConsecutives = map sum . group
I was wondering whether this solution would cause an overflow, and my other question was whether the runtime of the algorithm would be O(n)? Since Haskell is lazy I assume the group function would not be called, and would be called lazily with the map, so that the list is gone over only once. The other solution to the problem was the following:
import Data.List
summer :: ([Int], Maybe Int) -> Int -> ([Int], Maybe Int)
summer ([], _) next = next `seq` ([next], Just next)
summer (xs, Nothing) next = next `seq` (xs, Just next)
summer ((x:xs), Just prev) next
| next == prev = next `seq` (((x + next):xs), Just prev)
| otherwise = next `seq` ((next:x:xs), Just next)
sumConsecutives :: [Int] -> [Int]
sumConsecutives s = reverse . fst $ foldl' summer ([], Nothing) s
This solution tries to solve the thunk problem in the previous solution.
I'm guessing you might be worried that the groups will actually be put together first, so they'll all be sitting in memory. This could happen. In particular, if whoever consumes the result of your function steps through the list, holding on to the beginning, without forcing its elements along the way, then you could potentially have a problem. This is fairly unlikely in practice, but if it's a concern in your application, you could replace map by the following:
smap :: (a -> b) -> [a] -> [b]
smap f = foldr go [] where
go x = (:) $! f x
This refuses to produce a "cons" before evaluating its "car". In your application, it ensures that each group is summed before the next is started, which will actually cause each group to be summed incrementally as long as strictness analysis and/or other optimizations work out properly.
To avoid relying on any such optimizations, you'll have to replace sum by
sum' :: Num a => [a] -> a
sum' = foldl' (+) 0
As for group itself, you have nothing to worry about—it's written lazily, so you can access (and discard) the elements of a group as that group is being formed.
The simplest example of an "evil consumer" I could think of:
forceSpine :: [a] -> ()
forceSpine [] = ()
forceSpine (_ : xs) = forceSpine xs
evil :: ([a] -> r) -> [a] -> r
evil f xs = forceSpine xs `seq` f xs
The following function is not in the standard Haskell libraries, so I wrote it:
paginate _ [] = []
paginate n xs = let (h, t) = splitAt n xs in h : paginate n t
Then I wanted to rewrite it without the explicit recursion yet still be easily understandable.
I've tried the fix version, which does not yield very satisfactory results:
paginate = fix go
where
go _ _ [] = []
go v n xs = let (h, t) = splitAt n xs in h : v n t
Are there simpler solutions which use the Prelude functions?
When I see this sort of problem, I like to think about the "shape" of the function you want. In this case, you're starting with a list and producing a list of lists. This is a special case of starting with a single value and producing a list, which corresponds to an unfold. So, if you don't mind importing Data.List, you can neatly write your function using unfoldr.
Lets take a look at how to derive this step by step. First, as above, you just have to know about unfoldr and see that it can apply. This is where a bit of experience (like reading answers like this one :)) comes in.
Next, we take a look at the type of unfoldr:
Prelude Data.List> :t unfoldr
unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
The idea is that we start with a single "kernel" value (b), and apply a step function (b -> Maybe (a, b)) repeatedly until we hit Nothing. Our starting value is the list we want to separate into chunks, so we don't need to do any more processing there. This means the last step we have is implementing the step function.
Since we're starting with a list of values, we can replace b with [n]; moreover, since we want to produce a list of lists at the very end, we can replace [a] with [[n]] and, therefore, a with [n]. This gives us the final type we have to implement for the step function:
[n] -> Maybe ([n], [n])
Hey, that looks very similar to the type of splitAt!
splitAt :: Int -> a -> ([a], [a])
In fact, we can just wrap the result of splitAt in Just and satify our types. But this leaves out a very important part: the final Nothing that tells unfoldr to stop! So our helper function needs an extra base case for [] to return the right result.
Putting it all together gives us the final function:
import Data.List (unfoldr)
paginate n = unfoldr go
where go [] = Nothing -- base case
go ls = Just (splitAt n ls)
I think the end result is pretty good, but I'm not sure it's any more readable than the recursive version.
If you don't mind enabling an extension (LambdaCase), you can rewrite this in a slightly neater way by avoiding naming go:
paginate n = unfoldr $ \case
[] -> Nothing
ls -> Just (splitAt n ls)
FYI, following from Tikhon Jelvis' answer, I eventually ended up with:
boolMaybe p f x = if p x then Just (f x) else Nothing
groupWith = unfoldr . boolMaybe null
paginate = groupWith . splitAt
which is a bit too obfuscated for me. Back to the recursive version.
Here is a slightly changed version of the Tikhon Jelvis' code:
import Data.Maybe
import Data.List
import Control.Applicative
paginate n = unfoldr $ \xs -> listToMaybe xs *> Just (splitAt n xs)
Or in pointfree:
paginate n = unfoldr $ (*>) <$> listToMaybe <*> Just . splitAt n
there's always been this:
import Data.List
chunks n = takeWhile (not . null) . unfoldr (Just . splitAt n)
but the new champion, for me, is
import Data.Maybe -- additional imports
import Control.Applicative
chunks n = unfoldr $ (<$) . splitAt n <*> listToMaybe
-- \xs -> splitAt n xs <$ listToMaybe xs
(tweaking just a little bit the code from this comment by #user3237465).
The bits used here are:
unfoldr :: (b -> Maybe (a, b)) -> b -> [a]
(f <*> g) x = f x (g x) -- S combinator
x <$ c = fmap (const x) c -- "mapped into"
listToMaybe xs = head (map Just xs ++ [Nothing])
Another, similar way to write it is
import Control.Monad -- an additional import
chunks n = unfoldr $ listToMaybe . join ((<$) . splitAt n)
-- \xs -> listToMaybe (splitAt n xs <$ xs)
using the monadic join for functions,
join f x = f x x -- W combinator
I would like to generate infinite stream of numbers with Rand monad from System.Random.MWC.Monad. If only there would be a MonadFix instance for this monad, or instance like this:
instance (PrimMonad m) => MonadFix m where
...
then one could write:
runWithSystemRandom (mfix (\ xs -> uniform >>= \x -> return (x:xs)))
There isn't one though.
I was going through MonadFix docs but I don't see an obvious way of implementing this instance.
You can write a MonadFix instance. However, the code will not generate an infinite stream of distinct random numbers. The argument to mfix is a function that calls uniform exactly once. When the code is run, it will call uniform exactly once, and create an infinite list containing the result.
You can try the equivalent IO code to see what happens:
import System.Random
import Control.Monad.Fix
main = print . take 10 =<< mfix (\xs -> randomIO >>= (\x -> return (x : xs :: [Int])))
It seems that you want to use a stateful random number generator, and you want to run the generator and collect its results lazily. That isn't possible without careful use of unsafePerformIO. Unless you need to produce many random numbers quickly, you can use a pure RNG function such as randomRs instead.
A question: how do you wish to generate your initial seed?
The problem is that MWS is built on the "primitive" package which abstracts only IO and strict (Control.Monad.ST.ST s). It does not also abstract lazy (Control.Monad.ST.Lazy.ST s).
Perhaps one could make instances for "primitive" to cover lazy ST and then MWS could be lazy.
UPDATE: I can make this work using Control.Monad.ST.Lazy by using strictToLazyST:
module Main where
import Control.Monad(replicateM)
import qualified Control.Monad.ST as S
import qualified Control.Monad.ST.Lazy as L
import qualified System.Random.MWC as A
foo :: Int -> L.ST s [Int]
foo i = do rest <- foo $! succ i
return (i:rest)
splam :: A.Gen s -> S.ST s Int
splam = A.uniformR (0,100)
getS :: Int -> S.ST s [Int]
getS n = do gen <- A.create
replicateM n (splam gen)
getL :: Int -> L.ST s [Int]
getL n = do gen <- createLazy
replicateM n (L.strictToLazyST (splam gen))
createLazy :: L.ST s (A.Gen s)
createLazy = L.strictToLazyST A.create
makeLots :: A.Gen s -> L.ST s [Int]
makeLots gen = do x <- L.strictToLazyST (A.uniformR (0,100) gen)
rest <- makeLots gen
return (x:rest)
main = do
print (S.runST (getS 8))
print (L.runST (getL 8))
let inf = L.runST (foo 0) :: [Int]
print (take 10 inf)
let inf3 = L.runST (createLazy >>= makeLots) :: [Int]
print (take 10 inf3)
(This would be better suited as a comment to Heatsink's answer, but it's a bit too long.)
MonadFix instances must adhere to several laws. One of them is left shrinking/thightening:
mfix (\x -> a >>= \y -> f x y) = a >>= \y -> mfix (\x -> f x y)
This law allows to rewrite your expression as
mfix (\xs -> uniform >>= \x -> return (x:xs))
= uniform >>= \x -> mfix (\xs -> return (x:xs))
= uniform >>= \x -> mfix (return . (x :))
Using another law, purity mfix (return . h) = return (fix h), we can further simplify to
= uniform >>= \x -> return (fix (x :))
and using the standard monad laws and rewriting fix (x :) as repeat x
= liftM (\x -> fix (x :)) uniform
= liftM repeat uniform
Therefore, the result is indeed one invocation of uniform and then just repeating the single value indefinitely.