restoring to v041

EdwinTh · Apr 3, 2019 · e8aeb24 · e8aeb24 · lintr-bot · Apr 3, 2019
1 parent 49e78d5
commit e8aeb24
Show file tree

Hide file tree

Showing 76 changed files with 63 additions and 106 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: padr
 Type: Package
 Title: Quickly Get Datetime Data Ready for Analysis
-Version: 0.4.2
+Version: 0.4.1
 Author: Edwin Thoen
 Maintainer: Edwin Thoen <[email protected]>
 Description: Transforms datetime data into a format ready for analysis.

diff --git a/LICENSE b/LICENSE
diff --git a/NAMESPACE b/NAMESPACE
diff --git a/NEWS.md b/NEWS.md
@@ -1,12 +1,8 @@
-# padr 0.4.2
+# padr 0.4.9000
 
-- Patch release requested by CRAN maintainers. Removed `sample` function from unit test.
-
-##################################################
-
-# padr 0.4.1
+## Bug Fixes / Enhancements
 
-- Patch release requested by CRAN maintainers. Declaring `lintr` as a dependency in tests.
+- Error within `padr` for `break_above` error message is corrected. No longer prints the number of millions in millions (HT Sharla Gelfand).
 
 ##################################################
 
@@ -20,7 +16,7 @@
 
 * `get_interval` is sped up significantly:
 
-- to convert date to character `format` is used, instead of `as.character`. For large vectors it is 4 to 5 times faster.
+- to convert date to character `format` is used, instead of `as.character`. For large vectors it 4 to 5 times faster.
 
 ## New Features
 

diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -8,4 +8,3 @@ round_down_core <- function(a, b) {
 round_up_core <- function(a, b) {
     .Call('_padr_round_up_core', PACKAGE = 'padr', a, b)
 }
-
diff --git a/R/check_date_variables.R b/R/check_date_variables.R
diff --git a/R/closest_weekday.R b/R/closest_weekday.R
diff --git a/R/create_emrgency.R b/R/create_emrgency.R
diff --git a/R/fill_functions.R b/R/fill_functions.R
diff --git a/R/formatting_funcs.R b/R/formatting_funcs.R
diff --git a/R/get_interval.R b/R/get_interval.R
diff --git a/R/helpers.R b/R/helpers.R
@@ -29,12 +29,6 @@ is_df <- function(x){
   }
 }
 
