Academic-industry NIH funding by state

gistfile1.txt

library(nihexporter)
library(tidyverse)
library(rlang)
library(cowplot)

grant_funds <- function(codes, code_name) {
  code_name <- rlang::sym(code_name)
  
  projects %>%
    filter(activity %in% codes) %>%
    select(application.id, activity, fy.cost, fiscal.year) %>%
    left_join(project_orgs, by = "application.id") %>%
    left_join(org_info, by = "org.duns") %>%
    select(activity, fy.cost, fiscal.year, org.state) %>%
    mutate(
      activity = fct_collapse(
        activity, !!code_name := codes
      )
    ) %>%
    na.omit() %>%
    # filter for US states
    filter(org.state %in% state.abb)
}

fund_summary <- function(funds) {
  group_by(funds, activity, fiscal.year, org.state) %>%
    summarize(total.cost = sum(fy.cost, na.rm = TRUE)) %>%
    ungroup()
}

academic_funds <- grant_funds(c('R01'), "academic") %>% fund_summary()
industry_funds <- grant_funds(c('R41','R42'), "industry") %>% fund_summary()

combined_funds <- bind_rows(academic_funds, industry_funds) %>%
  spread(activity, total.cost) %>% na.omit() %>%
  mutate(fund.ratio = log10(academic / industry))

ggplot(combined_funds, aes(fiscal.year, fund.ratio)) +
  geom_point() + geom_line() + 
  facet_wrap(~ org.state)

library(nihexporter)
#> Loading required package: jsonlite
#> Loading required package: httr
#> Loading required package: dplyr
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(tidyverse)
library(rlang)
#> 
#> Attaching package: 'rlang'
#> The following objects are masked from 'package:purrr':
#> 
#>     %@%, %||%, as_function, flatten, flatten_chr, flatten_dbl,
#>     flatten_int, flatten_lgl, invoke, list_along, modify, prepend,
#>     rep_along, splice
#> The following objects are masked from 'package:jsonlite':
#> 
#>     flatten, unbox
library(cowplot)
#> 
#> Attaching package: 'cowplot'
#> The following object is masked from 'package:ggplot2':
#> 
#>     ggsave

grant_funds <- function(codes, code_name) {
  code_name <- rlang::sym(code_name)
  
  projects %>%
    filter(activity %in% codes) %>%
    select(application.id, activity, fy.cost, fiscal.year) %>%
    left_join(project_orgs, by = "application.id") %>%
    left_join(org_info, by = "org.duns") %>%
    select(activity, fy.cost, fiscal.year, org.state) %>%
    mutate(
      activity = fct_collapse(
        activity, !!code_name := codes
      )
    ) %>%
    na.omit() %>%
    # filter for US states
    filter(org.state %in% state.abb)
}

fund_summary <- function(funds) {
  group_by(funds, activity, fiscal.year, org.state) %>%
    summarize(total.cost = sum(fy.cost, na.rm = TRUE)) %>%
    ungroup()
}

academic_funds <- grant_funds(c('R01'), "academic") %>% fund_summary()
industry_funds <- grant_funds(c('R41','R42'), "industry") %>% fund_summary()

combined_funds <- bind_rows(academic_funds, industry_funds) %>%
  spread(activity, total.cost) %>% na.omit() %>%
  mutate(fund.ratio = log10(academic / industry))
#> Warning in bind_rows_(x, .id): Unequal factor levels: coercing to character
#> Warning in bind_rows_(x, .id): binding character and factor vector,
#> coercing into character vector

#> Warning in bind_rows_(x, .id): binding character and factor vector,
#> coercing into character vector

ggplot(combined_funds, aes(fiscal.year, fund.ratio)) +
  geom_point() + geom_line() + 
  facet_wrap(~ org.state)

Created on 2018-08-02 by the reprex package (v0.2.0).