tests/test_generate.R

In RGENERATE: Tools to Generate Vector Time Series

# 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)


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))
##

##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_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)
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))

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))

####
## 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))


### 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,])
print(mgg_nfill[1:31,])

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))




# #### 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_that(desc="Testing generate.matrix (autoregression) (2)",code=expect_equal(gg2,gg1, tolerance = .002, scale = 1))


## 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)

ggs_CS3 <- ggs[series=="CS3",] 
cov(ggs_CS3)

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))