2017-06-21 76 views
0

在下面的例子中,我有3 DT::datatables。我希望用戶能夠從所有這些表中選擇不超過一行。因此根據documentation中的「操作現有數據表實例」一節,使用dataTableProxyselectRow。它工作正常。Shiny - DT - 單行選擇,跨越幾個DT ::表

但是,在我的應用程序中,我有24(稱爲值N)表。如果我嘗試將下面的代碼調整到我的24表格頁面,我會得到可觀數量的代碼行。

這樣做的更聰明的方法是什麼?

特別是,我怎麼能:

  • 動態申報觀察員? (由user5029763回答)
  • 知道哪個表(不是行)最後被點擊了? (即如何重新寫reactiveText()?)

編輯:我user5029763的答案複製(見下文),在下面的代碼。

DTWrapper <- function(data, pl = 5, preselec = c()){ 
    datatable(data, 
      options = list(pageLength = pl, dom='t',ordering=F), 
      selection = list(mode = 'single', selected= preselec), 
      rownames = FALSE) 
} 
resetRows <- function(proxies, self){ 
    for (i in 1:length(proxies)){ 
    if (self != i){ 
     proxies[[i]] %>% selectRows(NULL) 
    } 
    } 
} 

lapply(1:3, function(id) { 
    observe({ 
    rownum <- input[[paste0("tab",id,"_rows_selected")]] 
    if (length(rownum) > 0) { resetRows(proxyList(), id) } 
    }) 
}) 

server = function(input, output) { 

    output$tab1 <- DT::renderDataTable(DTWrapper(head(mtcars[,1:3]), input$selectTop)) 
    output$tab2 <- DT::renderDataTable(DTWrapper(head(mtcars[,1:3]), input$selectTop)) 
    output$tab3 <- DT::renderDataTable(DTWrapper(head(mtcars[,1:3]), input$selectTop)) 

    proxyList <- reactive({ 
    proxies = list() 
    for (i in 1:3){ 
     tableID <- paste("tab", i, sep="") 
     proxies[[i]] = dataTableProxy(tableID) 
    } 
    return(proxies) 
    }) 

    reactiveText <- reactive({ 
    rownum1 <- input$tab1_rows_selected 
    rownum2 <- input$tab2_rows_selected 
    rownum3 <- input$tab3_rows_selected 
    if (length(rownum1) > 0){return(c(rownum1, 1))} 
    if (length(rownum2) > 0){return(c(rownum2, 2))} 
    if (length(rownum3) > 0){return(c(rownum3, 3))} 
    }) 

    output$txt1 <- renderText({ 
    paste("You selected row ", reactiveText()[1] 
      , " from table ", reactiveText()[2], ".", sep="") 
    }) 
} 

shinyApp(
    ui = fluidPage(
    fluidRow(column(4,DT::dataTableOutput("tab1")) 
      , column(4,DT::dataTableOutput("tab2")) 
      , column(4, DT::dataTableOutput("tab3"))) 
    ,fluidRow(column(4,textOutput("txt1"))) 
), 
    server = server 
) 

textOutput是:「你從第Y表中選擇的X行」。

回答

1

編輯後:

你可以嘗試modules。另一種方法是lapply

lapply(1:3, function(id) { 
    observe({ 
     rownum <- input[[paste0("tab",id,"_rows_selected")]] 
     if (length(rownum) > 0) { 
     resetRows(proxyList(), id) 

     msg <- paste0("You selected row ", rownum, ", from table ", id, ".") 
     output$txt1 <- renderText(msg) 
     } 
    }) 
}) 
+0

Thx for this answer。這需要清理以前的選擇,這很好。但是,通過這種方式,代碼中的其他函數如何檢索'rownum'(例如更新'Xoutput')?我不確定我是否清楚,但是我已經嘗試更新我的Q,以使這個問題更加詳細。 Thx- – hartmut

+0

我修改了我的答案 – user5029763

+0

完美,節省了我50多行代碼。 – hartmut