Commit b2cd1fd9 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-sigmajs-selector' into dev

parents c73f90ca 8f3e328c
...@@ -3069,6 +3069,16 @@ ...@@ -3069,6 +3069,16 @@
"repo": "https://github.com/purescript/purescript-tuples.git", "repo": "https://github.com/purescript/purescript-tuples.git",
"version": "v5.1.0" "version": "v5.1.0"
}, },
"tuples-native": {
"dependencies": [
"generics-rep",
"prelude",
"typelevel",
"unsafe-coerce"
],
"repo": "https://github.com/athanclark/purescript-tuples-native",
"version": "v2.0.1"
},
"type-equality": { "type-equality": {
"dependencies": [], "dependencies": [],
"repo": "https://github.com/purescript/purescript-type-equality.git", "repo": "https://github.com/purescript/purescript-type-equality.git",
......
...@@ -29,9 +29,10 @@ ...@@ -29,9 +29,10 @@
overflow-y: scroll; overflow-y: scroll;
top: 170px; top: 170px;
z-index: 1; z-index: 1;
left: 70%;
border: 1px white solid; border: 1px white solid;
background-color: white; background-color: white;
left: 70%;
width: 30%;
} }
#graph-explorer #sp-container #myTab { #graph-explorer #sp-container #myTab {
marginBottom: 18px; marginBottom: 18px;
......
...@@ -28,9 +28,10 @@ ...@@ -28,9 +28,10 @@
#sp-container #sp-container
@include sidePanelCommon @include sidePanelCommon
left: 70%
border: 1px white solid border: 1px white solid
background-color: white background-color: white
left: 70%
width: 30%
#myTab #myTab
marginBottom: 18px marginBottom: 18px
......
...@@ -7,6 +7,7 @@ ...@@ -7,6 +7,7 @@
"build": "pulp --psc-package browserify -t dist/bundle.js", "build": "pulp --psc-package browserify -t dist/bundle.js",
"sass": "sass dist/styles/", "sass": "sass dist/styles/",
"dev": "webpack-dev-server --env dev --mode development", "dev": "webpack-dev-server --env dev --mode development",
"docs": "pulp docs -- --format html",
"repl": "pulp --psc-package repl", "repl": "pulp --psc-package repl",
"clean": "rm -Rf output", "clean": "rm -Rf output",
"test": "pulp test" "test": "pulp test"
......
...@@ -204,6 +204,11 @@ let additions = ...@@ -204,6 +204,11 @@ let additions =
] ]
"https://github.com/irresponsible/purescript-reactix" "https://github.com/irresponsible/purescript-reactix"
"v0.4.2" "v0.4.2"
, tuples-native =
mkPackage
[ "generics-rep", "prelude", "typelevel", "unsafe-coerce" ]
"https://github.com/athanclark/purescript-tuples-native"
"v2.0.1"
, uint = , uint =
mkPackage mkPackage
[ "maybe", "math", "generics-rep" ] [ "maybe", "math", "generics-rep" ]
......
...@@ -33,6 +33,7 @@ ...@@ -33,6 +33,7 @@
"string-parsers", "string-parsers",
"strings", "strings",
"thermite", "thermite",
"tuples-native",
"uint", "uint",
"uri", "uri",
"web-html" "web-html"
......
...@@ -27,7 +27,6 @@ import Gargantext.Types (CTabNgramType(..), TermList) ...@@ -27,7 +27,6 @@ import Gargantext.Types (CTabNgramType(..), TermList)
import Gargantext.Components.Annotation.Utils ( termBootstrapClass ) import Gargantext.Components.Annotation.Utils ( termBootstrapClass )
import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram) import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, MenuType(..) ) import Gargantext.Components.Annotation.Menu ( AnnotationMenu, annotationMenu, MenuType(..) )
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Selection as Sel import Gargantext.Utils.Selection as Sel
type Props = type Props =
......
...@@ -55,7 +55,8 @@ favCategory _ = Favorite ...@@ -55,7 +55,8 @@ favCategory _ = Favorite
trashCategory :: Category -> Category trashCategory :: Category -> Category
trashCategory _ = Trash trashCategory _ = Trash
trashCategory Trash = UnRead -- TODO: ?
--trashCategory Trash = UnRead
decodeCategory :: Int -> Category decodeCategory :: Int -> Category
decodeCategory 0 = Trash decodeCategory 0 = Trash
...@@ -81,17 +82,17 @@ caroussel session nodeId setLocalCategories r cat = H.div {className:"flex"} div ...@@ -81,17 +82,17 @@ caroussel session nodeId setLocalCategories r cat = H.div {className:"flex"} div
else else
H.div { className : icon c (cat == c) H.div { className : icon c (cat == c)
, on: { click: onClick nodeId setLocalCategories r c} , on: { click: onClick c}
} [] } []
) (caroussel' cat) ) (caroussel' cat)
caroussel' :: Category -> Array Category caroussel' :: Category -> Array Category
caroussel' Trash = take 2 categories caroussel' Trash = take 2 categories
caroussel' cat = take 3 $ drop (cat2score cat - 1 ) categories caroussel' c = take 3 $ drop (cat2score c - 1 ) categories
onClick nodeId setLocalCategories r cat = \_-> do onClick c = \_-> do
setLocalCategories $ Map.insert r._id cat setLocalCategories $ Map.insert r._id c
void $ launchAff $ putCategories session nodeId $ CategoryQuery {nodeIds: [r._id], category: cat} void $ launchAff $ putCategories session nodeId $ CategoryQuery {nodeIds: [r._id], category: c}
icon :: Category -> Boolean -> String icon :: Category -> Boolean -> String
......
...@@ -6,7 +6,6 @@ import Data.Maybe (Maybe(..), fromMaybe) ...@@ -6,7 +6,6 @@ import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Effect.Uncurried (mkEffectFn1) import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..))
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), ID, Name) import Gargantext.Components.Forest.Tree.Node.Action (Action(..), ID, Name)
import Gargantext.Components.Forest.Tree.Node (SettingsBox(..), settingsBox) import Gargantext.Components.Forest.Tree.Node (SettingsBox(..), settingsBox)
import Gargantext.Types (NodeType(..), readNodeType) import Gargantext.Types (NodeType(..), readNodeType)
......
...@@ -8,7 +8,6 @@ import Data.Tuple.Nested ((/\)) ...@@ -8,7 +8,6 @@ import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Uncurried (mkEffectFn1) import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..))
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import React.SyntheticEvent as E import React.SyntheticEvent as E
import Reactix as R import Reactix as R
......
...@@ -41,7 +41,7 @@ graph :: forall s fa2. Record (Props s fa2) -> R.Element ...@@ -41,7 +41,7 @@ graph :: forall s fa2. Record (Props s fa2) -> R.Element
graph props = R.createElement graphCpt props [] graph props = R.createElement graphCpt props []
graphCpt :: forall s fa2. R.Component (Props s fa2) graphCpt :: forall s fa2. R.Component (Props s fa2)
graphCpt = R.hooksComponent "Graph" cpt graphCpt = R.hooksComponent "G.C.Graph" cpt
where where
cpt props _ = do cpt props _ = do
stageHooks props stageHooks props
...@@ -83,6 +83,8 @@ graphCpt = R.hooksComponent "Graph" cpt ...@@ -83,6 +83,8 @@ graphCpt = R.hooksComponent "Graph" cpt
Sigmax.setEdges sig false Sigmax.setEdges sig false
Sigma.startForceAtlas2 sig props.forceAtlas2Settings Sigma.startForceAtlas2 sig props.forceAtlas2Settings
pure unit
Just sig -> do Just sig -> do
pure unit pure unit
...@@ -99,6 +101,7 @@ graphCpt = R.hooksComponent "Graph" cpt ...@@ -99,6 +101,7 @@ graphCpt = R.hooksComponent "Graph" cpt
-- TODO Probably this can be optimized to re-mark selected nodes only when they changed -- TODO Probably this can be optimized to re-mark selected nodes only when they changed
R.useEffect' $ do R.useEffect' $ do
Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphCpt (Ready)] no sigma" $ \sigma -> do Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphCpt (Ready)] no sigma" $ \sigma -> do
Sigmax.performDiff sigma transformedGraph
Sigmax.updateEdges sigma tEdgesMap Sigmax.updateEdges sigma tEdgesMap
Sigmax.updateNodes sigma tNodesMap Sigmax.updateNodes sigma tNodesMap
Sigmax.setEdges sigma (not $ SigmaxTypes.edgeStateHidden showEdges) Sigmax.setEdges sigma (not $ SigmaxTypes.edgeStateHidden showEdges)
......
...@@ -2,8 +2,9 @@ module Gargantext.Components.GraphExplorer where ...@@ -2,8 +2,9 @@ module Gargantext.Components.GraphExplorer where
import Gargantext.Prelude hiding (max,min) import Gargantext.Prelude hiding (max,min)
import Data.FoldableWithIndex (foldMapWithIndex) import DOM.Simple.Types (Element)
import Data.Foldable (foldMap) import Data.Foldable (foldMap)
import Data.FoldableWithIndex (foldMapWithIndex)
import Data.Int (toNumber) import Data.Int (toNumber)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust) import Data.Maybe (Maybe(..), fromJust)
...@@ -11,28 +12,27 @@ import Data.Nullable (null, Nullable) ...@@ -11,28 +12,27 @@ import Data.Nullable (null, Nullable)
import Data.Sequence as Seq import Data.Sequence as Seq
import Data.Set as Set import Data.Set as Set
import Data.Tuple (fst, snd, Tuple(..)) import Data.Tuple (fst, snd, Tuple(..))
import DOM.Simple.Types (Element)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Math (log) import Gargantext.Components.Forest (forest)
import Partial.Unsafe (unsafePartial) import Gargantext.Components.Graph as Graph
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Components.GraphExplorer.Controls as Controls import Gargantext.Components.GraphExplorer.Controls as Controls
import Gargantext.Components.GraphExplorer.Sidebar as Sidebar import Gargantext.Components.GraphExplorer.Sidebar as Sidebar
import Gargantext.Components.GraphExplorer.ToggleButton as Toggle import Gargantext.Components.GraphExplorer.ToggleButton as Toggle
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Graph as Graph import Gargantext.Data.Louvain as Louvain
import Gargantext.Components.Forest (forest)
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Routes (SessionRoute(NodeAPI), AppRoute) import Gargantext.Routes (SessionRoute(NodeAPI), AppRoute)
import Gargantext.Sessions (Session, Sessions, get) import Gargantext.Sessions (Session, Sessions, get)
import Gargantext.Types (NodeType(Graph)) import Gargantext.Types as Types
import Gargantext.Utils.Range as Range import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Math (log)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
type GraphId = Int type GraphId = Int
...@@ -178,7 +178,14 @@ graphViewCpt = R.hooksComponent "GraphView" cpt ...@@ -178,7 +178,14 @@ graphViewCpt = R.hooksComponent "GraphView" cpt
where where
cpt {controls, elRef, graphId, graph, multiSelectEnabledRef} _children = do cpt {controls, elRef, graphId, graph, multiSelectEnabledRef} _children = do
-- TODO Cache this? -- TODO Cache this?
let transformedGraph = transformGraph controls graph let louvainGraph =
if (fst controls.showLouvain) then
let louvain = Louvain.louvain unit in
let cluster = Louvain.init louvain (SigmaxTypes.louvainNodes graph) (SigmaxTypes.louvainEdges graph) in
SigmaxTypes.louvainGraph graph cluster
else
graph
let transformedGraph = transformGraph controls louvainGraph
R.useEffect1' (fst controls.multiSelectEnabled) $ do R.useEffect1' (fst controls.multiSelectEnabled) $ do
R.setRef multiSelectEnabledRef $ fst controls.multiSelectEnabled R.setRef multiSelectEnabledRef $ fst controls.multiSelectEnabled
...@@ -204,17 +211,20 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxTypes.Graph {nodes, edges} ...@@ -204,17 +211,20 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxTypes.Graph {nodes, edges}
Seq.singleton Seq.singleton
{ borderColor: color { borderColor: color
, color : color , color : color
, equilateral: { numPoints: 3 }
, gargType
, hidden : false , hidden : false
, id : n.id_ , id : n.id_
, label : n.label , label : n.label
, size : log (toNumber n.size + 1.0) , size : log (toNumber n.size + 1.0)
, type : "def" -- default type , type : modeGraphType gargType
, x : n.x -- cos (toNumber i) , x : n.x -- cos (toNumber i)
, y : n.y -- sin (toNumber i) , y : n.y -- sin (toNumber i)
} }
where where
cDef (GET.Cluster {clustDefault}) = clustDefault cDef (GET.Cluster {clustDefault}) = clustDefault
color = GET.intColor (cDef n.attributes) color = GET.intColor (cDef n.attributes)
gargType = unsafePartial $ fromJust $ Types.modeFromString n.type_
nodesMap = SigmaxTypes.nodesMap nodes nodesMap = SigmaxTypes.nodesMap nodes
edges = foldMap edgeFn r.edges edges = foldMap edgeFn r.edges
edgeFn (GET.Edge e) = Seq.singleton { id : e.id_ edgeFn (GET.Edge e) = Seq.singleton { id : e.id_
...@@ -232,139 +242,16 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxTypes.Graph {nodes, edges} ...@@ -232,139 +242,16 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxTypes.Graph {nodes, edges}
targetNode = unsafePartial $ fromJust $ Map.lookup e.target nodesMap targetNode = unsafePartial $ fromJust $ Map.lookup e.target nodesMap
color = sourceNode.color color = sourceNode.color
defaultPalette :: Array String -- | See sigmajs/plugins/sigma.renderers.customShapes/shape-library.js
defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff" modeGraphType :: Types.Mode -> String
,"#b399df","#ffdfed","#33c8f3","#739e9a" modeGraphType Types.Authors = "square"
,"#caeca3","#f6f7e5","#f9bcca","#ccb069" modeGraphType Types.Institutes = "equilateral"
,"#c9ffde","#c58683","#6c9eb0","#ffd3cf" modeGraphType Types.Sources = "star"
,"#ccffc7","#52a1b0","#d2ecff","#99fffe" modeGraphType Types.Terms = "def"
,"#9295ae","#5ea38b","#fff0b3","#d99e68"
]
-- clusterColor :: Cluster -> Color
-- clusterColor (Cluster {clustDefault}) = unsafePartial $ fromJust $ defaultPalette !! (clustDefault `molength defrultPalette)
-- div [className "col-md-12", style {"padding-bottom" : "10px"}]
-- [ menu [_id "toolbar"]
-- [ ul'
-- [
-- -- li' [ button [className "btn btn-success btn-sm"] [text "Change Type"] ]
-- -- ,
-- -- , li' [ button [className "btn btn-primary btn-sm"] [text "Change Level"] ]
-- {- ,li [style {display : "inline-block"}]
-- [ form'
-- [ input [_type "file"
-- , name "file"
-- -- , onChange (\e -> d $ SetFile (getFile e) (unsafeCoerce $ d <<< SetProgress))
-- , className "btn btn-primary"]
-- -- , text $ show st.readyState
-- ]
-- ]
-- -}
-- {-, li' [ input [_type "button"
-- , className "btn btn-warning btn-sm"
-- ,value "Run Demo"
-- -- , onClick \_ -> d SetGraph, disabled (st.readyState /= DONE)
-- ]
-- ]
-- -}
-- {-, li'
-- [ form'
-- [ div [className "col-lg-2"]
-- [
-- div [className "input-group"]
-- [
-- span [className "input-group-btn"]
-- [
-- button [className "btn btn-primary", _type "button"]
-- [ span [className "glyphicon glyphicon-search"] []
-- ]
-- ]
-- , input [_type "text", className "form-control", placeholder "select topics"]
-- ]
-- ]
-- ]
-- ]
-- -}
-- li [className "col-md-1"]
-- [ span [] [text "Selector"]
-- , input [ _type "range"
-- , _id "cursorSizeRange"
-- , min "0"
-- , max "100"
-- , defaultValue (show st.cursorSize)
-- , onChange \e -> d $ ChangeCursorSize (numberTargetValue e)
-- ]
-- ]
-- , li [className "col-md-1"]
-- [ span [] [text "Labels"],input [_type "range"
-- , _id "labelSizeRange"
-- , max "4"
-- , defaultValue <<< show $ sigmaSettings ^. _labelSizeRatio
-- , min "1"
-- , onChange \e -> d $ ChangeLabelSize (numberTargetValue e)
-- ]
-- ]
-- , li [className "col-md-1"]
-- [ span [] [text "Nodes"],input [_type "range"
-- , _id "nodeSizeRange"
-- , max "15"
-- , defaultValue <<< show $ sigmaSettings ^. _minNodeSize
-- , min "5"
-- , onChange \e -> d $ ChangeNodeSize (numberTargetValue e)
-- ]
-- ]
-- {-, li [className "col-md-2"]
-- [ span [] [text "Edges"],input [_type "range", _id "myRange", value "90"]
-- ]
-- -}
-- -- , li'
-- -- [ button [ className "btn btn-primary"
-- -- , onClick \_ -> modCamera0 (const {x: 0.0, y: 0.0, ratio: 1.0})
-- -- ] [text "Center"]
-- -- ]
-- -- , li [className "col-md-1"]
-- -- [ span [] [text "Zoom"],input [ _type "range"
-- -- , _id "cameraRatio"
-- -- , max "100"
-- -- , defaultValue "0"
-- -- , min "0"
-- -- , onChange \e -> do
-- -- let ratio = (100.0 - numberTargetValue e) / 100.0pa
-- -- modCamera0 (const {ratio})
-- -- ]
-- -- ]
-- , li [className "col-md-1"]
-- [ span [] [text "MultiNode"]
-- , input
-- [ _type "checkbox"
-- , className "checkbox"
-- -- , checked
-- , onChange $ const $ d ToggleMultiNodeSelection
-- ]
-- ]
-- , li'
-- [ button [ className "btn btn-primary"
-- , onClick \_ -> pauseForceAtlas2
-- ] [text "Spatialization"]
-- ]
-- {-, li'
-- [ button [className "btn btn-primary"
-- , onClick \_ -> do
-- _ <- log "Hey there" -- $ show st.camera
-- pure unit
-- ] [text "Save"] -- TODO: Implement Save!
-- ]
-- -}
-- ]
-- ]
getNodes :: Session -> GraphId -> Aff GET.GraphData getNodes :: Session -> GraphId -> Aff GET.GraphData
getNodes session graphId = get session $ NodeAPI Graph (Just graphId) "" getNodes session graphId = get session $ NodeAPI Types.Graph (Just graphId) ""
transformGraph :: Record Controls.Controls -> SigmaxTypes.SGraph -> SigmaxTypes.SGraph transformGraph :: Record Controls.Controls -> SigmaxTypes.SGraph -> SigmaxTypes.SGraph
...@@ -378,30 +265,45 @@ transformGraph controls graph = SigmaxTypes.Graph {nodes: newNodes, edges: newEd ...@@ -378,30 +265,45 @@ transformGraph controls graph = SigmaxTypes.Graph {nodes: newNodes, edges: newEd
$ SigmaxTypes.neighbouringEdges graph (fst controls.selectedNodeIds) $ SigmaxTypes.neighbouringEdges graph (fst controls.selectedNodeIds)
hasSelection = not $ Set.isEmpty (fst controls.selectedNodeIds) hasSelection = not $ Set.isEmpty (fst controls.selectedNodeIds)
newNodes = Seq.map (nodeSizeFilter <<< nodeMarked) nodes --newNodes = Seq.map (nodeSizeFilter <<< nodeMarked) nodes
newEdges = Seq.map (edgeConfluenceFilter <<< edgeWeightFilter <<< edgeShowFilter <<< edgeMarked) edges --newEdges = Seq.map (edgeConfluenceFilter <<< edgeWeightFilter <<< edgeShowFilter <<< edgeMarked) edges
newEdges' = Seq.filter edgeFilter $ Seq.map (edgeShowFilter <<< edgeMarked) edges
nodeSizeFilter node@{ size } = newNodes = Seq.filter nodeFilter $ Seq.map (nodeMarked) nodes
if Range.within (fst controls.nodeSize) size then newEdges = Seq.filter (edgeInGraph $ Set.fromFoldable $ Seq.map _.id newNodes) newEdges'
node
else edgeFilter e = edgeConfluenceFilter e &&
node { hidden = true } edgeWeightFilter e
--edgeShowFilter e
edgeConfluenceFilter edge@{ confluence } = nodeFilter n = nodeSizeFilter n
if Range.within (fst controls.edgeConfluence) confluence then
edge --nodeSizeFilter node@{ size } =
else -- if Range.within (fst controls.nodeSize) size then
edge { hidden = true } -- node
-- else
-- node { hidden = true }
nodeSizeFilter node@{ size } = Range.within (fst controls.nodeSize) size
--edgeConfluenceFilter edge@{ confluence } =
-- if Range.within (fst controls.edgeConfluence) confluence then
-- edge
-- else
-- edge { hidden = true }
edgeConfluenceFilter edge@{ confluence } = Range.within (fst controls.edgeConfluence) confluence
edgeShowFilter edge = edgeShowFilter edge =
if (SigmaxTypes.edgeStateHidden $ fst controls.showEdges) then if (SigmaxTypes.edgeStateHidden $ fst controls.showEdges) then
edge { hidden = true } edge { hidden = true }
else else
edge edge
edgeWeightFilter edge@{ weight } = --edgeWeightFilter edge@{ weight } =
if Range.within (fst controls.edgeWeight) weight then -- if Range.within (fst controls.edgeWeight) weight then
edge -- edge
else -- else
edge { hidden = true } -- edge { hidden = true }
edgeWeightFilter :: Record SigmaxTypes.Edge -> Boolean
edgeWeightFilter edge@{ weight } = Range.within (fst controls.edgeWeight) weight
edgeInGraph :: SigmaxTypes.SelectedNodeIds -> Record SigmaxTypes.Edge -> Boolean
edgeInGraph nodeIds e = (Set.member e.source nodeIds) && (Set.member e.target nodeIds)
edgeMarked edge@{ id, sourceNode } = do edgeMarked edge@{ id, sourceNode } = do
let isSelected = Set.member id selectedEdgeIds let isSelected = Set.member id selectedEdgeIds
......
...@@ -24,7 +24,7 @@ import Gargantext.Components.GraphExplorer.Button (centerButton) ...@@ -24,7 +24,7 @@ import Gargantext.Components.GraphExplorer.Button (centerButton)
import Gargantext.Components.GraphExplorer.RangeControl (edgeConfluenceControl, edgeWeightControl, nodeSizeControl) import Gargantext.Components.GraphExplorer.RangeControl (edgeConfluenceControl, edgeWeightControl, nodeSizeControl)
import Gargantext.Components.GraphExplorer.Search (nodeSearchControl) import Gargantext.Components.GraphExplorer.Search (nodeSearchControl)
import Gargantext.Components.GraphExplorer.SlideButton (labelSizeButton, mouseSelectorSizeButton) import Gargantext.Components.GraphExplorer.SlideButton (labelSizeButton, mouseSelectorSizeButton)
import Gargantext.Components.GraphExplorer.ToggleButton (multiSelectEnabledButton, edgesToggleButton, pauseForceAtlasButton) import Gargantext.Components.GraphExplorer.ToggleButton (multiSelectEnabledButton, edgesToggleButton, louvainToggleButton, pauseForceAtlasButton)
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax as Sigmax import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
...@@ -42,6 +42,7 @@ type Controls = ...@@ -42,6 +42,7 @@ type Controls =
, selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds , selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
, showControls :: R.State Boolean , showControls :: R.State Boolean
, showEdges :: R.State SigmaxTypes.ShowEdgesState , showEdges :: R.State SigmaxTypes.ShowEdgesState
, showLouvain :: R.State Boolean
, showSidePanel :: R.State GET.SidePanelState , showSidePanel :: R.State GET.SidePanelState
, showTree :: R.State Boolean , showTree :: R.State Boolean
, sigmaRef :: R.Ref Sigmax.Sigma , sigmaRef :: R.Ref Sigmax.Sigma
...@@ -134,6 +135,7 @@ controlsCpt = R.hooksComponent "GraphControls" cpt ...@@ -134,6 +135,7 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
RH.li {} [ centerButton props.sigmaRef ] RH.li {} [ centerButton props.sigmaRef ]
, RH.li {} [ pauseForceAtlasButton {state: props.forceAtlasState} ] , RH.li {} [ pauseForceAtlasButton {state: props.forceAtlasState} ]
, RH.li {} [ edgesToggleButton {state: props.showEdges} ] , RH.li {} [ edgesToggleButton {state: props.showEdges} ]
, RH.li {} [ louvainToggleButton props.showLouvain ]
, RH.li {} [ edgeConfluenceControl edgeConfluenceRange props.edgeConfluence ] , RH.li {} [ edgeConfluenceControl edgeConfluenceRange props.edgeConfluence ]
, RH.li {} [ edgeWeightControl edgeWeightRange props.edgeWeight ] , RH.li {} [ edgeWeightControl edgeWeightRange props.edgeWeight ]
-- change level -- change level
...@@ -147,6 +149,7 @@ controlsCpt = R.hooksComponent "GraphControls" cpt ...@@ -147,6 +149,7 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
, RH.li {} [ multiSelectEnabledButton props.multiSelectEnabled ] -- toggle multi node selection , RH.li {} [ multiSelectEnabledButton props.multiSelectEnabled ] -- toggle multi node selection
-- save button -- save button
, RH.li {} [ nodeSearchControl { graph: props.graph , RH.li {} [ nodeSearchControl { graph: props.graph
, multiSelectEnabled: props.multiSelectEnabled
, selectedNodeIds: props.selectedNodeIds } ] , selectedNodeIds: props.selectedNodeIds } ]
, RH.li {} [ mouseSelectorSizeButton props.sigmaRef localControls.mouseSelectorSize ] , RH.li {} [ mouseSelectorSizeButton props.sigmaRef localControls.mouseSelectorSize ]
] ]
...@@ -161,11 +164,12 @@ useGraphControls graph = do ...@@ -161,11 +164,12 @@ useGraphControls graph = do
graphStage <- R.useState' Graph.Init graphStage <- R.useState' Graph.Init
multiSelectEnabled <- R.useState' false multiSelectEnabled <- R.useState' false
nodeSize <- R.useState' $ Range.Closed { min: 0.0, max: 100.0 } nodeSize <- R.useState' $ Range.Closed { min: 0.0, max: 100.0 }
showTree <- R.useState' false
selectedNodeIds <- R.useState' $ Set.empty selectedNodeIds <- R.useState' $ Set.empty
showControls <- R.useState' false showControls <- R.useState' false
showEdges <- R.useState' SigmaxTypes.EShow showEdges <- R.useState' SigmaxTypes.EShow
showLouvain <- R.useState' false
showSidePanel <- R.useState' GET.InitialClosed showSidePanel <- R.useState' GET.InitialClosed
showTree <- R.useState' false
sigma <- Sigmax.initSigma sigma <- Sigmax.initSigma
sigmaRef <- R.useRef sigma sigmaRef <- R.useRef sigma
...@@ -179,6 +183,7 @@ useGraphControls graph = do ...@@ -179,6 +183,7 @@ useGraphControls graph = do
, selectedNodeIds , selectedNodeIds
, showControls , showControls
, showEdges , showEdges
, showLouvain
, showSidePanel , showSidePanel
, showTree , showTree
, sigmaRef , sigmaRef
......
...@@ -18,6 +18,7 @@ import Gargantext.Hooks.Sigmax.Types as SigmaxTypes ...@@ -18,6 +18,7 @@ import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
type Props = ( type Props = (
graph :: SigmaxTypes.SGraph graph :: SigmaxTypes.SGraph
, multiSelectEnabled :: R.State Boolean
, selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds , selectedNodeIds :: R.State SigmaxTypes.SelectedNodeIds
) )
...@@ -37,36 +38,38 @@ nodeSearchControl props = R.createElement sizeButtonCpt props [] ...@@ -37,36 +38,38 @@ nodeSearchControl props = R.createElement sizeButtonCpt props []
sizeButtonCpt :: R.Component Props sizeButtonCpt :: R.Component Props
sizeButtonCpt = R.hooksComponent "NodeSearchControl" cpt sizeButtonCpt = R.hooksComponent "NodeSearchControl" cpt
where where
cpt {graph, selectedNodeIds} _ = do cpt {graph, multiSelectEnabled, selectedNodeIds} _ = do
search@(search' /\ setSearch) <- R.useState' "" search@(search' /\ setSearch) <- R.useState' ""
pure $ pure $
H.div { className: "form-group" } H.div { className: "form-group" }
[ H.div { className: "input-group" } [ H.div { className: "input-group" }
[ inputWithAutocomplete { autocompleteSearch: autocompleteSearch graph [ inputWithAutocomplete { autocompleteSearch: autocompleteSearch graph
, onAutocompleteClick: \s -> triggerSearch graph s selectedNodeIds , onAutocompleteClick: \s -> triggerSearch graph s multiSelectEnabled selectedNodeIds
, onEnterPress: \s -> triggerSearch graph s selectedNodeIds , onEnterPress: \s -> triggerSearch graph s multiSelectEnabled selectedNodeIds
, state: search } , state: search }
, H.div { className: "btn input-group-addon" , H.div { className: "btn input-group-addon"
, on: { click: \_ -> triggerSearch graph search' selectedNodeIds } , on: { click: \_ -> triggerSearch graph search' multiSelectEnabled selectedNodeIds }
} }
[ H.span { className: "fa fa-search" } [] ] [ H.span { className: "fa fa-search" } [] ]
] ]
] ]
autocompleteSearch :: SigmaxTypes.SGraph -> String -> Array String autocompleteSearch :: SigmaxTypes.SGraph -> String -> Array String
autocompleteSearch graph s = Seq.toUnfoldable $ (_.label) <$> searchNodes s nodes autocompleteSearch graph s = Seq.toUnfoldable $ (_.label) <$> searchNodes s nodes
where where
nodes = SigmaxTypes.graphNodes graph nodes = SigmaxTypes.graphNodes graph
triggerSearch :: SigmaxTypes.SGraph triggerSearch :: SigmaxTypes.SGraph
-> String -> String
-> R.State Boolean
-> R.State SigmaxTypes.SelectedNodeIds -> R.State SigmaxTypes.SelectedNodeIds
-> Effect Unit -> Effect Unit
triggerSearch graph search (_ /\ setSelectedNodeIds) = do triggerSearch graph search (multiSelectEnabled /\ _) (_ /\ setSelectedNodeIds) = do
let nodes = SigmaxTypes.graphNodes graph let graphNodes = SigmaxTypes.graphNodes graph
let matching = (_.id) <$> searchNodes search nodes let matching = Set.fromFoldable $ (_.id) <$> searchNodes search graphNodes
log2 "[triggerSearch] search" search log2 "[triggerSearch] search" search
setSelectedNodeIds $ const $ Set.fromFoldable matching setSelectedNodeIds $ \nodes ->
Set.union matching $ if multiSelectEnabled then nodes else Set.empty
...@@ -3,6 +3,8 @@ module Gargantext.Components.GraphExplorer.Sidebar ...@@ -3,6 +3,8 @@ module Gargantext.Components.GraphExplorer.Sidebar
where where
import Prelude import Prelude
import DOM.Simple.Console (log2)
import Data.Array (head) import Data.Array (head)
import Data.Int (fromString) import Data.Int (fromString)
import Data.Map as Map import Data.Map as Map
...@@ -10,23 +12,21 @@ import Data.Maybe (Maybe(..)) ...@@ -10,23 +12,21 @@ import Data.Maybe (Maybe(..))
import Data.Sequence as Seq import Data.Sequence as Seq
import Data.Set as Set import Data.Set as Set
import Data.Traversable (traverse_) import Data.Traversable (traverse_)
import Data.Tuple.Nested((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Components.RandomText (words)
import Gargantext.Components.Nodes.Corpus.Graph.Tabs as GT
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Nodes.Corpus.Graph.Tabs as GT
import Gargantext.Components.RandomText (words)
import Gargantext.Data.Array (mapMaybe) import Gargantext.Data.Array (mapMaybe)
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Routes (SessionRoute(NodeAPI)) import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, delete) import Gargantext.Sessions (Session, delete)
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..), TermList(..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as RH
type Props = type Props =
( frontends :: Frontends ( frontends :: Frontends
...@@ -51,7 +51,7 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt ...@@ -51,7 +51,7 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
let nodesMap = SigmaxTypes.nodesGraphMap props.graph let nodesMap = SigmaxTypes.nodesGraphMap props.graph
pure $ pure $
RH.div { id: "sp-container", className: "col-md-3" } RH.div { id: "sp-container" }
[ RH.div {} [ RH.div {}
[ R2.row [ R2.row
[ R2.col12 [ R2.col12
...@@ -63,8 +63,11 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt ...@@ -63,8 +63,11 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
, RH.div { className: "tab-content" } , RH.div { className: "tab-content" }
[ [
RH.button { className: "btn btn-danger" RH.button { className: "btn btn-danger"
, on: { click: onClickRemove props.session props.selectedNodeIds }} , on: { click: onClickRemove CandidateTerm props.session props.selectedNodeIds }}
[ RH.text "Remove" ] [ RH.text "Remove candidate" ]
, RH.button { className: "btn btn-danger"
, on: { click: onClickRemove StopTerm props.session props.selectedNodeIds }}
[ RH.text "Remove stop" ]
] ]
, RH.li { className: "nav-item" } , RH.li { className: "nav-item" }
[ RH.a { id: "home-tab" [ RH.a { id: "home-tab"
...@@ -98,13 +101,6 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt ...@@ -98,13 +101,6 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
] ]
] ]
] ]
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 = checkbox text =
RH.li {} RH.li {}
[ RH.span {} [ RH.text text ] [ RH.span {} [ RH.text text ]
...@@ -112,27 +108,42 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt ...@@ -112,27 +108,42 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
, className: "checkbox" , className: "checkbox"
, checked: true , checked: true
, title: "Mark as completed" } ] , title: "Mark as completed" } ]
badges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node)
badges graph (selectedNodeIds /\ _) = SigmaxTypes.nodesById graph selectedNodeIds
neighbourBadges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node)
neighbourBadges graph (selectedNodeIds /\ _) = SigmaxTypes.neighbours graph selectedNodes
where
selectedNodes = SigmaxTypes.nodesById graph selectedNodeIds
onClickRemove session (selectedNodeIds /\ _) e = do onClickRemove rType session (selectedNodeIds /\ _) e = do
log2 "[onClickRemove] selectedNodeIds" selectedNodeIds log2 "[onClickRemove] selectedNodeIds" selectedNodeIds
let nodeIds = mapMaybe fromString $ Set.toUnfoldable selectedNodeIds let nodeIds = mapMaybe fromString $ Set.toUnfoldable selectedNodeIds
deleteNodes session nodeIds deleteNodes rType session nodeIds
deleteNodes :: Session -> Array Int -> Effect Unit
deleteNodes session nodeIds = do
traverse_ (launchAff_ <<< deleteNode session) nodeIds
deleteNode :: Session -> Int -> Aff Int badge :: R.State SigmaxTypes.SelectedNodeIds -> Record SigmaxTypes.Node -> R.Element
deleteNode session nodeId = delete session $ NodeAPI Node (Just nodeId) "" 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
query _ _ _ _ (selectedNodeIds /\ _) | Set.isEmpty selectedNodeIds = RH.div {} [] badges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node)
query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) = badges graph (selectedNodeIds /\ _) = SigmaxTypes.graphNodes $ SigmaxTypes.nodesById graph selectedNodeIds
neighbourBadges :: SigmaxTypes.SGraph -> R.State SigmaxTypes.SelectedNodeIds -> Seq.Seq (Record SigmaxTypes.Node)
neighbourBadges graph (selectedNodeIds /\ _) = SigmaxTypes.neighbours graph selectedNodes
where
selectedNodes = SigmaxTypes.graphNodes $ SigmaxTypes.nodesById graph selectedNodeIds
deleteNodes :: TermList -> Session -> Array Int -> Effect Unit
deleteNodes termList session nodeIds = do
traverse_ (launchAff_ <<< deleteNode termList session) nodeIds
deleteNode :: TermList -> Session -> Int -> Aff Int
deleteNode termList session nodeId = delete session $ NodeAPI Node (Just nodeId) ""
query :: Frontends -> GET.MetaData -> Session -> SigmaxTypes.NodesMap -> R.State SigmaxTypes.SelectedNodeIds -> R.Element
query _ _ _ _ (selectedNodeIds /\ _) | Set.isEmpty selectedNodeIds = RH.div {} []
query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) =
query' (head metaData.corpusId) query' (head metaData.corpusId)
where where
query' Nothing = RH.div {} [] query' Nothing = RH.div {} []
...@@ -146,5 +157,3 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt ...@@ -146,5 +157,3 @@ sidebarCpt = R.hooksComponent "Sidebar" cpt
, listId: metaData.listId , listId: metaData.listId
, corpusLabel: metaData.title , corpusLabel: metaData.title
} }
...@@ -2,9 +2,10 @@ module Gargantext.Components.GraphExplorer.ToggleButton ...@@ -2,9 +2,10 @@ module Gargantext.Components.GraphExplorer.ToggleButton
( Props ( Props
, toggleButton , toggleButton
, toggleButtonCpt , toggleButtonCpt
, multiSelectEnabledButton
, controlsToggleButton , controlsToggleButton
, edgesToggleButton , edgesToggleButton
, louvainToggleButton
, multiSelectEnabledButton
, sidebarToggleButton , sidebarToggleButton
, pauseForceAtlasButton , pauseForceAtlasButton
, treeToggleButton , treeToggleButton
...@@ -78,6 +79,15 @@ edgesToggleButtonCpt = R.hooksComponent "EdgesToggleButton" cpt ...@@ -78,6 +79,15 @@ edgesToggleButtonCpt = R.hooksComponent "EdgesToggleButton" cpt
-- TODO: Move this to Graph.purs to the R.useEffect handler which renders nodes/edges -- TODO: Move this to Graph.purs to the R.useEffect handler which renders nodes/edges
onClick setState _ = setState SigmaxTypes.toggleShowEdgesState onClick setState _ = setState SigmaxTypes.toggleShowEdgesState
louvainToggleButton :: R.State Boolean -> R.Element
louvainToggleButton state =
toggleButton {
state: state
, onMessage: "Louvain off"
, offMessage: "Louvain on"
, onClick: \_ -> snd state not
}
multiSelectEnabledButton :: R.State Boolean -> R.Element multiSelectEnabledButton :: R.State Boolean -> R.Element
multiSelectEnabledButton state = multiSelectEnabledButton state =
toggleButton { toggleButton {
......
...@@ -163,7 +163,7 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath ...@@ -163,7 +163,7 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
, placeholder: "Search" , placeholder: "Search"
, type: "value" , type: "value"
, value: searchQuery , value: searchQuery
, on: {input: \e -> setSearchQuery (R2.unsafeEventValue e)}} , on: {input: setSearchQuery <<< R2.unsafeEventValue}}
, H.div {} ( , H.div {} (
if A.null props.tableBody && searchQuery /= "" then [ if A.null props.tableBody && searchQuery /= "" then [
H.button { className: "btn btn-primary" H.button { className: "btn btn-primary"
...@@ -176,14 +176,14 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath ...@@ -176,14 +176,14 @@ tableContainer { path: {searchQuery, termListFilter, termSizeFilter} /\ setPath
[ R2.select { id: "picklistmenu" [ R2.select { id: "picklistmenu"
, className: "form-control custom-select" , className: "form-control custom-select"
, value: (maybe "" show termListFilter) , value: (maybe "" show termListFilter)
, on: {change: (\e -> setTermListFilter $ readTermList $ R2.unsafeEventValue e)}} , on: {change: setTermListFilter <<< readTermList <<< R2.unsafeEventValue}}
(map optps1 termLists)]] (map optps1 termLists)]]
, H.div {className: "col-md-2", style: {marginTop : "6px"}} , H.div {className: "col-md-2", style: {marginTop : "6px"}}
[ H.li {className: "list-group-item"} [ H.li {className: "list-group-item"}
[ R2.select {id: "picktermtype" [ R2.select {id: "picktermtype"
, className: "form-control custom-select" , className: "form-control custom-select"
, value: (maybe "" show termSizeFilter) , value: (maybe "" show termSizeFilter)
, on: {change: (\e -> setTermSizeFilter $ readTermSize $ R2.unsafeEventValue e)}} , on: {change: setTermSizeFilter <<< readTermSize <<< R2.unsafeEventValue}}
(map optps1 termSizes)]] (map optps1 termSizes)]]
, H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}} , H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}}
[ H.li {className: " list-group-item"} [ H.li {className: " list-group-item"}
......
module Gargantext.Components.Nodes.Annuaire where module Gargantext.Components.Nodes.Annuaire where
import Prelude (bind, identity, pure, const, discard, ($), (<$>), (<>)) import Prelude (bind, const, identity, pure, ($), (<$>), (<>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?)) import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Array (head) import Data.Array (head)
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
......
...@@ -13,22 +13,7 @@ import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics) ...@@ -13,22 +13,7 @@ import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar) import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree) import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), TabType(..), TabSubType(..)) import Gargantext.Types (Mode(..), modeTabType, CTabNgramType(..), TabType(..), TabSubType(..))
data Mode = Authors | Sources | Institutes | Terms
derive instance genericMode :: Generic Mode _
instance showMode :: Show Mode where
show = genericShow
derive instance eqMode :: Eq Mode
modeTabType :: Mode -> CTabNgramType
modeTabType Authors = CTabAuthors
modeTabType Sources = CTabSources
modeTabType Institutes = CTabInstitutes
modeTabType Terms = CTabTerms
type Props = type Props =
( session :: Session ( session :: Session
......
...@@ -2,19 +2,12 @@ module Gargantext.Components.Search.SearchBar ...@@ -2,19 +2,12 @@ module Gargantext.Components.Search.SearchBar
( Props, searchBar, searchBarCpt ( Props, searchBar, searchBarCpt
) where ) where
import Prelude (Unit, bind, discard, pure, ($)) import Prelude (pure, ($))
import Data.Maybe (Maybe(..))
import Data.Newtype (over)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff_)
import Effect (Effect)
import Effect.Class (liftEffect)
import Reactix as R import Reactix as R
import DOM.Simple.Console (log2)
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Components.Search.Types -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..)) import Gargantext.Components.Search.Types -- (Database, SearchQuery(..), defaultSearchQuery, performSearch, Lang(..))
import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Components.Search.SearchField (Search, searchField) import Gargantext.Components.Search.SearchField (Search, searchField)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
......
/*
Author: Corneliu S. (github.com/upphiminn)
This is a javascript implementation of the Louvain
community detection algorithm (http://arxiv.org/abs/0803.0476)
Based on https://bitbucket.org/taynaud/python-louvain/overview
*/
exports._jLouvain = (function(){
return function(){
//Constants
var __PASS_MAX = -1
var __MIN = 0.0000001
//Local vars
var original_graph_nodes;
var original_graph_edges;
var original_graph = {};
var partition_init;
//Helpers
function make_set(array){
var set = {};
array.forEach(function(d,i){
set[d] = true;
});
return Object.keys(set);
};
function obj_values(obj){
var vals = [];
for( var key in obj ) {
if ( obj.hasOwnProperty(key) ) {
vals.push(obj[key]);
}
}
return vals;
};
function get_degree_for_node(graph, node){
var neighbours = graph._assoc_mat[node] ? Object.keys(graph._assoc_mat[node]) : [];
var weight = 0;
neighbours.forEach(function(neighbour,i){
var value = graph._assoc_mat[node][neighbour] || 1;
if(node == neighbour)
value *= 2;
weight += value;
});
return weight;
};
function get_neighbours_of_node(graph, node){
if(typeof graph._assoc_mat[node] == 'undefined')
return [];
var neighbours = Object.keys(graph._assoc_mat[node]);
return neighbours;
}
function get_edge_weight(graph, node1, node2){
return graph._assoc_mat[node1] ? graph._assoc_mat[node1][node2] : undefined;
}
function get_graph_size(graph){
var size = 0;
graph.edges.forEach(function(edge){
size += edge.weight;
});
return size;
}
function add_edge_to_graph(graph, edge){
update_assoc_mat(graph, edge);
var edge_index = graph.edges.map(function(d){
return d.source+'_'+d.target;
}).indexOf(edge.source+'_'+edge.target);
if(edge_index != -1)
graph.edges[edge_index].weight = edge.weight;
else
graph.edges.push(edge);
}
function make_assoc_mat(edge_list){
var mat = {};
edge_list.forEach(function(edge, i){
mat[edge.source] = mat[edge.source] || {};
mat[edge.source][edge.target] = edge.weight;
mat[edge.target] = mat[edge.target] || {};
mat[edge.target][edge.source] = edge.weight;
});
return mat;
}
function update_assoc_mat(graph, edge){
graph._assoc_mat[edge.source] = graph._assoc_mat[edge.source] || {};
graph._assoc_mat[edge.source][edge.target] = edge.weight;
graph._assoc_mat[edge.target] = graph._assoc_mat[edge.target] || {};
graph._assoc_mat[edge.target][edge.source] = edge.weight;
}
function clone(obj){
if(obj == null || typeof(obj) != 'object')
return obj;
var temp = obj.constructor();
for(var key in obj)
temp[key] = clone(obj[key]);
return temp;
}
//Core-Algorithm Related
function init_status(graph, status, part){
status['nodes_to_com'] = {};
status['total_weight'] = 0;
status['internals'] = {};
status['degrees'] = {};
status['gdegrees'] = {};
status['loops'] = {};
status['total_weight'] = get_graph_size(graph);
if(typeof part == 'undefined'){
graph.nodes.forEach(function(node,i){
status.nodes_to_com[node] = i;
var deg = get_degree_for_node(graph, node);
if (deg < 0)
throw 'Bad graph type, use positive weights!';
status.degrees[i] = deg;
status.gdegrees[node] = deg;
status.loops[node] = get_edge_weight(graph, node, node) || 0;
status.internals[i] = status.loops[node];
});
}else{
graph.nodes.forEach(function(node,i){
var com = part[node];
status.nodes_to_com[node] = com;
var deg = get_degree_for_node(graph, node);
status.degrees[com] = (status.degrees[com] || 0) + deg;
status.gdegrees[node] = deg;
var inc = 0.0;
var neighbours = get_neighbours_of_node(graph, node);
neighbours.forEach(function(neighbour, i){
var weight = graph._assoc_mat[node][neighbour];
if (weight <= 0){
throw "Bad graph type, use positive weights";
}
if(part[neighbour] == com){
if (neighbour == node){
inc += weight;
}else{
inc += weight/2.0;
}
}
});
status.internals[com] = (status.internals[com] || 0) + inc;
});
}
}
function __modularity(status){
var links = status.total_weight;
var result = 0.0;
var communities = make_set(obj_values(status.nodes_to_com));
communities.forEach(function(com,i){
var in_degree = status.internals[com] || 0 ;
var degree = status.degrees[com] || 0 ;
if(links > 0){
result = result + in_degree / links - Math.pow((degree / (2.0*links)), 2);
}
});
return result;
}
function __neighcom(node, graph, status){
// compute the communities in the neighb. of the node, with the graph given by
// node_to_com
var weights = {};
var neighboorhood = get_neighbours_of_node(graph, node);//make iterable;
neighboorhood.forEach(function(neighbour, i){
if(neighbour != node){
var weight = graph._assoc_mat[node][neighbour] || 1;
var neighbourcom = status.nodes_to_com[neighbour];
weights[neighbourcom] = (weights[neighbourcom] || 0) + weight;
}
});
return weights;
}
function __insert(node, com, weight, status){
//insert node into com and modify status
status.nodes_to_com[node] = +com;
status.degrees[com] = (status.degrees[com] || 0) + (status.gdegrees[node]||0);
status.internals[com] = (status.internals[com] || 0) + weight + (status.loops[node]||0);
}
function __remove(node, com, weight, status){
//remove node from com and modify status
status.degrees[com] = ((status.degrees[com] || 0) - (status.gdegrees[node] || 0));
status.internals[com] = ((status.internals[com] || 0) - weight -(status.loops[node] ||0));
status.nodes_to_com[node] = -1;
}
function __renumber(dict){
var count = 0;
var ret = clone(dict); //deep copy :)
var new_values = {};
var dict_keys = Object.keys(dict);
dict_keys.forEach(function(key){
var value = dict[key];
var new_value = typeof new_values[value] =='undefined' ? -1 : new_values[value];
if(new_value == -1){
new_values[value] = count;
new_value = count;
count = count + 1;
}
ret[key] = new_value;
});
return ret;
}
function __one_level(graph, status){
//Compute one level of the Communities Dendogram.
var modif = true,
nb_pass_done = 0,
cur_mod = __modularity(status),
new_mod = cur_mod;
while (modif && nb_pass_done != __PASS_MAX){
cur_mod = new_mod;
modif = false;
nb_pass_done += 1
graph.nodes.forEach(function(node,i){
var com_node = status.nodes_to_com[node];
var degc_totw = (status.gdegrees[node] || 0) / (status.total_weight * 2.0);
var neigh_communities = __neighcom(node, graph, status);
__remove(node, com_node, (neigh_communities[com_node] || 0.0), status);
var best_com = com_node;
var best_increase = 0;
var neigh_communities_entries = Object.keys(neigh_communities);//make iterable;
neigh_communities_entries.forEach(function(com,i){
var incr = neigh_communities[com] - (status.degrees[com] || 0.0) * degc_totw;
if (incr > best_increase){
best_increase = incr;
best_com = com;
}
});
__insert(node, best_com, neigh_communities[best_com] || 0, status);
if(best_com != com_node)
modif = true;
});
new_mod = __modularity(status);
if(new_mod - cur_mod < __MIN)
break;
}
}
function induced_graph(partition, graph){
var ret = {nodes:[], edges:[], _assoc_mat: {}};
var w_prec, weight;
//add nodes from partition values
var partition_values = obj_values(partition);
ret.nodes = ret.nodes.concat(make_set(partition_values)); //make set
graph.edges.forEach(function(edge,i){
weight = edge.weight || 1;
var com1 = partition[edge.source];
var com2 = partition[edge.target];
w_prec = (get_edge_weight(ret, com1, com2) || 0);
var new_weight = (w_prec + weight);
add_edge_to_graph(ret, {'source': com1, 'target': com2, 'weight': new_weight});
});
return ret;
}
function partition_at_level(dendogram, level){
var partition = clone(dendogram[0]);
for(var i = 1; i < level + 1; i++ )
Object.keys(partition).forEach(function(key,j){
var node = key;
var com = partition[key];
partition[node] = dendogram[i][com];
});
return partition;
}
function generate_dendogram(graph, part_init){
if(graph.edges.length == 0){
var part = {};
graph.nodes.forEach(function(node,i){
part[node] = node;
});
return part;
}
var status = {};
init_status(original_graph, status, part_init);
var mod = __modularity(status);
var status_list = [];
__one_level(original_graph, status);
var new_mod = __modularity(status);
var partition = __renumber(status.nodes_to_com);
status_list.push(partition);
mod = new_mod;
var current_graph = induced_graph(partition, original_graph);
init_status(current_graph, status);
while (true){
__one_level(current_graph, status);
new_mod = __modularity(status);
if(new_mod - mod < __MIN)
break;
partition = __renumber(status.nodes_to_com);
status_list.push(partition);
mod = new_mod;
current_graph = induced_graph(partition, current_graph);
init_status(current_graph, status);
}
return status_list;
}
var core = function(){
var status = {};
var dendogram = generate_dendogram(original_graph, partition_init);
return partition_at_level(dendogram, dendogram.length - 1);
};
core.nodes = function(nds){
if(arguments.length > 0){
original_graph_nodes = nds;
return core;
} else {
return original_graph_nodes;
}
};
core.edges = function(edgs){
if(typeof original_graph_nodes == 'undefined')
throw 'Please provide the graph nodes first!';
if(arguments.length > 0){
original_graph_edges = edgs;
var assoc_mat = make_assoc_mat(edgs);
original_graph = { 'nodes': original_graph_nodes,
'edges': original_graph_edges,
'_assoc_mat': assoc_mat };
return core;
} else {
return original_graph_edges;
}
};
core.partition_init = function(prttn){
if(arguments.length > 0){
partition_init = prttn;
}
return core;
};
return core;
}
})();
exports._init = function(louvain, nodes, edges) {
return Object.entries(louvain.nodes(nodes).edges(edges)());
}
module Gargantext.Data.Louvain where
import Prelude (Unit, (<$>))
import Data.Function.Uncurried (Fn1, runFn1, Fn3, runFn3)
import Data.Map as Map
import Data.Tuple (Tuple(..))
import Data.Tuple.Native (T2, prj)
import Data.Typelevel.Num (d0, d1)
foreign import data Louvain :: Type
type Node = String
type Edge =
(
source :: Node
, target :: Node
, weight :: Number
)
type Cluster = Int
type LouvainCluster_ = T2 Node Cluster
type LouvainCluster = Map.Map Node Cluster
foreign import _jLouvain :: Fn1 Unit Louvain
louvain :: Unit -> Louvain
louvain unit = runFn1 _jLouvain unit
foreign import _init :: Fn3 Louvain (Array Node) (Array (Record Edge)) (Array LouvainCluster_)
init :: Louvain -> Array Node -> Array (Record Edge) -> LouvainCluster
init l nds edgs = Map.fromFoldable clusterTuples
where
clusterArr = runFn3 _init l nds edgs
clusterTuples = (\t2 -> Tuple (prj d0 t2) (prj d1 t2)) <$> clusterArr
module Gargantext.Hooks.Sigmax module Gargantext.Hooks.Sigmax
where where
import Prelude (Unit, bind, discard, flip, pure, unit, ($), (*>), (<<<), (<>), (>>=), not, const, map) import Prelude (Unit, bind, discard, flip, pure, unit, ($), (*>), (<<<), (<>), (>>=), (&&), not, const, map)
import Data.Array as A import Data.Array as A
import Data.Either (either) import Data.Either (either)
...@@ -74,11 +74,12 @@ cleanupSigma sigma context = traverse_ kill (readSigma sigma) ...@@ -74,11 +74,12 @@ cleanupSigma sigma context = traverse_ kill (readSigma sigma)
refreshData :: forall n e. Sigma.Sigma -> Sigma.Graph n e -> Effect Unit refreshData :: forall n e. Sigma.Sigma -> Sigma.Graph n e -> Effect Unit
refreshData sigma graph refreshData sigma graph
= log clearingMsg = log clearingMsg
*> Sigma.clear sigma *> Sigma.clear sigmaGraph
*> log readingMsg *> log readingMsg
*> Sigma.graphRead sigma graph *> Sigma.graphRead sigmaGraph graph
>>= either (log2 errorMsg) refresh >>= either (log2 errorMsg) refresh
where where
sigmaGraph = Sigma.graph sigma
refresh _ = log refreshingMsg *> Sigma.refresh sigma refresh _ = log refreshingMsg *> Sigma.refresh sigma
clearingMsg = "[refreshData] Clearing existing graph data" clearingMsg = "[refreshData] Clearing existing graph data"
readingMsg = "[refreshData] Reading graph data" readingMsg = "[refreshData] Reading graph data"
...@@ -116,7 +117,7 @@ handleForceAtlas2Pause sigmaRef (toggled /\ setToggled) mFAPauseRef = do ...@@ -116,7 +117,7 @@ handleForceAtlas2Pause sigmaRef (toggled /\ setToggled) mFAPauseRef = do
dependOnSigma sigma "[handleForceAtlas2Pause] sigma: Nothing" $ \s -> do dependOnSigma sigma "[handleForceAtlas2Pause] sigma: Nothing" $ \s -> do
--log2 "[handleForceAtlas2Pause] mSigma: Just " s --log2 "[handleForceAtlas2Pause] mSigma: Just " s
--log2 "[handleForceAtlas2Pause] toggled: " toggled --log2 "[handleForceAtlas2Pause] toggled: " toggled
isFARunning <- Sigma.isForceAtlas2Running s let isFARunning = Sigma.isForceAtlas2Running s
--log2 "[handleForceAtlas2Pause] isFARunning: " isFARunning --log2 "[handleForceAtlas2Pause] isFARunning: " isFARunning
case Tuple toggled isFARunning of case Tuple toggled isFARunning of
Tuple ST.InitialRunning false -> do Tuple ST.InitialRunning false -> do
...@@ -145,7 +146,7 @@ setEdges sigma val = do ...@@ -145,7 +146,7 @@ setEdges sigma val = do
updateEdges :: Sigma.Sigma -> ST.EdgesMap -> Effect Unit updateEdges :: Sigma.Sigma -> ST.EdgesMap -> Effect Unit
updateEdges sigma edgesMap = do updateEdges sigma edgesMap = do
Sigma.forEachEdge sigma \e -> do Sigma.forEachEdge (Sigma.graph sigma) \e -> do
let mTEdge = Map.lookup e.id edgesMap let mTEdge = Map.lookup e.id edgesMap
case mTEdge of case mTEdge of
Nothing -> error $ "Edge id " <> e.id <> " not found in edgesMap" Nothing -> error $ "Edge id " <> e.id <> " not found in edgesMap"
...@@ -158,16 +159,18 @@ updateEdges sigma edgesMap = do ...@@ -158,16 +159,18 @@ updateEdges sigma edgesMap = do
updateNodes :: Sigma.Sigma -> ST.NodesMap -> Effect Unit updateNodes :: Sigma.Sigma -> ST.NodesMap -> Effect Unit
updateNodes sigma nodesMap = do updateNodes sigma nodesMap = do
Sigma.forEachNode sigma \n -> do Sigma.forEachNode (Sigma.graph sigma) \n -> do
let mTNode = Map.lookup n.id nodesMap let mTNode = Map.lookup n.id nodesMap
case mTNode of case mTNode of
Nothing -> error $ "Node id " <> n.id <> " not found in nodesMap" Nothing -> error $ "Node id " <> n.id <> " not found in nodesMap"
(Just { borderColor: tBorderColor (Just { borderColor: tBorderColor
, color: tColor , color: tColor
, equilateral: tEquilateral
, hidden: tHidden , hidden: tHidden
, type: tType}) -> do , type: tType }) -> do
_ <- pure $ (n .= "borderColor") tBorderColor _ <- pure $ (n .= "borderColor") tBorderColor
_ <- pure $ (n .= "color") tColor _ <- pure $ (n .= "color") tColor
_ <- pure $ (n .= "equilateral") tEquilateral
_ <- pure $ (n .= "hidden") tHidden _ <- pure $ (n .= "hidden") tHidden
_ <- pure $ (n .= "type") tType _ <- pure $ (n .= "type") tType
pure unit pure unit
...@@ -209,11 +212,27 @@ selectorWithSize :: Sigma.Sigma -> Int -> Effect Unit ...@@ -209,11 +212,27 @@ selectorWithSize :: Sigma.Sigma -> Int -> Effect Unit
selectorWithSize sigma size = do selectorWithSize sigma size = do
pure unit pure unit
performDiff :: Sigma.Sigma -> ST.SGraph -> Effect Unit
performDiff sigma g = do
if (Seq.null addEdges) && (Seq.null addNodes) && (Set.isEmpty removeEdges) && (Set.isEmpty removeNodes) then
pure unit
else do
traverse_ (Sigma.addNode sigmaGraph) addNodes
traverse_ (Sigma.addEdge sigmaGraph) addEdges
traverse_ (Sigma.removeEdge sigmaGraph) removeEdges
traverse_ (Sigma.removeNode sigmaGraph) removeNodes
Sigma.refresh sigma
Sigma.killForceAtlas2 sigma
where
sigmaGraph = Sigma.graph sigma
sigmaEdgeIds = Sigma.sigmaEdgeIds sigmaGraph
sigmaNodeIds = Sigma.sigmaNodeIds sigmaGraph
{add: Tuple addEdges addNodes, remove: Tuple removeEdges removeNodes} = ST.sigmaDiff sigmaEdgeIds sigmaNodeIds g
-- DEPRECATED -- DEPRECATED
markSelectedEdges :: Sigma.Sigma -> ST.SelectedEdgeIds -> ST.EdgesMap -> Effect Unit markSelectedEdges :: Sigma.Sigma -> ST.SelectedEdgeIds -> ST.EdgesMap -> Effect Unit
markSelectedEdges sigma selectedEdgeIds graphEdges = do markSelectedEdges sigma selectedEdgeIds graphEdges = do
Sigma.forEachEdge sigma \e -> do Sigma.forEachEdge (Sigma.graph sigma) \e -> do
case Map.lookup e.id graphEdges of case Map.lookup e.id graphEdges of
Nothing -> error $ "Edge id " <> e.id <> " not found in graphEdges map" Nothing -> error $ "Edge id " <> e.id <> " not found in graphEdges map"
Just {color} -> do Just {color} -> do
...@@ -228,7 +247,7 @@ markSelectedEdges sigma selectedEdgeIds graphEdges = do ...@@ -228,7 +247,7 @@ markSelectedEdges sigma selectedEdgeIds graphEdges = do
markSelectedNodes :: Sigma.Sigma -> ST.SelectedNodeIds -> ST.NodesMap -> Effect Unit markSelectedNodes :: Sigma.Sigma -> ST.SelectedNodeIds -> ST.NodesMap -> Effect Unit
markSelectedNodes sigma selectedNodeIds graphNodes = do markSelectedNodes sigma selectedNodeIds graphNodes = do
Sigma.forEachNode sigma \n -> do Sigma.forEachNode (Sigma.graph sigma) \n -> do
case Map.lookup n.id graphNodes of case Map.lookup n.id graphNodes of
Nothing -> error $ "Node id " <> n.id <> " not found in graphNodes map" Nothing -> error $ "Node id " <> n.id <> " not found in graphNodes map"
Just {color} -> do Just {color} -> do
......
...@@ -9,6 +9,30 @@ if (typeof window !== 'undefined') { ...@@ -9,6 +9,30 @@ if (typeof window !== 'undefined') {
const CustomShapes = require('sigma/plugins/garg.js').init(sigma, window).customShapes; const CustomShapes = require('sigma/plugins/garg.js').init(sigma, window).customShapes;
require('sigma/src/utils/sigma.utils.js').init(sigma); require('sigma/src/utils/sigma.utils.js').init(sigma);
// Black circle around a node
(function() {
var originalDef = sigma.canvas.nodes.def;
sigma.canvas.nodes.def = (node, context, settings) => {
var prefix = settings('prefix') || '';
originalDef(node, context, settings);
context.strokeStyle = '#000';
context.lineWidth = 1;
context.beginPath();
context.arc(
node[prefix + 'x'],
node[prefix + 'y'],
node[prefix + 'size'],
0,
Math.PI * 2,
true
);
context.stroke();
}
})()
sigma.canvas.nodes.selected = (node, context, settings) => { sigma.canvas.nodes.selected = (node, context, settings) => {
// hack // hack
// We need to temporarily set node.type to 'def'. This is for 2 reasons // We need to temporarily set node.type to 'def'. This is for 2 reasons
...@@ -148,14 +172,6 @@ function _sigma(left, right, opts) { ...@@ -148,14 +172,6 @@ function _sigma(left, right, opts) {
} }
} }
function graphRead(left, right, sigma, data) {
try {
return right(sigma.graph.read(data));
} catch(e) {
return left(e);
}
}
function refresh(sigma) { sigma.refresh(); }
function addRenderer(left, right, sigma, renderer) { function addRenderer(left, right, sigma, renderer) {
try { try {
return right(sigma.addRenderer(renderer)); return right(sigma.addRenderer(renderer));
...@@ -171,66 +187,9 @@ function bindMouseSelectorPlugin(left, right, sig) { ...@@ -171,66 +187,9 @@ function bindMouseSelectorPlugin(left, right, sig) {
return left(e); return left(e);
} }
} }
function killRenderer(left, right, sigma, renderer) {
try {
sigma.killRenderer(renderer);
return right(sigma)
} catch(e) {
return left(e);
}
}
function getRendererContainer(sigma) {
return sigma.renderers[0].container;
}
function setRendererContainer(sigma, el) {
sigma.renderers[0].container = el;
}
function killSigma(left, right, sigma) {
try {
sigma.kill()
return right(null)
} catch(e) {
return left(e);
}
}
function clear(sigma) { sigma.graph.clear(); }
function bind(sigma, event, handler) { sigma.bind(event, handler); } function bind(sigma, event, handler) { sigma.bind(event, handler); }
function unbind(sigma, event) { sigma.unbind(event); }
function forEachNode(sigma, handler) { sigma.graph.nodes().forEach(handler); }
function forEachEdge(sigma, handler) { sigma.graph.edges().forEach(handler); }
function setSettings(sigma, settings) { sigma.settings(settings); }
function startForceAtlas2(sigma, settings) { sigma.startForceAtlas2(settings); }
function stopForceAtlas2(sigma) { sigma.stopForceAtlas2(); }
function killForceAtlas2(sigma) { sigma.killForceAtlas2(); }
function isForceAtlas2Running(sigma) { return sigma.isForceAtlas2Running(); }
function getCameras(sigma) {
// For some reason, sigma.cameras is an object with integer keys
return Object.values(sigma.cameras);
};
function goTo(cam, props) {
return cam.goTo(props);
};
exports._sigma = _sigma; exports._sigma = _sigma;
exports._graphRead = graphRead;
exports._refresh = refresh;
exports._addRenderer = addRenderer; exports._addRenderer = addRenderer;
exports._bindMouseSelectorPlugin = bindMouseSelectorPlugin; exports._bindMouseSelectorPlugin = bindMouseSelectorPlugin;
exports._killRenderer = killRenderer;
exports._getRendererContainer = getRendererContainer;
exports._setRendererContainer = setRendererContainer;
exports._killSigma = killSigma
exports._clear = clear;
exports._bind = bind; exports._bind = bind;
exports._unbind = unbind;
exports._forEachNode = forEachNode;
exports._forEachEdge = forEachEdge;
exports._setSettings = setSettings;
exports._startForceAtlas2 = startForceAtlas2;
exports._stopForceAtlas2 = stopForceAtlas2;
exports._killForceAtlas2 = killForceAtlas2;
exports._isForceAtlas2Running = isForceAtlas2Running;
exports._getCameras = getCameras;
exports._goTo = goTo;
module Gargantext.Hooks.Sigmax.Sigma where module Gargantext.Hooks.Sigmax.Sigma where
import Prelude import Prelude
import Data.Either (Either(..))
import Data.Nullable (notNull, null, Nullable)
import DOM.Simple.Console (log2)
import DOM.Simple.Types (Element) import DOM.Simple.Types (Element)
import FFI.Simple ((..)) import Data.Array as A
import Effect (Effect, foreachE) import Data.Either (Either(..))
import Data.Maybe (Maybe)
import Data.Nullable (null)
import Data.Sequence as Seq
import Data.Set as Set
import Data.Traversable (traverse_)
import Effect (Effect)
import Effect.Exception as EEx
import Effect.Timer (setTimeout) import Effect.Timer (setTimeout)
import Effect.Uncurried (EffectFn1, mkEffectFn1, runEffectFn1, EffectFn2, runEffectFn2, EffectFn3, runEffectFn3, EffectFn4, runEffectFn4) import Effect.Uncurried (EffectFn1, EffectFn3, EffectFn4, mkEffectFn1, runEffectFn3, runEffectFn4)
import Type.Row (class Union) import FFI.Simple ((..), (...), (.=))
import Reactix as R import Foreign.Object as Object
import Gargantext.Hooks.Sigmax.Types as Types import Gargantext.Hooks.Sigmax.Types as Types
import Type.Row (class Union)
-- | Type representing a sigmajs instance
foreign import data Sigma :: Type foreign import data Sigma :: Type
-- | Type representing `sigma.graph`
foreign import data SigmaGraph :: Type
type NodeRequiredProps = ( id :: String ) type NodeRequiredProps = ( id :: Types.NodeId )
type EdgeRequiredProps = ( id :: String, source :: String, target :: String ) type EdgeRequiredProps = ( id :: Types.EdgeId, source :: Types.NodeId, target :: Types.NodeId )
class NodeProps (all :: #Type) (extra :: #Type) | all -> extra class NodeProps (all :: #Type) (extra :: #Type) | all -> extra
class EdgeProps (all :: #Type) (extra :: #Type) | all -> extra class EdgeProps (all :: #Type) (extra :: #Type) | all -> extra
...@@ -33,181 +41,202 @@ instance edgeProps ...@@ -33,181 +41,202 @@ instance edgeProps
type Graph n e = { nodes :: Array {|n}, edges :: Array {|e} } type Graph n e = { nodes :: Array {|n}, edges :: Array {|e} }
type SigmaOpts s = { settings :: s } type SigmaOpts s = { settings :: s }
-- | Initialize sigmajs.
sigma :: forall opts err. SigmaOpts opts -> Effect (Either err Sigma) sigma :: forall opts err. SigmaOpts opts -> Effect (Either err Sigma)
sigma = runEffectFn3 _sigma Left Right sigma = runEffectFn3 _sigma Left Right
foreign import _sigma :: -- | Call the `refresh()` method on a sigmajs instance.
forall a b opts err.
EffectFn3 (a -> Either a b)
(b -> Either a b)
(SigmaOpts opts)
(Either err Sigma)
graphRead :: forall node edge err. Sigma -> Graph node edge -> Effect (Either err Unit)
graphRead = runEffectFn4 _graphRead Left Right
foreign import _graphRead ::
forall a b data_ err.
EffectFn4 (a -> Either a b)
(b -> Either a b)
Sigma
data_
(Either err Unit)
refresh :: Sigma -> Effect Unit refresh :: Sigma -> Effect Unit
refresh = runEffectFn1 _refresh refresh s = pure $ s ... "refresh" $ []
foreign import _refresh :: EffectFn1 Sigma Unit -- | Type representing a sigmajs renderer.
foreign import data Renderer :: Type
type RendererType = String
--makeRenderer :: forall props. RendererType -> Element -> props -> Renderer
--makeRenderer type_ container props =
-- {
-- "type": type_
-- , container
-- | props
-- }
-- | Call the `addRenderer` method on a sigmajs instance.
--addRenderer :: forall err. Sigma -> Renderer -> Effect (Either err Unit)
addRenderer :: forall r err. Sigma -> r -> Effect (Either err Unit) addRenderer :: forall r err. Sigma -> r -> Effect (Either err Unit)
addRenderer = runEffectFn4 _addRenderer Left Right addRenderer = runEffectFn4 _addRenderer Left Right
foreign import _addRenderer -- | Initialize the mouse selector plugin. This allows for custom bindings to mouse events.
:: forall a b r err.
EffectFn4 (a -> Either a b)
(b -> Either a b)
Sigma
r
(Either err Unit)
bindMouseSelectorPlugin :: forall err. Sigma -> Effect (Either err Unit) bindMouseSelectorPlugin :: forall err. Sigma -> Effect (Either err Unit)
bindMouseSelectorPlugin = runEffectFn3 _bindMouseSelectorPlugin Left Right bindMouseSelectorPlugin = runEffectFn3 _bindMouseSelectorPlugin Left Right
foreign import _bindMouseSelectorPlugin -- | Call `killRenderer` on a sigmajs instance.
:: forall a b err. killRenderer :: forall r. Sigma -> r -> Effect (Either EEx.Error Unit)
EffectFn3 (a -> Either a b) killRenderer s r = EEx.try $ pure $ s ... "killRenderer" $ [ r ]
(b -> Either a b)
Sigma
(Either err Unit)
killRenderer :: forall r err. Sigma -> r -> Effect (Either err Unit)
killRenderer = runEffectFn4 _killRenderer Left Right
foreign import _killRenderer
:: forall a b r err.
EffectFn4 (a -> Either a b)
(b -> Either a b)
Sigma
r
(Either err Unit)
getRendererContainer :: Sigma -> Effect Element -- | Get `renderers` of a sigmajs instance.
getRendererContainer = runEffectFn1 _getRendererContainer renderers :: Sigma -> Array Renderer
renderers s = s .. "renderers" :: Array Renderer
foreign import _getRendererContainer -- | Get the `container` of a sigmajs renderer.
:: EffectFn1 Sigma Element rendererContainer :: Renderer -> Element
rendererContainer r = r .. "container"
swapRendererContainer :: R.Ref (Nullable Element) -> Sigma -> Effect Unit -- | Return the container of first renderer in sigmajs instance's `renderers` list.
swapRendererContainer ref s = do getRendererContainer :: Sigma -> Maybe Element
el <- getRendererContainer s getRendererContainer s = rendererContainer <$> mContainer
log2 "[swapRendererContainer] el" el where
R.setRef ref $ notNull el mContainer = A.head $ renderers s
setRendererContainer :: Sigma -> Element -> Effect Unit -- | Set the container of first renderer in sigmajs instance's `renderers` list.
setRendererContainer = runEffectFn2 _setRendererContainer setRendererContainer :: Renderer -> Element -> Effect Unit
setRendererContainer r el = do
foreign import _setRendererContainer _ <- pure $ (r .= "container") el
:: EffectFn2 Sigma Element Unit pure unit
killSigma :: forall err. Sigma -> Effect (Either err Unit) -- | Call the `kill()` method on a sigmajs instance.
killSigma = runEffectFn3 _killSigma Left Right killSigma :: Sigma -> Effect (Either EEx.Error Unit)
killSigma s = EEx.try $ pure $ s ... "kill" $ []
clear :: Sigma -> Effect Unit -- | Get the `.graph` object from a sigmajs instance.
clear = runEffectFn1 _clear graph :: Sigma -> SigmaGraph
graph s = s .. "graph" :: SigmaGraph
foreign import _clear :: EffectFn1 Sigma Unit -- | Read graph into a sigmajs instance.
graphRead :: forall nodeExtra node edgeExtra edge. NodeProps nodeExtra node => EdgeProps edgeExtra edge => SigmaGraph -> Graph node edge -> Effect (Either EEx.Error Unit)
graphRead sg g = EEx.try $ pure $ sg ... "read" $ [ g ]
foreign import _killSigma -- | Clear a sigmajs graph.
:: forall a b err. clear :: SigmaGraph -> Effect Unit
EffectFn3 (a -> Either a b) clear sg = pure $ sg ... "clear" $ []
(b -> Either a b)
Sigma
(Either err Unit)
-- | Call `sigma.bind(event, handler)` on a sigmajs instance.
bind_ :: forall e. Sigma -> String -> (e -> Effect Unit) -> Effect Unit bind_ :: forall e. Sigma -> String -> (e -> Effect Unit) -> Effect Unit
bind_ s e h = runEffectFn3 _bind s e (mkEffectFn1 h) bind_ s e h = runEffectFn3 _bind s e (mkEffectFn1 h)
foreign import _bind :: forall e. EffectFn3 Sigma String (EffectFn1 e Unit) Unit -- | Generic function to bind a sigmajs event for edges.
bindEdgeEvent :: Sigma -> String -> (Record Types.Edge -> Effect Unit) -> Effect Unit
unbind_ :: Sigma -> String -> Effect Unit bindEdgeEvent s ev f = bind_ s ev $ \e -> do
unbind_ s e = runEffectFn2 _unbind s e let edge = e .. "data" .. "edge" :: Record Types.Edge
f edge
foreign import _unbind :: EffectFn2 Sigma String Unit -- | Generic function to bind a sigmajs event for nodes.
bindNodeEvent :: Sigma -> String -> (Record Types.Node -> Effect Unit) -> Effect Unit
forEachNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit bindNodeEvent s ev f = bind_ s ev $ \e -> do
forEachNode s f = runEffectFn2 _forEachNode s (mkEffectFn1 f)
foreign import _forEachNode :: EffectFn2 Sigma (EffectFn1 (Record Types.Node) Unit) Unit
forEachEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
forEachEdge s f = runEffectFn2 _forEachEdge s (mkEffectFn1 f)
foreign import _forEachEdge :: EffectFn2 Sigma (EffectFn1 (Record Types.Edge) Unit) Unit
bindClickNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
bindClickNode s f = bind_ s "clickNode" $ \e -> do
let node = e .. "data" .. "node" :: Record Types.Node let node = e .. "data" .. "node" :: Record Types.Node
f node f node
-- | Call `sigma.unbind(event)` on a sigmajs instance.
unbind_ :: Sigma -> String -> Effect Unit
unbind_ s e = pure $ s ... "unbind" $ [e]
edges_ :: SigmaGraph -> Array (Record Types.Edge)
edges_ sg = sg ... "edges" $ [] :: Array (Record Types.Edge)
nodes_ :: SigmaGraph -> Array (Record Types.Node)
nodes_ sg = sg ... "nodes" $ [] :: Array (Record Types.Node)
-- | Call `sigmaGraph.edges()` on a sigmajs graph instance.
edges :: SigmaGraph -> Seq.Seq (Record Types.Edge)
edges = Seq.fromFoldable <<< edges_
-- | Call `sigmaGraph.nodes()` on a sigmajs graph instance.
nodes :: SigmaGraph -> Seq.Seq (Record Types.Node)
nodes = Seq.fromFoldable <<< nodes_
-- | Fetch ids of graph edges in a sigmajs instance.
sigmaEdgeIds :: SigmaGraph -> Types.SelectedEdgeIds
sigmaEdgeIds sg = Set.fromFoldable edgeIds
where
edgeIds = _.id <$> edges sg
-- | Fetch ids of graph nodes in a sigmajs instance.
sigmaNodeIds :: SigmaGraph -> Types.SelectedNodeIds
sigmaNodeIds sg = Set.fromFoldable nodeIds
where
nodeIds = _.id <$> nodes sg
-- | Call `addEdge` on a sigmajs graph.
addEdge :: SigmaGraph -> Record Types.Edge -> Effect Unit
addEdge sg e = pure $ sg ... "addEdge" $ [e]
-- | Call `removeEdge` on a sigmajs graph.
removeEdge :: SigmaGraph -> String -> Effect Unit
removeEdge sg eId = pure $ sg ... "dropEdge" $ [eId]
--removeEdge = runEffectFn2 _removeEdge
-- | Call `addNode` on a sigmajs graph.
addNode :: SigmaGraph -> Record Types.Node -> Effect Unit
addNode sg n = pure $ sg ... "addNode" $ [n]
-- | Call `removeNode` on a sigmajs graph.
removeNode :: SigmaGraph -> String -> Effect Unit
removeNode sg nId = pure $ sg ... "dropNode" $ [nId]
-- | Iterate over all edges in a sigmajs graph.
forEachEdge :: SigmaGraph -> (Record Types.Edge -> Effect Unit) -> Effect Unit
forEachEdge sg f = traverse_ f (edges sg)
-- | Iterate over all nodes in a sigmajs graph.
forEachNode :: SigmaGraph -> (Record Types.Node -> Effect Unit) -> Effect Unit
forEachNode sg f = traverse_ f (nodes sg)
-- | Bind a `clickNode` event.
bindClickNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
bindClickNode s f = bindNodeEvent s "clickNode" f
-- | Unbind a `clickNode` event.
unbindClickNode :: Sigma -> Effect Unit unbindClickNode :: Sigma -> Effect Unit
unbindClickNode s = unbind_ s "clickNode" unbindClickNode s = unbind_ s "clickNode"
-- | Bind a `clickNodes` event.
bindClickNodes :: Sigma -> (Array (Record Types.Node) -> Effect Unit) -> Effect Unit bindClickNodes :: Sigma -> (Array (Record Types.Node) -> Effect Unit) -> Effect Unit
bindClickNodes s f = bind_ s "clickNodes" $ \e -> do bindClickNodes s f = bind_ s "clickNodes" $ \e -> do
let nodes = e .. "data" .. "node" :: Array (Record Types.Node) let ns = e .. "data" .. "node" :: Array (Record Types.Node)
f nodes f ns
-- | Unbind a `clickNodes` event.
unbindClickNodes :: Sigma -> Effect Unit unbindClickNodes :: Sigma -> Effect Unit
unbindClickNodes s = unbind_ s "clickNodes" unbindClickNodes s = unbind_ s "clickNodes"
-- | Bind a `overNode` event.
bindOverNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit bindOverNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
bindOverNode s f = bind_ s "overNode" $ \e -> do bindOverNode s f = bindNodeEvent s "overNode" f
let node = e .. "data" .. "node" :: Record Types.Node
f node
-- | Bind a `clickEdge` event.
bindClickEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit bindClickEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
bindClickEdge s f = bind_ s "clickEdge" $ \e -> do bindClickEdge s f = bindEdgeEvent s "clickEdge" f
let edge = e .. "data" .. "edge" :: Record Types.Edge -- | Unbind a `clickEdge` event.
f edge
unbindClickEdge :: Sigma -> Effect Unit unbindClickEdge :: Sigma -> Effect Unit
unbindClickEdge s = unbind_ s "clickEdge" unbindClickEdge s = unbind_ s "clickEdge"
-- | Bind a `overEdge` event.
bindOverEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit bindOverEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
bindOverEdge s f = bind_ s "overEdge" $ \e -> do bindOverEdge s f = bindEdgeEvent s "overEdge" f
let edge = e .. "data" .. "edge" :: Record Types.Edge
f edge
-- | Call `settings(s)` on a sigmajs instance.
setSettings :: forall settings. Sigma -> settings -> Effect Unit setSettings :: forall settings. Sigma -> settings -> Effect Unit
setSettings s settings = do setSettings s settings = do
runEffectFn2 _setSettings s settings _ <- pure $ s ... "settings" $ [ settings ]
refresh s refresh s
foreign import _setSettings :: forall settings. EffectFn2 Sigma settings Unit -- | Start forceAtlas2 on a sigmajs instance.
startForceAtlas2 :: forall settings. Sigma -> settings -> Effect Unit startForceAtlas2 :: forall settings. Sigma -> settings -> Effect Unit
startForceAtlas2 = runEffectFn2 _startForceAtlas2 startForceAtlas2 s settings = pure $ s ... "startForceAtlas2" $ [ settings ]
-- | Restart forceAtlas2 on a sigmajs instance.
restartForceAtlas2 :: Sigma -> Effect Unit restartForceAtlas2 :: Sigma -> Effect Unit
restartForceAtlas2 s = runEffectFn2 _startForceAtlas2 s null restartForceAtlas2 s = startForceAtlas2 s null
-- | Stop forceAtlas2 on a sigmajs instance.
stopForceAtlas2 :: Sigma -> Effect Unit stopForceAtlas2 :: Sigma -> Effect Unit
stopForceAtlas2 = runEffectFn1 _stopForceAtlas2 stopForceAtlas2 s = pure $ s ... "stopForceAtlas2" $ []
-- | Kill forceAtlas2 on a sigmajs instance.
killForceAtlas2 :: Sigma -> Effect Unit killForceAtlas2 :: Sigma -> Effect Unit
killForceAtlas2 = runEffectFn1 _killForceAtlas2 killForceAtlas2 s = pure $ s ... "killForceAtlas2" $ []
isForceAtlas2Running :: Sigma -> Effect Boolean
isForceAtlas2Running = runEffectFn1 _isForceAtlas2Running
foreign import _startForceAtlas2 :: forall s. EffectFn2 Sigma s Unit -- | Return whether forceAtlas2 is running on a sigmajs instance.
foreign import _stopForceAtlas2 :: EffectFn1 Sigma Unit isForceAtlas2Running :: Sigma -> Boolean
foreign import _killForceAtlas2 :: EffectFn1 Sigma Unit isForceAtlas2Running s = s ... "isForceAtlas2Running" $ [] :: Boolean
foreign import _isForceAtlas2Running :: EffectFn1 Sigma Boolean
-- | Refresh forceAtlas2 (with a `setTimeout` hack as it seems it doesn't work
-- | otherwise).
refreshForceAtlas :: Sigma -> Effect Unit refreshForceAtlas :: Sigma -> Effect Unit
refreshForceAtlas s = do refreshForceAtlas s = do
isRunning <- isForceAtlas2Running s let isRunning = isForceAtlas2Running s
if isRunning then if isRunning then
pure unit pure unit
else do else do
...@@ -220,14 +249,15 @@ refreshForceAtlas s = do ...@@ -220,14 +249,15 @@ refreshForceAtlas s = do
newtype SigmaEasing = SigmaEasing String newtype SigmaEasing = SigmaEasing String
sigmaEasing :: { linear :: SigmaEasing sigmaEasing ::
, quadraticIn :: SigmaEasing { linear :: SigmaEasing
, quadraticOut :: SigmaEasing , quadraticIn :: SigmaEasing
, quadraticInOut :: SigmaEasing , quadraticOut :: SigmaEasing
, cubicIn :: SigmaEasing , quadraticInOut :: SigmaEasing
, cubicOut :: SigmaEasing , cubicIn :: SigmaEasing
, cubicInOut :: SigmaEasing , cubicOut :: SigmaEasing
} , cubicInOut :: SigmaEasing
}
sigmaEasing = sigmaEasing =
{ linear : SigmaEasing "linear" { linear : SigmaEasing "linear"
, quadraticIn : SigmaEasing "quadraticIn" , quadraticIn : SigmaEasing "quadraticIn"
...@@ -248,18 +278,37 @@ type CameraProps = ...@@ -248,18 +278,37 @@ type CameraProps =
foreign import data CameraInstance' :: # Type foreign import data CameraInstance' :: # Type
type CameraInstance = { | CameraInstance' } type CameraInstance = { | CameraInstance' }
cameras :: Sigma -> Effect (Array CameraInstance) -- | Get an array of a sigma instance's `cameras`.
cameras = runEffectFn1 _getCameras cameras :: Sigma -> Array CameraInstance
cameras s = Object.values cs
foreign import _getCameras :: EffectFn1 Sigma (Array CameraInstance) where
-- For some reason, `sigma.cameras` is an object with integer keys.
cs = s .. "cameras" :: Object.Object CameraInstance
goTo :: Record CameraProps -> CameraInstance -> Effect Unit goTo :: Record CameraProps -> CameraInstance -> Effect Unit
goTo props cam = do goTo props cam = pure $ cam ... "goTo" $ [props]
runEffectFn2 _goTo cam props
foreign import _goTo :: EffectFn2 CameraInstance (Record CameraProps) Unit
goToAllCameras :: Sigma -> Record CameraProps -> Effect Unit goToAllCameras :: Sigma -> Record CameraProps -> Effect Unit
goToAllCameras s props = do goToAllCameras s props = traverse_ (goTo props) $ cameras s
cs <- cameras s
foreachE cs (goTo props) -- | FFI
foreign import _sigma ::
forall a b opts err.
EffectFn3 (a -> Either a b)
(b -> Either a b)
(SigmaOpts opts)
(Either err Sigma)
foreign import _addRenderer
:: forall a b r err.
EffectFn4 (a -> Either a b)
(b -> Either a b)
Sigma
r
(Either err Unit)
foreign import _bindMouseSelectorPlugin
:: forall a b err.
EffectFn3 (a -> Either a b)
(b -> Either a b)
Sigma
(Either err Unit)
foreign import _bind :: forall e. EffectFn3 Sigma String (EffectFn1 e Unit) Unit
module Gargantext.Hooks.Sigmax.Types where module Gargantext.Hooks.Sigmax.Types where
import DOM.Simple.Types (Element) import DOM.Simple.Types (Element)
import Data.Array as A
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust)
import Data.Sequence as Seq import Data.Sequence as Seq
import Data.Set as Set import Data.Set as Set
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Prelude (map, ($), (&&), (||), (==), class Eq, class Ord, class Show, Ordering, compare) import Partial.Unsafe (unsafePartial)
import Prelude (class Eq, class Show, map, ($), (&&), (==), (||), (<$>), mod, not)
newtype Graph n e = Graph { nodes :: Seq.Seq {|n}, edges :: Seq.Seq {|e} } import Gargantext.Data.Louvain as Louvain
import Gargantext.Types as GT
newtype Graph n e = Graph { edges :: Seq.Seq {|e}, nodes :: Seq.Seq {|n} }
--derive instance eqGraph :: Eq Graph --derive instance eqGraph :: Eq Graph
...@@ -20,12 +26,16 @@ newtype Graph n e = Graph { nodes :: Seq.Seq {|n}, edges :: Seq.Seq {|e} } ...@@ -20,12 +26,16 @@ newtype Graph n e = Graph { nodes :: Seq.Seq {|n}, edges :: Seq.Seq {|e} }
type Renderer = { "type" :: String, container :: Element } type Renderer = { "type" :: String, container :: Element }
type NodeId = String
type EdgeId = String
type Node = type Node =
( borderColor :: String ( borderColor :: String
, color :: String , color :: String
, equilateral :: { numPoints :: Int }
, gargType :: GT.Mode
, hidden :: Boolean , hidden :: Boolean
, id :: String , id :: NodeId
, label :: String , label :: String
, size :: Number , size :: Number
, type :: String -- available types: circle, cross, def, diamond, equilateral, pacman, square, star , type :: String -- available types: circle, cross, def, diamond, equilateral, pacman, square, star
...@@ -36,22 +46,31 @@ type Node = ...@@ -36,22 +46,31 @@ type Node =
type Edge = type Edge =
( color :: String ( color :: String
, confluence :: Number , confluence :: Number
, id :: String , id :: EdgeId
, hidden :: Boolean , hidden :: Boolean
, size :: Number , size :: Number
, source :: String , source :: NodeId
, sourceNode :: Record Node , sourceNode :: Record Node
, target :: String , target :: NodeId
, targetNode :: Record Node , targetNode :: Record Node
, weight :: Number ) , weight :: Number )
type SelectedNodeIds = Set.Set String type SelectedNodeIds = Set.Set NodeId
type SelectedEdgeIds = Set.Set String type SelectedEdgeIds = Set.Set EdgeId
type EdgesMap = Map.Map String (Record Edge) type EdgesMap = Map.Map String (Record Edge)
type NodesMap = Map.Map String (Record Node) type NodesMap = Map.Map String (Record Node)
type SGraph = Graph Node Edge type SGraph = Graph Node Edge
-- Diff graph structure
-- NOTE: "add" is NOT a graph. There can be edges which join nodes that are not
-- in the SigmaDiff nodes array.
type SigmaDiff =
(
add :: Tuple (Seq.Seq (Record Edge)) (Seq.Seq (Record Node))
, remove :: Tuple SelectedEdgeIds SelectedNodeIds
)
graphEdges :: SGraph -> Seq.Seq (Record Edge) graphEdges :: SGraph -> Seq.Seq (Record Edge)
graphEdges (Graph {edges}) = edges graphEdges (Graph {edges}) = edges
...@@ -62,8 +81,8 @@ edgesGraphMap :: SGraph -> EdgesMap ...@@ -62,8 +81,8 @@ edgesGraphMap :: SGraph -> EdgesMap
edgesGraphMap graph = edgesGraphMap graph =
Map.fromFoldable $ map (\e -> Tuple e.id e) $ graphEdges graph Map.fromFoldable $ map (\e -> Tuple e.id e) $ graphEdges graph
edgesById :: SGraph -> SelectedEdgeIds -> Seq.Seq (Record Edge) edgesFilter :: (Record Edge -> Boolean) -> SGraph -> SGraph
edgesById g edgeIds = Seq.filter (\e -> Set.member e.id edgeIds) $ graphEdges g edgesFilter f (Graph {edges, nodes}) = Graph { edges: Seq.filter f edges, nodes }
nodesMap :: Seq.Seq (Record Node) -> NodesMap nodesMap :: Seq.Seq (Record Node) -> NodesMap
nodesMap nodes = Map.fromFoldable $ map (\n -> Tuple n.id n) nodes nodesMap nodes = Map.fromFoldable $ map (\n -> Tuple n.id n) nodes
...@@ -72,16 +91,45 @@ nodesGraphMap :: SGraph -> NodesMap ...@@ -72,16 +91,45 @@ nodesGraphMap :: SGraph -> NodesMap
nodesGraphMap graph = nodesGraphMap graph =
nodesMap $ graphNodes graph nodesMap $ graphNodes graph
nodesById :: SGraph -> SelectedNodeIds -> Seq.Seq (Record Node) nodesFilter :: (Record Node -> Boolean) -> SGraph -> SGraph
nodesById g nodeIds = Seq.filter (\n -> Set.member n.id nodeIds) $ graphNodes g nodesFilter f (Graph {edges, nodes}) = Graph { edges, nodes: Seq.filter f nodes }
nodesById :: SGraph -> SelectedNodeIds -> SGraph
nodesById g nodeIds = nodesFilter (\n -> Set.member n.id nodeIds) g
-- | "Subtract" second graph from first one (only node/edge id's are compared, not other props)
sub :: SGraph -> SGraph -> SGraph
sub graph (Graph {nodes, edges}) = newGraph
where
edgeIds = Set.fromFoldable $ Seq.map _.id edges
nodeIds = Set.fromFoldable $ Seq.map _.id nodes
edgeFilterFunc e = (not $ Set.member e.id edgeIds)
&& (not $ Set.member e.source nodeIds)
&& (not $ Set.member e.target nodeIds)
filteredEdges = edgesFilter edgeFilterFunc graph
newGraph = nodesFilter (\n -> not (Set.member n.id nodeIds)) filteredEdges
-- | Compute a diff between current sigma graph and whatever is set via customer controls
sigmaDiff :: SelectedEdgeIds -> SelectedNodeIds -> SGraph -> Record SigmaDiff
sigmaDiff sigmaEdges sigmaNodes g@(Graph {nodes, edges}) = {add, remove}
where
add = Tuple addEdges addNodes
remove = Tuple removeEdges removeNodes
addG = edgesFilter (\e -> not (Set.member e.id sigmaEdges)) $ nodesFilter (\n -> not (Set.member n.id sigmaNodes)) g
addEdges = graphEdges addG
addNodes = graphNodes addG
removeEdges = Set.difference sigmaEdges (Set.fromFoldable $ Seq.map _.id edges)
removeNodes = Set.difference sigmaNodes (Set.fromFoldable $ Seq.map _.id nodes)
neighbours :: SGraph -> Seq.Seq (Record Node) -> Seq.Seq (Record Node) neighbours :: SGraph -> Seq.Seq (Record Node) -> Seq.Seq (Record Node)
neighbours g nodes = Seq.fromFoldable $ Set.unions [Set.fromFoldable nodes, sources, targets] neighbours g nodes = Seq.fromFoldable $ Set.unions [Set.fromFoldable nodes, sources, targets]
where where
nodeIds = Set.fromFoldable $ Seq.map _.id nodes nodeIds = Set.fromFoldable $ Seq.map _.id nodes
selectedEdges = neighbouringEdges g nodeIds selectedEdges = neighbouringEdges g nodeIds
sources = Set.fromFoldable $ nodesById g $ Set.fromFoldable $ Seq.map _.source selectedEdges sources = Set.fromFoldable $ graphNodes $ nodesById g $ Set.fromFoldable $ Seq.map _.source selectedEdges
targets = Set.fromFoldable $ nodesById g $ Set.fromFoldable $ Seq.map _.target selectedEdges targets = Set.fromFoldable $ graphNodes $ nodesById g $ Set.fromFoldable $ Seq.map _.target selectedEdges
neighbouringEdges :: SGraph -> SelectedNodeIds -> Seq.Seq (Record Edge) neighbouringEdges :: SGraph -> SelectedNodeIds -> Seq.Seq (Record Edge)
neighbouringEdges g nodeIds = Seq.filter condition $ graphEdges g neighbouringEdges g nodeIds = Seq.filter condition $ graphEdges g
...@@ -155,3 +203,45 @@ forceAtlasEdgeState Running EShow = ETempHiddenThenShow ...@@ -155,3 +203,45 @@ forceAtlasEdgeState Running EShow = ETempHiddenThenShow
forceAtlasEdgeState Running es = es forceAtlasEdgeState Running es = es
forceAtlasEdgeState Paused ETempHiddenThenShow = EShow forceAtlasEdgeState Paused ETempHiddenThenShow = EShow
forceAtlasEdgeState Paused es = es forceAtlasEdgeState Paused es = es
louvainEdges :: SGraph -> Array (Record Louvain.Edge)
louvainEdges g = Seq.toUnfoldable $ Seq.map (\{source, target, weight} -> {source, target, weight}) (graphEdges g)
louvainNodes :: SGraph -> Array Louvain.Node
louvainNodes g = Seq.toUnfoldable $ Seq.map _.id (graphNodes g)
louvainGraph :: SGraph -> Louvain.LouvainCluster -> SGraph
louvainGraph g cluster = Graph {nodes: newNodes, edges: newEdges}
where
nodes = graphNodes g
edges = graphEdges g
newNodes = (nodeClusterColor cluster) <$> nodes
nm = nodesMap newNodes
newEdges = (edgeClusterColor cluster nm) <$> edges
edgeClusterColor cluster nm e = e { color = sourceNode.color, sourceNode = sourceNode, targetNode = targetNode }
where
sourceNode = case Map.lookup e.source nm of
Just sn -> sn
Nothing -> e.sourceNode
targetNode = case Map.lookup e.target nm of
Just tn -> tn
Nothing -> e.targetNode
nodeClusterColor cluster n = n { color = newColor }
where
newColor = case Map.lookup n.id cluster of
Nothing -> n.color
Just c -> do
let idx = c `mod` (A.length defaultPalette)
unsafePartial $ fromJust $ defaultPalette A.!! idx
defaultPalette :: Array String
defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff"
,"#b399df","#ffdfed","#33c8f3","#739e9a"
,"#caeca3","#f6f7e5","#f9bcca","#ccb069"
,"#c9ffde","#c58683","#6c9eb0","#ffd3cf"
,"#ccffc7","#52a1b0","#d2ecff","#99fffe"
,"#9295ae","#5ea38b","#fff0b3","#d99e68"
]
...@@ -9,6 +9,7 @@ import Prim.Row (class Union) ...@@ -9,6 +9,7 @@ import Prim.Row (class Union)
import URI.Query (Query) import URI.Query (Query)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Ord (genericCompare)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
newtype SessionId = SessionId String newtype SessionId = SessionId String
...@@ -409,3 +410,27 @@ instance showTabType :: Show TabType where ...@@ -409,3 +410,27 @@ instance showTabType :: Show TabType where
type TableResult a = {count :: Int, docs :: Array a} type TableResult a = {count :: Int, docs :: Array a}
type AffTableResult a = Aff (TableResult a) type AffTableResult a = Aff (TableResult a)
data Mode = Authors | Sources | Institutes | Terms
derive instance genericMode :: Generic Mode _
instance showMode :: Show Mode where
show = genericShow
derive instance eqMode :: Eq Mode
instance ordMode :: Ord Mode where
compare = genericCompare
modeTabType :: Mode -> CTabNgramType
modeTabType Authors = CTabAuthors
modeTabType Sources = CTabSources
modeTabType Institutes = CTabInstitutes
modeTabType Terms = CTabTerms
modeFromString :: String -> Maybe Mode
modeFromString "Authors" = Just Authors
modeFromString "Sources" = Just Sources
modeFromString "Institutes" = Just Institutes
modeFromString "Terms" = Just Terms
modeFromString _ = Nothing
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