module Biobase.Primary where
import "PrimitiveArray" Data.Array.Repa.Index
import "PrimitiveArray" Data.Array.Repa.Shape
import Data.Char (toUpper)
import Data.ExtShape
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.PrimitiveArray
import Data.PrimitiveArray.Unboxed.Zero
import Biobase.Primary.Bounds
class MkPrimary a where
mkPrimary :: a -> Primary
type Primary = Arr0 DIM1 Nuc
instance Eq Primary where
xs == ys
| bx==by = sliceEq xs zeroDim ys zeroDim bx
| otherwise = False
where (_,bx) = bounds xs
(_,by) = bounds ys
instance Ord Primary where
xs <= ys
| bx==by = toList xs <= toList ys
| otherwise = bx<=by
where (_,Z:.bx) = bounds xs
(_,Z:.by) = bounds ys
newtype Nuc = Nuc {unNuc :: Int}
deriving (Eq,Ord,Ix)
(nN : nA : nC : nG : nT : nIMI : nUndefined : _) = map Nuc [0 .. ]
nU = nT
acgt = [nA..nT]
acgu = acgt
nacgt = [nN..nT]
nacgu = nacgt
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 Bounded Nuc where
minBound = nN
maxBound = nT
instance Bounds Nuc where
minNormal = nA
maxNormal = nT
minExtended = nN
maxExtended = nT
instance Enum Nuc where
toEnum = Nuc
fromEnum = unNuc
instance MkPrimary String where
mkPrimary xs = fromList (Z:.0) (Z:.length xs 1) $ map mkNuc xs
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 xs = fromList (Z:.0) (Z:.length xs 1) xs