updated test-coverage github action

.github/workflows/test-coverage.yaml

@@ -1,48 +1,50 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
 on:
   push:
-    branches:
+    branches: [main, master]
-      - main
-      - master
   pull_request:
-    branches:
+    branches: [main, master]
-      - main
-      - master
 
 name: test-coverage
 
 jobs:
   test-coverage:
-    runs-on: macOS-latest
+    runs-on: ubuntu-latest
     env:
       GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v3
 
-      - uses: r-lib/actions/setup-r@v1
+      - uses: r-lib/actions/setup-r@v2
-
-      - uses: r-lib/actions/setup-pandoc@v1
-
-      - name: Query dependencies
-        run: |
-          install.packages('remotes')
-          saveRDS(remotes::dev_package_deps(dependencies = TRUE), ".github/depends.Rds", version = 2)
-          writeLines(sprintf("R-%i.%i", getRversion()$major, getRversion()$minor), ".github/R-version")
-        shell: Rscript {0}
-
-      - name: Cache R packages
-        uses: actions/cache@v2
         with:
-          path: ${{ env.R_LIBS_USER }}
+          use-public-rspm: true
-          key: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-${{ hashFiles('.github/depends.Rds') }}
-          restore-keys: ${{ runner.os }}-${{ hashFiles('.github/R-version') }}-1-
 
-      - name: Install dependencies
+      - uses: r-lib/actions/setup-r-dependencies@v2
-        run: |
+        with:
-          install.packages(c("remotes"))
+          extra-packages: any::covr
-          remotes::install_deps(dependencies = TRUE)
+          needs: coverage
-          remotes::install_cran("covr")
-        shell: Rscript {0}
 
       - name: Test coverage
-        run: covr::codecov()
+        run: |
+          covr::codecov(
+            quiet = FALSE,
+            clean = FALSE,
+            install_path = file.path(Sys.getenv("RUNNER_TEMP"), "package")
+          )
         shell: Rscript {0}
+
+      - name: Show testthat output
+        if: always()
+        run: |
+          ## --------------------------------------------------------------------
+          find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true
+        shell: bash
+
+      - name: Upload test results
+        if: failure()
+        uses: actions/upload-artifact@v3
+        with:
+          name: coverage-test-failures
+          path: ${{ runner.temp }}/package

R/apex.R

@@ -14,7 +14,7 @@
 #'  `"pie"`, `"donut"`,
 #'  `"radialBar"`, `"radar"`, `"scatter"`,
 #'  `"heatmap"`, `"treemap"`,
-#'  `"timeline"`.
+#'  `"timeline"` and `"dumbbell"`.
 #' @param ... Other arguments passed on to methods. Not currently used.
 #' @param synchronize Give a common id to charts to synchronize them (tooltip and zoom).
 #' @param serie_name Name for the serie displayed in tooltip,
@@ -43,6 +43,7 @@ apex <- function(data, mapping,
     arg = type,
     choices = c(
       "column", "bar",
+      "rangeBar", "dumbbell",
       "line", "spline", "step",
       "area", "area-spline", "area-step",
       "rangeArea",
@@ -68,7 +69,8 @@ apex <- function(data, mapping,
     type <- "bubble"
   }
   mapdata <- lapply(mapping, rlang::eval_tidy, data = data)
-  if (is.null(mapdata$y) & !type %in% c("candlestick", "boxplot", "timeline", "heatmap", "rangeArea")) {
+  type_no_compute <- c("candlestick", "boxplot", "timeline", "heatmap", "rangeArea", "rangeBar", "dumbbell")
+  if (is.null(mapdata$y) & !type %in% type_no_compute) {
     mapdata <- compute_count(mapdata)
   }
   if (type %in% c("pie", "donut", "radialBar", "polarArea")) {
@@ -134,6 +136,12 @@ make_series <- function(mapdata, mapping, type = NULL, serie_name = NULL, force_
     if (is.null(mapdata$group))
       mapdata$group <- serie_name %||% rlang::as_label(mapping$x)
     series <- parse_timeline_data(mapdata)
+  } else if (isTRUE(type %in% c("dumbbell"))) {
+    if (!all(c("y", "x", "xend") %in% names(mapping)))
+      stop("For dumbbell charts 'x', 'xend', and 'y' aesthetics must be provided.", call. = FALSE)
+    if (is.null(mapdata$group))
+      mapdata$group <- serie_name %||% rlang::as_label(mapping$x)
+    series <- parse_dumbbell_data(mapdata)
   } else {
     mapdata <- as.data.frame(mapdata, stringsAsFactors = FALSE)
     if (all(rlang::has_name(mapdata, c("ymin", "ymax")))) {
@@ -245,13 +253,13 @@ list1 <- function(x) {
 
 # Change type of charts for helpers type
 correct_type <- function(type) {
-  if (identical(type, "column")) {
+  if (isTRUE(type %in% c("column"))) {
     "bar"
   } else if (isTRUE(type %in% c("spline", "step"))) {
     "line"
   } else if (isTRUE(type %in% c("area-spline", "area-step"))) {
     "area"
-  } else if (identical(type, "timeline")) {
+  } else if (isTRUE(type %in% c("timeline", "dumbbell"))) {
     "rangeBar"
   } else if (identical(type, "boxplot")) {
     "boxPlot"
@@ -319,6 +327,7 @@ choose_config <- function(type, mapdata) {
   switch(
     type,
     "bar" = config_bar(horizontal = TRUE),
+    "dumbbell" = config_bar(horizontal = TRUE, isDumbbell = TRUE),
     "column" = config_bar(horizontal = FALSE, datetime = datetime),
     "line" = config_line(datetime = datetime),
     "area" = config_line(datetime = datetime),
@@ -338,12 +347,13 @@ choose_config <- function(type, mapdata) {
 
 
 # Config for column & bar charts
-config_bar <- function(horizontal = FALSE, datetime = FALSE) {
+config_bar <- function(horizontal = FALSE, datetime = FALSE, isDumbbell = FALSE) {
   config <- list(
     dataLabels = list(enabled = FALSE),
     plotOptions = list(
       bar = list(
-        horizontal = horizontal
+        horizontal = horizontal,
+        isDumbbell = isDumbbell
       )
     ),
     tooltip = list(

R/parse-data.R

@@ -110,6 +110,44 @@ parse_timeline_data <- function(.list) {
 }
 
 
+parse_dumbbell_data <- function(.list) {
+  if (is.null(.list$group)) {
+    lapply(
+      X = seq_len(length(.list[[1]])),
+      FUN = function(i) {
+        val <- lapply(.list, `[[`, i)
+        l <- list(
+          x = as.character(val$y),
+          y = list(val$x, val$xend)
+        )
+        if (!is.null(val$fill)) {
+          l$fillColor <- val$fill
+        }
+        l
+      }
+    )
+  } else {
+    grouped <- as.data.frame(.list, stringsAsFactors = FALSE)
+    grouped$group <- NULL
+    grouped <- split(
+      x = grouped,
+      f = .list$group
+    )
+    grouped <- lapply(grouped, as.list)
+    lapply(
+      X = names(grouped),
+      FUN = function(name) {
+        list(
+          name = name,
+          data = parse_dumbbell_data(grouped[[name]])
+        )
+      }
+    )
+  }
+}
+
+
+
 parse_candlestick_data <- function(.list) {
   list(list(
     type = "candlestick",