-- | Shape abstractions of structures.
--
-- Shapes do not preserve sizes of structures (say unpaired regions or stem
-- length). As such, distance measures provided here are to be used carefully!
--
-- TODO consider how to handle the different shape levels. One option would be
-- to phantom-type everything.

module Biobase.Types.Shape where

import           Control.DeepSeq
import           Control.Lens
import           Control.Monad.Error.Class
import           Control.Monad (foldM,unless)
import           Data.ByteString (ByteString)
import           Data.Data
import           Data.List (foldl1')
import           Data.Monoid ((<>))
import           Data.Set (Set)
import           GHC.Generics (Generic)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.List as L
import qualified Data.Set as Set

import           Data.Forest.StructuredPaired

import qualified Biobase.Types.Structure as TS



-- | Shape levels are hardcoded according to their specification.
--
-- TODO Allow compile-time check on accepted shape levels?

data ShapeLevel
  = SL1
  | SL2
  | SL3
  | SL4
  | SL5
  deriving (ShapeLevel -> ShapeLevel -> Bool
(ShapeLevel -> ShapeLevel -> Bool)
-> (ShapeLevel -> ShapeLevel -> Bool) -> Eq ShapeLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShapeLevel -> ShapeLevel -> Bool
$c/= :: ShapeLevel -> ShapeLevel -> Bool
== :: ShapeLevel -> ShapeLevel -> Bool
$c== :: ShapeLevel -> ShapeLevel -> Bool
Eq,Eq ShapeLevel
Eq ShapeLevel
-> (ShapeLevel -> ShapeLevel -> Ordering)
-> (ShapeLevel -> ShapeLevel -> Bool)
-> (ShapeLevel -> ShapeLevel -> Bool)
-> (ShapeLevel -> ShapeLevel -> Bool)
-> (ShapeLevel -> ShapeLevel -> Bool)
-> (ShapeLevel -> ShapeLevel -> ShapeLevel)
-> (ShapeLevel -> ShapeLevel -> ShapeLevel)
-> Ord ShapeLevel
ShapeLevel -> ShapeLevel -> Bool
ShapeLevel -> ShapeLevel -> Ordering
ShapeLevel -> ShapeLevel -> ShapeLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ShapeLevel -> ShapeLevel -> ShapeLevel
$cmin :: ShapeLevel -> ShapeLevel -> ShapeLevel
max :: ShapeLevel -> ShapeLevel -> ShapeLevel
$cmax :: ShapeLevel -> ShapeLevel -> ShapeLevel
>= :: ShapeLevel -> ShapeLevel -> Bool
$c>= :: ShapeLevel -> ShapeLevel -> Bool
> :: ShapeLevel -> ShapeLevel -> Bool
$c> :: ShapeLevel -> ShapeLevel -> Bool
<= :: ShapeLevel -> ShapeLevel -> Bool
$c<= :: ShapeLevel -> ShapeLevel -> Bool
< :: ShapeLevel -> ShapeLevel -> Bool
$c< :: ShapeLevel -> ShapeLevel -> Bool
compare :: ShapeLevel -> ShapeLevel -> Ordering
$ccompare :: ShapeLevel -> ShapeLevel -> Ordering
$cp1Ord :: Eq ShapeLevel
Ord,Int -> ShapeLevel -> ShowS
[ShapeLevel] -> ShowS
ShapeLevel -> String
(Int -> ShapeLevel -> ShowS)
-> (ShapeLevel -> String)
-> ([ShapeLevel] -> ShowS)
-> Show ShapeLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShapeLevel] -> ShowS
$cshowList :: [ShapeLevel] -> ShowS
show :: ShapeLevel -> String
$cshow :: ShapeLevel -> String
showsPrec :: Int -> ShapeLevel -> ShowS
$cshowsPrec :: Int -> ShapeLevel -> ShowS
Show,ReadPrec [ShapeLevel]
ReadPrec ShapeLevel
Int -> ReadS ShapeLevel
ReadS [ShapeLevel]
(Int -> ReadS ShapeLevel)
-> ReadS [ShapeLevel]
-> ReadPrec ShapeLevel
-> ReadPrec [ShapeLevel]
-> Read ShapeLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ShapeLevel]
$creadListPrec :: ReadPrec [ShapeLevel]
readPrec :: ReadPrec ShapeLevel
$creadPrec :: ReadPrec ShapeLevel
readList :: ReadS [ShapeLevel]
$creadList :: ReadS [ShapeLevel]
readsPrec :: Int -> ReadS ShapeLevel
$creadsPrec :: Int -> ReadS ShapeLevel
Read,Typeable ShapeLevel
DataType
Constr
Typeable ShapeLevel
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ShapeLevel -> c ShapeLevel)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ShapeLevel)
-> (ShapeLevel -> Constr)
-> (ShapeLevel -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ShapeLevel))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ShapeLevel))
-> ((forall b. Data b => b -> b) -> ShapeLevel -> ShapeLevel)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ShapeLevel -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ShapeLevel -> r)
-> (forall u. (forall d. Data d => d -> u) -> ShapeLevel -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ShapeLevel -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ShapeLevel -> m ShapeLevel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ShapeLevel -> m ShapeLevel)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ShapeLevel -> m ShapeLevel)
-> Data ShapeLevel
ShapeLevel -> DataType
ShapeLevel -> Constr
(forall b. Data b => b -> b) -> ShapeLevel -> ShapeLevel
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ShapeLevel -> c ShapeLevel
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ShapeLevel
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ShapeLevel -> u
forall u. (forall d. Data d => d -> u) -> ShapeLevel -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ShapeLevel -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ShapeLevel -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ShapeLevel -> m ShapeLevel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ShapeLevel -> m ShapeLevel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ShapeLevel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ShapeLevel -> c ShapeLevel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ShapeLevel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ShapeLevel)
$cSL5 :: Constr
$cSL4 :: Constr
$cSL3 :: Constr
$cSL2 :: Constr
$cSL1 :: Constr
$tShapeLevel :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ShapeLevel -> m ShapeLevel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ShapeLevel -> m ShapeLevel
gmapMp :: (forall d. Data d => d -> m d) -> ShapeLevel -> m ShapeLevel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ShapeLevel -> m ShapeLevel
gmapM :: (forall d. Data d => d -> m d) -> ShapeLevel -> m ShapeLevel
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ShapeLevel -> m ShapeLevel
gmapQi :: Int -> (forall d. Data d => d -> u) -> ShapeLevel -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ShapeLevel -> u
gmapQ :: (forall d. Data d => d -> u) -> ShapeLevel -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ShapeLevel -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ShapeLevel -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ShapeLevel -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ShapeLevel -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ShapeLevel -> r
gmapT :: (forall b. Data b => b -> b) -> ShapeLevel -> ShapeLevel
$cgmapT :: (forall b. Data b => b -> b) -> ShapeLevel -> ShapeLevel
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ShapeLevel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ShapeLevel)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ShapeLevel)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ShapeLevel)
dataTypeOf :: ShapeLevel -> DataType
$cdataTypeOf :: ShapeLevel -> DataType
toConstr :: ShapeLevel -> Constr
$ctoConstr :: ShapeLevel -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ShapeLevel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ShapeLevel
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ShapeLevel -> c ShapeLevel
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ShapeLevel -> c ShapeLevel
$cp1Data :: Typeable ShapeLevel
Data,Typeable,(forall x. ShapeLevel -> Rep ShapeLevel x)
-> (forall x. Rep ShapeLevel x -> ShapeLevel) -> Generic ShapeLevel
forall x. Rep ShapeLevel x -> ShapeLevel
forall x. ShapeLevel -> Rep ShapeLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ShapeLevel x -> ShapeLevel
$cfrom :: forall x. ShapeLevel -> Rep ShapeLevel x
Generic)

