diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -47,3 +47,7 @@ ## 0.1.0.11 -- 2022-11-16 * Adding more documentation for RLE and MTF implementations. + +## 0.1.0.12 -- 2022-11-23 + +* Added Full-text Minute-space index (FM-index) implementation. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -13,7 +13,7 @@ disclaimer in the documentation and/or other materials provided with the distribution. - * Neither the name of Matthew-Mosior nor the names of other + * Neither the name of Matthew Mosior nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. diff --git a/src/Data/BWT.hs b/src/Data/BWT.hs --- a/src/Data/BWT.hs +++ b/src/Data/BWT.hs @@ -16,7 +16,7 @@ -- The two functions that most users will utilize are 'toBWT' and 'fromBWT'. -- There are auxilary function(s) inside of @"Data.BWT.Internal"@. -- --- The helper functions for ByteString, 'bytestringToBWT', 'bytestringFromWord8BWT' , 'bytestringFromByteStringBWT' and Text, 'textToBWT' and 'textFromBWT' should help for common use cases. +-- The helper functions for ByteString, 'bytestringToBWT', 'bytestringFromWord8BWT', 'bytestringFromByteStringBWT' and Text, 'textToBWT' and 'textFromBWT' should help for common use cases. -- -- @"Data.BWT.Internal"@ also has the function 'createBWTMatrix', which can be useful as well, although not used by either 'toBWT' or 'fromBWT'. diff --git a/src/Data/BWT/Internal.hs b/src/Data/BWT/Internal.hs --- a/src/Data/BWT/Internal.hs +++ b/src/Data/BWT/Internal.hs @@ -36,7 +36,7 @@ -- 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 [massiv](https://hackage.haskell.org/package/massiv) package. +-- The internal 'BWTMatrix' data type relies upon the 'DS.Seq' as well. module Data.BWT.Internal where @@ -44,12 +44,10 @@ 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.Foldable() +import Data.List() 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.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 @@ -63,7 +61,7 @@ , suffixstartpos :: Int , suffix :: Maybe (Seq a) } - deriving (Show,Read,Eq,Ord,Generic) + deriving (Eq,Ord,Show,Read,Generic) -- | The SuffixArray data type. -- Uses 'DS.Seq' internally. @@ -74,10 +72,10 @@ newtype BWT a = BWT (Seq (Maybe a)) deriving (Eq,Ord,Show,Read,Generic) - -- | The BWTMatrix data type. -- Uses a 'DMA.Array' internally. -type BWTMatrix = DMA.Array BN Ix1 String +newtype BWTMatrix a = BWTMatrix (Seq (Seq (Maybe a))) + deriving (Eq,Ord,Show,Read,Generic) {-------------------} @@ -214,27 +212,23 @@ bwtcse -- | Simple yet efficient implementation of converting a given string --- into a BWT Matrix (the BWTMatrix type is a 'DMA.Array'). -createBWTMatrix :: String - -> BWTMatrix +-- into a BWT Matrix (the BWTMatrix type is a 'DS.Seq' ('Maybe' a). +createBWTMatrix :: Ord a + => [a] + -> BWTMatrix a createBWTMatrix t = - DMA.fromList (ParN 0) zippedffff :: Array BN Ix1 String + BWTMatrix (fmap (\(a,b) -> if | isNothing a + -> Nothing DS.<| + (fmap (\x -> Just x) $ fromJust b) + | isNothing b + -> (fmap (\x -> Just x) $ fromJust a) DS.|> + Nothing + | otherwise + -> ((fmap (\x -> Just x) $ fromJust a) DS.|> Nothing) DS.>< + (fmap (\x -> Just x) $ fromJust b) + ) zippedf) where - zippedffff = DL.map DFold.toList $ - DL.map (\(a,b) -> if | isNothing a - -> DS.singleton '$' DS.>< - fromJust b - | isNothing b - -> fromJust a DS.>< - DS.singleton '$' - | otherwise - -> fromJust a DS.>< - DS.singleton '$' DS.>< - fromJust b - ) - zippedfff - zippedfff = DFold.toList zippedff - zippedff = DS.unstableSortBy (\(a,_) (c,_) -> compare a c) + zippedf = DS.unstableSortBy (\(a,_) (c,_) -> compare a c) zippedp zippedp = DS.zip suffixesf prefixesf suffixesf = fmap (\x -> if | DS.null x diff --git a/src/Data/FMIndex.hs b/src/Data/FMIndex.hs new file mode 100644 --- /dev/null +++ b/src/Data/FMIndex.hs @@ -0,0 +1,353 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE Strict #-} + + +-- | +-- Module : Data.FMIndex +-- Copyright : (c) Matthew Mosior 2022 +-- License : BSD-style +-- Maintainer : mattm.github@gmail.com +-- Portability : portable +-- +-- = Full-text Minute-space index (FM-index) +-- +-- Users will get the most mileage by first compressing to a 'BWT' +-- on the initial 'ByteString' or 'Text' input before compressing to +-- a 'FMIndexB' or 'FMIndexT'. +-- +-- To do this, users can use the 'bytestringToBWTToFMIndexB' and 'bytestringToBWTToFMIndexT' functions, +-- as well as the 'textToBWTToFMIndexB' and 'textToBWTToFMIndexT' functions. +-- +-- The base functions for 'ByteString', 'bytestringToFMIndexB' and 'bytestringToFMIndexT' can be used to +-- convert a 'Seq' ('Maybe' 'ByteString') to a 'FMIndexB' and 'FMIndexT', respectively. +-- +-- Likewise, the base functions for 'Text', 'textToFMIndexB' and 'textToFMIndexT' can be used to +-- convert a 'Seq' ('Maybe' 'Text') to a 'FMIndexB' and 'FMIndexT' respectively. +-- +-- There are various other lower-level functions for interacting with the FMIndex implementation on 'ByteString' and 'Text' as well. +-- +-- @"Data.FMIndex.Internal"@ contains efficient and stateful implementations of the FMIndex and Inverse FMIndex algorithms. + + +module Data.FMIndex ( -- * To FMIndex functions + bytestringToBWTToFMIndexB, + bytestringToBWTToFMIndexT, + textToBWTToFMIndexB, + textToBWTToFMIndexT, + textBWTToFMIndexB, + bytestringBWTToFMIndexB, + textBWTToFMIndexT, + bytestringBWTToFMIndexT, + textToFMIndexB, + bytestringToFMIndexB, + textToFMIndexT, + bytestringToFMIndexT, + -- * From FMIndex functions + bytestringFromBWTFromFMIndexB, + bytestringFromBWTFromFMIndexT, + textFromBWTFromFMIndexB, + textFromBWTFromFMIndexT, + textBWTFromFMIndexT, + bytestringBWTFromFMIndexT, + textBWTFromFMIndexB, + bytestringBWTFromFMIndexB, + textFromFMIndexB, + bytestringFromFMIndexB, + textFromFMIndexT, + bytestringFromFMIndexT + ) where + +import Data.BWT +import Data.BWT.Internal +import Data.FMIndex.Internal + +import Control.Monad() +import Control.Monad.ST as CMST +import Control.Monad.State.Strict() +import Data.ByteString as BS +import Data.ByteString.Char8() +import Data.Char() +import Data.Foldable() +import Data.Maybe as DMaybe (isNothing,fromJust) +import Data.Sequence as DS (Seq(..)) +import Data.STRef() +import Data.Text as DText +import Data.Text.Encoding as DTE (decodeUtf8,encodeUtf8) +import Data.Word (Word8) +import Prelude as P + + +{-toFMIndex Function(s)-} + +-- | Helper function for converting a 'ByteString' +-- to a 'FMIndexB' via a 'BWT' first. +bytestringToBWTToFMIndexB :: ByteString -> + FMIndexB +bytestringToBWTToFMIndexB = bytestringBWTToFMIndexB . bytestringToBWT + +-- | Helper function for converting a 'ByteString' +-- to a 'FMIndexT' via a 'BWT' first. +bytestringToBWTToFMIndexT :: ByteString -> + FMIndexT +bytestringToBWTToFMIndexT = bytestringBWTToFMIndexT . bytestringToBWT + +-- | Helper function for converting a 'Text' +-- to a 'FMIndexB' via a 'BWT' first. +textToBWTToFMIndexB :: Text -> + FMIndexB +textToBWTToFMIndexB = textBWTToFMIndexB . textToBWT + +-- | Helper function for converting a 'Text' +-- to a 'FMIndexT' via a 'BWT' first. +textToBWTToFMIndexT :: Text -> + FMIndexT +textToBWTToFMIndexT = textBWTToFMIndexT . textToBWT + +-- | Take a 'BWT' of 'Word8's and generate the +-- FM-index ('FMIndexB'). +textBWTToFMIndexB :: TextBWT + -> FMIndexB +textBWTToFMIndexB xs = + FMIndexB (CMST.runST $ seqToFMIndexB xss) + where + xss = fmap (\x -> if | isNothing x + -> Nothing + | otherwise + -> Just $ + BS.singleton $ + fromJust x + ) + ((\(BWT t) -> t) $ + ((\(TextBWT t) -> t) xs)) + +-- | Take a 'BWT' of 'Word8's and generate the +-- FM-index ('FMIndexB'). +bytestringBWTToFMIndexB :: BWT Word8 + -> FMIndexB +bytestringBWTToFMIndexB xs = + FMIndexB (CMST.runST $ seqToFMIndexB xss) + where + xss = fmap (\x -> if | isNothing x + -> Nothing + | otherwise + -> Just $ + BS.singleton $ + fromJust x + ) + ((\(BWT t) -> t) xs) + +-- | Take a 'BWT' of 'Word8's and generate the +-- FM-index ('FMIndexB'). +textBWTToFMIndexT :: TextBWT + -> FMIndexT +textBWTToFMIndexT xs = + FMIndexT (CMST.runST $ seqToFMIndexT xss) + where + xss = fmap (\x -> if | isNothing x + -> Nothing + | otherwise + -> Just $ + DTE.decodeUtf8 $ + BS.singleton $ + fromJust x + ) + ((\(BWT t) -> t) $ + ((\(TextBWT t) -> t) xs)) + +-- | Take a 'BWT' of 'Word8's and generate the +-- FM-index ('FMIndexT'). +bytestringBWTToFMIndexT :: BWT Word8 + -> FMIndexT +bytestringBWTToFMIndexT xs = + FMIndexT (CMST.runST $ seqToFMIndexT xss) + where + xss = fmap (\x -> if | isNothing x + -> Nothing + | otherwise + -> Just $ + DTE.decodeUtf8 $ + BS.singleton $ + fromJust x + ) + ((\(BWT t) -> t) xs) + +-- | Takes a 'Text' and returns the FM-index ('FMIndexB'). +textToFMIndexB :: Seq (Maybe Text) + -> FMIndexB +textToFMIndexB DS.Empty = FMIndexB DS.Empty +textToFMIndexB xs = + FMIndexB (CMST.runST $ seqToFMIndexB xss) + where + xss = fmap (\x -> if | isNothing x + -> Nothing + | otherwise + -> Just $ + DTE.encodeUtf8 $ + fromJust x + ) + xs + +-- | Takes a 'Seq' of 'ByteString's and returns the FM-index ('FMIndexB'). +bytestringToFMIndexB :: Seq (Maybe ByteString) + -> FMIndexB +bytestringToFMIndexB DS.Empty = FMIndexB DS.Empty +bytestringToFMIndexB xs = + FMIndexB (CMST.runST $ seqToFMIndexB xs) + +-- | Takes a 'Text' and returns the FM-index ('FMIndexT'). +textToFMIndexT :: Seq (Maybe Text) + -> FMIndexT +textToFMIndexT DS.Empty = FMIndexT DS.Empty +textToFMIndexT xs = + FMIndexT (CMST.runST $ seqToFMIndexT xs) + +-- | Takes a 'ByteString' and returns the FM-index ('FMIndexT'). +bytestringToFMIndexT :: Seq (Maybe ByteString) + -> FMIndexT +bytestringToFMIndexT DS.Empty = FMIndexT DS.Empty +bytestringToFMIndexT xs = + FMIndexT (CMST.runST $ seqToFMIndexT xss) + where + xss = fmap (\x -> if | isNothing x + -> Nothing + | otherwise + -> Just $ + DTE.decodeUtf8 $ + fromJust x + ) + xs + +{-----------------------} + + +{-fromFMIndex function(s)-} + +-- | Helper function for converting a 'BWT'ed 'FMIndexB' +-- back to the original 'ByteString'. +bytestringFromBWTFromFMIndexB :: FMIndexB + -> ByteString +bytestringFromBWTFromFMIndexB = bytestringFromByteStringBWT . bytestringBWTFromFMIndexB + +-- | Helper function for converting a 'BWT'ed 'FMIndexT' +-- back to the original 'ByteString'. +bytestringFromBWTFromFMIndexT :: FMIndexT + -> ByteString +bytestringFromBWTFromFMIndexT xs = bytestringFromByteStringBWT $ + BWT $ + fmap (\x -> if | isNothing x + -> Nothing + | otherwise + -> Just $ + DTE.encodeUtf8 $ + fromJust x + ) + $ + ((\(BWT t) -> t) (textBWTFromFMIndexT xs)) + +-- | Helper function for converting a 'BWT'ed 'FMIndexB' +-- back to the original 'Text'. +textFromBWTFromFMIndexB :: FMIndexB + -> Text +textFromBWTFromFMIndexB = DTE.decodeUtf8 . bytestringFromByteStringBWT . bytestringBWTFromFMIndexB + +-- | Helper function for converting a 'BWT'ed 'FMIndexT' +-- back to the original 'Text'. +textFromBWTFromFMIndexT :: FMIndexT + -> Text +textFromBWTFromFMIndexT = DTE.decodeUtf8 . bytestringFromByteStringBWT . bytestringBWTFromFMIndexT + +-- | Takes a 'FMIndexT' and returns +-- the 'BWT' of 'Text's. +textBWTFromFMIndexT :: FMIndexT + -> BWT Text +textBWTFromFMIndexT (FMIndexT DS.Empty) = BWT DS.Empty +textBWTFromFMIndexT xs = + BWT (seqFromFMIndexT xs) + +-- | Takes a 'FMIndexT' and returns +-- the 'BWT' of 'ByteString's. +bytestringBWTFromFMIndexT :: FMIndexT + -> BWT ByteString +bytestringBWTFromFMIndexT (FMIndexT DS.Empty) = BWT DS.Empty +bytestringBWTFromFMIndexT xs = do + let originalbwtb = seqFromFMIndexT xs + BWT (fmap (\x -> if | isNothing x + -> Nothing + | otherwise + -> Just $ + DTE.encodeUtf8 $ + fromJust x + ) originalbwtb) + +-- | Takes a 'FMIndexB' and returns +-- the 'BWT' of 'Text's. +textBWTFromFMIndexB :: FMIndexB + -> BWT Text +textBWTFromFMIndexB (FMIndexB DS.Empty) = BWT DS.Empty +textBWTFromFMIndexB xs = do + let originalbwtt = seqFromFMIndexB xs + BWT (fmap (\x -> if | isNothing x + -> Nothing + | otherwise + -> Just $ + DTE.decodeUtf8 $ + fromJust x + ) originalbwtt) + +-- | Take a 'FMIndexB' and returns +-- the 'BWT' of 'ByteString's. +bytestringBWTFromFMIndexB :: FMIndexB + -> BWT ByteString +bytestringBWTFromFMIndexB (FMIndexB DS.Empty) = BWT DS.Empty +bytestringBWTFromFMIndexB xs = + BWT (seqFromFMIndexB xs) + +-- | Takes a 'FMIndexB' and returns +-- the original 'Seq' of 'Text's. +textFromFMIndexB :: FMIndexB + -> Seq (Maybe Text) +textFromFMIndexB (FMIndexB DS.Empty) = DS.Empty +textFromFMIndexB xs = do + let originalt = seqFromFMIndexB xs + fmap (\x -> if | isNothing x + -> Nothing + | otherwise + -> Just $ + DTE.decodeUtf8 $ + fromJust x + ) originalt + +-- | Takes a 'FMIndexB' and returns +-- the original 'Seq' of 'ByteString's. +bytestringFromFMIndexB :: FMIndexB + -> Seq (Maybe ByteString) +bytestringFromFMIndexB (FMIndexB DS.Empty) = DS.Empty +bytestringFromFMIndexB xs = + seqFromFMIndexB xs + +-- | Takes a 'FMIndexT' and returns +-- the original 'Seq' of 'Text's. +textFromFMIndexT :: FMIndexT + -> Seq (Maybe Text) +textFromFMIndexT (FMIndexT DS.Empty) = DS.Empty +textFromFMIndexT xs = + seqFromFMIndexT xs + +-- | Takes a 'FMIndexT' and returns +-- the original 'Seq' of 'ByteString's. +bytestringFromFMIndexT :: FMIndexT + -> Seq (Maybe ByteString) +bytestringFromFMIndexT (FMIndexT DS.Empty) = DS.Empty +bytestringFromFMIndexT xs = do + let originalb = seqFromFMIndexT xs + fmap (\x -> if | isNothing x + -> Nothing + | otherwise + -> Just $ + DTE.encodeUtf8 $ + fromJust x + ) originalb + +{-------------------------} diff --git a/src/Data/FMIndex/Internal.hs b/src/Data/FMIndex/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Data/FMIndex/Internal.hs @@ -0,0 +1,379 @@ +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE Strict #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeApplications #-} + + +-- | +-- Module : Data.FMIndex.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 +-- [Full-text Minute-space index (FM-index)](https://en.wikipedia.org/wiki/FM-index) +-- and the Inverse FM-index implementations, namely 'seqToFMIndexB', 'seqToFMIndexT', 'seqFromFMIndexB', and 'seqFromFMIndexT'. +-- +-- The FM-index implementations rely heavily upon 'Seq' provided by the [containers](https://hackage.haskell.org/package/containers), +-- 'STRef' and associated functions in the [stref](https://hackage.haskell.org/package/base-4.17.0.0/docs/Data-STRef.html) library, +-- and 'runST' in the [Control.Monad.ST](https://hackage.haskell.org/package/base-4.17.0.0/docs/Control-Monad-ST.html) library. + + +module Data.FMIndex.Internal where + +import Data.BWT.Internal() +import Data.MTF.Internal + +import Control.Monad as CM +import Control.Monad.ST as CMST +import Control.Monad.State.Strict() +import Data.ByteString as BS +import Data.ByteString.Char8() +import Data.ByteString.Internal() +import Data.Foldable() +import Data.List() +import Data.Maybe() +import Data.Sequence as DS (Seq(..),empty,(|>)) +import Data.STRef as DSTR +import Data.Text as DText +import GHC.Generics (Generic) +import Prelude as P + + +{-Base level types.-} + +-- | Basic FMIndex ('ByteString') data type. +newtype FMIndexB = FMIndexB (Seq (Maybe ByteString,Seq (Int,Int,Maybe ByteString))) + deriving (Eq,Ord,Show,Read,Generic) + +-- | Basic FMIndex ('Text') data type. +newtype FMIndexT = FMIndexT (Seq (Maybe Text,Seq (Int,Int,Maybe Text))) + deriving (Eq,Ord,Show,Read,Generic) + +{-------------------} + + +{-toFMIndex (ByteString) functions.-} + +-- | Abstract 'PBFMIndexSeqB' type utilizing a 'Seq'. +type PBFMIndexSeqB = Seq (Maybe ByteString) + +-- | Abstract 'FMIndexSeqB' type utilizing a 'Seq'. +-- (c,(indexofinputcurrentelement,Occ(c,k),inputcurrentelement)) +-- Please see [this](https://en.wikipedia.org/wiki/FM-index) +-- for an explanation of the above abbreviations. +type FMIndexSeqB = Seq (Maybe ByteString,Seq (Int,Int,Maybe ByteString)) + +-- | Abstract data type representing a 'FMIndexSeqB' in the (strict) ST monad. +type STFMIndexSeqB s a = STRef s FMIndexSeqB + +-- | State function to update 'FMIndexSeqB' +-- with each step of the FMIndex. +updateSTFMIndexSeqAB :: STFMIndexSeqB s (Seq (Maybe ByteString,Seq (Int,Int,Maybe ByteString))) + -> (Int,Int,Maybe ByteString) + -> ST s () +updateSTFMIndexSeqAB s e = do + (s2 DS.:|> s2fm) <- readSTRef s + writeSTRef s (s2 DS.|> (((\(a,_) -> a) s2fm),((\(_,b) -> b) s2fm) DS.|> e)) + +-- | State function to update 'FMIndexSeqB' +-- with each step of the FMIndex. +updateSTFMIndexSeqBB :: STFMIndexSeqB s (Seq (Maybe ByteString,Seq (Int,Int,Maybe ByteString))) + -> Maybe ByteString + -> ST s () +updateSTFMIndexSeqBB s e = do + s2 <- readSTRef s + writeSTRef s (s2 DS.|> (e,DS.empty)) + +-- | State function to create empty 'STFMIndexSeqB' type. +emptySTFMIndexSeqB :: ST s (STFMIndexSeqB s a) +emptySTFMIndexSeqB = newSTRef DS.empty + +-- | Abstract 'STFMIndexILB' and associated state type. +type STFMIndexILB s a = STRef s (Seq (Maybe ByteString)) + +-- | State function to load list into 'STFMIndexILB'. +loadSTFMIndexILB :: STMTFILB s (Maybe ByteString) + -> Seq (Maybe ByteString) + -> ST s () +loadSTFMIndexILB s e = writeSTRef s e + +-- | State function to create empty 'STFMIndexILB' type. +emptySTFMIndexILB :: ST s (STFMIndexILB s a) +emptySTFMIndexILB = newSTRef DS.empty + +-- | Abstract 'STFMIndexCounterB' and associated state type. +type STFMIndexCounterB s a = STRef s Int + +-- | State function to update 'STFMIndexCounterB'. +updateSTFMIndexCounterB :: STFMIndexCounterB s Int + -> Int + -> ST s () +updateSTFMIndexCounterB s e = writeSTRef s e + +-- | State function to create empty 'STFMIndexCounterB' type. +emptySTFMIndexCounterB :: ST s (STFMIndexCounterB s Int) +emptySTFMIndexCounterB = newSTRef 0 + +-- | Strict state monad function. +seqToFMIndexB :: PBFMIndexSeqB + -> ST s FMIndexSeqB +seqToFMIndexB DS.Empty = do + bfmiseqstackempty <- emptySTFMIndexSeqB + bfmiseqstackemptyr <- readSTRef bfmiseqstackempty + return bfmiseqstackemptyr +seqToFMIndexB xs = do + bfmiseqstack <- emptySTFMIndexSeqB + bfmiinitiallist <- emptySTFMIndexILB + bfmicounterstack <- emptySTFMIndexCounterB + let il = nubSeq' xs + loadSTFMIndexILB bfmiinitiallist + il + cbfmiinitiallist <- readSTRef bfmiinitiallist + iFMIndexB cbfmiinitiallist + xs + bfmiseqstack + bfmicounterstack + bfmiseqstackr <- readSTRef bfmiseqstack + return bfmiseqstackr + where + iFMIndexB DS.Empty _ _ _ = pure () + iFMIndexB (y DS.:<| ys) zs bfmiss bfmics = do + bfmiis <- emptySTFMIndexCounterB + updateSTFMIndexCounterB bfmiis + 1 + updateSTFMIndexSeqBB bfmiss + y + iiFMIndexB y + zs + bfmiss + bfmiis + bfmics + iFMIndexB ys + zs + bfmiss + bfmics + iiFMIndexB _ DS.Empty _ _ bfmics = do + updateSTFMIndexCounterB bfmics + 0 + pure () + iiFMIndexB as (b DS.:<| bs) bfmiss bfmiis bfmics = do + cbfmiis <- readSTRef bfmiis + cbfmics <- readSTRef bfmics + if | as == b + -> do updateSTFMIndexSeqAB bfmiss + (cbfmiis,cbfmics + 1,b) + updateSTFMIndexCounterB bfmics + (cbfmics + 1) + updateSTFMIndexCounterB bfmiis + (cbfmiis + 1) + iiFMIndexB as + bs + bfmiss + bfmiis + bfmics + | otherwise + -> do updateSTFMIndexSeqAB bfmiss + (cbfmiis,cbfmics,b) + updateSTFMIndexCounterB bfmiis + (cbfmiis + 1) + iiFMIndexB as + bs + bfmiss + bfmiis + bfmics + +{-----------------------------------} + + +{-toFMIndex (Text) functions.-} + +-- | Abstract 'PTFMIndexSeqT' type utilizing a 'Seq'. +type PTFMIndexSeqT = Seq (Maybe Text) + +-- | Abstract 'FMIndexSeqT' type utilizing a 'Seq'. +-- (c,(indexofinputcurrentelement,Occ(c,k),inputcurrentelement)) +-- Please see [this](https://en.wikipedia.org/wiki/FM-index) +-- for an explanation of the above abbreviations. +type FMIndexSeqT = Seq (Maybe Text,Seq (Int,Int,Maybe Text)) + +-- | Abstract data type representing a 'FMIndexSeqT' in the (strict) ST monad. +type STFMIndexSeqT s a = STRef s FMIndexSeqT + +-- | State function to update 'FMIndexSeqT' +-- with each step of the FMIndex. +updateSTFMIndexSeqAT :: STFMIndexSeqT s (Seq (Maybe Text,Seq (Int,Int,Maybe Text))) + -> (Int,Int,Maybe Text) + -> ST s () +updateSTFMIndexSeqAT s e = do + (s2 DS.:|> s2fm) <- readSTRef s + writeSTRef s (s2 DS.|> (((\(a,_) -> a) s2fm),((\(_,b) -> b) s2fm) DS.|> e)) + +-- | State function to update 'FMIndexSeqT' +-- with each step of the FMIndex. +updateSTFMIndexSeqBT :: STFMIndexSeqT s (Seq (Maybe Text,Seq (Int,Int,Maybe Text))) + -> Maybe Text + -> ST s () +updateSTFMIndexSeqBT s e = do + s2 <- readSTRef s + writeSTRef s (s2 DS.|> (e,DS.empty)) + +-- | State function to create empty 'STFMIndexSeqT' type. +emptySTFMIndexSeqT :: ST s (STFMIndexSeqT s a) +emptySTFMIndexSeqT = newSTRef DS.empty + +-- | Abstract 'STFMIndexILT' and associated state type. +type STFMIndexILT s a = STRef s (Seq (Maybe Text)) + +-- | State function to load list into 'STFMIndexILT'. +loadSTFMIndexILT :: STMTFILT s (Maybe Text) + -> Seq (Maybe Text) + -> ST s () +loadSTFMIndexILT s e = writeSTRef s e + +-- | State function to create empty 'STFMIndexILT' type. +emptySTFMIndexILT :: ST s (STFMIndexILT s a) +emptySTFMIndexILT = newSTRef DS.empty + +-- | Abstract 'STFMIndexCounterT' and associated state type. +type STFMIndexCounterT s a = STRef s Int + +-- | State function to update 'STFMIndexCounterT'. +updateSTFMIndexCounterT :: STFMIndexCounterT s Int + -> Int + -> ST s () +updateSTFMIndexCounterT s e = writeSTRef s e + +-- | State function to create empty 'STFMIndexCounterT' type. +emptySTFMIndexCounterT :: ST s (STFMIndexCounterT s Int) +emptySTFMIndexCounterT = newSTRef 0 + +-- | Strict state monad function. +seqToFMIndexT :: PTFMIndexSeqT + -> ST s FMIndexSeqT +seqToFMIndexT DS.Empty = do + tfmiseqstackempty <- emptySTFMIndexSeqT + tfmiseqstackemptyr <- readSTRef tfmiseqstackempty + return tfmiseqstackemptyr +seqToFMIndexT xs = do + tfmiseqstack <- emptySTFMIndexSeqT + tfmiinitiallist <- emptySTFMIndexILT + tfmicounterstack <- emptySTFMIndexCounterT + let il = nubSeq' xs + loadSTFMIndexILT tfmiinitiallist + il + ctfmiinitiallist <- readSTRef tfmiinitiallist + iFMIndexT ctfmiinitiallist + xs + tfmiseqstack + tfmicounterstack + tfmiseqstackr <- readSTRef tfmiseqstack + return tfmiseqstackr + where + iFMIndexT DS.Empty _ _ _ = pure () + iFMIndexT (y DS.:<| ys) zs tfmiss tfmics = do + tfmiis <- emptySTFMIndexCounterT + updateSTFMIndexCounterT tfmiis + 1 + updateSTFMIndexSeqBT tfmiss + y + iiFMIndexT y + zs + tfmiss + tfmiis + tfmics + iFMIndexT ys + zs + tfmiss + tfmics + iiFMIndexT _ DS.Empty _ _ tfmics = do + updateSTFMIndexCounterT tfmics + 0 + pure () + iiFMIndexT as (b DS.:<| bs) tfmiss tfmiis tfmics = do + ctfmiis <- readSTRef tfmiis + ctfmics <- readSTRef tfmics + if | as == b + -> do updateSTFMIndexSeqAT tfmiss + (ctfmiis,ctfmics + 1,b) + updateSTFMIndexCounterT tfmics + (ctfmics + 1) + updateSTFMIndexCounterT tfmiis + (ctfmiis + 1) + iiFMIndexT as + bs + tfmiss + tfmiis + tfmics + | otherwise + -> do updateSTFMIndexSeqAT tfmiss + (ctfmiis,ctfmics,b) + updateSTFMIndexCounterT tfmiis + (ctfmiis + 1) + iiFMIndexT as + bs + tfmiss + tfmiis + tfmics + +{-----------------------------} + + +{-fromFMIndex (ByteString) functions.-} + +-- | Abstract 'FFMIndexSeqB' type utilizing a 'Seq'. +type FFMIndexSeqB = Seq (Maybe ByteString) + +-- | Simple Inverse FMIndex function. +seqFromFMIndexB :: FMIndexB + -> FFMIndexSeqB +seqFromFMIndexB (FMIndexB DS.Empty) = DS.Empty +seqFromFMIndexB xs = do + let xss = (\(FMIndexB b) -> b) xs + iFFMIndexB xss + where + iFFMIndexB DS.Empty = DS.Empty + iFFMIndexB ((_,b) DS.:<| _) = + fmap (\(_,_,e) -> e) b + +{-------------------------------------} + + +{-fromFMIndex (Text) functions.-} + +-- | Abstract 'FFMIndexSeqT' type utilizing a 'Seq'. +type FFMIndexSeqT = Seq (Maybe Text) + +-- | Simple Inverse FMIndex function. +seqFromFMIndexT :: FMIndexT + -> FFMIndexSeqT +seqFromFMIndexT (FMIndexT DS.Empty) = DS.Empty +seqFromFMIndexT xs = do + let xss = (\(FMIndexT t) -> t) xs + iFFMIndexT xss + where + iFFMIndexT DS.Empty = DS.Empty + iFFMIndexT ((_,b) DS.:<| _) = + fmap (\(_,_,e) -> e) b + +{-------------------------------} diff --git a/src/Data/MTF.hs b/src/Data/MTF.hs --- a/src/Data/MTF.hs +++ b/src/Data/MTF.hs @@ -13,14 +13,14 @@ -- -- = Move-to-front transform (MTF) -- --- Most users will get the most mileage by first compressing using a 'BWT' +-- Users will get the most mileage by first compressing to a 'BWT' -- on the initial 'ByteString' or 'Text' input before compressing to -- a 'MTFB' or 'MTFT'. -- -- To do this, users can use the 'bytestringToBWTToMTFB' and 'bytestringToBWTToMTFT' functions, -- as well as the 'textToBWTToMTFB' and 'textToBWTToMTFT' functions. -- --- The base functions for 'ByteString', 'bytestringToMTFB', 'bytestringToMTFT' can be used to +-- The base functions for 'ByteString', 'bytestringToMTFB' and 'bytestringToMTFT' can be used to -- convert a 'Seq' ('Maybe' 'ByteString') to a 'MTFB' and 'MTFT', respectively. -- -- Likewise, the base functions for 'Text', 'textToMTFB' and 'textToMTFT' can be used to @@ -28,7 +28,7 @@ -- -- There are various other lower-level functions for interacting with the MTF implementation on 'ByteString' and 'Text' as well. -- --- @"Data.MTF.Internal"@ contains low-level, efficient, and stateful implementations of the MTF and Inverse MTF algorithms. +-- @"Data.MTF.Internal"@ contains efficient and stateful implementations of the MTF and Inverse MTF algorithms. module Data.MTF ( -- * To MTF functions diff --git a/src/Data/RLE.hs b/src/Data/RLE.hs --- a/src/Data/RLE.hs +++ b/src/Data/RLE.hs @@ -13,14 +13,14 @@ -- -- = Run-length encoding (RLE) -- --- Most users will get the most mileage by first compressing using a 'BWT' +-- Users will get the most mileage by first compressing to a 'BWT' -- on the initial 'ByteString' or 'Text' input before compressing to -- a 'RLEB' or 'RLET'. -- -- To do this, users can use the 'bytestringToBWTToRLEB' and 'bytestringToBWTToRLET' functions, -- as well as the 'textToBWTToRLEB' and 'textToBWTToRLET' functions. -- --- The base functions for 'ByteString', 'bytestringToRLEB', 'bytestringToRLET' can be used to +-- The base functions for 'ByteString', 'bytestringToRLEB' and 'bytestringToRLET' can be used to -- convert a 'Seq' ('Maybe' 'ByteString') to a 'RLEB' and 'RLET', respectively. -- -- Likewise, the base functions for 'Text', 'textToRLEB' and 'textToRLET' can be used to @@ -28,7 +28,7 @@ -- -- There are various other lower-level functions for interacting with the RLE implementation on 'ByteString' and 'Text' as well. -- --- @"Data.RLE.Internal"@ contains low-level, efficient, and stateful implementations of the RLE and Inverse RLE algorithms. +-- @"Data.RLE.Internal"@ contains efficient and stateful implementations of the RLE and Inverse RLE algorithms. module Data.RLE ( -- * To RLE functions diff --git a/text-compression.cabal b/text-compression.cabal --- a/text-compression.cabal +++ b/text-compression.cabal @@ -20,7 +20,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.0.11 +version: 0.1.0.12 -- A short (one-line) description of the package. synopsis: A text compression library. @@ -70,7 +70,9 @@ Data.RLE.Internal, Data.RLE, Data.MTF.Internal, - Data.MTF + Data.MTF, + Data.FMIndex.Internal, + Data.FMIndex -- Modules included in this library but not exported. -- other-modules: @@ -81,7 +83,6 @@ build-depends: base ^>=4.16.3.0, bytestring >= 0.11.3 && < 0.12, containers >= 0.6.5 && < 0.7, - massiv >= 1.0.2 && < 1.1, mtl >= 2.2.2 && < 2.3, text >= 1.2.5 && < 1.3