Merge pull request #153 from SafetyGraphics/108-add-buncreatinine-chart

108 add buncreatinine chart

.Rbuildignore

@@ -7,3 +7,6 @@
 ^\.lintr$
 ^_pkgdown\.yml$
 ^pkgdown$
+^nepExplorer\.Rcheck$
+^nepExplorer.*\.tar\.gz$
+^nepExplorer.*\.tgz$

.gitignore

@@ -109,3 +109,6 @@ dist
 .Rhistory
 .RData
 docs
+nepExplorer.Rcheck/
+nepExplorer*.tar.gz
+nepExplorer*.tgz

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: nepExplorer
 Type: Package
-Title: Interactive Graphic for Exploring Kidney Function Data in Clinical Trials.
+Title: Interactive Graphic for Exploring Kidney Function Data in Clinical Trials
 Version: 0.1.0
 Authors@R: c(
 	person("Preston", "Burns", email = "[email protected]", role = c("cre","aut")),
@@ -15,7 +15,7 @@ Depends: R (>= 4.0)
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Imports:
     shiny,
     dplyr,

R/create_nepexplorer_app.R

@@ -26,6 +26,7 @@ if (is.null(mapping)) {
                                                        "eGFR" = "eGFR",
                                                        "eGFRcys" = "eGFRcys",
                                                        "ALB/CREAT" = "Albumin/Creatinine",
+                                                       "BUN/CREAT" = "Blood Urea Nitrogen/Creatinine",
                                                        "BICARB" =  "Bicarbonate",
                                                        "BUN" =  "Blood Urea Nitrogen",
                                                        "CA" = "Calcium",

R/patient_profile_charts.R

@@ -99,14 +99,14 @@ drawRawChange <- function(adlb, settings, labs = c("Creatinine", "Cystatin C"),
   n_orig_test <- n_distinct(adlb_raw_chg[[settings$measure_col]]) #save number of tests for warning information later
 
   # Add units to Test so that legend includes units for user to see, if units provided in data
-  
+
   if (settings$unit_col != "") {
-  
+
   adlb_raw_chg <- adlb_raw_chg %>%
     mutate(!!settings$measure_col := paste0(.data[[settings$measure_col]], " (", .data[[settings$unit_col]], ")"))
 
   }
-  
+
   n_der_test <- n_distinct(adlb_raw_chg[[settings$measure_col]])
 
   if (n_orig_test != n_der_test) {
@@ -201,7 +201,7 @@ drawULNFoldChange <- function(adlb, settings,
     theme(legend.title = element_blank()) + #remove legend title
     ylab("xULN (Fold Change)") +
     xlab("Study Day") +
-    scale_colour_manual(values = brewer.pal(9, "Set1")[-6], name = "Lab Test") + #drop yellow
+    scale_colour_manual(values = brewer.pal(9, "Set1")[-6], name = "Lab Test") + # drop yellow
 
     ## Add ULN Annotation
     geom_hline(yintercept = 1, linetype = "dashed", color = "gray") +
@@ -286,9 +286,12 @@ drawNormalizedAlbumin <- function(adlb, settings) {
 
   adlb_norm <- adlb %>%
     filter(.data[[settings$measure_col]] == settings$measure_values[["ALB/CREAT"]])
-
-  uacr_unit <- unique(adlb_norm[[settings$unit_col]])
-
+  if (is.null(adlb_norm[[settings$unit_col]]) || all(adlb_norm[[settings$unit_col]] == "")) {
+    uacr_unit <- "Ratio"
+  } else {
+    uacr_unit <- unique(adlb_norm[[settings$unit_col]])
+  }
+
   if (length(uacr_unit) > 1)
     warning(paste0("Multiple units have been provided for UACR, therefore unit will",
                    " not be displayed on the Y-axis. Standardize units to see unit on Y-axis."))
@@ -358,3 +361,52 @@ drawDemoTable <- function(adlb, settings, demo_vars = c("USUBJID", "AGE", "SEX",
     gt()
 
 }
+
+#' Draw BUN/serum creatinine over time,
+#'
+#' @param adlb lab data in tall format that must contain DY for study day,
+#'   VISITN for visit number, TEST for lab test, and STRESN for lab value
+#' @param settings settings object with column mappings
+#'
+#' @import ggplot2
+#' @import dplyr
+#' @import RColorBrewer
+#' @importFrom plotly ggplotly
+#' @importFrom plotly config
+#' @return ggplot object
+drawBunCreat <- function(adlb, settings) {
+  adlb_norm <- adlb %>%
+    filter(.data[[settings$measure_col]] == settings$measure_values[["BUN/CREAT"]])
+
+  if (is.null(adlb_norm[[settings$unit_col]]) || all(adlb_norm[[settings$unit_col]] == "")) {
+    ubuncr_unit <- "Ratio"
+  } else {
+    ubuncr_unit <- unique(adlb_norm[[settings$unit_col]])
+  }
+
+  if (length(ubuncr_unit) > 1)
+    warning(paste0("Multiple units have been provided for UBUNCR, therefore unit will",
+                   " not be displayed on the Y-axis. Standardize units to see unit on Y-axis."))
+
+  p <- ggplot(adlb_norm, aes(x = .data[[settings$studyday_col]], y = .data[[settings$value_col]],
+                             color = .data[[settings$measure_col]], group = .data[[settings$measure_col]],
+                             text = paste0("Study Day: ", .data[[settings$studyday_col]], "\n",
+                                           "Lab Test: ", .data[[settings$measure_col]], "\n",
+                                           "Raw Value: ", format(round(.data[[settings$value_col]], 2), nsmall = 2)
+                             ))) +
+    geom_line() +
+    geom_point() +
+    theme_bw() +
+    theme(legend.title = element_blank()) + #remove legend title
+    ylab(ubuncr_unit) +
+    xlab("Study Day") +
+    scale_colour_manual(values = brewer.pal(9, "Set1")[-6], name = "Lab Test") #drop yellow
+
+    p <- p +
+      ## Add two threshold lines, one at 10 and one at 20.
+      geom_hline(yintercept = 10, linetype = "dashed", color = "gray") +
+      geom_hline(yintercept = 20, linetype = "dashed", color = "gray")
+
+  ggplotly(p, tooltip = "text") %>%
+    config(displayModeBar = FALSE)
+}

R/patient_profile_mod.R

@@ -15,6 +15,7 @@ patientProfileUI <-  function(id) {
     uiOutput(ns("ULN_FC")),
     uiOutput(ns("blood_pressure")),
     uiOutput(ns("normalized_albumin")),
+    uiOutput(ns("bun_creat"))
   )
 }
 
@@ -95,11 +96,12 @@ patientProfileServer <-  function(id, df, selected_measures, settings, subj_id)
       })
 
       output$ULN_FC <- renderUI({
-
-        available_labs <- intersect(patient_df[[lab_settings$measure_col]] %>%  unique(), selected_measures)
-
+        available_labs <-
+          intersect(patient_df[[lab_settings$measure_col]] %>%  unique(), selected_measures)
+        
         if (length(available_labs) > 0) {
-          drawULNFoldChange(adlb = patient_df, settings = lab_settings,
+          drawULNFoldChange(adlb = patient_df,
+                            settings = lab_settings,
                             labs = available_labs)
         } else {
           div()
@@ -130,6 +132,16 @@ patientProfileServer <-  function(id, df, selected_measures, settings, subj_id)
           div()
         }
       })
+
+      output$bun_creat <- renderUI({
+
+        if (length(lab_settings$measure_values[["BUN/CREAT"]] %in%
+                   patient_df[[lab_settings$measure_col]] %>%  unique()) > 0) {
+          drawBunCreat(adlb = patient_df, settings = lab_settings)
+        } else {
+          div()
+        }
+      })
 
     }
   )

data-raw/meta_nepExplorer.csv

@@ -10,8 +10,9 @@ measure_values--DIABP,vitals,measure_col,DIABP,field,Diastolic value,Value used
 unit_col,vitals,unit_col,,column,Unit column,Unit of measure variable name,FALSE,,VSSTRESU
 vs_baseline_flag,vitals,vs_baseline_flag,,column,Vital Signs Baseline Flag,Column for assigning VS baseline visits,FALSE,ABLFL,
 vs_baseline_values--Y,vitals,vs_baseline_flag,Y,field,Vital Signs Baseline Flag value,Value used for VS Baseline in the specified baseline column,FALSE,Y,
-measure_values--ALB,labs,measure_col,ALB,field,Albumin value,Value used for Albumin in the specified measure column,FALSE,Albumin (g/L),Albumin
-measure_values--Albumin/Creatinine,labs,measure_col,ALB/CREAT,field,Albumin/Creatinine Ratio value,Value used for Albumin/Creatinine ratio in the specified measure column,FALSE,Albumin/Creatinine,
+measure_values--ALB,labs,measure_col,ALB,field,Albumin value,Value used for Albumin in the specified measure column,FALSE,Albumin (mg/dL),Albumin
+measure_values--ALB/CREAT,labs,measure_col,ALB/CREAT,field,Albumin/Creatinine Ratio value,Value used for Albumin/Creatinine ratio in the specified measure column,FALSE,Albumin/Creatinine,
+measure_values--BUN/CREAT,labs,measure_col,BUN/CREAT,field,Blood Urea Nitrogen/Creatinine Ratio value,Value used for Blood Urea Nitrogen/Creatinine ratio in the specified measure column,FALSE,Blood Urea Nitrogen/Creatinine,
 measure_values--nepFC_BICARB,labs,measure_col,BICARB,field,Bicarbonate value,Value used for Bicarbonate in the specified measure column,FALSE,Bicarbonate (umol/L),Bicarbonate
 measure_values--nepFC_BUN,labs,measure_col,BUN,field,Blood Urea Nitrogen value,Value used for Blood Urea Nitrogen in the specified measure column,FALSE,Blood Urea Nitrogen (mmol/L),Blood Urea Nitrogen
 measure_values--nepFC_CA,labs,measure_col,CA,field,Calcium value,Value used for Calcium in the specified measure column,FALSE,Calcium (mmol/L),Calcium

data-raw/save_adlb.R

@@ -1,18 +1,71 @@
 # test file from
 # https://raw.githubusercontent.com/RhoInc/data-library/master/data/clinical-trials/renderer-specific/adbds.csv"
+# The conversion factors may vary based on your specific data.
+# It's recommended to use the conversion units established by your
+# own sponsor lab conversions.
 
-adlb <- read.csv("https://raw.githubusercontent.com/RhoInc/data-library/master/data/clinical-trials/renderer-specific/adbds.csv",
+# Helper functions for unit conversions - shortened names
+# The conversion factors may vary based on your specific data.
+# It's recommended to use the conversion units established by your
+# own sponsor lab conversions.
+
+# 1 mg/dL creatinine = 88.4 µmol/L
+convert_creat_to_mgdl <- function(value) {
+  value / 88.4
+}
+# 1 mmol/L BUN = 2.8 mg/dL
+convert_bun_to_mgdl <- function(value) {
+  value * 2.86
+}
+# 1 g/L ALB = 100 mg/dL
+convert_alb_to_mgdl <- function(value) {
+  value * 100
+}
+
+adlb_ <- read.csv("https://raw.githubusercontent.com/RhoInc/data-library/master/data/clinical-trials/renderer-specific/adbds.csv",
                  encoding = "UTF-8") %>%
-  mutate(STRESN  = ifelse(TEST == "Creatinine" & STRESU == "μmol/L", STRESN * .0113, STRESN), #Convert μmol/L to mg/dL
-         STRESU  = ifelse(TEST == "Creatinine" & STRESU == "μmol/L", "mg/dL", STRESU),
+  mutate(
+    # Use case_when for clearer conditional logic
+    STRESN = case_when(
+      TEST == "Creatinine" ~ convert_creat_to_mgdl(STRESN),
+      TEST == "Blood Urea Nitrogen"   ~ convert_bun_to_mgdl(STRESN),
+      TEST == "Albumin"   ~ convert_alb_to_mgdl(STRESN),
+      TRUE               ~ STRESN
+    ),
+    STNRLO = case_when(
+      TEST == "Creatinine" ~ convert_creat_to_mgdl(STNRLO),
+      TEST == "Blood Urea Nitrogen"   ~ convert_bun_to_mgdl(STNRLO),
+      TEST == "Albumin"   ~ convert_alb_to_mgdl(STNRLO),
+      TRUE               ~ STNRLO
+    ),
+    STNRHI = case_when(
+      TEST == "Creatinine" ~ convert_creat_to_mgdl(STNRHI),
+      TEST == "Blood Urea Nitrogen"   ~ convert_bun_to_mgdl(STNRHI),
+      TEST == "Albumin"   ~ convert_alb_to_mgdl(STNRHI),
+      TRUE               ~ STNRHI
+    ),
+    STRESU = ifelse(TEST %in% c("Creatinine", "Blood Urea Nitrogen", "Albumin"), "mg/dL",
+                    ifelse(TEST == "Albumin/Creatinine", "Ratio", STRESU)),
+    BLFL = ifelse(VISIT == "Screening", TRUE, FALSE) # add baseline column
   ) %>%
-  mutate(BLFL = ifelse(VISIT == "Screening", TRUE, FALSE)) %>% # add baseline column
   ungroup() %>%
   filter(!(TEST %in% c("Diastolic Blood Pressure",
                      "Heart Rate",
                      "Respiratory Rate",
                      "Systolic Blood Pressure",
                      "Temperature", "")))
 
+# derive BUN/serum creatinine ratio
+adlb <- adlb_ %>%
+  filter(TEST %in% c("Blood Urea Nitrogen", "Creatinine")) %>%
+  select(-c("STNRLO", "STNRHI")) %>%
+  tidyr::spread(TEST, STRESN) %>%
+  mutate(STRESN = `Blood Urea Nitrogen` / Creatinine,
+         TEST = "Blood Urea Nitrogen/Creatinine",
+         STRESU = "Ratio") %>%
+  select(-c("Blood Urea Nitrogen", "Creatinine")) %>%
+  dplyr::bind_rows(adlb_)
+
+
 usethis::use_data(adlb, overwrite = TRUE)
 

inst/examples/safetyGraphics_demo_app.R

@@ -7,17 +7,117 @@ library(safetyGraphics)
     safetyGraphics::makeChartConfig(),
     safetyGraphics::makeChartConfig(packages = "nepExplorer", packageLocation = "./inst/config", sourceFiles = TRUE)
   )
-  
+
   charts$nepexplorerMod$meta <- nepExplorer::meta_nepExplorer
-
-  adam_adlbc <- safetyData::adam_adlbc |>
-    mutate(STRESU = gsub("[\\(\\)]", "", regmatches(PARAM, gregexpr("\\(.*?\\)", PARAM))[[1]]),
-           STRESU = ifelse(PARAM == "Creatinine (umol/L)", "mg/dL", STRESU), # convert creatine to mg/dL
-           AVAL = ifelse(PARAM == "Creatinine (umol/L)", AVAL * .0113, AVAL),
-           PARAM = ifelse(PARAM == "Creatinine (umol/L)", "Creatinine (mg/dL)", PARAM))
-
+
+  # Helper functions for unit conversions - shortened names
+  # The conversion factors may vary based on your specific data.
+  # It's recommended to use the conversion units established by your
+  # own sponsor lab conversions.
+
+  # 1 mg/dL creatinine = 88.4 µmol/L
+  convert_creat_to_mgdl <- function(value) {
+    value / 88.4
+  }
+  # 1 mmol/L BUN = 2.8 mg/dL
+  convert_bun_to_mgdl <- function(value) {
+    value * 2.86
+  }
+  # 1 g/L ALB = 100 mg/dL
+  convert_alb_to_mgdl <- function(value) {
+    value * 100
+  }
+
+  # Apply unit conversions and data cleaning
+  adam_adlbc_ <- safetyData::adam_adlbc |>
+    mutate(
+      STRESU = gsub("[\\(\\)]", "", regmatches(PARAM, gregexpr("\\(.*?\\)", PARAM))[[1]]),
+      # Use case_when for clearer conditional logic
+      AVAL = case_when(
+        PARAMCD == "CREAT" ~ convert_creat_to_mgdl(AVAL),
+        PARAMCD == "BUN"   ~ convert_bun_to_mgdl(AVAL),
+        PARAMCD == "ALB"   ~ convert_alb_to_mgdl(AVAL),
+        TRUE               ~ AVAL
+      ),
+      BASE = case_when(
+        PARAMCD == "CREAT" ~ convert_creat_to_mgdl(BASE),
+        PARAMCD == "BUN"   ~ convert_bun_to_mgdl(BASE),
+        PARAMCD == "ALB"   ~ convert_alb_to_mgdl(BASE),
+        TRUE               ~ BASE
+      ),
+      CHG = case_when(
+        PARAMCD == "CREAT" ~ convert_creat_to_mgdl(CHG),
+        PARAMCD == "BUN"   ~ convert_bun_to_mgdl(CHG),
+        PARAMCD == "ALB"   ~ convert_alb_to_mgdl(CHG),
+        TRUE               ~ CHG
+      ),
+      A1LO = case_when(
+        PARAMCD == "CREAT" ~ convert_creat_to_mgdl(A1LO),
+        PARAMCD == "BUN"   ~ convert_bun_to_mgdl(A1LO),
+        PARAMCD == "ALB"   ~ convert_alb_to_mgdl(A1LO),
+        TRUE               ~ A1LO
+      ),
+      A1HI = case_when(
+        PARAMCD == "CREAT" ~ convert_creat_to_mgdl(A1HI),
+        PARAMCD == "BUN"   ~ convert_bun_to_mgdl(A1HI),
+        PARAMCD == "ALB"   ~ convert_alb_to_mgdl(A1HI),
+        TRUE               ~ A1HI
+      ),
+      LBSTRESN = case_when(
+        PARAMCD == "CREAT" ~ convert_creat_to_mgdl(LBSTRESN),
+        PARAMCD == "BUN"   ~ convert_bun_to_mgdl(LBSTRESN),
+        PARAMCD == "ALB"   ~ convert_alb_to_mgdl(LBSTRESN),
+        TRUE               ~ LBSTRESN
+      ),
+      STRESU = ifelse(PARAMCD %in% c("BUN", "CREAT", "ALB"), "mg/dL", STRESU),
+      PARAM = case_when(
+        PARAM == "Creatinine (umol/L)"                ~ "Creatinine (mg/dL)",
+        PARAM == "Blood Urea Nitrogen (mmol/L)"       ~ "Blood Urea Nitrogen (mg/dL)",
+        PARAM == "Albumin (g/L)"                      ~ "Albumin (mg/dL)",
+        TRUE                                         ~ PARAM
+      ) # todo: consider removing the units from the PARAM column - if this is implemented also update meta_nepExplorer
+    )
+  # derive BUN/serum creatinine ratio
+  # Filter and select relevant columns
+  adam_adlbc_filtered <- adam_adlbc_ %>%
+    filter(PARAMCD %in% c("BUN", "CREAT", "ALB")) %>%
+    select(
+      -A1LO, -A1HI, -R2A1LO, -R2A1HI, -BR2A1LO, -BR2A1HI,
+      -ALBTRVAL, -ANRIND, -BNRIND, -ABLFL, -AENTMTFL, -LBSEQ,
+      -LBNRIND, -AVAL, -BASE, -CHG, -PARAMN, -PARAM
+    )
+
+  # Reshape the data
+  adam_adlbc_wide <- adam_adlbc_filtered %>%
+    tidyr::spread(PARAMCD, LBSTRESN)
+
+  # Calculate BUN/CREAT ratio
+  adam_adlbc_bc <- adam_adlbc_wide %>%
+    mutate(
+      LBSTRESN = BUN / CREAT,
+      PARAMCD = "BUN/CREAT",
+      PARAM = "Blood Urea Nitrogen/Creatinine",
+      STRESU = "Ratio",
+      AVAL = LBSTRESN
+    )
+
+  # Calculate ALB/CREAT ratio
+  adam_adlbc_ac <- adam_adlbc_wide %>%
+    mutate(
+      LBSTRESN = ALB / CREAT,
+      PARAMCD = "ALB/CREAT",
+      PARAM = "Albumin/Creatinine",
+      STRESU = "Ratio",
+      AVAL = LBSTRESN
+    )
+
+  # Combine the data
+  adam_adlbc_final <- adam_adlbc_ac %>%
+    dplyr::bind_rows(adam_adlbc_bc, adam_adlbc_) %>%
+    select(-BUN, -CREAT, -ALB)
+
   safetyGraphics::safetyGraphicsApp(domainData = list(
-    labs = adam_adlbc,
+    labs = adam_adlbc_final,
     aes = safetyData::adam_adae,
     dm = safetyData::adam_adsl,
     vitals = safetyData::adam_advs