From 30be7d623aebea6daa32b49545642d9ec01fa398 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 20 Nov 2025 15:18:13 +0000 Subject: [PATCH 01/16] fix: use full url to avoid warning --- R/tm_file_viewer.R | 2 +- man/tm_file_viewer.Rd | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/tm_file_viewer.R b/R/tm_file_viewer.R index ba1f061d7..ffa1f7b18 100644 --- a/R/tm_file_viewer.R +++ b/R/tm_file_viewer.R @@ -31,7 +31,7 @@ #' folder = system.file("sample_files", package = "teal.modules.general"), #' png = system.file("sample_files/sample_file.png", package = "teal.modules.general"), #' txt = system.file("sample_files/sample_file.txt", package = "teal.modules.general"), -#' url = "https://fda.gov/files/drugs/published/Portable-Document-Format-Specifications.pdf" +#' url = "https://www.fda.gov/files/drugs/published/Portable-Document-Format-Specifications.pdf" #' ) #' ) #' ) diff --git a/man/tm_file_viewer.Rd b/man/tm_file_viewer.Rd index a1617b9db..245a5fbeb 100644 --- a/man/tm_file_viewer.Rd +++ b/man/tm_file_viewer.Rd @@ -40,7 +40,7 @@ app <- init( folder = system.file("sample_files", package = "teal.modules.general"), png = system.file("sample_files/sample_file.png", package = "teal.modules.general"), txt = system.file("sample_files/sample_file.txt", package = "teal.modules.general"), - url = "https://fda.gov/files/drugs/published/Portable-Document-Format-Specifications.pdf" + url = "https://www.fda.gov/files/drugs/published/Portable-Document-Format-Specifications.pdf" ) ) ) @@ -53,8 +53,8 @@ if (interactive()) { \section{Examples in Shinylive}{ \describe{ \item{example-1}{ - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqX8opKAeNdqAfQ8vG3dPbyNdAHdaUgALFXYgqFxdECVdXSSfTLCME2Z4dgBGRQgAX1KlNFRslRj2dJyvXQBeJuTGviERUVbdLuExBogMjNIYfxNaEX8tWjhImWHR0ZVUQVJ-VE9YvrpRUmWV0ZMian4ZPtFWA7gYPOm4BrBRWFQZqZ6FPF1tggBrKBSPrfPy8ASDcRSCBqajfOS4RrHX4QCRXG7ke6fJ7fV4wd5wSaPUQAejxBKJIgwqFR3xSf0BwLaoLg3HB3TEkmksnhiJGyN0pAAHqR0bcsY9nuSPsSyW8ZVThaQ6b91Iy9MywGCBj0uTCeWAEUjjoJGNQQWBYqRSKhRIgSSSTB5JEQtI7ZfxGIIJKT1vR9rE4PwSQAFIiMLz+uCGAAiRAIgngZEMADFwzBPIYAMqoOAEWhTAieKwQcSofgmb7GjKlFa13SlUoF3TsFTkZiWHQ2WxpfmieIQVgAQXQ7GqABJBLQUhPRDIdIxSmUlGAygBdIA}{Open in Shinylive} - \if{html}{\out{}} + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqX8opKAeNdqAfQ8vG3dPbyNdAHdaUgALFXYgqFxdECVdXSSfTLCME2Z4dgBGRQgAX1KlNFRslRj2dJyvXQBeJuTGviERUVbdLuExBogMjNIYfxNaEX8tWjhImWHR0ZVUQVJ-VE9YvrpRUmWV0ZMian4ZPtFWA7gYPOm4BrBRWFQZqZ6FPF1tggBrKBSPrfPy8ASDcRSCBqajfOS4RrHX4QCRXG7ke6fJ7fV4wd5wSaPUQAejxBKJIgwqFR3xSf0BwLaoLg3HB3TEkmksnhiJGyN0pAAHqR0bcsY9nuSPsSyW8ZVThaQ6b91Iy9MywGCBj0uTCeWAEUjjoJGNQQWBYqRSKhRIgSSTIk68h5JEQtCTsaT+IxBBJSet6PtYnB+CSAApERheINwQwAESIBEE8DIhgAYlGYJ5DABlVBwAi0KYETxWCDiVD8EzfY0ZUorBu6UqlYu6dgqcjMSw6Gy2NL80TxCCsACC6HY1QAJIJaClp6IZDpGKUykowGUALpAA}{Open in Shinylive} + \if{html}{\out{}} \if{html}{\out{}} } } From eef765fe4570165e8b21e1277ea5a5ad1de16d4d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 20 Nov 2025 15:27:54 +0000 Subject: [PATCH 02/16] fix: adds dplyr to support pipe operator usage --- R/tm_variable_browser.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/tm_variable_browser.R b/R/tm_variable_browser.R index a7b304e77..232731ccb 100644 --- a/R/tm_variable_browser.R +++ b/R/tm_variable_browser.R @@ -886,7 +886,7 @@ get_plotted_data <- function(input, plot_var, data) { teal.reporter::teal_card(obj), teal.reporter::teal_card("## Module's output(s)") ) - teal.code::eval_code(obj, "library(ggplot2)") |> + teal.code::eval_code(obj, "library(ggplot2)\nlibrary(dplyr)") |> within( { ANL <- dplyr::select(dataset_name, varname) From 285b97974303d68d1ccb8db9fa48482942f2b60b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 20 Nov 2025 16:54:39 +0000 Subject: [PATCH 03/16] fix: examples in tm_g_association --- R/tm_g_association.R | 16 +++++++--------- man/tm_g_association.Rd | 24 +++++++++++------------- 2 files changed, 18 insertions(+), 22 deletions(-) diff --git a/R/tm_g_association.R b/R/tm_g_association.R index 8516efc9b..172737dee 100644 --- a/R/tm_g_association.R +++ b/R/tm_g_association.R @@ -60,8 +60,6 @@ #' data <- within(data, { #' require(nestcolor) #' CO2 <- CO2 -#' factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L)))) -#' CO2[factors] <- lapply(CO2[factors], as.character) #' }) #' #' app <- init( @@ -72,8 +70,8 @@ #' dataname = "CO2", #' select = select_spec( #' label = "Select variable:", -#' choices = variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment")), -#' selected = "Plant", +#' choices = variable_choices(data[["CO2"]], c("conc", "uptake")), +#' selected = "conc", #' fixed = FALSE #' ) #' ), @@ -81,8 +79,8 @@ #' dataname = "CO2", #' select = select_spec( #' label = "Select variables:", -#' choices = variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment")), -#' selected = "Treatment", +#' choices = variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment", "conc", "uptake")), +#' selected = "uptake", #' multiple = TRUE, #' fixed = FALSE #' ) @@ -117,9 +115,9 @@ #' label = "Select variable:", #' choices = variable_choices( #' data[["ADSL"]], -#' c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2") +#' c("AGE", "BMRKR1", "LDDTHELD") #' ), -#' selected = "RACE", +#' selected = "AGE", #' fixed = FALSE #' ) #' ), @@ -129,7 +127,7 @@ #' label = "Select variables:", #' choices = variable_choices( #' data[["ADSL"]], -#' c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2") +#' c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2", "AGE", "BMRKR1", "LDDTHELD") #' ), #' selected = "BMRKR2", #' multiple = TRUE, diff --git a/man/tm_g_association.Rd b/man/tm_g_association.Rd index 86ae13618..29a872d33 100644 --- a/man/tm_g_association.Rd +++ b/man/tm_g_association.Rd @@ -129,8 +129,6 @@ data <- teal_data() data <- within(data, { require(nestcolor) CO2 <- CO2 - factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L)))) - CO2[factors] <- lapply(CO2[factors], as.character) }) app <- init( @@ -141,8 +139,8 @@ app <- init( dataname = "CO2", select = select_spec( label = "Select variable:", - choices = variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment")), - selected = "Plant", + choices = variable_choices(data[["CO2"]], c("conc", "uptake")), + selected = "conc", fixed = FALSE ) ), @@ -150,8 +148,8 @@ app <- init( dataname = "CO2", select = select_spec( label = "Select variables:", - choices = variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment")), - selected = "Treatment", + choices = variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment", "conc", "uptake")), + selected = "uptake", multiple = TRUE, fixed = FALSE ) @@ -181,9 +179,9 @@ app <- init( label = "Select variable:", choices = variable_choices( data[["ADSL"]], - c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2") + c("AGE", "BMRKR1", "LDDTHELD") ), - selected = "RACE", + selected = "AGE", fixed = FALSE ) ), @@ -193,7 +191,7 @@ app <- init( label = "Select variables:", choices = variable_choices( data[["ADSL"]], - c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2") + c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2", "AGE", "BMRKR1", "LDDTHELD") ), selected = "BMRKR2", multiple = TRUE, @@ -211,13 +209,13 @@ if (interactive()) { \section{Examples in Shinylive}{ \describe{ \item{example-1}{ - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQlQDCAPIATHG6-QMVpuqkHaLD0PCi7ABitNTkjOy0og4upVpokRyjpZsYJpMdpe0StATc7ACMADJyL129g8BnGtMAusPU+2ohw+XymjFEP1KUHEBHyLEmMi6AF8ukp9sMVHl2OMUroALz+DK4cZ8IQiGYE0nCMTY7qVXSkGCJCSJaGiIgEWiBKwQWn0+nVEz4wlBRJhUjMDSJUSoOAEPn8+kpOZ6AkKMCjdXEumK3SiOAiDTC-WG0jS2Xy8a6yoA+gG4XqgDKBrlpF0e0YXPoIkQWqt1thRBuYmFHq9IkSgeDCxSwGA6s1YB+kN0lrAAAUAWQtbp1XZWLKc3nqoF4NmwC9tdb6SbXXB+A6M1nSH6ddaTLRQvXhYsAIKPR2uNv8t6KuRVxUeikiqBi0ISybmuUK3XK2Cq3Mawat6u1o0EvdmmXL-26232tVgZ2m90scNiX14U+KqMEEMEsNQb1wSP5INvmMMjjBNtyTFM00zKBy1KPMCzgIswDsEtGQoFsK3HZ9+UPbtLyQuBS1Qndq10GBhE0SIN22ZwJ2rDsuwbAk+wHIdq1HEd-VHLouloIUNlUSVNB0GxbHKOlREKCBWF7dB2H2AASeooXQOT9UYHROiUJElDAJEfiAA}{Open in Shinylive} - \if{html}{\out{}} + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQlQDCAPIATHG6-QNKAL5dSmiowyp57BX+GboAvMtBuEt8QiKia7o7wmKL3ZW6pDCJEolQoqJEBLSBVhCn5+fVJgcpiWGkzA0iVEqDgBHeH3OKWg8AOCjAo3hWzOkN0ojgIg0B3RmNIwNB4KWqMq1Cg9AxcLAAGUMWDSLotCxnvQRIgkUTiQR8kRaAQxAdGYxmSJElyeXzRMUMsBgPDEWAALoK0qEwgkAhI3TwwSoIIAazg8LkcmRxPOOLpcH4lOIFnZKOJJlooStBwAYgBBAAyVNcDo+XVRJo5lUF+3Wv3+gLxILBENR0NgenWcsG9rNFqx60zMYJ8eJpPJfhT1NpWMFwrEbLwIchYt5-PWFbJIvrEqlQRlqbGiuVulVAAVSWRNfC7KxQaOwHZqoF4CO8Fq1XbF9rdVADUbg-7ITnXSWdfrDTWdx8YMJNJFk-YnM5TWbTM797pPT6-WbA5DP5VP10urRvnYFRyGjbQ4BsWxyjOURCggVgPXQdgZgAEnqUoUPRRgdE6CYlDAcYFSAA}{Open in Shinylive} + \if{html}{\out{}} \if{html}{\out{}} } \item{example-2}{ - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWTdVIxMxERGYbGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI09c2dveBoeH3MuQBdN2h0CZUxXYtRCuV0AF5QeFcCC+EIRKIIbo4cIxMCBnVJjA0hI0lBRKIiARaGErBB0ZjMQ0TEjMmloqRmBo0qJUHACBTKZjMm89JCFGAFqMBTCMVzdKI4CINEjJdLLqz2ZzxXVqFB6FKkQKAlL2aRdFoWCT6CJECKQSrdAQShsCGIkYbGMaRFcbbQ7fsLZaoVBgMABUKBV8vqLvZiOdrnAANEW6AVYQZeVx4ONgLwAeUcADkHABNWMBrAAWQLYACDkGdkGAEZS+WE1WAEylvx2OwAMWFKYFACEi1gANJYZtgfphuSh71yvVwfhasAJpPmsUqky0KKzpHtwajAKuFeUsdcideuqOxGQukMpkKtkRg-c3K8+eBvCnzHTmWQz+3pXvylqhq1Dzjq8oGka6oImab4PpS1q2vakKOs6cCughnqwVymR+gGIxdsGk5hhGZbRqWi7JlUAoZtmealoMxZ1hWVa1t2ZZMYMI6UWArYdl2XF9oOw4CkelonphdQ-pu-JgAJQ6cf+mIwBctBxHy9hOM4hGruuUm6Nuu77qJ74iboR79P0tA0uwKjkDe2hwDYtg1BiohlBArCDOg7BoKgAAkLRVD5vmSowOh9MsShgEsXxAA}{Open in Shinylive} - \if{html}{\out{}} + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWTdVIxMxERGYbGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI09c2dveBoeH3MuQBdN2h0CZUxXYtRCuV0AF5QeFcCC+EIRKIIbo4cIxMCBnVJjA0hI0lBRKIiARaGErBB0ZjMQ0TEjMmloqRmBo0qJUHACBTKZjMm89JCFGAFqMBTCMVzdKI4CINEjJdLLqz2ZzxXVqFB6FKkQKAlL2aRdFoWCT6CJECKQSrdAQShsCGIkYbGMaRFcbbQ7fsLZaoVBgMABUKBV8vqLvZiOQGAOKuPC6AUAIQAslgANJYACMIrjYFGPh8dgAEs5cwL+mG5KHvXK9XB+FrBdHzWKVSZaFFa0iAGKDUYBVzNyllrkVr11R2IyF0hlMhVsiMD7m5Xn1wN4UeY6syyGb2dK9eUtUa6j1nXyg1G9UIs1rheU622+2Qx3OuCuh+e29czJ+gMjYVgYNKzDCMwD7AANLMBSwQYvBjKoBS8AB5RwADkHAATUgwUsETLCAgcQY7EGTNY21AiiIAJiwvw7DsTt-3gsAk1TLAqNIhs4OzZi0xIxjc3zIsSzAIdLRHT86h3Dt+SY5M0zYoCVRgC5aDiPl7CcZwFPFVt2zrSFu17ftRPXETdCHfp+loGl2BUcgZ20OAbFsGoMVEMoIFYQZ0HYNBUAAEhaKpfL8yVGB0PpliUMAli+IA}{Open in Shinylive} + \if{html}{\out{}} \if{html}{\out{}} } } From 47738131d1c9adc811451f1b1c2cd28c2a86b924 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 20 Nov 2025 16:56:49 +0000 Subject: [PATCH 04/16] docs: adds title to is_tab_active_js --- R/utils.R | 1 + man/is_tab_active_js.Rd | 21 +++++++++++++++++++++ 2 files changed, 22 insertions(+) create mode 100644 man/is_tab_active_js.Rd diff --git a/R/utils.R b/R/utils.R index 5f462ba0d..cdebdc15f 100644 --- a/R/utils.R +++ b/R/utils.R @@ -234,6 +234,7 @@ variable_type_icons <- function(var_type) { )) } +#' JavaScript expression to check if a tab is active #' #' @param id (`character(1)`) the id of the tab panel with tabs. #' @param name (`character(1)`) the name of the tab. diff --git a/man/is_tab_active_js.Rd b/man/is_tab_active_js.Rd new file mode 100644 index 000000000..af2e3f4bd --- /dev/null +++ b/man/is_tab_active_js.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{is_tab_active_js} +\alias{is_tab_active_js} +\title{JavaScript expression to check if a tab is active} +\usage{ +is_tab_active_js(id, name) +} +\arguments{ +\item{id}{(\code{character(1)}) the id of the tab panel with tabs.} + +\item{name}{(\code{character(1)}) the name of the tab.} +} +\value{ +JavaScript expression to be used in \code{shiny::conditionalPanel()} to determine +if the specified tab is active. +} +\description{ +JavaScript expression to check if a tab is active +} +\keyword{internal} From bb77f9d0a610622cabcc3165f7fa796b19893bbb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 21 Nov 2025 12:31:45 +0000 Subject: [PATCH 05/16] feat: support categorical variables in association and bivariate --- NEWS.md | 1 + R/custom_mosaic.R | 87 +++++++++++++++++++++++++++++++++++++ R/tm_g_bivariate.R | 5 ++- man/create_mosaic_layers.Rd | 24 ++++++++++ 4 files changed, 116 insertions(+), 1 deletion(-) create mode 100644 R/custom_mosaic.R create mode 100644 man/create_mosaic_layers.Rd diff --git a/NEWS.md b/NEWS.md index 71f2ecf30..c95d96a59 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,7 @@ ### Enhancements - Modules now return a `teal_report` object that contains the data, code and reporter. All the reporter buttons were removed from the modules' UI. +- Support case when both variables are categorical in association and bivariate plots. # teal.modules.general 0.5.1 diff --git a/R/custom_mosaic.R b/R/custom_mosaic.R new file mode 100644 index 000000000..503f17fa2 --- /dev/null +++ b/R/custom_mosaic.R @@ -0,0 +1,87 @@ +#' Minimal mosaic plot +#' +#' Provides a minimal mosaic plot implementation using ggplot2. +#' @param data_name Name of the data frame to use. +#' @param x_var Name of the variable to use on the x-axis. +#' @param y_var Name of the variable to use for fill colors. +#' @param reduce_plot_call Function that takes multiple ggplot2 layers and combines them into a single plot call. +#' @return An expression that creates a mosaic plot when evaluated. +#' @keywords internal +create_mosaic_layers <- function(data_name, x_var, y_var, reduce_plot_call) { + data_call <- substitute( + mosaic_data <- data_name |> + # Count combinations of X and Y + dplyr::count(x_var, y_var) |> + # Compute total for each X group + dplyr::group_by(x_var) |> + dplyr::mutate( + x_total = sum(n), + prop = n / x_total + ) |> + dplyr::ungroup() |> + # Compute total sample size to turn counts into widths + dplyr::mutate(N_total = sum(x_total)) |> + # Convert counts to x widths + dplyr::group_by(x_var) |> + dplyr::mutate( + x_width = x_total / unique(N_total) + ) |> + # Compute x-min/x-max for each group + dplyr::group_by(x_var) |> + dplyr::mutate( + x_width_last = dplyr::if_else(dplyr::row_number() == dplyr::n(), x_width, 0) + ) |> + dplyr::ungroup() |> + dplyr::mutate( + xmin = cumsum(dplyr::lag(x_width_last, default = 0)), + xmax = xmin + x_width + ) |> + # Compute y-min/y-max for stacked proportions + dplyr::group_by(x_var) |> + dplyr::arrange(x_var, y_var) |> + dplyr::mutate( + ymin = c(0, head(cumsum(prop), -1)), + ymax = cumsum(prop) + ) |> + dplyr::ungroup(), + env = list(x_var = as.name(x_var), y_var = as.name(y_var), data_name = as.name(data_name)) + ) + + layer_rect <- substitute( + ggplot2::geom_rect( + ggplot2::aes( + xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, fill = y_var + ), + data = mosaic_data, + color = "white" + ), + env = list(y_var = as.name(y_var)) + ) + + layer_scale_x <- substitute( + ggplot2::scale_x_continuous( + breaks = mosaic_data |> + dplyr::distinct(x_var, xmin, xmax) |> + dplyr::rowwise() |> + dplyr::mutate(mid = (xmin + xmax) / 2) |> + dplyr::pull(mid), + labels = mosaic_data |> + dplyr::distinct(x_var) |> + dplyr::pull(x_var), + expand = c(0, 0) + ), + env = list(x_var = as.name(x_var)) + ) + + bquote( + local({ + .(data_call) + + list( + .(layer_rect), + .(layer_scale_x), + ggplot2::scale_y_continuous(expand = c(0, 0), labels = scales::percent_format(scale = 100)) + ) + }) + ) +} diff --git a/R/tm_g_bivariate.R b/R/tm_g_bivariate.R index 4bb60d406..c59516a18 100644 --- a/R/tm_g_bivariate.R +++ b/R/tm_g_bivariate.R @@ -927,7 +927,10 @@ bivariate_ggplot_call <- function(x_class, ) # Factor and character plots } else if (x_class == "factor" && y_class == "factor") { - stop("Categorical variables 'x' and 'y' are currently not supported.") + plot_call <- reduce_plot_call( + plot_call, + create_mosaic_layers(data_name, x_var = x, y_var = y, reduce_plot_call = reduce_plot_call) + ) } else { stop("x y type combination not allowed") } diff --git a/man/create_mosaic_layers.Rd b/man/create_mosaic_layers.Rd new file mode 100644 index 000000000..17ed7503c --- /dev/null +++ b/man/create_mosaic_layers.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/custom_mosaic.R +\name{create_mosaic_layers} +\alias{create_mosaic_layers} +\title{Minimal mosaic plot} +\usage{ +create_mosaic_layers(data_name, x_var, y_var, reduce_plot_call) +} +\arguments{ +\item{data_name}{Name of the data frame to use.} + +\item{x_var}{Name of the variable to use on the x-axis.} + +\item{y_var}{Name of the variable to use for fill colors.} + +\item{reduce_plot_call}{Function that takes multiple ggplot2 layers and combines them into a single plot call.} +} +\value{ +An expression that creates a mosaic plot when evaluated. +} +\description{ +Provides a minimal mosaic plot implementation using ggplot2. +} +\keyword{internal} From f3c2020fea1468eb8c75a9950b7663b6bb2e5367 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 21 Nov 2025 12:45:26 +0000 Subject: [PATCH 06/16] chore: prefix internal function with dot --- R/custom_mosaic.R | 2 +- R/tm_g_bivariate.R | 2 +- ...{create_mosaic_layers.Rd => dot-create_mosaic_layers.Rd} | 6 +++--- 3 files changed, 5 insertions(+), 5 deletions(-) rename man/{create_mosaic_layers.Rd => dot-create_mosaic_layers.Rd} (82%) diff --git a/R/custom_mosaic.R b/R/custom_mosaic.R index 503f17fa2..2487d0afd 100644 --- a/R/custom_mosaic.R +++ b/R/custom_mosaic.R @@ -7,7 +7,7 @@ #' @param reduce_plot_call Function that takes multiple ggplot2 layers and combines them into a single plot call. #' @return An expression that creates a mosaic plot when evaluated. #' @keywords internal -create_mosaic_layers <- function(data_name, x_var, y_var, reduce_plot_call) { +.create_mosaic_layers <- function(data_name, x_var, y_var, reduce_plot_call) { data_call <- substitute( mosaic_data <- data_name |> # Count combinations of X and Y diff --git a/R/tm_g_bivariate.R b/R/tm_g_bivariate.R index c59516a18..32b586048 100644 --- a/R/tm_g_bivariate.R +++ b/R/tm_g_bivariate.R @@ -929,7 +929,7 @@ bivariate_ggplot_call <- function(x_class, } else if (x_class == "factor" && y_class == "factor") { plot_call <- reduce_plot_call( plot_call, - create_mosaic_layers(data_name, x_var = x, y_var = y, reduce_plot_call = reduce_plot_call) + .create_mosaic_layers(data_name, x_var = x, y_var = y, reduce_plot_call = reduce_plot_call) ) } else { stop("x y type combination not allowed") diff --git a/man/create_mosaic_layers.Rd b/man/dot-create_mosaic_layers.Rd similarity index 82% rename from man/create_mosaic_layers.Rd rename to man/dot-create_mosaic_layers.Rd index 17ed7503c..5512ae9a3 100644 --- a/man/create_mosaic_layers.Rd +++ b/man/dot-create_mosaic_layers.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/custom_mosaic.R -\name{create_mosaic_layers} -\alias{create_mosaic_layers} +\name{.create_mosaic_layers} +\alias{.create_mosaic_layers} \title{Minimal mosaic plot} \usage{ -create_mosaic_layers(data_name, x_var, y_var, reduce_plot_call) +.create_mosaic_layers(data_name, x_var, y_var, reduce_plot_call) } \arguments{ \item{data_name}{Name of the data frame to use.} From 6fe6664c49bdf6293d3cbbb8f4ca7e1787c0ca85 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 24 Nov 2025 10:24:29 +0000 Subject: [PATCH 07/16] pr: feedback from @llrs-roche --- R/custom_mosaic.R | 41 +++++++++++++++++------------------------ 1 file changed, 17 insertions(+), 24 deletions(-) diff --git a/R/custom_mosaic.R b/R/custom_mosaic.R index 2487d0afd..02088f511 100644 --- a/R/custom_mosaic.R +++ b/R/custom_mosaic.R @@ -9,41 +9,35 @@ #' @keywords internal .create_mosaic_layers <- function(data_name, x_var, y_var, reduce_plot_call) { data_call <- substitute( - mosaic_data <- data_name |> + mosaic_data <- data_name %>% # Count combinations of X and Y - dplyr::count(x_var, y_var) |> + dplyr::count(x_var, y_var) %>% # Compute total for each X group - dplyr::group_by(x_var) |> dplyr::mutate( + .by = x_var, x_total = sum(n), prop = n / x_total - ) |> - dplyr::ungroup() |> + ) %>% # Compute total sample size to turn counts into widths - dplyr::mutate(N_total = sum(x_total)) |> + dplyr::mutate(N_total = sum(x_total)) %>% # Convert counts to x widths - dplyr::group_by(x_var) |> - dplyr::mutate( - x_width = x_total / unique(N_total) - ) |> - # Compute x-min/x-max for each group - dplyr::group_by(x_var) |> dplyr::mutate( + .by = x_var, + x_width = x_total / unique(N_total), x_width_last = dplyr::if_else(dplyr::row_number() == dplyr::n(), x_width, 0) - ) |> - dplyr::ungroup() |> + ) %>% + # Compute x-min/x-max for each group dplyr::mutate( xmin = cumsum(dplyr::lag(x_width_last, default = 0)), xmax = xmin + x_width - ) |> + ) %>% # Compute y-min/y-max for stacked proportions - dplyr::group_by(x_var) |> dplyr::arrange(x_var, y_var) |> dplyr::mutate( + .by = x_var, ymin = c(0, head(cumsum(prop), -1)), ymax = cumsum(prop) - ) |> - dplyr::ungroup(), + ), env = list(x_var = as.name(x_var), y_var = as.name(y_var), data_name = as.name(data_name)) ) @@ -60,13 +54,12 @@ layer_scale_x <- substitute( ggplot2::scale_x_continuous( - breaks = mosaic_data |> - dplyr::distinct(x_var, xmin, xmax) |> - dplyr::rowwise() |> - dplyr::mutate(mid = (xmin + xmax) / 2) |> + breaks = mosaic_data %>% + dplyr::distinct(x_var, xmin, xmax) %>% + dplyr::mutate(mid = (xmin + xmax) / 2) %>% dplyr::pull(mid), - labels = mosaic_data |> - dplyr::distinct(x_var) |> + labels = mosaic_data %>% + dplyr::distinct(x_var) %>% dplyr::pull(x_var), expand = c(0, 0) ), From fc0a48214d0ce5849c59d185ef356701dc79aada Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 24 Nov 2025 10:34:51 +0000 Subject: [PATCH 08/16] pr: make mosaic call simpler --- R/custom_mosaic.R | 15 +++++---------- R/tm_g_bivariate.R | 8 +++++--- 2 files changed, 10 insertions(+), 13 deletions(-) diff --git a/R/custom_mosaic.R b/R/custom_mosaic.R index 02088f511..d7b60a959 100644 --- a/R/custom_mosaic.R +++ b/R/custom_mosaic.R @@ -32,7 +32,7 @@ xmax = xmin + x_width ) %>% # Compute y-min/y-max for stacked proportions - dplyr::arrange(x_var, y_var) |> + dplyr::arrange(x_var, y_var) %>% dplyr::mutate( .by = x_var, ymin = c(0, head(cumsum(prop), -1)), @@ -46,7 +46,6 @@ ggplot2::aes( xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, fill = y_var ), - data = mosaic_data, color = "white" ), env = list(y_var = as.name(y_var)) @@ -67,14 +66,10 @@ ) bquote( - local({ - .(data_call) - - list( - .(layer_rect), - .(layer_scale_x), + .(data_call) %>% + ggplot2::ggplot() + + .(layer_rect) + + .(layer_scale_x) + ggplot2::scale_y_continuous(expand = c(0, 0), labels = scales::percent_format(scale = 100)) - ) - }) ) } diff --git a/R/tm_g_bivariate.R b/R/tm_g_bivariate.R index 32b586048..4e9968c90 100644 --- a/R/tm_g_bivariate.R +++ b/R/tm_g_bivariate.R @@ -927,9 +927,11 @@ bivariate_ggplot_call <- function(x_class, ) # Factor and character plots } else if (x_class == "factor" && y_class == "factor") { - plot_call <- reduce_plot_call( - plot_call, - .create_mosaic_layers(data_name, x_var = x, y_var = y, reduce_plot_call = reduce_plot_call) + plot_call <- .create_mosaic_layers( + data_name, + x_var = x, + y_var = y, + reduce_plot_call = reduce_plot_call ) } else { stop("x y type combination not allowed") From 54914e67f72dab060d2d6e35f7776afbae9f3f24 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Mon, 24 Nov 2025 10:36:55 +0000 Subject: [PATCH 09/16] [skip style] [skip vbump] Restyle files --- R/custom_mosaic.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/custom_mosaic.R b/R/custom_mosaic.R index d7b60a959..901ff7c66 100644 --- a/R/custom_mosaic.R +++ b/R/custom_mosaic.R @@ -68,8 +68,8 @@ bquote( .(data_call) %>% ggplot2::ggplot() + - .(layer_rect) + - .(layer_scale_x) + - ggplot2::scale_y_continuous(expand = c(0, 0), labels = scales::percent_format(scale = 100)) + .(layer_rect) + + .(layer_scale_x) + + ggplot2::scale_y_continuous(expand = c(0, 0), labels = scales::percent_format(scale = 100)) ) } From c7f9d5eb64872eae7e9bded5a04a170f36393ebe Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 24 Nov 2025 10:39:53 +0000 Subject: [PATCH 10/16] revert: back to main --- R/tm_g_association.R | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/R/tm_g_association.R b/R/tm_g_association.R index 172737dee..8516efc9b 100644 --- a/R/tm_g_association.R +++ b/R/tm_g_association.R @@ -60,6 +60,8 @@ #' data <- within(data, { #' require(nestcolor) #' CO2 <- CO2 +#' factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L)))) +#' CO2[factors] <- lapply(CO2[factors], as.character) #' }) #' #' app <- init( @@ -70,8 +72,8 @@ #' dataname = "CO2", #' select = select_spec( #' label = "Select variable:", -#' choices = variable_choices(data[["CO2"]], c("conc", "uptake")), -#' selected = "conc", +#' choices = variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment")), +#' selected = "Plant", #' fixed = FALSE #' ) #' ), @@ -79,8 +81,8 @@ #' dataname = "CO2", #' select = select_spec( #' label = "Select variables:", -#' choices = variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment", "conc", "uptake")), -#' selected = "uptake", +#' choices = variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment")), +#' selected = "Treatment", #' multiple = TRUE, #' fixed = FALSE #' ) @@ -115,9 +117,9 @@ #' label = "Select variable:", #' choices = variable_choices( #' data[["ADSL"]], -#' c("AGE", "BMRKR1", "LDDTHELD") +#' c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2") #' ), -#' selected = "AGE", +#' selected = "RACE", #' fixed = FALSE #' ) #' ), @@ -127,7 +129,7 @@ #' label = "Select variables:", #' choices = variable_choices( #' data[["ADSL"]], -#' c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2", "AGE", "BMRKR1", "LDDTHELD") +#' c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2") #' ), #' selected = "BMRKR2", #' multiple = TRUE, From 2f87483dd93c566ee94bf91af4fc3d9bc6acaeaf Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Mon, 24 Nov 2025 10:41:06 +0000 Subject: [PATCH 11/16] [skip style] [skip vbump] Restyle files --- R/custom_mosaic.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/custom_mosaic.R b/R/custom_mosaic.R index d7b60a959..901ff7c66 100644 --- a/R/custom_mosaic.R +++ b/R/custom_mosaic.R @@ -68,8 +68,8 @@ bquote( .(data_call) %>% ggplot2::ggplot() + - .(layer_rect) + - .(layer_scale_x) + - ggplot2::scale_y_continuous(expand = c(0, 0), labels = scales::percent_format(scale = 100)) + .(layer_rect) + + .(layer_scale_x) + + ggplot2::scale_y_continuous(expand = c(0, 0), labels = scales::percent_format(scale = 100)) ) } From 6227268f037956a8429b15a9fad2a9d7df4f2007 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 24 Nov 2025 10:41:08 +0000 Subject: [PATCH 12/16] docs: update documentation --- man/tm_g_association.Rd | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/man/tm_g_association.Rd b/man/tm_g_association.Rd index 29a872d33..86ae13618 100644 --- a/man/tm_g_association.Rd +++ b/man/tm_g_association.Rd @@ -129,6 +129,8 @@ data <- teal_data() data <- within(data, { require(nestcolor) CO2 <- CO2 + factors <- names(Filter(isTRUE, vapply(CO2, is.factor, logical(1L)))) + CO2[factors] <- lapply(CO2[factors], as.character) }) app <- init( @@ -139,8 +141,8 @@ app <- init( dataname = "CO2", select = select_spec( label = "Select variable:", - choices = variable_choices(data[["CO2"]], c("conc", "uptake")), - selected = "conc", + choices = variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment")), + selected = "Plant", fixed = FALSE ) ), @@ -148,8 +150,8 @@ app <- init( dataname = "CO2", select = select_spec( label = "Select variables:", - choices = variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment", "conc", "uptake")), - selected = "uptake", + choices = variable_choices(data[["CO2"]], c("Plant", "Type", "Treatment")), + selected = "Treatment", multiple = TRUE, fixed = FALSE ) @@ -179,9 +181,9 @@ app <- init( label = "Select variable:", choices = variable_choices( data[["ADSL"]], - c("AGE", "BMRKR1", "LDDTHELD") + c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2") ), - selected = "AGE", + selected = "RACE", fixed = FALSE ) ), @@ -191,7 +193,7 @@ app <- init( label = "Select variables:", choices = variable_choices( data[["ADSL"]], - c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2", "AGE", "BMRKR1", "LDDTHELD") + c("SEX", "RACE", "COUNTRY", "ARM", "STRATA1", "STRATA2", "ITTFL", "BMRKR2") ), selected = "BMRKR2", multiple = TRUE, @@ -209,13 +211,13 @@ if (interactive()) { \section{Examples in Shinylive}{ \describe{ \item{example-1}{ - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQlQDCAPIATHG6-QNKAL5dSmiowyp57BX+GboAvMtBuEt8QiKia7o7wmKL3ZW6pDCJEolQoqJEBLSBVhCn5+fVJgcpiWGkzA0iVEqDgBHeH3OKWg8AOCjAo3hWzOkN0ojgIg0B3RmNIwNB4KWqMq1Cg9AxcLAAGUMWDSLotCxnvQRIgkUTiQR8kRaAQxAdGYxmSJElyeXzRMUMsBgPDEWAALoK0qEwgkAhI3TwwSoIIAazg8LkcmRxPOOLpcH4lOIFnZKOJJlooStBwAYgBBAAyVNcDo+XVRJo5lUF+3Wv3+gLxILBENR0NgenWcsG9rNFqx60zMYJ8eJpPJfhT1NpWMFwrEbLwIchYt5-PWFbJIvrEqlQRlqbGiuVulVAAVSWRNfC7KxQaOwHZqoF4CO8Fq1XbF9rdVADUbg-7ITnXSWdfrDTWdx8YMJNJFk-YnM5TWbTM797pPT6-WbA5DP5VP10urRvnYFRyGjbQ4BsWxyjOURCggVgPXQdgZgAEnqUoUPRRgdE6CYlDAcYFSAA}{Open in Shinylive} - \if{html}{\out{}} + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXVIhrqu-lCkULpwAB6wqCJKAUEGxlzUAPoxUDbRgcFGugDutKQAFirsKbi6IEq6uoxwAI6CtNXsPqKkxNREjIoQlQDCAPIATHG6-QMVpuqkHaLD0PCi7ABitNTkjOy0og4upVpokRyjpZsYJpMdpe0StATc7ACMADJyL129g8BnGtMAusPU+2ohw+XymjFEP1KUHEBHyLEmMi6AF8ukp9sMVHl2OMUroALz+DK4cZ8IQiGYE0nCMTY7qVXSkGCJCSJaGiIgEWiBKwQWn0+nVEz4wlBRJhUjMDSJUSoOAEPn8+kpOZ6AkKMCjdXEumK3SiOAiDTC-WG0jS2Xy8a6yoA+gG4XqgDKBrlpF0e0YXPoIkQWqt1thRBuYmFHq9IkSgeDCxSwGA6s1YB+kN0lrAAAUAWQtbp1XZWLKc3nqoF4NmwC9tdb6SbXXB+A6M1nSH6ddaTLRQvXhYsAIKPR2uNv8t6KuRVxUeikiqBi0ISybmuUK3XK2Cq3Mawat6u1o0EvdmmXL-26232tVgZ2m90scNiX14U+KqMEEMEsNQb1wSP5INvmMMjjBNtyTFM00zKBy1KPMCzgIswDsEtGQoFsK3HZ9+UPbtLyQuBS1Qndq10GBhE0SIN22ZwJ2rDsuwbAk+wHIdq1HEd-VHLouloIUNlUSVNB0GxbHKOlREKCBWF7dB2H2AASeooXQOT9UYHROiUJElDAJEfiAA}{Open in Shinylive} + \if{html}{\out{}} \if{html}{\out{}} } \item{example-2}{ - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWTdVIxMxERGYbGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI09c2dveBoeH3MuQBdN2h0CZUxXYtRCuV0AF5QeFcCC+EIRKIIbo4cIxMCBnVJjA0hI0lBRKIiARaGErBB0ZjMQ0TEjMmloqRmBo0qJUHACBTKZjMm89JCFGAFqMBTCMVzdKI4CINEjJdLLqz2ZzxXVqFB6FKkQKAlL2aRdFoWCT6CJECKQSrdAQShsCGIkYbGMaRFcbbQ7fsLZaoVBgMABUKBV8vqLvZiOQGAOKuPC6AUAIQAslgANJYACMIrjYFGPh8dgAEs5cwL+mG5KHvXK9XB+FrBdHzWKVSZaFFa0iAGKDUYBVzNyllrkVr11R2IyF0hlMhVsiMD7m5Xn1wN4UeY6syyGb2dK9eUtUa6j1nXyg1G9UIs1rheU622+2Qx3OuCuh+e29czJ+gMjYVgYNKzDCMwD7AANLMBSwQYvBjKoBS8AB5RwADkHAATUgwUsETLCAgcQY7EGTNY21AiiIAJiwvw7DsTt-3gsAk1TLAqNIhs4OzZi0xIxjc3zIsSzAIdLRHT86h3Dt+SY5M0zYoCVRgC5aDiPl7CcZwFPFVt2zrSFu17ftRPXETdCHfp+loGl2BUcgZ20OAbFsGoMVEMoIFYQZ0HYNBUAAEhaKpfL8yVGB0PpliUMAli+IA}{Open in Shinylive} - \if{html}{\out{}} + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqUBiXQGEAIgEkAZS9dfihSKF04AA9YVBElUPCDYy5qAH1EqBsEsIijXQB3WlIACxV2TNxdECVdXUY4AEdBWgb2CDFSYmoiRkUIOoBBHwCAGWTdVIxMxERGYbGlAF9+gCsiFTSAazhWUQrc23z+OBMoYVI0gn5aUQI09c2dveBoeH3MuQBdN2h0CZUxXYtRCuV0AF5QeFcCC+EIRKIIbo4cIxMCBnVJjA0hI0lBRKIiARaGErBB0ZjMQ0TEjMmloqRmBo0qJUHACBTKZjMm89JCFGAFqMBTCMVzdKI4CINEjJdLLqz2ZzxXVqFB6FKkQKAlL2aRdFoWCT6CJECKQSrdAQShsCGIkYbGMaRFcbbQ7fsLZaoVBgMABUKBV8vqLvZiOdrnAANEW6AVYQZeVx4ONgLwAeUcADkHABNWMBrAAWQLYACDkGdkGAEZS+WE1WAEylvx2OwAMWFKYFACEi1gANJYZtgfphuSh71yvVwfhasAJpPmsUqky0KKzpHtwajAKuFeUsdcideuqOxGQukMpkKtkRg-c3K8+eBvCnzHTmWQz+3pXvylqhq1Dzjq8oGka6oImab4PpS1q2vakKOs6cCughnqwVymR+gGIxdsGk5hhGZbRqWi7JlUAoZtmealoMxZ1hWVa1t2ZZMYMI6UWArYdl2XF9oOw4CkelonphdQ-pu-JgAJQ6cf+mIwBctBxHy9hOM4hGruuUm6Nuu77qJ74iboR79P0tA0uwKjkDe2hwDYtg1BiohlBArCDOg7BoKgAAkLRVD5vmSowOh9MsShgEsXxAA}{Open in Shinylive} + \if{html}{\out{}} \if{html}{\out{}} } } From 2dbe6bdd0e25e77f073e1dda27a1be1115c97b7f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 24 Nov 2025 11:40:26 +0000 Subject: [PATCH 13/16] empty: trigger ci From e068c35afb94cf5d39281495afa9d52c95627500 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 24 Nov 2025 12:18:43 +0000 Subject: [PATCH 14/16] tests: re-adds tests that were removed --- tests/testthat/test_bivariate_ggplot_call.R | 47 ++++++++------------- 1 file changed, 18 insertions(+), 29 deletions(-) diff --git a/tests/testthat/test_bivariate_ggplot_call.R b/tests/testthat/test_bivariate_ggplot_call.R index c85d4fd1b..d65d122f5 100644 --- a/tests/testthat/test_bivariate_ggplot_call.R +++ b/tests/testthat/test_bivariate_ggplot_call.R @@ -18,35 +18,24 @@ testthat::test_that("bivariate_ggplot_call with numerics", { ) }) -testthat::test_that("bivariate_ggplot_call with factor, char, logical", { - error_message <- "Categorical variables 'x' and 'y' are currently not supported." - testthat::expect_error( - bivariate_ggplot_call("factor", "factor") %>% deparse(width.cutoff = 300), - error_message - ) - testthat::expect_error( - bivariate_ggplot_call("logical", "factor") %>% deparse(width.cutoff = 300), - error_message - ) - testthat::expect_error( - bivariate_ggplot_call("character", "factor") %>% deparse(width.cutoff = 300), - error_message - ) - testthat::expect_error( - bivariate_ggplot_call("logical", "character") %>% deparse(width.cutoff = 300), - error_message - ) - testthat::expect_error( - bivariate_ggplot_call("character", "logical") %>% deparse(width.cutoff = 300), - error_message - ) - testthat::expect_error( - bivariate_ggplot_call("logical", "logical") %>% deparse(width.cutoff = 300), - error_message - ) - testthat::expect_error( - bivariate_ggplot_call("character", "character") %>% deparse(width.cutoff = 300), - error_message +testthat::describe("bivariate_ggplot_call with arguments:", { + possible_classes <- c("factor", "logical", "character") + comb <- expand.grid(a = possible_classes, b = possible_classes, stringsAsFactors = FALSE) + apply( + comb, + 1, + function(x) { + it(sprintf("%s and %s", x[[1]], x[[2]]), { + testthat::expect_match( + deparse( + bivariate_ggplot_call(x[[1]], x[[2]], data_name = "ANL", x = "x", y = "y"), + width.cutoff = 300 + ), + "mosaic_data <- ", + all = FALSE + ) + }) + } ) }) From b351638fc891c041a597c6106978c0d5ba32ae1c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 26 Nov 2025 12:15:39 +0000 Subject: [PATCH 15/16] chore: prepare to merge to main --- NEWS.md | 1 - R/custom_mosaic.R | 75 --------------------- R/tm_g_bivariate.R | 7 +- man/dot-create_mosaic_layers.Rd | 24 ------- tests/testthat/test_bivariate_ggplot_call.R | 47 ++++++++----- 5 files changed, 30 insertions(+), 124 deletions(-) delete mode 100644 R/custom_mosaic.R delete mode 100644 man/dot-create_mosaic_layers.Rd diff --git a/NEWS.md b/NEWS.md index c95d96a59..71f2ecf30 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,7 +3,6 @@ ### Enhancements - Modules now return a `teal_report` object that contains the data, code and reporter. All the reporter buttons were removed from the modules' UI. -- Support case when both variables are categorical in association and bivariate plots. # teal.modules.general 0.5.1 diff --git a/R/custom_mosaic.R b/R/custom_mosaic.R deleted file mode 100644 index 901ff7c66..000000000 --- a/R/custom_mosaic.R +++ /dev/null @@ -1,75 +0,0 @@ -#' Minimal mosaic plot -#' -#' Provides a minimal mosaic plot implementation using ggplot2. -#' @param data_name Name of the data frame to use. -#' @param x_var Name of the variable to use on the x-axis. -#' @param y_var Name of the variable to use for fill colors. -#' @param reduce_plot_call Function that takes multiple ggplot2 layers and combines them into a single plot call. -#' @return An expression that creates a mosaic plot when evaluated. -#' @keywords internal -.create_mosaic_layers <- function(data_name, x_var, y_var, reduce_plot_call) { - data_call <- substitute( - mosaic_data <- data_name %>% - # Count combinations of X and Y - dplyr::count(x_var, y_var) %>% - # Compute total for each X group - dplyr::mutate( - .by = x_var, - x_total = sum(n), - prop = n / x_total - ) %>% - # Compute total sample size to turn counts into widths - dplyr::mutate(N_total = sum(x_total)) %>% - # Convert counts to x widths - dplyr::mutate( - .by = x_var, - x_width = x_total / unique(N_total), - x_width_last = dplyr::if_else(dplyr::row_number() == dplyr::n(), x_width, 0) - ) %>% - # Compute x-min/x-max for each group - dplyr::mutate( - xmin = cumsum(dplyr::lag(x_width_last, default = 0)), - xmax = xmin + x_width - ) %>% - # Compute y-min/y-max for stacked proportions - dplyr::arrange(x_var, y_var) %>% - dplyr::mutate( - .by = x_var, - ymin = c(0, head(cumsum(prop), -1)), - ymax = cumsum(prop) - ), - env = list(x_var = as.name(x_var), y_var = as.name(y_var), data_name = as.name(data_name)) - ) - - layer_rect <- substitute( - ggplot2::geom_rect( - ggplot2::aes( - xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax, fill = y_var - ), - color = "white" - ), - env = list(y_var = as.name(y_var)) - ) - - layer_scale_x <- substitute( - ggplot2::scale_x_continuous( - breaks = mosaic_data %>% - dplyr::distinct(x_var, xmin, xmax) %>% - dplyr::mutate(mid = (xmin + xmax) / 2) %>% - dplyr::pull(mid), - labels = mosaic_data %>% - dplyr::distinct(x_var) %>% - dplyr::pull(x_var), - expand = c(0, 0) - ), - env = list(x_var = as.name(x_var)) - ) - - bquote( - .(data_call) %>% - ggplot2::ggplot() + - .(layer_rect) + - .(layer_scale_x) + - ggplot2::scale_y_continuous(expand = c(0, 0), labels = scales::percent_format(scale = 100)) - ) -} diff --git a/R/tm_g_bivariate.R b/R/tm_g_bivariate.R index 4e9968c90..4bb60d406 100644 --- a/R/tm_g_bivariate.R +++ b/R/tm_g_bivariate.R @@ -927,12 +927,7 @@ bivariate_ggplot_call <- function(x_class, ) # Factor and character plots } else if (x_class == "factor" && y_class == "factor") { - plot_call <- .create_mosaic_layers( - data_name, - x_var = x, - y_var = y, - reduce_plot_call = reduce_plot_call - ) + stop("Categorical variables 'x' and 'y' are currently not supported.") } else { stop("x y type combination not allowed") } diff --git a/man/dot-create_mosaic_layers.Rd b/man/dot-create_mosaic_layers.Rd deleted file mode 100644 index 5512ae9a3..000000000 --- a/man/dot-create_mosaic_layers.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/custom_mosaic.R -\name{.create_mosaic_layers} -\alias{.create_mosaic_layers} -\title{Minimal mosaic plot} -\usage{ -.create_mosaic_layers(data_name, x_var, y_var, reduce_plot_call) -} -\arguments{ -\item{data_name}{Name of the data frame to use.} - -\item{x_var}{Name of the variable to use on the x-axis.} - -\item{y_var}{Name of the variable to use for fill colors.} - -\item{reduce_plot_call}{Function that takes multiple ggplot2 layers and combines them into a single plot call.} -} -\value{ -An expression that creates a mosaic plot when evaluated. -} -\description{ -Provides a minimal mosaic plot implementation using ggplot2. -} -\keyword{internal} diff --git a/tests/testthat/test_bivariate_ggplot_call.R b/tests/testthat/test_bivariate_ggplot_call.R index d65d122f5..c85d4fd1b 100644 --- a/tests/testthat/test_bivariate_ggplot_call.R +++ b/tests/testthat/test_bivariate_ggplot_call.R @@ -18,24 +18,35 @@ testthat::test_that("bivariate_ggplot_call with numerics", { ) }) -testthat::describe("bivariate_ggplot_call with arguments:", { - possible_classes <- c("factor", "logical", "character") - comb <- expand.grid(a = possible_classes, b = possible_classes, stringsAsFactors = FALSE) - apply( - comb, - 1, - function(x) { - it(sprintf("%s and %s", x[[1]], x[[2]]), { - testthat::expect_match( - deparse( - bivariate_ggplot_call(x[[1]], x[[2]], data_name = "ANL", x = "x", y = "y"), - width.cutoff = 300 - ), - "mosaic_data <- ", - all = FALSE - ) - }) - } +testthat::test_that("bivariate_ggplot_call with factor, char, logical", { + error_message <- "Categorical variables 'x' and 'y' are currently not supported." + testthat::expect_error( + bivariate_ggplot_call("factor", "factor") %>% deparse(width.cutoff = 300), + error_message + ) + testthat::expect_error( + bivariate_ggplot_call("logical", "factor") %>% deparse(width.cutoff = 300), + error_message + ) + testthat::expect_error( + bivariate_ggplot_call("character", "factor") %>% deparse(width.cutoff = 300), + error_message + ) + testthat::expect_error( + bivariate_ggplot_call("logical", "character") %>% deparse(width.cutoff = 300), + error_message + ) + testthat::expect_error( + bivariate_ggplot_call("character", "logical") %>% deparse(width.cutoff = 300), + error_message + ) + testthat::expect_error( + bivariate_ggplot_call("logical", "logical") %>% deparse(width.cutoff = 300), + error_message + ) + testthat::expect_error( + bivariate_ggplot_call("character", "character") %>% deparse(width.cutoff = 300), + error_message ) }) From eb90eab475dea7dbf0e93b6fe559b77cf9a546dc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Wed, 26 Nov 2025 12:38:04 +0000 Subject: [PATCH 16/16] fix: note in wide example --- R/tm_file_viewer.R | 5 ++++- man/tm_file_viewer.Rd | 9 ++++++--- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/R/tm_file_viewer.R b/R/tm_file_viewer.R index ffa1f7b18..7baceb802 100644 --- a/R/tm_file_viewer.R +++ b/R/tm_file_viewer.R @@ -31,7 +31,10 @@ #' folder = system.file("sample_files", package = "teal.modules.general"), #' png = system.file("sample_files/sample_file.png", package = "teal.modules.general"), #' txt = system.file("sample_files/sample_file.txt", package = "teal.modules.general"), -#' url = "https://www.fda.gov/files/drugs/published/Portable-Document-Format-Specifications.pdf" +#' url = file.path( +#' "https://www.fda.gov/files/drugs/published", +#' "Portable-Document-Format-Specifications.pdf" +#' ) #' ) #' ) #' ) diff --git a/man/tm_file_viewer.Rd b/man/tm_file_viewer.Rd index 245a5fbeb..38d0d1339 100644 --- a/man/tm_file_viewer.Rd +++ b/man/tm_file_viewer.Rd @@ -40,7 +40,10 @@ app <- init( folder = system.file("sample_files", package = "teal.modules.general"), png = system.file("sample_files/sample_file.png", package = "teal.modules.general"), txt = system.file("sample_files/sample_file.txt", package = "teal.modules.general"), - url = "https://www.fda.gov/files/drugs/published/Portable-Document-Format-Specifications.pdf" + url = file.path( + "https://www.fda.gov/files/drugs/published", + "Portable-Document-Format-Specifications.pdf" + ) ) ) ) @@ -53,8 +56,8 @@ if (interactive()) { \section{Examples in Shinylive}{ \describe{ \item{example-1}{ - \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqX8opKAeNdqAfQ8vG3dPbyNdAHdaUgALFXYgqFxdECVdXSSfTLCME2Z4dgBGRQgAX1KlNFRslRj2dJyvXQBeJuTGviERUVbdLuExBogMjNIYfxNaEX8tWjhImWHR0ZVUQVJ-VE9YvrpRUmWV0ZMian4ZPtFWA7gYPOm4BrBRWFQZqZ6FPF1tggBrKBSPrfPy8ASDcRSCBqajfOS4RrHX4QCRXG7ke6fJ7fV4wd5wSaPUQAejxBKJIgwqFR3xSf0BwLaoLg3HB3TEkmksnhiJGyN0pAAHqR0bcsY9nuSPsSyW8ZVThaQ6b91Iy9MywGCBj0uTCeWAEUjjoJGNQQWBYqRSKhRIgSSTIk68h5JEQtCTsaT+IxBBJSet6PtYnB+CSAApERheINwQwAESIBEE8DIhgAYlGYJ5DABlVBwAi0KYETxWCDiVD8EzfY0ZUorBu6UqlYu6dgqcjMSw6Gy2NL80TxCCsACC6HY1QAJIJaClp6IZDpGKUykowGUALpAA}{Open in Shinylive} - \if{html}{\out{}} + \href{https://shinylive.io/r/app/#code=NobwRAdghgtgpmAXGKAHVA6ASmANGAYwHsIAXOMpMAGwEsAjAJykYE8AKcqajGIgEwCu1OAGcMAcwpxm1AJQAdCLTIyoBUrQBucAAQAeALS6AZoIgbaJdnN0AVLAFUAokqX8opKAeNdqAfQ8vG3dPbyNdAHdaUgALFXYgqFxdECVdXSSfTLCME2Z4dgBGRQgAX1KlNFRslRj2dJyvXQBeJuTGviERUVbdLuExBogMjNIYfxNaEX8tWjhImWHR0ZVUQVJ-VE9YvrpRUmWV0ZMian4ZPtFWA7gYPOm4BrBRWFQZqZ6FPF1tggBrKBSPrfPy8ASDcRSCBqajfOS4RrHX4QCRXG7ke6fJ7fV4wd5wSaPUQAejxBKJIgwqFR3xSf0BwLaoLg3HB3TEkmksnhiJGyN0pAAHqR0bcsY9nuSPsSyW8ZVThaQ6b91Iy9MywGCBj0uTCeWAEUjjoJGNQ+tjqTsjgLdN9YqRSKhRIgSSTIh68h5JEQtCTsaT+IxBBJSet6PtYnB+HTjcjvgAFIiMLwRuCGAAiRAIgngZEMADFkzBPIYAMqoOAEWhTAieKwQcSofgmb5x0alZGdjuNUqlGu6dgqcjMSw6Gy2NL80TxCCsACC6HY1QAJIJaClV6IZDpGKUykowGUALpAA}{Open in Shinylive} + \if{html}{\out{}} \if{html}{\out{}} } }