From f7b049427cfec99fd371a267939ceb4013482090 Mon Sep 17 00:00:00 2001 From: Marco Ferrari Date: Fri, 1 May 2026 11:10:07 +0100 Subject: [PATCH 1/2] issue fix with plotting --- R/fct_Annotate.R | 4 +-- R/fct_Custom_tables.R | 57 +++++++++++++++++++++++++++++-------------- R/fct_R6_clean_data.R | 2 +- 3 files changed, 42 insertions(+), 21 deletions(-) diff --git a/R/fct_Annotate.R b/R/fct_Annotate.R index 1f03d10..240edeb 100644 --- a/R/fct_Annotate.R +++ b/R/fct_Annotate.R @@ -184,7 +184,7 @@ Annotate <- plt_title <- stringr::str_c(data$sampleName)#, data$img_number, sep = ", Image ") plt_sub <- data$vesselName - yaxis <- stringr::str_wrap(data$metric, width = 26) + yaxis <- stringr::str_wrap(data$metric, width = 40) # get data df <- data.frame(timevar = timevar, ch1 = ch1) group_label <- if (!is.null(data$sampleGroup) && nzchar(data$sampleGroup) && data$sampleGroup != "Exp") { @@ -245,7 +245,7 @@ Annotate <- plot.title = ggplot2::element_text(hjust = 0.5, size = 14), plot.subtitle = ggplot2::element_text(hjust = 0.5, size = 12), axis.text = ggplot2::element_text(size = 11), - axis.title.y = ggplot2::element_text(size = 13, margin = ggplot2::margin(r = 12)), + axis.title.y = ggplot2::element_text(size = 13, margin = ggplot2::margin(r = 30)), axis.title.x = ggplot2::element_text(size = 13), panel.grid.major.x = ggplot2::element_line(color = "black", linewidth = 0.5, diff --git a/R/fct_Custom_tables.R b/R/fct_Custom_tables.R index 41a0e88..bef0b00 100644 --- a/R/fct_Custom_tables.R +++ b/R/fct_Custom_tables.R @@ -443,15 +443,36 @@ Custom_tables <- R6::R6Class("Custom_tables", #' @return a table of resultys containing Period length, phase, amplitude, offset and error fft_nlls_period = function(data) { - # Perform FFT - n <- length(data$value) - dt <- mean(diff(data$t)) - fft_result <- stats::fft(data$value) + # Drop NAs before FFT — NAs propagate through fft() and make + # which.max() return integer(0), causing nls.lm length mismatch. + valid_idx <- !is.na(data$value) + fft_vals <- data$value[valid_idx] + fft_t <- data$t[valid_idx] + n_valid <- length(fft_vals) + + if (n_valid < 10) { + return(list(period = NA_real_, amplitude = NA_real_, + phase_rad = NA_real_, phase_circ = NA_real_, + phase_abs = NA_real_, offset = NA_real_, + error = NA_real_, GOF = NA_real_, RAE = NA_real_)) + } + + # Perform FFT on complete cases + n <- n_valid + dt <- mean(diff(fft_t)) + fft_result <- stats::fft(fft_vals) frequencies <- seq(0, 1/dt, length.out = n) # Identify the dominant frequency (excluding the zero frequency) - dominant_frequency <- frequencies[which.max(base::Mod(fft_result)[2:(n/2)]) + 1] - initial_period <- 1 / dominant_frequency + dominant_idx <- which.max(base::Mod(fft_result)[2:floor(n/2)]) + if (length(dominant_idx) == 0) { + initial_period <- 24 # fallback to circadian period + } else { + dominant_frequency <- frequencies[dominant_idx + 1] + initial_period <- if (is.finite(dominant_frequency) && dominant_frequency > 0) { + 1 / dominant_frequency + } else 24 + } # Define the sinusoidal model function sinusoidal_model = function(params, t) { @@ -467,18 +488,18 @@ Custom_tables <- R6::R6Class("Custom_tables", return(y - sinusoidal_model(params, t)) } - # Initial parameter estimates - initial_amplitude <- (max(data$value) - min(data$value)) / 2 + # Initial parameter estimates (using NA-free vectors) + initial_amplitude <- (max(fft_vals) - min(fft_vals)) / 2 initial_phase <- 0 - initial_offset <- mean(data$value) + initial_offset <- mean(fft_vals) initial_params <- c(initial_amplitude, initial_period, initial_phase, initial_offset) - # Perform nonlinear least squares fitting + # Perform nonlinear least squares fitting on complete cases fit <- minpack.lm::nls.lm( par = initial_params, fn = residuals, - t = data$t, - y = data$value, + t = fft_t, + y = fft_vals, lower = c(-Inf, 12, -Inf, -Inf), upper = c(Inf, 32, Inf, Inf) ) @@ -512,17 +533,17 @@ Custom_tables <- R6::R6Class("Custom_tables", phase_circadian <- circular::conversion.circular(fitted_phase, units = "hours") phase_absolute <- phase_circadian*(fitted_period/24) - # Compute residual error - fitted_values <- sinusoidal_model(fitted_params, data$t) - residual_error <- sqrt(mean((data$value - fitted_values)^2)) + # Compute residual error (using NA-free vectors) + fitted_values <- sinusoidal_model(fitted_params, fft_t) + residual_error <- sqrt(mean((fft_vals - fitted_values)^2)) # Calculate R-squared (GOF) - ss_total <- sum((data$value - mean(data$value))^2) - ss_res <- sum((data$value - fitted_values)^2) + ss_total <- sum((fft_vals - mean(fft_vals))^2) + ss_res <- sum((fft_vals - fitted_values)^2) r_squared <- 1 - (ss_res / ss_total) # Compute standard deviation of residuals - residual_std <- sqrt(sum((data$value - fitted_values)^2) / (length(data$value) - length(fitted_params))) + residual_std <- sqrt(sum((fft_vals - fitted_values)^2) / (length(fft_vals) - length(fitted_params))) # Compute RAE RAE <- residual_std / fitted_amplitude diff --git a/R/fct_R6_clean_data.R b/R/fct_R6_clean_data.R index 897ad68..78fb1f5 100644 --- a/R/fct_R6_clean_data.R +++ b/R/fct_R6_clean_data.R @@ -288,7 +288,7 @@ Clean_sample_data <- detrend = function(grade){ outliers_rm = FALSE # runs a check if the dataset with removed outliers is available - if(!is.null(self$intensity_clean)){ + if(length(self$intensity_clean) > 0){ outliers_rm = TRUE # import data from cleaned values intensity <- self$intensity_clean From a817fdcf3471bb3163dcda985e7535928e61c51e Mon Sep 17 00:00:00 2001 From: Marco Ferrari Date: Fri, 1 May 2026 11:26:09 +0100 Subject: [PATCH 2/2] update UI --- R/mod_analysis.R | 147 ++++++++++++++++++++++++++++++++++------------- 1 file changed, 107 insertions(+), 40 deletions(-) diff --git a/R/mod_analysis.R b/R/mod_analysis.R index efc231b..684365d 100644 --- a/R/mod_analysis.R +++ b/R/mod_analysis.R @@ -49,44 +49,61 @@ mod_analysis_ui <- function(id){ # # ), shinydashboard::box(title = "Timeseries", id = "box3_0", width = 12, solidHeader = TRUE, collapsible = TRUE, status = "primary", - fluidRow(column(width = 8), - column(width = 4, - actionButton(ns('help3_0'), label = 'Help', - style = "color: #fff; background-color: #1e690c; border-color: #1e530c;") - ) + # Section 1: pre-processing + fluidRow(style = "margin-top: 4px; margin-bottom: 4px;", + column(width = 8, + h5("1. Pre-processing", style = "font-weight: bold; margin: 0;") + ), + column(width = 4, style = "text-align: right;", + actionButton(ns('help3_0'), label = 'Help', + style = "color: #fff; background-color: #1e690c; border-color: #1e530c;") + ) + ), + fluidRow( + column(width = 4, + actionButton(ns("remove_out"), "Remove outliers", + style = "width: 100%;") + ), + column(width = 4, + actionButton(inputId = ns("TsDetrend"), label = "Detrend", + style = "width: 100%; margin-bottom: 6px;"), + shinyWidgets::pickerInput(inputId = ns("detr_opt"), + label = NULL, + choices = c("linear", "cubic"), + selected = "cubic", multiple = FALSE) + ), + column(width = 4, + shinyjs::disabled(actionButton(inputId = ns("TsNormalize"), label = "Normalize", + style = "width: 100%;")) + ) + ), + shiny::hr(), + # Section 2: visualise + fluidRow(style = "margin-bottom: 4px;", + column(width = 12, + h5("2. Plot", style = "font-weight: bold; margin: 0;") + ) ), fluidRow( column(width = 6, shiny::sliderInput(inputId = ns("xlimits_tsplot"), - label = "Select time window to visualize", + label = "Time window", min = 0, max = 200, step = 0.5, value = c(0, 200), dragRange = TRUE) ), column(width = 3, - shinyWidgets::pickerInput(inputId = ns("plot_this"), label = "Select data to plot", - choices = c("original", "detrended", "cleaned"), + shinyWidgets::pickerInput(inputId = ns("plot_this"), + label = "Dataset", + choices = "original", selected = "original", multiple = FALSE) ), - column(width = 3, - actionButton(inputId = ns("TsPlot"), label = "Plot") + column(width = 3, style = "margin-top: 25px;", + actionButton(inputId = ns("TsPlot"), label = "Plot", + style = "width: 100%;") ) - ), - shiny::hr(), - fluidRow( - column(width = 4, actionButton(inputId = ns("TsDetrend"), label = "Detrend")), - column(width = 4, actionButton(ns("remove_out"), "Remove outliers")), - column(width = 4, shinyjs::disabled(actionButton(inputId = ns("TsNormalize"), label = "Normalize"))) - ), - fluidRow( - column(width = 4, - shinyWidgets::pickerInput(inputId = ns("detr_opt"), label = "Select detrending method", - choices = c("linear", "cubic"), selected = "linear", multiple = FALSE) - ), - column(width = 4), - column(width = 4) ) ), - shinydashboard::box(title= "Plots", id = "box3_1", width = 12, solidHeader = TRUE, collapsible = TRUE, status = "primary", + shinydashboard::box(title= "Plots", id = "box3_1", width = 12, solidHeader = TRUE, collapsible = TRUE, collapsed = TRUE, status = "primary", shinyjs::hidden(div(id = ns("ts_plot_output"), fluidRow( column(width = 6, @@ -107,22 +124,24 @@ mod_analysis_ui <- function(id){ ), column(width = 3, offset = 1, downloadButton(outputId = ns("Dl_plots"), - label = tagList(" Timeseries plots")) + label = tagList(" Timeseries plots"), + style = "color: #fff; background-color: #2171b5; border-color: #125588;") ) ), fluidRow(column(width = 12, - plotly::plotlyOutput(ns("TSplot_out")) + plotly::plotlyOutput(ns("TSplot_out"), height = "400px") )) )) ), shinydashboard::box(title= "Period Analysis", id = "box3_2", width = 12, solidHeader = TRUE, collapsible = TRUE, status = "primary", fluidRow(column(width = 12, shinyWidgets::pickerInput(inputId = ns("period_data"), label = "Select data to use for period analysis", - choices = c("original", "detrended", "cleaned"), + choices = "original", selected = "original", multiple = FALSE), actionButton(ns("period_an"), "launch period analysis"), shinyjs::disabled(downloadButton(outputId = ns("Dl_period"), - label = tagList(" Period table (.csv)"))) + label = tagList(" Period table (.csv)"), + style = "color: #fff; background-color: #2171b5; border-color: #125588;")) ) ), fluidRow(column(width = 12, @@ -165,7 +184,8 @@ mod_analysis_ui <- function(id){ ), fluidRow(column(width = 12, downloadButton(ns("Dl_scatter"), - label = tagList(" Analysis plots (.zip)")) + label = tagList(" Analysis plots (.zip)"), + style = "color: #fff; background-color: #2171b5; border-color: #125588;") )), shinyjs::hidden(div(id = ns("excl_controls"), style = "margin-top: 12px; padding: 0 15px;", @@ -185,7 +205,8 @@ mod_analysis_ui <- function(id){ DT::DTOutput(ns("summary_table"))), shiny::br(), downloadButton(ns("Dl_summary"), - label = tagList(" Summary table (.csv)")) + label = tagList(" Summary table (.csv)"), + style = "color: #fff; background-color: #2171b5; border-color: #125588;") )) )) ) @@ -219,6 +240,7 @@ mod_analysis_server <- function(id, env){ rv <- reactiveValues(currentPlotIndex = 1, t_min = 0, t_max = 1000, + plot_initialized = FALSE, fft_data = NULL, selected_id = NULL, excluded_ids = character(0), @@ -277,21 +299,61 @@ mod_analysis_server <- function(id, env){ # BOX 3.0 + observeEvent(input$help3_0, { + shiny::showModal(shiny::modalDialog( + title = "Timeseries analysis", + easyClose = TRUE, + footer = shiny::modalButton("Close"), + shiny::tags$div( + shiny::tags$h4("1. Pre-processing"), + shiny::tags$p("These steps are optional but recommended before running period analysis. + Run them in order, then use", shiny::tags$b("Plot"), "to inspect the result."), + shiny::tags$b("Remove outliers"), + shiny::tags$p("Detects and removes extreme values (e.g. debris, focus artefacts) using a rolling-window loess filter. + Flagged timepoints are replaced with", shiny::tags$code("NA"), "and interpolated when plotting or analysing. + Run this step first, before detrending."), + shiny::tags$b("Detrend"), + shiny::tags$p("Removes long-term baseline drift by fitting and subtracting a polynomial trend. + If outlier removal has already been run, detrending uses the cleaned data automatically."), + shiny::tags$ul( + shiny::tags$li(shiny::tags$b("Linear"), " -- fits a straight-line trend (grade 1); suitable for mild drift."), + shiny::tags$li(shiny::tags$b("Cubic"), " -- fits a cubic polynomial (grade 3); better for curved baselines.") + ), + shiny::tags$h4("2. Plot"), + shiny::tags$p("Use the", shiny::tags$b("time window slider"), "to restrict the portion of the recording to display, + select the dataset to inspect from the dropdown, and press", shiny::tags$b("Plot"), "."), + shiny::tags$p("Navigation arrows step through individual samples; the last panel shows all samples in a single faceted overview."), + shiny::tags$h5("Available datasets"), + shiny::tags$ul( + shiny::tags$li(shiny::tags$b("original"), " -- raw values as exported from Incucyte."), + shiny::tags$li(shiny::tags$b("cleaned"), " -- available after Remove Outliers."), + shiny::tags$li(shiny::tags$b("detrended"), " -- available after Detrend.") + ) + ) + )) + }) + # actions to perform after pressing the TsPlot button observeEvent(input$TsPlot, { shinyjs::show("ts_plot_output") + shinyjs::runjs("$('#box3_1').closest('.box').removeClass('collapsed-box').find('.box-body').show();") shiny::showNotification("Timeseries plotted", type = "message", duration = 3) # update time range from actual data first, then use those values for plotting # (avoids reading stale input$xlimits_tsplot before the slider re-renders) rv$t_min <- round(min(env$env2$myCleanSample[[1]]$elapsed), 1) rv$t_max <- round(max(env$env2$myCleanSample[[1]]$elapsed), 1) - # update the slider inputs with real data range - updateSliderInput(session, "xlimits_tsplot", min = rv$t_min, max = rv$t_max, value = c(rv$t_min, rv$t_max)) - updateSliderInput(session, "period_timefr", min = rv$t_min, max = rv$t_max, value = c(rv$t_min, rv$t_max)) - - # use rv values as xlimits -- slider may not have re-rendered yet - xlimits <- c(rv$t_min, rv$t_max) + if (!rv$plot_initialized) { + # First press: update slider to real data range; input$xlimits_tsplot hasn't + # re-rendered yet so use the data range directly for this render. + updateSliderInput(session, "xlimits_tsplot", min = rv$t_min, max = rv$t_max, value = c(rv$t_min, rv$t_max)) + updateSliderInput(session, "period_timefr", min = rv$t_min, max = rv$t_max, value = c(rv$t_min, rv$t_max)) + xlimits <- c(rv$t_min, rv$t_max) + rv$plot_initialized <- TRUE + } else { + # Subsequent presses: slider is already initialised, use user selection. + xlimits <- input$xlimits_tsplot + } datasets <- input$datasets Annotate <- env$env2$Annotate @@ -458,7 +520,7 @@ mod_analysis_server <- function(id, env){ ) } } - plt <- plotly::ggplotly(p, height = 320) + plt <- plotly::ggplotly(p, height = 390) # inject hover text stored in the layer data frame (not in ggplot aes) layer_data <- p$layers[[1]]$data if (!is.null(layer_data) && "hover_text" %in% names(layer_data)) { @@ -835,20 +897,25 @@ mod_analysis_server <- function(id, env){ rv$selected_id <- NULL # clear any selection when new analysis runs rv$excluded_ids <- character(0) # reset exclusions for fresh analysis - # Auto-range period_timefr to actual data if the user hasn't plotted first + # Auto-range period_timefr to actual data if the user hasn't plotted first. + # updateSliderInput is async -- input$period_timefr won't reflect the new + # value within the same observer, so capture t_lim from the corrected range + # directly rather than re-reading the stale input after the update. t_min_data <- round(min(env$env2$myCleanSample[[1]]$elapsed), 1) t_max_data <- round(max(env$env2$myCleanSample[[1]]$elapsed), 1) if (input$period_timefr[2] > t_max_data || input$period_timefr[1] < t_min_data) { updateSliderInput(session, "period_timefr", min = t_min_data, max = t_max_data, value = c(t_min_data, t_max_data)) + t_lim <- c(t_min_data, t_max_data) + } else { + t_lim <- input$period_timefr } Custom_tables <- env$env2$Custom_tables Annotate <- env$env2$Annotate source <- input$period_data method <- input$period_fun - t_lim <- input$period_timefr period_tbl <- shiny::withProgress(message = "Running period analysis...", value = 0, { shiny::incProgress(0.2, detail = "Preparing data")