tests/testthat/test-periodicTS.R

In GeoBosh/pcts: Periodically Correlated and Periodically Integrated Time Series

test_that("the new periodic classes are ok",
{
    ##
    b1 <- new("BareCycle", nseasons = 1)
    b12 <- new("BareCycle", nseasons = 12)

    ts1 <- new("PeriodicTS", cycle = b1, 1:10)
    ts2 <- new("PeriodicTS", cycle = b12, AirPassengers)
    ap.ts <- new("PeriodicTS_ts", AirPassengers)
    expect_identical(S3Part(ap.ts, strictS3 = TRUE), AirPassengers)

    expect_error(pcts(AirPassengers, nseasons = 4, keep = TRUE),
                 "please change the frequency of the ts object or use keep = FALSE" )
    
    expect_output(show(ts1))
    plot(ts1)
    
    ap.mts <- new("PeriodicTS_ts", AirPassengers) # multivar ts with one variable is ok

    ## `z' is from help page of ts()
    m <- matrix(rnorm(300), 100, 3)
    z <- ts(m, start = c(1961, 1), frequency = 12)

    pcts(1:10, nseasons = 2)
    expect_error(pcts(1:10), "nseasons is missing and cannot be inferred")

    
    pcts.m <- pcts(m, nseasons = 4)
    expect_error(pcts(m), "nseasons is missing and cannot be inferred")

    ## 2020-04-19: not an error any more
    ## expect_error(pcts.m[1, ],
    ##         "use x\\[\\]\\[i, \\] or x\\[\\]\\[i,j\\] if you wish to use matrix indexing")
    expect_identical(pcts.m[1, ], pcts.m[1, 1:ncol(m)])
    
    ## TODO: maybe need to check validity
    ##       Then these would give error (number of seasons is integer(0)
    z.ts  <- new("PeriodicTS", z) ## this creates an invalid object, similar to below
    z.mts <- new("PeriodicMTS", z) ## TODO: something wrong here! doesn't set nseasons
                                   ##       and the show() method throws error

    expect_error(new("PeriodicTS_ts", z),
                 'not a scalar time series; consider "PeriodicMTS_ts"')

    as(z, "PeriodicMTS") 
    expect_error(as(z, "PeriodicTS"),
                 "the time series is multivariate")

    as(z[ , 1], "PeriodicMTS") 
    as(z[ , 1], "PeriodicTS")

    ## artificially create 'mts' with one time series
    z1 <- ts(matrix(1:12, ncol = 1), frequency = 4, class = c("mts", "ts", "matrix"))
    z1.ts <- as(z1, "PeriodicTS")
    window(z1.ts)
    window(z1.ts, start = c(1,2))
    window(z1.ts, start = c(1,2), end = c(3,3))
    window(z1.ts,                 end = c(3,3))

    window(z1.ts, start = c(1,2), end = c(2,1)) <- NA

    zm <- ts(matrix(1:36, ncol = 3), frequency = 4, class = c("mts", "ts", "matrix"))
    zm.ts <- as(zm, "PeriodicMTS")
    window(zm.ts)
    window(zm.ts, start = c(1,2))
    window(zm.ts, start = c(2,1), end = c(3,4))
    window(zm.ts, start = c(1,2), end = c(3,3))
    window(zm.ts,                 end = c(3,3))

    window(zm.ts, start = c(1,2), end = c(2,1)) <- NA
    
    z.ts <- pcts(z[ , 1]) # ok
    z.mts <- pcts(z) # ok
    z.mts_ts <- new("PeriodicMTS_ts", z) # ok
    expect_identical(S3Part(z.mts_ts, strictS3 = TRUE), z)

    expect_output(show(window(z.ts, start = c(1967, 1))))
    
    z.mts_ts_keep <- pcts(z, keep = TRUE)
    expect_error(pcts(z, nseasons = 5, keep = TRUE),
                 "please change the frequency of the ts object or use keep = FALSE")

    z.ts_ts_keep <- pcts(z[ , 1], keep = TRUE)
    expect_error(pcts(z[ , 1], nseasons = 5, keep = TRUE),
                 "please change the frequency of the ts object or use keep = FALSE")

    pcts(AirPassengers, nseasons = 12, keep = TRUE)
    pcts(z, nseasons = 12, keep = TRUE)
        
    as(AirPassengers, "PeriodicTS")
    as(AirPassengers, "PeriodicTS_ts")
    pcts(AirPassengers)

    as(AirPassengers, "PeriodicTS")
    as(AirPassengers, "PeriodicTS_ts")

    ## as(AirPassengers, "PeriodicMTS")
    as(AirPassengers, "PeriodicMTS_ts")
    as(z, "PeriodicMTS_ts")

    new("PeriodicTS_ts", 1:12, frequency = 4)
    new("PeriodicTS_ts", matrix(1:12, ncol = 1), frequency = 4)
    expect_error(new("PeriodicTS_ts", matrix(1:24, ncol = 2), frequency = 4),
                 "not a scalar time series")

    new("PeriodicMTS_ts", 1:12, frequency = 4)
    new("PeriodicMTS_ts", matrix(1:12, ncol = 1), frequency = 4)

    cycle(z.mts_ts)
    time(z.mts_ts)

    expect_output(show(ap.ts) )
    expect_output(show(ap.mts))
    expect_output(show(z.mts))
    pcts(AirPassengers)

    monthplot(ap.ts)
    monthplot(ap.mts)
    monthplot(z.mts)

    boxplot(ap.ts)
    boxplot(ap.mts)
    boxplot(z.mts)

    nTicks(ap.ts)
    frequency(ap.ts)
    deltat(ap.ts)

    as.matrix(z.mts)

    pcts(AirPassengers)# missing nseasons, gets it from the object
    ## pcts(1:12) # this probably should issue warning

    expect_error(pcts(1:12), "nseasons is missing and cannot be inferred")
    pcts(1:12, nseasons = 4)
    pcts(1:12, nseasons = 4, start = c(2020, 1))
    pcts(1:12, nseasons = 4, start = c(2020, 2))
    pcts(1:12, nseasons = 4, start = "2020-04-01")

    pcts(1:12, nseasons = BuiltinCycle(4))
    pcts(1:12, nseasons = BuiltinCycle(4), start = c(2020, 1))
    pcts.seq12 <- pcts(1:12, nseasons = BuiltinCycle(4), start = c(2020, 2))
    pcts(1:12, nseasons = BuiltinCycle(4), start = "2020-04-01")

    expect_output( show(pcts.seq12) )
    cycle(pcts.seq12)
    
    pcts(as.matrix(z))
    
    Vec(z)
    tsVector(z)
    tsMatrix(z)
    ## pcArray(z)
    pcArray(ap.ts)
    pctsArray(ap.ts)

    z[] ## ts
    z.mts[]
    expect_identical(z.mts[], z.mts@.Data)           # ...MTS
    expect_identical(z.mts[[1]][], z.mts[[1]]@.Data) # ...TS

    identical(z.mts$"Series 1", z.mts[[1]])

    summary(z.mts)

    pcCycle(z.mts)
    pcCycle(z.mts, "")
    pcCycle(z.mts, "SimpleCycle")

    pcCycle(z[ , 1], "")
    pcCycle(z[ , 1], type = "SimpleCycle")

    pcCycle(as(z.mts, "Cyclic"))
    
    start(ap.ts)
    end(ap.ts)
    
    ## 2020-04-14: defined these methods for cyclic
    ##
    ## expect_error(nTicks(new("Cyclic", cycle = pcCycle(4))),
    ##              "unable to find an inherited method for function")
    ## expect_error(end(new("Cyclic", cycle = pcCycle(4))),
    ##              "unable to find an inherited method for function")
    pcc4 <- new("Cyclic", cycle = pcCycle(4))
    expect_equal(nTicks(pcc4), 1)
    expect_equal(start(pcc4), c(1, 1))
    expect_equal(end(pcc4), c(1, 1))
    expect_equal(cycle(pcc4), 1)
    
    expect_equal(nTicks(1:12), 12)
    expect_equal(nTicks(matrix(1:12, nrow = 6)), 6)

    ap <- pcts(AirPassengers)
    window(ap, start = c(1958, 1))
    window(ap, end = c(1958, 1))
    window(ap, start = c(1958, 1),  end = c(1960, 1))
    summary(ap)

    window(ap, seasons = 1:3)
    
    ap7to9 <- window(ap, seasons = 7:9)
    expect_equal(allSeasons(ap7to9), c("July", "August", "September"))
    unitSeason(ap7to9)
    unitCycle(ap7to9)
    ap7to9@cycle[1:2]
    ap7to9@cycle[1:2, abb = TRUE]

    ## removed
    ## start2pc_time(c(1,1), ap7to9@cycle)
    ## start2pc_time("1954-08-01", ap7to9@cycle) # TODO: process properly


    
    expect_output(show(ap7to9))
    
    head(z.mts)
    tail(z.mts)

    availStart(z.mts)
    availEnd(z.mts)

    plot(z.mts)
    
    ## TODO: this gives an error  in pcMatrix(z.mts[1]) since  nTicks is not a multiple of
    ##       the number of seasons
    ## plot(z.mts[1])

    as(z.mts[[1]], "ts")

    ## added after setting coerce method from PeriodicTS and PeriodicMTS to "Cyclic",
    ##     see the comments in PeriodicTSClasses.org
    pcfr <- pcts(dataFranses1996)
    expect_identical(as(pcfr, "Cyclic"), as(pcfr[[1]], "Cyclic"))

    pcfr2to4 <- pcfr[2:4]
    window(pcfr2to4, seasons = 1:2)

    expect_equivalent(pcMean(ap), pcMean(ap@.Data, nseasons = 12))
    expect_equivalent(pcMean(pcfr2to4, na.rm = TRUE),
                      pcMean(pcfr2to4@.Data, nSeasons(pcfr2to4), na.rm = TRUE) )

    ## drop first row to test non-full year
    pcMean(pcfr2to4@.Data[-1, ], nSeasons(pcfr2to4), na.rm = TRUE)

    expect_equal(pc_apply(ap@.Data, 12, mean), pc_mean(ap@.Data, 12))
    expect_equivalent(pc_apply(ap@.Data, 12, median), pcApply(ap@.Data, 12, median))

    ## argument nseasons is not used for PeriodicTS objects
    expect_error(pcApply(ap, 12, median),
                 "object 'FUN' of mode 'function' was not found")
    pcApply(ap, median)
    
    pcApply(pcfr2to4, median) # NA's
    expect_equivalent(pcApply(pcfr2to4@.Data, 4, median, na.rm = TRUE),
                      pcApply(pcfr2to4, median, na.rm = TRUE) )
    

    pct1990_Q3 <- Pctime(c(1990, 3), pcCycle(pcfr2to4))
    expect_identical(pcfr2to4[as_date("1990-07-01")], pcfr2to4[pct1990_Q3])

    ap_num <- as.numeric(AirPassengers)
    pcts(ap_num, 12)               # generic 12 seasons
    pcts(ap_num, BuiltinCycle(12)) # months
    pcts(ap_num, BuiltinCycle(12), start = c(1949, 1)) # months

    pcts(as.data.frame(dataFranses1996), nseasons = 4)
    df_mat <- as.matrix(dataFranses1996)
    pcts(df_mat[ , 1:3], 4)               # generic 4 seasons
    pcts(df_mat[ , 1:3], BuiltinCycle(4)) # quarters
    pcts(df_mat[ , 1:3], BuiltinCycle(4), start = c(1955, 1) ) # quarters

    expect_equal(AirPassengers[c(1, 143, 144)],
                 ap[c(1, 143, 144)] )
    expect_equal(ap[as.Date("1960-11-01")], 390)
    expect_equal(ap[Pctime(c(1949, 1960, 1960, 1, 11,12), pcCycle(ap))],
                 c(112, 390, 432) )
    expect_equal(ap[Pctime(c(1949, 1960, 1960, 1, 11,12), pcCycle(ap))],
                 ap[c(1, 143, 144)] )

    ## 1990 Q4
    expect_equal(pcfr2to4[as.Date("1990-10-01")],                  # Date
                 pcfr2to4[Pctime(c(1990, 4), pcCycle(pcfr2to4))] ) # Pctime

    expect_equal(pcfr2to4[as.Date("1990-10-01")],                  # matix indexing
                 pcfr2to4[144, ] )
    pcfr2to4[Pctime(c(1990, 4), pcCycle(pcfr2to4)), 1:2] # 1st two variables

    tsVec(pcfr2to4)
    
    dell <- pcts(four_stocks_since2016_01_01$DELL)
    dell[as.Date("2020-04-17")]
    dim(four_stocks_since2016_01_01$DELL) # [1] 923   6
    dim(dell) # [1] 958   6
    expect_equal(dell[as.Date("2020-04-17")], dell[958,])

    ## a subseries which starts and ends wtih NA's
    pcpres <- window(pcts(presidents), end = c(1972, 4))
    
    availStart(pcpres) # 1945 2
    availEnd(pcpres)   # 1972 2

    both <- na.trim(pcpres) # same as "both"
    expect_identical(na.trim(pcpres), both)
    expect_identical(na.trim(pcpres, "left"), window(pcpres, start = availStart(pcpres)))
    expect_identical(na.trim(pcpres, "right"), window(pcpres, end = availEnd(pcpres)))

    
    cguk <- pcfr[c("CanadaUnemployment", "GermanyGNP", "UKTotalInvestment")]
    
    availStart(cguk)
    availStart(cguk, TRUE)
    expect_identical(availStart(cguk), availStart(cguk, TRUE))
    availStart(cguk, FALSE)

    availEnd(cguk)
    availEnd(cguk, TRUE)
    expect_identical(availEnd(cguk), availEnd(cguk, TRUE))
    availEnd(cguk, FALSE)

    both <- na.trim(cguk) # same as "both"
    expect_identical(na.trim(cguk), both)
    expect_identical(na.trim(cguk, "left"), window(cguk, start = availStart(cguk, FALSE)))
    expect_identical(na.trim(cguk, "right"), window(cguk, end = availEnd(cguk, FALSE)))
})