保持數據表格之間Shiny的選項卡

Question

我試圖實現一個閃亮的應用程序，其中我有一些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) 

任何想法？

Answer 1

input$table1_state變量你已經知道了。這裏的技巧是在renderDataTable()中定義一個數據表，並更新那裏的設置。我還沒有看到「震動」是如何觸發的，顯然這個順序經常發生變化，但我沒有明白爲什麼。

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)