R Shiny and Datatables ObserveEvent Reset Value

Question

I have a table where the first column contains a radio button. If a user clicks any cell in a row, it updates the table so that its radio button is selected. This then updates a second table with the values from the selected row. In my actual app, I get this to work, however as the first table is dynamically changed the cell_clicked value in an observeEvent still changes the value and the wrong radio button is showed. This only affects the display as the second table correctly updates.

For a reproducible example I made just the first table. If you change the pet choice to 'dog' the table only has 5 rows, while if 'cat' it will have 10 rows. Select any cell in the third row. Change the select to dog and the radio for the third row will automatically be selected. Now change the choice to cat, choose a row > 5 (7 for instance). Now change the input to dog and no radio button will be selected. This is because the observeEvent changes the selected row to 7, but there is no seventh row now.

I want the radio button to go back to the first row any time the reactive dataframe is changed. How do I go about doing this?

See reproducible example here:

library(shiny)
library(shinydashboard)
library(tidyverse)
library(DT)

ui <- dashboardPage(
  dashboardHeader(title = "Testing Observe Event on Cell Clicked"),
  #dashboard sidebar-----
  dashboardSidebar(
    sidebarMenu(id = "tabs",
                menuItem("Home", tabName = "home_tab")
    )
  ),
  #dashboard Body ----
  dashboardBody(
    tabItems(
      #Home page-----
      tabItem(tabName = "home_tab",
              fluidPage(
                fluidRow(h2("Home Page")),
                fluidRow(selectInput("petChoice", "Please select cats or dogs", c('cat','dog'))),
                fluidRow(dataTableOutput("table"))
              )
      )
    )
  )
)

server <- function(input, output, session) {
  
  #min reprex of a reactive dataframe I create
  myDF <- reactive({
    t<- data.frame(Months = month.name[1:10],
              Letters = letters[1:10],
              Numbers = c(1:10),
              Animal = paste(rep(input$petChoice,10), 1:10)) %>%
      mutate(Select = if_else(row_number()==1,
                             '<input type="radio" name="%s" value="%s" checked="checked"/>',
                             '<input type="radio" name="%s" value="%s"/>'),
            .before="Months")
    if(input$petChoice == 'dog') {
      t<- t %>%
        filter(Numbers>5)
    }
    t
  })
  
  output$table <- renderDataTable({
    DT::datatable(myDF(),
                  rownames = F, selection = 'single',
                  escape = FALSE,
                  options = list(dom = 't', pageLength = 10)) %>%
      formatStyle(c(0:3), cursor = "pointer")
  })
  
  #give radio choices to the grouped by genotype table
  observeEvent(input$table_cell_clicked, {
    info = input$table_cell_clicked
    # do nothing if not clicked yet
    if (is.null(info$value)) return()

    #change the radio button
    output$table <- renderDataTable({
      DT::datatable(myDF() %>%
                      mutate(Select = if_else(row_number()==info$row,
                                              '<input type="radio" name="%s" value="%s" checked="checked"/>',
                                              '<input type="radio" name="%s" value="%s"/>')),
                    rownames = F, selection =  list(mode = 'single', selected = c(info$row)),
                    escape = FALSE,
                    options = list(dom = 't', ordering=F, pageLength = 10)) %>%
        formatStyle(c(0:3), cursor = "pointer")
    })

  })
}

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

Answer 1

Try this

server <- function(input, output, session) {
  
  my <- reactiveValues(DF = NULL,newrow=1)
  
  observeEvent(input$petChoice, {
    my$newrow <- 1 
    if(input$petChoice == 'dog') n <- 6 else n <- 1
    t<- data.frame(Months = month.name[n:10],
                   Letters = letters[n:10],
                   Numbers = c(n:10),
                   Animal = paste(rep(input$petChoice,(4+n)), n:10)) %>%
      mutate(Select = if_else(row_number()==my$newrow,
                              '<input type="radio" name="%s" value="%s" checked="checked"/>',
                              '<input type="radio" name="%s" value="%s"/>'),
             .before="Months")
    if(input$petChoice == 'dog') {
      t<- t %>%
        filter(row_number()<6)
    }
    my$DF <- t

  })
  
  output$table <- renderDataTable({
    DT::datatable(my$DF,
                  rownames = F, selection = 'single',
                  escape = FALSE,
                  options = list(dom = 't', pageLength = 10)) %>%
      formatStyle(c(0:3), cursor = "pointer")
  })
  
  #give radio choices to the grouped by genotype table
  observeEvent(input$table_cell_clicked, {
    info = input$table_cell_clicked
    # do nothing if not clicked yet
    if (is.null(info$value)) return()
    my$newrow <- info$row
    
    #change the radio button
    output$table <- renderDataTable({
      DT::datatable(my$DF %>%
                      mutate(Select = if_else(row_number()== my$newrow,
                                              '<input type="radio" name="%s" value="%s" checked="checked"/>',
                                              '<input type="radio" name="%s" value="%s"/>')),
                    rownames = F, selection =  list(mode = 'single', selected = c(info$row)),
                    escape = FALSE,
                    options = list(dom = 't', ordering=F, pageLength = 10)) %>%
        formatStyle(c(0:3), cursor = "pointer")
    })

  })
}