library(tidyr)
library(readr)
library(dplyr)
library(stringr)
library(magrittr)
library(glptools)
path <- "data-raw/qop/arts/"
# County Business Pattern Data
cbp <- read_csv(path %p% "cbp16co.txt")
cbp %<>%
mutate(FIPS = as.numeric(paste0(fipstate, fipscty))) %>%
pull_peers_FIPS(add_info = FALSE)
ind_art_naics <- c("711510") # Independent Artists, Writers, and Performers
art_cult_naics <-
c("712110", # Museums
"712120", # Historical Sites
"7111//") # Performing Arts Companies (theater, dance, musical group, other performing arts)
art_cult_ent_naics <-
c(art_cult_naics,
"61161/", # Fine arts schools
"512110", # Motion picture production
"5122//") # Sound recording
cbp %<>%
mutate(
ind_art = if_else(naics %in% ind_art_naics, 1, 0),
art_cult = if_else(naics %in% art_cult_naics, 1, 0),
art_cult_ent = if_else(naics %in% art_cult_ent_naics, 1, 0)) %>%
filter((ind_art + art_cult + art_cult_ent) > 0) %>%
#filter(naics %in% c("7121//", "712110", "712120", "712130", "712190")) %>%
select(FIPS, naics, emp, empflag, est, ap, ind_art, art_cult, art_cult_ent) %>%
mutate(year = 2016)
emp_est <- data.frame(
naics = "712120",
FIPS = c(12031, 18097, 29095, 29189, 31055, 39049, 39061,
39113, 40109, 40143, 45045, 47157),
emp_est = c(13, 9.5, 52, 7.3, 3, 7.5, 59.5,
3, 7, 9.5, 1, 57.5),
stringsAsFactors = FALSE)
cbp %<>%
left_join(emp_est, by = c("naics", "FIPS")) %>%
mutate(
emp = if_else(naics == "712120" & !is.na(empflag),
emp_est,
emp))
indep_artists <- cbp %>%
filter(ind_art == 1) %>%
stl_merge(emp, method = "sum") %>%
left_join(population_df_merged %>% filter(year == 2016), by = c("FIPS", "year")) %>%
mutate(ind_art = emp / population * 100000) %>%
select(-emp, -population)
art_cult <- cbp %>%
filter(art_cult == 1) %>%
group_by(FIPS, year) %>%
summarise(emp = sum(emp)) %>%
ungroup() %>%
stl_merge(emp, method = "sum") %>%
left_join(population_df_merged %>% filter(year == 2016), by = c("FIPS", "year")) %>%
mutate(art_cult = emp / population * 100000) %>%
select(-emp, -population)
art_cult_ent <- cbp %>%
filter(art_cult_ent == 1) %>%
group_by(FIPS, year) %>%
summarise(est = sum(est)) %>%
ungroup() %>%
stl_merge(est, method = "sum") %>%
left_join(population_df_merged %>% filter(year == 2016), by = c("FIPS", "year")) %>%
mutate(art_cult_ent = est / population * 100000) %>%
select(-est, -population)
art_cult_payroll <- cbp %>%
filter(art_cult == 1) %>%
group_by(FIPS, year) %>%
summarise(art_cult_payroll = sum(ap)) %>%
ungroup() %>%
stl_merge(art_cult_payroll, method = "sum") %>%
left_join(population_df_merged %>% filter(year == 2016), by = c("FIPS", "year")) %>%
mutate(art_cult_payroll = art_cult_payroll / population * 100000) %>%
select(-population)
# Business Master File
bmf <- read_csv(path %p% "bmf.bm1812.csv")
arts_cult_ntee <-
c(
"A50", # Museums
"A25", # Arts education
"A27", # Community Celebration
"A62", # Dance
"A68", # Music
"A6A", # Opera
"A61", # Performing arts centers
"A69", # Orchestras
"A65", # Theater
"A01", # Alliances and Advocacy
"A11", # Single Organization Support
"A02",
"A12",
"A19")
bmf %<>%
mutate(FIPS = as.numeric(FIPS)) %>%
pull_peers_FIPS() %>%
filter(NTEECC %in% arts_cult_ntee) %>%
group_by(FIPS) %>%
summarise(
art_cult_org = n(),
art_cult_income = sum(INCOME, na.rm = TRUE)) %>%
ungroup() %>%
mutate(year = 2016) %>%
stl_merge(art_cult_org, art_cult_income, method = "sum") %>%
left_join(population_df_merged %>% filter(year == 2016), by = c("FIPS", "year")) %>%
mutate(
art_cult_org = art_cult_org / population * 100000,
art_cult_income = art_cult_income / population) %>%
select(-population)
# Bind and process data frames
providers <- bind_df(indep_artists, art_cult, art_cult_ent, art_cult_payroll, bmf)
providers_z <- providers %>%
pull_peers_FIPS() %>%
filter(current == 1) %>%
organize() %>%
filter(city != "Nashville") %>%
group_by(year) %>%
mutate_at(vars(ind_art:art_cult_income), norm_z) %>%
ungroup() %>%
rename_at(vars(ind_art:art_cult_income), paste0, "_index")
providers_z %<>%
mutate(
provider_index = (ind_art_index + art_cult_index + art_cult_ent_index + art_cult_org_index) / 4,
dollars = (art_cult_income_index + art_cult_payroll_index) / 2,
art_index = (provider_index + dollars) / 2) %>%
mutate(sex = "total", race ="total")
library(classInt)
library(scales)
library(ggthemes)
library(showtext)
library(ggplot2)
font_add("Museo Sans 300", "C:/Users/harri/Documents/GLP/MuseoSans_300.otf")
font_add("Museo Sans 300 Italic", "C:/Users/harri/Documents/GLP/MuseoSans_300_Italic.otf")
showtext_auto()
png("arts_ranking.png", 1800, 1200, res = 200)
ranking(providers_z,
"art_index",
plot_title = "Arts Vibrancy Index",
year = 2016,
y_title = "",
text = F)
dev.off()
write_csv(providers_z %>%
select(city, art_index) %>%
mutate(art_index = round(art_index, 2)), "Art Index.csv")
providers_bar <- providers_z %>%
select(city, ind_art_index:art_cult_income_index) %>%
mutate_at(vars(ind_art_index, art_cult_index, art_cult_ent_index, art_cult_org_index), funs(. * .125)) %>%
mutate_at(vars(art_cult_income_index, art_cult_payroll_index), funs(. * .25)) %>%
gather(-city, key = "Component", value = "Index")
cities_ord <- providers_z %>% arrange(art_index)
cities_ord <- cities_ord$city
providers_bar$city <-
factor(providers_bar$city,
levels = cities_ord,
ordered = TRUE)
providers_bar$Component <-
factor(providers_bar$Component,
levels = c("ind_art_index", "art_cult_index", "art_cult_org_index",
"art_cult_ent_index", "art_cult_income_index", "art_cult_payroll_index"),
labels = c("Independent Artists", "Arts and Culture Employees", "Arts and Culture Nonprofits",
"Arts, Culture, and Entertainment Firms", "Arts and Culture Contributions", "Arts and Culture Payroll"),
ordered = TRUE)
png("arts_ranking_components.png", 2100, 1200, res = 200)
ggplot() +
geom_bar(data = providers_bar, aes(x = city, y = Index, fill = Component), stat = "identity") +
scale_fill_manual(values = brewer_pal(type = "qual", palette = "Set3")(6)) +
theme(
text = element_text(family = "Museo Sans 300"),
plot.title = element_text(size = 42, hjust = 0.5, margin = margin(b = 10, unit = "pt")),
axis.text = element_text(size = 14),
axis.text.x = element_text(angle = 45, vjust = .5),
axis.title = element_text(size = 20),
legend.title = element_text(size = 20),
legend.text = element_text(size = 12)) +
labs(title = "Arts Index Components")
dev.off()
png("arts_ranking_lou.png", 1500, 1200, res = 200)
ggplot(providers_bar %>% filter(city == "Louisville")) +
aes(x = city, y = Index, fill = Component) +
geom_bar(stat = "identity") +
scale_fill_manual(values = brewer_pal(type = "qual", palette = "Set3")(6)) +
theme(
text = element_text(family = "Museo Sans 300"),
plot.title = element_text(size = 42, hjust = 0.5, margin = margin(b = 10, unit = "pt")),
plot.subtitle = element_text(size = 14, hjust = 0.5),
axis.text = element_text(size = 14),
axis.text.x = element_text(vjust = .5),
axis.title = element_text(size = 20),
legend.title = element_text(size = 20),
legend.text = element_text(size = 12)) +
labs(title = "Arts Index, Louisville",
subtitle = "All values except for Arts and Culture Nonprofits are negative for Louisville. Smaller values (closer to 0) are better.")
dev.off()
test <- providers_z %>% left_join(population_df_merged, by = c("FIPS", "year"))
ggplot(test, aes(x = population, y = art_index)) + geom_point()
cor(test$population, test$art_index)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.