Example Template: State Summary Table for Alabama

2.19.2019
Deondre' Jones

More from this project:

  1. library(httr)
  2. library(tidyverse)
  3. library(stringr)
  4. library(RCurl)
  5. library(reshape2)
  6. library(RColorBrewer)
  7. library(extrafont)
  8. library(knitr)
  9. library(foreign)
  10. library(kableExtra)
  11. library(grid)
  12. library(gridExtra)
  13.  
  14. stateparam <- "AL"
  15. yearparam <- "2015"
  16.  
  17.  
  18. #source('https://raw.githubusercontent.com/UrbanInstitute/urban_R_theme/master/urban_theme_windows.R')
  19.  
  20. #Import reduced NCCS Core File Function
  21. prepbmffile <- function(bmffilepath) {
  22.   output <- read_csv(bmffilepath,
  23.                      col_types = cols_only(EIN = col_character(),
  24.                                            NTEECC = col_character(),
  25.                                            STATE = col_character(),                                         
  26.                                            OUTNCCS = col_character(),
  27.                                            SUBSECCD = col_character(),
  28.                                            FNDNCD = col_character(),
  29.                                            CFILER = col_character(),
  30.                                            CZFILER = col_character(),
  31.                                            CTAXPER = col_character(),
  32.                                            CTOTREV = col_double(),
  33.                                            CASSETS = col_double()
  34.                      ))
  35.   names(output) <- toupper(names(output))
  36.   return(output)
  37. }
  38.  
  39. #Pull in first BMF from next year to get most complete picture at end of previous year
  40. bmf2015 <- prepbmffile("bmf.bm1608.csv")
  41. bmf2005 <- prepbmffile("bmf.bm0601.csv") 
  42.  
  43. #Pull state name for selected state
  44. stname <- state.name[grep(as.character(stateparam), state.abb)]
  45.  
  46. #replace for DC
  47. if (stateparam =="DC") {stname <- "Washington, DC"}

