Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
P
purescript-gargantext
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
142
Issues
142
List
Board
Labels
Milestones
Merge Requests
4
Merge Requests
4
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Charts
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
gargantext
purescript-gargantext
Commits
b2cd1fd9
Commit
b2cd1fd9
authored
Jan 06, 2020
by
Alexandre Delanoë
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'dev-sigmajs-selector' into dev
parents
c73f90ca
8f3e328c
Changes
27
Show whitespace changes
Inline
Side-by-side
Showing
27 changed files
with
1001 additions
and
512 deletions
+1001
-512
packages.json
.psc-package/local/.set/packages.json
+10
-0
Graph.css
dist/styles/Graph.css
+2
-1
Graph.sass
dist/styles/Graph.sass
+2
-1
package.json
package.json
+1
-0
packages.dhall
packages.dhall
+5
-0
psc-package.json
psc-package.json
+1
-0
AnnotatedField.purs
src/Gargantext/Components/Annotation/AnnotatedField.purs
+0
-1
DocsTable.purs
src/Gargantext/Components/DocsTable.purs
+7
-6
Add.purs
src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
+0
-1
Upload.purs
...Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
+0
-1
Graph.purs
src/Gargantext/Components/Graph.purs
+4
-1
GraphExplorer.purs
src/Gargantext/Components/GraphExplorer.purs
+66
-164
Controls.purs
src/Gargantext/Components/GraphExplorer/Controls.purs
+7
-2
Search.purs
src/Gargantext/Components/GraphExplorer/Search.purs
+20
-17
Sidebar.purs
src/Gargantext/Components/GraphExplorer/Sidebar.purs
+59
-50
ToggleButton.purs
src/Gargantext/Components/GraphExplorer/ToggleButton.purs
+11
-1
NgramsTable.purs
src/Gargantext/Components/NgramsTable.purs
+3
-3
Annuaire.purs
src/Gargantext/Components/Nodes/Annuaire.purs
+1
-1
Tabs.purs
src/Gargantext/Components/Nodes/Lists/Tabs.purs
+1
-16
SearchBar.purs
src/Gargantext/Components/Search/SearchBar.purs
+1
-8
Louvain.js
src/Gargantext/Data/Louvain.js
+384
-0
Louvain.purs
src/Gargantext/Data/Louvain.purs
+36
-0
Sigmax.purs
src/Gargantext/Hooks/Sigmax.purs
+28
-9
Sigma.js
src/Gargantext/Hooks/Sigmax/Sigma.js
+24
-65
Sigma.purs
src/Gargantext/Hooks/Sigmax/Sigma.purs
+199
-150
Types.purs
src/Gargantext/Hooks/Sigmax/Types.purs
+104
-14
Types.purs
src/Gargantext/Types.purs
+25
-0
No files found.
.psc-package/local/.set/packages.json
View file @
b2cd1fd9
...
@@ -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"
,
...
...
dist/styles/Graph.css
View file @
b2cd1fd9
...
@@ -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
;
...
...
dist/styles/Graph.sass
View file @
b2cd1fd9
...
@@ -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
...
...
package.json
View file @
b2cd1fd9
...
@@ -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"
...
...
packages.dhall
View file @
b2cd1fd9
...
@@ -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" ]
...
...
psc-package.json
View file @
b2cd1fd9
...
@@ -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"
...
...
src/Gargantext/Components/Annotation/AnnotatedField.purs
View file @
b2cd1fd9
...
@@ -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 =
...
...
src/Gargantext/Components/DocsTable.purs
View file @
b2cd1fd9
...
@@ -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' c
at = 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 c
at
setLocalCategories $ Map.insert r._id c
void $ launchAff $ putCategories session nodeId $ CategoryQuery {nodeIds: [r._id], category: c
at
}
void $ launchAff $ putCategories session nodeId $ CategoryQuery {nodeIds: [r._id], category: c}
icon :: Category -> Boolean -> String
icon :: Category -> Boolean -> String
...
...
src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
View file @
b2cd1fd9
...
@@ -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)
...
...
src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
View file @
b2cd1fd9
...
@@ -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
...
...
src/Gargantext/Components/Graph.purs
View file @
b2cd1fd9
...
@@ -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.G
raph" 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)
...
...
src/Gargantext/Components/GraphExplorer.purs
View file @
b2cd1fd9
...
@@ -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 D
ata.FoldableWithIndex (foldMapWithIndex
)
import D
OM.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 t
ype
, type :
modeGraphType gargT
ype
, 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
...
...
src/Gargantext/Components/GraphExplorer/Controls.purs
View file @
b2cd1fd9
...
@@ -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
...
...
src/Gargantext/Components/GraphExplorer/Search.purs
View file @
b2cd1fd9
...
@@ -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 n
odes = SigmaxTypes.graphNodes graph
let graphN
odes = SigmaxTypes.graphNodes graph
let matching = (_.id) <$> searchNodes search n
odes
let matching = Set.fromFoldable $ (_.id) <$> searchNodes search graphN
odes
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
src/Gargantext/Components/GraphExplorer/Sidebar.purs
View file @
b2cd1fd9
...
@@ -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
}
}
src/Gargantext/Components/GraphExplorer/ToggleButton.purs
View file @
b2cd1fd9
...
@@ -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 {
...
...
src/Gargantext/Components/NgramsTable.purs
View file @
b2cd1fd9
...
@@ -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"}
...
...
src/Gargantext/Components/Nodes/Annuaire.purs
View file @
b2cd1fd9
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)
...
...
src/Gargantext/Components/Nodes/Lists/Tabs.purs
View file @
b2cd1fd9
...
@@ -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
...
...
src/Gargantext/Components/Search/SearchBar.purs
View file @
b2cd1fd9
...
@@ -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)
...
...
src/Gargantext/Data/Louvain.js
0 → 100755
View file @
b2cd1fd9
/*
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
)());
}
src/Gargantext/Data/Louvain.purs
0 → 100644
View file @
b2cd1fd9
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
src/Gargantext/Hooks/Sigmax.purs
View file @
b2cd1fd9
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 sigma
Graph
*> log readingMsg
*> log readingMsg
*> Sigma.graphRead sigma graph
*> Sigma.graphRead sigma
Graph
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
...
...
src/Gargantext/Hooks/Sigmax/Sigma.js
View file @
b2cd1fd9
...
@@ -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
;
src/Gargantext/Hooks/Sigmax/Sigma.purs
View file @
b2cd1fd9
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 U
nit
pure u
nit
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 n
ode
s = e .. "data" .. "node" :: Array (Record Types.Node)
let ns = e .. "data" .. "node" :: Array (Record Types.Node)
f n
ode
s
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
src/Gargantext/Hooks/Sigmax/Types.purs
View file @
b2cd1fd9
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
edges
ById :: SGraph -> SelectedEdgeIds -> Seq.Seq (Record Edge)
edges
Filter :: (Record Edge -> Boolean) -> SGraph -> SGraph
edges
ById g edgeIds = Seq.filter (\e -> Set.member e.id edgeIds) $ graphEdges g
edges
Filter 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"
]
src/Gargantext/Types.purs
View file @
b2cd1fd9
...
@@ -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
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment