In cwolfsonseeley/regionalreports: Regional and School Analysis
knitr::opts_chunk$set(echo = TRUE)
model_format <- function(desc, type) {
replacement_value <- switch (type,
mgs = "No Major Gift Score",
ics = "No Implied Capacity Score",
stop("type must be 'mgs' or 'ics'")
)
desc[is.na(desc)] <- replacement_value
factor(desc, levels = c("Most Likely", "More Likely", "Somewhat Likely",
"Less Likely", "Least Likely", replacement_value))
}
knitr::include_graphics("R:/Prospect Development/Prospect Development/Letterhead Templates/UDAR_PD/Prospect Development banner_portrait.jpg")
r school_name r msa_name Analysis
r format(Sys.time(), "%B %d, %Y")
library(getcdw)
library(dplyr)
library(ggplot2)
library(knitr)
library(scales)
library(kableExtra)
library(tidyr)
knitr::opts_chunk$set(echo = TRUE)
## set up the functions
region_and_school <- function(school_code, msa) {
region_and_school_query <- getcdw::parameterize_template("R:/Prospect Development/Prospect Analysis/regionalreports/sql/region_and_school/region_and_school.sql")
getcdw::get_cdw(region_and_school_query(school_code = school_code, msa = msa))
}
imp_cap <- function(school_code, msa) {
imp_cap_query <- getcdw::parameterize_template("R:/Prospect Development/Prospect Analysis/regionalreports/sql/region_and_school/imp_cap.sql")
getcdw::get_cdw(imp_cap_query(school_code = school_code, msa = msa))
}
mgs <- function(school_code, msa) {
mgs_query <- getcdw::parameterize_template("R:/Prospect Development/Prospect Analysis/regionalreports/sql/region_and_school/mgs.sql")
getcdw::get_cdw(mgs_query(school_code = school_code, msa = msa))
}
events <- function(school_code, msa, from, to) {
events_query <- getcdw::parameterize_template("R:/Prospect Development/Prospect Analysis/regionalreports/sql/region_and_school/events.sql")
getcdw::get_cdw(events_query(school_code = school_code, msa = msa, from = from, to = to))
}
visits <- function(school_code, msa, from, to) {
visits_query <- getcdw::parameterize_template("R:/Prospect Development/Prospect Analysis/regionalreports/sql/region_and_school/visits.sql")
getcdw::get_cdw(visits_query(school_code = school_code, msa = msa, from = from, to = to))
}
gifts <- function(school_code, msa, from, to) {
gifts_query <- getcdw::parameterize_template("R:/Prospect Development/Prospect Analysis/regionalreports/sql/region_and_school/gifts.sql")
getcdw::get_cdw(gifts_query(school_code = school_code, msa = msa, from = from, to = to))
}
proposals <- function(school_code, msa, from, to) {
proposals_query <- getcdw::parameterize_template("R:/Prospect Development/Prospect Analysis/regionalreports/sql/region_and_school/proposals.sql")
getcdw::get_cdw(proposals_query(school_code = school_code, msa = msa, from = from, to = to))
}
## get the data
prospects <- region_and_school(school_code = school_code, msa = msa)
prospects$capacity_rating_code <- as.numeric(prospects$capacity_rating_code)
prospects$pref_class_year <- as.numeric(prospects$pref_class_year)
prospects <- prospects %>%
mutate(age = ifelse(!is.na(birth_year), 2018-birth_year,
2040-pref_class_year)) %>%
mutate(decade = cut(age, breaks = c(20, 30, 40, 50, 60, 70, 80, 90, Inf),
labels = c("20-29", "30-39", "40-49", "50-59", "60-69", "70-79", "80-89", "Over 90"),
include.lowest = TRUE, right = FALSE)) %>%
select(-pref_class_year, -birth_year, -age)
imp_cap <- imp_cap(school_code = school_code, msa = msa)
mgs <- mgs(school_code = school_code, msa = msa)
events <- events(school_code = school_code, msa = msa, from = from, to = to)
visits <- visits(school_code = school_code, msa = msa, from = from, to = to)
gifts <- gifts(school_code = school_code, msa = msa, from = from, to = to)
proposals <- proposals(school_code = school_code, msa = msa, from = from, to = to)
## create table that allows capacity descriptions to be ordered numerically
cap_match <- prospects %>%
select(capacity_rating_code, capacity_rating_desc) %>%
distinct()
## rating by major gift score table
capacity_mgs_table <- prospects %>%
mutate(capacity_rating_desc = ifelse(is.na(capacity_rating_desc), "Not Rated", capacity_rating_desc)) %>%
left_join(mgs, by = "hh_id") %>%
select(hh_id, capacity_rating_desc, major_gift_description) %>%
distinct() %>%
mutate(major_gift_description = model_format(major_gift_description, 'mgs')) %>%
group_by(capacity_rating_desc, major_gift_description) %>%
summarise(households = n_distinct(hh_id)) %>%
spread(major_gift_description, households) %>%
left_join(cap_match, by = "capacity_rating_desc") %>%
arrange(capacity_rating_code) %>%
select(-capacity_rating_code) %>%
replace(is.na(.), 0) %>%
janitor::adorn_totals(c("row", "col"))
colnames(capacity_mgs_table)[colnames(capacity_mgs_table)=="capacity_rating_desc"] <- "Capacity Rating"
## ics by major gift score table
ics_mgs_table <- prospects %>%
filter(is.na(capacity_rating_code)) %>%
select(hh_id) %>%
left_join(imp_cap, by = "hh_id") %>%
left_join(mgs, by = "hh_id") %>%
select(hh_id, implied_capacity_description, major_gift_description) %>%
mutate(implied_capacity_description =
model_format(implied_capacity_description, 'ics')) %>%
mutate(major_gift_description =
model_format(major_gift_description, 'mgs')) %>%
group_by(implied_capacity_description, major_gift_description) %>%
summarise(households = n_distinct(hh_id)) %>%
spread(major_gift_description, households) %>%
replace(is.na(.), 0) %>%
janitor::adorn_totals(c("row", "col"))
colnames(ics_mgs_table)[colnames(ics_mgs_table)=="implied_capacity_description"] <- "Implied Capacity Score"
ics_mgs_table[is.na(ics_mgs_table)] <- 0
## record type summary
record_type <- prospects %>%
group_by(record_type_desc) %>%
summarise(entities = n_distinct(entity_id)) %>%
arrange(-entities)
## age summary
age <- prospects %>%
filter(!is.na(decade)) %>%
group_by(decade) %>%
summarise(entities = n_distinct(entity_id))
## school summary
school <- prospects %>%
filter(!is.na(pref_school_desc)) %>%
group_by(pref_school_desc) %>%
summarise(entities = n_distinct(entity_id)) %>%
top_n(5, entities) %>%
arrange(-entities)
## rating summary
rated <- prospects %>%
mutate(capacity_rating = ifelse(is.na(capacity_rating_desc), "Not Rated", capacity_rating_desc)) %>%
group_by(capacity_rating, capacity_rating_code) %>%
summarise(households = n_distinct(hh_id)) %>%
arrange(capacity_rating_code)
## proposals summary
proposals <- proposals %>%
mutate(ask_made = ifelse(ask_amt > 0, 1, 0),
disqualified = ifelse(stage_desc == "Disqualified", 1, 0),
gift_made = ifelse(gift > 0, 1, 0),
canceled = ifelse(stage_desc == "Canceled", 1, 0),
turned_down = ifelse(stage_desc == "Turned Down", 1, 0)) %>%
mutate(in_progress = ifelse(is.na(commit_turndown_date) & ((disqualified + gift_made + canceled + turned_down) == 0), 1, 0)) %>%
mutate(canceled = ifelse((!is.na(commit_turndown_date) & stage_desc %in% c("Qualification", "Cultivation", "Proposal Development")), 1, canceled))
Introduction
This analysis looks at all alumni and current parents of students in r school_name in the r msa_name area. The time period included is from r format(as.Date(as.character(from), "%Y%m%d"), "%B %d, %Y") to r format(as.Date(as.character(to), "%Y%m%d"), "%B %d, %Y").
There are currently r comma(n_distinct(prospects$entity_id)) alumni and current parents of students in r school_name in the r msa_name area, comprising r comma(n_distinct(prospects$hh_id)) households.
Demographics
r percent(as.numeric(record_type[1,2]/n_distinct(prospects$entity_id))) of r msa_name area alumni and current parents of students in r school_name have a record type of r record_type[1,1], r percent(as.numeric(record_type[2,2]/n_distinct(prospects$entity_id))) have a record type of r record_type[2,1], and r percent(as.numeric(record_type[3,2]/n_distinct(prospects$entity_id))) have a record type of r record_type[3,1]. Note that these percentages do not add up to 100% since each entity may have multiple record types.
record_type %>%
filter(record_type_desc %in% c("UCB Parent of Current Student", "Alum: Undergrad", "Alum: Grad")) %>%
kable(col.names = c("Record Type", "Entities*"),
format.args = list(big.mark = ","), align = 'l') %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left") %>%
footnote(symbol = "Each entity may have multiple record types"
)
Age has been determined by birth date if available and estimated by class year if not. Alumni are most likely to be r arrange(top_n(age, 2), -entities)[1,1] years old (r percent(as.numeric(arrange(top_n(age, 2), -entities)[1,2]/sum(age$entities)))), with the next most common age being r arrange(top_n(age, 2), -entities)[2,1] (r percent(as.numeric(arrange(top_n(age, 2), -entities)[2,2]/sum(age$entities)))).
age %>%
ggplot(aes(x=decade, y=entities)) +
geom_bar(stat = "identity") +
theme_bw() +
theme(rect = element_blank(), axis.ticks = element_blank()) +
ylab(NULL) +
xlab(NULL) +
scale_y_continuous(labels = comma) +
ggtitle("Entities by Age")
Most alumni are graduates of r school[1,1], followed by r school[2,1] and r school[3,1]. The following table displays the top five schools represented.
school %>%
kable(col.names = c("School", "Entities"),
format.args = list(big.mark = ","), align = 'l') %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
Ratings
r percent(as.numeric(1-filter(rated, capacity_rating == "Not Rated")[1,3]/sum(rated$households))) of r msa_name r school_name households have been rated. Of those, r percent(as.numeric(sum(filter(rated, capacity_rating_code %in% c(1:9))$households)/sum(filter(rated, capacity_rating_code %in% c(1:14))$households))) are rated 250K+ or higher.
rated %>%
filter(capacity_rating != "Not Rated") %>%
ggplot(aes(x=reorder(capacity_rating, capacity_rating_code), y=households)) +
geom_bar(stat = "identity") +
theme_bw() +
theme(rect = element_blank(), axis.ticks = element_blank()) +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
ylab(NULL) +
xlab(NULL) +
scale_y_continuous(labels = comma) +
ggtitle("Households by Capacity Rating")
The following table looks at the breakdown of each capacity rating by Major Gift Score. The Major Gift Score is calculated for all undergraduate degree holders.
capacity_mgs_table %>%
kable(format.args = list(big.mark = ","), align = 'l') %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left") %>%
add_header_above(
header = c(" " = 1,
"Major Gift Score" = ncol(capacity_mgs_table) - 2,
" " = 1))
For unrated households only, the following table looks at the breakdown of Implied Capacity Score and Major Gift Score.
ics_mgs_table %>%
kable(format.args = list(big.mark = ","), align = 'l') %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left") %>%
add_header_above(
header = c(" " = 1,
"Major Gift Score" = ncol(ics_mgs_table) - 2,
" " = 1))
Events
There have been r comma(n_distinct(events$activity_code)) events attended by r msa_name r school_name households between r format(as.Date(as.character(from), "%Y%m%d"), "%B %d, %Y") and r format(as.Date(as.character(to), "%Y%m%d"), "%B %d, %Y"). r arrange(top_n(summarise(group_by(events, unit_code_desc), households = n_distinct(hh_id), events = n_distinct(activity_code)), 5, wt=events), -events)[1,1] has held the most events, followed by r arrange(top_n(summarise(group_by(events, unit_code_desc), households = n_distinct(hh_id), events = n_distinct(activity_code)), 5, wt=events), -events)[2,1].
events %>%
group_by(fiscal_year) %>%
summarise(households = n_distinct(hh_id), events = n_distinct(activity_code)) %>%
mutate(households = scales::comma(households)) %>%
kable(col.names = c("Fiscal Year", "Households", "Events"), align = 'l') %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
events %>%
group_by(unit_code_desc) %>%
summarise(households = n_distinct(hh_id), events = n_distinct(activity_code)) %>%
top_n(5, wt=events) %>%
arrange(-events) %>%
mutate(households = scales::comma(households)) %>%
kable(col.names = c("Unit", "Households", "Events"), align = 'l') %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
Visits
There have been r comma(n_distinct(visits$report_id)) visits to r msa_name r school_name households between r format(as.Date(as.character(from), "%Y%m%d"), "%B %d, %Y") and r format(as.Date(as.character(to), "%Y%m%d"), "%B %d, %Y"). r arrange(top_n(summarise(group_by(visits, unit_desc), households = n_distinct(hh_id), visits = n_distinct(report_id)), 5, wt=visits), -visits)[1,1] has made the most visits, followed by r arrange(top_n(summarise(group_by(visits, unit_desc), households = n_distinct(hh_id), visits = n_distinct(report_id)), 5, wt=visits), -visits)[2,1].
visits %>%
group_by(fiscal_year) %>%
summarise(households = n_distinct(hh_id), visits = n_distinct(report_id)) %>%
kable(col.names = c("Fiscal Year", "Households", "Visits"), align = 'l') %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
visits %>%
group_by(unit_desc) %>%
summarise(households = n_distinct(hh_id), visits = n_distinct(report_id)) %>%
top_n(5, wt=visits) %>%
arrange(-visits) %>%
kable(col.names = c("Unit", "Households", "Visits"), align = 'l') %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
Solicitation Plans
There have been r comma(n_distinct(proposals$proposal_id)) solicitation plans involving r msa_name r school_name households between r format(as.Date(as.character(from), "%Y%m%d"), "%B %d, %Y") and r format(as.Date(as.character(to), "%Y%m%d"), "%B %d, %Y"). r arrange(top_n(summarise(group_by(proposals, unit), households = n_distinct(hh_id), proposals = n_distinct(proposal_id)), 5, wt=proposals), -proposals)[1,1] has the most assignments, followed by r arrange(top_n(summarise(group_by(proposals, unit), households = n_distinct(hh_id), proposals = n_distinct(proposal_id)), 5, wt=proposals), -proposals)[2,1].
proposals %>%
select(hh_id, fiscal_year, proposal_id, ask_made, disqualified, gift_made, canceled, turned_down, in_progress) %>%
distinct() %>%
group_by(fiscal_year) %>%
summarise(households = n_distinct(hh_id),
proposals = n_distinct(proposal_id),
ask_made = sum(ask_made),
disqualified = sum(disqualified),
gift_made = sum(gift_made),
canceled = sum(canceled),
turned_down = sum(turned_down),
in_progress = sum(in_progress)) %>%
mutate(households = scales::comma(households),
proposals = scales::comma(proposals)) %>%
kable(col.names = c("Fiscal Year", "Households", "Solicitation Plans",
"Ask Made", "Disqualified", "Gift Made", "Canceled", "Turned Down", "In Progress"), align = 'l') %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left") %>%
add_header_above(header = c(" " = 4, "Outcomes" = 5))
proposals %>%
group_by(unit) %>%
summarise(households = n_distinct(hh_id), proposals = n_distinct(proposal_id)) %>%
top_n(5, wt=proposals) %>%
arrange(-proposals) %>%
mutate(households = scales::comma(households),
proposals = scales::comma(proposals)) %>%
kable(col.names = c("Unit", "Households", "Solicitation Plans"), align = 'l') %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
The following tables look at only solicitation plans where an ask was made.
proposals %>%
filter(ask_amt > 0) %>%
select(entity_id, hh_id, fiscal_year, proposal_id, unit, ask_amt, gift) %>%
group_by(hh_id, fiscal_year, proposal_id, unit) %>%
summarise(ask_amt = max(ask_amt), gift = max(gift)) %>%
group_by(fiscal_year) %>%
summarise(households = n_distinct(hh_id), asks = n_distinct(proposal_id), median_ask = median(ask_amt)) %>%
mutate(median_ask = scales::dollar(median_ask)) %>%
kable(col.names = c("Fiscal Year", "Households", "Asks", "Median Ask"), align = 'l') %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
proposals %>%
filter(ask_amt > 0) %>%
select(entity_id, hh_id, fiscal_year, proposal_id, unit, ask_amt, gift) %>%
group_by(hh_id, fiscal_year, proposal_id, unit) %>%
summarise(ask_amt = max(ask_amt), gift = max(gift)) %>%
group_by(unit) %>%
summarise(households = n_distinct(hh_id), asks = n_distinct(proposal_id), median_ask = median(ask_amt)) %>%
top_n(5, wt=asks) %>%
arrange(-asks) %>%
mutate(households = scales::comma(households),
asks = scales::comma(asks),
median_ask = scales::dollar(median_ask)) %>%
kable(col.names = c("Unit", "Households", "Asks", "Median Ask"), align = 'l') %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
Gifts
r msa_name r school_name households have made r comma(n_distinct(gifts$cads_giving_receipt_nbr)) gifts between r format(as.Date(as.character(from), "%Y%m%d"), "%B %d, %Y") and r format(as.Date(as.character(to), "%Y%m%d"), "%B %d, %Y"). r arrange(top_n(summarise(group_by(gifts, area_of_giving), households = n_distinct(hh_id), gifts = n_distinct(cads_giving_receipt_nbr)), 5, wt=gifts), -gifts)[1,1] has received the most gifts, followed by r arrange(top_n(summarise(group_by(gifts, area_of_giving), households = n_distinct(hh_id), gifts = n_distinct(cads_giving_receipt_nbr)), 5, wt=gifts), -gifts)[2,1].
gifts %>%
group_by(hh_id, fiscal_year, cads_giving_receipt_nbr, area_of_giving) %>%
summarise(gift_amt = max(gift_amt)) %>%
group_by(fiscal_year) %>%
summarise(households = n_distinct(hh_id), gifts = n_distinct(cads_giving_receipt_nbr), total_giving = sum(gift_amt), median_gift = median(gift_amt)) %>%
mutate(total_giving = scales::dollar(total_giving), median_gift = scales::dollar(median_gift)) %>%
mutate(households = scales::comma(households), gifts = scales::comma(gifts)) %>%
kable(col.names = c("Fiscal Year", "Households", "Gifts", "Total Giving", "Median Gift"), align = 'l') %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
gifts %>%
group_by(hh_id, fiscal_year, cads_giving_receipt_nbr, area_of_giving) %>%
summarise(gift_amt = max(gift_amt)) %>%
group_by(area_of_giving) %>%
summarise(households = n_distinct(hh_id), gifts = n_distinct(cads_giving_receipt_nbr), total_giving = sum(gift_amt), median_gift = median(gift_amt)) %>%
top_n(5, wt=gifts) %>%
arrange(-gifts) %>%
mutate(total_giving = scales::dollar(total_giving), median_gift = scales::dollar(median_gift)) %>%
mutate(households = scales::comma(households), gifts = scales::comma(gifts)) %>%
kable(col.names = c("Unit", "Households", "Gifts", "Total Giving", "Median Gift"), align = 'l') %>%
kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
cwolfsonseeley/regionalreports documentation built on June 27, 2019, 10:12 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
knitr::opts_chunk$set(echo = TRUE)
model_format <- function(desc, type) { replacement_value <- switch (type, mgs = "No Major Gift Score", ics = "No Implied Capacity Score", stop("type must be 'mgs' or 'ics'") ) desc[is.na(desc)] <- replacement_value factor(desc, levels = c("Most Likely", "More Likely", "Somewhat Likely", "Less Likely", "Least Likely", replacement_value)) }
knitr::include_graphics("R:/Prospect Development/Prospect Development/Letterhead Templates/UDAR_PD/Prospect Development banner_portrait.jpg")
r school_name r msa_name Analysis
r format(Sys.time(), "%B %d, %Y")
library(getcdw) library(dplyr) library(ggplot2) library(knitr) library(scales) library(kableExtra) library(tidyr) knitr::opts_chunk$set(echo = TRUE) ## set up the functions region_and_school <- function(school_code, msa) { region_and_school_query <- getcdw::parameterize_template("R:/Prospect Development/Prospect Analysis/regionalreports/sql/region_and_school/region_and_school.sql") getcdw::get_cdw(region_and_school_query(school_code = school_code, msa = msa)) } imp_cap <- function(school_code, msa) { imp_cap_query <- getcdw::parameterize_template("R:/Prospect Development/Prospect Analysis/regionalreports/sql/region_and_school/imp_cap.sql") getcdw::get_cdw(imp_cap_query(school_code = school_code, msa = msa)) } mgs <- function(school_code, msa) { mgs_query <- getcdw::parameterize_template("R:/Prospect Development/Prospect Analysis/regionalreports/sql/region_and_school/mgs.sql") getcdw::get_cdw(mgs_query(school_code = school_code, msa = msa)) } events <- function(school_code, msa, from, to) { events_query <- getcdw::parameterize_template("R:/Prospect Development/Prospect Analysis/regionalreports/sql/region_and_school/events.sql") getcdw::get_cdw(events_query(school_code = school_code, msa = msa, from = from, to = to)) } visits <- function(school_code, msa, from, to) { visits_query <- getcdw::parameterize_template("R:/Prospect Development/Prospect Analysis/regionalreports/sql/region_and_school/visits.sql") getcdw::get_cdw(visits_query(school_code = school_code, msa = msa, from = from, to = to)) } gifts <- function(school_code, msa, from, to) { gifts_query <- getcdw::parameterize_template("R:/Prospect Development/Prospect Analysis/regionalreports/sql/region_and_school/gifts.sql") getcdw::get_cdw(gifts_query(school_code = school_code, msa = msa, from = from, to = to)) } proposals <- function(school_code, msa, from, to) { proposals_query <- getcdw::parameterize_template("R:/Prospect Development/Prospect Analysis/regionalreports/sql/region_and_school/proposals.sql") getcdw::get_cdw(proposals_query(school_code = school_code, msa = msa, from = from, to = to)) } ## get the data prospects <- region_and_school(school_code = school_code, msa = msa) prospects$capacity_rating_code <- as.numeric(prospects$capacity_rating_code) prospects$pref_class_year <- as.numeric(prospects$pref_class_year) prospects <- prospects %>% mutate(age = ifelse(!is.na(birth_year), 2018-birth_year, 2040-pref_class_year)) %>% mutate(decade = cut(age, breaks = c(20, 30, 40, 50, 60, 70, 80, 90, Inf), labels = c("20-29", "30-39", "40-49", "50-59", "60-69", "70-79", "80-89", "Over 90"), include.lowest = TRUE, right = FALSE)) %>% select(-pref_class_year, -birth_year, -age) imp_cap <- imp_cap(school_code = school_code, msa = msa) mgs <- mgs(school_code = school_code, msa = msa) events <- events(school_code = school_code, msa = msa, from = from, to = to) visits <- visits(school_code = school_code, msa = msa, from = from, to = to) gifts <- gifts(school_code = school_code, msa = msa, from = from, to = to) proposals <- proposals(school_code = school_code, msa = msa, from = from, to = to) ## create table that allows capacity descriptions to be ordered numerically cap_match <- prospects %>% select(capacity_rating_code, capacity_rating_desc) %>% distinct() ## rating by major gift score table capacity_mgs_table <- prospects %>% mutate(capacity_rating_desc = ifelse(is.na(capacity_rating_desc), "Not Rated", capacity_rating_desc)) %>% left_join(mgs, by = "hh_id") %>% select(hh_id, capacity_rating_desc, major_gift_description) %>% distinct() %>% mutate(major_gift_description = model_format(major_gift_description, 'mgs')) %>% group_by(capacity_rating_desc, major_gift_description) %>% summarise(households = n_distinct(hh_id)) %>% spread(major_gift_description, households) %>% left_join(cap_match, by = "capacity_rating_desc") %>% arrange(capacity_rating_code) %>% select(-capacity_rating_code) %>% replace(is.na(.), 0) %>% janitor::adorn_totals(c("row", "col")) colnames(capacity_mgs_table)[colnames(capacity_mgs_table)=="capacity_rating_desc"] <- "Capacity Rating" ## ics by major gift score table ics_mgs_table <- prospects %>% filter(is.na(capacity_rating_code)) %>% select(hh_id) %>% left_join(imp_cap, by = "hh_id") %>% left_join(mgs, by = "hh_id") %>% select(hh_id, implied_capacity_description, major_gift_description) %>% mutate(implied_capacity_description = model_format(implied_capacity_description, 'ics')) %>% mutate(major_gift_description = model_format(major_gift_description, 'mgs')) %>% group_by(implied_capacity_description, major_gift_description) %>% summarise(households = n_distinct(hh_id)) %>% spread(major_gift_description, households) %>% replace(is.na(.), 0) %>% janitor::adorn_totals(c("row", "col")) colnames(ics_mgs_table)[colnames(ics_mgs_table)=="implied_capacity_description"] <- "Implied Capacity Score" ics_mgs_table[is.na(ics_mgs_table)] <- 0 ## record type summary record_type <- prospects %>% group_by(record_type_desc) %>% summarise(entities = n_distinct(entity_id)) %>% arrange(-entities) ## age summary age <- prospects %>% filter(!is.na(decade)) %>% group_by(decade) %>% summarise(entities = n_distinct(entity_id)) ## school summary school <- prospects %>% filter(!is.na(pref_school_desc)) %>% group_by(pref_school_desc) %>% summarise(entities = n_distinct(entity_id)) %>% top_n(5, entities) %>% arrange(-entities) ## rating summary rated <- prospects %>% mutate(capacity_rating = ifelse(is.na(capacity_rating_desc), "Not Rated", capacity_rating_desc)) %>% group_by(capacity_rating, capacity_rating_code) %>% summarise(households = n_distinct(hh_id)) %>% arrange(capacity_rating_code) ## proposals summary proposals <- proposals %>% mutate(ask_made = ifelse(ask_amt > 0, 1, 0), disqualified = ifelse(stage_desc == "Disqualified", 1, 0), gift_made = ifelse(gift > 0, 1, 0), canceled = ifelse(stage_desc == "Canceled", 1, 0), turned_down = ifelse(stage_desc == "Turned Down", 1, 0)) %>% mutate(in_progress = ifelse(is.na(commit_turndown_date) & ((disqualified + gift_made + canceled + turned_down) == 0), 1, 0)) %>% mutate(canceled = ifelse((!is.na(commit_turndown_date) & stage_desc %in% c("Qualification", "Cultivation", "Proposal Development")), 1, canceled))
Introduction
This analysis looks at all alumni and current parents of students in r school_name in the r msa_name area. The time period included is from r format(as.Date(as.character(from), "%Y%m%d"), "%B %d, %Y") to r format(as.Date(as.character(to), "%Y%m%d"), "%B %d, %Y").
There are currently r comma(n_distinct(prospects$entity_id)) alumni and current parents of students in r school_name in the r msa_name area, comprising r comma(n_distinct(prospects$hh_id)) households.
Demographics
r percent(as.numeric(record_type[1,2]/n_distinct(prospects$entity_id))) of r msa_name area alumni and current parents of students in r school_name have a record type of r record_type[1,1], r percent(as.numeric(record_type[2,2]/n_distinct(prospects$entity_id))) have a record type of r record_type[2,1], and r percent(as.numeric(record_type[3,2]/n_distinct(prospects$entity_id))) have a record type of r record_type[3,1]. Note that these percentages do not add up to 100% since each entity may have multiple record types.
record_type %>% filter(record_type_desc %in% c("UCB Parent of Current Student", "Alum: Undergrad", "Alum: Grad")) %>% kable(col.names = c("Record Type", "Entities*"), format.args = list(big.mark = ","), align = 'l') %>% kable_styling(bootstrap_options = "striped", full_width = F, position = "left") %>% footnote(symbol = "Each entity may have multiple record types" )
Age has been determined by birth date if available and estimated by class year if not. Alumni are most likely to be r arrange(top_n(age, 2), -entities)[1,1] years old (r percent(as.numeric(arrange(top_n(age, 2), -entities)[1,2]/sum(age$entities)))), with the next most common age being r arrange(top_n(age, 2), -entities)[2,1] (r percent(as.numeric(arrange(top_n(age, 2), -entities)[2,2]/sum(age$entities)))).
age %>% ggplot(aes(x=decade, y=entities)) + geom_bar(stat = "identity") + theme_bw() + theme(rect = element_blank(), axis.ticks = element_blank()) + ylab(NULL) + xlab(NULL) + scale_y_continuous(labels = comma) + ggtitle("Entities by Age")
Most alumni are graduates of r school[1,1], followed by r school[2,1] and r school[3,1]. The following table displays the top five schools represented.
school %>% kable(col.names = c("School", "Entities"), format.args = list(big.mark = ","), align = 'l') %>% kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
Ratings
r percent(as.numeric(1-filter(rated, capacity_rating == "Not Rated")[1,3]/sum(rated$households))) of r msa_name r school_name households have been rated. Of those, r percent(as.numeric(sum(filter(rated, capacity_rating_code %in% c(1:9))$households)/sum(filter(rated, capacity_rating_code %in% c(1:14))$households))) are rated 250K+ or higher.
rated %>% filter(capacity_rating != "Not Rated") %>% ggplot(aes(x=reorder(capacity_rating, capacity_rating_code), y=households)) + geom_bar(stat = "identity") + theme_bw() + theme(rect = element_blank(), axis.ticks = element_blank()) + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + ylab(NULL) + xlab(NULL) + scale_y_continuous(labels = comma) + ggtitle("Households by Capacity Rating")
The following table looks at the breakdown of each capacity rating by Major Gift Score. The Major Gift Score is calculated for all undergraduate degree holders.
capacity_mgs_table %>% kable(format.args = list(big.mark = ","), align = 'l') %>% kable_styling(bootstrap_options = "striped", full_width = F, position = "left") %>% add_header_above( header = c(" " = 1, "Major Gift Score" = ncol(capacity_mgs_table) - 2, " " = 1))
For unrated households only, the following table looks at the breakdown of Implied Capacity Score and Major Gift Score.
ics_mgs_table %>% kable(format.args = list(big.mark = ","), align = 'l') %>% kable_styling(bootstrap_options = "striped", full_width = F, position = "left") %>% add_header_above( header = c(" " = 1, "Major Gift Score" = ncol(ics_mgs_table) - 2, " " = 1))
Events
There have been r comma(n_distinct(events$activity_code)) events attended by r msa_name r school_name households between r format(as.Date(as.character(from), "%Y%m%d"), "%B %d, %Y") and r format(as.Date(as.character(to), "%Y%m%d"), "%B %d, %Y"). r arrange(top_n(summarise(group_by(events, unit_code_desc), households = n_distinct(hh_id), events = n_distinct(activity_code)), 5, wt=events), -events)[1,1] has held the most events, followed by r arrange(top_n(summarise(group_by(events, unit_code_desc), households = n_distinct(hh_id), events = n_distinct(activity_code)), 5, wt=events), -events)[2,1].
events %>% group_by(fiscal_year) %>% summarise(households = n_distinct(hh_id), events = n_distinct(activity_code)) %>% mutate(households = scales::comma(households)) %>% kable(col.names = c("Fiscal Year", "Households", "Events"), align = 'l') %>% kable_styling(bootstrap_options = "striped", full_width = F, position = "left") events %>% group_by(unit_code_desc) %>% summarise(households = n_distinct(hh_id), events = n_distinct(activity_code)) %>% top_n(5, wt=events) %>% arrange(-events) %>% mutate(households = scales::comma(households)) %>% kable(col.names = c("Unit", "Households", "Events"), align = 'l') %>% kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
Visits
There have been r comma(n_distinct(visits$report_id)) visits to r msa_name r school_name households between r format(as.Date(as.character(from), "%Y%m%d"), "%B %d, %Y") and r format(as.Date(as.character(to), "%Y%m%d"), "%B %d, %Y"). r arrange(top_n(summarise(group_by(visits, unit_desc), households = n_distinct(hh_id), visits = n_distinct(report_id)), 5, wt=visits), -visits)[1,1] has made the most visits, followed by r arrange(top_n(summarise(group_by(visits, unit_desc), households = n_distinct(hh_id), visits = n_distinct(report_id)), 5, wt=visits), -visits)[2,1].
visits %>% group_by(fiscal_year) %>% summarise(households = n_distinct(hh_id), visits = n_distinct(report_id)) %>% kable(col.names = c("Fiscal Year", "Households", "Visits"), align = 'l') %>% kable_styling(bootstrap_options = "striped", full_width = F, position = "left") visits %>% group_by(unit_desc) %>% summarise(households = n_distinct(hh_id), visits = n_distinct(report_id)) %>% top_n(5, wt=visits) %>% arrange(-visits) %>% kable(col.names = c("Unit", "Households", "Visits"), align = 'l') %>% kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
Solicitation Plans
There have been r comma(n_distinct(proposals$proposal_id)) solicitation plans involving r msa_name r school_name households between r format(as.Date(as.character(from), "%Y%m%d"), "%B %d, %Y") and r format(as.Date(as.character(to), "%Y%m%d"), "%B %d, %Y"). r arrange(top_n(summarise(group_by(proposals, unit), households = n_distinct(hh_id), proposals = n_distinct(proposal_id)), 5, wt=proposals), -proposals)[1,1] has the most assignments, followed by r arrange(top_n(summarise(group_by(proposals, unit), households = n_distinct(hh_id), proposals = n_distinct(proposal_id)), 5, wt=proposals), -proposals)[2,1].
proposals %>% select(hh_id, fiscal_year, proposal_id, ask_made, disqualified, gift_made, canceled, turned_down, in_progress) %>% distinct() %>% group_by(fiscal_year) %>% summarise(households = n_distinct(hh_id), proposals = n_distinct(proposal_id), ask_made = sum(ask_made), disqualified = sum(disqualified), gift_made = sum(gift_made), canceled = sum(canceled), turned_down = sum(turned_down), in_progress = sum(in_progress)) %>% mutate(households = scales::comma(households), proposals = scales::comma(proposals)) %>% kable(col.names = c("Fiscal Year", "Households", "Solicitation Plans", "Ask Made", "Disqualified", "Gift Made", "Canceled", "Turned Down", "In Progress"), align = 'l') %>% kable_styling(bootstrap_options = "striped", full_width = F, position = "left") %>% add_header_above(header = c(" " = 4, "Outcomes" = 5)) proposals %>% group_by(unit) %>% summarise(households = n_distinct(hh_id), proposals = n_distinct(proposal_id)) %>% top_n(5, wt=proposals) %>% arrange(-proposals) %>% mutate(households = scales::comma(households), proposals = scales::comma(proposals)) %>% kable(col.names = c("Unit", "Households", "Solicitation Plans"), align = 'l') %>% kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
The following tables look at only solicitation plans where an ask was made.
proposals %>% filter(ask_amt > 0) %>% select(entity_id, hh_id, fiscal_year, proposal_id, unit, ask_amt, gift) %>% group_by(hh_id, fiscal_year, proposal_id, unit) %>% summarise(ask_amt = max(ask_amt), gift = max(gift)) %>% group_by(fiscal_year) %>% summarise(households = n_distinct(hh_id), asks = n_distinct(proposal_id), median_ask = median(ask_amt)) %>% mutate(median_ask = scales::dollar(median_ask)) %>% kable(col.names = c("Fiscal Year", "Households", "Asks", "Median Ask"), align = 'l') %>% kable_styling(bootstrap_options = "striped", full_width = F, position = "left") proposals %>% filter(ask_amt > 0) %>% select(entity_id, hh_id, fiscal_year, proposal_id, unit, ask_amt, gift) %>% group_by(hh_id, fiscal_year, proposal_id, unit) %>% summarise(ask_amt = max(ask_amt), gift = max(gift)) %>% group_by(unit) %>% summarise(households = n_distinct(hh_id), asks = n_distinct(proposal_id), median_ask = median(ask_amt)) %>% top_n(5, wt=asks) %>% arrange(-asks) %>% mutate(households = scales::comma(households), asks = scales::comma(asks), median_ask = scales::dollar(median_ask)) %>% kable(col.names = c("Unit", "Households", "Asks", "Median Ask"), align = 'l') %>% kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
Gifts
r msa_name r school_name households have made r comma(n_distinct(gifts$cads_giving_receipt_nbr)) gifts between r format(as.Date(as.character(from), "%Y%m%d"), "%B %d, %Y") and r format(as.Date(as.character(to), "%Y%m%d"), "%B %d, %Y"). r arrange(top_n(summarise(group_by(gifts, area_of_giving), households = n_distinct(hh_id), gifts = n_distinct(cads_giving_receipt_nbr)), 5, wt=gifts), -gifts)[1,1] has received the most gifts, followed by r arrange(top_n(summarise(group_by(gifts, area_of_giving), households = n_distinct(hh_id), gifts = n_distinct(cads_giving_receipt_nbr)), 5, wt=gifts), -gifts)[2,1].
gifts %>% group_by(hh_id, fiscal_year, cads_giving_receipt_nbr, area_of_giving) %>% summarise(gift_amt = max(gift_amt)) %>% group_by(fiscal_year) %>% summarise(households = n_distinct(hh_id), gifts = n_distinct(cads_giving_receipt_nbr), total_giving = sum(gift_amt), median_gift = median(gift_amt)) %>% mutate(total_giving = scales::dollar(total_giving), median_gift = scales::dollar(median_gift)) %>% mutate(households = scales::comma(households), gifts = scales::comma(gifts)) %>% kable(col.names = c("Fiscal Year", "Households", "Gifts", "Total Giving", "Median Gift"), align = 'l') %>% kable_styling(bootstrap_options = "striped", full_width = F, position = "left") gifts %>% group_by(hh_id, fiscal_year, cads_giving_receipt_nbr, area_of_giving) %>% summarise(gift_amt = max(gift_amt)) %>% group_by(area_of_giving) %>% summarise(households = n_distinct(hh_id), gifts = n_distinct(cads_giving_receipt_nbr), total_giving = sum(gift_amt), median_gift = median(gift_amt)) %>% top_n(5, wt=gifts) %>% arrange(-gifts) %>% mutate(total_giving = scales::dollar(total_giving), median_gift = scales::dollar(median_gift)) %>% mutate(households = scales::comma(households), gifts = scales::comma(gifts)) %>% kable(col.names = c("Unit", "Households", "Gifts", "Total Giving", "Median Gift"), align = 'l') %>% kable_styling(bootstrap_options = "striped", full_width = F, position = "left")
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.