Commit 0ba78c07 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] History patch working, bug several NRE fixed, needs stemming scores now

parent ad759fa0
...@@ -100,18 +100,18 @@ buildNgramsOthersList user uCid groupParams (nt, MapListSize mapListSize) = do ...@@ -100,18 +100,18 @@ buildNgramsOthersList user uCid groupParams (nt, MapListSize mapListSize) = do
$ List.zip (Map.keys allTerms) $ List.zip (Map.keys allTerms)
(List.cycle [mempty]) (List.cycle [mempty])
) )
{-
if nt == Authors if nt == Sources -- Authors
then printDebug "flowSocialList" socialLists then printDebug "flowSocialList" socialLists
else printDebug "flowSocialList" "" else printDebug "flowSocialList" ""
-}
let let
groupedWithList = toGroupedTree groupParams socialLists allTerms groupedWithList = toGroupedTree groupParams socialLists allTerms
{-
if nt == Authors if nt == Sources -- Authors
then printDebug "groupedWithList" groupedWithList then printDebug "groupedWithList" groupedWithList
else printDebug "groupedWithList" "" else printDebug "groupedWithList" ""
-}
let let
(stopTerms, tailTerms) = Map.partition ((== Just StopTerm) . viewListType) (stopTerms, tailTerms) = Map.partition ((== Just StopTerm) . viewListType)
......
...@@ -38,12 +38,14 @@ groupWithScores' flc scores = FlowCont groups orphans ...@@ -38,12 +38,14 @@ groupWithScores' flc scores = FlowCont groups orphans
-- parent/child relation is inherited from social lists -- parent/child relation is inherited from social lists
groups = toGroupedTree groups = toGroupedTree
$ toMapMaybeParent scores $ toMapMaybeParent scores
$ view flc_scores flc $ (view flc_scores flc <> view flc_cont flc)
-- orphans should be filtered already -- orphans should be filtered already
orphans = toGroupedTree orphans = mempty {- toGroupedTree
$ toMapMaybeParent scores $ toMapMaybeParent scores
$ view flc_cont flc $ view flc_cont flc
-}
------------------------------------------------------------------------ ------------------------------------------------------------------------
toMapMaybeParent :: (Eq a, Ord a, Monoid a) toMapMaybeParent :: (Eq a, Ord a, Monoid a)
......
...@@ -97,14 +97,6 @@ parentUnionsExcl :: Ord a ...@@ -97,14 +97,6 @@ parentUnionsExcl :: Ord a
-> Map a b -> Map a b
parentUnionsExcl = Map.unions parentUnionsExcl = Map.unions
------------------------------------------------------------------------
hasParent :: Text
-> Map Text (Map Parent Int)
-> Maybe Parent
hasParent t m = case Map.lookup t m of
Nothing -> Nothing
Just m' -> keyWithMaxValue m'
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Takes key with max value if and only if value > 0 -- | Takes key with max value if and only if value > 0
-- If value <= 0 alors key is not taken at all -- If value <= 0 alors key is not taken at all
...@@ -113,12 +105,15 @@ hasParent t m = case Map.lookup t m of ...@@ -113,12 +105,15 @@ hasParent t m = case Map.lookup t m of
-- Just 'z' -- Just 'z'
-- >>> keyWithMaxValue $ DM.fromList $ zip (['a'..'z'] :: [Char]) ([-1,-2..]::[Int]) -- >>> keyWithMaxValue $ DM.fromList $ zip (['a'..'z'] :: [Char]) ([-1,-2..]::[Int])
-- Nothing -- Nothing
keyWithMaxValue :: (Ord a, Ord b, Num b) => Map a b -> Maybe a -- TODO duplicate with getMaxFromMap and improve it (lookup value should not be needed)
-- TODO put in custom Prelude
keyWithMaxValue :: (Ord a, Ord b, Num b)
=> Map a b -> Maybe a
keyWithMaxValue m = do keyWithMaxValue m = do
k <- headMay $ getMaxFromMap m maxKey <- headMay $ getMaxFromMap m
maxValue <- Map.lookup k m maxValue <- Map.lookup maxKey m
if maxValue > 0 if maxValue > 0
then pure k then pure maxKey
else Nothing else Nothing
......
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