Number of Nonprofit Organizations in Alabama, 2005 - 2015

  1. OverallT <- function(datayear) {
  2.  
  3.   #Function to pull both years of BMF data
  4.   byear <- function(datayear) {
  5.  
  6.     #get BMF file names:
  7.     bmf1 <- as.character(paste("bmf", (datayear -10), sep =""))
  8.     bmf2 <- as.character(paste("bmf", (datayear), sep =""))
  9.  
  10.     #for each BMF file name, run the following:
  11.     bcomponent <- function(bmfnum, year_of_int){
  12.  
  13.       #get dataset  
  14.       bmf <- get(bmfnum)
  15.  
  16.       #filter by state
  17.       bmf<- bmf %>%
  18.         filter(STATE == as.character(stateparam))
  19.  
  20.       #filter out out-of-scope cases
  21.       bmf<- bmf %>%
  22.         filter(OUTNCCS != "OUT")
  23.  
  24.       #calculate all registered nonprofits
  25.       all <- bmf %>%
  26.         summarize(
  27.           pop = "All registered nonprofits",
  28.           year = n()) 
  29.  
  30.       #calculate all public charities
  31.       pc <- bmf %>%  
  32.         filter((FNDNCD != "02" & FNDNCD!= "03" & FNDNCD != "04"), (SUBSECCD == "03")) %>%
  33.         summarize(
  34.           pop = "All 501(c)(3) public charities",
  35.           year = n())
  36.  
  37.       #calculate all active public charities
  38.       pcact <- bmf %>%  
  39.         filter((FNDNCD != "02" & FNDNCD!= "03" & FNDNCD != "04"), (SUBSECCD == "03")) %>%
  40.         filter(CFILER == "Y" & CZFILER =="N") %>%
  41.         summarize(
  42.           pop = "Reporting public charities",
  43.           year = n())
  44.  
  45.       #calculate all active supporting public charities
  46.       pcacts <- bmf %>%  
  47.         filter((FNDNCD != "02" & FNDNCD!= "03" & FNDNCD != "04"), (SUBSECCD == "03")) %>%
  48.         filter(CFILER == "Y" & CZFILER =="N") %>%
  49.         filter(str_sub(NTEECC,2,3) %in% c("11", "12")|
  50.                str_sub(NTEECC,1,2) %in% c("T2", "T3", "T6", "T7", "T9")) %>%
  51.         summarize(
  52.           pop = "Supporting public charities",
  53.           year = n())
  54.  
  55.       #calculate all active operating public charities
  56.       pcacto <- bmf %>%  
  57.         filter((FNDNCD != "02" & FNDNCD!= "03" & FNDNCD != "04"), (SUBSECCD == "03")) %>%
  58.         filter(CFILER == "Y" & CZFILER =="N") %>%
  59.         filter(!str_sub(NTEECC,2,3) %in% c("11", "12") &
  60.                  !str_sub(NTEECC,1,2) %in% c("T2", "T3", "T6", "T7", "T9")) %>%
  61.         summarize(
  62.           pop = "Operating public charities",
  63.           year = n())
  64.  
  65.       #calculate all non-reporting public charities
  66.       pcnact <- bmf %>%  
  67.         filter((FNDNCD != "02" & FNDNCD!= "03" & FNDNCD != "04"), (SUBSECCD == "03")) %>%
  68.         filter(CFILER == "N" |(CFILER =="Y" & CZFILER =="Y")) %>%
  69.         summarize(
  70.           pop = "Non-reporting, or with less than $50,000 in Gross Receipts",
  71.           year = n())
  72.  
  73.       #calculate all private foundations
  74.       pf <- bmf %>%  
  75.         filter((FNDNCD == "02" | FNDNCD== "03" | FNDNCD == "04"), (SUBSECCD == "03")) %>%
  76.         summarize(
  77.           pop = "All 501(c)(3) private foundations",
  78.           year = n())
  79.  
  80.       #calculate all non-operating foundations
  81.       pfno <- bmf %>%  
  82.         filter((FNDNCD == "04"), (SUBSECCD == "03")) %>%
  83.         summarize(
  84.           pop = "Private Grantmaking (Non-Operating) Foundations",
  85.           year = n())
  86.  
  87.       #calculate all operating foundations
  88.       pfo <- bmf %>%  
  89.         filter((FNDNCD == "02" | FNDNCD== "03"), (SUBSECCD == "03")) %>%
  90.         summarize(
  91.           pop = "Private Operating Foundations",
  92.           year = n())
  93.  
  94.       #calculate all other 501(c) roganizations
  95.       co <- bmf %>%  
  96.         filter((SUBSECCD != "03")) %>%
  97.         summarize(
  98.           pop = "All other 501(c) Nonprofit Organizations",
  99.           year = n())
  100.  
  101.       #calculate Civic leagues, social welfare orgs, etc.
  102.       co4 <- bmf %>%  
  103.         filter((SUBSECCD == "04")) %>%
  104.         summarize(
  105.           pop = "Civic leagues, social welfare orgs, etc.",
  106.           year = n())
  107.  
  108.       #calculate Fraternal beneficiary societies
  109.       co8 <- bmf %>%  
  110.         filter((SUBSECCD == "08")) %>%
  111.         summarize(
  112.           pop = "Fraternal beneficiary societies",
  113.           year = n())
  114.  
  115.       #calculate Business leagues, chambers of commerce, etc.
  116.       co6 <- bmf %>%  
  117.         filter((SUBSECCD == "06")) %>%
  118.         summarize(
  119.           pop = "Business leagues, chambers of commerce, etc.",
  120.           year = n())
  121.  
  122.       #calculate Labor, agricultural, horticultural orgs
  123.       co5 <- bmf %>%  
  124.         filter((SUBSECCD == "05")) %>%
  125.         summarize(
  126.           pop = "Labor, agricultural, horticultural orgs",
  127.           year = n())
  128.  
  129.       #calculate Social and recreational clubs
  130.       co7 <- bmf %>%  
  131.         filter((SUBSECCD == "07")) %>%
  132.         summarize(
  133.           pop = "Social and recreational clubs",
  134.           year = n())
  135.  
  136.       #calculate Post or organization of war veterans
  137.       co19 <- bmf %>%  
  138.         filter((SUBSECCD == "19")) %>%
  139.         summarize(
  140.           pop = "Post or organization of war veterans",
  141.           year = n())
  142.  
  143.       #calculate All Other Nonprofit Organizations
  144.       cooth <- bmf %>%  
  145.         filter((!SUBSECCD %in% c("03", "04", "08", "06", "05", "07","19"))) %>%
  146.         summarize(
  147.           pop = "Other Nonprofit Organizations",
  148.           year = n())
  149.  
  150.       #combine all data points
  151.       combined <- rbind(pc, pcact, pcacts, pcacto, pcnact, pf, pfno, pfo, co, co4, co8, co6, co5, co7, co19, cooth,all)
  152.  
  153.       #calculate percentages of all orgs
  154.       combined <- combined %>%
  155.         mutate(PctofAll = round((year/year[1])*100, digits=2))     
  156.  
  157.       #rename columns (with years)
  158.       colnames(combined) <- c("Nonprofit Type", 
  159.                               paste("# of Orgs:", as.character(year_of_int, sep = " ")),
  160.                               paste("% of All Orgs:", as.character(year_of_int, sep = " ")))
  161.  
  162.       #return combined file
  163.       return(combined)
  164.     }
  165.  
  166.     #run for each of 2 bmf years
  167.     bcomp1 <-bcomponent(bmf1, (datayear -10))
  168.     bcomp2 <-bcomponent(bmf2, datayear)
  169.  
  170.     #merge years
  171.     total <- bcomp1 %>%
  172.       left_join(bcomp2, by = "Nonprofit Type")
  173.  
  174.     #return combined file with both years
  175.     return(total)
  176.   }
  177.  
  178.   #run against year of interest:
  179.   btable<- byear(datayear)
  180.  
  181.   btable<- as.data.frame(btable)
  182.  
  183.   #calculate percentage change column
  184.   btable <- btable %>%
  185.     mutate( "Pct Change" = round(((btable[, 4] - btable[, 2])/(btable[, 2]))*100, digits=2))
  186.  
  187.   #add state name to final table
  188.   colnames(btable)[1] <- paste("Nonprofit Organizations in ", as.character(stname), sep ="")
  189.  
  190.  
  191.   #return final output
  192.   return(btable)
  193. }
  194.  
  195. #Generate output table
  196. kable(OverallT(as.integer(yearparam)), 
  197.       "html",
  198.       format.args = list(decimal.mark = '.', big.mark = ","),
  199.       align = "lccccc") %>%
  200.   kable_styling("hover", full_width = F) %>%
  201.   row_spec(17, bold = T, underline = T ) %>%
  202.   row_spec(c(1,6,9), bold = T) %>%
  203.   row_spec(c(3,4), italic = T) %>%
  204.   group_rows("Public Charities",1,5) %>%
  205.   group_rows("Private Foundations",6,8) %>%
  206.   group_rows("Other Organiations", 9,16) %>%
  207.   group_rows("Total", 17,17) %>%
  208.   #add_indent(c(3:6,8,9,11:17)) %>%
  209.   add_indent(c(3:4)) %>%
  210.   footnote(general = paste("Internal Revenue Service Business Master Files, Exempt Organizations (", as.integer(as.integer(yearparam)-9), ", ", as.integer(as.integer(yearparam)+1), ")", sep=""),
  211.            general_title = "Source ", 
  212.            title_format = "bold",
  213.            footnote_as_chunk = TRUE)
