Commit 6aebe7b8 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[CLEAN] doc + refact

parent 01f6f79c
...@@ -40,9 +40,8 @@ toGroupedText :: GroupedTextParams a b ...@@ -40,9 +40,8 @@ toGroupedText :: GroupedTextParams a b
toGroupedText groupParams scores = toGroupedText groupParams scores =
(groupWithStem groupParams) . (groupWithScores scores) (groupWithStem groupParams) . (groupWithScores scores)
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | WIP -- | WIP, put this in test folder
toGroupedText_test :: Bool -- Map Stem (GroupedText Int) toGroupedText_test :: Bool -- Map Stem (GroupedText Int)
toGroupedText_test = toGroupedText_test =
-- fromGroupedScores $ fromListScores from -- fromGroupedScores $ fromListScores from
......
...@@ -23,6 +23,7 @@ import Data.Text (Text) ...@@ -23,6 +23,7 @@ import Data.Text (Text)
import Gargantext.Core.Types (ListType(..)) -- (MasterCorpusId, UserCorpusId) import Gargantext.Core.Types (ListType(..)) -- (MasterCorpusId, UserCorpusId)
import Gargantext.Database.Admin.Types.Node (NodeId) import Gargantext.Database.Admin.Types.Node (NodeId)
-- import Gargantext.Core.Text.List.Learn (Model(..)) -- import Gargantext.Core.Text.List.Learn (Model(..))
import Gargantext.Core.Text.List.Social.Prelude
import Gargantext.Core.Text.List.Social.Scores import Gargantext.Core.Text.List.Social.Scores
import Gargantext.Prelude import Gargantext.Prelude
import qualified Data.Set as Set import qualified Data.Set as Set
...@@ -38,9 +39,11 @@ makeLenses ''GroupedWithListScores ...@@ -38,9 +39,11 @@ makeLenses ''GroupedWithListScores
instance Semigroup GroupedWithListScores where instance Semigroup GroupedWithListScores where
(<>) (GroupedWithListScores c1 l1) (<>) (GroupedWithListScores c1 l1)
(GroupedWithListScores c2 l2) = (GroupedWithListScores c2 l2) =
GroupedWithListScores (c1 <> c2) (l1 <> l2) GroupedWithListScores (c1 <> c2)
(l1 <> l2)
------ ------
-- To be removed
data GroupedTextScores score = data GroupedTextScores score =
GroupedTextScores { _gts_listType :: !(Maybe ListType) GroupedTextScores { _gts_listType :: !(Maybe ListType)
, _gts_score :: score , _gts_score :: score
...@@ -53,6 +56,7 @@ instance Semigroup a => Semigroup (GroupedTextScores a) where ...@@ -53,6 +56,7 @@ instance Semigroup a => Semigroup (GroupedTextScores a) where
= GroupedTextScores (l1 <> l2) (s1 <> s2) (c1 <> c2) = GroupedTextScores (l1 <> l2) (s1 <> s2) (c1 <> c2)
------ ------
-- | Tree of GroupedTextScores
data GroupedTextScores' score = data GroupedTextScores' score =
GroupedTextScores' { _gts'_listType :: !(Maybe ListType) GroupedTextScores' { _gts'_listType :: !(Maybe ListType)
, _gts'_score :: score , _gts'_score :: score
...@@ -78,6 +82,7 @@ groupWithScores scores ms = orphans <> groups ...@@ -78,6 +82,7 @@ groupWithScores scores ms = orphans <> groups
orphans = addIfNotExist scores ms orphans = addIfNotExist scores ms
------------------------------------------------------------------------
addScore :: Map Text (Set NodeId) addScore :: Map Text (Set NodeId)
-> Map Text (GroupedTextScores (Set NodeId)) -> Map Text (GroupedTextScores (Set NodeId))
-> Map Text (GroupedTextScores (Set NodeId)) -> Map Text (GroupedTextScores (Set NodeId))
...@@ -102,8 +107,15 @@ addIfNotExist mapSocialScores mapScores = ...@@ -102,8 +107,15 @@ addIfNotExist mapSocialScores mapScores =
_ -> m _ -> m
add ns' Nothing = Just $ GroupedTextScores Nothing ns' Set.empty add ns' Nothing = Just $ GroupedTextScores Nothing ns' Set.empty
add _ _ = Nothing -- should not be present add _ _ = Nothing -- should not be present
------------------------------------------------------------------------
{-
toGroupedTextScores' :: Map Parent GroupedWithListScores
-> Map Text (Set NodeId)
-> Map Parent (GroupedTextScores' (Set NodeId))
toGroupedTextScores' par datas = undefined
-}
------------------------------------------------------------------------ ------------------------------------------------------------------------
fromGroupedScores :: Map Parent GroupedWithListScores fromGroupedScores :: Map Parent GroupedWithListScores
......
...@@ -20,6 +20,7 @@ import Gargantext.API.Ngrams.Tools -- (getListNgrams) ...@@ -20,6 +20,7 @@ import Gargantext.API.Ngrams.Tools -- (getListNgrams)
import Gargantext.API.Ngrams.Types import Gargantext.API.Ngrams.Types
import Gargantext.Core.Text.List.Social.Find import Gargantext.Core.Text.List.Social.Find
import Gargantext.Core.Text.List.Social.ListType import Gargantext.Core.Text.List.Social.ListType
import Gargantext.Core.Text.List.Social.Prelude
import Gargantext.Core.Text.List.Social.Scores import Gargantext.Core.Text.List.Social.Scores
import Gargantext.Core.Types.Individu import Gargantext.Core.Types.Individu
import Gargantext.Core.Types.Main import Gargantext.Core.Types.Main
......
{-|
Module : Gargantext.Core.Text.List.Social.Prelude
Description :
Copyright : (c) CNRS, 2018-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
module Gargantext.Core.Text.List.Social.Prelude
where
import Data.Map (Map)
import Data.Text (Text)
import Gargantext.Prelude
import qualified Data.Map as Map
------------------------------------------------------------------------
-- | Tools to inherit groupings
------------------------------------------------------------------------
-- | Tools
parentUnionsMerge :: (Ord a, Ord b, Num c)
=> [Map a (Map b c)]
-> Map a (Map b c)
parentUnionsMerge = Map.unionsWith (Map.unionWith (+))
-- This Parent union is specific
-- [Private, Shared, Public]
-- means the following preferences:
-- Private > Shared > Public
-- if data have not been tagged privately, then use others tags
-- This unions behavior takes first key only and ignore others
parentUnionsExcl :: Ord a
=> [Map a b]
-> Map a b
parentUnionsExcl = Map.unions
------------------------------------------------------------------------
type Parent = Text
hasParent :: Text
-> Map Text (Map Parent Int)
-> Maybe Parent
hasParent t m = case Map.lookup t m of
Nothing -> Nothing
Just m' -> keyWithMaxValue m'
------------------------------------------------------------------------
keyWithMaxValue :: Map a b -> Maybe a
keyWithMaxValue m = (fst . fst) <$> Map.maxViewWithKey m
...@@ -26,48 +26,15 @@ import Data.Text (Text) ...@@ -26,48 +26,15 @@ import Data.Text (Text)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.API.Ngrams.Types import Gargantext.API.Ngrams.Types
import Gargantext.Core.Types.Main import Gargantext.Core.Types.Main
import Gargantext.Core.Text.List.Social.Prelude
import Gargantext.Prelude import Gargantext.Prelude
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Tools to inherit groupings -- | Datatype definition
------------------------------------------------------------------------
-- | Tools
parentUnionsMerge :: (Ord a, Ord b, Num c)
=> [Map a (Map b c)]
-> Map a (Map b c)
parentUnionsMerge = Map.unionsWith (Map.unionWith (+))
-- This Parent union is specific
-- [Private, Shared, Public]
-- means the following preferences:
-- Private > Shared > Public
-- if data have not been tagged privately, then use others tags
-- This unions behavior takes first key only and ignore others
parentUnionsExcl :: Ord a
=> [Map a b]
-> Map a b
parentUnionsExcl = Map.unions
------------------------------------------------------------------------
type Parent = Text
hasParent :: Text
-> Map Text (Map Parent Int)
-> Maybe Parent
hasParent t m = case Map.lookup t m of
Nothing -> Nothing
Just m' -> keyWithMaxValue m'
------------------------------------------------------------------------
keyWithMaxValue :: Map a b -> Maybe a
keyWithMaxValue m = (fst . fst) <$> Map.maxViewWithKey m
------------------------------------------------------------------------
data FlowListScores = data FlowListScores =
FlowListScores { _fls_parents :: Map Parent Int FlowListScores { _fls_parents :: Map Parent Int
, _fls_listType :: Map ListType Int , _fls_listType :: Map ListType Int
-- You can add any score by incrementing this type -- You can add any score by incrementing this type
-- , _flc_score :: Map Score Int -- , _flc_score :: Map Score Int
...@@ -76,29 +43,31 @@ data FlowListScores = ...@@ -76,29 +43,31 @@ data FlowListScores =
makeLenses ''FlowListScores makeLenses ''FlowListScores
-- | Rules to compose 2 datatype FlowListScores
-- Triangle de Pascal, nombre d'or ou pi ?
instance Semigroup FlowListScores where instance Semigroup FlowListScores where
(<>) (FlowListScores p1 l1) (FlowListScores p2 l2) = (<>) (FlowListScores p1 l1)
FlowListScores (p1 <> p2) (l1 <> l2) (FlowListScores p2 l2) =
FlowListScores (p1 <> p2)
(l1 <> l2)
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | toFlowListScores which generate Score from list of Map Text -- | Generates Score from list of Map Text NgramsRepoElement
-- NgramsRepoElement
toFlowListScores :: KeepAllParents toFlowListScores :: KeepAllParents
-> Set Text -> Set Text
-> Map Text FlowListScores -> Map Text FlowListScores
-> [Map Text NgramsRepoElement] -> [Map Text NgramsRepoElement]
-> Map Text FlowListScores -> Map Text FlowListScores
toFlowListScores k ts = foldl' (toFlowListScores' k ts) toFlowListScores k st = foldl' (toFlowListScores' k st)
where where
toFlowListScores' :: KeepAllParents toFlowListScores' :: KeepAllParents
-> Set Text -> Set Text
-> Map Text FlowListScores -> Map Text FlowListScores
-> Map Text NgramsRepoElement -> Map Text NgramsRepoElement
-> Map Text FlowListScores -> Map Text FlowListScores
toFlowListScores' k' ts' to' ngramsRepo = toFlowListScores' k' st' to' ngramsRepo =
Set.foldl' (toFlowListScores'' k' ts' ngramsRepo) to' ts' Set.foldl' (toFlowListScores'' k' st' ngramsRepo) to' st'
toFlowListScores'' :: KeepAllParents toFlowListScores'' :: KeepAllParents
-> Set Text -> Set Text
...@@ -106,10 +75,10 @@ toFlowListScores k ts = foldl' (toFlowListScores' k ts) ...@@ -106,10 +75,10 @@ toFlowListScores k ts = foldl' (toFlowListScores' k ts)
-> Map Text FlowListScores -> Map Text FlowListScores
-> Text -> Text
-> Map Text FlowListScores -> Map Text FlowListScores
toFlowListScores'' k'' ss ngramsRepo to'' t = toFlowListScores'' k'' st'' ngramsRepo to'' t =
case Map.lookup t ngramsRepo of case Map.lookup t ngramsRepo of
Nothing -> to'' Nothing -> to''
Just nre -> Map.alter (addParent k'' nre ss) t Just nre -> Map.alter (addParent k'' nre st'') t
$ Map.alter (addList $ _nre_list nre) t to'' $ Map.alter (addList $ _nre_list nre) t to''
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
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