我正在尝试根据输入选择显示/隐藏表格。根据我的第一个下拉菜单,如果用户选择了一个值 wave2,它应该在第一个选项卡下显示表 2,否则它应该隐藏。我尝试将反应输入选择值用于输出的 if else 条件,这不是反应在 R 中的工作方式。有人可以检查并让我知道我错在哪里。
用户界面.r
library(shiny)
library(shinydashboard)
library(shinyBS)
library(shinythemes)
dashboardPage(
dashboardHeader(disable = F, title = "PATH Study"),
dashboardSidebar(
uiOutput("choose_wave"),
uiOutput("choose_category"),
uiOutput("choose_ethnicity"),
uiOutput("choose_age"),
uiOutput("choose_gender")
),
#S dashboardPage(header = dashboardHeader(), sidebar = dashboardSidebar(),body,title = NUll, skin = "yellow"),
dashboardBody(box(
width = 12,
tabBox(
width = 12,
id = "tabBox_next_previous",
tabPanel("Initiation",
fluidRow(
box(
title = "TABLE1",
width = 5,
solidHeader = TRUE,
status = "primary",
tableOutput("smoke"),
collapsible = T,
),
box(
title = "TABLE2",
width = 7,
solidHeader = TRUE,
status = "primary",
tableOutput("first_flov"),
collapsible = T
)
))
),
uiOutput("Next_Previous")
))
)
服务器.r
library(shiny)
library(shinydashboard)
library(shinyBS)
library(knitr)
library(kableExtra)
library(plyr)
library(tidyverse)
library(DT)
library(dplyr)
shinyServer(function(input, output) {
print(sessionInfo())
with_demo_vars <- reactive({
data_selector(wave(), youth()) %>%
mutate(
ethnicity = !!ethnicity(),
age = !!age_group(),
gender = !!gender()
)
})
# Drop-down selection box for which Wave and User Type bracket to be selected
output$choose_wave <- renderUI({
# This can be static: it is the highest level and the options won't change
selectInput(
"selected_wave",
"Wave",
choices = list(
"Wave 1 Adult" = "wave1youthFALSE",
"Wave 1 Youth" = "wave1youthTRUE",
"Wave 2 Adult" = "wave2youthFALSE",
"Wave 2 Youth" = "wave2youthTRUE"
)
)
})
wave <- reactive({
as.integer(gsub("wave(\\d)youth.*", "\\1", input$selected_wave))
})
youth <- reactive({
as.logical(gsub("wave\\dyouth(.+)$", "\\1", input$selected_wave))
})
# Drop-down selection box for which Gender bracket to be selected
output$choose_ethnicity <- renderUI({
selectInput("selected_ethnicity", "Ethnicity", as.list(levels(with_demo_vars()$ethnicity)))
})
# Drop-down selection box for which Age bracket to be selected
output$choose_age <- renderUI({
selectInput("selected_age", "Age", as.list(levels(with_demo_vars()$age)))
})
# Drop-down selection box for which Gender bracket to be selected
output$choose_gender <- renderUI({
selectInput("selected_gender", "Gender", as.list(levels(with_demo_vars()$gender)))
})
output$selected_var <- renderText({
paste("You have selected", input$selected_wave)
})
myData <- reactive({
# wave_selected <- input$selected_wave
category_selected <- req(input$selected_category)
age_selected <- req(input$selected_age)
gender_selected <- req(input$selected_gender)
ethnicity_selected <- req(input$selected_ethnicity)
# TABLE 1
df<-data_selector(wave = 1, youth()) %>%
filter(!!is_ever_user(type = category_selected)) %>%
pct_first_flavored(type = category_selected)
df_sub <- names(df) %in% c("variable")
df <- df[!df_sub]
df
})
first_flov <- reactive({
category_selected <- req(input$selected_category)
age_selected <- req(input$selected_age)
gender_selected <- req(input$selected_gender)
ethnicity_selected <- req(input$selected_ethnicity)
first_flov_df <- data_selector(wave = 2, youth()) %>%
filter(!!is_new_user(type = category_selected)) %>% # this doesn't apply to wave 1
pct_first_flavored(type = category_selected)
first_flov_df_sub <- names(first_flov_df) %in% c("variable")
first_flov_df <- first_flov_df[!first_flov_df_sub]
first_flov_df
})
output$smoke <-
renderTable({
head(myData())
})
output$first_flov <-
if (wave() == 2) {
renderTable({
head(first_flov())
})
} else {
renderText({
paste("You have selected", input$selected_wave)
})
}
})