我正在尝试制作一个交互式仪表板，通过将销售业绩分组到各个存储段中，以直方图显示给定的数据。该直方图应随选定的年份，季度或月份进行调整。该应用程序本身会运行并正确显示所有内容，但是，当选择新的月份/季度/年份时，外观不会改变。任何帮助将不胜感激！
我有以下数据集：
date <- c("5/13/2016","1/11/2017","9/6/2016","4/17/2018","4/9/2017","5/23/2016",
"8/5/2017","4/10/2018","12/26/2018","1/11/2016")
employee_id <- c('738138','521743','566295','183475','614729','758291','523776',
'533564','634953','493395')
name <- c('Toby','Kelly','Pam','Jim','Michael','Angela','Oscar','Kevin','Dwight','Andy')
sales <- c('77632','85213','45839','5582','58587','64183','6133','117923','16372','111553')
participation <- c('NULL','Y','NULL','NULL','NULL','NULL','NULL','NULL','Y','NULL')
held_quota <- c('Y','Y','Y','Y','Y','Y','Y','Y','Y','Y')
attainment_bucket <- c('70-89%','100-200%','0-29%','70-89%','30-69%','0-29%','0-29%',
'200-300%','70-89%','0-29%')
sample_data <- data.frame(date,employee_id,name,sales,participation,held_quota,attainment_bucket)
我对数据进行了一些改动，以便可以更多地使用它，但是我觉得了解此处的更改对于可解释性目的很重要。
#adding in month&year coulmns to help break down views
class(sample_data$date)
x <- as.Date(sample_data$date, format = "%m/%d/%Y")
sample_data$mo <- strftime(x, "%m")
sample_data$yr <- strftime(x, "%Y")
sample_data$qrt <- quarter(x, with_year = FALSE, fiscal_start = 01)
#changing column names for front end purposes.
colName1 <- c("January" = "01",
"February" = "02",
"March" = "03",
"April" = "04",
"May" = "05",
"June" = "06",
"July" = "07",
"August" = "08",
"September" = "09",
"October" = "10",
"November" = "11",
"December" = "12")
colName2 <- c("Quarter 1" = "1",
"Quarter 2" = "2",
"Quarter 3" = "3",
"Quarter 4" = "4")
col_alias <- function(x) {switch(x,
"01" = "January",
"02" = "February",
"03" = "March",
"04" = "April",
"05" = "May",
"06" = "June",
"07" = "July",
"08" = "August",
"09" = "September",
"10" = "October",
"11" = "November",
"12" = "December")}
col_alias2 <- function(x) {switch(x,
"1" = "Quarter 1",
"2" = "Quarter 2",
"3" = "Quarter 3",
"4" = "Quarter 4")}
#subsetting data to display sales reps that hold a quota
newdata <- sample_data[grepl("Y", sample_data$held_quota),]
#fixing participation column into categorical for donut chart
newdata$participation[is.na(newdata$participation)] <- 0
newdata$participation <- factor(newdata$participation, labels =
c("0-99%","100%"))
#grouping data
newdata2 <- newdata %>%
group_by(yr, mo, qrt)
buckets <- newdata2$attainment_bucket
UI部分从此处开始：
ui = dashboardPage( skin = "blue",
dashboardHeader( title = "Sales Breakdown "),
dashboardSidebar(
sidebarMenu(
radioButtons("yearOption", "Select Year:", choices =
c("2016", "2017", "2018")),
radioButtons("timeView", "Select View:", choices =
c("Monthly", "Quarterly", "YTD")),
conditionalPanel(condition = 'input.timeView == "Quarterly"',
selectInput("quarter1", "Quarter 1", choices =
colName2),
selectInput("quarter2", "Quarter 2:", choices =
colName2)),
conditionalPanel(condition = 'input.timeView == "Monthly"',
selectInput("month1", "Month 1:", choices = colName1),
selectInput("month2", "Month 2:", choices = colName1)),
conditionalPanel(condition = 'input.timeView == "YTD"'),
numericInput('n',
"Number of Obervations",
min = 1,
max = 20,
value = 5)
)
),
dashboardBody(
fluidRow(
box(width = 6, plotOutput("hist1")),
box(width = 6, plotlyOutput("donut1")),
box(width = 12,tableOutput("table1"))
)
))
服务器部分从此处开始：
server = function(input, output) {
output$hist1 <- renderPlot({
g1 <- ggplot(data = filter(newdata2, yr == input$yearOption & mo == input$month1
& qrt == input$quarter1)
, aes_string(x = 'buckets'))+
geom_histogram(fill = "red", color = "black", stat = "count")+
scale_x_discrete(limits=c("0-29%","30-69%","70-89%","90-99%",
"100%-200%","200-300%",">300%"))+
theme_bw()
if (input$timeView == 'Monthly') {
return(g1 + labs(x="Attainment Buckets",
title = paste(col_alias(input$month1),
input$yearOption)))
}
if (input$timeView == 'Quarterly') {
return (g1 + labs(x="Attainment Buckets",
title = paste(col_alias2(input$quarter1),
input$yearOption)))
}
else{
return(g1 + labs(x="Attainment Buckets",
title = paste("YTD",input$yearOption)))
}
})
output$donut1 <- renderPlotly ({
p <- newdata2 %>%
group_by(participation) %>%
summarize(count = n()) %>%
plot_ly(labels = ~participation, values = ~count) %>%
add_pie(hole = 0.6) %>%
layout(title = "Participation", showlegend = T,
xaxis = list(showgrid = FALSE, zeroline = FALSE,
showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE,
showticklabels = FALSE))
print(p)
})
output$table1 <- renderTable ({
head(newdata2[,2:7], input$n)
})
}
shinyApp(ui = ui, server = server)
答案 0 :(得分：0)
而不是使用变量buckets，而是尝试指定位于数据框中的列：
g1 <- ggplot(data = filter(newdata2, yr == input$yearOption & mo == input$month1
& qrt == input$quarter1),
aes(x = attainment_bucket)) + ## CHANGE THIS
geom_histogram(fill = "red", color = "black", stat = "count") +
scale_x_discrete(limits=c("0-29%","30-69%","70-89%","90-99%",
"100%-200%","200-300%",">300%")) +
theme_bw()
编辑：
library(shiny)
library(dplyr)
library(lubridate)
library(shinydashboard)
library(plotly)
library(ggplot2)
date <- c("5/13/2016","1/11/2017","9/6/2016","4/17/2018","4/9/2017","5/23/2016",
"8/5/2017","4/10/2018","12/26/2018","1/11/2016") employee_id <- c('738138','521743','566295','183475','614729','758291','523776',
'533564','634953','493395') name <- c('Toby','Kelly','Pam','Jim','Michael','Angela','Oscar','Kevin','Dwight','Andy') sales <- c('77632','85213','45839','5582','58587','64183','6133','117923','16372','111553') participation <- c('NULL','Y','NULL','NULL','NULL','NULL','NULL','NULL','Y','NULL') held_quota <- c('Y','Y','Y','Y','Y','Y','Y','Y','Y','Y') attainment_bucket <- c('70-89%','100-200%','0-29%','70-89%','30-69%','0-29%','0-29%',
'200-300%','70-89%','0-29%')
sample_data <- data.frame(date,employee_id,name,sales,participation,held_quota,attainment_bucket)
#adding in month&year coulmns to help break down views
class(sample_data$date)
x <- as.Date(sample_data$date, format = "%m/%d/%Y")
sample_data$mo <- strftime(x, "%m") sample_data$yr <- strftime(x, "%Y") sample_data$qrt <- quarter(x, with_year = FALSE, fiscal_start = 01)
#changing column names for front end purposes.
colName1 <- c("January" = "01",
"February" = "02",
"March" = "03",
"April" = "04",
"May" = "05",
"June" = "06",
"July" = "07",
"August" = "08",
"September" = "09",
"October" = "10",
"November" = "11",
"December" = "12")
colName2 <- c("Quarter 1" = "1",
"Quarter 2" = "2",
"Quarter 3" = "3",
"Quarter 4" = "4")
col_alias <- function(x) {switch(x,
"01" = "January",
"02" = "February",
"03" = "March",
"04" = "April",
"05" = "May",
"06" = "June",
"07" = "July",
"08" = "August",
"09" = "September",
"10" = "October",
"11" = "November",
"12" = "December")}
col_alias2 <- function(x) {switch(x,
"1" = "Quarter 1",
"2" = "Quarter 2",
"3" = "Quarter 3",
"4" = "Quarter 4")}
#subsetting data to display sales reps that hold a quota
newdata <- sample_data[grepl("Y", sample_data$held_quota),]
#fixing participation column into categorical for donut chart newdata$participation[is.na(newdata$participation)] <- 0 newdata$participation <- factor(newdata$participation, labels =
c("0-99%","100%"))
#grouping data newdata2 <- newdata %>% group_by(yr, mo, qrt)
buckets <- newdata2$attainment_bucket
ui = dashboardPage( skin = "blue",
dashboardHeader( title = "Sales Breakdown "),
dashboardSidebar(
sidebarMenu(
radioButtons("yearOption", "Select Year:", choices =
c("2016", "2017", "2018")),
radioButtons("timeView", "Select View:", choices =
c("Monthly", "Quarterly", "YTD")),
conditionalPanel(condition = 'input.timeView == "Quarterly"',
selectInput("quarter1", "Quarter 1", choices =
colName2),
selectInput("quarter2", "Quarter 2:", choices =
colName2)),
conditionalPanel(condition = 'input.timeView == "Monthly"',
selectInput("month1", "Month 1:", choices = colName1),
selectInput("month2", "Month 2:", choices = colName1)),
conditionalPanel(condition = 'input.timeView == "YTD"'),
numericInput('n',
"Number of Obervations",
min = 1,
max = 20,
value = 5)
)
),
dashboardBody(
fluidRow(
box(width = 6, plotOutput("hist1")),
box(width = 6, plotlyOutput("donut1")),
box(width = 12,tableOutput("table1"))
)
))
server = function(input, output) {
output$hist1 <- renderPlot({
g1 <- ggplot(data = filter(newdata2, yr == input$yearOption & mo == input$month1
& qrt == input$quarter1),
aes(x = attainment_bucket))+
geom_histogram(fill = "red", color = "black", stat = "count")+
scale_x_discrete(limits=c("0-29%","30-69%","70-89%","90-99%",
"100%-200%","200-300%",">300%"))+
theme_bw()
if (input$timeView == 'Monthly') {
return(g1 + labs(x="Attainment Buckets",
title = paste(col_alias(input$month1),
input$yearOption)))
}
if (input$timeView == 'Quarterly') {
return (g1 + labs(x="Attainment Buckets",
title = paste(col_alias2(input$quarter1),
input$yearOption)))
}
else{
return(g1 + labs(x="Attainment Buckets",
title = paste("YTD",input$yearOption)))
}
})
output$donut1 <- renderPlotly ({
p <- newdata2 %>%
group_by(participation) %>%
summarize(count = n()) %>%
plot_ly(labels = ~participation, values = ~count) %>%
add_pie(hole = 0.6) %>%
layout(title = "Participation", showlegend = T,
xaxis = list(showgrid = FALSE, zeroline = FALSE,
showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE,
showticklabels = FALSE))
print(p)
})
output$table1 <- renderTable ({
head(newdata2[,2:7], input$n)
})
}
shinyApp(ui = ui, server = server)