{-# LANGUAGE MultiWayIf       #-}
{-# LANGUAGE ViewPatterns     #-}
{-# LANGUAGE Strict           #-}
{-# LANGUAGE DeriveGeneric    #-}
{-# LANGUAGE TypeApplications #-}


-- |
-- Module      :  Data.BWT.Internal
-- Copyright   :  (c) Matthew Mosior 2022
-- License     :  BSD-style
-- Maintainer  :  mattm.github@gmail.com
-- Portability :  portable
--
-- = WARNING
--
-- This module is considered __internal__.
--
-- The Package Versioning Policy __does not apply__.
--
-- The contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
--
-- Authors importing this library are expected to track development
-- closely.
--
-- All credit goes to the author(s)/maintainer(s) of the
-- [containers](https://hackage.haskell.org/package/containers) library
-- for the above warning text.
--
-- = Description
--
-- Various data structures and custom data types to describe the Burrows-Wheeler Transform (BWT)
-- and the Inverse BWT.
--
-- The implementation of the BWT relies upon 'DS.Seq' provided
-- by the [containers](https://hackage.haskell.org/package/containers).
--
-- The internal 'BWTMatrix' data type relies upon the 'DS.Seq' as well.


module Data.BWT.Internal where

import Control.Monad as CM
import Control.Monad.ST as CMST
import Control.Monad.State.Strict()
import Data.Foldable() 
import Data.List()
import Data.Maybe as DMaybe (fromJust,isNothing)
import Data.Sequence as DS (Seq(..),empty,findIndexL,fromList,length,index,inits,null,tails,unstableSortBy,unstableSortOn,zip,(><),(|>),(<|))
import Data.STRef as DSTR
import GHC.Generics
import Prelude as P


{-Base level types.-}

-- | Basic suffix data type.  Used to describe
-- the core data inside of the 'SuffixArray' data type.
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 (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,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,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)

-- | The SuffixArray data type.
-- Uses 'DS.Seq' internally.
type SuffixArray a = Seq (Suffix a)

-- | The BWT data type.
-- Uses 'DS.Seq' internally.
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)

-- | The BWTMatrix data type.
-- Uses a 'DMA.Array' internally.
newtype BWTMatrix a = BWTMatrix (Seq (Seq (Maybe a)))
  deriving (BWTMatrix a -> BWTMatrix a -> Bool
forall a. Eq a => BWTMatrix a -> BWTMatrix a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BWTMatrix a -> BWTMatrix a -> Bool
$c/= :: forall a. Eq a => BWTMatrix a -> BWTMatrix a -> Bool
== :: BWTMatrix a -> BWTMatrix a -> Bool
$c== :: forall a. Eq a => BWTMatrix a -> BWTMatrix a -> Bool
Eq,BWTMatrix a -> BWTMatrix a -> Bool
BWTMatrix a -> BWTMatrix a -> Ordering
BWTMatrix a -> BWTMatrix a -> BWTMatrix 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 (BWTMatrix a)
forall a. Ord a => BWTMatrix a -> BWTMatrix a -> Bool
forall a. Ord a => BWTMatrix a -> BWTMatrix a -> Ordering
forall a. Ord a => BWTMatrix a -> BWTMatrix a -> BWTMatrix a
min :: BWTMatrix a -> BWTMatrix a -> BWTMatrix a
$cmin :: forall a. Ord a => BWTMatrix a -> BWTMatrix a -> BWTMatrix a
max :: BWTMatrix a -> BWTMatrix a -> BWTMatrix a
$cmax :: forall a. Ord a => BWTMatrix a -> BWTMatrix a -> BWTMatrix a
>= :: BWTMatrix a -> BWTMatrix a -> Bool
$c>= :: forall a. Ord a => BWTMatrix a -> BWTMatrix a -> Bool
> :: BWTMatrix a -> BWTMatrix a -> Bool
$c> :: forall a. Ord a => BWTMatrix a -> BWTMatrix a -> Bool
<= :: BWTMatrix a -> BWTMatrix a -> Bool
$c<= :: forall a. Ord a => BWTMatrix a -> BWTMatrix a -> Bool
< :: BWTMatrix a -> BWTMatrix a -> Bool
$c< :: forall a. Ord a => BWTMatrix a -> BWTMatrix a -> Bool
compare :: BWTMatrix a -> BWTMatrix a -> Ordering
$ccompare :: forall a. Ord a => BWTMatrix a -> BWTMatrix a -> Ordering
Ord,Int -> BWTMatrix a -> ShowS
forall a. Show a => Int -> BWTMatrix a -> ShowS
forall a. Show a => [BWTMatrix a] -> ShowS
forall a. Show a => BWTMatrix a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BWTMatrix a] -> ShowS
$cshowList :: forall a. Show a => [BWTMatrix a] -> ShowS
show :: BWTMatrix a -> String
$cshow :: forall a. Show a => BWTMatrix a -> String
showsPrec :: Int -> BWTMatrix a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> BWTMatrix a -> ShowS
Show,ReadPrec [BWTMatrix a]
ReadPrec (BWTMatrix a)
ReadS [BWTMatrix a]
forall a. Read a => ReadPrec [BWTMatrix a]
forall a. Read a => ReadPrec (BWTMatrix a)
forall a. Read a => Int -> ReadS (BWTMatrix a)
forall a. Read a => ReadS [BWTMatrix a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BWTMatrix a]
$creadListPrec :: forall a. Read a => ReadPrec [BWTMatrix a]
readPrec :: ReadPrec (BWTMatrix a)
$creadPrec :: forall a. Read a => ReadPrec (BWTMatrix a)
readList :: ReadS [BWTMatrix a]
$creadList :: forall a. Read a => ReadS [BWTMatrix a]
readsPrec :: Int -> ReadS (BWTMatrix a)
$creadsPrec :: forall a. Read a => Int -> ReadS (BWTMatrix a)
Read,forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (BWTMatrix a) x -> BWTMatrix a
forall a x. BWTMatrix a -> Rep (BWTMatrix a) x
$cto :: forall a x. Rep (BWTMatrix a) x -> BWTMatrix a
$cfrom :: forall a x. BWTMatrix a -> Rep (BWTMatrix a) x
Generic)

{-------------------}


{-toBWT functions.-}

-- | Computes the Burrows-Wheeler Transform (BWT) using the suffix array
-- and the original string (represented as a 'DS.Seq' for performance).
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)

-- | Computes the corresponding 'SuffixArray' of a given string. Please see [suffix array](https://en.wikipedia.org/wiki/Suffix_array)
-- for more information. 
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

{------------------}


{-fromBWT functions.-}

-- | Hierarchical sorting scheme that compares fst first then snd.
-- Necessary for the setting up the BWT in order to correctly
-- invert it using the [Magic](https://www.youtube.com/watch?v=QwSsppKrCj4) algorithm.
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

-- | Abstract BWTSeq type utilizing a 'DS.Seq'.
type BWTSeq a = Seq a

-- | Abstract data type representing a BWTSeq in the (strict) ST monad.
type STBWTSeq s a = STRef s (BWTSeq a)

-- | State function to push BWTString data into stack.
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)

-- | State function to create empty STBWTString type.
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

-- | Abstract BWTCounter and associated state type.
type STBWTCounter s a = STRef s Int

-- | State function to update BWTCounter.
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

-- | State function to create empty STBWTCounter type.
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)

-- | "Magic" Inverse BWT function.
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

-- | Simple yet efficient implementation of converting a given string
-- into a BWT Matrix (the BWTMatrix type is a 'DS.Seq' ('Maybe' a).
createBWTMatrix :: Ord a
                => [a]
                -> BWTMatrix a
createBWTMatrix :: forall a. Ord a => [a] -> BWTMatrix a
createBWTMatrix [a]
t =
  forall a. Seq (Seq (Maybe a)) -> BWTMatrix a
BWTMatrix (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Maybe (Seq a)
a,Maybe (Seq a)
b) -> if | forall a. Maybe a -> Bool
isNothing Maybe (Seq a)
a
                                -> forall a. Maybe a
Nothing forall a. a -> Seq a -> Seq a
DS.<|
                                   (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> forall a. a -> Maybe a
Just a
x) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq a)
b)
                                | forall a. Maybe a -> Bool
isNothing Maybe (Seq a)
b
                                -> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> forall a. a -> Maybe a
Just a
x) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq a)
a) forall a. Seq a -> a -> Seq a
DS.|>
                                   forall a. Maybe a
