闪亮：使用复选框选中DT中的单行

debugcn 发表于 Dev

简·斯坦斯特鲁普

在下面的示例中，有一个示例如何使用复选框选择行：R Shiny，如何使数据表对数据表中的复选框做出反应

很好但是我只需要选择一行即可。

我接近了，但是有两个问题：

当一个方框被打勾时，反应式被触发两次。我不明白为什么。但是再说一次，我不明白是什么激活了反应堆，因为我没有直接在反应堆内部看到输入...
如果我单击同一框两次，则选择不会真正更新。

任何线索表示赞赏。

我到目前为止所得到的。我也觉得我要使事情复杂化。

library(shiny)
library(DT)
shinyApp(
  ui = fluidPage(
    DT::dataTableOutput('x1'),
    verbatimTextOutput('x2')
  ),

  server = function(input, output, session) {
    # create a character vector of shiny inputs
    shinyInput = function(FUN, len, id, value, ...) {
      if (length(value) == 1) value <- rep(value, len)
      inputs = character(len)
      for (i in seq_len(len)) {
        inputs[i] = as.character(FUN(paste0(id, i), label = NULL, value = value[i]))
      }
      inputs
    }

    # obtain the values of inputs
    shinyValue = function(id, len) {
      unlist(lapply(seq_len(len), function(i) {
        value = input[[paste0(id, i)]]
        if (is.null(value)) FALSE else value
      }))
    }

    n = 6
    df = data.frame(
      cb = shinyInput(checkboxInput, n, 'cb_', value = FALSE, width='1px'),
      month = month.abb[1:n],
      YN = rep(FALSE, n),
      ID = seq_len(n),
      stringsAsFactors = FALSE)

    df_old <- df


    loopData = reactive({


      checked <- shinyValue('cb_', n)

      changed <- which((checked-df_old$YN)!=0)

      print(checked)
      print(changed)

      if(length(changed)==0){ df 
        }else{


      df$cb <<- shinyInput(checkboxInput, n, 'cb_', value = rep(FALSE, n), width='1px')
      df$YN <<- FALSE

      df$YN[changed] <<- checked[changed]
      df$cb[changed] <<- shinyInput(checkboxInput, length(changed), 'cb_', value = df$YN[changed], width='1px')


      df_old <<- df
      df
        }

    })

    output$x1 = DT::renderDataTable(
      isolate(loopData()),
      escape = FALSE, selection = 'none',
      options = list(
        dom = 't', paging = FALSE, ordering = FALSE,
        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      ))

    proxy = dataTableProxy('x1')

    observe({
      replaceData(proxy, loopData(), resetPaging = FALSE)
    })

    output$x2 = renderPrint({
      data.frame(Like = shinyValue('cb_', n))
    })
  }
)

编辑：我改用@StéphaneLaurent的解决方案以适合我的使用，但是有一个轻微的垂直对齐问题。

斯蒂芬·洛朗（Stephane Laurent）

但是我只需要选择一行即可。

在这种情况下，我不会使用复选框，而是使用单选按钮。

这样可以吗：

library(shiny)
library(DT)

n <- 6
dat <- data.frame(
  Select = sprintf(
    '<input type="radio" name="rdbtn" value="%s"/>', 1:n
  ),
  YN = rep(FALSE, n),
  ID = 1:n,
  stringsAsFactors = FALSE
)

callback <- c(
  "$('input[name=rdbtn]').on('click', function(){",
  "  var value = $('input[name=rdbtn]:checked').val();",
  "  Shiny.setInputValue('rdbtn', value);",
  "});"
)

shinyApp(
  ui = fluidPage(
    title = "Radio buttons in a table",
    DTOutput("foo"),
    h3("Selected row:"),
    verbatimTextOutput("sel")
  ),
  server = function(input, output, session) {
    output[["foo"]] <- renderDT(
      dat, escape = FALSE, selection = 'none', server = FALSE,
      options = list(dom = 't', paging = FALSE, ordering = FALSE),
      callback = JS(callback)
    )
    output[["sel"]] <- renderPrint({
      input[["rdbtn"]]
    })
  }
)

编辑

这可能会使用带有Select扩展名的复选框：

library(shiny)
library(DT)

dat <- iris[1:6,]

callback <- c(
  "table.on('select', function(e, dt, type, indexes){",
  "  if(type === 'row'){",
  "    Shiny.setInputValue('selectedRow', indexes);",
  "  }",
  "});"
)

ui <- fluidPage(
  br(),
  DTOutput("tbl"),
  br(),
  h3("Selected row:"),
  verbatimTextOutput("selectedRow")
)

server <- function(input, output, session){

  output[["tbl"]] <- renderDT({
    datatable(dat, extensions = "Select", callback = JS(callback), 
              options = list(
                columnDefs = list(
                  list(targets = 0, orderable = FALSE, className = "select-checkbox")
                ),
                select = list(
                  style = "single", selector = "td:first-child"
                )
              )
    )
  })

  output[["selectedRow"]] <- renderPrint({
    input[["selectedRow"]] + 1
  })

}

shinyApp(ui, server)

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。