閃光動作按鈕的無效輸入

Question

我想要一個具有動作按鈕的閃亮應用程序，即我想自動顯示依賴於每個最後選擇的選擇。 例如，如果我選擇我要顯示「1」過濾器1「A」，「27」和「全部」選擇​​過濾器2不actionate「走出去」按鈕

這裏是我的代碼：

library(shiny) 
library(dplyr) 
library(DT) 

ui <- fluidPage(

    titlePanel("Title"), 

    sidebarLayout(
    sidebarPanel(width=3, 
       selectInput("filter1", "Filter 1", multiple = TRUE, choices = c("All", LETTERS)), 
       selectInput("filter2", "Filter 2", multiple = TRUE, choices = c("All", as.character(seq.int(1, length(letters), 1)))), 
       selectInput("filter3", "Filter 3", multiple = TRUE, choices = c("All", letters)), 
       actionButton("go_button", "GO !")), 

    mainPanel(
     DT::dataTableOutput("tableprint") 
    ) 
) 
) 

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


    goButton <- eventReactive(input$go_button,{ 
    # Data 
    df <- tibble(LETTERS = rep(LETTERS, 2), Numbers = as.character(1:52), 
       letters = paste(LETTERS, Numbers, sep = "")) 

    df1 <- df 

    if("All" %in% input$filter1){ 
     df1 
    } else if (length(input$filter1)){ 
     df1 <- df1[which(df1$LETTERS %in% input$filter1),] 
    } 

    # Update selectInput choices based on the filtered data. Update 'selected' to reflect the user input. 
    updateSelectInput(session, "filter1", choices = c("All", df$LETTERS), selected = input$filter1) 
    updateSelectInput(session, "filter2", choices = c("All", df1$Numbers), selected = input$filter2) 



    if("All" %in% input$filter2){ 
     df1 
    } else if (length(input$filter2)){ 
     df1 <- df1[which(df1$Numbers %in% input$filter2),] 
    } 
    updateSelectInput(session, "filter3", choices = c("All", df1$letters), selected = input$filter3) 

    if("All" %in% input$filter3){ 
     df1 
    } else if (length(input$filter3)){ 
     df1 <- df1[which(df1$letters %in% input$filter3),] 
    } 
    datatable(df1) 
    }) 

    output$tableprint <- DT::renderDataTable({ 
    goButton() 

    }) 
} 

# Run the application 
shinyApp(ui = ui, server = server) 

Answer 1

我修改了您的代碼，以便選擇輸入和表是反應性的，並在更改任何選擇輸入時得到更新。

library(shiny) 
library(dplyr) 
library(DT) 

ui <- fluidPage(

    titlePanel("Title"), 

    sidebarLayout(
    sidebarPanel(width=3, 
       selectInput("filter1", "Filter 1", multiple = FALSE, choices = c("All", LETTERS), selected = "All"), 
       selectInput("filter2", "Filter 2", multiple = FALSE, choices = c("All", as.character(seq.int(1, length(letters), 1))), selected = "All"), 
       selectInput("filter3", "Filter 3", multiple = FALSE, choices = c("All", letters), selected = "All"), 
       actionButton("go_button", "GO !")), 

    mainPanel(
     DT::dataTableOutput("tableprint") 
    ) 
) 
) 



df <- tibble(LETTERS = rep(LETTERS, 2), Numbers = as.character(1:52), 
      letters = paste(LETTERS, Numbers, sep = "")) 

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

    data1 <- reactive({ 

    if("All" %in% input$filter1){ 
     df1 <- df 
    }else{ 
     df1 <- df[which(df$LETTERS %in% input$filter1),] 
    } 

    df1 
    }) 

    data2 <- reactive({ 

    if("All" %in% input$filter2){ 
     df1 <- data1() 
    } else if (length(input$filter2)){ 
     df1 <- data1()[which(data1()$Numbers %in% input$filter2),] 
    } 
    df1 
    }) 

    data3<- reactive({ 

    if("All" %in% input$filter3){ 
     df1 <- data2() 
    } else if (length(input$filter3)){ 
     df1 <- data2()[which(data2()$letters %in% input$filter3),] 
    } 
    df1 
    }) 


    observeEvent(input$filter1,{ 
    updateSelectInput(session, "filter2", choices = c("All", data1()$Numbers), selected = "All") 
    }) 

    observeEvent(input$filter2,{ 
    updateSelectInput(session, "filter3", choices = c("All", data2()$letters), selected = "All") 
    }) 

    output$tableprint <- DT::renderDataTable({ 
    data3() 

    }) 

} 

shinyApp(ui = ui, server = server) 

要渲染表只點擊鏈接就可以使用下面的服務器代碼，而不是上面：

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

    data1 <- reactive({ 

    if("All" %in% input$filter1){ 
     df1 <- df 
    }else{ 
     df1 <- df[which(df$LETTERS %in% input$filter1),] 
    } 

    df1 
    }) 

    data2 <- reactive({ 

    if("All" %in% input$filter2){ 
     df1 <- data1() 
    } else if (length(input$filter2)){ 
     df1 <- data1()[which(data1()$Numbers %in% input$filter2),] 
    } 
    df1 
    }) 

    data3<- reactive({ 

    if("All" %in% input$filter3){ 
     df1 <- data2() 
    } else if (length(input$filter3)){ 
     df1 <- data2()[which(data2()$letters %in% input$filter3),] 
    } 
    df1 
    }) 


    observeEvent(input$filter1,{ 
    updateSelectInput(session, "filter2", choices = c("All", data1()$Numbers), selected = "All") 
    }) 

    observeEvent(input$filter2,{ 
    updateSelectInput(session, "filter3", choices = c("All", data2()$letters), selected = "All") 
    }) 

    observeEvent(input$go_button,{ 
    output$tableprint <- DT::renderDataTable({ 
     data3() 

    }) 
    })  
} 

在上面的代碼它呈現的第一次它會之後，你會發現，當我們改變selectinput的值時自動更新。爲了避免這種情況，只得到最後的新表格，可以使用下面的代碼：

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

    data3<-NULL 
    data1 <- reactive({ 

    if("All" %in% input$filter1){ 
     df1 <- df 
    }else{ 
     df1 <- df[which(df$LETTERS %in% input$filter1),] 
    } 

    df1 
    }) 

    data2 <- reactive({ 

    if("All" %in% input$filter2){ 
     df1 <- data1() 
    } else if (length(input$filter2)){ 
     df1 <- data1()[which(data1()$Numbers %in% input$filter2),] 
    } 
    df1 
    }) 


    observeEvent(input$filter1,{ 
    updateSelectInput(session, "filter2", choices = c("All", data1()$Numbers), selected = "All") 
    }) 

    observeEvent(input$filter2,{ 
    updateSelectInput(session, "filter3", choices = c("All", data2()$letters), selected = "All") 
    if("All" %in% input$filter3){ 
     data3 <<- data2() 
    } else if (length(input$filter3)){ 
     data3 <<- data2()[which(data2()$letters %in% input$filter3),] 
    } 

    }) 

    observeEvent(input$go_button,{ 
    output$tableprint <- DT::renderDataTable({ 
     data3 

    }) 
    }) 

} 

希望它有幫助！