instance NFData ShapeLevel



-- | The type of RNA shapes. Keeps the type 

data RNAshape
  = RNAshape
    { RNAshape -> ShapeLevel
_rnashapelevel  ∷ !ShapeLevel
    -- ^ The type of shape encoded here.
    , RNAshape -> ByteString
_rnashape       ∷ !ByteString
    -- ^ The actual shape as a string.
    }
  deriving (RNAshape -> RNAshape -> Bool
(RNAshape -> RNAshape -> Bool)
-> (RNAshape -> RNAshape -> Bool) -> Eq RNAshape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RNAshape -> RNAshape -> Bool
$c/= :: RNAshape -> RNAshape -> Bool
== :: RNAshape -> RNAshape -> Bool
$c== :: RNAshape -> RNAshape -> Bool
Eq,Eq RNAshape
Eq RNAshape
-> (RNAshape -> RNAshape -> Ordering)
-> (RNAshape -> RNAshape -> Bool)
-> (RNAshape -> RNAshape -> Bool)
-> (RNAshape -> RNAshape -> Bool)
-> (RNAshape -> RNAshape -> Bool)
-> (RNAshape -> RNAshape -> RNAshape)
-> (RNAshape -> RNAshape -> RNAshape)
-> Ord RNAshape
RNAshape -> RNAshape -> Bool
RNAshape -> RNAshape -> Ordering
RNAshape -> RNAshape -> RNAshape
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RNAshape -> RNAshape -> RNAshape
$cmin :: RNAshape -> RNAshape -> RNAshape
max :: RNAshape -> RNAshape -> RNAshape
$cmax :: RNAshape -> RNAshape -> RNAshape
>= :: RNAshape -> RNAshape -> Bool
$c>= :: RNAshape -> RNAshape -> Bool
> :: RNAshape -> RNAshape -> Bool
$c> :: RNAshape -> RNAshape -> Bool
<= :: RNAshape -> RNAshape -> Bool
$c<= :: RNAshape -> RNAshape -> Bool
< :: RNAshape -> RNAshape -> Bool
$c< :: RNAshape -> RNAshape -> Bool
compare :: RNAshape -> RNAshape -> Ordering
$ccompare :: RNAshape -> RNAshape -> Ordering
$cp1Ord :: Eq RNAshape
Ord,Int -> RNAshape -> ShowS
[RNAshape] -> ShowS
RNAshape -> String
(Int -> RNAshape -> ShowS)
-> (RNAshape -> String) -> ([RNAshape] -> ShowS) -> Show RNAshape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RNAshape] -> ShowS
$cshowList :: [RNAshape] -> ShowS
show :: RNAshape -> String
$cshow :: RNAshape -> String
showsPrec :: Int -> RNAshape -> ShowS
$cshowsPrec :: Int -> RNAshape -> ShowS
Show,ReadPrec [RNAshape]
ReadPrec RNAshape
Int -> ReadS RNAshape
ReadS [RNAshape]
(Int -> ReadS RNAshape)
-> ReadS [RNAshape]
-> ReadPrec RNAshape
-> ReadPrec [RNAshape]
-> Read RNAshape
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RNAshape]
$creadListPrec :: ReadPrec [RNAshape]
readPrec :: ReadPrec RNAshape
$creadPrec :: ReadPrec RNAshape
readList :: ReadS [RNAshape]
$creadList :: ReadS [RNAshape]
readsPrec :: Int -> ReadS RNAshape
$creadsPrec :: Int -> ReadS RNAshape
Read,Typeable RNAshape
DataType
Constr
Typeable RNAshape
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RNAshape -> c RNAshape)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c RNAshape)
-> (RNAshape -> Constr)
-> (RNAshape -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c RNAshape))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RNAshape))
-> ((forall b. Data b => b -> b) -> RNAshape -> RNAshape)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RNAshape -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RNAshape -> r)
-> (forall u. (forall d. Data d => d -> u) -> RNAshape -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RNAshape -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RNAshape -> m RNAshape)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RNAshape -> m RNAshape)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RNAshape -> m RNAshape)
-> Data RNAshape
RNAshape -> DataType
RNAshape -> Constr
(forall b. Data b => b -> b) -> RNAshape -> RNAshape
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RNAshape -> c RNAshape
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RNAshape
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RNAshape -> u
forall u. (forall d. Data d => d -> u) -> RNAshape -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RNAshape -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RNAshape -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RNAshape -> m RNAshape
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RNAshape -> m RNAshape
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RNAshape
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RNAshape -> c RNAshape
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RNAshape)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RNAshape)
$cRNAshape :: Constr
$tRNAshape :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RNAshape -> m RNAshape
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RNAshape -> m RNAshape
gmapMp :: (forall d. Data d => d -> m d) -> RNAshape -> m RNAshape
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RNAshape -> m RNAshape
gmapM :: (forall d. Data d => d -> m d) -> RNAshape -> m RNAshape
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RNAshape -> m RNAshape
gmapQi :: Int -> (forall d. Data d => d -> u) -> RNAshape -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RNAshape -> u
gmapQ :: (forall d. Data d => d -> u) -> RNAshape -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RNAshape -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RNAshape -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RNAshape -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RNAshape -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RNAshape -> r
gmapT :: (forall b. Data b => b -> b) -> RNAshape -> RNAshape
$cgmapT :: (forall b. Data b => b -> b) -> RNAshape -> RNAshape
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RNAshape)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RNAshape)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RNAshape)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RNAshape)
dataTypeOf :: RNAshape -> DataType
$cdataTypeOf :: RNAshape -> DataType
toConstr :: RNAshape -> Constr
$ctoConstr :: RNAshape -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RNAshape
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RNAshape
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RNAshape -> c RNAshape
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RNAshape -> c RNAshape
$cp1Data :: Typeable RNAshape
Data,Typeable,(forall x. RNAshape -> Rep RNAshape x)
-> (forall x. Rep RNAshape x -> RNAshape) -> Generic RNAshape
forall x. Rep RNAshape x -> RNAshape
forall x. RNAshape -> Rep RNAshape x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RNAshape x -> RNAshape
$cfrom :: forall x. RNAshape -> Rep RNAshape x
Generic)
makeLenses ''RNAshape

instance NFData RNAshape



-- | Given a compactified 'SPForest', creates a shape forest of the given level.
--
--
--
-- TODO needs newtyping

shapeForest
  ∷ ShapeLevel
  → SPForest ByteString ByteString
  → SPForest Char Char
shapeForest :: ShapeLevel -> SPForest ByteString ByteString -> SPForest Char Char
shapeForest = ShapeLevel -> SPForest ByteString ByteString -> SPForest Char Char
forall r t. ShapeLevel -> SPForest r t -> SPForest Char Char
preStem
  where
    -- | In @preStem@, we aim to close in on the next stem. @SPE@ means that we
    -- reached an end in a stem.
    preStem :: ShapeLevel -> SPForest r t -> SPForest Char Char
preStem ShapeLevel
s SPForest r t
SPE = SPForest Char Char
forall r t. SPForest r t
SPE
    -- | The start of a tree structure. The forest is compact, which means that
    -- the element in @xs@ is, by definition, not a continuation of a stack.
    preStem ShapeLevel
s (SPT t
_ SPForest r t
xs t
_) = Char -> SPForest Char Char -> Char -> SPForest Char Char
forall r t. t -> SPForest r t -> t -> SPForest r t
SPT Char
'[' (ShapeLevel -> SPForest r t -> SPForest Char Char
inStem ShapeLevel
s SPForest r t
xs) Char
']'
    -- |
    preStem ShapeLevel
