test_getAggregateTS.R
In rAmCharts: JavaScript Charts Tool

# context("getTransformTS tests")
# 
# tz = "CET"
# date.begin = "2010/10/30 00:00:00"
# date.end = "2010/12/01 23:50:00"
# vdate <- seq.POSIXt(as.POSIXct(date.begin, tz=tz),
#                     as.POSIXct(date.end, tz=tz),
#                     by="10 min")
# data <- data.frame(date = vdate, value = rnorm(length(vdate)))
# 
# data_bad_name <- data.frame(date = vdate, `value 1` = rnorm(length(vdate)), check.names = FALSE)
# 
# # for checking col_by
# data_1 <- data.frame(date=vdate, id = "1", value = rnorm(length(vdate)))
# data_2 <- data.frame(date=vdate, id = "2", value = rnorm(length(vdate)))
# 
# # for check type.aggre
# data.last <- data
# data.last$date <- data.last$date+600
# 
# data.last_bad_name <- data_bad_name
# data.last_bad_name$date <- data.last_bad_name$date+600
# 
# data.last_1 <- data_1
# data.last_1$date <- data.last_1$date+600
# data.last_2 <- data_2
# data.last_2$date <- data.last_2$date+600
# 
# data_1_mult <- data.frame(date=vdate, id = "1", value_1=rnorm(length(vdate)), value_2=rnorm(length(vdate)))
# data_2_mult <- data.frame(date=vdate, id = "2", value_1=rnorm(length(vdate)), value_2=rnorm(length(vdate)))
# 
# test_that("getTransformTS & data.table object", {
#   if (require(data.table)) {
#     dt.ok <- getTransformTS(data = data.table(data), tz="CET", ts = "hour")
#     expect_equal("data.frame", class(dt.ok))
#     
#     dt.ok <- getTransformTS(data = data.table(data), tz="CET", ts = "5 min")
#     expect_equal("data.frame", class(dt.ok))
#     
#     dt.ok <- getTransformTS(data = data.table(data_bad_name), tz="CET", ts = "5 min")
#     expect_equal("data.frame", class(dt.ok))
#     
#     dt.ok <- getTransformTS(data = data.table(data_bad_name), tz="CET", ts = "hour")
#     expect_equal("data.frame", class(dt.ok))
#     
#   }
# })
# 
# test_that("getTransformTS variables name", {
#   colnames(data)[2] <- "123"
#   name.ok <- getTransformTS(data = data, tz = "CET", ts = "hour")
#   expect_equal("data.frame", class(name.ok))
# })
# 
# test_that("getTransformTS NA column", {
#   data[, 2] <- NA
#   class(data[, 2]) <- "numeric"
#   na.ok <- getTransformTS(data = data, tz = "CET", ts = "hour")
#   expect_equal("data.frame", class(na.ok))
# })
# 
# test_that("getTransformTS tz", {
#   cet <- getTransformTS(data = data, tz = "CET")
#   expect_equal(cet, data)
#   
#   utc <- getTransformTS(data = data, tz = "UTC")
#   data.utc <- data
#   attr(data.utc$date, "tzone") <- "UTC"
#   expect_equivalent(utc, data.utc)
#   
#   cet <- getTransformTS(data = data_bad_name, tz = "CET")
#   expect_equal(cet, data_bad_name)
#   
#   utc <- getTransformTS(data = data_bad_name, tz = "UTC")
#   data.utc <- data_bad_name
#   attr(data.utc$date, "tzone") <- "UTC"
#   expect_equivalent(utc, data.utc)
# })
# 
# 
# test_that("getTransformTS NA", {
#   data.na <- data
#   data.na <- data.na[-c(5, 6, 10),]
#   check <- getTransformTS(data=data.na, tz = "CET", control_date = TRUE)
#   expect_equal(dim(data), dim(check))
#   expect_true(all(is.na(check[c(5, 6, 10), 2])))
#   
#   check <- getTransformTS(data = data.na, tz = "CET", treat_missing = TRUE)
#   expect_equal(dim(data), dim(check))
#   expect_true(!any(is.na(check[, 2])))
#   expect_equal(mean(data[c(9, 11), 2]), check[10, 2])
#   
#   data.na <- data_bad_name
#   data.na <- data.na[-c(5, 6, 10),]
#   check <- getTransformTS(data=data.na, tz = "CET", control_date = TRUE)
#   expect_equal(dim(data_bad_name), dim(check))
#   expect_true(all(is.na(check[c(5, 6, 10), 2])))
#   
#   check <- getTransformTS(data = data.na, tz = "CET", treat_missing = TRUE)
#   expect_equal(dim(data_bad_name), dim(check))
#   expect_true(!any(is.na(check[, 2])))
#   expect_equal(mean(data_bad_name[c(9, 11), 2]), check[10, 2])
# })
# 
# 
# test_that("getTransformTS function", {
#   data.mean <- getTransformTS(data, tz = "CET", ts = "30 min",
#                               fun_aggr = "mean")
#   expect_equal(mean(data[1:3, 2]), data.mean[1, 2])
#   
#   data.sum <- getTransformTS(data, tz = "CET", ts = "30 min",
#                              fun_aggr = "sum")
#   expect_equal(sum(data[1:3, 2]), data.sum[1, 2])
#   
#   data.min <- getTransformTS(data, tz = "CET", ts = "30 min",
#                              fun_aggr = "min")
#   expect_equal(min(data[1:3, 2]), data.min[1, 2])
#   
#   data.max <- getTransformTS(data, tz = "CET", ts = "30 min",
#                              fun_aggr = "max")
#   expect_equal(max(data[1:3, 2]), data.max[1, 2])
#   
#   
#   data.mean <- getTransformTS(data_bad_name, tz = "CET", ts = "30 min",
#                               fun_aggr = "mean")
#   expect_equal(mean(data_bad_name[1:3, 2]), data.mean[1, 2])
#   
#   data.sum <- getTransformTS(data_bad_name, tz = "CET", ts = "30 min",
#                              fun_aggr = "sum")
#   expect_equal(sum(data_bad_name[1:3, 2]), data.sum[1, 2])
#   
#   data.min <- getTransformTS(data_bad_name, tz = "CET", ts = "30 min",
#                              fun_aggr = "min")
#   expect_equal(min(data_bad_name[1:3, 2]), data.min[1, 2])
#   
#   data.max <- getTransformTS(data_bad_name, tz = "CET", ts = "30 min",
#                              fun_aggr = "max")
#   expect_equal(max(data_bad_name[1:3, 2]), data.max[1, 2])
# })
# 
# test_that("getTransformTS full", {
#   stats <- c("min", "max", "mean", "sum")
#   ts <- c(10 * 60, 30 * 60, 60 * 60, 120 * 60, 180 * 60, 24 * 60 * 60)
#   test <- expand.grid(stats, ts)
#   ctrl <- sapply(1:nrow(test), function(x) {
#     stats <- as.character(test[x, 1])
#     ts <- test[x, 2]
#     
#     data.check.first <- getTransformTS(data, tz = "CET", ts = ts,
#                                        fun_aggr = stats, type_aggr = "first")
#     
#     data.check.last <- getTransformTS(data.last, tz = "CET", ts = ts,
#                                       fun_aggr = stats, type_aggr = "last")
#     
#     expect_equal(data.check.first[1:nrow(data.check.first), "value"], 
#                  data.check.last[1:nrow(data.check.first), "value"])
#     
#     data.check.first <- getTransformTS(data_bad_name, tz = "CET", ts = ts,
#                                        fun_aggr = stats, type_aggr = "first")
#     
#     data.check.last <- getTransformTS(data.last_bad_name, tz = "CET", ts = ts,
#                                       fun_aggr = stats, type_aggr = "last")
#     
#     expect_equal(data.check.first[1:nrow(data.check.first), "value 1"], 
#                  data.check.last[1:nrow(data.check.first), "value 1"])
#     
#     data.check.first_1 <- getTransformTS(data_1, col_series = "value", tz = "CET", ts = ts,
#                                          fun_aggr = stats, type_aggr = "first")
#     
#     data.check.first_2 <- getTransformTS(data_2, col_series = "value", tz = "CET", ts = ts,
#                                          fun_aggr = stats, type_aggr = "first")
#     
#     data.check.first_12 <- getTransformTS(rbindlist(list(data_1, data_2)), col_by = "id", 
#                                           tz = "CET", ts = ts,
#                                           fun_aggr = stats, type_aggr = "first")
#     
#     expect_equivalent(data.check.first_1, 
#                       data.check.first_12[data.check.first_12$id == "1", c("date", "value")])
#     
#     expect_equivalent(data.check.first_2, 
#                       data.check.first_12[data.check.first_12$id == "2", c("date", "value")])
#     
#     data.check.last_1 <- getTransformTS(data.last_1, col_series = "value", tz = "CET", ts = ts,
#                                         fun_aggr = stats, type_aggr = "last")
#     
#     data.check.last_2 <- getTransformTS(data.last_2, col_series = "value", tz = "CET", ts = ts,
#                                         fun_aggr = stats, type_aggr = "last")
#     
#     data.check.last_12 <- getTransformTS(rbindlist(list(data.last_1, data.last_2)), col_by = "id", 
#                                          tz = "CET", ts = ts,
#                                          fun_aggr = stats, type_aggr = "last")
#     
#     expect_equivalent(data.check.last_1, 
#                       data.check.last_12[data.check.last_12$id == "1", c("date", "value")])
#     
#     expect_equivalent(data.check.last_2, 
#                       data.check.last_12[data.check.last_12$id == "2", c("date", "value")])
#     
#     expect_equal(data.check.first_12[1:nrow(data.check.first_12), "value"], 
#                  data.check.last_12[1:nrow(data.check.first_12), "value"])
#     
#     
#     data.check.first_1_mult <- getTransformTS(data_1_mult, col_series = c("value_1", "value_2"), tz = "CET", ts = ts,
#                                               fun_aggr = stats, type_aggr = "first")
#     
#     data.check.first_2_mult <- getTransformTS(data_2_mult, col_series = c("value_1", "value_2"), tz = "CET", ts = ts,
#                                               fun_aggr = stats, type_aggr = "first")
#     
#     data.check.first_12_mult <- getTransformTS(rbindlist(list(data_1_mult, data_2_mult)), col_by = "id", 
#                                                tz = "CET", ts = ts,
#                                                fun_aggr = stats, type_aggr = "first")
#     
#     data.check.first_12_mult_one <- getTransformTS(rbindlist(list(data_1_mult, data_2_mult)), col_by = "id", 
#                                                    col_series = "value_1",
#                                                    tz = "CET", ts = ts,
#                                                    fun_aggr = stats, type_aggr = "first")
#     
#     data.check.first_12_mult_two <- getTransformTS(rbindlist(list(data_1_mult, data_2_mult)), col_by = "id", 
#                                                    col_series = "value_2",
#                                                    tz = "CET", ts = ts,
#                                                    fun_aggr = stats, type_aggr = "first")
#     
#     expect_equivalent(data.check.first_1_mult, 
#                       data.check.first_12_mult[data.check.first_12_mult$id == "1", c("date", "value_1", "value_2")])
#     
#     expect_equivalent(data.check.first_2_mult, 
#                       data.check.first_12_mult[data.check.first_12_mult$id == "2", c("date", "value_1", "value_2")])
#     
#     expect_equivalent(data.check.first_12_mult[, c("date", "value_1")], 
#                       data.check.first_12_mult_one[, c("date", "value_1")])
#     
#     expect_equivalent(data.check.first_12_mult[, c("date", "value_2")], 
#                       data.check.first_12_mult_two[, c("date", "value_2")])
#     
#   })
# })
# 
# test_that("getTransformTS aggregation", {
#   data.30.min <- getTransformTS(data, tz = "CET", ts = "30 min")
#   expect_equal(mean(data[1:3, 2]), data.30.min[1, 2])
#   
#   data.hour <- getTransformTS(data, tz = "CET", ts = "hour")
#   expect_equal(mean(data[1:6, 2]), data.hour[1, 2])
#   
#   data.2.hours <- getTransformTS(data, tz = "UTC", ts = "2 hour")
#   expect_equal(mean(data[1:12, 2]), data.2.hours[1, 2])
#   
#   data.days <- getTransformTS(data, tz = "CET", ts = "day")
#   expect_equal(mean(data[1:144, 2]), data.days[1, 2])
#   
#   
#   data.30.min <- getTransformTS(data_bad_name, tz = "CET", ts = "30 min")
#   expect_equal(mean(data_bad_name[1:3, 2]), data.30.min[1, 2])
#   
#   data.hour <- getTransformTS(data_bad_name, tz = "CET", ts = "hour")
#   expect_equal(mean(data_bad_name[1:6, 2]), data.hour[1, 2])
#   
#   data.2.hours <- getTransformTS(data_bad_name, tz = "UTC", ts = "2 hour")
#   expect_equal(mean(data_bad_name[1:12, 2]), data.2.hours[1, 2])
#   
#   data.days <- getTransformTS(data_bad_name, tz = "CET", ts = "day")
#   expect_equal(mean(data_bad_name[1:144, 2]), data.days[1, 2])
#   
# })
# 
# 
# test_that("getTransformTS interpolation", {
#   
#   data.5.min <- getTransformTS(data, tz = "CET", ts = "5 min")
#   expect_equal(mean(data[1:2, 2]), data.5.min[2, 2])
#   
#   data_1_5m <- getTransformTS(data_1, col_series = "value", tz = "CET", ts = "5 min")
#   expect_equal(mean(data_1[1:2, 3]), data_1_5m[2, 2])
#   
#   data_2_5m <- getTransformTS(data_2, col_series = "value", tz = "CET", ts = "5 min")
#   expect_equal(mean(data_2[1:2, 3]), data_2_5m[2, 2])
#   
#   data_12_5m <- getTransformTS(rbindlist(list(data_1, data_2)), col_by = "id", 
#                                col_series = "value", tz = "CET", ts = "5 min")
#   expect_equivalent(data_1_5m, 
#                     data_12_5m[data_12_5m$id == "1", c("date", "value")])
#   
#   expect_equivalent(data_2_5m, 
#                     data_12_5m[data_12_5m$id == "2", c("date", "value")])
#   
#   vdate <- seq.POSIXt(as.POSIXct(date.begin, tz = tz),
#                       as.POSIXct(date.end, tz = tz),
#                       by = "2 hour")
#   
#   data_1_5m_mult <- getTransformTS(data_1_mult, col_series = c("value_1", "value_2"), tz = "CET", ts = "5 min")
#   expect_equal(mean(data_1_mult[1:2, 3]), data_1_5m_mult[2, 2])
#   expect_equal(mean(data_1_mult[1:2, 4]), data_1_5m_mult[2, 3])
#   
#   data_2_5m_mult <- getTransformTS(data_2_mult, col_series = c("value_1", "value_2"), tz = "CET", ts = "5 min")
#   expect_equal(mean(data_2_mult[1:2, 3]), data_2_5m_mult[2, 2])
#   expect_equal(mean(data_2_mult[1:2, 4]), data_2_5m_mult[2, 3])
#   
#   data_12_5m_mult <- getTransformTS(rbindlist(list(data_1_mult, data_2_mult)), col_by = "id", 
#                                col_series = c("value_1", "value_2"), tz = "CET", ts = "5 min")
#   
#   data_12_5m_mult_one <- getTransformTS(rbindlist(list(data_1_mult, data_2_mult)), col_by = "id", 
#                                     col_series = c("value_1"), tz = "CET", ts = "5 min")
#   
#   data_12_5m_mult_two <- getTransformTS(rbindlist(list(data_1_mult, data_2_mult)), col_by = "id", 
#                                         col_series = c("value_2"), tz = "CET", ts = "5 min")
#   
#   expect_equivalent(data_1_5m_mult, 
#                     data_12_5m_mult[data_12_5m_mult$id == "1", c("date", "value_1", "value_2")])
#   
#   expect_equivalent(data_2_5m_mult, 
#                     data_12_5m_mult[data_12_5m_mult$id == "2", c("date", "value_1", "value_2")])
#   
#   expect_equivalent(data_12_5m_mult[, c("date", "value_1")], 
#                     data_12_5m_mult_one[, c("date", "value_1")])
#   
#   expect_equivalent(data_12_5m_mult[, c("date", "value_2")], 
#                     data_12_5m_mult_two[, c("date", "value_2")])
#   
#   
#   data <- data.frame(date = vdate, value = rnorm(length(vdate)))
#   data.hour <- getTransformTS(data, tz = "CET", ts = "hour")
#   expect_equal(mean(data[1:2, 2]), data.hour[2, 2])
#   
#   
#   data.5.min <- getTransformTS(data_bad_name, tz = "CET", ts = "5 min")
#   expect_equal(mean(data_bad_name[1:2, 2]), data.5.min[2, 2])
#   
# })
# 
# 
# test_that("getTransformTS control", {
#   
#   expect_error(getTransformTS(data, ts = "30 min", fun_aggr = "sd"))
#   expect_error(getTransformTS(data, ts = 10))
#   expect_error(getTransformTS(data, col_date = "wrongname"))
#   expect_error(getTransformTS(data, col_quanti = "wrongname"))
#   
#   # exotic sequence
#   expect_error(getTransformTS(data, ts = "15 min"))
#   expect_error(getTransformTS(data, ts = "25 min"))
#   expect_error(getTransformTS(data, ts = "80 min"))
#   expect_error(getTransformTS(data, ts = 90*60))
#   expect_error(getTransformTS(data, ts = 5*60*60))
#   expect_error(getTransformTS(data, ts = "5 hour"))
#   expect_error(getTransformTS(data, ts = "36 hour"))
#   expect_error(getTransformTS(data, ts = "450 day"))
#   
#   # # warning on head and tail
#   # expect_warning(getTransformTS(data, ts = 4*60*60, tz = "UTC", showwarn = T))
#   # expect_warning(getTransformTS(data[-1, ], ts = "hour", tz = "CET", showwarn = T))
#   # expect_warning(getTransformTS(data[-nrow(data), ], ts = "hour", tz = "CET", showwarn = T))
#   
#   #check quanti
#   data.notquanti <- cbind(data, valuechar = as.character(data$value), stringsAsFactors = FALSE)
#   expect_error(getTransformTS(data.notquanti, col_quanti = c("value", "valuechar")))
#   
# })