From ff912b70c48904013ad496429780f4530f95b805 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Tue, 15 Mar 2022 15:36:48 +0100
Subject: [PATCH 01/14] new input modules

---
 DESCRIPTION    |   6 ++
 NAMESPACE      |   1 +
 R/mod_Inputs.R | 218 ++++++++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 224 insertions(+), 1 deletion(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index d74a4b3..8af9492 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -11,10 +11,12 @@ Description: A shiny app to easily generate advanced graphics and some non
 License: MIT + file LICENSE
 Imports: 
     config (>= 0.3.1),
+    datamods,
     dplyr,
     DT,
     factoextra,
     ggplot2,
+    ggrepel,
     glue,
     golem (>= 0.3.1),
     gridExtra,
@@ -30,6 +32,10 @@ Imports:
     stringr,
     tibble,
     tidyr
+Suggests: 
+    graphstats,
+    spelling,
+    testthat
 Remotes:
     bioc::3.10/rhdf5
 Config/testthat/edition: 3
diff --git a/NAMESPACE b/NAMESPACE
index f713455..ab30dd1 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -2,6 +2,7 @@
 
 export(run_app)
 import(DT)
+import(datamods)
 import(dplyr)
 import(ggplot2)
 import(rhdf5)
diff --git a/R/mod_Inputs.R b/R/mod_Inputs.R
index bd24be9..04e34a0 100644
--- a/R/mod_Inputs.R
+++ b/R/mod_Inputs.R
@@ -25,13 +25,66 @@
 #' @import shinyWidgets
 #' @import ggplot2
 #' @import DT
+#' @import datamods
 
 mod_Inputs_ui <- function(id){
   ns <- NS(id)
   tagList(
     fluidPage(
-      
       tabsetPanel(
+        tabPanel("Input tables dev.",
+              box(title = "Input features dataset", status = "warning", solidHeader = TRUE, width=12,
+                 fluidRow(
+                      column(
+                        width = 12,
+                        actionButton(ns("launch_modal"), "Features table input module")#,
+                        # tags$b("Imported data:"),
+                        # verbatimTextOutput(outputId = ns("name")),
+                        # verbatimTextOutput(outputId = ns("data"))
+                      )
+                    ),
+                      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"))#,
+                            # tags$b("Code dplyr:"),
+                            # verbatimTextOutput(outputId = ns("code_dplyr")),
+                            # tags$b("Expression:"),
+                            # verbatimTextOutput(outputId = ns("code")),
+                            # tags$b("Filtered data:"),
+                            # verbatimTextOutput(outputId = ns("res_str"))
+                          )
+                        )
+                      ),
+                  box(title = "Input metadata dataset", status = "warning", solidHeader = TRUE, width=12,
+                      actionButton(ns("launch_modal2"), "Metadata input module"),
+                      tags$h3("Use filters to subset on metadata:"),
+                      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"))
+                      )                      
+                    )
+
+                ),
+
         tabPanel("Input tables",
                  fluidRow(
                    box(
@@ -220,6 +273,169 @@ mod_Inputs_server <- function(id, r = r, session = session){
   moduleServer( id, function(input, output, session){
     ns <- session$ns
     r_values <- reactiveValues(ds1=NULL, mt1=NULL)
+    imported <- NULL
+
+
+    # Input dataset dev 
+
+    observeEvent(input$launch_modal, {
+      import_modal(
+        id = ns("myid"),
+        from = c("file", "env", "copypaste", "googlesheets", "url"),
+        title = "Import data to be used in application"
+      )
+    })
+
+    imported <- import_server("myid", return_class = "data.frame")
+
+    # output$name <- renderPrint({
+    #   req(imported$name())
+    #   imported$name()
+    # })
+
+    # output$data <- renderPrint({
+    #   req(imported$data())
+    #   as.tibble(imported$data())
+    # })
+
+
+    # Filters dev
+
+
+      data <- reactive({
+        imported$data()
+        # get("iris")  #get(input$dataset)
+      })
+
+      # output$datainput <- renderPrint({
+      #   # imported$data()[1:10,1:10]
+      #   data()[1:10,]
+      # })
+
+      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$table <- DT::renderDT({
+        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())
+      })
+
+
+    # Input metadata dev 
+
+    observeEvent(input$launch_modal2, {
+      import_modal(
+        id = ns("myid2"),
+        from = c("file", "env", "copypaste", "googlesheets", "url"),
+        title = "Import data to be used in application"
+      )
+    })
+
+    imported2 <- import_server("myid2", return_class = "data.frame")
+
+    # output$name <- renderPrint({
+    #   req(imported$name())
+    #   imported$name()
+    # })
+
+    # output$data <- renderPrint({
+    #   req(imported$data())
+    #   as.tibble(imported$data())
+    # })
+
+
+    # Filters metadata dev
+
+
+      data2 <- reactive({
+        imported2$data()
+        # get("iris")  #get(input$dataset)
+      })
+
+      # output$datainput <- renderPrint({
+      #   # imported$data()[1:10,1:10]
+      #   data()[1:10,]
+      # })
+
+      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({
+        res_filter2$filtered()
+      }, options = list(pageLength = 6, scrollX = TRUE))
+
+
+      # output$code_dplyr <- renderPrint({
+      #   res_filter2$code()
+      # })
+      # output$code <- renderPrint({
+      #   res_filter2$expr()
+      # })
+
+      # output$res_str <- renderPrint({
+      #   str(res_filter2$filtered())
+      # })
+
+
+
+    # Merge DEV
+
+
+      
+
+
     
     # Input Dataset
     dataset1 <- reactive({
-- 
GitLab


From 1bd322b16e27872fec6a450dac04dfa30173a199 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Tue, 15 Mar 2022 17:44:02 +0100
Subject: [PATCH 02/14] merge table

---
 R/mod_Inputs.R | 61 ++++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 57 insertions(+), 4 deletions(-)

diff --git a/R/mod_Inputs.R b/R/mod_Inputs.R
index 04e34a0..0c1c8bb 100644
--- a/R/mod_Inputs.R
+++ b/R/mod_Inputs.R
@@ -56,13 +56,15 @@ mod_Inputs_ui <- function(id){
                               id = ns("pbar"), value = 100,
                               total = 100, display_pct = TRUE
                             ),
-                            DT::dataTableOutput(outputId = ns("table"))#,
+                            DT::dataTableOutput(outputId = ns("table")),
                             # tags$b("Code dplyr:"),
                             # verbatimTextOutput(outputId = ns("code_dplyr")),
                             # tags$b("Expression:"),
                             # verbatimTextOutput(outputId = ns("code")),
                             # tags$b("Filtered data:"),
                             # verbatimTextOutput(outputId = ns("res_str"))
+                            tags$b("Outliers:"),
+                            verbatimTextOutput(outputId = ns("outliers"))
                           )
                         )
                       ),
@@ -81,7 +83,9 @@ mod_Inputs_ui <- function(id){
                         ),
                         DT::dataTableOutput(outputId = ns("table2"))
                       )                      
-                    )
+                    ),
+                  actionButton(ns("mergebutton"), "Merge tables..."),
+                  DT::dataTableOutput(outputId = ns("mergetable_DT"))
 
                 ),
 
@@ -412,9 +416,58 @@ mod_Inputs_server <- function(id, r = r, session = session){
         "}"
       )
 
-      output$table2 <- DT::renderDT({
+      output$table2 <- DT::renderDataTable({
         res_filter2$filtered()
-      }, options = list(pageLength = 6, scrollX = TRUE))
+      }, 
+      options = list(
+        pageLength = 6, scrollX = TRUE, rowCallback = DT::JS(rowCallback), server=TRUE, autoWidth = TRUE),
+      extensions = "Select", selection = "multiple"
+      )
+
+      # outliers <- reactive({
+      #   r_values$outliers <- input[["table2_DT_rows_selected"]]
+      #   print("reactive outliers")
+      #   print(r_values$outliers)
+      #   r_values$outliers
+      # })
+
+      # observe({
+      #   print(input[["table2_DT_rows_selected"]])
+      # })
+
+      # output$outliers <- renderPrint({
+      #   outliers()
+      # })
+
+      mergetable <- eventReactive(input$mergebutton, {
+        print("coucou")
+        # print(input[["table2_DT_rows_selected"]])
+
+        mt1 <- res_filter2$filtered()
+        ds0 <- res_filter$filtered()
+
+        save(list = ls(all.names = TRUE), file = "debug.rdata", envir = environment()); print("SAVE0")
+
+        row.names(ds0) <- glue::glue("{ds0[,1]}__{ds0[,2]}__{ds0[,3]}")
+        class1 <- sapply(ds0, class)
+        ds1 <- t(ds0[,class1 == "numeric" | class1 == "integer"])
+
+
+        r_values$tabF = as.data.frame(ds1) %>% 
+        tibble::rownames_to_column(var = "sample.id") %>% 
+        dplyr::right_join(x = mt1, by = "sample.id")# %>% mutate_if(is.character,as.factor)
+
+      })
+
+
+      output$mergetable_DT <- DT::renderDataTable({
+        mergetable()
+      }, 
+      options = list(
+        pageLength = 6, scrollX = TRUE,server=TRUE, autoWidth = TRUE)#, #, rowCallback = DT::JS(rowCallback), 
+      #extensions = "Select", selection = "multiple"
+      )
+
 
 
       # output$code_dplyr <- renderPrint({
-- 
GitLab


From 6352effd11b05ff28659ea50f057659bd9bc758a Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Thu, 17 Mar 2022 16:04:11 +0100
Subject: [PATCH 03/14] test

---
 R/mod_Inputs.R | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/R/mod_Inputs.R b/R/mod_Inputs.R
index 0c1c8bb..ed29b3f 100644
--- a/R/mod_Inputs.R
+++ b/R/mod_Inputs.R
@@ -417,11 +417,13 @@ mod_Inputs_server <- function(id, r = r, session = session){
       )
 
       output$table2 <- DT::renderDataTable({
+        print(class(res_filter2$filtered()))
+        print(str(print(class(res_filter2$filtered()))))
         res_filter2$filtered()
       }, 
       options = list(
-        pageLength = 6, scrollX = TRUE, rowCallback = DT::JS(rowCallback), server=TRUE, autoWidth = TRUE),
-      extensions = "Select", selection = "multiple"
+        pageLength = 6, scrollX = TRUE, server=TRUE, autoWidth = TRUE)#, , rowCallback = DT::JS(rowCallback)
+      # extensions = "Select", selection = "multiple"
       )
 
       # outliers <- reactive({
@@ -441,7 +443,7 @@ mod_Inputs_server <- function(id, r = r, session = session){
 
       mergetable <- eventReactive(input$mergebutton, {
         print("coucou")
-        # print(input[["table2_DT_rows_selected"]])
+        print(input[["table2_DT_rows_selected"]])
 
         mt1 <- res_filter2$filtered()
         ds0 <- res_filter$filtered()
-- 
GitLab


From 248f95f775faa2844e1947d2183700828abdb094 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Fri, 18 Mar 2022 18:12:56 +0100
Subject: [PATCH 04/14] add normalization

---
 R/mod_Inputs.R | 144 +++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 121 insertions(+), 23 deletions(-)

diff --git a/R/mod_Inputs.R b/R/mod_Inputs.R
index ad059b9..0481153 100644
--- a/R/mod_Inputs.R
+++ b/R/mod_Inputs.R
@@ -70,7 +70,7 @@ mod_Inputs_ui <- function(id){
                       ),
                   box(title = "Input metadata dataset", status = "warning", solidHeader = TRUE, width=12,
                       actionButton(ns("launch_modal2"), "Metadata input module"),
-                      tags$h3("Use filters to subset on metadata:"),
+                      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")
@@ -82,10 +82,35 @@ mod_Inputs_ui <- function(id){
                           total = 100, display_pct = TRUE
                         ),
                         DT::dataTableOutput(outputId = ns("table2"))
-                      )                      
+                      ),                      
+                      tags$b("Outlier(s) selected:"),
+                      verbatimTextOutput(ns('x4'))
                     ),
-                  actionButton(ns("mergebutton"), "Merge tables..."),
-                  DT::dataTableOutput(outputId = ns("mergetable_DT"))
+
+                    box(title = "Normalization", status = "warning", solidHeader = TRUE, width = 3,
+                        # verbatimTextOutput(ns('x4bis')),
+                        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-ration)" = 2
+                          ), selected = "Raw"
+                        ),
+                        actionButton(ns("mergebutton"), "Merge features and metadata...")
+                      ),
+
+
+                    box(title = "Final dataset", status = "primary", solidHeader = TRUE, width = 9,
+                      DT::dataTableOutput(outputId = ns("mergetable_DT"))
+                      )
 
                 ),
 
@@ -416,9 +441,9 @@ mod_Inputs_server <- function(id, r = r, session = session){
         "}"
       )
 
