diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -96,3 +96,7 @@ ## 0.1.0.23 -- 2022-12-07 * Fixed grammar/spelling in FM-index documentation. + +## 0.1.0.24 -- 2022-12-08 + +* Optimized parallel implementation for locate and count FM-index functions. diff --git a/src/Data/FMIndex.hs b/src/Data/FMIndex.hs --- a/src/Data/FMIndex.hs +++ b/src/Data/FMIndex.hs @@ -31,7 +31,7 @@ -- -- = Operation: Count -- --- The count operation is supported by both serial, 'bytestringFMIndexCountS' and 'textFMIndexCountS' +-- The count operation is supported by both sequential, 'bytestringFMIndexCountS' and 'textFMIndexCountS' -- and parallel, 'bytestringFMIndexCountP' and 'textFMIndexCountP' , implementations. -- -- The count operations on 'ByteString', 'bytestringFMIndexCountS' and 'bytestringFMIndexCountP', are implemented using the 'countFMIndexB' function. @@ -40,7 +40,7 @@ -- -- = Operation: Locate -- --- The locate operation is supported by both serial, 'bytestringFMIndexLocateS' and 'textFMIndexLocateS' +-- The locate operation is supported by both sequential, 'bytestringFMIndexLocateS' and 'textFMIndexLocateS' -- and parallel, 'bytestringFMIndexLocateP' and 'textFMIndexLocateP' , implementations. -- -- The locate operations on 'ByteString', 'bytestringFMIndexLocateS' and 'bytestringFMIndexLocateP', are implemented using the 'locateFMIndexB' function. @@ -94,6 +94,7 @@ import Data.BWT.Internal import Data.FMIndex.Internal +import Control.Concurrent as CC (getNumCapabilities) import Control.Monad() import Control.Monad.ST as CMST import Control.Monad.State.Strict() @@ -567,47 +568,57 @@ -- and an input 'ByteString' -- and returns the number of occurences of the pattern(s) -- in the input 'ByteString'. --- Parallelized over all available cores. +-- Parallelized and utilizes chunking +-- based on the number of available cores. +-- When using, compile with: -O2 -threaded -with-rtsopts=-N. bytestringFMIndexCountP :: [ByteString] -> ByteString - -> Seq (ByteString,CIntB) -bytestringFMIndexCountP [] _ = DS.Empty -bytestringFMIndexCountP _ (BSC8.uncons -> Nothing) = DS.Empty + -> IO (Seq (ByteString,CIntB)) +bytestringFMIndexCountP [] _ = return DS.Empty +bytestringFMIndexCountP _ (BSC8.uncons -> Nothing) = return DS.Empty bytestringFMIndexCountP allpats input = do - let bfmindex = bytestringToBWTToFMIndexB input - (iBFMC allpats bfmindex) `CPS.using` (CPS.parTraversable CPS.rseq) + numcores <- CC.getNumCapabilities + let chunksize = (P.length allpats) `div` numcores + let bfmindex = bytestringToBWTToFMIndexB input + let bcount = (iBFMC allpats bfmindex) `CPS.using` (CPS.parListChunk chunksize CPS.rseq) + return $ DS.fromList bcount where - iBFMC [] _ = DS.Empty + iBFMC [] _ = [] iBFMC (currentpat:restofpats) bfmi = do let patternf = fmap (BSC8.singleton) $ DS.fromList $ BSC8.unpack currentpat let countf = runST $ countFMIndexB patternf bfmi - (currentpat,countf) DS.<| (iBFMC restofpats bfmi) + (currentpat,countf) : (iBFMC restofpats bfmi) -- | Takes a list of pattern(s) of 'Text's -- and an input 'Text' -- and returns the number of occurences of the pattern(s) -- in the input 'Text'. --- Parallelized over all available cores. +-- Parallelized and utilizes chunking +-- based on the number of available cores. +-- When using, compile with: -O2 -threaded -with-rtsopts=-N. textFMIndexCountP :: [Text] -> Text - -> Seq (Text,CIntT) -textFMIndexCountP [] _ = DS.Empty -textFMIndexCountP _ "" = DS.Empty + -> IO (Seq (Text,CIntT)) +textFMIndexCountP [] _ = return DS.Empty +textFMIndexCountP _ "" = return DS.Empty textFMIndexCountP allpats input = do - let tfmindex = textToBWTToFMIndexT input - (iTFMC allpats tfmindex) `CPS.using` (CPS.parTraversable CPS.rseq) + numcores <- CC.getNumCapabilities + let chunksize = (P.length allpats) `div` numcores + let tfmindex = textToBWTToFMIndexT input + let tcount = (iTFMC allpats tfmindex) `CPS.using` (CPS.parListChunk chunksize CPS.rseq) + return $ DS.fromList tcount where - iTFMC [] _ = DS.Empty + iTFMC [] _ = [] iTFMC (currentpat:restofpats) tfmi = do let patternf = fmap (DText.singleton) $ DS.fromList $ DText.unpack currentpat let countf = runST $ countFMIndexT patternf tfmi - (currentpat,countf) DS.<| (iTFMC restofpats tfmi) + (currentpat,countf) : (iTFMC restofpats tfmi) {-------------------} @@ -626,11 +637,11 @@ bytestringFMIndexLocateS [] _ = DS.Empty bytestringFMIndexLocateS _ (BSC8.uncons -> Nothing) = DS.Empty bytestringFMIndexLocateS allpats input = do - let bytestringsa = createSuffixArray $ - fmap (BS.singleton) $ - DS.fromList $ - BS.unpack input - let bfmindex = bytestringToBWTToFMIndexB input + let bytestringsa = createSuffixArray $ + fmap (BS.singleton) $ + DS.fromList $ + BS.unpack input + let bfmindex = bytestringToBWTToFMIndexB input iBFML allpats bytestringsa bfmindex @@ -694,21 +705,26 @@ -- in the input 'ByteString'. -- The output indices are __1__-based, -- and are __not__ sorted. --- Parallelized over all available cores. +-- Parallelized and utilizes chunking +-- based on the number of available cores. +-- When using, compile with: -O2 -threaded -with-rtsopts=-N. bytestringFMIndexLocateP :: [ByteString] -> ByteString - -> Seq (ByteString,LIntB) -bytestringFMIndexLocateP [] _ = DS.Empty -bytestringFMIndexLocateP _ (BSC8.uncons -> Nothing) = DS.Empty + -> IO (Seq (ByteString,LIntB)) +bytestringFMIndexLocateP [] _ = return DS.Empty +bytestringFMIndexLocateP _ (BSC8.uncons -> Nothing) = return DS.Empty bytestringFMIndexLocateP allpats input = do - let bytestringsa = createSuffixArray $ - fmap (BS.singleton) $ - DS.fromList $ - BS.unpack input - let bfmindex = bytestringToBWTToFMIndexB input - (iBFML allpats bytestringsa bfmindex) `CPS.using` (CPS.parTraversable CPS.rseq) + numcores <- CC.getNumCapabilities + let chunksize = (P.length allpats) `div` numcores + let bytestringsa = createSuffixArray $ + fmap (BS.singleton) $ + DS.fromList $ + BS.unpack input + let bfmindex = bytestringToBWTToFMIndexB input + let blocate = (iBFML allpats bytestringsa bfmindex) `CPS.using` (CPS.parListChunk chunksize CPS.rseq) + return $ DS.fromList blocate where - iBFML [] _ _ = DS.Empty + iBFML [] _ _ = [] iBFML (currentpat:restofpats) bsa bfmi = do let patternf = fmap (BSC8.singleton) $ DS.fromList $ @@ -722,7 +738,7 @@ suffixstartpos $ DS.index bsa ((fromJust x) - 1) ) indices - (currentpat,indicesf) DS.<| (iBFML restofpats bsa bfmi) + (currentpat,indicesf) : (iBFML restofpats bsa bfmi) -- | Takes a list of pattern(s) of 'Text's -- and an input 'Text' @@ -730,21 +746,26 @@ -- in the input 'Text'. -- The output indices are __1__-based, -- and are __not__ sorted. --- Parallelized over all available cores. +-- Parallelized and utilizes chunking +-- based on the number of available cores. +-- When using, compile with: -O2 -threaded -with-rtsopts=-N. textFMIndexLocateP :: [Text] -> Text - -> Seq (Text,LIntT) -textFMIndexLocateP [] _ = DS.Empty -textFMIndexLocateP _ "" = DS.Empty + -> IO (Seq (Text,LIntT)) +textFMIndexLocateP [] _ = return DS.Empty +textFMIndexLocateP _ "" = return DS.Empty textFMIndexLocateP allpats input = do - let textsa = createSuffixArray $ - fmap (DText.singleton) $ - DS.fromList $ - DText.unpack input - let tfmindex = textToBWTToFMIndexT input - (iTFML allpats textsa tfmindex) `CPS.using` (CPS.parTraversable CPS.rseq) + numcores <- CC.getNumCapabilities + let chunksize = (P.length allpats) `div` numcores + let textsa = createSuffixArray $ + fmap (DText.singleton) $ + DS.fromList $ + DText.unpack input + let tfmindex = textToBWTToFMIndexT input + let tlocate = (iTFML allpats textsa tfmindex) `CPS.using` (CPS.parListChunk chunksize CPS.rseq) + return $ DS.fromList tlocate where - iTFML [] _ _ = DS.Empty + iTFML [] _ _ = [] iTFML (currentpat:restofpats) tsa tfmi = do let patternf = fmap (DText.singleton) $ DS.fromList $ @@ -758,6 +779,6 @@ suffixstartpos $ DS.index tsa ((fromJust x) - 1) ) indices - (currentpat,indicesf) DS.<| (iTFML restofpats tsa tfmi) + (currentpat,indicesf) : (iTFML restofpats tsa tfmi) {--------------------} 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.23 +version: 0.1.0.24 -- A short (one-line) description of the package. synopsis: A text compression library.