闪亮:在这种情况下,如何为条件过滤器进行无功输入?

Shiny: how to make a reactive input for a conditional filter in this case?

最近我正在更改 DT::datatable 的选项,因为我必须使用 formatCurrency,所以我在 renderDataTable 之外使用了 datatable 函数。在这种情况下,selectInput 选择的输入对象的别名列中的动态 filter 不再起作用。

错误建议将表达式包装成reactiveobserveEvent。我确实尝试了一些都失败的方法。也许有人很快就做对了:

# shiny lib
library(shiny)
library(shinydashboard)
# core
suppressPackageStartupMessages(library(tidyverse))
suppressPackageStartupMessages(library(DT))

#### UI 

ui <- dashboardPage(
  dashboardHeader(title = "TEST"),
  dashboardSidebar(
    sidebarMenu(id = "tabs",
                menuItem("Inspection",
                         tabName = "analyze"
                        )
             )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "analyze",
              selectInput(inputId = "id",
                          label = "Select",
                          choices = "",
                          selected = ""),
              mainPanel(width = 100, 
                        fluidPage(
                          fluidRow(dataTableOutput("ts_kpi1.1")
                          )
                      )
                  )
              )
          )
     )
)


#### SERVER
    
  server <- function(input, output, session) {

  data <- tibble(value = c(c(10000.33,15000.55),c(12000.99,33005.44)),
                 Alias = c(rep("A",2),rep("B",2))
  )
  updateSelectInput(session ,
                    "id",
                    choices = unique(data$Alias)
  )
  df_kpi1 <- data %>% 
    dplyr::filter(Alias == input$id) %>%
    summarise(Mean = mean(value),
              Median = median(value)
    ) %>% as_tibble() %>% 
    mutate_if(is.numeric, ~round(., 0)
              )
  DT_kpi1 <- datatable(df_kpi1,         
                     options = list(
                       scrollX = FALSE,
                                    autoWidth = TRUE,
                                    bFilter = 0,
                                    bInfo = FALSE,
                                    bPaginate = FALSE,
                                    lengthChange = FALSE,
                                    columnDefs = list(list(searchable = FALSE, targets = "_all"),
                                                      list(targets = c(0), visible = TRUE),
                                                      list(searching = FALSE),
                                                      list(ordering=F)
                                                     )
                                                   ),
                                   rownames = FALSE ) %>% 
                                   formatCurrency(columns = c(1:2), currency = "", interval = 3, mark = ".")
  output$ts_kpi1.1 <- DT::renderDataTable({
    DT_kpi1
  }) 
}
runApp(list(ui = ui, server = server),launch.browser = TRUE)

正如您在问题中正确假设的那样,R 几乎在错误消息中为您提供了答案:

Input `..1` is `Alias == input$id`.
x Can't access reactive value 'id' outside of reactive consumer.
i Do you need to wrap inside reactive() or observe()?

您无法在反应性上下文之外访问 input$id 内的值。只需将 df_kpi1 的分配包装成反应式,例如:

df_kpi1 <- reactive(data %>%
      ...
      ...
      )

这应该可以解决您的问题。

编辑:您的示例

# shiny lib
library(shiny)
library(shinydashboard)
# core
suppressPackageStartupMessages(library(tidyverse))
suppressPackageStartupMessages(library(DT))

#### UI 

ui <- dashboardPage(
  dashboardHeader(title = "TEST"),
  dashboardSidebar(
    sidebarMenu(id = "tabs",
                menuItem("Inspection",
                         tabName = "analyze"
                )
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "analyze",
              selectInput(inputId = "id",
                          label = "Select",
                          choices = "",
                          selected = ""),
              mainPanel(width = 100, 
                        fluidPage(
                          fluidRow(dataTableOutput("ts_kpi1.1")
                          )
                        )
              )
      )
    )
  )
)


#### SERVER

server <- function(input, output, session) {
  
  data <- tibble(value = c(c(10000.33,15000.55),c(12000.99,33005.44)),
                 Alias = c(rep("A",2),rep("B",2))
  )
  updateSelectInput(session ,
                    "id",
                    choices = unique(data$Alias)
  )
  DT_kpi1 <- reactive({
    
    
    df_kpi1 <- data %>% 
    dplyr::filter(Alias == input$id) %>%
    summarise(Mean = mean(value),
              Median = median(value)
    ) %>% as_tibble() %>% 
    mutate_if(is.numeric, ~round(., 0)
    )
    
  DT_kpi1 <- datatable(df_kpi1,         
                       options = list(
                         scrollX = FALSE,
                         autoWidth = TRUE,
                         bFilter = 0,
                         bInfo = FALSE,
                         bPaginate = FALSE,
                         lengthChange = FALSE,
                         columnDefs = list(list(searchable = FALSE, targets = "_all"),
                                           list(targets = c(0), visible = TRUE),
                                           list(searching = FALSE),
                                           list(ordering=F)
                         )
                       ),
                       rownames = FALSE ) %>% 
    formatCurrency(columns = c(1:2), currency = "", interval = 3, mark = ".")
  DT_kpi1
  })
  
  
  output$ts_kpi1.1 <- DT::renderDataTable({
    DT_kpi1()
  }) 
}
runApp(list(ui = ui, server = server),launch.browser = TRUE)