{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
module Data.BWT.Internal where
import Control.Monad as CM
import Control.Monad.ST as CMST
import Control.Monad.State.Strict()
import Data.Foldable as DFold
import Data.List as DL
import Data.Maybe as DMaybe (fromJust,isNothing)
import Data.Sequence as DS (Seq(..),empty,findIndexL,fromList,length,index,inits,null,singleton,tails,unstableSortBy,unstableSortOn,zip,(><),(|>),(<|))
import Data.Massiv.Array as DMA
import Data.Massiv.Core()
import Data.STRef as DSTR
import GHC.Generics
import Prelude as P
data Suffix a = Suffix { forall a. Suffix a -> Int
suffixindex :: Int
, forall a. Suffix a -> Int
suffixstartpos :: Int
, forall a. Suffix a -> Maybe (Seq a)
suffix :: Maybe (Seq a)
}
deriving (Int -> Suffix a -> ShowS
forall a. Show a => Int -> Suffix a -> ShowS
forall a. Show a => [Suffix a] -> ShowS
forall a. Show a => Suffix a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Suffix a] -> ShowS
$cshowList :: forall a. Show a => [Suffix a] -> ShowS
show :: Suffix a -> String
$cshow :: forall a. Show a => Suffix a -> String
showsPrec :: Int -> Suffix a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Suffix a -> ShowS
Show,ReadPrec [Suffix a]
ReadPrec (Suffix a)
ReadS [Suffix a]
forall a. Read a => ReadPrec [Suffix a]
forall a. Read a => ReadPrec (Suffix a)
forall a. Read a => Int -> ReadS (Suffix a)
forall a. Read a => ReadS [Suffix a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Suffix a]
$creadListPrec :: forall a. Read a => ReadPrec [Suffix a]
readPrec :: ReadPrec (Suffix a)
$creadPrec :: forall a. Read a => ReadPrec (Suffix a)
readList :: ReadS [Suffix a]
$creadList :: forall a. Read a => ReadS [Suffix a]
readsPrec :: Int -> ReadS (Suffix a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Suffix a)
Read,Suffix a -> Suffix a -> Bool
forall a. Eq a => Suffix a -> Suffix a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Suffix a -> Suffix a -> Bool
$c/= :: forall a. Eq a => Suffix a -> Suffix a -> Bool
== :: Suffix a -> Suffix a -> Bool
$c== :: forall a. Eq a => Suffix a -> Suffix a -> Bool
Eq,Suffix a -> Suffix a -> Bool
Suffix a -> Suffix a -> Ordering
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
forall {a}. Ord a => Eq (Suffix a)
forall a. Ord a => Suffix a -> Suffix a -> Bool
forall a. Ord a => Suffix a -> Suffix a -> Ordering
forall a. Ord a => Suffix a -> Suffix a -> Suffix a
min :: Suffix a -> Suffix a -> Suffix a
$cmin :: forall a. Ord a => Suffix a -> Suffix a -> Suffix a
max :: Suffix a -> Suffix a -> Suffix a
$cmax :: forall a. Ord a => Suffix a -> Suffix a -> Suffix a
>= :: Suffix a -> Suffix a -> Bool
$c>= :: forall a. Ord a => Suffix a -> Suffix a -> Bool
> :: Suffix a -> Suffix a -> Bool
$c> :: forall a. Ord a => Suffix a -> Suffix a -> Bool
<= :: Suffix a -> Suffix a -> Bool
$c<= :: forall a. Ord a => Suffix a -> Suffix a -> Bool
< :: Suffix a -> Suffix a -> Bool
$c< :: forall a. Ord a => Suffix a -> Suffix a -> Bool
compare :: Suffix a -> Suffix a -> Ordering
$ccompare :: forall a. Ord a => Suffix a -> Suffix a -> Ordering
Ord,forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Suffix a) x -> Suffix a
forall a x. Suffix a -> Rep (Suffix a) x
$cto :: forall a x. Rep (Suffix a) x -> Suffix a
$cfrom :: forall a x. Suffix a -> Rep (Suffix a) x
Generic)
type SuffixArray a = Seq (Suffix a)
newtype BWT a = BWT (Seq (Maybe a))
deriving (BWT a -> BWT a -> Bool
forall a. Eq a => BWT a -> BWT a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BWT a -> BWT a -> Bool
$c/= :: forall a. Eq a => BWT a -> BWT a -> Bool
== :: BWT a -> BWT a -> Bool
$c== :: forall a. Eq a => BWT a -> BWT a -> Bool
Eq,BWT a -> BWT a -> Bool
BWT a -> BWT a -> Ordering
BWT a -> BWT a -> BWT a
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
forall {a}. Ord a => Eq (BWT a)
forall a. Ord a => BWT a -> BWT a -> Bool
forall a. Ord a => BWT a -> BWT a -> Ordering
forall a. Ord a => BWT a -> BWT a -> BWT a
min :: BWT a -> BWT a -> BWT a
$cmin :: forall a. Ord a => BWT a -> BWT a -> BWT a
max :: BWT a -> BWT a -> BWT a
$cmax :: forall a. Ord a => BWT a -> BWT a -> BWT a
>= :: BWT a -> BWT a -> Bool
$c>= :: forall a. Ord a => BWT a -> BWT a -> Bool
> :: BWT a -> BWT a -> Bool
$c> :: forall a. Ord a => BWT a -> BWT a -> Bool
<= :: BWT a -> BWT a -> Bool
$c<= :: forall a. Ord a => BWT a -> BWT a -> Bool
< :: BWT a -> BWT a -> Bool
$c< :: forall a. Ord a => BWT a -> BWT a -> Bool
compare :: BWT a -> BWT a -> Ordering
$ccompare :: forall a. Ord a => BWT a -> BWT a -> Ordering
Ord,Int -> BWT a -> ShowS
forall a. Show a => Int -> BWT a -> ShowS
forall a. Show a => [BWT a] -> ShowS
forall a. Show a => BWT a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BWT a] -> ShowS
$cshowList :: forall a. Show a => [BWT a] -> ShowS
show :: BWT a -> String
$cshow :: forall a. Show a => BWT a -> String
showsPrec :: Int -> BWT a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> BWT a -> ShowS
Show,ReadPrec [BWT a]
ReadPrec (BWT a)
ReadS [BWT a]
forall a. Read a => ReadPrec [BWT a]
forall a. Read a => ReadPrec (BWT a)
forall a. Read a => Int -> ReadS (BWT a)
forall a. Read a => ReadS [BWT a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BWT a]
$creadListPrec :: forall a. Read a => ReadPrec [BWT a]
readPrec :: ReadPrec (BWT a)
$creadPrec :: forall a. Read a => ReadPrec (BWT a)
readList :: ReadS [BWT a]
$creadList :: forall a. Read a => ReadS [BWT a]
readsPrec :: Int -> ReadS (BWT a)
$creadsPrec :: forall a. Read a => Int -> ReadS (BWT a)
Read,forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (BWT a) x -> BWT a
forall a x. BWT a -> Rep (BWT a) x
$cto :: forall a x. Rep (BWT a) x -> BWT a
$cfrom :: forall a x. BWT a -> Rep (BWT a) x
Generic)
type BWTMatrix = DMA.Array BN Ix1 String
saToBWT :: SuffixArray a
-> Seq a
-> Seq (Maybe a)
saToBWT :: forall a. SuffixArray a -> Seq a -> Seq (Maybe a)
saToBWT Seq (Suffix a)
DS.Empty Seq a
_ = forall a. Seq a
DS.Empty
saToBWT (Suffix a
y DS.:<| Seq (Suffix a)
ys) Seq a
t =
if | forall a. Suffix a -> Int
suffixstartpos Suffix a
y forall a. Eq a => a -> a -> Bool
/= Int
1
-> (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Int -> a
DS.index Seq a
t (forall a. Suffix a -> Int
suffixstartpos Suffix a
y forall a. Num a => a -> a -> a
- Int
1 forall a. Num a => a -> a -> a
- Int
1))
forall a. a -> Seq a -> Seq a
DS.<| (forall a. SuffixArray a -> Seq a -> Seq (Maybe a)
saToBWT Seq (Suffix a)
ys Seq a
t)
| Bool
otherwise
-> forall a. Maybe a
Nothing
forall a. a -> Seq a -> Seq a
DS.<| (forall a. SuffixArray a -> Seq a -> Seq (Maybe a)
saToBWT Seq (Suffix a)
ys Seq a
t)
createSuffixArray :: Ord a
=> Seq a
-> SuffixArray a
createSuffixArray :: forall a. Ord a => Seq a -> SuffixArray a
createSuffixArray Seq a
xs =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Int
a,Int
b,Seq a
c) -> if | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Seq a -> Bool
DS.null Seq a
c
-> Suffix { suffixindex :: Int
suffixindex = Int
a
, suffixstartpos :: Int
suffixstartpos = Int
b
, suffix :: Maybe (Seq a)
suffix = forall a. a -> Maybe a
Just Seq a
c
}
| Bool
otherwise
-> Suffix { suffixindex :: Int
suffixindex = Int
a
, suffixstartpos :: Int
suffixstartpos = Int
b
, suffix :: Maybe (Seq a)
suffix = forall a. Maybe a
Nothing
}
)
Seq (Int, Int, Seq a)
xsssuffixesfff
where
xsssuffixes :: Seq (Seq a)
xsssuffixes = forall a. Seq a -> Seq (Seq a)
DS.tails Seq a
xs
xsssuffixesf :: Seq (Int, Seq a)
xsssuffixesf = forall a b. Seq a -> Seq b -> Seq (a, b)
DS.zip (forall a. [a] -> Seq a
DS.fromList [Int
1..(forall a. Seq a -> Int
DS.length Seq (Seq a)
xsssuffixes)])
Seq (Seq a)
xsssuffixes
xsssuffixesffsorted :: Seq (Int, Seq a)
xsssuffixesffsorted = forall b a. Ord b => (a -> b) -> Seq a -> Seq a
DS.unstableSortOn forall a b. (a, b) -> b
snd Seq (Int, Seq a)
xsssuffixesf
xsssuffixesfff :: Seq (Int, Int, Seq a)
xsssuffixesfff = (\(Int
a,(Int
b,Seq a
c)) -> (Int
a,Int
b,Seq a
c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall a b. Seq a -> Seq b -> Seq (a, b)
DS.zip (forall a. [a] -> Seq a
DS.fromList [Int
1..(forall a. Seq a -> Int
DS.length Seq (Int, Seq a)
xsssuffixesffsorted)])
Seq (Int, Seq a)
xsssuffixesffsorted
sortTB :: (Ord a1,Ord a2)
=> (a1, a2)
-> (a1, a2)
-> Ordering
sortTB :: forall a1 a2. (Ord a1, Ord a2) => (a1, a2) -> (a1, a2) -> Ordering
sortTB (a1
c1,a2
i1) (a1
c2,a2
i2) = forall a. Ord a => a -> a -> Ordering
compare a1
c1 a1
c2 forall a. Semigroup a => a -> a -> a
<>
forall a. Ord a => a -> a -> Ordering
compare a2
i1 a2
i2
type BWTSeq a = Seq a
type STBWTSeq s a = STRef s (BWTSeq a)
pushSTBWTSeq :: STBWTSeq s a
-> a
-> ST s ()
pushSTBWTSeq :: forall s a. STBWTSeq s a -> a -> ST s ()
pushSTBWTSeq STBWTSeq s a
s a
e = do
BWTSeq a
s2 <- forall s a. STRef s a -> ST s a
readSTRef STBWTSeq s a
s
forall s a. STRef s a -> a -> ST s ()
writeSTRef STBWTSeq s a
s (BWTSeq a
s2 forall a. Seq a -> a -> Seq a
DS.|> a
e)
emptySTBWTSeq :: ST s (STBWTSeq s a)
emptySTBWTSeq :: forall s a. ST s (STBWTSeq s a)
emptySTBWTSeq = forall a s. a -> ST s (STRef s a)
newSTRef forall a. Seq a
DS.empty
type STBWTCounter s a = STRef s Int
updateSTBWTCounter :: STBWTCounter s Int
-> Int
-> ST s ()
updateSTBWTCounter :: forall s. STBWTCounter s Int -> Int -> ST s ()
updateSTBWTCounter STBWTCounter s Int
s Int
e = forall s a. STRef s a -> a -> ST s ()
writeSTRef STBWTCounter s Int
s Int
e
emptySTBWTCounter :: ST s (STBWTCounter s Int)
emptySTBWTCounter :: forall s. ST s (STBWTCounter s Int)
emptySTBWTCounter = forall a s. a -> ST s (STRef s a)
newSTRef (-Int
1)
magicInverseBWT :: Seq (Maybe a,Int)
-> ST s (BWTSeq a)
magicInverseBWT :: forall a s. Seq (Maybe a, Int) -> ST s (BWTSeq a)
magicInverseBWT Seq (Maybe a, Int)
DS.Empty = do
STBWTSeq s a
bwtseqstackempty <- forall s a. ST s (STBWTSeq s a)
emptySTBWTSeq
BWTSeq a
bwtseqstackemptyr <- forall s a. STRef s a -> ST s a
readSTRef STBWTSeq s a
bwtseqstackempty
forall (m :: * -> *) a. Monad m => a -> m a
return BWTSeq a
bwtseqstackemptyr
magicInverseBWT Seq (Maybe a, Int)
xs = do
STBWTSeq s a
bwtseqstack <- forall s a. ST s (STBWTSeq s a)
emptySTBWTSeq
STBWTCounter s Int
bwtcounterstackf <- forall s. ST s (STBWTCounter s Int)
emptySTBWTCounter
STBWTCounter s Int
bwtcounterstacke <- forall s. ST s (STBWTCounter s Int)
emptySTBWTCounter
case (forall a. (a -> Bool) -> Seq a -> Maybe Int
DS.findIndexL (\(Maybe a, Int)
x -> forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (Maybe a, Int)
x) Seq (Maybe a, Int)
xs) of
Maybe Int
Nothing -> do BWTSeq a
bwtseqstackr <- forall s a. STRef s a -> ST s a
readSTRef STBWTSeq s a
bwtseqstack
forall (m :: * -> *) a. Monad m => a -> m a
return BWTSeq a
bwtseqstackr
Just Int
nothingindex -> do let nothingfirst :: (Maybe a, Int)
nothingfirst = forall a. Seq a -> Int -> a
DS.index Seq (Maybe a, Int)
xs
Int
nothingindex
forall s. STBWTCounter s Int -> Int -> ST s ()
updateSTBWTCounter STBWTCounter s Int
bwtcounterstacke
Int
nothingindex
forall s. STBWTCounter s Int -> Int -> ST s ()
updateSTBWTCounter STBWTCounter s Int
bwtcounterstackf
(forall a b. (a, b) -> b
snd (Maybe a, Int)
nothingfirst)
forall {a} {s}.
Seq (Maybe a, Int)
-> STBWTSeq s a -> STRef s Int -> STRef s Int -> ST s ()
iBWT Seq (Maybe a, Int)
xs
STBWTSeq s a
bwtseqstack
STBWTCounter s Int
bwtcounterstackf
STBWTCounter s Int
bwtcounterstacke
BWTSeq a
bwtseqstackr <- forall s a. STRef s a -> ST s a
readSTRef STBWTSeq s a
bwtseqstack
forall (m :: * -> *) a. Monad m => a -> m a
return BWTSeq a
bwtseqstackr
where
iBWT :: Seq (Maybe a, Int)
-> STBWTSeq s a -> STRef s Int -> STRef s Int -> ST s ()
iBWT Seq (Maybe a, Int)
ys STBWTSeq s a
bwtss STRef s Int
bwtcsf STRef s Int
bwtcse = do
Int
cbwtcsf <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
bwtcsf
Int
cbwtcse <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
bwtcse
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
CM.when (Int
cbwtcsf forall a. Eq a => a -> a -> Bool
/= Int
cbwtcse) forall a b. (a -> b) -> a -> b
$ do
let next :: (Maybe a, Int)
next = forall a. Seq a -> Int -> a
DS.index Seq (Maybe a, Int)
ys Int
cbwtcsf
forall s a. STBWTSeq s a -> a -> ST s ()
pushSTBWTSeq STBWTSeq s a
bwtss
(forall a. HasCallStack => Maybe a -> a
DMaybe.fromJust forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (Maybe a, Int)
next)
forall s. STBWTCounter s Int -> Int -> ST s ()
updateSTBWTCounter STRef s Int
bwtcsf
(forall a b. (a, b) -> b
snd (Maybe a, Int)
next)
Seq (Maybe a, Int)
-> STBWTSeq s a -> STRef s Int -> STRef s Int -> ST s ()
iBWT Seq (Maybe a, Int)
ys
STBWTSeq s a
bwtss
STRef s Int
bwtcsf
STRef s Int
bwtcse
createBWTMatrix :: String
-> BWTMatrix
createBWTMatrix :: String -> BWTMatrix
createBWTMatrix String
t =
forall r e. Manifest r e => Comp -> [e] -> Vector r e
DMA.fromList (Word16 -> Comp
ParN Word16
0) [String]
zippedffff :: Array BN Ix1 String
where
zippedffff :: [String]
zippedffff = forall a b. (a -> b) -> [a] -> [b]
DL.map forall (t :: * -> *) a. Foldable t => t a -> [a]
DFold.toList forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
DL.map (\(Maybe (Seq Char)
a,Maybe (Seq Char)
b) -> if | forall a. Maybe a -> Bool
isNothing Maybe (Seq Char)
a
-> forall a. a -> Seq a
DS.singleton Char
'$' forall a. Seq a -> Seq a -> Seq a
DS.><
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq Char)
b
| forall a. Maybe a -> Bool
isNothing Maybe (Seq Char)
b
-> forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq Char)
a forall a. Seq a -> Seq a -> Seq a
DS.><
forall a. a -> Seq a
DS.singleton Char
'$'
| Bool
otherwise
-> forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq Char)
a forall a. Seq a -> Seq a -> Seq a
DS.><
forall a. a -> Seq a
DS.singleton Char
'$' forall a. Seq a -> Seq a -> Seq a
DS.><
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq Char)
b
)
[(Maybe (Seq Char), Maybe (Seq Char))]
zippedfff
zippedfff :: [(Maybe (Seq Char), Maybe (Seq Char))]
zippedfff = forall (t :: * -> *) a. Foldable t => t a -> [a]
DFold.toList Seq (Maybe (Seq Char), Maybe (Seq Char))
zippedff
zippedff :: Seq (Maybe (Seq Char), Maybe (Seq Char))
zippedff = forall a. (a -> a -> Ordering) -> Seq a -> Seq a
DS.unstableSortBy (\(Maybe (Seq Char)
a,Maybe (Seq Char)
_) (Maybe (Seq Char)
c,Maybe (Seq Char)
_) -> forall a. Ord a => a -> a -> Ordering
compare Maybe (Seq Char)
a Maybe (Seq Char)
c)
Seq (Maybe (Seq Char), Maybe (Seq Char))
zippedp
zippedp :: Seq (Maybe (Seq Char), Maybe (Seq Char))
zippedp = forall a b. Seq a -> Seq b -> Seq (a, b)
DS.zip Seq (Maybe (Seq Char))
suffixesf Seq (Maybe (Seq Char))
prefixesf
suffixesf :: Seq (Maybe (Seq Char))
suffixesf = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Seq Char
x -> if | forall a. Seq a -> Bool
DS.null Seq Char
x
-> forall a. Maybe a
Nothing
| Bool
otherwise
-> forall a. a -> Maybe a
Just Seq Char
x
)
Seq (Seq Char)
suffixes
prefixesf :: Seq (Maybe (Seq Char))
prefixesf = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Seq Char
x -> if | forall a. Seq a -> Bool
DS.null Seq Char
x
-> forall a. Maybe a
Nothing
| Bool
otherwise
-> forall a. a -> Maybe a
Just Seq Char
x
)
Seq (Seq Char)
prefixes
suffixes :: Seq (Seq Char)
suffixes = forall a. Seq a -> Seq (Seq a)
DS.tails Seq Char
tseq
prefixes :: Seq (Seq Char)
prefixes = forall a. Seq a -> Seq (Seq a)
DS.inits Seq Char
tseq
tseq :: Seq Char
tseq = forall a. [a] -> Seq a
DS.fromList String
t