diff --git a/DESCRIPTION b/DESCRIPTION
index d2a8b25324ac6b619abcdd01499a63d7e8548e3b..ae5ea6d33495e09473fd2941bcbbfc62f880e02d 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
@@ -25,6 +25,7 @@ Imports:
htmltools,
plotly,
PMCMRplus,
+ RColorBrewer,
reshape2,
rhdf5,
shiny (>= 1.6.0),
diff --git a/NAMESPACE b/NAMESPACE
index e687c09a155095cb9c44416d9d470005fe7d1bd9..54f394b3f9e96e24cb93d7a88536e644e6fce3db 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(car,Boxplot)
importFrom(factoextra,fviz_pca_var)
diff --git a/R/app_server.R b/R/app_server.R
index 028bf5ccf658d2e4ad4438e01ac1b7d0eed78cf8..cc79df3ef9784d813e307d1a0ba8d2a8d660b2cb 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", session=session, r=r)
}
diff --git a/R/app_ui.R b/R/app_ui.R
index 2e4b70a88761491e6e1014606f916c752df1452f..81e25992461fb0d0d88e26400b5a343611e08b3f 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")),
@@ -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_boxplots.R b/R/mod_boxplots.R
index a9454bf13364b8156683b6a07a05eab116b9b1db..439bd904147336b125501b79939909c190b85c32 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")
)
),
diff --git a/R/mod_inputs_isot.R b/R/mod_inputs_isot.R
new file mode 100644
index 0000000000000000000000000000000000000000..fffa871518a11f92cbc6163370c4220b1d8b93b9
--- /dev/null
+++ b/R/mod_inputs_isot.R
@@ -0,0 +1,428 @@
+#' 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(
+ 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")
+ )
+ ),
+ 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 = "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")
+ )
+
+ )
+ )
+}
+
+#' 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
+
+ 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]
+ })
+
+
+
+ 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))
+ r_values$mt1 <- mt1
+ # print(mt1$sample)
+
+ 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) %>%
+ 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
+
+ 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$merged2 <- reactive({
+ req(mergetable())
+ mergetable()
+ })
+
+ r$mt1_isoT <- reactive({
+ req(r_values$mt1)
+ r_values$mt1
+ })
+
+ })
+}
+
+## 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 0000000000000000000000000000000000000000..816f63a8e1836f2e4eb6bffcec738de4ed93e969
--- /dev/null
+++ b/R/mod_plots_isot.R
@@ -0,0 +1,731 @@
+#' plots_isot UI Function
+#'
+#' @description A shiny Module.
+#'
+#' @param id,input,output,session Internal parameters for {shiny}.
+#'
+#' @noRd
+#'
+#' @importFrom shiny NS tagList
+#' @importFrom RColorBrewer brewer.pal
+#'
+
+tmpdir <- tempdir()
+systim <- as.numeric(Sys.time())
+
+mod_plots_isot_ui <- function(id){
+ ns <- NS(id)
+ tagList(
+ fluidRow(
+
+ box(title = "Plot Settings:", width = 5, status = "warning", solidHeader = TRUE,
+ selectInput(
+ ns("feat2"),
+ label = "Feature to preview:",
+ choices = ""
+ ),
+ selectInput(
+ ns("group1"),
+ label = "Variable used to calculate means:",
+ choices = ""
+ )
+ ),
+ 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"))
+ )
+ ),
+ 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")
+ )
+
+ )
+ )
+}
+
+#' 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(r$merged2())
+ dsF <- r_values$merged <- r$merged2()
+ mtF <- r_values$mt1 <- r$mt1_isoT()
+
+ updateSelectInput(session, "feat2",
+ choices = unique(dsF$metabolite),
+ selected = unique(dsF$metabolite)[1])
+
+ updateSelectInput(session, "group1",
+ 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({
+ req(r$merged2())
+ 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")
+ 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
+
+ print("PLOTS")
+ if(input$dodge1){
+ tab_plot <- tab_plot5 %>% filter(metabolite == input$feat2)
+
+ 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'),
+ 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
+ })
+
+ 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)))
+
+ 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(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))
+
+ 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 = get(input$group1), 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 = get(input$group1), 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)
+
+ })
+
+
+
+
+
+
+ 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)
+
+ col1 = mycolors[1:length(levels(mtab$Miso))]
+ 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 <- 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{
+
+ 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{
+ 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
+
+ # 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)){
+
+ if(input$relativOUT){
+ 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(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 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))
+
+ }
+ }
+
+ }else{
+ 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)){
+ print(i)
+ if(input$relativOUT){
+ 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") +
+ 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(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 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))
+
+ }
+
+ }
+
+ }
+
+
+ }
+
+ }, 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')
+
+
+
+ }
+ )
+
+ output$hist_downloadTAR <- downloadHandler(
+ filename <- glue::glue("{tmpdir}/figures_pngs.tar"),
+
+ content <- function(file) {
+ print("WRITE PLOTS")
+ print(glue::glue("{tmpdir}/figures_{systim}/"))
+ dir.create(glue::glue("{tmpdir}/figures_{systim}/"), recursive = TRUE)
+
+
+ req(pdfall_isoplot())
+ listP <- pdfall_isoplot()
+
+ FEAT = names(listP)
+
+ 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"
+ )
+
+
+
+ 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 = get(input$group1), 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 = get(input$group1), 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')
+
+ }
+ )
+
+
+
+
+ })
+}
+
+## 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")