add boxplot customisation according to VRI ask

Dockerfile

@@ -21,6 +21,7 @@ RUN R -e 'remotes::install_cran("RSelenium")'
 RUN R -e 'remotes::install_cran("Rlabkey")'
 RUN R -e 'remotes::install_cran("RColorBrewer")'
 RUN R -e 'remotes::install_cran("shinyWidgets")'
+RUN R -e 'remotes::install_cran("colourpicker")'
 #RUN R -e 'remotes::install_cran("golem")'
 RUN R -e 'install.packages("golem")'
 COPY vici_*.tar.gz /app.tar.gz

R/boxplot_VICI.R

@@ -18,23 +18,15 @@
 #'@import ggplot2
 #'@import ggpubr
 #'@import RColorBrewer
+#'@import rlang
 
 boxplot_VICI <- function(data_df, pval_2plot, response_name, input, inter=TRUE, baseline=NULL,fill=FALSE){
 
   if(!is.numeric(data_df$response)){
     data_df$response <- as.numeric(data_df$response)
   }
 
-  listRowClass <<- unique(data_df$time)
-  listCol <- c()
-  for (x in 1:length(listRowClass)) {
-    #browser()
-    cat(paste("\n color of ",listRowClass[x]))
-    #browser()
-    cat(input[[paste0("color",listRowClass[x])]])
-    #newColor <- list(input[[paste0("color",listRowClass[x])]])
-    listCol <- c(listCol,input[[paste0("color",listRowClass[x])]])
-  }
+
 
   p <- NULL
   #browser()
@@ -52,10 +44,20 @@ boxplot_VICI <- function(data_df, pval_2plot, response_name, input, inter=TRUE,
       listCol <- c(listCol,input[[paste0("color",listRowClass[x])]])
     }
 
+    listShape <- c()
+    for (x in 1:length(listRowClass)) {
+      #browser()
+      cat(paste("\n shape of ",listRowClass[x]))
+      cat(input[[paste0("shape",listRowClass[x])]])
+      #newColor <- list(input[[paste0("color",listRowClass[x])]])
+      #browser()
+      listShape <- c(listShape,rlang::as_string(input[[paste0("shape",listRowClass[x])]]))
+    }
+
     data_df$arm <- relevel(data_df$arm, ref=input$selectRefArmInter)
     suppressWarnings(
       if(input$jiter == "None"){
-        browser()
+        #browser()
         p <- ggboxplot(na.omit(data_df), x="stim", y="response", color= "arm", palette = "RdGy",fill = "stim",#c("Red","Blue","Black"),#"RdBu",
                        #fill="white",#"arm",
                        alpha=0.3,)+
@@ -80,11 +82,12 @@ boxplot_VICI <- function(data_df, pval_2plot, response_name, input, inter=TRUE,
                   #fill="white",#"arm",
                   alpha=0.3,
                   add="jitter",
-                  shape = as.numeric(input$jiter))+
+                  shape = "arm")+#as.numeric(input$jiter))+
         #theme_bw() +
         theme_grey() + 
         theme(panel.grid.major.x = element_blank()) +
         scale_colour_manual(values = listCol) +
+        scale_shape_manual(values = listShape) +
         #scale_color_brewer(palette = input$color) +#"RdGy") +
         #scale_fill_viridis_d("Arm: ") +
         #scale_color_viridis_d("Arm: ") +
@@ -116,6 +119,30 @@ boxplot_VICI <- function(data_df, pval_2plot, response_name, input, inter=TRUE,
     #browser()
 
     data_df$time <- relevel(data_df$time, ref=input$selectRefTimeIntra)
+
+    listRowClass <<- unique(data_df$time)
+    #browser()
+
+    listCol <- c()
+    for (x in 1:length(listRowClass)) {
+      #browser()
+      cat(paste("\n color of ",listRowClass[x]))
+      #browser()
+      cat(input[[paste0("color",listRowClass[x])]])
+      #newColor <- list(input[[paste0("color",listRowClass[x])]])
+      listCol <- c(listCol,input[[paste0("color",listRowClass[x])]])
+    }
+
+    listShape <- c()
+    for (x in 1:length(listRowClass)) {
+      #browser()
+      cat(paste("\n shape of ",listRowClass[x]))
+      cat(input[[paste0("shape",listRowClass[x])]])
+      #newColor <- list(input[[paste0("color",listRowClass[x])]])
+      #browser()
+      listShape <- c(listShape,rlang::as_string(input[[paste0("shape",listRowClass[x])]]))
+    }
+
     #browser()
     #suppressWarnings(
     if(input$jiter == "None"){
@@ -142,12 +169,13 @@ boxplot_VICI <- function(data_df, pval_2plot, response_name, input, inter=TRUE,
                      #fill="white",#"arm",
                      alpha=0.3,
                      add="jitter",
-                     shape = as.numeric(input$jiter))+
+                     shape = "time")+#as.numeric(input$jiter))+
 
         #theme_bw() +
         theme_grey() + 
         theme(panel.grid.major.x = element_blank()) +
         scale_colour_manual(values = listCol) +
+        scale_shape_manual( values = listShape)+
         #scale_color_brewer(palette = input$color)+#"RdGy") +
         #scale_fill_viridis_d("Time-point: ") +
         #scale_color_viridis_d("Time-point: ") +

R/mod_settings_pan.R

@@ -236,6 +236,7 @@ mod_settings_pan_ui <- function(id){
                                Empty = "1",
                                None = "None"),
                    selected = "19"),
+      uiOutput(ns("shapes")),
 
       tags$hr(),
       h3("Run analysis"),
@@ -710,6 +711,33 @@ mod_settings_pan_server <- function(input, output, session,datas,parent){
           #cat(str(BoxPlotColors))
           do.call(tagList,color)
         })
+        cat("Jitter: ")
+        cat(input$jiter,"\n")
+        cat(input$jiter != "None")
+        #browser()
+        if(input$jiter != "None"){
+          cat("\n ENTER THE VOID \n")
+          output$shapes <- renderUI({
+            #browser()
+            #map(listRowClass(),)
+            shapes <- lapply(listRowClass, function(i){
+              cat(paste0("Create shape",i,"\n"))
+              pickerInput(inputId = ns(paste0("shape",i)),
+                          label = paste("Shape for",i),
+                          choices = listShape <- list("circle","square","diamond","cross"),
+                          selected = "circle",
+                          choicesOpt = list(content = c(sprintf("<img src='./shapes/circle.png' width=30px><div class='jhr'>%s</div></img>", "circle"),#ok
+                                                        sprintf("<img src='./shapes/square.png' width=30px><div class='jhr'>%s</div></img>", "square"),#ok
+                                                        sprintf("<img src='./shapes/diamond.png' width=30px><div class='jhr'>%s</div></img>", "diamond"),#ok
+                                                        sprintf("<img src='./shapes/cross.png' width=30px><div class='jhr'>%s</div></img>", "cross")#ok
+                          )
+                          )
+              )
+            })
+            #cat(str(BoxPlotColors))
+            do.call(tagList,shapes)
+          })
+        }
 
         datas$df[, input$selectTimeIntra] <- as.factor(as.character(datas$df[, input$selectTimeIntra]))
         selected_time_var <- datas$df[, input$selectTimeIntra]
@@ -762,6 +790,33 @@ mod_settings_pan_server <- function(input, output, session,datas,parent){
         #cat(str(BoxPlotColors))
         do.call(tagList,color)
       })
