R shiny DT hover shows detailed table

Question

I am trying to work on an R shiny app where I want to show a consolidated table on top and when the user hovers on any line item it would show the detailed section of that table.So here's the code for the first table

library(ggplot2)

ui <- fluidPage(
  titlePanel("Basic DataTable"),

  # Create a new row for the table.
  DT::dataTableOutput("table")
)
server <- function(input, output) {
  data <- mpg

  data <-data %>% group_by(manufacturer,year) %>% 
    summarise(cty = round(mean(cty),2),hwy = round(2,mean(hwy)))

  # Filter data based on selections
  output$table <- DT::renderDataTable(DT::datatable({


    data
  }))

}

shinyApp(ui,server)

Now when the user hovers on Audi for example it should show a detailed version just for Audi something like this in a table below.Can this be done in shiny with DT on hover or click.

Answer 1

Here is a way. If you prefer to display the child table on click rather than on hover, replace "table.on('mouseover', 'td', function(){" with "table.on('click', 'td', function(){" .

library(shiny)
library(DT)

data(mpg, package = "ggplot2")

callback <- c(
  "table.on('mouseover', 'td', function(){",
  "  var index = table.cell(this).index();",
  "  Shiny.setInputValue('cell', index, {priority: 'event'});",
  "});"
)

ui <- fluidPage(
  br(),
  DTOutput("tbl")
)

server <- function(input, output, session){

  dat <- mpg

  output[["tbl"]] <- renderDT({
    datatable(
      dat,
      callback = JS(callback)
    )
  })

  filteredData <- eventReactive(input[["cell"]], {
    i <- input[["cell"]]$row + 1
    j <- input[["cell"]]$column
    if(j > 0){
      dat[dat[[j]] == dat[i,j], , drop = FALSE]
    }else{
      NULL
    }
  })

  output[["tblfiltered"]] <- renderDT({
    datatable(
      filteredData(),
      fillContainer = TRUE, 
      options = list(
        pageLength = 5
      )
    )
  })

  observeEvent(filteredData(), {
    showModal(
      modalDialog(
        DTOutput("tblfiltered"), 
        size = "l", 
        easyClose = TRUE
      )
    )
  })

}

shinyApp(ui, server)