Skip to content

Commit

Permalink
simplify module and fix LOQFL_COMB (#283)
Browse files Browse the repository at this point in the history 
alternative to
#280

Simplified the code by replacing pivot_ calls with simple filter and
select.
  • Loading branch information
@gogonzo
gogonzo committed Jun 27, 2024
1 parent 0efb541 commit 66600b7
Show file tree
Hide file tree
Showing 2 changed files with 73 additions and 80 deletions.
3 changes: 1 addition & 2 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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),
Expand Down
150 changes: 72 additions & 78 deletions R/tm_g_gh_correlationplot.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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))

Expand All @@ -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({
Expand Down Expand Up @@ -747,15 +741,15 @@ 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
vline_arb_color <- vertical_line()$line_arb_color
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(
Expand Down

0 comments on commit 66600b7

Please sign in to comment.