2017-12-19 7 views
2

Was ich zu erreichen versuche ist ähnlich wie this thread, aber etwas komplizierter.Radiobuttons in Shiny DataTable für "Unterauswahl" von Zeilen/Gruppierung in einer Spalte

Ich möchte die Radiobuttons in verschiedene Gruppen gruppieren, aber in einer Spalte ist also eine "Unterselektion" von Zeilen möglich.

Derzeit funktioniert nur die Optionsfeldgruppe mit der ID "C", da das Element div für die gesamte Tabelle definiert ist. Ich habe versucht, die glänzenden Tags über JavaScript Callback einzufügen, aber ich kann nur eine Optionsschaltfläche für jede Zeile oder für jede Spalte einfügen, aber nicht für eine Teilmenge mehrerer Zeilen in einer Spalte.

Offen für Javascript oder glänzende Lösungen.

shinyApp(
    ui = fluidPage(
    title = 'Radio buttons in a table', 
    tags$div(id="C",class='shiny-input-radiogroup',DT::dataTableOutput('foo')), 
    verbatimTextOutput("test") 
), 
    server = function(input, output, session) { 
    m = matrix(
     c(round(rnorm(24),1), rep(3,12)), nrow = 12, ncol = 3, byrow = F, 
     dimnames = list(month.abb, LETTERS[1:3]) 
    ) 
    m[, 2] <- rep(c("A","B","C", "D"), each= 3) 
    m[, 3] <- paste0('<input type="radio" name="', rep(c("A","B","C", "D"), each= 3),'" value="', month.abb,'"/>') 
    m[c(1,4,7,10), 3] <- gsub('/>', 'checked="checked"/>', m[c(1,4,7,10), 3], fixed = T) 
    m 
    output$foo = DT::renderDataTable(
     m, escape = FALSE, selection = 'none', server = FALSE, 
     options = list(dom = 't', paging = FALSE, ordering = FALSE) 
     # callback = JS("table.rows().every(function() { 
     #   var $this = $(this.node()); 
     #   $this.attr('id', this.data()[0]); 
     #   $this.addClass('shiny-input-radiogroup'); 
     #   }); 
     #   Shiny.unbindAll(table.table().node()); 
     #   Shiny.bindAll(table.table().node());") 
    ) 
    output$test <- renderPrint(str(input$C)) 
    } 
) 

UPDATE:

Die grobe Struktur meiner Endlösung mit reaktiver Taste Auswahl. Die Eingaben und Visualisierungen bleiben erhalten, wenn die Tabelle neu gerendert wird (nur beim ersten Mal, wenn die Eingabe als NULL gerendert wird, was für mich kein besonderes Problem darstellt).

library(shiny) 
library(DT) 

shinyApp(
    ui = fluidPage(
    title = "Radio buttons in a table", 
    sliderInput("slider_num_rows", "Num Rows", min = 2, max = 12, value = 5), 
    tags$div(id = 'placeholder'), 
    verbatimTextOutput("test") 
), 
    server = function(input, output, session) { 
    rea <- reactive({ 
     m = matrix(
     c(round(rnorm(24),1), rep(3,12)), nrow = 12, ncol = 3, byrow = F, 
     dimnames = list(month.abb, LETTERS[1:3]) 
    ) 

     m[, 2] <- rep(c("A","B","C", "D"), each= 3) 
     m[, 3] <- paste0('<input type="radio" name="', rep(c("A","B","C", "D"), each= 3),'" value="', month.abb,'"/>') 
     save_sel <- c() 
     mon_tes <- c("Jan", "Apr", "Jul", "Oct") 
     ab <- c("A", "B", "C", "D") 
     for (i in 1:4){ 
     if (is.null(input[[ab[i]]])){ 
      save_sel[i] <- mon_tes[i] 
     } else { 
      save_sel[i] <- input[[ab[i]]] 
     } 
     } 
     sel <- rownames(m) %in% save_sel 
     m[sel, 3] <- gsub('/>', 'checked="checked"/>', m[sel, 3], fixed = T) 
     m <- m[1:input$slider_num_rows,] 
     m 
    }) 

    output$foo = DT::renderDataTable(
     rea(), escape = FALSE, selection = 'none', server = FALSE, 
     options = list(dom = 't', paging = FALSE, ordering = FALSE, 
        columnDefs = list(list(className = 'no_select', targets = 3))) 
    ) 

    observe({ 
     l <- unique(m[, 2]) 

     for(i in 1:length(l)) { 
     if (i == 1) { 
      radio_grp <- div(id = l[i], class = "shiny-input-radiogroup", DT::dataTableOutput("foo")) 
     } else { 
      radio_grp <- div(id = l[i], class = "shiny-input-radiogroup", radio_grp) 
     } 
     } 
     insertUI(selector = '#placeholder', 
       ui = radio_grp) 
    }) 
    output$test <- renderPrint({ 
     str(input$A) 
     str(input$B) 
     str(input$C) 
     str(input$D) 
    }) 
    } 
) 

