0

I have a shinyApp that allows the user to create a barplot and dynamically select the colors of the plot.

As you can see, this app is working fine, however, as the colors are represented by the Hex code, there is no really a way of telling which color is it until you have plot it, hece I would like a way to improve the display of the colors selection.

In the webpage (https://ssc.wisc.edu/shiny/users/jstruck2/colorpicker/) there is an example of what I want, although there is no code.

And here you can find a RepEx of my app.

# Shiny
library(shiny)
library(shinyWidgets)
library(shinyjqui)
library(shinyjs)
library(DT)

# Data
library(readxl)
library(dplyr)
library(vcd)

# Plots
library(ggplot2)

not_sel <- "Not Selected"

ui <- navbarPage(
  title = "Plotter",
  windowTitle = "Plotter",
  tabPanel(
    "Plotter",
    fluidPage(
      fluidRow(
        sidebarPanel(
          title = "Inputs",
          fileInput("xlsx_input", "Select XLSX file to import", accept = c(".xlsx")),
          selectInput("num_var_1", "Variable X axis", choices = c(not_sel)),
          selectInput("num_var_2", "Variable Y axis", choices = c(not_sel)),
          br(),
          actionButton("run_button", "Run Analysis", icon = icon("play"))
        ),
        
        # Main panel
        mainPanel(
          tabsetPanel(
            tabPanel(
              "Plot",
              br(),
              plotOutput("plot_1"),
              uiOutput("factor"),
            ) 
          )
        )
      )
    )
  )
)

################# --------------------------------------------------------------
# Server
################# --------------------------------------------------------------
server <- function(input, output){
  
  # Dynamic selection of the data 
  data_input <- reactive({
    #req(input$xlsx_input)
    #inFile <- input$xlsx_input
    #read_excel(inFile$datapath, 1)
    Arthritis
  })
  
  # We update the choices available for each of the variables
  observeEvent(data_input(),{
    choices <- c(not_sel, names(data_input()))
    updateSelectInput(inputId = "num_var_1", choices = choices)
    updateSelectInput(inputId = "num_var_2", choices = choices)
  })
  
  num_var_1 <- eventReactive(input$run_button, input$num_var_1)
  num_var_2 <- eventReactive(input$run_button, input$num_var_2)
  
  # data
  data_discrete_plot <- reactive({
    req(data_input(), input$num_var_1, input$num_var_2) 
    df <- data_input()
    df1 <- as.data.frame(prop.table(table(df[[input$num_var_1]], df[[input$num_var_2]]), margin = 1))
    df1
  })
  
  output$factor <- renderUI({
    #req(input$num_var_2,data_input())
    if (is.null(input$num_var_2) | (input$num_var_2=="Not Selected")) return(NULL)
    df <- data_input()
    uvalues <- unique(df[[input$num_var_2]])
    n <- length(uvalues)
    choices <- as.list(uvalues)
    myorder  <- as.list(1:n)
    mycolors <- list("#727CA3", "#464653", "#638CAE", "#836A61", "#889328", "#F5AF22", "#DF564B", "#6B4A8C", "#CE7EB8")
    nk <- length(mycolors)  ## to repeat colors when there are more bars than the number of colors
    tagList(
      div(br()),
      div(
        lapply(1:n, function(i){
          k <- i %% nk
          if (k==0) k=nk
          pickerInput(paste0("colorvar",i),
                      label = paste0(uvalues[i], ": " ),
                      choices = list(# DisplayOrder = myorder,
                        FillColor = mycolors),
                      selected = list( i, mycolors[[k]]),
                      multiple = T,
                      options = list('max-options-group' = 1, `style` = "btn-primary"))
        })
      )
    )
    
  })
  
  #observe({print(input$colorvar1)})
  
  output$t1 <- renderDT(data_discrete_plot())
  # Function for printing the plots
  
  draw_barplot <- function(data_input) {
    n <- length(unique(data_input[,"Var2"]))
    val <- list()
    myvaluesx <- lapply(1:n, function(i) {
      input[[paste0("colorvar",i)]]
      if (i==1) val <- list(input[[paste0("colorvar",i)]])
      else val <- list(val,input[[paste0("colorvar",i)]])
    })
    print(myvaluesx)
    ggplot(data = data_input, aes(x = Var1, y = Freq, fill = factor(Var2), label = round(Freq, 3))) +
      geom_bar(stat = "identity") +
      #scale_fill_discrete(guide = guide_legend(fill = myvaluesx, reverse = TRUE)) +
      scale_fill_manual(values = unlist(myvaluesx)) +
      ylim(0, 1) +
      theme_bw()
  }
  
  ## BarPlot -------------------------------------------------------------------
  plot_1 <- eventReactive(input$run_button,{
    req(data_input())
    draw_barplot(data_discrete_plot())
  })
  
  output$plot_1 <- renderPlot(plot_1())
}

# Connection for the shinyApp
shinyApp(ui = ui, server = server)


Dawit Zuri
  • 15
  • 4
  • Perhaps you would be interested in the `colourpicker` package? [github link](https://github.com/daattali/colourpicker) – Ben Jan 09 '22 at 18:29
  • One option would be to use a named list or following https://stackoverflow.com/questions/63255906/change-colour-of-pickerinput-items-in-shiny you could set the background or text colors in the dropdown menus. – stefan Jan 09 '22 at 18:47

0 Answers0