在Shiny中的选项卡之间保持数据表排序

时间:2017-05-15 07:40:17

标签: r sorting shiny dt

我正在尝试实现一个闪亮的应用程序,其中我在tabset面板中有一些数据表,并且这些数据表具有相同的行和列。我想要实现的是,当用户对列进行排序时,如果他更改了选项卡,则数据将按与第一列相同的列号排序。我有这个应用程序,我将尝试实现它:

library(DT)
library(shiny)
app <- shinyApp(
  ui = fluidPage(
    tags$head(
      # hides the default search functionality
      tags$style(
        #HTML(".dataTables_filter, .dataTables_info { display: none; }"),
        HTML(".shiny-input-container { display: none; }")
      )
    ),
    fluidRow(
      column(10, 
             ""
      ), 
      column(2,              
             # adding new page filter
             uiOutput("pageFilter")
      ),
      column(12,
       tabsetPanel(id = "tab",
         tabPanel('pressure',
                  DT::dataTableOutput('table1')
         ),
         tabPanel('mtcars',
                  DT::dataTableOutput('table2')
         )
       )
      )
    )
  ),
  server = function(input, output) {

    global <- reactiveValues()

    observe({
      global$val <- input$table1_state$start / input$table1_state$length + 1
    })

    observe({
      global$val <- input$table2_state$start / input$table2_state$length + 1
    })

    output$pageFilter <- renderUI({
      numericInput("page", "Page", max(global$val,1), min = 1)
    })

    output$table1 <- DT::renderDataTable({
      iris
    }, options = list(pageLength = 15, stateSave = TRUE))

    output$table2 = DT::renderDataTable({
      mtcars
    }, options = list(pageLength = 15, stateSave = TRUE))

    # using new page filter
    observeEvent({input$page; input$tab}, {
      dataTableProxy("table1") %>% selectPage(global$val)
      dataTableProxy("table2") %>% selectPage(global$val)
    })
  }
)

runApp(app, launch.browser =  TRUE)

有什么想法吗?

1 个答案:

答案 0 :(得分:2)

您已知道的input$table1_state变量。这里的技巧是在renderDataTable()中定义数据表并更新其中的设置。我还没看到&#34;摇晃&#34;触发,显然订单经常变化,但我还没有得到原因。

library(DT)
library(shiny)
app <- shinyApp(
  ui = fluidPage(
    tags$head(
      # hides the default search functionality
      tags$style(
        HTML(".dataTables_filter, .dataTables_info { display: none; }"),
        HTML(".shiny-input-container { display: none; }")
      )
    ),
    fluidRow(
      column(10, 
             ""
      ), 
      column(2,              
             # adding new page filter
             uiOutput("pageFilter")
      ),
      column(12,
             tabsetPanel(id = "tab",
                         tabPanel('pressure',
                                  DT::dataTableOutput('table1')
                         ),
                         tabPanel('mtcars',
                                  DT::dataTableOutput('table2')
                         )
             )
      )
    )
  ),
  server = function(input, output) {

    global <- reactiveValues()

    observe({
      input$table1_state
      isolate({
        global$val <- input$table1_state$start / input$table1_state$length + 1
        if(!is.null(input$table1_state$order)){
          global$order <- input$table1_state$order
        }
      })
    })

    observe({
      input$table2_state
      isolate({
        global$val <- input$table2_state$start / input$table2_state$length + 1
        if(!is.null(input$table2_state$order)){
          global$order <- input$table2_state$order
        }
      })
    })

    output$pageFilter <- renderUI({
      numericInput("page", "Page", max(global$val, 1), min = 1)
    })

    output$table1 <- DT::renderDataTable({
      datatable(iris, options = list(
        order = global$order, stateSave = TRUE, pageLength = 15)
      )
    })

    output$table2 = DT::renderDataTable({
      datatable(mtcars, options = list(
        order = global$order, stateSave = TRUE, pageLength = 15)
      )
    })

    # using new page filter
    observeEvent({input$page; input$tab}, {
      dataTableProxy("table1") %>% selectPage(global$val)
      dataTableProxy("table2") %>% selectPage(global$val)
    })

  }
)

runApp(app, launch.browser =  TRUE)