![](/img/trans.png)
[英]Displaying data table in shiny app, columns displayed conditional on checkboxGroupInput
[英]checkboxGroupInput hide or delete table output in a shiny app
我正在創建一個 shiny 應用程序,其復選框組中的選擇在單擊操作按鈕后返回一個包含過濾數據的表格,如下例所示。 我的問題是如何在生成表格后包含該功能,當我再次單擊任何復選框時,表格將被隱藏或刪除,直到用戶再次單擊操作按鈕。
library(shiny)
library(DT)
library(dplyr)
ui <- fluidPage(
checkboxGroupInput(inputId = "checkboxGroup1", label = "checkboxGroup1", choices = list(5.0, 4.6)),
checkboxGroupInput(inputId = "checkboxGroup2", label = "checkboxGroup2", choices = list(3.4, 3.6)),
checkboxGroupInput(inputId = "checkboxGroup3", label = "checkboxGroup3", choices = list(0.2, 1.5)),
checkboxGroupInput(inputId = "checkboxGroup4", label = "checkboxGroup4", choices = list("setosa", "virginica")),
actionButton('action',label = 'action'),
mainPanel(
dataTableOutput("table1")
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
filter_data <- eventReactive(input$action, {
data <- iris
data %>%
{if (is.null(input$checkboxGroup1) == FALSE) filter(., Sepal.Length %in% input$checkboxGroup1) else .} %>%
{if (is.null(input$checkboxGroup2) == FALSE) filter(., Sepal.Width %in% input$checkboxGroup2) else .} %>%
{if (is.null(input$checkboxGroup3) == FALSE) filter(., Petal.Width %in% input$checkboxGroup3) else .} %>%
{if (is.null(input$checkboxGroup4) == FALSE) filter(., Species %in% input$checkboxGroup4) else .}
})
output$table1 <- renderDataTable(
filter_data()
)
}
# Run the application
shinyApp(ui = ui, server = server)
這是一個使用shinyjs
的選項。 首先創建一個依賴於所有復選框輸入的反應式表達式。 我們可以在選擇復選框時使用shinyjs::hide
DT。 然后使用shinyjs::show
在單擊操作按鈕時顯示表格。
帶有更新的基本 UI 的演示
library(shiny)
library(DT)
library(dplyr)
library(shinyjs)
ui <- fluidPage(
useShinyjs(), # include shinyjs here
checkboxGroupInput(inputId = "checkboxGroup1", label = "checkboxGroup1", choices = list(5.0, 4.6)),
checkboxGroupInput(inputId = "checkboxGroup2", label = "checkboxGroup2", choices = list(3.4, 3.6)),
checkboxGroupInput(inputId = "checkboxGroup3", label = "checkboxGroup3", choices = list(0.2, 1.5)),
checkboxGroupInput(inputId = "checkboxGroup4", label = "checkboxGroup4", choices = list("setosa", "virginica")),
actionButton('action',label = 'action'),
mainPanel(
dataTableOutput("table1")
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
filter_data <- eventReactive(input$action, {
data <- iris
data %>%
{if (is.null(input$checkboxGroup1) == FALSE) filter(., Sepal.Length %in% input$checkboxGroup1) else .} %>%
{if (is.null(input$checkboxGroup2) == FALSE) filter(., Sepal.Width %in% input$checkboxGroup2) else .} %>%
{if (is.null(input$checkboxGroup3) == FALSE) filter(., Petal.Width %in% input$checkboxGroup3) else .} %>%
{if (is.null(input$checkboxGroup4) == FALSE) filter(., Species %in% input$checkboxGroup4) else .}
})
obs_checkboxes = reactive({
list(input$checkboxGroup1,input$checkboxGroup2,input$checkboxGroup3,input$checkboxGroup4)
})
observeEvent(obs_checkboxes(), {
hide("table1")
})
observeEvent(input$action, {
show("table1")
})
output$table1 <- renderDataTable(
filter_data()
)
}
# Run the application
shinyApp(ui = ui, server = server)
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.