Browse Source

added code coverage

tags/v0.5.2
boB Rudis 3 years ago
parent
commit
919a74fd54
No known key found for this signature in database GPG Key ID: 2A514A4997464560
11 changed files with 91 additions and 42 deletions
  1. +1
    -0
      .Rbuildignore
  2. +3
    -0
      .travis.yml
  3. +3
    -2
      DESCRIPTION
  4. +4
    -3
      NEWS.md
  5. +17
    -5
      R/get_flu_data.r
  6. +3
    -0
      R/get_state_data.r
  7. +32
    -22
      R/mortalty.r
  8. +12
    -10
      R/zzz.r
  9. +1
    -0
      README.Rmd
  10. +1
    -0
      codecov.yml
  11. +14
    -0
      tests/testthat/test-cdcfluview.R

+ 1
- 0
.Rbuildignore View File

@@ -8,3 +8,4 @@
^README_files/.*
^README-.*
^cran-comments\.md$
^codecov\.yml$

+ 3
- 0
.travis.yml View File

@@ -19,3 +19,6 @@ notifications:
channels:
- "irc.rud.is#builds"
nick: travisci

after_success:
- Rscript -e 'covr::codecov()'

+ 3
- 2
DESCRIPTION View File

@@ -2,7 +2,7 @@ Package: cdcfluview
Type: Package
Title: Retrieve U.S. Flu Season Data from the CDC FluView Portal
Version: 0.5.2
Date: 2017-01-02
Date: 2017-03-14
Author: Bob Rudis (bob@rud.is)
Maintainer: Bob Rudis <bob@rud.is>
Encoding: UTF-8
@@ -17,7 +17,8 @@ BugReports: https://github.com/hrbrmstr/cdcfluview/issues
License: MIT + file LICENSE
LazyData: true
Suggests:
testthat
testthat,
covr
Imports:
httr (>= 0.3.0),
xml2,


+ 4
- 3
NEWS.md View File

@@ -1,8 +1,9 @@
# cdcfluview 0.5.2

