r - Shiny: Dynamic colour (fill) input for ggplot -

i need post: dynamic color input in shiny server not give full answer problem.

i have dynamic colour (fill) selection in shiny app. have prepared 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 user choose fill colour of boxplot. number of colour widgets appear according number of selected variables in selectizeinput("select".... till point working perfectly, going further not able figure out how apply colour ggplot, etc...

here questions:

1. how can connect fill colour ggplot correctly

2. can make default colour of colourinput() correspond default colour palette (not 1 colour --> in case black)

3. instead of choose colour text in colourinput(paste("col", i, sep="_"), "choose colour:", love have corresponding name (choosen variable selectizeinput) of variable (in case x1, x2 , x3)

4. i have button reset all choosen colours

thank in advance , hope can solved

cheers

these nice , concrete questions , i'm glad to, hopefully, answer them :)

1. how can connect fill colour ggplot correctly

in case best way, think, fill boxes according variable (which reactive) , add new layer scale_fill_manual in specify custom colours different boxes. number of colours has equal number of levels of variable. best way because have correct legend.

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

---

2. can make default colour of colourinput() correspond default colour palette (not 1 colour --> in case black)

of course, can it.

first, need know default colours discrete variables ggplot uses. generate these colours use function gg_color_hue found in this nice discussion. i've changed name gg_fill_hue follow ggplot convention.

we can code within renderui first specify selected levels/variables. rid of unambiguity caused due dynamically (and possibly in different order) generated widgets, sort names of levels/variables.

then generate appropriate number of default colours gg_fil_hue , assign them appropriate widget.

to make things easier, change ids of these widgets col + "varname" given input$select

output$mypanel <- renderui({        lev <- sort(unique(input$select)) # sorting "things" unambigious       cols <- gg_fill_hue(length(lev))        # new ids "colx1" partly coincide input$select...       lapply(seq_along(lev), function(i) {         colourinput(inputid = paste0("col", lev[i]),                     label = paste0("choose colour ", lev[i]),                      value = cols[i]         )               })     }) 

---

3.instead of choose colour text in colourinput(paste("col", i, sep="_"), "choose colour:", love have corresponding name (choosen variable selectizeinput) of variable (in case x1, x2 , x3)

it done in code above - simple pasting.

---

now, let's take @ important issue arises due dynamical number of generated widgets. have set colours of boxes according unique colorinput , there may 1,2 or 10 inputs.

a nice way of approaching problem, believe, create character vector elements specifying how access these widgets. in example below vector looks follows: c("input$x1", "input$x2", ...).

then using non-standard evaluation (eval, parse) can evaluate these inputs vector selected colours pass scale_fill_manual layer.

to prevent errors may arise between selections, use function `req´ make sure length of vector colours same length of 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)          # 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 have button reset choosen colours

after defining actionbutton on client side id="reset" create observer that's going update colorinputs.

our goal return list updatecolourinput appropriate parametrisation each available colourinput widget.

we define variable chosen levels/variables , generate appropriate number of default colours. again sort vector avoid ambiguity.

then use lapply , do.call call updatecolourinput function specified parameters given 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 produces default gg-colours taken 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 "things" unambigious       cols <- gg_fill_hue(length(lev))        # new ids "colx1" partly coincide input$select...       lapply(seq_along(lev), function(i) {         colourinput(inputid = paste0("col", lev[i]),                     label = paste0("choose colour ", 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)        # 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()       })   } ))