-      output$table2 <- DT::renderDataTable({
+      output$table2 <- DT::renderDT({
         print(class(res_filter2$filtered()))
-        print(str(print(class(res_filter2$filtered()))))
+        print(str(res_filter2$filtered()))
         res_filter2$filtered()
       }, 
       options = list(
@@ -426,38 +451,111 @@ mod_Inputs_server <- function(id, r = r, session = session){
       # extensions = "Select", selection = "multiple"
       )
 
-      # outliers <- reactive({
-      #   r_values$outliers <- input[["table2_DT_rows_selected"]]
-      #   print("reactive outliers")
-      #   print(r_values$outliers)
-      #   r_values$outliers
-      # })
+      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")
+        }
+      })
 
-      # observe({
-      #   print(input[["table2_DT_rows_selected"]])
-      # })
+      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()
+        #Norm1
+        class1 <- sapply(metadata1, class)
+        r_values$norm1fact = names(metadata1)[class1 %in% "integer" | class1 %in% "numeric"]
+        updateSelectInput(session, "norm1fact1",
+                          choices = c("Raw", r_values$norm1fact),
+                          selected = names(r_values$metadata_final)[1])
+      })
+
+
       mergetable <- eventReactive(input$mergebutton, {
-        print("coucou")
-        print(input[["table2_DT_rows_selected"]])
+        metadata1 <- res_filter2$filtered()
+        row.names(metadata1) <- metadata1[,"sample.id"]
+        feat1 <- res_filter$filtered()
+
+        print("Outliers:")
+        outliers1 <- input[["table2_rows_selected"]]
+        samplenames_out <- metadata1[input[["table2_rows_selected"]], "sample.id"]
+        print(outliers1)
+        print(samplenames_out)
+
+        mt1 <- metadata1 %>% filter(!row_number() %in% outliers1)
+        print(mt1$sample.id)
+        ds0 <- feat1 %>% select(-samplenames_out)
+        print(colnames(ds0))
 
-        mt1 <- res_filter2$filtered()
-        ds0 <- res_filter$filtered()
 
-        save(list = ls(all.names = TRUE), file = "debug.rdata", envir = environment()); print("SAVE0")
 
         row.names(ds0) <- glue::glue("{ds0[,1]}__{ds0[,2]}__{ds0[,3]}")
+
+
+        cat(file=stderr(), 'PONDERATION', "\n")
+        
         class1 <- sapply(ds0, class)
-        ds1 <- t(ds0[,class1 == "numeric" | class1 == "integer"])
+        ds1 <- ds0[,class1 == "numeric" | class1 == "integer"]
+        print(colnames(ds1))
+        r_values$wgt1 <- input$norm1fact1
+        print(prev(ds1))
+        
+        if(input$norm1fact1 == "Raw"){
+          pondds1 <- ds1
+        }else{
+          fp1 = metadata1[colnames(ds1),input$norm1fact1]  # force same order between table
+          fp1[fp1 == 0] <- NA
+          pondds1 <- t(apply(ds1, 1, function(x){x/fp1}))
+        }
+        
+        print(prev(pondds1))
+        # r_values$pondds1 <- pondds1
+        
+        
+        cat(file=stderr(), 'NORMALIZATION', "\n")
+        ds1 <- pondds1
+        # print(head(ds1))
+        norm_names = c("Raw", "TSS", "CLR")
+        r_values$norm1 <- norm_names[as.numeric(input$norm_method)+1]
+        print(r_values$norm1)
+
+        if(input$norm_method == 0){
+          normds1 <- ds1
+        }
+        
+        if(input$norm_method == 1){
+          normf = function(x){ x/sum(x, na.rm = TRUE) }
+          # normds1 <- transform_sample_counts(ds1, normf)
+          normds1 <- apply(ds1, 2, normf)
+        }
+        
+        if(input$norm_method == 2){
+          clr = function(x){log(x+1) - rowMeans(log(x+1), na.rm = TRUE)}
+          normds1 <- clr(ds1)
+        }
+        # save(list = ls(all.names = TRUE), file = "debug.rdata", envir = environment()); print("SAVE0")
 
 
-        r_values$tabF = as.data.frame(ds1) %>% 
+        r_values$tabF = as.data.frame(t(normds1)) %>% 
         tibble::rownames_to_column(var = "sample.id") %>% 
-        dplyr::right_join(x = mt1, by = "sample.id")# %>% mutate_if(is.character,as.factor)
+        dplyr::right_join(x = mt1, by = "sample.id")  # %>% mutate_if(is.character,as.factor)
 
       })
 
-- 
GitLab


From 2d54150d9b7512684fe9609aa0921e692a6a9704 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Tue, 12 Apr 2022 17:54:59 +0200
Subject: [PATCH 05/14] update

---
 R/mod_Inputs.R | 34 ++++++++++++++++++++++++----------
 1 file changed, 24 insertions(+), 10 deletions(-)

