Commit 80e7ae38 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[PHYLO][API] Get implemented.

parent b04c334f
...@@ -317,11 +317,11 @@ graphAPI nId = do ...@@ -317,11 +317,11 @@ graphAPI nId = do
type PhyloAPI = Summary "Phylo API" type PhyloAPI = Summary "Phylo API"
:> QueryParam "param" PhyloQueryView -- :> QueryParam "param" PhyloQueryView
:> Get '[JSON] PhyloView :> Get '[JSON] PhyloView
phyloAPI :: NodeId -> GargServer PhyloAPI phyloAPI :: NodeId -> GargServer PhyloAPI
phyloAPI n q = pure $ getPhylo n q phyloAPI n = pure $ getPhylo n
......
...@@ -74,7 +74,7 @@ import qualified Data.Map as M ...@@ -74,7 +74,7 @@ import qualified Data.Map as M
import Data.Map.Strict (insertWith) import Data.Map.Strict (insertWith)
import qualified Data.Vector as V import qualified Data.Vector as V
import Safe (headMay, lastMay) import Safe (headMay, lastMay, initMay, tailMay)
import Text.Show (Show(), show) import Text.Show (Show(), show)
import Text.Read (Read()) import Text.Read (Read())
import Data.String.Conversions (cs) import Data.String.Conversions (cs)
...@@ -270,5 +270,33 @@ maximumWith f = L.maximumBy (compare `on` f) ...@@ -270,5 +270,33 @@ maximumWith f = L.maximumBy (compare `on` f)
listToCombi :: forall a b. (a -> b) -> [a] -> [(b,b)] listToCombi :: forall a b. (a -> b) -> [a] -> [(b,b)]
listToCombi f l = [ (f x, f y) | (x:rest) <- L.tails l, y <- rest ] listToCombi f l = [ (f x, f y) | (x:rest) <- L.tails l, y <- rest ]
------------------------------------------------------------------------
-- Empty List Sugar Error Handling
-- TODO add Garg Monad Errors
listSafe1 :: Text -> ([a] -> Maybe a)
-> Text -> [a] -> a
listSafe1 s f e xs = maybe (panic $ h <> e) identity (f xs)
where
h = "[ERR][Gargantext] Empty list for " <> s <> " in "
head' :: Text -> [a] -> a head' :: Text -> [a] -> a
head' e xs = maybe (panic e) identity (head xs) head' = listSafe1 "head" headMay
last' :: Text -> [a] -> a
last' = listSafe1 "last" lastMay
------------------------------------------------------------------------
listSafeN :: Text -> ([a] -> Maybe [a])
-> Text -> [a] -> [a]
listSafeN s f e xs = maybe (panic $ h <> e) identity (f xs)
where
h = "[ERR][Gargantext] Empty list for " <> s <> " in "
tail' :: Text -> [a] -> [a]
tail' = listSafeN "tail" tailMay
init' :: Text -> [a] -> [a]
init' = listSafeN "init" initMay
...@@ -122,12 +122,11 @@ splitDoc' :: SplitContext -> CsvDoc -> Vector CsvDoc ...@@ -122,12 +122,11 @@ splitDoc' :: SplitContext -> CsvDoc -> Vector CsvDoc
splitDoc' contextSize (CsvDoc t s py pm pd abst auth) = V.fromList $ [firstDoc] <> nextDocs splitDoc' contextSize (CsvDoc t s py pm pd abst auth) = V.fromList $ [firstDoc] <> nextDocs
where where
firstDoc = CsvDoc t s py pm pd firstAbstract auth firstDoc = CsvDoc t s py pm pd firstAbstract auth
firstAbstract = head' abstracts firstAbstract = head' "splitDoc'1" abstracts
nextDocs = map (\txt -> CsvDoc (head' $ sentences txt) s py pm pd (unsentences $ tail' $ sentences txt) auth) (tail' abstracts) nextDocs = map (\txt -> CsvDoc (head' "splitDoc'2" $ sentences txt) s py pm pd (unsentences $ tail' $ sentences txt) auth) (tail' abstracts)
abstracts = (splitBy $ contextSize) abst abstracts = (splitBy $ contextSize) abst
head' x = maybe "" identity (head x)
tail' x = maybe [""] identity (tailMay x) tail' x = maybe [""] identity (tailMay x)
--------------------------------------------------------------- ---------------------------------------------------------------
......
...@@ -42,7 +42,6 @@ import GHC.Generics (Generic) ...@@ -42,7 +42,6 @@ import GHC.Generics (Generic)
import Gargantext.Core.Utils.Prefix (unPrefix) import Gargantext.Core.Utils.Prefix (unPrefix)
import Gargantext.Prelude import Gargantext.Prelude
-------------------- --------------------
-- | PhyloParam | -- -- | PhyloParam | --
-------------------- --------------------
...@@ -238,21 +237,21 @@ data PhyloError = LevelDoesNotExist ...@@ -238,21 +237,21 @@ data PhyloError = LevelDoesNotExist
data Cluster = Fis FisParams data Cluster = Fis FisParams
| RelatedComponents RCParams | RelatedComponents RCParams
| Louvain LouvainParams | Louvain LouvainParams
deriving (Show, Eq) deriving (Generic, Show, Eq)
-- | Parameters for Fis clustering -- | Parameters for Fis clustering
data FisParams = FisParams data FisParams = FisParams
{ _fis_keepMinorFis :: Bool { _fis_keepMinorFis :: Bool
, _fis_minSupport :: Support , _fis_minSupport :: Support
} deriving (Show, Eq) } deriving (Generic, Show, Eq)
-- | Parameters for RelatedComponents clustering -- | Parameters for RelatedComponents clustering
data RCParams = RCParams data RCParams = RCParams
{ _rc_proximity :: Proximity } deriving (Show, Eq) { _rc_proximity :: Proximity } deriving (Generic, Show, Eq)
-- | Parameters for Louvain clustering -- | Parameters for Louvain clustering
data LouvainParams = LouvainParams data LouvainParams = LouvainParams
{ _louvain_proximity :: Proximity } deriving (Show, Eq) { _louvain_proximity :: Proximity } deriving (Generic, Show, Eq)
------------------- -------------------
...@@ -264,17 +263,17 @@ data LouvainParams = LouvainParams ...@@ -264,17 +263,17 @@ data LouvainParams = LouvainParams
data Proximity = WeightedLogJaccard WLJParams data Proximity = WeightedLogJaccard WLJParams
| Hamming HammingParams | Hamming HammingParams
| Filiation | Filiation
deriving (Show, Eq) deriving (Generic, Show, Eq)
-- | Parameters for WeightedLogJaccard proximity -- | Parameters for WeightedLogJaccard proximity
data WLJParams = WLJParams data WLJParams = WLJParams
{ _wlj_threshold :: Double { _wlj_threshold :: Double
, _wlj_sensibility :: Double , _wlj_sensibility :: Double
} deriving (Show, Eq) } deriving (Generic, Show, Eq)
-- | Parameters for Hamming proximity -- | Parameters for Hamming proximity
data HammingParams = HammingParams data HammingParams = HammingParams
{ _hamming_threshold :: Double } deriving (Show, Eq) { _hamming_threshold :: Double } deriving (Generic, Show, Eq)
---------------- ----------------
...@@ -283,13 +282,13 @@ data HammingParams = HammingParams ...@@ -283,13 +282,13 @@ data HammingParams = HammingParams
-- | Filter constructors -- | Filter constructors
data Filter = SmallBranch SBParams deriving (Show, Eq) data Filter = SmallBranch SBParams deriving (Generic, Show, Eq)
-- | Parameters for SmallBranch filter -- | Parameters for SmallBranch filter
data SBParams = SBParams data SBParams = SBParams
{ _sb_periodsInf :: Int { _sb_periodsInf :: Int
, _sb_periodsSup :: Int , _sb_periodsSup :: Int
, _sb_minNodes :: Int } deriving (Show, Eq) , _sb_minNodes :: Int } deriving (Generic, Show, Eq)
---------------- ----------------
...@@ -298,7 +297,7 @@ data SBParams = SBParams ...@@ -298,7 +297,7 @@ data SBParams = SBParams
-- | Metric constructors -- | Metric constructors
data Metric = BranchAge deriving (Show, Eq) data Metric = BranchAge deriving (Generic, Show, Eq)
---------------- ----------------
...@@ -316,8 +315,8 @@ data Tagger = BranchLabelFreq | GroupLabelCooc | GroupDynamics deriving (Show) ...@@ -316,8 +315,8 @@ data Tagger = BranchLabelFreq | GroupLabelCooc | GroupDynamics deriving (Show)
-- | Sort constructors -- | Sort constructors
data Sort = ByBranchAge deriving (Show) data Sort = ByBranchAge deriving (Generic, Show)
data Order = Asc | Desc deriving (Show) data Order = Asc | Desc deriving (Generic, Show)
-------------------- --------------------
...@@ -346,11 +345,11 @@ data PhyloQueryBuild = PhyloQueryBuild ...@@ -346,11 +345,11 @@ data PhyloQueryBuild = PhyloQueryBuild
, _q_nthLevel :: Level , _q_nthLevel :: Level
-- Clustering method used from level 1 to nthLevel -- Clustering method used from level 1 to nthLevel
, _q_nthCluster :: Cluster , _q_nthCluster :: Cluster
} deriving (Show, Eq) } deriving (Generic, Show, Eq)
-- | To choose the Phylo edge you want to export : --> <-- <--> <=> -- | To choose the Phylo edge you want to export : --> <-- <--> <=>
data Filiation = Ascendant | Descendant | Merge | Complete deriving (Show) data Filiation = Ascendant | Descendant | Merge | Complete deriving (Generic, Show)
data EdgeType = PeriodEdge | LevelEdge deriving (Show) data EdgeType = PeriodEdge | LevelEdge deriving (Generic, Show)
------------------- -------------------
-- | PhyloView | -- -- | PhyloView | --
...@@ -367,21 +366,21 @@ data PhyloView = PhyloView ...@@ -367,21 +366,21 @@ data PhyloView = PhyloView
, _pv_branches :: [PhyloBranch] , _pv_branches :: [PhyloBranch]
, _pv_nodes :: [PhyloNode] , _pv_nodes :: [PhyloNode]
, _pv_edges :: [PhyloEdge] , _pv_edges :: [PhyloEdge]
} deriving (Show) } deriving (Generic, Show)
-- | A phyloview is made of PhyloBranches, edges and nodes -- | A phyloview is made of PhyloBranches, edges and nodes
data PhyloBranch = PhyloBranch data PhyloBranch = PhyloBranch
{ _pb_id :: PhyloBranchId { _pb_id :: PhyloBranchId
, _pb_label :: Text , _pb_label :: Text
, _pb_metrics :: Map Text [Double] , _pb_metrics :: Map Text [Double]
} deriving (Show) } deriving (Generic, Show)
data PhyloEdge = PhyloEdge data PhyloEdge = PhyloEdge
{ _pe_source :: PhyloGroupId { _pe_source :: PhyloGroupId
, _pe_target :: PhyloGroupId , _pe_target :: PhyloGroupId
, _pe_type :: EdgeType , _pe_type :: EdgeType
, _pe_weight :: Weight , _pe_weight :: Weight
} deriving (Show) } deriving (Generic, Show)
data PhyloNode = PhyloNode data PhyloNode = PhyloNode
{ _pn_id :: PhyloGroupId { _pn_id :: PhyloGroupId
...@@ -392,7 +391,7 @@ data PhyloNode = PhyloNode ...@@ -392,7 +391,7 @@ data PhyloNode = PhyloNode
, _pn_metrics :: Map Text [Double] , _pn_metrics :: Map Text [Double]
, _pn_parents :: Maybe [PhyloGroupId] , _pn_parents :: Maybe [PhyloGroupId]
, _pn_childs :: [PhyloNode] , _pn_childs :: [PhyloNode]
} deriving (Show) } deriving (Generic, Show)
------------------------ ------------------------
......
...@@ -9,20 +9,30 @@ Portability : POSIX ...@@ -9,20 +9,30 @@ Portability : POSIX
-} -}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-} -- allows to write Text literals
{-# LANGUAGE OverloadedLists #-} -- allows to write Map and HashMap as lists
module Gargantext.Viz.Phylo.API module Gargantext.Viz.Phylo.API
where where
--{- import Data.Swagger
import Servant.Job.Utils (swaggerOptions)
import Gargantext.Database.Types.Node (PhyloId, ListId, CorpusId) import Gargantext.Database.Types.Node (PhyloId, ListId, CorpusId)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Viz.Phylo import Gargantext.Viz.Phylo
import Gargantext.Viz.Phylo.Example import Gargantext.Viz.Phylo.Example
import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
getPhylo :: PhyloId -> Maybe PhyloQueryView -> PhyloView
getPhylo _phyloId _phyloQueryView = phyloView getPhylo :: PhyloId -> PhyloView
getPhylo _phyloId = phyloView
--getPhylo :: PhyloId -> Maybe PhyloQueryView -> PhyloView
--getPhylo _phyloId _phyloQueryView = phyloView
postPhylo :: CorpusId -> Maybe ListId -> PhyloQueryBuild -> Phylo postPhylo :: CorpusId -> Maybe ListId -> PhyloQueryBuild -> Phylo
postPhylo = undefined postPhylo = undefined
...@@ -33,4 +43,34 @@ putPhylo = undefined ...@@ -33,4 +43,34 @@ putPhylo = undefined
deletePhylo :: PhyloId -> IO () deletePhylo :: PhyloId -> IO ()
deletePhylo = undefined deletePhylo = undefined
--}
-- | Instances
instance ToSchema Cluster
instance ToSchema EdgeType
instance ToSchema Filiation
instance ToSchema Filter
instance ToSchema FisParams
instance ToSchema HammingParams
instance ToSchema LouvainParams
instance ToSchema Metric
instance ToSchema PhyloBranch
instance ToSchema PhyloEdge
instance ToSchema PhyloNode
instance ToSchema PhyloParam
instance ToSchema PhyloQueryBuild
instance ToSchema PhyloView
instance ToSchema RCParams
instance ToSchema SBParams
instance ToSchema Software
instance ToSchema WLJParams
instance ToSchema Proximity
where
declareNamedSchema = genericDeclareNamedSchemaUnrestricted
$ swaggerOptions ""
instance Arbitrary PhyloView
where
arbitrary = elements [phyloView]
...@@ -19,7 +19,6 @@ module Gargantext.Viz.Phylo.Aggregates.Cooc ...@@ -19,7 +19,6 @@ module Gargantext.Viz.Phylo.Aggregates.Cooc
import Data.List (union,concat) import Data.List (union,concat)
import Data.Map (Map, elems, adjust) import Data.Map (Map, elems, adjust)
import Data.Maybe (maybe)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Viz.Phylo import Gargantext.Viz.Phylo
import Gargantext.Viz.Phylo.Tools import Gargantext.Viz.Phylo.Tools
...@@ -27,7 +26,6 @@ import qualified Data.Map as Map ...@@ -27,7 +26,6 @@ import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
-- | To transform the Fis into a coocurency Matrix in a Phylo -- | To transform the Fis into a coocurency Matrix in a Phylo
fisToCooc :: Map (Date, Date) [PhyloFis] -> Phylo -> Map (Int, Int) Double fisToCooc :: Map (Date, Date) [PhyloFis] -> Phylo -> Map (Int, Int) Double
fisToCooc m p = map (/docs) fisToCooc m p = map (/docs)
......
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