Enhancement/display pp adpp (#141)

* feature: changed tab structure and pp/adpp to downloadable DT objects * fix: Add more PPTEST names and missing subject-level variables * fix: recover 3 signif decimals in PP/ADPP results * lintr: code cleaning * fix: solved roxygen2 and rounding deleted based on user feedback * fix: redundant PARAM/CD columns deleted and "unspecified" spelling corrected * Update R/export_cdisc.R: use only dplyr Co-authored-by: Mateusz Kołomański <[email protected]> * fix: code to dplyr and download adpp csv with ADPP name * lintr: clean code suggestion --------- Co-authored-by: Mateusz Kołomański <[email protected]>
pharmaverse · Dec 13, 2024 · 2f9918d · 2f9918d
1 parent 9c19cdd
commit 2f9918d
Show file tree

Hide file tree

Showing 4 changed files with 104 additions and 53 deletions.
diff --git a/R/export_cdisc.R b/R/export_cdisc.R
@@ -27,11 +27,21 @@ pptestcd_dict <- setNames(
     "Last Nonzero Conc", "Time of CMAX", "R Squared", "R Squared Adjusted", "Max Conc Norm by Dose",
     "AUC to Last Nonzero Conc Norm by Dose", "Lambda z", "AUC to Last Nonzero Conc",
     "Half-Life Lambda z", "Number of points used for Lambda z", "Last Nonzero Conc Predicted",
-    "Span Ratio", "Lambda z lower limit (time)"
+    "Span Ratio", "Lambda z lower limit (time)",
+
+    # Manually filled
+    "Trough Concentration", "Average Concentration", "AUC Infinity Predicted",
+    "AUMC Infinity Observed", "AUC Percent Extrapolated Observed",
+    "AUC Percent Extrapolated Predicted", "Clearance Observed",
+    "Clearance Predicted", "Mean Residence Time Intravenous Observed",
+    "Volume of Distribution Observed",
+    "Steady-State Volume of Distribution Intravenous Observed",
+    "AUC Infinity Observed Dose-Normalized", "Maximum Concentration Dose-Normalized"
   ),
-  c(
-    "CLFO", "TLST", "CMAX", "VZFO", "AUCIFO", "CLST", "TMAX", "R2", "R2ADJ", "CMAXD", "AUCLSTD",
-    "LAMZ", "AUCLST", "LAMZHL", "LAMZNPT", "CLSTP", "LAMZSPNR", "LAMZLL"
+  c("CLFO", "TLST", "CMAX", "VZFO", "AUCIFO", "CLST", "TMAX", "R2", "R2ADJ", "CMAXD", "AUCLSTD",
+    "LAMZ", "AUCLST", "LAMZHL", "LAMZNPT", "CLSTP", "LAMZSPNR", "LAMZLL",
+    "CTROUGH", "CAV", "AUCIFP", "AUMCINF.OBS", "AUCPEO", "AUCPEP", "CL.OBS", "CL.PRED",
+    "MRT.IV.OBS", "VZ.OBS", "VSS.IV.OBS", "AUCINF.OBS.DN", "CMAX.DN"
   )
 )
 
@@ -54,23 +64,17 @@ export_cdisc <- function(res_nca) {
   }
 
 
-
-
   # define columns needed for pp
   pp_col <- c(
     "STUDYID",
     "DOMAIN",
     "USUBJID",
     "PPSEQ",
+    "PPCAT",
     "PPGRPID",
-    # "DRUG",
-    # "PARAM",
-    # "PPSPEC",
-    # "PPDOSNO",
     "PPSPID",
     "PPTESTCD",
     "PPTEST",
-    "PPCAT",
     "PPSCAT",
     "PPORRES",
     "PPORRESU",
@@ -87,13 +91,14 @@ export_cdisc <- function(res_nca) {
 
   # define columns needed for adpp
   adpp_col <- c("STUDYID",
+                "DOMAIN",
                 "USUBJID",
-                "PPGRPID",
-                # "DRUG",
-                # "PARAM",
-                # "PPDOSNO",
-                # "PPSPEC",
+                "PPSEQ",
                 "PPCAT",
+                "PPGRPID",
+                "PPSPID",
+                "PPTESTCD",
+                "PPTEST",
                 "PPSCAT",
                 "PPREASND",
                 "PPSPEC",
@@ -109,15 +114,15 @@ export_cdisc <- function(res_nca) {
                 "AAGEU",
                 "TRT01P",
                 "TRT01A",
-                "PARAM",
-                "PARAMCD",
                 "AVAL",
                 "AVALC",
                 "AVALU")
 
-
   pp_info <- res_nca$result  %>%
     filter(is.infinite(end) | PPTESTCD == "auclast") %>%
+    left_join(res_nca$data$dose$data,
+              by = unname(unlist(res_nca$data$dose$columns$groups)),
+              suffix = c("", ".y")) %>%
     group_by(
       across(all_of(c(
         unname(unlist(res_nca$data$conc$columns$groups)), "start", "end", "PPTESTCD"
@@ -127,8 +132,7 @@ export_cdisc <- function(res_nca) {
     # Identify all dulicates (fromlast and fromfirst) and keep only the first one
     filter(!duplicated(paste0(USUBJID, DOSNO, PPTESTCD))) %>%
     ungroup() %>%
-    #  mutate PPTESTCD to match metadata and recode the PPTESTCD to
-    #  match the PPTESTCD in the PPTESTCD data frame
+    #  Recode PPTESTCD PKNCA names to CDISC abbreviations
     mutate(
       PPTESTCD = recode(
         PPTESTCD %>% toupper,
@@ -169,7 +173,7 @@ export_cdisc <- function(res_nca) {
       PPSTAT = ifelse(is.na(PPORRES) | (PPORRES == 0 & PPTESTCD == "CMAX"), "NOT DONE",  ""),
       PPREASND = case_when(
         !is.na(exclude) ~ exclude,
-        is.na(PPORRES) ~ "Unespecified",
+        is.na(PPORRES) ~ "Unspecified",
         TRUE ~ ""
       ),
       # Datetime
@@ -184,13 +188,11 @@ export_cdisc <- function(res_nca) {
       # Matrix
       PPSPEC = PCSPEC,
       # TODO start and end intervals in case of partial aucs -> see oak file in templates
-      PPSTINT = ifelse(end != Inf, start, NA),
+      PPSTINT = ifelse(start != Inf, start, NA),
       PPENINT = ifelse(end != Inf, end, NA)
     )  %>%
-    # Include PPTEST (PPTESTCD descriptions)
+    # Map PPTEST CDISC descriptions using PPTESTCD CDISC names
     mutate(PPTEST = pptestcd_dict[PPTESTCD])  %>%
-    # Make all numeric columns with 3 decimals
-    mutate(across(where(is.numeric), ~ signif(.x, 3)))  %>%
     group_by(USUBJID)  %>%
     mutate(PPSEQ = if ("PCSEQ" %in% names(.)) PCSEQ else row_number())  %>%
     ungroup()
@@ -199,17 +201,16 @@ export_cdisc <- function(res_nca) {
   # select pp columns
   pp <- pp_info %>%  select(all_of(pp_col))
 
-  # Include subject metadata and select adpp columns
   adpp <- pp_info %>%
+    # Elude potential collapse cases with PC variables
+    select(-any_of(c("AVAL", "AVALC", "AVALU"))) %>%
     rename(AVAL = PPSTRESN, AVALC = PPSTRESC, AVALU = PPSTRESU)  %>%
-    merge(
+    left_join(
       res_nca$data$dose$data %>%
-        select(any_of(c("USUBJID", setdiff(names(res_nca$data$dose$data), names(pp_info))))),
-      all.x = TRUE,
-      all.y = FALSE
+        select(-any_of(setdiff(names(pp_info), "USUBJID"))),
+      by = "USUBJID"
     ) %>%
     select(any_of(adpp_col))
 
-
   return(list(pp = pp, adpp = adpp))
 }
diff --git a/inst/shiny/tabs/outputs.R b/inst/shiny/tabs/outputs.R
@@ -411,28 +411,72 @@ output$boxplot <- renderPlotly({
   )
 })
 
-# CDISC ------------------------------------------------------------------------
+# Parameter datasets ------------------------------------------------------------------------
 
-# export pp and adpp as zip file
-output$exportCDISC <- downloadHandler(
-  filename = function() {
-    paste("CDISC_", Sys.Date(), ".zip", sep = "")
-  },
-  content = function(file) {
-    # Create a temporary directory to store the CSV files
-    temp_dir <- tempdir()
-
-    CDISC <- export_cdisc(res_nca())
-    # Export the list of data frames to CSV files in the temporary directory
-    file_paths <- rio::export_list(
-      x = CDISC,
-      file = file.path(temp_dir, paste0(names(CDISC), "_", Sys.Date(), ".csv"))
+# Create CDISC parameter datasets (PP, ADPP)
+observeEvent(res_nca(), {
+  CDISC <- export_cdisc(res_nca())
+
+  output$pp_dataset <- DT::renderDataTable({
+    DT::datatable(
+      data = CDISC$pp,
+      rownames = FALSE,
+      extensions = c("FixedHeader", "Buttons"),
+      options = list(
+        scrollX = TRUE,
+        scrollY = TRUE,
+        searching = TRUE,
+        fixedColumns = TRUE,
+        fixedHeader = TRUE,
+        autoWidth = TRUE,
+        dom = "Bfrtip",
+        buttons = list(
+          list(
+            extend = "copy",
+            title = paste0("PP_Dataset", "_", Sys.Date())
+          ),
+          list(
+            extend = "csv",
+            title = paste0("PP_Dataset", "_", Sys.Date())
+          ),
+          list(
+            extend = "excel",
+            title = paste0("PP_Dataset", "_", Sys.Date())
+          )
+        )
+      )
     )
+  }, server = FALSE)
+
+  output$adpp_dataset <- DT::renderDataTable({
+    DT::datatable(
+      data = CDISC$adpp,
+      extensions = c("FixedHeader", "Buttons"),
+      options = list(
+        scrollX = TRUE,
+        scrollY = TRUE,
+        lengthMenu = list(c(10, 25, -1), c("10", "25", "All")),
+        fixedHeader = TRUE,
+        dom = "Bfrtip",
+        buttons = list(
+          list(
+            extend = "copy",
+            title = paste0("ADPP_Dataset", "_", Sys.Date())
+          ),
+          list(
+            extend = "csv",
+            title = paste0("ADPP_Dataset", "_", Sys.Date())
+          ),
+          list(
+            extend = "excel",
+            title = paste0("ADPP_Dataset", "_", Sys.Date())
+          )
+        )
+      )
+    )
+  })
+})
 
-    # Create a ZIP file containing the CSV files
-    zip::zipr(zipfile = file, files = file_paths)
-  }
-)
 # EXPORT Report ----------------------------------------------------------------
 
 # ATTENTION: most of the blocks in the RMD are still eval = FALSE, as

diff --git a/inst/shiny/ui.R b/inst/shiny/ui.R
@@ -304,7 +304,13 @@ fluidPage(
             )
           )
         ),
-        tabPanel("CDISC", downloadButton("exportCDISC", "Export CDISC")),
+        tabPanel("Parameter Datasets",
+                 tabsetPanel(
+                   tabPanel("PP",
+                            DTOutput("pp_dataset")),
+                   tabPanel("ADPP",
+                            DTOutput("adpp_dataset"))
+                 )),
         tabPanel("Report",
           tabsetPanel(
             tabPanel("Configuration",

diff --git a/man/pptestcd_dict.Rd b/man/pptestcd_dict.Rd