Xmas 2nd ed.

R/echarty.R

@@ -603,7 +603,7 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ...,
                        #"^(50|56|62|68|74|152|158)$")
     )))
     wt$x$opts$dataset <- append(wt$x$opts$dataset, tmp)
-    if (!is.null(wt$x$opts$series))
+    if ('series' %in% names(opt1))
       wt$x$opts$series[[1]]$datasetId= 'Xtalk'
   }
 
@@ -621,6 +621,7 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ...,
   # add missing defaults
   if (is.null(tl.series$type)) tl.series$type <- 'scatter'
 
+  steps <- c()
   tmp <- xyNamesCS(tl.series)
   xtem <- tmp$x; ytem <- tmp$y
   if (!is.null(tmp$c)) tl.series$coordinateSystem <- tmp$c
@@ -643,8 +644,9 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ...,
     di <- 0
     optl <- lapply(df |> group_split(), \(gp) {
       di <<- di+1
+      steps <<- c(steps, unique(unlist(lapply(gp[grnm], as.character))))
       series <- list(list(type= 'map', geoIndex= 1, datasetIndex= di +1))
-      tmp <- list(title= list(text= as.character(unique(gp[grnm]))),  
+      tmp <- list( #title= list(text= as.character(unique(gp[grnm]))),  
                   series= series)
       tmp <- .renumber(tmp)
     })
@@ -664,6 +666,7 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ...,
     di <- 0
     optl <- lapply(df |> group_split(), \(gp) {
       di <<- di+1
+      steps <<- c(steps, unique(unlist(lapply(gp[grnm], as.character))))
       # nicer looking lines with sorted X 
       #if (!is.null(xcol)) gp <- gp |> arrange(across(all_of(xcol)))
 
@@ -673,7 +676,7 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ...,
           append(list(datasetIndex= di +1), tl.series)  # , name= sname
       })
 
-      tmp <- list(title= list(text= unique(unlist(lapply(gp[grnm], as.character)))),
+      tmp <- list( #title= list(text= unique(unlist(lapply(gp[grnm], as.character)))),
                   series= unname(series))
       tmp <- .renumber(tmp)
     })
@@ -720,8 +723,13 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ...,
     wt$x$opts$legend <- .merlis(wt$x$opts$legend, list(show=TRUE))  # needed for sub-group
   }
 
-  steps <- lapply(optl, \(x) { paste(x$title$text, collapse=' ') })
-  wt$x$opts$timeline <- .merlis(wt$x$opts$timeline, list(data=steps, axisType='category'))
+  if ('timeline' %in% names(opt1)) {
+    if (is.null(opt1$timeline$data))
+       wt$x$opts$timeline <- .merlis(wt$x$opts$timeline, list(data= steps))
+    if (is.null(opt1$timeline$axisType))
+       wt$x$opts$timeline <- .merlis(wt$x$opts$timeline, list(axisType='category'))
+  } else
+    wt$x$opts$timeline <- .merlis(wt$x$opts$timeline, list(data=steps, axisType='category'))
 
   return(wt)
 }

tests/testthat/test-other.R

@@ -36,8 +36,8 @@ test_that("tl.series, timeline options, groupBy", {  # also in test-presets
     timeline= list(autoPlay=TRUE),
     tl.series= list(type='bar', encode=list(x='Tree', y='circumference'))
   ) |> ec.upd({
-    options <- lapply(options, 
-      function(o) { o$title$text <- paste('age',o$title$text,'days'); o })
+    options <- lapply(seq_along(options), 
+      function(i) { options[[i]]$title$text <- paste('age',timeline$data[[i]],'days'); options[[i]] })
   })
   expect_equal(p$x$opts$options[[5]]$title$text, "age 1231 days")
   expect_equal(p$x$opts$options[[5]]$series[[1]]$datasetIndex, 5)
@@ -53,9 +53,10 @@ test_that("tl.series, timeline options, groupBy", {  # also in test-presets
   )
   p <- dat |> group_by(x1) |> ec.init(
     tl.series= list(encode= list(x= 'x3', y= 'x5'), groupBy='x2',
-                    symbolSize= ec.clmn(4, scale=30)) 
+                    symbolSize= ec.clmn(4, scale=30)),
+    legend= list(s=T)
   )
-  expect_equal(p$x$opts$options[[4]]$title$text, '2023')
+  expect_equal(p$x$opts$options[[4]]$series[[2]]$name, 'B')
   expect_true(p$x$opts$dataset[[9]]$transform$config$and[[2]]$dimension=='x2')
 })
 
@@ -100,7 +101,7 @@ test_that("leaflet with ec.clmn and timeline", {
   expect_equal(p$x$opts$leaflet$zoom, 2)
   expect_s3_class(p$x$opts$tooltip$formatter, 'JS_EVAL')
   #expect_equal(p$dependencies[[9]]$name, 'echarts-leaflet')  # loads slow?
-  expect_equal(p$x$opts$options[[10]]$title$text, '19')
+  #expect_equal(p$x$opts$options[[10]]$title$text, '19')
   expect_equal(p$x$opts$options[[10]]$series[[1]]$name, 'quake')
   expect_true (p$x$opts$options[[10]]$legend$show)
   expect_equal(p$x$opts$options[[41]]$series[[1]]$coordinateSystem, 'leaflet')

tests/testthat/test-presets.R

@@ -48,6 +48,7 @@ test_that("ec.init presets for grouped data.frame", {
 })
 
 test_that("ec.init presets for timeline", {
+  # TODO 'timeline= list(data=,axisType=)'...
   dftl <- data.frame(
     value = runif(16),
     quarter = as.factor(rep(1:4, 4)),
@@ -56,15 +57,17 @@ test_that("ec.init presets for timeline", {
   barTL <- function(data, timeline_var) {  #}, x_var, bar_var) {
     bt <- data |> dplyr::group_by(!!dplyr::sym(timeline_var)) |> 
       ec.init(tl.series = list(type='bar'), #,encode=list(x=x_var, y=bar_var)),
-              xAxis= list(name='xval'))
+              xAxis= list(name='xval'),
+              timeline= list(s=T) # data= c(1,2,3,4), axisType='value') #ok
+      )
     bt
   }
   p <- barTL(dftl, timeline_var= "year") #, x_var= "value", bar_var= "quarter")
   o <- p$x$opts
   expect_equal(length(o$dataset[[1]]$source), 17)
   expect_equal(length(o$dataset), 5)
   expect_equal(length(o$options), 4)
-  expect_equal(o$options[[4]]$title$text, '2021')
+  expect_equal(o$timeline$axisType, 'category')
   expect_equal(o$yAxis$name, 'quarter')
   expect_equal(o$xAxis$name, 'xval')
   expect_equal(o$options[[1]]$series[[1]]$encode, list(x=0, y=1, z=2))