-- | Methods to transform a secondary structure containing pseudoknots into a
-- structure which is pseudoknot-free.
--
-- TODO Until a better name is found, this module is home to functions for
-- "de-pseudoknotting" structures.
--
-- TODO Check if there are corner-cases remaining when considering 2-diagrams.

module Biobase.Secondary.Pseudoknots where

import           Data.List
import qualified Data.Vector.Unboxed as VU

import Biobase.Secondary.Basepair



-- | Try to removed pseudoknots from the "pairlist". This works by counting for
-- each pair, how many pairs are incompatible with it. Then those with most
-- incompatibilities are successively removed. This function might well remove
-- more than necessary!

class RemovePseudoKnots a where
  removeByCounting :: a -> a

-- | Remove pseudoknotted pairs from RNA secondary structures.

instance RemovePseudoKnots (VU.Vector PairIdx) where
  removeByCounting :: Vector PairIdx -> Vector PairIdx
removeByCounting = Vector PairIdx -> Vector PairIdx
forall a. Unbox a => Vector a -> Vector a
VU.force (Vector PairIdx -> Vector PairIdx)
-> (Vector PairIdx -> Vector PairIdx)
-> Vector PairIdx
-> Vector PairIdx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector PairIdx -> Vector PairIdx
forall a. (Unbox a, Ord a) => Vector (a, a) -> Vector (a, a)
wrapRemove where
    wrapRemove :: Vector (a, a) -> Vector (a, a)
wrapRemove !Vector (a, a)
ps
      | Vector Int -> Bool
forall a. Unbox a => Vector a -> Bool
VU.null Vector Int
cnts = Vector (a, a)
ps -- there are no pairs
      | Int
mmx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0     = Vector (a, a)
ps -- there are no incompatibilities
      | Bool
