Refactor ngram normalization

parent 16138dfa
...@@ -28,7 +28,7 @@ import Reactix.SyntheticEvent as E ...@@ -28,7 +28,7 @@ import Reactix.SyntheticEvent as E
import Gargantext.Types ( TermList ) import Gargantext.Types ( TermList )
import Gargantext.Components.Annotation.Utils ( termBootstrapClass ) import Gargantext.Components.Annotation.Utils ( termBootstrapClass )
import Gargantext.Components.NgramsTable.Core ( NgramsTerm, NgramsTable(..), _NgramsElement, _list, highlightNgrams, nGramsRegex ) import Gargantext.Components.NgramsTable.Core ( NgramsTerm, NgramsTable(..), _NgramsElement, _list, highlightNgrams, findNgramTermList )
import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, MenuType(..) ) import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, MenuType(..) )
import Gargantext.Utils.Selection as Sel import Gargantext.Utils.Selection as Sel
...@@ -80,10 +80,9 @@ maybeShowMenu setMenu setTermList ngrams event = do ...@@ -80,10 +80,9 @@ maybeShowMenu setMenu setTermList ngrams event = do
sel' -> do sel' -> do
let x = E.clientX event let x = E.clientX event
y = E.clientY event y = E.clientY event
sel'' = S.trim $ R.replace nGramsRegex " " sel' list = findNgramTermList ngrams sel'
list = findNgram ngrams sel''
setList t = do setList t = do
setTermList sel'' list t setTermList sel' list t
setMenu (const Nothing) setMenu (const Nothing)
E.preventDefault event E.preventDefault event
setMenu (const $ Just { x, y, list, menuType: NewNgram, setList }) setMenu (const $ Just { x, y, list, menuType: NewNgram, setList })
...@@ -100,9 +99,6 @@ maybeAddMenu _ e _ = e ...@@ -100,9 +99,6 @@ maybeAddMenu _ e _ = e
compile :: NgramsTable -> Maybe String -> Array (Tuple String (Maybe TermList)) compile :: NgramsTable -> Maybe String -> Array (Tuple String (Maybe TermList))
compile ngrams = maybe [] (highlightNgrams ngrams) compile ngrams = maybe [] (highlightNgrams ngrams)
findNgram :: NgramsTable -> String -> Maybe TermList
findNgram (NgramsTable m) s = m ^? at s <<< _Just <<< _NgramsElement <<< _list
-- Runs -- Runs
type Run = type Run =
......
module Gargantext.Components.NgramsTable.Core module Gargantext.Components.NgramsTable.Core
( PageParams ( PageParams
, CoreParams , CoreParams
, PatchMap
, NgramsElement(..) , NgramsElement(..)
, _NgramsElement , _NgramsElement
, NgramsPatch(..) , NgramsPatch(..)
...@@ -11,12 +10,13 @@ module Gargantext.Components.NgramsTable.Core ...@@ -11,12 +10,13 @@ module Gargantext.Components.NgramsTable.Core
, NgramsPatches , NgramsPatches
, _NgramsTable , _NgramsTable
, NgramsTerm , NgramsTerm
, normNgram
, findNgramTermList
, Version , Version
, Versioned(..) , Versioned(..)
, VersionedNgramsTable , VersionedNgramsTable
, CoreState , CoreState
, LoadedNgramsTableProps , LoadedNgramsTableProps
, nGramsRegex
, highlightNgrams , highlightNgrams
, initialPageParams , initialPageParams
, loadNgramsTable , loadNgramsTable
...@@ -211,11 +211,14 @@ instance decodeJsonNgramsTable :: DecodeJson NgramsTable where ...@@ -211,11 +211,14 @@ instance decodeJsonNgramsTable :: DecodeJson NgramsTable where
f e@(NgramsElement e') = Tuple e'.ngrams e f e@(NgramsElement e') = Tuple e'.ngrams e
----------------------------------------------------------------------------------- -----------------------------------------------------------------------------------
nGramWordBoundaries = "[ .,;:!?'\\{}()]" wordBoundaryChars :: String
nGramsRegex = case R.regex ("(" <> nGramWordBoundaries <> ")") (R.global <> R.multiline) of wordBoundaryChars = "[ .,;:!?'\\{}()]"
wordBoundaryReg = case R.regex ("(" <> wordBoundaryChars <> ")") (R.global <> R.multiline) of
Left e -> unsafePartial $ crashWith e Left e -> unsafePartial $ crashWith e
Right r -> r Right r -> r
nGramsRegex2 = case R.regex ("(" <> nGramWordBoundaries <> ")\\1") (R.global <> R.multiline) of
wordBoundaryReg2 = case R.regex ("(" <> wordBoundaryChars <> ")\\1") (R.global <> R.multiline) of
Left e -> unsafePartial $ crashWith e Left e -> unsafePartial $ crashWith e
Right r -> r Right r -> r
...@@ -227,15 +230,15 @@ highlightNgrams (NgramsTable table) input0 = ...@@ -227,15 +230,15 @@ highlightNgrams (NgramsTable table) input0 =
let sN = unsafePartial (foldl goFold {i0: 0, s: input, l: Nil} ixs) in let sN = unsafePartial (foldl goFold {i0: 0, s: input, l: Nil} ixs) in
A.reverse (A.fromFoldable (consNonEmpty (undb (init sN.s)) sN.l)) A.reverse (A.fromFoldable (consNonEmpty (undb (init sN.s)) sN.l))
where where
spR x = " " <> R.replace nGramsRegex "$1$1" x <> " " spR x = " " <> R.replace wordBoundaryReg "$1$1" x <> " "
reR = R.replace nGramsRegex " " reR = R.replace wordBoundaryReg " "
db = S.replace (S.Pattern " ") (S.Replacement " ") db = S.replace (S.Pattern " ") (S.Replacement " ")
sp x = " " <> db x <> " " sp x = " " <> db x <> " "
undb = R.replace nGramsRegex2 "$1" undb = R.replace wordBoundaryReg2 "$1"
init x = S.take (S.length x - 1) x init x = S.take (S.length x - 1) x
input = spR input0 input = spR input0
pats = A.fromFoldable (Map.keys table) pats = A.fromFoldable (Map.keys table)
ixs = indicesOfAny (sp <$> pats) (S.toLower $ reR input) ixs = indicesOfAny (sp <$> pats) (normNgram input)
consOnJustTail s xs@(Tuple _ (Just _) : _) = consOnJustTail s xs@(Tuple _ (Just _) : _) =
Tuple s Nothing : xs Tuple s Nothing : xs
...@@ -483,8 +486,14 @@ type NgramsTablePatch = ...@@ -483,8 +486,14 @@ type NgramsTablePatch =
fromNgramsPatches :: NgramsPatches -> NgramsTablePatch fromNgramsPatches :: NgramsPatches -> NgramsTablePatch
fromNgramsPatches ngramsPatches = {ngramsNewElems: mempty, ngramsPatches} fromNgramsPatches ngramsPatches = {ngramsNewElems: mempty, ngramsPatches}
normNgram :: String -> NgramsTerm
normNgram = S.toLower <<< R.replace wordBoundaryReg " "
findNgramTermList :: NgramsTable -> String -> Maybe TermList
findNgramTermList (NgramsTable m) s = m ^? at (normNgram s) <<< _Just <<< _NgramsElement <<< _list
singletonNgramsTablePatch :: NgramsTerm -> NgramsPatch -> NgramsTablePatch singletonNgramsTablePatch :: NgramsTerm -> NgramsPatch -> NgramsTablePatch
singletonNgramsTablePatch n p = fromNgramsPatches $ singletonPatchMap (S.toLower n) p singletonNgramsTablePatch n p = fromNgramsPatches $ singletonPatchMap (normNgram n) p
type RootParent = { root :: NgramsTerm, parent :: NgramsTerm } type RootParent = { root :: NgramsTerm, parent :: NgramsTerm }
...@@ -559,7 +568,7 @@ postNewElems newElems params = void $ traverseWithIndex postNewElem newElems ...@@ -559,7 +568,7 @@ postNewElems newElems params = void $ traverseWithIndex postNewElem newElems
addNewNgram :: NgramsTerm -> TermList -> NgramsTablePatch addNewNgram :: NgramsTerm -> TermList -> NgramsTablePatch
addNewNgram ngrams list = { ngramsPatches: mempty addNewNgram ngrams list = { ngramsPatches: mempty
, ngramsNewElems: Map.singleton (S.toLower ngrams) list } , ngramsNewElems: Map.singleton (normNgram ngrams) list }
putNgramsPatches :: {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches) putNgramsPatches :: {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches)
putNgramsPatches {nodeId, listIds, tabType} = putNgramsPatches {nodeId, listIds, tabType} =
......
...@@ -207,6 +207,7 @@ pathUrl c (Chart {chartType, tabType}) i = ...@@ -207,6 +207,7 @@ pathUrl c (Chart {chartType, tabType}) i =
------------------------------------------------------------ ------------------------------------------------------------
routesPath :: R.Routes -> String
routesPath R.Home = "" routesPath R.Home = ""
routesPath R.Login = "login" routesPath R.Login = "login"
routesPath R.SearchView = "search" routesPath R.SearchView = "search"
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment