diff --git a/Data/SearchEngine.hs b/Data/SearchEngine.hs --- a/Data/SearchEngine.hs +++ b/Data/SearchEngine.hs @@ -9,6 +9,8 @@ -- *** Query auto-completion \/ auto-suggestion queryAutosuggest, ResultsFilter(..), + queryAutosuggestPredicate, + queryAutosuggestMatchingDocuments, -- ** Making a search engine instance initSearchEngine, diff --git a/Data/SearchEngine/Autosuggest.hs b/Data/SearchEngine/Autosuggest.hs --- a/Data/SearchEngine/Autosuggest.hs +++ b/Data/SearchEngine/Autosuggest.hs @@ -7,6 +7,9 @@ queryAutosuggest, ResultsFilter(..), + queryAutosuggestPredicate, + queryAutosuggestMatchingDocuments + ) where import Data.SearchEngine.Types @@ -114,6 +117,33 @@ step_external = convertIdsToExternal se +-- | Given an incomplete prefix query, find the set of documents that match +-- possible completions of that query. This should be less computationally +-- expensive than 'queryAutosuggest' as it does not do any ranking of documents. +-- However, it does not apply the pre-filter or post-filter limits, and the list +-- may be large when the query terms occur in many documents. The order of +-- returned keys is unspecified. +queryAutosuggestMatchingDocuments :: (Ix field, Bounded field, Ord key) => + SearchEngine doc key field feature -> + [Term] -> Term -> [key] +queryAutosuggestMatchingDocuments se@SearchEngine{searchIndex} precedingTerms partialTerm = + let (_, _, ds) = processAutosuggestQuery (mkAutosuggestQuery se precedingTerms partialTerm) + in map (SI.getDocKey searchIndex) (DocIdSet.toList ds) + +-- | Given an incomplete prefix query, return a predicate that indicates whether +-- a key is in the set of documents that match possible completions of that +-- query. This is equivalent to calling 'queryAutosuggestMatchingDocuments' and +-- testing whether the key is in the list, but should be more efficient. +-- +-- This does not apply the pre-filter or post-filter limits. +queryAutosuggestPredicate :: (Ix field, Bounded field, Ord key) => + SearchEngine doc key field feature -> + [Term] -> Term -> (key -> Bool) +queryAutosuggestPredicate se@SearchEngine{searchIndex} precedingTerms partialTerm = + let (_, _, ds) = processAutosuggestQuery (mkAutosuggestQuery se precedingTerms partialTerm) + in (\ key -> maybe False (flip DocIdSet.member ds) (SI.lookupDocKeyDocId searchIndex key)) + + -- We apply hard limits both before and after filtering. -- The post-filter limit is to avoid scoring 1000s of documents. -- The pre-filter limit is to avoid filtering 1000s of docs (which in some @@ -478,10 +508,10 @@ -- term would score highly. candidateScore :: TermId -> DocIdSet -> Float candidateScore t ds_t = - sum [ docImportance * termRelevence + sum [ docImportance * termRelevance | Just (docImportance, termRelevances) <- map (`Map.lookup` allTermDocInfo) (DocIdSet.toList ds_t) - , let Just termRelevence = Map.lookup t termRelevances + , let termRelevance = termRelevances Map.! t ] diff --git a/Data/SearchEngine/BM25F.hs b/Data/SearchEngine/BM25F.hs --- a/Data/SearchEngine/BM25F.hs +++ b/Data/SearchEngine/BM25F.hs @@ -5,7 +5,7 @@ -- * A quick overview: -- -- * /The Probabilistic Relevance Framework: BM25 and Beyond/ --- +-- -- -- * /An Introduction to Information Retrieval/ -- diff --git a/Data/SearchEngine/DocIdSet.hs b/Data/SearchEngine/DocIdSet.hs --- a/Data/SearchEngine/DocIdSet.hs +++ b/Data/SearchEngine/DocIdSet.hs @@ -11,6 +11,7 @@ toList, insert, delete, + member, union, unions, intersection, @@ -79,6 +80,9 @@ (i, True) -> case Vec.splitAt i vec of (before, after) -> DocIdSet (before Vec.++ Vec.tail after) + +member :: DocId -> DocIdSet -> Bool +member x (DocIdSet vec) = snd (binarySearch vec 0 (Vec.length vec - 1) x) binarySearch :: Vec.Vector DocId -> Int -> Int -> DocId -> (Int, Bool) binarySearch vec !a !b !key diff --git a/Data/SearchEngine/SearchIndex.hs b/Data/SearchEngine/SearchIndex.hs --- a/Data/SearchEngine/SearchIndex.hs +++ b/Data/SearchEngine/SearchIndex.hs @@ -16,6 +16,7 @@ lookupTermId, lookupDocId, lookupDocKey, + lookupDocKeyDocId, getTerm, getDocKey, @@ -192,6 +193,9 @@ case IntMap.lookup (fromEnum docid) docIdMap of Nothing -> error "lookupDocKey: internal error" Just (DocInfo _key doctermids _) -> Just doctermids + +lookupDocKeyDocId :: Ord key => SearchIndex key field feature -> key -> Maybe DocId +lookupDocKeyDocId SearchIndex{docKeyMap} key = Map.lookup key docKeyMap getTerm :: SearchIndex key field feature -> TermId -> Term diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +0.2.2.0 Adam Gundry November 2022 + * Add queryAutosuggestPredicate and queryAutosuggestMatchingDocuments + * Compatibility with GHC 8.10 to 9.4 and new package versions + 0.2.1.4 Mikolaj Konarski August 2017 * Compatibility with GHC 8.0.2 and new package versions (no API changes) diff --git a/full-text-search.cabal b/full-text-search.cabal --- a/full-text-search.cabal +++ b/full-text-search.cabal @@ -1,5 +1,5 @@ name: full-text-search -version: 0.2.1.4 +version: 0.2.2.0 synopsis: In-memory full text search engine description: An in-memory full text search engine library. It lets you run full-text queries on a collection of your documents. @@ -44,14 +44,17 @@ license: BSD3 license-file: LICENSE author: Duncan Coutts -maintainer: Duncan Coutts +maintainer: Duncan Coutts , + Adam Gundry copyright: 2013-2014 Duncan Coutts, 2014 Well-Typed LLP, - 2014 IRIS Connect Ltd. + 2014-2022 IRIS Connect Ltd. category: Data, Text, Search build-type: Simple cabal-version: >=1.10 extra-source-files: changelog +tested-with: GHC ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.2 + source-repository head type: git location: git@github.com:well-typed/full-text-search.git @@ -59,6 +62,7 @@ flag build-search-demo default: False description: Build a little program illustrating the use of the library + manual: True library exposed-modules: Data.SearchEngine, @@ -79,9 +83,9 @@ ScopedTypeVariables build-depends: base >=4.5 && <5.9, array >=0.4 && <0.6, - vector >=0.11 && <0.13, - containers >=0.4 && <0.6, - text >=0.11 && <1.3 + vector >=0.11 && <0.14, + containers >=0.4 && <0.7, + text >=0.11 && <2.1 default-language: Haskell2010 ghc-options: -Wall -funbox-strict-fields @@ -129,6 +133,7 @@ other-modules: Test.Data.SearchEngine.TermBag, Test.Data.SearchEngine.DocIdSet, Data.SearchEngine.DocTermIds, - Data.SearchEngine.DocIdSet + Data.SearchEngine.DocIdSet, + Data.SearchEngine.TermBag default-language: Haskell2010 ghc-options: -Wall diff --git a/tests/Test/Data/SearchEngine/DocIdSet.hs b/tests/Test/Data/SearchEngine/DocIdSet.hs --- a/tests/Test/Data/SearchEngine/DocIdSet.hs +++ b/tests/Test/Data/SearchEngine/DocIdSet.hs @@ -1,7 +1,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Test.Data.SearchEngine.DocIdSet where -import Data.SearchEngine.DocIdSet +import Data.SearchEngine.DocIdSet (DocIdSet(DocIdSet), DocId(DocId)) +import qualified Data.SearchEngine.DocIdSet as DocIdSet import qualified Data.Vector.Unboxed as Vec import qualified Data.List as List @@ -9,7 +10,7 @@ instance Arbitrary DocIdSet where - arbitrary = fromList `fmap` (listOf arbitrary) + arbitrary = DocIdSet.fromList `fmap` (listOf arbitrary) instance Arbitrary DocId where arbitrary = DocId `fmap` choose (0,15) @@ -17,35 +18,35 @@ prop_insert :: DocIdSet -> DocId -> Bool prop_insert dset x = - let dset' = insert x dset - in invariant dset && invariant dset' - && all (`member` dset') (x : toList dset) + let dset' = DocIdSet.insert x dset + in DocIdSet.invariant dset && DocIdSet.invariant dset' + && all (`member` dset') (x : DocIdSet.toList dset) prop_delete :: DocIdSet -> DocId -> Bool prop_delete dset x = - let dset' = delete x dset - in invariant dset && invariant dset' - && all (`member` dset') (List.delete x (toList dset)) + let dset' = DocIdSet.delete x dset + in DocIdSet.invariant dset && DocIdSet.invariant dset' + && all (`member` dset') (List.delete x (DocIdSet.toList dset)) && not (x `member` dset') prop_delete' :: DocIdSet -> Bool prop_delete' dset = - all (prop_delete dset) (toList dset) + all (prop_delete dset) (DocIdSet.toList dset) prop_union :: DocIdSet -> DocIdSet -> Bool prop_union dset1 dset2 = - let dset = union dset1 dset2 - dset' = fromList (List.union (toList dset1) (toList dset2)) + let dset = DocIdSet.union dset1 dset2 + dset' = DocIdSet.fromList (List.union (DocIdSet.toList dset1) (DocIdSet.toList dset2)) - in invariant dset && invariant dset' + in DocIdSet.invariant dset && DocIdSet.invariant dset' && dset == dset' prop_union' :: DocIdSet -> DocIdSet -> Bool prop_union' dset1 dset2 = - let dset = union dset1 dset2 - dset' = List.foldl' (\s i -> insert i s) dset1 (toList dset2) - dset'' = List.foldl' (\s i -> insert i s) dset2 (toList dset1) - in invariant dset && invariant dset' && invariant dset'' + let dset = DocIdSet.union dset1 dset2 + dset' = List.foldl' (\s i -> DocIdSet.insert i s) dset1 (DocIdSet.toList dset2) + dset'' = List.foldl' (\s i -> DocIdSet.insert i s) dset2 (DocIdSet.toList dset1) + in DocIdSet.invariant dset && DocIdSet.invariant dset' && DocIdSet.invariant dset'' && dset == dset' && dset' == dset''