Skip to content

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

[GraphExplorer] Camera in separate module, fixes to updating and centering it

parent 9e37faed
Show whitespace changes
Inline Side-by-side
Showing with 206 additions and 162 deletions
src/Gargantext/Components/GraphExplorer/GraphTypes.purs 0 → 100644
View file @ a31e6830
module Gargantext.Components.GraphExplorer.GraphTypes where
import Gargantext.Prelude
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype)
import Data.Ord.Generic (genericCompare)
import Data.Show.Generic (genericShow)
import Partial.Unsafe (unsafePartial)
import Record as Record
import Simple.JSON as JSON
import Type.Proxy (Proxy(..))
newtype Cluster = Cluster { clustDefault :: Int }
derive instance Generic Cluster _
derive instance Newtype Cluster _
instance Eq Cluster where eq = genericEq
instance JSON.ReadForeign Cluster where
readImpl f = do
inst <- JSON.readImpl f
pure $ Cluster $ Record.rename clust_defaultP clustDefaultP inst
instance JSON.WriteForeign Cluster where
writeImpl (Cluster cl) = JSON.writeImpl $ Record.rename clustDefaultP clust_defaultP cl
newtype ClusterCount = ClusterCount
{ id :: Int
, count :: Int
}
derive instance Generic ClusterCount _
derive instance Newtype ClusterCount _
newtype Node = Node {
attributes :: Cluster
, children :: Array String
, id_ :: String
, label :: String
, size :: Int
, type_ :: String
, x :: Number
, y :: Number
}
x_coordP = Proxy :: Proxy "x_coord"
xP = Proxy :: Proxy "x"
y_coordP = Proxy :: Proxy "y_coord"
yP = Proxy :: Proxy "y"
clustDefaultP = Proxy :: Proxy "clustDefault"
clust_defaultP = Proxy :: Proxy "clust_default"
cameraP = Proxy :: Proxy "camera"
mCameraP = Proxy :: Proxy "mCamera"
idP = Proxy :: Proxy "id"
id_P = Proxy :: Proxy "id_"
typeP = Proxy :: Proxy "type"
type_P = Proxy :: Proxy "type_"
derive instance Generic Node _
derive instance Newtype Node _
instance Eq Node where eq = genericEq
instance Ord Node where compare (Node n1) (Node n2) = compare n1.id_ n2.id_
instance JSON.ReadForeign Node where
readImpl f = do
inst <- JSON.readImpl f
pure $ Node $
Record.rename idP id_P $
Record.rename typeP type_P $
Record.rename x_coordP xP $
Record.rename y_coordP yP $ inst
instance JSON.WriteForeign Node where
writeImpl (Node nd) = JSON.writeImpl $
Record.rename id_P idP $
Record.rename type_P typeP $
Record.rename xP x_coordP $
Record.rename yP y_coordP nd
newtype Edge = Edge {
confluence :: Number
, id_ :: String
, source :: String
, target :: String
, weight :: Number
}
derive instance Generic Edge _
derive instance Newtype Edge _
instance Eq Edge where eq = genericEq
instance Ord Edge where compare (Edge e1) (Edge e2) = compare e1.id_ e2.id_
instance JSON.ReadForeign Edge where
readImpl f = do
inst <- JSON.readImpl f
pure $ Edge $ Record.rename idP id_P inst
instance JSON.WriteForeign Edge where
writeImpl (Edge ed) = JSON.writeImpl $ Record.rename id_P idP ed
src/Gargantext/Components/GraphExplorer/Layout.purs
View file @ a31e6830
......@@ -17,6 +17,7 @@ import Effect (Effect)
import Gargantext.Components.App.Store as AppStore
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.GraphExplorer.Frame.DocFocus (docFocus)
import Gargantext.Components.GraphExplorer.GraphTypes as GEGT
import Gargantext.Components.GraphExplorer.Resources as Graph
import Gargantext.Components.GraphExplorer.Sidebar as GES
import Gargantext.Components.GraphExplorer.Store as GraphStore
......@@ -289,7 +290,7 @@ convert :: GET.GraphData -> Tuple (Maybe GET.MetaData) SigmaxT.SGraph
convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges}
where
nodes = foldMapWithIndex nodeFn r.nodes
nodeFn _i nn@(GET.Node n) =
nodeFn _i nn@(GEGT.Node n) =
Seq.singleton {
borderColor: color
, children: n.children
......@@ -307,12 +308,12 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges}
, _original: nn
}
where
cDef (GET.Cluster {clustDefault}) = clustDefault
cDef (GEGT.Cluster {clustDefault}) = clustDefault
color = GET.intColor (cDef n.attributes)
gargType = unsafePartial $ fromJust $ Types.modeFromString n.type_
nodesMap = SigmaxT.nodesMap nodes
edges = foldMapWithIndex edgeFn $ A.sortWith (\(GET.Edge {weight}) -> weight) r.edges
edgeFn i ee@(GET.Edge e) =
edges = foldMapWithIndex edgeFn $ A.sortWith (\(GEGT.Edge {weight}) -> weight) r.edges
edgeFn i ee@(GEGT.Edge e) =
Seq.singleton
{ id : e.id_
, color
......
src/Gargantext/Components/GraphExplorer/Resources.purs
View file @ a31e6830
......@@ -19,6 +19,7 @@ import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Themes (darksterTheme)
import Gargantext.Components.Themes as Themes
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Camera as Camera
import Gargantext.Hooks.Sigmax.Graphology as Graphology
import Gargantext.Hooks.Sigmax.ForceAtlas2 as ForceAtlas2
import Gargantext.Hooks.Sigmax.Sigma as Sigma
......@@ -148,12 +149,12 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where
Just fa2 -> ForceAtlas2.stop fa2
case mCamera of
Just (GET.Camera { ratio, x, y }) -> do
Sigma.updateCamera sig { ratio, x, y }
Just cam -> do
Camera.updateCamera (Camera.camera sig) cam
-- Default camera: slightly de-zoom the graph to avoid
-- nodes sticking to the container borders
Nothing ->
Sigma.updateCamera sig { ratio: 1.1, x: 0.5, y: 0.5 }
Camera.updateCamera (Camera.camera sig) Camera.defaultCamera
-- Reload Sigma on Theme changes
-- TODO
......
src/Gargantext/Components/GraphExplorer/Sidebar/Legend.purs
View file @ a31e6830
......@@ -10,6 +10,7 @@ import Data.Sequence (Seq)
import Data.Set as Set
import Data.Traversable (foldMap, intercalate)
import Gargantext.Components.Bootstrap as B
import Gargantext.Components.GraphExplorer.GraphTypes as GEGT
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax.Types as ST
import Gargantext.Utils (getter, nbsp, (?))
......@@ -23,8 +24,8 @@ here = R2.here "Gargantext.Components.GraphExplorer.Sidebar.Legend"
type Props =
( legendSeq :: Seq GET.Legend
, extractedNodeList :: Array GET.Node
, nodeCountList :: Array GET.ClusterCount
, extractedNodeList :: Array GEGT.Node
, nodeCountList :: Array GEGT.ClusterCount
, selectedNodeIds :: T.Box ST.NodeIds
)
......@@ -76,7 +77,7 @@ legendCpt = here.component "legend" cpt where
]
]
filterByCluster :: Int -> Array GET.Node -> Array GET.Node
filterByCluster :: Int -> Array GEGT.Node -> Array GEGT.Node
filterByCluster id
= A.filter
( getter _.attributes
......@@ -84,7 +85,7 @@ filterByCluster id
>>> eq id
)
getClusterNodeCount :: Array GET.ClusterCount -> Int -> Int
getClusterNodeCount :: Array GEGT.ClusterCount -> Int -> Int
getClusterNodeCount nodeCountList id
= nodeCountList
# A.find
......@@ -98,7 +99,7 @@ getClusterNodeCount nodeCountList id
---------------------------------------------------------
type SelectedNodesProps =
( extractedNodeList :: Array GET.Node
( extractedNodeList :: Array GEGT.Node
, selectedNodeIds :: T.Box ST.NodeIds
, clusterId :: Int
, nodeCount :: Int
......@@ -146,7 +147,7 @@ selectedNodesCpt = here.component "selectedNodes" cpt where
{ className: "graph-legend-nodes" }
[
flip foldMap (filterByCluster clusterId extractedNodeList)
\(GET.Node { label: nodeLabel, id_: nodeId }) ->
\(GEGT.Node { label: nodeLabel, id_: nodeId }) ->
H.li
{ className: "graph-legend-nodes__item" }
......
src/Gargantext/Components/GraphExplorer/Toolbar/Buttons.purs
View file @ a31e6830
......@@ -32,6 +32,7 @@ import Gargantext.Components.GraphExplorer.Resources as Graph
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Utils as GEU
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Camera as Camera
import Gargantext.Hooks.Sigmax.Graphology as Graphology
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
......@@ -54,7 +55,7 @@ centerButton sigmaRef = B.button
, callback: \_ -> do
let sigma = R.readRef sigmaRef
Sigmax.dependOnSigma sigma "[centerButton] sigma: Nothing" $ \s ->
Sigma.goToAllCameras s {x: 0.0, y: 0.0, ratio: 1.0, angle: 0.0}
Camera.updateCamera (Camera.camera s) Camera.defaultCamera
}
[ H.text "Center" ]
......@@ -96,10 +97,7 @@ cameraButton { id
nodes = Graphology.nodes graph
graphData = GET.GraphData $ hyperdataGraph { edges = A.fromFoldable $ Seq.map GEU.stEdgeToGET edges
, nodes = A.fromFoldable $ GEU.normalizeNodes $ Seq.map GEU.stNodeToGET nodes }
let cameras = map Sigma.toCamera $ Sigma.cameras s
let camera = case cameras of
[c] -> GET.Camera { ratio: c.ratio, x: c.x, y: c.y }
_ -> GET.Camera { ratio: 1.0, x: 0.0, y: 0.0 }
let camera = Camera.toCamera $ Camera.camera s
let hyperdataGraph' = GET.HyperdataGraph { graph: graphData, mCamera: Just camera }
launchAff_ $ do
eClonedGraphId <- cloneGraph { id, hyperdataGraph: hyperdataGraph', session }
......
src/Gargantext/Components/GraphExplorer/Types.purs
View file @ a31e6830
......@@ -12,91 +12,13 @@ import Data.Show.Generic (genericShow)
import Partial.Unsafe (unsafePartial)
import Record as Record
import Simple.JSON as JSON
import Gargantext.Components.GraphExplorer.GraphTypes
import Gargantext.Hooks.Sigmax.Camera (Camera(..))
import Type.Proxy (Proxy(..))
type GraphId = Int
newtype Node = Node {
attributes :: Cluster
, children :: Array String
, id_ :: String
, label :: String
, size :: Int
, type_ :: String
, x :: Number
, y :: Number
}
x_coordP = Proxy :: Proxy "x_coord"
xP = Proxy :: Proxy "x"
y_coordP = Proxy :: Proxy "y_coord"
yP = Proxy :: Proxy "y"
clustDefaultP = Proxy :: Proxy "clustDefault"
clust_defaultP = Proxy :: Proxy "clust_default"
cameraP = Proxy :: Proxy "camera"
mCameraP = Proxy :: Proxy "mCamera"
idP = Proxy :: Proxy "id"
id_P = Proxy :: Proxy "id_"
typeP = Proxy :: Proxy "type"
type_P = Proxy :: Proxy "type_"
derive instance Generic Node _
derive instance Newtype Node _
instance Eq Node where eq = genericEq
instance Ord Node where compare (Node n1) (Node n2) = compare n1.id_ n2.id_
instance JSON.ReadForeign Node where
readImpl f = do
inst <- JSON.readImpl f
pure $ Node $
Record.rename idP id_P $
Record.rename typeP type_P $
Record.rename x_coordP xP $
Record.rename y_coordP yP $ inst
instance JSON.WriteForeign Node where
writeImpl (Node nd) = JSON.writeImpl $
Record.rename id_P idP $
Record.rename type_P typeP $
Record.rename xP x_coordP $
Record.rename yP y_coordP nd
newtype Cluster = Cluster { clustDefault :: Int }
derive instance Generic Cluster _
derive instance Newtype Cluster _
instance Eq Cluster where eq = genericEq
instance JSON.ReadForeign Cluster where
readImpl f = do
inst <- JSON.readImpl f
pure $ Cluster $ Record.rename clust_defaultP clustDefaultP inst
instance JSON.WriteForeign Cluster where
writeImpl (Cluster cl) = JSON.writeImpl $ Record.rename clustDefaultP clust_defaultP cl
newtype ClusterCount = ClusterCount
{ id :: Int
, count :: Int
}
derive instance Generic ClusterCount _
derive instance Newtype ClusterCount _
newtype Edge = Edge {
confluence :: Number
, id_ :: String
, source :: String
, target :: String
, weight :: Number
}
derive instance Generic Edge _
derive instance Newtype Edge _
instance Eq Edge where eq = genericEq
instance Ord Edge where compare (Edge e1) (Edge e2) = compare e1.id_ e2.id_
instance JSON.ReadForeign Edge where
readImpl f = do
inst <- JSON.readImpl f
pure $ Edge $ Record.rename idP id_P inst
instance JSON.WriteForeign Edge where
writeImpl (Edge ed) = JSON.writeImpl $ Record.rename id_P idP ed
-- | A 'fully closed interval' in CS parlance
type InclusiveRange t = { min :: t, max :: t }
......@@ -246,18 +168,6 @@ instance Show SideTab where
show SideTabData = "Data"
show SideTabCommunity = "Community"
newtype Camera =
Camera { ratio :: Number
, x :: Number
, y :: Number
}
derive instance Generic Camera _
derive instance Newtype Camera _
instance Eq Camera where eq = genericEq
derive newtype instance JSON.ReadForeign Camera
derive newtype instance JSON.WriteForeign Camera
newtype HyperdataGraph = HyperdataGraph {
graph :: GraphData
, mCamera :: Maybe Camera
......
src/Gargantext/Components/GraphExplorer/Utils.purs
View file @ a31e6830
......@@ -11,16 +11,17 @@ import Data.Foldable (maximum, minimum)
import Data.Maybe (Maybe(..))
import Data.Newtype (wrap)
import Data.Sequence as Seq
import Gargantext.Components.GraphExplorer.GraphTypes as GEGT
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax.Types as ST
import Gargantext.Utils (getter)
import Gargantext.Utils.Seq as GUS
stEdgeToGET :: Record ST.Edge -> GET.Edge
stEdgeToGET :: Record ST.Edge -> GEGT.Edge
stEdgeToGET { _original } = _original
stNodeToGET :: Record ST.Node -> GET.Node
stNodeToGET { id, label, x, y, _original: GET.Node { attributes, size, type_ } } = GET.Node {
stNodeToGET :: Record ST.Node -> GEGT.Node
stNodeToGET { id, label, x, y, _original: GEGT.Node { attributes, size, type_ } } = GEGT.Node {
attributes
, children: []
, id_: id
......@@ -33,11 +34,11 @@ stNodeToGET { id, label, x, y, _original: GET.Node { attributes, size, type_ } }
-----------------------------------------------------------------------
normalizeNodes :: Seq.Seq GET.Node -> Seq.Seq GET.Node
normalizeNodes :: Seq.Seq GEGT.Node -> Seq.Seq GEGT.Node
normalizeNodes ns = Seq.map normalizeNode ns
where
xs = map (\(GET.Node { x }) -> x) ns
ys = map (\(GET.Node { y }) -> y) ns
xs = map (\(GEGT.Node { x }) -> x) ns
ys = map (\(GEGT.Node { y }) -> y) ns
mMinx = minimum xs
mMaxx = maximum xs
mMiny = minimum ys
......@@ -56,12 +57,12 @@ normalizeNodes ns = Seq.map normalizeNode ns
ydivisor = case mYrange of
Nothing -> 1.0
Just ydiv -> 1.0 / ydiv
normalizeNode (GET.Node n@{ x, y }) = GET.Node $ n { x = x * xdivisor
normalizeNode (GEGT.Node n@{ x, y }) = GEGT.Node $ n { x = x * xdivisor
, y = y * ydivisor }
------------------------------------------------------------------------
takeGreatestNodeByCluster :: GET.HyperdataGraph -> Int -> Int -> Array GET.Node
takeGreatestNodeByCluster :: GET.HyperdataGraph -> Int -> Int -> Array GEGT.Node
takeGreatestNodeByCluster graphData take clusterId
= graphData
# getter _.graph
......@@ -77,7 +78,7 @@ takeGreatestNodeByCluster graphData take clusterId
>>> A.takeEnd take
>>> A.reverse
countNodeByCluster :: GET.HyperdataGraph -> Int -> GET.ClusterCount
countNodeByCluster :: GET.HyperdataGraph -> Int -> GEGT.ClusterCount
countNodeByCluster graphData clusterId
= graphData
# getter _.graph
......
src/Gargantext/Hooks/Sigmax/Camera.js 0 → 100644
View file @ a31e6830
'use strict';
export function _setState(cam, state) {
return cam.setState(state);
}
src/Gargantext/Hooks/Sigmax/Camera.purs 0 → 100644
View file @ a31e6830
module Gargantext.Hooks.Sigmax.Camera where
import Gargantext.Prelude
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Newtype (class Newtype)
import Effect (Effect)
import Effect.Uncurried (EffectFn2, runEffectFn2)
import FFI.Simple ((..))
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Simple.JSON as JSON
foreign import data CameraInstance' :: Row Type
type CameraInstance = { | CameraInstance' }
type CameraRow =
( angle :: Number
, ratio :: Number
, x :: Number
, y :: Number )
newtype Camera =
Camera { |CameraRow }
derive instance Generic Camera _
derive instance Newtype Camera _
instance Eq Camera where eq = genericEq
derive newtype instance JSON.ReadForeign Camera
derive newtype instance JSON.WriteForeign Camera
defaultCamera :: Camera
defaultCamera = Camera { angle: 0.0
, ratio: 1.1
, x: 0.5
, y: 0.5 }
camera :: Sigma.Sigma -> CameraInstance
camera sig = sig .. "camera"
toCamera :: CameraInstance -> Camera
toCamera c = Camera { angle, ratio, x, y }
where
angle = c .. "angle" :: Number
ratio = c .. "ratio" :: Number
x = c .. "x" :: Number
y = c .. "y" :: Number
updateCamera :: CameraInstance -> Camera -> Effect Unit
updateCamera cam (Camera { angle, ratio, x, y }) = runEffectFn2 _setState cam { angle, ratio, x, y }
foreign import _setState :: forall e. EffectFn2 CameraInstance {|CameraRow} Unit
src/Gargantext/Hooks/Sigmax/Sigma.purs
View file @ a31e6830
......@@ -190,44 +190,19 @@ sigmaEasing =
, cubicInOut : SigmaEasing "cubicInOut"
}
type CameraProps =
( x :: Number
, y :: Number
, ratio :: Number
, angle :: Number
)
foreign import data CameraInstance' :: Row Type
type CameraInstance = { | CameraInstance' }
-- | Get an array of a sigma instance's `cameras`.
cameras :: Sigma -> Array CameraInstance
cameras s = Object.values cs
where
-- For some reason, `sigma.cameras` is an object with integer keys.
cs = s .. "cameras" :: Object.Object CameraInstance
toCamera :: CameraInstance -> Record CameraProps
toCamera c = { angle, ratio, x, y }
where
angle = c .. "angle" :: Number
ratio = c .. "ratio" :: Number
x = c .. "x" :: Number
y = c .. "y" :: Number
updateCamera :: Sigma -> { ratio :: Number, x :: Number, y :: Number } -> Effect Unit
updateCamera sig { ratio, x, y } = do
let camera = sig .. "camera"
_ <- pure $ (camera .= "ratio") ratio
_ <- pure $ (camera .= "x") x
_ <- pure $ (camera .= "y") y
pure unit
goTo :: Record CameraProps -> CameraInstance -> Effect Unit
goTo props cam = pure $ cam ... "goTo" $ [props]
goToAllCameras :: Sigma -> Record CameraProps -> Effect Unit
goToAllCameras s props = traverse_ (goTo props) $ cameras s
-- DEPRECATED
-- -- | Get an array of a sigma instance's `cameras`.
-- cameras :: Sigma -> Array CameraInstance
-- cameras s = Object.values cs
-- 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 props cam = pure $ cam ... "goTo" $ [props]
-- goToAllCameras :: Sigma -> Record CameraProps -> Effect Unit
-- goToAllCameras s props = traverse_ (goTo props) $ cameras s
takeScreenshot :: Sigma -> Effect String
takeScreenshot = runEffectFn1 _takeScreenshot
......
src/Gargantext/Hooks/Sigmax/Types.purs
View file @ a31e6830
......@@ -13,7 +13,7 @@ import Data.Tuple (Tuple(..))
import Partial.Unsafe (unsafePartial)
import Prelude (class Eq, class Show, map, ($), (&&), (==), (||), (<$>), mod, not)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.GraphTypes as GEGT
import Gargantext.Data.Louvain as Louvain
import Gargantext.Types as GT
......@@ -47,7 +47,7 @@ type Node = (
, type :: String -- available types: circle, cross, def, diamond, equilateral, pacman, square, star
, x :: Number
, y :: Number
, _original :: GET.Node
, _original :: GEGT.Node
)
type Edge = (
......@@ -62,7 +62,7 @@ type Edge = (
, targetNode :: Record Node
, weight :: Number
, weightIdx :: Int
, _original :: GET.Edge
, _original :: GEGT.Edge
)
type NodeIds = Set.Set NodeId
......
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