import Numeric.LinearAlgebra
import Numeric.GSL.Special.Gamma
import Control.Parallel.Strategies
import Control.Monad
import Data.IORef
import Data.Random
import Data.Random.Source.PureMT
import Debug.Trace
--
subsets s n = (subsets_stream s) !! n
subsets_stream [] = [[]] : repeat []
subsets_stream (x:xs) =
let r = subsets_stream xs
s = map (map (x:)) r
in [[]] : zipWith (++) s (tail r)
testfun :: Matrix Double -> Int -> [Int] -> Double
testfun x k cs = lngamma (det (c+u))
where
(m,c) = meanCov xx
m' = fromRows [m]
u = (trans m') <> m'
xx = fromColumns ( [(toColumns x)!!i] ++ [(toColumns x)!!j] ++ [(toColumns x)!!k] )
i = cs !! 0
j = cs !! 1
test :: Matrix Double -> Int -> Double
test x i = sum p
where
p = parMap (rdeepseq) (testfun x (i+1)) (subsets [0..i] 2)
ranMatrix :: Int -> RVar (Matrix Double)
ranMatrix n = do
xs <- mapM (\_ -> mapM (\_ -> uniform 0 1.0) [1..n]) [1..n]
return (fromLists xs)
loop :: Int -> Double -> Int -> RVar Double
loop n s i = traceShow i $ do
x <- ranMatrix n
let r = sum $ parMap (rdeepseq) (test x) [2..(n-2)]
return (r+s)
main = do
let n = 100
let iter = 5
rng <- newPureMT
rngr <- newIORef rng
p <- runRVar (foldM (loop n) 0.0 [1..iter]) rngr
print p
I have also found that the segmentation faults in my code disappear if I switch from Control.Parallel to Control.Monad.Par, which is quite strange. I get slightly better performance with Control.Parallel when it completes without a seg. fault, and the frequency with which it does so seems to depend on the number of sparks that are being created.