From 66600b7a7309c7e4e070c967977e2cd36add7027 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Dawid=20Ka=C5=82=C4=99dkowski?= <6959016+gogonzo@users.noreply.github.com> Date: Thu, 27 Jun 2024 15:52:24 +0200 Subject: [PATCH 1/2] simplify module and fix LOQFL_COMB (#283) alternative to https://github.com/insightsengineering/teal.goshawk/pull/280 Simplified the code by replacing pivot_ calls with simple filter and select. --- DESCRIPTION | 3 +- R/tm_g_gh_correlationplot.R | 150 +++++++++++++++++------------------- 2 files changed, 73 insertions(+), 80 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a6533131..cbd3b530 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -50,8 +50,7 @@ Imports: teal.code (>= 0.4.1.9009), teal.logger (>= 0.2.0.9004), teal.reporter (>= 0.2.0), - teal.widgets (>= 0.4.0), - tidyr (>= 0.8.3) + teal.widgets (>= 0.4.0) Suggests: knitr (>= 1.42), nestcolor (>= 0.1.0), diff --git a/R/tm_g_gh_correlationplot.R b/R/tm_g_gh_correlationplot.R index a3033663..8376faa5 100644 --- a/R/tm_g_gh_correlationplot.R +++ b/R/tm_g_gh_correlationplot.R @@ -517,7 +517,13 @@ srv_g_correlationplot <- function(id, teal.code::eval_code( code = bquote({ ANL <- .(as.name(dataset_var)) %>% # nolint - dplyr::filter(.data[[.(param_var)]] %in% union(.(input$xaxis_param), .(input$yaxis_param))) + dplyr::filter(.data[[.(param_var)]] %in% union(.(input$xaxis_param), .(input$yaxis_param))) %>% + dplyr::select( + .(c( + "USUBJID", input$trt_group, "AVISITCD", param_var, "PARAM", input$xaxis_var, input$yaxis_var, + "LOQFL", "LBSTRESC", unique(c(input$hline_vars, input$vline_vars)) + )) + ) }) ) validate_has_data(private_qenv[["ANL"]], 1) @@ -605,8 +611,8 @@ srv_g_correlationplot <- function(id, keep_data_const_opts_updated(session, input, anl_constraint, "xaxis_param") # selector names after transposition - xvar <- reactive(paste0(input$xaxis_var, ".", input$xaxis_param)) - yvar <- reactive(paste0(input$yaxis_var, ".", input$yaxis_param)) + xvar <- reactive(paste0(input$xaxis_var, "_", input$xaxis_param)) + yvar <- reactive(paste0(input$yaxis_var, "_", input$yaxis_param)) xloqfl <- reactive(paste0("LOQFL_", input$xaxis_param)) yloqfl <- reactive(paste0("LOQFL_", input$yaxis_param)) @@ -617,88 +623,76 @@ srv_g_correlationplot <- function(id, req(anl_constraint()) ANL <- anl_constraint()$ANL # nolint trt_group <- input$trt_group - line_vars <- unique(c(input$hline_vars, input$vline_vars)) - private_q <- anl_constraint()$qenv %>% teal.code::eval_code( + qenv <- anl_constraint()$qenv %>% teal.code::eval_code( code = bquote({ - ANL_TRANSPOSED1 <- ANL %>% # nolint - dplyr::select( - .data[["USUBJID"]], - .data[[.(trt_group)]], - .data[["AVISITCD"]], - .data[[.(param_var)]], - .data[[.(input$xaxis_var)]], - .data[[.(input$yaxis_var)]], - .(`if`(length(line_vars) == 0, NULL, line_vars)) - ) %>% - tidyr::pivot_longer( - c( - .data[[.(input$xaxis_var)]], - .data[[.(input$yaxis_var)]], - .(`if`(length(line_vars) == 0, NULL, line_vars)) - ), - names_to = "ANLVARS", - values_to = "ANLVALS" - ) %>% - tidyr::unite( - "ANL.PARAM", - "ANLVARS", - .(param_var), - sep = ".", - remove = TRUE - ) %>% - tidyr::pivot_wider(names_from = "ANL.PARAM", values_from = "ANLVALS") %>% - dplyr::filter(!is.na(.data[[.(xvar())]]) & !is.na(.data[[.(yvar())]])) - - ANL_TRANSPOSED2 <- ANL %>% # nolint - dplyr::select( - .data[["USUBJID"]], - .data[[.(trt_group)]], - .data[["AVISITCD"]], - .data[[.(param_var)]], - .data[["LOQFL"]], - .data[["PARAM"]], - .data[["LBSTRESC"]] - ) %>% - tidyr::pivot_longer( - c( - .data[["LOQFL"]], - .data[["PARAM"]], - .data[["LBSTRESC"]] - ), - names_to = "ANLVARS", - values_to = "ANLVALS" - ) %>% - tidyr::unite( - "ANL.PARAM", - "ANLVARS", - .(param_var), - sep = "_", - remove = TRUE - ) %>% - tidyr::pivot_wider(names_from = "ANL.PARAM", values_from = "ANLVALS") %>% - dplyr::mutate(LOQFL_COMB = dplyr::case_when( - .data[[.(xloqfl())]] == "Y" | .data[[.(yloqfl())]] == "Y" ~ "Y", - .data[[.(xloqfl())]] == "N" & .data[[.(yloqfl())]] == "N" ~ "N", - .data[[.(xloqfl())]] == "N" & .data[[.(yloqfl())]] == "NA" ~ "N", - .data[[.(xloqfl())]] == "NA" & .data[[.(yloqfl())]] == "N" ~ "N", - .data[[.(xloqfl())]] == "NA" & .data[[.(yloqfl())]] == "NA" ~ "NA", - TRUE ~ as.character(NA) - )) - - ANL_TRANSPOSED <- merge(ANL_TRANSPOSED1, ANL_TRANSPOSED2) # nolint + ANL_x <- ANL %>% # nolint + dplyr::filter(.data[[.(param_var)]] == .(input$xaxis_param) & !is.na(.data[[.(input$xaxis_var)]])) }) ) - validate(need(nrow(private_q[["ANL_TRANSPOSED"]]) > 0, "Plot Data No Observations Left")) - validate_has_variable(data = private_q[["ANL_TRANSPOSED"]], varname = c(xvar(), yvar(), xloqfl(), yloqfl())) + if (input$xaxis_var == "BASE") { + qenv <- qenv %>% within({ + ANL_x <- ANL_x |> # nolint + dplyr::group_by(.data[["USUBJID"]]) %>% + dplyr::mutate(LOQFL = .data[["LOQFL"]][.data[["AVISITCD"]] == "BL"]) %>% + dplyr::ungroup() + }) + } else if (input$xaxis_var != "AVAL") { + qenv <- qenv %>% within({ + ANL_x <- ANL_x |> # nolint + dplyr::mutate(LOQFL = "N") + }) + } + + qenv <- qenv %>% teal.code::eval_code( + code = bquote({ + ANL_y <- ANL %>% # nolint + dplyr::filter(.data[[.(param_var)]] == .(input$yaxis_param) & !is.na(.data[[.(input$yaxis_var)]])) + }) + ) + + if (input$yaxis_var == "BASE") { + qenv <- qenv %>% within({ + ANL_y <- ANL_y |> # nolint + dplyr::group_by(.data[["USUBJID"]]) %>% + dplyr::mutate(LOQFL = .data[["LOQFL"]][.data[["AVISITCD"]] == "BL"]) %>% + dplyr::ungroup() + }) + } else if (input$yaxis_var != "AVAL") { + qenv <- qenv %>% within({ + ANL_y <- ANL_y |> # nolint + dplyr::mutate(LOQFL = "N") + }) + } + + qenv <- qenv %>% teal.code::eval_code( + code = bquote({ + ANL_TRANSPOSED <- dplyr::full_join( # nolint + ANL_x, ANL_y, + by = c("USUBJID", "AVISITCD", .(trt_group)), + suffix = .(sprintf("_%s", c(input$xaxis_param, input$yaxis_param))) + ) + ANL_TRANSPOSED <- ANL_TRANSPOSED %>% # nolint + dplyr::mutate( + LOQFL_COMB = case_when( + .data[[.(xloqfl())]] == "Y" | .data[[.(yloqfl())]] == "Y" ~ "Y", + .data[[.(xloqfl())]] == "N" | .data[[.(yloqfl())]] == "N" ~ "N", + TRUE ~ "NA" + ) + ) + }) + ) + + validate(need(nrow(qenv[["ANL_TRANSPOSED"]]) > 0, "Plot Data No Observations Left")) + validate_has_variable(data = qenv[["ANL_TRANSPOSED"]], varname = c(xvar(), yvar(), xloqfl(), yloqfl())) - private_q <- teal.code::eval_code( - object = private_q, + qenv <- teal.code::eval_code( + object = qenv, code = bquote(attr(ANL_TRANSPOSED[[.(trt_group)]], "label") <- attr(ANL[[.(trt_group)]], "label")) # nolint ) - return(list(ANL_TRANSPOSED = private_q[["ANL_TRANSPOSED"]], qenv = private_q)) + return(list(ANL_TRANSPOSED = qenv[["ANL_TRANSPOSED"]], qenv = qenv)) }) plot_labels <- reactive({ @@ -747,7 +741,7 @@ srv_g_correlationplot <- function(id, hline_vars <- if (length(input$hline_vars) == 0) { NULL } else { - paste0(input$hline_vars, ".", yaxis_param) + paste0(input$hline_vars, "_", yaxis_param) } vline_arb <- vertical_line()$line_arb vline_arb_label <- vertical_line()$line_arb_label @@ -755,7 +749,7 @@ srv_g_correlationplot <- function(id, vline_vars <- if (length(input$vline_vars) == 0) { NULL } else { - paste0(input$vline_vars, ".", xaxis_param) + paste0(input$vline_vars, "_", xaxis_param) } facet_ncol <- input$facet_ncol validate(need( From 5faa22d6f393610be327857e90d7cb028451496c Mon Sep 17 00:00:00 2001 From: gogonzo Date: Thu, 27 Jun 2024 13:53:49 +0000 Subject: [PATCH 2/2] [skip actions] Bump version to 0.1.15.9025 --- DESCRIPTION | 4 ++-- NEWS.md | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index cbd3b530..321b6837 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Type: Package Package: teal.goshawk Title: Longitudinal Visualization `teal` Modules -Version: 0.1.15.9024 -Date: 2024-06-19 +Version: 0.1.15.9025 +Date: 2024-06-27 Authors@R: c( person("Nick", "Paszty", , "nick.paszty@gene.com", role = c("aut", "cre")), person("Dawid", "Kaledkowski", , "dawid.kaledkowski@roche.com", role = "aut"), diff --git a/NEWS.md b/NEWS.md index d9ca2600..1c966755 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# teal.goshawk 0.1.15.9024 +# teal.goshawk 0.1.15.9025 * Removed `Show Warnings` modals from modules.