[phylo] hourly phylo seems to work now

At least with proper settings.
parent 59efd170
Pipeline #7829 failed with stages
in 28 minutes and 29 seconds
......@@ -93,6 +93,7 @@ data TimeUnit
| Month TimeUnitCriteria
| Week TimeUnitCriteria
| Day TimeUnitCriteria
| Hour TimeUnitCriteria
derive instance Generic TimeUnit _
derive instance Eq TimeUnit
......@@ -109,6 +110,7 @@ instance JSON.WriteForeign TimeUnit where
Month (TimeUnitCriteria o) -> (JSON.writeImpl <<< parseMonth) o
Week (TimeUnitCriteria o) -> (JSON.writeImpl <<< parseWeek) o
Day (TimeUnitCriteria o) -> (JSON.writeImpl <<< parseDay) o
Hour (TimeUnitCriteria o) -> (JSON.writeImpl <<< parseHour) o
where
parseEpoch =
Record.rename
......@@ -175,6 +177,19 @@ instance JSON.WriteForeign TimeUnit where
>>> Record.insert
(Proxy :: Proxy "tag")
"Day"
parseHour =
Record.rename
(Proxy :: Proxy "period")
(Proxy :: Proxy "_hour_period")
>>> Record.rename
(Proxy :: Proxy "step")
(Proxy :: Proxy "_hour_step")
>>> Record.rename
(Proxy :: Proxy "matchingFrame")
(Proxy :: Proxy "_hour_matchingFrame")
>>> Record.insert
(Proxy :: Proxy "tag")
"Hour"
data ReflexiveTimeUnit
= Epoch_
......@@ -182,6 +197,7 @@ data ReflexiveTimeUnit
| Month_
| Week_
| Day_
| Hour_
derive instance Generic ReflexiveTimeUnit _
derive instance Eq ReflexiveTimeUnit
......@@ -196,6 +212,7 @@ instance Read ReflexiveTimeUnit where
"Month_" -> Just Month_
"Week_" -> Just Week_
"Day_" -> Just Day_
"Hour_" -> Just Hour_
_ -> Nothing
newtype TimeUnitCriteria = TimeUnitCriteria
......@@ -302,6 +319,7 @@ toReflexiveTimeUnit (Year _) = Year_
toReflexiveTimeUnit (Month _) = Month_
toReflexiveTimeUnit (Week _) = Week_
toReflexiveTimeUnit (Day _) = Day_
toReflexiveTimeUnit (Hour _) = Hour_
fromReflexiveTimeUnit :: ReflexiveTimeUnit -> TimeUnitCriteria -> TimeUnit
fromReflexiveTimeUnit Epoch_ c = Epoch c
......@@ -309,6 +327,7 @@ fromReflexiveTimeUnit Year_ c = Year c
fromReflexiveTimeUnit Month_ c = Month c
fromReflexiveTimeUnit Week_ c = Week c
fromReflexiveTimeUnit Day_ c = Day c
fromReflexiveTimeUnit Hour_ c = Hour c
extractCriteria :: TimeUnit -> TimeUnitCriteria
extractCriteria (Epoch (o :: TimeUnitCriteria)) = o
......@@ -316,6 +335,7 @@ extractCriteria (Year (o :: TimeUnitCriteria)) = o
extractCriteria (Month (o :: TimeUnitCriteria)) = o
extractCriteria (Week (o :: TimeUnitCriteria)) = o
extractCriteria (Day (o :: TimeUnitCriteria)) = o
extractCriteria (Hour (o :: TimeUnitCriteria)) = o
toReflexiveClique :: Clique -> ReflexiveClique
toReflexiveClique (FIS _) = FIS_
......
......@@ -195,6 +195,9 @@ component = R.hooksComponent "configForm" cpt
, H.option
{ value: show Day_ }
[ H.text "Day" ]
, H.option
{ value: show Hour_ }
[ H.text "Hour" ]
]
]
]
......
......@@ -62,6 +62,8 @@ derive newtype instance JSON.ReadForeign PhyloJSON
--------------------------------------------------
-- | This is in direct correspondence with backend's 'G.C.T.Phylo' ->
-- | 'GraphData'. It is an output of the 'dot' command.
type GraphData =
( bb :: String
, color :: String
......@@ -361,6 +363,11 @@ data TimeUnit
, _day_step :: Int
, _day_matchingFrame :: Int
}
| Hour
{ _hour_period :: Int
, _hour_step :: Int
, _hour_matchingFrame :: Int
}
derive instance Generic TimeUnit _
derive instance Eq TimeUnit
......
......@@ -1228,7 +1228,11 @@ function drawPhylo(branches, periods, groups, links, aLinks, bLinks, frame) {
.attr("height", scapeCoordinates.h)
/* labels */
if (groups.length == 0) {
console.log('groups empty, exiting');
return
}
var firstDate = Math.min(...groups.map(g => (g.from).getFullYear()))
var yLabels = (periods.map(p => ({y:p.y,from:p.from,to:p.to,label:(p.from).getFullYear()}))).filter(p => p.label >= firstDate);
var xLabels = toXLabels(branches,groups,frame[2]);
......
......@@ -173,3 +173,9 @@ detailsTimeUnit t =
, detailsParams _day_step "Step"
, detailsParams _day_matchingFrame "Matching frame"
]
parseTimeUnit (Hour { _hour_period, _hour_step, _hour_matchingFrame }) =
[ detailsParams "Hour" "Time unit"
, detailsParams _hour_period "Period"
, detailsParams _hour_step "Step"
, detailsParams _hour_matchingFrame "Matching frame"
]
'use strict';
import dayjs from '../../src/external-deps/dayjs.min.js';
/**
* @name yearToDate
* @param {string} year
......@@ -13,6 +16,49 @@ export function yearToDate(year) {
return d;
}
/**
* @name monthToDate
* @param {string} year
* @returns {Date}
*/
export function monthToDate(month) {
var d = dayjs('0001-01-01');
return d.add(month, 'months').toDate();
}
/**
* @name weekToDate
* @param {string} year
* @returns {Date}
*/
export function weekToDate(week) {
// week is number of days divided by 7
var d = dayjs('0001-01-01');
return d.add(week*7, 'days').toDate();
}
/**
* @name dayToDate
* @param {string} year
* @returns {Date}
*/
export function dayToDate(days) {
// week is number of days divided by 7
var d = dayjs('0001-01-01');
return d.add(days, 'days').toDate();
}
/**
* @name hourToDate
* @param {string} year
* @returns {Date}
*/
export function hourToDate(hours) {
// week is number of days divided by 7
var d = dayjs('0001-01-01');
return d.add(hours, 'hours').toDate();
}
/**
* @name stringToDate
* @param {string} str
......
......@@ -39,11 +39,17 @@ import Data.String as String
import Data.String.Extra (camelCase)
import Data.Tuple as Tuple
import Data.Tuple.Nested ((/\))
import Gargantext.Components.PhyloExplorer.JSON (Cluster, PhyloJSON(..), PhyloSimilarity(..), Quality(..), RawEdge(..), RawObject(..), Synchrony(..), TimeUnit)
import Debug (trace)
import Gargantext.Components.PhyloExplorer.JSON (Cluster, PhyloJSON(..), PhyloSimilarity(..), Quality(..), RawEdge(..), RawObject(..), Synchrony(..), TimeUnit(..))
import Partial.Unsafe (unsafeCrashWith)
import Simple.JSON as JSON
-- @NOTE #219: PureScript Date or stick to JavaScript foreign?
foreign import yearToDate :: String -> Date.Date
foreign import monthToDate :: String -> Date.Date
foreign import weekToDate :: String -> Date.Date
foreign import dayToDate :: String -> Date.Date
foreign import hourToDate :: String -> Date.Date
foreign import stringToDate :: String -> Date.Date
foreign import utcStringToDate :: String -> Date.Date
......@@ -105,9 +111,9 @@ parseToPhyloSet (PhyloJSON o@{ pd_data: Just p, pd_config: Just c }) = Just $ Ph
ancestorLinks = parseAncestorLinks p.edges
branchLinks = parseBranchLinks p.edges
branches = parseBranches p.objects
groups = parseGroups epochTS p.objects
groups = parseGroups c.timeUnit epochTS p.objects
links = parseLinks p.edges
periods = parsePeriods epochTS p.objects
periods = parsePeriods c.timeUnit epochTS p.objects
parseToPhyloSet _ = Nothing
----------------------------------------------------------------------
......@@ -217,15 +223,15 @@ derive instance Eq Period
instance Show Period where
show = genericShow
parsePeriods :: Boolean -> Array RawObject -> Array Period
parsePeriods epoch = map parse
parsePeriods :: TimeUnit -> Boolean -> Array RawObject -> Array Period
parsePeriods tu epoch = map parse
>>> Array.catMaybes
where
parse :: RawObject -> Maybe Period
parse (PeriodToNode o) = Just $ Period
{ from: parseNodeDate o.strFrom o.from epoch
, to: parseNodeDate o.strTo o.to epoch
{ from: parseNodeDate tu o.strFrom o.from epoch
, to: parseNodeDate tu o.strTo o.to epoch
, y: Tuple.snd $ parsePos o.pos
}
parse _ = Nothing
......@@ -252,8 +258,8 @@ derive instance Eq Group
instance Show Group where
show = genericShow
parseGroups :: Boolean -> Array RawObject -> Array Group
parseGroups epoch = map parse
parseGroups :: TimeUnit -> Boolean -> Array RawObject -> Array Group
parseGroups tu epoch = map parse
>>> Array.catMaybes
where
......@@ -261,18 +267,18 @@ parseGroups epoch = map parse
parse (GroupToNode o) = Just $ Group
{ bId: parseInt o.bId
, foundation: stringedArrayToArray' o.foundation
, from: parseNodeDate o.strFrom o.from epoch
, from: parseNodeDate tu 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
, to: parseNodeDate tu o.strTo o.to epoch
, weight: stringedMaybeToNumber o.weight
, x: Tuple.fst $ parsePos o.pos
, y: Tuple.snd $ parsePos o.pos
}
parse _ = Nothing
parse g = trace ("not a GroupToNode: " <> show g) \_ -> Nothing
-----------------------------------------------------------
......@@ -457,13 +463,19 @@ parseBB :: String -> Array Number
parseBB = String.split (String.Pattern ",")
>>> map parseFloat
parseNodeDate :: Maybe String -> String -> Boolean -> Date.Date
-- | NOTE This must be in accordance with backend's 'G.C.V.P.API.Tools' -> 'toPhyloDate'
parseNodeDate :: TimeUnit -> Maybe String -> String -> Boolean -> Date.Date
-- parseNodeDate Nothing year _ = yearToDate(year)
-- parseNodeDate (Just str) _ true = utcStringToDate(str)
-- parseNodeDate (Just str) _ false = stringToDate(str)
-- @NOTE #219 ^ as soon as the issue regarding `Date` (< 1970) is resolved
-- please uncomment above lines + delete below one
parseNodeDate _ y _ = yearToDate (y)
parseNodeDate (Year _) _ s _ = yearToDate (s)
parseNodeDate (Month _) _ s _ = monthToDate (s)
parseNodeDate (Week _) _ s _ = weekToDate (s)
parseNodeDate (Day _) _ s _ = dayToDate (s)
parseNodeDate (Hour _) _ s _ = hourToDate (s)
parseNodeDate tu _ s _ = unsafeCrashWith $ "[parseNodeDate] s = " <> s <> " unsupported for time unit = " <> show tu
parsePos :: String -> Tuple.Tuple Number Number
parsePos = String.split (String.Pattern ",")
......
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