闪亮:在这种情况下,如何为条件过滤器进行无功输入?
Shiny: how to make a reactive input for a conditional filter in this case?
最近我正在更改 DT::datatable
的选项,因为我必须使用 formatCurrency,所以我在 renderDataTable 之外使用了 datatable
函数。在这种情况下,selectInput
选择的输入对象的别名列中的动态 filter
不再起作用。
错误建议将表达式包装成reactive
或observeEvent
。我确实尝试了一些都失败的方法。也许有人很快就做对了:
# 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)
最近我正在更改 DT::datatable
的选项,因为我必须使用 formatCurrency,所以我在 renderDataTable 之外使用了 datatable
函数。在这种情况下,selectInput
选择的输入对象的别名列中的动态 filter
不再起作用。
错误建议将表达式包装成reactive
或observeEvent
。我确实尝试了一些都失败的方法。也许有人很快就做对了:
# 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)