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)