Commit acad4d47 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Type] Instance FlowLists

parent 4b2f54ab
......@@ -89,22 +89,26 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
<- flowSocialList' MySelfFirst user nt (FlowCont Map.empty $ Set.fromList $ Map.keys ngs')
-- PrivateFirst for first developments since Public NodeMode is not implemented yet
{-
printDebug "flowSocialList'"
$ Map.filter (not . ((==) Map.empty) . view fls_parents)
$ view flc_scores socialLists'
-}
let
groupParams = GroupedTextParams groupIt (Set.size . snd) fst snd {-(size . fst)-}
groupedWithList = toGroupedText groupParams (view flc_scores socialLists') ngs'
{-
printDebug "groupedWithList"
$ Map.map (\v -> (view gt_label v, view gt_children v))
$ Map.filter (\v -> (Set.size $ view gt_children v) > 0)
$ groupedWithList
-}
let
(stopTerms, tailTerms) = Map.partition (\t -> t ^. gt_listType == Just StopTerm) groupedWithList
(mapTerms, tailTerms') = Map.partition (\t -> t ^. gt_listType == Just MapTerm) tailTerms
(stopTerms, tailTerms) = Map.partition ((== Just StopTerm) . viewListType) groupedWithList
(mapTerms, tailTerms') = Map.partition ((== Just MapTerm) . viewListType) tailTerms
listSize = mapListSize - (List.length mapTerms)
(mapTerms', candiTerms) = List.splitAt listSize
......@@ -114,9 +118,9 @@ buildNgramsOthersList user uCid groupIt (nt, MapListSize mapListSize) = do
pure $ Map.fromList [( nt, (List.concat $ map toNgramsElement stopTerms)
<> (List.concat $ map toNgramsElement mapTerms )
<> (List.concat $ map toNgramsElement
$ map (set gt_listType (Just MapTerm )) mapTerms' )
$ map (setListType (Just MapTerm )) mapTerms' )
<> (List.concat $ map toNgramsElement
$ map (set gt_listType (Just CandidateTerm)) candiTerms)
$ map (setListType (Just CandidateTerm)) candiTerms)
)]
......
......@@ -42,57 +42,6 @@ toGroupedText groupParams scores =
(groupWithStem groupParams) . (groupWithScores scores)
------------------------------------------------------------------------
-- | TODO put in test folder
toGroupedText_test :: Bool -- Map Stem (GroupedText Int)
toGroupedText_test =
-- fromGroupedScores $ fromListScores from
toGroupedText params from datas == result
where
params = GroupedTextParams identity (Set.size . snd) fst snd
from :: Map Text FlowListScores
from = Map.fromList [("A. Rahmani",FlowListScores {_fls_parents = Map.fromList [("T. Reposeur",1)]
,_fls_listType = Map.fromList [(MapTerm,2)]})
,("B. Tamain",FlowListScores {_fls_parents = Map.fromList [("T. Reposeur",1)]
, _fls_listType = Map.fromList [(MapTerm,2)]})
]
datas :: Map Text (Set NodeId)
datas = Map.fromList [("A. Rahmani" , Set.fromList [1,2])
,("T. Reposeur", Set.fromList [3,4])
,("B. Tamain" , Set.fromList [5,6])
]
result :: Map Stem (GroupedText Int)
result = Map.fromList [("A. Rahmani",GroupedText {_gt_listType = Nothing
,_gt_label = "A. Rahmani"
,_gt_score = 2
,_gt_children = Set.empty
,_gt_size = 2
,_gt_stem = "A. Rahmani"
,_gt_nodes = Set.fromList [1,2]
}
)
,("B. Tamain",GroupedText {_gt_listType = Nothing
, _gt_label = "B. Tamain"
, _gt_score = 2
, _gt_children = Set.empty
, _gt_size = 2
, _gt_stem = "B. Tamain"
, _gt_nodes = Set.fromList [5,6]
}
)
,("T. Reposeur",GroupedText {_gt_listType = Nothing
,_gt_label = "T. Reposeur"
,_gt_score = 2
,_gt_children = Set.fromList ["A. Rahmani","B. Tamain"]
,_gt_size = 2
,_gt_stem = "T. Reposeur"
,_gt_nodes = Set.fromList [1..6]
}
)
]
------------------------------------------------------------------------
-- | TODO To be removed
addListType :: Map Text ListType -> GroupedText a -> GroupedText a
......
......@@ -14,7 +14,7 @@ Portability : POSIX
module Gargantext.Core.Text.List.Group.Prelude
where
import Control.Lens (makeLenses)
import Control.Lens (makeLenses, view, set)
import Data.Monoid
import Data.Semigroup
import Data.Set (Set)
......@@ -50,6 +50,28 @@ instance (Ord score, Monoid score)
makeLenses 'GroupedTreeScores
---------------------------------------------
class ViewListType a where
viewListType :: a -> Maybe ListType
class SetListType a where
setListType :: Maybe ListType -> a -> a
class ViewScore a b where
viewScore :: a -> b
instance ViewListType (GroupedTreeScores a) where
viewListType = view gts'_listType
instance SetListType (GroupedTreeScores a) where
setListType = set gts'_listType
{-
instance ViewScore (GroupedTreeScores a) b where
viewScore = view gts'_score
-}
-- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
-- TODO to remove below
......@@ -70,8 +92,6 @@ instance Monoid GroupedWithListScores where
makeLenses ''GroupedWithListScores
-- 8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--8<--
------------------------------------------------------------------------
------------------------------------------------------------------------
-- | Group With Stem Main Types
......@@ -85,6 +105,16 @@ data GroupedText score =
, _gt_stem :: !Stem -- needed ?
, _gt_nodes :: !(Set NodeId)
} deriving (Show, Eq) --}
-- | Lenses Instances
makeLenses 'GroupedText
instance ViewListType (GroupedText a) where
viewListType = view gt_listType
instance SetListType (GroupedText a) where
setListType = set gt_listType
{-
instance Show score => Show (GroupedText score) where
show (GroupedText lt l s _ _ _ _) = show l <> " : " <> show lt <> " : " <> show s
......@@ -110,5 +140,3 @@ instance Ord a => Semigroup (GroupedText a) where
gr = Set.union group1 group2
nodes = Set.union nodes1 nodes2
-- | Lenses Instances
makeLenses 'GroupedText
......@@ -48,8 +48,8 @@ groupWithScores' flc scores = FlowCont groups orphans
------------------------------------------------------------------------
toMapMaybeParent :: (Text -> Set NodeId)
-> Map Text FlowListScores
-> Map (Maybe Parent) (Map Text (GroupedTreeScores (Set NodeId)))
-> Map Text FlowListScores
-> Map (Maybe Parent) (Map Text (GroupedTreeScores (Set NodeId)))
toMapMaybeParent f = Map.fromListWith (<>) . (map (fromScores'' f)) . Map.toList
fromScores'' :: (Text -> Set NodeId)
......@@ -86,7 +86,6 @@ toGroupedTree' m notEmpty
--8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<-- -8<--
-- TODO TO BE REMOVED
data GroupedTextScores score =
......
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