From e474db1a4539c94fcfdb15d665aef90f27f17736 Mon Sep 17 00:00:00 2001 From: Stefanie LaZerte Date: Thu, 8 Jun 2017 18:29:14 -0300 Subject: [PATCH] Add catch and message if downloading from invalid date range (closes #21) --- NEWS.md | 1 + R/weather.R | 48 ++++++++++----- tests/testthat/test_weather.R | 107 ++++++++++++++++++++++++++++++---- 3 files changed, 130 insertions(+), 26 deletions(-) diff --git a/NEWS.md b/NEWS.md index 8cdc9aa..7560e55 100755 --- a/NEWS.md +++ b/NEWS.md @@ -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) diff --git a/R/weather.R b/R/weather.R index e1c0c24..e525866 100755 --- a/R/weather.R +++ b/R/weather.R @@ -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 @@ -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") { @@ -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){ diff --git a/tests/testthat/test_weather.R b/tests/testthat/test_weather.R index b81f9be..d4c1927 100755 --- a/tests/testthat/test_weather.R +++ b/tests/testthat/test_weather.R @@ -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 ##################### @@ -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)) @@ -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 ##################### @@ -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", {