CanvasXpress Version 51.8

R/canvasXpress.R

@@ -63,7 +63,7 @@ canvasXpress <- function(data        = NULL,
 
     config <- list(graphType = graphType, isR = TRUE, ...)
 
-    if (is.null(data) || !(any(c("canvasXpress", "ggplot") %in% class(data)))) {
+    if (is.null(data) || !(any(c("canvasXpress", "ggplot", "ggsurvplot") %in% class(data)))) {
         assertDataCorrectness(data, graphType, config)
     }
 
@@ -140,6 +140,19 @@ canvasXpress <- function(data        = NULL,
             stop("The ggplot2 package is required to use this functionality.")
         }
         cx_object <- ggplot.as.list(data, ...)
+    } else if (!is.null(data) && ("ggsurvplot" %in% class(data))) {
+        if (!(requireNamespace("ggplot2", quietly = TRUE))) {
+            stop("The ggplot2 package is required to use this functionality.")
+        }
+        if (!(requireNamespace("survminer", quietly = TRUE))) {
+            stop("The survminer package is required to use this functionality.")
+        }
+        if (is.null(data$table)) {
+            tab <- FALSE
+        } else {
+            tab <- TRUE
+        }
+        cx_object <- ggplot.as.list(data$plot, kmCxplot = TRUE, kmRiskTable = tab, showKMConfidenceIntervals = data$plot$plot_env$conf.int, ...)
     } else if (is.character(data) && (graphType != "Network")) {
         if (httr::http_error(data)) {
             message("Unable to validate URL")

R/ggplot_as_list.R

@@ -129,6 +129,17 @@ gg_cxplot <- function(o, target, ...) {
         p$size <- bld$data[[i]]$size
         p$shape <- bld$data[[i]]$shape
       }
+    } else if (l == "GeomStep") {
+      if (("kmCxplot") %in% names(config)) {
+        p$kmCxplot <- TRUE
+        p$showKMConfidenceIntervals <- config$showKMConfidenceIntervals
+        p$kmRiskTable <- config$kmRiskTable
+        p$kmColors <- unique(p$data$color)
+        within(cx$config, rm(kmCxplot))
+        within(cx$config, rm(showKMConfidenceIntervals))
+        within(cx$config, rm(kmRiskTable))
+        within(p, rm(data))
+      }
     } else if (l == "GeomDensityRidges") {
       p$bandwidthAdjust <- bld$data[[i]]$x[2] - bld$data[[i]]$x[1]
     } else if (l == "GeomRect" || l == "GeomTile") {
@@ -170,6 +181,8 @@ gg_cxplot <- function(o, target, ...) {
 gg_default_aes <- function(geom_name) {
   if (geom_name == "GeomPwc" || geom_name == "GeomBracket") {
     namesp <- asNamespace("ggpubr")
+  } else if (geom_name == "GeomConfint") {
+    namesp <- asNamespace("survminer")
   } else {
     namesp <- asNamespace("ggplot2")
   }
@@ -518,16 +531,18 @@ gg_labels <- function(o) {
     o <- ggplot2::last_plot()
   }
   r <- list()
-  l <- c("x", "y", "z", "title", "subtitle", "caption", "colour", "shape", "size")
+  l <- c("x", "y", "z", "title", "subtitle", "caption", "colour", "fill", "shape", "size")
   for (i in l) {
     if (!is.null(o$labels[[i]])) {
       if (i %in% c("title", "subtitle")) {
         r[[i]] <- as.character(o$labels[[i]])
       } else if (i == "caption") {
         r["citation"] <- as.character(o$labels[[i]])
-      } else if (i %in% c("colour", "shape", "size")) {
-        if (i == "colour") {
-          r["colorLegendTitle"] <- as.character(o$labels[[i]])
+      } else if (i %in% c("colour", "fill", "shape", "size")) {
+        if (i == "colour" || i == "fill") {
+          if (class(o$labels[[i]])[1] != "element_blank") {
+            r["colorLegendTitle"] <- as.character(o$labels[[i]])
+          }
         } else {
           r[[paste(i, "LegendTitle", sep = "")]] <- as.character(o$labels[[i]])
         }

R/internal_functionality.R

@@ -1,8 +1,13 @@
 assertDataCorrectness <- function(data, graphType, config) {
 
     # skip all data validation in the following scenarios:
-    if (!is.null(data) && "ggplot" %in% class(data)) {
-        return()
+    if (!is.null(data)) {
+        if ("ggplot" %in% class(data)) {
+            return()
+        }
+        if ("ggsurvplot" %in% class(data)) {
+            return()
+        }
     }
 
     # proceed with validation

inst/htmlwidgets/canvasXpress.js

@@ -114,10 +114,10 @@ HTMLWidgets.widget({
       },
 
       transpose(matrix) {
-        return matrix[0].map(function(col, i) { 
-          return matrix.map(function(row) { 
-            return row[i]; 
-          }) 
+        return matrix[0].map(function(col, i) {
+          return matrix.map(function(row) {
+            return row[i];
+          })
         })
       },