<div dir="ltr">I have a program which does backtracking search in a recursive function.  I followed the chapter in "Real World Haskell" to parallelize it.<br><div><br></div><div>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. </div><div><br></div><div>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! </div><div><br></div><div>There's no effect from the R.W.H. ideas. Can I get some suggestions as to why? </div><div><br></div><div>Here's the program:</div><div>--------------------------------------------</div><div><div>import qualified Data.List as L</div><div>import Text.Printf</div><div>import System.CPUTime</div><div>import Data.Function</div><div>import Control.Parallel</div></div><div><br></div><div><div>-- Run backtracking search for a list of doubles, optimizing a </div><div>-- fitness function on the list, called 'evalFunc'. At each step, use 'stepFunc' <br></div><div>-- to generate a list of possible next Doubles that can be added to the list. </div><div>-- We are done when the list has 'finalSize' elements.</div><div>search1_par :: Int -></div><div>  ([Double] -> Double) -> ([Double] -> [Double]) -> [Double] -> (Double,[Double])</div><div>search1_par finalSize evalFunc stepFunc listIn</div><div>  | length listIn == finalSize = (evalFunc listIn,listIn)</div><div>  | otherwise = </div><div>      let steps = stepFunc listIn</div><div>          (steps1,steps2) = divideListInTwo steps</div><div>          f s = search1_par finalSize evalFunc stepFunc $ s:listIn</div><div>          results1 = map f steps1</div><div>          results2 = map f steps2</div><div>          results = force results1 `par` (force results2 `pseq` (results1++results2))</div><div>      in L.maximumBy (compare `on` fst) results</div><div>  </div><div>force :: [a] -> ()</div><div>force xs = go xs `pseq` ()</div><div>  where go (_:xs) = go xs</div><div>        go [] = 1</div><div><br></div><div>divideListInTwo :: [a] -> ([a],[a])</div><div>divideListInTwo [] = ([],[])</div><div>divideListInTwo xs = (take l xs,drop l xs) where l = length xs `div` 2</div><div><br></div><div>---------------------------------------------</div><div>-- some sample evaluation (fitness) functions and step generation functions.</div><div><br></div><div>eval1 :: [Double] -> Double</div><div>eval1 xs = v1 - v2 + v3</div><div>  where</div><div>    v1 = sum $ zipWith (*) (cycle [1]) xs</div><div>    v2 = sum . map (*2) $ zipWith (*) (cycle [1,0]) xs</div><div>    v3 = sum . map (*3)  $ zipWith (*) (cycle [1,0,0]) xs</div><div><br></div><div><br></div><div>step1 :: [Double] -> [Double]</div><div>step1 xs | l == 0 = take 8 $ xs</div><div>         | l == 1 = take 8 $ map (/2) xs</div><div>         | l == 2 = take 8 $ map (*3) xs</div><div>  where</div><div>    l = length xs `mod` 3</div><div>--------------------------------------------------------------------------------</div><div>-- main</div><div><br></div><div>main = do</div><div>  t1 <- getCPUTime</div><div>  let f :: Double -> String</div><div>      f x = printf "%5.1f" x</div><div>      (_,result) = search1_par 13 eval1 step1 [1,2,3]</div><div>  putStrLn $ concatMap f result</div><div>  t2 <- getCPUTime</div><div>  putStrLn $ printf "CPU time: %.3f" ((fromIntegral $ t2-t1) / 1000000000000 :: Double)</div></div><div><br></div></div>