From 0f36f040970f533d0349e22626ca1f7a3af51d41 Mon Sep 17 00:00:00 2001 From: Spinner Date: Fri, 17 Jan 2025 15:23:28 +0100 Subject: [PATCH 1/9] feat: multiple analytes for NCA --- R/format_data.R | 7 +++++-- inst/shiny/tabs/nca.R | 10 +++++----- inst/shiny/ui.R | 6 +++++- 3 files changed, 15 insertions(+), 8 deletions(-) diff --git a/R/format_data.R b/R/format_data.R index 22ea7ec6..f88b0897 100644 --- a/R/format_data.R +++ b/R/format_data.R @@ -64,7 +64,8 @@ format_pkncadose_data <- function(pkncaconc_data, group_columns, dosno_column = NULL, time_column = "AFRLT", - since_lastdose_time_column = "ARRLT") { + since_lastdose_time_column = "ARRLT", + nominal_time = "NFRLT") { # Check: Dataset is not empty if (nrow(pkncaconc_data) == 0) { @@ -85,7 +86,7 @@ format_pkncadose_data <- function(pkncaconc_data, group_columns <- c(group_columns, "TIME") } - pkncaconc_data %>% + dose_data <- pkncaconc_data %>% mutate(TIME = !!sym(time_column) - !!sym(since_lastdose_time_column)) %>% group_by(!!!syms(group_columns)) %>% arrange(!!sym(since_lastdose_time_column) < 0, @@ -93,6 +94,8 @@ format_pkncadose_data <- function(pkncaconc_data, slice(1) %>% ungroup() %>% arrange(!!!syms(group_columns)) + + dose_data } #' Create Dose Intervals Dataset diff --git a/inst/shiny/tabs/nca.R b/inst/shiny/tabs/nca.R index d3498a91..7a3a3f2d 100644 --- a/inst/shiny/tabs/nca.R +++ b/inst/shiny/tabs/nca.R @@ -193,7 +193,7 @@ observeEvent(input$submit_analyte, priority = 2, { dplyr::filter(!!sym(analyte_column) %in% input$select_analyte) df_dose <- format_pkncadose_data(pkncaconc_data = df_conc, - group_columns = c(group_columns, usubjid_column), + group_columns = c(group_columns, usubjid_column, analyte_column), time_column = time_column, dosno_column = dosno_column, since_lastdose_time_column = "ARRLT") @@ -214,7 +214,7 @@ observeEvent(input$submit_analyte, priority = 2, { mydose <- PKNCA::PKNCAdose( data = df_dose, - formula = DOSEA ~ TIME | STUDYID + PCSPEC + DRUG + USUBJID, + formula = DOSEA ~ TIME | STUDYID + PCSPEC + DRUG + USUBJID + ANALYTE, route = route_column, time.nominal = "NFRLT", duration = "ADOSEDUR" @@ -320,7 +320,7 @@ observe({ observeEvent(input$select_analyte, priority = -1, { req(data()) doses_options <- data() %>% - filter(ANALYTE == input$select_analyte) %>% + filter(ANALYTE %in% input$select_analyte) %>% pull(DOSNO) %>% sort() %>% unique() @@ -458,9 +458,9 @@ res_nca <- eventReactive(pk_nca_trigger(), { # Make the starts and ends of results relative to last dose using the dose data myres$result <- myres$result %>% inner_join(select(mydata()$dose$data, -exclude)) %>% - dplyr::mutate(start = start - !!sym(mydata()$dose$columns$time), + mutate(start = start - !!sym(mydata()$dose$columns$time), end = end - !!sym(mydata()$dose$columns$time)) %>% - dplyr::select(names(myres$result)) + select(names(myres$result)) # Return the result return(myres) diff --git a/inst/shiny/ui.R b/inst/shiny/ui.R index 3ca5472c..6e78863f 100644 --- a/inst/shiny/ui.R +++ b/inst/shiny/ui.R @@ -49,7 +49,11 @@ fluidPage( br(), # Selection of analyte - selectInput("select_analyte", "Choose the analyte :", choices = NULL), + selectInput( + "select_analyte", + "Choose the analyte :", + choices = NULL, + multiple = TRUE), selectInput( "select_dosno", "Choose the Dose Number:", From 823553562ffc761b3134dac03e502250f14d3dae Mon Sep 17 00:00:00 2001 From: Spinner Date: Fri, 17 Jan 2025 15:38:49 +0100 Subject: [PATCH 2/9] feat: matrix selection option --- inst/shiny/tabs/nca.R | 22 +++++++++++++++++----- inst/shiny/ui.R | 8 +++++++- 2 files changed, 24 insertions(+), 6 deletions(-) diff --git a/inst/shiny/tabs/nca.R b/inst/shiny/tabs/nca.R index 7a3a3f2d..d217c5e7 100644 --- a/inst/shiny/tabs/nca.R +++ b/inst/shiny/tabs/nca.R @@ -18,11 +18,20 @@ observeEvent(data(), { updateSelectInput( session, inputId = "select_analyte", - label = "Choose the analyte :", + label = "Choose the Analyte(s) :", choices = unique(data()$ANALYTE) ) }) +observeEvent(data(), { + updateSelectInput( + session, + inputId = "select_pcspec", + label = "Choose the Specimen Type(s) :", + choices = unique(data()$PCSPEC) + ) +}) + # Make GUI change when new settings are uploaded observeEvent(input$settings_upload, { @@ -183,14 +192,16 @@ observeEvent(input$submit_analyte, priority = 2, { dosno_column <- "DOSNO" route_column <- "ROUTE" analyte_column <- "ANALYTE" + matrix_column <- "PCSPEC" # Segregate the data into concentration and dose records df_conc <- format_pkncaconc_data(ADNCA = data(), group_columns = c(group_columns, usubjid_column, analyte_column), time_column = time_column) %>% dplyr::arrange(across(all_of(c(usubjid_column, time_column)))) %>% - # Consider only the analytes requested by the user - dplyr::filter(!!sym(analyte_column) %in% input$select_analyte) + # Consider only the analytes and matrix requested by the user + dplyr::filter(!!sym(analyte_column) %in% input$select_analyte, + !!sym(matrix_column) %in% input$select_pcspec) df_dose <- format_pkncadose_data(pkncaconc_data = df_conc, group_columns = c(group_columns, usubjid_column, analyte_column), @@ -248,7 +259,8 @@ output$datatable <- renderReactable({ req(mydata()) data <- mydata()$conc$data %>% filter(DOSNO %in% input$select_dosno, - ANALYTE %in% input$select_analyte) + ANALYTE %in% input$select_analyte, + PCSPEC %in% input$select_pcspec) # Generate column definitions col_defs <- generate_col_defs(data) @@ -644,7 +656,7 @@ output$settings_save <- downloadHandler( # Include the rule settings as additional columns setts <- setts_lambda %>% mutate( - ANALYTE = input$select_analyte, + ANALYTE %in% input$select_analyte, doses_selected = ifelse( !is.null(input$select_dosno), paste0(input$select_dosno, collapse = ","), diff --git a/inst/shiny/ui.R b/inst/shiny/ui.R index 6e78863f..878de5a2 100644 --- a/inst/shiny/ui.R +++ b/inst/shiny/ui.R @@ -51,7 +51,13 @@ fluidPage( # Selection of analyte selectInput( "select_analyte", - "Choose the analyte :", + "Choose the Analyte :", + choices = NULL, + multiple = TRUE), + # Selection of matrix + selectInput( + "select_pcspec", + "Choose the Matrix:", choices = NULL, multiple = TRUE), selectInput( From 2b4e203b1c9af4c494c876398c58601acf536a64 Mon Sep 17 00:00:00 2001 From: Spinner Date: Mon, 20 Jan 2025 11:05:41 +0100 Subject: [PATCH 3/9] feat: update multiple analyte dependencies --- inst/shiny/modules/slope_selector.R | 74 +++++++++++++++++++++-------- inst/shiny/tabs/nca.R | 16 ++++++- 2 files changed, 69 insertions(+), 21 deletions(-) diff --git a/inst/shiny/modules/slope_selector.R b/inst/shiny/modules/slope_selector.R index cbd6bfff..8b276087 100644 --- a/inst/shiny/modules/slope_selector.R +++ b/inst/shiny/modules/slope_selector.R @@ -92,10 +92,10 @@ slope_selector_ui <- function(id) { ) } -.SLOPE_SELECTOR_COLUMNS <- c("TYPE", "PATIENT", "PROFILE", "IXrange", "REASON") +.SLOPE_SELECTOR_COLUMNS <- c("TYPE", "PATIENT", "ANALYTE", "PCSPEC", "PROFILE", "IXrange", "REASON") slope_selector_server <- function( - id, mydata, res_nca, profiles_per_patient, cycle_nca, pk_nca_trigger, settings_upload + id, mydata, res_nca, profiles_per_patient, cycle_nca, analyte_nca, pcspec_nca, pk_nca_trigger, settings_upload ) { moduleServer(id, function(input, output, session) { log_trace("{id}: Attaching server") @@ -138,11 +138,13 @@ slope_selector_server <- function( patient_profile_plot_ids <- mydata()$conc$data %>% filter( DOSNO %in% cycle_nca, + ANALYTE %in% analyte_nca, + PCSPEC %in% pcspec_nca, USUBJID %in% search_patient ) %>% - dplyr::select(USUBJID, DOSNO) %>% + dplyr::select(USUBJID, ANALYTE, PCSPEC, DOSNO) %>% unique() %>% - dplyr::arrange(USUBJID, DOSNO) + dplyr::arrange(USUBJID, ANALYTE, PCSPEC, DOSNO) num_plots <- nrow(patient_profile_plot_ids) @@ -160,6 +162,8 @@ slope_selector_server <- function( plot_data()$conc$data, row["DOSNO"], row["USUBJID"], + row["ANALYTE"], + row["PCSPEC"], 0.7 ) |> htmlwidgets::onRender( @@ -216,7 +220,12 @@ slope_selector_server <- function( # Define the profiles selected (dosno) that each patient (usubjid) has profiles_per_patient( - tapply(res_nca()$result$DOSNO, res_nca()$result$USUBJID, unique, simplify = FALSE) + res_nca()$result %>% + mutate(USUBJID = as.character(USUBJID), + DOSNO = as.character(DOSNO)) %>% + group_by(USUBJID, ANALYTE, PCSPEC) %>% + summarise(DOSNO = unique(DOSNO), .groups = "drop") %>% + unnest(DOSNO) # Convert lists into individual rows ) # Update the patient search input to make available choices for the user @@ -233,6 +242,8 @@ slope_selector_server <- function( data.frame( TYPE = character(), PATIENT = character(), + ANALYTE = character(), + PCSPEC = character(), PROFILE = character(), IXrange = character(), REASON = character() @@ -247,11 +258,14 @@ slope_selector_server <- function( new_row <- data.frame( TYPE = "Selection", - PATIENT = names(profiles_per_patient())[1], - PROFILE = unique(unlist(profiles_per_patient()))[1], + PATIENT = as.character(unique(profiles_per_patient()$USUBJID)[1]), + ANALYTE = unique(profiles_per_patient()$ANALYTE)[1], + PCSPEC = unique(profiles_per_patient()$PCSPEC)[1], + PROFILE = as.character(unique(profiles_per_patient()$DOSNO)[1]), IXrange = "1:3", REASON = "", - stringsAsFactors = FALSE + stringsAsFactors = FALSE, + check.names = FALSE ) updated_data <- rbind(manual_slopes(), new_row) manual_slopes(updated_data) @@ -278,8 +292,6 @@ slope_selector_server <- function( data <- manual_slopes() }) - profiles <- unique(unlist(profiles_per_patient())) - reactable( data = data, defaultColDef = colDef( @@ -297,15 +309,31 @@ slope_selector_server <- function( PATIENT = colDef( cell = dropdown_extra( id = session$ns("edit_PATIENT"), - choices = names(profiles_per_patient()), + choices = unique(profiles_per_patient()$USUBJID), + class = "dropdown-extra" + ), + minWidth = 75 + ), + ANALYTE = colDef( + cell = dropdown_extra( + id = session$ns("edit_ANALYTE"), + choices = unique(profiles_per_patient()$ANALYTE), + class = "dropdown-extra" + ), + minWidth = 75 + ), + PCSPEC = colDef( + cell = dropdown_extra( + id = session$ns("edit_PCSPEC"), + choices = unique(profiles_per_patient()$PCSPEC), class = "dropdown-extra" ), minWidth = 75 ), PROFILE = colDef( cell = dropdown_extra( - id = session$ns("dropdown_PROFILE"), - choices = profiles, + id = session$ns("edit_PROFILE"), + choices = unique(profiles_per_patient()$DOSNO), class = "dropdown-extra" ), minWidth = 75 @@ -342,7 +370,7 @@ slope_selector_server <- function( ) }) - #' For each of the columns in slope selector data frame, attach an even that will read + #' For each of the columns in slope selector data frame, attach an event that will read #' edits for that column made in the reactable. purrr::walk(.SLOPE_SELECTOR_COLUMNS, \(colname) { observeEvent(input[[paste0("edit_", colname)]], { @@ -374,7 +402,7 @@ slope_selector_server <- function( shiny::debounce(750) # Define the click events for the point exclusion and selection in the slope plots - last_click_data <- reactiveValues(patient = "", profile = "", idx_pnt = "") + last_click_data <- reactiveValues(patient = "", profile = "", analyte = "", pcspec = "", idx_pnt = "") observeEvent(event_data("plotly_click", priority = "event"), { # Store the information of the last click event # click_data <- event_data("plotly_click") @@ -388,6 +416,8 @@ slope_selector_server <- function( # Get identifiers of the clicked plot # patient <- gsub("(.*)_.*_.*", "\\1", click_data$customdata) profile <- gsub(".*_(.*)_.*", "\\1", click_data$customdata) + analyte <- gsub(".*_.*_(.*)_.*", "\\1", click_data$customdata) + pcspec <- gsub(".*_.*_.*_(.*)", "\\1", click_data$customdata) idx_pnt <- gsub(".*_.*_(.*)", "\\1", click_data$customdata) #' If not data was previously provided, or user clicked on different plot, @@ -395,6 +425,8 @@ slope_selector_server <- function( if (patient != last_click_data$patient || profile != last_click_data$profile) { last_click_data$patient <- patient last_click_data$profile <- profile + last_click_data$analyte <- analyte + last_click_data$pcspec <- pcspec last_click_data$idx_pnt <- idx_pnt return(NULL) } @@ -402,7 +434,9 @@ slope_selector_server <- function( # If valid selection is provided, construct new row new_slope_rule <- data.frame( TYPE = if (idx_pnt != last_click_data$idx_pnt) "Selection" else "Exclusion", - PATIENT = patient, + PATIENT = as.character(patient), + ANALYTE = analyte, + PCSPEC = pcspec, PROFILE = as.character(profile), IXrange = paste0(last_click_data$idx_pnt, ":", idx_pnt), REASON = "[Graphical selection. Click here to include a reason]" @@ -416,6 +450,8 @@ slope_selector_server <- function( # after adding new rule, reset last click data # last_click_data$patient <- "" last_click_data$profile <- "" + last_click_data$analyte <- "" + last_click_data$pcspec <- "" last_click_data$idx_pnt <- "" # render rectable anew # @@ -433,11 +469,11 @@ slope_selector_server <- function( #' modularized and improved further. setts <- read.csv(settings_upload()$datapath) imported_slopes <- setts %>% - select(TYPE, USUBJID, DOSNO, IX, REASON) %>% + select(TYPE, USUBJID, ANALYTE, PCSPEC, DOSNO, IX, REASON) %>% mutate(PATIENT = as.character(USUBJID), PROFILE = as.character(DOSNO)) %>% - group_by(TYPE, PATIENT, PROFILE, REASON) %>% + group_by(TYPE, PATIENT, ANALYTE, PCSPEC, PROFILE, REASON) %>% summarise(IXrange = .compress_range(IX), .groups = "keep") %>% - select(TYPE, PATIENT, PROFILE, IXrange, REASON) %>% + select(TYPE, PATIENT, ANALYTE, PCSPEC, PROFILE, IXrange, REASON) %>% na.omit() manual_slopes(imported_slopes) diff --git a/inst/shiny/tabs/nca.R b/inst/shiny/tabs/nca.R index d217c5e7..084bb372 100644 --- a/inst/shiny/tabs/nca.R +++ b/inst/shiny/tabs/nca.R @@ -287,7 +287,12 @@ output$datatable <- renderReactable({ # Define the profiles (dosno) associated with each patient (usubjid) for the selected analyte profiles_per_patient <- reactiveVal(NULL) observeEvent(mydata(), { - profiles_per_patient(tapply(mydata()$conc$data$DOSNO, mydata()$conc$data$USUBJID, unique)) + profiles_per_patient( + mydata()$conc$data %>% + mutate(USUBJID = as.character(USUBJID)) %>% + group_by(USUBJID, ANALYTE, PCSPEC) %>% + summarise(DOSNO = list(unique(DOSNO)), .groups = "drop") + ) }) # Include keyboard limits for the settings GUI display @@ -401,7 +406,12 @@ observeEvent(input$nca, { } # Update profiles per patient considering the profiles selected - profiles_per_patient(tapply(mydata()$conc$data$DOSNO, mydata()$conc$data$USUBJID, unique)) + profiles_per_patient( + mydata()$conc$data %>% + mutate(USUBJID = as.character(USUBJID)) %>% + group_by(USUBJID, ANALYTE, PCSPEC) %>% + summarise(DOSNO = list(unique(DOSNO)), .groups = "drop") + ) # Use the user inputs to determine the NCA settings to apply PKNCA::PKNCA.options( @@ -744,6 +754,8 @@ slope_rules <- slope_selector_server( res_nca, profiles_per_patient, input$select_dosno, + input$select_analyte, + input$select_pcspec, pk_nca_trigger, reactive(input$settings_upload) ) From 71d7ea8a6855bf9162e396847ae630971180ffca Mon Sep 17 00:00:00 2001 From: Spinner Date: Mon, 20 Jan 2025 11:13:04 +0100 Subject: [PATCH 4/9] refactor: ma dependencies and docs --- NAMESPACE | 2 +- R/lambda_slope_plot.R | 16 ++++++++++------ R/utils-slope_selector.R | 20 +++++++++++++------- inst/shiny/modules/tab_data.R | 2 +- inst/shiny/tabs/nca.R | 2 +- man/format_pkncadose_data.Rd | 3 ++- man/lambda_slope_plot.Rd | 2 ++ 7 files changed, 30 insertions(+), 17 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 42d7eec8..540e2f87 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,9 +21,9 @@ export(geometric_mean) export(get_label) export(has_label) export(lambda_slope_plot) -export(pivot_wider_pknca_results) export(parse_annotation) export(parse_tlg_definitions) +export(pivot_wider_pknca_results) export(pkcg01) export(pptestcd_dict) export(run_app) diff --git a/R/lambda_slope_plot.R b/R/lambda_slope_plot.R index aa8b004d..eb6ddd97 100644 --- a/R/lambda_slope_plot.R +++ b/R/lambda_slope_plot.R @@ -52,14 +52,16 @@ lambda_slope_plot <- function( conc_pknca_df = mydata$conc$data, dosno = profile, usubjid = patient, + analyte = analyte, + pcspec = pcspec, R2ADJTHRESHOL = 0.7 ) { # Obtain all information relevant regarding lambda calculation lambda_res <- res_pknca_df %>% - filter(DOSNO == dosno, USUBJID == usubjid, type_interval == "main") %>% - arrange(USUBJID, DOSNO, start, desc(end)) %>% - filter(!duplicated(paste0(USUBJID, DOSNO, PPTESTCD))) + filter(DOSNO == dosno, USUBJID == usubjid, ANALYTE == analyte, PCSPEC == pcspec, type_interval == "main") %>% + arrange(USUBJID, DOSNO, ANALYTE, PCSPEC, start, desc(end)) %>% + filter(!duplicated(paste0(USUBJID, DOSNO, PCSPEC, ANALYTE, PPTESTCD))) # Obtain the number of data points used to calculate lambda lambda_z_n_points <- as.numeric(lambda_res$PPORRES[lambda_res$PPTESTCD == "lambda.z.n.points"]) @@ -141,7 +143,7 @@ lambda_slope_plot <- function( # Include in the data the aesthetics for the plot plot_data <- conc_pknca_df %>% - filter(DOSNO == dosno, USUBJID == usubjid) %>% + filter(DOSNO == dosno, USUBJID == usubjid, ANALYTE == analyte, PCSPEC == pcspec) %>% arrange(IX) %>% mutate( IX_shape = ifelse(is.excluded.hl, "excluded", "included"), @@ -174,7 +176,8 @@ lambda_slope_plot <- function( size = 5 ) + labs( - title = paste0("USUBJID: ", usubjid, ", DOSNO: ", dosno), + title = paste0("USUBJID: ", usubjid, ", DOSNO: ", dosno, + ", ANALYTE: ", analyte, ", PCSPEC: ", pcspec), y = paste0("Log10 Concentration (", conc_pknca_df $PCSTRESU[1], ")"), x = paste0("Actual time post dose (", conc_pknca_df $RRLTU[1], ")") ) + @@ -229,7 +232,8 @@ lambda_slope_plot <- function( pl <- pl %>% # Make this trace the only one add_trace( - data = plot_data %>% filter(DOSNO == dosno, USUBJID == usubjid), + data = plot_data %>% filter(DOSNO == dosno, USUBJID == usubjid, + ANALYTE == analyte, PCSPEC == pcspec), x = ~TIME, y = ~log10(AVAL), customdata = ~paste0(USUBJID, "_", DOSNO, "_", IX), text = ~paste0("Data Point: ", IX, "\n", "(", signif(TIME, 2), " , ", signif(AVAL, 2), ")"), diff --git a/R/utils-slope_selector.R b/R/utils-slope_selector.R index 068cf1f4..0a435034 100644 --- a/R/utils-slope_selector.R +++ b/R/utils-slope_selector.R @@ -28,12 +28,14 @@ # Eliminate all rows with conflicting or blank values slopes <- slopes %>% - dplyr::filter( - TYPE %in% c("Selection", "Exclusion"), - PATIENT %in% names(profiles), - PROFILE %in% unname(unlist(profiles[PATIENT])), - all(!is.na(sapply(IXrange, function(x) .eval_range(x)))) - ) + dplyr::filter(TYPE %in% c("Selection", "Exclusion")) %>% + semi_join( + profiles %>% + select(USUBJID, ANALYTE, PCSPEC, DOSNO) %>% + rename(PATIENT = USUBJID, PROFILE = DOSNO), + by = c("PATIENT", "ANALYTE", "PCSPEC", "PROFILE") + ) %>% + filter(all(!is.na(sapply(IXrange, function(x) .eval_range(x))))) if (nrow(slopes) != 0) { # Go over all rules and check if there is no overlap - if there is, edit accordingly @@ -47,6 +49,8 @@ for (i in seq_len(nrow(slopes))) { selection_index <- which( data$conc$data$USUBJID == slopes$PATIENT[i] & + data$conc$data$ANALYTE == slopes$ANALYTE[i] & + data$conc$data$PCSPEC == slopes$PCSPEC[i] & data$conc$data$DOSNO == slopes$PROFILE[i] & data$conc$data$IX %in% .eval_range(slopes$IXrange[i]) ) @@ -61,7 +65,7 @@ } data$conc$data <- data$conc$data %>% - dplyr::group_by(STUDYID, USUBJID, PCSPEC, DOSNO) %>% + dplyr::group_by(STUDYID, USUBJID, ANALYTE, PCSPEC, DOSNO) %>% dplyr::mutate(exclude_half.life = { if (any(is.included.hl)) { is.excluded.hl | !is.included.hl @@ -89,6 +93,8 @@ existing_index <- which( existing$TYPE == new$TYPE & existing$PATIENT == new$PATIENT & + existing$ANALYTE == new$ANALYTE & + existing$PCSPEC == new$PCSPEC & existing$PROFILE == new$PROFILE ) diff --git a/inst/shiny/modules/tab_data.R b/inst/shiny/modules/tab_data.R index 4adf22f9..b872e82b 100644 --- a/inst/shiny/modules/tab_data.R +++ b/inst/shiny/modules/tab_data.R @@ -71,7 +71,7 @@ tab_data_server <- function(id) { ADNCA <- reactiveVal( read.csv( system.file("shiny/data/DummyRO_ADNCA.csv", package = "aNCA"), - na.strings = c("", "NA") + # na.strings = c("", "NA") ) ) diff --git a/inst/shiny/tabs/nca.R b/inst/shiny/tabs/nca.R index 084bb372..57350e8f 100644 --- a/inst/shiny/tabs/nca.R +++ b/inst/shiny/tabs/nca.R @@ -721,7 +721,7 @@ output$preslopesettings <- DT::renderDataTable({ # Reshape results and only choose the columns that are relevant to half life calculation preslopesettings <- pivot_wider_pknca_results(res_nca()) %>% select( - any_of(c("USUBJID", "DOSNO")), + any_of(c("USUBJID", "DOSNO", "ANALYTE", "PCSPEC")), starts_with("lambda.z"), starts_with("span.ratio"), starts_with("half.life"), diff --git a/man/format_pkncadose_data.Rd b/man/format_pkncadose_data.Rd index e75cf39c..07b8bfc9 100644 --- a/man/format_pkncadose_data.Rd +++ b/man/format_pkncadose_data.Rd @@ -9,7 +9,8 @@ format_pkncadose_data( group_columns, dosno_column = NULL, time_column = "AFRLT", - since_lastdose_time_column = "ARRLT" + since_lastdose_time_column = "ARRLT", + nominal_time = "NFRLT" ) } \arguments{ diff --git a/man/lambda_slope_plot.Rd b/man/lambda_slope_plot.Rd index 7ca04920..baca177e 100644 --- a/man/lambda_slope_plot.Rd +++ b/man/lambda_slope_plot.Rd @@ -9,6 +9,8 @@ lambda_slope_plot( conc_pknca_df = mydata$conc$data, dosno = profile, usubjid = patient, + analyte = analyte, + pcspec = pcspec, R2ADJTHRESHOL = 0.7 ) } From f7ef43969c73cd4f0c7b2a54dc92938fd8631e6a Mon Sep 17 00:00:00 2001 From: Spinner Date: Mon, 20 Jan 2025 13:56:43 +0100 Subject: [PATCH 5/9] update lineplot for MA --- R/general_lineplot.R | 7 ++-- inst/shiny/modules/tab_visuals.R | 59 +++++++++++++++++++++++++++----- inst/shiny/tabs/nca.R | 2 +- man/general_lineplot.Rd | 1 + 4 files changed, 57 insertions(+), 12 deletions(-) diff --git a/R/general_lineplot.R b/R/general_lineplot.R index 83380bf4..6061060d 100644 --- a/R/general_lineplot.R +++ b/R/general_lineplot.R @@ -50,7 +50,7 @@ #' @importFrom tern g_ipp #' @export general_lineplot <- function( - data, selected_analytes, selected_usubjids, colorby_var, time_scale, yaxis_scale, cycle = NULL + data, selected_analytes, selected_pcspec, selected_usubjids, colorby_var, time_scale, yaxis_scale, cycle = NULL ) { # Check if the data is empty @@ -63,6 +63,7 @@ general_lineplot <- function( filter( USUBJID %in% selected_usubjids, ANALYTE %in% selected_analytes, + PCSPEC %in% selected_pcspec, if ("EVID" %in% names(data)) EVID == 0 else TRUE ) %>% filter(!is.na(AVAL)) %>% @@ -125,8 +126,8 @@ general_lineplot <- function( subtitle = paste0( "Subjects: ", paste(unique(preprocessed_data$USUBJID), collapse = ", "), - "\nAnalyte: ", - unique(preprocessed_data$ANALYTE) + "\nAnalyte(s): ", + paste(unique(preprocessed_data$ANALYTE), collapse = ", ") ), caption = NULL, add_baseline_hline = FALSE, diff --git a/inst/shiny/modules/tab_visuals.R b/inst/shiny/modules/tab_visuals.R index 5b2a1ead..f557ff1d 100644 --- a/inst/shiny/modules/tab_visuals.R +++ b/inst/shiny/modules/tab_visuals.R @@ -17,7 +17,15 @@ tab_visuals_ui <- function(id) { label = "Select Analyte:", choices = NULL, selected = NULL, - multiple = FALSE, + multiple = TRUE, + options = list(`actions-box` = TRUE) + ), + pickerInput( + inputId = ns("generalplot_pcspec"), + label = "Select Matrix:", + choices = NULL, + selected = NULL, + multiple = TRUE, options = list(`actions-box` = TRUE) ), pickerInput( @@ -61,7 +69,14 @@ tab_visuals_ui <- function(id) { selectInput( inputId = ns("analyte_mean"), label = "Choose the Analyte:", - choices = NULL + choices = NULL, + multiple = TRUE + ), + selectInput( + inputId = ns("pcspec_mean"), + label = "Choose the Matrix:", + choices = NULL, + multiple = TRUE ), selectInput( inputId = ns("studyid_mean"), @@ -71,8 +86,8 @@ tab_visuals_ui <- function(id) { selectInput( inputId = ns("select_id_var"), label = "Choose the variable to group by:", - choices = c("PCSPEC", "DOSEA", "TRT01A", "TRT01P"), - selected = "DOSEA" + choices = NULL, + multiple = TRUE ), selectInput( inputId = ns("cycles_mean"), @@ -201,9 +216,21 @@ tab_visuals_server <- function(id, data, grouping_vars, res_nca) { updatePickerInput( session, "generalplot_analyte", - choices = param_choices_analyte + choices = param_choices_analyte, + selected = param_choices_analyte[1] ) + # Update pcspec picker input + param_choices_pcspec <- data() %>% + pull(PCSPEC) %>% + unique() + + updatePickerInput( + session, + "generalplot_pcspec", + choices = param_choices_pcspec, + ) + # Update the usubjid picker input param_choices_usubjid <- data() %>% pull(USUBJID) %>% @@ -218,7 +245,7 @@ tab_visuals_server <- function(id, data, grouping_vars, res_nca) { # Update the colorby picker input param_choices_colorby <- sort( - c("STUDYID", "PCSPEC", "ANALYTE", "DOSEA", "DOSNO", "USUBJID", grouping_vars()) + c("STUDYID", "PCSPEC", "ANALYTE", "DOSEA", "DOSNO", "USUBJID", grouping_vars()) ) updatePickerInput( @@ -249,9 +276,20 @@ tab_visuals_server <- function(id, data, grouping_vars, res_nca) { "studyid_mean", choices = sort(studyid_choices) ) + + # Update pcspec mean choices + pcspec_choices <- data() %>% + pull(PCSPEC) %>% + unique() + + updateSelectInput( + session, + "pcspec_mean", + choices = sort(pcspec_choices) + ) # Update the selectidvar select input - idvar_choices <- c("PCSPEC", "DOSEA", grouping_vars()) + idvar_choices <- c("ANALYTE","PCSPEC", "DOSEA", grouping_vars()) updateSelectInput( session, @@ -265,7 +303,7 @@ tab_visuals_server <- function(id, data, grouping_vars, res_nca) { output$cycle_select <- renderUI({ req(input$generalplot_analyte) y <- data() %>% - filter(ANALYTE == input$generalplot_analyte) %>% + filter(ANALYTE %in% input$generalplot_analyte) %>% pull(DOSNO) %>% unique() selectInput(ns("cycles"), "Choose the cycle :", choices = sort(y), @@ -278,6 +316,7 @@ tab_visuals_server <- function(id, data, grouping_vars, res_nca) { output$individualplot <- renderPlotly({ req(data()) req(input$generalplot_analyte) + req(input$generalplot_pcspec) req(input$generalplot_usubjid) req(input$generalplot_colorby) req(input$timescale) @@ -287,6 +326,7 @@ tab_visuals_server <- function(id, data, grouping_vars, res_nca) { general_lineplot( data(), input$generalplot_analyte, + input$generalplot_pcspec, input$generalplot_usubjid, input$generalplot_colorby, input$timescale, @@ -319,6 +359,7 @@ tab_visuals_server <- function(id, data, grouping_vars, res_nca) { output$mean_plot <- renderPlotly({ req(input$studyid_mean) req(input$analyte_mean) + req(input$pcspec_mean) req(input$cycles_mean) log_info("Rendering mean plot") @@ -328,6 +369,7 @@ tab_visuals_server <- function(id, data, grouping_vars, res_nca) { filter( STUDYID %in% input$studyid_mean, ANALYTE %in% input$analyte_mean, + PCSPEC %in% input$pcspec_mean, DOSNO %in% input$cycles_mean, if ("EVID" %in% names(data)) EVID == 0 else TRUE, NRRLT > 0 @@ -348,6 +390,7 @@ tab_visuals_server <- function(id, data, grouping_vars, res_nca) { data = data(), selected_studyids = input$studyid_mean, selected_analytes = input$analyte_mean, + selected_pcspecs = input$pcspec_mean, selected_cycles = input$cycles_mean, id_variable = input$select_id_var, plot_ylog = input$log_mean_plot, diff --git a/inst/shiny/tabs/nca.R b/inst/shiny/tabs/nca.R index 57350e8f..0d1a522f 100644 --- a/inst/shiny/tabs/nca.R +++ b/inst/shiny/tabs/nca.R @@ -41,7 +41,7 @@ observeEvent(input$settings_upload, { doses_selected <- as.numeric(strsplit(as.character(setts$doses_selected), split = ",")[[1]]) # Check that match with the data currently loaded - if (!setts$ANALYTE[1] %in% unique(data()$ANALYTE) || + if (!analyte %in% unique(data()$ANALYTE) || !all(doses_selected %in% unique(data()$DOSNO))) { showNotification( diff --git a/man/general_lineplot.Rd b/man/general_lineplot.Rd index eede87fe..2033b8f1 100644 --- a/man/general_lineplot.Rd +++ b/man/general_lineplot.Rd @@ -7,6 +7,7 @@ general_lineplot( data, selected_analytes, + selected_pcspec, selected_usubjids, colorby_var, time_scale, From 4db47a02a954a2818bcd48c3dbd225984c394b90 Mon Sep 17 00:00:00 2001 From: Spinner Date: Mon, 20 Jan 2025 14:08:43 +0100 Subject: [PATCH 6/9] refactor: mean plots to adapt to MA --- R/general_meanplot.R | 4 +++- inst/shiny/modules/tab_visuals.R | 7 +++---- man/general_meanplot.Rd | 1 + 3 files changed, 7 insertions(+), 5 deletions(-) diff --git a/R/general_meanplot.R b/R/general_meanplot.R index 53688c5e..d9757942 100644 --- a/R/general_meanplot.R +++ b/R/general_meanplot.R @@ -28,6 +28,7 @@ general_meanplot <- function(data, selected_studyids, selected_analytes, + selected_pcspecs, selected_cycles, id_variable = "DOSEA", plot_ylog = FALSE, @@ -39,6 +40,7 @@ general_meanplot <- function(data, filter( STUDYID %in% selected_studyids, ANALYTE %in% selected_analytes, + PCSPEC %in% selected_pcspecs, DOSNO %in% selected_cycles, if ("EVID" %in% names(data)) EVID == 0 else TRUE, NRRLT > 0 @@ -50,7 +52,7 @@ general_meanplot <- function(data, summarised_data <- preprocessed_data %>% mutate(id_variable = as.factor(!!sym(id_variable))) %>% # Create a groups variables for the labels - mutate(groups = paste(STUDYID, ANALYTE, DOSNO, sep = ", ")) %>% + mutate(groups = paste(STUDYID, ANALYTE, PCSPEC, DOSNO, sep = ", ")) %>% group_by(id_variable, NRRLT, groups) %>% summarise( Mean = round(mean(AVAL, na.rm = TRUE), 3), diff --git a/inst/shiny/modules/tab_visuals.R b/inst/shiny/modules/tab_visuals.R index f557ff1d..e93467f3 100644 --- a/inst/shiny/modules/tab_visuals.R +++ b/inst/shiny/modules/tab_visuals.R @@ -86,8 +86,7 @@ tab_visuals_ui <- function(id) { selectInput( inputId = ns("select_id_var"), label = "Choose the variable to group by:", - choices = NULL, - multiple = TRUE + choices = NULL ), selectInput( inputId = ns("cycles_mean"), @@ -122,14 +121,14 @@ tab_visuals_ui <- function(id) { orderInput( ns("summary_groupby_source"), "Drag and drop these variables...", - items = c("STUDYID", "USUBJID", "DOSEA", "PCSPEC", "ANALYTE"), + items = c("STUDYID", "USUBJID", "DOSEA",), width = shiny::validateCssUnit("100%"), connect = ns("summary_groupby") ), orderInput( ns("summary_groupby"), "..to hierarchically group by (order matters!):", - items = c("DOSNO"), + items = c( "ANALYTE", "PCSPEC", "DOSNO"), width = shiny::validateCssUnit("100%"), connect = ns("summary_groupby_source"), placeholder = "Drag items here to group hierarchically..." diff --git a/man/general_meanplot.Rd b/man/general_meanplot.Rd index 12937330..aa722f97 100644 --- a/man/general_meanplot.Rd +++ b/man/general_meanplot.Rd @@ -8,6 +8,7 @@ general_meanplot( data, selected_studyids, selected_analytes, + selected_pcspecs, selected_cycles, id_variable = "DOSEA", plot_ylog = FALSE, From 686095c81d229acfc098840d08ae0b4f55b145fd Mon Sep 17 00:00:00 2001 From: Spinner Date: Mon, 20 Jan 2025 14:51:02 +0100 Subject: [PATCH 7/9] add MA dummy data and update docs and testing --- R/format_data.R | 12 +++++---- R/general_lineplot.R | 4 ++- R/general_meanplot.R | 1 + R/lambda_slope_plot.R | 4 +++ inst/shiny/modules/tab_data.R | 2 +- inst/shiny/modules/tab_visuals.R | 2 +- man/format_pkncadose_data.Rd | 13 ++++++--- man/general_lineplot.Rd | 5 +++- man/general_meanplot.Rd | 2 ++ man/lambda_slope_plot.Rd | 6 +++++ tests/testthat/test-general_lineplot.R | 7 ++++- tests/testthat/test-general_meanplot.R | 29 ++++++++++++-------- tests/testthat/test-utils-slope_selector.R | 31 ++++++++++++++++++---- 13 files changed, 89 insertions(+), 29 deletions(-) diff --git a/R/format_data.R b/R/format_data.R index f88b0897..43144da6 100644 --- a/R/format_data.R +++ b/R/format_data.R @@ -47,7 +47,11 @@ format_pkncaconc_data <- function(ADNCA, group_columns, time_column = "AFRLT") { #' #' This function creates a pharmacokinetic dose dataset from the provided concentration data. #' -#' @param ADNCA_conc A data frame containing the concentration data. +#' @param pkncaconc_data A data frame containing the concentration data. +#' @param group_columns A character vector specifying the columns to group by. +#' @param dosno_column A character string specifying the dose number column. +#' @param time_column A character string specifying the time column. +#' @param since_lastdose_time_column A character string specifying the time since last dose column. #' #' @returns A data frame containing the dose data. #' @@ -64,8 +68,7 @@ format_pkncadose_data <- function(pkncaconc_data, group_columns, dosno_column = NULL, time_column = "AFRLT", - since_lastdose_time_column = "ARRLT", - nominal_time = "NFRLT") { + since_lastdose_time_column = "ARRLT") { # Check: Dataset is not empty if (nrow(pkncaconc_data) == 0) { @@ -86,7 +89,7 @@ format_pkncadose_data <- function(pkncaconc_data, group_columns <- c(group_columns, "TIME") } - dose_data <- pkncaconc_data %>% + pkncaconc_data %>% mutate(TIME = !!sym(time_column) - !!sym(since_lastdose_time_column)) %>% group_by(!!!syms(group_columns)) %>% arrange(!!sym(since_lastdose_time_column) < 0, @@ -95,7 +98,6 @@ format_pkncadose_data <- function(pkncaconc_data, ungroup() %>% arrange(!!!syms(group_columns)) - dose_data } #' Create Dose Intervals Dataset diff --git a/R/general_lineplot.R b/R/general_lineplot.R index 6061060d..29dcfe4f 100644 --- a/R/general_lineplot.R +++ b/R/general_lineplot.R @@ -6,6 +6,7 @@ #' #' @param data A data frame containing the ADNCA dataset. #' @param selected_analytes A character vector of selected analytes to be included in the plot. +#' @param selected_pcspec A character vector of selected pcspec to be included in the plot. #' @param selected_usubjids A character vector of selected unique subject identifiers (USUBJIDs) #' to be included in the plot. #' @param colorby_var A character string specifying the variable by which to color @@ -22,7 +23,7 @@ #' @details #' The function performs the following steps:a #' \itemize{ -#' \item Filters the data based on the selected analytes and subjects. +#' \item Filters the data based on the selected analytes, matrices, and subjects. #' \item Selects relevant columns and removes rows with missing concentration values. #' \item Converts 'USUBJID', 'DOSNO', and 'DOSEA' to factors. #' \item Filters the data by cycle if `time_scale` is "By Cycle". @@ -36,6 +37,7 @@ #' # Example usage: #' plot <- general_lineplot(data = adnca_data, #' selected_analytes = c("Analyte1", "Analyte2"), +#' selected_pcspec = c("Spec1", "Spec2"), #' selected_usubjids = c("Subject1", "Subject2"), #' colorby_var = "DOSNO", #' time_scale = "By Cycle", diff --git a/R/general_meanplot.R b/R/general_meanplot.R index d9757942..87ef3b31 100644 --- a/R/general_meanplot.R +++ b/R/general_meanplot.R @@ -7,6 +7,7 @@ #' @param data A data frame containing the ADNCA dataset. #' @param selected_studyids A character vector of selected study IDs to be included in the plot. #' @param selected_analytes A character vector of selected analytes to be included in the plot. +#' @param selected_pcspecs A character vector of selected pcspecs to be included in the plot. #' @param selected_cycles A character vector or numeric vector of selected cycles to be #' included in the plot. #' @param id_variable A character string specifying the variable by which to color the lines diff --git a/R/lambda_slope_plot.R b/R/lambda_slope_plot.R index eb6ddd97..8aa9e8ed 100644 --- a/R/lambda_slope_plot.R +++ b/R/lambda_slope_plot.R @@ -9,6 +9,8 @@ #' @param conc_pknca_df Data frame containing the concentration data #' (default is `mydata$conc$data`). #' @param dosno Numeric value representing the dose number (default is `profile`). +#' @param analyte Character value representing the analyte (default is `analyte`). +#' @param pcspec Character value representing the pcspec (default is `pcspec`). #' @param usubjid Character value representing the unique subject identifier #' (default is `patient`). #' @param R2ADJTHRESHOL Numeric value representing the R-squared adjusted threshold for determining @@ -37,6 +39,8 @@ #' # Example usage: #' plot <- lambda_slope_plot(res_pknca_df = myres$result, #' conc_pknca_df = mydata$conc$data, +#' analyte = "analyte_1", +#' pcspec = "pcspec_1", #' dosno = 1, #' usubjid = "subject_1", #' R2ADJTHRESHOL = 0.7) diff --git a/inst/shiny/modules/tab_data.R b/inst/shiny/modules/tab_data.R index b872e82b..4adf22f9 100644 --- a/inst/shiny/modules/tab_data.R +++ b/inst/shiny/modules/tab_data.R @@ -71,7 +71,7 @@ tab_data_server <- function(id) { ADNCA <- reactiveVal( read.csv( system.file("shiny/data/DummyRO_ADNCA.csv", package = "aNCA"), - # na.strings = c("", "NA") + na.strings = c("", "NA") ) ) diff --git a/inst/shiny/modules/tab_visuals.R b/inst/shiny/modules/tab_visuals.R index e93467f3..a163de5a 100644 --- a/inst/shiny/modules/tab_visuals.R +++ b/inst/shiny/modules/tab_visuals.R @@ -121,7 +121,7 @@ tab_visuals_ui <- function(id) { orderInput( ns("summary_groupby_source"), "Drag and drop these variables...", - items = c("STUDYID", "USUBJID", "DOSEA",), + items = c("STUDYID", "USUBJID", "DOSEA"), width = shiny::validateCssUnit("100%"), connect = ns("summary_groupby") ), diff --git a/man/format_pkncadose_data.Rd b/man/format_pkncadose_data.Rd index 07b8bfc9..0dcb1088 100644 --- a/man/format_pkncadose_data.Rd +++ b/man/format_pkncadose_data.Rd @@ -9,12 +9,19 @@ format_pkncadose_data( group_columns, dosno_column = NULL, time_column = "AFRLT", - since_lastdose_time_column = "ARRLT", - nominal_time = "NFRLT" + since_lastdose_time_column = "ARRLT" ) } \arguments{ -\item{ADNCA_conc}{A data frame containing the concentration data.} +\item{pkncaconc_data}{A data frame containing the concentration data.} + +\item{group_columns}{A character vector specifying the columns to group by.} + +\item{dosno_column}{A character string specifying the dose number column.} + +\item{time_column}{A character string specifying the time column.} + +\item{since_lastdose_time_column}{A character string specifying the time since last dose column.} } \value{ A data frame containing the dose data. diff --git a/man/general_lineplot.Rd b/man/general_lineplot.Rd index 2033b8f1..675ba70e 100644 --- a/man/general_lineplot.Rd +++ b/man/general_lineplot.Rd @@ -20,6 +20,8 @@ general_lineplot( \item{selected_analytes}{A character vector of selected analytes to be included in the plot.} +\item{selected_pcspec}{A character vector of selected pcspec to be included in the plot.} + \item{selected_usubjids}{A character vector of selected unique subject identifiers (USUBJIDs) to be included in the plot.} @@ -46,7 +48,7 @@ logarithmic scale and can be filtered by cycle. \details{ The function performs the following steps:a \itemize{ -\item Filters the data based on the selected analytes and subjects. +\item Filters the data based on the selected analytes, matrices, and subjects. \item Selects relevant columns and removes rows with missing concentration values. \item Converts 'USUBJID', 'DOSNO', and 'DOSEA' to factors. \item Filters the data by cycle if \code{time_scale} is "By Cycle". @@ -60,6 +62,7 @@ The function performs the following steps:a # Example usage: plot <- general_lineplot(data = adnca_data, selected_analytes = c("Analyte1", "Analyte2"), + selected_pcspec = c("Spec1", "Spec2"), selected_usubjids = c("Subject1", "Subject2"), colorby_var = "DOSNO", time_scale = "By Cycle", diff --git a/man/general_meanplot.Rd b/man/general_meanplot.Rd index aa722f97..f51985c2 100644 --- a/man/general_meanplot.Rd +++ b/man/general_meanplot.Rd @@ -23,6 +23,8 @@ general_meanplot( \item{selected_analytes}{A character vector of selected analytes to be included in the plot.} +\item{selected_pcspecs}{A character vector of selected pcspecs to be included in the plot.} + \item{selected_cycles}{A character vector or numeric vector of selected cycles to be included in the plot.} diff --git a/man/lambda_slope_plot.Rd b/man/lambda_slope_plot.Rd index baca177e..e04b32c6 100644 --- a/man/lambda_slope_plot.Rd +++ b/man/lambda_slope_plot.Rd @@ -26,6 +26,10 @@ analysis (default is \code{PKNCA::pk.nca(.)$result}).} \item{usubjid}{Character value representing the unique subject identifier (default is \code{patient}).} +\item{analyte}{Character value representing the analyte (default is \code{analyte}).} + +\item{pcspec}{Character value representing the pcspec (default is \code{pcspec}).} + \item{R2ADJTHRESHOL}{Numeric value representing the R-squared adjusted threshold for determining the subtitle color (default is 0.7).} } @@ -58,6 +62,8 @@ linear regression line, and annotations. # Example usage: plot <- lambda_slope_plot(res_pknca_df = myres$result, conc_pknca_df = mydata$conc$data, + analyte = "analyte_1", + pcspec = "pcspec_1", dosno = 1, usubjid = "subject_1", R2ADJTHRESHOL = 0.7) diff --git a/tests/testthat/test-general_lineplot.R b/tests/testthat/test-general_lineplot.R index f7e21ff2..b9cb9375 100644 --- a/tests/testthat/test-general_lineplot.R +++ b/tests/testthat/test-general_lineplot.R @@ -2,7 +2,8 @@ sample_data <- data.frame( STUDYID = rep("Study1", 24), USUBJID = rep(c("Subject1", "Subject2", "Subject3", "Subject4"), each = 6), - ANALYTE = rep("Analyte1", 24), + ANALYTE = rep(c("Analyte1", "Analyte 2"), each = 12), + PCSPEC = rep(c("Spec1", "Spec2"), each = 12), DOSNO = rep(1, 24), EVID = rep(0, 24), NRRLT = rep(1:6, 4), @@ -25,6 +26,7 @@ describe("general_lineplot functions correctly", { data = sample_data, selected_analytes = "Analyte1", selected_usubjids = c("Subject1", "Subject2"), + selected_pcspec = "Spec1", colorby_var = "DOSNO", time_scale = "By Cycle", yaxis_scale = "Linear", @@ -39,6 +41,7 @@ describe("general_lineplot functions correctly", { data = empty_data, selected_analytes = "Analyte1", selected_usubjids = c("Subject1", "Subject2"), + selected_pcspec = "Spec1", colorby_var = "DOSNO", time_scale = "By Cycle", yaxis_scale = "Linear", @@ -55,6 +58,7 @@ describe("general_lineplot functions correctly", { data = incomplete_data, selected_analytes = "Analyte1", selected_usubjids = c("Subject1", "Subject2"), + selected_pcspec = "Spec1", colorby_var = "DOSNO", time_scale = "By Cycle", yaxis_scale = "Linear", @@ -69,6 +73,7 @@ describe("general_lineplot functions correctly", { data = sample_data, selected_analytes = "Analyte1", selected_usubjids = c("Subject1", "Subject2"), + selected_pcspec = "Spec1", colorby_var = "DOSNO", time_scale = "By Cycle", yaxis_scale = "Log", diff --git a/tests/testthat/test-general_meanplot.R b/tests/testthat/test-general_meanplot.R index f8b2fcd7..e8c59740 100644 --- a/tests/testthat/test-general_meanplot.R +++ b/tests/testthat/test-general_meanplot.R @@ -1,20 +1,21 @@ # Sample data for testing sample_data <- data.frame( - STUDYID = rep("Study1", 24), - USUBJID = rep(c("Subject1", "Subject2", "Subject3", "Subject4"), each = 6), - ANALYTE = rep("Analyte1", 24), - DOSNO = rep(1, 24), - EVID = rep(0, 24), - NRRLT = rep(1:6, 4), - AVAL = c( + STUDYID = rep("Study1", 48), + USUBJID = rep(c("Subject1", "Subject2", "Subject3", "Subject4"), each = 12), + ANALYTE = rep(c("Analyte1", "Analyte 2"), each = 24), + PCSPEC = rep(c("Spec1", "Spec2"), each = 24), + DOSNO = rep(1, 48), + EVID = rep(0, 48), + NRRLT = rep(1:6, 8), + AVAL = rep(c( 10, 20, 30, 40, 50, 60, 15, 25, 35, 45, 55, 65, 12, 22, 32, 42, 52, 62, 18, 28, 38, 48, 58, 68 - ), - RRLTU = rep("hours", 24), - AVALU = rep("ng/mL", 24), - DOSEA = rep(35, 24) + ), 2), + RRLTU = rep("hours", 48), + AVALU = rep("ng/mL", 48), + DOSEA = rep(35, 48) ) describe("general_meanplot functions correctly", { @@ -23,6 +24,7 @@ describe("general_meanplot functions correctly", { data = sample_data, selected_studyids = "Study1", selected_analytes = "Analyte1", + selected_pcspecs = "Spec1", selected_cycles = 1 ) expect_s3_class(p, "ggplot") @@ -34,6 +36,7 @@ describe("general_meanplot functions correctly", { data = empty_data, selected_studyids = "Study1", selected_analytes = "Analyte1", + selected_pcspecs = "Spec1", selected_cycles = 1 ) expect_s3_class(p, "ggplot") @@ -47,6 +50,7 @@ describe("general_meanplot functions correctly", { data = incomplete_data, selected_studyids = "Study1", selected_analytes = "Analyte1", + selected_pcspecs = "Spec1", selected_cycles = 1 ), "object 'AVAL' not found" @@ -57,6 +61,7 @@ describe("general_meanplot functions correctly", { data = sample_data, selected_studyids = "Study1", selected_analytes = "Analyte1", + selected_pcspecs = "Spec1", selected_cycles = 1, plot_sd = TRUE ) @@ -72,6 +77,7 @@ describe("general_meanplot functions correctly", { data = sample_data, selected_studyids = "Study1", selected_analytes = "Analyte1", + selected_pcspecs = "Spec1", selected_cycles = 1, plot_ci = TRUE ) @@ -90,6 +96,7 @@ describe("general_meanplot functions correctly", { data = sample_data, selected_studyids = "Study1", selected_analytes = "Analyte1", + selected_pcspecs = "Spec1", selected_cycles = 1, plot_ylog = TRUE ) diff --git a/tests/testthat/test-utils-slope_selector.R b/tests/testthat/test-utils-slope_selector.R index 0b03ccba..0936058a 100644 --- a/tests/testthat/test-utils-slope_selector.R +++ b/tests/testthat/test-utils-slope_selector.R @@ -6,6 +6,7 @@ DATA_FIXTURE <- list( USUBJID = rep(1:4, each = 4), DOSNO = 1, IX = rep(1:4, times = 4), + ANALYTE = rep("A", 16), is.included.hl = FALSE, is.excluded.hl = FALSE, exclude_half.life = FALSE, @@ -14,11 +15,11 @@ DATA_FIXTURE <- list( ) ) -PROFILES_FIXTURE <- list( - "1" = list(1), - "2" = list(1), - "3" = list(1), - "4" = list(1) +PROFILES_FIXTURE <- data.frame( + USUBJID = rep(1:4, each = 1), + ANALYTE = rep("A", 4), + PCSPEC = rep(1, 4), + DOSNO = rep(1, 4) ) describe(".filter_slopes", { @@ -27,6 +28,8 @@ describe(".filter_slopes", { TYPE = rep("Selection", 2), PATIENT = c(1, 3), PROFILE = c(1, 1), + ANALYTE = c("A", "A"), + PCSPEC = c(1, 1), IXrange = c("1:3", "2:4"), REASON = "Test selection" ) @@ -41,6 +44,8 @@ describe(".filter_slopes", { TYPE = rep("Exclusion", 2), PATIENT = c(2, 4), PROFILE = c(1, 1), + ANALYTE = c("A", "A"), + PCSPEC = c(1, 1), IXrange = c("1:2", "2:3"), REASON = "Test exclusion" ) @@ -66,6 +71,8 @@ EXISTING_FIXTURE <- data.frame( TYPE = "Exclusion", PATIENT = 1, PROFILE = 1, + ANALYTE = "A", + PCSPEC = 1, IXrange = "3:6" ) @@ -76,6 +83,8 @@ describe(".check_slope_rule_overlap", { TYPE = "Selection", PATIENT = 1, PROFILE = 1, + ANALYTE = "A", + PCSPEC = 1, IXrange = "1:3" ) expect_equal(nrow(.check_slope_rule_overlap(EXISTING_FIXTURE, NEW)), 2) @@ -85,6 +94,8 @@ describe(".check_slope_rule_overlap", { TYPE = "Exclusion", PATIENT = 2, PROFILE = 1, + ANALYTE = "A", + PCSPEC = 1, IXrange = "1:3" ) expect_equal(nrow(.check_slope_rule_overlap(EXISTING_FIXTURE, NEW)), 2) @@ -94,6 +105,8 @@ describe(".check_slope_rule_overlap", { TYPE = "Exclusion", PATIENT = 1, PROFILE = 2, + ANALYTE = "A", + PCSPEC = 1, IXrange = "1:3" ) expect_equal(nrow(.check_slope_rule_overlap(EXISTING_FIXTURE, NEW)), 2) @@ -104,6 +117,8 @@ describe(".check_slope_rule_overlap", { TYPE = "Exclusion", PATIENT = 1, PROFILE = 1, + ANALYTE = "A", + PCSPEC = 1, IXrange = "4:5" ) expect_equal(.check_slope_rule_overlap(EXISTING_FIXTURE, NEW)$IXrange, "3,6") @@ -112,6 +127,8 @@ describe(".check_slope_rule_overlap", { TYPE = "Exclusion", PATIENT = 1, PROFILE = 1, + ANALYTE = "A", + PCSPEC = 1, IXrange = "3:4" ) expect_equal(.check_slope_rule_overlap(EXISTING_FIXTURE, NEW)$IXrange, "5:6") @@ -122,6 +139,8 @@ describe(".check_slope_rule_overlap", { TYPE = "Exclusion", PATIENT = 1, PROFILE = 1, + ANALYTE = "A", + PCSPEC = 1, IXrange = "4:9" ) expect_equal(.check_slope_rule_overlap(EXISTING_FIXTURE, NEW)$IXrange, "3:9") @@ -132,6 +151,8 @@ describe(".check_slope_rule_overlap", { TYPE = "Exclusion", PATIENT = 1, PROFILE = 1, + ANALYTE = "A", + PCSPEC = 1, IXrange = "3:6" ) expect_equal(nrow(.check_slope_rule_overlap(EXISTING_FIXTURE, NEW)), 0) From bc66f5c3f442610c8b1ad509f07eecd784c01067 Mon Sep 17 00:00:00 2001 From: Spinner Date: Mon, 20 Jan 2025 15:19:03 +0100 Subject: [PATCH 8/9] clean and lint --- R/format_data.R | 2 +- R/general_lineplot.R | 7 ++++++- R/lambda_slope_plot.R | 5 +++-- inst/shiny/modules/slope_selector.R | 10 ++++++++-- inst/shiny/modules/tab_visuals.R | 21 ++++++++++++--------- inst/shiny/tabs/nca.R | 8 +++++--- inst/shiny/ui.R | 16 +++++++++------- 7 files changed, 44 insertions(+), 25 deletions(-) diff --git a/R/format_data.R b/R/format_data.R index 43144da6..79265c0e 100644 --- a/R/format_data.R +++ b/R/format_data.R @@ -97,7 +97,7 @@ format_pkncadose_data <- function(pkncaconc_data, slice(1) %>% ungroup() %>% arrange(!!!syms(group_columns)) - + } #' Create Dose Intervals Dataset diff --git a/R/general_lineplot.R b/R/general_lineplot.R index 29dcfe4f..2ad421ed 100644 --- a/R/general_lineplot.R +++ b/R/general_lineplot.R @@ -52,7 +52,8 @@ #' @importFrom tern g_ipp #' @export general_lineplot <- function( - data, selected_analytes, selected_pcspec, selected_usubjids, colorby_var, time_scale, yaxis_scale, cycle = NULL + data, selected_analytes, selected_pcspec, selected_usubjids, + colorby_var, time_scale, yaxis_scale, cycle = NULL ) { # Check if the data is empty @@ -75,6 +76,10 @@ general_lineplot <- function( DOSEA = factor(DOSEA), id_var = interaction(!!!syms(colorby_var), sep = ", ") ) + # Check if the data is empty + if (nrow(preprocessed_data) == 0) { + return(ggplot() + ggtitle("No data available for selected parameters")) + } # If there are predose records duplicate them in the previous line so they are considered if ("ARRLT" %in% names(preprocessed_data) && diff --git a/R/lambda_slope_plot.R b/R/lambda_slope_plot.R index 8aa9e8ed..3b628f52 100644 --- a/R/lambda_slope_plot.R +++ b/R/lambda_slope_plot.R @@ -63,7 +63,8 @@ lambda_slope_plot <- function( # Obtain all information relevant regarding lambda calculation lambda_res <- res_pknca_df %>% - filter(DOSNO == dosno, USUBJID == usubjid, ANALYTE == analyte, PCSPEC == pcspec, type_interval == "main") %>% + filter(DOSNO == dosno, USUBJID == usubjid, ANALYTE == analyte, + PCSPEC == pcspec, type_interval == "main") %>% arrange(USUBJID, DOSNO, ANALYTE, PCSPEC, start, desc(end)) %>% filter(!duplicated(paste0(USUBJID, DOSNO, PCSPEC, ANALYTE, PPTESTCD))) @@ -236,7 +237,7 @@ lambda_slope_plot <- function( pl <- pl %>% # Make this trace the only one add_trace( - data = plot_data %>% filter(DOSNO == dosno, USUBJID == usubjid, + data = plot_data %>% filter(DOSNO == dosno, USUBJID == usubjid, ANALYTE == analyte, PCSPEC == pcspec), x = ~TIME, y = ~log10(AVAL), customdata = ~paste0(USUBJID, "_", DOSNO, "_", IX), diff --git a/inst/shiny/modules/slope_selector.R b/inst/shiny/modules/slope_selector.R index 8b276087..9b74cb56 100644 --- a/inst/shiny/modules/slope_selector.R +++ b/inst/shiny/modules/slope_selector.R @@ -95,7 +95,9 @@ slope_selector_ui <- function(id) { .SLOPE_SELECTOR_COLUMNS <- c("TYPE", "PATIENT", "ANALYTE", "PCSPEC", "PROFILE", "IXrange", "REASON") slope_selector_server <- function( - id, mydata, res_nca, profiles_per_patient, cycle_nca, analyte_nca, pcspec_nca, pk_nca_trigger, settings_upload + id, mydata, res_nca, profiles_per_patient, + cycle_nca, analyte_nca, pcspec_nca, + pk_nca_trigger, settings_upload ) { moduleServer(id, function(input, output, session) { log_trace("{id}: Attaching server") @@ -402,7 +404,11 @@ slope_selector_server <- function( shiny::debounce(750) # Define the click events for the point exclusion and selection in the slope plots - last_click_data <- reactiveValues(patient = "", profile = "", analyte = "", pcspec = "", idx_pnt = "") + last_click_data <- reactiveValues( + patient = "", profile = "", + analyte = "", pcspec = "", + idx_pnt = "" + ) observeEvent(event_data("plotly_click", priority = "event"), { # Store the information of the last click event # click_data <- event_data("plotly_click") diff --git a/inst/shiny/modules/tab_visuals.R b/inst/shiny/modules/tab_visuals.R index a163de5a..e555ccab 100644 --- a/inst/shiny/modules/tab_visuals.R +++ b/inst/shiny/modules/tab_visuals.R @@ -128,7 +128,7 @@ tab_visuals_ui <- function(id) { orderInput( ns("summary_groupby"), "..to hierarchically group by (order matters!):", - items = c( "ANALYTE", "PCSPEC", "DOSNO"), + items = c("ANALYTE", "PCSPEC", "DOSNO"), width = shiny::validateCssUnit("100%"), connect = ns("summary_groupby_source"), placeholder = "Drag items here to group hierarchically..." @@ -223,13 +223,14 @@ tab_visuals_server <- function(id, data, grouping_vars, res_nca) { param_choices_pcspec <- data() %>% pull(PCSPEC) %>% unique() - + updatePickerInput( session, "generalplot_pcspec", choices = param_choices_pcspec, + selected = param_choices_pcspec[1] ) - + # Update the usubjid picker input param_choices_usubjid <- data() %>% pull(USUBJID) %>% @@ -244,7 +245,7 @@ tab_visuals_server <- function(id, data, grouping_vars, res_nca) { # Update the colorby picker input param_choices_colorby <- sort( - c("STUDYID", "PCSPEC", "ANALYTE", "DOSEA", "DOSNO", "USUBJID", grouping_vars()) + c("STUDYID", "PCSPEC", "ANALYTE", "DOSEA", "DOSNO", "USUBJID", grouping_vars()) ) updatePickerInput( @@ -262,7 +263,8 @@ tab_visuals_server <- function(id, data, grouping_vars, res_nca) { updateSelectInput( session, "analyte_mean", - choices = sort(analyte_choices) + choices = sort(analyte_choices), + selected = analyte_choices[1] ) # Update the studyidmean select input @@ -275,20 +277,21 @@ tab_visuals_server <- function(id, data, grouping_vars, res_nca) { "studyid_mean", choices = sort(studyid_choices) ) - + # Update pcspec mean choices pcspec_choices <- data() %>% pull(PCSPEC) %>% unique() - + updateSelectInput( session, "pcspec_mean", - choices = sort(pcspec_choices) + choices = sort(pcspec_choices), + selected = pcspec_choices[1] ) # Update the selectidvar select input - idvar_choices <- c("ANALYTE","PCSPEC", "DOSEA", grouping_vars()) + idvar_choices <- c("ANALYTE", "PCSPEC", "DOSEA", grouping_vars()) updateSelectInput( session, diff --git a/inst/shiny/tabs/nca.R b/inst/shiny/tabs/nca.R index 0d1a522f..d5c68045 100644 --- a/inst/shiny/tabs/nca.R +++ b/inst/shiny/tabs/nca.R @@ -19,7 +19,8 @@ observeEvent(data(), { session, inputId = "select_analyte", label = "Choose the Analyte(s) :", - choices = unique(data()$ANALYTE) + choices = unique(data()$ANALYTE), + selected = unique(data()$ANALYTE)[1] ) }) @@ -28,7 +29,8 @@ observeEvent(data(), { session, inputId = "select_pcspec", label = "Choose the Specimen Type(s) :", - choices = unique(data()$PCSPEC) + choices = unique(data()$PCSPEC), + selected = unique(data()$PCSPEC)[1] ) }) @@ -481,7 +483,7 @@ res_nca <- eventReactive(pk_nca_trigger(), { myres$result <- myres$result %>% inner_join(select(mydata()$dose$data, -exclude)) %>% mutate(start = start - !!sym(mydata()$dose$columns$time), - end = end - !!sym(mydata()$dose$columns$time)) %>% + end = end - !!sym(mydata()$dose$columns$time)) %>% select(names(myres$result)) # Return the result diff --git a/inst/shiny/ui.R b/inst/shiny/ui.R index 878de5a2..ffe4cb44 100644 --- a/inst/shiny/ui.R +++ b/inst/shiny/ui.R @@ -51,20 +51,22 @@ fluidPage( # Selection of analyte selectInput( "select_analyte", - "Choose the Analyte :", - choices = NULL, - multiple = TRUE), + "Choose the Analyte(s) :", + choices = c("Please specify ANALYTE" = ""), + multiple = TRUE + ), # Selection of matrix selectInput( "select_pcspec", - "Choose the Matrix:", - choices = NULL, - multiple = TRUE), + "Choose the Specimen Type(s):", + choices = c("Please specify PCSPEC" = ""), + multiple = TRUE + ), selectInput( "select_dosno", "Choose the Dose Number:", multiple = TRUE, - choices = c("Please specify ANALYTE in Data Selection" = "") + choices = c("Please specify ANALYTE first" = "") ), br(), actionButton("submit_analyte", "Submit"), From c04ac4e60d21353c3b8db0fbb4ab0596c0a61157 Mon Sep 17 00:00:00 2001 From: Spinner Date: Mon, 20 Jan 2025 16:06:01 +0100 Subject: [PATCH 9/9] spellcheck --- R/general_lineplot.R | 2 +- R/general_meanplot.R | 2 +- R/lambda_slope_plot.R | 2 +- man/general_lineplot.Rd | 2 +- man/general_meanplot.Rd | 2 +- man/lambda_slope_plot.Rd | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/general_lineplot.R b/R/general_lineplot.R index 2ad421ed..40783651 100644 --- a/R/general_lineplot.R +++ b/R/general_lineplot.R @@ -6,7 +6,7 @@ #' #' @param data A data frame containing the ADNCA dataset. #' @param selected_analytes A character vector of selected analytes to be included in the plot. -#' @param selected_pcspec A character vector of selected pcspec to be included in the plot. +#' @param selected_pcspec A character vector of selected matrix to be included in the plot. #' @param selected_usubjids A character vector of selected unique subject identifiers (USUBJIDs) #' to be included in the plot. #' @param colorby_var A character string specifying the variable by which to color diff --git a/R/general_meanplot.R b/R/general_meanplot.R index 87ef3b31..a8326666 100644 --- a/R/general_meanplot.R +++ b/R/general_meanplot.R @@ -7,7 +7,7 @@ #' @param data A data frame containing the ADNCA dataset. #' @param selected_studyids A character vector of selected study IDs to be included in the plot. #' @param selected_analytes A character vector of selected analytes to be included in the plot. -#' @param selected_pcspecs A character vector of selected pcspecs to be included in the plot. +#' @param selected_pcspecs A character vector of selected matrices to be included in the plot. #' @param selected_cycles A character vector or numeric vector of selected cycles to be #' included in the plot. #' @param id_variable A character string specifying the variable by which to color the lines diff --git a/R/lambda_slope_plot.R b/R/lambda_slope_plot.R index 3b628f52..7e0cf566 100644 --- a/R/lambda_slope_plot.R +++ b/R/lambda_slope_plot.R @@ -10,7 +10,7 @@ #' (default is `mydata$conc$data`). #' @param dosno Numeric value representing the dose number (default is `profile`). #' @param analyte Character value representing the analyte (default is `analyte`). -#' @param pcspec Character value representing the pcspec (default is `pcspec`). +#' @param pcspec Character value representing the matrix (default is `pcspec`). #' @param usubjid Character value representing the unique subject identifier #' (default is `patient`). #' @param R2ADJTHRESHOL Numeric value representing the R-squared adjusted threshold for determining diff --git a/man/general_lineplot.Rd b/man/general_lineplot.Rd index 675ba70e..99f0f475 100644 --- a/man/general_lineplot.Rd +++ b/man/general_lineplot.Rd @@ -20,7 +20,7 @@ general_lineplot( \item{selected_analytes}{A character vector of selected analytes to be included in the plot.} -\item{selected_pcspec}{A character vector of selected pcspec to be included in the plot.} +\item{selected_pcspec}{A character vector of selected matrix to be included in the plot.} \item{selected_usubjids}{A character vector of selected unique subject identifiers (USUBJIDs) to be included in the plot.} diff --git a/man/general_meanplot.Rd b/man/general_meanplot.Rd index f51985c2..2974561a 100644 --- a/man/general_meanplot.Rd +++ b/man/general_meanplot.Rd @@ -23,7 +23,7 @@ general_meanplot( \item{selected_analytes}{A character vector of selected analytes to be included in the plot.} -\item{selected_pcspecs}{A character vector of selected pcspecs to be included in the plot.} +\item{selected_pcspecs}{A character vector of selected matrices to be included in the plot.} \item{selected_cycles}{A character vector or numeric vector of selected cycles to be included in the plot.} diff --git a/man/lambda_slope_plot.Rd b/man/lambda_slope_plot.Rd index e04b32c6..e1504a86 100644 --- a/man/lambda_slope_plot.Rd +++ b/man/lambda_slope_plot.Rd @@ -28,7 +28,7 @@ analysis (default is \code{PKNCA::pk.nca(.)$result}).} \item{analyte}{Character value representing the analyte (default is \code{analyte}).} -\item{pcspec}{Character value representing the pcspec (default is \code{pcspec}).} +\item{pcspec}{Character value representing the matrix (default is \code{pcspec}).} \item{R2ADJTHRESHOL}{Numeric value representing the R-squared adjusted threshold for determining the subtitle color (default is 0.7).}