R/make_codebook_vignette.R

In socdataR/wonderapi: User Friendly Access to CDC Wonder API

make_codebook_vignette <- function(dbcode = "D66") {
    index <- purrr::map(dbnamelookup, ~which(.x == dbcode)) %>% unlist()
    if (length(index) == 0) stop ("I don't know which database you want.")
    # get data
    webdata <- agree_and_scrape(dbname = dbnamelookup$dbname[index],
                                dbcode = dbnamelookup$dbcode[index],
                                submit = dbnamelookup$dbagree[index])
    # find form, organize the info
    webform <- webdata %>% rvest::html_form()
    form_df <- purrr::map_df(webform[[2]]$fields, unpack)
    form_df <- form_df %>%
        dplyr::filter(!(type %in% c("button", "submit", "hidden"))) %>%
        dplyr::filter(!(stringr::str_detect(name, "O_") & type == "checkbox")) %>%
        dplyr::mutate(dbcode = dbcode)
    # create vignette
    sink(paste0("vignettes/", dbcode, "codebook.Rmd"))
    cat("---\n")
    cat("title: \"", dbcode, dbnamelookup$dblabel[index],
        "Dataset Codebook\"\n")
    cat("author: \"Joyce Robbins \"\n")
    cat("date: \"`r Sys.Date()`\"\n")
    cat("output: rmarkdown::html_vignette\n")
    cat("vignette: >\n")
    cat("  %\\VignetteIndexEntry{", dbcode,
        dbnamelookup$dblabel[index],"}\n")
    cat("  %\\VignetteEngine{knitr::rmarkdown}\n")
    cat("  %\\VignetteEncoding{UTF-8}\n")
    cat("---\n")
    cat("This codebook is provided to assist in determining how to set up a query to the CDC Wonder API. The best way to become familiar with the API is to use the web interface: https://wonder.cdc.gov.  Also, read the [<code>wonderapi</code> vignette](IntroVignette.html) to learn about the basic sections of CDC Wonder query requests.\n\n")
    apply(form_df, 1, process_item)
    sink()
}


# functions
check_and_assign <- function(field) {
    if (length(field) > 0) {
        return(field)
    }
    else
        return("NULL")
}

unpack <- function(item) {
    name <- check_and_assign(item$name)
    value <- check_and_assign(item$value)
    type <- check_and_assign(item$type)
    options <- check_and_assign(item$options) %>% list()
    df <- data.frame(name, value, type, stringsAsFactors = FALSE)
    df$options <- options
    df
}

process_item <- function(thisrow) {
    precode <- strsplit(thisrow$name, "_")[[1]][1]
    lookupname <- thisrow$name
    switch(precode,
           O = if (thisrow$type == "radio") {
               lookupname <- paste0(thisrow$name,
                                    thisrow$value)
           },
           F = lookupname <- strsplit(thisrow$name,
                                      "_")[[1]][2],
           V = lookupname <- strsplit(thisrow$name,
                                      "_")[[1]][2]
    )

    label_list_name <- paste0(thisrow$dbcode, "labellookup")
    index <- which(names(label_list) == label_list_name)
    labellookup <- label_list[[index]]
    index <- which(labellookup$code == lookupname)
    cat("**Parameter:**\n")
    if (thisrow$type == "radio") {
        cat(thisrow$name, "\n**Values:**\t", thisrow$value, "\t",
            labellookup$label[index], "\n")
    }
    else {
        cat(thisrow$name, "\t", labellookup$label[index], "\n")
    }
    if (length(thisrow$options) > 1) {
        cat("\n**Value(s):**\n```\n")
        opt <- thisrow$options %>% unlist()
        for (i in seq_along(opt)) {
            optname <- names(opt[i])
            cat("\t\t", opt[i], "\t", optname, "\n")
        }
        cat("```\n")
    }
    cat("\n")
}