R/閃亮鑽取報告

Question

嘗試制作一個餅圖（或者最好是圓環圖），顯示每個類別的總數，並允許在單擊時向下鑽取以顯示每個類別的細節。 說得通？

我想我可能不是每個系統設置都正確，因為復制/粘貼標准示例也會呈現一個空白頁面。 除非那是某種過時的東西。 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和在 R Shiny 中創建鑽取報告（等等）

我目前的嘗試（還沒有反應，因為我一生都無法弄清楚）：

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)

所以基本上，我想要實現的是用預算的甜甜圈 plot 打開頁面，顯示類別的所有總數。 單擊類別時，甜甜圈應自行更新以顯示剛剛單擊的類別的每個子類別的總數。 實際上，在用戶選擇這些參數的情況下，單擊應該將 SQL 查詢更改為"SELECT artikelnaam, sum(bedrag_t) FROM OWB WHERE jaar=2018 AND VUO='U' AND naam_begroting='Financiën'" 。 理想情況下，renderTable 應該顯示一個列出子類別的嵌套表，但這是針對不同的問題。

有什么想法我可能做錯了嗎？

Answer 1

關鍵是使用input$donut_selected ，自動生成的_selected后綴輸入，見https://davidgohel.github.io/ggiraph/articles/offcran/shiny.html#access-the-selected-value
像這樣：

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

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

      " GROUP BY ....;"))

（正如評論中所討論的，不參數化查詢是不好的做法，但以上內容按原樣提供以解決主要問題（如何深入研究））。

請注意，由於使用了submitButton ，整個應用程序，包括向下鑽取功能，將不會完全反應，並且只有在單擊“提交”時才會發生向下鑽取（請參閱?submitButton ）

---

使示例可重現/可運行（但不是最小的）：

將磁盤寫入虛擬 SQLite 數據庫：

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)
}

適用於使用 SQLite 數據庫的示例：

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)

其他變化：

• girafe選項傳遞
• 刪除可能與 SQLite 不兼容且與問題無關的set指令