Я создал приложение для предстоящих выборов в Австралии: https://regionalinnovationdatalab.shinyapps.io/Dashboard/
Рабочий код и данные приложения (они не содержат правок, с которыми я прошу помощи): https://gitlab.com/r.chappell/2019_ElectionApp_RIDL
Я хотел бы создать несколько вкладок («Демография», «Доход», «Жилье» и т. Д.), Которые позволяют пользователям сравнивать данные об электорате со средними показателями по стране и штату.Данные об уровне электората являются реагирующими на основе электората, выбранного в раскрывающемся меню, но я хотел бы, чтобы графики на национальном и государственном уровне отображались независимо от электората, выбранного из раскрывающегося списка.
Например, на вкладке демография я хотел бы 3 графика.1. Население по возрасту и полу для выбранного электората 2. Население по возрасту и полу для всей Австралии (AUS) - отображает, независимо от того, какой электорат выбран) 3. Население по возрасту и полу для всего Квинсленда (QLD) - отображаетНезависимо от того, какой электорат выбран,
Я не могу понять, как построить данные AUS и QLD, не включив их в реактивный вход из выпадающего меню электората.Причина, по которой я не хочу этого делать, заключается в том, что само приложение использует пространственные данные и отображает их, поэтому мне придется создавать кликабельные многоугольники для Aus и Qld, что я не уверен, как это сделать без потери интерактивного электората.конкретные полигоны.
Мне нужна помощь, пожалуйста, и спасибо:).
Пример данных: https://drive.google.com/drive/folders/1byijKXHZwnJSzVv3UiNgjmUwAG3p9yZ7?usp=sharing
#read in data
df.age<-read.csv("ced.age.csv") #electorate level data use for options from drop down
qld.age<-read.csv("qld.age.csv") #state level data
aus.age<-read.csv("aus.age.csv") #national data
#UI
ui <- shiny::navbarPage(title= "Federal Election Dashboard",
theme = "journal",
tabPanel("Commonwealth Electoral Divisions",
column(selectInput("division", "",
label="Select an electorate, graphs will be updated.",
choices = ced.age$Elect_div),
plotlyOutput("ageBar", height="300px", width = "500px"))),
tabPanel("Demographics",
radioButtons(inputId="View", label="Select an option", choices = c("Absolute_Numbers", "Percentages"), selected = "Absolute_Numbers"),
plotlyOutput("ageBar2"),#, #CED
plotlyOutput("age_qld"),#qld
plotlyOutput("age_aus")))
br()
#~~~~~~AESTHETIC STUFF~~~~~~~
#colour scheme for bar charts
mycol=c("#021893", "#0099CC", "#740699","#C12525","#990623")
MF=c("#2359AF","#970B76")
point <- format_format(big.mark = " ", decimal.mark = ",", scientific = FALSE)
#~~~~SERVER CODE~~~~~
server <- function(input, output, session) {
#Create the plots for all the different bar charts we want displayed using the dfs we created above (age, income etc.)
#using ggplot and plotly to create the bar charts/ distributions
#population per electorate by age and sex
output$ageBar <- renderPlotly({
ageplot<-ggplot(
subset(df.age,df.age$Elect_div==input$division),
aes(variable2, value)) + geom_bar(stat = "identity", position ="stack", aes(fill = variable3))+
scale_x_discrete(labels=c("0-4","5-9","10-14","15-19","20-24","25-29","30-34", "35-39","40-44",
"45-49","50-54","55-59","60-64","65-69",
"70-74","75-79", "80-84",">85")) +
theme_classic() + scale_fill_manual(values = MF, guide=FALSE) +
theme(axis.text.x = element_text(angle=45, hjust = 1, size = 8, face= 'bold'))+
labs(title = "Population", subtitle = "Data from ABS", x = "", y = "", fill= "Sex")
ggplotly(ageplot)%>% config(displayModeBar = F) %>% layout(xaxis=list(fixedrange=TRUE)) %>% layout(yaxis=list(fixedrange=TRUE)) })
output$ageBar2 <- renderPlotly({
ageplot<-ggplot(
subset(df.age,df.age$Elect_div==input$division),
aes(variable2, value)) + geom_bar(stat = "identity", position ="stack", aes(fill = variable3))+
scale_x_discrete(labels=c("0-4","5-9","10-14","15-19","20-24","25-29","30-34", "35-39","40-44",
"45-49","50-54","55-59","60-64","65-69",
"70-74","75-79", "80-84",">85")) +
theme_classic() + scale_fill_manual(values = MF, guide=FALSE) +
theme(axis.text.x = element_text(angle=45, hjust = 1, size = 8, face= 'bold'))+
labs(title = "Population", subtitle = "Data from ABS", x = "", y = "", fill= "Sex")
ggplotly(ageplot)%>% config(displayModeBar = F) %>% layout(xaxis=list(fixedrange=TRUE)) %>% layout(yaxis=list(fixedrange=TRUE)) })
#attempt to create some reactive data for the state and national level data to change the y variable to display absolute or percentages based on radio button input
qld_age_reactive<-reactive({
if (input$View=="Absolute_Numbers"){qld.age$View<-qld.age$Absolute_Numbers} else{
qld.age$View<-qld.age$Percentages
}
qld.age
})
#population for QLD by age and sex
output$age_qld <- renderPlotly({
ageQld<-ggplot(data=qld_age_reactive(), aes(x=variable2, y=View)) + geom_bar(stat = "identity", position ="stack", aes(fill = variable3))+
scale_x_discrete(labels=c("0-4","5-9","10-14","15-19","20-24","25-29","30-34", "35-39","40-44",
"45-49","50-54","55-59","60-64","65-69",
"70-74","75-79", "80-84",">85")) +
theme_classic() + scale_fill_manual(values = MF, guide=FALSE) +
theme(axis.text.x = element_text(angle=45, hjust = 1, size = 8, face= 'bold'))+
labs(title = "State Population", subtitle = "Data from ABS", x = "", y = "", fill= "Sex")
ggplotly(ageQld)%>% config(displayModeBar = F) %>% layout(xaxis=list(fixedrange=TRUE)) %>% layout(yaxis=list(fixedrange=TRUE)) })
#population for AUS by age and sex
output$age_aus <- renderPlotly({
ageAus<-ggplot(data=aus.age, aes_string(x=variable2, y=Absolute_Numbers)) + geom_bar(stat = "identity", position ="stack", aes(fill = variable3))+
scale_x_discrete(labels=c("0-4","5-9","10-14","15-19","20-24","25-29","30-34", "35-39","40-44",
"45-49","50-54","55-59","60-64","65-69",
"70-74","75-79", "80-84",">85")) +
theme_classic() + scale_fill_manual(values = MF, guide=FALSE) +
theme(axis.text.x = element_text(angle=45, hjust = 1, size = 8, face= 'bold'))+
labs(title = "Australian Population", subtitle = "Data from ABS", x = "", y = "", fill= "Sex")
ggplotly(ageAus)%>% config(displayModeBar = F) %>% layout(xaxis=list(fixedrange=TRUE)) %>% layout(yaxis=list(fixedrange=TRUE)) })
}
shinyApp(ui, server)