Commit 72cb6ab2 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[GraphExplorer] range slider fixes

parent a31e6830
...@@ -60,6 +60,7 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where ...@@ -60,6 +60,7 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where
boxes <- AppStore.use boxes <- AppStore.use
{ showEdges { showEdges
, edgeWeight
, graph , graph
, graphStage , graphStage
, hyperdataGraph , hyperdataGraph
...@@ -70,6 +71,7 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where ...@@ -70,6 +71,7 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where
} <- GraphStore.use } <- GraphStore.use
showEdges' <- R2.useLive' showEdges showEdges' <- R2.useLive' showEdges
edgeWeight' <- R2.useLive' edgeWeight
graphStage' <- R2.useLive' graphStage graphStage' <- R2.useLive' graphStage
graph' <- R2.useLive' graph graph' <- R2.useLive' graph
startForceAtlas' <- R2.useLive' startForceAtlas startForceAtlas' <- R2.useLive' startForceAtlas
...@@ -131,7 +133,7 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where ...@@ -131,7 +133,7 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where
_ <- Sigma.bindMouseSelectorPlugin sigma _ <- Sigma.bindMouseSelectorPlugin sigma
pure unit pure unit
Sigmax.setEdges sig false Sigmax.setSigmaEdgesVisibility sig { edgeWeight: edgeWeight', showEdges: showEdges' }
-- here.log2 "[graph] startForceAtlas" startForceAtlas -- here.log2 "[graph] startForceAtlas" startForceAtlas
if startForceAtlas' then if startForceAtlas' then
...@@ -188,7 +190,7 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where ...@@ -188,7 +190,7 @@ drawGraphCpt = R.memo' $ here.component "graph" cpt where
-- Sigmax.updateNodes sigma tNodesMap -- Sigmax.updateNodes sigma tNodesMap
let edgesState = not $ SigmaxTypes.edgeStateHidden showEdges' let edgesState = not $ SigmaxTypes.edgeStateHidden showEdges'
-- here.log2 "[graphCpt] edgesState" edgesState -- here.log2 "[graphCpt] edgesState" edgesState
Sigmax.setEdges sigma edgesState Sigmax.setSigmaEdgesVisibility sigma { edgeWeight: edgeWeight', showEdges: showEdges' }
_ -> pure unit _ -> pure unit
...@@ -230,8 +232,8 @@ type SigmaSettings = ...@@ -230,8 +232,8 @@ type SigmaSettings =
-- , doubleClickZoomingRatio :: Number -- , doubleClickZoomingRatio :: Number
-- , doubleTapTimeout :: Number -- , doubleTapTimeout :: Number
-- , dragTimeout :: Number -- , dragTimeout :: Number
, drawEdgeLabels :: Boolean -- , drawEdgeLabels :: Boolean
, drawEdges :: Boolean -- , drawEdges :: Boolean
, drawLabels :: Boolean , drawLabels :: Boolean
, drawNodes :: Boolean , drawNodes :: Boolean
-- , edgeColor :: String -- , edgeColor :: String
...@@ -313,8 +315,8 @@ sigmaSettings theme = ...@@ -313,8 +315,8 @@ sigmaSettings theme =
, defaultNodeBorderColor : "#000" -- <- if nodeBorderColor = 'default' , defaultNodeBorderColor : "#000" -- <- if nodeBorderColor = 'default'
, defaultNodeColor : "#FFF" , defaultNodeColor : "#FFF"
, doubleClickEnabled : false -- indicates whether or not the graph can be zoomed on double-click , doubleClickEnabled : false -- indicates whether or not the graph can be zoomed on double-click
, drawEdgeLabels : true -- , drawEdgeLabels : true
, drawEdges : true -- , drawEdges : true
, drawLabels : true , drawLabels : true
, drawNodes : true , drawNodes : true
, enableEdgeHovering : false , enableEdgeHovering : false
......
...@@ -101,6 +101,8 @@ controlsCpt = R.memo' $ here.component "controls" cpt where ...@@ -101,6 +101,8 @@ controlsCpt = R.memo' $ here.component "controls" cpt where
-- NOTE This is a hack anyways. It's force atlas that should be fixed. -- NOTE This is a hack anyways. It's force atlas that should be fixed.
R.useEffect2' sigmaRef forceAtlasState' $ do R.useEffect2' sigmaRef forceAtlasState' $ do
T.modify_ (SigmaxT.forceAtlasEdgeState forceAtlasState') showEdges T.modify_ (SigmaxT.forceAtlasEdgeState forceAtlasState') showEdges
v <- T.read showEdges
here.log2 "[controls] modifed showEdges to forceAtlasState'" v
-- Automatic opening of sidebar when a node is selected (but only first time). -- Automatic opening of sidebar when a node is selected (but only first time).
R.useEffect' $ do R.useEffect' $ do
......
...@@ -25,7 +25,6 @@ type Props = ...@@ -25,7 +25,6 @@ type Props =
rangeControl :: R2.Leaf Props rangeControl :: R2.Leaf Props
rangeControl = R2.leaf rangeControlCpt rangeControl = R2.leaf rangeControlCpt
rangeControlCpt :: R.Component Props rangeControlCpt :: R.Component Props
rangeControlCpt = here.component "rangeButton" cpt rangeControlCpt = here.component "rangeButton" cpt
where where
...@@ -50,7 +49,6 @@ type EdgeConfluenceControlProps = ...@@ -50,7 +49,6 @@ type EdgeConfluenceControlProps =
edgeConfluenceControl :: R2.Leaf EdgeConfluenceControlProps edgeConfluenceControl :: R2.Leaf EdgeConfluenceControlProps
edgeConfluenceControl = R2.leaf edgeConfluenceControlCpt edgeConfluenceControl = R2.leaf edgeConfluenceControlCpt
edgeConfluenceControlCpt :: R.Component EdgeConfluenceControlProps edgeConfluenceControlCpt :: R.Component EdgeConfluenceControlProps
edgeConfluenceControlCpt = here.component "edgeConfluenceControl" cpt edgeConfluenceControlCpt = here.component "edgeConfluenceControl" cpt
where where
...@@ -81,7 +79,6 @@ type EdgeWeightControlProps = ...@@ -81,7 +79,6 @@ type EdgeWeightControlProps =
edgeWeightControl :: R2.Leaf EdgeWeightControlProps edgeWeightControl :: R2.Leaf EdgeWeightControlProps
edgeWeightControl = R2.leaf edgeWeightControlCpt edgeWeightControl = R2.leaf edgeWeightControlCpt
edgeWeightControlCpt :: R.Component EdgeWeightControlProps edgeWeightControlCpt :: R.Component EdgeWeightControlProps
edgeWeightControlCpt = here.component "edgeWeightControl" cpt edgeWeightControlCpt = here.component "edgeWeightControl" cpt
where where
...@@ -99,7 +96,9 @@ edgeWeightControlCpt = here.component "edgeWeightControl" cpt ...@@ -99,7 +96,9 @@ edgeWeightControlCpt = here.component "edgeWeightControl" cpt
, step: 1.0 , step: 1.0
, width: 10.0 , width: 10.0
, height: 5.0 , height: 5.0
, onChange: \rng -> T.write_ rng state , onChange: \rng -> do
here.log2 "[edgeWeightControl] new range" rng
T.write_ rng state
} }
} }
...@@ -112,7 +111,6 @@ type NodeSideControlProps = ...@@ -112,7 +111,6 @@ type NodeSideControlProps =
nodeSizeControl :: R2.Leaf NodeSideControlProps nodeSizeControl :: R2.Leaf NodeSideControlProps
nodeSizeControl = R2.leaf nodeSizeControlCpt nodeSizeControl = R2.leaf nodeSizeControlCpt
nodeSizeControlCpt :: R.Component NodeSideControlProps nodeSizeControlCpt :: R.Component NodeSideControlProps
nodeSizeControlCpt = here.component "nodeSizeControl" cpt nodeSizeControlCpt = here.component "nodeSizeControl" cpt
where where
......
...@@ -8,6 +8,7 @@ module Gargantext.Components.RangeSlider where ...@@ -8,6 +8,7 @@ module Gargantext.Components.RangeSlider where
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq) import Data.Eq.Generic (genericEq)
import Data.Foldable (maximum)
import Data.Int (fromNumber) import Data.Int (fromNumber)
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Number as DN import Data.Number as DN
...@@ -50,9 +51,6 @@ type Props = ...@@ -50,9 +51,6 @@ type Props =
, height :: Number , height :: Number
, onChange :: Range.NumberRange -> Effect Unit ) , onChange :: Range.NumberRange -> Effect Unit )
rangeSlider :: Record Props -> R.Element
rangeSlider props = R.createElement rangeSliderCpt props []
data Knob = MinKnob | MaxKnob data Knob = MinKnob | MaxKnob
derive instance Generic Knob _ derive instance Generic Knob _
instance Eq Knob where instance Eq Knob where
...@@ -60,12 +58,24 @@ instance Eq Knob where ...@@ -60,12 +58,24 @@ instance Eq Knob where
data RangeUpdate = SetMin Number | SetMax Number data RangeUpdate = SetMin Number | SetMax Number
rangeSlider :: Record Props -> R.Element
rangeSlider props = R.createElement rangeSliderCpt props []
rangeSliderCpt :: R.Component Props rangeSliderCpt :: R.Component Props
rangeSliderCpt = here.component "rangeSlider" cpt rangeSliderCpt = here.component "rangeSlider" cpt
where where
cpt props _ = do cpt props _ = do
-- rounding precision (i.e. how many decimal digits are in epsilon) -- rounding precision (i.e. how many decimal digits are in epsilon)
let precision = fromMaybe 0 $ fromNumber $ max 0.0 $ - DN.floor $ (DN.log props.epsilon) / DN.ln10 let (Range.Closed { min: minR, max: maxR }) = props.initialValue
let decPrecision num =
-- int digits
(fromMaybe 0 $ fromNumber $ DN.ceil $ (DN.log num) / DN.ln10)
-- float digits
+ (fromMaybe 0 $ fromNumber $ DN.ceil $ -(DN.log (num - (DN.floor num))) / DN.ln10)
let epsilonPrecision = decPrecision props.epsilon
let minPrecision = decPrecision minR
let maxPrecision = decPrecision maxR
--let precision = fromMaybe 0 $ fromNumber $ max 0.0 epsilonPrecision
let precision = fromMaybe 0 $ maximum [0, epsilonPrecision, minPrecision, maxPrecision]
-- scale bar -- scale bar
scaleElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- dom ref scaleElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- dom ref
...@@ -186,11 +196,13 @@ renderKnob knob ref (Range.Closed value) bounds set precision = ...@@ -186,11 +196,13 @@ renderKnob knob ref (Range.Closed value) bounds set precision =
tabIndex = 0 tabIndex = 0
className = "range-slider__knob" className = "range-slider__knob"
aria = { label: labelPrefix knob <> "value: " <> show val } aria = { label: labelPrefix knob <> "value: " <> show val }
labelPrefix :: Knob -> String
labelPrefix MinKnob = "Minimum " labelPrefix MinKnob = "Minimum "
labelPrefix MaxKnob = "Maximum " labelPrefix MaxKnob = "Maximum "
onMouseDown _ = T.write_ (Just knob) set onMouseDown _ = T.write_ (Just knob) set
percOffset = Range.normalise bounds val percOffset = Range.normalise bounds val
style = { left: (show $ 100.0 * percOffset) <> "%" } style = { left: (show $ 100.0 * percOffset) <> "%" }
val :: Number
val = case knob of val = case knob of
MinKnob -> value.min MinKnob -> value.min
MaxKnob -> value.max MaxKnob -> value.max
......
...@@ -141,14 +141,13 @@ handleForceAtlas2Pause fa2Ref forceAtlasState mFAPauseRef settings = do ...@@ -141,14 +141,13 @@ handleForceAtlas2Pause fa2Ref forceAtlasState mFAPauseRef settings = do
ForceAtlas.stop fa2 ForceAtlas.stop fa2
_ -> pure unit _ -> pure unit
setEdges :: Sigma.Sigma -> Boolean -> Effect Unit setSigmaEdgesVisibility :: Sigma.Sigma -> Record ST.EdgeVisibilityProps -> Effect Unit
setEdges sigma val = do setSigmaEdgesVisibility sigma ev = do
let settings = { let settings = {
drawEdges: val hideEdgesOnMove: ST.edgeStateHidden ev.showEdges
, drawEdgeLabels: val
, hideEdgesOnMove: not val
} }
Sigma.setSettings sigma settings Sigma.setSettings sigma settings
Graphology.updateEachEdgeAttributes (Sigma.graph sigma) $ ST.setEdgeVisibility ev
-- updateEdges :: Sigma.Sigma -> ST.EdgesMap -> Effect Unit -- updateEdges :: Sigma.Sigma -> ST.EdgesMap -> Effect Unit
......
...@@ -39,6 +39,15 @@ export function _forEachEdge(g, fn) { ...@@ -39,6 +39,15 @@ export function _forEachEdge(g, fn) {
}); });
} }
export function _updateEachEdgeAttributes(g, fn) {
return g.updateEachEdgeAttributes(function(name, attrs, source, target) {
return fn({id: name,
source,
target,
...attrs});
});
}
// Almost the same as graphology.mapNodes but with a change that only // Almost the same as graphology.mapNodes but with a change that only
// 1 argument is passed: the whole node structure // 1 argument is passed: the whole node structure
// https://graphology.github.io/iteration.html#mapedges // https://graphology.github.io/iteration.html#mapedges
......
...@@ -29,6 +29,7 @@ foreign import _mergeNodeAttributes :: forall a. EffectFn3 Graph String a Unit ...@@ -29,6 +29,7 @@ foreign import _mergeNodeAttributes :: forall a. EffectFn3 Graph String a Unit
--foreign import _updateEdge :: EffectFn4 Graph String String (Record Types.Edge) String --foreign import _updateEdge :: EffectFn4 Graph String String (Record Types.Edge) String
foreign import _mapNodes :: forall a. Fn2 Graph (Record Types.Node -> a) (Array a) foreign import _mapNodes :: forall a. Fn2 Graph (Record Types.Node -> a) (Array a)
foreign import _forEachEdge :: EffectFn2 Graph (Record Types.Edge -> Effect Unit) Unit foreign import _forEachEdge :: EffectFn2 Graph (Record Types.Edge -> Effect Unit) Unit
foreign import _updateEachEdgeAttributes :: EffectFn2 Graph (Record Types.Edge -> Record Types.Edge) Unit
foreign import _mapEdges :: forall a. Fn2 Graph (Record Types.Edge -> a) (Array a) foreign import _mapEdges :: forall a. Fn2 Graph (Record Types.Edge -> a) (Array a)
newGraph :: Unit -> Effect Graph newGraph :: Unit -> Effect Graph
...@@ -77,6 +78,8 @@ forEachEdge = runEffectFn2 _forEachEdge ...@@ -77,6 +78,8 @@ forEachEdge = runEffectFn2 _forEachEdge
--forEachEdge g fn = pure $ g ... "forEachEdge" $ [\_ e -> fn e] --forEachEdge g fn = pure $ g ... "forEachEdge" $ [\_ e -> fn e]
mapEdges :: forall a. Graph -> (Record Types.Edge -> a) -> Array a mapEdges :: forall a. Graph -> (Record Types.Edge -> a) -> Array a
mapEdges = runFn2 _mapEdges mapEdges = runFn2 _mapEdges
updateEachEdgeAttributes :: Graph -> (Record Types.Edge -> Record Types.Edge) -> Effect Unit
updateEachEdgeAttributes = runEffectFn2 _updateEachEdgeAttributes
-- TODO Maybe our use of this function (`updateWithGraph`) in code is -- TODO Maybe our use of this function (`updateWithGraph`) in code is
-- too much. We convert Types.Graph into Graphology.Graph and then -- too much. We convert Types.Graph into Graphology.Graph and then
......
...@@ -100,7 +100,7 @@ killSigma s = EEx.try $ pure $ s ... "kill" $ [] ...@@ -100,7 +100,7 @@ killSigma s = EEx.try $ pure $ s ... "kill" $ []
-- | Get the `.graph` object from a sigmajs instance. -- | Get the `.graph` object from a sigmajs instance.
graph :: Sigma -> Graphology.Graph graph :: Sigma -> Graphology.Graph
graph s = s ... "getGraph" $ [] :: Graphology.Graph graph s = s .. "graph" :: Graphology.Graph
-- | Call `sigma.bind(event, handler)` on a sigmajs instance. -- | Call `sigma.bind(event, handler)` on a sigmajs instance.
on_ :: forall e. Sigma -> String -> (e -> Effect Unit) -> Effect Unit on_ :: forall e. Sigma -> String -> (e -> Effect Unit) -> Effect Unit
......
...@@ -11,11 +11,12 @@ import Data.Sequence as Seq ...@@ -11,11 +11,12 @@ import Data.Sequence as Seq
import Data.Set as Set import Data.Set as Set
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
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.Components.GraphExplorer.GraphTypes as GEGT import Gargantext.Components.GraphExplorer.GraphTypes as GEGT
import Gargantext.Data.Louvain as Louvain import Gargantext.Data.Louvain as Louvain
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Range as Range
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} }
...@@ -51,18 +52,18 @@ type Node = ( ...@@ -51,18 +52,18 @@ type Node = (
) )
type Edge = ( type Edge = (
color :: String color :: String
, confluence :: Number , confluence :: Number
, id :: EdgeId , id :: EdgeId
, hidden :: Boolean , hidden :: Boolean
, size :: Number , size :: Number
, source :: NodeId , source :: NodeId
, sourceNode :: Record Node , sourceNode :: Record Node
, target :: NodeId , target :: NodeId
, targetNode :: Record Node , targetNode :: Record Node
, weight :: Number , weight :: Number
, weightIdx :: Int , weightIdx :: Int
, _original :: GEGT.Edge , _original :: GEGT.Edge
) )
type NodeIds = Set.Set NodeId type NodeIds = Set.Set NodeId
...@@ -266,3 +267,13 @@ defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff" ...@@ -266,3 +267,13 @@ defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff"
,"#ccffc7","#52a1b0","#d2ecff","#99fffe" ,"#ccffc7","#52a1b0","#d2ecff","#99fffe"
,"#9295ae","#5ea38b","#fff0b3","#d99e68" ,"#9295ae","#5ea38b","#fff0b3","#d99e68"
] ]
type EdgeVisibilityProps =
( edgeWeight :: Range.NumberRange
, showEdges :: ShowEdgesState )
setEdgeVisibility :: Record EdgeVisibilityProps -> Record Edge -> Record Edge
setEdgeVisibility { edgeWeight, showEdges } e@{ weight } = e { hidden = hidden }
where
hidden = (edgeStateHidden showEdges) || (not $ Range.within edgeWeight weight)
...@@ -14,7 +14,7 @@ derive instance Newtype (Closed t) _ ...@@ -14,7 +14,7 @@ derive instance Newtype (Closed t) _
instance Ord t => Range (Closed t) t where instance Ord t => Range (Closed t) t where
clamp (Closed r) = max r.min <<< min r.max clamp (Closed r) = max r.min <<< min r.max
within (Closed r) v = (v <= r.max) && (v >= r.min) within (Closed r) v = (r.min <= v) && (v <= r.max)
instance Eq t => Eq (Closed t) where instance Eq t => Eq (Closed t) where
eq (Closed r1) (Closed r2) = (r1.min == r2.min) && (r1.max == r2.max) eq (Closed r1) (Closed r2) = (r1.min == r2.min) && (r1.max == r2.max)
......
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