如何在 R Shiny App 中保留复选框中的值？
How to Retain the values in the Check Box in R Shiny App?
我正在尝试创建一个闪亮的应用程序。在这个特定的应用程序中，我有一组单选按钮，选择一个按钮将在下面显示一组选项作为复选框，选择另一个单选按钮将选择其他选项集。请在下面找到 UI 和服务器代码。
library(shiny)
library(shinydashboard)
library(shinyWidgets)
d <-
data.frame(
year = c(1995, 1995, 1995, 1996, 1996, 1996, 1997, 1997, 1997),
Product_Name = c(
"Table",
"Chair",
"Bed",
"Table",
"Chair",
"Bed",
"Table",
"Chair",
"Bed"
),
Product_desc = c("X", "X", "X", "Y", "Y", "Y", "Z", "Z", "Z"),
Cost = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
)
ui <- shinyUI(fluidPage(
useShinydashboard(),
tabPanel(
"Plot",
sidebarLayout(
sidebarPanel(
radioButtons(
"Choose",
"Choose One",
c("Year" = "p", "Numbers" = "l")
),
uiOutput('checkbox'),
#width = 2,
position = "bottom"),
mainPanel(uiOutput("graph"))
)
)
))
server <- function(input, output, session) {
output$graph <- renderUI({
# create tabPanel with datatable in it
req(input$year)
tabPanel("Plots",
fluidRow(lapply(as.list(paste0("plot", seq_along(input$year))), plotOutput)))
})
output$checkbox <- renderUI({
if (input$Choose == "p") {
checkboxGroupInput("Cross",
"Year",
choices = (unique(d$year)))
} else{
checkboxGroupInput("Cross_1",
"Numbers",
choices = c("1","2","3"))
}
})
}
shinyApp(ui, server)
现在我面临的挑战是当我选择 "Year" 单选按钮时，年份值显示为复选框，当我 select 复选框时，相应的图表显示在主面板（我没有在这里给出代码）。现在，当我选择 "Number" 单选按钮时，会显示正确的复选框选项。但是当我回到 "Year" 单选按钮时。已经 selected 的复选框值不会保留，因此用户需要再次选中复选框以获取相应的图表。
在我的例子中，CheckboxGroupInput() 中的选择是动态的。所以我将无法在 UI() 中给出这个选择。我也尝试使用失败的 updateCheckboxGroupInput() 。通过再次对代码进行一些调查，我了解到问题发生的地方是这部分代码。
output$checkbox <- renderUI({
if (input$Choose == "p") {
checkboxGroupInput("Cross",
"Year",
choices = (unique(d$year)))
} else{
checkboxGroupInput("Cross_1",
"Numbers",
choices = c("1","2","3"))
}
})
请建议我如何在选中另一个单选按钮时保留复选框中的值。另请注意，每个单选按钮下的复选框选项将根据用户在上一个选项卡中 select 编辑的选项而变化。所以我用observe函数来获取对应的复选框。
我建议 showing/hiding 复选框而不是使用 renderUI。这样，即使它们未显示，它们也会保留其设置。
shinyjs 是一个流行的包，可以为我们做到这一点。我根据上面的代码创建了一个最小的例子来展示它的实际效果：
library(shiny)
library(shinyjs)
ui <- shinyUI(fluidPage(
useShinyjs(),
radioButtons("radio_choose", "Choose One", choices = c("Year", "Numbers")),
checkboxGroupInput("checkbox_years", "Year", choices = c(1995, 1996, 1997, 1997)),
checkboxGroupInput("checkbox_numbers", "Numbers", choices = c(1, 2, 3))
))
server <- function(input, output, session) {
#Observe the radio buttons (runs when the radio button changes)
observeEvent(input$radio_choose, {
if(input$radio_choose == "Year") {
shinyjs::show("checkbox_years")
shinyjs::hide("checkbox_numbers")
}
if(input$radio_choose == "Numbers") {
shinyjs::hide("checkbox_years")
shinyjs::show("checkbox_numbers")
}
})
}
shinyApp(ui, server)
您可以将您尝试保留的年份值存储在反应值中。
global <- reactiveValues(years = NULL)
observeEvent(input$Cross, {
global$years <- input$Cross
})
然后你使你的动态 ui 依赖于反应值：
checkboxGroupInput(
"Cross",
"Year",
choices = (unique(d$year)),
selected = global$years
)
可重现的例子：
library(shiny)
library(shinydashboard)
library(shinyWidgets)
d <-
data.frame(
year = c(1995, 1995, 1995, 1996, 1996, 1996, 1997, 1997, 1997),
Product_Name = c(
"Table",
"Chair",
"Bed",
"Table",
"Chair",
"Bed",
"Table",
"Chair",
"Bed"
),
Product_desc = c("X", "X", "X", "Y", "Y", "Y", "Z", "Z", "Z"),
Cost = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
)
ui <- shinyUI(fluidPage(
useShinydashboard(),
tabPanel(
"Plot",
sidebarLayout(
sidebarPanel(
radioButtons(
"Choose",
"Choose One",
c("Year" = "p", "Numbers" = "l")
),
uiOutput('checkbox'),
#width = 2,
position = "bottom"),
mainPanel(uiOutput("graph"))
)
)
))
server <- function(input, output, session) {
global <- reactiveValues(years = NULL)
observeEvent(input$Cross, {
global$years <- input$Cross
})
output$graph <- renderUI({
# create tabPanel with datatable in it
req(input$year)
tabPanel("Plots",
fluidRow(lapply(as.list(paste0("plot", seq_along(input$year))), plotOutput)))
})
output$checkbox <- renderUI({
if (input$Choose == "p") {
checkboxGroupInput("Cross",
"Year",
choices = (unique(d$year)),selected = global$years)
} else{
checkboxGroupInput("Cross_1",
"Numbers",
choices = c("1","2","3"))
}
})
}
shinyApp(ui, server)
我认为 Ash 的 shinyjs hide/show 变体也很有趣。我还没有测试过它，但我假设你可以用动态替换静态 ui (?).
这是我的方法，使用 shinyjs 中的 hidden。我还添加了默认 selection 为空，因此反应性没有歧义。尽量避免在名称中单独使用数值变量，例如 "1"、"2" 等
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(shinyjs)
d <- data.frame(
year = c(1995, 1995, 1995, 1996, 1996, 1996, 1997, 1997, 1997),
Product_Name = c("Table","Chair","Bed","Table","Chair","Bed","Table","Chair","Bed"),
Product_desc = c("X", "X", "X", "Y", "Y", "Y", "Z", "Z", "Z"),
Cost = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
)
ui <- shinyUI(fluidPage(
useShinyjs(),
useShinydashboard(),
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
radioButtons("Choose","Choose One", c("Year" = "p", "Numbers" = "b"),selected = character(0)),
uiOutput('checkbox'),
position = "bottom"),
mainPanel(
uiOutput("graph")
)
)
)
))
server <- function(input, output, session) {
output$checkbox <- renderUI({
hidden(
tagList(
checkboxGroupInput("Cross","Year",choices = (unique(d$year))),
checkboxGroupInput("Cross_1","Numbers",choices = c("1","2","3"))
)
)
})
observeEvent(input$Choose,{
toggleElement(id = "Cross", condition = input$Choose == "p")
toggleElement(id = "Cross_1", condition = input$Choose == "b")
})
}
shinyApp(ui, server)
或者，由于 radioButtons 默认为 select 第一个值，您可以隐藏第二个元素：
ui <- shinyUI(fluidPage(
useShinyjs(),
useShinydashboard(),
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
radioButtons("Choose","Choose One", c("Year" = "p", "Numbers" = "b")),
uiOutput('checkbox'),
position = "bottom"),
mainPanel(
uiOutput("graph")
)
)
)
))
server <- function(input, output, session) {
output$checkbox <- renderUI({
tagList(
checkboxGroupInput("Cross","Year",choices = (unique(d$year))),
hidden(checkboxGroupInput("Cross_1","Numbers",choices = c("1","2","3")))
)
})
observeEvent(input$Choose,{
toggleElement(id = "Cross", condition = input$Choose == "p")
toggleElement(id = "Cross_1", condition = input$Choose == "b")
})
}
shinyApp(ui, server)
我正在尝试创建一个闪亮的应用程序。在这个特定的应用程序中，我有一组单选按钮，选择一个按钮将在下面显示一组选项作为复选框，选择另一个单选按钮将选择其他选项集。请在下面找到 UI 和服务器代码。
library(shiny)
library(shinydashboard)
library(shinyWidgets)
d <-
data.frame(
year = c(1995, 1995, 1995, 1996, 1996, 1996, 1997, 1997, 1997),
Product_Name = c(
"Table",
"Chair",
"Bed",
"Table",
"Chair",
"Bed",
"Table",
"Chair",
"Bed"
),
Product_desc = c("X", "X", "X", "Y", "Y", "Y", "Z", "Z", "Z"),
Cost = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
)
ui <- shinyUI(fluidPage(
useShinydashboard(),
tabPanel(
"Plot",
sidebarLayout(
sidebarPanel(
radioButtons(
"Choose",
"Choose One",
c("Year" = "p", "Numbers" = "l")
),
uiOutput('checkbox'),
#width = 2,
position = "bottom"),
mainPanel(uiOutput("graph"))
)
)
))
server <- function(input, output, session) {
output$graph <- renderUI({
# create tabPanel with datatable in it
req(input$year)
tabPanel("Plots",
fluidRow(lapply(as.list(paste0("plot", seq_along(input$year))), plotOutput)))
})
output$checkbox <- renderUI({
if (input$Choose == "p") {
checkboxGroupInput("Cross",
"Year",
choices = (unique(d$year)))
} else{
checkboxGroupInput("Cross_1",
"Numbers",
choices = c("1","2","3"))
}
})
}
shinyApp(ui, server)
现在我面临的挑战是当我选择 "Year" 单选按钮时，年份值显示为复选框，当我 select 复选框时，相应的图表显示在主面板（我没有在这里给出代码）。现在，当我选择 "Number" 单选按钮时，会显示正确的复选框选项。但是当我回到 "Year" 单选按钮时。已经 selected 的复选框值不会保留，因此用户需要再次选中复选框以获取相应的图表。
在我的例子中，CheckboxGroupInput() 中的选择是动态的。所以我将无法在 UI() 中给出这个选择。我也尝试使用失败的 updateCheckboxGroupInput() 。通过再次对代码进行一些调查，我了解到问题发生的地方是这部分代码。
output$checkbox <- renderUI({
if (input$Choose == "p") {
checkboxGroupInput("Cross",
"Year",
choices = (unique(d$year)))
} else{
checkboxGroupInput("Cross_1",
"Numbers",
choices = c("1","2","3"))
}
})
请建议我如何在选中另一个单选按钮时保留复选框中的值。另请注意，每个单选按钮下的复选框选项将根据用户在上一个选项卡中 select 编辑的选项而变化。所以我用observe函数来获取对应的复选框。
我建议 showing/hiding 复选框而不是使用 renderUI。这样，即使它们未显示，它们也会保留其设置。
shinyjs 是一个流行的包，可以为我们做到这一点。我根据上面的代码创建了一个最小的例子来展示它的实际效果：
library(shiny)
library(shinyjs)
ui <- shinyUI(fluidPage(
useShinyjs(),
radioButtons("radio_choose", "Choose One", choices = c("Year", "Numbers")),
checkboxGroupInput("checkbox_years", "Year", choices = c(1995, 1996, 1997, 1997)),
checkboxGroupInput("checkbox_numbers", "Numbers", choices = c(1, 2, 3))
))
server <- function(input, output, session) {
#Observe the radio buttons (runs when the radio button changes)
observeEvent(input$radio_choose, {
if(input$radio_choose == "Year") {
shinyjs::show("checkbox_years")
shinyjs::hide("checkbox_numbers")
}
if(input$radio_choose == "Numbers") {
shinyjs::hide("checkbox_years")
shinyjs::show("checkbox_numbers")
}
})
}
shinyApp(ui, server)
您可以将您尝试保留的年份值存储在反应值中。
global <- reactiveValues(years = NULL)
observeEvent(input$Cross, {
global$years <- input$Cross
})
然后你使你的动态 ui 依赖于反应值：
checkboxGroupInput(
"Cross",
"Year",
choices = (unique(d$year)),
selected = global$years
)
可重现的例子：
library(shiny)
library(shinydashboard)
library(shinyWidgets)
d <-
data.frame(
year = c(1995, 1995, 1995, 1996, 1996, 1996, 1997, 1997, 1997),
Product_Name = c(
"Table",
"Chair",
"Bed",
"Table",
"Chair",
"Bed",
"Table",
"Chair",
"Bed"
),
Product_desc = c("X", "X", "X", "Y", "Y", "Y", "Z", "Z", "Z"),
Cost = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
)
ui <- shinyUI(fluidPage(
useShinydashboard(),
tabPanel(
"Plot",
sidebarLayout(
sidebarPanel(
radioButtons(
"Choose",
"Choose One",
c("Year" = "p", "Numbers" = "l")
),
uiOutput('checkbox'),
#width = 2,
position = "bottom"),
mainPanel(uiOutput("graph"))
)
)
))
server <- function(input, output, session) {
global <- reactiveValues(years = NULL)
observeEvent(input$Cross, {
global$years <- input$Cross
})
output$graph <- renderUI({
# create tabPanel with datatable in it
req(input$year)
tabPanel("Plots",
fluidRow(lapply(as.list(paste0("plot", seq_along(input$year))), plotOutput)))
})
output$checkbox <- renderUI({
if (input$Choose == "p") {
checkboxGroupInput("Cross",
"Year",
choices = (unique(d$year)),selected = global$years)
} else{
checkboxGroupInput("Cross_1",
"Numbers",
choices = c("1","2","3"))
}
})
}
shinyApp(ui, server)
我认为 Ash 的 shinyjs hide/show 变体也很有趣。我还没有测试过它，但我假设你可以用动态替换静态 ui (?).
这是我的方法，使用 shinyjs 中的 hidden。我还添加了默认 selection 为空，因此反应性没有歧义。尽量避免在名称中单独使用数值变量，例如 "1"、"2" 等
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(shinyjs)
d <- data.frame(
year = c(1995, 1995, 1995, 1996, 1996, 1996, 1997, 1997, 1997),
Product_Name = c("Table","Chair","Bed","Table","Chair","Bed","Table","Chair","Bed"),
Product_desc = c("X", "X", "X", "Y", "Y", "Y", "Z", "Z", "Z"),
Cost = c(1, 2, 3, 4, 2, 3, 4, 5, 6)
)
ui <- shinyUI(fluidPage(
useShinyjs(),
useShinydashboard(),
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
radioButtons("Choose","Choose One", c("Year" = "p", "Numbers" = "b"),selected = character(0)),
uiOutput('checkbox'),
position = "bottom"),
mainPanel(
uiOutput("graph")
)
)
)
))
server <- function(input, output, session) {
output$checkbox <- renderUI({
hidden(
tagList(
checkboxGroupInput("Cross","Year",choices = (unique(d$year))),
checkboxGroupInput("Cross_1","Numbers",choices = c("1","2","3"))
)
)
})
observeEvent(input$Choose,{
toggleElement(id = "Cross", condition = input$Choose == "p")
toggleElement(id = "Cross_1", condition = input$Choose == "b")
})
}
shinyApp(ui, server)
或者，由于 radioButtons 默认为 select 第一个值，您可以隐藏第二个元素：
ui <- shinyUI(fluidPage(
useShinyjs(),
useShinydashboard(),
tabPanel("Plot",
sidebarLayout(
sidebarPanel(
radioButtons("Choose","Choose One", c("Year" = "p", "Numbers" = "b")),
uiOutput('checkbox'),
position = "bottom"),
mainPanel(
uiOutput("graph")
)
)
)
))
server <- function(input, output, session) {
output$checkbox <- renderUI({
tagList(
checkboxGroupInput("Cross","Year",choices = (unique(d$year))),
hidden(checkboxGroupInput("Cross_1","Numbers",choices = c("1","2","3")))
)
})
observeEvent(input$Choose,{
toggleElement(id = "Cross", condition = input$Choose == "p")
toggleElement(id = "Cross_1", condition = input$Choose == "b")
})
}
shinyApp(ui, server)