Commit 89d26230 authored by Quentin Lobbé's avatar Quentin Lobbé

just finalized the dot export

parent e050b8b6
...@@ -364,6 +364,7 @@ data PhyloView = PhyloView ...@@ -364,6 +364,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]
...@@ -400,6 +401,7 @@ data PhyloNode = PhyloNode ...@@ -400,6 +401,7 @@ data PhyloNode = PhyloNode
------------------------ ------------------------
data ExportMode = Json | Dot | Svg
data DisplayMode = Flat | Nested data DisplayMode = Flat | Nested
deriving (Generic, Show, Read) deriving (Generic, Show, Read)
...@@ -424,6 +426,7 @@ data PhyloQueryView = PhyloQueryView ...@@ -424,6 +426,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
-------------------------------------------------- --------------------------------------------------
......
...@@ -588,6 +588,55 @@ getViewBranchIds v = map getBranchId $ v ^. pv_branches ...@@ -588,6 +588,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
...@@ -673,9 +722,9 @@ initPhyloQueryBuild name desc (def 5 -> grain) (def 3 -> steps) (def defaultFis ...@@ -673,9 +722,9 @@ initPhyloQueryBuild name desc (def 5 -> grain) (def 3 -> steps) (def defaultFis
-- | 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
...@@ -725,7 +774,7 @@ defaultQueryBuild = initPhyloQueryBuild (Just "Cesar et Cleôpatre") ...@@ -725,7 +774,7 @@ defaultQueryBuild = initPhyloQueryBuild (Just "Cesar et Cleôpatre")
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))
...@@ -148,7 +148,7 @@ toPhyloView' :: Maybe Level ...@@ -148,7 +148,7 @@ toPhyloView' :: Maybe Level
toPhyloView' = initPhyloQueryView toPhyloView' = initPhyloQueryView
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