Merge pull request #146 from pharmaverse/enhancement/units-edition-re…

…sults * data: correct RRLTU to a recognised character in units (Hours -> hr) * feat: setup dynamic modal table for mydata$units * fix: create indepedant reactive, still some problem in prefiltering * fix: prefiltering to exclude unitless & not requested parameters * build: connects modal_units_table in server with mydata$units when saving * build: create transform_unit function and associated tests * fix: notify when saving units table if any conversion factor is missing * refactor: modularise units table elements * refactor: modularise units table elements (module) * fix: output with custom unit values, substitute: PPORRES(U) -> PPSTRES(U) * unfinished feat: add a postNCA button to edit units also in all result outputs * refactor: make res_nca updetable for units module (reactiveEvent > reactiveVal) * refactor: lintr cleaning * documentation: improve transform unit doc and update roxygen * documentation: add units to description * fix: import entire units package so set_units and ud_are_convertible work * fix: import whole units package in NAMESPACE * fix: eliminate transform_unit dependency on units::ud_are_convertible * fix: lintr cleaning code * Apply suggestions from code review style: m-kolomanski suggested changes Co-authored-by: Mateusz Kołomański <[email protected]> * fix: small issue in analyte_choices call * fix: rename and update transform_unit > get_conversion_factor * fix: rename and update transform_unit > get_conversion_factor * refactor: req(res_nca()) instead of req(!is.null(res_nca())) * style: JS call code cleaning * refactor: units_table_server implicit actions on mydata & res_nca * documentation: update docstrings * style: call units module after res_nca is defined * style: lintr cleaning * fix: code conflicts in main * fix: res_nca as a reactiveVal instead of eventReactive * style: lint code cleaning * fix: data with merge conflict line not deleted * refactor: use describe and it functions for get_conversion_factor * style: rename test file for get_conversion_factor function * style: apply suggestions from m-kolomanski Co-authored-by: Mateusz Kołomański <[email protected]> * style: eliminate all namespacing for dplyr, shiny, base * style: lint clean code * fix: issue with DT::renderDT * fix: take off ugly not-working close button for the modal message * fix: delete unused argument in units_table module (params_to_calculate) * fix: prevent crashing when conversion_factor edition is with a non numeric * fix: notify when unit changed is not convertible * fix: instead of row, just highlight cell selections in units_table * style: lintr code cleaning * add clearance to params * fix: add cl.obs to parameters to calculate * nitpick: increase notification duration (5s to 12.5s) --------- Co-authored-by: Mateusz Kołomański <[email protected]> Co-authored-by: Spinner <[email protected]>
pharmaverse · Jan 23, 2025 · 75feaea · 75feaea
2 parents b97559b + 28acb4a
commit 75feaea
Show file tree

Hide file tree

Showing 19 changed files with 407 additions and 45 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -62,6 +62,7 @@ Imports:
     tidyr,
     tools,
     utils,
+    units,
     rlang,
     yaml,
     zip

diff --git a/NAMESPACE b/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)

diff --git a/R/calculate_summary_stats.R b/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() %>%

diff --git a/R/export_cdisc.R b/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

diff --git a/R/flexible_violinboxplot.R b/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))
     )
   )

diff --git a/R/format_data.R b/R/format_data.R
@@ -124,7 +124,8 @@ format_pkncadata_intervals <- function(pknca_dose,
                                                    "cmax", "half.life", "tmax", "lambda.z",
                                                    "lambda.z.n.points", "r.squared",
                                                    "adj.r.squared", "lambda.z.time.first",
-                                                   "aucpext.obs", "aucpext.pred", "clast.obs"),
+                                                   "aucpext.obs", "aucpext.pred", "clast.obs",
+                                                   "cl.obs"),
                                        start_from_last_dose = TRUE) {
   if (!inherits(pknca_dose, "PKNCAdose")) {
     stop("Input must be a PKNCAdose object from the PKNCA package.")

diff --git a/R/get_conversion_factor.R b/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)
diff --git a/R/pivot_wider_pknca_results.R b/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
   }

diff --git a/inst/shiny/data/DummyRO_ADNCA.csv b/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
diff --git a/inst/shiny/global.R b/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")

diff --git a/inst/shiny/modules/slope_selector.R b/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

diff --git a/inst/shiny/modules/tab_visuals.R b/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(
-Original file line number
+Diff line change
@@ Expand Up / @@ -62,6 +62,7 @@ Imports: @@
         tidyr,
         tools,
         utils,
+        units,
         rlang,
         yaml,
         zip
@@ Expand Down @@