Merge branch 'dev-merge' into dev

src/Gargantext/Components/Annotation/Field.purs

@@ -14,7 +14,9 @@ module Gargantext.Components.Annotation.Field where
 import Gargantext.Prelude
 
 import Data.Array as A
+import Data.FoldableWithIndex (foldlWithIndex, foldrWithIndex)
 import Data.List (List(..), (:))
+import Data.Map (Map)
 import Data.Maybe (Maybe(..), maybe)
 import Data.String.Common (joinWith)
 import Data.Tuple (Tuple(..), snd)
@@ -23,8 +25,8 @@ import DOM.Simple.Event as DE
 import Effect (Effect)
 import Gargantext.Components.Annotation.Menu (annotationMenu, AnnotationMenu)
 import Gargantext.Components.Annotation.Types (MenuType(..), ModeType(..), termClass)
-import Gargantext.Core.NgramsTable.Functions (findNgramTermList, highlightNgrams, normNgram)
-import Gargantext.Core.NgramsTable.Types (NgramsTable, NgramsTerm(..))
+import Gargantext.Core.NgramsTable.Functions (Cache, findNgramTermList, highlightNgrams, normNgram)
+import Gargantext.Core.NgramsTable.Types (HighlightElement, NgramsRepoElement(..), NgramsTable(..), NgramsTerm(..), parentMap)
 import Gargantext.Types (CTabNgramType(..), TermList)
 import Gargantext.Utils.Reactix as R2
 import Gargantext.Utils.Selection as Sel
@@ -43,6 +45,7 @@ type Props =
   , setTermList  :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
   , text         :: Maybe String
   , mode         :: ModeType
+  , cache        :: Record Cache
   )
 type MouseEvent = E.SyntheticEvent DE.MouseEvent
 
@@ -78,6 +81,7 @@ annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
       , setTermList
       , text: fieldText
       , mode
+      , cache
       } _ = do
     -- | States
     -- |
@@ -110,7 +114,7 @@ annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
 
             H.div
             { className: "annotated-field-runs" }
-            ((\p -> annotateRun p) <$> wrap <$> compile ngrams fieldText)
+            ((\p -> annotateRun p) <$> wrap <$> compile cache ngrams fieldText)
 
 
           AdditionMode ->
@@ -132,10 +136,11 @@ annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
 -----------------------------------------------------------
 
 compile ::
-     NgramsTable
+     Record Cache
+  -> NgramsTable
   -> Maybe String
-  -> Array (Tuple String (List (Tuple NgramsTerm TermList)))
-compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
+  -> Array HighlightElement
+compile cache ngrams = maybe [] (highlightNgrams CTabTerms ngrams cache)
 
 -- Runs
 

src/Gargantext/Components/Document/Layout.purs

@@ -19,7 +19,7 @@ import Gargantext.Components.Category (ratingSimpleLoader)
 import Gargantext.Components.Document.Types (DocPath, Document(..), LoadedData, initialState)
 import Gargantext.Components.NgramsTable.AutoSync (useAutoSync)
 import Gargantext.Components.Node (NodePoly(..))
