【发布时间】：2019-09-17 08:23:13
【问题描述】：
我试图通过设置一个函数以在每次调用绘图函数时接收一组不同的参数值来从一个 ggplot 饼图代码呈现两个饼图。这让我不必为每个 Pie 编写两组几乎相同的代码。
传递的三个参数是因子、标题和比例。 Pie1 有factor=age_group、title="Age_Group Segmentation" 和scale=c("#ffd700", "#bcbcbc", "#ffa500", "#254290", "#f0e68c", "#808000")。
Pie2 有factor=Outcome、title="Outcome Segmentation" 和scale=c(#ffd700", "#bcbcbc", "#ffa500", "#254290")
我原则上知道这样做的方法是：
plot_func <- function(factor, title, scale) {ggplot(dfnew, aes("", share, fill = factor)) + geom_bar( +
labs(x = NULL, y = NULL, fill = NULL,title = title) + scale_fill_manual(values = scale)))}
然后在 renderplot 中调用这个 plot_function：
plot_func(group, title, scale) 带有参数值。
问题是我不知道所需的语法，尤其是因为反应数据对象也被传递到 ggplot 中，data_mod()。我在stackoverflow中没有找到任何东西来模仿我正在尝试做的事情。包含示例数据框的完整代码。
library(shiny)
library(ggplot2)
library(dplyr)
# use the below if you want to increase the file size being inputed to 9MB
# options(shiny.maxRequestSize = 9.1024^2)
ui <- shinyUI(navbarPage(
"Example",
tabPanel("Data",
sidebarLayout(
sidebarPanel("Nothing here at the moment"),
mainPanel(
"Select Dashboard Panel for results.Click on
Select/All to make the plots render"
)
)),
tabPanel("Dashboard",
sidebarLayout(
sidebarPanel(
checkboxInput('all', 'Select All/None', value = TRUE),
uiOutput("year_month"),
tags$head(
tags$style(
"#year_month{color:red; font-
size:12px; font-style:italic;
overflow-y:scroll; max-height: 100px; background:
ghostwhite;}"
)
)
),
mainPanel(uiOutput("tb"))
))
))
complaint_id <- c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
age_group <- c(
"09 Months",
"03 Months",
"06 Months",
"Over A Year",
"12 Months",
"01 Months",
"09 Months",
"03 Months",
"06 Months",
"Over A Year",
"12 Months",
"01 Months"
)
closed_date_ym <- c(
"2019-09",
"2019-09",
"2019-09",
"2019-09",
"2019-09",
"2019-09",
"2019-08",
"2019-08",
"2019-08",
"2018-08",
"2019-08",
"2019-08"
)
officer <- c("A", "B", "C", "D", "A", "B", "C", "D", "A", "B", "C",
"D")
Outcome <- c(
"Excellent",
"Good",
"OK",
"Poor",
"Excellent",
"Good",
"OK",
"Poor",
"Excellent",
"Good",
"OK",
"Poor"
)
sample_data <- data.frame(complaint_id, age_group, closed_date_ym,
officer, Outcome)
server <- shinyServer(function(session, input, output) {
# Make it reactive
data <- reactive({
sample_data
})
# Have to modify the reactive data object to add a column of 1s(Ones) inorder
# that the Pie chart %s are calculated correctly within the segments. We apply
# this modification to a new reactive object, data_mod()
data_mod <- reactive({
req(data())
df <- data() %>% select(complaint_id, age_group, closed_date_ym,
officer, Outcome)
df$Ones <- rep(1, nrow(data()))
df
})
# creates a selectInput widget with unique YYYY-MM variables ordered from most
# recent to oldest time period
output$year_month <- renderUI({
req(data_mod())
data_ordered <- order(data_mod()$closed_date_ym, decreasing = T)
data_ordered <- data_mod()[data_ordered,]
checkboxGroupInput("variable_month",
"Select Month",
choices = unique(data_ordered$closed_date_ym))
})
observe({
req(data_mod())
data_ordered <- order(data_mod()$closed_date_ym, decreasing = T)
data_ordered <- data_mod()[data_ordered,]
updateCheckboxGroupInput(
session,
"variable_month",
choices = unique(data_ordered$closed_date_ym),
selected = if (input$all)
unique(data_ordered$closed_date_ym)
)
})
# This subsets the dataset based on what "variable month" above is selected
# and renders it into a Table
output$table <- renderTable({
req(data_mod())
dftable <- data_mod()
df_subset <- dftable[, 1:5][dftable$closed_date_ym %in%
input$variable_month, ]
},
options = list(scrollX = TRUE))
# This takes the modified reactive data object data_mod(), assigns it to a
# dataframe df. The dataset in df is subsetted based on the selected variable
# month above and assigned into a new data frame, dfnew. The Pie chart is
# built on the variables within dfnew.
plot_func <- function(factor, title, scale) {
group_by(factor) %>%
summarize(volume = sum(Ones)) %>%
mutate(share = volume / sum(volume) * 100.0) %>%
arrange(desc(volume))
ggplot(dfnew, aes("", share, fill = factor)) +
geom_bar(
width = 1,
size = 1,
color = "white",
stat = "identity"
) +
coord_polar("y") +
geom_text(aes(label = paste0(round(share, digits = 2), "%")),
position = position_stack(vjust = 0.5)) +
labs(
x = NULL,
y = NULL,
fill = NULL,
title = title
) +
guides(fill = guide_legend(reverse = TRUE)) +
scale_fill_manual(values = scale) +
theme_classic() +
theme(
axis.line = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
plot.title = element_text(hjust = 0.5, color = "#666666")
)
}
output$plot1 <- renderPlot({
req(data_mod(), input$variable_month)
df <- data_mod()
dfnew <- df[, 1:6][df$closed_date_ym %in% input$variable_month, ] %>%
plot_func(
factor = age_group,
title = "Age Group Segmentation",
scale = c(
"#ffd700",
"#bcbcbc",
"#ffa500",
"#254290",
"#f0e68c",
"#808000"
)
)
})
output$plot2 <- renderPlot({
req(data_mod(), input$variable_month)
df <- data_mod()
dfnew <- df[, 1:6][df$closed_date_ym %in% input$variable_month, ] %>%
plot_func(
factor = Outcome,
title = "Outcome Segmentation",
scale =
c("#ffd700", "#bcbcbc", "#ffa500", "#254290")
)
})
# the following renderUI is used to dynamically gnerate the tabsets when the file is loaded
output$tb <- renderUI({
req(data())
tabsetPanel(tabPanel("Plot",
plotOutput("plot1"), plotOutput("plot2")),
tabPanel("Data", tableOutput("table")))
})
})
shinyApp(ui = ui, server = server)
预期结果是呈现两个饼图，但我收到错误消息
警告：plot_func 中的错误：未使用的参数 (.)
有人可以帮我解决这个问题吗？ 非常感谢。
【问题讨论】：
-
欢迎来到stackoverflow！请向我们提供reproducible example。
-
谢谢。是的，我是堆栈溢出的新手。我的完整代码 ui 和服务器从目录上传数据集，因此除非我也提供 csv 数据集，否则这是不可能的。是否可以附加我的 csv 数据集并因此使用完整的工作代码？
-
向我们提供一些虚拟数据（创建
data.frame）或使用dput()将数据粘贴到此处就足够了。此外，请添加使用的库和应用程序结构（服务器，ui）。 -
我会提供完整的代码
-
您好，感谢您对我应该如何提交问题的有用建议。我现在提供了一个完整的代码，用户界面，服务器 + 库 + 一个示例 data.frame。我期待着回音。问候