依赖于另一个 selectInput 的 selectInput
selectInput that is dependent on another selectInput
我在下面有一些数据,我用这些数据在 R shiny 中创建圆环图,其中 date
是一个字符。我希望能够 select 我想查看分数的电子邮件,但是在第二个下拉列表中 selection 只能看到该电子邮件具有 activity.[=14 的日期=]
例如,如果我在第一个下拉列表中 select email = xxxx,我只想在日期 selection 字段中看到 'no activity'。对于 email = yyyy,我只想将 6/17/14、6/18/14、6/19/14 视为 selections。
我在 ui 中尝试了一种嵌套子集。示例:
> ui <- shinyUI(fluidPage(
+ sidebarLayout(
+ sidebarPanel(
+ selectInput('Select', 'Customer:', choices = unique(as.character(dat5$email))),
+ selectInput("User", "Date:", choices = dat5[dat5$email==input$Select,date])
+ ),
+ mainPanel(plotOutput("distPlot"))
+ )
+ ))
但这仍然显示所有可能的日期 selections
数据
email date variable value ymin ymax
xxxx no activity e_score 0 0 0
xxxx no activity diff 1 0 1
yyyy 6/17/14 e_score 0.7472 0 0.7472
yyyy 6/17/14 diff 0.2528 0.7472 1
yyyy 6/18/14 e_score 0.373 0 0.373
yyyy 6/18/14 diff 0.627 0.373 1
yyyy 6/19/14 e_score 0.533 0 0.533
yyyy 6/19/14 diff 0.467 0.533 1
到目前为止我的代码:
app.R
library(shiny)
library(shinydashboard)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
selectInput('Select', 'Customer:', choices = unique(as.character(dat5$email))),
selectInput("User", "Date:", choices = unique(dat5$date) )
),
mainPanel(plotOutput("distPlot"))
)
))
server <- function(input, output) {
output$distPlot <- renderPlot({
ggplot(data = subset(dat5, (email %in% input$Select & date %in% input$User)), aes(fill=variable, ymax = ymax, ymin = ymin, xmax = 4, xmin = 3)) +
geom_rect(colour = "grey30", show_guide = F) +
coord_polar(theta = "y") +
geom_text(aes(x = 0, y = 0,label = round(value[1]*100))) +
xlim(c(0, 4)) +
theme_bw() +
theme(panel.grid=element_blank()) +
theme(axis.text=element_blank()) +
theme(axis.ticks=element_blank()) +
xlab("") +
ylab("") +
scale_fill_manual(values=c('#33FF00','#CCCCCC'))
})
}
shinyApp(ui = ui, server = server)
您无法在应用程序的 ui.R 部分访问输入,因此您需要使用 renderUi/uiOutput 动态生成您的 selectInput。
在您的 ui.R
中您可以添加:
uiOutput("secondSelection")
在你的 server.R
:
output$secondSelection <- renderUI({
selectInput("User", "Date:", choices = as.character(dat5[dat5$email==input$Select,"date"]))
})
你也可以不改变ui.R
。将此添加到 server.R
具有相同的效果。
observe({
updateSelectInput(session, "User", choices = as.character(dat5[dat5$email==input$Select, date]))
})
虽然它是一个有用且强大的工具,但我发现没有 renderUI
也能“更干净”。它将 UI 保留在 UI 中,将服务器保留在服务器中。但我想这只是一个品味问题。
我在下面有一些数据,我用这些数据在 R shiny 中创建圆环图,其中 date
是一个字符。我希望能够 select 我想查看分数的电子邮件,但是在第二个下拉列表中 selection 只能看到该电子邮件具有 activity.[=14 的日期=]
例如,如果我在第一个下拉列表中 select email = xxxx,我只想在日期 selection 字段中看到 'no activity'。对于 email = yyyy,我只想将 6/17/14、6/18/14、6/19/14 视为 selections。
我在 ui 中尝试了一种嵌套子集。示例:
> ui <- shinyUI(fluidPage(
+ sidebarLayout(
+ sidebarPanel(
+ selectInput('Select', 'Customer:', choices = unique(as.character(dat5$email))),
+ selectInput("User", "Date:", choices = dat5[dat5$email==input$Select,date])
+ ),
+ mainPanel(plotOutput("distPlot"))
+ )
+ ))
但这仍然显示所有可能的日期 selections
数据
email date variable value ymin ymax
xxxx no activity e_score 0 0 0
xxxx no activity diff 1 0 1
yyyy 6/17/14 e_score 0.7472 0 0.7472
yyyy 6/17/14 diff 0.2528 0.7472 1
yyyy 6/18/14 e_score 0.373 0 0.373
yyyy 6/18/14 diff 0.627 0.373 1
yyyy 6/19/14 e_score 0.533 0 0.533
yyyy 6/19/14 diff 0.467 0.533 1
到目前为止我的代码:
app.R
library(shiny)
library(shinydashboard)
ui <- shinyUI(fluidPage(
sidebarLayout(
sidebarPanel(
selectInput('Select', 'Customer:', choices = unique(as.character(dat5$email))),
selectInput("User", "Date:", choices = unique(dat5$date) )
),
mainPanel(plotOutput("distPlot"))
)
))
server <- function(input, output) {
output$distPlot <- renderPlot({
ggplot(data = subset(dat5, (email %in% input$Select & date %in% input$User)), aes(fill=variable, ymax = ymax, ymin = ymin, xmax = 4, xmin = 3)) +
geom_rect(colour = "grey30", show_guide = F) +
coord_polar(theta = "y") +
geom_text(aes(x = 0, y = 0,label = round(value[1]*100))) +
xlim(c(0, 4)) +
theme_bw() +
theme(panel.grid=element_blank()) +
theme(axis.text=element_blank()) +
theme(axis.ticks=element_blank()) +
xlab("") +
ylab("") +
scale_fill_manual(values=c('#33FF00','#CCCCCC'))
})
}
shinyApp(ui = ui, server = server)
您无法在应用程序的 ui.R 部分访问输入,因此您需要使用 renderUi/uiOutput 动态生成您的 selectInput。
在您的 ui.R
中您可以添加:
uiOutput("secondSelection")
在你的 server.R
:
output$secondSelection <- renderUI({
selectInput("User", "Date:", choices = as.character(dat5[dat5$email==input$Select,"date"]))
})
你也可以不改变ui.R
。将此添加到 server.R
具有相同的效果。
observe({
updateSelectInput(session, "User", choices = as.character(dat5[dat5$email==input$Select, date]))
})
虽然它是一个有用且强大的工具,但我发现没有 renderUI
也能“更干净”。它将 UI 保留在 UI 中,将服务器保留在服务器中。但我想这只是一个品味问题。