+      cat("Jitter: ")
+      cat(input$jiter,"\n")
+      cat(input$jiter != "None")
+      #browser()
+      if(input$jiter != "None"){
+        cat("\n ENTER THE VOID \n")
+        #browser()
+        output$shapes <- renderUI({
+          #map(listRowClass(),)
+          shapes <- lapply(listRowClass, function(i){
+            cat(paste0("Create shape",i,"\n"))
+            pickerInput(inputId = ns(paste0("shape",i)),
+                        label = paste("Shape for",i),
+                        choices = listShape <- list("circle","square","diamond","cross"),
+                        selected = "circle",
+                        choicesOpt = list(content = c(sprintf("<img src='./shapes/circle.png' width=30px><div class='jhr'>%s</div></img>", "circle"),#ok
+                                                      sprintf("<img src='./shapes/square.png' width=30px><div class='jhr'>%s</div></img>", "square"),#ok
+                                                      sprintf("<img src='./shapes/diamond.png' width=30px><div class='jhr'>%s</div></img>", "diamond"),#ok
+                                                      sprintf("<img src='./shapes/cross.png' width=30px><div class='jhr'>%s</div></img>", "cross")#ok
+                        )
+                        )
+            )
+          })
+          #cat(str(BoxPlotColors))
+          do.call(tagList,shapes)
+        })
+      }
 
       if(input$selectTimeInter %in% colnames(datas$df)){
         datas$df[, input$selectTimeInter] <- as.factor(as.character(datas$df[, input$selectTimeInter]))