Commit 024d161d authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[graph] respect the startForceAtlas graph hyperdata setting

parent 849e94c9
...@@ -6,7 +6,6 @@ ...@@ -6,7 +6,6 @@
"aff-promise", "aff-promise",
"affjax", "affjax",
"argonaut", "argonaut",
"codec-argonaut",
"console", "console",
"css", "css",
"datetime", "datetime",
......
...@@ -34,6 +34,7 @@ type Props sigma forceatlas2 = ...@@ -34,6 +34,7 @@ type Props sigma forceatlas2 =
, sigmaRef :: R.Ref Sigmax.Sigma , sigmaRef :: R.Ref Sigmax.Sigma
, sigmaSettings :: sigma , sigmaSettings :: sigma
, stage :: R.State Stage , stage :: R.State Stage
, startForceAtlas :: Boolean
, transformedGraph :: SigmaxTypes.SGraph , transformedGraph :: SigmaxTypes.SGraph
) )
...@@ -82,7 +83,12 @@ graphCpt = R.hooksComponent "G.C.Graph" cpt ...@@ -82,7 +83,12 @@ graphCpt = R.hooksComponent "G.C.Graph" cpt
pure unit pure unit
Sigmax.setEdges sig false Sigmax.setEdges sig false
Sigma.startForceAtlas2 sig props.forceAtlas2Settings
log2 "[graph] startForceAtlas" props.startForceAtlas
if props.startForceAtlas then
Sigma.startForceAtlas2 sig props.forceAtlas2Settings
else
Sigma.stopForceAtlas2 sig
pure unit pure unit
Just sig -> do Just sig -> do
......
...@@ -7,7 +7,7 @@ import Data.Array as A ...@@ -7,7 +7,7 @@ import Data.Array as A
import Data.FoldableWithIndex (foldMapWithIndex) 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, maybe)
import Data.Nullable (null, Nullable) 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
...@@ -96,10 +96,14 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -96,10 +96,14 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
, sessions , sessions
, showLogin , showLogin
, treeReload } _ = do , treeReload } _ = do
let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas }) -> startForceAtlas) mMetaData
let forceAtlasS = if startForceAtlas then SigmaxT.InitialRunning else SigmaxT.InitialStopped
dataRef <- R.useRef graph dataRef <- R.useRef graph
graphRef <- R.useRef null graphRef <- R.useRef null
graphVersionRef <- R.useRef (fst graphVersion) graphVersionRef <- R.useRef (fst graphVersion)
controls <- Controls.useGraphControls graph graphId session controls <- Controls.useGraphControls graph graphId session forceAtlasS
multiSelectEnabledRef <- R.useRef $ fst controls.multiSelectEnabled multiSelectEnabledRef <- R.useRef $ fst controls.multiSelectEnabled
R.useEffect' $ do R.useEffect' $ do
...@@ -117,7 +121,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -117,7 +121,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
snd controls.removedNodeIds $ const SigmaxT.emptyNodeIds snd controls.removedNodeIds $ const SigmaxT.emptyNodeIds
snd controls.selectedNodeIds $ const SigmaxT.emptyNodeIds snd controls.selectedNodeIds $ const SigmaxT.emptyNodeIds
snd controls.showEdges $ const SigmaxT.EShow snd controls.showEdges $ const SigmaxT.EShow
snd controls.forceAtlasState $ const SigmaxT.InitialRunning snd controls.forceAtlasState $ const forceAtlasS
snd controls.graphStage $ const Graph.Init snd controls.graphStage $ const Graph.Init
snd controls.showSidePanel $ const GET.InitialClosed snd controls.showSidePanel $ const GET.InitialClosed
...@@ -145,6 +149,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt ...@@ -145,6 +149,7 @@ explorerCpt = R.hooksComponent "G.C.GraphExplorer.explorer" cpt
, elRef: graphRef , elRef: graphRef
, graphId , graphId
, graph , graph
, mMetaData
, multiSelectEnabledRef , multiSelectEnabledRef
} }
, mSidebar mMetaData { frontends , mSidebar mMetaData { frontends
...@@ -215,6 +220,7 @@ type GraphProps = ( ...@@ -215,6 +220,7 @@ type GraphProps = (
, elRef :: R.Ref (Nullable Element) , elRef :: R.Ref (Nullable Element)
, graphId :: GET.GraphId , graphId :: GET.GraphId
, graph :: SigmaxT.SGraph , graph :: SigmaxT.SGraph
, mMetaData :: Maybe GET.MetaData
, multiSelectEnabledRef :: R.Ref Boolean , multiSelectEnabledRef :: R.Ref Boolean
) )
...@@ -225,7 +231,7 @@ graphView props = R.createElement graphViewCpt props [] ...@@ -225,7 +231,7 @@ graphView props = R.createElement graphViewCpt props []
graphViewCpt :: R.Component GraphProps graphViewCpt :: R.Component GraphProps
graphViewCpt = R.hooksComponent "GraphView" cpt graphViewCpt = R.hooksComponent "GraphView" cpt
where where
cpt {controls, elRef, graphId, graph, multiSelectEnabledRef} _children = do cpt {controls, elRef, graphId, graph, mMetaData, multiSelectEnabledRef} _children = do
-- TODO Cache this? -- TODO Cache this?
let louvainGraph = let louvainGraph =
if (fst controls.showLouvain) then if (fst controls.showLouvain) then
...@@ -235,6 +241,7 @@ graphViewCpt = R.hooksComponent "GraphView" cpt ...@@ -235,6 +241,7 @@ graphViewCpt = R.hooksComponent "GraphView" cpt
else else
graph graph
let transformedGraph = transformGraph controls louvainGraph let transformedGraph = transformGraph controls louvainGraph
let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas }) -> startForceAtlas) mMetaData
R.useEffect1' (fst controls.multiSelectEnabled) $ do R.useEffect1' (fst controls.multiSelectEnabled) $ do
R.setRef multiSelectEnabledRef $ fst controls.multiSelectEnabled R.setRef multiSelectEnabledRef $ fst controls.multiSelectEnabled
...@@ -249,6 +256,7 @@ graphViewCpt = R.hooksComponent "GraphView" cpt ...@@ -249,6 +256,7 @@ graphViewCpt = R.hooksComponent "GraphView" cpt
, sigmaRef: controls.sigmaRef , sigmaRef: controls.sigmaRef
, sigmaSettings: Graph.sigmaSettings , sigmaSettings: Graph.sigmaSettings
, stage: controls.graphStage , stage: controls.graphStage
, startForceAtlas
, transformedGraph , transformedGraph
} }
......
...@@ -21,11 +21,11 @@ type GraphAsyncUpdateParams = ...@@ -21,11 +21,11 @@ type GraphAsyncUpdateParams =
) )
graphAsyncUpdate :: Record GraphAsyncUpdateParams -> Aff GT.AsyncTaskWithType graphAsyncUpdate :: Record GraphAsyncUpdateParams -> Aff GT.AsyncTaskWithType
graphAsyncUpdate {graphId, listId, nodes, session, termList, version} = do graphAsyncUpdate { graphId, listId, nodes, session, termList, version } = do
task <- post session p q task <- post session p q
pure $ GT.AsyncTaskWithType { task, typ: GT.GraphT } pure $ GT.AsyncTaskWithType { task, typ: GT.GraphRecompute }
where where
p = GR.GraphAPI graphId $ GT.asyncTaskTypePath GT.GraphT p = GR.GraphAPI graphId $ GT.asyncTaskTypePath GT.GraphRecompute
q = { listId q = { listId
, nodes , nodes
, termList , termList
...@@ -41,9 +41,9 @@ type GraphAsyncRecomputeParams = ...@@ -41,9 +41,9 @@ type GraphAsyncRecomputeParams =
graphAsyncRecompute :: Record GraphAsyncRecomputeParams -> Aff GT.AsyncTaskWithType graphAsyncRecompute :: Record GraphAsyncRecomputeParams -> Aff GT.AsyncTaskWithType
graphAsyncRecompute { graphId, session } = do graphAsyncRecompute { graphId, session } = do
task <- post session p q task <- post session p q
pure $ GT.AsyncTaskWithType { task, typ: GT.GraphT } pure $ GT.AsyncTaskWithType { task, typ: GT.GraphRecompute }
where where
p = GR.GraphAPI graphId $ GT.asyncTaskTypePath GT.GraphT p = GR.GraphAPI graphId $ GT.asyncTaskTypePath GT.GraphRecompute
q = {} q = {}
type QueryProgressParams = type QueryProgressParams =
......
...@@ -166,14 +166,14 @@ controlsCpt = R.hooksComponent "GraphControls" cpt ...@@ -166,14 +166,14 @@ controlsCpt = R.hooksComponent "GraphControls" cpt
] ]
] ]
useGraphControls :: SigmaxT.SGraph -> GET.GraphId -> Session -> R.Hooks (Record Controls) useGraphControls :: SigmaxT.SGraph -> GET.GraphId -> Session -> SigmaxT.ForceAtlasState -> R.Hooks (Record Controls)
useGraphControls graph graphId session = do useGraphControls graph graphId session forceAtlasS = do
edgeConfluence <- R.useState' $ Range.Closed { min: 0.0, max: 1.0 } edgeConfluence <- R.useState' $ Range.Closed { min: 0.0, max: 1.0 }
edgeWeight <- R.useState' $ Range.Closed { edgeWeight <- R.useState' $ Range.Closed {
min: 0.0 min: 0.0
, max: I.toNumber $ Seq.length $ SigmaxT.graphEdges graph , max: I.toNumber $ Seq.length $ SigmaxT.graphEdges graph
} }
forceAtlasState <- R.useState' SigmaxT.InitialRunning forceAtlasState <- R.useState' forceAtlasS
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 }
......
...@@ -116,6 +116,7 @@ pauseForceAtlasButtonCpt = R.hooksComponent "ForceAtlasToggleButton" cpt ...@@ -116,6 +116,7 @@ pauseForceAtlasButtonCpt = R.hooksComponent "ForceAtlasToggleButton" cpt
[ H.text (text state) ] [ H.text (text state) ]
] ]
text SigmaxTypes.InitialRunning = "Pause Force Atlas" text SigmaxTypes.InitialRunning = "Pause Force Atlas"
text SigmaxTypes.InitialStopped = "Start Force Atlas"
text SigmaxTypes.Running = "Pause Force Atlas" text SigmaxTypes.Running = "Pause Force Atlas"
text SigmaxTypes.Paused = "Start Force Atlas" text SigmaxTypes.Paused = "Start Force Atlas"
......
...@@ -60,12 +60,13 @@ derive instance newtypeGraphData :: Newtype GraphData _ ...@@ -60,12 +60,13 @@ derive instance newtypeGraphData :: Newtype GraphData _
newtype MetaData = MetaData newtype MetaData = MetaData
{ title :: String { corpusId :: Array Int
, legend :: Array Legend , legend :: Array Legend
, corpusId :: Array Int
, list :: { listId :: ListId , list :: { listId :: ListId
, version :: Version , version :: Version
} }
, startForceAtlas :: Boolean
, title :: String
} }
getLegend :: GraphData -> Maybe (Array Legend) getLegend :: GraphData -> Maybe (Array Legend)
...@@ -100,7 +101,13 @@ initialGraphData = GraphData { ...@@ -100,7 +101,13 @@ initialGraphData = GraphData {
nodes: [] nodes: []
, edges: [] , edges: []
, sides: [] , sides: []
, metaData : Just $ MetaData {title : "", legend : [], corpusId : [], list: {listId : 0, version : 0}} , metaData : Just $ MetaData {
corpusId : []
, legend : []
, list: { listId : 0, version : 0 }
, startForceAtlas: true
, title : ""
}
} }
instance decodeJsonGraphData :: DecodeJson GraphData where instance decodeJsonGraphData :: DecodeJson GraphData where
...@@ -134,13 +141,20 @@ instance decodeJsonNode :: DecodeJson Node where ...@@ -134,13 +141,20 @@ instance decodeJsonNode :: DecodeJson Node where
instance decodeJsonMetaData :: DecodeJson MetaData where instance decodeJsonMetaData :: DecodeJson MetaData where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
title <- obj .: "title"
legend <- obj .: "legend" legend <- obj .: "legend"
corpusId <- obj .: "corpusId" corpusId <- obj .: "corpusId"
list <- obj .: "list" list <- obj .: "list"
listId <- list .: "listId" listId <- list .: "listId"
startForceAtlas <- obj .: "startForceAtlas"
title <- obj .: "title"
version <- list .: "version" version <- list .: "version"
pure $ MetaData { title, legend, corpusId, list: {listId, version}} pure $ MetaData {
corpusId
, legend
, list: {listId, version}
, startForceAtlas
, title
}
instance decodeJsonLegend :: DecodeJson Legend where instance decodeJsonLegend :: DecodeJson Legend where
......
...@@ -151,7 +151,7 @@ eqGraph (Graph {nodes: n1, edges: e1}) (Graph {nodes: n2, edges: e2}) = (n1 == n ...@@ -151,7 +151,7 @@ eqGraph (Graph {nodes: n1, edges: e1}) (Graph {nodes: n2, edges: e2}) = (n1 == n
-- however when graph is loaded initially, forceAtlas is running for a couple of -- however when graph is loaded initially, forceAtlas is running for a couple of
-- seconds and then stops (unless the user alters this by clicking the toggle -- seconds and then stops (unless the user alters this by clicking the toggle
-- button). -- button).
data ForceAtlasState = InitialRunning | Running | Paused data ForceAtlasState = InitialRunning | InitialStopped | Running | Paused
derive instance genericForceAtlasState :: Generic ForceAtlasState _ derive instance genericForceAtlasState :: Generic ForceAtlasState _
instance eqForceAtlasState :: Eq ForceAtlasState where instance eqForceAtlasState :: Eq ForceAtlasState where
...@@ -159,6 +159,7 @@ instance eqForceAtlasState :: Eq ForceAtlasState where ...@@ -159,6 +159,7 @@ instance eqForceAtlasState :: Eq ForceAtlasState where
toggleForceAtlasState :: ForceAtlasState -> ForceAtlasState toggleForceAtlasState :: ForceAtlasState -> ForceAtlasState
toggleForceAtlasState InitialRunning = Paused toggleForceAtlasState InitialRunning = Paused
toggleForceAtlasState InitialStopped = InitialRunning
toggleForceAtlasState Running = Paused toggleForceAtlasState Running = Paused
toggleForceAtlasState Paused = Running toggleForceAtlasState Paused = Running
...@@ -206,6 +207,7 @@ edgeStateStabilize s = s ...@@ -206,6 +207,7 @@ edgeStateStabilize s = s
forceAtlasEdgeState :: ForceAtlasState -> ShowEdgesState -> ShowEdgesState forceAtlasEdgeState :: ForceAtlasState -> ShowEdgesState -> ShowEdgesState
forceAtlasEdgeState InitialRunning EShow = ETempHiddenThenShow forceAtlasEdgeState InitialRunning EShow = ETempHiddenThenShow
forceAtlasEdgeState InitialRunning es = es forceAtlasEdgeState InitialRunning es = es
forceAtlasEdgeState InitialStopped es = es
forceAtlasEdgeState Running EShow = ETempHiddenThenShow forceAtlasEdgeState Running EShow = ETempHiddenThenShow
forceAtlasEdgeState Running es = es forceAtlasEdgeState Running es = es
forceAtlasEdgeState Paused ETempHiddenThenShow = EShow forceAtlasEdgeState Paused ETempHiddenThenShow = EShow
......
...@@ -584,7 +584,7 @@ modeFromString _ = Nothing ...@@ -584,7 +584,7 @@ modeFromString _ = Nothing
-- corresponds to /add/form/async or /add/query/async -- corresponds to /add/form/async or /add/query/async
data AsyncTaskType = Form data AsyncTaskType = Form
| UploadFile | UploadFile
| GraphT | GraphRecompute
| Query | Query
| AddNode | AddNode
| UpdateNode | UpdateNode
...@@ -600,20 +600,20 @@ instance decodeJsonAsyncTaskType :: DecodeJson AsyncTaskType where ...@@ -600,20 +600,20 @@ instance decodeJsonAsyncTaskType :: DecodeJson AsyncTaskType where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
case obj of case obj of
"Form" -> pure Form "Form" -> pure Form
"UploadFile" -> pure UploadFile "UploadFile" -> pure UploadFile
"GraphT" -> pure GraphT "GraphRecompute" -> pure GraphRecompute
"Query" -> pure Query "Query" -> pure Query
"AddNode" -> pure AddNode "AddNode" -> pure AddNode
s -> Left $ AtKey s $ TypeMismatch "Unknown string" s -> Left $ AtKey s $ TypeMismatch "Unknown string"
asyncTaskTypePath :: AsyncTaskType -> String asyncTaskTypePath :: AsyncTaskType -> String
asyncTaskTypePath Form = "add/form/async/" asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath UploadFile = "async/file/add/" asyncTaskTypePath UploadFile = "async/file/add/"
asyncTaskTypePath Query = "query/" asyncTaskTypePath Query = "query/"
asyncTaskTypePath GraphT = "async/" asyncTaskTypePath GraphRecompute = "async/recompute/"
asyncTaskTypePath AddNode = "async/nobody/" asyncTaskTypePath AddNode = "async/nobody/"
asyncTaskTypePath UpdateNode = "update/" asyncTaskTypePath UpdateNode = "update/"
type AsyncTaskID = String type AsyncTaskID = String
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment