Question

我正在构建一个Shiny应用程序，该应用程序通过特定功能生成数据框。我想根据无功输入使用eventReactive（）来赋予该函数结果的属性。

我尝试遵循以下答案：Working with a reactive() dataframe inside eventReactive()?，但是当我要使用observeEvent时，它总是会产生错误警告：$ .shinyoutput中的错误：不允许从Shinyoutput对象读取对象。

我的第一次尝试如下：

数据和图书馆

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)

df <-  data.frame(c1 = c(rep("A", 3), rep("B", 4), "on"), 
                  c2 = 1:8, 
                  c3 = c(2002,2003,2002,2004,2002,2003,2005, 2005))

my_function <- function(arg1, arg2)
{
  df = data.frame(
    v1 = mean(df %>% filter(c1 == arg1) %>% select(c2) %>% pull()),
    v2 = arg2
  )
  return(df)
}

UI

ui <- fluidPage(
  selectInput(inputId = "input1", label = NULL,
                         choices = c("A", "B"),
                         selected = "A"),
  selectInput(inputId = "input2", label = NULL,
                         choices = c("on", "off"),
                         selected = "on"),
  uiOutput("ui_year"),
  uiOutput("fct_extract"),
  actionButton(inputId = "extraction", label = "Go", icon = icon("play")),
  uiOutput("col_visu")
)

服务器

server <- function(input, output) {

  output$ui_year <- renderUI({
    checkboxGroupInput(inputId = "year1", label = NULL, choices = df %>% filter(c1 == "A") %>% select(c3) %>% pull())
  })

  output$fct_extract <- renderUI({
    shinyWidgets::radioGroupButtons(
      inputId = "fct_extract",
      label = NULL,
      selected = "B1",
      choices = c("B0", "B1"),
      status = "warning")
  })

 fct_extr <- reactive(output$fct_extract)

 df2 <- eventReactive(input$extraction, {
  if (fct_extr() == "B0")
  {
      my_function(arg1 = input$input1,
                  arg2 = input$input1)

  } else if (fct_extr() == "B1")
  {
      my_function(arg1 = input$input2,
                  arg2 = input$input1)
  }
  })

  columns <- reactive(colnames(df2()))

  output$col_visu <- renderUI({
    shinyWidgets::multiInput(
    inputId = "col_visu", width = "400px",
    label = h2("Selection :"),
    choices = columns())
  })
}

当我放置actionButton时，它生成消息：不允许从Shinyoutput对象读取对象。没有其他事情发生

所以我在SERVER中尝试过：

 fct_extr <- reactive(output$fct_extract)

 df2 <- observeEvent(input$extraction, {
  if (fct_extr() == "B0")
  {
      my_function(arg1 = input$input1,
                  arg2 = input$input1)

  } else if (fct_extr() == "B1")
  {
      my_function(arg1 = input$input2,
                  arg2 = input$input1)
  }
  })
}

我在这里收到消息：缺少参数“ x”，没有默认值，而不是 col_visu 的结果，当我放置actionButton时，应用关闭了< / p>

此外，当我不尝试使用fct_extra添加选择时，它可以工作：

  df2 <- eventReactive(input$extraction, {
          my_function(arg1 = input$input1,
                  arg2 = input$input1) 
  })

  columns <- reactive(colnames(df2()))

  output$col_visu <- renderUI({
    shinyWidgets::multiInput(
    inputId = "col_visu", width = "400px",
    label = h2("Selection :"),
    choices = columns())
  })

谢谢你们中的一位，他们将解释如何在eventReactive中包括一个反应式：）

Answer 1

我对您的代码进行了一些编辑以使其正常运行。这是实际的代码更改，不过是针对您的问题：

mean(df...而不是mean(a...

my_function <- function(arg1, arg2)
{
    df = data.frame(
        v1 = mean(df %>% filter(c1 == arg1) %>% select(c2) %>% pull()),
        v2 = arg2
    )
    return(df)
}

，然后删除行fct_extr <- reactive(output$fct_extract)。我认为您打算使用reactiveVal，但这在这里是不必要的。我只是替换了：

if (fct_extr() == "B0")... else if (fct_extr() == "B1")与 if (input$fct_extr == "B0")... else if (input$fct_extr == "B1")

下面的完整代码。

library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)

df <-  data.frame(c1 = c(rep("A", 3), rep("B", 4), "on"), 
                  c2 = 1:8, 
                  c3 = c(2002,2003,2002,2004,2002,2003,2005, 2005))

my_function <- function(arg1, arg2)
{
  df = data.frame(
    v1 = mean(df %>% filter(c1 == arg1) %>% select(c2) %>% pull()),
    v2 = arg2
  )
  return(df)
}

ui <- fluidPage(
  selectInput(inputId = "input1", label = NULL,
                         choices = c("A", "B"),
                         selected = "A"),
  selectInput(inputId = "input2", label = NULL,
                         choices = c("on", "off"),
                         selected = "on"),
  uiOutput("ui_year"),
  uiOutput("fct_extract"),
  actionButton(inputId = "extraction", label = "Go", icon = icon("play")),
  uiOutput("col_visu")
)

server <- function(input, output) {

    output$ui_year <- renderUI({
        checkboxGroupInput(inputId = "year1", label = NULL, choices = df %>% filter(c1 == "A") %>% select(c3) %>% pull())
    })

    output$fct_extract <- renderUI({
        shinyWidgets::radioGroupButtons(
            inputId = "fct_extract",
            label = NULL,
            selected = "B1",
            choices = c("B0", "B1"),
            status = "warning")
    })

    # fct_extr <- reactiveVal(input$fct_extract)

    df2 <- eventReactive(input$extraction, {
        if (input$fct_extract == "B0")
        {
            my_function(arg1 = input$input1,
                        arg2 = input$input1)

        } else if (input$fct_extract == "B1")
        {
            my_function(arg1 = input$input2,
                        arg2 = input$input1)
        }
    })

    columns <- reactive(colnames(df2()))

    output$col_visu <- renderUI({
        shinyWidgets::multiInput(
            inputId = "col_visu", width = "400px",
            label = h2("Selection :"),
            choices = columns())
    })
}

shinyApp(ui, server)

Answer 2

您定义以下动态radioGroupButton：

 output$fct_extract <- renderUI({
    shinyWidgets::radioGroupButtons(
      inputId = "fct_extract",
      label = NULL,
      selected = "B1",
      choices = c("B0", "B1"),
      status = "warning")
  })

这定义了一个UI元素，其值可以在input中访问，其键设置为元素的inputId。因此，在这种情况下，值在input$fct_extract

下

请注意，这与输出中UI对象的名称无关，只是碰巧也就是fct_extract。这种命名令人困惑，并可能导致您的错误：实际上是在output$fct_extract中访问试图在input$fct_extract中的窗口小部件的值。

要修复您的代码，请使用正确的字符替换非法行（fct_extr <- reactive(output$fct_extract)）

fct_extr <- reactive(input$fct_extract)

实际上，由于input$fct_extract已经是一个有效值，因此该有效值是多余的。因此，完全抛弃您的反应堆，并使用input$fct_extract

在事件中使用反应条件

2 个答案: