Enhancement/display pp adpp

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,17 @@ export_cdisc <- function(res_nca) {
                 "AAGEU",
                 "TRT01P",
                 "TRT01A",
-                "PARAM",
-                "PARAMCD",
                 "AVAL",
                 "AVALC",
                 "AVALU")
 
-
   pp_info <- res_nca$result  %>%
     filter(is.infinite(end) | PPTESTCD == "auclast") %>%
+    merge(res_nca$data$dose$data,
+          by = unname(unlist(res_nca$data$dose$columns$groups)),
+          all.x = TRUE,
+          all.y = FALSE,
+          suffixes = c("", ".y")) %>%
     group_by(
       across(all_of(c(
         unname(unlist(res_nca$data$conc$columns$groups)), "start", "end", "PPTESTCD"
@@ -127,8 +134,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 +175,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 +190,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()
@@ -201,6 +205,8 @@ export_cdisc <- function(res_nca) {
 
   # Include subject metadata and select adpp columns
   adpp <- pp_info %>%
+    # Elude potential collapse cases with PC variables
+    .[!names(.) %in% c("AVAL", "AVALC", "AVALU")] %>%
     rename(AVAL = PPSTRESN, AVALC = PPSTRESC, AVALU = PPSTRESU)  %>%
     merge(
       res_nca$data$dose$data %>%
@@ -210,6 +216,5 @@ export_cdisc <- function(res_nca) {
     ) %>%
     select(any_of(adpp_col))
 
-
   return(list(pp = pp, adpp = adpp))
 }

inst/shiny/tabs/outputs.R

@@ -411,28 +411,59 @@ 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 = c("copy", "csv", "excel")
+      )
+    )
+  })
+})
 
-    # 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

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",