Fix factors crash in tm_g_association (#692)

Closes #645 Changes: Pass the base class into `bivariate_plot_call` because we only expect the base class in the downstream function call.
insightsengineering · Feb 28, 2024 · 8f0b3ef · 8f0b3ef
1 parent c9f87bf
commit 8f0b3ef
Show file tree

Hide file tree

Showing 2 changed files with 25 additions and 20 deletions.
diff --git a/R/tm_g_association.R b/R/tm_g_association.R
@@ -336,7 +336,7 @@ srv_tm_g_association <- function(id,
       teal::validate_has_data(ANL[, c(ref_name, vars_names)], 3, complete = TRUE, allow_inf = FALSE)
 
       # reference
-      ref_class <- class(ANL[[ref_name]])
+      ref_class <- class(ANL[[ref_name]])[1]
       if (is.numeric(ANL[[ref_name]]) && log_transformation) {
         # works for both integers and doubles
         ref_cl_name <- call("log", as.name(ref_name))
@@ -373,7 +373,7 @@ srv_tm_g_association <- function(id,
       print_call <- quote(print(p))
 
       var_calls <- lapply(vars_names, function(var_i) {
-        var_class <- class(ANL[[var_i]])
+        var_class <- class(ANL[[var_i]])[1]
         if (is.numeric(ANL[[var_i]]) && log_transformation) {
           # works for both integers and doubles
           var_cl_name <- call("log", as.name(var_i))

diff --git a/R/tm_g_bivariate.R b/R/tm_g_bivariate.R
@@ -733,7 +733,7 @@ bivariate_plot_call <- function(data_name,
                                 alpha = double(0),
                                 size = 2,
                                 ggplot2_args = teal.widgets::ggplot2_args()) {
-  supported_types <- c("NULL", "numeric", "integer", "factor", "character", "logical")
+  supported_types <- c("NULL", "numeric", "integer", "factor", "character", "logical", "ordered")
   validate(need(x_class %in% supported_types, paste0("Data type '", x_class, "' is not supported.")))
   validate(need(y_class %in% supported_types, paste0("Data type '", y_class, "' is not supported.")))
 
@@ -797,8 +797,8 @@ substitute_q <- function(x, env) {
 #' bivariate_ggplot_call("numeric", "factor")
 #' bivariate_ggplot_call("factor", "numeric")
 #' bivariate_ggplot_call("factor", "factor")
-bivariate_ggplot_call <- function(x_class = c("NULL", "numeric", "integer", "factor", "character", "logical"),
-                                  y_class = c("NULL", "numeric", "integer", "factor", "character", "logical"),
+bivariate_ggplot_call <- function(x_class,
+                                  y_class,
                                   freq = TRUE,
                                   theme = "gray",
                                   rotate_xaxis_labels = FALSE,
@@ -811,21 +811,26 @@ bivariate_ggplot_call <- function(x_class = c("NULL", "numeric", "integer", "fac
                                   ylab = "-",
                                   data_name = "ANL",
                                   ggplot2_args = teal.widgets::ggplot2_args()) {
-  x_class <- match.arg(x_class)
-  y_class <- match.arg(y_class)
-
-  if (x_class %in% c("character", "logical")) {
-    x_class <- "factor"
-  }
-  if (x_class %in% c("integer")) {
-    x_class <- "numeric"
-  }
-  if (y_class %in% c("character", "logical")) {
-    y_class <- "factor"
-  }
-  if (y_class %in% c("integer")) {
-    y_class <- "numeric"
-  }
+  x_class <- switch(x_class,
+    "character" = ,
+    "ordered" = ,
+    "logical" = ,
+    "factor" = "factor",
+    "integer" = ,
+    "numeric" = "numeric",
+    "NULL" = "NULL",
+    stop("unsupported x_class: ", x_class)
+  )
+  y_class <- switch(y_class,
+    "character" = ,
+    "ordered" = ,
+    "logical" = ,
+    "factor" = "factor",
+    "integer" = ,
+    "numeric" = "numeric",
+    "NULL" = "NULL",
+    stop("unsupported y_class: ", y_class)
+  )
 
   if (all(c(x_class, y_class) == "NULL")) {
     stop("either x or y is required")