반짝이는 탭 사이에서 데이터 테이블 정렬을 유지하십시오.

Question

탭 세트 패널에 데이터 테이블이있는 곳에 반짝 이는 응용 프로그램을 구현하려고하는데이 데이터 테이블에는 동일한 행과 열이 있습니다. 구현하고자하는 것은 사용자가 열을 정렬 할 때 탭을 변경하면 데이터가 첫 번째 열과 동일한 열 번호로 정렬된다는 것입니다. 나는 그것을 구현하려고하는이 어플리케이션을 가지고있다 :

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)