Commit 7c1ce395 authored by Quentin Lobbé's avatar Quentin Lobbé

just finalized the dot export

parent edd553c5
Pipeline #348 failed with stage
...@@ -362,6 +362,7 @@ data PhyloView = PhyloView ...@@ -362,6 +362,7 @@ data PhyloView = PhyloView
, _pv_title :: Text , _pv_title :: Text
, _pv_description :: Text , _pv_description :: Text
, _pv_filiation :: Filiation , _pv_filiation :: Filiation
, _pv_level :: Level
, _pv_metrics :: Map Text [Double] , _pv_metrics :: Map Text [Double]
, _pv_branches :: [PhyloBranch] , _pv_branches :: [PhyloBranch]
, _pv_nodes :: [PhyloNode] , _pv_nodes :: [PhyloNode]
...@@ -398,6 +399,7 @@ data PhyloNode = PhyloNode ...@@ -398,6 +399,7 @@ data PhyloNode = PhyloNode
------------------------ ------------------------
data ExportMode = Json | Dot | Svg
data DisplayMode = Flat | Nested data DisplayMode = Flat | Nested
-- | A PhyloQueryView describes a Phylo as an output view -- | A PhyloQueryView describes a Phylo as an output view
...@@ -421,6 +423,7 @@ data PhyloQueryView = PhyloQueryView ...@@ -421,6 +423,7 @@ data PhyloQueryView = PhyloQueryView
, _qv_sort :: Maybe (Sort,Order) , _qv_sort :: Maybe (Sort,Order)
-- A display mode to apply to the PhyloGraph, ie: [Node[Node,Edge],Edge] or [[Node,Node],[Edge,Edge]] -- A display mode to apply to the PhyloGraph, ie: [Node[Node,Edge],Edge] or [[Node,Node],[Edge,Edge]]
, _qv_export :: ExportMode
, _qv_display :: DisplayMode , _qv_display :: DisplayMode
, _qv_verbose :: Bool , _qv_verbose :: Bool
} }
......
...@@ -28,6 +28,7 @@ TODO: ...@@ -28,6 +28,7 @@ TODO:
module Gargantext.Viz.Phylo.Example where module Gargantext.Viz.Phylo.Example where
import Data.GraphViz.Types.Generalised (DotGraph)
import Data.Text (Text) import Data.Text (Text)
import Data.List ((++), last) import Data.List ((++), last)
import Data.Map (Map) import Data.Map (Map)
...@@ -44,6 +45,7 @@ import Gargantext.Viz.Phylo.LevelMaker ...@@ -44,6 +45,7 @@ import Gargantext.Viz.Phylo.LevelMaker
import Gargantext.Viz.Phylo.LinkMaker import Gargantext.Viz.Phylo.LinkMaker
import Gargantext.Viz.Phylo.Tools import Gargantext.Viz.Phylo.Tools
import Gargantext.Viz.Phylo.View.ViewMaker import Gargantext.Viz.Phylo.View.ViewMaker
import Gargantext.Viz.Phylo.View.Export
import qualified Data.List as List import qualified Data.List as List
...@@ -52,6 +54,9 @@ import qualified Data.List as List ...@@ -52,6 +54,9 @@ import qualified Data.List as List
------------------------------------------------------ ------------------------------------------------------
phyloDot :: DotGraph DotId
phyloDot = viewToDot phyloView
phyloView :: PhyloView phyloView :: PhyloView
phyloView = toPhyloView (queryParser' queryViewEx) phyloFromQuery phyloView = toPhyloView (queryParser' queryViewEx) phyloFromQuery
...@@ -69,7 +74,7 @@ queryViewEx = "level=3" ...@@ -69,7 +74,7 @@ queryViewEx = "level=3"
phyloQueryView :: PhyloQueryView phyloQueryView :: PhyloQueryView
phyloQueryView = PhyloQueryView 2 Merge False 1 [BranchAge] [defaultSmallBranch] [BranchLabelFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Flat True phyloQueryView = PhyloQueryView 2 Merge False 1 [BranchAge] [defaultSmallBranch] [BranchLabelFreq,GroupLabelCooc] (Just (ByBranchAge,Asc)) Json Flat True
-------------------------------------------------- --------------------------------------------------
......
...@@ -586,6 +586,55 @@ getViewBranchIds v = map getBranchId $ v ^. pv_branches ...@@ -586,6 +586,55 @@ getViewBranchIds v = map getBranchId $ v ^. pv_branches
-- | PhyloQuery & QueryView | -- -- | PhyloQuery & QueryView | --
-------------------------------- --------------------------------
-- | To filter PhyloView's Branches by level
filterBranchesByLevel :: Level -> PhyloView -> [PhyloBranch]
filterBranchesByLevel lvl pv = filter (\pb -> lvl == (fst $ pb ^. pb_id))
$ pv ^. pv_branches
-- | To filter PhyloView's Edges by level
filterEdgesByLevel :: Level -> [PhyloEdge] -> [PhyloEdge]
filterEdgesByLevel lvl pes = filter (\pe -> (lvl == ((snd . fst) $ pe ^. pe_source))
&& (lvl == ((snd . fst) $ pe ^. pe_target))) pes
-- | To filter PhyloView's Edges by type
filterEdgesByType :: EdgeType -> [PhyloEdge] -> [PhyloEdge]
filterEdgesByType t pes = filter (\pe -> t == (pe ^. pe_type)) pes
-- | To filter PhyloView's Nodes by the oldest Period
filterNodesByFirstPeriod :: [PhyloNode] -> [PhyloNode]
filterNodesByFirstPeriod pns = filter (\pn -> fstPrd == ((fst . fst) $ pn ^. pn_id)) pns
where
--------------------------------------
fstPrd :: (Date,Date)
fstPrd = (head' "filterNodesByFirstPeriod")
$ sortOn fst
$ map (\pn -> (fst . fst) $ pn ^. pn_id) pns
--------------------------------------
-- | To filter PhyloView's Nodes by Branch
filterNodesByBranch :: PhyloBranchId -> [PhyloNode] -> [PhyloNode]
filterNodesByBranch bId pns = filter (\pn -> if isJust $ pn ^. pn_bid
then if bId == (fromJust $ pn ^. pn_bid)
then True
else False
else False ) pns
-- | To filter PhyloView's Nodes by level
filterNodesByLevel :: Level -> [PhyloNode] -> [PhyloNode]
filterNodesByLevel lvl pns = filter (\pn -> lvl == ((snd . fst) $ pn ^. pn_id)) pns
-- | To filter PhyloView's Nodes by Period
filterNodesByPeriod :: PhyloPeriodId -> [PhyloNode] -> [PhyloNode]
filterNodesByPeriod prd pns = filter (\pn -> prd == ((fst . fst) $ pn ^. pn_id)) pns
-- | To get the first clustering method to apply to get the contextual units of a Phylo -- | To get the first clustering method to apply to get the contextual units of a Phylo
getContextualUnit :: PhyloQueryBuild -> Cluster getContextualUnit :: PhyloQueryBuild -> Cluster
getContextualUnit q = q ^. q_contextualUnit getContextualUnit q = q ^. q_contextualUnit
...@@ -667,9 +716,9 @@ initPhyloQuery name desc (def 5 -> grain) (def 3 -> steps) (def defaultFis -> cl ...@@ -667,9 +716,9 @@ initPhyloQuery name desc (def 5 -> grain) (def 3 -> steps) (def defaultFis -> cl
-- | To initialize a PhyloQueryView default parameters -- | To initialize a PhyloQueryView default parameters
initPhyloQueryView :: Maybe Level -> Maybe Filiation -> Maybe Bool -> Maybe Level -> Maybe [Metric] -> Maybe [Filter] -> Maybe [Tagger] -> Maybe (Sort, Order) -> Maybe DisplayMode -> Maybe Bool -> PhyloQueryView initPhyloQueryView :: Maybe Level -> Maybe Filiation -> Maybe Bool -> Maybe Level -> Maybe [Metric] -> Maybe [Filter] -> Maybe [Tagger] -> Maybe (Sort, Order) -> Maybe ExportMode -> Maybe DisplayMode -> Maybe Bool -> PhyloQueryView
initPhyloQueryView (def 2 -> lvl) (def Descendant -> f) (def False -> c) (def 1 -> d) (def [] -> ms) (def [] -> fs) (def [] -> ts) s (def Flat -> dm) (def True -> v) = initPhyloQueryView (def 2 -> lvl) (def Descendant -> f) (def False -> c) (def 1 -> d) (def [] -> ms) (def [] -> fs) (def [] -> ts) s (def Json -> em) (def Flat -> dm) (def True -> v) =
PhyloQueryView lvl f c d ms fs ts s dm v PhyloQueryView lvl f c d ms fs ts s em dm v
-- | To define some obvious boolean getters -- | To define some obvious boolean getters
...@@ -716,7 +765,7 @@ defaultQuery = initPhyloQuery "Cesar et Cleôpatre" "An example of Phylomemy (fr ...@@ -716,7 +765,7 @@ defaultQuery = initPhyloQuery "Cesar et Cleôpatre" "An example of Phylomemy (fr
Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
defaultQueryView :: PhyloQueryView defaultQueryView :: PhyloQueryView
defaultQueryView = initPhyloQueryView Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing defaultQueryView = initPhyloQueryView Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
-- Software -- Software
......
...@@ -43,11 +43,12 @@ toNestedView ns ns' ...@@ -43,11 +43,12 @@ toNestedView ns ns'
-- | To process a DisplayMode to a PhyloView -- | To process a DisplayMode to a PhyloView
processDisplay :: DisplayMode -> PhyloView -> PhyloView processDisplay :: DisplayMode -> ExportMode -> PhyloView -> PhyloView
processDisplay d v = case d of processDisplay d e v = case e of
Flat -> v Json -> case d of
Nested -> let ns = sortOn getNodeLevel $ v ^. pv_nodes Flat -> v
lvl = getNodeLevel $ head' "processDisplay" ns Nested -> let ns = sortOn getNodeLevel $ v ^. pv_nodes
in v & pv_nodes .~ toNestedView (filter (\n -> lvl == getNodeLevel n) ns) lvl = getNodeLevel $ head' "processDisplay" ns
(filter (\n -> lvl < getNodeLevel n) ns) in v & pv_nodes .~ toNestedView (filter (\n -> lvl == getNodeLevel n) ns)
--_ -> panic "[ERR][Viz.Phylo.Example.processDisplay] display not found" (filter (\n -> lvl < getNodeLevel n) ns)
_ -> v
This diff is collapsed.
...@@ -46,7 +46,7 @@ initPhyloEdge id pts et = map (\pt -> PhyloEdge id (fst pt) et (snd pt)) pts ...@@ -46,7 +46,7 @@ initPhyloEdge id pts et = map (\pt -> PhyloEdge id (fst pt) et (snd pt)) pts
-- | To init a PhyloView -- | To init a PhyloView
initPhyloView :: Level -> Text -> Text -> Filiation -> Bool -> Phylo -> PhyloView initPhyloView :: Level -> Text -> Text -> Filiation -> Bool -> Phylo -> PhyloView
initPhyloView lvl lbl dsc fl vb p = PhyloView (getPhyloParams p) lbl dsc fl empty initPhyloView lvl lbl dsc fl vb p = PhyloView (getPhyloParams p) lbl dsc fl lvl empty
([] ++ (phyloToBranches lvl p)) ([] ++ (phyloToBranches lvl p))
([] ++ (groupsToNodes True vb (getPeaksLabels p) gs)) ([] ++ (groupsToNodes True vb (getPeaksLabels p) gs))
([] ++ (groupsToEdges fl PeriodEdge gs)) ([] ++ (groupsToEdges fl PeriodEdge gs))
...@@ -135,7 +135,7 @@ addChildNodes shouldDo lvl lvlMin vb fl p v = ...@@ -135,7 +135,7 @@ addChildNodes shouldDo lvl lvlMin vb fl p v =
-- | To transform a PhyloQuery into a PhyloView -- | To transform a PhyloQuery into a PhyloView
toPhyloView :: PhyloQueryView -> Phylo -> PhyloView toPhyloView :: PhyloQueryView -> Phylo -> PhyloView
toPhyloView q p = processDisplay (q ^. qv_display) toPhyloView q p = processDisplay (q ^. qv_display) (q ^. qv_export)
$ processSort (q ^. qv_sort ) p $ processSort (q ^. qv_sort ) p
$ processTaggers (q ^. qv_taggers) p $ processTaggers (q ^. qv_taggers) p
$ processFilters (q ^. qv_filters) p $ processFilters (q ^. qv_filters) p
......
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