Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
140
Issues
140
List
Board
Labels
Milestones
Merge Requests
2
Merge Requests
2
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
purescript-gargantext
Commits
a59b072f
Commit
a59b072f
authored
Sep 15, 2020
by
Nicolas Pouillard
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Fix scores
parent
d8b176aa
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
69 additions
and
33 deletions
+69
-33
NgramsTable.purs
src/Gargantext/Components/NgramsTable.purs
+20
-10
Core.purs
src/Gargantext/Components/NgramsTable/Core.purs
+49
-23
No files found.
src/Gargantext/Components/NgramsTable.purs
View file @
a59b072f
...
...
@@ -22,7 +22,6 @@ import Data.Set as Set
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Reactix as R
...
...
@@ -36,7 +35,7 @@ import Gargantext.Components.NgramsTable.Core
import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI)
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Table as T
import Gargantext.Prelude (class Show, Unit, bind, const, discard, identity, map, mempty, not, pure, show, unit, (#), ($), (&&), (/=), (<$>), (<<<), (<>), (=<<), (==), (||), read
, otherwise
)
import Gargantext.Prelude (class Show, Unit, bind, const, discard, identity, map, mempty, not, pure, show, unit, (#), ($), (&&), (/=), (<$>), (<<<), (<>), (=<<), (==), (||), read)
import Gargantext.Routes (SessionRoute(..)) as R
import Gargantext.Sessions (Session, get)
import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
...
...
@@ -379,10 +378,14 @@ loadedNgramsTableCpt = R2.hooksComponent thisModule "loadedNgramsTable" cpt
filteredConvertedRows = convertRow <$> filteredRows
filteredRows :: PreConversionRows
filteredRows = T.filterRows { params } rows
ng_scores :: Map NgramsTerm (Additive Int)
ng_scores = ngramsTable ^. _NgramsTable <<< _ngrams_scores
rows :: PreConversionRows
rows = orderWith (
L.mapMaybe (\(Tuple ng nre) -> addOcc <$> rowsFilter (ngramsRepoElementToNgramsElement ng nre)) $
Map.toUnfoldable (ngramsTable ^. _NgramsTable)
L.mapMaybe (\(Tuple ng nre) ->
let Additive s = ng_scores ^. at ng <<< _Just in
addOcc <$> rowsFilter (ngramsRepoElementToNgramsElement ng s nre)) $
Map.toUnfoldable (ngramsTable ^. _NgramsTable <<< _ngrams_repo_elements)
)
rowsFilter :: NgramsElement -> Maybe NgramsElement
rowsFilter ne =
...
...
@@ -391,7 +394,7 @@ loadedNgramsTableCpt = R2.hooksComponent thisModule "loadedNgramsTable" cpt
else
Nothing
addOcc ngramsElement =
let Additive occurrences = sumOccurrences ngramsTable
ngramsElement
in
let Additive occurrences = sumOccurrences ngramsTable
(ngramsElementToNgramsOcc ngramsElement)
in
ngramsElement # _NgramsElement <<< _occurrences .~ occurrences
allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows
...
...
@@ -567,13 +570,20 @@ mainNgramsTablePaintCpt = R2.hooksComponent thisModule "mainNgramsTablePaint" cp
, withAutoUpdate
}
sumOccurrences :: NgramsTable -> NgramsElement -> Additive Int
sumOccurrences ngramsTable (NgramsElement {occurrences, children}) =
Additive occurrences <> children ^. folded <<< to (sumOccurrences' ngramsTable)
type NgramsOcc = { occurrences :: Additive Int, children :: Set NgramsTerm }
ngramsElementToNgramsOcc :: NgramsElement -> NgramsOcc
ngramsElementToNgramsOcc (NgramsElement {occurrences, children}) = {occurrences: Additive occurrences, children}
sumOccurrences :: NgramsTable -> NgramsOcc -> Additive Int
sumOccurrences ngramsTable {occurrences, children} =
occurrences <> children ^. folded <<< to (sumOccurrences' ngramsTable)
where
sumOccurrences' :: NgramsTable -> NgramsTerm -> Additive Int
sumOccurrences' nt label = Additive 0 -- TODO
--nt ^. ix label <<< to (sumOccurrences nt)
sumOccurrences' nt label =
sumOccurrences nt { occurrences: nt ^. _NgramsTable <<< _ngrams_scores <<< ix label
, children: nt ^. ix label <<< _NgramsRepoElement <<< _children
}
optps1 :: forall a. Show a => { desc :: String, mval :: Maybe a } -> R.Element
optps1 { desc, mval } = H.option { value: value } [H.text desc]
...
...
src/Gargantext/Components/NgramsTable/Core.purs
View file @
a59b072f
...
...
@@ -46,6 +46,8 @@ module Gargantext.Components.NgramsTable.Core
, _ngrams
, _parent
, _root
, _ngrams_repo_elements
, _ngrams_scores
, commitPatchR
, putNgramsPatches
, syncPatchesR
...
...
@@ -84,6 +86,7 @@ import Data.List ((:), List(Nil))
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isJust)
import Data.Monoid.Additive (Additive(..))
import Data.Newtype (class Newtype)
import Data.Set (Set)
import Data.Set as Set
...
...
@@ -211,6 +214,12 @@ _occurrences = prop (SProxy :: SProxy "occurrences")
_list :: forall a row. Lens' { list :: a | row } a
_list = prop (SProxy :: SProxy "list")
_ngrams_repo_elements :: forall a row. Lens' { ngrams_repo_elements :: a | row } a
_ngrams_repo_elements = prop (SProxy :: SProxy "ngrams_repo_elements")
_ngrams_scores :: forall a row. Lens' { ngrams_scores :: a | row } a
_ngrams_scores = prop (SProxy :: SProxy "ngrams_scores")
derive instance newtypeNgramsElement :: Newtype NgramsElement _
derive instance genericNgramsElement :: Generic NgramsElement _
instance showNgramsElement :: Show NgramsElement where
...
...
@@ -297,8 +306,8 @@ _NgramsRepoElement :: Iso' NgramsRepoElement {
}
_NgramsRepoElement = _Newtype
ngramsRepoElementToNgramsElement :: NgramsTerm -> NgramsRepoElement -> NgramsElement
ngramsRepoElementToNgramsElement ngrams (NgramsRepoElement { size, list, root, parent, children }) =
ngramsRepoElementToNgramsElement :: NgramsTerm ->
Int ->
NgramsRepoElement -> NgramsElement
ngramsRepoElementToNgramsElement ngrams
occurrences
(NgramsRepoElement { size, list, root, parent, children }) =
NgramsElement
{ ngrams
, size -- TODO should we assert that size(ngrams) == size?
...
...
@@ -306,7 +315,7 @@ ngramsRepoElementToNgramsElement ngrams (NgramsRepoElement { size, list, root, p
, root
, parent
, children
, occurrences
: 0 -- TODO fake here
, occurrences
}
-----------------------------------------------------------------------------------
...
...
@@ -330,9 +339,22 @@ instance decodeJsonVersioned :: DecodeJson a => DecodeJson (Versioned a) where
data_ <- obj .: "data"
pure $ Versioned {version, data: data_}
-- type NgramsTable = Array (NTree NgramsElement)
-- type NgramsTable = Array NgramsElement
newtype NgramsTable = NgramsTable (Map NgramsTerm NgramsRepoElement)
{-
NgramsRepoElement does not have the occurrences field.
Instead NgramsTable has a ngrams_scores map.
Pro:
* Does not encumber NgramsRepoElement with the score which is not part of repo.
* Enables for multiple scores through multiple maps.
Cons:
* Having a map on the side is equivalent to a `occurrences :: Maybe Int`, which is
less precise.
* It is a tiny bit less performant to access the score.
-}
newtype NgramsTable = NgramsTable
{ ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement
, ngrams_scores :: Map NgramsTerm (Additive Int)
}
derive instance newtypeNgramsTable :: Newtype NgramsTable _
derive instance genericNgramsTable :: Generic NgramsTable _
...
...
@@ -341,28 +363,34 @@ instance eqNgramsTable :: Eq NgramsTable where
instance showNgramsTable :: Show NgramsTable where
show = genericShow
_NgramsTable :: Iso' NgramsTable (Map NgramsTerm NgramsRepoElement)
_NgramsTable :: Iso' NgramsTable
{ ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement
, ngrams_scores :: Map NgramsTerm (Additive Int)
}
_NgramsTable = _Newtype
instance indexNgramsTable :: Index NgramsTable NgramsTerm NgramsRepoElement where
ix k = _NgramsTable <<< ix k
ix k = _NgramsTable <<<
_ngrams_repo_elements <<<
ix k
instance atNgramsTable :: At NgramsTable NgramsTerm NgramsRepoElement where
at k = _NgramsTable <<< at k
at k = _NgramsTable <<<
_ngrams_repo_elements <<<
at k
instance decodeJsonNgramsTable :: DecodeJson NgramsTable where
decodeJson json = do
elements <- decodeJson json
pure $ NgramsTable
$ Map.fromFoldable
$ f <$> (elements :: Array NgramsElement)
{ ngrams_repo_elements: Map.fromFoldable $ f <$> (elements :: Array NgramsElement)
, ngrams_scores: Map.fromFoldable $ g <$> elements
}
where
-- f e@(NgramsElement e') = Tuple e'.ngrams e
f (NgramsElement {ngrams, size, list, root, parent, children{-, occurrences-}}) =
Tuple ngrams (NgramsRepoElement {size, list, root, parent, children{-, occurrences-}}
)
f (NgramsElement {ngrams, size, list, root, parent, children}) =
Tuple ngrams (NgramsRepoElement {size, list, root, parent, children})
g (NgramsElement e) = Tuple e.ngrams (Additive e.occurrences
)
{- NOT USED
instance encodeJsonNgramsTable :: EncodeJson NgramsTable where
encodeJson (NgramsTable m) = encodeJson $ Map.values m
encodeJson (NgramsTable {ngrams_repo_elements, ngrams_scores}) = encodeJson $ Map.values ... TODO
-}
-----------------------------------------------------------------------------------
wordBoundaryChars :: String
...
...
@@ -393,7 +421,7 @@ highlightNgrams ntype (NgramsTable table) input0 =
undb = R.replace wordBoundaryReg2 "$1"
init x = S.take (S.length x - 1) x
input = spR input0
pats = A.fromFoldable (Map.keys table)
pats = A.fromFoldable (Map.keys table
.ngrams_repo_elements
)
ixs = indicesOfAny (sp <<< ngramsTermText <$> pats) (normNgramInternal ntype input)
consOnJustTail s xs@(Tuple _ (Just _) : _) =
...
...
@@ -420,7 +448,7 @@ highlightNgrams ntype (NgramsTable table) input0 =
crashWith "highlightNgrams: out of bounds pattern"
Just pat ->
let lpat = S.length (db (ngramsTermText pat)) in
case Map.lookup pat table of
case Map.lookup pat table
.ngrams_repo_elements
of
Nothing ->
crashWith "highlightNgrams: pattern missing from table"
Just ne ->
...
...
@@ -703,18 +731,15 @@ fromNgramsPatches :: NgramsPatches -> NgramsTablePatch
fromNgramsPatches ngramsPatches = {ngramsPatches}
findNgramTermList :: NgramsTable -> NgramsTerm -> Maybe TermList
findNgramTermList (NgramsTable m) n = m ^? at n <<< _Just <<< _NgramsRepoElement <<< _list
findNgramTermList (NgramsTable m) n = m
.ngrams_repo_elements
^? at n <<< _Just <<< _NgramsRepoElement <<< _list
singletonNgramsTablePatch :: NgramsTerm -> NgramsPatch -> NgramsTablePatch
singletonNgramsTablePatch n p = fromNgramsPatches $ singletonPatchMap n p
rootsOf :: NgramsTable -> Set NgramsTerm
rootsOf (NgramsTable m) = Map.keys $ Map.mapMaybe isRoot m
rootsOf (NgramsTable m) = Map.keys $ Map.mapMaybe isRoot m
.ngrams_repo_elements
where
isRoot (NgramsRepoElement { parent }) = parent
-- rootsOf (NgramsTable m) = Map.keys $ Map.filter isRoot m
-- where
-- isRoot (NgramsElement {parent}) = isNothing parent
type RootParent = { root :: NgramsTerm, parent :: NgramsTerm }
...
...
@@ -769,7 +794,8 @@ newElemsTable = mapWithIndex newElem
applyNgramsTablePatch :: NgramsTablePatch -> NgramsTable -> NgramsTable
applyNgramsTablePatch { ngramsPatches } (NgramsTable m) =
execState (reParentNgramsTablePatch ngramsPatches) $
NgramsTable $ applyPatchMap applyNgramsPatch ngramsPatches m
NgramsTable $ m { ngrams_repo_elements =
applyPatchMap applyNgramsPatch ngramsPatches m.ngrams_repo_elements }
applyNgramsPatches :: forall s. CoreState s -> NgramsTable -> NgramsTable
applyNgramsPatches {ngramsLocalPatch, ngramsStagePatch, ngramsValidPatch} =
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment