2 Module : Gargantext.API.Ngrams.NTree
3 Description : Tree of Ngrams
4 Copyright : (c) CNRS, 2017-Present
5 License : AGPL + CECILL v3
6 Maintainer : team@gargantext.org
7 Stability : experimental
12 {-# LANGUAGE NoImplicitPrelude #-}
13 {-# LANGUAGE OverloadedStrings #-}
14 {-# LANGUAGE RankNTypes #-}
15 {-# LANGUAGE DeriveGeneric #-}
16 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
17 {-# LANGUAGE TemplateHaskell #-}
19 module Gargantext.API.Ngrams.NTree
22 import Data.Text (Text)
23 import Gargantext.Prelude
24 import GHC.Generics (Generic)
25 import Data.Aeson.TH (deriveJSON)
26 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger)
27 import Gargantext.Core.Types (ListType(..), NodeId)
28 import Gargantext.API.Ngrams
30 import Data.Maybe (catMaybes)
34 import qualified Data.Set as Set
35 import qualified Data.Map as Map
36 import qualified Data.List as List
37 import Test.QuickCheck
42 data MyTree = MyTree { mt_label :: Text
44 , mt_children :: [MyTree]
45 } deriving (Generic, Show)
47 toMyTree :: Tree (Text,Double) -> MyTree
48 toMyTree (Node (l,v) xs) = MyTree l v (map toMyTree xs)
50 deriveJSON (unPrefix "mt_") ''MyTree
52 instance ToSchema MyTree where
53 declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "mt_")
54 instance Arbitrary MyTree
56 arbitrary = MyTree <$> arbitrary <*> arbitrary <*> arbitrary
58 toTree :: ListType -> Map Text (Set NodeId) -> Map Text NgramsRepoElement -> [MyTree]
59 toTree lt vs m = map toMyTree $ unfoldForest buildNode roots
61 buildNode r = maybe ((r, value r),[]) (\x -> ((r, value r), mSetToList $ _nre_children x)) (Map.lookup r m)
63 value l = maybe 0 (fromIntegral . Set.size) $ Map.lookup l vs
65 rootsCandidates = catMaybes
67 $ map (\(c,c') -> case _nre_root c' of
69 _ -> _nre_root c' ) (Map.toList m)
72 $ filter (\(_,l) -> l == lt)
74 $ map (\c -> (,) <$> Just c <*> (_nre_list <$> Map.lookup c m)) rootsCandidates