允许用户在 r shiny plots 中选择颜色
Allow user for color selection in rshiny plots
我的 shinyApp 为一个连续变量和一个分类变量生成箱线图。
我希望用户能够 select 箱线图的颜色。
为此，方法是根据分类变量的类别数生成颜色选择器，
然后，select
到目前为止，我所做的是使用 renderUI 渲染颜色，然后在箱线图函数中允许 selection。
但是，这个函数内部有些东西不能正常工作draw_boxplot <- function(data_input, num_var_1, num_var_2, biomarker){
因为这个错误是在控制台提示的。
代码如下：
library(shiny)
library(shinyWidgets)
library(shinyjqui)
library(bslib)
library(shinybusy) # For busy spinners
library(shinyjs)
# Data
library(readxl)
library(dplyr)
library(tidyr) # to drop na
# Plots
library(ggplot2)
not_sel <- "Not Selected"
ui <- navbarPage(
tabPanel(
useShinyjs(),
title = "",
titlePanel(""),
sidebarLayout(
sidebarPanel(
title = "Inputs",
fileInput("csv_input", "Select CSV file to import", accept = c(".csv")),
selectInput("num_var_1", "Variable name", choices = c(not_sel)),
selectInput("num_var_2", "Variable name", choices = c(not_sel)),
actionButton("run_button", "Display", icon = icon("play")),
),
mainPanel(
tabsetPanel(
tabPanel(
title = "Plot",
br(),
plotOutput("sel_graph"),
br(),
### Fluid Row
#tags$head(tags$style(HTML('.irs-from, .irs-to, .irs-min, .irs-max, .irs-single {visibility: hidden !important;}'))),
shinyjs::hidden(
div(
id = "sliders",
fluidRow(
column(4, div(style = "height:140px"),
h4("Select colors"),
uiOutput("colors")
)
)
)
)
)
)
)
)
)
)
server <- function(input, output, session){
# Dynamic selection of the data
data_input <- reactive({
#req(input$csv_input)
#inFile <- input$csv_input
#read.csv(inFile$datapath, 1)
iris
})
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)
# Render colors for boxplot
output$colors <- renderUI({
#req(input$num_var_2,data_input())
if (is.null(input$num_var_1) | (input$num_var_1=="Not Selected")) return(NULL)
df <- data_input()
uvalues <- unique(df[[input$num_var_1]])
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"))
})
)
)
})
## Obtain plots dynamically -----------------------
draw_boxplot <- function(data_input, num_var_1, num_var_2, biomarker){
n <- length(unique(data_input()[, input$num_var_1()]))
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)]])
})
ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]])) +
geom_boxplot(values = unlist(myvaluesx)) +
theme_bw()
}
## First we create another dataframe that will be use in the new plot
data_raw_plot <- reactive({
req(data_input(), input$num_var_1)
df <- data_input()
df
})
## BoxPlot
plot_1 <- eventReactive(input$run_button,{
req(data_raw_plot())
draw_boxplot(data_raw_plot(), num_var_1(), num_var_2())
})
output$sel_graph <- renderPlot({
plot_1()
})
observeEvent(input$run_button, {
shinyjs::show("sliders")
})
}
shinyApp(ui = ui, server = server)
这里有几个问题。如果 pickerInput() 被隐藏，您的颜色选择在开始时为空，因此您不能在绘图中使用这些颜色。此外，作为选项列表中的 multiple = T，您需要使用 input$colorvar1[[1]] 而不是 input$colorvar1。完整的工作代码：
not_sel <- "Not Selected"
ui <- navbarPage(
tabPanel(
useShinyjs(),
title = "",
titlePanel(""),
sidebarLayout(
sidebarPanel(
title = "Inputs",
fileInput("csv_input", "Select CSV file to import", accept = c(".csv")),
selectInput("num_var_1", "Variable name", choices = c(not_sel)),
selectInput("num_var_2", "Variable name", choices = c(not_sel)),
actionButton("run_button", "Display", icon = icon("play")),
),
mainPanel(
tabsetPanel(
tabPanel(
title = "Plot",
br(),
plotOutput("sel_graph"),
br(),
### Fluid Row
#tags$head(tags$style(HTML('.irs-from, .irs-to, .irs-min, .irs-max, .irs-single {visibility: hidden !important;}'))),
#shinyjs::hidden(
div(
id = "sliders",
fluidRow(
column(4, div(style = "height:140px"),
h4("Select colors"),
uiOutput("colors")
)
)
)
#)
)
)
)
)
)
)
server <- function(input, output, session){
# Dynamic selection of the data
data_input <- reactive({
#req(input$csv_input)
#inFile <- input$csv_input
#read.csv(inFile$datapath, 1)
iris
})
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)
# Render colors for boxplot
output$colors <- renderUI({
#req(input$num_var_1,data_input())
if (is.null(input$num_var_1) | (input$num_var_1=="Not Selected")) return(NULL)
df <- data_input()
uvalues <- unique(df[[input$num_var_1]])
n <- length(uvalues)
choices <- as.list(uvalues)
myorder <- as.list(1:n)
#mycolors <- list("#727CA3", "#464653", "#638CAE", "#836A61", "#889328", "#F5AF22", "#DF564B", "#6B4A8C", "#CE7EB8")
mycolors <- list("red","blue","green","pink","orange")
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(mycolors[[k]]),
multiple = T,
options = list('max-options-group' = 1, `style` = "btn-primary"))
})
)
)
})
## Obtain plots dynamically -----------------------
draw_boxplot <- function(data_input, num_var_1, num_var_2){
n <- length(unique(data_input()[,num_var_1]))
val <- list()
myvaluesx <- lapply(1:n, function(i) {
req(input[[paste0("colorvar",i)]])
if (i==1) val <- list(input[[paste0("colorvar",i)]])
else val <- list(val,input[[paste0("colorvar",i)]])
})
ggplot(data = data_input(), aes(x = .data[[num_var_1]], y = .data[[num_var_2]]) ) +
geom_boxplot(aes(fill=.data[[num_var_1]])) +
scale_fill_manual(values=unlist(myvaluesx)) +
theme_bw()
}
## First we create another dataframe that will be use in the new plot
data_raw_plot <- reactive({
req(data_input(), input$num_var_1)
df <- data_input()
df
})
## BoxPlot
plot_1 <- eventReactive(input$run_button,{
req(data_raw_plot(),num_var_1(),num_var_2())
draw_boxplot(data_raw_plot, num_var_1(), num_var_2())
})
output$sel_graph <- renderPlot({
plot_1()
})
# observeEvent(input$run_button, {
# shinyjs::show("sliders")
# })
}
shinyApp(ui = ui, server = server)
我的 shinyApp 为一个连续变量和一个分类变量生成箱线图。 我希望用户能够 select 箱线图的颜色。
为此，方法是根据分类变量的类别数生成颜色选择器， 然后，select
到目前为止，我所做的是使用 renderUI 渲染颜色，然后在箱线图函数中允许 selection。
但是，这个函数内部有些东西不能正常工作draw_boxplot <- function(data_input, num_var_1, num_var_2, biomarker){
因为这个错误是在控制台提示的。
代码如下：
library(shiny)
library(shinyWidgets)
library(shinyjqui)
library(bslib)
library(shinybusy) # For busy spinners
library(shinyjs)
# Data
library(readxl)
library(dplyr)
library(tidyr) # to drop na
# Plots
library(ggplot2)
not_sel <- "Not Selected"
ui <- navbarPage(
tabPanel(
useShinyjs(),
title = "",
titlePanel(""),
sidebarLayout(
sidebarPanel(
title = "Inputs",
fileInput("csv_input", "Select CSV file to import", accept = c(".csv")),
selectInput("num_var_1", "Variable name", choices = c(not_sel)),
selectInput("num_var_2", "Variable name", choices = c(not_sel)),
actionButton("run_button", "Display", icon = icon("play")),
),
mainPanel(
tabsetPanel(
tabPanel(
title = "Plot",
br(),
plotOutput("sel_graph"),
br(),
### Fluid Row
#tags$head(tags$style(HTML('.irs-from, .irs-to, .irs-min, .irs-max, .irs-single {visibility: hidden !important;}'))),
shinyjs::hidden(
div(
id = "sliders",
fluidRow(
column(4, div(style = "height:140px"),
h4("Select colors"),
uiOutput("colors")
)
)
)
)
)
)
)
)
)
)
server <- function(input, output, session){
# Dynamic selection of the data
data_input <- reactive({
#req(input$csv_input)
#inFile <- input$csv_input
#read.csv(inFile$datapath, 1)
iris
})
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)
# Render colors for boxplot
output$colors <- renderUI({
#req(input$num_var_2,data_input())
if (is.null(input$num_var_1) | (input$num_var_1=="Not Selected")) return(NULL)
df <- data_input()
uvalues <- unique(df[[input$num_var_1]])
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"))
})
)
)
})
## Obtain plots dynamically -----------------------
draw_boxplot <- function(data_input, num_var_1, num_var_2, biomarker){
n <- length(unique(data_input()[, input$num_var_1()]))
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)]])
})
ggplot(data = data_input, aes(x = .data[[num_var_1]], y = .data[[num_var_2]])) +
geom_boxplot(values = unlist(myvaluesx)) +
theme_bw()
}
## First we create another dataframe that will be use in the new plot
data_raw_plot <- reactive({
req(data_input(), input$num_var_1)
df <- data_input()
df
})
## BoxPlot
plot_1 <- eventReactive(input$run_button,{
req(data_raw_plot())
draw_boxplot(data_raw_plot(), num_var_1(), num_var_2())
})
output$sel_graph <- renderPlot({
plot_1()
})
observeEvent(input$run_button, {
shinyjs::show("sliders")
})
}
shinyApp(ui = ui, server = server)
这里有几个问题。如果 pickerInput() 被隐藏，您的颜色选择在开始时为空，因此您不能在绘图中使用这些颜色。此外，作为选项列表中的 multiple = T，您需要使用 input$colorvar1[[1]] 而不是 input$colorvar1。完整的工作代码：
not_sel <- "Not Selected"
ui <- navbarPage(
tabPanel(
useShinyjs(),
title = "",
titlePanel(""),
sidebarLayout(
sidebarPanel(
title = "Inputs",
fileInput("csv_input", "Select CSV file to import", accept = c(".csv")),
selectInput("num_var_1", "Variable name", choices = c(not_sel)),
selectInput("num_var_2", "Variable name", choices = c(not_sel)),
actionButton("run_button", "Display", icon = icon("play")),
),
mainPanel(
tabsetPanel(
tabPanel(
title = "Plot",
br(),
plotOutput("sel_graph"),
br(),
### Fluid Row
#tags$head(tags$style(HTML('.irs-from, .irs-to, .irs-min, .irs-max, .irs-single {visibility: hidden !important;}'))),
#shinyjs::hidden(
div(
id = "sliders",
fluidRow(
column(4, div(style = "height:140px"),
h4("Select colors"),
uiOutput("colors")
)
)
)
#)
)
)
)
)
)
)
server <- function(input, output, session){
# Dynamic selection of the data
data_input <- reactive({
#req(input$csv_input)
#inFile <- input$csv_input
#read.csv(inFile$datapath, 1)
iris
})
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)
# Render colors for boxplot
output$colors <- renderUI({
#req(input$num_var_1,data_input())
if (is.null(input$num_var_1) | (input$num_var_1=="Not Selected")) return(NULL)
df <- data_input()
uvalues <- unique(df[[input$num_var_1]])
n <- length(uvalues)
choices <- as.list(uvalues)
myorder <- as.list(1:n)
#mycolors <- list("#727CA3", "#464653", "#638CAE", "#836A61", "#889328", "#F5AF22", "#DF564B", "#6B4A8C", "#CE7EB8")
mycolors <- list("red","blue","green","pink","orange")
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(mycolors[[k]]),
multiple = T,
options = list('max-options-group' = 1, `style` = "btn-primary"))
})
)
)
})
## Obtain plots dynamically -----------------------
draw_boxplot <- function(data_input, num_var_1, num_var_2){
n <- length(unique(data_input()[,num_var_1]))
val <- list()
myvaluesx <- lapply(1:n, function(i) {
req(input[[paste0("colorvar",i)]])
if (i==1) val <- list(input[[paste0("colorvar",i)]])
else val <- list(val,input[[paste0("colorvar",i)]])
})
ggplot(data = data_input(), aes(x = .data[[num_var_1]], y = .data[[num_var_2]]) ) +
geom_boxplot(aes(fill=.data[[num_var_1]])) +
scale_fill_manual(values=unlist(myvaluesx)) +
theme_bw()
}
## First we create another dataframe that will be use in the new plot
data_raw_plot <- reactive({
req(data_input(), input$num_var_1)
df <- data_input()
df
})
## BoxPlot
plot_1 <- eventReactive(input$run_button,{
req(data_raw_plot(),num_var_1(),num_var_2())
draw_boxplot(data_raw_plot, num_var_1(), num_var_2())
})
output$sel_graph <- renderPlot({
plot_1()
})
# observeEvent(input$run_button, {
# shinyjs::show("sliders")
# })
}
shinyApp(ui = ui, server = server)