在 Shiny 中输入更改时切换到不同的 DataTable 页面?

Switching to different DataTable page when input change in Shiny?

基本上,我希望输出 DataTable 切换到具有与输入选择值 (radioButtons) 匹配的值的页面。我知道我可以做一个简单的过滤器,但这会删除所有其他不符合我不想要的条件的行。

感谢任何帮助!谢谢!

library(shiny)
library(DT)

ui <- basicPage(
  h3("The mtcars data"),
  fluidRow(column(2,
                  offset = 1,
                  radioButtons("valSel", strong("Gear"),
                               inline = TRUE,
                               choices = c("3", "4", "5"),
                               selected = "3")),
           fluidRow(column(10,
                           offset = 1,
                           dataTableOutput("mytable")))
  )
)

server <- function(input, output) {
  
  output$mytable = DT::renderDataTable({
    mtcars[mtcars$gear == input$valSel, ]
  })
}

shinyApp(ui, server)

reprex package (v2.0.0)

于 2021-05-27 创建

不清楚您将如何识别给定特定值的页面,它们可能包含不同的行数。

设置页面的一种替代方法是使用 factor 数据类型根据单选按钮输入对类别重新排序,这只会将感兴趣的类别带到数据框的顶部传递给 renderDatatable:

library(shiny)
library(DT)

ui <- basicPage(
  h3("The mtcars data"),
  fluidRow(column(2,
                  offset = 1,
                  radioButtons("valSel", strong("Gear"),
                               inline = TRUE,
                               choices = c("3", "4", "5"),
                               selected = "3")),
           fluidRow(column(10,
                           offset = 1,
                           dataTableOutput("mytable")))
  )
)

server <- function(input, output) {
  
  df <- reactive({
    gear_vals <- unique(as.character(mtcars$gear))
    mtcars$gear <- factor(mtcars$gear, 
                          levels = c(input$valSel, 
                                     gear_vals[input$valSel != gear_vals]))
    mtcars[order(mtcars$gear),]
  })
  
  output$mytable = DT::renderDataTable({
    df()
  })
}

shinyApp(ui, server)

您可以创建自定义 js 函数并切换到所需页面。试试这个

library(shiny)
library(DT)
library(tidyverse)

ui <- basicPage(
  h3("The mtcars data"),
  fluidRow(column(2,
                  offset = 1,
                  radioButtons("valSel", strong("Gear"),
                               inline = TRUE,
                               choices = c("3", "4", "5"),
                               selected = "3")),
           fluidRow(column(10,
                           offset = 1, # verbatimTextOutput("t1"),
                           DTOutput("mytable")))
  ),
  tags$script(HTML(
    "Shiny.addCustomMessageHandler('pager',function(page) {
      $('#'+'mytable').find('table').DataTable().page(page).draw(false);
    })"
  ))
)

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

  mydf <- reactive({
    mtcars %>% mutate(rowid = row_number())
  })

  subdf <- reactive({
    req(mydf())
    mydf()[mydf()$gear == input$valSel, ]
  })
  output$t1 <- renderPrint({ceiling(min(subdf()$rowid)/10)})

  output$mytable = renderDT({
    n <- length(names(mydf())) ## to remove rowid
    mydf()[,-n]
  })

  observeEvent(input$valSel,{

    page <- ceiling(min(subdf()$rowid)/10) ## assumes 10 rows are displayed per page (default); if different, replace 10 by the number of rows displayed per page
    
    session$sendCustomMessage("pager",page-1)

  })

}

shinyApp(ui, server)