下面的新代码示例，我尝试在所有三个选项卡中链接 selectInput。在下面的示例中，前两个选项卡 selectInputs 已链接，但我试图将所有三个选项卡链接起来。有没有办法将这三个链接起来？
#``````````````````````````````````````
a <- list("2016", "MALE", "25", "50")
b <- list("2017", "FEMALE", "5", "100")
c <- list("2017", "MALE", "15", "75")
d <- list("2016", "MALE", "10", "35")
e <- list("2017", "FEMALE","55", "20")
data <- rbind(a,b,c,d,e)
#``````````````````````````````````````
## UI
library(shiny)
if(interactive()){
ui = fluidPage(
navbarPage("",
#``````````````````````````````````````
## SHOES TAB
tabPanel("SHOES",
fluidRow(
column(2, "",
selectInput("shoes_year", "YEAR", choices = c("2017", "2016", "2015", "2014"))),
column(9, "SHOES"))),
#``````````````````````````````````````
## HATS
tabPanel("HATS",
fluidRow(
column(2, "",
selectInput("hats_year", "YEAR", choices = c("2017", "2016", "2015", "2014"))),
column(9, "HATS"))),
#``````````````````````````````````````
## COATS
tabPanel("COATS",
fluidRow(
column(2, "",
selectInput("coats_year", "YEAR", choices = c("2017", "2016", "2015", "2014"))),
column(9, "COATS")))
))
#``````````````````````````````````````
server = function(input, output, session) {
observeEvent(input[["shoes_year"]],
{
updateSelectInput(session = session,
inputId = "hats_year",
selected = input[["shoes_year"]])
})
observeEvent(input[["hats_year"]],
{
updateSelectInput(session = session,
inputId = "shoes_year",
selected = input[["hats_year"]])
})
}
#``````````````````````````````````````
shinyApp(ui, server)
}
#``````````````````````````````````````
最佳答案
需要注意的一些事项:
- 您的
inputId必须是唯一的。您不能在两个不同的选项卡上使用相同的inputId进行两次selectInput调用。它不会抛出错误，但您的应用将无法按您想要的方式运行。 - 您需要在服务器函数中包含
session参数。 - 拥有在两个不同选项卡上执行相同任务的控件有些多余。您可能需要考虑侧边栏 (
sidebarLayout) 是否对您有利。
无论如何，下面的代码都适用于更新年份选择。
a <- list("2016", "MALE", "25", "50")
b <- list("2017", "FEMALE", "5", "100")
c <- list("2017", "MALE", "15", "75")
d <- list("2016", "MALE", "10", "35")
e <- list("2017", "FEMALE","55", "20")
data <- rbind(a,b,c,d,e)
#``````````````````````````````````````
## UI
library(shiny)
if(interactive()){
ui = fluidPage(
navbarPage("",
#``````````````````````````````````````
## SHOES TAB
tabPanel("SHOES",
fluidRow(
column(2, "",
selectInput("shoes_year", "YEAR", choices = c("2017", "2016")),
selectInput("dataset", "CHOOSE POPULATION", choices = c("MALE", "FEMALE"))),
column(9, "SHOES"))),
#``````````````````````````````````````
## HATS
tabPanel("HATS",
fluidRow(
column(2, "",
selectInput("hats_year", "YEAR", choices = c("2017", "2016")),
selectInput("dataset", "CHOOSE POPULATION", choices =c("MALE","FEMALE"))),
column(9, "HATS"))
)))
#``````````````````````````````````````
server = function(input, output, session) {
observeEvent(input[["shoes_year"]],
{
updateSelectInput(session = session,
inputId = "hats_year",
selected = input[["shoes_year"]])
})
observeEvent(input[["hats_year"]],
{
updateSelectInput(session = session,
inputId = "shoes_year",
selected = input[["hats_year"]])
})
}
#``````````````````````````````````````
shinyApp(ui, server)
}
#``````````````````````````````````````
其他内容(技术术语)
根据您在三个或更多选项卡上执行此操作的评论，我强烈建议您停止正在做的事情。可以通过一些巧妙的lapply来做到这一点，例如
observeEvent(input$coat_year,
{
lapply(c("shoes_year", "hats_year"),
function(x) updateSelectInput(session = session,
inputId = x,
selected = input$coat_year))
}
)
这将最大限度地减少您必须编写的代码量，但每个选项卡仍然需要其中一个 block ，并且您必须手动维护进入 lapply 的向量以确保它包括所有适当的控制。然后你需要对数据集再做一次。还有其他选择，但我不确定它们是否会减少工作量。
您正处于应用程序足够复杂的阶段，您确实应该找到方法来最大程度地减少代码工作，使其更易于维护。我在下面提供了两个选项，它们仅使用 shiny 中提供的工具。第一个使用 tabsetPanel 而不是 navbarPage。第二个使用 navbarPage 但将其嵌入 sidebarLayout 中。如果您探索 shinyjs、shinydashboard 和 shinyBS 软件包(仅举几例)，您还可以使用许多其他解决方案。
tabsetPanel
library(shiny)
shinyApp(
ui = shinyUI(
fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("year", "YEAR", choices = c("2017", "2016")),
selectInput("dataset", "CHOOSE POPULATION", choices = c("MALE", "FEMALE"))
),
mainPanel(
tabsetPanel(
tabPanel(title = "Shoes",
uiOutput("shoe_input")),
tabPanel(title = "Hats",
uiOutput("hat_input"))
)
)
)
)
),
server = shinyServer(function(input, output, session){
selected_input <-
reactive({
tagList(
h3(input$year),
h3(input$dataset)
)
})
output$shoe_input <-
renderUI({
selected_input()
})
output$hat_input <-
renderUI({
selected_input()
})
})
)
导航栏页面
library(shiny)
shinyApp(
ui = shinyUI(
sidebarLayout(
sidebarPanel(
selectInput("year", "YEAR", choices = c("2017", "2016")),
selectInput("dataset", "CHOOSE POPULATION", choices = c("MALE", "FEMALE"))
),
mainPanel(
navbarPage(
title = "",
tabPanel(title = "Shoes",
uiOutput("shoe_input")),
tabPanel(title = "Hats",
uiOutput("hat_input"))
)
)
)
),
server = shinyServer(function(input, output, session){
selected_input <-
reactive({
tagList(
h3(input$year),
h3(input$dataset)
)
})
output$shoe_input <-
renderUI({
selected_input()
})
output$hat_input <-
renderUI({
selected_input()
})
})
)
关于r - 在 R 中选择输入更新？在两个相关的选项卡中选择输入，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/43075333/