mardi 7 mars 2017

R shiny generated checkboxes fire no more after setting value automatically

See "minimal" example:

library(shiny)
library(DT)
library(gtools)

# Define UI for application that draws a histogram
ui <- fluidPage(
  titlePanel("MinimalExample"),
  sidebarLayout(
    sidebarPanel(
      tabsetPanel(
        tabPanel("Import",textInput("photos","Photos",placeholder = "dummy"),actionButton("refreshImport","Press!")),
        tabPanel("Filter",value = "filter",shinydashboard::box(title = "Imported files",
            width = NULL,status = "primary",div(style = 'overflow-x: scroll', DT::dataTableOutput("filenames"))),
          checkboxInput("ignoreMissingLocation","Ignore images with missing location",value = F),
          actionButton("refresh", "Show selected!"))),width = 3),
    mainPanel(textOutput("result"))
  )
)

server <- function(input, output, session) {
  shinyInput <- function(FUN,id,num,value,offset,...) {
    inputs <- character(num)
    for (i in seq_len(num)) {
      inputs[i] <- as.character(FUN(paste0(id,i + offset),label=NULL,value = value[i],...))
    }
    inputs
  }

  #observer for filenames reactiveValue
  filelist <- reactiveValues(data = NULL)
  observeEvent(input$refreshImport,
               {
                 filelist$data <- input$photos
               })
  currentCheckboxes <- reactiveValues(data = NULL)

  output$filenames <- DT::renderDataTable({
    exifFiles <- mapPhotosFilter()
    if(is.null(exifFiles)){
      return(NULL)
    }

    exifDT <- cbind(Pick = shinyInput(checkboxInput,"srows_",nrow(exifFiles),
                                      value=exifFiles$checked,offset=currentCheckboxes$data, width=1),
                    exifFiles[,"filenames"])
    DT::datatable(exifDT,options = list(dom = "tip",drawCallback = JS(
                                          'function(settings) {
                                          Shiny.bindAll(this.api().table().node());}')),
                  escape = F,class = "compact",selection = list(mode="single"))
  })

  mapPhotosFilter <-
    reactive({
      if(is.null(filelist$data))return(NULL)
      filenames <- filelist$data
      exifFiles <- as.data.frame(filenames)
      exifFiles$checked <- T
      exifFiles$missingLocation <- T
      ignoreMissingLocation <- input$ignoreMissingLocation
      exifFiles$checked = T
      if(ignoreMissingLocation){
        exifFiles[which(exifFiles$missingLocation),]$checked = F
      }
      return(exifFiles)
    })

  rowsSelected <- reactiveValues(data = NULL)

  observeEvent(input$refresh,{
    rows <- names(input)[grepl(pattern = "srows_",names(input))]
    rows <- mixedsort(rows)
    offset <- isolate(currentCheckboxes$data)
    rowsSelected$data <- as.numeric(paste(unlist(lapply(rows,function(i){
      if(input[[i]]){
        currentRowIndex <- as.numeric(substr(i,gregexpr(pattern = "_",i)[[1]]+1,nchar(i)))
        if(currentRowIndex > offset){
          return(currentRowIndex - offset) 
        }
      }
    }))))
  })

  observeEvent(filelist$data,{
    rows=names(input)[grepl(pattern = "srows_",names(input))]
    currentCheckboxes$data <- max(as.numeric(paste(unlist(lapply(rows,function(i){
      if(input[[i]]){
        return(substr(i,gregexpr(pattern = "_",i)[[1]]+1,nchar(i)))
      }
    })))),0)
  })

  output$result <- renderText({
    print(rowsSelected$data)
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

If you press the button "Press!" on the first tab, "Show selected" on the second tab will trigger the main panel to display whether the row in the datatable is selected.

This works, as long as I don't set the checkbox value programmatically, i.e. through the mapPhotosFilter and DT::renderDataTable function. Then the checkbox doesn't seem to fire anymore. This is because shiny's input$srow_1 variable doesn't change its value anymore, even when the checkbox is clicked at with the mouse.

I guess this has something to to with javscript (which I just started to learn) and I tried several approaches based on Shiny.unbindAll({checkboxSelector}), without success. An alternative explanation could be that there is a loop in the reactive that never breaks and therefore doesn't update the UI. Either way, I have no idea how to proceed.




Aucun commentaire:

Enregistrer un commentaire