Introduce the pruneForest

This function allows us to keep only the roots, and discard the
redundant children after building a 'Forest'.

src/Gargantext/API/Ngrams.hs

@@ -91,6 +91,7 @@ module Gargantext.API.Ngrams
   , filterNgramsNodes
   , buildForest
   , destroyForest
+  , pruneForest
   )
   where
 
@@ -484,6 +485,15 @@ destroyForest f = Map.fromList . map (foldTree destroyTree) $ f
     squashElements :: NgramsElement -> [(NgramsTerm, NgramsElement)] -> NgramsElement
     squashElements r _ = r
 
+-- | Prunes the input 'Forest' of 'NgramsElement' by keeping only the roots, i.e. the
+-- nodes which has no children /AND/ they do not appear in any other 'children' relationship.
+-- /NOTE ON IMPLEMENTATION:/ The fast way to do this is to simply filter each tree, ensuring
+-- that we keep only trees which root has no parent or root (i.e. it's a root itself!) and this
+-- will work only under the assumption that the input 'Forest' has been built correctly, i.e.
+-- with the correct relationships specified, or this will break.
+pruneForest :: Forest NgramsElement -> Forest NgramsElement
+pruneForest = filter (\(Node r _) -> isNothing (_ne_parent r))
+
 -- | TODO Errors management
 --  TODO: polymorphic for Annuaire or Corpus or ...
 -- | Table of Ngrams is a ListNgrams formatted (sorted and/or cut).
@@ -500,9 +510,9 @@ searchTableNgrams :: Versioned (Map NgramsTerm NgramsElement)
 searchTableNgrams versionedTableMap NgramsSearchQuery{..} =
   let tableMap     = versionedTableMap ^. v_data
       filteredData = filterNgramsNodes _nsq_listType _nsq_minSize _nsq_maxSize _nsq_searchQuery tableMap
-      forestRoots  = Set.fromList . Map.elems . destroyForest . buildForest $ filteredData
+      forestRoots  = Set.fromList . Map.elems . destroyForest . pruneForest . buildForest $ filteredData
       tableMapSorted = versionedTableMap
-                     & v_data .~ (NgramsTable . sortAndPaginate $ forestRoots)
+                     & v_data .~ (NgramsTable . sortAndPaginate . withInners tableMap $ forestRoots)
 
   in toVersionedWithCount (Set.size forestRoots) tableMapSorted
   where
@@ -524,8 +534,8 @@ searchTableNgrams versionedTableMap NgramsSearchQuery{..} =
 
     -- | For each input root, extends its occurrence count with
     -- the information found in the subitems.
-    _withInners :: Map NgramsTerm NgramsElement -> Set NgramsElement -> Set NgramsElement
-    _withInners tblMap roots = Set.map addSubitemsOccurrences roots
+    withInners :: Map NgramsTerm NgramsElement -> Set NgramsElement -> Set NgramsElement
+    withInners tblMap roots = Set.map addSubitemsOccurrences roots
       where
         addSubitemsOccurrences :: NgramsElement -> NgramsElement
         addSubitemsOccurrences e =

test/Test/Offline/Ngrams.hs

@@ -8,7 +8,7 @@ import Prelude
 import Control.Lens
 import Data.Map.Strict qualified as Map
 import Data.Text qualified as T
-import Gargantext.API.Ngrams (filterNgramsNodes, buildForest, destroyForest)
+import Gargantext.API.Ngrams (filterNgramsNodes, buildForest, destroyForest, pruneForest)
 import Gargantext.API.Ngrams.Types
 import Gargantext.API.Ngrams.Types qualified as NT
 import Gargantext.Core
@@ -104,6 +104,8 @@ tests = describe "Ngrams" $ do
   describe "ngram forests" $ do
    it "building a simple tree works"  testBuildNgramsTree_01
    it "building a complex tree works" testBuildNgramsTree_02
+   it "pruning a simple tree works" testPruningNgramsForest_01
+   it "pruning a complex tree works" testPruningNgramsForest_02
    prop "destroyForest . buildForest === id" buildDestroyForestRoundtrips
   describe "hierarchical grouping" $ do
    it "filterNgramsNodes with empty query is identity" testFilterNgramsNodesEmptyQuery
@@ -204,3 +206,24 @@ instance Arbitrary TableMapLockStep where
 buildDestroyForestRoundtrips :: TableMapLockStep -> Property
 buildDestroyForestRoundtrips (TableMapLockStep mp) =
   (destroyForest . buildForest $ mp) === mp
+
+testPruningNgramsForest_01 :: Property
+testPruningNgramsForest_01 =
+  let t1 = Map.fromList [ ( "foo", mkMapTerm "foo" & ne_children .~ mSetFromList ["bar"])
+                        , ( "bar", mkMapTerm "bar" & ne_parent   .~ Just "foo")
+                        ]
+  in (pruneForest $ buildForest t1) `compareForestVisually` [r|
+         foo
+         |
+         `- bar
+|]
+
+testPruningNgramsForest_02 :: Property
+testPruningNgramsForest_02 =
+  (pruneForest $ buildForest hierarchicalTableMap) `compareForestVisually` [r|
+         vehicle
+         |
+         `- car
+            |
+            `- ford
+|]