text-compression (empty) → 0.1.0.3
raw patch · 6 files changed
+433/−0 lines, 6 filesdep +basedep +containersdep +massivsetup-changed
Dependencies added: base, containers, massiv, mtl
Files
- CHANGELOG.md +13/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- src/Data/BWT.hs +72/−0
- src/Data/BWT/Internal.hs +227/−0
- text-compression.cabal +89/−0
+ CHANGELOG.md view
@@ -0,0 +1,13 @@+# Revision history for text-compression++## 0.1.0.0 -- 2022-10-31++* First version. Released on an unsuspecting world.++## 0.1.0.1 -- 2022-10-31++* First version, with some updated documentation.++## 0.1.0.2 -- 2022-10-31++* First version, with some updated documentation.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2022, Matthew Mosior++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * 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.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Data/BWT.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE Strict #-}+++-- |+-- Module : Data.BWT+-- Copyright : (c) Matthew Mosior 2022+-- License : BSD-style+-- Maintainer : mattm.github@gmail.com+-- Portability : portable+--+-- = Burrows-Wheeler Transform (BWT)+-- +-- The two functions that most users will utilize are 'toBWT' and 'fromBWT'.+-- There are auxilary function(s) inside of @"Data.BWT.Internal"@.+--+-- @"Data.BWT.Internal"@ also has the function 'createBWTMatrix', which can be useful as well, although not used by either 'toBWT' or 'fromBWT'.+++module Data.BWT where++import Data.BWT.Internal++import Control.Monad()+import Control.Monad.ST as CMST+import Control.Monad.State.Strict()+import Data.Foldable as DFold (toList)+import Data.Sequence as DS+import Data.STRef()+++{-toBWT function(s).-}++-- | Takes a String and returns the Burrows-Wheeler Transform (BWT).+-- Implemented via a 'SuffixArray'.+--+-- Works with alphanumeric characters (A-Za-z0-9), as well as special characters `~?!@#%^&*()_+<>';:[]{}/\|"-.,+-- Does __NOT__ work with an input containing the __$__ character.+-- +-- Appends the __$__ character to the input automatically.+toBWT :: String -> BWT+toBWT [] = DS.Empty+toBWT xs = do+ let saxs = createSuffixArray xseos+ saToBWT saxs+ xseos+ where+ xseos = (DS.fromList xs) DS.|> '$'++{--------------------}+++{-fromBWT function(s).-}++-- | Takes a BWT data type (please see @"Data.BWT.Internal"@) and inverts it back to the original string.+-- +-- This function utilizes the state monad (strict) in order+-- to implement the [Magic](https://www.youtube.com/watch?v=QwSsppKrCj4) Inverse BWT algorithm by backtracking+-- indices starting with the __$__ character.+fromBWT :: BWT -> String+fromBWT bwt = do+ let originalp = CMST.runST $ magicInverseBWT magicsz+ DFold.toList $ DS.take ((DS.length originalp) - 1)+ originalp+ where+ magicsz = DS.sortBy (\(a,b) (c,d) -> sortTB (a,b) (c,d))+ zipped+ zipped = DS.zip bwt+ (DS.iterateN (DS.length bwt) (+1) 0)++{----------------------}
+ src/Data/BWT/Internal.hs view
@@ -0,0 +1,227 @@+{-# 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 sequence 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.+++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.Sequence as DS+import Data.Massiv.Array as DMA+import Data.Massiv.Core()+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 = Suffix { suffixindex :: Int+ , suffixstartpos :: Int+ , suffix :: Seq Char+ }+ deriving (Show,Read,Eq,Ord,Generic)++-- | The SuffixArray data type.+-- Uses sequence internally.+type SuffixArray = Seq Suffix++-- | The BWT data type.+-- Uses sequence internally.+type BWT = Seq Char++-- | The BWTMatrix data type.+-- Uses a massiv array internally.+type BWTMatrix = DMA.Array BN Ix1 String++{-------------------}+++{-toBWT functions.-}++-- | Computes the Burrows-Wheeler Transform (BWT) using the suffix array+-- and the original string (represented as a sequence for performance).+saToBWT :: SuffixArray -> Seq Char -> BWT+saToBWT DS.Empty _ = DS.Empty+saToBWT (y DS.:<| ys) t =+ if | suffixstartpos y /= 1+ -> DS.index t (suffixstartpos y - 1 - 1)+ DS.<| (saToBWT ys t)+ | otherwise+ -> DS.index t (DS.length t - 1)+ DS.<| (saToBWT ys t)++-- | Computes the corresponding 'SuffixArray' of a given string. Please see [suffix array](https://en.wikipedia.org/wiki/Suffix_array)+-- for more information. +createSuffixArray :: Seq Char -> SuffixArray+createSuffixArray xs =+ fmap (\x -> Suffix { suffixindex = ((\(a,_,_) -> a) x)+ , suffixstartpos = ((\(_,b,_) -> b) x)+ , suffix = ((\(_,_,c) -> c) x)+ }+ ) xsssuffixesfff+ where+ xsssuffixes = DS.tails xs+ xsssuffixesf = DS.zip (DS.fromList [1..(DS.length xsssuffixes)])+ xsssuffixes+ xsssuffixesff = DS.filter (\(_,b) -> not $ DS.null b)+ xsssuffixesf+ xsssuffixesffsorted = DS.sortOn snd xsssuffixesff+ xsssuffixesfff = (\(a,(b,c)) -> (a,b,c))+ <$>+ DS.zip (DS.fromList [1..(DS.length xsssuffixesffsorted)])+ 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 (c1,i1) (c2,i2) = compare c1 c2 <>+ compare i1 i2++-- | Abstract BWTSeq type utilizing a sequence.+type BWTSeq a = Seq Char++-- | Abstract data type representing a BWTSeq in the (strict) ST monad.+type STBWTSeq s a = STRef s (BWTSeq Char)++-- | State function to push BWTString data into stack.+pushSTBWTSeq :: STBWTSeq s Char -> Char -> ST s ()+pushSTBWTSeq s e = do+ s2 <- readSTRef s+ writeSTRef s (s2 DS.|> e)++-- | State function to create empty STBWTString type.+emptySTBWTSeq :: ST s (STBWTSeq s Char)+emptySTBWTSeq = newSTRef 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 s e = writeSTRef s e++-- | State function to create empty STBWTCounter type.+emptySTBWTCounter :: ST s (STBWTCounter s Int)+emptySTBWTCounter = newSTRef (-1)++-- | "Magic" Inverse BWT function.+magicInverseBWT :: Seq (Char,Int) -> ST s (BWTSeq Char)+magicInverseBWT DS.Empty = do+ bwtseqstackempty <- emptySTBWTSeq+ bwtseqstackemptyr <- readSTRef bwtseqstackempty+ return bwtseqstackemptyr+magicInverseBWT xs = do+ bwtseqstack <- emptySTBWTSeq+ bwtcounterstack <- emptySTBWTCounter+ case (DS.findIndexL ((== '$') . fst) xs) of+ Nothing -> do bwtseqstackr <- readSTRef bwtseqstack+ return bwtseqstackr+ Just dollarsignindex -> do let dollarsignfirst = DS.index xs+ dollarsignindex+ updateSTBWTCounter bwtcounterstack+ (snd dollarsignfirst)+ iBWT xs+ bwtseqstack+ bwtcounterstack+ bwtseqstackr <- readSTRef bwtseqstack+ return bwtseqstackr+ where+ iBWT ys bwtss bwtcs = do+ cbwtcs <- readSTRef bwtcs+ cbwtss <- readSTRef bwtss+ CM.when (DS.length cbwtss < DS.length ys) $ do+ let next = DS.index ys cbwtcs+ pushSTBWTSeq bwtss+ (fst next)+ updateSTBWTCounter bwtcs+ (snd next)+ iBWT ys bwtss bwtcs++-- | Easy way to grab the first two elements of a sequence.+grabHeadChunks :: Seq (Seq Char) -> (Seq Char,Seq Char)+grabHeadChunks DS.Empty = (DS.Empty,DS.Empty)+grabHeadChunks (x1 DS.:<| xs) = (x1,grabHeadChunksInternal xs)+ where+ grabHeadChunksInternal :: Seq (Seq Char) -> Seq Char+ grabHeadChunksInternal DS.Empty = DS.Empty+ grabHeadChunksInternal (y1 DS.:<| _) = y1++-- | Simple yet efficient implementation of converting a given string+-- into a BWT Matrix (the BWTMatrix type is a massiv array).+createBWTMatrix :: String -> BWTMatrix+createBWTMatrix t =+ DMA.fromList (ParN 0) zippedfff :: Array BN Ix1 String + where+ zippedfff = DL.map DFold.toList $+ DL.map (\(a,b) -> a DS.>< b) $+ DFold.toList zippedff+ zippedff = DS.sortBy (\(a,_) (c,_) -> compare a c)+ zippedf+ zippedf = zippedh+ DS.><+ zippedp+ zippedh = DS.singleton $+ grabHeadChunks $+ DS.chunksOf ((DS.length tseq) - 1)+ tseq+ zippedp = DS.zip suffixesf prefixesf+ prefixesf = DS.take ((DS.length prefixes) - 1)+ prefixes+ suffixesf = DS.drop 1+ suffixes+ suffixes = DS.filter (not . DS.null)+ (DS.tails tseq)+ prefixes = DS.filter (not . DS.null)+ (DS.inits tseq)+ tseq = (DS.fromList t) DS.|> '$'++{--------------------}
+ text-compression.cabal view
@@ -0,0 +1,89 @@+cabal-version: 3.0+-- The cabal-version field refers to the version of the .cabal specification,+-- and can be different from the cabal-install (the tool) version and the+-- Cabal (the library) version you are using. As such, the Cabal (the library)+-- version used must be equal or greater than the version stated in this field.+-- Starting from the specification version 2.2, the cabal-version field must be+-- the first thing in the cabal file.++-- Initial package description 'text-compression' generated by+-- 'cabal init'. For further documentation, see:+-- http://haskell.org/cabal/users-guide/+--+-- The name of the package.+name: text-compression++-- The package version.+-- See the Haskell package versioning policy (PVP) for standards+-- guiding when and how versions should be incremented.+-- https://pvp.haskell.org+-- PVP summary: +-+------- breaking API changes+-- | | +----- non-breaking API additions+-- | | | +--- code changes with no API change+version: 0.1.0.3++-- A short (one-line) description of the package.+synopsis: A text compression library.++-- A longer description of the package.+description: This package contains efficient implementations of the Burrows-Wheeler Transform (BWT) and Inverse BWT algorithms.++-- URL for the project homepage or repository.+homepage: https://github.com/Matthew-Mosior/text-compression++-- The license under which the package is released.+license: BSD-3-Clause++-- The file containing the license text.+license-file: LICENSE++-- The package author(s).+author: Matthew Mosior++-- An email address to which users can send suggestions, bug reports, and patches.+maintainer: mattm.github@gmail.com++-- Where to submit bugs.+bug-reports: https://github.com/Matthew-Mosior/text-compression/issues++-- A copyright notice.+-- copyright:+category: Data Structures+build-type: Simple++-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.+extra-doc-files: CHANGELOG.md++-- Extra source files to be distributed with the package, such as examples, or a tutorial module.+-- extra-source-files:++common warnings+ ghc-options: -Wall++library+ -- Import common warning flags.+ import: warnings++ -- Modules exported by the library.+ exposed-modules: Data.BWT.Internal,+ Data.BWT+ -- Modules included in this library but not exported.+ -- other-modules:++ -- LANGUAGE extensions used by modules in this package.+ -- other-extensions:++ -- Other library packages from which modules are imported.+ build-depends: base ^>=4.16.3.0, + containers >= 0.6.5 && < 0.7,+ massiv >= 1.0.2 && < 1.1,+ mtl >= 2.2.2 && < 2.3 ++ -- Directories containing source files.+ hs-source-dirs: src++ -- Base language which the package is written in.+ default-language: Haskell2010 ++ -- Set highest (reasonable) optimization level to compile with.+ ghc-options: -O2