s spr :: SPForest r t
spr@(SPR r
rs) = ShapeLevel -> SPForest r t -> SPForest Char Char
inStem ShapeLevel
s SPForest r t
spr -- = error $ "preStem/SPR " ++ show rs
    -- |
    preStem ShapeLevel
s (SPJ [SPForest r t]
xs)
      | [SPForest r t
x] ← [SPForest r t]
xs  = ShapeLevel -> SPForest r t -> SPForest Char Char
preStem ShapeLevel
s SPForest r t
x
      -- left bulge
      | [l :: SPForest r t
l@SPR{},x :: SPForest r t
x@SPT{}] ← [SPForest r t]
xs = if ShapeLevel
s ShapeLevel -> ShapeLevel -> Bool
forall a. Ord a => a -> a -> Bool
<= ShapeLevel
SL2 then ([SPForest Char Char] -> SPForest Char Char
forall r t. [SPForest r t] -> SPForest r t
SPJ [Char -> SPForest Char Char
forall r t. r -> SPForest r t
SPR Char
'_', ShapeLevel -> SPForest r t -> SPForest Char Char
preStem ShapeLevel
s SPForest r t
x]) else ShapeLevel -> SPForest r t -> SPForest Char Char
preStem ShapeLevel
s SPForest r t
x
      -- right bulge
      | [x :: SPForest r t
x@SPT{},r :: SPForest r t
r@SPR{}] ← [SPForest r t]
xs = if ShapeLevel
s ShapeLevel -> ShapeLevel -> Bool
forall a. Ord a => a -> a -> Bool
<= ShapeLevel
SL2 then ([SPForest Char Char] -> SPForest Char Char
forall r t. [SPForest r t] -> SPForest r t
SPJ [ShapeLevel -> SPForest r t -> SPForest Char Char
preStem ShapeLevel
s SPForest r t
x, Char -> SPForest Char Char
forall r t. r -> SPForest r t
SPR Char
'_']) else ShapeLevel -> SPForest r t -> SPForest Char Char
preStem ShapeLevel
s SPForest r t
x
      | Bool
otherwise = [SPForest Char Char] -> SPForest Char Char
forall r t. [SPForest r t] -> SPForest r t
SPJ ([SPForest Char Char] -> SPForest Char Char)
-> [SPForest Char Char] -> SPForest Char Char
forall a b. (a -> b) -> a -> b
$ (SPForest r t -> SPForest Char Char)
-> [SPForest r t] -> [SPForest Char Char]
forall a b. (a -> b) -> [a] -> [b]
map (ShapeLevel -> SPForest r t -> SPForest Char Char
preStem ShapeLevel
s) [SPForest r t]
xs -- error $ "preStem/SPJ " ++ show xs
    --
    -- | After a stem, there could be an @SPE@ element.
    inStem :: ShapeLevel -> SPForest r t -> SPForest Char Char
inStem ShapeLevel
s SPForest r t
SPE = SPForest Char Char
forall r t. SPForest r t
SPE
    -- | This case happens when eradicating unstructured regions with high
    -- abstraction levels.
    inStem ShapeLevel
s (SPT t
_ SPForest r t
xs t
_) = ShapeLevel -> SPForest r t -> SPForest Char Char
inStem ShapeLevel
s SPForest r t
xs
    inStem ShapeLevel
s (SPR r
rs)
      | ShapeLevel
s ShapeLevel -> ShapeLevel -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeLevel
SL1  = Char -> SPForest Char Char
forall r t. r -> SPForest r t
SPR Char
'_' -- = error $ "inStem / SPR " ++ show rs
      | Bool
otherwise = SPForest Char Char
forall r t. SPForest r t
SPE
    inStem ShapeLevel