otherwise    = Vector (a, a) -> Vector (a, a)
wrapRemove (Vector (a, a) -> Vector (a, a)) -> Vector (a, a) -> Vector (a, a)
forall a b. (a -> b) -> a -> b
$ Int -> Vector (a, a) -> Vector (a, a)
forall a. Unbox a => Int -> Vector a -> Vector a
VU.take Int
pos Vector (a, a)
ps Vector (a, a) -> Vector (a, a) -> Vector (a, a)
forall a. Unbox a => Vector a -> Vector a -> Vector a
VU.++ Int -> Vector (a, a) -> Vector (a, a)
forall a. Unbox a => Int -> Vector a -> Vector a
VU.drop (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Vector (a, a)
ps
      where
        cnts :: Vector Int
cnts = ((a, a) -> Int) -> Vector (a, a) -> Vector Int
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
VU.map (a, a) -> Int
incomp Vector (a, a)
ps
        mmx :: Int
mmx = Vector Int -> Int
forall a. (Unbox a, Ord a) => Vector a -> a
VU.maximum Vector Int
cnts
        Just Int
pos = Int -> Vector Int -> Maybe Int
forall a. (Unbox a, Eq a) => a -> Vector a -> Maybe Int
VU.elemIndex Int
mmx Vector Int
cnts
        incomp :: (a, a) -> Int
incomp (a
i,a
j) = Vector (a, a) -> Int
forall a. Unbox a => Vector a -> Int
VU.length (Vector (a, a) -> Int) -> Vector (a, a) -> Int
forall a b. (a -> b) -> a -> b
$ ((a, a) -> Bool) -> Vector (a, a) -> Vector (a, a)
forall a. Unbox a => (a -> Bool) -> Vector a -> Vector a
VU.filter (\(a
k,a
l) -> a
ia -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
kBool -> Bool -> Bool
&&a
ka -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
jBool -> Bool -> Bool
&&a
ja -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
l Bool -> Bool -> Bool
|| a
ka -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
iBool -> Bool -> Bool
&&a
ia -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
lBool -> Bool -> Bool
&&a
la -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
j) Vector (a, a)
ps

instance RemovePseudoKnots [PairIdx] where
  removeByCounting :: [PairIdx] -> [PairIdx]
removeByCounting = Vector PairIdx -> [PairIdx]
forall a. Unbox a => Vector a -> [a]
VU.toList (Vector PairIdx -> [PairIdx])
-> ([PairIdx] -> Vector PairIdx) -> [PairIdx] -> [PairIdx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector PairIdx -> Vector PairIdx
forall a. RemovePseudoKnots a => a -> a
removeByCounting (Vector PairIdx -> Vector PairIdx)
-> ([PairIdx] -> Vector PairIdx) -> [PairIdx] -> Vector PairIdx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PairIdx] -> Vector PairIdx
forall a. Unbox a => [a] -> Vector a
VU.fromList

-- | Remove pseudoknotted pairs from extended RNA secondary structures.

instance RemovePseudoKnots (VU.Vector ExtPairIdx) where
  removeByCounting :: Vector ExtPairIdx -> Vector ExtPairIdx
removeByCounting = Vector ExtPairIdx -> Vector ExtPairIdx
forall a. Unbox a => Vector a -> Vector a
VU.force (Vector ExtPairIdx -> Vector ExtPairIdx)
-> (Vector ExtPairIdx -> Vector ExtPairIdx)
-> Vector ExtPairIdx
-> Vector ExtPairIdx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector ExtPairIdx -> Vector ExtPairIdx
forall a b.
(Unbox a, Unbox b, Ord a) =>
Vector ((a, a), b) -> Vector ((a, a), b)
wrapRemove where
    wrapRemove :: Vector ((a, a), b) -> Vector ((a, a), b)
wrapRemove !Vector ((a, a), b)
ps
      | Vector Int -> Bool
forall a. Unbox a => Vector a -> Bool
VU.null Vector Int
cnts = Vector ((a, a), b)
ps -- there are no pairs
      | Int
mmx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0     = Vector ((a, a), b)
ps -- there are no incompatibilities
      | Bool
otherwise    = Vector ((a, a), b) -> Vector ((a, a), b)
wrapRemove (Vector ((a, a), b) -> Vector ((a, a), b))
-> Vector ((a, a), b) -> Vector ((a, a), b)
forall a b. (a -> b) -> a -> b
$ Int -> Vector ((a, a), b) -> Vector ((a, a), b)
forall a. Unbox a => Int -> Vector a -> Vector a
VU.take Int
pos Vector ((a, a), b)
ps Vector ((a, a), b) -> Vector ((a, a), b) -> Vector ((a, a), b)
forall a. Unbox a => Vector a -> Vector a -> Vector a
VU.++ Int -> Vector ((a, a), b) -> Vector ((a, a), b)
forall a. Unbox a => Int -> Vector a -> Vector a
VU.drop (Int
posInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Vector ((a, a), b)
ps
      where
        cnts :: Vector Int
cnts = (((a, a), b) -> Int) -> Vector ((a, a), b) -> Vector Int
forall a b. (Unbox a, Unbox b) => (a -> b) -> Vector a -> Vector b
VU.map ((a, a), b) -> Int
incomp Vector ((a, a), b)
ps
        mmx :: Int
mmx = Vector Int -> Int
forall a. (Unbox a, Ord a) => Vector a -> a
VU.maximum Vector Int
cnts
        Just Int
pos = Int -> Vector Int -> Maybe Int
forall a. (Unbox a, Eq a) => a -> Vector a -> Maybe Int
VU.elemIndex Int
mmx Vector Int
cnts
        incomp :: ((a, a), b) -> Int
incomp ((a
i,a
j),b
_) = Vector ((a, a), b) -> Int
forall a. Unbox a => Vector a -> Int
VU.length (Vector ((a, a), b) -> Int) -> Vector ((a, a), b) -> Int
forall a b. (a -> b) -> a -> b
$ (((a, a), b) -> Bool) -> Vector ((a, a), b) -> Vector ((a, a), b)
forall a. Unbox a => (a -> Bool) -> Vector a -> Vector a
VU.filter (\((a
k,a
l),b
_) -> a
ia -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
kBool -> Bool -> Bool
&&a
ka -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
jBool -> Bool -> Bool
&&a
ja -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
l Bool -> Bool -> Bool
|| a
ka -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
iBool -> Bool -> Bool
&&a
ia -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
lBool -> Bool -> Bool
&&a
la -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
j) Vector ((a, a), b)
ps

instance RemovePseudoKnots [ExtPairIdx] where
  removeByCounting :: [ExtPairIdx] -> [ExtPairIdx]
removeByCounting = Vector ExtPairIdx -> [ExtPairIdx]
forall a. Unbox a => Vector a -> [a]
VU.toList (Vector ExtPairIdx -> [ExtPairIdx])
-> ([ExtPairIdx] -> Vector ExtPairIdx)
-> [ExtPairIdx]
-> [ExtPairIdx]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector ExtPairIdx -> Vector ExtPairIdx
forall a. RemovePseudoKnots a => a -> a
removeByCounting (Vector ExtPairIdx -> Vector ExtPairIdx)
-> ([ExtPairIdx] -> Vector ExtPairIdx)
-> [ExtPairIdx]
-> Vector ExtPairIdx
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ExtPairIdx] -> Vector ExtPairIdx
forall a. Unbox a => [a] -> Vector a
VU.fromList