{-# LANGUAGE BangPatterns #-}
module MEP.Run where
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import System.IO.Unsafe ( unsafePerformIO )
import MEP.Types
evaluate :: Num a
=> Chromosome a
-> V.Vector a
-> V.Vector a
evaluate chr vmap = unsafePerformIO $ do
v <- VM.new chrLen
let
_f (C c) _ = return c
_f (Var n) _ = return $ vmap V.! n
_f (Op (_, f) i1 i2) v' = do
!r1 <- v' `VM.read` i1
!r2 <- v' `VM.read` i2
let !r = f r1 r2
return r
go !v' !j =
if j == chrLen
then return ()
else do
val <- _f (chr V.! j) v'
VM.write v' j val
go v' (j + 1)
go v 0
V.unsafeFreeze v
where chrLen = V.length chr
{-# SPECIALIZE
evaluate :: Chromosome Double
-> V.Vector Double
-> V.Vector Double #-}