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