module BioInf.RNAdesign.CandidateChain where
import Control.Arrow (first)
import Control.Monad (foldM)
import Control.Monad.Primitive
import Control.Monad.Primitive.Class
import Data.Function (on)
import qualified Data.Vector as V
import qualified Data.Vector.Fusion.Stream.Monadic as SM
import qualified Data.Vector.Unboxed as VU
import System.Random.MWC.Monad
import Biobase.Primary
import Biobase.Secondary.Diagrams
import Biobase.Vienna
import BioInf.RNAdesign.Assignment (Assignment(..))
data Candidate = Candidate
{ candidate :: Primary
, score :: Score
} deriving (Eq,Show)
instance Ord Candidate where
(<=) = (<=) `on` score
newtype Score = Score { unScore :: Double }
deriving (Eq,Ord,Show,Read)
data DesignProblem = DesignProblem
{ structures :: [D1Secondary]
, assignments :: [Assignment]
} deriving (Eq,Read,Show)
mkInitial :: (MonadPrim m, PrimMonad m) => (Primary -> Score) -> Int -> DesignProblem -> Rand m Candidate
mkInitial scoring l dp = do
let z = VU.replicate l nA
foldM (mutateOneAssignmentWith scoring (\_ _ -> return True)) (Candidate z (scoring z)) $ assignments dp
unfoldStream
:: forall m . (MonadPrim m, PrimMonad m)
=> Int -> Int -> Int -> (Primary -> Score) -> (Candidate -> Candidate -> Rand m Bool) -> DesignProblem -> Candidate
-> SM.Stream (Rand m) Candidate
unfoldStream burnin number thin score f dp = go where
go s = SM.map snd
. SM.take number
. SM.filter ((==0) . flip mod thin . fst)
. SM.indexed
. SM.drop burnin
. SM.drop 1
. SM.scanlM' (mutateOneAssignmentWith score f) s
$ SM.unfoldr (Just . first head . splitAt 1)
(cycle $ assignments dp)
mutateOneAssignmentWith
:: (MonadPrim m, PrimMonad m)
=> (Primary -> Score)
-> (Candidate -> Candidate -> Rand m Bool)
-> Candidate
-> Assignment
-> Rand m Candidate
mutateOneAssignmentWith score f old Assignment{..} = do
i <- uniformR (0,V.length assignment 1)
let cs = VU.zip columns (assignment V.! i)
let nw = VU.update (candidate old) cs
let new = Candidate nw (score nw)
b <- f old new
return $ if b then new else old