Enhancement: Units edition results

DESCRIPTION

@@ -62,6 +62,7 @@ Imports:
     tidyr,
     tools,
     utils,
+    units,
     rlang,
     yaml,
     zip

NAMESPACE

@@ -18,6 +18,7 @@ export(g_pkconc_ind_log)
 export(general_lineplot)
 export(general_meanplot)
 export(geometric_mean)
+export(get_conversion_factor)
 export(get_label)
 export(has_label)
 export(lambda_slope_plot)
@@ -122,6 +123,7 @@ importFrom(tern,g_ipp)
 importFrom(tidyr,pivot_longer)
 importFrom(tidyr,pivot_wider)
 importFrom(tools,file_ext)
+importFrom(units,set_units)
 importFrom(utils,read.csv)
 importFrom(utils,write.csv)
 importFrom(yaml,read_yaml)

R/calculate_summary_stats.R

@@ -61,15 +61,15 @@ calculate_summary_stats <- function(res_pknca, input_groups = "DOSNO") {
     group_by(across(all_of(c(input_groups, "PPTESTCD")))) %>%
     unique() %>%
     summarise(
-      geomean = exp(mean(log(PPORRES), na.rm = TRUE)), # nolint
-      geocv = (sd(PPORRES, na.rm = TRUE) / exp(mean(log(PPORRES), na.rm = TRUE))) * 100,
-      mean = mean(PPORRES, na.rm = TRUE),
-      CV = (sd(PPORRES, na.rm = TRUE) / mean(PPORRES, na.rm = TRUE)) * 100,
-      sd = sd(PPORRES, na.rm = TRUE),
-      min = min(PPORRES, na.rm = TRUE),
-      max = max(PPORRES, na.rm = TRUE),
-      median = median(PPORRES, na.rm = TRUE),
-      count.missing = sum(is.na(PPORRES)),
+      geomean = exp(mean(log(PPSTRES), na.rm = TRUE)),
+      geocv = (sd(PPSTRES, na.rm = TRUE) / exp(mean(log(PPSTRES), na.rm = TRUE))) * 100,
+      mean = mean(PPSTRES, na.rm = TRUE),
+      CV = (sd(PPSTRES, na.rm = TRUE) / mean(PPSTRES, na.rm = TRUE)) * 100,
+      sd = sd(PPSTRES, na.rm = TRUE),
+      min = min(PPSTRES, na.rm = TRUE),
+      max = max(PPSTRES, na.rm = TRUE),
+      median = median(PPSTRES, na.rm = TRUE),
+      count.missing = sum(is.na(PPSTRES)),
       count.total = n()
     ) %>%
     ungroup() %>%

R/export_cdisc.R

@@ -128,7 +128,7 @@ export_cdisc <- function(res_nca) {
         unname(unlist(res_nca$data$conc$columns$groups)), "start", "end", "PPTESTCD"
       )))
     )  %>%
-    arrange(USUBJID, DOSNO, !is.na(PPORRES)) %>%
+    arrange(USUBJID, DOSNO, !is.na(PPSTRES)) %>%
     # Identify all dulicates (fromlast and fromfirst) and keep only the first one
     filter(!duplicated(paste0(USUBJID, DOSNO, PPTESTCD))) %>%
     ungroup() %>%
