Shiny: Dynamic colour (fill) input for ggplot

Question

i do need some help as the post: Dynamic color input in shiny server does not give full answer to my problem.

I would like to have dynamic colour (fill) selection in my shiny app. I have prepared a sample code:

library(shiny)
library(shinyjs)
library(reshape2)
library(ggplot2)

dat <- data.frame(matrix(rnorm(60, 2, 3), ncol=3))
dat <- melt(dat)

runApp(shinyApp(
  ui = fluidPage(
    selectizeInput("select","Select:", choices=as.list(levels(dat$variable)), selected="X1",multiple =TRUE),
    uiOutput('myPanel'),
    plotOutput("plot"),
    downloadButton('downloadplot',label='Download Plot')
  ),
  server = function(input, output, session) {
    cols <- reactive({
      lapply(seq_along(unique(input$select)), function(i) {
        colourInput(paste("col", i, sep="_"), "Choose colour:", "black")        
      })
    })

    output$myPanel <- renderUI({cols()})

    cols2 <- reactive({        
      if (is.null(input$col_1)) {
        cols <- rep("#000000", length(input$select))
      } else {
        cols <- unlist(colors())
      }
      cols})

    testplot <- function(){
      dat <- dat[dat$variable %in% input$select, ]
      ggplot(dat, aes(x=variable,y=value, fill=cols2()[1])) + geom_boxplot()}

    output$plot <- renderPlot({testplot()})

    output$downloadplot <- downloadHandler(
      filename ="plot.pdf",
      content = function(file) {
        pdf(file, width=12, height=6.3)
        print(testplot())
        dev.off()
      })
  }
))

