From e0ee126bdeace9cbb33552e71f5d143f4cca805a Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Mon, 25 Sep 2023 17:20:14 +0200
Subject: [PATCH 01/13] update
---
R/app_server.R | 4 +-
R/app_ui.R | 15 +-
R/mod_inputs_isot.R | 502 ++++++++++++++++++++++++++++++++++++++++++++
R/mod_plots_isot.R | 79 +++++++
4 files changed, 598 insertions(+), 2 deletions(-)
create mode 100644 R/mod_inputs_isot.R
create mode 100644 R/mod_plots_isot.R
diff --git a/R/app_server.R b/R/app_server.R
index 028bf5c..4d1fe1f 100644
--- a/R/app_server.R
+++ b/R/app_server.R
@@ -21,6 +21,8 @@ app_server <- function( input, output, session ) {
mod_inputs_server("inputs_1", session=session, r=r)
mod_acp_server("acp_1", session=session, r=r)
mod_boxplots_server("boxplots_1", session=session, r=r)
- # mod_idmschoice_server("idmschoice_ui_1", session=session, r=r)
+
+ mod_inputs_isot_server("inputs_2", session=session, r=r)
+ mod_plots_isot_server("plot-tab2")
}
diff --git a/R/app_ui.R b/R/app_ui.R
index 62450aa..5981194 100644
--- a/R/app_ui.R
+++ b/R/app_ui.R
@@ -38,13 +38,19 @@ app_ui <- function(request) {
menuSubItem('Input data', tabName = 'inputs-tab'),
menuSubItem('ACP', tabName = 'acp-tab'),
menuSubItem('Boxplots', tabName = 'boxplot-tab')
+ ),
+ menuItem("IsoPlot", tabName= 'isoplot-tab', icon=icon("diagnoses"),
+ startExpanded = TRUE,
+ menuSubItem('Input data', tabName = 'inputs-tab2'),
+ # menuSubItem('ACP', tabName = 'acp-tab2'),
+ menuSubItem('Plots', tabName = 'plot-tab2')
)
)
),
dashboardBody(
tags$head(includeCSS(system.file(file.path('app/www', 'style.css'), package='graphstatsr'))),
- tabItems(
+ tabItems(
tabItem(tabName = 'inputs-tab',
mod_inputs_ui("inputs_1")
),
@@ -53,7 +59,14 @@ app_ui <- function(request) {
),
tabItem(tabName = 'boxplot-tab',
mod_boxplots_ui("boxplots_1")
+ ),
+ tabItem(tabName = 'inputs-tab2',
+ mod_inputs_isot_ui("inputs_2")
+ ),
+ tabItem(tabName = 'plot-tab2',
+ mod_plots_isot_ui("plot-tab2")
)
+
)
)
diff --git a/R/mod_inputs_isot.R b/R/mod_inputs_isot.R
new file mode 100644
index 0000000..2ce77fe
--- /dev/null
+++ b/R/mod_inputs_isot.R
@@ -0,0 +1,502 @@
+#' inputs UI Function
+#'
+#' @description A shiny Module.
+#'
+#' @param id,input,output,session Internal parameters for {shiny}.
+#'
+#' @noRd
+#'
+#' @importFrom shiny NS tagList
+
+mod_inputs_isot_ui <- function(id){
+ ns <- NS(id)
+ tagList(
+ fluidPage(
+
+ box(title = "Input features dataset from isocor", status = "warning", solidHeader = TRUE, width=12,
+ fluidRow(
+ column(
+ width = 12,
+ actionButton(ns("launch_modal"), "Features table input module",
+ icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469"),
+ downloadButton(ns("dl_ds_test"), "Data test")
+ )
+ ),
+ tags$h3("Use filters to subset on features:"),
+
+ fluidRow(
+ column(
+ width = 3,
+ filter_data_ui(ns("filtering"), max_height = "500px")
+ ),
+ column(
+ width = 9,
+ progressBar(
+ id = ns("pbar"), value = 100,
+ total = 100, display_pct = TRUE
+ ),
+ DT::dataTableOutput(outputId = ns("table"))
+ )
+ )
+ ),
+ box(title = "Input metadata dataset", status = "warning", solidHeader = TRUE, width=12,
+ actionButton(ns("launch_modal2"), "Metadata input module", icon = icon("play-circle"),
+ style="color: #fff; background-color: #3b9ef5; border-color: #1a4469"),
+ downloadButton(ns("dl_mt_test"), "MetaData test"),
+ uiOutput(ns("DLTemp")),
+ # downloadButton(outputId = ns("metadatTemplate_download"), label = "Download metadata template"),
+ tags$h3("Use filters to subset on metadata, and click on rows you need to remove:"),
+ column(
+ width = 3,
+ filter_data_ui(ns("filtering2"), max_height = "500px")
+ ),
+ column(
+ width = 9,
+ progressBar(
+ id = ns("pbar2"), value = 100,
+ total = 100, display_pct = TRUE
+ ),
+ DT::dataTableOutput(outputId = ns("table2"))
+ ),
+ tags$b("Outlier(s) selected:"),
+ verbatimTextOutput(ns('x4'))
+ ),
+
+ box(title = "Normalization", status = "warning", solidHeader = TRUE, width = 3,
+ # verbatimTextOutput(ns('x4bis')),
+ selectInput(
+ ns("mergefact"),
+ label = "Sum features belonging the same group:",
+ choices = ""
+ ),
+
+ selectInput(
+ ns("norm1fact1"),
+ label = "Numeric factor/covariable to weight features values with:",
+ choices = ""
+ ),
+ radioButtons(
+ ns("norm_method"),
+ label = "Normalization : ",
+ inline = TRUE,
+ choices = list(
+ "Raw" = 0 ,
+ "TSS (total-sum normalization)" = 1,
+ "CLR (center log-ratio)" = 2
+ ), selected = 0
+ ),
+ actionButton(ns("mergebutton"), "Merge features and metadata...", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469")
+ ),
+
+
+ box(title = "Final dataset", status = "primary", solidHeader = TRUE, width = 9,
+ DT::dataTableOutput(outputId = ns("mergetable_DT")),
+ downloadButton(outputId = ns("mergedf_download"), label = "Download merged table")
+ ),
+
+ fluidRow(
+ box(width = 12,
+ title = 'Out plotly:', status = "warning", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
+ plotlyOutput(ns("histo_plotly"), height = "500")
+ )
+ )
+
+
+ )
+
+ )
+}
+
+#' inputs Server Functions
+#'
+#' @noRd
+mod_inputs_isot_server <- function(id, r = r, session = session){
+ moduleServer( id, function(input, output, session){
+
+ ns <- session$ns
+ r_values <- reactiveValues(merged = NULL, imported = NULL, imported2 = NULL,
+ subsetds_final = "emptytable", metadata_final = NULL,
+ features_final = NULL, subsetds_final_melt = "emptytable")
+ imported <- NULL
+
+
+ # Input dataset dev
+
+ observeEvent(input$launch_modal, {
+ print("inputMODAL1")
+ r_values$subsetds_final <- "emptytable" # for shinyalert acp / boxplot
+ r_values$subsetds_final_melt <- "emptytable"
+ r_values$merged <- NULL
+
+ import_modal(
+ id = ns("myid"),
+ from = c("file","copypaste", "googlesheets", "url"), #
+ title = "Import data to be used in application",
+ file_extensions = c(".csv", ".txt", ".tsv", ".xls", ".xlsx")
+ )
+ })
+
+ imported <- import_server("myid", return_class = "data.frame")
+
+ output$myid <- renderPrint({
+ req(input$myid)
+ input$myid
+ })
+
+
+ # Filters dev
+
+ data <- reactive({
+ r_values$imported <- imported$data()
+ if(is.null(imported$data())){
+ dat <- imported$data()
+ }else{
+ dat <- imported$data() %>% mutate_if(bit64::is.integer64,as.numeric)
+ }
+
+ dat
+ })
+
+ res_filter <- filter_data_server(
+ id = "filtering",
+ data = data ,
+ name = reactive("feature_table"),
+ vars = reactive(NULL),
+ widget_num = "slider",
+ widget_date = "slider",
+ label_na = "Missing"
+ )
+
+ observeEvent(res_filter$filtered(), {
+ updateProgressBar(
+ session = session, id = "pbar",
+ value = nrow(res_filter$filtered()), total = nrow(data())
+ )
+ })
+
+ output$dl_ds_test <- downloadHandler(
+ filename = glue::glue("datatest.csv"),
+ content = function(file){
+ print("DATATEST")
+
+ dstest <- read.csv(system.file("dataset", "features_quanti_data.csv", package="graphstatsr"), sep = ",")
+ write.csv(dstest, file, row.names=FALSE)
+ },
+ contentType = "application/tar"
+ )
+
+
+ output$dl_mt_test <- downloadHandler(
+ filename = glue::glue("metadata_test.csv"),
+ content = function(file){
+ print("METADATATEST")
+
+ mttest <- read.csv(system.file("dataset", "metadata_file.csv", package="graphstatsr"), sep = "\t")
+ write.csv(mttest, file, row.names=FALSE)
+ },
+ contentType = "application/tar"
+ )
+
+ output$table <- DT::renderDT({
+ print("renderDS")
+ res_filter$filtered()
+
+ }, options = list(pageLength = 6, scrollX = TRUE))
+
+
+ # output$code_dplyr <- renderPrint({
+ # res_filter$code()
+ # })
+ # output$code <- renderPrint({
+ # res_filter$expr()
+ # })
+
+ # output$res_str <- renderPrint({
+ # str(res_filter$filtered())
+ # })
+
+ output$metadatTemplate_download <- downloadHandler(
+ filename = "metadata_template.csv",
+ content = function(file) {
+ req(data())
+ A <- data() #r_values$imported
+
+ if(!is.null(A)){
+ print("there is a DATASET")
+ DF <- data.frame(row.names = names(A)[4:ncol(A)])
+ DF$sample.id <- names(A)[4:ncol(A)]
+ DF$factor_example <- glue::glue("group_{rep(LETTERS[1:3], each = 2, length.out=nrow(DF))}")
+ write.csv(DF, file , row.names=FALSE)
+ }else{
+ print("no dataset")
+ return(NULL)
+ }
+
+ }
+ )
+
+ output$DLTemp <- renderUI({
+ # req(input$launch_modal)
+ req(data())
+ downloadButton(outputId = ns("metadatTemplate_download"), label = "Download metadata template")
+ })
+
+
+ # Input metadata dev
+
+ observeEvent(input$launch_modal2, {
+ print("inputMODAL2")
+ r_values$merged <- NULL
+
+ import_modal(
+ id = ns("myid2"),
+ from = c("file", "copypaste", "googlesheets", "url"),
+ title = "Import data to be used in application",
+ file_extensions = c(".csv", ".txt", ".tsv", ".xls", ".xlsx")
+ )
+ })
+
+ imported2 <- import_server("myid2", return_class = "data.frame")
+
+
+ # Filters metadata dev
+
+
+ data2 <- reactive({
+ r_values$imported2 <- imported2$data()
+ imported2$data()
+ })
+
+ res_filter2 <- filter_data_server(
+ id = "filtering2",
+ data = data2,
+ name = reactive("metadata_table"),
+ vars = reactive(NULL),
+ widget_num = "slider",
+ widget_date = "slider",
+ label_na = "Missing"
+ )
+
+ observeEvent(res_filter2$filtered(), {
+ updateProgressBar(
+ session = session, id = "pbar2",
+ value = nrow(res_filter2$filtered()), total = nrow(data2())
+ )
+ })
+
+
+ # Function for table filters
+ rowCallback <- c(
+ "function(row, data){",
+ " for(var i=0; i<data.length; i++){",
+ " if(data[i] === null){",
+ " $('td:eq('+i+')', row).html('NA')",
+ " .css({'color': 'rgb(151,151,151)', 'font-style': 'italic'});",
+ " }",
+ " }",
+ "}"
+ )
+
+ output$table2 <- DT::renderDT({
+ # print(class(res_filter2$filtered()))
+ # print(str(res_filter2$filtered()))
+ res_filter2$filtered()
+ },
+ options = list(
+ pageLength = 6, scrollX = TRUE, server=TRUE, autoWidth = FALSE)#, , rowCallback = DT::JS(rowCallback)
+ # extensions = "Select", selection = "multiple"
+ )
+
+ output$x4bis <- output$x4 <- renderPrint({
+ s = input$table2_rows_selected
+ if (length(s)) {
+ cat('These rows were selected:\n')
+ cat(s, sep = ', ')
+ }else{
+ cat("None")
+ }
+ })
+
+ outliers <- reactive({
+ r_values$outliers <- input[["table2_rows_selected"]]
+ print("reactive outliers")
+ print(r_values$outliers)
+ r_values$outliers
+ })
+
+ observe({
+ print(input[["table2_rows_selected"]])
+ })
+
+ # output$outliers <- renderPrint({
+ # outliers()
+ # })
+
+ observe({
+ req(res_filter2$filtered()) #metadata
+ metadata1 <- res_filter2$filtered()
+ ds1 <- res_filter$filtered()
+ #Norm1
+ class1 <- sapply(metadata1, class)
+ r_values$norm1fact = names(metadata1)[class1 %in% "integer" | class1 %in% "numeric"]
+ r_values$mergefact = ds1 %>% select(where(is.character)) %>% names()
+
+ updateSelectInput(session, "mergefact",
+ choices = c("Raw", r_values$mergefact),
+ selected = c("Raw", r_values$mergefact)[1])
+
+
+ updateSelectInput(session, "norm1fact1",
+ choices = c("Raw", r_values$norm1fact),
+ selected = c("Raw", r_values$norm1fact)[1]) #names(r_values$metadata_final)[1]
+ })
+
+
+
+ r$mergetable2 <- mergetable <- eventReactive(input$mergebutton, {
+ print("merge")
+ if(is.null(r_values$imported) | is.null(r_values$imported2)){
+ showNotification("Please use modules for input files...", type="message", duration = 5)
+ }
+
+ metadata1 <- res_filter2$filtered()
+
+ if(length(unique(metadata1$sample)) != length(metadata1$sample)){
+ print("non unique sample id")
+ shinyalert(title = "Oops", text=glue::glue("Each sample ID needs to be unique."), type='error')
+ return(data.frame())
+ }
+
+ row.names(metadata1) <- metadata1[,"sample"]
+ feat1 <- res_filter$filtered()
+
+ print("Outliers:")
+ outliers1 <- input[["table2_rows_selected"]]
+ samplenames_out <- metadata1[input[["table2_rows_selected"]], "sample"]
+ print(outliers1)
+ # print(samplenames_out)
+
+ mt1 <- metadata1 %>% filter(!row_number() %in% outliers1)
+ names(mt1) <- gsub(" ","_",names(mt1))
+ # print(mt1$sample)
+ ds0 <- feat1 %>% select(-samplenames_out)
+
+ Calcul <- ds0 %>% mutate(Miso = as.factor(glue::glue("M{stringr::str_pad(ds0$isotopologue, 2, pad = '0')}"))) %>%
+ mutate(Area_Iso = corrected_area * isotopologue) %>% group_by(sample, metabolite) %>%
+ mutate(mean_area_persample = mean(corrected_area)) %>%
+ # ungroup() %>% group_by(metabolite) %>%
+ mutate(maxIso = max(isotopologue)) %>%
+ data.frame() #%>% head()
+
+ Fdataset <- Calcul %>%
+ dplyr::left_join(x = mt1, by = "sample")
+ r_values$subsetds_final <- Fdataset
+
+ # # melt final dataset for boxplot
+ # r_values$subsetds_final_melt <- reshape2::melt(Fdataset, id.vars = 1:ncol(mt1), measure.vars = (ncol(mt1)+1):ncol(Fdataset), variable.name = "features")
+
+
+ # #for PCA
+ # r_values$metadata_final <- droplevels(Fdataset[,1:ncol(mt1)])
+ # # print(prev(r_values$metadata_final))
+ # r_values$features_final <- Fdataset[,(ncol(mt1)+1):ncol(Fdataset)]
+ # # print(prev(r_values$features_final))
+
+ showNotification("Dataset ready !", type="message", duration = 5)
+ Fdataset
+
+ })
+
+
+ output$histo_plotly <- renderPlotly({
+ req(mergetable())
+ # req(input$go3)
+ tab_plot <- mergetable() %>% filter(metabolite == "AMP")
+
+ xform <- list()
+ p1 <- plotly::plot_ly(tab_plot, x = ~sample, y = ~corrected_area, type = 'bar',
+ name = ~Miso, color = ~Miso, height = 700) %>%
+ plotly::layout(title="Raw area", yaxis = list(title = 'Raw area'),
+ barmode = 'stack', xaxis = xform)
+
+ p1
+ })
+
+
+
+ output$mergetable_DT <- DT::renderDataTable({
+ # req(mergetable())
+ if(is.null(r_values$merged)){validate('\t\t\t\t\t\t\t\t\t\tValidate each step.')}
+ # print("rendermergeDT")
+
+ mergetable()
+ },
+ options = list(
+ pageLength = 6, scrollX = TRUE,server=TRUE, autoWidth = TRUE)#, #, rowCallback = DT::JS(rowCallback),
+ #extensions = "Select", selection = "multiple"
+ )
+
+ output$mergedf_download <- downloadHandler(
+ filename = "merged_table.csv",
+ content = function(file) {
+ req(r_values$subsetds_final)
+ write.csv(r_values$subsetds_final, file, sep=",", row.names=FALSE)
+ }
+ )
+
+
+ # observe({
+ # r_values$merged <- mergetable()
+ # })
+
+
+ # r$ds0 <- reactive({
+ # req(res_filter$filtered())
+ # res_filter$filtered()
+
+ # })
+
+ # r$fdata <- reactive({
+ # print("reactive r")
+ # req(r_values$subsetds_final)
+ # r_values$subsetds_final
+
+ # })
+
+
+ # r$mt1 <- reactive({
+ # req(r_values$metadata_final)
+ # r_values$metadata_final
+ # })
+
+ # r$ds1 <- reactive({
+ # req(r_values$features_final)
+ # r_values$features_final
+ # })
+
+ # r$fdata_melt <- reactive({
+ # req(r_values$subsetds_final_melt)
+ # r_values$subsetds_final_melt
+ # })
+
+ # r$wgt1 <- reactive({
+ # req(r_values$wgt1)
+ # r_values$wgt1
+ # })
+
+ # r$norm1 <- reactive({
+ # req(r_values$norm1)
+ # r_values$norm1
+ # })
+
+
+
+
+ })
+}
+
+## To be copied in the UI
+# mod_inputs_ui("inputs_1")
+
+## To be copied in the server
+# mod_inputs_server("inputs_1")
diff --git a/R/mod_plots_isot.R b/R/mod_plots_isot.R
new file mode 100644
index 0000000..9f5d128
--- /dev/null
+++ b/R/mod_plots_isot.R
@@ -0,0 +1,79 @@
+#' plots_isot UI Function
+#'
+#' @description A shiny Module.
+#'
+#' @param id,input,output,session Internal parameters for {shiny}.
+#'
+#' @noRd
+#'
+#' @importFrom shiny NS tagList
+mod_plots_isot_ui <- function(id){
+ ns <- NS(id)
+ tagList(
+ fluidRow(
+ box(title = "Plot Settings:", width = 7, status = "warning", solidHeader = TRUE,
+ selectInput(
+ ns("feat2"),
+ label = "Feature to plot in boxplot:",
+ choices = ""
+ )
+ )
+ ),
+
+
+ fluidRow(
+ box(width = 12,
+ title = 'Stacked histogram preview:', status = "warning", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
+ plotlyOutput(ns("histo_plotly"), height = "500")
+ )
+ )
+
+ )
+}
+
+#' plots_isot Server Functions
+#'
+#' @noRd
+mod_plots_isot_server <- function(id, r = r, session = session){
+ moduleServer( id, function(input, output, session){
+ ns <- session$ns
+ r_values <- reactiveValues()
+
+ # observe({
+ # # req(metadata1(), r_values$subsetds_final_melt)
+ # req(r$merged())
+ # dsF <- r_values$merged <- r$merged()
+ # # r_values$metadata_final <- r$mt1()
+
+
+ # updateSelectInput(session, "feat2",
+ # choices = unique(dsF$metabolite),
+ # selected = unique(dsF$metabolite)[1])
+ # })
+
+
+ output$histo_plotly <- renderPlotly({
+ req(r$mergetable2())
+ mtab <- r$mergetable2()
+ # req(input$go3)
+ tab_plot <- mtab %>% filter(metabolite == "AMP")
+
+ xform <- list()
+ p1 <- plotly::plot_ly(tab_plot, x = ~sample, y = ~corrected_area, type = 'bar',
+ name = ~Miso, color = ~Miso, height = 700) %>%
+ plotly::layout(title="Raw area", yaxis = list(title = 'Raw area'),
+ barmode = 'stack', xaxis = xform)
+
+ p1
+ })
+
+
+
+ })
+}
+
+## To be copied in the UI
+# mod_plots_isot_ui("plots_isot_1")
+
+## To be copied in the server
+# mod_plots_isot_server("plots_isot_1")
--
GitLab
From 0915d9acf76c59efafc6500d025fc64e1c8af106 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Tue, 26 Sep 2023 17:30:32 +0200
Subject: [PATCH 02/13] update
---
NAMESPACE | 1 +
R/app_server.R | 2 +-
R/mod_inputs_isot.R | 15 ++++--
R/mod_plots_isot.R | 109 ++++++++++++++++++++++++++++++++++++--------
4 files changed, 103 insertions(+), 24 deletions(-)
diff --git a/NAMESPACE b/NAMESPACE
index 42b7c9c..03c370e 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -12,6 +12,7 @@ import(shinyWidgets)
import(shinydashboard)
import(tibble)
import(tidyr)
+importFrom(RColorBrewer,brewer.pal)
importFrom(bit64,is.integer64)
importFrom(factoextra,fviz_pca_var)
importFrom(factoextra,get_pca_var)
diff --git a/R/app_server.R b/R/app_server.R
index 4d1fe1f..cc79df3 100644
--- a/R/app_server.R
+++ b/R/app_server.R
@@ -23,6 +23,6 @@ app_server <- function( input, output, session ) {
mod_boxplots_server("boxplots_1", session=session, r=r)
mod_inputs_isot_server("inputs_2", session=session, r=r)
- mod_plots_isot_server("plot-tab2")
+ mod_plots_isot_server("plot-tab2", session=session, r=r)
}
diff --git a/R/mod_inputs_isot.R b/R/mod_inputs_isot.R
index 2ce77fe..33a3232 100644
--- a/R/mod_inputs_isot.R
+++ b/R/mod_inputs_isot.R
@@ -353,7 +353,7 @@ mod_inputs_isot_server <- function(id, r = r, session = session){
- r$mergetable2 <- mergetable <- eventReactive(input$mergebutton, {
+ mergetable <- eventReactive(input$mergebutton, {
print("merge")
if(is.null(r_values$imported) | is.null(r_values$imported2)){
showNotification("Please use modules for input files...", type="message", duration = 5)
@@ -379,7 +379,8 @@ mod_inputs_isot_server <- function(id, r = r, session = session){
mt1 <- metadata1 %>% filter(!row_number() %in% outliers1)
names(mt1) <- gsub(" ","_",names(mt1))
# print(mt1$sample)
- ds0 <- feat1 %>% select(-samplenames_out)
+
+ ds0 <- feat1 %>% filter(!sample %in% samplenames_out) #select(-samplenames_out)
Calcul <- ds0 %>% mutate(Miso = as.factor(glue::glue("M{stringr::str_pad(ds0$isotopologue, 2, pad = '0')}"))) %>%
mutate(Area_Iso = corrected_area * isotopologue) %>% group_by(sample, metabolite) %>%
@@ -444,11 +445,15 @@ mod_inputs_isot_server <- function(id, r = r, session = session){
}
)
+ observe({
+ r_values$merged <- mergetable()
+ })
- # observe({
- # r_values$merged <- mergetable()
- # })
+ r$merged2 <- reactive({
+ req(mergetable())
+ mergetable()
+ })
# r$ds0 <- reactive({
# req(res_filter$filtered())
diff --git a/R/mod_plots_isot.R b/R/mod_plots_isot.R
index 9f5d128..cb5bf9b 100644
--- a/R/mod_plots_isot.R
+++ b/R/mod_plots_isot.R
@@ -7,6 +7,9 @@
#' @noRd
#'
#' @importFrom shiny NS tagList
+#' @importFrom RColorBrewer brewer.pal
+#'
+
mod_plots_isot_ui <- function(id){
ns <- NS(id)
tagList(
@@ -16,7 +19,10 @@ mod_plots_isot_ui <- function(id){
ns("feat2"),
label = "Feature to plot in boxplot:",
choices = ""
- )
+ ),
+ materialSwitch(ns("relativOUT"), label = "Absolute or relative plot", value = FALSE, status = "primary"),
+ downloadButton(outputId = ns("hist_download"), label = "Download PDF (long process)"),
+ downloadButton(outputId = ns("hist_downloadTAR"), label = "Download PNGs (long process)")
)
),
@@ -39,35 +45,102 @@ mod_plots_isot_server <- function(id, r = r, session = session){
ns <- session$ns
r_values <- reactiveValues()
- # observe({
- # # req(metadata1(), r_values$subsetds_final_melt)
- # req(r$merged())
- # dsF <- r_values$merged <- r$merged()
- # # r_values$metadata_final <- r$mt1()
-
+ observe({
+ req(r$merged2())
+ dsF <- r_values$merged <- r$merged2()
- # updateSelectInput(session, "feat2",
- # choices = unique(dsF$metabolite),
- # selected = unique(dsF$metabolite)[1])
- # })
+ updateSelectInput(session, "feat2",
+ choices = unique(dsF$metabolite),
+ selected = unique(dsF$metabolite)[1])
+ })
output$histo_plotly <- renderPlotly({
- req(r$mergetable2())
- mtab <- r$mergetable2()
+ req(r$merged2())
+ mtab <- r$merged2()
# req(input$go3)
- tab_plot <- mtab %>% filter(metabolite == "AMP")
+ tab_plot <- mtab %>% filter(metabolite == input$feat2)
+
+ mycolors <- colorRampPalette(RColorBrewer::brewer.pal(12, "Paired"))(20)
xform <- list()
- p1 <- plotly::plot_ly(tab_plot, x = ~sample, y = ~corrected_area, type = 'bar',
- name = ~Miso, color = ~Miso, height = 700) %>%
- plotly::layout(title="Raw area", yaxis = list(title = 'Raw area'),
- barmode = 'stack', xaxis = xform)
+ if(input$relativOUT){
+ p1 <- plotly::plot_ly(tab_plot, x = ~sample, y = ~isotopologue_fraction, type = 'bar',
+ name = ~Miso, color = ~Miso, height = 700, colors = rev(mycolors[1:length(levels(tab_plot$Miso))])) %>%
+ plotly::layout(title=glue::glue("Isotopologue Fraction {input$feat2}"), yaxis = list(title = 'Isotopologue fraction'),
+ barmode = 'stack', xaxis = xform)
+ }else{
+ p1 <- plotly::plot_ly(tab_plot, x = ~sample, y = ~corrected_area, type = 'bar',
+ name = ~Miso, color = ~Miso, height = 700, colors = rev(mycolors[1:length(levels(tab_plot$Miso))])) %>%
+ plotly::layout(title=glue::glue('Raw area {input$feat2}'), yaxis = list(title = 'Raw area'),
+ barmode = 'stack', xaxis = xform)
+ }
p1
})
+ pdfall_isoplot <- reactive({
+ cat(file=stderr(), 'All Barplots ...', "\n")
+ req(r$merged2())
+ mtab <- r$merged2()
+ LL <- list()
+ mycolors <- colorRampPalette(RColorBrewer::brewer.pal(12, "Paired"))(20)
+ save(list = ls(all.names = TRUE), file = "~/Bureau/debug.rdata", envir = environment()); print("SAVE0")
+ withProgress({
+
+ for(i in unique(mtab$metabolite)){
+ # incProgress(1/length(i))
+ tab_plot <- mtab %>% filter(metabolite == i)
+ tab_plot$Miso <- factor(tab_plot$Miso, rev(levels(tab_plot$Miso)))
+ LL[[i]] <- ggplot(tab_plot, aes(fill=Miso, y=corrected_area, x=sample)) +
+ geom_bar(position="stack", stat="identity") + scale_fill_manual(values = mycolors) +
+ theme_bw() + labs(fill='') +
+ theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1))
+ }
+
+ }, value = 0 ,message = glue::glue("Processing barplots ... please wait."))
+
+
+ LL
+
+ })
+
+
+
+ output$hist_download <- downloadHandler(
+ filename = glue::glue("isoplot_figures_{systim}.pdf"),
+ content = function(file) {
+ print('DOWNLOAD ALL')
+ print("isoplot")
+ req(pdfall_isoplot())
+ p <- pdfall_isoplot()
+ withProgress({
+ ml <- marrangeGrob(p, nrow=2, ncol=1)
+
+ # if(as.numeric(input$nbPicPage) == 4){
+ # ml <- marrangeGrob(p, nrow=2, ncol=2)
+ # }else if(as.numeric(input$nbPicPage) == 3){
+ # ml <- marrangeGrob(p, nrow= 1, ncol=as.numeric(input$nbPicPage))
+ # }else if(as.numeric(input$nbPicPage) == 2){
+ # if(input$verticaldisplay){
+ # ml <- marrangeGrob(p, nrow= as.numeric(input$nbPicPage), ncol= 1)
+ # }else{
+ # ml <- marrangeGrob(p, nrow= 1, ncol=as.numeric(input$nbPicPage))
+ # }
+ # }
+
+ # ggsave(file, ml, units = "cm", width = 20, height = 15, dpi = 100)
+ ggsave(file, ml , width = 11, height = 8, dpi = 100)
+ }, message = "Prepare pdf file... please wait.")
+ print('pdf output')
+
+
+
+ }
+ )
+
+
})
}
--
GitLab
From 3422595cbba9915cb12d3fd14e6b7354a4572290 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Tue, 10 Oct 2023 17:37:18 +0200
Subject: [PATCH 03/13] resolve matching color ggplot / plotly
---
R/mod_inputs_isot.R | 86 ++++++++++++++++++++++-----------------------
R/mod_plots_isot.R | 28 ++++++++-------
2 files changed, 58 insertions(+), 56 deletions(-)
diff --git a/R/mod_inputs_isot.R b/R/mod_inputs_isot.R
index 33a3232..f7d7f91 100644
--- a/R/mod_inputs_isot.R
+++ b/R/mod_inputs_isot.R
@@ -11,15 +11,15 @@
mod_inputs_isot_ui <- function(id){
ns <- NS(id)
tagList(
- fluidPage(
+ fluidRow(
box(title = "Input features dataset from isocor", status = "warning", solidHeader = TRUE, width=12,
fluidRow(
column(
width = 12,
actionButton(ns("launch_modal"), "Features table input module",
- icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469"),
- downloadButton(ns("dl_ds_test"), "Data test")
+ icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469")#,
+ # downloadButton(ns("dl_ds_test"), "Data test")
)
),
tags$h3("Use filters to subset on features:"),
@@ -42,8 +42,8 @@ mod_inputs_isot_ui <- function(id){
box(title = "Input metadata dataset", status = "warning", solidHeader = TRUE, width=12,
actionButton(ns("launch_modal2"), "Metadata input module", icon = icon("play-circle"),
style="color: #fff; background-color: #3b9ef5; border-color: #1a4469"),
- downloadButton(ns("dl_mt_test"), "MetaData test"),
- uiOutput(ns("DLTemp")),
+ # downloadButton(ns("dl_mt_test"), "MetaData test"),
+ # uiOutput(ns("DLTemp")),
# downloadButton(outputId = ns("metadatTemplate_download"), label = "Download metadata template"),
tags$h3("Use filters to subset on metadata, and click on rows you need to remove:"),
column(
@@ -62,48 +62,46 @@ mod_inputs_isot_ui <- function(id){
verbatimTextOutput(ns('x4'))
),
- box(title = "Normalization", status = "warning", solidHeader = TRUE, width = 3,
+ # box(title = "Merge dataset", status = "warning", solidHeader = TRUE, width = 3,
# verbatimTextOutput(ns('x4bis')),
- selectInput(
- ns("mergefact"),
- label = "Sum features belonging the same group:",
- choices = ""
- ),
-
- selectInput(
- ns("norm1fact1"),
- label = "Numeric factor/covariable to weight features values with:",
- choices = ""
- ),
- radioButtons(
- ns("norm_method"),
- label = "Normalization : ",
- inline = TRUE,
- choices = list(
- "Raw" = 0 ,
- "TSS (total-sum normalization)" = 1,
- "CLR (center log-ratio)" = 2
- ), selected = 0
- ),
- actionButton(ns("mergebutton"), "Merge features and metadata...", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469")
- ),
-
-
- box(title = "Final dataset", status = "primary", solidHeader = TRUE, width = 9,
+ # selectInput(
+ # ns("mergefact"),
+ # label = "Sum features belonging the same group:",
+ # choices = ""
+ # ),
+
+ # selectInput(
+ # ns("norm1fact1"),
+ # label = "Numeric factor/covariable to weight features values with:",
+ # choices = ""
+ # ),
+ # radioButtons(
+ # ns("norm_method"),
+ # label = "Normalization : ",
+ # inline = TRUE,
+ # choices = list(
+ # "Raw" = 0 ,
+ # "TSS (total-sum normalization)" = 1,
+ # "CLR (center log-ratio)" = 2
+ # ), selected = 0
+ # ),
+ # actionButton(ns("mergebutton"), "Merge features and metadata...", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469")
+ # ),
+
+
+ box(title = "Final dataset", status = "primary", solidHeader = TRUE, width = 12,
+ actionButton(ns("mergebutton"), "Merge features and metadata...", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469"),
DT::dataTableOutput(outputId = ns("mergetable_DT")),
downloadButton(outputId = ns("mergedf_download"), label = "Download merged table")
- ),
+ )#,
+ # fluidRow(
+ # box(width = 12,
+ # title = 'Out plotly:', status = "warning", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
+ # plotlyOutput(ns("histo_plotly"), height = "500")
+ # )
+ # )
- fluidRow(
- box(width = 12,
- title = 'Out plotly:', status = "warning", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
- plotlyOutput(ns("histo_plotly"), height = "500")
- )
- )
-
-
- )
-
+ )
)
}
@@ -197,6 +195,8 @@ mod_inputs_isot_server <- function(id, r = r, session = session){
contentType = "application/tar"
)
+
+
output$table <- DT::renderDT({
print("renderDS")
res_filter$filtered()
diff --git a/R/mod_plots_isot.R b/R/mod_plots_isot.R
index cb5bf9b..a42a5d3 100644
--- a/R/mod_plots_isot.R
+++ b/R/mod_plots_isot.R
@@ -13,7 +13,8 @@
mod_plots_isot_ui <- function(id){
ns <- NS(id)
tagList(
- fluidRow(
+ fluidRow(
+
box(title = "Plot Settings:", width = 7, status = "warning", solidHeader = TRUE,
selectInput(
ns("feat2"),
@@ -23,17 +24,15 @@ mod_plots_isot_ui <- function(id){
materialSwitch(ns("relativOUT"), label = "Absolute or relative plot", value = FALSE, status = "primary"),
downloadButton(outputId = ns("hist_download"), label = "Download PDF (long process)"),
downloadButton(outputId = ns("hist_downloadTAR"), label = "Download PNGs (long process)")
- )
- ),
+ ),
- fluidRow(
- box(width = 12,
+
+ box(width = 12, height = "600",
title = 'Stacked histogram preview:', status = "warning", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
- plotlyOutput(ns("histo_plotly"), height = "500")
+ plotlyOutput(ns("histo_plotly"))
+ )
)
- )
-
)
}
@@ -66,12 +65,12 @@ mod_plots_isot_server <- function(id, r = r, session = session){
xform <- list()
if(input$relativOUT){
p1 <- plotly::plot_ly(tab_plot, x = ~sample, y = ~isotopologue_fraction, type = 'bar',
- name = ~Miso, color = ~Miso, height = 700, colors = rev(mycolors[1:length(levels(tab_plot$Miso))])) %>%
+ name = ~Miso, color = ~Miso, height = 500, colors = mycolors[1:length(levels(tab_plot$Miso))]) %>%
plotly::layout(title=glue::glue("Isotopologue Fraction {input$feat2}"), yaxis = list(title = 'Isotopologue fraction'),
barmode = 'stack', xaxis = xform)
}else{
p1 <- plotly::plot_ly(tab_plot, x = ~sample, y = ~corrected_area, type = 'bar',
- name = ~Miso, color = ~Miso, height = 700, colors = rev(mycolors[1:length(levels(tab_plot$Miso))])) %>%
+ name = ~Miso, color = ~Miso, height = 500, colors = mycolors[1:length(levels(tab_plot$Miso))]) %>%
plotly::layout(title=glue::glue('Raw area {input$feat2}'), yaxis = list(title = 'Raw area'),
barmode = 'stack', xaxis = xform)
}
@@ -87,15 +86,18 @@ mod_plots_isot_server <- function(id, r = r, session = session){
LL <- list()
mycolors <- colorRampPalette(RColorBrewer::brewer.pal(12, "Paired"))(20)
save(list = ls(all.names = TRUE), file = "~/Bureau/debug.rdata", envir = environment()); print("SAVE0")
+ col1 = mycolors[1:length(levels(mtab$Miso))]
withProgress({
+ mtab$Miso <- factor(mtab$Miso, rev(levels(mtab$Miso)))
for(i in unique(mtab$metabolite)){
# incProgress(1/length(i))
+ print(i)
tab_plot <- mtab %>% filter(metabolite == i)
- tab_plot$Miso <- factor(tab_plot$Miso, rev(levels(tab_plot$Miso)))
+
LL[[i]] <- ggplot(tab_plot, aes(fill=Miso, y=corrected_area, x=sample)) +
- geom_bar(position="stack", stat="identity") + scale_fill_manual(values = mycolors) +
- theme_bw() + labs(fill='') +
+ geom_bar(position="stack", stat="identity") + scale_fill_manual(values = rev(col1[1:length(levels(droplevels(tab_plot$Miso)))])) +
+ theme_bw() + labs(fill='') + ggtitle(i) +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1))
}
--
GitLab
From 22849aac72887271c167ba3f0adf93b0d3074e53 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Thu, 12 Oct 2023 08:29:03 +0200
Subject: [PATCH 04/13] add image generation
---
R/mod_plots_isot.R | 55 +++++++++++++++++++++++++++++++++++++++++-----
1 file changed, 49 insertions(+), 6 deletions(-)
diff --git a/R/mod_plots_isot.R b/R/mod_plots_isot.R
index a42a5d3..237ae87 100644
--- a/R/mod_plots_isot.R
+++ b/R/mod_plots_isot.R
@@ -10,6 +10,9 @@
#' @importFrom RColorBrewer brewer.pal
#'
+tmpdir <- tempdir()
+systim <- as.numeric(Sys.time())
+
mod_plots_isot_ui <- function(id){
ns <- NS(id)
tagList(
@@ -67,7 +70,7 @@ mod_plots_isot_server <- function(id, r = r, session = session){
p1 <- plotly::plot_ly(tab_plot, x = ~sample, y = ~isotopologue_fraction, type = 'bar',
name = ~Miso, color = ~Miso, height = 500, colors = mycolors[1:length(levels(tab_plot$Miso))]) %>%
plotly::layout(title=glue::glue("Isotopologue Fraction {input$feat2}"), yaxis = list(title = 'Isotopologue fraction'),
- barmode = 'stack', xaxis = xform)
+ barmode = 'fill', xaxis = xform)
}else{
p1 <- plotly::plot_ly(tab_plot, x = ~sample, y = ~corrected_area, type = 'bar',
name = ~Miso, color = ~Miso, height = 500, colors = mycolors[1:length(levels(tab_plot$Miso))]) %>%
@@ -85,7 +88,7 @@ mod_plots_isot_server <- function(id, r = r, session = session){
mtab <- r$merged2()
LL <- list()
mycolors <- colorRampPalette(RColorBrewer::brewer.pal(12, "Paired"))(20)
- save(list = ls(all.names = TRUE), file = "~/Bureau/debug.rdata", envir = environment()); print("SAVE0")
+
col1 = mycolors[1:length(levels(mtab$Miso))]
withProgress({
@@ -95,10 +98,20 @@ mod_plots_isot_server <- function(id, r = r, session = session){
print(i)
tab_plot <- mtab %>% filter(metabolite == i)
- LL[[i]] <- ggplot(tab_plot, aes(fill=Miso, y=corrected_area, x=sample)) +
- geom_bar(position="stack", stat="identity") + scale_fill_manual(values = rev(col1[1:length(levels(droplevels(tab_plot$Miso)))])) +
- theme_bw() + labs(fill='') + ggtitle(i) +
- theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1))
+ if(input$relativOUT){
+ LL[[i]] <- ggplot(tab_plot, aes(fill=Miso, y=corrected_area, x=sample)) +
+ geom_bar(position="fill", stat="identity") + scale_fill_manual(values = rev(col1[1:length(levels(droplevels(tab_plot$Miso)))])) +
+ theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} CID")) +
+ theme(axis.text.x = element_text(size = 8, angle = 45, vjust = 1, hjust=1))
+ }else{
+ LL[[i]] <- ggplot(tab_plot, aes(fill=Miso, y=corrected_area, x=sample)) +
+ geom_bar(position="stack", stat="identity") + scale_fill_manual(values = rev(col1[1:length(levels(droplevels(tab_plot$Miso)))])) +
+ theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} Area")) +
+ theme(axis.text.x = element_text(size = 8, angle = 45, vjust = 1, hjust=1))
+ }
+
+
+
}
}, value = 0 ,message = glue::glue("Processing barplots ... please wait."))
@@ -142,6 +155,36 @@ mod_plots_isot_server <- function(id, r = r, session = session){
}
)
+ output$hist_downloadTAR <- downloadHandler(
+ filename <- glue::glue("{tmpdir}/figures_pngs.tar"),
+
+ content <- function(file) {
+ print("WRITE PLOTS")
+ print(glue::glue("{tmpdir}/figures_pngs/"))
+
+
+ req(pdfall_isoplot())
+ listP <- pdfall_isoplot()
+
+ FEAT = names(listP)
+ # save(list = ls(all.names = TRUE), file = "~/Bureau/debug.rdata", envir = environment()); print("SAVE0")
+
+ withProgress({
+ for(i in 1:length(FEAT)){
+ incProgress(1/length(FEAT))
+ ggsave(glue::glue("{tmpdir}/figures_{systim}/HistPlot_{FEAT[i]}.png"), listP[[FEAT[i]]], width = 30, height = 15, units = "cm")
+ }
+
+ }, value = 0, message = "Generating PNGs...")
+
+ tar(glue::glue("{tmpdir}/figures_pngs.tar"), files = glue::glue("{tmpdir}/figures_{systim}") )
+
+
+ file.copy(filename, file)
+ },
+ contentType = "application/tar"
+ )
+
})
--
GitLab
From 1c53b5cafd9c6d42429198ee67237fc6088da45c Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Thu, 12 Oct 2023 11:26:31 +0200
Subject: [PATCH 05/13] fix png output
---
R/mod_plots_isot.R | 7 ++++---
1 file changed, 4 insertions(+), 3 deletions(-)
diff --git a/R/mod_plots_isot.R b/R/mod_plots_isot.R
index 237ae87..0b3309e 100644
--- a/R/mod_plots_isot.R
+++ b/R/mod_plots_isot.R
@@ -67,10 +67,10 @@ mod_plots_isot_server <- function(id, r = r, session = session){
xform <- list()
if(input$relativOUT){
- p1 <- plotly::plot_ly(tab_plot, x = ~sample, y = ~isotopologue_fraction, type = 'bar',
+ p1 <- plotly::plot_ly(tab_plot, x = ~sample, y = ~corrected_area, type = 'bar',
name = ~Miso, color = ~Miso, height = 500, colors = mycolors[1:length(levels(tab_plot$Miso))]) %>%
plotly::layout(title=glue::glue("Isotopologue Fraction {input$feat2}"), yaxis = list(title = 'Isotopologue fraction'),
- barmode = 'fill', xaxis = xform)
+ barmode = 'stack', xaxis = xform, barnorm = "fraction")
}else{
p1 <- plotly::plot_ly(tab_plot, x = ~sample, y = ~corrected_area, type = 'bar',
name = ~Miso, color = ~Miso, height = 500, colors = mycolors[1:length(levels(tab_plot$Miso))]) %>%
@@ -160,7 +160,8 @@ mod_plots_isot_server <- function(id, r = r, session = session){
content <- function(file) {
print("WRITE PLOTS")
- print(glue::glue("{tmpdir}/figures_pngs/"))
+ print(glue::glue("{tmpdir}/figures_{systim}/"))
+ dir.create(glue::glue("{tmpdir}/figures_{systim}/"), recursive = TRUE)
req(pdfall_isoplot())
--
GitLab
From 293c20606000527148b9abd24b8126dc94aa95b1 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Fri, 26 Jan 2024 14:19:43 +0100
Subject: [PATCH 06/13] add plotly and ggplot outputs
---
R/mod_inputs_isot.R | 6 ++
R/mod_plots_isot.R | 210 +++++++++++++++++++++++++++++++++++++-------
2 files changed, 184 insertions(+), 32 deletions(-)
diff --git a/R/mod_inputs_isot.R b/R/mod_inputs_isot.R
index f7d7f91..05cc682 100644
--- a/R/mod_inputs_isot.R
+++ b/R/mod_inputs_isot.R
@@ -378,6 +378,7 @@ mod_inputs_isot_server <- function(id, r = r, session = session){
mt1 <- metadata1 %>% filter(!row_number() %in% outliers1)
names(mt1) <- gsub(" ","_",names(mt1))
+ r_values$mt1 <- mt1
# print(mt1$sample)
ds0 <- feat1 %>% filter(!sample %in% samplenames_out) #select(-samplenames_out)
@@ -455,6 +456,11 @@ mod_inputs_isot_server <- function(id, r = r, session = session){
mergetable()
})
+ r$mt1 <- reactive({
+ req(r_values$mt1)
+ r_values$mt1
+ })
+
# r$ds0 <- reactive({
# req(res_filter$filtered())
# res_filter$filtered()
diff --git a/R/mod_plots_isot.R b/R/mod_plots_isot.R
index 0b3309e..3a8df76 100644
--- a/R/mod_plots_isot.R
+++ b/R/mod_plots_isot.R
@@ -21,10 +21,16 @@ mod_plots_isot_ui <- function(id){
box(title = "Plot Settings:", width = 7, status = "warning", solidHeader = TRUE,
selectInput(
ns("feat2"),
- label = "Feature to plot in boxplot:",
+ label = "Feature to preview:",
choices = ""
),
- materialSwitch(ns("relativOUT"), label = "Absolute or relative plot", value = FALSE, status = "primary"),
+ selectInput(
+ ns("group1"),
+ label = "Variable used to calculate means:",
+ choices = ""
+ ),
+ materialSwitch(ns("relativOUT"), label = "Absolute or relative plot", value = TRUE, status = "primary"),
+ materialSwitch(ns("dodge1"), label = "Dodge histogram", value = FALSE, status = "primary"),
downloadButton(outputId = ns("hist_download"), label = "Download PDF (long process)"),
downloadButton(outputId = ns("hist_downloadTAR"), label = "Download PNGs (long process)")
),
@@ -32,7 +38,7 @@ mod_plots_isot_ui <- function(id){
box(width = 12, height = "600",
- title = 'Stacked histogram preview:', status = "warning", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
+ title = 'Figure preview:', status = "warning", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
plotlyOutput(ns("histo_plotly"))
)
)
@@ -50,34 +56,102 @@ mod_plots_isot_server <- function(id, r = r, session = session){
observe({
req(r$merged2())
dsF <- r_values$merged <- r$merged2()
+ mtF <- r_values$mt1 <- r$mt1()
updateSelectInput(session, "feat2",
choices = unique(dsF$metabolite),
selected = unique(dsF$metabolite)[1])
+
+ updateSelectInput(session, "group1",
+ choices = colnames(mtF),
+ selected = colnames(mtF)[1])
})
output$histo_plotly <- renderPlotly({
req(r$merged2())
mtab <- r$merged2()
- # req(input$go3)
- tab_plot <- mtab %>% filter(metabolite == input$feat2)
-
mycolors <- colorRampPalette(RColorBrewer::brewer.pal(12, "Paired"))(20)
-
xform <- list()
- if(input$relativOUT){
- p1 <- plotly::plot_ly(tab_plot, x = ~sample, y = ~corrected_area, type = 'bar',
- name = ~Miso, color = ~Miso, height = 500, colors = mycolors[1:length(levels(tab_plot$Miso))]) %>%
- plotly::layout(title=glue::glue("Isotopologue Fraction {input$feat2}"), yaxis = list(title = 'Isotopologue fraction'),
- barmode = 'stack', xaxis = xform, barnorm = "fraction")
- }else{
- p1 <- plotly::plot_ly(tab_plot, x = ~sample, y = ~corrected_area, type = 'bar',
- name = ~Miso, color = ~Miso, height = 500, colors = mycolors[1:length(levels(tab_plot$Miso))]) %>%
- plotly::layout(title=glue::glue('Raw area {input$feat2}'), yaxis = list(title = 'Raw area'),
- barmode = 'stack', xaxis = xform)
+
+ if(input$group1 != "sample"){
+ print("GROUPING")
+ cols2group <- c("metabolite", "Miso", input$group1)
+ tab_plot4 <- mtab %>% group_by(across(all_of(cols2group))) %>%
+ summarise(meanGroup = mean(isotopologue_fraction), sdGroup = sd(isotopologue_fraction),
+ meanGroupAbs = mean(corrected_area), sdGroupAbs = sd(corrected_area), .groups = "keep") %>%
+ arrange(as.character(Miso)) %>%
+ arrange(across(c("metabolite",input$group1))) %>%
+ group_by(across(c("metabolite",input$group1))) %>%
+ mutate(SDPos = cumsum(meanGroup), SDPosAbs = cumsum(meanGroupAbs)) %>%
+ as.data.frame()
+
+ tab_plot4[which(tab_plot4$sdGroup == 0), "sdGroup"] <- NA
+
+ tab_plot5 <- r_values$tab_plot4 <- tab_plot4
+ tab_plot5$Miso = factor(tab_plot5$Miso, levels = sort(levels(tab_plot5$Miso)) )
+
+
+ r_values$tab_plot5 <- tab_plot5
+
+ # save(list = ls(all.names = TRUE), file = "debug_plotly.rdata", envir = environment()); print("SAVE0")
+
+ if(input$dodge1){
+ tab_plot <- tab_plot5 %>% filter(metabolite == input$feat2)
+
+ if(input$relativOUT){
+ p1 <- plotly::plot_ly(tab_plot, x = as.formula(glue::glue("~{input$group1}")), y = ~meanGroup, type = 'bar',
+ name = ~Miso, color = ~Miso, height = 500, colors = mycolors[1:length(levels(tab_plot$Miso))]) %>%
+ plotly::layout(title=glue::glue("Isotopologue Fraction {input$feat2}"), yaxis = list(title = 'Isotopologue fraction'),
+ barmode = "group", xaxis = xform, barnorm = "fraction")
+ }else{
+ p1 <- plotly::plot_ly(tab_plot, x = as.formula(glue::glue("~{input$group1}")), y = ~meanGroupAbs, type = 'bar',
+ name = ~Miso, color = ~Miso, height = 500, colors = mycolors[1:length(levels(tab_plot$Miso))]) %>%
+ plotly::layout(title=glue::glue("Corrected Area {input$feat2}"), yaxis = list(title = 'Isotopologue fraction'),
+ barmode = "group", xaxis = xform, barnorm = "")
+ }
+
+ }else{
+ tab_plot <- tab_plot4 %>% filter(metabolite == input$feat2)
+ if(input$relativOUT){
+ p1 <- plotly::plot_ly(tab_plot, x = as.formula(glue::glue("~{input$group1}")), y = ~meanGroup, type = 'bar',
+ name = ~Miso, color = ~Miso, height = 500, colors = mycolors[1:length(levels(tab_plot$Miso))]) %>%
+ plotly::layout(title=glue::glue("Isotopologue Fraction {input$feat2}"), yaxis = list(title = 'Isotopologue fraction'),
+ barmode = "stack", xaxis = xform, barnorm = "fraction")
+ }else{
+ p1 <- plotly::plot_ly(tab_plot, x = as.formula(glue::glue("~{input$group1}")), y = ~meanGroupAbs, type = 'bar',
+ name = ~Miso, color = ~Miso, height = 500, colors = mycolors[1:length(levels(tab_plot$Miso))]) %>%
+ plotly::layout(title=glue::glue('Raw area {input$feat2}'), yaxis = list(title = 'Raw area'),
+ barmode = "stack", xaxis = xform, barnorm = "")
+ }
+
+ }
+
+ }else{
+ tab_plot <- mtab %>% filter(metabolite == input$feat2)
+
+ if(input$dodge1){
+ BARMOD <- "group"
+ }else{BARMOD <- "stack"}
+
+ xform <- list()
+ if(input$relativOUT){
+ p1 <- plotly::plot_ly(tab_plot, x = ~sample, y = ~corrected_area, type = 'bar',
+ name = ~Miso, color = ~Miso, height = 500, colors = mycolors[1:length(levels(tab_plot$Miso))]) %>%
+ plotly::layout(title=glue::glue("Isotopologue Fraction {input$feat2}"), yaxis = list(title = 'Isotopologue fraction'),
+ barmode = BARMOD, xaxis = xform, barnorm = "fraction")
+ }else{
+ p1 <- plotly::plot_ly(tab_plot, x = ~sample, y = ~corrected_area, type = 'bar',
+ name = ~Miso, color = ~Miso, height = 500, colors = mycolors[1:length(levels(tab_plot$Miso))]) %>%
+ plotly::layout(title=glue::glue('Raw area {input$feat2}'), yaxis = list(title = 'Raw area'),
+ barmode = BARMOD, xaxis = xform)
+ }
}
+
+
+
+
p1
})
@@ -93,30 +167,102 @@ mod_plots_isot_server <- function(id, r = r, session = session){
withProgress({
mtab$Miso <- factor(mtab$Miso, rev(levels(mtab$Miso)))
- for(i in unique(mtab$metabolite)){
- # incProgress(1/length(i))
- print(i)
- tab_plot <- mtab %>% filter(metabolite == i)
+
+
+ if(input$group1 == "sample"){
+ for(i in unique(mtab$metabolite)){
+ # incProgress(1/length(i))
+ print(i)
+ tab_plot <- mtab %>% filter(metabolite == i)
+ if(input$relativOUT){
+ LL[[i]] <- ggplot(tab_plot, aes(fill=Miso, y=corrected_area, x=sample)) +
+ geom_bar(position="fill", stat="identity") + scale_fill_manual(values = rev(col1[1:length(levels(droplevels(tab_plot$Miso)))])) +
+ theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} CID")) +
+ theme(axis.text.x = element_text(size = 8, angle = 45, vjust = 1, hjust=1))
+ }else{
+ LL[[i]] <- ggplot(tab_plot, aes(fill=Miso, y=corrected_area, x=sample)) +
+ geom_bar(position="stack", stat="identity") + scale_fill_manual(values = rev(col1[1:length(levels(droplevels(tab_plot$Miso)))])) +
+ theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} Area")) +
+ xlab("") + ylab("mean CID") +
+ theme(axis.text.x = element_text(size = 8, angle = 45, vjust = 1, hjust=1))
+ }
+ }
+
+ }else{
+ print("GROUP BY")
+
+ # cols2group <- c("metabolite", "Miso", input$group1)
+ # tab_plot4 <- mtab %>% group_by(across(all_of(cols2group))) %>%
+ # summarise(meanGroup = mean(isotopologue_fraction), sdGroup = sd(isotopologue_fraction), .groups = "keep") %>%
+ # arrange(as.character(Miso)) %>%
+ # arrange(across(c("metabolite",input$group1))) %>%
+ # group_by(across(c("metabolite",input$group1))) %>%
+ # mutate(SDPos = cumsum(meanGroup)) %>%
+ # as.data.frame()
+
+ # tab_plot4[which(tab_plot4$sdGroup == 0), "sdGroup"] <- NA
- if(input$relativOUT){
- LL[[i]] <- ggplot(tab_plot, aes(fill=Miso, y=corrected_area, x=sample)) +
- geom_bar(position="fill", stat="identity") + scale_fill_manual(values = rev(col1[1:length(levels(droplevels(tab_plot$Miso)))])) +
- theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} CID")) +
- theme(axis.text.x = element_text(size = 8, angle = 45, vjust = 1, hjust=1))
+ # tab_plot5 <- tab_plot4
+ # tab_plot5$Miso = factor(tab_plot5$Miso, levels = sort(levels(tab_plot5$Miso)) )
+
+
+
+ if(input$dodge1){
+ tab_plot5 <- r_values$tab_plot5
+ for(i in unique(mtab$metabolite)[1:3]){
+
+ if(input$relativOUT){
+ LL[[i]] <- ggplot(tab_plot5 %>% filter(metabolite == i), aes(fill=Miso, y=meanGroup, x=get(input$group1))) +
+ geom_bar(position="dodge", stat="identity") + scale_fill_manual(values = col1) +
+ theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} mean CID by '{input$group1}' factor")) + xlab("") + ylab("Isotopologue fraction") +
+ theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1)) +
+ geom_errorbar(aes(ymin = meanGroup-sdGroup, ymax = meanGroup+sdGroup), width = 0.3, position = position_dodge(0.9))
+
+ }else{
+ LL[[i]] <- ggplot(tab_plot5 %>% filter(metabolite == i), aes(fill=Miso, y=meanGroupAbs, x=get(input$group1))) +
+ geom_bar(position="dodge", stat="identity") + scale_fill_manual(values = col1) +
+ theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} mean CID by '{input$group1}' factor")) + xlab("") + ylab("Isotopologue fraction") +
+ theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1)) +
+ geom_errorbar(aes(ymin = meanGroupAbs-sdGroupAbs, ymax = meanGroupAbs+sdGroupAbs), width = 0.3, position = position_dodge(0.9))
+
+ }
+ }
+
}else{
- LL[[i]] <- ggplot(tab_plot, aes(fill=Miso, y=corrected_area, x=sample)) +
- geom_bar(position="stack", stat="identity") + scale_fill_manual(values = rev(col1[1:length(levels(droplevels(tab_plot$Miso)))])) +
- theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} Area")) +
- theme(axis.text.x = element_text(size = 8, angle = 45, vjust = 1, hjust=1))
- }
+ tab_plot4 <- r_values$tab_plot4
+ tab_plot4$Miso = factor(tab_plot4$Miso, levels = rev(levels(tab_plot4$Miso)) )
+
+ col2 <- rev(col1)
+ names(col2) <- levels(tab_plot4$Miso)
+ for(i in unique(mtab$metabolite)[1:3]){
+ print(i)
+ if(input$relativOUT){
+ LL[[i]] <- ggplot(tab_plot4 %>% filter(metabolite == i), aes(fill=Miso, y=meanGroup, x=get(input$group1))) +
+ geom_bar(position="stack", stat="identity") + scale_fill_manual(values = col2) +
+ theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} mean CID by '{input$group1}' factor")) +
+ theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1)) +
+ geom_linerange(aes(ymin = SDPos-sdGroup, ymax = SDPos+sdGroup), width = 0.1, position = position_jitter(0.1))
+
+ }else{
+ LL[[i]] <- ggplot(tab_plot4 %>% filter(metabolite == i), aes(fill=Miso, y=meanGroupAbs, x=get(input$group1))) +
+ geom_bar(position="stack", stat="identity") + scale_fill_manual(values = col2) +
+ theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} mean CID by '{input$group1}' factor")) +
+ theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1)) +
+ geom_linerange(aes(ymin = SDPosAbs-sdGroupAbs, ymax = SDPosAbs+sdGroupAbs), width = 0.1, position = position_jitter(0.1))
+
+ }
+
+ }
+
+ }
}
}, value = 0 ,message = glue::glue("Processing barplots ... please wait."))
-
+ # save(list = ls(all.names = TRUE), file = "debug.rdata", envir = environment()); print("SAVE0")
LL
})
--
GitLab
From 1cdf2619f38fed087bd7144e41d8a026795ab534 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Fri, 26 Jan 2024 14:39:05 +0100
Subject: [PATCH 07/13] misc
---
R/mod_plots_isot.R | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/R/mod_plots_isot.R b/R/mod_plots_isot.R
index 3a8df76..1ba3d5d 100644
--- a/R/mod_plots_isot.R
+++ b/R/mod_plots_isot.R
@@ -209,7 +209,7 @@ mod_plots_isot_server <- function(id, r = r, session = session){
if(input$dodge1){
tab_plot5 <- r_values$tab_plot5
- for(i in unique(mtab$metabolite)[1:3]){
+ for(i in unique(mtab$metabolite)){
if(input$relativOUT){
LL[[i]] <- ggplot(tab_plot5 %>% filter(metabolite == i), aes(fill=Miso, y=meanGroup, x=get(input$group1))) +
@@ -235,7 +235,7 @@ mod_plots_isot_server <- function(id, r = r, session = session){
col2 <- rev(col1)
names(col2) <- levels(tab_plot4$Miso)
- for(i in unique(mtab$metabolite)[1:3]){
+ for(i in unique(mtab$metabolite)){
print(i)
if(input$relativOUT){
LL[[i]] <- ggplot(tab_plot4 %>% filter(metabolite == i), aes(fill=Miso, y=meanGroup, x=get(input$group1))) +
--
GitLab
From 85e67787d675e850136228d08eaee8a1abca4630 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Fri, 26 Jan 2024 15:33:36 +0100
Subject: [PATCH 08/13] axis names
---
R/mod_plots_isot.R | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/R/mod_plots_isot.R b/R/mod_plots_isot.R
index 1ba3d5d..489c840 100644
--- a/R/mod_plots_isot.R
+++ b/R/mod_plots_isot.R
@@ -214,14 +214,14 @@ mod_plots_isot_server <- function(id, r = r, session = session){
if(input$relativOUT){
LL[[i]] <- ggplot(tab_plot5 %>% filter(metabolite == i), aes(fill=Miso, y=meanGroup, x=get(input$group1))) +
geom_bar(position="dodge", stat="identity") + scale_fill_manual(values = col1) +
- theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} mean CID by '{input$group1}' factor")) + xlab("") + ylab("Isotopologue fraction") +
+ theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} mean CID by '{input$group1}' factor")) + xlab("") + ylab("Mean Isotopologue fraction") +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1)) +
geom_errorbar(aes(ymin = meanGroup-sdGroup, ymax = meanGroup+sdGroup), width = 0.3, position = position_dodge(0.9))
}else{
LL[[i]] <- ggplot(tab_plot5 %>% filter(metabolite == i), aes(fill=Miso, y=meanGroupAbs, x=get(input$group1))) +
geom_bar(position="dodge", stat="identity") + scale_fill_manual(values = col1) +
- theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} mean CID by '{input$group1}' factor")) + xlab("") + ylab("Isotopologue fraction") +
+ theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} mean CID by '{input$group1}' factor")) + xlab("") + ylab("Mean corrected area") +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1)) +
geom_errorbar(aes(ymin = meanGroupAbs-sdGroupAbs, ymax = meanGroupAbs+sdGroupAbs), width = 0.3, position = position_dodge(0.9))
@@ -241,6 +241,7 @@ mod_plots_isot_server <- function(id, r = r, session = session){
LL[[i]] <- ggplot(tab_plot4 %>% filter(metabolite == i), aes(fill=Miso, y=meanGroup, x=get(input$group1))) +
geom_bar(position="stack", stat="identity") + scale_fill_manual(values = col2) +
theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} mean CID by '{input$group1}' factor")) +
+ xlab("") + ylab("Mean Isotopologue fraction") +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1)) +
geom_linerange(aes(ymin = SDPos-sdGroup, ymax = SDPos+sdGroup), width = 0.1, position = position_jitter(0.1))
@@ -248,6 +249,7 @@ mod_plots_isot_server <- function(id, r = r, session = session){
LL[[i]] <- ggplot(tab_plot4 %>% filter(metabolite == i), aes(fill=Miso, y=meanGroupAbs, x=get(input$group1))) +
geom_bar(position="stack", stat="identity") + scale_fill_manual(values = col2) +
theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} mean CID by '{input$group1}' factor")) +
+ xlab("") + ylab("Mean corrected area") +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1)) +
geom_linerange(aes(ymin = SDPosAbs-sdGroupAbs, ymax = SDPosAbs+sdGroupAbs), width = 0.1, position = position_jitter(0.1))
--
GitLab
From 8d7ffe6efca72dd2b12632d37883027195a7e5c7 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Fri, 26 Jan 2024 15:43:57 +0100
Subject: [PATCH 09/13] debug ACP
---
R/mod_inputs_isot.R | 2 +-
R/mod_plots_isot.R | 2 +-
2 files changed, 2 insertions(+), 2 deletions(-)
diff --git a/R/mod_inputs_isot.R b/R/mod_inputs_isot.R
index 05cc682..7850506 100644
--- a/R/mod_inputs_isot.R
+++ b/R/mod_inputs_isot.R
@@ -456,7 +456,7 @@ mod_inputs_isot_server <- function(id, r = r, session = session){
mergetable()
})
- r$mt1 <- reactive({
+ r$mt1_isoT <- reactive({
req(r_values$mt1)
r_values$mt1
})
diff --git a/R/mod_plots_isot.R b/R/mod_plots_isot.R
index 489c840..26bf48d 100644
--- a/R/mod_plots_isot.R
+++ b/R/mod_plots_isot.R
@@ -56,7 +56,7 @@ mod_plots_isot_server <- function(id, r = r, session = session){
observe({
req(r$merged2())
dsF <- r_values$merged <- r$merged2()
- mtF <- r_values$mt1 <- r$mt1()
+ mtF <- r_values$mt1 <- r$mt1_isoT()
updateSelectInput(session, "feat2",
choices = unique(dsF$metabolite),
--
GitLab
From c938de9740115d5cdecc5317f6f33fc534125170 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Wed, 31 Jan 2024 15:14:44 +0100
Subject: [PATCH 10/13] update description
---
DESCRIPTION | 4 +++-
1 file changed, 3 insertions(+), 1 deletion(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index fee0c6e..234e9b4 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -24,6 +24,7 @@ Imports:
htmltools,
plotly,
PMCMRplus,
+ RColorBrewer,
reshape2,
rhdf5,
shiny (>= 1.6.0),
@@ -35,7 +36,8 @@ Imports:
stats,
stringr,
tibble,
- tidyr
+ tidyr,
+ waiter
Suggests:
spelling,
testthat
--
GitLab
From 940148c2a8cff545efa33d47a76aecaec8095ba7 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Fri, 15 Mar 2024 15:58:54 +0100
Subject: [PATCH 11/13] misc
---
R/mod_boxplots.R | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/R/mod_boxplots.R b/R/mod_boxplots.R
index a9454bf..439bd90 100644
--- a/R/mod_boxplots.R
+++ b/R/mod_boxplots.R
@@ -94,7 +94,8 @@ mod_boxplots_ui <- function(id){
actionButton(ns("go4"), "Update plot only", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469"),
uiOutput(ns("DLbuttons"))
),
- box(title = "Reorder boxplots:", width = 5, status = "warning", solidHeader = TRUE, collapsible = TRUE,
+ box(title = "Reorder boxplots:", width = 5, status = "warning", solidHeader = TRUE, collapsible = FALSE,
+ style='height:400px;overflow-y: scroll;',
uiOutput(ns("sortable"))#,
# verbatimTextOutput(ns("results_sort"))
)
@@ -112,7 +113,7 @@ mod_boxplots_ui <- function(id){
),
fluidRow(
box(width = 12,
- title = 'Boxplot with stats:', status = "warning", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
+ title = 'Boxplot with stats:', status = "warning", solidHeader = TRUE, collapsible = TRUE, collapsed = TRUE,
plotOutput(ns("ggplotstatsOUT1"), height = "500")
)
),
--
GitLab
From 79057202d3f6cf8514f780e82f77b57bbe27687c Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa@inra.fr>
Date: Mon, 18 Mar 2024 10:38:53 +0100
Subject: [PATCH 12/13] Dev iso t2
---
DESCRIPTION | 2 +-
R/app_ui.R | 2 +-
R/mod_plots_isot.R | 468 +++++++++++++++++++++++++++++++++++++++++----
3 files changed, 428 insertions(+), 44 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index 851e932..ae5ea6d 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
Package: graphstatsr
Title: graphstatsr
-Version: 1.10.0
+Version: 2.0.0
Authors@R:
person("Etienne", "Rifa", , "etienne.rifa@insa-toulouse.fr", role = c("cre", "aut"))
Description: A shiny app to easily generate advanced graphics and some non
diff --git a/R/app_ui.R b/R/app_ui.R
index 2a348ba..81e2599 100644
--- a/R/app_ui.R
+++ b/R/app_ui.R
@@ -19,7 +19,7 @@ app_ui <- function(request) {
# )
dashboardPage(skin = "red",
dashboardHeader(
- title = "GraphStatsR 1.10.0",
+ title = "GraphStatsR 2.0.0",
tags$li(class="dropdown",tags$a("Hosted by", img(src = SK8img,
title = "SK8", height = "20px"), headerText = "Source code",href="https://sk8.inrae.fr/", target="_blank")),
diff --git a/R/mod_plots_isot.R b/R/mod_plots_isot.R
index 26bf48d..26dcb11 100644
--- a/R/mod_plots_isot.R
+++ b/R/mod_plots_isot.R
@@ -18,7 +18,7 @@ mod_plots_isot_ui <- function(id){
tagList(
fluidRow(
- box(title = "Plot Settings:", width = 7, status = "warning", solidHeader = TRUE,
+ box(title = "Plot Settings:", width = 5, status = "warning", solidHeader = TRUE,
selectInput(
ns("feat2"),
label = "Feature to preview:",
@@ -28,19 +28,41 @@ mod_plots_isot_ui <- function(id){
ns("group1"),
label = "Variable used to calculate means:",
choices = ""
- ),
- materialSwitch(ns("relativOUT"), label = "Absolute or relative plot", value = TRUE, status = "primary"),
- materialSwitch(ns("dodge1"), label = "Dodge histogram", value = FALSE, status = "primary"),
- downloadButton(outputId = ns("hist_download"), label = "Download PDF (long process)"),
- downloadButton(outputId = ns("hist_downloadTAR"), label = "Download PNGs (long process)")
+ )
),
-
-
-
- box(width = 12, height = "600",
- title = 'Figure preview:', status = "warning", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
- plotlyOutput(ns("histo_plotly"))
+ box(title = "Reorder boxplots:", width = 5, status = "warning", solidHeader = TRUE, collapsible = FALSE,
+ style='height:400px;overflow-y: scroll;',
+ uiOutput(ns("sortable1"))#,
+ # verbatimTextOutput(ns("results_sort"))
)
+ ),
+ fluidRow(
+ box(width = 12, height = "700",
+ title = 'CID barplot preview:', status = "warning", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
+ materialSwitch(ns("relativOUT"), label = "Absolute or relative plot", value = TRUE, status = "primary"),
+ materialSwitch(ns("dodge1"), label = "Dodge histogram", value = FALSE, status = "primary"),
+ downloadButton(outputId = ns("hist_download"), label = "Download PDF (long process)"),
+ downloadButton(outputId = ns("hist_downloadTAR"), label = "Download PNGs (long process)"),
+ plotlyOutput(ns("histo_plotly"))
+ ),
+
+ box(width = 12,
+ title = 'EnrC13 / TotalArea preview:', status = "warning", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
+ downloadButton(outputId = ns("bars_download"), label = "Download PDF (long process)"),
+ plotOutput(ns("histo_Aire_enrC13"), height = "800px")
+ ),
+
+ box(width = 12,
+ title = 'EnrC13 / TotalArea preview per specific group or sample :', status = "warning", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
+ selectInput(
+ ns("level1"),
+ label = "Select group for preview:",
+ choices = ""
+ ),
+ downloadButton(outputId = ns("bars_spec_download"), label = "Download PDF (long process)"),
+ plotOutput(ns("histo_Aire_enrC13_allFeat_1group"), height = "800px")
+ )
+
)
)
}
@@ -54,6 +76,7 @@ mod_plots_isot_server <- function(id, r = r, session = session){
r_values <- reactiveValues()
observe({
+
req(r$merged2())
dsF <- r_values$merged <- r$merged2()
mtF <- r_values$mt1 <- r$mt1_isoT()
@@ -66,6 +89,46 @@ mod_plots_isot_server <- function(id, r = r, session = session){
choices = colnames(mtF),
selected = colnames(mtF)[1])
})
+
+ observe({
+ tt <- r$MeanSD_Area_EnrC13_per_compound
+ updateSelectInput(session, "level1",
+ choices = unique(tt[,input$group1]))
+ })
+
+
+ output$sortable1 <- renderUI({
+ tabF_melt2 <- tabF_melt <- r$merged2()
+
+ # if(length(input$group1) == 1){
+ r_values$group1ok <- group1ok <- input$group1
+ fun = glue::glue('tabF_melt2 <- tabF_melt %>% dplyr::mutate(newfact = {input$group1}, .after= "sample")')
+ eval(parse(text=fun))
+
+ # }else{ # concat factors
+ # comb = glue::glue_collapse(input$group1, sep = ', \"_\",')
+ # fun = glue::glue('tabF_melt2 <- tabF_melt %>% dplyr::mutate(newfact = paste0({comb}), .after= "sample")')
+ # eval(parse(text=fun))
+ # fact3ok <- "newfact"
+ # tabF_melt2
+ # }
+
+ print("SORTABLE UI")
+ # print(str(tabF_melt2))
+ # print(names(tabF_melt2))
+ bucket_list("Drag condition names to change order (multiple selection allowed)",
+ group_name = "bucket_list_group",
+ orientation = "horizontal",
+ add_rank_list("Plotted conditions",
+ unique(tabF_melt2$newfact), ns("sorted2"),
+ options = sortable_options(multiDrag = TRUE)
+ ),
+ add_rank_list("Stashed conditions",
+ NULL, ns("stashed2"),
+ options = sortable_options(multiDrag = TRUE)
+ )
+ )
+ })
output$histo_plotly <- renderPlotly({
@@ -73,6 +136,14 @@ mod_plots_isot_server <- function(id, r = r, session = session){
mtab <- r$merged2()
mycolors <- colorRampPalette(RColorBrewer::brewer.pal(12, "Paired"))(20)
xform <- list()
+
+ fun <- glue::glue("
+ mtab <- mtab %>%
+ dplyr::filter({input$group1} %in% input$sorted2) %>%
+ droplevels() %>%
+ mutate({input$group1} = factor({input$group1}, levels = input$sorted2))
+ ")
+ eval(parse(text=fun))
if(input$group1 != "sample"){
print("GROUPING")
@@ -87,19 +158,17 @@ mod_plots_isot_server <- function(id, r = r, session = session){
as.data.frame()
tab_plot4[which(tab_plot4$sdGroup == 0), "sdGroup"] <- NA
-
tab_plot5 <- r_values$tab_plot4 <- tab_plot4
- tab_plot5$Miso = factor(tab_plot5$Miso, levels = sort(levels(tab_plot5$Miso)) )
-
+ tab_plot5$Miso = factor(tab_plot5$Miso, levels = sort(levels(tab_plot5$Miso)) )
+
r_values$tab_plot5 <- tab_plot5
- # save(list = ls(all.names = TRUE), file = "debug_plotly.rdata", envir = environment()); print("SAVE0")
if(input$dodge1){
tab_plot <- tab_plot5 %>% filter(metabolite == input$feat2)
- if(input$relativOUT){
+ if(input$relativOUT){ # newfact / as.formula(glue::glue("~{input$group1}"))
p1 <- plotly::plot_ly(tab_plot, x = as.formula(glue::glue("~{input$group1}")), y = ~meanGroup, type = 'bar',
name = ~Miso, color = ~Miso, height = 500, colors = mycolors[1:length(levels(tab_plot$Miso))]) %>%
plotly::layout(title=glue::glue("Isotopologue Fraction {input$feat2}"), yaxis = list(title = 'Isotopologue fraction'),
@@ -147,19 +216,146 @@ mod_plots_isot_server <- function(id, r = r, session = session){
barmode = BARMOD, xaxis = xform)
}
}
+ p1
+ })
+ output$histo_Aire_enrC13 <- renderPlot({
+ req(r$merged2())
+ mtab <- r$merged2()
+
+ fun <- glue::glue("
+ mtab <- mtab %>%
+ dplyr::filter({input$group1} %in% input$sorted2) %>%
+ droplevels() %>%
+ mutate({input$group1} = factor({input$group1}, levels = input$sorted2))
+ ")
+ eval(parse(text=fun))
+
+ mycolors <- colorRampPalette(RColorBrewer::brewer.pal(12, "Paired"))(20)
+ xform <- list()
+
+ CalculPerMerabolite <- mtab %>% group_by(sample) %>% group_by(metabolite, .add = TRUE) %>%
+ mutate(TotArea = sum(corrected_area), CID = 100 * corrected_area / sum(corrected_area),
+ EnrC13 = 100 * sum(Area_Iso)/(max(isotopologue) * sum(corrected_area)))
+
+
+ r$MeanSD_Area_EnrC13_per_compound <- MeanSD_Area_EnrC13_per_compound <- CalculPerMerabolite %>% group_by(condition2, .add = TRUE) %>%
+ summarise(MeanTotalArea = mean(TotArea), SDTotalArea = sd(TotArea),
+ MeanEnrC13 = mean(EnrC13), SDEnrC13 = sd(EnrC13))
+
+ r$MeanSD_Area_EnrC13_per_compound_groups <- MeanSD_Area_EnrC13_per_compound_groups <- MeanSD_Area_EnrC13_per_compound %>% ungroup() %>%
+ group_by(metabolite, condition2) %>%
+ summarise(MeanGroupArea = mean(MeanTotalArea, na.rm = TRUE), SDTotalArea = sd(MeanTotalArea, na.rm = TRUE),
+ MeanGroupEnrC13 = mean(MeanEnrC13, na.rm = TRUE), SDEnrC13 = sd(MeanEnrC13, na.rm = TRUE))
+
+ if(input$group1 == "sample"){
+
+ tabhisto <- MeanSD_Area_EnrC13_per_compound %>% filter(metabolite == input$feat2)
+
+ p3_bar <- p3_bar1 <- ggplot(tabhisto, aes(x = sample, y = MeanEnrC13)) +
+ geom_bar(stat="identity", color="black", fill = "#b6bced",
+ position=position_dodge()) +
+ theme_bw() + ylab("EnrC13") +
+ theme(legend.position = "None",
+ axis.text.x = element_text(
+ angle = 45, hjust=1)) +
+ ggtitle(glue::glue("EnrC13 {input$feat2} all samples") )
+
+ p4_bar <- p4_bar1 <- ggplot(tabhisto, aes(x = sample, y = MeanTotalArea)) +
+ geom_bar(stat="identity", color="black", fill = "#b6bced",
+ position=position_dodge()) +
+ theme_bw() + ylab("TotalArea") +
+ theme(legend.position = "None",
+ axis.text.x = element_text(
+ angle = 45, hjust=1)) +
+ ggtitle(glue::glue("TotalArea {input$feat2} all samples") )
+
+ }else{
+
+ tabhisto2 <- MeanSD_Area_EnrC13_per_compound_groups %>% filter(metabolite == input$feat2)
+
+ p3_bar <- p3_bar_group <- ggplot(tabhisto2, aes(x = condition2, y = MeanGroupEnrC13)) +
+ geom_bar(stat="identity", color="black", fill = "#b6bced",
+ position=position_dodge()) +
+ theme_bw() + ylab("Mean EnrC13") +
+ theme(legend.position = "None",
+ axis.text.x = element_text(
+ angle = 45, hjust=1)) +
+ ggtitle(glue::glue("EnrC13 {input$feat2} all groups")) +
+ geom_errorbar(aes(ymin=MeanGroupEnrC13-SDEnrC13, ymax=MeanGroupEnrC13+SDEnrC13), width=.2,
+ position=position_dodge(.9))
+
+ p4_bar <- p4_bar_group <- ggplot(tabhisto2, aes(x = condition2, y = MeanGroupArea)) +
+ geom_bar(stat="identity", color="black", fill = "#b6bced",
+ position=position_dodge()) +
+ theme_bw() + ylab("Mean TotalArea") +
+ theme(legend.position = "None",
+ axis.text.x = element_text(
+ angle = 45, hjust=1)) +
+ ggtitle(glue::glue("TotalArea {input$feat2} all groups")) +
+ geom_errorbar(aes(ymin=MeanGroupArea-SDTotalArea, ymax=MeanGroupArea+SDTotalArea), width=.2,
+ position=position_dodge(.9))
+
+ }
+
+ gridExtra::grid.arrange(p3_bar, p4_bar, nrow = 2)
+ })
+
+ output$histo_Aire_enrC13_allFeat_1group <- renderPlot({
+
+ # pour chaque condition metabolite en x
+ MeanSD_Area_EnrC13_per_compound <- r$MeanSD_Area_EnrC13_per_compound
+ tabhisto3 <- MeanSD_Area_EnrC13_per_compound %>% filter(!!as.symbol(input$group1) == input$level1) %>% ungroup() %>%
+ group_by(metabolite) %>%
+ summarise(MeanEnrC13Group = mean(MeanEnrC13, na.rm = TRUE), MeanTotAreaGroup = mean(MeanTotalArea, na.rm = TRUE),
+ sdEnrC13Group = sd(MeanEnrC13, na.rm = TRUE), sdTotAreaGroup = sd(MeanTotalArea, na.rm = TRUE))
+
+ p3_bar_all_feats_1group <- ggplot(tabhisto3, aes(x = metabolite, y = MeanEnrC13Group)) +
+ geom_bar(stat="identity", color="black", fill = "#b6bced",
+ position=position_dodge()) +
+ theme_bw() + ylab("EnrC13") +
+ theme(legend.position = "None",
+ axis.text.x = element_text(
+ angle = 45, hjust=1)) +
+ ggtitle(glue::glue("EnrC13 {input$group1} == {input$level1} all metabolites")) +
+ geom_errorbar(aes(ymin=MeanEnrC13Group-sdEnrC13Group, ymax=MeanEnrC13Group+sdEnrC13Group), width=.2,
+ position=position_dodge(.9))
+
+ p4_bar_all_feats_1group <- ggplot(tabhisto3, aes(x = metabolite, y = MeanTotAreaGroup)) +
+ geom_bar(stat="identity", color="black", fill = "#b6bced",
+ position=position_dodge()) +
+ theme_bw() + ylab("Total Area") +
+ theme(legend.position = "None",
+ axis.text.x = element_text(
+ angle = 45, hjust=1)) +
+ ggtitle(glue::glue("Total Area {input$group1} == {input$level1} all metabolites")) +
+ geom_errorbar(aes(ymin=MeanTotAreaGroup-sdTotAreaGroup, ymax=MeanTotAreaGroup+sdTotAreaGroup), width=.2,
+ position=position_dodge(.9))
+
+
+ gridExtra::grid.arrange(p3_bar_all_feats_1group, p4_bar_all_feats_1group, nrow = 2)
+ })
- p1
- })
+
pdfall_isoplot <- reactive({
cat(file=stderr(), 'All Barplots ...', "\n")
req(r$merged2())
mtab <- r$merged2()
+
+ fun <- glue::glue("
+ mtab <- mtab %>%
+ dplyr::filter({input$group1} %in% input$sorted2) %>%
+ droplevels() %>%
+ mutate({input$group1} = factor({input$group1}, levels = input$sorted2)) %>%
+ as.data.frame()
+ ")
+ eval(parse(text=fun))
+
LL <- list()
mycolors <- colorRampPalette(RColorBrewer::brewer.pal(12, "Paired"))(20)
@@ -167,25 +363,47 @@ mod_plots_isot_server <- function(id, r = r, session = session){
withProgress({
mtab$Miso <- factor(mtab$Miso, rev(levels(mtab$Miso)))
-
-
+
if(input$group1 == "sample"){
for(i in unique(mtab$metabolite)){
# incProgress(1/length(i))
print(i)
- tab_plot <- mtab %>% filter(metabolite == i)
- if(input$relativOUT){
- LL[[i]] <- ggplot(tab_plot, aes(fill=Miso, y=corrected_area, x=sample)) +
- geom_bar(position="fill", stat="identity") + scale_fill_manual(values = rev(col1[1:length(levels(droplevels(tab_plot$Miso)))])) +
- theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} CID")) +
- theme(axis.text.x = element_text(size = 8, angle = 45, vjust = 1, hjust=1))
+ tab_plot <- as.data.frame(mtab) %>% filter(metabolite == i)
+
+ if(input$dodge1){
+
+ if(input$relativOUT){
+ LL[[i]] <- ggplot(tab_plot, aes(fill=Miso, y=isotopologue_fraction, x=sample)) +
+ geom_bar(position="dodge", stat="identity") + scale_fill_manual(values = rev(col1[1:length(levels(droplevels(tab_plot$Miso)))])) +
+ theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} CID")) +
+ xlab("") + ylab("CID") +
+ theme(axis.text.x = element_text(size = 8, angle = 45, vjust = 1, hjust=1))
+ }else{
+ LL[[i]] <- ggplot(tab_plot, aes(fill=Miso, y=corrected_area, x=sample)) +
+ geom_bar(position="dodge", stat="identity") + scale_fill_manual(values = rev(col1[1:length(levels(droplevels(tab_plot$Miso)))])) +
+ theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} Area")) +
+ xlab("") + ylab("Area") +
+ theme(axis.text.x = element_text(size = 8, angle = 45, vjust = 1, hjust=1))
+ }
+
+
}else{
- LL[[i]] <- ggplot(tab_plot, aes(fill=Miso, y=corrected_area, x=sample)) +
- geom_bar(position="stack", stat="identity") + scale_fill_manual(values = rev(col1[1:length(levels(droplevels(tab_plot$Miso)))])) +
- theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} Area")) +
- xlab("") + ylab("mean CID") +
- theme(axis.text.x = element_text(size = 8, angle = 45, vjust = 1, hjust=1))
+
+ if(input$relativOUT){
+ LL[[i]] <- ggplot(tab_plot, aes(fill=Miso, y=corrected_area, x=sample)) +
+ geom_bar(position="fill", stat="identity") + scale_fill_manual(values = rev(col1[1:length(levels(droplevels(tab_plot$Miso)))])) +
+ theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} CID")) +
+ xlab("") + ylab("CID") +
+ theme(axis.text.x = element_text(size = 8, angle = 45, vjust = 1, hjust=1))
+ }else{
+ LL[[i]] <- ggplot(tab_plot, aes(fill=Miso, y=corrected_area, x=sample)) +
+ geom_bar(position="stack", stat="identity") + scale_fill_manual(values = rev(col1[1:length(levels(droplevels(tab_plot$Miso)))])) +
+ theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} Area")) +
+ xlab("") + ylab("Area") +
+ theme(axis.text.x = element_text(size = 8, angle = 45, vjust = 1, hjust=1))
+ }
}
+
}
}else{
@@ -212,16 +430,16 @@ mod_plots_isot_server <- function(id, r = r, session = session){
for(i in unique(mtab$metabolite)){
if(input$relativOUT){
- LL[[i]] <- ggplot(tab_plot5 %>% filter(metabolite == i), aes(fill=Miso, y=meanGroup, x=get(input$group1))) +
+ LL[[i]] <- ggplot(as.data.frame(tab_plot5) %>% filter(metabolite == i), aes(fill=Miso, y=meanGroup, x=get(input$group1))) +
geom_bar(position="dodge", stat="identity") + scale_fill_manual(values = col1) +
theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} mean CID by '{input$group1}' factor")) + xlab("") + ylab("Mean Isotopologue fraction") +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1)) +
geom_errorbar(aes(ymin = meanGroup-sdGroup, ymax = meanGroup+sdGroup), width = 0.3, position = position_dodge(0.9))
}else{
- LL[[i]] <- ggplot(tab_plot5 %>% filter(metabolite == i), aes(fill=Miso, y=meanGroupAbs, x=get(input$group1))) +
+ LL[[i]] <- ggplot(as.data.frame(tab_plot5) %>% filter(metabolite == i), aes(fill=Miso, y=meanGroupAbs, x=get(input$group1))) +
geom_bar(position="dodge", stat="identity") + scale_fill_manual(values = col1) +
- theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} mean CID by '{input$group1}' factor")) + xlab("") + ylab("Mean corrected area") +
+ theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} mean Area by '{input$group1}' factor")) + xlab("") + ylab("Mean corrected area") +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1)) +
geom_errorbar(aes(ymin = meanGroupAbs-sdGroupAbs, ymax = meanGroupAbs+sdGroupAbs), width = 0.3, position = position_dodge(0.9))
@@ -234,11 +452,11 @@ mod_plots_isot_server <- function(id, r = r, session = session){
col2 <- rev(col1)
names(col2) <- levels(tab_plot4$Miso)
-
+
for(i in unique(mtab$metabolite)){
print(i)
if(input$relativOUT){
- LL[[i]] <- ggplot(tab_plot4 %>% filter(metabolite == i), aes(fill=Miso, y=meanGroup, x=get(input$group1))) +
+ LL[[i]] <- ggplot(as.data.frame(tab_plot4) %>% filter(metabolite == i), aes(fill=Miso, y=meanGroup, x=get(input$group1))) +
geom_bar(position="stack", stat="identity") + scale_fill_manual(values = col2) +
theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} mean CID by '{input$group1}' factor")) +
xlab("") + ylab("Mean Isotopologue fraction") +
@@ -246,9 +464,9 @@ mod_plots_isot_server <- function(id, r = r, session = session){
geom_linerange(aes(ymin = SDPos-sdGroup, ymax = SDPos+sdGroup), width = 0.1, position = position_jitter(0.1))
}else{
- LL[[i]] <- ggplot(tab_plot4 %>% filter(metabolite == i), aes(fill=Miso, y=meanGroupAbs, x=get(input$group1))) +
+ LL[[i]] <- ggplot(as.data.frame(tab_plot4) %>% filter(metabolite == i), aes(fill=Miso, y=meanGroupAbs, x=get(input$group1))) +
geom_bar(position="stack", stat="identity") + scale_fill_manual(values = col2) +
- theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} mean CID by '{input$group1}' factor")) +
+ theme_bw() + labs(fill='') + ggtitle(glue::glue("{i} mean Area by '{input$group1}' factor")) +
xlab("") + ylab("Mean corrected area") +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1)) +
geom_linerange(aes(ymin = SDPosAbs-sdGroupAbs, ymax = SDPosAbs+sdGroupAbs), width = 0.1, position = position_jitter(0.1))
@@ -264,7 +482,6 @@ mod_plots_isot_server <- function(id, r = r, session = session){
}, value = 0 ,message = glue::glue("Processing barplots ... please wait."))
- # save(list = ls(all.names = TRUE), file = "debug.rdata", envir = environment()); print("SAVE0")
LL
})
@@ -316,7 +533,6 @@ mod_plots_isot_server <- function(id, r = r, session = session){
listP <- pdfall_isoplot()
FEAT = names(listP)
- # save(list = ls(all.names = TRUE), file = "~/Bureau/debug.rdata", envir = environment()); print("SAVE0")
withProgress({
for(i in 1:length(FEAT)){
@@ -335,7 +551,175 @@ mod_plots_isot_server <- function(id, r = r, session = session){
)
-
+
+ pdfall_EnrC13_Area <- reactive({
+ cat(file=stderr(), 'All Barplots EnrC13 Area ...', "\n")
+ req(r$merged2())
+ mtab <- r$merged2()
+ LL <- list()
+
+ withProgress({
+
+ if(input$group1 == "sample"){
+ mtab <- MeanSD_Area_EnrC13_per_compound <- r$MeanSD_Area_EnrC13_per_compound
+ print(head(mtab))
+
+ for(i in sort(unique(mtab$metabolite))){
+ print("per sample")
+ print(i)
+ tabhisto <- MeanSD_Area_EnrC13_per_compound %>% filter(metabolite == i)
+
+ LL[[glue::glue("{i}_enrC13")]] <- p3_bar <- ggplot(tabhisto, aes(x = sample, y = MeanEnrC13)) +
+ geom_bar(stat="identity", color="black", fill = "#b6bced",
+ position=position_dodge()) +
+ theme_bw() + ylab("EnrC13") +
+ theme(legend.position = "None",
+ axis.text.x = element_text(
+ angle = 45, hjust=1)) +
+ ggtitle(glue::glue("EnrC13 {i} all samples") )
+
+ LL[[glue::glue("{i}_area")]] <- p4_bar <- ggplot(tabhisto, aes(x = sample, y = MeanTotalArea)) +
+ geom_bar(stat="identity", color="black", fill = "#b6bced",
+ position=position_dodge()) +
+ theme_bw() + ylab("TotalArea") +
+ theme(legend.position = "None",
+ axis.text.x = element_text(
+ angle = 45, hjust=1)) +
+ ggtitle(glue::glue("TotalArea {i} all samples") )
+
+ }
+
+ }else{
+ mtab <- MeanSD_Area_EnrC13_per_compound_groups <- r$MeanSD_Area_EnrC13_per_compound_groups
+ print(head(mtab))
+
+ for(i in sort(unique(mtab$metabolite))){
+ print("per group")
+ print(i)
+ tabhisto2 <- MeanSD_Area_EnrC13_per_compound_groups %>% filter(metabolite == i)
+
+ LL[[glue::glue("{i}_enrC13")]] <- p3_bar_group <- ggplot(tabhisto2, aes(x = condition2, y = MeanGroupEnrC13)) +
+ geom_bar(stat="identity", color="black", fill = "#b6bced",
+ position=position_dodge()) +
+ theme_bw() + ylab("Mean EnrC13") +
+ theme(legend.position = "None",
+ axis.text.x = element_text(
+ angle = 45, hjust=1)) +
+ ggtitle(glue::glue("EnrC13 {i} all groups")) +
+ geom_errorbar(aes(ymin=MeanGroupEnrC13-SDEnrC13, ymax=MeanGroupEnrC13+SDEnrC13), width=.2,
+ position=position_dodge(.9))
+
+ LL[[glue::glue("{i}_area")]] <- p4_bar_group <- ggplot(tabhisto2, aes(x = condition2, y = MeanGroupArea)) +
+ geom_bar(stat="identity", color="black", fill = "#b6bced",
+ position=position_dodge()) +
+ theme_bw() + ylab("Mean TotalArea") +
+ theme(legend.position = "None",
+ axis.text.x = element_text(
+ angle = 45, hjust=1)) +
+ ggtitle(glue::glue("TotalArea {i} all groups")) +
+ geom_errorbar(aes(ymin=MeanGroupArea-SDTotalArea, ymax=MeanGroupArea+SDTotalArea), width=.2,
+ position=position_dodge(.9))
+
+ }
+
+
+ }
+ }, value = 0 ,message = glue::glue("Processing barplots ... please wait."))
+
+
+ LL
+ })
+
+
+ output$bars_download <- downloadHandler(
+ filename = glue::glue("isoplot_figures_bars_{systim}.pdf"),
+ content = function(file) {
+ print('DOWNLOAD ALL')
+ print("bars")
+ req(pdfall_EnrC13_Area())
+ p <- pdfall_EnrC13_Area()
+ withProgress({
+ ml <- marrangeGrob(p, nrow=2, ncol=1)
+
+ ggsave(file, ml , width = 11, height = 8, dpi = 100)
+ }, message = "Prepare pdf file... please wait.")
+ print('pdf output')
+
+
+
+ }
+ )
+
+ pdfall_EnrC13_Area_spec <- reactive({
+ cat(file=stderr(), 'All Barplots EnrC13 Area ...', "\n")
+ req(r$merged2())
+ LL <- list()
+
+
+ # pour chaque condition metabolite en x
+ mtab <- MeanSD_Area_EnrC13_per_compound <- r$MeanSD_Area_EnrC13_per_compound
+ # for i in all groups from chosen factor
+ withProgress({
+ for(i in levels(as.data.frame(mtab)[,input$group1])) {
+ print(input$group1)
+ print(i)
+ tabhisto3 <- MeanSD_Area_EnrC13_per_compound %>% filter(!!as.symbol(input$group1) == i) %>% ungroup() %>%
+ group_by(metabolite) %>%
+ summarise(MeanEnrC13Group = mean(MeanEnrC13, na.rm = TRUE), MeanTotAreaGroup = mean(MeanTotalArea, na.rm = TRUE),
+ sdEnrC13Group = sd(MeanEnrC13, na.rm = TRUE), sdTotAreaGroup = sd(MeanTotalArea, na.rm = TRUE))
+
+ LL[[glue::glue("{i}_enrC13")]] <- p3_bar_all_feats_1group <- ggplot(tabhisto3, aes(x = metabolite, y = MeanEnrC13Group)) +
+ geom_bar(stat="identity", color="black", fill = "#b6bced",
+ position=position_dodge()) +
+ theme_bw() + ylab("EnrC13") +
+ theme(legend.position = "None",
+ axis.text.x = element_text(
+ angle = 45, hjust=1)) +
+ ggtitle(glue::glue("EnrC13 {input$group1} == {i} all metabolites")) +
+ geom_errorbar(aes(ymin=MeanEnrC13Group-sdEnrC13Group, ymax=MeanEnrC13Group+sdEnrC13Group), width=.2,
+ position=position_dodge(.9))
+
+ LL[[glue::glue("{i}_area")]] <- p4_bar_all_feats_1group <- ggplot(tabhisto3, aes(x = metabolite, y = MeanTotAreaGroup)) +
+ geom_bar(stat="identity", color="black", fill = "#b6bced",
+ position=position_dodge()) +
+ theme_bw() + ylab("Total Area") +
+ theme(legend.position = "None",
+ axis.text.x = element_text(
+ angle = 45, hjust=1)) +
+ ggtitle(glue::glue("Total Area {input$group1} == {i} all metabolites")) +
+ geom_errorbar(aes(ymin=MeanTotAreaGroup-sdTotAreaGroup, ymax=MeanTotAreaGroup+sdTotAreaGroup), width=.2,
+ position=position_dodge(.9))
+
+ }
+ }, message = "Processing barplots ... please wait.")
+
+ LL
+
+
+
+ })
+
+
+ output$bars_spec_download <- downloadHandler(
+ filename = glue::glue("isoplot_figures_bars_spec_{systim}.pdf"),
+ content = function(file) {
+ print('DOWNLOAD ALL')
+ print("bars")
+ req(pdfall_EnrC13_Area_spec())
+ p <- pdfall_EnrC13_Area_spec()
+ withProgress({
+ ml <- marrangeGrob(p, nrow=2, ncol=1)
+
+ ggsave(file, ml , width = 11, height = 8, dpi = 100)
+ }, message = "Prepare pdf file... please wait.")
+ print('pdf output')
+
+ }
+ )
+
+
+
+
})
}
--
GitLab
From c3ad1f565a4e9066a836680d3554e7971bd61cea Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Mon, 18 Mar 2024 16:41:12 +0100
Subject: [PATCH 13/13] cleaning code + last fix
---
R/mod_inputs_isot.R | 89 +--------------------------------------------
R/mod_plots_isot.R | 23 ++++++------
2 files changed, 14 insertions(+), 98 deletions(-)
diff --git a/R/mod_inputs_isot.R b/R/mod_inputs_isot.R
index 7850506..fffa871 100644
--- a/R/mod_inputs_isot.R
+++ b/R/mod_inputs_isot.R
@@ -62,44 +62,11 @@ mod_inputs_isot_ui <- function(id){
verbatimTextOutput(ns('x4'))
),
- # box(title = "Merge dataset", status = "warning", solidHeader = TRUE, width = 3,
- # verbatimTextOutput(ns('x4bis')),
- # selectInput(
- # ns("mergefact"),
- # label = "Sum features belonging the same group:",
- # choices = ""
- # ),
-
- # selectInput(
- # ns("norm1fact1"),
- # label = "Numeric factor/covariable to weight features values with:",
- # choices = ""
- # ),
- # radioButtons(
- # ns("norm_method"),
- # label = "Normalization : ",
- # inline = TRUE,
- # choices = list(
- # "Raw" = 0 ,
- # "TSS (total-sum normalization)" = 1,
- # "CLR (center log-ratio)" = 2
- # ), selected = 0
- # ),
- # actionButton(ns("mergebutton"), "Merge features and metadata...", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469")
- # ),
-
-
box(title = "Final dataset", status = "primary", solidHeader = TRUE, width = 12,
actionButton(ns("mergebutton"), "Merge features and metadata...", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469"),
DT::dataTableOutput(outputId = ns("mergetable_DT")),
downloadButton(outputId = ns("mergedf_download"), label = "Download merged table")
- )#,
- # fluidRow(
- # box(width = 12,
- # title = 'Out plotly:', status = "warning", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
- # plotlyOutput(ns("histo_plotly"), height = "500")
- # )
- # )
+ )
)
)
@@ -142,7 +109,7 @@ mod_inputs_isot_server <- function(id, r = r, session = session){
})
- # Filters dev
+ # Filters
data <- reactive({
r_values$imported <- imported$data()
@@ -394,16 +361,6 @@ mod_inputs_isot_server <- function(id, r = r, session = session){
dplyr::left_join(x = mt1, by = "sample")
r_values$subsetds_final <- Fdataset
- # # melt final dataset for boxplot
- # r_values$subsetds_final_melt <- reshape2::melt(Fdataset, id.vars = 1:ncol(mt1), measure.vars = (ncol(mt1)+1):ncol(Fdataset), variable.name = "features")
-
-
- # #for PCA
- # r_values$metadata_final <- droplevels(Fdataset[,1:ncol(mt1)])
- # # print(prev(r_values$metadata_final))
- # r_values$features_final <- Fdataset[,(ncol(mt1)+1):ncol(Fdataset)]
- # # print(prev(r_values$features_final))
-
showNotification("Dataset ready !", type="message", duration = 5)
Fdataset
@@ -461,48 +418,6 @@ mod_inputs_isot_server <- function(id, r = r, session = session){
r_values$mt1
})
- # r$ds0 <- reactive({
- # req(res_filter$filtered())
- # res_filter$filtered()
-
- # })
-
- # r$fdata <- reactive({
- # print("reactive r")
- # req(r_values$subsetds_final)
- # r_values$subsetds_final
-
- # })
-
-
- # r$mt1 <- reactive({
- # req(r_values$metadata_final)
- # r_values$metadata_final
- # })
-
- # r$ds1 <- reactive({
- # req(r_values$features_final)
- # r_values$features_final
- # })
-
- # r$fdata_melt <- reactive({
- # req(r_values$subsetds_final_melt)
- # r_values$subsetds_final_melt
- # })
-
- # r$wgt1 <- reactive({
- # req(r_values$wgt1)
- # r_values$wgt1
- # })
-
- # r$norm1 <- reactive({
- # req(r_values$norm1)
- # r_values$norm1
- # })
-
-
-
-
})
}
diff --git a/R/mod_plots_isot.R b/R/mod_plots_isot.R
index 26dcb11..816f63a 100644
--- a/R/mod_plots_isot.R
+++ b/R/mod_plots_isot.R
@@ -30,7 +30,7 @@ mod_plots_isot_ui <- function(id){
choices = ""
)
),
- box(title = "Reorder boxplots:", width = 5, status = "warning", solidHeader = TRUE, collapsible = FALSE,
+ box(title = "Reorder boxplots:", width = 7, status = "warning", solidHeader = TRUE, collapsible = FALSE,
style='height:400px;overflow-y: scroll;',
uiOutput(ns("sortable1"))#,
# verbatimTextOutput(ns("results_sort"))
@@ -136,7 +136,6 @@ mod_plots_isot_server <- function(id, r = r, session = session){
mtab <- r$merged2()
mycolors <- colorRampPalette(RColorBrewer::brewer.pal(12, "Paired"))(20)
xform <- list()
-
fun <- glue::glue("
mtab <- mtab %>%
dplyr::filter({input$group1} %in% input$sorted2) %>%
@@ -144,10 +143,11 @@ mod_plots_isot_server <- function(id, r = r, session = session){
mutate({input$group1} = factor({input$group1}, levels = input$sorted2))
")
eval(parse(text=fun))
-
+
if(input$group1 != "sample"){
print("GROUPING")
cols2group <- c("metabolite", "Miso", input$group1)
+
tab_plot4 <- mtab %>% group_by(across(all_of(cols2group))) %>%
summarise(meanGroup = mean(isotopologue_fraction), sdGroup = sd(isotopologue_fraction),
meanGroupAbs = mean(corrected_area), sdGroupAbs = sd(corrected_area), .groups = "keep") %>%
@@ -164,7 +164,7 @@ mod_plots_isot_server <- function(id, r = r, session = session){
r_values$tab_plot5 <- tab_plot5
-
+ print("PLOTS")
if(input$dodge1){
tab_plot <- tab_plot5 %>% filter(metabolite == input$feat2)
@@ -238,13 +238,14 @@ mod_plots_isot_server <- function(id, r = r, session = session){
mutate(TotArea = sum(corrected_area), CID = 100 * corrected_area / sum(corrected_area),
EnrC13 = 100 * sum(Area_Iso)/(max(isotopologue) * sum(corrected_area)))
-
- r$MeanSD_Area_EnrC13_per_compound <- MeanSD_Area_EnrC13_per_compound <- CalculPerMerabolite %>% group_by(condition2, .add = TRUE) %>%
+ cols2group <- c(input$group1)
+ r$MeanSD_Area_EnrC13_per_compound <- MeanSD_Area_EnrC13_per_compound <- CalculPerMerabolite %>% group_by(across(all_of(cols2group)), .add = TRUE) %>%
summarise(MeanTotalArea = mean(TotArea), SDTotalArea = sd(TotArea),
MeanEnrC13 = mean(EnrC13), SDEnrC13 = sd(EnrC13))
+ cols2group <- c("metabolite", input$group1)
r$MeanSD_Area_EnrC13_per_compound_groups <- MeanSD_Area_EnrC13_per_compound_groups <- MeanSD_Area_EnrC13_per_compound %>% ungroup() %>%
- group_by(metabolite, condition2) %>%
+ group_by(across(all_of(cols2group))) %>%
summarise(MeanGroupArea = mean(MeanTotalArea, na.rm = TRUE), SDTotalArea = sd(MeanTotalArea, na.rm = TRUE),
MeanGroupEnrC13 = mean(MeanEnrC13, na.rm = TRUE), SDEnrC13 = sd(MeanEnrC13, na.rm = TRUE))
@@ -274,7 +275,7 @@ mod_plots_isot_server <- function(id, r = r, session = session){
tabhisto2 <- MeanSD_Area_EnrC13_per_compound_groups %>% filter(metabolite == input$feat2)
- p3_bar <- p3_bar_group <- ggplot(tabhisto2, aes(x = condition2, y = MeanGroupEnrC13)) +
+ p3_bar <- p3_bar_group <- ggplot(tabhisto2, aes(x = get(input$group1), y = MeanGroupEnrC13)) +
geom_bar(stat="identity", color="black", fill = "#b6bced",
position=position_dodge()) +
theme_bw() + ylab("Mean EnrC13") +
@@ -285,7 +286,7 @@ mod_plots_isot_server <- function(id, r = r, session = session){
geom_errorbar(aes(ymin=MeanGroupEnrC13-SDEnrC13, ymax=MeanGroupEnrC13+SDEnrC13), width=.2,
position=position_dodge(.9))
- p4_bar <- p4_bar_group <- ggplot(tabhisto2, aes(x = condition2, y = MeanGroupArea)) +
+ p4_bar <- p4_bar_group <- ggplot(tabhisto2, aes(x = get(input$group1), y = MeanGroupArea)) +
geom_bar(stat="identity", color="black", fill = "#b6bced",
position=position_dodge()) +
theme_bw() + ylab("Mean TotalArea") +
@@ -598,7 +599,7 @@ mod_plots_isot_server <- function(id, r = r, session = session){
print(i)
tabhisto2 <- MeanSD_Area_EnrC13_per_compound_groups %>% filter(metabolite == i)
- LL[[glue::glue("{i}_enrC13")]] <- p3_bar_group <- ggplot(tabhisto2, aes(x = condition2, y = MeanGroupEnrC13)) +
+ LL[[glue::glue("{i}_enrC13")]] <- p3_bar_group <- ggplot(tabhisto2, aes(x = get(input$group1), y = MeanGroupEnrC13)) +
geom_bar(stat="identity", color="black", fill = "#b6bced",
position=position_dodge()) +
theme_bw() + ylab("Mean EnrC13") +
@@ -609,7 +610,7 @@ mod_plots_isot_server <- function(id, r = r, session = session){
geom_errorbar(aes(ymin=MeanGroupEnrC13-SDEnrC13, ymax=MeanGroupEnrC13+SDEnrC13), width=.2,
position=position_dodge(.9))
- LL[[glue::glue("{i}_area")]] <- p4_bar_group <- ggplot(tabhisto2, aes(x = condition2, y = MeanGroupArea)) +
+ LL[[glue::glue("{i}_area")]] <- p4_bar_group <- ggplot(tabhisto2, aes(x = get(input$group1), y = MeanGroupArea)) +
geom_bar(stat="identity", color="black", fill = "#b6bced",
position=position_dodge()) +
theme_bw() + ylab("Mean TotalArea") +
--
GitLab