Largest Active and Reporting Arts Public Charities by Expenses

9.13.2018
Deondre' Jones

More from this project:

Largest Active and Reporting Arts Public Charities by Expenses

  1. library(tidyverse)
  2. library(knitr)
  3. library(stringr)
  4. library(scales)
  5. library(httr)
  6. source('https://raw.githubusercontent.com/UrbanInstitute/urban_R_theme/master/urban_theme_windows.R')
  7.  
  8.  
  9. #Create NTEE grouping categories
  10. arts <- c("A")
  11. highered <- c("B4", "B5")
  12. othered <- c("B")
  13. envanimals <- c("C", "D")
  14. hospitals <- c('E20','E21','E22','E23','E24','F31','E30','E31','E32')
  15. otherhlth <- c("E", "F", "G", "H")
  16. humanserv <- c("I", "J", "K", "L", "M", "N", "O", "P")
  17. intl <- c("Q")
  18. pubben <- c("R", "S", "T", "U", "V", "W", "Y", "Z")
  19. relig <- c("X")
  20.  
  21. #link to NCCS Data Archive
  22. nteedoc<- GET("http://nccs-data.urban.org/data/misc/nccs.nteedocAllEins.csv")
  23.  
  24. #pull only the most important columns (EIN, , NTEECC, Nteefinal)
  25. nteedocalleins <-content(nteedoc, type = "text/csv",
  26.                          col_types=cols_only(EIN = col_character(),
  27.                                              NteeCC = col_character(),
  28.                                              NteeFinal = col_character()))
  29.  
  30. #convert variable names to upper case
  31. names(nteedocalleins) <- toupper(names(nteedocalleins))
  32.  
  33. #This function will apply the most common NTEE Grouping categories to your data.
  34. NTEEclassify <- function(dataset) {
  35.   #merge in Master NTEE look up file
  36.   dataset <- dataset %>%
  37.     left_join(nteedocalleins, by = "EIN")
  38.   #create NTEEGRP classifications
  39.   dataset$NTEEGRP <- "  "
  40.   dataset$NTEEGRP[str_sub(dataset$NTEEFINAL,1,1) %in% arts ] <- "Arts"
  41.   dataset$NTEEGRP[str_sub(dataset$NTEEFINAL,1,1) %in% othered ] <- "Education: Other"
  42.   dataset$NTEEGRP[str_sub(dataset$NTEEFINAL,1,2) %in% highered ] <- "Education: Higher"
  43.   dataset$NTEEGRP[str_sub(dataset$NTEEFINAL,1,1) %in% envanimals] <- "Environment and Animals"
  44.   dataset$NTEEGRP[str_sub(dataset$NTEEFINAL,1,1) %in% otherhlth] <- "Health Care: Other"
  45.   dataset$NTEEGRP[str_sub(dataset$NTEEFINAL,1,3) %in% hospitals] <- "Health Care: Hospitals and primary care facilities"
  46.   dataset$NTEEGRP[str_sub(dataset$NTEEFINAL,1,1) %in% humanserv] <- "Human Services"
  47.   dataset$NTEEGRP[str_sub(dataset$NTEEFINAL,1,1) %in% intl] <- "International"
  48.   dataset$NTEEGRP[str_sub(dataset$NTEEFINAL,1,1) %in% pubben] <- "Other Public and social benefit"
  49.   dataset$NTEEGRP[str_sub(dataset$NTEEFINAL,1,1) %in% relig] <- "Religion related"
  50.   dataset$NTEEGRP[is.na(dataset$NTEEFINAL)] <- "Other Public and social benefit"
  51.   return(dataset)
  52. }
  53.  
  54. #Import reduced NCCS Core File Function
  55. prepcorepcfile <- function(corefilepath) {
  56.   output <- read_csv(corefilepath,
  57.                      col_types = cols_only(EIN = col_character(),
  58.                                            FISYR = col_integer(),
  59.                                            NAME = col_character(),
  60.                                            STATE = col_character(),
  61.                                            ADDRESS = col_character(),
  62.                                            CITY = col_character(),
  63.                                            ZIP = col_character(),
  64.                                            MSA_NECH = col_character(),
  65.                                            FIPS = col_character(),
  66.                                            PMSA = col_character(),
  67.                                            STYEAR = col_double(),
  68.                                            TAXPER = col_integer(),
  69.                                            OUTNCCS = col_character(),
  70.                                            OutNCCS = col_character(),
  71.                                            SUBSECCD = col_character(),
  72.                                            RULEDATE = col_character(),
  73.                                            FNDNCD = col_character(),
  74.                                            FRCD = col_character(),
  75.                                            TOTREV = col_double(),
  76.                                            EXPS = col_double(),
  77.                                            ASS_EOY = col_double(),
  78.                                            GRREC = col_double()
  79.  
  80.                      ))
  81.   names(output) <- toupper(names(output))
  82.   return(output)
  83. }
  84.  
  85. #Import NCCS Core File for given year
  86. corefile <- prepcorepcfile(as.character(paste("Data/core", "2015", "pc.csv", sep="")))
  87.  
  88. #Add NTEE Classifications to the Core File
  89. corefile <- NTEEclassify(corefile)
  90.  
  91. #Filter out of scope organizations 
  92. corefile <- corefile %>%
  93.   filter((OUTNCCS != "OUT")) %>%
  94.   filter((FNDNCD != "02" & FNDNCD!= "03" & FNDNCD != "04")) %>%
  95.   filter((NTEEGRP == "Arts"))
  96.  
  97. #Sort the corefile in descending order by expenses
  98. LargestExpenses <- corefile[with(corefile,order(-EXPS)),]
  99.  
  100. #Limit the list to 10
  101. LargestExpenses <- LargestExpenses[1:10,]
  102.  
  103. #Select the appropriate columns, drop the rest
  104. LargestExpenses <- LargestExpenses %>% 
  105.   select(EIN, NTEEFINAL, NTEEGRP, NAME, EXPS)
  106.  
  107. #Rename columns appropriately
  108. colnames(LargestExpenses) <- c("EIN", "NTEE Code", "NTEE Group", "Name", "Expenses")
  1. #display table
  2. kable(LargestExpenses, format.args = list(decimal.mark = '.', big.mark = ","))
EIN NTEE Code NTEE Group Name Expenses
131599108 A33 Arts CHANCELLOR MASTERS AND SCHOLARS OF THE UNIVERSITY OF CAMBRIDGE 2,114,256,815
381359510 A51 Arts THE DETROIT INSTITUTE OF ARTS 578,433,181
520899215 A32 Arts PUBLIC BROADCASTING SERVICE 520,215,821
132607374 A30 Arts CORPORATION FOR PUBLIC BROADCASTING 472,506,141
131624086 A51 Arts THE METROPOLITAN MUSEUM OF ART 421,039,350
131624087 A6A Arts METROPOLITAN OPERA ASSOCIATION INC 309,136,883
113669999 A40 Arts MOSAIC 234,978,196
131624100 A51 Arts MUSEUM OF MODERN ART 230,136,082
530245017 A61 Arts JOHN F KENNEDY CENTER FOR THE PERFORMING ARTS 209,123,555
043177990 A33 Arts HARVARD BUSINESS SCHOOL PUBLISHING CORPORATION 205,004,021

Source: NCCS 501(c)(3) Public Charities Core File 2015