-has_rows <- function(x) {
-  if (nrow(x) == 0) {
-    stop("x has no rows", call. = FALSE)
-  }
-}
-
 check_start_and_end <- function(start_val, end_val) {
   if (!is.null(start_val)) {
     if (! (inherits(start_val, "Date") | inherits(start_val, "POSIXt")) ){

diff --git a/R/pad.R b/R/pad.R
@@ -97,8 +97,6 @@ pad <- function(x,
                 group     = NULL,
                 break_above = 1){
   is_df(x)
-  has_rows(x)
-
   check_start_and_end(start_val, end_val)
   group <- get_dplyr_groups(x, group)
 

diff --git a/R/pad_cust.R b/R/pad_cust.R
@@ -33,8 +33,6 @@ pad_cust <- function(x,
                      group     = NULL,
                      drop_last_spanned = TRUE){
   is_df(x)
-  has_rows(x)
-
   stop_not_datetime(spanned)
   group <- get_dplyr_groups(x, group)
 

diff --git a/R/pad_int.R b/R/pad_int.R
@@ -39,9 +39,8 @@ pad_int <- function(x,
                     start_val = NULL,
                     end_val   = NULL,
                     group     = NULL,
-                    step      = 1) {
+                    step      = 1){
   is_df(x)
-  has_rows(x)
 
   group <- get_dplyr_groups(x, group)
   if (!all(group %in% colnames(x))) {

diff --git a/R/span.R b/R/span.R
diff --git a/R/span_date.R b/R/span_date.R
diff --git a/R/subset_span.R b/R/subset_span.R
diff --git a/R/thicken.R b/R/thicken.R
@@ -25,8 +25,6 @@
 #' than the lowest value of the input datetime variable, with all time units on
 #' default value. Specify \code{start_val} as an offset if you want the range
 #' to be nonstandard.
-#' @param drop Should the original datetime variable be dropped from the
-#' returned data frame? Defaults to \code{FALSE}.
 #' @return The data frame \code{x} with the variable added to it.
 #' @details When the datetime variable contains missing values, they are left
 #' in place in the dataframe. The added column with the new datetime variable,
@@ -67,11 +65,9 @@ thicken <- function(x,
                     rounding = c('down',
                                  'up'),
                     by        = NULL,
-                    start_val = NULL,
-                    drop      = FALSE) {
+                    start_val = NULL) {
 
   is_df(x)
-  has_rows(x)
 
   original_data_frame <- x
   x <- as.data.frame(x)
@@ -86,6 +82,11 @@ thicken <- function(x,
   interval_converted$interval <- uniform_interval_name(interval_converted$interval)
   rounding <- match.arg(rounding)
 
+  if (check_for_sorting(dt_var)){
+    warning('Datetime variable was unsorted, result will be unsorted as well.',
+            call. = FALSE)
+  }
+
   if (inherits(start_val, 'POSIXt') & inherits(dt_var, 'POSIXt')) {
     start_val <- enforce_time_zone(start_val, dt_var)
   }
@@ -120,8 +121,6 @@ the interval specified is too low for the interval of the datetime variable", ca
   return_frame <- dplyr::bind_cols(x, thickened_frame)
   colnames(return_frame)[ncol(return_frame)] <- colname
 
-  if (drop) return_frame <- remove_original_var(return_frame, dt_var_name)
-
   set_to_original_type(return_frame, original_data_frame)
 }
 
@@ -214,6 +213,12 @@ start_val_after_min_dt <- function(start_val, dt_var) {
   }
 }
 
+check_for_sorting <- function(dt_var) {
+  # filter out missing values, there will be a warning thrown for them later
+  dt_var <- dt_var[!is.na(dt_var)]
+  !all(dt_var[1:(length(dt_var) - 1)] <= dt_var[2:length(dt_var)])
+}
+
 check_for_NA_thicken <- function(dt_var, dt_var_name, colname) {
   if (sum(is.na(dt_var))  > 0) {
     dt_var <- dt_var[!is.na(dt_var)]
@@ -235,7 +240,3 @@ add_na_to_thicken <- function(thickened, na_ind) {
   attr(return_var_ord, "tzone") <- attr(thickened, "tzone")
   return(return_var_ord)
 }
-
-remove_original_var <- function(x, var_name) {
-  x[, colnames(x) != var_name]
-}
diff --git a/R/thicken_cust.R b/R/thicken_cust.R
@@ -13,8 +13,6 @@
 #' @param by Only needs to be specified when \code{x} contains multiple
 #' variables of class \code{Date}, \code{POSIXct} or \code{POSIXlt}.
 #' Indicates which to use for thickening.
-#' @param drop Should the original datetime variable be dropped from the
-#' returned data frame? Defaults to \code{FALSE}.
 #' @details
 #' Only rounding down is available for custom thickening.
 #' @return The data frame \code{x} with the variable added to it.
@@ -31,11 +29,9 @@
 thicken_cust <- function(x,
                          spanned,
                          colname,
-                         by   = NULL,
-                         drop = FALSE) {
+                         by = NULL) {
 
   is_df(x)
-  has_rows(x)
 
   original_data_frame <- x
   x <- as.data.frame(x)
@@ -44,6 +40,11 @@ thicken_cust <- function(x,
   dt_var      <- dt_var_info$dt_var
   dt_var_name <- dt_var_info$dt_var_name
 
+  if (check_for_sorting(dt_var)){
+    warning('Datetime variable was unsorted, result will be unsorted as well.',
+            call. = FALSE)
+  }
+
   is_datetime(spanned)
   if (inherits(spanned, 'POSIXt') & inherits(dt_var, 'POSIXt')) {
     spanned   <- enforce_time_zone(spanned, dt_var)
@@ -67,8 +68,6 @@ thicken_cust <- function(x,
   return_frame <- dplyr::bind_cols(x, thickened_frame)
   colnames(return_frame)[ncol(return_frame)] <- colname
 
-  if (drop) return_frame <- remove_original_var(return_frame, dt_var_name)
-
   set_to_original_type(return_frame, original_data_frame)
 }
 

diff --git a/R/thicken_helpers.R b/R/thicken_helpers.R
diff --git a/README.Rmd b/README.Rmd
diff --git a/README.md b/README.md
diff --git a/cran-comments.md b/cran-comments.md
@@ -1,19 +1,29 @@
-Submissing patch release
+Resubmission
 
-As requested by Kurt Hornik, the behavior of sample() will be changed from R 3.6 onwards. Making some unit tests fail. The sampled data are replaced by hard coded values so this should be evaded now.
+As requested by Uwe Ligges changed link to other vignette in padr_custom.Rmd from
+
+https://cran.r-project.org/web/packages/padr/vignettes/padr.html
+
+to 
+
+https://CRAN.R-project.org/package=padr
+
+so it is in CRAN URL canonical form.
 
 ################################################
 
-# padr v0.4.2
+# padr v0.4.0
 
 ## Test environments
-* local OS X install, R 3.5
-* ubuntu 14.04.5 (on travis-ci), R 3.5
-* win-builder
+* local OS X install, R 3.4.2
+* ubuntu 14.04.5 (on travis-ci), R 3.4.2
+* win-builder (devel and release)
 
 ## R CMD check results
 
-All tests passed without Errors, Warnings, or Notes on all platforms (including "checking for unstated dependencies in 'tests'").
+0 errors | 0 warnings | 0 notes
 
+On win-builder only there was the standard NOTE
+* checking CRAN incoming feasibility
 
-There is one reverse dependency timetk. Since this is patch release the maintainers are not informed, changes cannot break dependencies.
+There is one reverse dependency timetk. Its maintainer Matt Dancho has received a personal email and assured me the new version works with timetk.
diff --git a/data/coffee.rda b/data/coffee.rda
diff --git a/data/emergency.rda b/data/emergency.rda
diff --git a/man/center_interval.Rd b/man/center_interval.Rd
diff --git a/man/closest_weekday.Rd b/man/closest_weekday.Rd
diff --git a/man/coffee.Rd b/man/coffee.Rd
diff --git a/man/emergency.Rd b/man/emergency.Rd
diff --git a/man/fill_by_function.Rd b/man/fill_by_function.Rd
diff --git a/man/fill_by_prevalent.Rd b/man/fill_by_prevalent.Rd
diff --git a/man/fill_by_value.Rd b/man/fill_by_value.Rd
diff --git a/man/format_interval.Rd b/man/format_interval.Rd
diff --git a/man/get_interval.Rd b/man/get_interval.Rd
diff --git a/man/pad.Rd b/man/pad.Rd
diff --git a/man/pad_cust.Rd b/man/pad_cust.Rd
diff --git a/man/pad_int.Rd b/man/pad_int.Rd
diff --git a/man/span_around.Rd b/man/span_around.Rd
diff --git a/man/span_date.Rd b/man/span_date.Rd
diff --git a/man/span_time.Rd b/man/span_time.Rd
diff --git a/man/subset_span.Rd b/man/subset_span.Rd
diff --git a/man/thicken.Rd b/man/thicken.Rd
diff --git a/man/thicken_cust.Rd b/man/thicken_cust.Rd
diff --git a/padr.Rproj b/padr.Rproj
diff --git a/scripts/emergency_data.R b/scripts/emergency_data.R
diff --git a/src/.Rapp.history b/src/.Rapp.history
diff --git a/src/.gitignore b/src/.gitignore
diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
diff --git a/src/padr_init.c b/src/padr_init.c
diff --git a/src/round_down_core.cpp b/src/round_down_core.cpp
diff --git a/src/round_up_core.cpp b/src/round_up_core.cpp
diff --git a/src/symbols.rds b/src/symbols.rds
diff --git a/tests/testthat.R b/tests/testthat.R
diff --git a/tests/testthat/library.R b/tests/testthat/library.R
diff --git a/tests/testthat/test_check_date_variables.R b/tests/testthat/test_check_date_variables.R
diff --git a/tests/testthat/test_closest_weekday.R b/tests/testthat/test_closest_weekday.R
diff --git a/tests/testthat/test_fill_functions.R b/tests/testthat/test_fill_functions.R
@@ -1,10 +1,12 @@
 source("library.R")
-
-x_df <- data_frame(x = as.Date(c("2019-01-01", "2019-01-04", "2019-01-06")),
-                   y1 = c(3, 5, 6),
-                   y2 = c(11, 14, 14),
-                   y3 = rep(10, 3),
-                   y4 = c("A", "A", "B")) %>% pad()
+set.seed(543)
+x <- seq(as.Date("2016-01-01"), by = "day", length.out = 366)
+x <- x[sample(1:366, 200)] %>% sort
+x_df <- data_frame(x  = x,
+                   y1 = runif(200, 10, 20) %>% round,
+                   y2 = runif(200, 1, 50) %>% round,
+                   y3 = rep(10, 200) %>% round,
+                   y4 = rep(letters[1:4], c(80, 60, 40, 20))) %>% pad
 
 context("Test the fill functions")
 
@@ -31,17 +33,17 @@ test_that("fill_by_value gives expected outcomes", {
 
 test_that("fill_by_function gives expected outcomes", {
   expect_error( fill_by_function(x_df, y1, fun = y2) )
-  expect_equal( fill_by_function(x_df, y1)$y1 %>% median, 4 + 2 / 3)
-  expect_equal( fill_by_function(x_df, y1, y2)$y1 %>% median, 4 + 2 / 3)
-  expect_equal( fill_by_function(x_df, y1, y2)$y2 %>% median, 13)
-  expect_equal( fill_by_function(x_df, y1, fun = median)$y1 %>% median, 5)
-  expect_equal( fill_by_function(x_df, y1, y2, fun = median)$y1 %>% median, 5)
+  expect_equal( fill_by_function(x_df, y1)$y1 %>% median, 14.77)
+  expect_equal( fill_by_function(x_df, y1, y2)$y1 %>% median, 14.77)
+  expect_equal( fill_by_function(x_df, y1, y2)$y2 %>% median, 22.765)
+  expect_equal( fill_by_function(x_df, y1, fun = median)$y1 %>% median, 15)
+  expect_equal( fill_by_function(x_df, y1, y2, fun = median)$y1 %>% median, 15)
 })
 
 test_that("fill_by_prevalent gives expected outcomes", {
-  expect_equal( fill_by_prevalent(x_df, y4)$y4[2], "A")
+  expect_equal( fill_by_prevalent(x_df, y4)$y4[2], "a")
   expect_equal( fill_by_prevalent(x_df, y3)$y3[2], 10)
-  expect_equal( fill_by_prevalent(x_df, y3, y4)$y4[2], "A")
+  expect_equal( fill_by_prevalent(x_df, y3, y4)$y4[2], "a")
   expect_equal( fill_by_prevalent(x_df, y3, y4)$y3[2], 10)
   expect_error( fill_by_prevalent(x_df, y1))
 })

diff --git a/tests/testthat/test_formatting_funcs.R b/tests/testthat/test_formatting_funcs.R
diff --git a/tests/testthat/test_get_interval.R b/tests/testthat/test_get_interval.R
diff --git a/tests/testthat/test_helpers.R b/tests/testthat/test_helpers.R
diff --git a/tests/testthat/test_pad.R b/tests/testthat/test_pad.R
diff --git a/tests/testthat/test_pad_cust.R b/tests/testthat/test_pad_cust.R
diff --git a/tests/testthat/test_pad_int.R b/tests/testthat/test_pad_int.R
diff --git a/tests/testthat/test_span.R b/tests/testthat/test_span.R
diff --git a/tests/testthat/test_span_date.R b/tests/testthat/test_span_date.R
diff --git a/tests/testthat/test_subset_span.R b/tests/testthat/test_subset_span.R
diff --git a/tests/testthat/test_thicken.R b/tests/testthat/test_thicken.R
@@ -54,6 +54,10 @@ test_that("thicken throws error when asked interval is lower", {
   expect_error( thicken(x_month, interval = "year"), NA)
 })
 
+test_that("thicken gives warning when unordered", {
+  expect_warning( thicken(x_month_unordered, interval =  "quarter") )
+  expect_warning( thicken(x_month, interval =  "quarter"), NA)
+})
 
 test_that("thicken gives informed error when start_val is wrong class", {
   expect_error(thicken(x_month, start_val = "2017-01-01",
@@ -141,17 +145,3 @@ Returned dataframe contains original observations, with NA values for d and d_we
   expect_equal(coffee_na_thickened %>% filter(is.na(d_week)) %>% nrow, 1)
   expect_equal(coffee_na_thickened$d[3] %>% as.character(), NA_character_)
 })
-
-context("thicken drop argument")
-test_that("the drop argument gives the desired result", {
-  hourly <- ymd_h(c("20160707 09",
-                    "20160707 09",
-                    "20160709 13",
-                    "20160710 10"), tz = "CET")
-  coffee_hour <- coffee %>% mutate(time_stamp_hour = hourly)
-  no_drop <- coffee_hour
-  with_drop <- coffee_hour %>% select(-time_stamp)
-  expect_equal(thicken(coffee, "hour"), no_drop)
-  expect_equal(thicken(coffee, "hour", drop = FALSE), no_drop)
-  expect_equal(thicken(coffee, "hour", drop = TRUE), with_drop)
-})
diff --git a/tests/testthat/test_thicken_cust.R b/tests/testthat/test_thicken_cust.R
@@ -44,26 +44,3 @@ test_that("thicken_cust works properly", {
   spanned_2 <- spanned_asym[c(2, 2)]
   expect_equal(thicken_cust_2, spanned_2)
 })
-
-context("thicken_cust drop argument")
-test_that("the drop argument gives the desired result", {
-  hourly <- ymd_h(c("20160707 09",
-                    "20160707 09",
-                    "20160709 13",
-                    "20160710 10"), tz = "CET")
-  coffee_hour <- coffee %>% mutate(time_stamp_hour = hourly)
-  no_drop <- coffee_hour
-  with_drop <- coffee_hour %>% select(-time_stamp)
-
-  expect_equal(sw(thicken_cust(coffee,
-                               spanned = hourly,
-                               colname = "time_stamp_hour")), no_drop)
-  expect_equal(sw(thicken_cust(coffee,
-                               spanned = hourly,
-                               colname = "time_stamp_hour",
-                               drop = FALSE)), no_drop)
-  expect_equal(sw(thicken_cust(coffee,
-                               spanned = hourly,
-                               colname = "time_stamp_hour",
-                               drop = TRUE)), with_drop)
-})
diff --git a/tests/testthat/test_thicken_helpers.R b/tests/testthat/test_thicken_helpers.R
diff --git a/tests/testthat/test_thicken_integration.R b/tests/testthat/test_thicken_integration.R
diff --git a/tests/testthat/test_zzz_lintr.R b/tests/testthat/test_zzz_lintr.R
diff --git a/vignettes/padr.Rmd b/vignettes/padr.Rmd
diff --git a/vignettes/padr_custom.Rmd b/vignettes/padr_custom.Rmd
diff --git a/vignettes/padr_implementation.Rmd b/vignettes/padr_implementation.Rmd
diff --git a/vignettes/thicken_graph.png b/vignettes/thicken_graph.png
Original file line number	Diff line number	Diff line change
Expand Up		@@ -8,4 +8,3 @@ round_down_core <- function(a, b) {
		round_up_core <- function(a, b) {
		.Call('_padr_round_up_core', PACKAGE = 'padr', a, b)
		}