s (SPJ [SPForest r t]
xs)
      | [SPForest r t
x] ← [SPForest r t]
xs = String -> SPForest Char Char
forall a. HasCallStack => String -> a
error String
"x"
      -- left bulge
      | [l :: SPForest r t
l@SPR{},SPForest r t
x] ← [SPForest r t]
xs = if ShapeLevel
s ShapeLevel -> ShapeLevel -> Bool
forall a. Ord a => a -> a -> Bool
<= ShapeLevel
SL3 then ShapeLevel -> SPForest r t -> SPForest Char Char
preStem ShapeLevel
s ([SPForest r t] -> SPForest r t
forall r t. [SPForest r t] -> SPForest r t
SPJ [SPForest r t]
xs) else ShapeLevel -> SPForest r t -> SPForest Char Char
inStem ShapeLevel
s SPForest r t
x
      -- right bulge
      | [SPForest r t
x,r :: SPForest r t
r@SPR{}] ← [SPForest r t]
xs = if ShapeLevel
s ShapeLevel -> ShapeLevel -> Bool
forall a. Ord a => a -> a -> Bool
<= ShapeLevel
SL3 then ShapeLevel -> SPForest r t -> SPForest Char Char
preStem ShapeLevel
s ([SPForest r t] -> SPForest r t
forall r t. [SPForest r t] -> SPForest r t
SPJ [SPForest r t]
xs) else ShapeLevel -> SPForest r t -> SPForest Char Char
inStem ShapeLevel
s SPForest r t
x
      -- interior loop
      | [l :: SPForest r t
l@SPR{},SPForest r t
x,r :: SPForest r t
r@SPR{}] ← [SPForest r t]
xs = if ShapeLevel
s ShapeLevel -> ShapeLevel -> Bool
forall a. Eq a => a -> a -> Bool
== ShapeLevel
SL5 then ShapeLevel -> SPForest r t -> SPForest Char Char
inStem ShapeLevel
s SPForest r t
x else ShapeLevel -> SPForest r t -> SPForest Char Char
preStem ShapeLevel
s ([SPForest r t] -> SPForest r t
forall r t. [SPForest r t] -> SPForest r t
SPJ [SPForest r t]
xs)
--      | s == SL1  = error $ "inStem / SPJ " ++ show xs
--      | s == SL2  = error $ "inStem / SPJ " ++ show xs
      -- multibranched loop
      | Bool
otherwise = [SPForest Char Char] -> SPForest Char Char
forall r t. [SPForest r t] -> SPForest r t
SPJ ([SPForest Char Char] -> SPForest Char Char)
-> [SPForest Char Char] -> SPForest Char Char
forall a b. (a -> b) -> a -> b
$ (SPForest r t -> SPForest Char Char)
-> [SPForest r t] -> [SPForest Char Char]
forall a b. (a -> b) -> [a] -> [b]
map (ShapeLevel -> SPForest r t -> SPForest Char Char
preStem ShapeLevel
s) [SPForest r t]
xs

rnass2shape :: ShapeLevel -> RNAss -> RNAshape
rnass2shape ShapeLevel
lvl RNAss
s = ShapeLevel -> SPForest Char Char -> RNAshape
shapeForestshape ShapeLevel
lvl (SPForest Char Char -> RNAshape)
-> (RNAss -> SPForest Char Char) -> RNAss -> RNAshape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShapeLevel -> SPForest ByteString ByteString -> SPForest Char Char
shapeForest ShapeLevel
lvl (SPForest ByteString ByteString -> SPForest Char Char)
-> (RNAss -> SPForest ByteString ByteString)
-> RNAss
-> SPForest Char Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SPForest ByteString Char -> SPForest ByteString ByteString
TS.compactifySPForest
                (SPForest ByteString Char -> SPForest ByteString ByteString)
-> (RNAss -> SPForest ByteString Char)
-> RNAss
-> SPForest ByteString ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> SPForest ByteString Char)
-> (SPForest ByteString Char -> SPForest ByteString Char)
-> Either String (SPForest ByteString Char)
-> SPForest ByteString Char
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
e → String -> SPForest ByteString Char
forall a. HasCallStack => String -> a
error (String -> SPForest ByteString Char)
-> String -> SPForest ByteString Char
forall a b. (a -> b) -> a -> b
$ (String, RNAss) -> String
forall a. Show a => a -> String
show (String
e,RNAss
s)) SPForest ByteString Char -> SPForest ByteString Char
forall a. a -> a
id (Either String (SPForest ByteString Char)
 -> SPForest ByteString Char)
