module Biobase.Primary where
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
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Unboxed as VU
import Data.Array.Repa.ExtShape
import Data.Array.Repa.Index
import Data.Array.Repa.Shape
import Biobase.Primary.Bounds
class MkPrimary a where
mkPrimary :: a -> Primary
type Primary = VU.Vector Nuc
newtype Nuc = Nuc {unNuc :: Int}
deriving (Eq,Ord,Ix)
(nN : nA : nC : nG : nT : nU : nIMI : nUndefined : _) = map Nuc [0 .. ]
acgt = [nA,nC,nG,nT]
acgu = [nA,nC,nG,nU]
cgau = [nC,nG,nA,nU]
nacgt = nN:acgt
nacgu = nN:acgu
mkNuc :: Char -> Nuc
mkNuc = f . toUpper where
f k
| Just v <- k `lookup` charNucList = v
| otherwise = nN
fromNuc :: Nuc -> Char
fromNuc = f where
f k
| Just v <- k `lookup` nucCharList = v
| otherwise = 'N'
charNucList =
[ ('N',nN)
, ('A',nA)
, ('C',nC)
, ('G',nG)
, ('T',nT)
, ('U',nU)
]
nucCharList = map swap charNucList
instance Show Nuc where
show n = [fromNuc n]
instance Read Nuc where
readsPrec p [] = []
readsPrec p (x:xs)
| x ==' ' = readsPrec p xs
| Just n <- x `lookup` charNucList = [(n,xs)]
| otherwise = []
deriving instance Prim Nuc
deriving instance VGM.MVector VU.MVector Nuc
deriving instance VG.Vector VU.Vector Nuc
deriving instance VU.Unbox Nuc
instance (Shape sh,Show sh) => Shape (sh :. Nuc) where
rank (sh:._) = rank sh + 1
zeroDim = zeroDim:.Nuc 0
unitDim = unitDim:.Nuc 1
intersectDim (sh1:.n1) (sh2:.n2) = intersectDim sh1 sh2 :. min n1 n2
addDim (sh1:.Nuc n1) (sh2:.Nuc n2) = addDim sh1 sh2 :. Nuc (n1+n2)
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<n2 && inShapeRange sh1 sh2 idx
listOfShape (sh:.Nuc n) = n : listOfShape sh
shapeOfList xx = case xx of
[] -> error "empty list in shapeOfList/Primary"
x:xs -> shapeOfList xs :. Nuc x
deepSeq (sh:.n) x = deepSeq sh (n `seq` x)
instance (Shape sh, Show sh, ExtShape sh) => ExtShape (sh :. Nuc) where
subDim (sh1:.Nuc n1) (sh2:.Nuc n2) = subDim sh1 sh2 :. Nuc (n1n2)
rangeList (sh1:.Nuc n1) (sh2:.Nuc n2) = [ sh:.Nuc n | sh <- rangeList sh1 sh2, n <- [n1 .. (n1+n2)]]
instance Enum Nuc where
toEnum = Nuc
fromEnum = unNuc
instance MkPrimary String where
mkPrimary = VU.fromList . map mkNuc
instance MkPrimary BS.ByteString where
mkPrimary = mkPrimary . BS.unpack
instance MkPrimary BSL.ByteString where
mkPrimary = mkPrimary . BSL.unpack
instance MkPrimary T.Text where
mkPrimary = mkPrimary . T.unpack
instance MkPrimary [Nuc] where
mkPrimary = VU.fromList