1.6.6

helgasoft · Jan 15, 2025 · 34ab93f · 34ab93f
1 parent 781c8dd
commit 34ab93f
Show file tree

Hide file tree

Showing 15 changed files with 391 additions and 317 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: echarty
 Title: Minimal R/Shiny Interface to JavaScript Library 'ECharts'
-Date: 2024-12-29
-Version: 1.6.5
+Date: 2025-01-15
+Version: 1.6.6
 Authors@R: c(
   person(given= "Larry", family= "Helgason", role= c("aut", "cre"), email= "[email protected]", comment="initial code from John Coene's library echarts4r")
   )

diff --git a/NEWS.md b/NEWS.md
@@ -1,6 +1,10 @@
 # history of package _echarty_
 
-# echarty 1.6.5  latest in development
+# echarty 1.6.6  latest in development
+
+* more tests to increase coverage without disturbing CRAN submission
+
+# echarty 1.6.5  on CRAN
 
 * upgrade ECharts to v.5.6.0, built with R v.4.4.2.
 * auto-load 3D plugin when 3D attributes present (xAxis3D, bar3D, etc.).
@@ -12,7 +16,7 @@
 * integrate website with library using _pkgdown_.
 * moved _examples.R_ into 'demo' folder, _ec.examples_ is no longer a command.
 
-# echarty 1.6.4  on CRAN
+# echarty 1.6.4
 
 * upgrade ECharts to v.5.5.0, built with R v.4.4.0.
 * add _nasep_ parameter to _ec.data('names')_ to easily set nested lists from a _data.frame_.

