Question

我希望有一个具有动作效果的ractive闪亮应用程序，即我想自动显示依赖于每个最后选择的选择。例如，如果我在过滤器1中选择“A”，我想在过滤器2中显示“1”，“27”和“全部”选项而不操作“go”按钮

这是我的代码：

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

    })
  })

}

希望它有所帮助！

反应性输出，动作按钮闪亮

1 个答案: