diff --git a/Biobase/Vienna.hs b/Biobase/Vienna.hs --- a/Biobase/Vienna.hs +++ b/Biobase/Vienna.hs @@ -1,66 +1,37 @@ -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} -- | The Vienna 2004 model is a mirror of the Turner data structure. The -- difference is that The ViennaRNA package uses an explicit annotation for RNA --- basepairs. +-- basepairs (which this library does not anymore!) -- -- Furthermore, all energies are stored in parts of 1/100, using Ints instead -- of Doubles. module Biobase.Vienna where -import Data.Array.Repa.Index -import Data.Array.Repa.Shape -import Data.ByteString (ByteString) -import Data.Map (Map) +import qualified Data.Vector.Unboxed as VU +import qualified Data.Vector.Generic as VG +import qualified Data.Vector.Generic.Mutable as VGM +import Data.Primitive.Types -import Data.PrimitiveArray -import Data.PrimitiveArray.Unboxed.Zero -import Biobase.Primary -import Biobase.Secondary.Vienna +import Biobase.Turner -type P = Z:.ViennaPair -type PN = P:.Nuc -type PNN = PN:.Nuc -type PP = Z:.ViennaPair:.ViennaPair -type PPNN = PP:.Nuc:.Nuc -type PPNNN = PPNN:.Nuc -type PPNNNN = PPNNN:.Nuc -data Vienna2004 = Vienna2004 - { stack :: Arr0 PP Int - , dangle3 :: Arr0 PN Int - , dangle5 :: Arr0 PN Int - , hairpinL :: Arr0 DIM1 Int - , hairpinMM :: Arr0 PNN Int - , hairpinLookup :: Map Primary Int - , hairpinGGG :: Int - , hairpinCslope :: Int - , hairpinCintercept :: Int - , hairpinC3 :: Int - , bulgeL :: Arr0 DIM1 Int - , bulgeSingleC :: Int - , iloop1x1 :: Arr0 PPNN Int - , iloop2x1 :: Arr0 PPNNN Int - , iloop2x2 :: Arr0 PPNNNN Int - , iloopMM :: Arr0 PNN Int - , iloop2x3MM :: Arr0 PNN Int - , iloop1xnMM :: Arr0 PNN Int - , iloopL :: Arr0 DIM1 Int - , multiMM :: Arr0 PNN Int - , ninio :: Int - , maxNinio :: Int - , multiOffset :: Int - , multiNuc :: Int - , multiHelix :: Int - , multiAsym :: Int - , multiStrain :: Int - , extMM :: Arr0 PNN Int - , coaxial :: Arr0 PP Int -- no intervening unpaired nucleotides - , coaxStack :: Arr0 PNN Int - , tStackCoax :: Arr0 PNN Int - , largeLoop :: Int - , termAU :: Int - , intermolecularInit :: Int - } -- deriving (Read,Show) + +newtype Deka = Deka Int + deriving (Eq,Ord,Num,Read,Show) + +deriving instance Prim Deka +deriving instance VGM.MVector VU.MVector Deka +deriving instance VG.Vector VU.Vector Deka +deriving instance VU.Unbox Deka + + + +type Vienna2004 = Turner2004Model Deka + +turnerToVienna :: Turner2004 -> Vienna2004 +turnerToVienna = emap (\(Energy e) -> Deka $ round $ 100 * e) diff --git a/Biobase/Vienna/Default.hs b/Biobase/Vienna/Default.hs deleted file mode 100644 --- a/Biobase/Vienna/Default.hs +++ /dev/null @@ -1,22 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} - --- | A set of default Turner 2004 parameters in ViennaRNA format. - -module Biobase.Vienna.Default where - -import Data.FileEmbed -import qualified Data.ByteString.Char8 as B - -import Biobase.Vienna -import Biobase.Vienna.ImportPar - - - --- | - -turnerRNA2004 :: (Vienna2004,Vienna2004) -turnerRNA2004 = fromByteString rnaTurner2004par - --- | embedded parameter file for Turner2004 parameters - -rnaTurner2004par = $(embedFile "parfiles/rna_turner2004.par") diff --git a/Biobase/Vienna/Export.hs b/Biobase/Vienna/Export.hs deleted file mode 100644 --- a/Biobase/Vienna/Export.hs +++ /dev/null @@ -1,141 +0,0 @@ -{-# LANGUAGE NoMonomorphismRestriction #-} - -module Biobase.Vienna.Export where - -import Control.Arrow -import Data.Array.Repa.Index -import Data.Array.Repa.Shape -import Data.List (intersperse) -import Data.List.Split -import qualified Data.Map as M -import Text.Printf -import qualified Data.Vector.Unboxed as VU - -import Biobase.Primary -import Biobase.Secondary.Vienna -import Data.PrimitiveArray -import Data.PrimitiveArray.Unboxed.Zero - -import Biobase.Vienna - - - --- * Export as a ViennaRNA 2004 ".par" file - -asPar :: Vienna2004 -> Vienna2004 -> String -asPar trnr trnrH = hdr ++ blocks ++ mlps ++ ninios ++ misc ++ triloops ++ tetra ++ hexa ++ "\n#END" where - hdr = "## RNAfold parameter file v2.0\n\n" - mlps = printf "# ML_params\n%7d %7d %7d %7d %7d %7d\n\n" - (multiNuc trnr) (multiNuc trnrH) - (multiOffset trnr) (multiOffset trnrH) - (multiHelix trnr) (multiHelix trnrH) - ninios = printf "# NINIO\n%7d %7d %7d\n\n" - (ninio trnr) (ninio trnrH) (maxNinio trnr) - misc = printf "# Misc\n %7d %7d %7d %7d\n\n" - (intermolecularInit trnr) (intermolecularInit trnrH) (termAU trnr) (termAU trnrH) - triloops = "# Triloops\n" ++ printHairpinAssocs 5 trnr trnrH ++ "\n" - tetra = "# Tetraloops\n" ++ printHairpinAssocs 6 trnr trnrH ++ "\n" - hexa = "# Hexaloops\n" ++ printHairpinAssocs 8 trnr trnrH ++ "\n" - blocks = concat $ zipWith (++) - -- entropy terms - [ printBlock "stack" 7 pp2lkey $ stack trnr - , printBlock "mismatch_hairpin" 5 pbb2lkey $ hairpinMM trnr - , printBlock "mismatch_interior" 5 pbb2lkey $ iloopMM trnr - , printBlock "mismatch_interior_1n" 5 pbb2lkey $ iloop1xnMM trnr - , printBlock "mismatch_interior_23" 5 pbb2lkey $ iloop2x3MM trnr - , printBlock "mismatch_multi" 5 pbb2lkey $ multiMM trnr - , printBlock "mismatch_exterior" 5 pbb2lkey $ extMM trnr - , printBlock "dangle5" 5 pb2lkey $ dangle5 trnr - , printBlock "dangle3" 5 pb2lkey $ dangle3 trnr - , printBlock "int11" 5 ppbb2lkey $ iloop1x1 trnr - , printBlock "int21" 5 ppbbb2lkey $ iloop2x1 trnr - , printBlock22 "int22" 4 ppbbbb2lkey $ iloop2x2 trnr - , printLinear "hairpin" 10 $ hairpinL trnr - , printLinear "bulge" 10 $ bulgeL trnr - , printLinear "interior" 10 $ iloopL trnr - ] - -- enthalpy terms - [ printBlockH "stack" 7 pp2lkey $ stack trnrH - , printBlockH "mismatch_hairpin" 5 pbb2lkey $ hairpinMM trnrH - , printBlockH "mismatch_interior" 5 pbb2lkey $ iloopMM trnrH - , printBlockH "mismatch_interior_1n" 5 pbb2lkey $ iloop1xnMM trnrH - , printBlockH "mismatch_interior_23" 5 pbb2lkey $ iloop2x3MM trnrH - , printBlockH "mismatch_multi" 5 pbb2lkey $ multiMM trnrH - , printBlockH "mismatch_exterior" 5 pbb2lkey $ extMM trnrH - , printBlockH "dangle5" 5 pb2lkey $ dangle5 trnrH - , printBlockH "dangle3" 5 pb2lkey $ dangle3 trnrH - , printBlockH "int11" 5 ppbb2lkey $ iloop1x1 trnrH - , printBlockH "int21" 5 ppbbb2lkey $ iloop2x1 trnrH - , printBlock22H "int22" 4 ppbbbb2lkey $ iloop2x2 trnrH - , printLinearH "hairpin" 10 $ hairpinL trnrH - , printLinearH "bulge" 10 $ bulgeL trnrH - , printLinearH "interior" 10 $ iloopL trnrH - ] - - - --- * Helper functions - --- | Show the key of the line, minus the changing last key - -showKey :: [(LKey,Int)] -> String -showKey xs = - " /* " ++ - (concat $ intersperse "," $ init $ (map show ps) ++ (map show ns)) ++ - " */" - where - (ps,ns) = fst $ head xs - --- | Transform from tuple-based keys to a pair of list-based keys. - -type LKey = ([ViennaPair],[Nuc]) - -pb2lkey (Z:.p1:.b1) = ([p1],[b1]) -pbb2lkey (Z:.p1:.b1:.b2) = ([p1],[b1,b2]) -pp2lkey (Z:.k1:.k2) = ([k1,k2],[]) -ppbb2lkey (Z:.p1:.p2:.b1:.b2) = ([p1,p2],[b1,b2]) -ppbbb2lkey (Z:.p1:.p2:.b1:.b2:.b3) = ([p1,p2],[b1,b2,b3]) -ppbbbb2lkey (Z:.p1:.p2:.b1:.b2:.b3:.b4) = ([p1,p2],[b1,b2,b3,b4]) - --- | Print a block. - -printBlock = printBlockG noNP where - noNP ((ps,ns),v) = not $ any (==vpNP) ps || any (==nIMI) ns - -printBlockH s = printBlock (s ++ "_enthalpies") - -printBlock22 = printBlockG noNSNPE where - noNSNPE ((ps,ns),v) = not $ any (==vpNP) ps || any (==vpNS) ps || any (==nN) ns || any (==nIMI) ns - -printBlock22H s = printBlock22 (s ++ "_enthalpies") - -printBlockG fltr s k tolkey xs' = - let - xs = filter fltr $ map (first tolkey) $ assocs xs' - in - printf "# %s\n" s ++ - (concatMap printLine $ splitEvery k xs) ++ - "\n" - -printLine xs = - concatMap printVal xs ++ " " ++ showKey xs ++ - printf "\n" - -printVal (k,v) - | v > 10000 = printf " INF" - | otherwise = printf "%6d" v - --- | A linear block is more boring - -printLinear s k xs' = let xs = assocs xs' in - printf "# %s\n" s ++ - (concatMap (\ys -> concatMap printVal ys ++ "\n") $ splitEvery k xs) ++ - "\n" - -printHairpinAssocs l trnr trnrH = res where - res = concat $ zipWith (\(k,v) vH -> printf "%s %7d %7d\n" (concatMap show k) v vH) xs ys - xs = filter ((==l).length.fst) $ map (\(k,v) -> (mkString k,v)) $ M.assocs $ hairpinLookup trnr - ys = map snd $ filter ((==l).length.fst) $ map (\(k,v) -> (mkString k,v)) $ M.assocs $ hairpinLookup trnrH - mkString = let convT x = if x =='T' then 'U' else x in map (convT . fromNuc) . toList - -printLinearH s = printLinear (s ++ "_enthalpies") diff --git a/Biobase/Vienna/Import.hs b/Biobase/Vienna/Import.hs deleted file mode 100644 --- a/Biobase/Vienna/Import.hs +++ /dev/null @@ -1,121 +0,0 @@ -{-# LANGUAGE TypeSynonymInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE FlexibleInstances #-} - --- | There are two import scenarios: (i) importing from a ViennaRNA parameter --- file (version 2004 only) and (ii) importing from a Turner2004 data --- structure. --- --- TODO (i) is missing right now - -module Biobase.Vienna.Import where - -import Control.Arrow -import Data.Array.Repa.Index -import Data.Array.Repa.Shape -import qualified Data.ByteString.Char8 as BS -import qualified Data.Map as M - -import Biobase.Primary -import Biobase.Secondary -import Biobase.Secondary.Vienna -import Data.PrimitiveArray -import qualified Biobase.Turner as T - -import Biobase.Vienna - - - --- * Transforming a Turner2004 data structure into a Vienna2004 data structure. - --- | From a 'Turner2004' data structure via lists of key/value pairs. - -fromTurner2004 :: T.Turner2004 -> Vienna2004 -fromTurner2004 turner = Vienna2004 - { stack = convert minPP maxPP $ T.stack turner - , dangle3 = convert minPB maxPB $ T.dangle3 turner - , dangle5 = convert minPB maxPB $ T.dangle5 turner - , hairpinL = convert (Z:.0) (Z:.30) $ T.hairpinL turner - , hairpinMM = convert minPBB maxPBB $ T.hairpinMM turner - , hairpinLookup = M.mapKeys (mkPrimary . BS.unpack) . M.map deka $ T.hairpinLookup turner - , hairpinGGG = deka $ T.hairpinGGG turner - , hairpinCslope = deka $ T.hairpinCslope turner - , hairpinCintercept = deka $ T.hairpinCintercept turner - , hairpinC3 = deka $ T.hairpinC3 turner - , bulgeL = convert (Z:.0) (Z:.30) $ T.bulgeL turner - , bulgeSingleC = deka $ T.bulgeSingleC turner - , iloop1x1 = convert minPPBB maxPPBB $ T.iloop1x1 turner - , iloop2x1 = convert minPPBBB maxPPBBB $ T.iloop2x1 turner - , iloop2x2 = convert minPPBBBB maxPPBBBB $ T.iloop2x2 turner - , iloopMM = convert minPBB maxPBB $ T.iloopMM turner - , iloop2x3MM = convert minPBB maxPBB $ T.iloop2x3MM turner - , iloop1xnMM = convert minPBB maxPBB $ T.iloop1xnMM turner - , iloopL = convert (Z:.0) (Z:.30) $ T.iloopL turner - , multiMM = convert minPBB maxPBB $ T.multiMM turner - , ninio = deka $ T.ninio turner - , maxNinio = deka $ T.maxNinio turner - , multiOffset = deka $ T.multiOffset turner - , multiNuc = deka $ T.multiNuc turner - , multiHelix = deka $ T.multiHelix turner - , multiAsym = deka $ T.multiAsym turner - , multiStrain = deka $ T.multiStrain turner - , extMM = convert minPBB maxPBB $ T.extMM turner - , coaxial = convert minPP maxPP $ T.coaxial turner - , coaxStack = convert minPBB maxPBB $ T.coaxStack turner - , tStackCoax = convert minPBB maxPBB $ T.tStackCoax turner - , largeLoop = deka $ T.largeLoop turner - , termAU = deka $ T.termAU turner - , intermolecularInit = deka $ T.intermolecularInit turner - } where convert mn mx = fromAssocs mn mx 999999 . map (idxConvert *** deka) . assocs - --- conversion of indices --- --- (roll your eyes) - -class IdxConvert a b where - idxConvert :: a -> b - -instance IdxConvert DIM1 DIM1 where - idxConvert = id - -instance IdxConvert T.PNN PNN where - idxConvert (Z:.p1:.p2:.n1:.n2) = Z:. mkViennaPair (p1,p2) :.n1:.n2 - -instance IdxConvert T.PN PN where - idxConvert (Z:.p1:.p2:.n1) = Z:. mkViennaPair (p1,p2) :.n1 - -instance IdxConvert T.PPNNNN PPNNNN where - idxConvert (Z:.p11:.p12:.p21:.p22:.n1:.n2:.n3:.n4) = Z:. mkViennaPair (p11,p12) :. mkViennaPair (p21,p22) :.n1:.n2:.n3:.n4 - -instance IdxConvert T.PPNNN PPNNN where - idxConvert (Z:.p11:.p12:.p21:.p22:.n1:.n2:.n3) = Z:. mkViennaPair (p11,p12) :. mkViennaPair (p21,p22) :.n1:.n2:.n3 - -instance IdxConvert T.PPNN PPNN where - idxConvert (Z:.p11:.p12:.p21:.p22:.n1:.n2) = Z:. mkViennaPair (p11,p12) :. mkViennaPair (p21,p22) :.n1:.n2 - -instance IdxConvert T.PP PP where - idxConvert (Z:.p11:.p12:.p21:.p22) = Z:. mkViennaPair (p11,p12) :. mkViennaPair (p21,p22) - - - --- | Transform energies to the vienna Int-based variant --- --- (which is round (e*100)). - -deka = round . (*100) - -minP = Z:.vpNP -- minBound -maxP = Z:.vpNS -- maxBound -minPB = minP:.nN -- (minP,nN) -maxPB = maxP:.nU -- (maxP,nU) -minPP = minP:.vpNP -- (minP,minP) -maxPP = maxP:.vpNS -- (maxP,maxP) -minPBB = minP:.nN:.nN -- (minP,nN,nN) -maxPBB = maxP:.nU:.nU -- (maxP,nU,nU) -minPPBB = minPP:.nN:.nN -- (minP,minP,(nN,nN)) -maxPPBB = maxPP:.nU:.nU -- (maxP,maxP,(nU,nU)) -minPPBBB = minPPBB:.nN -- (minP,minP,(nN,nN,nN)) -maxPPBBB = maxPPBB:.nU -- (maxP,maxP,(nU,nU,nU)) -minPPBBBB = minPPBBB:.nN -- (minP,minP,(nN,nN,nN,nN)) -maxPPBBBB = maxPPBBB:.nU -- (maxP,maxP,(nU,nU,nU,nU)) - diff --git a/Biobase/Vienna/ImportPar.hs b/Biobase/Vienna/ImportPar.hs deleted file mode 100644 --- a/Biobase/Vienna/ImportPar.hs +++ /dev/null @@ -1,164 +0,0 @@ -{-# LANGUAGE DoAndIfThenElse #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE NoMonomorphismRestriction #-} - --- | Import ViennaRNA parameter files (*par files). Imports Turner2004 files. - -module Biobase.Vienna.ImportPar where - -import Data.Iteratee as I -import Data.Iteratee.Char as I -import Data.Iteratee.IO as I -import Data.ByteString.Char8 as BS -import Prelude as P -import Data.Array.Repa.Index -import Data.Array.Repa.Shape -import qualified Data.Map as M -import Control.Monad.Identity -import Data.Maybe (fromJust) - -import Data.PrimitiveArray -import Data.PrimitiveArray.Unboxed.Zero -import Biobase.Secondary.Vienna -import Biobase.Primary - -import Biobase.Vienna -import Biobase.Vienna.Import - -import Debug.Trace - - - --- | split the input into different blocks. Each block has a name (prefixed # --- in the file) and some data. - - -data BL - = Block {fromBlock :: [Int]} - | Lookup {fromLookup :: [(ByteString,Int,Int)]} - deriving (Show) - -lookupStructure = - [ "# Triloops" - , "# Tetraloops" - , "# Hexaloops" - ] - -iterBlocks = enumLinesBS ><> I.filter (not . BS.null) ><> convStream f where - f = do - h <- I.head -- the # prefix - if h `P.elem` lookupStructure - then do - xs' <- I.takeWhile ((/='#') . BS.head) - let xs = P.map (\[w,x,y] -> (w,getInt x, getInt y)) . P.map BS.words $ xs' - return [(h, Lookup xs)] - else do - xs' <- I.takeWhile ((/='#') . BS.head) - let xs = P.map getInt . P.concat . P.map BS.words . P.map (BS.takeWhile (/='/')) $ xs' - return [(h, Block xs)] - -getInt :: ByteString -> Int -getInt s - | s == "INF" = 999999 - | otherwise = read . BS.unpack $ s - -fromFile :: FilePath -> IO (Vienna2004,Vienna2004) -fromFile fp = do - i <- enumFile 8192 fp (joinI $ iterBlocks stream2list) - bs <- run i - return $ makeStructures bs - -fromByteString :: ByteString -> (Vienna2004,Vienna2004) -fromByteString s = runIdentity $ do - i <- enumPure1Chunk s (joinI $ iterBlocks stream2list) - bs <- run i - return $ makeStructures bs - -makeStructures bs = - let vEner = Vienna2004 - { stack = blockAssocs minPP maxPP ppKeys $ lookup "# stack" bs - , dangle3 = blockAssocs minPB maxPB pbKeys $ lookup "# dangle3" bs - , dangle5 = blockAssocs minPB maxPB pbKeys $ lookup "# dangle5" bs - , hairpinL = blockAssocs (Z:.0) (Z:.30) thirty $ lookup "# hairpin" bs - , hairpinMM = blockAssocs minPBB maxPBB pbbKeys $ lookup "# mismatch_hairpin" bs - , hairpinLookup = fst $ allLookups bs - , hairpinGGG = 999999 - , hairpinCslope = 999999 - , hairpinCintercept = 999999 - , hairpinC3 = 999999 - , bulgeL = blockAssocs (Z:.0) (Z:.30) thirty $ lookup "# bulge" bs - , bulgeSingleC = 999999 - , iloop1x1 = blockAssocs minPPBB maxPPBB ppbbKeys $ lookup "# int11" bs - , iloop2x1 = blockAssocs minPPBBB maxPPBBB ppbbbKeys $ lookup "# int21" bs - , iloop2x2 = blockAssocs minPPBBBB maxPPBBBB ppbbbbKeys $ lookup "# int22" bs - , iloopMM = blockAssocs minPBB maxPBB pbbKeys $ lookup "# mismatch_interior" bs - , iloop2x3MM = blockAssocs minPBB maxPBB pbbKeys $ lookup "# mismatch_interior_23" bs - , iloop1xnMM = blockAssocs minPBB maxPBB pbbKeys $ lookup "# mismatch_interior_1n" bs - , iloopL = blockAssocs (Z:.0) (Z:.30) thirty $ lookup "# interior" bs - , multiMM = blockAssocs minPBB maxPBB pbbKeys $ lookup "# mismatch_multi" bs - , ninio = single 0 $ lookup "# NINIO" bs - , maxNinio = single 2 $ lookup "# NINIO" bs - , multiOffset = single 2 $ lookup "# ML_params" bs - , multiNuc = single 0 $ lookup "# ML_params" bs - , multiHelix = single 4 $ lookup "# ML_params" bs - , multiAsym = 999999 - , multiStrain = 999999 - , extMM = blockAssocs minPBB maxPBB pbbKeys $ lookup "# mismatch_exterior" bs - , coaxial = fromAssocs minPP maxPP 999999 [] - , coaxStack = fromAssocs minPBB maxPBB 999999 [] - , tStackCoax = fromAssocs minPBB maxPBB 999999 [] - , largeLoop = 999999 - , termAU = single 2 $ lookup "# Misc" bs - , intermolecularInit = 999999 - } - vEnth = Vienna2004 - { stack = blockAssocs minPP maxPP ppKeys $ lookup "# stack_enthalpies" bs - , dangle3 = blockAssocs minPB maxPB pbKeys $ lookup "# dangle3_enthalpies" bs - , dangle5 = blockAssocs minPB maxPB pbKeys $ lookup "# dangle5_enthalpies" bs - , hairpinL = blockAssocs (Z:.0) (Z:.30) thirty $ lookup "# hairpin_enthalpies" bs - , hairpinMM = blockAssocs minPBB maxPBB pbbKeys $ lookup "# mismatch_hairpin_enthalpies" bs - , hairpinLookup = snd $ allLookups bs - , hairpinGGG = 999999 - , hairpinCslope = 999999 - , hairpinCintercept = 999999 - , hairpinC3 = 999999 - , bulgeL = blockAssocs (Z:.0) (Z:.30) thirty $ lookup "# bulge_enthalpies" bs - , bulgeSingleC = 999999 - , iloop1x1 = blockAssocs minPPBB maxPPBB ppbbKeys $ lookup "# int11_enthalpies" bs - , iloop2x1 = blockAssocs minPPBBB maxPPBBB ppbbbKeys $ lookup "# int21_enthalpies" bs - , iloop2x2 = blockAssocs minPPBBBB maxPPBBBB ppbbbbKeys $ lookup "# int22_enthalpies" bs - , iloopMM = blockAssocs minPBB maxPBB pbbKeys $ lookup "# mismatch_interior_enthalpies" bs - , iloop2x3MM = blockAssocs minPBB maxPBB pbbKeys $ lookup "# mismatch_interior_23_enthalpies" bs - , iloop1xnMM = blockAssocs minPBB maxPBB pbbKeys $ lookup "# mismatch_interior_1n_enthalpies" bs - , iloopL = blockAssocs (Z:.0) (Z:.30) thirty $ lookup "# interior_enthalpies" bs - , multiMM = blockAssocs minPBB maxPBB pbbKeys $ lookup "# mismatch_multi_enthalpies" bs - , ninio = 999999 - , maxNinio = 999999 - , multiOffset = 999999 - , multiNuc = 999999 - , multiHelix = 999999 - , multiAsym = 999999 - , multiStrain = 999999 - , extMM = blockAssocs minPBB maxPBB pbbKeys $ lookup "# mismatch_exterior_enthalpies" bs - , coaxial = fromAssocs minPP maxPP 999999 [] - , coaxStack = fromAssocs minPBB maxPBB 999999 [] - , tStackCoax = fromAssocs minPBB maxPBB 999999 [] - , largeLoop = 999999 - , termAU = 999999 - , intermolecularInit = 999999 - } - in (vEner,vEnth) - -single k (Just (Block xs)) = xs !! k -thirty = P.map (Z:.) [0..30] -pbKeys = [ (Z:.x:.y) | x<-cgnsP, y<-nacgu ] -ppKeys = [ (Z:.x:.y) | x<-cgnsP, y<-cgnsP ] -pbbKeys = [ (Z:.a:.b:.c) | a<-cgnsP, b<-nacgu, c<-nacgu ] -ppbbKeys = [ pp:.a:.b | pp<-ppKeys, a<-nacgu, b<-nacgu ] -ppbbbKeys = [ ppbb:.a | ppbb<-ppbbKeys, a<-nacgu ] -ppbbbbKeys = [ Z:.a:.b:.c:.d:.e:.f | a<-cguaP, b<-cguaP, c<-acgu, d<-acgu, e<-acgu, f<-acgu ] -blockAssocs minKey maxKey keys (Just (Block xs)) = fromAssocs minKey maxKey 999999 $ P.zip keys xs -allLookups bs = (M.fromList $ P.map (\(a,b,c) -> (a,b)) ls, M.fromList $ P.map (\(a,b,c) -> (a,c)) ls) where - ls = P.map (\(a,b,c) -> (mkPrimary a,b,c)) $ P.concatMap (fromLookup . snd) $ P.filter (isL . snd) bs - isL (Lookup _) = True - isL _ = False diff --git a/BiobaseVienna.cabal b/BiobaseVienna.cabal --- a/BiobaseVienna.cabal +++ b/BiobaseVienna.cabal @@ -1,9 +1,9 @@ name: BiobaseVienna -version: 0.2.2.5 +version: 0.3.0.0 author: Christian Hoener zu Siederdissen maintainer: choener@tbi.univie.ac.at homepage: http://www.tbi.univie.ac.at/~choener/ -copyright: Christian Hoener zu Siederdissen, 2010-2012 +copyright: Christian Hoener zu Siederdissen, 2010-2013 category: Bioinformatics synopsis: Import Vienna energy parameters license: GPL-3 @@ -14,12 +14,7 @@ description: Importer and Exporter for Vienna energy files. Allows converting Turner parameter files to Vienna parameter files. - . - This is the 2011 post-library split version, hence not - deprecated anymore. - - extra-source-files: parfiles/rna_turner2004.par @@ -28,41 +23,17 @@ library build-depends: base >3 && <5, - bytestring >= 0.9, - bytestring-lexing >= 0.4, - containers >= 0.4, - file-embed >= 0.0.4.1, - filepath >= 1, - iteratee >= 0.8.8, - mtl >= 2, - split >= 0.1.4, - vector == 0.9.* , - BiobaseTurner == 0.2.2.4 , - BiobaseXNA == 0.6.2.5 , - PrimitiveArray == 0.2.2.0 + primitive >= 0.5 , + vector >= 0.10 , + BiobaseTurner >= 0.3.0.0 , + BiobaseXNA >= 0.7 , + PrimitiveArray >= 0.5 exposed-modules: Biobase.Vienna - Biobase.Vienna.Default - Biobase.Vienna.Export - Biobase.Vienna.Import - Biobase.Vienna.ImportPar ghc-options: -O2 -funbox-strict-fields - - -executable ViennaConverter - build-depends: - cmdargs == 0.9.* - main-is: - ViennaConverter.hs - ghc-options: - -O2 -funbox-strict-fields - - - source-repository head type: git location: git://github.com/choener/BiobaseVienna - diff --git a/ViennaConverter.hs b/ViennaConverter.hs deleted file mode 100644 --- a/ViennaConverter.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DeriveDataTypeable #-} - --- | Convert Turner parameter files into Vienna energy files. Either into a --- ".par" file (which is used by the Haskell RNAFold as well) or multiple ".C" --- and ".H" files for inclusion into the ViennaRNA package. - -module Main where - -import System.Console.CmdArgs - -import Biobase.Turner.Import -import Biobase.Vienna.Export -import Biobase.Vienna.Import - - - -data Options = Options - { dir :: FilePath - , dna :: Bool - } deriving (Show,Data,Typeable) - -options = Options - { dir = def &= args - , dna = False &= help "apply dna prefix (default: false)" - } - -main :: IO () -main = do - Options{..} <- cmdArgs options - let prefix = if dna then "dna" else "" - trnr <- fmap fromTurner2004 $ fromDir dir prefix "dat" - trnrH <- fmap fromTurner2004 $ fromDir dir prefix "dh" - putStrLn $ asPar trnr trnrH - --mapM_ print $ int22symmetry $ iloop2x2 trnr - return () - -{- symmetry checking -int22symmetry :: PrimArray I22K Int -> [( (I22K,Int) , (I22K,Int) )] -int22symmetry arr = filter (\(a,b) -> snd a /= snd b) - . map (\k -> ((k,arr!k),(swp k, arr! swp k))) - $ keys - where - keys = [ (p1,p2,(b1,b2,b3,b4)) - | p1 <- cguaP, p2 <- cguaP - , b1 <- acgu, b2 <- acgu, b3 <- acgu, b4 <- acgu - ] - swp (p1,p2,(b1,b2,b3,b4)) = ( p2 - , p1 - , ( b3 - , b4 - , b1 - , b2 - ) - ) - -type I22K = (ViennaPair,ViennaPair,(Nuc,Nuc,Nuc,Nuc)) - --}