add possibility to order boxplot X axis by mean or not

Aucomte · Mar 19, 2020 · 5b55239 · 5b55239
1 parent 16ec580
commit 5b55239
Show file tree

Hide file tree

Showing 3 changed files with 23 additions and 6 deletions.
diff --git a/inst/app/global.R b/inst/app/global.R
@@ -411,9 +411,21 @@ GraphTime <- function(tab,tim,var1,var2,var3,var4,timeselecter, smoothing){
 #---------------------------------------
 #visu
 
-NiceGraph <-  function(tab,var1,var2,var3,var4){
+NiceGraph <-  function(tab,var1,var2,var3,var4, order){
   tab = as.data.frame(tab)
-  p <- ggplot(data=tab, aes(x=reorder(tab[,var2], as.numeric(as.character(tab[,var1])),FUN = median), y=as.numeric(as.character(tab[,var1])))) + geom_boxplot()
+  if (order == TRUE){
+    p <- ggplot(data=tab, aes(x=reorder(tab[,var2], as.numeric(as.character(tab[,var1])),FUN = median), y=as.numeric(as.character(tab[,var1])))) + geom_boxplot()
+  }
+  else{
+    listX = vector()
+    for (i in 1:nrow(tab)){
+      if (!(as.character(tab[i,var2]) %in% listX)){
+        listX[length(listX)+1] = as.character(tab[i,var2])
+      }
+    }
+    tab[,var2] = factor(tab[,var2], levels = listX)
+    p <- ggplot(data=tab, aes(x=tab[,var2], y=as.numeric(as.character(tab[,var1])))) + geom_boxplot()
+  }
   if(var3 != "None" && !is.null(var3) && var3 !=""){
     p <- p + geom_jitter(aes(colour=tab[,var3]),width = 0.2)
   }

diff --git a/inst/app/server.R b/inst/app/server.R
@@ -97,6 +97,7 @@ server <-function(input,output,session){
     factorPG1 = NULL,
     factorPG2 = NULL,
     factorPG3 = NULL,
+    OrderX = TRUE,
 
     # panel 7 : Barplot
 
@@ -868,7 +869,7 @@ Then, you need to choose a quantitative response variable (ex: Lenght)"
   # panel 6 : Visu
 
   outVisu <- function(){
-    x = NiceGraph(sr$tableF,sr$responseVarPG,sr$factorPG1,sr$factorPG2,sr$factorPG3)
+    x = NiceGraph(sr$tableF,sr$responseVarPG,sr$factorPG1,sr$factorPG2,sr$factorPG3,sr$OrderX)
     return(x)
   }
 
@@ -884,10 +885,13 @@ Then, you need to choose a quantitative response variable (ex: Lenght)"
   observeEvent(input$factorPG3, {
     sr$factorPG3 = input$factorPG3
   })
-  observeEvent(c(sr$responseVarPG,sr$factorPG1,sr$factorPG2,sr$factorPG3), ignoreInit = TRUE, {
+  observeEvent(input$OrderX, {
+    sr$OrderX = input$OrderX
+  })
+  observeEvent(c(sr$responseVarPG,sr$factorPG1,sr$factorPG2,sr$factorPG3,sr$OrderX), ignoreInit = TRUE, {
     if(sr$booTable==1){
       output$PrettyG <- renderPlot({
-        NiceGraph(sr$tableF,sr$responseVarPG,sr$factorPG1,sr$factorPG2,sr$factorPG3)
+        NiceGraph(sr$tableF,sr$responseVarPG,sr$factorPG1,sr$factorPG2,sr$factorPG3,sr$OrderX)
       })
     }
     else{

diff --git a/inst/app/ui.R b/inst/app/ui.R
@@ -500,7 +500,8 @@ body <- dashboardBody(
           pickerInput(inputId='factorPG1', label ='Select the factor for the x-axis (x)', ""),
 ##TODO: May be? Currently this will color the points based on the factor. But the expected behavior should be to color the boxplots, shouldn't it?
           pickerInput(inputId='factorPG2', label ='Select a factor for coloring based on its levels (fill)', ""),
-          pickerInput(inputId='factorPG3', label ='Select a third factor to generate one plot per level of this factor in a grid', "")
+          pickerInput(inputId='factorPG3', label ='Select a third factor to generate one plot per level of this factor in a grid', ""),
+          checkboxInput("OrderX", "Order the X axis by median", TRUE)
         )
       ),
       fluidRow(