knitr::opts_chunk$set( collapse = TRUE, comment = "#>", width = 95, fig.dpi = 96 ) opts.old <- options() options(width = 95, cli.unicode = FALSE, cli.width = 95) ## confirm RePORTER is currently available before building this, for CRAN r <- httr::POST("https://api.reporter.nih.gov/v2/projects/search", httr::accept("application/json"), httr::content_type_json(), body = "{\"criteria\":{\"foa\":[\"RFA-NS-19-036\"]},\"include_fields\":[\"ApplId\"],\"offset\":0,\"limit\":10,\"sort_field\":\"appl_id\",\"sort_order\":\"desc\"}", encode = "raw" ) if (r$status_code != 200) knitr::knit_exit()
knitr::include_graphics("covid_plot.png")
The US National Institute of Health (NIH) received funding of approximately \$42 billion in fiscal year 2022; \$31 billion (72%) of this was awarded by the NIH in the form of research grant funding to hospitals, medical colleges, non-profits, businesses, and other organizations based in the U.S. and abroad.^[https://nexus.od.nih.gov/all/2021/04/21/fy-2020-by-the-numbers-extramural-investments-in-research] The NIH maintains a publicly available database called "RePORTER" to track this substantial flow of grant funding and makes it available to the public via a web-based query interface as well as an API.
"The NIH RePORTER APIs is designed to programmatically expose relevant scientific awards data from both NIH and non-NIH federal agencies for the consumption of project teams or external 3rd party applications to support reporting, data analysis, data integration or to satisfy other business needs as deemed pertinent."
r tufte::quote_footer('--NIH RePORTER v2 API Documentation')
This data can have significant value for many audiences, including researchers, investors, industry, watchdogs/public advocates, and R users. But constructing queries and retrieving results programmatically involves some coding overhead which can be a challenge for those not familiar with RESTful APIs and JSON; it takes some effort even for those who are. The repoRter.nih
package aims to simplify this task for the typical analyst scripting in R.
This package (latest stable release) can be installed from CRAN the usual way:
install.packages("repoRter.nih")
The current dev version can be installed from github, on the dev
branch:
devtools::install_github('bikeactuary/repoRter.nih@dev')
I welcome R developers more capable than myself to collaborate on improving the source code, documentation, and unit testing in this package.
library(tibble) library(repoRter.nih) library(ggplot2) library(ggrepel) library(dplyr) library(scales) library(tufte)
The make_req()
method is used to generate a valid JSON request object. The req can subsequently be passed to the RePORTER Project API and results retrieved via the get_nih_data()
method.
Generating the request:
# all projects funded by the Paycheck Protection Act, Coronavirus Response and # Relief Act, and American Rescue Plan, in fiscal year 2021 req <- make_req(criteria = list(fiscal_years = 2021, covid_response = c("C4", "C5", "C6")))
Sending the request and retrieving results:
res <- get_nih_data(req) class(res)
A tibble is returned containing 43 columns. This data is not flat - several columns are nested data.frame
s and list
s (of variable length vectors and data.frame
s of varying height).
res %>% glimpse(width = getOption("cli.width"))
A dataset (nih_fields
) is provided with this package to assist in translating between field names used in the payload criteria
, column names in the return data, and field names used in the include_fields
, exclude_fields
, and sort_field
arguments.
data("nih_fields") nih_fields %>% print
Some fields can not be used as filtering criteria
- these will show NA
in the payload_name
column.
Most of the detail (and function documentation) is around the many parameters available in RePORTER to filter/search project records. Let's get into some of the capabilities.
If no arguments are supplied, the default behavior of make_req()
is to generate a request for all projects funded in fiscal_years = lubridate::year(Sys.Date())
. Limiting requests to a single year is often necessary (depending on additional filtering criteria used) due to a RePORTER restriction that a maximum of 10K records may be returned from any result set. There are currently ~2.6M projects in the database going back to fiscal year 1985, and each fiscal year tends to have 70-100K projects, so the 10K limit can be restrictive to the user wanting a broad search.
req <- make_req()
The method prints a helpful message to the console in addition to returning the JSON. Set message = FALSE
if you wish to suppress this message.
You can limit both the width and height of the result set retrieved from the API.
We probably will not need to fetch every field every time. The include_fields
argument is provided to specify a limited set of fields to be returned. Alternatively, fields may be excluded using exclude_fields
.
This package provides the ability to retrieve only a limited number of result pages via the max_pages
argument. This can be useful for developing/testing your queries (and for reducing time to render package documentation). Each page has a record count equal to limit
- so setting max_pages = 5
with the default limit = 500
(the maximum permitted by RePORTER) in make_req()
will result in up to 2,500 total records returned.
data("nih_fields") fields <- nih_fields %>% filter(response_name %in% c("appl_id", "subproject_id", "project_title", "fiscal_year", "award_amount", "is_active", "project_start_date")) %>% pull(include_name) req <- make_req(include_fields = fields, limit = 500, message = FALSE) # default res <- get_nih_data(query = req, max_pages = 1) res %>% glimpse(width = getOption("cli.width"))
Many criteria are passed as vectors within the criteria
list argument. We will cover some of the most useful examples:
We can refine our query results by providing filtering criteria to make_req()
, and by extension to the API. Suppose we want all currently active projects, funded in fiscal years 2017 through 2021, with a specific organization in mind (though we don't know exactly how its name will appear in RePORTER):
req <- make_req(criteria = list( fiscal_years = 2010:2011, include_active_projects = TRUE, org_names = c("Yale", "New Haven") ), include_fields = c("Organization", "FiscalYear", "AwardAmount"), message = FALSE)
Here we are asking for any orgs containing the strings "yale" or "new haven" (ignoring case) - there are implied wildcards on either end of the strings we provide. This is the same as org_name LIKE '%yale%' OR org_name LIKE '%new haven%'
in a SQL WHERE clause.
res <- get_nih_data(req, max_pages = 1) res %>% glimpse(width = getOption("cli.width"))
Notice the column organization
is a nested data frame - it has 17 columns and always a single record. Setting flatten_result = TRUE
in the call to get_nih_data()
will flatten all such return fields, prefixing the original field name and returning with clean names (see janitor::clean_names()
).
res <- get_nih_data(req, max_pages = 1, flatten_result = TRUE) res %>% glimpse(width = getOption("cli.width"))
Most users will prefer the flattened format above. It looks like Yale is busy, but it is not the only org matching our search.
evl <- class(res)[1] == "tbl_df"
res %>% group_by(organization_org_name) %>% summarise(project_count = n())
The org_names_exact_match
criteria can be used as an alternative when we know the exact org name as it appears in RePORTER, if we want only that org's projects returned.
We can also filter projects by the geographic location (country/state/city) of the applicant organization.
## A valid request but probably not what we want req <- make_req(criteria = list( fiscal_years = 2010:2011, include_active_projects = TRUE, org_cities = "New Haven", org_states = "WY" ), include_fields = c("Organization", "FiscalYear", "AwardAmount"), message = FALSE ## suppress printed message ) res <- get_nih_data(req, max_pages = 5, flatten_result = TRUE)
Multiple criteria are usually connected by logical "AND" - there are no orgs based in the city of New Haven in Wyoming state (because it doesn't exist.)
req <- make_req(criteria = list( fiscal_years = 2015, include_active_projects = TRUE, org_states = "WY" ), include_fields = c("ApplId", "Organization", "FiscalYear", "AwardAmount"), sort_field = "AwardAmount", sort_order = "desc", message = FALSE) res <- get_nih_data(req, flatten_result = TRUE) res %>% glimpse(width = getOption("cli.width"))
Why are there projects from more recent years than 2015? Because the include_active_projects
flag adds in active projects that match all criteria aside from fiscal_years
(this appears to be the intended behavior by RePORTER).
We already provided one example of this search criteria above. Let's mix it up and request all Covid response projects.
## all projects funded by the Paycheck Protection Act, Coronavirus Response and Relief Act, ## and American Rescue Plan, over all years req <- make_req(criteria = list(covid_response = c("All")), include_fields = nih_fields %>% filter(payload_name %in% c("award_amount_range", "covid_response")) %>% pull(include_name)) res <- get_nih_data(req, max_pages = 1)
evl <- class(res)[1] == "tbl_df"
Let's inspect the result:
res$covid_response %>% class() res$covid_response[[1]]
covid_response
is a nested list (with character vectors of variable length) within the return tibble. We can use flatten_result = TRUE
here - elements of each vector will be collapsed to a single string delimited by ";", massaging the list to a single character vector.
## all projects funded by the Paycheck Protection Act, Coronavirus Response and Relief Act, ## and American Rescue Plan, in fiscal year 2021 req <- make_req(criteria = list(covid_response = c("All")), message = FALSE) res <- get_nih_data(req, flatten_result = TRUE)
unique(res$covid_response)
res <- readRDS("cov_res.RDS") unique(res$covid_response)
Some projects are being funded from multiple sources. Summarizing all Covid-related project awards:
library(ggplot2) res %>% left_join(covid_response_codes, by = "covid_response") %>% mutate(covid_code_desc = case_when(!is.na(fund_src) ~ paste0(covid_response, ": ", fund_src), TRUE ~ paste0(covid_response, " (Multiple)"))) %>% group_by(covid_code_desc) %>% summarise(total_awards = sum(award_amount) / 1e6) %>% ungroup() %>% arrange(desc(covid_code_desc)) %>% mutate(prop = total_awards / sum(total_awards), csum = cumsum(prop), ypos = csum - prop/2 ) %>% ggplot(aes(x = "", y = prop, fill = covid_code_desc)) + geom_bar(stat="identity") + geom_text_repel(aes(label = paste0(dollar(total_awards, accuracy = 1, suffix = "M"), "\n", percent(prop, accuracy = .01)), y = ypos), show.legend = FALSE, nudge_x = .8, size = 3, color = "grey25") + coord_polar(theta ="y") + theme_void() + theme(legend.position = "right", legend.title = element_text(colour = "grey25"), legend.text = element_text(colour="blue", size=6, face="bold"), plot.title = element_text(color = "grey25"), plot.caption = element_text(size = 6)) + labs(caption = "Data Source: NIH RePORTER API v2") + ggtitle("Legislative Source for NIH Covid Response Project Funding")
knitr::include_graphics("covid_plot.png")
A second dataset is provided to translate the covid_response
codes; it includes both the long-form and a shorter version of the source name.
data("covid_response_codes") covid_response_codes %>% print
Other criteria provide search and filtering capability on many of the nested data elements. These criteria are passed as lists and must include a value for each of the named elements within.
The pi_names
and po_names
criteria allow the user to search for projects based on the first and last names of Principal Investigators and Principal Officers assigned. Each of these criteria must be provided as a list with three named character vector elements: first_name
, last_name
, and any_name
. Even if you only want to search on one of these name fields, you must provide the remaining elements as an empty string. We will demonstrate with a search on PI name:
## projects funded in 2021 where the principal investigator first name ## is "Michael" or begins with "Jo" req <- make_req(criteria = list(fiscal_years = 2021, pi_names = list(first_name = c("Michael", "Jo*"), last_name = c(""), # must specify all pi_names elements always any_name = character(1))), include_fields = nih_fields %>% filter(payload_name == "pi_names") %>% pull(include_name), message = FALSE) res <- get_nih_data(req, max_pages = 1, flatten_result = TRUE) res %>% glimpse(width = getOption("cli.width"))
Here we searched for any projects with a PI first-named "Michael" or beginning with "Jo" - the "*" is a wildcard operator.
Note that the first column in the return is a list of data frames of variable height (not a nested data.frame
) - we leave such returned elements to the user to handle extraction/formatting - flattening is only performed for lists of atomic vectors and nested data frames.
RePORTER allows users to search the project title, abstract, and tags for specific terms or phrases. You can access this capability with the advanced_text_search
criteria - a named list with three elements:
operator
may be either "and", "or", or "advanced" - and/or will specify the logical operator connecting multiple search terms. "advanced" allows the user to pass a boolean search string directly;search_field
can be any or multiple of "terms", "abstract", "projecttitle." To search all items, specify "all" or "" (a length 1 vector with an empty string);search_text
may be either a length 1 character vector of space-delimited search terms (when using "and" or "or" for the operator argument - the logical operator is inserted between all search terms); or it may be a boolean search string (when specifying "advanced" for the operator argument).## using advanced_text_search with boolean search string req <- make_req(criteria = list(advanced_text_search = list(operator = "advanced", search_field = c("terms", "abstract"), search_text = "(head AND trauma) OR \"brain damage\" AND NOT \"psychological\"")), include_fields = c("ProjectTitle", "AbstractText", "Terms") ) res <- get_nih_data(req, max_pages = 1)
Let's inspect the fields we searched from one of these results:
evl <- class(res)[1] == "tbl_df"
one_rec <- res %>% slice(42) %>% mutate(abstract_text = gsub("[\r\n]", " ", abstract_text)) one_rec %>% pull(project_title) %>% print
## substr to avoid LaTeX error exceeding char limit one_rec %>% pull(abstract_text) %>% substr(1, 85) %>% print
one_rec %>% pull(terms) %>% substr(1, 85) %>% print
The RePORTER API provides no direct way to obtain complete result sets when searches yield over 10,000 records. get_nih_data()
provides the return_meta
argument which is defaulted to FALSE
. When set to TRUE
and combined with a little programming, you can easily obtain full result sets well beyond the 10K limit. One approach may be the following:
get_nih_data()
with max_pages = 1
(or some small number of pages); also set return_meta = TRUE
in order to determine the total number of records in the full result setaward_amount
)award_amount_range
criteriaBelow is an implementation of the above logic:
all_res <- list() for(y in 2017:2021) { ## five years to loop over, each year is ~80K records ## We only need the AwardAmount for quantiles req_sample <- make_req(criteria = list(fiscal_years = y), include_fields = "AwardAmount") ## get a sample of the result set - 1000 records should be enough ## return the metadata res_sample <- get_nih_data(req_sample, max_pages = 2, return_meta = TRUE) paste0("There are ", res_sample$meta$total, " results for fiscal year ", y) %>% print() ## deciles of award amount - each decile should contain ~7,314.2 records, approximately qtiles <- res_sample$records %>% pull(award_amount) %>% quantile(na.rm = TRUE, probs = seq(.1, 1, .1)) ## list for qtile results (full year) this_res <- list() ## for each qtile for (i in 1:length(qtiles)) { if (i == 1) { award_min <- 0 } else { award_min <- ceiling(qtiles[i-1])+.01 } if (i == length(qtiles)) { award_max <- 1e9 ## arbitrarily huge } else { award_max <- ceiling(qtiles[i]) } req <- make_req(criteria = list(fiscal_years = y, award_amount_range = list(min_amount = award_min, max_amount = award_max))) ## result set for quantile this_res[[i]] <- get_nih_data(req, flatten_result = FALSE) } ## list of result sets for each year yr_res[[y %>% as.character()]] <- this_res } ## shape it up all_res <- unlist(yr_res, recursive = FALSE) %>% bind_rows() %>% flatten(recursive = FALSE) %>% clean_names() ## pull out everything that is flat flat_columns <- all_res %>% select_if(is.atomic) ## everything that isn't annoying_columns <- all_res %>% select_if(!is.atomic)
Note that using award_amount
for this purpose will omit records with missing values. If you need these included, you may consider similar logic applied to an alternative field such as award_notice_date
.
The version number of R and packages loaded for generating the vignette were:
sessionInfo()
options(opts.old)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.