Commit 9bb32e37 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FEAT] Social lists WithParent class and instances

parent 8bccd07f
Pipeline #1207 failed with stage
...@@ -136,30 +136,29 @@ toGroupedText_FlowListScores :: ( FlowList a b ...@@ -136,30 +136,29 @@ toGroupedText_FlowListScores :: ( FlowList a b
toGroupedText_FlowListScores = undefined toGroupedText_FlowListScores = undefined
toGroupedText_FlowListScores' :: ( FlowList a b, Ord b) toGroupedText_FlowListScores' :: ( FlowList a b, Ord b)
=> ( Map Text c => Map Text c
, Maybe a -> (Text,c) -> a
, Text -> a -> a
)
-> Map Text FlowListScores -> Map Text FlowListScores
-> ( [a] -> ( [a]
, Map Text (GroupedText b) , Map Text (GroupedText b)
) )
toGroupedText_FlowListScores' (ms', to, with) scores = foldl' fun_group start ms toGroupedText_FlowListScores' ms' scores = foldl' fun_group start ms
where where
start = ([], Map.empty) start = ([], Map.empty)
ms = (to Nothing) <$> Map.toList ms' ms = map selfParent (Map.toList ms')
fun_group (left, grouped) current = fun_group (left, grouped) current =
case Map.lookup (hasNgrams current) scores of case Map.lookup (hasNgrams current) scores of
Just scores' -> case keyWithMaxValue $ scores' ^. flc_parents of Just scores' ->
Nothing -> (left, Map.alter (updateWith scores' current) (hasNgrams current) grouped) case keyWithMaxValue $ scores' ^. flc_parents of
Just parent -> fun_group (left, grouped) (with parent current) Nothing -> (left, Map.alter (updateWith scores' current) (hasNgrams current) grouped)
Just parent -> fun_group (left, grouped) (withParent ms' parent current)
Nothing -> (current : left, grouped) Nothing -> (current : left, grouped)
updateWith scores current Nothing = Just $ createGroupWith scores current updateWith scores current Nothing = Just $ createGroupWith scores current
updateWith scores current (Just x) = Just $ updateGroupWith scores current x updateWith scores current (Just x) = Just $ updateGroupWith scores current x
type FlowList a b = (HasNgrams a, HasGroup a b) ------------------------------------------------------------------------
type FlowList a b = (HasNgrams a, HasGroup a b, WithParent a)
class HasNgrams a where class HasNgrams a where
hasNgrams :: a -> Text hasNgrams :: a -> Text
...@@ -168,6 +167,10 @@ class HasGroup a b | a -> b where ...@@ -168,6 +167,10 @@ class HasGroup a b | a -> b where
createGroupWith :: FlowListScores -> a -> GroupedText b createGroupWith :: FlowListScores -> a -> GroupedText b
updateGroupWith :: FlowListScores -> a -> GroupedText b -> GroupedText b updateGroupWith :: FlowListScores -> a -> GroupedText b -> GroupedText b
class WithParent a where
selfParent :: (Text, c) -> a
withParent :: Map Text c -> Text -> a -> a
------------------------------------------------------------------------ ------------------------------------------------------------------------
type Stem = Text type Stem = Text
type Label = Text type Label = Text
......
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