Commit 81c77cb9 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski Committed by Alexandre Delanoë

[utils] generic renormalization using lens

parent 9b1ef410
...@@ -8,6 +8,7 @@ import Gargantext.Prelude ...@@ -8,6 +8,7 @@ import Gargantext.Prelude
import Data.Array as A import Data.Array as A
import Data.Foldable (maximum, minimum) import Data.Foldable (maximum, minimum)
import Data.Lens (lens)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Newtype (wrap) import Data.Newtype (wrap)
import Data.Sequence as Seq import Data.Sequence as Seq
...@@ -15,6 +16,7 @@ import Gargantext.Components.GraphExplorer.GraphTypes as GEGT ...@@ -15,6 +16,7 @@ import Gargantext.Components.GraphExplorer.GraphTypes as GEGT
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax.Types as ST import Gargantext.Hooks.Sigmax.Types as ST
import Gargantext.Utils (getter) import Gargantext.Utils (getter)
import Gargantext.Utils.Lens as GUL
import Gargantext.Utils.Seq as GUS import Gargantext.Utils.Seq as GUS
stEdgeToGET :: Record ST.Edge -> GEGT.Edge stEdgeToGET :: Record ST.Edge -> GEGT.Edge
...@@ -34,31 +36,37 @@ stNodeToGET { id, label, x, y, _original: GEGT.Node { attributes, size, type_ } ...@@ -34,31 +36,37 @@ stNodeToGET { id, label, x, y, _original: GEGT.Node { attributes, size, type_ }
----------------------------------------------------------------------- -----------------------------------------------------------------------
-- | Normalize nodes, i.e. set their {x, y} values so that they are in
-- | range [0, 1].
normalizeNodes :: Seq.Seq GEGT.Node -> Seq.Seq GEGT.Node normalizeNodes :: Seq.Seq GEGT.Node -> Seq.Seq GEGT.Node
normalizeNodes ns = Seq.map normalizeNode ns normalizeNodes ns = GUL.normalizeLens xLens $ GUL.normalizeLens yLens ns
where where
xs = map (\(GEGT.Node { x }) -> x) ns xLens = lens (\(GEGT.Node { x }) -> x) $ (\(GEGT.Node n) val -> GEGT.Node (n { x = val }))
ys = map (\(GEGT.Node { y }) -> y) ns yLens = lens (\(GEGT.Node { y }) -> y) $ (\(GEGT.Node n) val -> GEGT.Node (n { y = val }))
mMinx = minimum xs -- normalizeNodes ns = Seq.map normalizeNode ns
mMaxx = maximum xs -- where
mMiny = minimum ys -- xs = map (\(GEGT.Node { x }) -> x) ns
mMaxy = maximum ys -- ys = map (\(GEGT.Node { y }) -> y) ns
mXrange = do -- mMinx = minimum xs
minx <- mMinx -- mMaxx = maximum xs
maxx <- mMaxx -- mMiny = minimum ys
pure $ maxx - minx -- mMaxy = maximum ys
mYrange = do -- mXrange = do
miny <- mMiny -- minx <- mMinx
maxy <- mMaxy -- maxx <- mMaxx
pure $ maxy - miny -- pure $ maxx - minx
xdivisor = case mXrange of -- mYrange = do
Nothing -> 1.0 -- miny <- mMiny
Just xdiv -> 1.0 / xdiv -- maxy <- mMaxy
ydivisor = case mYrange of -- pure $ maxy - miny
Nothing -> 1.0 -- xdivisor = case mXrange of
Just ydiv -> 1.0 / ydiv -- Nothing -> 1.0
normalizeNode (GEGT.Node n@{ x, y }) = GEGT.Node $ n { x = x * xdivisor -- Just xdiv -> 1.0 / xdiv
, y = y * ydivisor } -- ydivisor = case mYrange of
-- Nothing -> 1.0
-- Just ydiv -> 1.0 / ydiv
-- normalizeNode (GEGT.Node n@{ x, y }) = GEGT.Node $ n { x = x * xdivisor
-- , y = y * ydivisor }
------------------------------------------------------------------------ ------------------------------------------------------------------------
......
module Gargantext.Utils.Lens where
import Gargantext.Prelude
import Data.Foldable (maximum, minimum)
import Data.Maybe (Maybe(..))
import Data.Lens
import Data.Traversable
-- | Given a Traversable of entities and a lens for them, normalize
-- | over lens getter so that the value of lens setter is in range [0,
-- | 1].
normalizeLens :: forall a t. Traversable t => Lens' a Number -> t a -> t a
normalizeLens l ns = over traversed normalize' ns
where
values = over traversed (_ ^. l) ns
vMin = minimum values
vMax = maximum values
vRange = do
minv <- vMin
maxv <- vMax
pure $ maxv - minv
divisor = case vRange of
Nothing -> 1.0
Just d -> 1.0 / d
normalize' n = over l (_ * divisor) n
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