R의 DataTable 콜백 동작 Shiny

Question

해결 방법을 찾을 수없는 문제가 있습니다. DT :: datatable를 사용하여 반짝이는 앱에 테이블을 표시하고 싶습니다. 이 탭에서 좌표로 정의 된 셀을 색칠하고 싶습니다. A부터 R 콘솔 (RStudio)에서 실행하지만 난 내 반짝 응용 프로그램에서이를 구현하는 경우, 약간의 버그가있을 때

test.table <- data.frame(lapply(1:8, function(x) {1:1000})) 
test.table[c(2,3,7), c(2,7,6)] <- NA 
id <- which(is.na(test.table)) 


datatable(test.table, 
options = list(drawCallback=JS(
paste("function(row, data) {", 
paste(sapply(1:ncol(test.table),function(i) 
paste("$(this.api().cell(",id %% nrow(test.table)-1,",",trunc(id/nrow(test.table))+1,").node()).css({'background-color': 'lightblue'});") 
),collapse = "\n"),"}")) 
)) 

이 코드는 잘 작동 : 여기에 컬러가있는 셀은 NA 값에 해당하는 경우 코드의 예입니다 : 첫 번째 페이지에서 색이있는 셀은 올바른 위치에 있지만 다른 페이지를 보려면 다음 단추를 클릭 할 때 색이있는 셀이 nout 업데이트를 수행하는 것처럼 보이고 색이 더 이상 더 이상 없음을 나타냅니다. 여기 는 그 문제에 작동하는 예이다 : 누군가가 그 문제

감사 나를 도울 수 있다면 내가

샘 아주 행복 할 것이다

shinyApp(
ui = fluidPage(
    fluidRow(
     column(12, 
     dataTableOutput('table') 
     ) 
) 
), 
server = function(input, output) { 
    test.table <- data.frame(lapply(1:8, function(x) {1:1000})) 
    test.table[c(2,3,7), c(2,7,6)] <- NA 
    id <- which(is.na(test.table)) 

    output$table <- renderDataTable(
     datatable(test.table, 
        options = list(drawCallback=JS(
          paste("function(row, data) {", 
           paste(sapply(1:ncol(test.table),function(i) 
           paste("$(this.api().cell(",id %% nrow(test.table)-1,",",trunc(id/nrow(test.table))+1,").node()).css({'background-color': 'lightblue'});") 
           ),collapse = "\n"),"}")) 
     ))) 

} 
) 

Answer 1

나는 그것을 할 수 있었다 서버 측 처리가 false로 설정된 상태로 작업하십시오. 이 link을보세요. 주제 1에서 주제 2 이전의 마지막 텍스트가 시작됩니다.

이 수정 된 코드입니다 :

shinyApp(
      ui = fluidPage(
        fluidRow(
          column(12, 
            dataTableOutput('table') 
          ) 
        ) 
      ), 
      server = function(input, output) { 
        test.table <- data.frame(lapply(1:8, function(x) {1:1000})) 
        test.table[c(2,3,7), c(2,7,6)] <- NA 
        id <- which(is.na(test.table)) 

        output$table <- renderDataTable(
          test.table, 
             options = list(drawCallback=JS(
               paste("function(row, data) {", 
                paste(sapply(1:ncol(test.table),function(i) 
                  paste("$(this.api().cell(",id %% nrow(test.table)-1,",",trunc(id/nrow(test.table))+1,").node()).css({'background-color': 'lightblue'});") 
                ),collapse = "\n"),"}")) 
            ), server = FALSE) 

      } 
    ) 

Answer 2

난 당신이 자바 스크립트 코드를 사용하는 방법이 복잡 찾을 수 있습니다. 차라리 옵션 rowCallback에 아래의 코드를 통과 할 것 :

function(row, data) { 
var value=data[1]; if (value===null) $(this.api().cell(row, 1).node()).css({'background-color':'lightblue'}) 
var value=data[2]; if (value===null) $(this.api().cell(row, 2).node()).css({'background-color':'lightblue'}) 
var value=data[3]; if (value===null) $(this.api().cell(row, 3).node()).css({'background-color':'lightblue'}) 
... 

이 코드는 다음과 같이 생성된다 (8 열) :

jscode <- paste("function(row, data) {", 
       paste0(sprintf("var value=data[%s]; if (value===null) $(this.api().cell(row, %s).node()).css({'background-color':'lightblue'})", 
           1:8, 1:8), collapse = "\n"), "}", sep="\n") 

그리고 그것은 반짝 응용 프로그램에서 작동 :

shinyApp(
    ui = fluidPage(
    fluidRow(
     column(12, 
      DT::dataTableOutput('table') 
    ) 
    ) 
), 
    server = function(input, output) { 
    test.table <- data.frame(lapply(1:8, function(x) {1:1000})) 
    test.table[c(2,3,7), c(2,7,6)] <- NA 

    output$table <- DT::renderDataTable(
     datatable(test.table, 
       options = list(rowCallback=JS(jscode)) 
    ) 
    ) 
    } 
)