Commit aa2115b4 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[Graph] bigraph implemented (i.e. render different node types differently)

parent d02b8c48
...@@ -2,8 +2,9 @@ module Gargantext.Components.GraphExplorer where ...@@ -2,8 +2,9 @@ module Gargantext.Components.GraphExplorer where
import Gargantext.Prelude hiding (max,min) import Gargantext.Prelude hiding (max,min)
import Data.FoldableWithIndex (foldMapWithIndex) import DOM.Simple.Types (Element)
import Data.Foldable (foldMap) import Data.Foldable (foldMap)
import Data.FoldableWithIndex (foldMapWithIndex)
import Data.Int (toNumber) import Data.Int (toNumber)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust) import Data.Maybe (Maybe(..), fromJust)
...@@ -11,29 +12,27 @@ import Data.Nullable (null, Nullable) ...@@ -11,29 +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.Data.Louvain as Louvain
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
...@@ -212,17 +211,20 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxTypes.Graph {nodes, edges} ...@@ -212,17 +211,20 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxTypes.Graph {nodes, edges}
Seq.singleton Seq.singleton
{ borderColor: color { borderColor: color
, color : color , color : color
, equilateral: { numPoints: 3 }
, gargType
, hidden : false , hidden : false
, id : n.id_ , id : n.id_
, label : n.label , label : n.label
, size : log (toNumber n.size + 1.0) , size : log (toNumber n.size + 1.0)
, type : "def" -- default type , type : modeGraphType gargType
, x : n.x -- cos (toNumber i) , x : n.x -- cos (toNumber i)
, y : n.y -- sin (toNumber i) , y : n.y -- sin (toNumber i)
} }
where where
cDef (GET.Cluster {clustDefault}) = clustDefault cDef (GET.Cluster {clustDefault}) = clustDefault
color = GET.intColor (cDef n.attributes) color = GET.intColor (cDef n.attributes)
gargType = unsafePartial $ fromJust $ Types.modeFromString n.type_
nodesMap = SigmaxTypes.nodesMap nodes nodesMap = SigmaxTypes.nodesMap nodes
edges = foldMap edgeFn r.edges edges = foldMap edgeFn r.edges
edgeFn (GET.Edge e) = Seq.singleton { id : e.id_ edgeFn (GET.Edge e) = Seq.singleton { id : e.id_
...@@ -240,130 +242,16 @@ convert (GET.GraphData r) = Tuple r.metaData $ SigmaxTypes.Graph {nodes, edges} ...@@ -240,130 +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
-- clusterColor :: Cluster -> Color -- | See sigmajs/plugins/sigma.renderers.customShapes/shape-library.js
-- clusterColor (Cluster {clustDefault}) = unsafePartial $ fromJust $ defaultPalette !! (clustDefault `molength defrultPalette) modeGraphType :: Types.Mode -> String
modeGraphType Types.Authors = "square"
-- div [className "col-md-12", style {"padding-bottom" : "10px"}] modeGraphType Types.Institutes = "equilateral"
-- [ menu [_id "toolbar"] modeGraphType Types.Sources = "star"
-- [ ul' modeGraphType Types.Terms = "def"
-- [
-- -- 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
......
...@@ -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
......
...@@ -164,10 +164,12 @@ updateNodes sigma nodesMap = do ...@@ -164,10 +164,12 @@ updateNodes sigma nodesMap = do
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
......
...@@ -10,10 +10,12 @@ import Data.Maybe (Maybe(..), fromJust) ...@@ -10,10 +10,12 @@ 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 Gargantext.Data.Louvain as Louvain
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Prelude (class Eq, class Show, map, ($), (&&), (==), (||), (<$>), mod, not) import Prelude (class Eq, class Show, map, ($), (&&), (==), (||), (<$>), mod, not)
import Gargantext.Data.Louvain as Louvain
import Gargantext.Types as GT
newtype Graph n e = Graph { edges :: Seq.Seq {|e}, nodes :: Seq.Seq {|n} } newtype Graph n e = Graph { edges :: Seq.Seq {|e}, nodes :: Seq.Seq {|n} }
--derive instance eqGraph :: Eq Graph --derive instance eqGraph :: Eq Graph
...@@ -28,6 +30,8 @@ type Renderer = { "type" :: String, container :: Element } ...@@ -28,6 +30,8 @@ type Renderer = { "type" :: String, container :: Element }
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 :: String
, label :: String , label :: String
......
...@@ -9,6 +9,7 @@ import Prim.Row (class Union) ...@@ -9,6 +9,7 @@ import Prim.Row (class Union)
import URI.Query (Query) import URI.Query (Query)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Ord (genericCompare)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
newtype SessionId = SessionId String newtype SessionId = SessionId String
...@@ -409,3 +410,27 @@ instance showTabType :: Show TabType where ...@@ -409,3 +410,27 @@ instance showTabType :: Show TabType where
type TableResult a = {count :: Int, docs :: Array a} type TableResult a = {count :: Int, docs :: Array a}
type AffTableResult a = Aff (TableResult a) type AffTableResult a = Aff (TableResult a)
data Mode = Authors | Sources | Institutes | Terms
derive instance genericMode :: Generic Mode _
instance showMode :: Show Mode where
show = genericShow
derive instance eqMode :: Eq Mode
instance ordMode :: Ord Mode where
compare = genericCompare
modeTabType :: Mode -> CTabNgramType
modeTabType Authors = CTabAuthors
modeTabType Sources = CTabSources
modeTabType Institutes = CTabInstitutes
modeTabType Terms = CTabTerms
modeFromString :: String -> Maybe Mode
modeFromString "Authors" = Just Authors
modeFromString "Sources" = Just Sources
modeFromString "Institutes" = Just Institutes
modeFromString "Terms" = Just Terms
modeFromString _ = Nothing
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment