Skip to content

Commit

Permalink
Add catch and message if downloading from invalid date range (closes #21
Browse files Browse the repository at this point in the history 
)
  • Loading branch information
@steffilazerte
steffilazerte committed Jun 8, 2017
1 parent 4cbae14 commit e474db1
Show file tree
Hide file tree
Showing 3 changed files with 130 additions and 26 deletions.
1 change: 1 addition & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ output: html_document

## Bug fixes
- Fixed inclusion of New Brunswick stations (closes #9)
- Downloads with no data return empty tibble and an informative message (closes #21)


# envirocan 0.2.1 (2017-03-04)
Expand Down
48 changes: 34 additions & 14 deletions R/weather.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -106,6 +106,7 @@ weather <- function(station_ids,
if(!(interval %in% c("hour", "day", "month"))) stop("'interval' must be either 'hour', 'day', OR 'month'")

w_all <- data.frame()

for(s in station_ids) {
if(verbose) message("Getting station: ", s)
if(is.null(stations_data)) stn <- stations else stn <- stations_data
Expand All @@ -119,7 +120,7 @@ weather <- function(station_ids,
"\nAvailable Station Data:\n",
paste0(utils::capture.output(print(stations %>%
dplyr::filter_(lazyeval::interp("station_id %in% x & !is.na(start)", x = s)))), collapse = "\n"))
next
if(length(station_ids) > 1) next else return(tibble::tibble())
}

if(class(try(as.Date(stn$start), silent = TRUE)) == "try-error") {
Expand Down Expand Up @@ -191,30 +192,49 @@ weather <- function(station_ids,
## Trim to match date range
w <- w[w$date >= s.start & w$date <= s.end, ]


w_all <- rbind(w_all, w)
}

if(nrow(w_all) == 0) {
message("There are no data for these stations (", paste0(station_ids, collapse = ", "),
") in this time range (",
as.character(lubridate::int_start(dates)), " to ",
as.character(lubridate::int_end(dates)), ").",
"\nAvailable Station Data:\n",
paste0(utils::capture.output(print(stations %>%
dplyr::filter_(lazyeval::interp("station_id %in% x & !is.na(start)", x = station_ids)))), collapse = "\n"))
return(tibble::tibble())
}

## Trim to available data
if(trim & nrow(w_all) > 0){
if(trim){
if(verbose) message("Trimming missing values before and after")
temp <- w_all[, !(names(w_all) %in% c("date", "time", "prov", "station_name", "station_id", "lat", "lon", "year", "month", "day", "qual","elev", "climat_id", "WMO_id", "TC_id"))]
temp <- w_all[, !(names(w_all) %in% c("date", "time", "prov", "station_name", "station_id", "lat", "lon", "year", "month", "day", "hour", "qual","elev", "climat_id", "WMO_id", "TC_id"))]
temp <- w_all$date[which(rowSums(is.na(temp) | temp == "") != ncol(temp))]
w_all <- w_all[w_all$date >= min(temp) & w_all$date <= max(temp), ]
}

if(nrow(w_all) > 0){

## Average if requested
if(avg != "none"){
if(verbose) message("Averaging station data")
message("Averaging is currently unavailable")
if(length(temp) == 0) {
message("There are no data for these stations (", paste0(station_ids, collapse = ", "),
") in this time range (",
as.character(lubridate::int_start(dates)), " to ",
as.character(lubridate::int_end(dates)), ").",
"\nAvailable Station Data:\n",
paste0(utils::capture.output(print(stations %>%
dplyr::filter_(lazyeval::interp("station_id %in% x & !is.na(start)", x = station_ids)))), collapse = "\n"))
return(tibble::tibble())
}

## Arrange
w_all <- dplyr::select(w_all, station_name, station_id, dplyr::everything())
w_all <- w_all[w_all$date >= min(temp) & w_all$date <= max(temp), ]
}

## Average if requested
if(avg != "none"){
if(verbose) message("Averaging station data")
message("Averaging is currently unavailable")
}

## Arrange
w_all <- dplyr::select(w_all, station_name, station_id, dplyr::everything())

## If list_colis TRUE
if(list_col == TRUE){

Expand Down
107 changes: 95 additions & 12 deletions tests/testthat/test_weather.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -90,6 +90,37 @@ test_that("weather(hour) multiple stations", {
})


test_that("weather(hour) no data fails nicely", {
expect_silent(expect_message(w0 <- weather(1274, interval = "hour",
start = "2012-11-01", end = "2012-12-01"),
"There are no data for station 1274 for interval by 'hour'."))
expect_silent(expect_message(w1 <- weather(c(1274, 1275), interval = "hour",
start = "2012-11-01", end = "2012-12-01"),
"There are no data for station 1274 for interval by 'hour'."))

expect_is(w0, "data.frame")
expect_length(w0, 0)
expect_equal(nrow(w0), 0)
expect_is(w1, "data.frame")
expect_length(w1, 35)
expect_equal(nrow(w1), 744)

expect_silent(expect_message(w0 <- weather(1275, interval = "hour",
start = "2017-01-01", end = "2017-02-01"),
"There are no data for these stations \\(1275\\) in this time range \\(2017-01-01 to 2017-02-01\\)."))

expect_silent(expect_message(w1 <- weather(c(1275, 1001), interval = "hour",
start = "2017-01-01", end = "2017-02-01"),
"There are no data for these stations \\(1275, 1001\\) in this time range \\(2017-01-01 to 2017-02-01\\)."))

expect_is(w0, "data.frame")
expect_length(w0, 0)
expect_equal(nrow(w0), 0)
expect_is(w1, "data.frame")
expect_length(w1, 0)
expect_equal(nrow(w1), 0)
})

#####################
## DAILY
#####################
Expand Down Expand Up @@ -137,8 +168,6 @@ test_that("weather(daily) gets all", {
})




test_that("weather(daily) trims NAs", {
expect_silent(w1 <- weather(station_ids = 54398, interval = "day", trim = FALSE))
expect_silent(w2 <- weather(station_ids = 54398, interval = "day", trim = TRUE))
Expand All @@ -147,23 +176,42 @@ test_that("weather(daily) trims NAs", {
expect_gte(length(data.frame(w1)[is.na(data.frame(w1))]), length(data.frame(w2)[is.na(data.frame(w2))]))
})

test_that("weather(day) mutliple stations", {
expect_error(w <- weather(station_ids = c(54398, 51423), start = "2016-03-01", end = "2016-04-01", interval = "day"), NA)

expect_equal(unique(w$station_name), c("MUSKOKA SNOW", "KAMLOOPS A"))
expect_equal(nrow(w[w$station_id == 54398,]), nrow(w[w$station_id == 51423,]))
})

test_that("weather(day) no data fails nicely", {
expect_message(expect_error(w0 <- weather(station_ids = 51457, start = "2014-01-01", end = "2014-05-01", interval = "day"), NA))
expect_silent(expect_message(w0 <- weather(station_ids = 42013, interval = "day",
start = "2017-01-01", end = "2017-02-01"),
"There are no data for station 42013 for interval by 'day'."))
expect_silent(expect_message(w1 <- weather(station_ids = c(42013, 51423), interval = "day",
start = "2017-01-01", end = "2017-02-01"),
"There are no data for station 42013 for interval by 'day'."))

## Basics
expect_is(w0, "data.frame")
expect_length(w0, 0)
expect_equal(nrow(w0), 0)
})
expect_is(w1, "data.frame")
expect_length(w1, 36)
expect_equal(nrow(w1), 32)

test_that("weather(day) mutliple stations", {
expect_error(w <- weather(station_ids = c(54398, 51423), start = "2016-03-01", end = "2016-04-01", interval = "day"), NA)
expect_silent(expect_message(w0 <- weather(1274, interval = "day", start = "2017-01-01"),
"There are no data for these stations \\(1274\\) in this time range \\(2017-01-01 to 2017-06-08\\)."))
expect_silent(expect_message(w1 <- weather(c(1274, 1275), interval = "day", start = "2017-01-01"),
"There are no data for these stations \\(1274, 1275\\) in this time range \\(2017-01-01 to 2017-06-08\\)."))

expect_equal(unique(w$station_name), c("MUSKOKA SNOW", "KAMLOOPS A"))
expect_equal(nrow(w[w$station_id == 54398,]), nrow(w[w$station_id == 51423,]))
## Basics
expect_is(w0, "data.frame")
expect_length(w0, 0)
expect_equal(nrow(w0), 0)
expect_is(w1, "data.frame")
expect_length(w1, 0)
expect_equal(nrow(w1), 0)
})


#####################
## MONTHLY
#####################
Expand Down Expand Up @@ -196,13 +244,48 @@ test_that("weather(monthly) trims NAs", {

})

test_that("weather(monthly) no data fails nicely", {
expect_message(expect_error(w0 <- weather(station_ids = 51423, start = "2014-01-01", end = "2014-05-01", interval = "month"), NA))
test_that("weather(day) no data fails nicely", {
expect_silent(expect_message(w0 <- weather(station_ids = 42013, interval = "day"),
"There are no data for station 42013 for interval by 'day'."))

expect_silent(expect_message(w1 <- weather(1274, interval = "day", start = "2017-01-01"),
"There are no data for these stations \\(1274\\) in this time range \\(2017-01-01 to 2017-06-08\\)."))

## Basics
expect_is(w0, "data.frame")
expect_length(w0, 0)
expect_equal(nrow(w0), 0)
expect_is(w1, "data.frame")
expect_length(w1, 0)
expect_equal(nrow(w1), 0)
})

test_that("weather(monthly) no data fails nicely", {
expect_silent(expect_message(w0 <- weather(station_ids = 51423, interval = "month",
start = "2012-01-01", end = "2012-02-01"),
"There are no data for station 51423 for interval by 'month'."))
expect_silent(expect_message(w1 <- weather(station_ids = c(51423, 1275), interval = "month",
start = "2012-01-01", end = "2012-02-01"),
"There are no data for station 51423 for interval by 'month'."))
expect_is(w0, "data.frame")
expect_length(w0, 0)
expect_equal(nrow(w0), 0)
expect_is(w1, "data.frame")
expect_length(w1, 34)
expect_equal(nrow(w1), 2)


expect_silent(expect_message(w0 <- weather(1274, interval = "month", start = "2017-01-01", end = "2017-02-01"),
"There are no data for these stations \\(1274\\) in this time range \\(2017-01-01 to 2017-02-01\\)."))
expect_silent(expect_message(w1 <- weather(c(1274, 1275), interval = "month", start = "2017-01-01", end = "2017-02-01"),
"There are no data for these stations \\(1274, 1275\\) in this time range \\(2017-01-01 to 2017-02-01\\)."))

expect_is(w0, "data.frame")
expect_length(w0, 0)
expect_equal(nrow(w0), 0)
expect_is(w1, "data.frame")
expect_length(w1, 0)
expect_equal(nrow(w1), 0)
})

test_that("weather(month) multiple stations", {
Expand Down

0 comments on commit e474db1

Please sign in to comment.