Correlation Plot: regression line #255
Comments
|
set to low-priority as it isn't a blocker for now to needing to tag and release. |
|
To add more context:
Steps to reproduce:
For convenience, here is the error
Acceptance Criteria
@npaszty |
|
yes, I think you're right that the mcr error comes from its use in the goshawk package. |
|
To transfer, it's on the right hand side of the issue: 
No worries, I'll move this. |
|
@donyunardi |
|
Hey, the code that reproduces the issue, so it's simpler for the person handling the issue (note that between library(shiny)
library(dplyr)
library(goshawk)
library(teal.code)
library(teal.data)
library(teal.slice)
library(teal)
library(teal.transform)
library(teal.goshawk)
library(formatters)
library(magrittr)
library(rtables)
library(tern)
library(teal.modules.clinical)
library(ggplot2)
library(ggmosaic)
library(teal.modules.general)
library(DescTools)
library(random.cdisc.data)
library(stringr)
library(sparkline)
library(DescTools)
library(magrittr)
library(dplyr)
library(random.cdisc.data)
library(stringr)
library(sparkline)
`%make_label%` <- function(lhv, label) {
attr(lhv, "label") <- label
lhv
}
`%keep_label%` <- function(lhv, rhv) {
attributes(lhv) <- attributes(rhv)
lhv
}
ADSL <- radsl(seed = 1)
ADLB <- radlb(ADSL, seed = 1)
exclude_l2 <- c("")
exclude_chg <- c("")
arm_mapping <- list(`A: Drug X` = "Drug X 100mg", `C: Combination` = "Combination 100mg", `B: Placebo` = "Placebo")
ADSL <- ADSL %>% filter(ITTFL == "Y") %>% mutate(TRTORD = case_when(TRT01P == "A: Drug X" ~ 1, TRT01P == "C: Combination" ~ 2, TRT01P == "B: Placebo" ~ 3, TRUE ~ as.numeric(NA)), TRTORD = TRTORD %make_label% "Treatment Order", TRT01P = as.character(arm_mapping[match(TRT01P, names(arm_mapping))]), TRT01P = factor(ARM) %>% reorder(TRTORD), TRT01P = TRT01P %make_label% "Planned Treatment for Period 01")
char_vars_adsl <- names(Filter(isTRUE, sapply(ADSL, is.character)))
ADSL <- ADSL %>% mutate_at(char_vars_adsl, factor)
ADLB_SUBSET <- ADLB %>% filter(!is.na(AVAL)) %>% filter(ITTFL == "Y" & toupper(AVISIT) %like any% c("SCREEN%", "BASE%", "%WEEK%", "%FOLLOW%")) %>% select(c("STUDYID", "USUBJID", "ITTFL", "ARM", "ARMCD", "ACTARM", "ACTARMCD", "TRT01P", "TRT01A", "AVISIT", "AVISITN", "ADY", "PARAM", "PARAMCD", "AVAL", "AVALU", "BASE", "CHG", "PCHG", "ANRLO", "ANRHI", "LBSTRESC", "SEX", "RACE", "LOQFL")) %>% mutate(AVISITCD = case_when(toupper(AVISIT) == "SCREENING" ~ "SCR", toupper(AVISIT) == "BASELINE" ~ "BL", grepl("WEEK",
toupper(AVISIT)) ~ paste("W", trimws(substr(AVISIT, start = 6, stop = stringr::str_locate(AVISIT, "DAY") - 1))), grepl("FOLLOW", toupper(AVISIT)) ~ "FU", TRUE ~ as.character(NA)), AVISITCDN = case_when(AVISITCD == "SCR" ~ -2, AVISITCD == "BL" ~ 0, grepl("W", AVISITCD) ~ as.numeric(gsub("[^0-9]+", "", AVISITCD)) * 7, AVISITCD == "FU" ~ 100, TRUE ~ as.numeric(NA)), TRTORD = case_when(TRT01P == "A: Drug X" ~ 1, TRT01P == "C: Combination" ~ 2, TRT01P == "B: Placebo" ~ 3, TRUE ~ as.numeric(NA)), LOQFL = if_else(as.character(LOQFL) ==
"Y", as.character(LOQFL), "N"), BASE2 = NA, CHG2 = NA, PCHG2 = NA) %>% rowwise() %>% group_by(PARAMCD) %>% mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE), paste("<", round(runif(1, min = 25, max = 30))), LBSTRESC)) %>% mutate(LBSTRESC = ifelse(USUBJID %in% sample(USUBJID, 1, replace = TRUE), paste(">", round(runif(1, min = 70, max = 75))), LBSTRESC)) %>% ungroup()
attr(ADLB_SUBSET[["LBSTRESC"]], "label") <- "Character Result/Finding in Std Format"
attr(ADLB_SUBSET[["ANRLO"]], "label") <- "Analysis Normal Range Lower Limit"
attr(ADLB_SUBSET[["ANRHI"]], "label") <- "Analysis Normal Range Upper Limit"
PARAM_MINS <- ADLB_SUBSET %>% select(USUBJID, PARAMCD, AVAL) %>% group_by(PARAMCD) %>% summarise(AVAL_MIN = min(AVAL, na.rm = TRUE), .groups = "drop") %>% mutate(PARAMCD = PARAMCD %make_label% "Parameter Code")
ADLB_SUPED1 <- ADLB_SUBSET %>% mutate(BASE2 = ifelse(toupper(AVISIT) == "SCREENING" & is.na(BASE2), AVAL, BASE2) %keep_label% BASE2) %>% mutate(CHG2 = ifelse(toupper(AVISIT) == "SCREENING" & is.na(CHG2), 0, CHG2) %keep_label% CHG2) %>% mutate(PCHG2 = ifelse(toupper(AVISIT) == "SCREENING" & is.na(PCHG2), 0, PCHG2) %keep_label% PCHG2) %>% mutate(BASE = ifelse(toupper(AVISIT) == "BASELINE" & is.na(BASE), AVAL, BASE) %keep_label% BASE) %>% mutate(CHG = ifelse(toupper(AVISIT) == "BASELINE" & is.na(CHG),
0, CHG) %keep_label% CHG) %>% mutate(PCHG = ifelse(toupper(AVISIT) == "BASELINE" & is.na(PCHG), 0, PCHG) %keep_label% PCHG) %>% mutate(TRTORD = TRTORD %make_label% "Treatment Order")
ADLB_SUPED2 <- inner_join(PARAM_MINS, ADLB_SUPED1, by = "PARAMCD")[, union(names(ADLB_SUPED1), names(PARAM_MINS))] %>% mutate(AVALL2 = ifelse(PARAMCD %in% exclude_l2, AVAL, ifelse(PARAMCD %in% exclude_chg, NA, ifelse(AVAL == 0 & AVAL_MIN > 0, log2(AVAL_MIN/2), ifelse(AVAL == 0 & AVAL_MIN <= 0, NA, ifelse(AVAL > 0, log2(AVAL), NA))))) %make_label% "Log2 of AVAL") %>% mutate(BASEL2 = ifelse(PARAMCD %in% exclude_l2, BASE, ifelse(PARAMCD %in% exclude_chg, NA, ifelse(BASE == 0 & AVAL_MIN > 0, log2(AVAL_MIN/2),
ifelse(BASE == 0 & AVAL_MIN <= 0, NA, ifelse(BASE > 0, log2(BASE), NA))))) %make_label% "Log2 of BASE") %>% mutate(BASE2L2 = ifelse(PARAMCD %in% exclude_l2, BASE2, ifelse(PARAMCD %in% exclude_chg, NA, ifelse(BASE2 == 0 & AVAL_MIN > 0, log2(AVAL_MIN/2), ifelse(BASE2 == 0 & AVAL_MIN <= 0, NA, ifelse(BASE2 > 0, log2(BASE2), NA))))) %make_label% "Log2 of BASE2") %>% mutate(AVAL_MIN = AVAL_MIN %make_label% "Minimum AVAL Within PARAMCD")
ADLB <- ADLB_SUPED2 %>% mutate(TRT01P = as.character(arm_mapping[match(TRT01P, names(arm_mapping))]), TRT01P = factor(TRT01P) %>% reorder(TRTORD) %make_label% "Planned Treatment for Period 01", TRT01A = as.character(arm_mapping[match(TRT01A, names(arm_mapping))]), TRT01A = factor(TRT01A) %>% reorder(TRTORD) %make_label% "Actual Treatment for Period 01", LOQFL = LOQFL %make_label% "Limit of Quantification", AVISITCD = factor(AVISITCD) %>% reorder(AVISITCDN) %make_label% "Analysis Visit Window Code",
AVISITCDN = AVISITCDN %make_label% "Analysis Visit Window Code (N)", BASE2 = BASE2 %make_label% "Screening Value", CHG2 = CHG2 %make_label% "Absolute Change from Screening", PCHG2 = PCHG2 %make_label% "Percent Change from Screening")
ADLB_LOQS <- goshawk:::h_identify_loq_values(ADLB, flag_var = "LOQFL")
ADLB <- left_join(ADLB, ADLB_LOQS, by = "PARAM")
# stopifnot(rlang::hash(ADSL) == "6a0d37a2dc4a81d7ff62dd65e4bc324a")
# stopifnot(rlang::hash(ADLB) == "3c8a641b2a2df269fbc095cacf0a4360")
ADLB <- dplyr::inner_join(x = ADLB, y = ADSL[, c("STUDYID", "USUBJID"), drop = FALSE], by = c("STUDYID", "USUBJID"))
ANL <- ADLB %>% dplyr::filter(.data[["PARAMCD"]] %in% union("ALT", "ALT")) %>% dplyr::select(c("USUBJID", "TRT01A", "AVISITCD", "PARAMCD", "PARAM", "CHG", "AVAL", "LOQFL", "LBSTRESC"))
ANL_x <- ANL %>% dplyr::filter(.data[["PARAMCD"]] == "ALT" & !is.na(.data[["CHG"]]))
ANL_x <- dplyr::mutate(ANL_x, LOQFL = "N")
ANL_y <- ANL %>% dplyr::filter(.data[["PARAMCD"]] == "ALT" & !is.na(.data[["AVAL"]]))
ANL_TRANSPOSED <- dplyr::inner_join(ANL_x, ANL_y, by = c("USUBJID", "AVISITCD", "TRT01A"), suffix = c("_ALT", "_ALT"))
ANL_TRANSPOSED <- ANL_TRANSPOSED %>% dplyr::mutate(LOQFL_COMB = case_when(.data[["LOQFL_ALT"]] == "Y" | .data[["LOQFL_ALT"]] == "Y" ~ "Y", .data[["LOQFL_ALT"]] == "N" | .data[["LOQFL_ALT"]] == "N" ~ "N", TRUE ~ "NA"))
attr(ANL_TRANSPOSED[["TRT01A"]], "label") <- attr(ANL[["TRT01A"]], "label")
p <- goshawk::g_correlationplot(
data = ANL_TRANSPOSED,
param_var = "PARAMCD",
xaxis_param = "ALT",
xaxis_var = "CHG",
xvar = "CHG_ALT",
yaxis_param = "ALT",
yaxis_var = "AVAL",
yvar = "AVAL_ALT",
trt_group = "TRT01A",
xlim = c(-48, 47),
ylim = c(0, 55),
title_text = "Alanine Aminotransferase Measurement and Alanine Aminotransferase Measurement @ Visits",
xaxis_lab = "Alanine Aminotransferase Measurement CHG Values",
yaxis_lab = "Alanine Aminotransferase Measurement AVAL Values",
color_manual =
c(`Drug X 100mg` = "#1e90ff",
`Combination 100mg` = "#bb9990",
Placebo = "#ffa07a"),
shape_manual = c(N = 1, Y = 2, `NA` = 0),
facet_ncol = 2,
visit_facet = TRUE,
facet = FALSE,
facet_var = "TRT01A",
reg_line = FALSE,
font_size = 12,
dot_size = 1,
reg_text_size = 3,
loq_legend = TRUE,
rotate_xlab = TRUE,
hline_arb = c(10, 30),
hline_arb_label = "arb hori label",
hline_arb_color = c("red", "blue"),
hline_vars = NULL,
hline_vars_colors = character(0),
hline_vars_labels = " - ALT",
vline_arb = c(50, 70),
vline_arb_label = "arb vert A",
vline_arb_color = c("green", "orange"),
vline_vars = NULL,
vline_vars_colors = character(0),
vline_vars_labels = " - ALT"
)
p_error <- goshawk::g_correlationplot(
data = ANL_TRANSPOSED,
param_var = "PARAMCD",
xaxis_param = "ALT",
xaxis_var = "CHG",
xvar = "CHG_ALT",
yaxis_param = "ALT",
yaxis_var = "AVAL",
yvar = "AVAL_ALT",
trt_group = "TRT01A",
xlim = c(-48, 47),
ylim = c(0, 55),
title_text = "Alanine Aminotransferase Measurement and Alanine Aminotransferase Measurement @ Visits",
xaxis_lab = "Alanine Aminotransferase Measurement CHG Values",
yaxis_lab = "Alanine Aminotransferase Measurement AVAL Values",
color_manual =
c(`Drug X 100mg` = "#1e90ff",
`Combination 100mg` = "#bb9990",
Placebo = "#ffa07a"),
shape_manual = c(N = 1, Y = 2, `NA` = 0),
facet_ncol = 2,
visit_facet = TRUE,
facet = FALSE,
facet_var = "TRT01A",
reg_line = TRUE,
font_size = 12,
dot_size = 1,
reg_text_size = 3,
loq_legend = TRUE,
rotate_xlab = TRUE,
hline_arb = c(10, 30),
hline_arb_label = "arb hori label",
hline_arb_color = c("red", "blue"),
hline_vars = NULL,
hline_vars_colors = character(0),
hline_vars_labels = " - ALT",
vline_arb = c(50, 70),
vline_arb_label = "arb vert A",
vline_arb_color = c("green", "orange"),
vline_vars = NULL,
vline_vars_colors = character(0),
vline_vars_labels = " - ALT"
)
|
|
The error is cause in the slope <- function(x, y) {
ratio <- stats::sd(x) / stats::sd(y)
if (!is.na(ratio) && ratio > 0) {
reg <- mc.deming(y, x, ratio)
# return the evaluation of the ratio condition as third value in numeric vector to control
# downstream processing
return(c(round(reg$b0, 2), round(reg$b1, 2), !is.na(ratio) & ratio > 0))
}
# if ratio condition is not met then assign NA to vector so that NULL condition does not throw
# the error below
return(as.numeric(c(NA, NA, NA)))
}
error_group <-
ANL_TRANSPOSED %>%
filter(TRT01A == "Drug X 100mg" & AVISITCD == "BL")
error_group %>%
pull(CHG_ALT) %>%
table
> 0
> 133
slope(error_group$AVAL_ALT, error_group$CHG_ALT)
> Error in mc.deming(y, x, ratio) :
> NA/NaN/Inf in foreign function call (arg 4)I believe it's an disability to create a regression line for the plot that has all values on the same X axis :) 
|
|
Created a fix for this issue in this PR and assigned @donyunardi for the review #258 |
What happened?
selecting eithr CHG or PCHG for the x-axis biomarker results in error if regression line is included. could not trigger same error from y-axis analysis variable when selecting CHG or PCHG. this is a bug but I don't know what the best approach is since the regression package used is not NEST it's mcr package from CRAN.
sessionInfo()
Relevant log output
Code of Conduct
Contribution Guidelines
Security Policy
The text was updated successfully, but these errors were encountered: