diff --git a/.gitignore b/.gitignore index a527a76..b9dbcaa 100755 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,6 @@ *_cache docs environment.yml +Pathway_info/ +.github +tests/ \ No newline at end of file diff --git a/R/MetAlyzer_dataset.R b/R/MetAlyzer_dataset.R index 9d2fb53..08947a3 100644 --- a/R/MetAlyzer_dataset.R +++ b/R/MetAlyzer_dataset.R @@ -223,7 +223,7 @@ get_data_range <- function(full_sheet) { dim(full_sheet) )[, 2] - rows_data <- which(full_sheet[, col_sample_type] == "Sample") # rows + rows_data <- which(grepl("^\\s*Sample\\s*$", full_sheet[, col_sample_type], ignore.case = TRUE)) # rows names(rows_data) <- NULL cols_data <- (col_class + 1):ncol(full_sheet) # columns diff --git a/R/MetAlyzer_fpaths.R b/R/MetAlyzer_fpaths.R index f3c706c..1187563 100644 --- a/R/MetAlyzer_fpaths.R +++ b/R/MetAlyzer_fpaths.R @@ -89,5 +89,5 @@ polarity <- function() { #' @examples #' fpath <- MetAlyzer::pathway() pathway <- function() { - system.file("extdata", "Pathway_120325.xlsx", package = "MetAlyzer") + system.file("extdata", "Pathway_100426.xlsx", package = "MetAlyzer") } diff --git a/inst/extdata/Pathway_100426.xlsx b/inst/extdata/Pathway_100426.xlsx new file mode 100644 index 0000000..97835ab Binary files /dev/null and b/inst/extdata/Pathway_100426.xlsx differ diff --git a/inst/extdata/Pathway_100426_lipids.xlsx b/inst/extdata/Pathway_100426_lipids.xlsx new file mode 100644 index 0000000..577151a Binary files /dev/null and b/inst/extdata/Pathway_100426_lipids.xlsx differ diff --git a/inst/extdata/Pathway_120325.xlsx b/inst/extdata/Pathway_120325.xlsx deleted file mode 100644 index e448137..0000000 Binary files a/inst/extdata/Pathway_120325.xlsx and /dev/null differ diff --git a/inst/extdata/~$Pathway_new.xlsx b/inst/extdata/~$Pathway_new.xlsx new file mode 100644 index 0000000..41813b4 Binary files /dev/null and b/inst/extdata/~$Pathway_new.xlsx differ diff --git a/inst/shinyapp/app.R b/inst/shinyapp/app.R index d1bd68f..7f87351 100644 --- a/inst/shinyapp/app.R +++ b/inst/shinyapp/app.R @@ -16,6 +16,7 @@ library(bslib) library(viridis) library(viridisLite) library(gridExtra) +library(MetaProViz) ui <- fluidPage( # Define notification styles for 'Process' and 'Revert/Default' buttons @@ -137,7 +138,7 @@ ui <- fluidPage( shinyBS::bsCollapse( id = 'panelDatOverviewViz', # Note that collapsed panel does not render output until it is expanded - open = c('Data distribution', 'Data completeness', 'Quantification status', 'Sample metadata (All)'), + open = c('Data distribution', 'Data completeness', 'Quantification status', 'Sample metadata (All)', 'PCA'), multiple = T, shinyBS::bsCollapsePanel('Sample metadata (All)', style = 'primary', DT::dataTableOutput('tblSmpMetadat') %>% @@ -205,6 +206,30 @@ ui <- fluidPage( selected = "html")), column(width = 2, downloadButton("downloadQuanStatus", "Download"))) + ), + shinyBS::bsCollapsePanel('PCA', style = 'primary', + fluidRow( + style = 'display:flex; align-items: center;', + column(width = 2, + selectInput('pcxPCA', 'PC (x-axis)', + choices = paste0('PC', 1:10), + selected = 'PC1')), + column(width = 2, + selectInput('pcyPCA', 'PC (y-axis)', + choices = paste0('PC', 1:10), + selected = 'PC2')), + column(width = 4, offset = 4, uiOutput('updateColorByPCA')) + ), + uiOutput('pcaDuplicateWarning'), + plotly::plotlyOutput('plotPCA') %>% + shinycssloaders::withSpinner(color="#56070C"), + fluidRow(style="display:flex; justify-content:right; margin-top:1rem;", + column(width = 2, + selectInput("formatPCA", label = NULL, + choices = c("html", "png", "pdf", "svg"), + selected = "html")), + column(width = 2, downloadButton("downloadPCA", + "Download"))) ) ) ) @@ -1445,7 +1470,7 @@ server <- function(input, output, session) { req(reactOriSmpMetadatTbl()) DT::datatable(reactOriSmpMetadatTbl(), rownames = F, filter = list(position = 'top', clear = T, plain = F), selection = list(mode = 'single', target = 'row'), style = 'bootstrap', - options = list(pageLength = 5)) + options = list(pageLength = 5, scrollX = TRUE)) # Reactive # req(datOverviewPack()$smpMetadatTbl) @@ -1461,6 +1486,7 @@ server <- function(input, output, session) { # DT::dataTableOutput('tblSmpMetadat') # }) + # Data completeness output$summDatComplete <- renderText({ req(datOverviewPack()$featCompleteLvTbl) @@ -1524,6 +1550,82 @@ server <- function(input, output, session) { plotly::ggplotly(g) }) + # === PCA === + # Update color by choices for PCA + output$updateColorByPCA <- renderUI({ + req(smpChoicePack()$smpChoiceList) + metaCols <- names(smpChoicePack()$smpChoiceList) + div( + style = "display: flex; align-items: center;", + tags$label("Color by:", style = "margin-right: 10px; margin-bottom: 15px;"), + selectInput('colorByPCA', NULL, choices = c('None', metaCols), selected = 'None', multiple = F) + ) + }) + # Create reactive object for PCA plot (for downloading) + reactPCAPlot <- reactiveVal(NULL) + # Show warning when both PC axes are the same + output$pcaDuplicateWarning <- renderUI({ + req(input$pcxPCA, input$pcyPCA) + pcx_val <- as.integer(gsub('PC', '', input$pcxPCA)) + pcy_val <- as.integer(gsub('PC', '', input$pcyPCA)) + if (pcx_val == pcy_val) { + tags$p(style = "color: red; font-weight: bold; margin-top: 0.5rem;", + "Please select two different principal components.") + } + }) + + # Separate PCA computation from visualization to avoid rerunning prcomp on PC change + reactPCAResult <- reactive({ + req(reactMetabObj$metabObj) + color_by <- if (!is.null(input$colorByPCA) && input$colorByPCA != 'None') input$colorByPCA else NULL + + metadata_info_vec <- NULL + if (!is.null(color_by)) { + # viz_pca's process_se() converts colData to data.frame (spaces β†’ dots); match that here + metadata_info_vec <- c(color = gsub(' ', '.', color_by)) + } + + # Remove zero-variance metabolites (all-NA rows become constant after MetaProViz's + # internal NAβ†’0 imputation and would cause prcomp to fail with scale.=TRUE) + se_pca <- reactMetabObj$metabObj + conc_mat <- SummarizedExperiment::assay(se_pca, 'conc_values') + row_vars <- apply(conc_mat, 1, function(x) var(x, na.rm = TRUE)) + se_pca <- se_pca[!is.na(row_vars) & row_vars > 0, ] + + list(se_pca = se_pca, metadata_info_vec = metadata_info_vec) + }) + + # Render PCA plot – only reruns viz_pca when PC selection changes + output$plotPCA <- plotly::renderPlotly({ + pca_data <- reactPCAResult() + pcx_val <- as.integer(gsub('PC', '', input$pcxPCA)) + pcy_val <- as.integer(gsub('PC', '', input$pcyPCA)) + + # Prevent rendering when both axes use the same PC + validate(need(pcx_val != pcy_val, "")) + + result <- MetaProViz::viz_pca( + data = pca_data$se_pca, + metadata_info = pca_data$metadata_info_vec, + save_plot = NULL, + print_plot = FALSE, + pcx = pcx_val, + pcy = pcy_val + ) + pca_plot <- result$Plot[["Plot"]] + reactPCAPlot(pca_plot) + p <- plotly::ggplotly(pca_plot) + # Clean legend: remove parenthesised trace names like "(Group, 1)" β†’ "Group" + for (i in seq_along(p$x$data)) { + nm <- p$x$data[[i]]$name + if (!is.null(nm)) { + p$x$data[[i]]$name <- gsub("^\\((.+),\\d+\\)$", "\\1", nm) + p$x$data[[i]]$legendgroup <- p$x$data[[i]]$name + } + } + p + }) + # Export abundance matrix output$downloadRawAbunExport <- downloadHandler( filename = paste("abundance_matrix_", format(Sys.Date(), "%Y-%m-%d"), ".csv", sep = ""), @@ -1777,6 +1879,23 @@ server <- function(input, output, session) { } ) + # PCA plot + output$downloadPCA <- downloadHandler( + filename = function() { + paste0("pca_plot_", Sys.Date(), '.', input$formatPCA) + }, + content = function(file) { + req(reactPCAPlot()) + if (input$formatPCA == "html") { + final_plot <- plotly::ggplotly(reactPCAPlot()) + htmlwidgets::saveWidget(final_plot, file, selfcontained = TRUE) + } else { + ggsave(filename = file, plot = reactPCAPlot(), device = input$formatPCA, + dpi = 400, units = "cm", width = 29.7, height = 21.0) + } + } + ) + # Download log2(FC) visuals # Vulcano plot output$downloadVulcanoPlot <- downloadHandler(