CODEWITHSUNDEEP
rshinydatatablereactive
stat
stat

Reputation: 669

dynamically reset observers on change Shiny R

I have this small app.

I am dividing a dataframe in slices, using a previous and next button I am iterating showing the different slices of it in a datatable.

Inside the datatable I have checkboxes, their IDs are reset programmatically as soon as the new slice is requested.

From a tibble with 30 rows:

the first display works, as soon as it changes I need a way to reset the observers.

sample code:

library("DT")
library("shinyjs")
library("tidyverse")
library("shiny")

ui <- basicPage(
  h2("The mtcars data"),
  useShinyjs(),
  actionButton("prv", "prv", icon("arrow-left")),
  actionButton("nxt", "nxt", icon("arrow-right")),
  DT::dataTableOutput("mytable")
)

server <- function(input, output) {
  
  ###Sample Data
  mtcarsx <- reactive(
    data.frame(mtcars) %>%
      as_tibble() %>%
      mutate( slice=round(runif(row_number(),min=1,max=5))  ) 
  )
  
  ###Slice selector that will be modified with the button
  sliceN <- reactiveVal(1)
  
  ###Manipulating the slice
  thisSlice <- reactive({
    mtcarsx() %>%
      filter(slice==sliceN()) %>%
      mutate(rown=row_number()) %>%
      rowwise() %>% 
      mutate( 
        randmz=runif(row_number(),min=0,max=3),
        newvar=case_when(
          #I have checkboxes defaulted to true, checkboxes defaulted to false, checkboxes defaulted to true that I will disable
          randmz < 1 ~ as.character(checkboxInput(paste0("chk",rown),label="",value=TRUE)),
          randmz < 2 ~ as.character(checkboxInput(paste0("chk",rown),label="",value=FALSE)),        
          TRUE ~ as.character(checkboxInput(paste0("chk",rown),label="",value=TRUE))          
        ),
        mytype=case_when(
          #I have checkboxes defaulted to true, checkboxes defaulted to false, checkboxes defaulted to true that I will disable
          randmz < 1 ~ "MYTRUE",
          randmz < 2 ~ "MYFALSE",        
          TRUE ~ "DISABLED"          
        )
      )
  })
  
  #to disable checkboxes
  observe({
    print(input$chk1)
    n <- nrow(thisSlice())
    lapply(1:n, function(i){if(thisSlice()$mytype[i]=="DISABLED"){  shinyjs::disable(paste0("chk",i)) } })
  })
  
  #to listen to checkboxes
  observeEvent(input,{
    print(input$chk1)
    n <- nrow(thisSlice())
    lapply(
      1:n, 
      function(i){ 
        observeEvent(input[[paste0("chk",i)]],{
          print(paste0("chk",i))
          #print(input[[paste0("chk",i)]])
        })
      })   
  })
  
  
  
  #previous and next buttons
  observeEvent(input$nxt, {
    sliceN(sliceN()+ 1) 
  })
  observeEvent(input$prv, {
    sliceN(sliceN()- 1)
  }) 
  
  #display
  output$mytable = DT::renderDataTable({
    #print(thisSlice())
    DT::datatable(thisSlice(), 
                  escape = FALSE, 
                  selection = 'none', 
                  rownames = TRUE, 
                  extensions = c('FixedColumns'),
                  options = list(searching = FALSE, 
                                 ordering  = FALSE,
                                 autoWidth = TRUE,
                                 scrollX = TRUE,
                                 FixedColumns = list(leftColumns = c(2)),
                                 preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                                 drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
                  ))
  })
  
}

shinyApp(ui, server)

how can I reset the observers when "next" is pressed and after the render of the datatable?

I also tried triggering the event after draw with a javascript callback like this:

  observeEvent(input$mycback,{
    print("received")
    o$destroy
    o
  })

o<-observeEvent(input,{
same as before
})

and in the dt callback

drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); Shiny.setInputValue("mycback","drawn", {priority: "event"})} '),

pasting the disable code inside my callback I've been able to call the disable function after redraw of the table successfully!! big success.

