R/shiny drilldown report

Question

Trying to have a pie (or preferably, donut) chart that displays totals per category and that allows a drilldown to display specifics per category when clicked. Make sense?

I think I might not have every system setting correct, since also copy/paste standard examples render an empty page. Unless that's somehow outdated or something. My system: Ubuntu 20.04, R 4.0.5, packageVersion("shiny") 1.6.0, shiny-server --version 1.5.16.958 Blank examples: https://plotly-r.com/linking-views-with-shiny.html#drill-down and Creating drill down report in R Shiny (amongst others)

My current attempt (not reactive yet because I can't for the life of me figure it out):

library(shiny)
library(DBI)
library(ggplot2)
library(dplyr)
library(ggiraph)

ui<-fluidPage(
  titlePanel("Budget visuals"),

  sidebarLayout(
    sidebarPanel(
      selectInput("fase", "Choose a budget phase:", choices = c("Budget" = "OWB", "Report" = "JV")),
      selectInput("jaar", "Choose a year:", choices = c(2021, 2020, 2019, 2018, 2017, 2016, 2015)),
      selectInput("vuo", "V/U/O:", choices = c("Verplichtingen" = "V", "Uitgaven" = "U", "Ontvangsten" = "O")),
      submitButton("Submit")
    ),

    mainPanel(
      h4(textOutput("header")),
      girafeOutput("donut"),
      tableOutput("view")
    )
  )
)

server<-function(input, output, session) {
  output$header <- renderText({paste0("Visual: ", input$fase, " (", input$vuo, ") ", input$jaar)})

  output$donut <- renderGirafe({
    conn <- dbConnect(
      drv = RMySQL::MySQL(),
      dbname = "btabellen",
      host = "localhost",
      username = "dbuser",
      password = "***")
    on.exit(dbDisconnect(conn), add = TRUE)
    dbGetQuery(conn, 'set character set "utf8"')
    data <- dbGetQuery(conn, paste0(
      "SELECT naam_begroting as begroting, sum(bedrag_t) as bedrag FROM ", input$fase, " WHERE jaar = ", input$jaar, " AND VUO = '", input$vuo, "' GROUP BY jaar, naam_begroting ORDER BY bedrag DESC;"))
    data$fraction <- data$bedrag / sum(data$bedrag)
    data$fraclbl <- paste0(round(100 * data$fraction, 1), "%")
    data$ymax <- cumsum(data$fraction)
    data$ymin <- c(0, head(data$ymax, n=-1))
    data$label <- paste0(data$begroting, ": € ", format(data$bedrag, big.mark=".", decimal.mark=","), " (k)")

    donut_plot <- ggplot(data, aes(y = bedrag, fill = begroting, data_id = begroting)) +
    geom_bar_interactive(
      aes(x = 1, tooltip = label),
      width = 0.1,
      stat = "identity",
      show.legend = FALSE
      ) +
    coord_polar(theta = "y") +
    theme_void() +
    theme(legend.position = "bottom")

    girafe(ggobj = donut_plot, opts_selection(type = "single"))
  })

  output$view <- renderTable({
    conn <- dbConnect(
      drv = RMySQL::MySQL(),
      dbname = "btabellen",
      host = "localhost",
      username = "dbuser",
      password = "***")
    on.exit(dbDisconnect(conn), add = TRUE)
    dbGetQuery(conn, 'set character set "utf8"')
    data <- dbGetQuery(conn, paste0(
      "SELECT naam_begroting as Begroting, SUM(bedrag_t) as Bedrag FROM ", input$fase, " WHERE jaar = ", input$jaar, " AND VUO = '", input$vuo, "' GROUP BY jaar, naam_begroting ORDER BY bedrag DESC;"))
  }, digits=0)
}

shinyApp(ui=ui, server=server)

So basically, what I would like to achieve is to open the page up with a donut plot of the budget showing all of the totals for the categories. When clicking a category, the donut should update itself to showing the totals per subcategory for the category that was just clicked. Effectively, a click should change the SQL query to "SELECT artikelnaam, sum(bedrag_t) FROM OWB WHERE jaar=2018 AND VUO='U' AND naam_begroting='Financiën'" given the user's selection of these parameters. The renderTable should ideally then show a nested table listing the subcategories, but that's for a different question.

Any thoughts what I might be doing wrong?

Answer 1

The key is to use input$donut_selected, the automatically generated _selected-suffixed input, see https://davidgohel.github.io/ggiraph/articles/offcran/shiny.html#access-the-selected-values.
Like so:

dbGetQuery(conn, paste0(
      "SELECT .... ",
      "FROM ", input$fase, " WHERE .... ",

      if (!is.null(input$donut_selected)) paste0(" AND naam_begroting = '", input$donut_selected, "' "),

      " GROUP BY ....;"))

(As discussed in the comments, not parameterising the query is bad practice, but the above is provided as is to address the main question (how to drill down)).

Note that due to the use of a submitButton, the entire app, including the drill-down functionality, will not be fully reactive, and drilling down will only happen upon clicking "Submit" (see ?submitButton)

---

Making the example reproducible/runnable (but not minimal):

Writing to disk to a dummy SQLite database:

library(DBI)

if (!dir.exists("data")) dir.create("data")
if (!file.exists(csv_file <- "data/OWB.csv")) {
  download.file("https://www.gitlab-minfin.nl/datasets/OWB.csv",
                destfile = csv_file)
}
if (!file.exists(db_file <- "data/owb.sqlite")) {
  df <- read.csv(csv_file, fileEncoding = "UTF-8")
  con <- dbConnect(RSQLite::SQLite(), db_file)
  dbWriteTable(con, "owb", df)
}

Example adapted to use SQLite database:

library(shiny)
library(ggplot2)
library(dplyr)
library(ggiraph)

ui<-fluidPage(
  titlePanel("Budget visuals"),
  
  sidebarLayout(
    sidebarPanel(
      selectInput("fase", "Choose a budget phase:", choices = c(
        "Budget" = "OWB", "Report" = "JV")),
      selectInput("jaar", "Choose a year:", choices = c(
        2021, 2020, 2019, 2018, 2017, 2016, 2015)),
      selectInput("vuo", "V/U/O:", choices = c(
        "Verplichtingen" = "V", "Uitgaven" = "U", "Ontvangsten" = "O")),
      submitButton("Submit")
    ),
    
    mainPanel(
      h4(textOutput("header")),
      girafeOutput("donut"),
      tableOutput("view")
    )
  )
)

server<-function(input, output, session) {
  output$header <- renderText({
    paste0("Visual: ", input$fase, " (", input$vuo, ") ", input$jaar)
  })
  
  output$donut <- renderGirafe({
    conn <- dbConnect(drv = RSQLite::SQLite(), db_file)
    on.exit(dbDisconnect(conn), add = TRUE)
    data <- dbGetQuery(conn, paste0(
      "SELECT naam_begroting as begroting, sum(bedrag_t) as bedrag ",
      "FROM ", input$fase, " WHERE jaar = ", input$jaar, " AND VUO = '", input$vuo, 
      "' GROUP BY jaar, naam_begroting ORDER BY bedrag DESC;"))
    data$fraction <- data$bedrag / sum(data$bedrag)
    data$fraclbl <- paste0(round(100 * data$fraction, 1), "%")
    data$ymax <- cumsum(data$fraction)
    data$ymin <- c(0, head(data$ymax, n=-1))
    data$label <- paste0(
      data$begroting, ": € ", 
      format(data$bedrag, big.mark=".", decimal.mark=","), " (k)")
    
    donut_plot <- ggplot(data, aes(y = bedrag, fill = begroting, data_id = begroting)) +
      geom_bar_interactive(
        aes(x = 1, tooltip = label),
        width = 0.1,
        stat = "identity",
        show.legend = FALSE
      ) +
      coord_polar(theta = "y") +
      theme_void() +
      theme(legend.position = "bottom")
    
      girafe(ggobj = donut_plot, options = list(opts_selection(type = "single")))
  })
  
  output$view <- renderTable({
    conn <- dbConnect(drv = RSQLite::SQLite(), db_file)
    on.exit(dbDisconnect(conn), add = TRUE)
    data <- dbGetQuery(conn, paste0(
      "SELECT naam_begroting as Begroting, SUM(bedrag_t) as Bedrag ",
      "FROM ", input$fase, " WHERE jaar = ", input$jaar, " AND VUO = '", input$vuo, "' ",
      
      if (!is.null(input$donut_selected)) paste0(" AND naam_begroting = '", input$donut_selected, "' "),
      
      " GROUP BY jaar, naam_begroting ORDER BY bedrag DESC;"))
  }, digits=0)
}

shinyApp(ui=ui, server=server)

Other changes:

• girafe options passing
• removing set instructions that may not be compatible with SQLite, and are not relevant to the question