@@ -166,14 +166,14 @@ export_cdisc <- function(res_nca) {
       # Specific ID variables
       PPSPID = "TBD",
       # TODO Results in Standard Units if ORRESU is not in standard units
-      PPSTRESN = as.numeric(PPORRES),
-      PPSTRESC = as.character(PPORRES),
-      PPSTRESU = PPORRESU,
+      PPSTRESN = as.numeric(PPSTRES),
+      PPSTRESC = as.character(PPSTRES),
+      PPSTRESU = PPSTRESU,
       # Status and Reason for Exclusion
-      PPSTAT = ifelse(is.na(PPORRES) | (PPORRES == 0 & PPTESTCD == "CMAX"), "NOT DONE",  ""),
+      PPSTAT = ifelse(is.na(PPSTRES) | (PPSTRES == 0 & PPTESTCD == "CMAX"), "NOT DONE",  ""),
       PPREASND = case_when(
         !is.na(exclude) ~ exclude,
-        is.na(PPORRES) ~ "Unspecified",
+        is.na(PPSTRES) ~ "Unspecified",
         TRUE ~ ""
       ),
       # Datetime

R/flexible_violinboxplot.R

@@ -61,12 +61,12 @@ flexible_violinboxplot <- function(boxplotdata,
 
   # ylabel of violin/boxplot
   ylabel <- {
-    if (box_data$PPORRESU[1] == "unitless" ||
-          is.na(box_data$PPORRESU[1]) ||
-          is.null(box_data$PPORRESU)) {
+    if (box_data$PPSTRESU[1] == "unitless" ||
+          is.na(box_data$PPSTRESU[1]) ||
+          is.null(box_data$PPSTRESU)) {
       parameter
     } else {
-      paste(parameter, " [", box_data$PPORRESU[1], "]")
+      paste(parameter, " [", box_data$PPSTRESU[1], "]")
     }
   }
 
@@ -75,7 +75,7 @@ flexible_violinboxplot <- function(boxplotdata,
     data = box_data %>% arrange(!!!syms(colorvars)),
     aes(
       x = interaction(!!!syms(xvars), sep = "\n"),
-      y = PPORRES,
+      y = PPSTRES,
       color = interaction(!!!syms(colorvars))
     )
   )

R/get_conversion_factor.R

@@ -0,0 +1,28 @@
+#' Transform Units
+#'
+#' This function transforms a value from an initial unit to a target unit.
+#'
+#' @param initial_unit A character string representing the initial unit.
+#' @param target_unit A character string representing the target unit.
+#' @returns A numeric value for the conversion factor from the initial to the target unit,
+#' or NA if the units are not convertible.
+#' @examples
+#' get_conversion_factor("meter", "kilometer")
+#' get_conversion_factor("sec", "min")
+#' @importFrom units set_units
+#' @export
+get_conversion_factor <- Vectorize(function(initial_unit, target_unit) {
+  tryCatch({
+    conversion <- units::set_units(
+      units::set_units(1, initial_unit, mode = "standard"),
+      target_unit, mode = "standard"
+    )
+    unname(as.numeric(conversion))
+  }, error = function(e) {
+    if (initial_unit == target_unit) {
+      1
+    } else {
+      NA
+    }
+  })
+}, USE.NAMES = FALSE)

R/pivot_wider_pknca_results.R

@@ -21,24 +21,24 @@ pivot_wider_pknca_results <- function(myres) {
 
   # Get all names with units and make a dictionary structure
   dict_pttestcd_with_units <- myres$result %>%
-    select(PPTESTCD, PPORRESU) %>%
+    select(PPTESTCD, PPSTRESU) %>%
     distinct() %>%
-    pull(PPORRESU, PPTESTCD)
+    pull(PPSTRESU, PPTESTCD)
 
   # Filter out infinite AUCs and pivot the data to incorporate
   # the parameters into columns with their units
   infinite_aucs_vals <- myres$result %>%
     distinct() %>%
     filter(type_interval == "main")  %>%
-    select(-PPORRESU, -exclude, -type_interval) %>%
-    pivot_wider(names_from = PPTESTCD, values_from = PPORRES)
+    select(-PPSTRESU, -PPORRES, -PPORRESU, -exclude, -type_interval) %>%
+    pivot_wider(names_from = PPTESTCD, values_from = PPSTRES)
 
   infinite_aucs_exclude <- myres$result %>%
     distinct() %>%
     filter(type_interval == "main") %>%
-    select(-PPORRES, -PPORRESU, -type_interval)  %>%
-    mutate(PPTESTCD = paste0("exclude.", PPTESTCD)) %>%
-    pivot_wider(names_from = PPTESTCD, values_from = exclude)
+    select(-PPSTRES, -PPSTRESU, -PPORRES, -PPORRESU, -type_interval)  %>%
+    mutate(exclude.PPTESTCD = paste0("exclude.", PPTESTCD)) %>%
+    pivot_wider(names_from = exclude.PPTESTCD, values_from = exclude)
 
   infinite_aucs <- inner_join(infinite_aucs_vals, infinite_aucs_exclude)
 
@@ -70,18 +70,18 @@ pivot_wider_pknca_results <- function(myres) {
         interval_name = paste0(signif(start), "-", signif(end)),
         interval_name_col = paste0(PPTESTCD, "_", interval_name)
       ) %>%
-      select(-exclude, -PPORRESU, -start, -end,
+      select(-exclude, -PPSTRESU, -PPORRES, -PPORRESU, -start, -end,
              -PPTESTCD, -interval_name, -type_interval) %>%
       pivot_wider(names_from = interval_name_col,
-                  values_from = PPORRES)
+                  values_from = PPSTRES)
 
     interval_aucs_exclude <- myres$result %>%
       filter(type_interval == "manual", startsWith(PPTESTCD, "aucint")) %>%
       mutate(
         interval_name = paste0(signif(start), "-", signif(end)),
         interval_name_col = paste0("exclude.", PPTESTCD, "_", interval_name)
       )  %>%
-      select(-PPORRES, -PPORRESU, -start, -end,
+      select(-PPSTRES, -PPSTRESU, -PPORRES, -PPORRESU, -start, -end,
              -PPTESTCD, -interval_name, -type_interval) %>%
       pivot_wider(names_from = interval_name_col, values_from = exclude)
 
@@ -93,7 +93,7 @@ pivot_wider_pknca_results <- function(myres) {
         .x
       ))
 
-    all_aucs <- inner_join(infinite_aucs_with_lambda, interval_aucs, all = TRUE)
+    all_aucs <- inner_join(infinite_aucs_with_lambda, interval_aucs)
   } else {
     all_aucs <- infinite_aucs_with_lambda
   }

inst/shiny/data/DummyRO_ADNCA.csv

@@ -536,4 +536,4 @@
 "XX01",25201,"Analyte01","SERUM","EVERY 3 WEEKS",1,7.96166666666667,7.96166666666667,8,8,5.83,"Analyte01","ug/mL","intravascular",35,51,"M","WHITE",1.53,"Hours","mg",0,"Analyte01","Cycle 1 Day 1",5.83,"ug/mL",0,"2022-09-13 11:34:00",339203,"Dummy Treatment Arm A","Dummy Treatment Arm P","2022-08-23 11:59:00",176.5,81.6,"kg","cm",1.58,0
 "XX01",25201,"Analyte01","SERUM","EVERY 3 WEEKS",1,25.3016666666667,25.3016666666667,48,48,4.28,"Analyte01","ug/mL","intravascular",35,51,"M","WHITE",1.53,"Hours","mg",0,"Analyte01","Cycle 1 Day 2",4.28,"ug/mL",0,"2022-09-13 11:34:00",339203,"Dummy Treatment Arm A","Dummy Treatment Arm P","2022-08-23 11:59:00",176.5,81.6,"kg","cm",1.53,0
 "XX01",25201,"Analyte01","SERUM","EVERY 3 WEEKS",1,75.6816666666667,75.6816666666667,144,144,1.95,"Analyte01","ug/mL","intravascular",35,51,"M","WHITE",1.53,"Hours","mg",0,"Analyte01","Cycle 1 Day 4",1.95,"ug/mL",0,"2022-09-13 11:34:00",339203,"Dummy Treatment Arm A","Dummy Treatment Arm P","2022-08-23 11:59:00",176.5,81.6,"kg","cm",1.54,0
-"XX01",25201,"Analyte01","SERUM","EVERY 3 WEEKS",1,171.701666666667,171.701666666667,336,336,0.258,"Analyte01","ug/mL","intravascular",35,51,"M","WHITE",1.53,"Hours","mg",0,"Analyte01","Cycle 1 Day 8",0.258,"ug/mL",0,"2022-09-13 11:34:00",339203,"Dummy Treatment Arm A","Dummy Treatment Arm P","2022-08-23 11:59:00",176.5,81.6,"kg","cm",1.5,0
+"XX01",25201,"Analyte01","SERUM","EVERY 3 WEEKS",1,171.701666666667,171.701666666667,336,336,0.258,"Analyte01","ug/mL","intravascular",35,51,"M","WHITE",1.53,"Hours","mg",0,"Analyte01","Cycle 1 Day 8",0.258,"ug/mL",0,"2022-09-13 11:34:00",339203,"Dummy Treatment Arm A","Dummy Treatment Arm P","2022-08-23 11:59:00",176.5,81.6,"kg","cm",1.5,0

inst/shiny/global.R

@@ -4,6 +4,8 @@ LABELS <- read.csv(system.file("shiny/data/adnca_labels.csv", package = "aNCA"))
 
 source("modules/slope_selector.R")
 
+source("modules/units_table.R")
+
 source("functions/partial_auc_input.R")
 
 source("modules/tlg_plot.R")

inst/shiny/modules/slope_selector.R

@@ -123,6 +123,7 @@ slope_selector_server <- function(
     observeEvent(list(
       plot_data(), res_nca(), input$plots_per_page, input$search_patient, current_page()
     ), {
+      req(res_nca())
       log_trace("{id}: Updating displayed plots")
 
       # Make sure the search_patient input is not NULL

inst/shiny/modules/tab_visuals.R

@@ -391,6 +391,7 @@ tab_visuals_server <- function(id, data, grouping_vars, res_nca) {
     # Reactive expression for summary table based on selected group and parameters
     summary_stats <- reactive({
       req(input$summary_groupby, input$select_display_parameters)
+      req(res_nca())
 
       # Calculate summary stats and filter by selected parameters
       calculate_summary_stats(res_nca(), input$summary_groupby) %>%
@@ -444,7 +445,7 @@ tab_visuals_server <- function(id, data, grouping_vars, res_nca) {
     # Create formatted Box plot data: PKNCA + PP results, linking DOSEA + PPTESTCD
     boxplotdata <- reactive({
       group_columns <- unname(unlist(res_nca()$data$conc$columns$groups))
-
+      req(res_nca())
       left_join(
         res_nca()$result %>%
           filter(