still the observers can listen for changes ONLY at the first draw, I can't explain why.

Upvotes: 1

Views: 259

Answers (1)

YBS
YBS

Reputation: 21349

That is because you are using the same ID for the checkboxInput, when you go back to the same slice. As the IDs have to be unique, it will only work the first time. To overcome this issue you can add a counter value to the ID. Try this

library("DT")
library("shinyjs")
library("tidyverse")
library("shiny")

ui <- basicPage(
  h2("The mtcars data"),
  useShinyjs(),
  actionButton("prv", "prv", icon("arrow-left")),
  actionButton("nxt", "nxt", icon("arrow-right")),
  DT::dataTableOutput("mytable")
)

server <- function(input, output) {

  cn <- reactiveValues(tr=1)
  ###Sample Data
  mtcarsx <- reactive(
    data.frame(mtcars) %>%
      as_tibble() %>%
      mutate( slice=round(runif(row_number(),min=1,max=5))  ) %>%
      mutate(rown=row_number())
  )

  ###Slice selector that will be modified with the button
  sliceN <- reactiveVal(1)

  ###Manipulating the slice
  thisSlice <- reactive({
    req(mtcarsx(),sliceN())
    print(cn$tr)
    if (sliceN() < 1 | sliceN() >5) return(NULL)
    df <- mtcarsx() %>% dplyr::filter(slice==sliceN()) %>%
      rowwise() %>%
      mutate(
        randmz=runif(row_number(),min=0,max=3),
        newvar=case_when(
          #I have checkboxes defaulted to true, checkboxes defaulted to false, checkboxes defaulted to true that I will disable
          randmz < 1 ~ as.character(checkboxInput(paste0("chk",rown,cn$tr),label="",value=TRUE)),
          randmz < 2 ~ as.character(checkboxInput(paste0("chk",rown,cn$tr),label="",value=FALSE)),
          TRUE ~ as.character(checkboxInput(paste0("chk",rown,cn$tr),label="",value=TRUE))
        ),
        mytype=case_when(
          #I have checkboxes defaulted to true, checkboxes defaulted to false, checkboxes defaulted to true that I will disable
          randmz < 1 ~ "MYTRUE",
          randmz < 2 ~ "MYFALSE",
          TRUE ~ "DISABLED"
        )
      )
    df
  })

  #to disable checkboxes
  observe({
    df <- thisSlice()
    print(input[[paste0("chk",df$rown[1],cn$tr)]])
    n <- nrow(df)
    lapply(1:n, function(i){
      print(paste0("chk",df$rown[i],cn$tr))
      if (df$mytype[i] == "DISABLED") {  shinyjs::disable(paste0("chk",df$rown[i],cn$tr)) }
    })
    
    lapply(1:n, function(i){ 
      thisval <- paste0("chk",df$rown[i],cn$tr) 
      observeEvent(input[[thisval]] ,{ 
        #print(input[[paste0("chk",df$rown[i],cn$tr)]]) 
        print(input[[thisval]]) 
      }) 
    }) 
  })

  #previous and next buttons
  observeEvent(input$nxt, {
    cn$tr <- cn$tr + 1
    sliceN(sliceN()+ 1)
  })
  observeEvent(input$prv, {
    cn$tr <- cn$tr + 1
    sliceN(sliceN()- 1)
  })

  #display
  output$mytable = DT::renderDataTable({
    req(thisSlice())
    #if (sliceN() < 1 | sliceN() >5) return(NULL)
    DT::datatable(thisSlice(),
                  escape = FALSE,
                  selection = 'none',
                  rownames = TRUE,
                  extensions = c('FixedColumns'),
                  options = list(searching = FALSE,
                                 ordering  = FALSE,
                                 autoWidth = TRUE,
                                 scrollX = TRUE,
                                 FixedColumns = list(leftColumns = c(2)),
                                 preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                                 drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
                                 )
                  )
  })

}

shinyApp(ui, server)

Upvotes: 2

Related Questions