R/fpds_research.R

In abresler/govtrackR: Federal government tracking tools

.generate_search_dates <-
  function() {
    df_dates <- .fpds_bulk_dates(years = 2000:(year(Sys.Date())))
    start_dates <-
      df_dates %>% group_by(yearData) %>% filter(dateStart == min(dateStart)) %>%
      ungroup() %>%
      pull(dateStart) %>% as.character()

    end_dates <-
      df_dates %>% group_by(yearData) %>% filter(dateEnd == max(dateEnd)) %>%
      ungroup() %>%
      pull(dateEnd) %>%
      as.character()

    tbl_dates <-
      tibble(
        start_date = c("1900-01-01", start_dates),
        end_date = c("1999-12-31",  end_dates)
      )

    tbl_dates
  }

.fpds_research_csv <-
  function(research_code = "ST2",
           decode_contract_ids = T,
           use_future = T,
           return_message = T) {
    rows <-
      fpds_atom(research = research_code) %>% nrow() * 10
    no_multi <- rows <= 30000 & (research_code != "ST2")

    if (no_multi) {
      data <- fpds_csv(research = research_code, return_message = F) %>%
        mutate(codeResearch = research_code) %>%
        mutate_if(is.numeric, as.numeric) %>%
        select(codeResearch, everything()) %>%
        .add_budget_year()

    } else {
      df_dates <- .fpds_bulk_dates(years = 2000:(year(Sys.Date())))
      start_dates <-
        df_dates %>% group_by(yearData) %>% filter(dateStart == min(dateStart)) %>%
        ungroup() %>%
        pull(dateStart) %>% as.character()

      end_dates <-
        df_dates %>% group_by(yearData) %>% filter(dateEnd == max(dateEnd)) %>%
        ungroup() %>%
        pull(dateEnd) %>%
        as.character()

      tbl_dates <-
        tibble(
          start_date = c("1900-01-01", start_dates),
          end_date = c("1999-12-31",  end_dates)
        )

      data <-
        1:nrow(tbl_dates) %>%
        map_dfr(function(x) {
          df_date <- tbl_dates %>% dplyr::slice(x)
          fpds_csv_safe <- possibly(fpds_csv, tibble())
          data <- fpds_csv(
            research = research_code,
            signed_date = c(df_date$start_date, df_date$end_date),
            use_future = use_future,
            decode_contract_ids = decode_contract_ids,
            return_message = F
          )

          if (length(data) == 0) {
            return(tibble())
          }

          if (nrow(data) <= 1) {
            return(tibble())
          }

          data %>%
            mutate(codeResearch = research_code) %>%
            mutate_if(is.numeric, as.numeric) %>%
            select(codeResearch, everything())
        })
    }


    data <-
      data %>% .add_budget_year()

    if (return_message) {
      actions <- data %>% nrow() %>% comma(digits = 0)
      contracts <-
        data %>% distinct(idContractAnalysis) %>% nrow() %>% comma(digits = 0)
      duns <-
        data %>% distinct(idDUNS) %>% nrow() %>% comma(digits = 0)
      parent_duns  <-
        data %>% distinct(idDUNSParent) %>% nrow() %>% comma(digits = 0)
      amt <-
        data$amountObligation %>% sum() %>% currency(digits = 0)
      from_date <- data$dateObligation %>% min(na.rm = T)
      to_date <- data$dateObligation %>% max(na.rm = T)
      glue(
        "\n\n{yellow(research_code)}: {green({amt})} procured between {red({from_date})} and {red({to_date})} across {magenta(actions)} actions amongst {yellow(contracts)} contracts allocated to {cyan(duns)} distinct DUNS and {blue(parent_duns)} distinct parent DUNS\n\n"
      ) %>% cat(fill = T)
    }
    data
  }


#' FPDS SBIR/STTR Actions
#'
#' Acquires all SBIR/STTR CSV actions
#'
#' @param research_codes \itemize{
#' \item ST1 - STTR Phase 1
#' \item ST2 - STTR Phase 2
#' \item ST3 - STTR Phase 3
#' \item SR1 - SBIR Phase 1
#' \item SR2 - SBIR Phase 2
#' \item SR3 - SBIR Phase 3
#' }
#' @param snake_names if \code{TRUE} snake case names
#' @param return_message if \code{TRUE} returns mess
#'
#' @return a \code{tibble}
#' @export
#'
#' @examples
fpds_research_csv <-
  function(research_codes = c("ST1", "ST2", "ST3", "SR1", "SR2", "SR3"),
           snake_names = F,
           use_future = F,
           decode_contract_ids = F,
           return_message = T) {
    .fpds_research_csv_safe <- possibly(.fpds_research_csv, tibble())

    data <-
      research_codes %>%
      map_dfr(function(research_code) {
        .fpds_research_csv_safe(research_code = research_code,
                                use_future = use_future,
                                decode_contract_ids = decode_contract_ids,
                                return_message = return_message)
      })

    data <-
      data %>%
      mutate_if(is.numeric, as.numeric) %>%
      select(-one_of(c(
        "namesVendorListed", "namesVendorParentListed"
      ))) %>%
      munge_lite(snake_names = snake_names) %>%
      resolve_listed_duns()

    data <-
      data %>%
      arrange((dateObligation))

    data
  }