-import Gargantext.Core.NgramsTable.Functions (addNewNgramA, applyNgramsPatches, coreDispatch, findNgramRoot, setTermListA)
+import Gargantext.Core.NgramsTable.Functions (addNewNgramA, applyNgramsPatches, coreDispatch, findNgramRoot, setTermListA, computeCache)
 import Gargantext.Core.NgramsTable.Types (CoreAction(..), Versioned(..), replace)
 import Gargantext.Hooks.FirstEffect (useFirstEffect')
 import Gargantext.Utils ((?))
@@ -88,11 +88,14 @@ layoutCpt = here.component "layout" cpt where
 
       ngrams = applyNgramsPatches state' initTable
 
+      cache = computeCache ngrams
+
       annotate text = AnnotatedField.annotatedField
         { ngrams
         , setTermList
         , text
         , mode: mode'
+        , cache
         }
 
       setTermListOrAddA ngram Nothing        =

src/Gargantext/Core/NgramsTable/Functions.purs

@@ -8,6 +8,7 @@ import Data.Array (head)
 import Data.Array as A
 import Data.Either (Either(..))
 import Data.Foldable (foldl)
+import Data.FoldableWithIndex (foldlWithIndex, foldrWithIndex)
 import Data.Lens (use, view, (^?), (^.), (?=), (%~), (%=), (.~))
 import Data.Lens.At (at)
 import Data.Lens.Common (_Just)
@@ -19,6 +20,7 @@ import Data.Map (Map)
 import Data.Map as Map
 import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', isJust)
 import Data.Set (Set)
+import Data.Set as Set
 import Data.String as S
 import Data.String.Common as DSC
 import Data.String.Regex (Regex, regex, replace) as R
@@ -112,6 +114,19 @@ lookupRootList ngram (NgramsTable {ngrams_repo_elements: elts}) =
         Nothing -> Nothing
         Just (NgramsRepoElement {list}) -> Just list -- assert root == Nothing
 
+lookupRootListWithChildren :: NgramsTerm -> NgramsTable -> Record Cache -> Maybe TermList
+lookupRootListWithChildren ngram table@(NgramsTable {ngrams_repo_elements: elts}) { pm, pats } =
+  case Map.lookup ngram elts of
+    Nothing -> -- try to find in children
+      case Map.lookup ngram pm of
+        Nothing -> Nothing
+        Just parent' -> lookupRootList parent' table
+    Just (NgramsRepoElement {list, root: Nothing}) -> Just list
+    Just (NgramsRepoElement {root: Just root}) ->
+      case Map.lookup root elts of
+        Nothing -> Nothing
+        Just (NgramsRepoElement {list}) -> Just list -- assert root == Nothing
+
 wordBoundaryChars :: String
 wordBoundaryChars = "[ .,;:!?'\\{}()]"
 
@@ -125,10 +140,24 @@ wordBoundaryReg2 = case R.regex ("(" <> wordBoundaryChars <> ")\\1") (R.global <
   Left e  -> unsafePartial $ crashWith e
   Right r -> r
 
+type Cache =
+  ( pm :: Map NgramsTerm NgramsTerm
+  , pats :: Array NgramsTerm )
+
+computeCache :: NgramsTable -> Record Cache
+computeCache ngrams = { pm, pats }
+  where
+    NgramsTable { ngrams_repo_elements } = ngrams
+    pm = parentMap ngrams_repo_elements
+
+    pats :: Array NgramsTerm
+    pats = A.fromFoldable $
+           foldrWithIndex (\term (NgramsRepoElement nre) acc -> Set.union acc $ Set.insert term nre.children) Set.empty ngrams_repo_elements
+
 -- TODO: while this function works well with word boundaries,
 --       it inserts too many spaces.
-highlightNgrams :: CTabNgramType -> NgramsTable -> String -> Array HighlightElement
-highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 =
+highlightNgrams :: CTabNgramType -> NgramsTable -> Record Cache -> String -> Array HighlightElement
+highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) { pm, pats } input0 =
     -- trace {pats, input0, input, ixs} \_ ->
     A.fromFoldable ((\(s /\ ls)-> undb s /\ ls) <$> unsafePartial (foldl goFold ((input /\ Nil) : Nil) ixs))
   where
@@ -138,7 +167,12 @@ highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 =
     sp x = " " <> db x <> " "
     undb = R.replace wordBoundaryReg2 "$1"
     input = spR input0
-    pats = A.fromFoldable (Map.keys elts)
+    -- pats = A.fromFoldable (Map.keys elts)
+    -- pats :: Array NgramsTerm
+    -- pats = A.fromFoldable $
+    --        foldrWithIndex (\term (NgramsRepoElement nre) acc -> Set.union acc $ Set.insert term nre.childre
+                                                                -- n) Set.empty elts
+             -- foldlWithIndex (\term acc (NgramsRepoElement nre) -> Set.union acc $ Set.insert term nre.children) Set.empty elts
     hashStruct = SSKR.hashStruct (sp <<< ngramsTermText <$> pats)
     ixs = SSKR.indicesOfAnyHashStruct hashStruct (normNgramInternal ntype input)
 
@@ -167,9 +201,12 @@ highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 =
 
     addNgramElt ng ne_list (elt /\ elt_lists) = (elt /\ ((ng /\ ne_list) : elt_lists))
 
+    -- parentMap' :: Map NgramsTerm NgramsTerm
+    -- parentMap' = parentMap elts
+
     goAcc :: Partial => Int -> HighlightAccumulator -> Tuple NgramsTerm Int -> HighlightAccumulator
     goAcc i acc (pat /\ lpat) =
-      case lookupRootList pat table of
+      case lookupRootListWithChildren pat table { pm, pats } of
         Nothing ->
           crashWith "highlightNgrams: pattern missing from table"
         Just ne_list ->

src/Gargantext/Core/NgramsTable/Types.purs

@@ -13,6 +13,7 @@ import Data.Lens.Index (class Index, ix)
 import Data.Lens.Iso.Newtype (_Newtype)
 import Data.Lens.Record (prop)
 import Data.List (List)
+import Data.List as List
 import Data.List.Types (NonEmptyList(..))
 import Data.Map (Map)
 import Data.Map as Map
@@ -347,6 +348,18 @@ _NgramsRepoElement  :: Iso' NgramsRepoElement {
   }
 _NgramsRepoElement = _Newtype
 
+-- | Given a `Map NgramsTerm NgramsRepoElement` (e.g. from
+-- | `NgramsTable.ngrams_repo_elements`), produce a map of child ->
+-- | parent mappings.
+parentMap :: Map NgramsTerm NgramsRepoElement -> Map NgramsTerm NgramsTerm
+parentMap m = Map.fromFoldable rev
+  where
+    mf :: Map NgramsTerm (List NgramsTerm)
+    mf = (\(NgramsRepoElement nre) -> List.fromFoldable nre.children) <$> m
+    rev :: List (Tuple NgramsTerm NgramsTerm)
+    rev = foldlWithIndex (\term (acc :: List (Tuple NgramsTerm NgramsTerm)) children ->
+                           acc <> ((\c -> Tuple c term) <$> children)) List.Nil mf
+
 -----------------------------------------------------------------------------------
 {-
   NgramsRepoElement does not have the occurrences field.