如何使用多个反应式eventExpr实现EventResponsive?

如何使用多个反应式eventExpr实现EventResponsive?,r,shiny,R,Shiny,在R中初始化闪亮的应用程序时遇到问题。我希望EventResponsive从几个事件中的任意一个触发,这些事件由反应式表达式链接。该应用程序主要按预期工作,但在初始化时不显示,而是要求用户在显示结果之前选择一个actionButton。为什么会这样 我阅读了eventReactive的文档,使用ignoreNULL和ignoreInit设置,并进行了许多在线搜索 下面的例子 require(shiny) require(ggplot2) ui <- fluidPage( titleP

在R中初始化闪亮的应用程序时遇到问题。我希望EventResponsive从几个事件中的任意一个触发,这些事件由反应式表达式链接。该应用程序主要按预期工作,但在初始化时不显示,而是要求用户在显示结果之前选择一个actionButton。为什么会这样

我阅读了eventReactive的文档,使用ignoreNULL和ignoreInit设置,并进行了许多在线搜索

下面的例子

require(shiny)
require(ggplot2)

ui <- fluidPage(
  titlePanel("Car Weight"),
  br(),
  uiOutput(outputId = "cylinders"),
  sidebarLayout(
    mainPanel(
      # plotOutput(outputId = "trend"),
      # plotOutput(outputId = "hist"),
      tableOutput("table"),
      uiOutput(outputId = "dataFilter"),
      actionButton(inputId = "update1", label = "Apply Filters"),
      width = 9
    ),
    sidebarPanel(
      actionButton(inputId = "update2", label = "Apply Filters"),
      uiOutput(outputId = "modelFilter"),
      actionButton(inputId = "update3", label = "Apply Filters"),
      width = 3
    )
  )
)

server <- function(input, output) {
  # Read data.  Real code will pull from database.
  df <- mtcars
  df$model <- row.names(df)

  # Get cylinders
  output$cylinders <- renderUI(
    selectInput(
      inputId = "cyl",
      label = "Select Cylinders",
      choices = c("", as.character(unique(df$cyl)))
    )
  )

  # Subset data by cyl.
  df2 <-
    reactive(droplevels(df[df$cyl == input$cyl, ]))

  # Filter data.
  df3 <-
    eventReactive({
      ##############################################################
      # Help needed:
      # Why does this block not update upon change in 'input$cyl'?
      ##############################################################
      input$update1
      input$update2
      input$update3
      input$cyl
    },
    {
      req(input$modelFilter)
      modelFilterDf <-
        data.frame(model = input$modelFilter)
      df3a <-
        merge(df2(), modelFilterDf, by = "model")
      df3a[df3a$wt >= input$dataFilter[1] &
             df3a$wt <= input$dataFilter[2],]
    },
    ignoreNULL = FALSE,
    ignoreInit = FALSE)

  # Plot table.
  output$table <- renderTable(df3())

  # Filter by data value.
  output$dataFilter <-
    renderUI({
      req(df2()$wt[1])
      sliderInput(
        inputId = "dataFilter",
        label = "Filter by Weight (1000 lbs)",
        min = floor(min(df2()$wt, na.rm = TRUE)),
        max = ceiling(max(df2()$wt, na.rm = TRUE)),
        value = c(
          min(df2()$wt, na.rm = TRUE),
          max(df2()$wt, na.rm = TRUE)
        ),
        step = round(
          max(df2()$wt, na.rm = TRUE) - min(df2()$wt, na.rm = TRUE)
        ) / 100,
        round = round(log((
          max(df2()$wt, na.rm = TRUE) - min(df2()$wt, na.rm = TRUE)
        ) / 100))
      )
    })

  # Filter by lot / wafer.
  output$modelFilter <- renderUI({
    req(input$cyl)
    checkboxGroupInput(
      inputId = "modelFilter",
      label = "Filter by Model",
      choices = as.character(unique(df2()$model)),
      selected = as.character(unique(df2()$model))
    )
  })
}

# Run shiny.
shinyApp(ui = ui, server = server)
require(闪亮)
需要(ggplot2)

ui我找到了解决办法。也许不是最优雅的,但它很管用

问题是
input$modelFilter
input$modelFilter
df2
之后的一个更新。当用户选择
input$update
时,这并不重要,因为
df2
没有更新,只是在新创建的
df2
期间出现问题,因为过滤器与数据不匹配

为了解决这个问题,我添加了
值0
,然后过滤数据,否则返回未过滤的数据

可能有用的链接:

require(闪亮)
需要(ggplot2)

ui eventReactive在启动期间执行两次,但在
req(输入$modelFilter)
处停止。谢谢@ismirsehegal。如果我删除
req(input$modelFilter)
,代码将执行,但将返回错误:“by”必须在执行
merge(df2(),modelFilterDf,by=“model”)
时指定唯一有效的列,这不是所需的结果。你有什么建议来解决这个问题吗?
require(shiny)
require(ggplot2)

ui <- fluidPage(
  titlePanel("Car Weight"),
  br(),
  uiOutput(outputId = "cylinders"),
  sidebarLayout(
    mainPanel(
      tableOutput("table"),
      uiOutput(outputId = "dataFilter"),
      actionButton(inputId = "update1", label = "Apply Filters"),
      width = 9
    ),
    sidebarPanel(
      actionButton(inputId = "update2", label = "Apply Filters"),
      uiOutput(outputId = "modelFilter"),
      actionButton(inputId = "update3", label = "Apply Filters"),
      width = 3
    )
  )
)

server <- function(input, output) {
  # Read data.  Real code will pull from database.
  df <- mtcars
  df$model <- row.names(df)
  df <- df[order(df$model), c(12,1,2,3,4,5,6,7,8,9,10,11)]

  # Get cylinders
  output$cylinders <- renderUI({
    selectInput(
      inputId = "cyl",
      label = "Select Cylinders",
      choices = c("", as.character(unique(df$cyl)))
    )})

  # Check if data frame has been updated.
  values <- reactiveValues(update = 0)

  # Subset data by cyl.
  df2 <-
    reactive({
      values$update <- 0
      df2 <- droplevels(df[df$cyl == input$cyl,])})

  # Filter data.
  df3 <-
    eventReactive({
      input$update1
      input$update2
      input$update3
      df2()
    },
    {
      if (values$update > 0) {
        req(input$modelFilter)
        modelFilterDf <-
          data.frame(model = input$modelFilter)
        df3a <-
          merge(df2(), modelFilterDf, by = "model")
        df3a <- df3a[df3a$wt >= input$dataFilter[1] &
                       df3a$wt <= input$dataFilter[2], ]
      } else {
        df3a <- df2()
      }

      values$update <- values$update + 1
      df3a
    },
    ignoreNULL = FALSE,
    ignoreInit = TRUE)

  # Plot table.
  output$table <- renderTable(df3())

  # Filter by data value.
  output$dataFilter <-
    renderUI({
      req(df2()$wt[1])
      sliderInput(
        inputId = "dataFilter",
        label = "Filter by Weight (1000 lbs)",
        min = floor(min(df2()$wt, na.rm = TRUE)),
        max = ceiling(max(df2()$wt, na.rm = TRUE)),
        value = c(floor(min(df2()$wt, na.rm = TRUE)),
                  ceiling(max(df2()$wt, na.rm = TRUE))),
        step = round(max(df2()$wt, na.rm = TRUE) - min(df2()$wt, na.rm = TRUE)) / 100,
        round = round(log((
          max(df2()$wt, na.rm = TRUE) - min(df2()$wt, na.rm = TRUE)
        ) / 100))
      )
    })

  # Filter by lot / wafer.
  output$modelFilter <- renderUI({
    req(input$cyl)
    checkboxGroupInput(
      inputId = "modelFilter",
      label = "Filter by Model",
      choices = as.character(unique(df2()$model)),
      selected = as.character(unique(df2()$model))
    )
  })
}

# Run shiny.
shinyApp(ui = ui, server = server)