Antwort

0

Sie können Nest die div Elemente ineinander wie folgt aus:

ui = fluidPage(
    title = "Radio buttons in a table", 
    div(id = "A", class = "shiny-input-radiogroup", 
     div(id = "B", class = "shiny-input-radiogroup", 
     div(id = "C", class = "shiny-input-radiogroup", 
      div(id = "D", class = "shiny-input-radiogroup", DT::dataTableOutput("foo"))  
     ) 
    ) 
    ), 

ich alle Werte auch renderText modifiziert, um zu drucken.

output$test <- renderPrint({ 
    str(input$A) 
    str(input$B) 
    str(input$C) 
    str(input$D) 
}) 

Hier ist das Ergebnis nach dem dataTableOutput der Interaktion (ausgewählt, um das Feb Optionsfeld):

enter image description here

Bitte beachten Sie, dass die Elemente noch NULL Wert bis Interaktion haben. Sie können dieses Problem jedoch mit einer if-Anweisung unter Verwendung der Standardwerte von Optionsfeldern umgehen, wenn die Eingabeelemente NULL sind.

bearbeiten: Sie können die divs mit einer Schleife wie folgt erstellen:

l <- unique(m[, 2]) 

for(i in 1:length(l)) { 
    if (i == 1) { 
    radio_grp <- div(id = l[i], class = "shiny-input-radiogroup", DT::dataTableOutput("foo")) 
    } else { 
    radio_grp <- div(id = l[i], class = "shiny-input-radiogroup", radio_grp) 
    } 
} 
+0

Danke, das funktioniert wie ein Charme. Aber wenn ich 100 Gruppen habe, ist es klug, so viele "div" -Elemente zu verschachteln? Und ist es möglich, diese dynamisch zu verschachteln? – Fideldue

+0

Ich denke nicht, dass das Verschachteln einiger 'divs' ein Problem sein sollte. Wie bei der "dynamischen Verschachtelung" können Sie eine Schleife dafür schreiben. Siehe meine Bearbeitung. – GyD

+0

Danke nochmal! Noch eine Frage zu den Radiobuttons mit dem Wert "NULL" bis zur Interaktion. Ich habe ihre Werte in einem 'observe()' geändert, wenn sie 'NULL' sind. Wenn ich jedoch eine Auswahl mache oder etwas ändere, was zu einem erneuten Rendering der Tabelle führt, wird in keiner der Schaltflächen nichts angezeigt. Ihre Eingabewerte sind jedoch immer noch die gleichen. Weißt du, wie man die Tabelle auf diese Weise mit Standardwerten rendert oder ihre visuelle Ausgabe nach jedem Rendern entsprechend ihren aktuellen Werten ändert? – Fideldue

Verwandte Themen