diff --git a/R/mod_Inputs.R b/R/mod_Inputs.R
index 0481153..6ac2e05 100644
--- a/R/mod_Inputs.R
+++ b/R/mod_Inputs.R
@@ -37,7 +37,7 @@ mod_Inputs_ui <- function(id){
                  fluidRow(
                       column(
                         width = 12,
-                        actionButton(ns("launch_modal"), "Features table input module")#,
+                        actionButton(ns("launch_modal"), "Features table input module", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469")#,
                         # tags$b("Imported data:"),
                         # verbatimTextOutput(outputId = ns("name")),
                         # verbatimTextOutput(outputId = ns("data"))
@@ -69,7 +69,7 @@ mod_Inputs_ui <- function(id){
                         )
                       ),
                   box(title = "Input metadata dataset", status = "warning", solidHeader = TRUE, width=12,
-                      actionButton(ns("launch_modal2"), "Metadata input module"),
+                      actionButton(ns("launch_modal2"), "Metadata input module", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469"),
                       tags$h3("Use filters to subset on metadata, and click on rows you need to remove:"),
                       column(
                         width = 3,
@@ -104,7 +104,7 @@ mod_Inputs_ui <- function(id){
                             "CLR (center log-ration)" = 2
                           ), selected = "Raw"
                         ),
-                        actionButton(ns("mergebutton"), "Merge features and metadata...")
+                        actionButton(ns("mergebutton"), "Merge features and metadata...", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469")
                       ),
 
 
@@ -447,7 +447,7 @@ mod_Inputs_server <- function(id, r = r, session = session){
         res_filter2$filtered()
       }, 
       options = list(
-        pageLength = 6, scrollX = TRUE, server=TRUE, autoWidth = TRUE)#, , rowCallback = DT::JS(rowCallback)
+        pageLength = 6, scrollX = TRUE, server=TRUE, autoWidth = FALSE)#, , rowCallback = DT::JS(rowCallback)
       # extensions = "Select", selection = "multiple"
       )
 
@@ -513,9 +513,9 @@ mod_Inputs_server <- function(id, r = r, session = session){
         
         class1 <- sapply(ds0, class)
         ds1 <- ds0[,class1 == "numeric" | class1 == "integer"]
-        print(colnames(ds1))
+        # print(colnames(ds1))
         r_values$wgt1 <- input$norm1fact1
-        print(prev(ds1))
+        # print(prev(ds1))
         
         if(input$norm1fact1 == "Raw"){
           pondds1 <- ds1
@@ -552,11 +552,25 @@ mod_Inputs_server <- function(id, r = r, session = session){
         }
         # save(list = ls(all.names = TRUE), file = "debug.rdata", envir = environment()); print("SAVE0")
 
+        print("Final data")
 
-        r_values$tabF = as.data.frame(t(normds1)) %>% 
+        
+        r_values$subsetds_final <- Fdataset <- as.data.frame(t(normds1)) %>% 
         tibble::rownames_to_column(var = "sample.id") %>% 
         dplyr::right_join(x = mt1, by = "sample.id")  # %>% mutate_if(is.character,as.factor)
 
+        # 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))
+
+        Fdataset
+
       })
 
 
@@ -851,11 +865,11 @@ mod_Inputs_server <- function(id, r = r, session = session){
   
     # Settings   
     observe({
-      req(metadata1())
+      req(res_filter2$filtered())  # metadata1()
       
       #Norm1
-      class1 <- sapply(metadata1(), class)
-      r_values$norm1fact = names(metadata1())[class1 %in% "integer" | class1 %in% "numeric"]
+      class1 <- sapply(res_filter2$filtered(), class)
+      r_values$norm1fact = names(res_filter2$filtered())[class1 %in% "integer" | class1 %in% "numeric"]
       updateSelectInput(session, "norm1fact1",
                         choices = c("Raw", r_values$norm1fact),
                         selected = names(r_values$metadata_final)[1])
-- 
GitLab


From 93f172b81e71f6a9fed60f997887f70ffc6df339 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Wed, 13 Apr 2022 16:39:20 +0200
Subject: [PATCH 06/14] modularizing

---
 R/app_server.R                      |   7 +-
 R/app_ui.R                          |  33 +-
 R/mod_acp.R                         | 303 ++++++++++++++++++
 R/mod_boxplots.R                    | 357 +++++++++++++++++++++
 R/{mod_Inputs.R => mod_easystats.R} |   8 +-
 R/mod_inputs.R                      | 473 ++++++++++++++++++++++++++++
 inst/app/www/style.css              |  16 +
 tests/testthat.R                    |   4 +-
 8 files changed, 1178 insertions(+), 23 deletions(-)
 create mode 100644 R/mod_acp.R
 create mode 100644 R/mod_boxplots.R
 rename R/{mod_Inputs.R => mod_easystats.R} (99%)
 create mode 100644 R/mod_inputs.R
 create mode 100644 inst/app/www/style.css

diff --git a/R/app_server.R b/R/app_server.R
index 68fd984..028bf5c 100644
--- a/R/app_server.R
+++ b/R/app_server.R
@@ -18,8 +18,9 @@ app_server <- function( input, output, session ) {
   
   
   # List the first level callModules here
-  # callModule(mod_Inputs_server, "Inputs_ui_1", session=session, r = r)
-  mod_Inputs_server("Inputs_ui_1")
-  # mod_idmschoice_server("idmschoice_ui_1")
+  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)
   
 }
diff --git a/R/app_ui.R b/R/app_ui.R
index 8db16ae..cd143db 100644
--- a/R/app_ui.R
+++ b/R/app_ui.R
@@ -25,23 +25,28 @@ app_ui <- function(request) {
                   
                   dashboardSidebar(
                     sidebarMenu(
-                      id="tabs",
-                      style = "position: fixed; overflow: visible",
-                      menuItem("Easy Stats", tabName= 'easystats', icon=icon("diagnoses"))#,
-                      # menuItem("IDMS choice", tabName= 'idmschoice', icon=icon("diagnoses"))
-                      # menuItem("Community Composition", tabName = "tab_compo", icon = icon("chart-pie"))
+                      # id="tabs",
+                      menuItem("Easy Stats", tabName= 'easystats-tab', icon=icon("diagnoses"),
+                          startExpanded = TRUE,
+                          menuSubItem('Input data', tabName = 'inputs-tab'),
+                          menuSubItem('ACP', tabName = 'acp-tab'),
+                          menuSubItem('Boxplots', tabName = 'boxplot-tab')
+                          )
                     )
                   ),
                   
                   dashboardBody(
-                    
-                    tabItems(
-                      tabItem(tabName = 'easystats',
-                              mod_Inputs_ui("Inputs_ui_1")
-                      )#,
-                      # tabItem(tabName = 'idmschoice',
-                      #         mod_idmschoice_ui("idmschoice_ui_1")
-                      # )
+                    tags$head(includeCSS('inst/app/www/style.css')),
+                    tabItems(                               
+                      tabItem(tabName = 'inputs-tab',
+                              mod_inputs_ui("inputs_1")
+                      ),
+                      tabItem(tabName = 'acp-tab',
+                              mod_acp_ui("acp_1")
+                      ),
+                      tabItem(tabName = 'boxplot-tab',
+                              mod_boxplots_ui("boxplots_1")
+                      )
                     )
                   )
                   
@@ -72,7 +77,7 @@ golem_add_external_resources <- function(){
     ),
     # Add here other external resources
     # for example, you can add shinyalert::useShinyalert()
-    shinyalert::useShinyalert()
+    # shinyalert::useShinyalert()
   )
 }
 
diff --git a/R/mod_acp.R b/R/mod_acp.R
new file mode 100644
index 0000000..b6fe248
--- /dev/null
+++ b/R/mod_acp.R
@@ -0,0 +1,303 @@
+#' acp UI Function
+#'
+#' @description A shiny Module.
+#'
+#' @param id,input,output,session Internal parameters for {shiny}.
+#'
+#' @noRd 
+#'
+#' @importFrom shiny NS tagList 
+mod_acp_ui <- function(id){
+  ns <- NS(id)
+  tagList(
+
+    fluidPage(
+
+       fluidRow(
+         box(title = "PCA options:", width = 6, status = "warning", solidHeader = TRUE,
+             radioButtons(
+               ns("naomit_method"),
+               label = "Missing values (drop lines or columns with NA) : ",
+               inline = TRUE,
+               choices = list(
+                 "Samples based" = 0 ,
+                 "Features based" = 1
+               ), selected = 0
+             ),
+             actionButton(ns("go2"), "Run ACP", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469"),
+             verbatimTextOutput(ns("naomitval"))
+         ),
+         box(title = "Plot Settings:", width = 6, status = "warning", solidHeader = TRUE,
+             # uiOutput(ns("factor1")),
+             selectInput(
+               ns("fact1"),
+               label = "Factor to color samples in PCA:",
+               choices = ""
+             ),
+             fluidRow(
+               column(3,
+                      selectInput(ns("pc1"),
+                                  label = "Component on X axis:",
+                                  choices = "")), 
+               column(3,
+                      selectInput(ns("pc2"),
+                                  label = "Component on Y axis:",
+                                  choices = ""))
+             ),
+             actionButton(ns("go1"), "Plot ACP", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469")
+         )
+       ),
+       fluidRow(box(width = 6, 
+                    title = 'ACP plot individuals', status = "primary", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
+                    plotlyOutput(ns("acpplot"), height = "500"),
+                    downloadButton(outputId = ns("acpplot_download"), label = "Download html plot")
+                    ),
+                box(width = 6, 
+                    title = 'ACP plot variables', status = "primary", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
+                    plotOutput(ns("acpplotvar"), height = "500"),
+                    downloadButton(outputId = ns("acpplotvar_download"), label = "Download plot")
+                    )
+                ),
+       fluidRow(box(width = 12, 
+                    title = 'Individuals Coordinates:', status = "primary", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
+                    DT::dataTableOutput(ns("prevacp1")),
+                    downloadButton(outputId = ns("acpind_download"), label = "Download table")
+                    )
+       ),
+       fluidRow(box(width = 12, 
+                    title = 'Variables Coordinates:', status = "primary", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
+                    DT::dataTableOutput(ns("prevacp1var")),
+                    downloadButton(outputId = ns("acpvar_download"), label = "Download table")
+                    )
+       )
+
+      )
+ 
+  )
+}
+    
+#' acp Server Functions
+#'
+#' @noRd 
+mod_acp_server <- function(id, r = r, session = session){
+  moduleServer( id, function(input, output, session){
+    ns <- session$ns
+    r_values <- reactiveValues()
+
+    ### ACP tab
+  
+    # Settings   
+    observe({
+      req(r$mt1()) #r$mt1())  # metadata1()
+      metadata1 <- r$mt1() #r$mt1()
+      if(!is.null(metadata1)){
+
+        #ACP
+        updateSelectInput(session, "fact1",
+                          choices = names(metadata1),
+                          selected = names(metadata1)[1])
+        updateSelectInput(session, "pc1",
+                          choices = colnames(acp1()$x)[1:10],
+                          selected = colnames(acp1()$x)[1])
+        updateSelectInput(session, "pc2",
+                          choices = colnames(acp1()$x)[1:10],
+                          selected = colnames(acp1()$x)[2])
+
+      }
+
+    })
+    
+    ### ACP 
+    observeEvent({input$go1
+                 input$go2}, {
+      if(!isTruthy(r$ds1())){ #r_values$features_final
+        cat(file=stderr(), 'ACP1 no table... ', "\n")
+        shinyalert(title = "Oops", text="Final table not available, check all steps.", type='error')
+      }
+                   
+    })
+    
+    acp1 <- eventReactive(input$go2, {
+      cat(file=stderr(), 'ACP1 ... ', "\n")
+      req(r$ds1())  # r_values$metadata_final # r_values$features_final , r_values$mt1
+      ds1 <- r_values$features_final <- r$ds1()
+      # browser()
+
+      # print(head(normds1()))
+      # print(str(normds1()))
+      if(input$naomit_method == 0){
+      acp_input <- na.omit(r_values$features_final)
+      r_values$snaomit <- setdiff(row.names(r_values$features_final),row.names(acp_input))
+      r_values$snaomit_att <- "sample(s)"
+      r_values$snaomit_ndim <- nrow(r_values$features_final)
+      }
+      
+      if(input$naomit_method == 1){
+        Tfeat0 =t(r_values$features_final)
+        allNA_index = apply(Tfeat0,2,function(x){all(is.na(x))})
+        Tfeat = Tfeat0[,!allNA_index]
+
+        Tfeat_ok <- na.omit(Tfeat)
+        acp_input <- t(Tfeat_ok)
+        r_values$snaomit <- setdiff(row.names(Tfeat),row.names(Tfeat_ok))
+        r_values$snaomit_att <- "feature(s)"
+        r_values$snaomit_ndim <- ncol(r_values$features_final)
+      }
+      
+      if(nrow(acp_input) == 0){
+        print("Empty table")
+        showNotification("Empty table for ACP ...", type="error", duration = 5)
+        return()
+      }
+      
+      # Simplify features names
+      tt <- stringr::str_split(colnames(acp_input), "__")
+      tt1 <- sapply(tt,"[[",1)
+      if(length(unique(tt1) ) == length(tt1)){
+        colnames(acp_input) = tt1
+        print(head(acp_input))
+        
+        # Check SD
+        sds = apply(acp_input, 2, sd, na.rm=TRUE)
+        keepsds = which(sds > 0)
+          cat(file=stderr(), 'Delete variables with sd = 0 ... ', "\n")
+          print(which(sds==0))
+          Facp_input <- acp_input[,keepsds]
+          
+        acp1 = stats::prcomp(Facp_input, scale. = TRUE)  #t(normds1()[,-1])
+        r_values$acp1 <- acp1
+        
+        r_values$summary_acp <- summary(acp1)
+        
+        # print(colnames(r_values$acp1$x))
+        acp1
+        
+      }else{print("NON UNIQUE FEATURES in table.")
+        shinyalert(title = "Oops", text="Non unique features in table, consider filtering on metadata.", type='error')
+        acp1 = NULL
+      }
+      
+      acp1
+    })
+    
+    # Print samples or features with missing values
+    output$naomitval <- renderPrint({
+      req(r_values$snaomit,r_values$snaomit_att)
+      cat(file = stderr(), 'missing values', "\n")
+        list1 <- glue_collapse(r_values$snaomit, ", ")
+        glue::glue("Following {r_values$snaomit_att} were omitted for PCA ({length(r_values$snaomit)}/{r_values$snaomit_ndim}):\n{list1}")
+     })
+    
+    # Generate ACP Table
+    acptab <- eventReactive(input$go2, {
+      req(acp1()$x, r$mt1())
+      r_values$metadata_final <- r$mt1()
+      cat(file=stderr(), 'ACP tab ... ', "\n")
+      acptab= as.data.frame(acp1()$x) %>% tibble::rownames_to_column(var = "sample.id") %>% 
+        dplyr::inner_join(x = r_values$metadata_final, by = "sample.id")
+      acptab
+
+    })
+    
+    output$prevacp1 <- DT::renderDataTable({
+      cat(file=stderr(), 'ACP table', "\n")
+      acptab()
+    }, filter="top",options = list(pageLength = 5, scrollX = TRUE, server=TRUE))  # , rowCallback = DT::JS(rowCallback))
+    
+    output$acpind_download <- downloadHandler(
+      filename = "acpind_table.csv",
+      content = function(file) {
+        req(acptab())
+        write.table(acptab(), file, sep="\t", row.names=FALSE)
+      }
+    )
+    
+    
+    ## Table var
+    acptabvar <- eventReactive(input$go2, {
+      cat(file=stderr(), 'ACP tab var... ', "\n")
+      acptabvar = factoextra::get_pca_var(acp1())$coord %>% as.data.frame() %>% tibble::rownames_to_column(var = "features") 
+      acptabvar
+    })
+  
+    output$prevacp1var <- DT::renderDataTable({
+      cat(file=stderr(), 'ACP table variables', "\n")
+      acptabvar()
+    }, filter="top",options = list(pageLength = 5, scrollX = TRUE, server=TRUE))  # , rowCallback = DT::JS(rowCallback))
+    
+    output$acpvar_download <- downloadHandler(
+      filename = "acpvar_table.csv",
+      content = function(file) {
+        req(acptabvar())
+        write.table(acptabvar(), file, sep="\t", row.names=FALSE)
+      }
+    )
+    
+    # Acp PLOT
+    acpplot <- eventReactive(input$go1, {
+      req(input$fact1, acptab(), input$pc1, input$pc2)
+    # acpplot <- reactive({
+      cat(file=stderr(), 'ACP plot', "\n")
+      showNotification("Processing visualization...", type="message", duration = 2)
+      print(input$fact1)
+      
+      pc1 = as.numeric(substring(input$pc1, 3, 10))
+      pc2 = as.numeric(substring(input$pc2, 3, 10))
+      
+      p = ggplot(acptab(), aes_string(x = input$pc1, y =
+                                        input$pc2, color = input$fact1, sampleID = "sample.id")) + 
+        geom_point() + stat_ellipse(aes_string(x = input$pc1, y = input$pc2, color = input$fact1), inherit.aes = FALSE) + theme_bw() + 
+        xlab(glue::glue("{input$pc1} ({round(r_values$summary_acp$importance[2,pc1]*100,1)}%)")) + ylab(glue::glue("{input$pc2} ({round(r_values$summary_acp$importance[2,pc2]*100,1)}%)"))
+      
+      ggplotly(p, tooltip=c("x", "y", "sampleID"))
+    })
+      
+    output$acpplot <- renderPlotly({
+      req(acpplot())
+      acpplot() %>% config(toImageButtonOptions = list(format = "svg"))
+    })
+    
+    output$acpplot_download <- downloadHandler(
+      filename = "ACP_plot.html",
+      content = function(file) {
+        req(acpplot())
+        saveWidget(acpplot(), file= file)
+      }
+    )
+    
+    
+    acpplotvar <- eventReactive(input$go1, {
+      req(acp1(), input$pc1, input$pc2)
+      pc1 = as.numeric(substring(input$pc1, 3, 10))
+      pc2 = as.numeric(substring(input$pc2, 3, 10))
+      print(c(pc1, pc2))
+      plotvar  <- factoextra::fviz_pca_var(acp1(), repel = TRUE, axes = c(pc1, pc2))
+      print(class(plotvar))
+      plotvar
+    })
+    
+    output$acpplotvar <- renderPlot({
+      req(acpplotvar())
+      acpplotvar()
+    })
+    
+    output$acpplotvar_download <- downloadHandler(
+      filename = "acp_plotvar.pdf",
+      content = function(file) {
+        req(acpplotvar())
+        p <- acpplotvar()
+        ggsave(file, p, units = "cm", width = 15, height = 15, dpi = 300)
+      }
+    )
+
+
+
+ 
+  })
+}
+    
+## To be copied in the UI
+# mod_acp_ui("acp_1")
+    
+## To be copied in the server
+# mod_acp_server("acp_1")
diff --git a/R/mod_boxplots.R b/R/mod_boxplots.R
new file mode 100644
index 0000000..cebac41
--- /dev/null
+++ b/R/mod_boxplots.R
@@ -0,0 +1,357 @@
+#' boxplots UI Function
+#'
+#' @description A shiny Module.
+#'
+#' @param id,input,output,session Internal parameters for {shiny}.
+#'
+#' @noRd 
+#'
+#' @importFrom shiny NS tagList 
+mod_boxplots_ui <- function(id){
+  ns <- NS(id)
+  tagList(
+    fluidPage(
+
+      fluidRow(
+        box(title = "Plot Settings:", width = 7, status = "warning", solidHeader = TRUE,
+            pickerInput(
+              ns("fact3"),
+              label = "Factor to plot with in boxplot:",
+              choices = "",
+              multiple = TRUE
+            ),
+            selectInput(
+              ns("feat1"),
+              label = "Feature to plot in boxplot:",
+              choices = ""
+            ),
+            selectInput(
+              ns("nbPicPage"),
+              label = "Select number of plot per pdf page (max 4 per page):",
+              choices = c(1:4), selected = 1
+            ),
+            materialSwitch(ns("plotall"), label = "Plot all conditions (even NAs)", value = TRUE, status = "primary"),
+            actionButton(ns("go4"), "Just plot", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469"),
+            actionButton(ns("go3"), "Run plot/stats & tests", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469"),
+            downloadButton(outputId = ns("boxplots_download"), label = "Download all plots (long process)")
+        )
+      ),
+      # fluidRow(
+      #   box(title = "Boxplot:", width = 12, status = "warning", solidHeader = TRUE,
+      #       plotOutput(ns("boxplot_out"), height = "500")
+      #   )
+      # ),
+      fluidRow(
+        box(width = 12, 
+            title = 'Boxplot:', status = "warning", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
+            plotlyOutput(ns("boxplotly1"), height = "500")
+        )
+      ),
+      fluidRow(box(width = 12, 
+                   title = 'Boxplot sumary stats:', status = "primary", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
+                   DT::dataTableOutput(ns("summaryBP")),
+                   downloadButton(outputId = ns("summaryBP_download"), label = "Download table")
+      )),
+      fluidRow(box(width = 12, 
+                   title = 'Pairwise Wilcox tests:', status = "primary", solidHeader = TRUE, collapsible = TRUE, collapsed = FALSE,
+                   DT::dataTableOutput(ns("wilcoxBP")),
+                   downloadButton(outputId = ns("wilcoxBP_download"), label = "Download table")
+                   
+      ))
+
+    )
+ 
+  )
+}
+    
+#' boxplots Server Functions
+#'
+#' @noRd 
+mod_boxplots_server <- function(id, r = r, session = session){
+  moduleServer( id, function(input, output, session){
+    ns <- session$ns
+    r_values <- reactiveValues()
+
+    ###BOXPLOT
+    
+    observeEvent(input$go3, {
+      if(!isTruthy(r$fdata_melt())){ #r_values$features_final
+        cat(file=stderr(), 'Boxplot no table... ', "\n")
+        shinyalert(title = "Oops", text="Final table not available, check all steps.", type='error')
+      }
+    })
+    
+    # Settings   
+    observe({
+      # req(metadata1(), r_values$subsetds_final_melt)
+      req(r$mt1(), r$fdata_melt())
+      r_values$subsetds_final_melt <- r$fdata_melt()
+      r_values$metadata_final <- r$mt1()
+      updateSelectInput(session, "feat1",
+                        choices = unique(r_values$subsetds_final_melt[,"features"]),
+                        selected = unique(r_values$subsetds_final_melt[,"features"])[1])
+      updateSelectInput(session, "fact2",
+                        choices = names(r_values$metadata_final),
+                        selected = names(r_values$metadata_final)[2])
+      updatePickerInput(session, "fact3",
+                        choices = names(r_values$metadata_final),
+                        selected = names(r_values$metadata_final)[2],
+                        options = list(
+                          `actions-box` = TRUE, 
+                          size = 10,
+                          `selected-text-format` = "count > 3"
+                        )
+      )
+    })
+
+    
+    
+    boxplot1 <- eventReactive(c(input$go3, input$go4), {
+      cat(file=stderr(), 'BOXPLOT', "\n")
+      req(r_values$subsetds_final_melt, input$fact3, r$ds1())
+      r_values$tabF_melt2 <- tabF_melt2 <- tabF_melt <- r_values$subsetds_final_melt
+      if(length(input$fact3) == 1){r_values$fact3ok <- fact3ok <- input$fact3
+        }else{
+          comb = glue::glue_collapse(input$fact3, sep = ', \"_\",')
+          fun = glue::glue('tabF_melt2 <- tabF_melt %>% dplyr::mutate(newfact = paste0({comb}), .after= "sample.id")')
+          eval(parse(text=fun))
+          r_values$fact3ok <- fact3ok <- "newfact"
+          r_values$tabF_melt2 <- tabF_melt2
+        }
+      print(head(r_values$tabF_melt2))
+      print(r_values$fact3ok)
+      
+      ytitle <- glue::glue("{as.character(r$ds1()[input$feat1,3])}")
+      if(r$wgt1() != "Raw"){
+        ytitle <- glue::glue("{ytitle}, weight: {r$wgt1()}")
+      }
+      if(r$norm1() != "Raw"){
+        ytitle <- glue::glue("{ytitle}, norm.: {r$norm1()}")
+      }
+      
+      fun <-  glue::glue('tabfeat = tabF_melt2[tabF_melt2$features == input$feat1,] %>% 
+        group_by({fact3ok}) %>% 
+        mutate(outlier=ifelse(is_outlier(value), as.character(sample.id), NA))')
+      eval(parse(text=fun))
+
+      if(!input$plotall){
+        tabfeat <- tabfeat %>% filter(!is.na(value))
+      }
+
+     fun <-  glue::glue('p <- ggplot(tabfeat, aes(x = {fact3ok}, y = value)) + 
+        geom_boxplot(fill = "#99AFE3") + theme_bw() + xlab("Condition") + ylab(ytitle) + ggtitle(input$feat1) +
+        theme(legend.position = "None", axis.text.x = element_text(angle = 45, hjust=1))')
+      eval(parse(text=fun))
+      ggly <- ggplotly(p)
+      
+      # # Hoverinfo BUG
+      # tabfeat$sample.id <- as.character(tabfeat$sample.id)
+      # hoverinfo <- with(tabfeat, paste0("sample: ", sample.id, "</br></br>", 
+      #                                 "value: ", value))
+      # ggly$x$data[[1]]$text <- hoverinfo
+      # ggly$x$data[[1]]$hoverinfo <- c("text", "boxes")
+      
+      
+      cat(file=stderr(), 'BOXPLOT done', "\n")
+      
+      outlist = list()
+      outlist$p <- p
+      outlist$tabF_melt2 <- tabF_melt2
+      outlist$fact3ok <- fact3ok
+      outlist$ggly <- ggly
+
+      outlist
+    })
+    
+    # output$boxplot_out <- renderPlot({
+    #   req(boxplot1())
+    #   bp1 <- boxplot1()
+    #   
+    #   bp1$p
+    # })
+    
+    output$boxplotly1 <- renderPlotly({
+      req(boxplot1())
+      bp1 <- boxplot1()
+      ggplotly(bp1$ggly)
+    })
+    
+    # Export all figures
+    
+    pdfall <- reactive({
+      cat(file=stderr(), 'ALL BOXPLOT', "\n")
+      req(r_values$tabF_melt2, r_values$fact3ok)
+
+        fact3ok <- r_values$fact3ok
+        tabF_melt2 <- r_values$tabF_melt2
+        tabF_melt2$sample.id <- as.character(tabF_melt2$sample.id)
+        listP <- list()
+        FEAT = levels(tabF_melt2$features)
+        print(head(FEAT))
+
+        for(i in 1:length(FEAT)){
+          
+          tt <- stringr::str_split(FEAT[i], "__")
+          print(tt)
+          ytitle <- sapply(tt,"[[",2)
+          print(ytitle)
+          if(r$wgt1() != "Raw"){
+            ytitle <- glue::glue("{ytitle}, weight: {r$wgt1()}")
+          }
+          if(r$norm1() != "Raw"){
+            ytitle <- glue::glue("{ytitle}, norm.: {r$norm1()}")
+          }
+          
+          fun <-  glue::glue('tabfeat = tabF_melt2[tabF_melt2$features == FEAT[i],] %>% 
+                  group_by({fact3ok}) %>% 
+                  mutate(outlier=ifelse(is_outlier(value), sample.id, NA))')
+          eval(parse(text=fun))
+
+           if(!input$plotall){
+              tabfeat <- tabfeat %>% filter(!is.na(value))
+            }
+
+          if(nrow(tabfeat) == 0){print("no data"); next}
+          
+          fun <-  glue::glue('listP[[FEAT[i]]] <- ggplot(tabfeat, aes(x = {fact3ok}, y = value)) + 
+        geom_boxplot(fill = "#99AFE3") + theme_bw() + xlab("Condition") + ylab(ytitle) + ggtitle(FEAT[i]) +
+        theme(legend.position = "None", axis.text.x = element_text(angle = 45, hjust=1)) + 
+        ggrepel::geom_text_repel(aes(label = outlier), na.rm = TRUE, show.legend = F, 
+                             direction = "both",
+                             nudge_x = 0.1,
+                             size= 3
+                             )')
+          eval(parse(text=fun))
+          
+          print(length(listP))
+        }
+      
+      print(length(listP))
+      
+      listP
+    })
+    
+    output$boxplots_download <- downloadHandler(
+      filename = "figures.pdf",
+      content = function(file) {
+        print('DOWNLOAD ALL')
+        req(pdfall())
+        p <- pdfall()
+        print('pdf output')
+        
+        withProgress({
+          if(as.numeric(input$nbPicPage) < 4){
+            ml <- marrangeGrob(p, nrow= 1, ncol=as.numeric(input$nbPicPage))
+          }else{
+            ml <- marrangeGrob(p, nrow=2, ncol=2)
+          }
+          
+          ggsave(file, ml, units = "cm", width = 20, height = 15, dpi = 300)
+        }, message = "Prepare pdf file... please wait.")
+
+        
+      }
+    )
+    
+    
+    
+    summaryBP <- eventReactive(input$go3, {
+      cat(file=stderr(), 'BOXPLOT summary', "\n")
+      req(boxplot1())
+      
+      
+      
+      q = c(.25, .5, .75)
+      boxstat <- data.frame()
+      #calculate quantiles by grouping variable
+      Amelt <- boxplot1()$tabF_melt2
+      print(head(Amelt))
+      for(i in unique(Amelt$features)){
+        boxstat1 <- Amelt[Amelt$features == i,] %>%
+          filter(!is.na(value)) %>%
+          group_by(.dots = boxplot1()$fact3ok) %>%
+          summarize(min = min(value),
+                    quant25 = quantile(value, probs = q[1]),
+                    median = quantile(value, probs = q[2]),
+                    quant75 = quantile(value, probs = q[3]),
+                    max = max(value),
+                    mean = mean(value),
+                    sd = sd(value)) %>% 
+          add_column(Features = i, .after = 0) %>% mutate_if(is.character,as.factor)
+        
+        boxstat <- rbind(boxstat, boxstat1)
+      }
+      cat(file=stderr(), 'BOXPLOT summary done', "\n")
+      print(head(boxstat))
+      
+      as.data.frame(boxstat)
+    })
+    
+    output$summaryBP <- DT::renderDataTable({
+      cat(file=stderr(), 'SummaryBP DT', "\n")
+      summaryBP()
+    }, filter="top",options = list(pageLength = 5, scrollX = TRUE, server=TRUE)) # , rowCallback = DT::JS(rowCallback)) 
+    
+    output$summaryBP_download <- downloadHandler(
+      filename = "summary-boxplot_table.csv",
+      content = function(file) {
+        req(summaryBP())
+        write.table(summaryBP(), file, sep="\t", row.names=FALSE)
+      }
+    )
+ 
+    #wilcoxBP
+    wilcoxBP <- eventReactive(input$go3, {
+      cat(file=stderr(), 'wilcoxBP table', "\n")
+      req(boxplot1())
+      
+      Amelt <- boxplot1()$tabF_melt2
+      
+      pval_table <- data.frame()
+      for(feat1 in unique(Amelt$features)){
+        Ftabtest = Amelt[Amelt$features == feat1,] %>%
+          filter(!is.na(value)) 
+        if(nrow(Ftabtest)==0){next}
+        if(length(which(table(Ftabtest[Ftabtest$features == feat1,boxplot1()$fact3ok]) >= 3)) < 2){next} # si moins de 2 groupes avec au moins 3 repetitions next.
+        print(feat1)
+        print(table(Ftabtest[Ftabtest$features == feat1,boxplot1()$fact3ok]))
+        wcoxtab = pairwise.wilcox.test(Ftabtest[Ftabtest$features == feat1,"value"], as.factor(Ftabtest[,boxplot1()$fact3ok]),
+                                       p.adjust.method = "none")
+        
+        ftable1 <- as.data.frame(wcoxtab$p.value) %>%
+          rownames_to_column() %>% pivot_longer(!rowname, names_to = "condition", values_to = "pvalue") %>%
+          na.omit() %>% add_column(Features = feat1, .after = 0)
+        
+        pval_table <- rbind.data.frame(pval_table, ftable1)
+      }
+      colnames(pval_table) = c("Features", "Condition1", "Condition2", "pvalue")
+      
+      Fpvaltable <- pval_table %>% mutate(adjusted_pval = p.adjust(pvalue, method = "fdr")) %>% mutate_if(is.character,as.factor) 
+      print(dim(Fpvaltable))
+      cat(file=stderr(), 'wilcoxBP table done', "\n")
+      
+      Fpvaltable
+    })
+    
+    output$wilcoxBP <- DT::renderDataTable({
+      cat(file=stderr(), 'wilcoxBP DT', "\n")
+      wilcoxBP()
+    }, filter="top",options = list(pageLength = 5, scrollX = TRUE, server=TRUE)) # , rowCallback = DT::JS(rowCallback)) 
+    
+    output$wilcoxBP_download <- downloadHandler(
+      filename = "wilcoxtests_table.csv",
+      content = function(file) {
+        req(wilcoxBP())
+        write.table(wilcoxBP(), file, sep="\t", row.names=FALSE)
+      }
+    )
+      
+ 
+  })
+}
+    
+## To be copied in the UI
+# mod_boxplots_ui("boxplots_1")
+    
+## To be copied in the server
+# mod_boxplots_server("boxplots_1")
diff --git a/R/mod_Inputs.R b/R/mod_easystats.R
similarity index 99%
rename from R/mod_Inputs.R
rename to R/mod_easystats.R
index 6ac2e05..f92c2d5 100644
--- a/R/mod_Inputs.R
+++ b/R/mod_easystats.R
@@ -27,7 +27,7 @@
 #' @import DT
 #' @import datamods
 
-mod_Inputs_ui <- function(id){
+mod_easystats_ui <- function(id){
   ns <- NS(id)
   tagList(
     fluidPage(
@@ -298,7 +298,7 @@ mod_Inputs_ui <- function(id){
 #' Inputs Server Functions
 #'
 #' @noRd 
-mod_Inputs_server <- function(id, r = r, session = session){
+mod_easystats_server <- function(id, r = r, session = session){
   moduleServer( id, function(input, output, session){
     ns <- session$ns
     r_values <- reactiveValues(ds1=NULL, mt1=NULL)
@@ -1341,7 +1341,7 @@ mod_Inputs_server <- function(id, r = r, session = session){
 }
     
 ## To be copied in the UI
-# mod_Inputs_ui("Inputs_ui_1")
+# mod_easystats_ui("Inputs_ui_1")
     
 ## To be copied in the server
-# mod_Inputs_server("Inputs_ui_1")
+# mod_easystats_server("Inputs_ui_1")
diff --git a/R/mod_inputs.R b/R/mod_inputs.R
new file mode 100644
index 0000000..bef5412
--- /dev/null
+++ b/R/mod_inputs.R
@@ -0,0 +1,473 @@
+#' inputs UI Function
+#'
+#' @description A shiny Module.
+#'
+#' @param id,input,output,session Internal parameters for {shiny}.
+#'
+#' @noRd 
+#'
+#' @importFrom shiny NS tagList
+#' @import tibble 
+#' @import dplyr
+#' @import tidyr
+#' @importFrom gridExtra marrangeGrob
+#' @importFrom plotly plotlyOutput
+#' @importFrom plotly renderPlotly
+#' @importFrom plotly ggplotly
+#' @importFrom plotly config
+#' @importFrom factoextra fviz_pca_var
+#' @importFrom factoextra get_pca_var
+#' @importFrom glue glue_collapse
+#' @importFrom glue glue
+#' @importFrom reshape2 melt
+#' @importFrom shinyalert shinyalert
+#' @importFrom ggrepel geom_text_repel
+#' @import shinyWidgets
+#' @import ggplot2
+#' @import DT
+#' @import datamods
+
+mod_inputs_ui <- function(id){
+  ns <- NS(id)
+  tagList(
+    fluidPage(
+
+      box(title = "Input features dataset", 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")#,
+                # tags$b("Imported data:"),
+                # verbatimTextOutput(outputId = ns("name")),
+                # verbatimTextOutput(outputId = ns("data"))
+              )
+            ),
+              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")),
+                    # tags$b("Code dplyr:"),
+                    # verbatimTextOutput(outputId = ns("code_dplyr")),
+                    # tags$b("Expression:"),
+                    # verbatimTextOutput(outputId = ns("code")),
+                    # tags$b("Filtered data:"),
+                    # verbatimTextOutput(outputId = ns("res_str"))
+                    tags$b("Outliers:"),
+                    verbatimTextOutput(outputId = ns("outliers"))
+                  )
+                )
+              ),
+          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"),
+              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("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-ration)" = 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")
+              )
+
+      )
+ 
+  )
+}
+    
+#' inputs Server Functions
+#'
+#' @noRd 
+mod_inputs_server <- function(id, r = r, session = session){
+  moduleServer( id, function(input, output, session){
+
+    ns <- session$ns
+    r_values <- reactiveValues(subsetds_final = NULL, metadata_final = NULL, features_final = NULL, subsetds_final_melt = NULL)
+    imported <- NULL
+
+
+    # Input dataset dev 
+
+    observeEvent(input$launch_modal, {
+      import_modal(
+        id = ns("myid"),
+        from = c("file", "env", "copypaste", "googlesheets", "url"),
+        title = "Import data to be used in application"
+      )
+    })
+
+    imported <- import_server("myid", return_class = "data.frame")
+
+    # output$name <- renderPrint({
+    #   req(imported$name())
+    #   imported$name()
+    # })
+
+    # output$data <- renderPrint({
+    #   req(imported$data())
+    #   as.tibble(imported$data())
+    # })
+
+
+    # Filters dev
+
+
+      data <- reactive({
+        imported$data()
+        
+        # dev
+        # read.csv("~/repository/graphstatsr/data_test/metabo_all_data_special.csv", sep ="\t")
+      })
+
+      # output$datainput <- renderPrint({
+      #   # imported$data()[1:10,1:10]
+      #   data()[1:10,]
+      # })
+
+      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$table <- DT::renderDT({
+        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())
+      })
+
+
+    # Input metadata dev 
+
+    observeEvent(input$launch_modal2, {
+      import_modal(
+        id = ns("myid2"),
+        from = c("file", "env", "copypaste", "googlesheets", "url"),
+        title = "Import data to be used in application"
+      )
+    })
+
+    imported2 <- import_server("myid2", return_class = "data.frame")
+
+    # output$name <- renderPrint({
+    #   req(imported$name())
+    #   imported$name()
+    # })
+
+    # output$data <- renderPrint({
+    #   req(imported$data())
+    #   as.tibble(imported$data())
+    # })
+
+
+    # Filters metadata dev
+
+
+      data2 <- reactive({
+        imported2$data()
+        
+        # dev
+        # read.csv("~/repository/graphstatsr/data_test/metadata_metabo.csv", sep ="\t")
+      })
+
+      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()
+        #Norm1
+        class1 <- sapply(metadata1, class)
+        r_values$norm1fact = names(metadata1)[class1 %in% "integer" | class1 %in% "numeric"]
+        updateSelectInput(session, "norm1fact1",
+                          choices = c("Raw", r_values$norm1fact),
+                          selected = names(r_values$metadata_final)[1])
+      })
+
+
+      mergetable <- eventReactive(input$mergebutton, {
+        metadata1 <- res_filter2$filtered()
+        row.names(metadata1) <- metadata1[,"sample.id"]
+        feat1 <- res_filter$filtered()
+
+        print("Outliers:")
+        outliers1 <- input[["table2_rows_selected"]]
+        samplenames_out <- metadata1[input[["table2_rows_selected"]], "sample.id"]
+        print(outliers1)
+        print(samplenames_out)
+
+        mt1 <- metadata1 %>% filter(!row_number() %in% outliers1)
+        print(mt1$sample.id)
+        ds0 <- feat1 %>% select(-samplenames_out)
+        print(colnames(ds0))
+
+
+
+        row.names(ds0) <- glue::glue("{ds0[,1]}__{ds0[,2]}__{ds0[,3]}")
+
+
+        cat(file=stderr(), 'PONDERATION', "\n")
+        
+        class1 <- sapply(ds0, class)
+        ds1 <- ds0[,class1 == "numeric" | class1 == "integer"]
+        # print(colnames(ds1))
+        r_values$wgt1 <- input$norm1fact1
+        # print(prev(ds1))
+        
+        if(input$norm1fact1 == "Raw"){
+          pondds1 <- ds1
+        }else{
+          fp1 = metadata1[colnames(ds1),input$norm1fact1]  # force same order between table
+          fp1[fp1 == 0] <- NA
+          pondds1 <- t(apply(ds1, 1, function(x){x/fp1}))
+        }
+        
+        print(prev(pondds1))
+        # r_values$pondds1 <- pondds1
+        
+        
+        cat(file=stderr(), 'NORMALIZATION', "\n")
+        ds1 <- pondds1
+        # print(head(ds1))
+        norm_names = c("Raw", "TSS", "CLR")
+        r_values$norm1 <- norm_names[as.numeric(input$norm_method)+1]
+        print(r_values$norm1)
+
+        if(input$norm_method == 0){
+          normds1 <- ds1
+        }
+        
+        if(input$norm_method == 1){
+          normf = function(x){ x/sum(x, na.rm = TRUE) }
+          # normds1 <- transform_sample_counts(ds1, normf)
+          normds1 <- apply(ds1, 2, normf)
+        }
+        
+        if(input$norm_method == 2){
+          clr = function(x){log(x+1) - rowMeans(log(x+1), na.rm = TRUE)}
+          normds1 <- clr(ds1)
+        }
+        # save(list = ls(all.names = TRUE), file = "debug.rdata", envir = environment()); print("SAVE0")
+
+        print("Final data")
+
+        # Finale dataset
+        Fdataset <- as.data.frame(t(normds1)) %>% 
+        tibble::rownames_to_column(var = "sample.id") %>% 
+        dplyr::right_join(x = mt1, by = "sample.id")  # %>% mutate_if(is.character,as.factor)
+        row.names(Fdataset) <- Fdataset$sample.id
+        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))
+
+        Fdataset
+
+      })
+
+
+      output$mergetable_DT <- DT::renderDataTable({
+        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)
+        }
+      )
+
+
+      r$fdata <- reactive({
+        print("reactive r")
+        req(r_values$subsetds_final)
+        print(prev(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
+      })
+
+ 
+
+
+
+      # output$code_dplyr <- renderPrint({
+      #   res_filter2$code()
+      # })
+      # output$code <- renderPrint({
+      #   res_filter2$expr()
+      # })
+
+      # output$res_str <- renderPrint({
+      #   str(res_filter2$filtered())
+      # })
+ 
+  })
+}
+    
+## 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/inst/app/www/style.css b/inst/app/www/style.css
new file mode 100644
index 0000000..5e8dbc0
--- /dev/null
+++ b/inst/app/www/style.css
@@ -0,0 +1,16 @@
+.sidebar {
+  color: #FFF;
+  position: fixed;
+  width: 230px;
+  white-space: nowrap;
+  overflow: visible;
+}
+
+.main-header {
+  position: fixed;
+  width:100%;
+}
+
+.content {
+  padding-top: 60px;
+}
\ No newline at end of file
diff --git a/tests/testthat.R b/tests/testthat.R
index cc3b2e9..c43ef98 100644
--- a/tests/testthat.R
+++ b/tests/testthat.R
@@ -1,4 +1,4 @@
 library(testthat)
-library(graphstats)
+library(graphstatsr)
 
-test_check("graphstats")
+test_check("graphstatsr")
-- 
GitLab


From 38002c037b76d080580a0c6692d8637dffde47e1 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Thu, 14 Apr 2022 09:29:03 +0200
Subject: [PATCH 07/14] description

---
 DESCRIPTION | 8 ++------
 1 file changed, 2 insertions(+), 6 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 2781912..ced892c 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,11 +1,8 @@
 Package: graphstatsr
 Title: graphstatsr
-Version: 1.3.2
+Version: 1.4.0
 Authors@R: 
-    person(given = "Etienne",
-           family = "Rifa",
-           role = c("cre", "aut"),
-           email = "etienne.rifa@insa-toulouse.fr")
+    person("Etienne", "Rifa", , "etienne.rifa@insa-toulouse.fr", role = c("cre", "aut"))
 Description: A shiny app to easily generate advanced graphics and some non
     parametric tests.
 License: MIT + file LICENSE
@@ -33,7 +30,6 @@ Imports:
     tibble,
     tidyr
 Suggests: 
-    graphstats,
     spelling,
     testthat
 Remotes:
-- 
GitLab


From f16f1ef9a1acfae1d21042437da1e9ba626fb02f Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Thu, 14 Apr 2022 09:43:00 +0200
Subject: [PATCH 08/14] fix path

---
 R/app_ui.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/app_ui.R b/R/app_ui.R
index cd143db..5993c2c 100644
--- a/R/app_ui.R
+++ b/R/app_ui.R
@@ -36,7 +36,7 @@ app_ui <- function(request) {
                   ),
                   
                   dashboardBody(
-                    tags$head(includeCSS('inst/app/www/style.css')),
+                    tags$head(includeCSS(system.file(file.path('app/www', 'style.css'), package='graphstatsr'))),
                     tabItems(                               
                       tabItem(tabName = 'inputs-tab',
                               mod_inputs_ui("inputs_1")
-- 
GitLab


From 504cf85331c4a03e8c6028c4255fccfbceb1b751 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Thu, 14 Apr 2022 15:19:52 +0200
Subject: [PATCH 09/14] handles features with only NA

---
 R/app_ui.R     |  2 +-
 R/mod_acp.R    | 40 ++++++++++++++++++++++++++++------------
 R/mod_inputs.R |  7 +++----
 3 files changed, 32 insertions(+), 17 deletions(-)

diff --git a/R/app_ui.R b/R/app_ui.R
index 5993c2c..86c5ec6 100644
--- a/R/app_ui.R
+++ b/R/app_ui.R
@@ -25,7 +25,7 @@ app_ui <- function(request) {
                   
                   dashboardSidebar(
                     sidebarMenu(
-                      # id="tabs",
+                      id="tabs",
                       menuItem("Easy Stats", tabName= 'easystats-tab', icon=icon("diagnoses"),
                           startExpanded = TRUE,
                           menuSubItem('Input data', tabName = 'inputs-tab'),
diff --git a/R/mod_acp.R b/R/mod_acp.R
index b6fe248..73549fa 100644
--- a/R/mod_acp.R
+++ b/R/mod_acp.R
@@ -84,6 +84,17 @@ mod_acp_server <- function(id, r = r, session = session){
     ns <- session$ns
     r_values <- reactiveValues()
 
+    # observeEvent(r$tabs$tabselected, {
+    #   if(r$tabs$tabselected=='acp-tab') { # && is.null(r$fdata) )
+    #   fdata <- NULL
+    #   print(r$tabs$tabselected)
+    #   print(names(r))
+    #   print(isolate(r$fdata()))
+    #     print("alert")
+    #     shinyalert::shinyalert(title = "Oops", text="Final table not available, check all steps.", type='error')
+    #   }
+    # })    
+
     ### ACP tab
   
     # Settings   
@@ -108,28 +119,33 @@ mod_acp_server <- function(id, r = r, session = session){
     })
     
     ### ACP 
-    observeEvent({input$go1
-                 input$go2}, {
-      if(!isTruthy(r$ds1())){ #r_values$features_final
-        cat(file=stderr(), 'ACP1 no table... ', "\n")
-        shinyalert(title = "Oops", text="Final table not available, check all steps.", type='error')
-      }
+    # observeEvent({input$go1
+    #              input$go2}, {
+    #   if(!isTruthy(r$ds1())){ #r_values$features_final
+    #     cat(file=stderr(), 'ACP1 no table... ', "\n")
+    #     shinyalert(title = "Oops", text="Final table not available, check all steps.", type='error')
+    #   }
                    
-    })
+    # })
     
     acp1 <- eventReactive(input$go2, {
       cat(file=stderr(), 'ACP1 ... ', "\n")
       req(r$ds1())  # r_values$metadata_final # r_values$features_final , r_values$mt1
       ds1 <- r_values$features_final <- r$ds1()
-      # browser()
+      print(prev(ds1))
 
       # print(head(normds1()))
       # print(str(normds1()))
       if(input$naomit_method == 0){
-      acp_input <- na.omit(r_values$features_final)
-      r_values$snaomit <- setdiff(row.names(r_values$features_final),row.names(acp_input))
-      r_values$snaomit_att <- "sample(s)"
-      r_values$snaomit_ndim <- nrow(r_values$features_final)
+        Tfeat0 =r_values$features_final
+        allNA_index = apply(Tfeat0,2,function(x){all(is.na(x))})
+        Tfeat = Tfeat0[,!allNA_index]
+
+
+        acp_input <- na.omit(Tfeat)
+        r_values$snaomit <- setdiff(row.names(r_values$features_final),row.names(acp_input))
+        r_values$snaomit_att <- "sample(s)"
+        r_values$snaomit_ndim <- nrow(r_values$features_final)
       }
       
       if(input$naomit_method == 1){
diff --git a/R/mod_inputs.R b/R/mod_inputs.R
index bef5412..b48580f 100644
--- a/R/mod_inputs.R
+++ b/R/mod_inputs.R
@@ -306,11 +306,11 @@ mod_inputs_server <- function(id, r = r, session = session){
         r_values$norm1fact = names(metadata1)[class1 %in% "integer" | class1 %in% "numeric"]
         updateSelectInput(session, "norm1fact1",
                           choices = c("Raw", r_values$norm1fact),
-                          selected = names(r_values$metadata_final)[1])
+                          selected = c("Raw", r_values$norm1fact)[1]) #names(r_values$metadata_final)[1]
       })
 
 
-      mergetable <- eventReactive(input$mergebutton, {
+      r$mergetable <- mergetable <- eventReactive(input$mergebutton, {
         metadata1 <- res_filter2$filtered()
         row.names(metadata1) <- metadata1[,"sample.id"]
         feat1 <- res_filter$filtered()
@@ -393,6 +393,7 @@ mod_inputs_server <- function(id, r = r, session = session){
         r_values$features_final <- Fdataset[,(ncol(mt1)+1):ncol(Fdataset)]
         print(prev(r_values$features_final))
 
+        showNotification("Dataset ready !", type="message", duration = 5)
         Fdataset
 
       })
@@ -418,8 +419,6 @@ mod_inputs_server <- function(id, r = r, session = session){
       r$fdata <- reactive({
         print("reactive r")
         req(r_values$subsetds_final)
-        print(prev(r_values$subsetds_final))
-
         r_values$subsetds_final
 
       })
-- 
GitLab


From c8c262186f191d3499d5a54d9035190d040bbade Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Thu, 14 Apr 2022 17:54:19 +0200
Subject: [PATCH 10/14] update

---
 NAMESPACE        |  2 ++
 R/mod_acp.R      |  8 +++---
 R/mod_boxplots.R | 70 +++++++++++++++++++++++++++++++++++++++---------
 R/mod_inputs.R   |  8 +++---
 4 files changed, 67 insertions(+), 21 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index ab30dd1..0d36f7e 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -36,3 +36,5 @@ importFrom(shiny,tagList)
 importFrom(shiny,tags)
 importFrom(shinyalert,shinyalert)
 importFrom(shinyalert,useShinyalert)
+importFrom(sortable,rank_list)
+importFrom(sortable,sortable_options)
diff --git a/R/mod_acp.R b/R/mod_acp.R
index 73549fa..43f6210 100644
--- a/R/mod_acp.R
+++ b/R/mod_acp.R
@@ -259,10 +259,10 @@ mod_acp_server <- function(id, r = r, session = session){
       
       pc1 = as.numeric(substring(input$pc1, 3, 10))
       pc2 = as.numeric(substring(input$pc2, 3, 10))
-      
-      p = ggplot(acptab(), aes_string(x = input$pc1, y =
-                                        input$pc2, color = input$fact1, sampleID = "sample.id")) + 
-        geom_point() + stat_ellipse(aes_string(x = input$pc1, y = input$pc2, color = input$fact1), inherit.aes = FALSE) + theme_bw() + 
+
+      p = ggplot(data = acptab(), aes_string(x = input$pc1, y =
+                                        input$pc2, color = as.name(input$fact1), sampleID = "sample.id")) + 
+        geom_point() + stat_ellipse(aes_string(x = input$pc1, y = input$pc2, color = as.name(input$fact1)), inherit.aes = FALSE) + theme_bw() + 
         xlab(glue::glue("{input$pc1} ({round(r_values$summary_acp$importance[2,pc1]*100,1)}%)")) + ylab(glue::glue("{input$pc2} ({round(r_values$summary_acp$importance[2,pc2]*100,1)}%)"))
       
       ggplotly(p, tooltip=c("x", "y", "sampleID"))
diff --git a/R/mod_boxplots.R b/R/mod_boxplots.R
index cebac41..4c4c3a4 100644
--- a/R/mod_boxplots.R
+++ b/R/mod_boxplots.R
@@ -7,6 +7,22 @@
 #' @noRd 
 #'
 #' @importFrom shiny NS tagList 
+#' @importFrom sortable rank_list sortable_options
+
+
+
+labels <- list(
+  "one",
+  "two",
+  "three",
+  htmltools::tags$div(
+    htmltools::em("Complex"), " html tag without a name"
+  ),
+  "five" = htmltools::tags$div(
+    htmltools::em("Complex"), " html tag with name: 'five'"
+  )
+)
+
 mod_boxplots_ui <- function(id){
   ns <- NS(id)
   tagList(
@@ -34,7 +50,11 @@ mod_boxplots_ui <- function(id){
             actionButton(ns("go4"), "Just plot", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469"),
             actionButton(ns("go3"), "Run plot/stats & tests", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469"),
             downloadButton(outputId = ns("boxplots_download"), label = "Download all plots (long process)")
-        )
+        ),
+        box(title = "Reorder boxplots:", width = 7, status = "warning", solidHeader = TRUE,
+            uiOutput(ns("sortable")),
+            verbatimTextOutput(ns("results_sort"))
+        )          
       ),
       # fluidRow(
       #   box(title = "Boxplot:", width = 12, status = "warning", solidHeader = TRUE,
@@ -106,8 +126,9 @@ mod_boxplots_server <- function(id, r = r, session = session){
 
     
     
-    boxplot1 <- eventReactive(c(input$go3, input$go4), {
-      cat(file=stderr(), 'BOXPLOT', "\n")
+    boxtab <- eventReactive(c(input$go3, input$go4), {
+      cat(file=stderr(), 'BOXTAB', "\n")
+
       req(r_values$subsetds_final_melt, input$fact3, r$ds1())
       r_values$tabF_melt2 <- tabF_melt2 <- tabF_melt <- r_values$subsetds_final_melt
       if(length(input$fact3) == 1){r_values$fact3ok <- fact3ok <- input$fact3
@@ -121,13 +142,6 @@ mod_boxplots_server <- function(id, r = r, session = session){
       print(head(r_values$tabF_melt2))
       print(r_values$fact3ok)
       
-      ytitle <- glue::glue("{as.character(r$ds1()[input$feat1,3])}")
-      if(r$wgt1() != "Raw"){
-        ytitle <- glue::glue("{ytitle}, weight: {r$wgt1()}")
-      }
-      if(r$norm1() != "Raw"){
-        ytitle <- glue::glue("{ytitle}, norm.: {r$norm1()}")
-      }
       
       fun <-  glue::glue('tabfeat = tabF_melt2[tabF_melt2$features == input$feat1,] %>% 
         group_by({fact3ok}) %>% 
@@ -138,7 +152,37 @@ mod_boxplots_server <- function(id, r = r, session = session){
         tabfeat <- tabfeat %>% filter(!is.na(value))
       }
 
-     fun <-  glue::glue('p <- ggplot(tabfeat, aes(x = {fact3ok}, y = value)) + 
+      tabfeat
+    })
+
+
+    output$sortable <- renderUI({
+      tabfeat <- boxtab()
+      print("SORTABLE UI")
+      print(str(tabfeat))
+      print(names(tabfeat))
+      rank_list("Drag column names to change order", unique(tabfeat$newfact), "sorted1")
+    })
+
+
+
+    output$results_sort <- renderPrint({
+      input$sorted1 # This matches the input_id of the rank list
+    })
+
+    boxplot1 <- eventReactive(c(input$go3, input$go4), {
+      cat(file=stderr(), 'BOXPLOT', "\n")
+      tabfeat <- boxtab()
+
+      ytitle <- glue::glue("{as.character(r$ds1()[input$feat1,3])}")
+      if(r$wgt1() != "Raw"){
+        ytitle <- glue::glue("{ytitle}, weight: {r$wgt1()}")
+      }
+      if(r$norm1() != "Raw"){
+        ytitle <- glue::glue("{ytitle}, norm.: {r$norm1()}")
+      }
+
+     fun <-  glue::glue('p <- ggplot(tabfeat, aes(x = {r_values$fact3ok }, y = value)) + 
         geom_boxplot(fill = "#99AFE3") + theme_bw() + xlab("Condition") + ylab(ytitle) + ggtitle(input$feat1) +
         theme(legend.position = "None", axis.text.x = element_text(angle = 45, hjust=1))')
       eval(parse(text=fun))
@@ -156,8 +200,8 @@ mod_boxplots_server <- function(id, r = r, session = session){
       
       outlist = list()
       outlist$p <- p
-      outlist$tabF_melt2 <- tabF_melt2
-      outlist$fact3ok <- fact3ok
+      outlist$tabF_melt2 <- r_values$tabF_melt2
+      outlist$fact3ok <- r_values$fact3ok 
       outlist$ggly <- ggly
 
       outlist
diff --git a/R/mod_inputs.R b/R/mod_inputs.R
index b48580f..ac7fdee 100644
--- a/R/mod_inputs.R
+++ b/R/mod_inputs.R
@@ -155,10 +155,10 @@ mod_inputs_server <- function(id, r = r, session = session){
 
 
       data <- reactive({
-        imported$data()
+        # imported$data()
         
         # dev
-        # read.csv("~/repository/graphstatsr/data_test/metabo_all_data_special.csv", sep ="\t")
+        read.csv("~/repository/graphstatsr/data_test/metabo_all_data_special.csv", sep ="\t")
       })
 
       # output$datainput <- renderPrint({
@@ -227,10 +227,10 @@ mod_inputs_server <- function(id, r = r, session = session){
 
 
       data2 <- reactive({
-        imported2$data()
+        # imported2$data()
         
         # dev
-        # read.csv("~/repository/graphstatsr/data_test/metadata_metabo.csv", sep ="\t")
+        read.csv("~/repository/graphstatsr/data_test/metadata_metabo.csv", sep =",")
       })
 
       res_filter2 <- filter_data_server(
-- 
GitLab


From 46eb5bacfc86f143cacca4ffba229fde0b1497ff Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Fri, 15 Apr 2022 16:48:11 +0200
Subject: [PATCH 11/14] add bucket_list

---
 NAMESPACE        |   2 +
 R/mod_acp.R      |  28 ++++---------
 R/mod_boxplots.R | 103 +++++++++++++++++++++++++++++++++++++----------
 R/mod_inputs.R   |  21 +++++-----
 4 files changed, 103 insertions(+), 51 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index 0d36f7e..e1cbc22 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -36,5 +36,7 @@ importFrom(shiny,tagList)
 importFrom(shiny,tags)
 importFrom(shinyalert,shinyalert)
 importFrom(shinyalert,useShinyalert)
+importFrom(sortable,add_rank_list)
+importFrom(sortable,bucket_list)
 importFrom(sortable,rank_list)
 importFrom(sortable,sortable_options)
diff --git a/R/mod_acp.R b/R/mod_acp.R
index 43f6210..d5623da 100644
--- a/R/mod_acp.R
+++ b/R/mod_acp.R
@@ -84,16 +84,12 @@ mod_acp_server <- function(id, r = r, session = session){
     ns <- session$ns
     r_values <- reactiveValues()
 
-    # observeEvent(r$tabs$tabselected, {
-    #   if(r$tabs$tabselected=='acp-tab') { # && is.null(r$fdata) )
-    #   fdata <- NULL
-    #   print(r$tabs$tabselected)
-    #   print(names(r))
-    #   print(isolate(r$fdata()))
-    #     print("alert")
-    #     shinyalert::shinyalert(title = "Oops", text="Final table not available, check all steps.", type='error')
-    #   }
-    # })    
+    observeEvent(r$tabs$tabselected, {
+      if(r$tabs$tabselected=='acp-tab' && r$fdata() == "emptytable") { # && is.null(r$fdata) )
+        print("alert")
+        shinyalert::shinyalert(title = "Oops", text="Final table not available, check all steps.", type='error')          
+      }
+    })    
 
     ### ACP tab
   
@@ -118,18 +114,10 @@ mod_acp_server <- function(id, r = r, session = session){
 
     })
     
-    ### ACP 
-    # observeEvent({input$go1
-    #              input$go2}, {
-    #   if(!isTruthy(r$ds1())){ #r_values$features_final
-    #     cat(file=stderr(), 'ACP1 no table... ', "\n")
-    #     shinyalert(title = "Oops", text="Final table not available, check all steps.", type='error')
-    #   }
-                   
-    # })
-    
     acp1 <- eventReactive(input$go2, {
       cat(file=stderr(), 'ACP1 ... ', "\n")
+
+
       req(r$ds1())  # r_values$metadata_final # r_values$features_final , r_values$mt1
       ds1 <- r_values$features_final <- r$ds1()
       print(prev(ds1))
diff --git a/R/mod_boxplots.R b/R/mod_boxplots.R
index 4c4c3a4..8c12f53 100644
--- a/R/mod_boxplots.R
+++ b/R/mod_boxplots.R
@@ -7,7 +7,7 @@
 #' @noRd 
 #'
 #' @importFrom shiny NS tagList 
-#' @importFrom sortable rank_list sortable_options
+#' @importFrom sortable rank_list bucket_list add_rank_list sortable_options
 
 
 
@@ -51,7 +51,7 @@ mod_boxplots_ui <- function(id){
             actionButton(ns("go3"), "Run plot/stats & tests", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469"),
             downloadButton(outputId = ns("boxplots_download"), label = "Download all plots (long process)")
         ),
-        box(title = "Reorder boxplots:", width = 7, status = "warning", solidHeader = TRUE,
+        box(title = "Reorder boxplots:", width = 5, status = "warning", solidHeader = TRUE, collapsible = TRUE,
             uiOutput(ns("sortable")),
             verbatimTextOutput(ns("results_sort"))
         )          
@@ -90,12 +90,12 @@ mod_boxplots_ui <- function(id){
 mod_boxplots_server <- function(id, r = r, session = session){
   moduleServer( id, function(input, output, session){
     ns <- session$ns
-    r_values <- reactiveValues()
+    r_values <- reactiveValues(ggly = NULL)
 
     ###BOXPLOT
     
-    observeEvent(input$go3, {
-      if(!isTruthy(r$fdata_melt())){ #r_values$features_final
+    observeEvent(r$tabs$tabselected, {
+      if(r$tabs$tabselected=='boxplot-tab' && r$fdata_melt() == "emptytable"){ #r_values$features_final
         cat(file=stderr(), 'Boxplot no table... ', "\n")
         shinyalert(title = "Oops", text="Final table not available, check all steps.", type='error')
       }
@@ -126,12 +126,14 @@ mod_boxplots_server <- function(id, r = r, session = session){
 
     
     
-    boxtab <- eventReactive(c(input$go3, input$go4), {
+    boxtab <- eventReactive(c(input$go4, input$go3), {  #
       cat(file=stderr(), 'BOXTAB', "\n")
 
       req(r_values$subsetds_final_melt, input$fact3, r$ds1())
       r_values$tabF_melt2 <- tabF_melt2 <- tabF_melt <- r_values$subsetds_final_melt
       if(length(input$fact3) == 1){r_values$fact3ok <- fact3ok <- input$fact3
+          fun = glue::glue('tabF_melt2 <- tabF_melt %>% dplyr::mutate(newfact = {input$fact3}, .after= "sample.id")')
+          eval(parse(text=fun))
         }else{
           comb = glue::glue_collapse(input$fact3, sep = ', \"_\",')
           fun = glue::glue('tabF_melt2 <- tabF_melt %>% dplyr::mutate(newfact = paste0({comb}), .after= "sample.id")')
@@ -156,23 +158,71 @@ mod_boxplots_server <- function(id, r = r, session = session){
     })
 
 
+
+    # output$sortable <- renderUI({
+    #   tabF_melt2 <- tabF_melt <- r_values$subsetds_final_melt
+
+    #   if(length(input$fact3) == 1){r_values$fact3ok <- fact3ok <- input$fact3
+    #       fun = glue::glue('tabF_melt2 <- tabF_melt %>% dplyr::mutate(newfact = {input$fact3}, .after= "sample.id")')
+    #       eval(parse(text=fun))
+    #     }else{
+    #       comb = glue::glue_collapse(input$fact3, sep = ', \"_\",')
+    #       fun = glue::glue('tabF_melt2 <- tabF_melt %>% dplyr::mutate(newfact = paste0({comb}), .after= "sample.id")')
+    #       eval(parse(text=fun))
+    #       fact3ok <- "newfact"
+    #       tabF_melt2
+    #     }
+
+    #   print("SORTABLE UI")
+    #   print(str(tabF_melt2))
+    #   print(names(tabF_melt2))
+    #   rank_list("Drag condition names to change order...", unique(tabF_melt2$newfact), ns("sorted1"),
+    #     options = sortable_options(multiDrag = TRUE))
+    # })
+
     output$sortable <- renderUI({
-      tabfeat <- boxtab()
+      tabF_melt2 <- tabF_melt <- r_values$subsetds_final_melt
+
+      if(length(input$fact3) == 1){r_values$fact3ok <- fact3ok <- input$fact3
+          fun = glue::glue('tabF_melt2 <- tabF_melt %>% dplyr::mutate(newfact = {input$fact3}, .after= "sample.id")')
+          eval(parse(text=fun))
+        }else{
+          comb = glue::glue_collapse(input$fact3, sep = ', \"_\",')
+          fun = glue::glue('tabF_melt2 <- tabF_melt %>% dplyr::mutate(newfact = paste0({comb}), .after= "sample.id")')
+          eval(parse(text=fun))
+          fact3ok <- "newfact"
+          tabF_melt2
+        }
+
       print("SORTABLE UI")
-      print(str(tabfeat))
-      print(names(tabfeat))
-      rank_list("Drag column names to change order", unique(tabfeat$newfact), "sorted1")
+      # 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("sorted1"),
+          options = sortable_options(multiDrag = TRUE)
+        ),
+        add_rank_list("Stashed conditions",
+          NULL, ns("stashed1"),
+          options = sortable_options(multiDrag = TRUE)
+        )
+      )
     })
 
 
 
+
     output$results_sort <- renderPrint({
       input$sorted1 # This matches the input_id of the rank list
     })
 
-    boxplot1 <- eventReactive(c(input$go3, input$go4), {
+
+
+    boxplot1 <- eventReactive(c(input$go4, input$go3), {  #
       cat(file=stderr(), 'BOXPLOT', "\n")
-      tabfeat <- boxtab()
+      tabfeat0 <- boxtab()
 
       ytitle <- glue::glue("{as.character(r$ds1()[input$feat1,3])}")
       if(r$wgt1() != "Raw"){
@@ -182,11 +232,22 @@ mod_boxplots_server <- function(id, r = r, session = session){
         ytitle <- glue::glue("{ytitle}, norm.: {r$norm1()}")
       }
 
+      fun <- glue::glue("
+          tabfeat <- tabfeat0 %>%
+            dplyr::filter({r_values$fact3ok} %in% input$sorted1) %>%
+            droplevels() %>%
+            mutate({r_values$fact3ok} = factor({r_values$fact3ok}, levels = input$sorted1))
+        ")
+      eval(parse(text=fun))
+
+      # tabfeat[[r_values$fact3ok]] <- factor(tabfeat[[r_values$fact3ok]], levels = input$sorted1)
+      print(tabfeat[[r_values$fact3ok]])
+
      fun <-  glue::glue('p <- ggplot(tabfeat, aes(x = {r_values$fact3ok }, y = value)) + 
         geom_boxplot(fill = "#99AFE3") + theme_bw() + xlab("Condition") + ylab(ytitle) + ggtitle(input$feat1) +
         theme(legend.position = "None", axis.text.x = element_text(angle = 45, hjust=1))')
       eval(parse(text=fun))
-      ggly <- ggplotly(p)
+      r_values$ggly <- ggly <- ggplotly(p)
       
       # # Hoverinfo BUG
       # tabfeat$sample.id <- as.character(tabfeat$sample.id)
@@ -207,17 +268,15 @@ mod_boxplots_server <- function(id, r = r, session = session){
       outlist
     })
     
-    # output$boxplot_out <- renderPlot({
-    #   req(boxplot1())
-    #   bp1 <- boxplot1()
-    #   
-    #   bp1$p
-    # })
+
     
     output$boxplotly1 <- renderPlotly({
-      req(boxplot1())
-      bp1 <- boxplot1()
-      ggplotly(bp1$ggly)
+      # req(boxplot1())
+      req(input$go3)
+      if(!is.null(r_values$ggly)){
+        bp1 <- boxplot1()
+        ggplotly(bp1$ggly)
+      }
     })
     
     # Export all figures
diff --git a/R/mod_inputs.R b/R/mod_inputs.R
index ac7fdee..b522182 100644
--- a/R/mod_inputs.R
+++ b/R/mod_inputs.R
@@ -131,6 +131,9 @@ mod_inputs_server <- function(id, r = r, session = session){
     # Input dataset dev 
 
     observeEvent(input$launch_modal, {
+      r_values$subsetds_final <- "emptytable" # for shinyalert acp / boxplot
+      r_values$subsetds_final_melt <- "emptytable"
+
       import_modal(
         id = ns("myid"),
         from = c("file", "env", "copypaste", "googlesheets", "url"),
@@ -230,7 +233,7 @@ mod_inputs_server <- function(id, r = r, session = session){
         # imported2$data()
         
         # dev
-        read.csv("~/repository/graphstatsr/data_test/metadata_metabo.csv", sep =",")
+        read.csv("~/repository/graphstatsr/data_test/metadata_metabo.csv", sep ="\t")
       })
 
       res_filter2 <- filter_data_server(
@@ -319,12 +322,12 @@ mod_inputs_server <- function(id, r = r, session = session){
         outliers1 <- input[["table2_rows_selected"]]
         samplenames_out <- metadata1[input[["table2_rows_selected"]], "sample.id"]
         print(outliers1)
-        print(samplenames_out)
+        # print(samplenames_out)
 
         mt1 <- metadata1 %>% filter(!row_number() %in% outliers1)
-        print(mt1$sample.id)
+        # print(mt1$sample.id)
         ds0 <- feat1 %>% select(-samplenames_out)
-        print(colnames(ds0))
+        # print(colnames(ds0))
 
 
 
@@ -347,7 +350,7 @@ mod_inputs_server <- function(id, r = r, session = session){
           pondds1 <- t(apply(ds1, 1, function(x){x/fp1}))
         }
         
-        print(prev(pondds1))
+        # print(prev(pondds1))
         # r_values$pondds1 <- pondds1
         
         
@@ -389,9 +392,9 @@ mod_inputs_server <- function(id, r = r, session = session){
 
         #for PCA
         r_values$metadata_final <- droplevels(Fdataset[,1:ncol(mt1)])
-        print(prev(r_values$metadata_final))
+        # print(prev(r_values$metadata_final))
         r_values$features_final <- Fdataset[,(ncol(mt1)+1):ncol(Fdataset)]
-        print(prev(r_values$features_final))
+        # print(prev(r_values$features_final))
 
         showNotification("Dataset ready !", type="message", duration = 5)
         Fdataset
@@ -431,8 +434,9 @@ mod_inputs_server <- function(id, r = r, session = session){
 
       r$ds1 <- reactive({
         req(r_values$features_final)
-        r_values$features_final
+          r_values$features_final
       })
+
       r$fdata_melt <- reactive({
         req(r_values$subsetds_final_melt)
         r_values$subsetds_final_melt
@@ -447,7 +451,6 @@ mod_inputs_server <- function(id, r = r, session = session){
         r_values$norm1
       })
 
- 
 
 
 
-- 
GitLab


From 8518bead3efafcd18f251372bae84f97317031ec Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Tue, 19 Apr 2022 16:45:09 +0200
Subject: [PATCH 12/14] update

---
 R/mod_boxplots.R | 62 +++++++++++++++++++++++++++++++++++-------------
 R/mod_inputs.R   |  2 +-
 2 files changed, 47 insertions(+), 17 deletions(-)

diff --git a/R/mod_boxplots.R b/R/mod_boxplots.R
index 8c12f53..9f32392 100644
--- a/R/mod_boxplots.R
+++ b/R/mod_boxplots.R
@@ -47,8 +47,10 @@ mod_boxplots_ui <- function(id){
               choices = c(1:4), selected = 1
             ),
             materialSwitch(ns("plotall"), label = "Plot all conditions (even NAs)", value = TRUE, status = "primary"),
-            actionButton(ns("go4"), "Just plot", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469"),
+            materialSwitch(ns("outlier_labs"), label = "Inform outlier in pdf output", value = TRUE, status = "primary"),
+            materialSwitch(ns("grey_mode"), label = "Colored boxplot", value = TRUE, status = "primary"),
             actionButton(ns("go3"), "Run plot/stats & tests", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469"),
+            actionButton(ns("go4"), "Update plot only", icon = icon("play-circle"), style="color: #fff; background-color: #3b9ef5; border-color: #1a4469"),
             downloadButton(outputId = ns("boxplots_download"), label = "Download all plots (long process)")
         ),
         box(title = "Reorder boxplots:", width = 5, status = "warning", solidHeader = TRUE, collapsible = TRUE,
@@ -125,7 +127,6 @@ mod_boxplots_server <- function(id, r = r, session = session){
     })
 
     
-    
     boxtab <- eventReactive(c(input$go4, input$go3), {  #
       cat(file=stderr(), 'BOXTAB', "\n")
 
@@ -212,8 +213,6 @@ mod_boxplots_server <- function(id, r = r, session = session){
     })
 
 
-
-
     output$results_sort <- renderPrint({
       input$sorted1 # This matches the input_id of the rank list
     })
@@ -243,10 +242,21 @@ mod_boxplots_server <- function(id, r = r, session = session){
       # tabfeat[[r_values$fact3ok]] <- factor(tabfeat[[r_values$fact3ok]], levels = input$sorted1)
       print(tabfeat[[r_values$fact3ok]])
 
-     fun <-  glue::glue('p <- ggplot(tabfeat, aes(x = {r_values$fact3ok }, y = value)) + 
-        geom_boxplot(fill = "#99AFE3") + theme_bw() + xlab("Condition") + ylab(ytitle) + ggtitle(input$feat1) +
+     fun <-  glue::glue('p <- ggplot(tabfeat, aes(x = {r_values$fact3ok}, y = value, fill = {r_values$fact3ok})) + 
+        theme_bw() + xlab("Condition") + ylab(ytitle) + ggtitle(input$feat1) +
         theme(legend.position = "None", axis.text.x = element_text(angle = 45, hjust=1))')
       eval(parse(text=fun))
+
+      if(!input$grey_mode){
+        p <- p + 
+            geom_boxplot(fill = "grey")
+      }else{
+        p <- p + 
+            geom_boxplot()            
+      }
+
+
+
       r_values$ggly <- ggly <- ggplotly(p)
       
       # # Hoverinfo BUG
@@ -305,30 +315,50 @@ mod_boxplots_server <- function(id, r = r, session = session){
             ytitle <- glue::glue("{ytitle}, norm.: {r$norm1()}")
           }
           
-          fun <-  glue::glue('tabfeat = tabF_melt2[tabF_melt2$features == FEAT[i],] %>% 
+          fun <-  glue::glue('tabfeat0 = tabF_melt2[tabF_melt2$features == FEAT[i],] %>% 
                   group_by({fact3ok}) %>% 
                   mutate(outlier=ifelse(is_outlier(value), sample.id, NA))')
           eval(parse(text=fun))
 
+          fun <- glue::glue("
+              tabfeat <- tabfeat0 %>%
+                dplyr::filter({r_values$fact3ok} %in% input$sorted1) %>%
+                droplevels() %>%
+                mutate({r_values$fact3ok} = factor({r_values$fact3ok}, levels = input$sorted1))
+            ")
+          eval(parse(text=fun))
+
            if(!input$plotall){
               tabfeat <- tabfeat %>% filter(!is.na(value))
             }
 
           if(nrow(tabfeat) == 0){print("no data"); next}
           
-          fun <-  glue::glue('listP[[FEAT[i]]] <- ggplot(tabfeat, aes(x = {fact3ok}, y = value)) + 
+          fun <-  glue::glue('listP[[FEAT[i]]] <- ggplot(tabfeat, aes(x = {fact3ok}, y = value, fill = {fact3ok})) + 
         geom_boxplot(fill = "#99AFE3") + theme_bw() + xlab("Condition") + ylab(ytitle) + ggtitle(FEAT[i]) +
-        theme(legend.position = "None", axis.text.x = element_text(angle = 45, hjust=1)) + 
-        ggrepel::geom_text_repel(aes(label = outlier), na.rm = TRUE, show.legend = F, 
-                             direction = "both",
-                             nudge_x = 0.1,
-                             size= 3
-                             )')
+        theme(legend.position = "None", axis.text.x = element_text(angle = 45, hjust=1))')
           eval(parse(text=fun))
-          
+
+          if(input$outlier_labs){
+            listP[[FEAT[i]]] <- listP[[FEAT[i]]] + 
+                              ggrepel::geom_text_repel(aes(label = outlier), na.rm = TRUE, show.legend = F, 
+                              direction = "both",
+                              nudge_x = 0.1,
+                              size= 3
+                             )
+          }
+
+          if(!input$grey_mode){
+            listP[[FEAT[i]]] <- listP[[FEAT[i]]] + 
+                              geom_boxplot(fill = "grey")
+          }else{
+            listP[[FEAT[i]]] <- listP[[FEAT[i]]] + 
+                              geom_boxplot()            
+          }
+
           print(length(listP))
         }
-      
+      # browser()
       print(length(listP))
       
       listP
diff --git a/R/mod_inputs.R b/R/mod_inputs.R
index b522182..519c407 100644
--- a/R/mod_inputs.R
+++ b/R/mod_inputs.R
@@ -233,7 +233,7 @@ mod_inputs_server <- function(id, r = r, session = session){
         # imported2$data()
         
         # dev
-        read.csv("~/repository/graphstatsr/data_test/metadata_metabo.csv", sep ="\t")
+        read.csv("~/repository/graphstatsr/data_test/metadata_metabo.csv", sep =",")
       })
 
       res_filter2 <- filter_data_server(
-- 
GitLab


From 5bd297a9f3a1a8b044e0fcc0ed8b279c5e0b35e9 Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Wed, 20 Apr 2022 10:05:04 +0200
Subject: [PATCH 13/14] add for 1.4 custom ytitle coloring boxplot reordering
 boxplot

---
 R/app_ui.R       |  2 +-
 R/mod_boxplots.R | 72 +++++++++++++++++++++---------------------------
 R/mod_inputs.R   |  8 +++---
 3 files changed, 37 insertions(+), 45 deletions(-)

diff --git a/R/app_ui.R b/R/app_ui.R
index 86c5ec6..9590020 100644
--- a/R/app_ui.R
+++ b/R/app_ui.R
@@ -16,7 +16,7 @@ app_ui <- function(request) {
     # )
     dashboardPage(skin = "red",
                   dashboardHeader(
-                    title = "GraphStatsR",
+                    title = "GraphStatsR 1.4.0",
                     tags$li(class="dropdown",tags$a(icon("gitlab"), headerText = "Source code",href="https://forgemia.inra.fr/etienne.rifa/graphstats", target="_blank")),
                     tags$li(class="dropdown",tags$a(icon("clinic-medical"), headerText = "Issues",href="https://forgemia.inra.fr/etienne.rifa/graphstats/-/issues", target="_blank"))#,
                     # tags$li(class="dropdown",tags$a(icon("twitter"), headerText = "Share", href="
diff --git a/R/mod_boxplots.R b/R/mod_boxplots.R
index 9f32392..c5d1d34 100644
--- a/R/mod_boxplots.R
+++ b/R/mod_boxplots.R
@@ -46,6 +46,7 @@ mod_boxplots_ui <- function(id){
               label = "Select number of plot per pdf page (max 4 per page):",
               choices = c(1:4), selected = 1
             ),
+            textInput(ns("custom_ytitle"), "Custom y title", "None"),
             materialSwitch(ns("plotall"), label = "Plot all conditions (even NAs)", value = TRUE, status = "primary"),
             materialSwitch(ns("outlier_labs"), label = "Inform outlier in pdf output", value = TRUE, status = "primary"),
             materialSwitch(ns("grey_mode"), label = "Colored boxplot", value = TRUE, status = "primary"),
@@ -142,8 +143,8 @@ mod_boxplots_server <- function(id, r = r, session = session){
           r_values$fact3ok <- fact3ok <- "newfact"
           r_values$tabF_melt2 <- tabF_melt2
         }
-      print(head(r_values$tabF_melt2))
-      print(r_values$fact3ok)
+      # print(head(r_values$tabF_melt2))
+      # print(r_values$fact3ok)
       
       
       fun <-  glue::glue('tabfeat = tabF_melt2[tabF_melt2$features == input$feat1,] %>% 
@@ -160,27 +161,6 @@ mod_boxplots_server <- function(id, r = r, session = session){
 
 
 
-    # output$sortable <- renderUI({
-    #   tabF_melt2 <- tabF_melt <- r_values$subsetds_final_melt
-
-    #   if(length(input$fact3) == 1){r_values$fact3ok <- fact3ok <- input$fact3
-    #       fun = glue::glue('tabF_melt2 <- tabF_melt %>% dplyr::mutate(newfact = {input$fact3}, .after= "sample.id")')
-    #       eval(parse(text=fun))
-    #     }else{
-    #       comb = glue::glue_collapse(input$fact3, sep = ', \"_\",')
-    #       fun = glue::glue('tabF_melt2 <- tabF_melt %>% dplyr::mutate(newfact = paste0({comb}), .after= "sample.id")')
-    #       eval(parse(text=fun))
-    #       fact3ok <- "newfact"
-    #       tabF_melt2
-    #     }
-
-    #   print("SORTABLE UI")
-    #   print(str(tabF_melt2))
-    #   print(names(tabF_melt2))
-    #   rank_list("Drag condition names to change order...", unique(tabF_melt2$newfact), ns("sorted1"),
-    #     options = sortable_options(multiDrag = TRUE))
-    # })
-
     output$sortable <- renderUI({
       tabF_melt2 <- tabF_melt <- r_values$subsetds_final_melt
 
@@ -223,12 +203,17 @@ mod_boxplots_server <- function(id, r = r, session = session){
       cat(file=stderr(), 'BOXPLOT', "\n")
       tabfeat0 <- boxtab()
 
-      ytitle <- glue::glue("{as.character(r$ds1()[input$feat1,3])}")
-      if(r$wgt1() != "Raw"){
-        ytitle <- glue::glue("{ytitle}, weight: {r$wgt1()}")
-      }
-      if(r$norm1() != "Raw"){
-        ytitle <- glue::glue("{ytitle}, norm.: {r$norm1()}")
+      if(input$custom_ytitle == "None"){
+        ytitle <- stringr::str_split(input$feat1, "__",simplify = TRUE)[2]
+        if(r$wgt1() != "Raw"){
+          ytitle <- glue::glue("{ytitle}, weight: {r$wgt1()}")
+        }
+        if(r$norm1() != "Raw"){
+          ytitle <- glue::glue("{ytitle}, norm.: {r$norm1()}")
+        }
+
+      }else{
+        ytitle <- input$custom_ytitle
       }
 
       fun <- glue::glue("
@@ -244,7 +229,8 @@ mod_boxplots_server <- function(id, r = r, session = session){
 
      fun <-  glue::glue('p <- ggplot(tabfeat, aes(x = {r_values$fact3ok}, y = value, fill = {r_values$fact3ok})) + 
         theme_bw() + xlab("Condition") + ylab(ytitle) + ggtitle(input$feat1) +
-        theme(legend.position = "None", axis.text.x = element_text(angle = 45, hjust=1))')
+        theme(legend.position = "None", axis.text.x = element_text(angle = 45, hjust=1)) + 
+        labs(fill="")')
       eval(parse(text=fun))
 
       if(!input$grey_mode){
@@ -304,15 +290,20 @@ mod_boxplots_server <- function(id, r = r, session = session){
 
         for(i in 1:length(FEAT)){
           
-          tt <- stringr::str_split(FEAT[i], "__")
-          print(tt)
-          ytitle <- sapply(tt,"[[",2)
-          print(ytitle)
-          if(r$wgt1() != "Raw"){
-            ytitle <- glue::glue("{ytitle}, weight: {r$wgt1()}")
-          }
-          if(r$norm1() != "Raw"){
-            ytitle <- glue::glue("{ytitle}, norm.: {r$norm1()}")
+          if(input$custom_ytitle == "None"){
+            tt <- stringr::str_split(FEAT[i], "__")
+            print(tt)
+            ytitle <- sapply(tt,"[[",2)
+            print(ytitle)
+            if(r$wgt1() != "Raw"){
+              ytitle <- glue::glue("{ytitle}, weight: {r$wgt1()}")
+            }
+            if(r$norm1() != "Raw"){
+              ytitle <- glue::glue("{ytitle}, norm.: {r$norm1()}")
+            }
+
+          }else{
+            ytitle <- input$custom_ytitle
           }
           
           fun <-  glue::glue('tabfeat0 = tabF_melt2[tabF_melt2$features == FEAT[i],] %>% 
@@ -336,7 +327,8 @@ mod_boxplots_server <- function(id, r = r, session = session){
           
           fun <-  glue::glue('listP[[FEAT[i]]] <- ggplot(tabfeat, aes(x = {fact3ok}, y = value, fill = {fact3ok})) + 
         geom_boxplot(fill = "#99AFE3") + theme_bw() + xlab("Condition") + ylab(ytitle) + ggtitle(FEAT[i]) +
-        theme(legend.position = "None", axis.text.x = element_text(angle = 45, hjust=1))')
+        theme(legend.position = "None", axis.text.x = element_text(angle = 45, hjust=1))  + 
+        labs(fill="")')
           eval(parse(text=fun))
 
           if(input$outlier_labs){
diff --git a/R/mod_inputs.R b/R/mod_inputs.R
index 519c407..eeed9e5 100644
--- a/R/mod_inputs.R
+++ b/R/mod_inputs.R
@@ -158,10 +158,10 @@ mod_inputs_server <- function(id, r = r, session = session){
 
 
       data <- reactive({
-        # imported$data()
+        imported$data()
         
         # dev
-        read.csv("~/repository/graphstatsr/data_test/metabo_all_data_special.csv", sep ="\t")
+        # read.csv("~/repository/graphstatsr/data_test/metabo_all_data_special.csv", sep ="\t")
       })
 
       # output$datainput <- renderPrint({
@@ -230,10 +230,10 @@ mod_inputs_server <- function(id, r = r, session = session){
 
 
       data2 <- reactive({
-        # imported2$data()
+        imported2$data()
         
         # dev
-        read.csv("~/repository/graphstatsr/data_test/metadata_metabo.csv", sep =",")
+        # read.csv("~/repository/graphstatsr/data_test/metadata_metabo.csv", sep ="\t")
       })
 
       res_filter2 <- filter_data_server(
-- 
GitLab


From fbd5b8a1ec2247a976bd6ab9cd3707b82db937ef Mon Sep 17 00:00:00 2001
From: Etienne Rifa <etienne.rifa[at]insa-toulouse.fr>
Date: Wed, 20 Apr 2022 10:54:46 +0200
Subject: [PATCH 14/14] desc

---
 DESCRIPTION | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/DESCRIPTION b/DESCRIPTION
index ced892c..09810c6 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -17,6 +17,7 @@ Imports:
     glue,
     golem (>= 0.3.1),
     gridExtra,
+    htmltools,
     plotly,
     reshape2,
     rhdf5,
@@ -25,6 +26,7 @@ Imports:
     shinyBS,
     shinydashboard,
     shinyWidgets,
+    sortable,
     stats,
     stringr,
     tibble,
-- 
GitLab