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)
#> Loading tidyverse: ggplot2
#> Loading tidyverse: tibble
#> Loading tidyverse: tidyr
#> Loading tidyverse: readr
#> Loading tidyverse: purrr
#> Conflicts with tidy packages ----------------------------------------------
#> filter(): dplyr, stats
#> lag():    dplyr, stats

# this produces several NA values for application.id 
left_join(clinical_studies, projects) %>%
  select(application.id, one_of(names(clinical_studies)))
#> Joining, by = "project.num"
#> # A tibble: 248,786 × 4
#>    application.id                project.num    trial.id
#>             <int>                      <chr>       <chr>
#> 1              NA        261201100031C-0-0-1 NCT01831778
#> 2              NA 261201200042I-0-26100006-1 NCT02772003
#> 3              NA        261201400046C-0-0-1 NCT02464332
#> 4              NA        268200700015C-2-0-0 NCT00534495
#> 5              NA        268200700036C-5-0-1 NCT00556439
#> 6              NA        268200900040C-1-0-1 NCT01206062
#> 7              NA        268201000048C-5-0-1 NCT01322165
#> 8              NA        268201300046C-4-0-1 NCT00005485
#> 9              NA        268201300047C-4-0-1 NCT00005485
#> 10             NA        268201300048C-4-0-1 NCT00005485
#> # ... with 248,776 more rows, and 1 more variables: study.status <fctr>

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)