I would like the user to choose fill colour of the boxplot. The number of colour widgets will appear according to number of selected variables in selectizeInput("select".... Till this point everything is working perfectly, however going further i am not able to figure out how to apply this colour to the ggplot, etc...

Here are my questions:

1. How i can connect the fill colour to ggplot correctly

2. Can i make the default colour of colourInput() correspond to the default colour palette (not to one colour --> in my case is black)

3. Instead of Choose colour text in colourInput(paste("col", i, sep="_"), "Choose colour:", i would love to have the corresponding name (choosen variable from selectizeInput) of the variable (in this case X1, X2 and X3)

4. I would like as well to have a button which could reset all the choosen colours

Thank You all in advance and i hope this can be solved

Cheers

Answer 1

These are very nice and concrete questions and I'm glad to, hopefully, answer them :)

1. How i can connect the fill colour to ggplot correctly

In this case the best way, I think, is to fill boxes according to the variable (which is reactive) and to add a new layer scale_fill_manual in which you specify custom colours for different boxes. The number of colours has to be obviously equal to the number of levels of variable. This is probably the best way because you will always have a correct legend.

ggplot(dat, aes(x = variable, y = value, fill = variable)) + 
          geom_boxplot() +
          scale_fill_manual(values = cols)

---

2. Can i make the default colour of colourInput() correspond to the default colour palette (not to one colour --> in my case is black)

Of course, you can do it.

First, you need to know the default colours for discrete variables that ggplot uses. To generate these colours we will use a function gg_color_hue found in this nice discussion. I've changed its name to gg_fill_hue to follow a ggplot convention.

We can code everything within renderUI where we first specify the selected levels/variables. To get rid of unambiguity which would be caused due to dynamically (and possibly in a different order) generated widgets, we sort the names of levels/variables.

Then we generate appropriate number of default colours with gg_fil_hue and assign them to the appropriate widget.

To make things easier, we change the IDs of these widgets to col + "varname" which is given by input$select

output$myPanel <- renderUI({ 
      lev <- sort(unique(input$select)) # sorting so that "things" are unambigious
      cols <- gg_fill_hue(length(lev))

      # New IDs "colX1" so that it partly coincide with input$select...
      lapply(seq_along(lev), function(i) {
        colourInput(inputId = paste0("col", lev[i]),
                    label = paste0("Choose colour for ", lev[i]), 
                    value = cols[i]
        )        
      })
    })

---

3.Instead of Choose colour text in colourInput(paste("col", i, sep="_"), "Choose colour:", i would love to have the corresponding name (choosen variable from selectizeInput) of the variable (in this case X1, X2 and X3)

It is done in the code above as well - simple pasting.

---

Now, let's take a look at a very important issue that arises due to dynamical number of generated widgets. We have to set the colours of boxes according to a unique colorInput and there may by 1,2 or even 10 those inputs.

A very nice way of approaching this problem, I believe, is to create a character vector with elements specifying how we would normally access these widgets. In the example below this vector looks as follows: c("input$X1", "input$X2", ...).

Then using non-standard evaluation (eval, parse) we can evaluate these inputs to get a vector with selected colours which we then pass to scale_fill_manual layer.

To prevent errors that may arise between selections, we will use the function `req´ to make sure that the length of the vector with colours is the same as the length of the selected levels/variables.

output$plot <- renderPlot({
        cols <- paste0("c(", paste0("input$col", sort(input$select), collapse = ", "), ")")
        # print(cols)
        cols <- eval(parse(text = cols))
        # print(cols)

        # To prevent errors
        req(length(cols) == length(input$select))

        dat <- dat[dat$variable %in% input$select, ]
        ggplot(dat, aes(x = variable, y = value, fill = variable)) + 
          geom_boxplot() +
          scale_fill_manual(values = cols)

    })

---

4. I would like as well to have a button which could reset all the choosen colours

After defining the actionButton on the client side with an ID="reset" we create an observer that's going to update colorInputs.

Our goal is to return a list with updateColourInput with an appropriate parametrisation for each available colourInput widget.

We define a variable with all chosen levels/variables and generate an appropriate number of default colours. We again sort the vector to avoid ambiguity.

Then we use lapply and do.call to call a updateColourInput function with specified parameters that are given as a list.

observeEvent(input$reset, {
      # Problem: dynamic number of widgets
      # - lapply, do.call

      lev <- sort(unique(input$select))
      cols <- gg_fill_hue(length(lev))

      lapply(seq_along(lev), function(i) {
              do.call(what = "updateColourInput",
                      args = list(
                        session = session,
                        inputId = paste0("col", lev[i]),
                        value = cols[i]
                      )
              )
      })
    })

---

Full Example:

library(shiny)
library(shinyjs)
library(reshape2)
library(ggplot2)

dat <- data.frame(matrix(rnorm(60, 2, 3), ncol=3))
dat <- melt(dat)

# Function that produces default gg-colours is taken from this discussion:
# https://stackoverflow.com/questions/8197559/emulate-ggplot2-default-color-palette
gg_fill_hue <- function(n) {
  hues = seq(15, 375, length = n + 1)
  hcl(h = hues, l = 65, c = 100)[1:n]
}

runApp(shinyApp(
  ui = fluidPage(
    selectizeInput("select", "Select:", 
                   choices = as.list(levels(dat$variable)), 
                   selected = "X1", 
                   multiple = TRUE), 
    uiOutput('myPanel'),
    plotOutput("plot"),
    downloadButton('downloadplot', label = 'Download Plot'),
    actionButton("reset", "Default colours", icon = icon("undo"))
  ),
  server = function(input, output, session) {

    output$myPanel <- renderUI({ 
      lev <- sort(unique(input$select)) # sorting so that "things" are unambigious
      cols <- gg_fill_hue(length(lev))

      # New IDs "colX1" so that it partly coincide with input$select...
      lapply(seq_along(lev), function(i) {
        colourInput(inputId = paste0("col", lev[i]),
                    label = paste0("Choose colour for ", lev[i]), 
                    value = cols[i]
        )        
      })
    })


    output$plot <- renderPlot({
      cols <- paste0("c(", paste0("input$col", sort(input$select), collapse = ", "), ")")
      # print(cols)
      cols <- eval(parse(text = cols))
      # print(cols)

      # To prevent errors
      req(length(cols) == length(input$select))

      dat <- dat[dat$variable %in% input$select, ]
      ggplot(dat, aes(x = variable, y = value, fill = variable)) + 
        geom_boxplot() +
        scale_fill_manual(values = cols)

    })


    observeEvent(input$reset, {
      # Problem: dynamic number of widgets
      # - lapply, do.call

      lev <- sort(unique(input$select))
      cols <- gg_fill_hue(length(lev))

      lapply(seq_along(lev), function(i) {
        do.call(what = "updateColourInput",
                args = list(
                  session = session,
                  inputId = paste0("col", lev[i]),
                  value = cols[i]
                )
        )
      })
    })




    output$downloadplot <- downloadHandler(
      filename = "plot.pdf",
      content = function(file) {
        pdf(file, width = 12, height = 6.3)
        print(testplot())
        dev.off()
      })
  }
))