Skip to content

P
purescript-gargantext
Commit 67593ada authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[Graph] graph walk functionality 

I.e. neighbor badges are clickable now.
parent 79f5d45e
Hide whitespace changes
Inline Side-by-side
Showing with 82 additions and 40 deletions
dist/styles/Graph.css
View file @ 67593ada
......@@ -17,7 +17,7 @@
position: absolute;
max-height: 600px;
overflow-y: scroll;
top: 150px;
top: 170px;
z-index: 1;
}
#graph-explorer #graph-view {
......@@ -27,7 +27,7 @@
position: absolute;
max-height: 600px;
overflow-y: scroll;
top: 150px;
top: 170px;
z-index: 1;
left: 70%;
border: 1px white solid;
......
dist/styles/Graph.sass
View file @ 67593ada
......@@ -2,7 +2,7 @@
position: absolute
max-height: 600px
overflow-y: scroll
top: 150px
top: 170px
z-index: 1
#graph-explorer
......
src/Gargantext/Components/GraphExplorer.purs
View file @ 67593ada
......@@ -201,7 +201,7 @@ convert :: GET.GraphData -> Tuple (Maybe GET.MetaData) SigmaxTypes.SGraph
convert (GET.GraphData r) = Tuple r.metaData $ SigmaxTypes.Graph {nodes, edges}
where
nodes = foldMapWithIndex nodeFn r.nodes
nodeFn i (GET.Node n) =
nodeFn _i (GET.Node n) =
Seq.singleton
{ borderColor: color
, color : color
......@@ -224,12 +224,14 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxTypes.Graph {nodes, edges}
, hidden : false
, size: 1.0
, source : e.source
, sourceNode
, target : e.target
, targetNode
, weight : e.weight }
where
color = case Map.lookup e.source nodesMap of
Nothing -> "#000000"
Just node -> node.color
sourceNode = unsafePartial $ fromJust $ Map.lookup e.source nodesMap
targetNode = unsafePartial $ fromJust $ Map.lookup e.target nodesMap
color = sourceNode.color
defaultPalette :: Array String
defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff"
......@@ -371,16 +373,14 @@ transformGraph controls graph = SigmaxTypes.Graph {nodes: newNodes, edges: newEd
where
edges = SigmaxTypes.graphEdges graph
nodes = SigmaxTypes.graphNodes graph
graphEdgesMap = SigmaxTypes.edgesGraphMap graph
graphNodesMap = SigmaxTypes.nodesGraphMap graph
selectedEdgeIds =
Set.fromFoldable
$ Seq.map _.id
$ Seq.filter (\e -> Set.member e.source (fst controls.selectedNodeIds)) edges
$ SigmaxTypes.neighbouringEdges graph (fst controls.selectedNodeIds)
hasSelection = not $ Set.isEmpty (fst controls.selectedNodeIds)
newNodes = nodeSizeFilter <$> nodeMarked <$> nodes
newEdges = edgeConfluenceFilter <$> edgeWeightFilter <$> edgeShowFilter <$> edgeMarked <$> edges
newNodes = Seq.map (nodeSizeFilter <<< nodeMarked) nodes
newEdges = Seq.map (edgeConfluenceFilter <<< edgeWeightFilter <<< edgeShowFilter <<< edgeMarked) edges
nodeSizeFilter node@{ size } =
if Range.within (fst controls.nodeSize) size then
......@@ -404,13 +404,12 @@ transformGraph controls graph = SigmaxTypes.Graph {nodes: newNodes, edges: newEd
else
edge { hidden = true }
edgeMarked edge@{ id } = do
edgeMarked edge@{ id, sourceNode } = do
let isSelected = Set.member id selectedEdgeIds
let sourceNode = Map.lookup edge.source graphNodesMap
case Tuple hasSelection isSelected of
Tuple false true -> edge { color = "#ff0000" }
Tuple true true -> edge { color = (unsafePartial $ fromJust sourceNode).color }
Tuple true false -> edge { color = "#dddddd" }
Tuple true true -> edge { color = sourceNode.color }
Tuple true false -> edge { color = "rgba(221, 221, 221, 0.5)" }
_ -> edge
nodeMarked node@{ id } =
if Set.member id (fst controls.selectedNodeIds) then
......
src/Gargantext/Components/GraphExplorer/Controls.purs
View file @ 67593ada
......@@ -172,7 +172,7 @@ useGraphControls graph = do
nodeSize <- R.useState' $ Range.Closed { min: 0.0, max: 100.0 }
showTree <- R.useState' false
selectedNodeIds <- R.useState' $ Set.empty
selectorSize <- R.useState' 5
selectorSize <- R.useState' 15
showControls <- R.useState' false
showEdges <- R.useState' SigmaxTypes.EShow
showSidePanel <- R.useState' GET.InitialClosed
......
src/Gargantext/Components/GraphExplorer/Sidebar.purs
View file @ 67593ada
......@@ -6,12 +6,12 @@ import Prelude
import Data.Array (head)
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Sequence as Seq
import Data.Set as Set
import Data.Tuple.Nested((/\))
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Data.Array (catMaybes)
import Gargantext.Components.RandomText (words)
import Gargantext.Components.Nodes.Corpus.Graph.Tabs as GT
import Gargantext.Components.GraphExplorer.Types as GET
......@@ -53,11 +53,16 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
, data: {toggle: "tab"}
, href: "#home"
, role: "tab"
, aria: {controls: "home", selected: "true"}}
[ RH.text "Selected nodes" ] ] ]
, aria: {controls: "home", selected: "true"}
}
[ RH.text "Selected nodes" ]
]
]
, RH.div { className: "tab-content", id: "myTabContent" }
[ RH.div { className: "", id: "home", role: "tabpanel" }
(badge <$> badges props.selectedNodeIds nodesMap) ] ]
(Seq.toUnfoldable $ (Seq.map (badge props.selectedNodeIds) (badges props.graph props.selectedNodeIds)))
]
]
{-, RH.div { className: "col-md-12", id: "horizontal-checkbox" }
[ RH.ul {}
[ checkbox "Pubs"
......@@ -74,8 +79,13 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
]
]
]
badge text =
RH.a { className: "badge badge-light" } [ RH.text text ]
badge (_ /\ setSelectedNodeIds) {id, label} =
RH.a { className: "badge badge-light"
, on: { click: onClick }
} [ RH.text label ]
where
onClick e = do
setSelectedNodeIds $ const $ Set.singleton id
checkbox text =
RH.li {}
[ RH.span {} [ RH.text text ]
......@@ -83,10 +93,10 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
, className: "checkbox"
, checked: true
, title: "Mark as completed" } ]
badges (selectedNodeIds /\ _) nodesMap = map (\n -> n.label)
$ catMaybes
$ map (\n -> Map.lookup n nodesMap)
$ Set.toUnfoldable selectedNodeIds
badges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node)
badges graph (selectedNodeIds /\ _) = SigmaxTypes.neighbours graph selectedNodes
where
selectedNodes = SigmaxTypes.nodesById graph selectedNodeIds
query _ _ _ _ (selectedNodeIds /\ _) | Set.isEmpty selectedNodeIds = RH.div {} []
query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) =
......
src/Gargantext/Data/Array.purs
View file @ 67593ada
......@@ -3,7 +3,7 @@ module Gargantext.Data.Array
import Data.Array as DA
import Data.Maybe
import Data.Sequence as DS
import Data.Sequence as Seq
import Data.Tuple (Tuple(..))
import Prelude (bind, flip, identity, (<<<))
......@@ -16,9 +16,9 @@ splitEvery n xs =
in DA.cons h (splitEvery n t)
splitAt :: forall a. Int -> Array a -> Tuple (Array a) (Array a)
splitAt n ls = Tuple (DS.toUnfoldable x) (DS.toUnfoldable xs)
splitAt n ls = Tuple (Seq.toUnfoldable x) (Seq.toUnfoldable xs)
where
Tuple x xs = DS.splitAt n (DS.fromFoldable ls)
Tuple x xs = Seq.splitAt n (Seq.fromFoldable ls)
----------------------------------------------------------------------
-- | Array with Maybe tools
......@@ -36,4 +36,15 @@ concatMap = flip bind
singleton :: forall a. a -> Array a
singleton a = [a]
----------------------------------------------------------------------
-- | Seq with Maybe tools
seqMapMaybe :: forall a b. (a -> Maybe b) -> Seq.Seq a -> Seq.Seq b
seqMapMaybe f = seqConcatMap (maybe Seq.empty Seq.singleton <<< f)
seqCatMaybes :: forall a. Seq.Seq (Maybe a) -> Seq.Seq a
seqCatMaybes = seqMapMaybe identity
----------------------------------------------------------------------
-- | Seq misc tools
seqConcatMap :: forall a b. (a -> Seq.Seq b) -> Seq.Seq a -> Seq.Seq b
seqConcatMap = flip bind
src/Gargantext/Hooks/Sigmax/Types.purs
View file @ 67593ada
module Gargantext.Hooks.Sigmax.Types where
import Prelude (map, ($), (&&), (==), class Eq, class Ord, class Show, Ordering, compare)
import DOM.Simple.Types (Element)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Map as Map
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Set as Set
import Data.Tuple (Tuple(..))
import DOM.Simple.Types (Element)
import Prelude (map, ($), (&&), (||), (==), class Eq, class Ord, class Show, Ordering, compare)
newtype Graph n e = Graph { nodes :: Seq {|n}, edges :: Seq {|e} }
newtype Graph n e = Graph { nodes :: Seq.Seq {|n}, edges :: Seq.Seq {|e} }
--derive instance eqGraph :: Eq Graph
......@@ -40,7 +40,9 @@ type Edge =
, hidden :: Boolean
, size :: Number
, source :: String
, sourceNode :: Record Node
, target :: String
, targetNode :: Record Node
, weight :: Number )
type SelectedNodeIds = Set.Set String
......@@ -50,24 +52,44 @@ type NodesMap = Map.Map String (Record Node)
type SGraph = Graph Node Edge
graphEdges :: SGraph -> Seq (Record Edge)
graphEdges :: SGraph -> Seq.Seq (Record Edge)
graphEdges (Graph {edges}) = edges
graphNodes :: SGraph -> Seq (Record Node)
graphNodes :: SGraph -> Seq.Seq (Record Node)
graphNodes (Graph {nodes}) = nodes
edgesGraphMap :: Graph Node Edge -> EdgesMap
edgesGraphMap :: SGraph -> EdgesMap
edgesGraphMap graph =
Map.fromFoldable $ map (\e -> Tuple e.id e) $ graphEdges graph
nodesMap :: Seq (Record Node) -> NodesMap
edgesById :: SGraph -> SelectedEdgeIds -> Seq.Seq (Record Edge)
edgesById g edgeIds = Seq.filter (\e -> Set.member e.id edgeIds) $ graphEdges g
nodesMap :: Seq.Seq (Record Node) -> NodesMap
nodesMap nodes = Map.fromFoldable $ map (\n -> Tuple n.id n) nodes
nodesGraphMap :: Graph Node Edge -> NodesMap
nodesGraphMap :: SGraph -> NodesMap
nodesGraphMap graph =
nodesMap $ graphNodes graph
eqGraph :: (Graph Node Edge) -> (Graph Node Edge) -> Boolean
nodesById :: SGraph -> SelectedNodeIds -> Seq.Seq (Record Node)
nodesById g nodeIds = Seq.filter (\n -> Set.member n.id nodeIds) $ graphNodes g
neighbours :: SGraph -> Seq.Seq (Record Node) -> Seq.Seq (Record Node)
neighbours g nodes = Seq.fromFoldable $ Set.unions [Set.fromFoldable nodes, sources, targets]
where
nMap = nodesMap $ graphNodes g
nodeIds = Set.fromFoldable $ Seq.map _.id nodes
selectedEdges = neighbouringEdges g nodeIds
sources = Set.fromFoldable $ nodesById g $ Set.fromFoldable $ Seq.map _.source selectedEdges
targets = Set.fromFoldable $ nodesById g $ Set.fromFoldable $ Seq.map _.target selectedEdges
neighbouringEdges :: SGraph -> SelectedNodeIds -> Seq.Seq (Record Edge)
neighbouringEdges g nodeIds = Seq.filter condition $ graphEdges g
where
condition {source, target} = (Set.member source nodeIds) || (Set.member target nodeIds)
eqGraph :: SGraph -> SGraph -> Boolean
eqGraph (Graph {nodes: n1, edges: e1}) (Graph {nodes: n2, edges: e2}) = (n1 == n2) && (e1 == e2)
......
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