diff --git a/R/echarty.R b/R/echarty.R
@@ -274,8 +274,8 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ...,
         is.null(vm$min) && is.null(vm$max) && is.null(vm$categories) &&
         (is.null(vm$type) || (vm$type == 'continuous')) ) {
 
-        xx <- length(colnames(df))   # last numeric column by default
-        for(xx in xx:1) if (is.numeric(df[,xx])) break
+        xx <- length(colnames(df))   # last numeric column (by default)
+        for(xx in xx:1) if (is.numeric(unlist(df[,xx]))) break  # unlist for group_by
         if (any(names(df) == 'value') && (
           (!is.null(tl.series) && tl.series$type=='map') ||
           (!is.null(series.param) && series.param$type=='map'))
@@ -659,7 +659,7 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ...,
   tmp <- xyNamesCS(tl.series)
   xtem <- tmp$x; ytem <- tmp$y
   if (!is.null(tmp$c)) tl.series$coordinateSystem <- tmp$c
-  #if (dbg) cat('\ntl=',tmp$x,' ',tmp$y,' ',tmp$c)
+  if (dbg) cat('\ntimeline: x=',xtem,' y=',ytem,' cs=',tmp$c)
 
   if (any(c('geo','leaflet') %in% tl.series$coordinateSystem)) {
       klo <- 'lng'; kla <- 'lat'
@@ -693,15 +693,9 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ...,
     })
   } 
   else {
-    if (is.null(unlist(tl.series$encode[xtem]))) {
-      # append col XcolX 1:max for each group
-      df <- df |> group_modify(~ { .x |> mutate(XcolX = 1:nrow(.)) })
-      tl.series$encode[xtem] <- 'XcolX'    # instead of relocate(XcolX)
-      # replace only source, transforms stay
-      wt$x$opts$dataset[[1]] <- list(source= ec.data(df, header=TRUE))
-    }
-    stopifnot("timeline: bad second parameter name for encode"= !is.null(unlist(tl.series$encode[ytem])))
-
+    if (is.null(tl.series$encode[[xtem]]) || is.null(tl.series$encode[[ytem]]))
+      stop(paste0('for ',tl.series$type,' use encode=list(',xtem,'=..., ',ytem,'=...)'), call.=FALSE)
+
     # dataset is already in, now loop group column(s)
     #gvar <- df |> group_vars() |> first() |> as.character()  # convert if factor
     di <- 0
@@ -1114,12 +1108,12 @@ ecs.render <- function(wt, env=parent.frame(), quoted= FALSE) {
 #' @export
 ecs.proxy <- function(id) {
   sessi <- globalenv()
-  if (interactive()) {
+  #if (interactive()) {
     if (requireNamespace("shiny", quietly = TRUE)) {
       sessi <- shiny::getDefaultReactiveDomain()
     } else 
       return(invisible(NULL))
-  }
+  #}
   proxy <- list(id= id, session= sessi)
   class(proxy) <- 'ecsProxy'
   return(proxy)
@@ -1164,13 +1158,13 @@ ecs.exec <- function(proxy, cmd= 'p_merge') {
 
   # create web dependencies for JS, if present
   if (!is.null(proxy$dependencies)) {
-    if (interactive()) {
+    #if (interactive()) {
       if (requireNamespace("shiny", quietly = TRUE)) {
         plist$deps <- list(shiny::createWebDependency(
           htmltools::resolveDependencies( proxy$dependencies )[[1]]
         ))
       }
-    }
+    #}
   }
   if (!is.null(proxy$session))
     proxy$session$sendCustomMessage('kahuna', plist)
@@ -1256,9 +1250,7 @@ ec.plugjs <- function(wt=NULL, source=NULL, ask=FALSE) {
 }
 
 # called by widget init
-# .preRender <- function(wt) {
-#   wt
-# }
+# .preRender <- function(wt) { wt }
 
 # convert from R to JS numbering
 .renumber <- function(opa) {

diff --git a/R/util.R b/R/util.R
diff --git a/README.md b/README.md
@@ -4,10 +4,10 @@
 <!-- badges: start -->
 
 [![R-CMD-check](https://github.com/helgasoft/echarty/workflows/R-CMD-check/badge.svg)](https://github.com/helgasoft/echarty/actions)
-[![coverage](https://coveralls.io/repos/github/helgasoft/echarty/badge.svg)](https://coveralls.io/r/helgasoft/echarty?branch=main)
+[![coverage](https://coveralls.io/repos/github/helgasoft/echarty/badge.svg)](https://coveralls.io/github/helgasoft/echarty)
 [![size](https://img.shields.io/github/languages/code-size/helgasoft/echarty)](https://github.com/helgasoft/echarty/releases/)
 [![website](https://img.shields.io/badge/Website-Visit-blue)](https://helgasoft.github.io/echarty)
-[![twitter](https://img.shields.io/twitter/follow/echarty.svg?style=social&label=Follow)](https://twitter.com/echarty_R)
+[![twitter](https://img.shields.io/twitter/follow/echarty.svg?style=social&label=Follow)](https://x.com/echarty_R)
 
 <!--
 [![CRAN
@@ -54,7 +54,7 @@ Please consider granting a Github star ⭐ to show your support.
 ## Installation
 
 <!-- [![Github version](https://img.shields.io/github/v/release/helgasoft/echarty?label=github)](https://github.com/helgasoft/echarty/releases)  <sup>.02</sup>  -->
-Latest development build **1.6.5**
+Latest development build **1.6.6**
 
 ``` r
 if (!requireNamespace('remotes')) install.packages('remotes')

diff --git a/demo/examples.R b/demo/examples.R
@@ -98,38 +98,36 @@
 #'                     color = c("#387e78","#eeb422","#d9534f",'magenta'))
 #'   tmp <- head(flights,10) |> inner_join(tmp)    # add color by airport
 #'   ec.init(load= 'world',
-#'     geo= list(center= c(mean(flights$start_lon), mean(flights$start_lat)), 
-#'   	   		 zoom= 7, map='world' ),
-#'     series= list(list(
-#'       type= 'lines', coordinateSystem= 'geo',
+#'    geo= list(center= c(mean(flights$start_lon), mean(flights$start_lat)), zoom=7, map='world'),
+#'    series.param= list( type= 'lines',
 #'       data= lapply(ec.data(tmp, 'names'), function(x)
-#'         list(coords = list(c(x$start_lon,x$start_lat),
-#'                            c(x$end_lon,x$end_lat)),
+#'         list(coords = list(c(x$start_lon, x$start_lat),
+#'                            c(x$end_lon, x$end_lat)),
 #'              colr = x$color)
 #'       ),
 #'       lineStyle= list(curveness=0.3, width=3, color=ec.clmn('colr'))
-#'     ))
+#'     )
 #'   )
 #' } }
 #' 
 #' #------ registerMap JSON
 #' # registerMap supports also maps in SVG format, see website gallery
-#' #if (interactive()) {
-#'  json <- jsonlite::read_json("https://echarts.apache.org/examples/data/asset/geo/USA.json")
-#'  dusa <- USArrests
-#'  dusa$states <- row.names(dusa)
-#'  p <- ec.init(preset= FALSE,
-#'    series= list(list(type= 'map', map= 'USA', roam= TRUE, zoom= 3, left= -100, top= -30,
-#'        data= lapply(ec.data(dusa, 'names'), 
-#'            function(x) list(name=x$states, value=x$UrbanPop))
-#'    )),
-#'    visualMap= list(type='continuous', calculable=TRUE, 
-#'        inRange= list(color = rainbow(8)),
-#'        min= min(dusa$UrbanPop), max= max(dusa$UrbanPop))
-#'  )
-#'  p$x$registerMap <- list(list(mapName= 'USA', geoJSON= json))
-#'  p
-#' #}
+#' if (interactive()) {
+#' json <- jsonlite::read_json("https://echarts.apache.org/examples/data/asset/geo/USA.json")
+#' dusa <- USArrests
+#' dusa$states <- row.names(dusa)
+#' p <- ec.init(
+#'   series.param= list(type= 'map', map= 'USA', roam= TRUE, zoom= 3, left= -100, top= -30,
+#'     data= lapply(ec.data(dusa, 'names'),
+#'         function(x) list(name=x$states, value=x$UrbanPop))
+#'   ),
+#'   visualMap= list(type='continuous', calculable=TRUE,
+#'     inRange= list(color = rainbow(8)),
+#'     min= min(dusa$UrbanPop), max= max(dusa$UrbanPop))
+#' )
+#' p$x$registerMap <- list(list(mapName= 'USA', geoJSON= json))
+#' p
+#' }
 #'
 #' #------ locale
 #' mo <- seq.Date(Sys.Date() - 444, Sys.Date(), by= "month")
@@ -199,12 +197,12 @@
 #' if (interactive()) {
 #' iris |> group_by(Species) |>
 #'   mutate(size= log(Petal.Width*10)) |>  # add size as 6th column
-#'   ec.init(load= '3D',
-#'           xAxis3D= list(name= 'Petal.Length'),
-#'           yAxis3D= list(name= 'Sepal.Width'),
-#'           zAxis3D= list(name= 'Sepal.Length'),
-#'           legend= list(show= TRUE),
-#'     series.param= list(symbolSize= ec.clmn(6, scale=10))
+#'   ec.init(
+#'      xAxis3D= list(name= 'Petal.Length'),
+#'      yAxis3D= list(name= 'Sepal.Width'),
+#'      zAxis3D= list(name= 'Sepal.Length'),
+#'      legend= list(show= TRUE),
+#'      series.param= list(type='scatter3D', symbolSize= ec.clmn(6, scale=10))
 #'   )
 #' }
 #'

diff --git a/man/ec.data.Rd b/man/ec.data.Rd
diff --git a/man/ec.fromJson.Rd b/man/ec.fromJson.Rd
diff --git a/man/ec.inspect.Rd b/man/ec.inspect.Rd