-> (RNAss -> Either String (SPForest ByteString Char))
-> RNAss
-> SPForest ByteString Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RNAss -> Either String (SPForest ByteString Char)
forall (m :: * -> *).
MonadError String m =>
RNAss -> m (SPForest ByteString Char)
TS.rnassSPForest (RNAss -> RNAshape) -> RNAss -> RNAshape
forall a b. (a -> b) -> a -> b
$ RNAss
s

-- | turn into unit test. also reverse of the input should give reverse shape!
-- this then gives a quickcheck test, reversing the input should reverse the shape
--
-- TODO requires generating secondary structures via @Arbitrary@.

test :: ShapeLevel -> RNAshape
test ShapeLevel
lvl = ShapeLevel -> SPForest Char Char -> RNAshape
shapeForestshape ShapeLevel
lvl (SPForest Char Char -> RNAshape)
-> (SPForest ByteString ByteString -> SPForest Char Char)
-> SPForest ByteString ByteString
-> RNAshape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShapeLevel -> SPForest ByteString ByteString -> SPForest Char Char
shapeForest ShapeLevel
lvl (SPForest ByteString ByteString -> RNAshape)
-> SPForest ByteString ByteString -> RNAshape
forall a b. (a -> b) -> a -> b
$ SPForest ByteString Char -> SPForest ByteString ByteString
TS.compactifySPForest (SPForest ByteString Char -> SPForest ByteString ByteString)
-> SPForest ByteString Char -> SPForest ByteString ByteString
forall a b. (a -> b) -> a -> b
$ (String -> SPForest ByteString Char)
-> (SPForest ByteString Char -> SPForest ByteString Char)
-> Either String (SPForest ByteString Char)
-> SPForest ByteString Char
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> SPForest ByteString Char
forall a. HasCallStack => String -> a
error SPForest ByteString Char -> SPForest ByteString Char
forall a. a -> a
id (Either String (SPForest ByteString Char)
 -> SPForest ByteString Char)
-> Either String (SPForest ByteString Char)
-> SPForest ByteString Char
forall a b. (a -> b) -> a -> b
$ RNAss -> Either String (SPForest ByteString Char)
forall (m :: * -> *).
MonadError String m =>
RNAss -> m (SPForest ByteString Char)
TS.rnassSPForest (RNAss -> Either String (SPForest ByteString Char))
-> RNAss -> Either String (SPForest ByteString Char)
forall a b. (a -> b) -> a -> b
$ ByteString -> RNAss
TS.RNAss ByteString
"(((((...(((..(((...))))))...(((..((.....))..)))))))).."

{-
shapeForest SL5 = go
  where
    go SPE = SPE
    go (SPT _ xs _)
      | SPE ← xs, SPR{} ← xs, [] ← ts = SPT '[' SPE ']'
      | [t] ← ts = go t
      | otherwise = SPT '[' (SPJ $ map go ts) ']'
      where (SPJ ys) = xs
            ts = [ t | t@SPT{} ← ys ]
    -- should only happen on a single unfolded structure
    go (SPR _) = SPR '_'
    go (SPJ xs)
      | [] ← ts   = SPR '_'
      | [t] ← ts  = go t
      | otherwise = SPJ $ map go ts
      where ts = [ t | t@SPT{} ← xs ]
    go xs = error $ show xs ++ " should no be reached"
-}

-- | 

shapeForestshape
  ∷ ShapeLevel
  → SPForest Char Char
  → RNAshape
shapeForestshape :: ShapeLevel -> SPForest Char Char -> RNAshape
shapeForestshape ShapeLevel
lvl = ShapeLevel -> ByteString -> RNAshape
RNAshape ShapeLevel
lvl (ByteString -> RNAshape)
-> (SPForest Char Char -> ByteString)
-> SPForest Char Char
-> RNAshape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SPForest Char Char -> ByteString
go
  where
    go :: SPForest Char Char -> ByteString
