R/rif.R

In abresler/govtrackR: Federal government tracking tools

# http://www.defenseinnovationmarketplace.mil/rif.html

## download - read each sheet


# download ----------------------------------------------------------------


#' RIF Awarards
#'
#' Data on Rapid Innovation
#'
#' @return
#' @export
#'
#' @examples
rif_awards <- function() {
  url = "https://defenseinnovationmarketplace.dtic.mil/wp-content/uploads/2018/02/FY11_through_FY16_RIF_Awards.xlsx"
  tmp <-
    tempfile()
  curl::curl_download(url, tmp)

  sheets <- tmp %>% readxl::excel_sheets()
  sheet_nos <- 1:length(sheets)

  all_data <-
    sheet_nos %>%
    map_dfr(function(x) {
      x %>% message()
      year <- sheets[[x]] %>% parse_number()
      data <- tmp %>% read_excel(sheet = x) %>% suppressWarnings()

      if (x >=4) {
        data <-
          data %>% dplyr::slice(3:nrow(data))
        data <-
          data %>%
          set_names(c("a", "b", "c", "d")) %>%
          mutate(idRow = 1:n())

        d <- data  %>%
          separate("a", into = c("nameFundingAgency", "a"),
                   extra = "merge",
                   sep = "\\:") %>%
          suppressMessages() %>%
          suppressWarnings()

        df_groups <-
          d %>% filter(!is.na(a)) %>% filter(is.na(b)) %>%
          select(idRow, nameFundingAgency) %>%
          mutate_at("nameFundingAgency",str_trim)

        data <- data %>%
          left_join(df_groups, by = "idRow") %>%
          select(nameFundingAgency, everything()) %>%
          fill(nameFundingAgency) %>%
          filter(!is.na(b)) %>%
          select(-idRow) %>%
          set_names(
            c(
              "nameFundingAgency",
              "nameProject",
              "nameAwardee",
              "locationAwardee",
              "descriptionAward"
            )
          ) %>%
          mutate(yearRIF = year) %>%
          select(yearRIF, everything()) %>%
          suppressWarnings()
        return(data)
      }


      data %>% set_names(
        c(
          "nameFundingAgency",
          "nameProject",
          "nameAwardee",
          "locationAwardee",
          "descriptionAward"
        )
      ) %>%
        mutate(yearRIF = year) %>%
        select(yearRIF, everything()) %>%
        suppressWarnings()
    })
  tmp %>%
    unlink()
  all_data <-
    all_data %>%
    filter(!is.na(nameProject)) %>%
    filter(nameFundingAgency != "Organization")

  all_data <-
    all_data %>%
    separate(nameFundingAgency, sep = "\\ - |\\ / |/",
             extra = "merge",
             into = c("nameFundingAgency", "detailOrganization")) %>% suppressMessages() %>% suppressWarnings() %>%
    .munge_data()

  all_data

}

# contacts ----------------------------------------------------------------