module Biobase.Vienna.Import where
import Control.Arrow
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as BS
import Biobase.Primary
import Biobase.Secondary
import Biobase.Secondary.Vienna
import Data.PrimitiveArray
import qualified Biobase.Turner as T
import Biobase.Vienna
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 0 30 $ T.hairpinL turner
, hairpinMM = convert minPBB maxPBB $ T.hairpinMM turner
, hairpinLookup = M.mapKeys (read . 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 0 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 0 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
class IdxConvert a b where
idxConvert :: a -> b
instance IdxConvert Pair ViennaPair where
idxConvert = mkViennaPair
instance IdxConvert Nuc Nuc where
idxConvert = id
instance IdxConvert Int Int where
idxConvert = id
instance (IdxConvert a c, IdxConvert b d) => IdxConvert (a,b) (c,d) where
idxConvert = idxConvert *** idxConvert
instance (IdxConvert a d, IdxConvert b e, IdxConvert c f) => IdxConvert (a,b,c) (d,e,f) where
idxConvert (a,b,c) = (idxConvert a, idxConvert b, idxConvert c)
instance (IdxConvert al ar, IdxConvert bl br, IdxConvert cl cr, IdxConvert dl dr) => IdxConvert (al,bl,cl,dl) (ar,br,cr,dr) where
idxConvert (a,b,c,d) = (idxConvert a, idxConvert b, idxConvert c, idxConvert d)
deka = round . (*100)
minP = minBound
maxP = maxBound
minPB = (minP,nN)
maxPB = (maxP,nU)
minPP = (minP,minP)
maxPP = (maxP,maxP)
minPBB = (minP,nN,nN)
maxPBB = (maxP,nU,nU)
minPPBB = (minP,minP,(nN,nN))
maxPPBB = (maxP,maxP,(nU,nU))
minPPBBB = (minP,minP,(nN,nN,nN))
maxPPBBB = (maxP,maxP,(nU,nU,nU))
minPPBBBB = (minP,minP,(nN,nN,nN,nN))
maxPPBBBB = (maxP,maxP,(nU,nU,nU,nU))