go SPForest Char Char
SPE = ByteString
""
    go (SPT Char
l SPForest Char Char
x Char
r) = Char -> ByteString
BS8.singleton Char
l ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> SPForest Char Char -> ByteString
go SPForest Char Char
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Char -> ByteString
BS8.singleton Char
r
    go (SPJ [SPForest Char Char]
xs   ) = [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (SPForest Char Char -> ByteString)
-> [SPForest Char Char] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map SPForest Char Char -> ByteString
go [SPForest Char Char]
xs
    go (SPR   Char
x  ) = Char -> ByteString
BS8.singleton Char
x -- error "should not be reached" -- BS8.singleton x

generateShape ∷ ShapeLevel → TS.RNAss → RNAshape
generateShape :: ShapeLevel -> RNAss -> RNAshape
generateShape = ShapeLevel -> RNAss -> RNAshape
forall a. HasCallStack => a
undefined


-- * Distance measures on the shape string itself.

-- | Wrapper for string-positional shapes. Intentionally chosen long name.

data RNAshapepset = RNAshapepset { RNAshapepset -> ShapeLevel
_rnashapepsetlevel ∷ ShapeLevel, RNAshapepset -> Set (Int, Int)
_rnashapepset ∷ Set (Int,Int) }
  deriving (ReadPrec [RNAshapepset]
ReadPrec RNAshapepset
Int -> ReadS RNAshapepset
ReadS [RNAshapepset]
(Int -> ReadS RNAshapepset)
-> ReadS [RNAshapepset]
-> ReadPrec RNAshapepset
-> ReadPrec [RNAshapepset]
-> Read RNAshapepset
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RNAshapepset]
$creadListPrec :: ReadPrec [RNAshapepset]
readPrec :: ReadPrec RNAshapepset
$creadPrec :: ReadPrec RNAshapepset
readList :: ReadS [RNAshapepset]
$creadList :: ReadS [RNAshapepset]
readsPrec :: Int -> ReadS RNAshapepset
$creadsPrec :: Int -> ReadS RNAshapepset
Read,Int -> RNAshapepset -> ShowS
[RNAshapepset] -> ShowS
RNAshapepset -> String
(Int -> RNAshapepset -> ShowS)
-> (RNAshapepset -> String)
-> ([RNAshapepset] -> ShowS)
-> Show RNAshapepset
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RNAshapepset] -> ShowS
$cshowList :: [RNAshapepset] -> ShowS
show :: RNAshapepset -> String
$cshow :: RNAshapepset -> String
showsPrec :: Int -> RNAshapepset -> ShowS
$cshowsPrec :: Int -> RNAshapepset -> ShowS
Show,RNAshapepset -> RNAshapepset -> Bool
(RNAshapepset -> RNAshapepset -> Bool)
-> (RNAshapepset -> RNAshapepset -> Bool) -> Eq RNAshapepset
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RNAshapepset -> RNAshapepset -> Bool
$c/= :: RNAshapepset -> RNAshapepset -> Bool
== :: RNAshapepset -> RNAshapepset -> Bool
$c== :: RNAshapepset -> RNAshapepset -> Bool
Eq,Eq RNAshapepset
Eq RNAshapepset
-> (RNAshapepset -> RNAshapepset -> Ordering)
-> (RNAshapepset -> RNAshapepset -> Bool)
-> (RNAshapepset -> RNAshapepset -> Bool)
-> (RNAshapepset -> RNAshapepset -> Bool)
-> (RNAshapepset -> RNAshapepset -> Bool)
-> (RNAshapepset -> RNAshapepset -> RNAshapepset)
-> (RNAshapepset -> RNAshapepset -> RNAshapepset)
-> Ord RNAshapepset
RNAshapepset -> RNAshapepset -> Bool
RNAshapepset -> RNAshapepset -> Ordering
RNAshapepset -> RNAshapepset -> RNAshapepset
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RNAshapepset -> RNAshapepset -> RNAshapepset
$cmin :: RNAshapepset -> RNAshapepset -> RNAshapepset
max :: RNAshapepset -> RNAshapepset -> RNAshapepset
$cmax :: RNAshapepset -> RNAshapepset -> RNAshapepset
>= :: RNAshapepset -> RNAshapepset -> Bool
$c>= :: RNAshapepset -> RNAshapepset -> Bool
> :: RNAshapepset -> RNAshapepset -> Bool
$c> :: RNAshapepset -> RNAshapepset -> Bool
<= :: RNAshapepset -> RNAshapepset -> Bool
$c<= :: RNAshapepset -> RNAshapepset -> Bool
< :: RNAshapepset -> RNAshapepset -> Bool
$c< :: RNAshapepset -> RNAshapepset -> Bool
compare :: RNAshapepset -> RNAshapepset -> Ordering
$ccompare :: RNAshapepset -> RNAshapepset -> Ordering
$cp1Ord :: Eq RNAshapepset
Ord,(forall x. RNAshapepset -> Rep RNAshapepset x)
-> (forall x. Rep RNAshapepset x -> RNAshapepset)
-> Generic RNAshapepset
forall x. Rep RNAshapepset x -> RNAshapepset
forall x. RNAshapepset -> Rep RNAshapepset x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RNAshapepset x -> RNAshapepset
$cfrom :: forall x. RNAshapepset -> Rep RNAshapepset x
Generic)
makeLenses ''RNAshapepset

instance NFData RNAshapepset

-- | Transform an 'RNAss' into a set of base pairs @(i,j)@. The pairs are
-- 0-based.

rnashapePairSet
  ∷ (MonadError String m)
  ⇒ RNAshape
  → m RNAshapepset
rnashapePairSet :: RNAshape -> m RNAshapepset
rnashapePairSet (RNAshape ShapeLevel
lvl ByteString
s2) = do
  let go :: (Set (Int, Int), [Int]) -> (Int, Char) -> m (Set (Int, Int), [Int])
go (Set (Int, Int)
set,[Int]
ks  ) (Int
i,Char
'[') = (Set (Int, Int), [Int]) -> m (Set (Int, Int), [Int])
forall (m :: * -> *) a. Monad m => a -> m a
return (Set (Int, Int)
set,Int
iInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ks)
      go (Set (Int, Int)
set,Int
i:[Int]
is) (Int
j,Char
']') = (Set (Int, Int), [Int]) -> m (Set (Int, Int), [Int])
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int, Int) -> Set (Int, Int) -> Set (Int, Int)
forall a. Ord a => a -> Set a -> Set a
Set.insert (Int
i,Int
j) Set (Int, Int)
set, [Int]
is)
      go (Set (Int, Int)
set,[]  ) (Int
j,Char
']') = String -> m (Set (Int, Int), [Int])
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m (Set (Int, Int), [Int]))
-> String -> m (Set (Int, Int), [Int])
forall a b. (a -> b) -> a -> b
$ String
"unequal brackets in \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BS8.unpack ByteString
s2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" at position: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
j
      go (Set (Int, Int)
set,[Int]
ks  ) (Int
_,Char
'_') = (Set (Int, Int), [Int]) -> m (Set (Int, Int), [Int])
forall (m :: * -> *) a. Monad m => a -> m a
return (Set (Int, Int)
set,[Int]
ks)
  (Set (Int, Int)
set,[Int]
ss) ← ((Set (Int, Int), [Int])
 -> (Int, Char) -> m (Set (Int, Int), [Int]))
-> (Set (Int, Int), [Int])
-> [(Int, Char)]
-> m (Set (Int, Int), [Int])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Set (Int, Int), [Int]) -> (Int, Char) -> m (Set (Int, Int), [Int])
go (Set (Int, Int)
forall a. Set a
Set.empty,[]) ([(Int, Char)] -> m (Set (Int, Int), [Int]))
-> (String -> [(Int, Char)]) -> String -> m (Set (Int, Int), [Int])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
L.zip [Int
0..] (String -> m (Set (Int, Int), [Int]))
-> String -> m (Set (Int, Int), [Int])
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BS8.unpack ByteString
s2
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
ss) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"unequal brackets in \"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BS8.unpack ByteString
s2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\" with opening bracket(s): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show [Int]
ss
  RNAshapepset -> m RNAshapepset
forall (m :: * -> *) a. Monad m => a -> m a
return (RNAshapepset -> m RNAshapepset) -> RNAshapepset -> m RNAshapepset
forall a b. (a -> b) -> a -> b
$ ShapeLevel -> Set (Int, Int) -> RNAshapepset
RNAshapepset ShapeLevel
lvl Set (Int, Int)
set
{-# Inlinable rnashapePairSet #-}

-- | RNA pair set, but a transformation error calls @error@.

rnassPairSet' ∷ RNAshape → RNAshapepset
rnassPairSet' :: RNAshape -> RNAshapepset
rnassPairSet' = (String -> RNAshapepset)
-> (RNAshapepset -> RNAshapepset)
-> Either String RNAshapepset
-> RNAshapepset
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> RNAshapepset
forall a. HasCallStack => String -> a
error RNAshapepset -> RNAshapepset
forall a. a -> a
id (Either String RNAshapepset -> RNAshapepset)
-> (RNAshape -> Either String RNAshapepset)
-> RNAshape
-> RNAshapepset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RNAshape -> Either String RNAshapepset
forall (m :: * -> *).
MonadError String m =>
RNAshape -> m RNAshapepset
rnashapePairSet

-- | Calculates the number of different base pairs betwwen two structures.
--
-- TODO error out on different shape levels

shapePairDist ∷ RNAshapepset → RNAshapepset → Int
shapePairDist :: RNAshapepset -> RNAshapepset -> Int
shapePairDist (RNAshapepset ShapeLevel
lvl1 Set (Int, Int)
p1) (RNAshapepset ShapeLevel
lvl2 Set (Int, Int)
p2) = Set (Int, Int) -> Int
forall a. Set a -> Int
Set.size Set (Int, Int)
z1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Set (Int, Int) -> Int
forall a. Set a -> Int
Set.size Set (Int, Int)
z2
  where i :: Set (Int, Int)
i = Set (Int, Int) -> Set (Int, Int) -> Set (Int, Int)
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set (Int, Int)
p1 Set (Int, Int)
p2
        z1 :: Set (Int, Int)
z1 = Set (Int, Int)
p1 Set (Int, Int) -> Set (Int, Int) -> Set (Int, Int)
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set (Int, Int)
i
        z2 :: Set (Int, Int)
z2 = Set (Int, Int)
p2 Set (Int, Int) -> Set (Int, Int) -> Set (Int, Int)
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Set (Int, Int)
i