How can I make my plot react to my data table filtering in Shiny?

I've combined a few tutorials of interest I found online , and have now made some progress getting my Shiny dashboard to display two things: 1) a data table with filtering and 2) a donut plot.

Both work great - but how can I make the donut plot respond to the filtering?

Using mtcars as an example, if I filter the 'mpg' column to just values of 10-15, is there a way I can make my donut plot update accordingly? Reproducible example below:

#load packages
library(ggpubr)
library(ggplot2)
library(plotly)
library(shiny)
library(dplyr)
library(shinydashboard)
library(DT)


# Prepare mtcars and use plotly to make donut plot
mtcars$manuf <- sapply(strsplit(rownames(mtcars), " "), "[[", 1)

df <- mtcars
df <- df %>% group_by(manuf)
df <- df %>% summarize(count = n())
fig <- df %>% plot_ly(labels = ~manuf, values = ~count)
fig <- fig %>% add_pie(hole = 0.6)
fig <- fig %>% layout(title = "Donut charts using Plotly",  showlegend = F,
                      xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
                      yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))


#Simple Shiny dashboard with first box as mtcars data table, second box as the donut plot ('fig')
body <- dashboardBody(
  
  fluidRow(
    
    box(
      title = "Title 1", width = 5, solidHeader = TRUE, status = "primary",
      DTOutput('table')
    ),
    box(
      title = "Title 2", width = 5, solidHeader = TRUE, status = "warning", 
      fig
    )
  )
  
  
)

# We'll save it in a variable `ui` so that we can preview it in the console
ui <- dashboardPage(
  dashboardHeader(title = "Row layout"),
  dashboardSidebar(disable=TRUE),
  body
)

# Preview the UI in the console
shinyApp(ui = ui, server = function(input, output) {
  output$table <- renderDT(mtcars,
                           filter = "top",
                           options = list(
                             pageLength = 5
                           )
  )
})

Screenshot:

# 

#load packages
library(ggpubr)
library(ggplot2)
library(plotly)
library(shiny)
library(dplyr)
library(shinydashboard)
library(DT)


# Prepare mtcars and use plotly to make donut plot


initial_df <- mtcars
initial_df$manuf <- sapply(strsplit(rownames(initial_df), " "), "[[", 1)



#Simple Shiny dashboard with first box as mtcars data table, second box as the donut plot ('fig')
body <- dashboardBody(
  
  fluidRow(
    
    box(
      title = "Title 1", width = 5, solidHeader = TRUE, status = "primary",
      DTOutput('table')
    ),
    box(
      title = "Title 2", width = 5, solidHeader = TRUE, status = "warning", 
      plotlyOutput("fig")
    )
  )
  
  
)

# We'll save it in a variable `ui` so that we can preview it in the console
ui <- dashboardPage(
  dashboardHeader(title = "Row layout"),
  dashboardSidebar(disable=TRUE),
  body
)

# Preview the UI in the console
shinyApp(ui = ui, server = function(input, output) {
  
  in_react_frame<-reactiveVal(initial_df)
  
   filtered_frame <-  reactive({
     frame <- req(in_react_frame())
    indexes <- req(input$table_rows_all)

    frame[indexes,]
    })
  summarised_frame <- reactive({req(filtered_frame()) %>% group_by(manuf) %>% summarize(count = n())})
  
  output$table <- renderDT(in_react_frame(),
                           filter = "top",
                           options = list(
                             pageLength = 5
                           )
  )
  output$fig <- renderPlotly({
    fig <- req(summarised_frame()) %>% plot_ly(labels = ~manuf, values = ~count)
    fig <- fig %>% add_pie(hole = 0.6)
    fig <- fig %>% layout(title = "Donut charts using Plotly",  showlegend = F,
                          xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
                          yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
    
  })
})

@nirgrahamuk Woah I have been really scratching my head over this and your solution worked flawlessly! Thank you!! The plot is perfectly reactive!

Just one last thing I was wondering if you know about - is there a way I can add a 'download' button to the filtered datatable? I seem to be having an issue keeping all the filters and also adding an option to download it as a CSV.

Thank you so much!

you have two options for that

  1. add a shiny download button, and make it write a csv from the contents of the filtered_frame() that we made above. reference : Shiny - Create a download button or link — downloadButton (rstudio.com)
  2. or use Datatables buttons extention, which has a CSV button
    DataTables Extensions (rstudio.github.io) - 2 Buttons
1 Like

I've tried both of these resources but I keep getting errors like, "Error in tagAssert(body, type = "div", class = "content-wrapper") : Expected tag to be of type div"

I was thinking I could just add something like buttons = c("csv", "excel", "pdf") (per the second resource you've provided) within this chunk:

  output$table <- renderDT(in_react_frame(),
                           filter = "top",
                           options = list(
                             pageLength = 5
                           )

But I'm always getting various errors. Any tips for where I should insert the code? Or does some part of this upstream need to be modified, like with fancyTable, for example?

Thanks for your guidance!

output$table <- renderDT({
  datatable(
    in_react_frame(),
    filter = "top",
    extensions = "Buttons",
    options = list(
      dom = "Bfrtip",
      pageLength = 5,
      buttons = c("copy", "csv", "excel", "pdf", "print")))
})

1 Like

Interesting....it was the in_react_frame() that I'm not fully understanding apparently. I'm going to play around some more and see if I can get a better understanding of it and learn from your example.

Hope I can get to your level of expertise some day. Thanks!

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.