UI

Question

我对此有些困惑，一直在搜寻和阅读早晨的大部分时间。尝试了几件事，但似乎无法正确执行。

我正在尝试制作一个shiny图，该图基于ggplot选定的输入创建一个ui。

这是我正在使用的示例：

library(tidyverse)
library(shiny)
library(shinyWidgets)

subject <- c("A", "A", "A", "B", "B", "B", "C", "C", "C", "D", "D", "D", "E", "E")
grp <- c(rep("One", times = 6), rep("Two", times = 8))
date <- c(rep(c("8/1/2020", "8/2/2020", "8/3/2020"), times = 4), "8/1/2020", "8/2/2020")
var <- round(rnorm(n = length(subject), mean = 0, sd = 2), 3)

df <- data.frame(subject, grp, date, var)
df$date <- as.Date(df$date, "%m/%d/%Y")

我根据需要的选择定义ui：日期，组，主题，并可以选择绘制多个主题：

UI

ui <- fluidPage(
  
  selectInput(inputId = "date",
              label = "date",
              choices = df %>% distinct(date) %>% pull(date),
              selected = min(df$date)),
  
  selectInput(inputId = "grp",
              label = "grp",
              choices = df %>% distinct(grp) %>% pull(grp),
              selected = "One"),
  
  selectizeInput(inputId = "subject",
              label = "subject",
              choices = df %>% distinct(subject) %>% pull(subject),
              multiple = T),
  
  plotOutput(outputId = "plt")
)

在我的server中，我尝试进行两个过滤。第一个过滤器是获取日期和组。其次是仅选择所选组中的主题。不幸的是，shiny保留了所有主题。

服务器

server <- function(input, output){
  
  output1 <- reactive({
    d <- df %>%
      filter(date == input$date,
             (grp == input$grp))
    d
  })
  
  output2 <- reactive({
    d <- output1() %>%
      filter(grp == input$grp &
               subject %in% input$subject)
    d
  })
  
  output$plt <- renderPlot({
    d <- output2()
    
    plt <- d %>%
      ggplot(aes(x = subject, y = var)) +
      geom_col()
    
    plt
  })
  
}


shinyApp(ui, server)

我觉得上面已经很简单了，但是我无法弄清为什么它不会返回我想要的东西。谢谢。

Answer 1

两件事：

我认为您在两个filter区块中过度output*。我推断output1应该只返回包含该date的帧，然后确保grp下拉列表仅包括可用组；类似地，第二次下拉入主题。为此，我将简化过滤。
当您知道可用的grps和主题时，请updateSelectizeInput列出适用的下拉菜单和可用的choices。为此，我们还将在session定义中添加server。

尝试一下：

ui <- fluidPage(
  
  selectInput(inputId = "date",
              label = "date",
              choices = df %>% distinct(date) %>% pull(date),
              selected = min(df$date)),
  
  selectInput(inputId = "grp",
              label = "grp",
              choices = df %>% distinct(grp) %>% pull(grp),
              selected = "One"),
  
  selectizeInput(inputId = "subject",
              label = "subject",
              choices = df %>% distinct(subject) %>% pull(subject),
              multiple = T),
  
  plotOutput(outputId = "plt")
)

server <- function(input, output, session) {
  
  output1 <- reactive({
    d <- df %>%
      filter(date == input$date)
    updateSelectizeInput(session, "grp", choices = unique(d$grp))
    d
  })
  
  output2 <- reactive({
    d <- req(output1()) %>%
      filter(grp == input$grp)
    updateSelectizeInput(session, "subject", choices = unique(d$subject))
    d
  })
  
  output$plt <- renderPlot({
    d <- req(output2()) %>%
      filter(subject %in% input$subject)
    plt <- ggplot(d, aes(x = subject, y = var)) +
      geom_col()
    plt
  })
  
}

仅供参考：我还向req添加了调用，以防止块在输入无效，丢失或只是不稳定时触发和完成。在较小的应用程序中，通常不会发生这种情况，但是如果/当反应性变大时，它就会频繁发生。即使只是虚假地发生，使用req(...)也可能会阻止renderPlot暂时/不必要地引发错误。（它当然不会伤害任何东西。）

基于条件的闪亮图

UI

服务器

1 个答案: