Skip to content

P
purescript-gargantext
Commit 8a00269a authored by arturo's avatar arturo
Browse files
Options

>>> continue

parent 2b96ca23
Show whitespace changes
Inline Side-by-side
Showing with 488 additions and 364 deletions
src/Gargantext/Components/Nodes/Corpus/Phylo.purs
View file @ 8a00269a
......@@ -12,7 +12,7 @@ import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.PhyloExplorer.JSON (PhyloJSONSet)
import Gargantext.Components.PhyloExplorer.JSON (PhyloJSONSet(..))
import Gargantext.Components.PhyloExplorer.Layout (layout)
import Gargantext.Components.PhyloExplorer.Types (PhyloDataSet, parsePhyloJSONSet)
import Gargantext.Sessions (Session)
......
src/Gargantext/Components/PhyloExplorer/Draw.js
View file @ 8a00269a
'use strict';
exports._drawPhylo = drawPhylo;
// set javascript date from a string year
function yearToDate(year) {
var d = new Date()
......@@ -10,39 +12,39 @@ function yearToDate(year) {
}
function stringToDate(str) {
var arr = (str.replace('"','')).split('-');
var d = new Date();
d.setYear(parseInt(arr[0]));
d.setMonth(parseInt(arr[1]));
d.setMonth(d.getMonth() - 1);
d.setDate(parseInt(arr[2]));
return d;
var arr = (str.replace('"','')).split('-');
var d = new Date();
d.setYear(parseInt(arr[0]));
d.setMonth(parseInt(arr[1]));
d.setMonth(d.getMonth() - 1);
d.setDate(parseInt(arr[2]));
return d;
}
function utcStringToDate(str) {
var arr = ((str.replace('"','')).replace(' UTC','')).split(/[\s-:]+/);
var d = new Date();
d.setYear(parseInt(arr[0]));
d.setMonth(parseInt(arr[1]));
d.setDate(parseInt(arr[2]));
d.setHours(parseInt(arr[3]),parseInt(arr[4]),parseInt(arr[5]))
return d;
var arr = ((str.replace('"','')).replace(' UTC','')).split(/[\s-:]+/);
var d = new Date();
d.setYear(parseInt(arr[0]));
d.setMonth(parseInt(arr[1]));
d.setDate(parseInt(arr[2]));
d.setHours(parseInt(arr[3]),parseInt(arr[4]),parseInt(arr[5]))
return d;
}
function stringArrToArr(str) {
var arr = ((str.replace('["','')).replace('"]','')).split('","');
return arr;
var arr = ((str.replace('["','')).replace('"]','')).split('","');
return arr;
}
function intArrToArr(int) {
var arr = ((int.replace('[','')).replace(']','')).split(',');
return arr;
var arr = ((int.replace('[','')).replace(']','')).split(',');
return arr;
}
function yearToDateHacked(w) {
var d = new Date(2020,0,0);
d.setDate(d.getDate() + (w * 7));
return d
var d = new Date(2020,0,0);
d.setDate(d.getDate() + (w * 7));
return d
}
function toCoord(id) {
......@@ -116,6 +118,7 @@ function xOverFlow(ticks,arr) {
var branchFocus = [];
function addMarkX(ticks,ws,ids) {
ticks.each(function(t,i){
d3.select(this)
......@@ -139,6 +142,7 @@ function setMarkYLabel(labels) {
})
}
function addMarkY(ticks) {
ticks.each(function(d,i){
if (d3.timeYear(d) < d) {
......@@ -168,6 +172,7 @@ function removeDays(date, days) {
return result;
}
function setYDomain(labels) {
var ts = ["week","month","day","year","epoch"];
......@@ -207,10 +212,11 @@ function setYDomain(labels) {
return [inf,sup];
}
function groupTermsBy(elements, attr) {
let grouped = {},
let grouped = {},
curr = "";
for (var i = 0; i < elements.length; i++) {
for (var i = 0; i < elements.length; i++) {
let from = elements[i].getAttribute(attr)
if (curr != from) {
grouped[from] = [[(elements[i]).getAttribute("gx"),(elements[i]).getAttribute("gy"),(elements[i]).getAttribute("bid")]];
......@@ -218,9 +224,9 @@ for (var i = 0; i < elements.length; i++) {
} else {
grouped[from].push([(elements[i]).getAttribute("gx"),(elements[i]).getAttribute("gy"),(elements[i]).getAttribute("bid")]);
}
}
return Object.values(grouped);
};
}
return Object.values(grouped);
};
function findValueByPrefix(prefix) {
......@@ -235,6 +241,7 @@ function findValueByPrefix(prefix) {
return null;
}
function highlightSource() {
let checkSource = document.getElementById("checkSource");
let value = checkSource.options[checkSource.selectedIndex].value;
......@@ -266,9 +273,9 @@ function highlightSource() {
.classed("peak-focus-source", true);
})
}
}
}
function drawWordCloud (groups) {
function drawWordCloud (groups) {
let labels = {},
count = 0;
......@@ -306,7 +313,7 @@ function highlightSource() {
.style("opacity", opacity(Math.log(l.freq)))
.text(l.label);
})
}
}
function drawPhylo(branches, periods, groups, links, aLinks, bLinks, frame) {
......@@ -430,7 +437,6 @@ function drawPhylo(branches, periods, groups, links, aLinks, bLinks, frame) {
.attr("height",div3.height)
.append("g");
/* labels */
var firstDate = Math.min(...groups.map(g => (g.from).getFullYear()))
......@@ -716,6 +722,7 @@ function drawPhylo(branches, periods, groups, links, aLinks, bLinks, frame) {
});
});
function landingView() {
window.ldView = true;
doubleClick()
......@@ -789,7 +796,9 @@ function drawPhylo(branches, periods, groups, links, aLinks, bLinks, frame) {
for (let i = 0, n = lines.length; i < n; ++i) {
const dy = (Math.abs(i - n / 2 + 0.5) + 2) * lineHeight;
const dx = lines[i].width / 2;
radius = Math.max(radius, Math.sqrt(dx ** 2 + dy ** 2));
const sdy = Math.pow(dy, 2);
const sdx = Math.pow(dx, 2);
radius = Math.max(radius, Math.sqrt(sdx + sdy));
}
return radius;
}
......@@ -902,7 +911,6 @@ function drawPhylo(branches, periods, groups, links, aLinks, bLinks, frame) {
d3.selectAll(".header").raise();
function findRole(r) {
if (r == 0) {
return " emerging";
......@@ -1048,8 +1056,6 @@ function drawPhylo(branches, periods, groups, links, aLinks, bLinks, frame) {
}
}
}
function termClick (txt,idx,nodeId,typeNode) {
// remove old focus
......@@ -1291,15 +1297,15 @@ function drawPhylo(branches, periods, groups, links, aLinks, bLinks, frame) {
function exportViz() {
const xmlns = "http://www.w3.org/2000/xmlns/";
const xlinkns = "http://www.w3.org/1999/xlink";
const svgns = "http://www.w3.org/2000/svg";
const xmlns = "http://www.w3.org/2000/xmlns/";
const xlinkns = "http://www.w3.org/1999/xlink";
const svgns = "http://www.w3.org/2000/svg";
var time = new Date();
var time = new Date();
serialize(svg.node(),"phylomemy-" + Date.parse(time.toString()) + ".svg")
serialize(svg.node(),"phylomemy-" + Date.parse(time.toString()) + ".svg")
function serialize(graph,name) {
function serialize(graph,name) {
graph = graph.cloneNode(true);
const fragment = window.location.href + "#";
const walker = document.createTreeWalker(graph, NodeFilter.SHOW_ELEMENT, null, false);
......@@ -1326,10 +1332,10 @@ function serialize(graph,name) {
document.body.appendChild(downloadLink);
downloadLink.click();
document.body.removeChild(downloadLink);
};
};
function getCSSStyles( parentElement ) {
function getCSSStyles( parentElement ) {
var selectorTextArr = [];
// Add Parent element Id and Classes to the list
......@@ -1377,15 +1383,16 @@ function getCSSStyles( parentElement ) {
return arr.indexOf( str ) === -1 ? false : true;
}
}
}
function appendCSS( cssText, element ) {
function appendCSS( cssText, element ) {
var styleElement = document.createElement("style");
styleElement.setAttribute("type","text/css");
styleElement.innerHTML = cssText;
var refNode = element.hasChildNodes() ? element.children[0] : null;
element.insertBefore( styleElement, refNode );
}
}
}
}
}
}
src/Gargantext/Components/PhyloExplorer/Draw.purs
View file @ 8a00269a
module Gargantext.Components.PhyloExplorer.Draw where
import Gargantext.Prelude
import Data.Function.Uncurried (Fn7, runFn7)
import Effect (Effect)
import Gargantext.Components.PhyloExplorer.Types (AncestorLink, Branch, BranchLink, Group, Link, Period)
foreign import _drawPhylo :: Fn7
(Array Branch)
(Array Period)
(Array Group)
(Array Link)
(Array AncestorLink)
(Array BranchLink)
(Array Number)
(Effect Unit)
drawPhylo ::
Array Branch
-> Array Period
-> Array Group
-> Array Link
-> Array AncestorLink
-> Array BranchLink
-> Array Number
-> Effect Unit
drawPhylo = runFn7 _drawPhylo
src/Gargantext/Components/PhyloExplorer/JSON.purs
View file @ 8a00269a
......@@ -134,31 +134,32 @@ type EdgeData =
)
data RawEdge
= GroupToGroup
= GroupToAncestor
{ _gvid :: Int
, constraint :: String
, arrowhead :: String
, edgeType :: String
, lbl :: String
, penwidth :: String
, style :: String
| EdgeData
}
| BranchToGroup
| GroupToGroup
{ _gvid :: Int
, arrowhead :: String
, constraint :: String
, edgeType :: String
, lbl :: String
, penwidth :: String
| EdgeData
}
| BranchToBranch
| BranchToGroup
{ _gvid :: Int
, arrowhead :: String
, style :: String
, edgeType :: String
| EdgeData
}
| GroupToAncestor
| BranchToBranch
{ _gvid :: Int
, arrowhead :: String
, lbl :: String
, penwidth :: String
, style :: String
| EdgeData
}
......
src/Gargantext/Components/PhyloExplorer/Layout.purs
View file @ 8a00269a
......@@ -4,29 +4,16 @@ module Gargantext.Components.PhyloExplorer.Layout
import Gargantext.Prelude
import DOM.Simple (Window, window)
import DOM.Simple (window)
import DOM.Simple.Console (log2)
import Data.Array as Array
import Data.Date as Date
import Data.FoldableWithIndex (forWithIndex_)
import Data.Int as Int
import Data.Maybe (Maybe(..), maybe)
import Data.Number as Number
import Data.String as String
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 (GlobalTerm(..), Group(..), PhyloDataSet(..))
import Gargantext.Components.PhyloExplorer.Draw (drawPhylo)
import Gargantext.Components.PhyloExplorer.JSON (RawEdge(..))
import Gargantext.Components.PhyloExplorer.Types (PhyloDataSet(..), setGlobalDependencies)
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"
......@@ -46,6 +33,16 @@ layoutCpt = here.component "layout" cpt where
R.useEffectOnce' $ do
setGlobalDependencies window (PhyloDataSet o)
drawPhylo
o.branches
o.periods
o.groups
o.links
o.ancestorLinks
o.branchLinks
o.bb
-- @hightlightSource
let
......@@ -259,59 +256,6 @@ layoutCpt = here.component "layout" cpt where
]
setGlobalDependencies :: Window -> PhyloDataSet -> Effect Unit
setGlobalDependencies w (PhyloDataSet o)
= do
_ <- 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"
for_ o.groups \(Group g) -> do
let
f = g.foundation
l = g.label
log2 "group" g
-- 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 @ 8a00269a
......@@ -49,32 +49,3 @@ function utcStringToDate(str) {
exports.yearToDate = yearToDate;
exports.stringToDate = stringToDate;
exports.utcStringToDate = utcStringToDate;
function draw(json) {
var links = json.edges.filter(edges => edges.edgeType == "link").map(function(l){
return { lId : parseInt(l._gvid),
from : parseInt(l.tail) ,
to : parseInt(l.head) ,
label : l.label}
});
var aLinks = json.edges.filter(edges => edges.edgeType == "ancestorLink").map(function(l){
return { lId : parseInt(l._gvid),
from : parseInt(l.tail) ,
to : parseInt(l.head) ,
label : l.label }
});
var bLinks = json.edges.filter(edges => edges.edgeType == "branchLink").map(function(l){
return { from : parseInt(l.tail) ,
to : parseInt(l.head) }
});
window.terms = Object.values(window.terms)
// draw the phylo
drawPhylo(branches,periods,groups,links,aLinks,bLinks,bb);
}
src/Gargantext/Components/PhyloExplorer/Types.purs
View file @ 8a00269a
module Gargantext.Components.PhyloExplorer.Types
( PhyloDataSet(..)
, Branch(..), Period(..), Group(..)
, Link(..), AncestorLink(..), BranchLink(..)
, GlobalTerm(..)
, parsePhyloJSONSet
, setGlobalDependencies
) where
import Gargantext.Prelude
import DOM.Simple (Window)
import DOM.Simple.Console (log2)
import Data.Array as Array
import Data.Date as Date
import Data.Foldable (for_)
import Data.FoldableWithIndex (forWithIndex_)
import Data.Generic.Rep (class Generic)
import Data.Int as Int
import Data.Maybe (Maybe(..), maybe)
......@@ -17,19 +23,25 @@ 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(..), RawObject(..))
import Effect (Effect)
import FFI.Simple (applyTo, (..), (.=), (.?))
import Gargantext.Components.PhyloExplorer.JSON (PhyloJSONSet(..), RawEdge(..), RawObject(..))
import Unsafe.Coerce (unsafeCoerce)
-- @WIP Date or foreign?
-- @WIP PureScript Date or stick to JavaScript foreign?
foreign import yearToDate :: String -> Date.Date
foreign import stringToDate :: String -> Date.Date
foreign import utcStringToDate :: String -> Date.Date
newtype PhyloDataSet = PhyloDataSet
{ bb :: Array Number
{ ancestorLinks :: Array AncestorLink
, bb :: Array Number
, branchLinks :: Array BranchLink
, branches :: Array Branch
, groups :: Array Group
, links :: Array Link
, nbBranches :: Int
, nbDocs :: Int
, nbFoundations :: Int
......@@ -48,9 +60,12 @@ instance Show PhyloDataSet where show = genericShow
parsePhyloJSONSet :: PhyloJSONSet -> PhyloDataSet
parsePhyloJSONSet (PhyloJSONSet o) = PhyloDataSet
{ bb : parseBB o.bb
{ ancestorLinks
, bb : parseBB o.bb
, branchLinks
, branches
, groups
, links
, nbBranches : parseInt o.phyloBranches
, nbDocs : parseInt o.phyloDocs
, nbFoundations : parseInt o.phyloFoundations
......@@ -65,8 +80,12 @@ parsePhyloJSONSet (PhyloJSONSet o) = PhyloDataSet
where
epochTS = o.phyloTimeScale == "epoch"
ancestorLinks = parseAncestorLinks o.edges
branchLinks = parseBranchLinks o.edges
branches = parseBranches o.objects
groups = parseGroups epochTS o.objects
links = parseLinks o.edges
periods = parsePeriods epochTS o.objects
-----------------------------------------------------------
......@@ -173,6 +192,107 @@ parseGroups epoch
-----------------------------------------------------------
data Link = Link
{ from :: Int
, lId :: Int
, label :: String -- @WIP: undefined in Mèmiescape v2, still needed?
, to :: Int
}
derive instance Generic Link _
derive instance Eq Link
instance Show Link where show = genericShow
parseLinks :: Array RawEdge -> Array Link
parseLinks
= Array.filter filter
>>> map parse
>>> Array.catMaybes
where
-- @WIP: necessary?
-- bc. GroupToGroup as 1-1 relation with "edgeType=link"
filter :: RawEdge -> Boolean
filter (GroupToGroup o) = o.edgeType == "link"
filter _ = false
parse :: RawEdge -> Maybe Link
parse (GroupToGroup o) = Just $ Link
{ from : o.tail
, lId : o._gvid
, label : ""
, to : o.head
}
parse _ = Nothing
-----------------------------------------------------------
data AncestorLink = AncestorLink
{ from :: Int
, lId :: Int
, label :: String -- @WIP: undefined in Mèmiescape v2, still needed?
, to :: Int
}
derive instance Generic AncestorLink _
derive instance Eq AncestorLink
instance Show AncestorLink where show = genericShow
parseAncestorLinks :: Array RawEdge -> Array AncestorLink
parseAncestorLinks
= Array.filter filter
>>> map parse
>>> Array.catMaybes
where
-- @WIP: necessary?
-- bc. GroupToAncestor as 1-1 relation with "edgeType=ancestorLink"
filter :: RawEdge -> Boolean
filter (GroupToAncestor o) = o.edgeType == "ancestorLink"
filter _ = false
parse :: RawEdge -> Maybe AncestorLink
parse (GroupToAncestor o) = Just $ AncestorLink
{ from : o.tail
, lId : o._gvid
, label : ""
, to : o.head
}
parse _ = Nothing
-----------------------------------------------------------
data BranchLink = BranchLink
{ from :: Int
, to :: Int
}
derive instance Generic BranchLink _
derive instance Eq BranchLink
instance Show BranchLink where show = genericShow
parseBranchLinks :: Array RawEdge -> Array BranchLink
parseBranchLinks
= Array.filter filter
>>> map parse
>>> Array.catMaybes
where
-- @WIP: necessary?
-- bc. BranchToGroup as 1-1 relation with "edgeType=branchLink"
filter :: RawEdge -> Boolean
filter (BranchToGroup o) = o.edgeType == "branchLink"
filter _ = false
parse :: RawEdge -> Maybe BranchLink
parse (BranchToGroup o) = Just $ BranchLink
{ from : o.tail
, to : o.head
}
parse _ = Nothing
-----------------------------------------------------------
data GlobalTerm = GlobalTerm
{ label :: String
, fdt :: String
......@@ -182,6 +302,55 @@ derive instance Generic GlobalTerm _
derive instance Eq GlobalTerm
instance Show GlobalTerm where show = genericShow
setGlobalDependencies :: Window -> PhyloDataSet -> Effect Unit
setGlobalDependencies w (PhyloDataSet o)
= do
_ <- 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"
for_ o.groups \(Group g) -> do
let
f = g.foundation
l = g.label
forWithIndex_ f \idx val ->
let
idx' = show idx
val' = show val
-- For each entries in group.foundation array,
-- increment consequently the global window.keys array
in case (freq .? val') of
Nothing -> pure $ (freq .= val') 0
Just v -> pure $ (freq .= val') (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
*> case (terms .? val') of
Just _ -> pure unit
Nothing -> void <<< pure $ (terms .= val') $ GlobalTerm
{ label: l .. idx'
, fdt : val'
}
-- @XXX: FFI.Simple `(...)` throws error (JavaScript issue)
-- need to decompose computation
void do
new <- pure $ applyTo (terms .. "flat") terms []
pure $ (w .= "terms") new
-----------------------------------------------------------
parseInt :: String -> Int
......
src/Main.purs
View file @ 8a00269a
......@@ -9,6 +9,7 @@ import Effect (Effect)
import FFI.Simple ((...))
import Gargantext.Components.App (app)
import Gargantext.Utils.Reactix as R2
import Graphics.D3.Base (D3, d3)
import Prelude (Unit, ($))
main :: Effect Unit
......@@ -17,3 +18,7 @@ main = paint $ toMaybe (document ... "getElementById" $ [ "app" ])
paint :: Maybe Element -> Effect Unit
paint Nothing = log "[main] Container not found"
paint (Just c) = R2.render (app {} []) c
-- @WIP
d3charge :: D3
d3charge = d3
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