R/shiny 细分报告
R/shiny drilldown report
尝试制作一个饼图（或者最好是圆环图）来显示每个类别的总数，并允许在单击时向下钻取以显示每个类别的详细信息。有道理吗？
我想我可能没有正确设置每个系统，因为 copy/paste 标准示例也会呈现空白页面。除非那不知何故过时或什么的。
我的系统：Ubuntu 20.04, R 4.0.5, packageVersion("shiny") 1.6.0, shiny-server --version 1.5.16.958
空白示例：https://plotly-r.com/linking-views-with-shiny.html#drill-down and Creating drill down report in 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)
所以基本上，我想要实现的是打开页面，其中包含预算的圆环图，显示所有类别的总计。单击类别时，甜甜圈应自行更新以显示刚刚单击的类别的每个 子类别 的总数。实际上，根据用户对这些参数的选择，单击应该会将 SQL 查询更改为 "SELECT artikelnaam, sum(bedrag_t) FROM OWB WHERE jaar=2018 AND VUO='U' AND naam_begroting='Financiën'"。 renderTable 理想情况下应该显示一个嵌套的 table 列出子类别，但这是针对不同的问题。
有没有想过我可能做错了什么？
关键是使用input$donut_selected，自动生成_selected后缀输入，见https://davidgohel.github.io/ggiraph/articles/offcran/shiny.html#access-the-selected-values.
像这样：
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)
制作示例reproducible/runnable（但不是最小的）：
正在将磁盘写入虚拟 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 选项传递- 删除
set 可能与 SQLite 不兼容且与问题无关的指令
尝试制作一个饼图（或者最好是圆环图）来显示每个类别的总数，并允许在单击时向下钻取以显示每个类别的详细信息。有道理吗？
我想我可能没有正确设置每个系统，因为 copy/paste 标准示例也会呈现空白页面。除非那不知何故过时或什么的。 我的系统：Ubuntu 20.04, R 4.0.5, packageVersion("shiny") 1.6.0, shiny-server --version 1.5.16.958 空白示例：https://plotly-r.com/linking-views-with-shiny.html#drill-down and Creating drill down report in 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)
所以基本上，我想要实现的是打开页面，其中包含预算的圆环图，显示所有类别的总计。单击类别时，甜甜圈应自行更新以显示刚刚单击的类别的每个 子类别 的总数。实际上，根据用户对这些参数的选择，单击应该会将 SQL 查询更改为 "SELECT artikelnaam, sum(bedrag_t) FROM OWB WHERE jaar=2018 AND VUO='U' AND naam_begroting='Financiën'"。 renderTable 理想情况下应该显示一个嵌套的 table 列出子类别，但这是针对不同的问题。
有没有想过我可能做错了什么？
关键是使用input$donut_selected，自动生成_selected后缀输入，见https://davidgohel.github.io/ggiraph/articles/offcran/shiny.html#access-the-selected-values.
像这样：
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)
制作示例reproducible/runnable（但不是最小的）：
正在将磁盘写入虚拟 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选项传递- 删除
set可能与 SQLite 不兼容且与问题无关的指令