module Biobase.Secondary.Diagrams where
import qualified Data.Vector.Unboxed as VU
import Data.List (sort,groupBy,sortBy)
import Data.Tuple.Select (sel1,sel2)
import Data.Tuple (swap)
import Control.Arrow
import Biobase.Primary
import Biobase.Secondary
newtype D1Secondary = D1S {unD1S :: VU.Vector Int}
deriving (Read,Show,Eq)
newtype D2Secondary = D2S {unD2S :: VU.Vector ( (Int,Edge,CTisomerism), (Int,Edge,CTisomerism) )}
deriving (Read,Show,Eq)
class MkD1Secondary a where
mkD1S :: a -> D1Secondary
fromD1S :: D1Secondary -> a
class MkD2Secondary a where
mkD2S :: a -> D2Secondary
fromD2S :: D2Secondary -> a
data SSTree idx a = SSTree idx a [SSTree idx a]
| SSExt Int a [SSTree idx a]
deriving (Read,Show,Eq)
d1sTree :: D1Secondary -> SSTree PairIdx ()
d1sTree s = ext $ sort ps where
(len,ps) = fromD1S s
ext [] = SSExt len () []
ext xs = SSExt len () . map tree $ groupBy (\l r -> snd l > fst r) xs
tree [ij] = SSTree ij () []
tree (ij:xs) = SSTree ij () . map tree $ groupBy (\l r -> snd l > fst r) xs
d2sTree :: D2Secondary -> SSTree ExtPairIdx ()
d2sTree s = ext $ sortBy d2Compare ps where
(len,ps) = fromD2S s
ext [] = SSExt len () []
ext xs = SSExt len () . map tree . groupBy d2Grouping $ xs
tree [ij] = SSTree ij () []
tree (ij:xs) = SSTree ij () . map tree . groupBy d2Grouping $ xs
d2Compare ((i,j),_) ((k,l),_)
| i==k = compare l j
| j==l = compare i k
| otherwise = compare (i,j) (k,l)
d2Grouping ((i,j),_) ((k,l),_) = i<=k && j>=l
test :: (Int,[ExtPairIdx])
test = (20,test')
test' =
[ ((2,15),(cis,wc,wc))
, ((3,14),(cis,wc,wc))
, ((4,13),(cis,wc,wc))
, ((5,12),(cis,wc,wc))
, ((6,10),(trans,wc,hoogsteen))
, ((2,18),(trans,sugar,sugar))
, ((15,18),(cis,sugar,sugar))
]
instance MkD1Secondary D2Secondary where
mkD1S = fromD2S
fromD1S = mkD2S
instance MkD1Secondary (Int,[PairIdx]) where
mkD1S (len,ps) = let xs = concatMap (\ij -> [ij,swap ij]) ps
in D1S $ VU.replicate len (1) VU.// xs
fromD1S (D1S s) = (VU.length s, filter (\(i,j) -> i<j && j>=0) . zip [0..] . VU.toList $ s)
instance MkD2Secondary D1Secondary where
mkD2S (D1S xs) = D2S . VU.map (\k -> ((k,wc,cis),(1,unknownEdge,unknownCT))) $ xs
fromD2S (D2S xs) = D1S . VU.map (sel1 . sel1) $ xs
instance MkD2Secondary (Int,[ExtPairIdx]) where
mkD2S (len,ps) = let xs = concatMap (\((i,j),(ct,e1,e2)) ->
[ (i, (j,e1,ct))
, (j, (i,e2,ct))
]) ps
f (x,y) z = if sel1 x == 1 then (z,y) else (x,z)
in D2S $ VU.accum f (VU.replicate len ((1,unknownEdge,unknownCT),(1,unknownEdge,unknownCT))) xs
fromD2S (D2S s) = ( VU.length s
, let (xs,ys) = unzip . VU.toList $ s
g i j = let z = s VU.! i in if sel1 (sel1 z) == j then sel2 (sel1 z) else sel2 (sel2 z)
f (i,(j,eI,ct)) = ((i,j),(ct,eI,g j i))
in
map f . filter (\(i,(j,_,_)) -> i<j && j>=0) $ zip [0..] xs ++ zip [0..] ys
)
instance MkD1Secondary ([String],String) where
mkD1S (dict,xs) = mkD1S (length xs,ps) where
ps :: [(Int,Int)]
ps = dotBracket dict xs
fromD1S (D1S s) = ([], zipWith f [0..] $ VU.toList s) where
f k (1) = '.'
f k p
| k>p = ')'
| otherwise = '('
instance MkD1Secondary ([String],VU.Vector Char) where
mkD1S (dict,xs) = mkD1S (dict, VU.toList xs)
fromD1S s = let (dict,res) = fromD1S s in (dict,VU.fromList res)
instance MkD1Secondary String where
mkD1S xs = mkD1S (["()"],xs)
fromD1S s = let (_::[String],res) = fromD1S s in res
instance MkD1Secondary (VU.Vector Char) where
mkD1S xs = mkD1S (["()"],xs)
fromD1S s = let (_::[String],res::VU.Vector Char) = fromD1S s in res
dotBracket :: [String] -> String -> [(Int,Int)]
dotBracket dict xs = sort . concatMap (f xs) $ dict where
f xs [l,r] = g 0 [] . map (\x -> if x `elem` [l,r] then x else '.') $ xs where
g :: Int -> [Int] -> String -> [(Int,Int)]
g _ st [] = []
g k st ('.':xs) = g (k+1) st xs
g k sst (x:xs)
| l==x = g (k+1) (k:sst) xs
g k (s:st) (x:xs)
| r==x = (s,k) : g (k+1) st xs
g a b c = error $ show (a,b,c)