packages feed

RNAwolf 0.3.2.0 → 0.4.0.0

raw patch · 5 files changed

+74/−32 lines, 5 filesdep ~BiobaseTrainingDatadep ~cmdargsPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: BiobaseTrainingData, cmdargs

API changes (from Hackage documentation)

+ BioInf.RNAwolf.Constraint: applyConstraint :: PairIdx -> PrimArray (Int, Int) Double -> Double -> Double
- BioInf.RNAwolf: rnaWolf :: Params -> Primary -> Tables
+ BioInf.RNAwolf: rnaWolf :: Params -> Constraint -> Primary -> Tables
- BioInf.RNAwolf: rnaWolfBacktrack :: Params -> Primary -> Double -> Tables -> [([ExtPairIdx], Double)]
+ BioInf.RNAwolf: rnaWolfBacktrack :: Params -> Constraint -> Primary -> Double -> Tables -> [([ExtPairIdx], Double)]

Files

BioInf/RNAwolf.hs view
@@ -33,15 +33,18 @@ import Control.Monad.ST import qualified Data.Vector.Unboxed as VU import Control.Arrow+import Data.Fixed (mod')  import Data.PrimitiveArray import Data.PrimitiveArray.Ix import Biobase.Primary import Biobase.Secondary+import Biobase.Secondary.Constraint (Constraint, bonusTable)  import BioInf.Params import BioInf.RNAwolf.Types import qualified BioInf.RNAwolf.Bulge as Bul+import qualified BioInf.RNAwolf.Constraint as Constraint import qualified BioInf.RNAwolf.Extern as Ext import qualified BioInf.RNAwolf.Hairpin as Hp import qualified BioInf.RNAwolf.Interior as Int@@ -58,16 +61,17 @@  -- | Wrapper around the state monad. -rnaWolf :: Params -> Primary -> Tables-rnaWolf ps inp = {-# SCC "rnaWolf" #-} runST $ foldST ps inp+rnaWolf :: Params -> Constraint -> Primary -> Tables+rnaWolf ps cst inp = {-# SCC "rnaWolf" #-} runST $ foldST ps cst inp  -- | Folding magic. In principle, this is not more complicated than -- Nussinov-style folding. -foldST :: Params -> Primary -> ST s Tables-foldST ps inp = do+foldST :: Params -> Constraint -> Primary -> ST s Tables+foldST ps cst inp = do   let n = VU.length inp -1   let imi = map fst . filter ((==nIMI).snd) $ zip [0..] (VU.toList inp)+  let constraintTable = bonusTable (-10000) 1000000 cst   (eStemM,eStem) <- second EStem `fmap` mkExtTable n   (nStemM,nStem) <- second NStem `fmap` mkTable n   (nInteM,nInte) <- second NInte `fmap` mkTable n -- interior loop helper table@@ -99,7 +103,7 @@       let vInterior = minimumVU $ Int.fInteriorOuter ps inp nInteLoop i j ct eI eJ       let vMlClose  = minimumVU $ Mul.fMlClose       ps inp nMultLoop i j ct eI eJ       let vBulge    = minimumVU $ Bul.fBulgeOuter    ps inp nBulgLoop i j ct eI eJ-      writeM eStemM ((i,j),(ct,eI,eJ)) $ minimum [vHairpin,vStem,vInterior,vMlClose,vBulge] -- FIXME vTStem+      writeM eStemM ((i,j),(ct,eI,eJ)) . Constraint.applyConstraint (i,j) constraintTable $ minimum [vHairpin,vStem,vInterior,vMlClose,vBulge] -- FIXME vTStem     -- fill stem table that ignores extended annotations     writeM nStemM (i,j) . minimumVU $ Stem.fNstem ps inp eStem i j     -- fill the inner interior table@@ -153,22 +157,22 @@ -- -- TODO all the crap in comments are bug-fix backtracking options. -rnaWolfBacktrack :: Params -> Primary -> Double -> Tables -> [([ExtPairIdx],Double)]-rnaWolfBacktrack ps inp delta ( estem@(EStem eStem)-                              , nstem@(NStem nStem)-                              , ninte@(NInte nInte)-                              , ninteloop@(NInteLoop nInteLoop)-                              , nbulg@(NBulg nBulg)-                              , nbulgloop@(NBulgLoop nBulgLoop)-                              , nmult@(NMult nMult)-                              , nmbr@(NMbr nMbr)-                              , nmbr1@(NMbr1 nMbr1)-                              , nmultloop@(NMultLoop nMultLoop)-                              , nextn@(NExtn nExtn)-                              )+rnaWolfBacktrack :: Params -> Constraint -> Primary -> Double -> Tables -> [([ExtPairIdx],Double)]+rnaWolfBacktrack ps cst inp delta ( estem@(EStem eStem)+                                  , nstem@(NStem nStem)+                                  , ninte@(NInte nInte)+                                  , ninteloop@(NInteLoop nInteLoop)+                                  , nbulg@(NBulg nBulg)+                                  , nbulgloop@(NBulgLoop nBulgLoop)+                                  , nmult@(NMult nMult)+                                  , nmbr@(NMbr nMbr)+                                  , nmbr1@(NMbr1 nMbr1)+                                  , nmultloop@(NMultLoop nMultLoop)+                                  , nextn@(NExtn nExtn)+                                  )   | null res = [([],0)]   | otherwise = let finalScore = nExtn ! (0,n)-                in filter ((<=0).snd) . map (second (\z -> finalScore + delta -z)) $ res+                in filter ((<=0).snd) . map (second (\z -> constraintMangling $ finalScore + delta -z)) $ res   where     res = btE 0 n delta     btE i j d = -- trace (show ("btE",i,j,d)) $@@ -179,7 +183,7 @@     btNS i j d = -- trace (show ("btNS",i,j,d)) $       Stem.btNstem ps inp nstem estem btES i j d     btES :: Int -> Int -> CTisomerism -> Edge -> Edge -> Double -> [([ExtPairIdx],Double)]-    btES i j ct eI eJ d = -- trace (show ("btES",i,j,ct,eI,eJ,d)) $+    btES i j ct eI eJ d' = let d = d' - constraintTable!(i,j) in -- trace (show ("btES",i,j,ct,eI,eJ,d)) $       Hp.btHairpin ps inp estem i j ct eI eJ d ++       Int.btInteriorOuter ps inp estem ninteloop btILoop i j ct eI eJ d ++       Bul.btBulgeOuter ps inp estem nbulgloop btBULoop i j ct eI eJ d ++@@ -210,6 +214,9 @@     n = VU.length inp -1     epsilon = 0.001     imi = map fst . filter ((==nIMI).snd) $ zip [0..] (VU.toList inp)+    constraintTable = bonusTable (-10000) 1000000 cst+    constraintMangling s = s - 10000 * c where+      c = fromIntegral $ round $ s / 10000  -- | Return the optimal energy. 
+ BioInf/RNAwolf/Constraint.hs view
@@ -0,0 +1,19 @@++-- | Applies folding constraints to extended stem calculations.++module BioInf.RNAwolf.Constraint where++import Data.PrimitiveArray++import Biobase.Secondary+import Biobase.Secondary.Constraint++++-- | Applies a constraint bonus/malus in the backtracking phase++applyConstraint :: PairIdx -> PrimArray (Int,Int) Double -> Double -> Double+applyConstraint (i,j) cst score = score + cst!(i,j)+++
RNAwolf.cabal view
@@ -1,5 +1,5 @@ name:           RNAwolf-version:        0.3.2.0+version:        0.4.0.0 author:         Christian Hoener zu Siederdissen, Stephan H Bernhart, Peter F Stadler, Ivo L Hofacker copyright:      Christian Hoener zu Siederdissen, 2010-2011 homepage:       http://www.tbi.univie.ac.at/software/rnawolf/@@ -48,6 +48,10 @@                 changes. Please send a mail, if you encounter strange behaviour                 or bugs.                 .+                Changes in 0.4.0.0+                .+                * secondary structure constraints (untested and undocumented)+                .                 Changes in 0.3.2.0                 .                 * simpler training wrapper@@ -76,7 +80,7 @@     vector,     PrimitiveArray,     BiobaseXNA,-    BiobaseTrainingData >= 0.1.2.2,+    BiobaseTrainingData >= 0.1.2.3,     StatisticalMethods   exposed-modules:     BioInf.Keys@@ -86,6 +90,7 @@     BioInf.PassiveAggressive     BioInf.RNAwolf     BioInf.RNAwolf.Bulge+    BioInf.RNAwolf.Constraint     BioInf.RNAwolf.Extern     BioInf.RNAwolf.Hairpin     BioInf.RNAwolf.Interior@@ -104,7 +109,7 @@ executable RNAwolfTrain   build-depends:     split,-    cmdargs == 0.7.*+    cmdargs == 0.8.*   main-is:     RNAwolfTrain.hs   ghc-options:@@ -115,7 +120,7 @@  executable RNAwolf   build-depends:-    cmdargs == 0.7.*+    cmdargs == 0.8.*   main-is:     RNAwolf.hs   ghc-options:
RNAwolf.hs view
@@ -16,8 +16,10 @@ import System.Console.CmdArgs import Control.Monad import Text.Printf+import Data.List.Split (splitEvery)  import Biobase.Primary+import Biobase.Secondary.Constraint  import BioInf.RNAwolf import BioInf.RNAwolf.Types@@ -32,16 +34,17 @@   o@Options{..} <- cmdArgs options   when (null inDB) $ error "you need to give a database"   db <- fmap read $ readFile inDB-  xs <- fmap lines $ getContents+  xs <- fmap (splitEvery (if constraint then 2 else 1) . lines) $ getContents   mapM_ (foldLine o db) xs   return () -foldLine :: Options -> Params -> String -> IO ()-foldLine Options{..} p inp = do+foldLine :: Options -> Params -> [String] -> IO ()+foldLine Options{..} p (inp:rest) = do   let pri = mkPrimary inp-  let ts = rnaWolf p pri-  let bt = take coopt $ rnaWolfBacktrack p pri subopt ts-  printX inp ts+  let cst = if null rest then (mkConstraint $ replicate (length inp) '.') else (mkConstraint $ head rest)+  let ts = rnaWolf p cst pri+  let bt = take coopt $ rnaWolfBacktrack p cst pri subopt ts+--  printX inp ts   putStrLn inp   forM_ bt $ \(pairs,score) -> do     printf "%s %7.4f\n" (simpleViewer inp pairs) score@@ -59,12 +62,14 @@   { inDB :: FilePath   , subopt :: Double   , coopt :: Int+  , constraint :: Bool   } deriving (Show,Data,Typeable)  options = Options   { inDB = "" &= help "specify parameter database"   , subopt = 0.00001 &= help "calculate suboptimal in this range (returns all suboptimal results)"   , coopt = 1 &= help "how many co-optimal structures to return"+  , constraint = False &= help "2-line input: sequence, then constraint (default: no)"   }  -- | simple viewer...
RNAwolfTrain.hs view
@@ -40,8 +40,10 @@ import System.Console.CmdArgs import System.Random import Text.Printf+import System.IO (hFlush,stdout)  import Biobase.Primary+import Biobase.Secondary.Constraint import Biobase.Secondary.Diagrams import Biobase.TrainingData import Biobase.TrainingData.Import@@ -102,6 +104,7 @@             (length xs')             (maximum $ map (length . primary) xs')     putStrLn "======================================\n"+    hFlush stdout   let indices = mapAccumL (\acc x -> (acc+x,(acc+1,acc+x))) 0 $ map length xs   (newp,rs) <- foldM (foldTD o $ length xs) (p,[]) . zip xs . snd $ indices   let drctch = sum $ zipWith (\x y -> abs $ x-y) (P.toList p) (P.toList newp)@@ -119,6 +122,7 @@     zipWithM_ (printf " %4d %4.2f") [1::Int ..] $ rhos++[rho]     putStrLn ""     putStrLn "======================================\n"+    hFlush stdout   writeFile (printf "%04d.db" k) . show $ newp   return (newp,rhos++[rho]) @@ -131,9 +135,10 @@   | otherwise = (fst worst, ret)   where     pri = mkPrimary $ primary td-    tables = rnaWolf p pri+    cst = mkConstraint $ replicate (length $ primary td) '.'+    tables = rnaWolf p cst pri     bs = let f x = td{predicted = x} in-         map (first f) . take (maybe 1 id maxLoss) $ rnaWolfBacktrack p pri 0.001 tables+         map (first f) . take (maybe 1 id maxLoss) $ rnaWolfBacktrack p cst pri 0.001 tables     worst = minimumBy (comparing (fmeasure . mkConfusionMatrix . fst)) bs     runPA (x,score) = defaultPA aggressiveness p             $ x { comments =@@ -166,6 +171,7 @@             rhoR   -- detailed information on each folded structure   mapM_ (printDetailed o . fst) parfolds+  hFlush stdout   return $ pseq (rdeepseq results)          ( new          , oldresults ++ results