Nonprofit Organizations in Alabama # of Orgs: 2005 % of All Orgs: 2005 # of Orgs: 2015 % of All Orgs: 2015 Pct Change
Public Charities
All 501(c)(3) public charities 10,797 100.00 14,471 100.00 34.03
Reporting public charities 3,707 34.33 4,436 30.65 19.67
Supporting public charities 518 4.80 604 4.17 16.60
Operating public charities 3,189 29.54 3,832 26.48 20.16
Non-reporting, or with less than $50,000 in Gross Receipts 7,090 65.67 10,035 69.35 41.54
Private Foundations
All 501(c)(3) private foundations 1,115 10.33 1,172 8.10 5.11
Private Grantmaking (Non-Operating) Foundations 1,075 9.96 1,100 7.60 2.33
Private Operating Foundations 40 0.37 72 0.50 80.00
Other Organiations
All other 501(c) Nonprofit Organizations 6,574 60.89 4,934 34.10 -24.95
Civic leagues, social welfare orgs, etc. 1,425 13.20 996 6.88 -30.11
Fraternal beneficiary societies 1,190 11.02 632 4.37 -46.89
Business leagues, chambers of commerce, etc. 911 8.44 831 5.74 -8.78
Labor, agricultural, horticultural orgs 784 7.26 522 3.61 -33.42
Social and recreational clubs 781 7.23 700 4.84 -10.37
Post or organization of war veterans 425 3.94 302 2.09 -28.94
Other Nonprofit Organizations 1,058 9.80 951 6.57 -10.11
Total
All registered nonprofits 18,486 171.21 20,577 142.19 11.31
Source Internal Revenue Service Business Master Files, Exempt Organizations (2006, 2016) 
  1. #Create NTEE grouping categories
  2. arts <- c("A")
  3. highered <- c("B4", "B5")
  4. othered <- c("B")
  5. envanimals <- c("C", "D")
  6. hospitals <- c('E20','E21','E22','E23','E24','F31','E30','E31','E32')
  7. otherhlth <- c("E", "F", "G", "H")
  8. humanserv <- c("I", "J", "K", "L", "M", "N", "O", "P")
  9. intl <- c("Q")
  10. pubben <- c("R", "S", "T", "U", "V", "W", "Y", "Z")
  11. relig <- c("X")
  12.  
  13. #define function to join NTEE Master list and categorize organizations accordingly
  14. NTEEclassify <- function(dataset) {
  15.   #create NTEEGRP classifications
  16.   dataset$NTEEGRP <- "  "
  17.   dataset$NTEEGRP[str_sub(dataset$NTEECC,1,1) %in% arts ] <- "Arts"
  18.   dataset$NTEEGRP[str_sub(dataset$NTEECC,1,1) %in% othered ] <- "Other Education"
  19.   dataset$NTEEGRP[str_sub(dataset$NTEECC,1,2) %in% highered ] <- "Higher Education"
  20.   dataset$NTEEGRP[str_sub(dataset$NTEECC,1,1) %in% envanimals] <- "Environment and Animals"
  21.   dataset$NTEEGRP[str_sub(dataset$NTEECC,1,1) %in% otherhlth] <- "Other Health Care"
  22.   dataset$NTEEGRP[str_sub(dataset$NTEECC,1,3) %in% hospitals] <- "Hospitals and primary care facilities"
  23.   dataset$NTEEGRP[str_sub(dataset$NTEECC,1,1) %in% humanserv] <- "Human Services"
  24.   dataset$NTEEGRP[str_sub(dataset$NTEECC,1,1) %in% intl] <- "International"
  25.   dataset$NTEEGRP[str_sub(dataset$NTEECC,1,1) %in% pubben] <- "Other Public and social benefit"
  26.   dataset$NTEEGRP[str_sub(dataset$NTEECC,1,1) %in% relig] <- "Religion related"
  27.   dataset$NTEEGRP[is.na(dataset$NTEECC)] <- "Other Public and social benefit"
  28.   return(dataset)
  29. }
  30.  
  31. BNorder<- c("Arts","Higher Education", "Other Education", "Environment and Animals",
  32.                "Hospitals and primary care facilities", "Other Health Care", "Human Services",
  33.                "International", "Other Public and social benefit", "Religion related")
  34.  
  35. #Classify most recent BMF by NTEE
  36. bmfNTEE <- NTEEclassify(bmf2015) %>%
  37.   filter(STATE == as.character(stateparam)) %>%
  38.   filter(((CTOTREV>50000)), (OUTNCCS != "OUT"), (FNDNCD != "02" & FNDNCD!= "03" & FNDNCD != "04")) %>%
  39.   group_by(NTEEGRP) %>%
  40.   summarize(Number_of_Orgs = n()) %>%
  41.   mutate(Numbers_PCT = round((Number_of_Orgs/sum(Number_of_Orgs)) *100, digits =1)) %>%
  42.   slice(match(BNorder, NTEEGRP))
  43.  
  44. #make sure plot will be ordered corretly
  45. bmfNTEE$NTEEGRPORDER <- factor(bmfNTEE$NTEEGRP, as.character(bmfNTEE$NTEEGRP))
  46.  
  47. #create figure (note: this is the only essential step, the rest is just styling!)
  48. NTEEFIG <- bmfNTEE %>%
  49.   ggplot(aes(x= NTEEGRPORDER,y= Numbers_PCT)) + 
  50.   geom_col() +
  51.     theme(axis.title.y = element_blank(),
  52.           axis.text.y = element_blank(),
  53.           axis.ticks.y = element_blank(),
  54.           axis.title.x = element_blank(),
  55.           panel.grid = element_blank()) +
  56.   #set bounds of plot
  57.   scale_y_continuous(expand = c(0, 0), limits= c(0,60)) +
  58.   # make sure labels will wrap text
  59.   scale_x_discrete(labels = c("Arts",
  60.                               "Higher\nEducation",
  61.                               "Other\nEducation", 
  62.                               "Environment\nand Animals", 
  63.                               "Hospitals",
  64.                                "Other Health\nCare", 
  65.                               "Human\nServices",
  66.                               "International",
  67.                               "Other  Pub.\n Benefit",
  68.                               "Religion\n Related")) +
  69.   #add text labels to columns
  70.   geom_text(aes(NTEEGRP, Numbers_PCT, label=formatC(Numbers_PCT, format = 'f', digits =1)),
  71.               vjust=-1, 
  72.               position = position_dodge(width=1),
  73.               size =3) 
  74.  
  75.   #Make figure title in Urban Institute style
  76.   Title <- textGrob("FIGURE 1", 
  77.                   x = unit(0, "npc"), 
  78.                   y = unit(0, "npc"),
  79.                   hjust = 0, 
  80.                   vjust = 0,
  81.                   gp = gpar(fontsize = 9, fontfamily = "Lato", col = "#1696d2"))
  82.  
  83.   #Make figure subtitle in Urban Institute Style
  84.   Subtitle <- textGrob(paste("Percent of reporting public charities in ", as.character(stname), " by subsector, ", as.integer(yearparam), sep =""), 
  85.                      x = unit(0, "npc"), 
  86.                      y = unit(0, "npc"),
  87.                      hjust = 0, 
  88.                      vjust = 0,
  89.                      gp = gpar(fontsize = 10, fontfamily = "Lato", fontface = "bold"))
  90.  
  91.   #Add Urban institute Caption
  92.   UrbCaption <- grobTree(
  93.     gp = gpar(fontsize = 8, hjust = 1), 
  94.     textGrob(label = "I N S T I T U T E", 
  95.              name = "caption1",
  96.              x = unit(1, "npc"),  
  97.              y = unit(0, "npc"),
  98.              hjust = 1, 
  99.              vjust = 0),
  100.     textGrob(label = "U R B A N  ", 
  101.              x = unit(1, "npc") - grobWidth("caption1") - unit(0.01, "lines"),         
  102.              y = unit(0, "npc"), 
  103.              hjust = 1, 
  104.              vjust = 0, 
  105.              gp = gpar(col = "#1696d2")))
  106.  
  107.   #Add sources in Urban Institute style
  108.   Sources <- grobTree(
  109.     gp = gpar(fontsize = 8, hjust = 0),
  110.     textGrob(label = paste("Internal Revenue Service Business Master Files, Exempt Organizations (", as.integer(as.integer(yearparam)+1), ")", sep=""), 
  111.              x = unit(0, "npc")+ grobWidth("sources1"),  
  112.              y = unit(0, "npc"),
  113.              hjust = 0, 
  114.              vjust = 0),
  115.     textGrob(label = "Source: ", 
  116.              name = "sources1",
  117.              x = unit(0, "npc") ,         
  118.              y = unit(0, "npc"), 
  119.              hjust = 0, 
  120.              vjust = 0,
  121.              gp = gpar(fontface = "bold")))
  122.  
  123.   #Combine elements
  124.   grid.arrange(Title, Subtitle, NTEEFIG, UrbCaption, Sources, ncol = 1, heights = c(2, 3, 30, 1, .5))