* Modified behavior of `get_flu_data()` to actually grab current flu season year
if a single year was specified and it is the current year and the return is a 0 length
data frame #7
* Modified behavior of `get_flu_data()` to actually grab current flu season
year if a single year was specified and it is the current year and the
return is a 0 length data frame (fixes #7)
* Added code coverage tests for all API functions.
# cdcfluview 0.5.1



+ 17
- 5
R/get_flu_data.r View File

@@ -68,15 +68,17 @@ get_flu_data <- function(region="hhs", sub_region=1:10,
data_source <- gsub("who", "WHO_NREVSS", data_source)
data_source <- gsub("ilinet", "ILINet", data_source)

params <- list(SubRegionsList=paste0(sub_region, collapse=","),
DataSources=paste0(data_source, collapse=","),
RegionID=reg,
SeasonsList=paste0(years, collapse=","))
params <- list(SubRegionsList = paste0(sub_region, collapse=","),
DataSources = paste0(data_source, collapse=","),
RegionID = reg,
SeasonsList = paste0(years, collapse=","))

out_file <- tempfile(fileext=".zip")

# CDC API returns a ZIP file so we grab, save & expand it to then read in CSVs

tmp <- httr::POST("https://gis.cdc.gov/grasp/fluview/FluViewPhase2CustomDownload.ashx",
body=params,
body = params,
write_disk(out_file))

stop_for_status(tmp)
@@ -97,10 +99,19 @@ get_flu_data <- function(region="hhs", sub_region=1:10,

names(file_list) <- substr(basename(files), 1, 3)

# Depending on the parameters, there could be more than one
# file returned. When there's only one, return a more usable
# structure.

if (length(file_list) == 1) {

file_list <- file_list[[1]]

# when no rows, then it's likely the caller specified the
# current year and the flu season has technically not started yet.
# so help them out and move the year back and get current flu
# season data.

if ((nrow(file_list) == 0) &&
(length(years)==1) &&
(years == (as.numeric(format(Sys.Date(), "%Y"))-1960))) {
@@ -111,6 +122,7 @@ get_flu_data <- function(region="hhs", sub_region=1:10,
} else {
return(file_list)
}

} else {
return(file_list)
}


+ 3
- 0
R/get_state_data.r View File

@@ -36,6 +36,9 @@ get_state_data <- function(years=as.numeric(format(Sys.Date(), "%Y"))) {

stop_for_status(tmp)

# the API doesn't return actual JSON. It returns a JavaScript data structre
# which is why we need the assistance of the super handy V8 pkg.

res <- httr::content(tmp, as="parsed")

ctx <- V8::v8()


+ 32
- 22
R/mortalty.r View File

@@ -28,52 +28,62 @@
#' }
get_mortality_surveillance_data <- function() {

pg <- read_html("https://www.cdc.gov/flu/weekly/nchs.htm")
# scrape (ugh) web page to get data file links for state mortality data

pg <- xml2::read_html("https://www.cdc.gov/flu/weekly/nchs.htm")

PREFIX <- "https://www.cdc.gov"

xml_find_all(pg, ".//select[@id='State']/option[contains(@value, 'csv') and
contains(@value, 'State_')]") %>%
xml_attr("value") %>%
xml2::xml_find_all(pg, ".//select[@id='State']/option[contains(@value, 'csv') and
contains(@value, 'State_')]") %>%
xml2::xml_attr("value") %>%
sprintf("%s%s", PREFIX, .) -> targets

pb <- progress_estimated(length(targets))
map_df(targets, function(x) {
pb <- dplyr::progress_estimated(length(targets))
purrr::map_df(targets, function(x) {
pb$tick()$print()
suppressMessages(read_csv(URLencode(x), col_types="ciidii"))
}) -> influenza_mortality_by_state

# scrape (ugh) web page to get data file links for regional mortality data

xml_find_all(pg, ".//select[@id='Regional Data']/
option[contains(@value, 'csv') and
not(contains(@value, 'Week_'))]") %>%
xml_attr("value") %>%
xml2::xml_find_all(pg, ".//select[@id='Regional Data']/
option[contains(@value, 'csv') and
not(contains(@value, 'Week_'))]") %>%
xml2::xml_attr("value") %>%
sprintf("%s%s", PREFIX, .) -> targets

pb <- progress_estimated(length(targets))
map_df(targets, function(x) {
pb <- dplyr::progress_estimated(length(targets))
purrr::map_df(targets, function(x) {
pb$tick()$print()
suppressMessages(read_csv(URLencode(x), col_types="ciidii"))
}) -> influenza_mortality_by_region

# scrape (ugh) web page to get data file links for weekly mortality data

xml_find_all(pg, ".//select[@id='Regional Data']/
option[contains(@value, 'csv') and
contains(@value, 'Week_')]") %>%
xml_attr("value") %>%
xml2::xml_find_all(pg, ".//select[@id='Regional Data']/
option[contains(@value, 'csv') and
contains(@value, 'Week_')]") %>%
xml2::xml_attr("value") %>%
sprintf("%s%s", PREFIX, .) -> targets

pb <- progress_estimated(length(targets))
map_df(targets, function(x) {
pb <- dplyr::progress_estimated(length(targets))
purrr::map_df(targets, function(x) {
pb$tick()$print()
suppressMessages(read_csv(URLencode(x), col_types="ciidii"))
}) -> influenza_mortality_by_week

# if return it all

list(
by_state=influenza_mortality_by_state,
by_region=influenza_mortality_by_region,
by_week=influenza_mortality_by_week
)
by_state = influenza_mortality_by_state,
by_region = influenza_mortality_by_region,
by_week = influenza_mortality_by_week
) -> out

class(out) <- c("cfv_mortality", class(out))

out

}


+ 12
- 10
R/zzz.r View File

@@ -1,10 +1,12 @@
.onAttach <- function(...) {

if (!interactive()) return()

# packageStartupMessage(paste0("cdcfluview is under *active* development. ",
# "There are *breaking changes*. ",
# "See https://github.com/hrbrmstr/cdcfluview for info/news."))

}

# this is only used during active development phases before/after CRAN releases

# .onAttach <- function(...) {
#
# if (!interactive()) return()
#
# packageStartupMessage(paste0("cdcfluview is under *active* development. ",
# "There are *breaking changes*. ",
# "See https://github.com/hrbrmstr/cdcfluview for info/news."))
#
# }
#

+ 1
- 0
README.Rmd View File

@@ -16,6 +16,7 @@ knitr::opts_chunk$set(

[![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/cdcfluview)](https://cran.r-project.org/package=cdcfluview)
[![Travis-CI Build Status](https://travis-ci.org/hrbrmstr/cdcfluview.svg?branch=master)](https://travis-ci.org/hrbrmstr/cdcfluview)
[![Coverage Status](https://img.shields.io/codecov/c/github/hrbrmstr/cdcfluview/master.svg)](https://codecov.io/github/hrbrmstr/cdcfluview?branch=master)

**NOTE** If there's a particular data set from https://www.cdc.gov/flu/weekly/fluviewinteractive.htm that you want and that isn't in the package, please file it as an issue and be as specific as you can (screen shot if possible).



+ 1
- 0
codecov.yml View File

@@ -0,0 +1 @@
comment: false

+ 14
- 0
tests/testthat/test-cdcfluview.R View File

@@ -5,4 +5,18 @@ test_that("we can do something", {

expect_that(dim(get_state_data(2008)), equals(c(2494L, 8L)))

invisible(get_flu_data())

invisible(get_flu_data(data_source="all"))

invisible(get_weekly_flu_report())

})

test_that("these are potentially time-consuming calls", {

skip_on_cran()

invisible(get_mortality_surveillance_data())

})

Loading…
Cancel
Save