Skip to content

P
purescript-gargantext
Commit 471fbf05 authored by arturo's avatar arturo
Browse files
Options

>>> continue

parent 7a9fdad7
Hide whitespace changes
Inline Side-by-side
Showing with 118 additions and 129 deletions
src/Gargantext/Components/Nodes/Corpus/Phylo.purs
View file @ 471fbf05
......@@ -14,7 +14,7 @@ import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.PhyloExplorer.JSON (PhyloJSONSet)
import Gargantext.Components.PhyloExplorer.Layout (layout)
import Gargantext.Components.PhyloExplorer.Types (PhyloDataSet)
import Gargantext.Components.PhyloExplorer.Types (PhyloDataSet, parsePhyloJSONSet)
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeID)
import Gargantext.Utils.Reactix as R2
......@@ -37,7 +37,7 @@ phyloLayoutCpt :: R.Component Props
phyloLayoutCpt = here.component "phyloLayout" cpt where
cpt _ _ = do
fetchedDataBox <- T.useBox (Nothing :: Maybe PhyloJSONSet)
fetchedDataBox <- T.useBox (Nothing :: Maybe PhyloDataSet)
fetchedData <- T.useLive T.unequal fetchedDataBox
R.useEffectOnce' $ launchAff_ do
......
src/Gargantext/Components/PhyloExplorer/JSON.purs
View file @ 471fbf05
......@@ -42,8 +42,8 @@ type GraphData =
newtype PhyloJSONSet = PhyloJSONSet
{ _subgraph_cnt :: Int
, directed :: Boolean
, edges :: Array Edge
, objects :: Array PhyloObject
, edges :: Array RawEdge
, objects :: Array RawObject
, strict :: Boolean
| GraphData
}
......@@ -65,7 +65,7 @@ type NodeData =
, width :: String
)
data PhyloObject
data RawObject
= Layer
{ _gvid :: Int
, nodes :: Array Int
......@@ -116,10 +116,10 @@ data PhyloObject
| NodeData
}
derive instance Generic PhyloObject _
derive instance Eq PhyloObject
instance Show PhyloObject where show = genericShow
instance JSON.ReadForeign PhyloObject where
derive instance Generic RawObject _
derive instance Eq RawObject
instance Show RawObject where show = genericShow
instance JSON.ReadForeign RawObject where
readImpl f = GR.to <$> untaggedSumRep f
......@@ -133,7 +133,7 @@ type EdgeData =
, width :: String
)
data Edge
data RawEdge
= GroupToGroup
{ _gvid :: Int
, constraint :: String
......@@ -167,8 +167,8 @@ data Edge
| EdgeData
}
derive instance Generic Edge _
derive instance Eq Edge
instance Show Edge where show = genericShow
instance JSON.ReadForeign Edge where
derive instance Generic RawEdge _
derive instance Eq RawEdge
instance Show RawEdge where show = genericShow
instance JSON.ReadForeign RawEdge where
readImpl f = GR.to <$> untaggedSumRep f
src/Gargantext/Components/PhyloExplorer/Layout.purs
View file @ 471fbf05
......@@ -5,6 +5,7 @@ module Gargantext.Components.PhyloExplorer.Layout
import Gargantext.Prelude
import DOM.Simple (Window, window)
import DOM.Simple.Console (log2)
import Data.Array as Array
import Data.Date as Date
import Data.FoldableWithIndex (forWithIndex_)
......@@ -12,17 +13,20 @@ import Data.Int as Int
import Data.Maybe (Maybe(..), maybe)
import Data.Number as Number
import Data.String as String
import Data.Traversable (for)
import Data.Symbol (SProxy(..))
import Data.Traversable (for, for_)
import Data.Tuple as Tuple
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import FFI.Simple (maybeGetProperty, (..), (...))
import Gargantext.Components.PhyloExplorer.Types (Group, PhyloDataSet(..))
import FFI.Simple (maybeGetProperty, (..), (...), (.=), (.?))
import Gargantext.Components.PhyloExplorer.Types (GlobalTerm(..), Group(..), PhyloDataSet(..))
import Gargantext.Utils (nbsp)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Record (get)
import Toestand as T
import Type.Proxy (Proxy(..))
here :: R2.Here
here = R2.here "Gargantext.Components.PhyloExplorer"
......@@ -41,7 +45,7 @@ layoutCpt = here.component "layout" cpt where
R.useEffectOnce' $ do
pure unit
setGlobalDependencies window (PhyloDataSet o)
-- @hightlightSource
let
......@@ -260,29 +264,55 @@ layoutCpt = here.component "layout" cpt where
setGlobalDependencies :: Window -> PhyloDataSet -> Effect Unit
setGlobalDependencies w (PhyloDataSet o)
= do
-- _ <- w ... "freq" $ {}
-- _ <- w ... "nbBranches" $ o.nbBranches
-- _ <- w ... "nbDocs" $ o.nbDocs
-- _ <- w ... "nbFoundations" $ o.nbFoundations
-- _ <- w ... "nbGroups" $ o.nbGroups
-- _ <- w ... "nbPeriods" $ o.nbPeriods
-- _ <- w ... "nbTerms" $ o.nbTerms
-- _ <- w ... "sources" $ o.sources
-- _ <- w ... "terms" $ {}
-- _ <- w ... "timeScale" $ o.timeScale
-- _ <- w ... "weighted" $ o.weighted
(freq :: Array Int) <- pure $ w .. "freq"
pure unit
-- forWithIndex_ o.foundations $ \i _ -> case maybeGetProperty (show i) freq of
-- Nothing -> freq ... (show i) $ 0
-- Just v -> freq ... (show i) $ (v + 1)
-- pure $ for o.groups \(g :: Group)-> pure unit
_ <- pure $ (w .= "freq") {}
_ <- pure $ (w .= "nbBranches") o.nbBranches
_ <- pure $ (w .= "nbDocs") o.nbDocs
_ <- pure $ (w .= "nbFoundations") o.nbFoundations
_ <- pure $ (w .= "nbGroups") o.nbGroups
_ <- pure $ (w .= "nbPeriods") o.nbPeriods
_ <- pure $ (w .= "nbTerms") o.nbTerms
_ <- pure $ (w .= "sources") o.sources
_ <- pure $ (w .= "terms") []
_ <- pure $ (w .= "timeScale") o.timeScale
_ <- pure $ (w .= "weighted") o.weighted
(freq :: Array Int) <- pure $ w .. "freq"
(terms :: Array GlobalTerm) <- pure $ w .. "terms"
void $ for o.groups \(Group g) -> do
let
f = g.foundation
l = g.label
log2 "FOUNDATION" f
log2 "LABEL" l
-- For each entries in group.foundation array,
-- increment consequently the global window.keys array
-- forWithIndex_ f \i _ ->
-- let i' = show i
-- in case (freq .? i') of
-- Nothing -> pure $ (freq .= i') 0
-- Just v -> pure $ (freq .= i') (v +1)
for_ f \i ->
let i' = show i
in case (freq .? i') of
Nothing -> pure $ (freq .= i') 0
Just v -> pure $ (freq .= i') (v +1)
-- For each entries in group.foundation array,
-- if the global window.terms does not have it in property,
-- append an item to the global window.terms
for_ f \i ->
let i' = show i
in case (terms .? i') of
Nothing -> pure unit
Just _ -> void <<< pure $ (terms .= i') $ GlobalTerm
{ label: l .. i'
, fdt : f .. i'
}
--------------------------------------------------------
type PhyloCorpusProps = ()
......
src/Gargantext/Components/PhyloExplorer/Types.js
View file @ 471fbf05
......@@ -52,74 +52,6 @@ exports.utcStringToDate = utcStringToDate;
function draw(json) {
// groups
window.weighted = false;
var groups = json.objects.filter(node => node.nodeType == "group").map(function(g){
// console.log(g.weight)
if ((g.weight != undefined) && (g.weight != "Nothing"))
window.weighted = true;
var keys = (g.foundation.slice(1, g.foundation.length - 1)).split('|')
var labels = (g.lbl.slice(1, g.lbl.length - 1)).split('|')
for (var i = 0; i < keys.length; i++) {
// freq
if (!((keys[i]).trim() in window.freq)) {
window.freq[(keys[i]).trim()] = 0;
} else {
window.freq[(keys[i]).trim()] += 1;
}
// terms
if (!((keys[i]).trim() in window.terms)) {
window.terms[(keys[i]).trim()] = {label:(labels[i]).trim(),fdt:(keys[i]).trim()}
}
}
var from = yearToDate(g.from),
to = yearToDate(g.to),
weight = 0;
source = [];
if (g.strFrom != undefined) {
if (window.timeScale == "epoch") {
from = utcStringToDate(g.strFrom)
} else {
from = stringToDate(g.strFrom)
}
}
if (g.strTo != undefined) {
if (window.timeScale == "epoch") {
to = utcStringToDate(g.strTo)
} else {
to = stringToDate(g.strTo)
}
}
if (g.source != undefined)
source = intArrToArr(g.source);
if (g.weight != undefined)
weight = parseFloat((g.weight).replace("Just ",""));
return { from : from,
to : to,
x : parseFloat(((g.pos).split(','))[0]) ,
y : parseFloat(((g.pos).split(','))[1]) ,
bId : parseInt(g.bId) ,
gId : parseInt(g._gvid) ,
size : parseInt(g.support),
source : source,
weight : weight,
label : labels,
foundation : keys,
role : ((g.role.slice(1, g.role.length - 1)).split('|')).map(e => parseInt(e.trim()))}
});
var links = json.edges.filter(edges => edges.edgeType == "link").map(function(l){
return { lId : parseInt(l._gvid),
......
src/Gargantext/Components/PhyloExplorer/Types.purs
View file @ 471fbf05
module Gargantext.Components.PhyloExplorer.Types
( PhyloDataSet(..)
, Branch, Period, Group
, Branch(..), Period(..), Group(..)
, GlobalTerm(..)
, parsePhyloJSONSet
) where
......@@ -12,10 +13,11 @@ import Data.Generic.Rep (class Generic)
import Data.Int as Int
import Data.Maybe (Maybe(..), maybe)
import Data.Number as Number
import Data.Show.Generic (genericShow)
import Data.String as String
import Data.Tuple as Tuple
import Data.Tuple.Nested ((/\))
import Gargantext.Components.PhyloExplorer.JSON (PhyloJSONSet(..), PhyloObject(..))
import Gargantext.Components.PhyloExplorer.JSON (PhyloJSONSet(..), RawObject(..))
-- @WIP Date or foreign?
......@@ -41,6 +43,8 @@ newtype PhyloDataSet = PhyloDataSet
}
derive instance Generic PhyloDataSet _
derive instance Eq PhyloDataSet
instance Show PhyloDataSet where show = genericShow
parsePhyloJSONSet :: PhyloJSONSet -> PhyloDataSet
parsePhyloJSONSet (PhyloJSONSet o) = PhyloDataSet
......@@ -76,13 +80,17 @@ data Branch = Branch
, y :: String
}
parseBranches :: Array PhyloObject -> Array Branch
derive instance Generic Branch _
derive instance Eq Branch
instance Show Branch where show = genericShow
parseBranches :: Array RawObject -> Array Branch
parseBranches
= map parse
>>> Array.catMaybes
where
parse :: PhyloObject -> Maybe Branch
parse :: RawObject -> Maybe Branch
parse (BranchToNode o) = Just $ Branch
{ bId : parseInt o.bId
, gvid : o._gvid
......@@ -101,13 +109,17 @@ data Period = Period
, y :: Number
}
parsePeriods :: Boolean -> Array PhyloObject -> Array Period
derive instance Generic Period _
derive instance Eq Period
instance Show Period where show = genericShow
parsePeriods :: Boolean -> Array RawObject -> Array Period
parsePeriods epoch
= map parse
>>> Array.catMaybes
where
parse :: PhyloObject -> Maybe Period
parse :: RawObject -> Maybe Period
parse (PeriodToNode o) = Just $ Period
{ from : parseNodeDate o.strFrom o.from epoch
, to : parseNodeDate o.strTo o.to epoch
......@@ -132,31 +144,46 @@ data Group = Group
, y :: Number
}
parseGroups :: Boolean -> Array PhyloObject -> Array Group
derive instance Generic Group _
derive instance Eq Group
instance Show Group where show = genericShow
parseGroups :: Boolean -> Array RawObject -> Array Group
parseGroups epoch
= map parse
>>> Array.catMaybes
where
parse :: PhyloObject -> Maybe Group
parse :: RawObject -> Maybe Group
parse (GroupToNode o) = Just $ Group
{ from : parseNodeDate o.strFrom o.from epoch
, to : parseNodeDate o.strTo o.to epoch
, x : Tuple.fst $ parsePos o.pos
, y : Tuple.snd $ parsePos o.pos
, bId : parseInt o.bId
, gId : o._gvid
, size : parseInt o.support
, source: parseSources o.source
, weight: stringedMaybeToNumber o.weight
, label : stringedArrayToArray o.lbl
, role : stringedArrayToArray' o.role
, foundation: stringedArrayToArray' o.foundation
{ bId : parseInt o.bId
, foundation : stringedArrayToArray' o.foundation
, from : parseNodeDate o.strFrom o.from epoch
, gId : o._gvid
, label : stringedArrayToArray o.lbl
, role : stringedArrayToArray' o.role
, size : parseInt o.support
, source : parseSources o.source
, to : parseNodeDate o.strTo o.to epoch
, weight : stringedMaybeToNumber o.weight
, x : Tuple.fst $ parsePos o.pos
, y : Tuple.snd $ parsePos o.pos
}
parse _ = Nothing
-----------------------------------------------------------
data GlobalTerm = GlobalTerm
{ label :: String
, fdt :: String
}
derive instance Generic GlobalTerm _
derive instance Eq GlobalTerm
instance Show GlobalTerm where show = genericShow
-----------------------------------------------------------
parseInt :: String -> Int
parseInt s = maybe 0 identity $ Int.fromString s
......
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