Shiny - DT - Einreihige Auswahl, über mehrere DT :: Tabellen

Question

Im Beispiel unten habe ich 3 DT::datatables. Ich möchte, dass der Benutzer nicht mehr als eine Zeile aus allen diesen Tabellen auswählen kann. Ich verwende daher dataTableProxy und selectRow, wie im Abschnitt "Manipulieren einer vorhandenen DataTables-Instanz" in der documentation. Es funktioniert gut.

Allerdings habe ich in meiner Anwendung 24 (nennen Sie diesen Wert N) Tabellen. Wenn ich versuche, den unten stehenden Code an meine 24-Tabellen-Seite anzupassen, bekomme ich eine entsetzliche Anzahl von Codezeilen.

Was ist ein klügerer Weg, dies zu tun?

Insbesondere, wie kann ich:

• die Beobachter dynamisch erklären? (beantwortet von user5029763)
• wissen, auf welche Tabelle (nicht Zeile) zuletzt geklickt wurde? (. Dh wie reactiveText() schreiben wieder?)

EDIT: ich in user5029763 Antwort kopiert haben (siehe unten) in den Code unten.

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 
) 

The textOutput ist: "Sie haben die X-te Zeile aus der Y-ten Tabelle ausgewählt".

Answer 1

Nach edit:

Sie könnten modules versuchen. Ein anderer Weg wäre ein 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) 
     } 
    }) 
})