R Under development (unstable) (2025-07-28 r88462 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2025 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> # This is a test script for RGENERATE::generate function
> # 
> # Author: Emanuele Cordano
> ###############################################################################
> rm(list=ls())
> 
> ## TESTING R CODE: 
> library(testthat)
> context("Verfiy RGENERATE::generate example output")
> 
> library(RGENERATE)
Loading required package: RMAWGEN
Loading required package: chron
Loading required package: date
Loading required package: vars
Loading required package: MASS
Loading required package: strucchange
Loading required package: zoo

Attaching package: 'zoo'

The following objects are masked from 'package:base':

    as.Date, as.Date.numeric

Loading required package: sandwich
Loading required package: urca
Loading required package: lmtest
Loading required package: magrittr

Attaching package: 'magrittr'

The following objects are masked from 'package:testthat':

    equals, is_less_than, not

> 
> 
> write_test_outcomes=FALSE
> ##test_outcomes=!write_test_outcomes
> 
> seed = 122
> set.seed(seed)
> NSTEP <- 1000
> x <- rnorm(NSTEP)
> y <- x+rnorm(NSTEP)
> z <- c(rnorm(1),y[-1]+rnorm(NSTEP-1))
> df <- data.frame(x=x,y=y,z=z)
> var <- VAR(df,type="none")
> gg <- generate(var,n=20) 
> if (write_test_outcomes)  saveRDS(gg,file="/home/ecor/local/rpackages/rendena100/RGENERATE/inst/outcomes/gg.rds")
> ggo <- readRDS(system.file("outcomes/gg.rds",package="RGENERATE")) 
> 
> ##ggo <- data.frame(x=1:10,y=0,z=0)
> ##
> test_that(desc="Testing generate.varest",code=expect_equal(gg,ggo, tolerance = .002, scale = 1))
Test passed 🌈
> ##
> 
> ##stop("QUI")
> cov <- cov(gg)
> set.seed(seed)
> ggg <- generate(FUN=rnorm,n=NSTEP,cov=cov)
> if (write_test_outcomes)  saveRDS(ggg,file="/home/ecor/local/rpackages/rendena100/RGENERATE/inst/outcomes/ggg.rds")
> gggo <- readRDS(system.file("outcomes/ggg.rds",package="RGENERATE")) 
> 
> test_that(desc="Testing generate.default",code=expect_equal(ggg,gggo, tolerance = .002, scale = 1))
Test passed 😸
> 
> ##test_that(desc="Testing generate.varest",code=expect_equal(test,test0, tolerance = .002, scale = 1))
> ##stop("QUI")
> 
> library(RMAWGEN)
> ####
> exogen <- as.data.frame(x+5)
> set.seed(seed)
> gpcavar <- getVARmodel(data=df,suffix=NULL,p=3,n_GPCA_iteration=5,
+                        n_GPCA_iteration_residuals=5,exogen=exogen)
Warning message:
In VAR(y = data_for_var, p = p, type = type, season = season, exogen = exogen,  :
  No column names supplied in exogen, using: exo1 , instead.

> gpcavar <- readRDS(system.file("outcomes/gpcavar.rds",package="RGENERATE")) ## gpcavar may differ in different machines! (This must be investigated!)
> gpcagg <- generate(gpcavar,n=20,exogen=exogen) 
> 
> ####
> if (write_test_outcomes)  saveRDS(gpcavar,file="/home/ecor/local/rpackages/rendena100/RGENERATE/inst/outcomes/gpcavar.rds")
> gpcavaro <- readRDS(system.file("outcomes/gpcavar.rds",package="RGENERATE")) 
> test_that(desc="Testing getVARMODEL output (gpcavar)",code=expect_equal(gpcavar,gpcavaro, tolerance = .002, scale = 1))
Test passed 😸
> 
> if (write_test_outcomes)  saveRDS(gpcagg,file="/home/ecor/local/rpackages/rendena100/RGENERATE/inst/outcomes/gpcagg.rds")
> gpcaggo <- readRDS(system.file("outcomes/gpcagg.rds",package="RGENERATE")) 
> 
> test_that(desc="Testing generate.GPCAvarest2",code=expect_equal(gpcagg,gpcaggo, tolerance = .002, scale = 1))
Test passed 🎉
> 
> ####
> ## Generate an auto-regrassive time-series with a generic matrix 
> 
> A <- diag(c(1,-1,1))
> set.seed(seed)
> mgg <- generate(A,n=100)
> 
> if (write_test_outcomes)  saveRDS(mgg,file="/home/ecor/local/rpackages/rendena100/RGENERATE/inst/outcomes/mgg.rds")
> mggo <- readRDS(system.file("outcomes/mgg.rds",package="RGENERATE"))
> 
> test_that(desc="Testing generate.matrix",code=expect_equal(mggo,mgg, tolerance = .002, scale = 1))
Test passed 🥇
> 
> 
> ### Gap Filling Examples
> # 
> # #### Gap filling with GPCAvarest (2 columns with NAs)
> # dfobs <- df
> # dfobs[20:30,] <- NA 
> # n <- nrow(df)
> # set.seed(seed)
> # dffill <- generate(gpcavar,n=n,exogen=exogen,gap.filling=dfobs,names=names(dfobs)) 
> # 
> # qqplot(dfobs$y,dffill$y)
> # abline(0,1)
> # 
> # if (write_test_outcomes)  saveRDS(dffill,file="/home/ecor/local/rpackages/rendena100/RGENERATE/inst/outcomes/dffill.rds")
> # dffillo <- readRDS(system.file("outcomes/dffill.rds",package="RGENERATE"))
> # 
> # test_that(desc="Testing gap filling with generate.GPCAvarest (2 columns with NAs) ",code=expect_equal(dffillo,dffill, tolerance = .002, scale = 1))
> # 
> 
> #### Gap filling with matrix 
> 
> mgg_n <- mgg
> mgg_n[20:30,2] <- NA 
> set.seed(seed)
> mgg_nfill <- generate(A,gap.filling=mgg_n)
> 
> 
> print(mgg_n[1:31,])
           V1         V2         V3
1   2.6214018  0.0000000  1.4655880
2   1.7455487 -0.8841121  2.3439300
3   1.9450724  1.3077684  1.7913577
4   2.4110268 -2.5948801  2.1125925
5   0.6089701  4.5546339  2.2968789
6   2.0577135 -6.7870954  2.5510361
7   2.3565674  6.3372773 -0.9872638
8   2.7183790 -5.6209964 -2.1569294
9   1.7114386  5.4743586 -0.9002127
10  1.4544395 -5.0271222 -2.3653138
11  1.3223107  6.5034196 -2.3212475
12  0.4806759 -5.9769965 -1.2446349
13  0.7549282  6.1879159 -0.7792725
14 -1.7076622 -6.2908337 -0.2659506
15 -3.8610582  6.1431625  1.0661802
16 -2.7018824 -7.7939728  0.1731444
17 -2.0121423  5.8247158  0.9358128
18 -1.1318910 -5.9475835  0.8204551
19 -2.0752612  7.0349240  2.5673568
20 -1.3561883         NA  3.4014561
21 -1.8940138         NA  3.5276045
22 -2.4166624         NA  4.2201990
23 -3.4695843         NA  3.7590331
24 -3.3680671         NA  3.8085548
25 -1.5045660         NA  3.1961856
26 -1.5241751         NA  2.4004884
27 -2.6024826         NA  2.2221963
28 -2.4298784         NA  1.8029699
29 -1.8968243         NA  3.4963299
30  0.0554402         NA  3.2803165
31  1.4667949  7.6923989  4.0652226
> print(mgg_nfill[1:31,])
           V1         V2         V3
1   2.6214018  0.0000000  1.4655880
2   1.7455487 -0.8841121  2.3439300
3   1.9450724  1.3077684  1.7913577
4   2.4110268 -2.5948801  2.1125925
5   0.6089701  4.5546339  2.2968789
6   2.0577135 -6.7870954  2.5510361
7   2.3565674  6.3372773 -0.9872638
8   2.7183790 -5.6209964 -2.1569294
9   1.7114386  5.4743586 -0.9002127
10  1.4544395 -5.0271222 -2.3653138
11  1.3223107  6.5034196 -2.3212475
12  0.4806759 -5.9769965 -1.2446349
13  0.7549282  6.1879159 -0.7792725
14 -1.7076622 -6.2908337 -0.2659506
15 -3.8610582  6.1431625  1.0661802
16 -2.7018824 -7.7939728  0.1731444
17 -2.0121423  5.8247158  0.9358128
18 -1.1318910 -5.9475835  0.8204551
19 -2.0752612  7.0349240  2.5673568
20 -1.3561883 -8.2283671  3.4014561
21 -1.8940138  8.5722884  3.5276045
22 -2.4166624 -8.5345797  4.2201990
23 -3.4695843  7.9313060  3.7590331
24 -3.3680671 -7.1701361  3.8085548
25 -1.5045660  7.9437117  3.1961856
26 -1.5241751 -7.2599326  2.4004884
27 -2.6024826  7.7036705  2.2221963
28 -2.4298784 -7.7216001  1.8029699
29 -1.8968243  7.6426507  3.4963299
30  0.0554402 -6.9618233  3.2803165
31  1.4667949  7.6923989  4.0652226
> 
> if (write_test_outcomes)  saveRDS(mgg_nfill,file="/home/ecor/local/rpackages/rendena100/RGENERATE/inst/outcomes/mgg_nfill.rds")
> mgg_nfillo <- readRDS(system.file("outcomes/mgg_nfill.rds",package="RGENERATE"))
> 
> test_that(desc="Testing gap filling with generate.matrix (autoregression)",code=expect_equal(mgg_nfillo,mgg_nfill, tolerance = .002, scale = 1))
Test passed 🥇
> 
> 
> 
> 
> # #### Gap filling with GPCAvarest (1 column with NAs)
> # dfobs2 <- df
> # dfobs2[20:30,2] <- NA
> # n <- nrow(df)
> # set.seed(seed)
> # dffill2 <- generate(gpcavar,n=n,exogen=exogen,gap.filling=dfobs2,names=names(dfobs2)) 
> # 
> # qqplot(dfobs2$y,dffill2$y)
> # abline(0,1)
> # 
> # if (write_test_outcomes)  saveRDS(dffill2,file="/home/ecor/local/rpackages/rendena100/RGENERATE/inst/outcomes/dffill2.rds")
> # dffill2o <- readRDS(system.file("outcomes/dffill2.rds",package="RGENERATE"))
> # 
> # test_that(desc="Testing gap filling with generate.GPCAvarest (1 column  with NAs)",code=expect_equal(dffill2o,dffill2, tolerance = .002, scale = 1))
> # 
> 
> 
> 
> ### generation with 'generetion.matrix' 
> ### and matrix 'x' is a covariance matrix 
> 
> covariance <- array(0.5,c(3,3))
> 
> diag(covariance) <- 1
> 
> set.seed(seed)
> ngns <- 1000
> gg1 <- generate(FUN=rnorm,n=ngns,cov=covariance)
> set.seed(seed)
> gg2 <- generate(covariance,type="covariance",n=ngns)
> 
> if (write_test_outcomes)  saveRDS(gg1,file="/home/ecor/local/rpackages/rendena100/RGENERATE/inst/outcomes/gg1.rds")
> gg1o <- readRDS(system.file("outcomes/gg1.rds",package="RGENERATE"))
> 
> test_that(desc="Testing generate.matrix (autoregression) (1)",code=expect_equal(gg1o,gg1, tolerance = .002, scale = 1))
Test passed 😸
> test_that(desc="Testing generate.matrix (autoregression) (2)",code=expect_equal(gg2,gg1, tolerance = .002, scale = 1))
Test passed 🎊
> 
> 
> ## generate with a list of covariance matrix 
> ndim <- 5
> dim <- c(ndim,ndim)
> CS1 <- array(0.3,dim)
> CS2 <- array(0.5,dim)
> CS3 <- array(0.7,dim)
> CS4 <- array(0.1,dim)
> 
> diag(CS1) <- 1
> diag(CS2) <- 1
> diag(CS3) <- 1
> diag(CS4) <- 1
> 
> list <- list(CS1=CS1,CS2=CS2,CS3=CS3,CS4=CS4)
> 
> series <- rep(1:4,times=4,each=100)
> series <- sprintf("CS%d",series)
> names_A <- sprintf("A%d",1:ndim)
> set.seed(seed)
> ggs <- generate(list,factor.series=series,FUN=rnorm,type="covariance",names=names_A)
> 
> 
> ####
> 
> 
> #####
> ggs_CS1 <- ggs[series=="CS1",]
> cov(ggs_CS1)
          A1        A2        A3        A4        A5
A1 1.1197663 0.2745120 0.3428389 0.2861430 0.2823685
A2 0.2745120 0.9834386 0.2490438 0.2814041 0.3263994
A3 0.3428389 0.2490438 0.9655494 0.2701315 0.2620820
A4 0.2861430 0.2814041 0.2701315 1.0172911 0.2795158
A5 0.2823685 0.3263994 0.2620820 0.2795158 1.0278654
> 
> ggs_CS3 <- ggs[series=="CS3",] 
> cov(ggs_CS3)
          A1        A2        A3        A4        A5
A1 0.9779602 0.7026040 0.7045227 0.6579017 0.6771827
A2 0.7026040 1.0294135 0.7146953 0.7006806 0.6690183
A3 0.7045227 0.7146953 1.0186356 0.6980989 0.6883297
A4 0.6579017 0.7006806 0.6980989 0.9793993 0.6466419
A5 0.6771827 0.6690183 0.6883297 0.6466419 0.9680262
> 
> if (write_test_outcomes)  saveRDS(ggs,file="/home/ecor/local/rpackages/rendena100/RGENERATE/inst/outcomes/ggs.rds")
> ggso <- readRDS(system.file("outcomes/ggs.rds",package="RGENERATE"))
> 
> test_that(desc="Testing generate.list (covariance)",code=expect_equal(ggso,ggs, tolerance = .002, scale = 1))
Test passed 🎊
> 
> 
> proc.time()
   user  system elapsed 
   3.39    0.48    3.87