@ChristineBaver @EricaNova I don't have a blog post on this, but i can share the code of one my R Shiny Apps that's a web application showing interactive Pyramid plots of Hispanic Population. This web app was then embedded as an iframe into a ESRI web application. If you would like to have the data behind this app to play and learn the code, please dm me, and i can share it with you 🙂.
App URL: https://saadib.shinyapps.io/PopulationPyramidPlots/
R Shiny Web App Embedded in StoryMaps: https://storymaps.arcgis.com/stories/885ec2e2359d48bab885da95d20fa810

library(shiny)
library(shinythemes)
library(tidyverse)
library(plotly)
library(janitor)
# Define UI for application
ui = fluidPage(
navbarPage( theme = shinytheme("paper"),
tabPanel("Pyramid Plots",
icon = icon("chart-area"),
plotlyOutput(outputId = "PP1",
width = "1024px",
height = "768px",
inline = T),
plotlyOutput(outputId = "PP2",
width = "1024px",
height = "768px",
inline = T),
)
)
)
# Define server logic
server = function(input, output) {
pop_hisp = read_csv("HISPANIC_POPULATION_PYRAMID_DATA.csv")
pop_gen = read_csv("GEN_POP_PYRAMID_DATA.csv")
pop_hisp = clean_names(pop_hisp)
pop_hisp = pop_hisp %>% dplyr::rename(Females = females)
pop_hisp = pop_hisp %>% dplyr::rename(Males = males)
pop_gen = clean_names(pop_gen)
pop_gen = pop_gen %>% dplyr::rename(Females = females)
pop_gen = pop_gen %>% dplyr::rename(Males = males)
# Draw a pyramid plot
# Clean data
pop_hisp_df = pop_hisp %>% select(age_group,
Males,
Females) %>%
gather(key = Type, value = Value, -c(age_group))
pop_gen_df = pop_gen %>% select(age_group,
Males,
Females) %>%
gather(key = Type, value = Value, -c(age_group))
# Make male values negative
pop_hisp_df$Value = ifelse(pop_hisp_df$Type == "Males", -1*pop_hisp_df$Value, pop_hisp_df$Value)
pop_gen_df$Value = ifelse(pop_gen_df$Type == "Males", -1*pop_gen_df$Value, pop_gen_df$Value)
# Change the order of values to reflect them in the plot
reverse_legend_labels = function(plotly_plot) {
n_labels <- length(plotly_plot$x$data)
plotly_plot$x$data[1:n_labels] <- plotly_plot$x$data[n_labels:1]
plotly_plot
}
output$PP1 = renderPlotly({
# Plot
gg_pop_hisp = ggplot(pop_hisp_df, aes( x = forcats::as_factor(age_group), y = Value, fill = Type,
text = paste('Age group:', age_group, '\nValue:', abs(Value), '\nType:', Type))) +
geom_bar(data = subset(pop_hisp_df, Type == "Females"), stat = "identity") +
geom_bar(data = subset(pop_hisp_df, Type == "Males"), stat = "identity") +
#geom_text(aes(label = paste0(abs(Value), "%"))) +
scale_y_continuous(limits=c(-20,20),
breaks=c(-15,-10,0,10,15),
labels=paste0(c(15,10,0,10,15),"%")) + # CHANGE
scale_fill_manual(name = "", values = c("Females"="#FC921F", "Males"="#149ECE"), labels = c("Females", "Males")) +
ggtitle("FIGURE 3: HISPANIC POPULATION BY GENDER AND AGE GROUP") +
labs(x = "AGE GROUPS", y = "PERCENTAGE POPULATION", fill = "Gender") +
theme_minimal() +
theme(legend.position="bottom") +
coord_flip()
# Interactive
ggplotly(gg_pop_hisp, tooltip = 'text') %>%
layout(
legend = list(
orientation = 'h', x = 0.3, y = -0.3,
title = list(text = '')
)
) %>%
reverse_legend_labels()
})
output$PP2 = renderPlotly({
# Plot
gg_pop_gen = ggplot(pop_hisp_df, aes(x = forcats::as_factor(age_group), y = Value, fill = Type,
text = paste('Age group:', age_group, '\nValue:', abs(Value), '\nType:', Type))) +
geom_bar(data = subset(pop_hisp_df, Type == "Females"), stat = "identity") +
geom_bar(data = subset(pop_hisp_df, Type == "Males"), stat = "identity") +
#geom_text(aes(label = paste0(abs(Value), "%"))) +
#scale_y_continuous(labels = function(z) paste0(abs(z), "%")) + # CHANGE
scale_y_continuous(
limits=c(-20,20),
breaks=c(-15,-10,0,10,15),
labels=paste0(c(15,10,0,10,15),"%")
) +
scale_fill_manual(name = "", values = c("Females"="#ED5151", "Males"="#6B6BD6"), labels = c("Females", "Males")) +
ggtitle("FIGURE 4: TOTAL POPULATION BY AGE AND GENDER") +
labs(x = "AGE GROUPS", y = "PERCENTAGE POPULATION", fill = "Gender") +
theme_minimal() +
theme(legend.position="bottom") +
coord_flip()
# Interactive
ggplotly(gg_pop_gen, tooltip = 'text') %>%
layout(
legend = list(
orientation = 'h', x = 0.3, y = -0.3,
title = list(text = '')
)
) %>%
#reverse_legend_labels() %>%
layout(margin = list(l = 50, r = 50, b = 100, t = 50),
annotations = list(x = 0.3, y = -0.3, text = "<b>Figure 3 & 4</b>: Data for Figure 3 and 4 was retrieved from: \n U.S. Census Bureau, American Community 5-Year Estimates",
xref='paper', yref='paper', showarrow = F,
xanchor='right', yanchor='auto', xshift=0, yshift=0,
font = list(size = 10)))
})
}
# Run the application
shinyApp(ui = ui, server = server)
Question | Analyze | Visualize