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

[graph] respect the startForceAtlas graph hyperdata setting

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