Nothing
                                | Bool
otherwise
                                -> ((forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> forall a. a -> Maybe a
Just a
x) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq a)
a) forall a. Seq a -> a -> Seq a
DS.|> forall a. Maybe a
Nothing) forall a. Seq a -> Seq a -> Seq a
DS.><
                                   (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
x -> forall a. a -> Maybe a
Just a
x) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Seq a)
b)
                  ) Seq (Maybe (Seq a), Maybe (Seq a))
zippedf)
    where
      zippedf :: Seq (Maybe (Seq a), Maybe (Seq a))
zippedf    = forall a. (a -> a -> Ordering) -> Seq a -> Seq a
DS.unstableSortBy (\(Maybe (Seq a)
a,Maybe (Seq a)
_) (Maybe (Seq a)
c,Maybe (Seq a)
_) -> forall a. Ord a => a -> a -> Ordering
compare Maybe (Seq a)
a Maybe (Seq a)
c)
                   Seq (Maybe (Seq a), Maybe (Seq a))
zippedp
      zippedp :: Seq (Maybe (Seq a), Maybe (Seq a))
zippedp    = forall a b. Seq a -> Seq b -> Seq (a, b)
DS.zip Seq (Maybe (Seq a))
suffixesf Seq (Maybe (Seq a))
prefixesf
      suffixesf :: Seq (Maybe (Seq a))
suffixesf  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Seq a
x -> if | forall a. Seq a -> Bool
DS.null Seq a
x
                                  -> forall a. Maybe a
Nothing
                                  | Bool
otherwise
                                  -> forall a. a -> Maybe a
Just Seq a
x
                        )
                   Seq (Seq a)
suffixes
      prefixesf :: Seq (Maybe (Seq a))
prefixesf  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Seq a
x -> if | forall a. Seq a -> Bool
DS.null Seq a
x
                                  -> forall a. Maybe a
Nothing
                                  | Bool
otherwise
                                  -> forall a. a -> Maybe a
Just Seq a
x
                        )
                   Seq (Seq a)
prefixes
      suffixes :: Seq (Seq a)
suffixes   = forall a. Seq a -> Seq (Seq a)
DS.tails Seq a
tseq
      prefixes :: Seq (Seq a)
prefixes   = forall a. Seq a -> Seq (Seq a)
DS.inits Seq a
tseq
      tseq :: Seq a
tseq       = forall a. [a] -> Seq a
DS.fromList [a]
t

{--------------------}