Выберите InputUpdate в R? Выберите вкладку в двух вкладках, которые связаны
Ниже приведен пример кода, где я пытаюсь связать 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)
}
#``````````````````````````````````````
1 ответ
Некоторые вещи, чтобы принять к сведению:
- Ваш
inputIds должен быть уникальным. Вы не можете иметь дваselectInputзвонки с тем жеinputIdна двух разных вкладках. Он не выдаст ошибку, но ваше приложение не будет работать так, как вы хотите. - Вам нужно будет включить
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)
}
#``````````````````````````````````````
ДОПОЛНИТЕЛЬНЫЕ ПЕРСОНАЛЫ (технический термин)
Исходя из вашего комментария о выполнении этого на трех или более вкладках, я настоятельно рекомендую вам прекратить то, что вы делаете. Это можно сделать с помощью некоторых умных lapplyING, такой как
observeEvent(input$coat_year,
{
lapply(c("shoes_year", "hats_year"),
function(x) updateSelectInput(session = session,
inputId = x,
selected = input$coat_year))
}
)
Что минимизирует объем кода, который вы должны написать, но вам все равно нужен один из этих блоков для каждой вкладки, и вам придется вручную поддерживать вектор, входящий в 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()
})
})
)
navbarPage
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()
})
})
)