mardi 25 février 2020

Shiny: Select single row in DT with checkbox

In the example here there is an example of how to select rows with a checkbox: R Shiny, how to make datatable react to checkboxes in datatable

That works fine. But I need to only be able to select a single row.


I got close but there are two problems:

  1. when a box is ticked the reactive is trigger twice. I don't understand why. But then again I don't understand what activates the reactive since I don't see the input directly inside the reactive...
  2. If I click on the same box twice the selection is not really updated.


Any clue appreciated.

What I got so far. I also have a feeling I am over complicating things.

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))
    })
  }
)



Aucun commentaire:

Enregistrer un commentaire