diff --git a/Biobase/Primary.hs b/Biobase/Primary.hs --- a/Biobase/Primary.hs +++ b/Biobase/Primary.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE FlexibleInstances #-} @@ -18,10 +19,13 @@ module Biobase.Primary where +import Data.Array.Repa.Index +import Data.Array.Repa.Shape import Data.Char (toUpper) import Data.Ix (Ix(..)) import Data.Primitive.Types import Data.Tuple (swap) +import GHC.Base (remInt,quotInt) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Data.Text as T @@ -55,7 +59,7 @@ newtype Nuc = Nuc {unNuc :: Int} deriving (Eq,Ord,Ix) -(nN : nA : nC : nG : nT : nIMI : _) = map Nuc [0 .. ] +(nN : nA : nC : nG : nT : nIMI : nUndefined : _) = map Nuc [0 .. ] nU = nT acgt = [nA..nT] @@ -114,6 +118,44 @@ deriving instance VGM.MVector VU.MVector Nuc deriving instance VG.Vector VU.Vector Nuc deriving instance VU.Unbox Nuc + +-- Shape-based indexing. Nucleotide representations go from nN (0) to nU (4), +-- with additional symbols being available for specialized problems. This is a +-- bit of a problem for shape-based indexing. In particular, we need to be +-- careful with size operations. To include, say, all of nN to nU one needs a +-- size of (z:.nIMI), as nIMI is the first element not in the size anymore. + +instance (Shape sh,Show sh) => Shape (sh :. Nuc) where + rank (sh:._) = rank sh + 1 + zeroDim = zeroDim:.Nuc 0 + unitDim = unitDim:.Nuc 1 -- TODO does this one make sense? + intersectDim (sh1:.n1) (sh2:.n2) = intersectDim sh1 sh2 :. min n1 n2 + addDim (sh1:.Nuc n1) (sh2:.Nuc n2) = addDim sh1 sh2 :. Nuc (n1+n2) -- TODO will not necessarily yield a valid Nuc + size (sh1:.Nuc n) = size sh1 * n + sizeIsValid (sh1:.Nuc n) = sizeIsValid (sh1:.n) + toIndex (sh1:.Nuc sh2) (sh1':.Nuc sh2') = toIndex (sh1:.sh2) (sh1':.sh2') + fromIndex (ds:.Nuc d) n = fromIndex ds (n `quotInt` d) :. Nuc r where + r | rank ds == 0 = n + | otherwise = n `remInt` d + inShapeRange (sh1:.n1) (sh2:.n2) (idx:.i) = i>=n1 && i error "empty list in shapeOfList/Primary" + x:xs -> shapeOfList xs :. Nuc x + deepSeq (sh:.n) x = deepSeq sh (n `seq` x) + {-# INLINE rank #-} + {-# INLINE zeroDim #-} + {-# INLINE unitDim #-} + {-# INLINE intersectDim #-} + {-# INLINE addDim #-} + {-# INLINE size #-} + {-# INLINE sizeIsValid #-} + {-# INLINE toIndex #-} + {-# INLINE fromIndex #-} + {-# INLINE inShapeRange #-} + {-# INLINE listOfShape #-} + {-# INLINE shapeOfList #-} + {-# INLINE deepSeq #-} -- | The bounded instance from GHC proper. Captures all defined symbols. diff --git a/Biobase/Secondary.hs b/Biobase/Secondary.hs --- a/Biobase/Secondary.hs +++ b/Biobase/Secondary.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE FlexibleInstances #-} @@ -15,14 +16,17 @@ module Biobase.Secondary where +import Data.Array.Repa.Index +import Data.Array.Repa.Shape +import Data.Char (toLower, toUpper) +import Data.Ix (Ix(..)) +import Data.List as L import Data.Primitive.Types +import Data.Tuple (swap) +import GHC.Base (remInt,quotInt) import qualified Data.Vector.Generic as VG import qualified Data.Vector.Generic.Mutable as VGM import qualified Data.Vector.Unboxed as VU -import Data.Ix (Ix(..)) -import Data.Tuple (swap) -import Data.List as L -import Data.Char (toLower, toUpper) import Biobase.Primary import Biobase.Primary.Bounds @@ -46,8 +50,40 @@ newtype Edge = Edge {unEdge :: Int} deriving (Eq,Ord,Ix) -(wc : sugar : hoogsteen : unknownEdge : _) = map Edge [0..] +instance (Shape sh,Show sh) => Shape (sh :. Edge) where + rank (sh:._) = rank sh + 1 + zeroDim = zeroDim:.Edge 0 + unitDim = unitDim:.Edge 1 -- TODO does this one make sense? + intersectDim (sh1:.n1) (sh2:.n2) = intersectDim sh1 sh2 :. min n1 n2 + addDim (sh1:.Edge n1) (sh2:.Edge n2) = addDim sh1 sh2 :. Edge (n1+n2) -- TODO will not necessarily yield a valid Edge + size (sh1:.Edge n) = size sh1 * n + sizeIsValid (sh1:.Edge n) = sizeIsValid (sh1:.n) + toIndex (sh1:.Edge sh2) (sh1':.Edge sh2') = toIndex (sh1:.sh2) (sh1':.sh2') + fromIndex (ds:.Edge d) n = fromIndex ds (n `quotInt` d) :. Edge r where + r | rank ds == 0 = n + | otherwise = n `remInt` d + inShapeRange (sh1:.n1) (sh2:.n2) (idx:.i) = i>=n1 && i error "empty list in shapeOfList/Primary" + x:xs -> shapeOfList xs :. Edge x + deepSeq (sh:.n) x = deepSeq sh (n `seq` x) + {-# INLINE rank #-} + {-# INLINE zeroDim #-} + {-# INLINE unitDim #-} + {-# INLINE intersectDim #-} + {-# INLINE addDim #-} + {-# INLINE size #-} + {-# INLINE sizeIsValid #-} + {-# INLINE toIndex #-} + {-# INLINE fromIndex #-} + {-# INLINE inShapeRange #-} + {-# INLINE listOfShape #-} + {-# INLINE shapeOfList #-} + {-# INLINE deepSeq #-} +(wc : sugar : hoogsteen : unknownEdge : edgeUndefined : _) = map Edge [0..] + charEdgeList = [ ('W',wc) , ('S',sugar) @@ -78,7 +114,39 @@ newtype CTisomerism = CT {unCT :: Int} deriving (Eq,Ord,Ix) -(cis : trans : unknownCT : _) = map CT [0..] +instance (Shape sh,Show sh) => Shape (sh :. CTisomerism) where + rank (sh:._) = rank sh + 1 + zeroDim = zeroDim:.CT 0 + unitDim = unitDim:.CT 1 -- TODO does this one make sense? + intersectDim (sh1:.n1) (sh2:.n2) = intersectDim sh1 sh2 :. min n1 n2 + addDim (sh1:.CT n1) (sh2:.CT n2) = addDim sh1 sh2 :. CT (n1+n2) -- TODO will not necessarily yield a valid CT + size (sh1:.CT n) = size sh1 * n + sizeIsValid (sh1:.CT n) = sizeIsValid (sh1:.n) + toIndex (sh1:.CT sh2) (sh1':.CT sh2') = toIndex (sh1:.sh2) (sh1':.sh2') + fromIndex (ds:.CT d) n = fromIndex ds (n `quotInt` d) :. CT r where + r | rank ds == 0 = n + | otherwise = n `remInt` d + inShapeRange (sh1:.n1) (sh2:.n2) (idx:.i) = i>=n1 && i error "empty list in shapeOfList/Primary" + x:xs -> shapeOfList xs :. CT x + deepSeq (sh:.n) x = deepSeq sh (n `seq` x) + {-# INLINE rank #-} + {-# INLINE zeroDim #-} + {-# INLINE unitDim #-} + {-# INLINE intersectDim #-} + {-# INLINE addDim #-} + {-# INLINE size #-} + {-# INLINE sizeIsValid #-} + {-# INLINE toIndex #-} + {-# INLINE fromIndex #-} + {-# INLINE inShapeRange #-} + {-# INLINE listOfShape #-} + {-# INLINE shapeOfList #-} + {-# INLINE deepSeq #-} + +(cis : trans : unknownCT : undefinedCT : _) = map CT [0..] antiCT = undefined paraCT = undefined diff --git a/Biobase/Secondary/Constraint.hs b/Biobase/Secondary/Constraint.hs --- a/Biobase/Secondary/Constraint.hs +++ b/Biobase/Secondary/Constraint.hs @@ -6,6 +6,8 @@ module Biobase.Secondary.Constraint where +import Data.Array.Repa.Index +import Data.Array.Repa.Shape import Data.Char (toLower) import Data.Primitive.Types import qualified Data.Vector.Generic as VG @@ -13,7 +15,7 @@ import qualified Data.Vector.Unboxed as VU import Data.PrimitiveArray -import Data.PrimitiveArray.Ix +import Data.PrimitiveArray.Unboxed import Biobase.Secondary.Diagrams @@ -48,49 +50,49 @@ -- TODO and again, we should parametrize over "Energy", "Score", etc (that is, -- Prim a) -bonusTable :: Double -> Double -> Constraint -> PrimArray (Int,Int) Double +bonusTable :: Double -> Double -> Constraint -> PrimArray DIM2 Double bonusTable bonus malus (Constraint constraint) = arr where - arr = fromAssocs (0,0) (n,n) 0 $ bonusBr ++ bonusAn ++ bonusBa ++ malusBr ++ malusAn ++ malusX + arr = fromAssocs zeroDim (Z:.n:.n) 0 $ bonusBr ++ bonusAn ++ bonusBa ++ malusBr ++ malusAn ++ malusX n = VU.length constraint -1 infixl 1 `xor` xor a b = a && not b || not a && b -- "()" bonus energies - bonusBr = [ ((i,j),bonus) + bonusBr = [ (Z:.i:.j,bonus) | (i,('(',j)) <- zip [0..] $ VU.toList constraint ] - malusBr = [ ((i,j),malus) + malusBr = [ (Z:.i:.j,malus) | i <- [0..n] , j <- [i..n] , let bi = constraint VU.! i , let bj = constraint VU.! j , fst bi == '(' && snd bi /= j || fst bj == ')' && snd bj /= i ] - bonusAn = [ ((i,j),bonus) + bonusAn = [ (Z:.i:.j,bonus) | i<-[0..n] , fst (constraint VU.! i) == '<' , j<-[i+1..n] ] ++ - [ ((i,j),bonus) + [ (Z:.i:.j,bonus) | j<-[0..n] , fst (constraint VU.! j) == '>' , i<-[0..j-1] ] - malusAn = [ ((i,j),malus) + malusAn = [ (Z:.i:.j,malus) | i<-[0..n] , j<-[i+1..n] , fst (constraint VU.! j) == '<' ] ++ - [ ((i,j),malus) + [ (Z:.i:.j,malus) | i<-[0..n] , j<-[i+1..n] , fst (constraint VU.! i) == '>' ] - bonusBa = [ ((i,j),bonus) + bonusBa = [ (Z:.i:.j,bonus) | i<-[0..n] , j<-[i+1..n] , fst (constraint VU.! i) == '|' || fst (constraint VU.! j) == '|' ] - malusX = [ ((i,j),malus) + malusX = [ (Z:.i:.j,malus) | i<-[0..n] , j<-[i+1..n] , fst (constraint VU.! i) == 'x' || fst (constraint VU.! j) == 'x' diff --git a/Biobase/Secondary/Vienna.hs b/Biobase/Secondary/Vienna.hs --- a/Biobase/Secondary/Vienna.hs +++ b/Biobase/Secondary/Vienna.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -8,12 +9,15 @@ module Biobase.Secondary.Vienna where +import Data.Array.Repa.Index +import Data.Array.Repa.Shape import Data.Ix import Data.Primitive.Types +import Data.Tuple (swap) +import GHC.Base (remInt,quotInt) import qualified Data.Vector.Generic as VG import qualified Data.Vector.Generic.Mutable as VGM import qualified Data.Vector.Unboxed as VU -import Data.Tuple (swap) import Biobase.Primary import Biobase.Primary.Bounds @@ -25,7 +29,39 @@ newtype ViennaPair = ViennaPair Int deriving (Eq,Ord,Ix) -(vpNP:vpCG:vpGC:vpGU:vpUG:vpAU:vpUA:vpNS:_) = map ViennaPair [0..] +instance (Shape sh,Show sh) => Shape (sh :. ViennaPair) where + rank (sh:._) = rank sh + 1 + zeroDim = zeroDim:.ViennaPair 0 + unitDim = unitDim:.ViennaPair 1 -- TODO does this one make sense? + intersectDim (sh1:.n1) (sh2:.n2) = intersectDim sh1 sh2 :. min n1 n2 + addDim (sh1:.ViennaPair n1) (sh2:.ViennaPair n2) = addDim sh1 sh2 :. ViennaPair (n1+n2) -- TODO will not necessarily yield a valid ViennaPair + size (sh1:.ViennaPair n) = size sh1 * n + sizeIsValid (sh1:.ViennaPair n) = sizeIsValid (sh1:.n) + toIndex (sh1:.ViennaPair sh2) (sh1':.ViennaPair sh2') = toIndex (sh1:.sh2) (sh1':.sh2') + fromIndex (ds:.ViennaPair d) n = fromIndex ds (n `quotInt` d) :. ViennaPair r where + r | rank ds == 0 = n + | otherwise = n `remInt` d + inShapeRange (sh1:.n1) (sh2:.n2) (idx:.i) = i>=n1 && i error "empty list in shapeOfList/Primary" + x:xs -> shapeOfList xs :. ViennaPair x + deepSeq (sh:.n) x = deepSeq sh (n `seq` x) + {-# INLINE rank #-} + {-# INLINE zeroDim #-} + {-# INLINE unitDim #-} + {-# INLINE intersectDim #-} + {-# INLINE addDim #-} + {-# INLINE size #-} + {-# INLINE sizeIsValid #-} + {-# INLINE toIndex #-} + {-# INLINE fromIndex #-} + {-# INLINE inShapeRange #-} + {-# INLINE listOfShape #-} + {-# INLINE shapeOfList #-} + {-# INLINE deepSeq #-} + +(vpNP:vpCG:vpGC:vpGU:vpUG:vpAU:vpUA:vpNS:vpUndefined:_) = map ViennaPair [0..] class MkViennaPair a where mkViennaPair :: a -> ViennaPair diff --git a/BiobaseXNA.cabal b/BiobaseXNA.cabal --- a/BiobaseXNA.cabal +++ b/BiobaseXNA.cabal @@ -1,16 +1,16 @@ name: BiobaseXNA -version: 0.5.6.0 +version: 0.6.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, 2011 +copyright: Christian Hoener zu Siederdissen, 2011-2012 category: Bioinformatics synopsis: Efficient RNA/DNA representations license: GPL-3 license-file: LICENSE build-type: Simple stability: experimental -cabal-version: >= 1.4.0 +cabal-version: >= 1.6.0 description: This is a base library for bioinformatics with emphasis on RNA and DNA primary structure and related tools. Provided are @@ -30,25 +30,9 @@ . . . - Changes since 0.5.5.0 - . - * isostericity for the 6 "missing" classes - . - Changes since 0.5.4.0 - . - * tuple-like updating (updL, updR, updP, updT) - . - * baseP pair selection - . - * isostericity data, loaded from csv files - . - Changes since 0.5.3.0 - . - * tuple-like (selN) selection of basepairing elements (baseL,baseR,baseT) - . - Changes since 0.5.1.0 + New in 0.6.0.0 . - * bonusTable for constrained folding + * Updated to PrimitiveArrays >= 0.1 extra-source-files: sources/isostericity-matrices.csv @@ -65,7 +49,8 @@ text, tuple, vector >=0.9 && <0.10, - PrimitiveArray + repa >= 2, + PrimitiveArray >= 0.1.1.2 exposed-modules: Biobase.Primary @@ -79,5 +64,9 @@ Biobase.Secondary.Vienna ghc-options: - -O2 + -Odph -funbox-strict-fields + +source-repository head + type: git + location: git://github.com/choener/BiobaseXNA