I have a program which does backtracking search in a recursive function. I
followed the chapter in "Real World Haskell" to parallelize it.
Without Control.Parallel, it uses about 25% of the CPU, namely one core out
of four. With the suggestions in RWH it runs faster but still uses only 35%
of the CPU max.
So I set about creating a MWE in order to experiment and reach out for
help. For some reason, my stripped down program isn't working with
parallelism at all!
There's no effect from the R.W.H. ideas. Can I get some suggestions as to
why?
Here's the program:
--------------------------------------------
import qualified Data.List as L
import Text.Printf
import System.CPUTime
import Data.Function
import Control.Parallel
-- Run backtracking search for a list of doubles, optimizing a
-- fitness function on the list, called 'evalFunc'. At each step, use
'stepFunc'
-- to generate a list of possible next Doubles that can be added to the
list.
-- We are done when the list has 'finalSize' elements.
search1_par :: Int ->
([Double] -> Double) -> ([Double] -> [Double]) -> [Double] ->
(Double,[Double])
search1_par finalSize evalFunc stepFunc listIn
| length listIn == finalSize = (evalFunc listIn,listIn)
| otherwise =
let steps = stepFunc listIn
(steps1,steps2) = divideListInTwo steps
f s = search1_par finalSize evalFunc stepFunc $ s:listIn
results1 = map f steps1
results2 = map f steps2
results = force results1 `par` (force results2 `pseq`
(results1++results2))
in L.maximumBy (compare `on` fst) results
force :: [a] -> ()
force xs = go xs `pseq` ()
where go (_:xs) = go xs
go [] = 1
divideListInTwo :: [a] -> ([a],[a])
divideListInTwo [] = ([],[])
divideListInTwo xs = (take l xs,drop l xs) where l = length xs `div` 2
---------------------------------------------
-- some sample evaluation (fitness) functions and step generation functions.
eval1 :: [Double] -> Double
eval1 xs = v1 - v2 + v3
where
v1 = sum $ zipWith (*) (cycle [1]) xs
v2 = sum . map (*2) $ zipWith (*) (cycle [1,0]) xs
v3 = sum . map (*3) $ zipWith (*) (cycle [1,0,0]) xs
step1 :: [Double] -> [Double]
step1 xs | l == 0 = take 8 $ xs
| l == 1 = take 8 $ map (/2) xs
| l == 2 = take 8 $ map (*3) xs
where
l = length xs `mod` 3
--------------------------------------------------------------------------------
-- main
main = do
t1 <- getCPUTime
let f :: Double -> String
f x = printf "%5.1f" x
(_,result) = search1_par 13 eval1 step1 [1,2,3]
putStrLn $ concatMap f result
t2 <- getCPUTime
putStrLn $ printf "CPU time: %.3f" ((fromIntegral $ t2-t1) /
1000000000000 :: Double)
