R 반짝 : data.table에서 입력 값을 선택 업데이트하십시오.

Question

내부에 선택 입력 및 단추가있는 renderDataTable이 있습니다. 난 적절한 행에 '저장'버튼을 클릭 후 datatable 안에 selectInput을 업데이 트하고 싶습니다. 어떻게해야합니까? 솔루션을 검색하는 동안 "테이블을 다시 렌더링하면 바인딩을 해제하는 코드를 추가하지 않으면 입력이 작동하지 않습니다"라는 것을 알게되었습니다. 그러나 나는 반짝이는 새로운 js 옵션을 사용하므로 어떤 힌트/솔루션에도 감사 할 것입니다.

library(shiny) 
library(DT) 
runApp(list(
    ui = basicPage(
    h2('The mtcars data'), 
    DT::dataTableOutput('mytable'), 
    h2("Selected"), 
    tableOutput("checked") 
), 

    server = function(input, output) { 
    # helper function for making checkbox 
    shinyInput = function(FUN, len, id, ...) { 
     inputs = character(len) 
     for (i in seq_len(len)) { 
     inputs[i] = as.character(FUN(paste0(id, i), ...)) 
     } 
     inputs 
    } 
    # datatable with checkbox 
    output$mytable = DT::renderDataTable({ 
     data.frame(mtcars,Rating=shinyInput(selectInput,nrow(mtcars),"selecter_",label=NULL, 
              choices=1:5, width="60px"), 
       Save = shinyInput(actionButton, nrow(mtcars),'button_', 
             label = 'Save',onclick = 'Shiny.onInputChange(\"select_button\", this.id)')) 
    }, selection='none',server = FALSE, escape = FALSE, options = list( 
     paging=TRUE, 
     preDrawCallback = JS('function() { 
          Shiny.unbindAll(this.api().table().node()); }'), 
     drawCallback = JS('function() { 
         Shiny.bindAll(this.api().table().node()); } ') 
    )) 
    # helper function for reading checkbox 
    shinyValue = function(id, len) { 
     unlist(lapply(seq_len(len), function(i) { 
     value = input[[paste0(id, i)]] 
     if (is.null(value)) NA else value 
     })) 
    } 
    # output read checkboxes 
    output$checked <- renderTable({ 
     data.frame(selected=shinyValue("selecter_",nrow(mtcars))) 
    }) 
    } 
)) 

Answer 1

안녕하세요. 귀하의 질문을 완전히 이해하지 못했지만 잘하면이 도움이됩니다. 이 앱은 완벽하지는 않지만 원하는 것을해야합니다.

library(shiny) 
library(DT) 
runApp(list(
    ui = basicPage(
    tags$script(
     HTML(
     "Shiny.addCustomMessageHandler('unbind-DT', function(id) { 
     Shiny.unbindAll($('#'+id).find('table').DataTable().table().node()); 
     })" 
) 
    ), 
h2('The data'), 
selectInput("myData", "Choose dataset", c("mtcars", "iris"), "mtcars"), 
DT::dataTableOutput('mytable'), 
h2("Selected"), 
tableOutput("checked") 
    ), 

server = function(input, output, session) { 
    dataset <- reactive({ 
    session$sendCustomMessage("unbind-DT", "mytable") 
    get(input$myData) 
    }) 

    # helper function for making checkbox 
    shinyInput = function(FUN, len, id, ...) { 
    inputs = character(len) 
    for (i in seq_len(len)) { 
     inputs[i] = as.character(FUN(paste0(id, i), ...)) 
    } 
    inputs 
    } 
    # datatable with checkbox 
    output$mytable = DT::renderDataTable({ 
    data.frame(
     dataset(), 
     Rating = shinyInput(
     selectInput, 
     nrow(dataset()), 
     "selecter_", 
     choices = 1:5, 
     width = "60px", 
     label = NULL 
    ), 
     Save = shinyInput(actionButton, nrow(dataset()), 'button_', 
         label = 'Save') 
    ) 
    }, selection = 'none', server = FALSE, escape = FALSE, options = list(
    dom = "ti", 
    paging = TRUE, 
    preDrawCallback = JS(
     'function() { 
     Shiny.unbindAll(this.api().table().node()); }' 
    ), 
    drawCallback = JS('function() { 
         Shiny.bindAll(this.api().table().node()); } ') 
    )) 
    # helper function for reading checkbox 
    shinyValue = function(id, len) { 
    unlist(lapply(seq_len(len), function(i) { 
     value = input[[paste0(id, i)]] 
     if (is.null(value)) 
     NA 
     else 
     value 
    })) 
    } 
    # output read checkboxes 
    output$checked <- renderTable({ 
    data.frame(selected = shinyValue("selecter_", nrow(mtcars))) 
    }) 

    lapply(1:150, function(i) { 
    observeEvent(input[[paste0("button_", i)]], { 
     updateSelectInput(session, 
         paste0("selecter_", i), 
         selected = 5, 
         label = NULL) 
    }) 
    }) 

} 

))