test_that("the cycle classes are ok",
{
##
## BareCycle
expect_equal_to_reference(b <- new("BareCycle") , "BareCycle_0.rds")
expect_equal_to_reference(b1 <- new("BareCycle", nseasons = 1), "BareCycle_1.rds")
expect_equal_to_reference(b4 <- new("BareCycle", nseasons = 4), "BareCycle_4.rds")
expect_equal_to_reference(b12 <- new("BareCycle", nseasons = 12), "BareCycle_12.rds")
expect_identical({ new("BareCycle", nseasons = 1L) }, b1)
expect_identical({ new("BareCycle", nseasons = 4L) }, b4)
expect_identical({ new("BareCycle", 1) }, b1)
expect_identical({ new("BareCycle", 4) }, b4)
expect_identical(new("BareCycle", 5), pcCycle(5))
expect_identical(BuiltinCycle(7), new("DayWeekCycle"))
expect_identical(BuiltinCycle(7, first = 7), new("DayWeekCycle", first = 7))
expect_identical(BuiltinCycle(12), new("MonthYearCycle") )
expect_identical(new("BareCycle", 5), pcCycle(5))
## SimpleCycle
new("SimpleCycle")
expect_equal_to_reference(a1 <- new("SimpleCycle", 1), "SimpleCycle_1.rds")
expect_equal_to_reference(a4 <- new("SimpleCycle", 4), "SimpleCycle_4.rds")
expect_identical({ new("SimpleCycle", nseasons = 1) }, a1)
expect_identical({ new("SimpleCycle", nseasons = 4) }, a4)
expect_error({ new("SimpleCycle", c(4, 12)) },
"currently 'nseasons' should have length one")
## Builtin cycles - only check that the constructors don't give errors for now.
new("QuarterYearCycle")
new("MonthYearCycle")
dwc <- new("DayWeekCycle")
expect_equal(.get_period_length(dwc), 1)
expect_equal(.get_period_units(dwc), "days")
expect_error(new("FiveDayWeekCycle"),
"New objects from class 'FiveDayWeekCycle' can no longer be created")
## TODO: when class "FiveDayWeekCycle" is removed, modify "FiveDayWeekCycle_objects.R" to
## use Builtin(5) and regenerate "FiveDayWeekCycle_objects.rds".
fdc_all <- readRDS("FiveDayWeekCycle_objects.rds")
fdc <- fdc_all[[1]] # new("FiveDayWeekCycle")
expect_equal(.get_period_length(fdc), 1)
expect_equal(.get_period_units(fdc), "days")
.cycle_and_time2pair(fdc, as.Date(4)) # [1] 2 1
.cycle_and_time2pair(fdc, as.Date(6)) # [1] 2 3
.cycle_and_time2pair(fdc, as.Date(8)) # [1] 2 5
.cycle_and_time2pair(fdc, as.Date(9)) # [1] 2 NA (Saturday)
.cycle_offsets(fdc, 10, 1) # [1] 0 1 2 3 4 7 8 9 10 11
## two five-day weeks from Monday 1969-12-29
expect_equal(as.Date(.get_origin(fdc)) + 1 + .cycle_offsets(fdc, 10, 1),
c(seq(as.Date("1969-12-29"), as.Date("1970-01-02"), length.out = 5),
seq(as.Date("1970-01-05"), as.Date("1970-01-09"), length.out = 5)) )
unitSeason(fdc)
unitCycle(fdc)
allSeasons(fdc)
allSeasons(fdc, abb = TRUE)
allSeasons(fdc, abb = FALSE)
fdc[1:3]
fdc[]
.cycle_offsets(BuiltinCycle(7), 10, 1) # 0:9
expect_equal(
as.Date(.get_origin(BuiltinCycle(7))) + 1 + .cycle_offsets(BuiltinCycle(7), 10, 1),
seq(as.Date("1969-12-29"), by = "1 day", length.out = 10) )
## pdc5b <- new("FiveDayWeekCycle")
pdc5bP1 <- as.Date(Cyclic(cycle = fdc, start = c(1,1))) # "1969-12-29"
format(pdc5bP1)
pdc5bP2 <- as.Date(Cyclic(cycle = fdc, start = c(1,2))) # "1969-12-30"
format(pdc5bP2)
# pcpdc5bP1 <- as.pcdate(Cyclic(cycle = fdc, start = c(1,1))) # "W1 Monday"
# format(pcpdc5bP1)
# pcpdc5bP2 <- as.pcdate(Cyclic(cycle = fdc, start = c(1,2))) # "W1 Tuesday"
# format(pcpdc5bP2)
occ <- new("OpenCloseCycle")
expect_equal(.get_period_length(occ), 12)
expect_equal(.get_period_units(occ), "hours")
## 'Every30MinutesCycle'
e30 <- BuiltinCycle(48)
expect_equal(.get_period_length(e30), 30)
expect_equal(.get_period_units(e30), "minutes")
.get_origin(e30)
## TODO: this checks current behaviour, not clear it should stay so.
expect_equal(.get_period_length(BareCycle(3)), 1)
expect_equal(.get_period_units(BareCycle(3)), "seconds")
unitSeason(e30)
unitCycle(e30)
allSeasons(e30)
allSeasons(e30, abb = TRUE)
unitCycle()
unitSeason()
unitCycle(a4)
unitSeason(a4)
seqSeasons(a4)
allSeasons(a4)
a4a <- a4
unitCycle(a4a) <- "Godina"
unitSeason(a4a) <- "Trimesechie"
allSeasons(a4a) <- c("Parvo", "Vtoro", "Treto", "Chetvarto")
allSeasons(a4a, abb = TRUE) <- c("I", "II", "III", "IV")
expect_output(show(a4a))
a4a[1:2, abb = 2]
a4a[1:2, abb = -2]
a4a[abb = 2]
a4a[abb = -2]
a4a[1:2] <- letters[1:2]
a4a[] <- LETTERS[1:4]
new("QuarterYearCycle", first = 2)
qy <- new("QuarterYearCycle")
unitSeason(qy)
unitCycle(qy)
allSeasons(qy)
allSeasons(qy, abb = TRUE)
allSeasons(qy, abb = FALSE)
dw <- new("DayWeekCycle")
unitSeason(dw)
unitCycle(dw)
allSeasons(dw)
allSeasons(dw, abb = TRUE)
allSeasons(dw, abb = FALSE)
oc <- new("OpenCloseCycle")
unitSeason(oc)
unitCycle(oc)
allSeasons(oc)
allSeasons(oc, abb = TRUE)
allSeasons(oc, abb = FALSE)
BuiltinCycle(2)
BuiltinCycle(4)
BuiltinCycle(5)
BuiltinCycle(7)
yc <- BuiltinCycle(12)
BuiltinCycle(48)
expect_error(BuiltinCycle(19))
BuiltinCycle(19, stop = FALSE)
BuiltinCycle(19, coerce = TRUE, stop = FALSE)
BuiltinCycle(4, coerce = TRUE)
pdc5a <- new("PartialCycle", orig = new("DayWeekCycle"), subindex = 1:5)
expect_output(show(pdc5a))
unitSeason(pdc5a)
unitCycle(pdc5a)
allSeasons(pdc5a)
allSeasons(pdc5a, abb = TRUE)
pdc5a[1:3]
pdc5a[]
expect_equal(.get_origin(pdc5a), as.POSIXct("1969-12-28", "UTC"))
expect_equal(.get_offset(pdc5a), 0)
## pdcWeekend <- new("PartialDayWeekCycle", subindex = 6:7)
## unitSeason(pdcWeekend)
## unitCycle(pdcWeekend)
## allSeasons(pdcWeekend)
## allSeasons(pdcWeekend, abb = TRUE)
## pdcWeekend[1:3] # [1] "Saturday" "Sunday" NA ==> TODO: is this by design?
## pdcWeekend[]
## equivalent to above
pdcWeekend2 <- new("PartialCycle", orig = new("DayWeekCycle"), subindex = 6:7)
unitSeason(pdcWeekend2)
unitCycle(pdcWeekend2)
allSeasons(pdcWeekend2)
allSeasons(pdcWeekend2, abb = TRUE)
pdcWeekend2[1:3] # [1] "Saturday" "Sunday" NA ==> TODO: is this by design?
pdcWeekend2[]
as(yc, "SimpleCycle")
pcCycle(4)
pcCycle(4, "SimpleCycle")
pcCycle(4, "BareCycle")
cyc <- pcCycle(4, seasons = c("Spring", "Summer", "Autumn", "Winter"))
pcCycle(cyc, "BareCycle")
pcCycle(cyc,
unitCycle = "Year", unitSeason = "Season",
allSeasons = c("Spring", "Summer", "Autumn", "Winter"),
abb = c("Sp", "Su", "Au", "Wi"))
pcCycle(cyc, type = "SimpleCycle",
unitCycle = "Year", unitSeason = "Season",
allSeasons = c("Spring", "Summer", "Autumn", "Winter"),
abb = c("Sp", "Su", "Au", "Wi"))
pcCycle("QuarterYearCycle")
pcCycle("QuarterYearCycle", type = "BareCycle")
pcCycle("QuarterYearCycle", type = "SimpleCycle")
## Cyclic !!
ap <- pcts(AirPassengers)
nSeasons(ap) # 12
unitCycle(ap)
unitSeason(ap)
expect_equal(frequency(ap), 12)
expect_equal(deltat(ap), 1/12)
expect_equal(cycle(as(ap, "Cyclic")), 1) # only one value
expect_equal(frequency(as(ap, "Cyclic")), 12)
expect_equal(deltat(as(ap, "Cyclic")), 1/12)
## can't change built-in class 'MonthYearCycle'
expect_error(unitCycle(ap) <- "Godina")
expect_error(unitSeason(ap) <- "Sezon")
ap2 <- ap
ap2@cycle <- as(ap2@cycle, "SimpleCycle")
unitCycle(ap2) <- "Godina"
unitSeason(ap2) <- "Sezon"
allSeasons(ap2) <- paste0("S_", 1:12)
pcfr <- pcts(dataFranses1996)
## nSeasons(pcfr) # 4
expect_error(pcfr[[c(1,2)]],
"for \\[\\[ the length of argument i must be equal to one")
pctipiM <- pcfr["USTotalIPI"] # PeriodicMTS
plot(pctipiM)
tipi <- dataFranses1996[ , "USTotalIPI"]
## plot(tipi)
## convert to PeriodicTS and remove NA's at the start and end
pctipi <- pcts(tipi) # PeriodicTS
pctipi <- window(pctipi, start = availStart(pctipi), end = availEnd(pctipi))
plot(pctipi)
plot(autocorrelations(pctipi, maxlag = 10))
## pc-origin is as.Date("1970-01-01") - 4, Sunday
expect_equal(.date2pcweek(as.Date("1969-12-28")), c(0, 7))
expect_equal(.date2pcweek(as.Date("1969-12-29")), c(1, 1))
expect_equal(.date2pcweek(as.Date("1970-01-01")), c(1, 4))
expect_equal(.date2pcweek("1969-12-28"), c(0, 7))
expect_equal(.date2pcweek("1969-12-29"), c(1, 1))
expect_equal(.date2pcweek("1970-01-01"), c(1, 4))
expect_equal(pcweek2date(c(0, 7)), as.POSIXct("1969-12-28", "UTC"))
expect_equal(pcweek2date(c(1, 1)), as.POSIXct("1969-12-29", "UTC"))
expect_equal(pcweek2date(c(1, 4)), as.POSIXct("1970-01-01", "UTC"))
expect_equal(Cyclic(BuiltinCycle(7), "2020-04-06")@pcstart, c(2624, 1))
expect_equal(Cyclic(BuiltinCycle(5), "2020-04-06")@pcstart, c(2624, 1))
ap7to9 <- window(ap, seasons = 7:9)
expect_equal(allSeasons(window(ap, seasons = 7:9)), c("July", "August", "September") )
expect_equal(unitSeason(ap7to9), "Month")
expect_equal(unitCycle(ap7to9), "Year")
expect_output(show(ap7to9))
## start2pc_time(c(1,1), ap7to9@cycle)
as.Date(as(ap, "Cyclic"))
as.Date(ap)
as.Date(ap7to9)
as.Date(as(ap7to9, "Cyclic"))
as.Date("2019-08-01") + period(1, "months") * .cycle_offsets(ap7to9@cycle, 12, 2)
as_date(ap)
as_date(ap7to9)
as_date(as(ap7to9, "Cyclic"))
expect_identical(as.POSIXct(ap), as_datetime(ap))
as.Date(ap)
# as.pcdate(as(ap7to9, "Cyclic"))
# pcdate_ap7to9 <- as.pcdate(ap7to9)
#
# pcd1 <- pcdate(as.Date("2020-04-01"), BuiltinCycle(4))
# expect_equal(pcdate("2020-04-01", BuiltinCycle(4)), pcd1)
# expect_equal(pcdate(c(2020, 2), BuiltinCycle(4)), pcd1)
# format(pcdate_ap7to9)
# expect_output(str(pcdate_ap7to9))
Cyclic(cycle = pdcWeekend2, start = c(12, 1)) # Saturday
Cyclic(cycle = pdcWeekend2, start = c(12, 2)) # Sunday
Cyclic(cycle = pdcWeekend2, start = c(12, 3)) # weekday is NA
pdcWeekendP <- new("PartialCycle", orig = new("DayWeekCycle"), subindex = 6:7)
Cyclic(3, c(1,1))
.get_origin(BuiltinCycle(7))
.get_period(BuiltinCycle(7)) # [1] "1d 0H 0M 0S"
.get_period(BuiltinCycle(2)) # [1] "12H 0M 0S"
.get_period(BuiltinCycle(48)) # [1] "30M 0S"
.cycle_and_pair2time(BuiltinCycle(7), c(2624, 5)) # [1] "2020-04-10"
.cycle_and_pair2time(BuiltinCycle(7), c(2624, 2624, 5, 6)) # [1] "2020-04-10"
.cycle_and_time2pair(BuiltinCycle(7), as.Date("2020-04-10")) # [1] 2624 5
expect_equal(.cycle_and_time2pair(BuiltinCycle(12), as.Date("1970-04-01")),
c(1970, 4) )
expect_equal(.cycle_and_time2pair(BuiltinCycle(4), as.Date("1970-04-01")),
c(1970, 2) )
expect_equal(.cycle_and_time2pair(BuiltinCycle(5), as.Date("1970-01-01")), c(1, 4 ))
expect_equal(.cycle_and_time2pair(BuiltinCycle(5), as.Date("1970-01-02")), c(1, 5 ))
expect_equal(.cycle_and_time2pair(BuiltinCycle(5), as.Date("1970-01-03")), c(1, NA))
expect_equal(.cycle_and_time2pair(BuiltinCycle(5), as.Date("1970-01-04")), c(1, NA))
.cycle_and_pair2time(BuiltinCycle(7), c(1, 6)) == pcweek2date(c(1,6))
expect_equal(.cycle_and_pair2time(BuiltinCycle(7), c(1, 6)),
as.POSIXct("1970-01-03", "UTC"))
## Saturdays are not included in five day week, so:
expect_equal(.cycle_and_pair2time(BuiltinCycle(5), c(1, 6)),
as_datetime(NA, "UTC") )
.cycle_and_pair2time(BuiltinCycle(4), c(2020, 2)) # "2020-04-01 UTC"
.cycle_and_pair2time(BuiltinCycle(2), c(1, 1)) # [1] "1969-12-29 09:00:00 UTC"
.cycle_and_pair2time(BuiltinCycle(2), c(1, 2)) # [1] "1969-12-29 21:00:00 UTC"
.cycle_and_pair2time(BuiltinCycle(2), c(4, 1)) # [1] "1970-01-01 09:00:00 UTC"
.cycle_and_pair2time(BuiltinCycle(2), c(4, 2)) # [1] "1970-01-01 21:00:00 UTC"
twoweeks <- seq(as.Date("2020-04-13"), by = "day", length.out = 14)
# pcdate(twoweeks, BuiltinCycle(7))
twoyears <- seq(as.Date("2020-04-13"), by = "month", length.out = 14)
# pcdate(twoyears, BuiltinCycle(12))
eightquarters <- seq(as.Date("2020-01-01"), by = "3 months", length.out = 14)
# pcdate(eightquarters, BuiltinCycle(4))
# as.pcdate(pcts(dataFranses1996, nseasons = 4))
# as.pcdate(pcts(dataFranses1996, nseasons = 4))
expect_equal(.nperiods(BuiltinCycle(4), seq(as.Date("2020-04-01"), by ="3 months", length.out = 3)
), c(202, 203, 204) )
expect_equal(allSeasons(new("BareCycle")), character(0))
bc4 <- BareCycle(4)
allSeasons(bc4)
.get_period_units(bc4) # [1] "seconds"
.get_period_length(bc4) # [1] 1
.get_period(bc4) # [1] "1S"
.get_origin(bc4) # [1] "1970-01-01 UTC"
.nperiods(bc4, 5)
.cycle_and_time2pair(bc4, 5) # [1] 2 1
.cycle_and_time2pair(bc4, 13) # [1] 4 1
as.Date(.cycle_and_time2pair(bc4, 13)) # [1] "1970-01-05" "1970-01-02"
# pcdate(13, bc4) # [1] "C4 S1"
expect_error(date(bc4), "date is undefined for Cycle objects")
.cycle_and_pair2time(bc4, c(4, 1)) # [1] "1970-01-01 00:00:13 UTC"
.cycle_and_time2pair(bc4, 5) # [1] 2 1
.cycle_and_time2pair(bc4, 9) # [1] 3 1
fourseasons <- pcCycle(4, seasons = c("Spring", "Summer", "Autumn", "Winter"))
.get_period_units(fourseasons)
.get_period_length(fourseasons)
.get_period(fourseasons)
.get_origin(fourseasons)
.nperiods(fourseasons, 5)
## .mark_invalid_seasons_in_pairs
expect_equal(.mark_invalid_seasons_in_pairs(c(2020, 4), 7:9), c(2020, NA))
expect_equal(.mark_invalid_seasons_in_pairs(c(2020, 9), 7:9), c(2020, 9))
expect_equal(.mark_invalid_seasons_in_pairs(c(2020, NA), 7:9), c(2020, NA))
## more pairs
morepairs <- c(rep(2020, 12), 1:12)
morepairs.marked <- c(rep(2020, 12), c(rep(NA, 6), 7:9, rep(NA, 3)))
expect_equal(.mark_invalid_seasons_in_pairs(morepairs, 7:9), morepairs.marked)
expect_equal(.mark_invalid_seasons_in_pairs(c(1:6, c(1:3, 6,4,7)), 4:6),
c(1:6, NA, NA, NA, 6, 4, NA) )
.recode_seasons_in_pairs(c(5,5,5, 1,2,3), 7:9, 12)
expect_equal(ind2pctime(13, c(1, 1), 4), c(4, 1))
expect_equal(pctime2ind(c(4,1), c(1, 1), 4), 13)
expect_equal(pctime2ind(c(4,4), c(1, 1), 4), 16)
## more pairs
expect_equal(pctime2ind(c(4,4,4, 1,2,3), c(1, 1), 4), 13:15)
expect_equal(.allseas(BuiltinCycle(4), letters[1:4]), letters[1:4])
expect_equal(.allseas(BuiltinCycle(4, first = 2), letters[1:4]), letters[c(2,3,4, 1)])
## Pctime
Pctime(Sys.time(), BuiltinCycle(4)) # from datetime
pct2020_01_01 <- Pctime("2020-01-01", BuiltinCycle(4)) # from date
Pctime(pct2020_01_01) # from Pctime, no op.
expect_equal(cycle(Pctime(ap)), as.numeric(cycle(ap)))
expect_equal(cycle(Pctime(ap7to9)), rep(1:3, length.out = length(ap7to9)))
Pctime(c(4,1), bc4) # [1] "C4 S1"
expect_error(Pctime(bc4), "cycle not specified and cannot be inferred")
expect_error(Pctime(13, bc4), "the length of pairs must be even")
Pctime(c(4, 1), fourseasons) # [1] "C4 Spring"
Pctime(c(2020, 1), ap7to9@cycle) # [1] "Y2020 Jul"
Pctime(c(2020, 2), ap7to9@cycle) # [1] "Y2020 Aug"
Pctime(c(2020, 3), ap7to9@cycle) # [1] "Y2020 Sep"
Pctime(as.POSIXct(Sys.time()), BuiltinCycle(4))
pct1 <- Pctime(as.Date("2020-04-01"), BuiltinCycle(4))
expect_equal(Pctime("2020-04-01", BuiltinCycle(4)), pct1)
expect_equal(Pctime(c(2020, 2), BuiltinCycle(4)), pct1)
expect_equal(Pctime(c(2020, 2), BuiltinCycle(4)), Pctime("2020-04-01", BuiltinCycle(4)))
expect_output(str(pct1))
pct.ap <- Pctime(ap)
expect_true(!inherits(pct.ap[[1]], "Pctime"))
expect_true(inherits(pct.ap[1], "Pctime"))
expect_true(inherits(pct.ap[], "Pctime"))
expect_output(print(pct.ap[1])) #a bug was causing printing to fail, so check this works
pct.ap[1] <- as_date("2020-04-01")
Cyclic(pct.ap[1])
expect_warning(Cyclic(pct.ap), "got datetime start with length > 1, using first")
Cyclic(cycle = pdcWeekend2, start = as_datetime("2020-04-11")) # Sat
Cyclic(cycle = pdcWeekend2, start = as.Date("2020-04-11"))
as_Pctime(as(ap, "Cyclic"))
## TODO: think: one of as.Date() and date() may be redundant
## but: date has assignment counterpart, "date<-"
## but: as.Date() has '...' argument
date(as(ap, "Cyclic")) # ok but TODO: maybe format as date or time?
date(ap) # TODO: unintended, should define a method for PeriodicTimeSeries
format(Pctime(c(4, 1) , pdcWeekendP))
seq(Pctime(c(4, 1) , pdcWeekendP), length.out = 4)
as.POSIXct(Pctime(c(4, 1) , pdcWeekendP))
pdcWP1 <- as.Date(Cyclic(cycle = pdcWeekendP, start = c(1,1))) # "1970-01-03"
format(pdcWP1)
pdcWP2 <- as.Date(Cyclic(cycle = pdcWeekendP, start = c(1,2))) # "1970-01-04"
format(pdcWP2)
# pdcP1 <- as.pcdate(Cyclic(cycle = pdcWeekendP, start = c(1,1))) # "1970-01-03"
# format(pdcP1)
# pdcP2 <- as.pcdate(Cyclic(cycle = pdcWeekendP, start = c(1,2))) # "1970-01-04"
# format(pdcP2)
as.Date(pctipi)
# as.pcdate(pctipi)
# format(as.pcdate(pctipi))
as_Pctime(pctipi)
format(as_Pctime(pctipi))
as.Date(window(pctipi, seasons = 1:2))
as.Date(window(pctipi, seasons = c(1L, 3L)))
as.Date(window(pctipi, seasons = c(1L, 4L)))
as.Date(window(pctipi, seasons = c(2L, 3L)))
as.Date(window(pctipi, seasons = c(2L, 4L)))
as.Date(window(pctipi, seasons = 3:4))
# as.pcdate(window(pctipi, seasons = 1:2))
# as.pcdate(window(pctipi, seasons = c(1L, 3L)))
# as.pcdate(window(pctipi, seasons = c(1L, 4L)))
# as.pcdate(window(pctipi, seasons = c(2L, 3L)))
# as.pcdate(window(pctipi, seasons = c(2L, 4L)))
# as.pcdate(window(pctipi, seasons = 3:4))
# seqD1 <- seq(pcdate("2020-01-01", BuiltinCycle(4)), length.out = 12)
# expect_equal(class(seqD1), c("pcdate", "Date"))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.