Improve artificial data generation and tests (Resolves #42)

Stan125 · Oct 9, 2017 · 3b52fca · 3b52fca
1 parent 40d0b53
commit 3b52fca
Show file tree

Hide file tree

Showing 9 changed files with 47 additions and 22 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -1,3 +1,4 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
 ^\.travis\.yml$
+^\.httr-oauth$
diff --git a/.gitignore b/.gitignore
@@ -2,3 +2,4 @@
 .Rhistory
 .RData
 .Ruserdata
+.httr-oauth
diff --git a/R/model_fam_data.R b/R/model_fam_data.R
@@ -38,7 +38,8 @@ model_fam_data <- function(nrow = 500, seed = 1408) {
 
 
   ## Families
-  data <- data.frame(beta = qbeta(u_data$v1, 2, 5), # Beta distribution, alpha = 2, beta = 5
+  data <- data.frame(normal = qnorm(u_data$v1),
+                     beta = qbeta(u_data$v1, 2, 5), # Beta distribution, alpha = 2, beta = 5
                      binomial = qbinom(u_data$v1, 1, 0.8), # Binomial distribution, pi = 0.8
                      cnorm = cnorm_bamlss()$q(u_data$v1, # Cnorm distribution, mu = 5, sigma = 2
                                               par = list(mu = 5, sigma = 2)),

diff --git a/demo/all_models_demo.R b/demo/all_models_demo.R
@@ -14,6 +14,11 @@ art_data <- GAMart()
 
 ### --- Models --- ###
 
+# Normal model
+normal_model <- bamlss(list(normal ~ norm1 + norm2,
+                            sigma ~ norm1 + norm2),
+                       data = data_fam, family = gaussian_bamlss())
+
 # Beta dist model
 beta_model <- bamlss(list(beta ~ norm1 + norm2,
                           sigma2 ~ norm1 + norm2),
@@ -45,6 +50,7 @@ multinomial_model <- bamlss(list(multinomial ~ norm1 + norm2),
                             data = data_fam,
                             family = multinomial_bamlss())
 
+# MVnorm model
 mvnorm_model <- bamlss(list(cbind(num, err) ~ x1 + x2 + x3,
                             sigma1 ~ 1,
                             sigma2 ~ 1), data = art_data,
@@ -60,36 +66,40 @@ expl_mvnorm <- sample_n(art_data, 5) %>%
   select(x1:x3) %>%
   mutate(intercept = TRUE)
 
+# Normal
+normal_p <- preds(normal_model, expl)
+
 # Beta
-beta_p <- bamlss.vis:::preds(beta_model, expl)
+beta_p <- preds(beta_model, expl)
 
 # Binomial
-binomial_p <- bamlss.vis:::preds(binomial_model, expl)
+binomial_p <- preds(binomial_model, expl)
 
 # Cnorm
-cnorm_p <- bamlss.vis:::preds(cnorm_model, expl)
+cnorm_p <- preds(cnorm_model, expl)
 
 # Gamma
-gamma_p <- bamlss.vis:::preds(gamma_model, expl)
+gamma_p <- preds(gamma_model, expl)
 
 # GPareto
-gpareto_p <- bamlss.vis:::preds(gpareto_model, expl)
+gpareto_p <- preds(gpareto_model, expl)
 
 # Poisson
-poisson_p <- bamlss.vis:::preds(poisson_model, expl)
+poisson_p <- preds(poisson_model, expl)
 
 # Multinomial model
-multinomial_p <- bamlss.vis:::preds(multinomial_model, expl)
+multinomial_p <- preds(multinomial_model, expl)
 
 # MVnorm model
-mvnorm_p <- bamlss.vis:::preds(mvnorm_model, expl_mvnorm)
+mvnorm_p <- preds(mvnorm_model, expl_mvnorm)
 
 ## --- Plots --- ###
 # Function because I'm lazy
 plot_f <- function(model, preds)
   return(list(plot_dist(model, preds),
               plot_dist(model, preds, type = "cdf")))
 
+normal_plots <- plot_f(normal_model, normal_p)
 beta_plots <- plot_f(beta_model, beta_p)
 binomial_plots <- plot_f(binomial_model, binomial_p)
 cnorm_plots <- plot_f(cnorm_model, cnorm_p)
@@ -105,6 +115,7 @@ mvnorm_pdf_image <- bamlss.vis:::pdfcdf_2d(mvnorm_p, mvnorm_model, type = "pdf",
                                      display = "image")
 
 ## --- Show da plots --- ###
+grid.arrange(grobs = normal_plots) # normal
 grid.arrange(grobs = beta_plots) # beta
 grid.arrange(grobs = binomial_plots) # binomial
 grid.arrange(grobs = cnorm_plots) # cnorm

diff --git a/tests/testthat/test_01_create_models.R b/tests/testthat/test_01_create_models.R
@@ -4,6 +4,9 @@
 # Remove everything
 rm(list = ls())
 
+# Skip on cran
+skip_on_cran()
+
 # Libraries
 library(bamlss.vis)
 library(dplyr)
@@ -16,10 +19,14 @@ set.seed(1408)
 
 ## --- Generating data --- ##
 data_fam <- model_fam_data()
-art_data <- GAMart()
 
 ### --- Models --- ###
 
+# Normal model
+normal_model <- bamlss(list(normal ~ norm1 + norm2,
+                            sigma ~ norm1 + norm2),
+                       data = data_fam, family = gaussian_bamlss())
+
 # Beta dist model
 beta_model <- bamlss(list(beta ~ norm1 + norm2,
                           sigma2 ~ norm1 + norm2),
@@ -51,11 +58,12 @@ multinomial_model <- bamlss(list(multinomial ~ norm1 + norm2),
                             data = data_fam,
                             family = multinomial_bamlss())
 
+# MVnorm model
 suppressWarnings({
-  mvnorm_model <- bamlss(list(cbind(num, err) ~ x1 + x2 + x3,
-                            sigma1 ~ 1,
-                            sigma2 ~ 1), data = art_data,
-                       family = mvnorm_bamlss(k = 2))
+  mvnorm_model <- bamlss(list(normal ~ norm1 + norm2,
+                              norm1 ~ norm2 + normal),
+                         data = data_fam,
+                         family = mvnorm_bamlss(k = 2))
 })
 
 ### --- Predictions --- ###
@@ -64,12 +72,8 @@ suppressWarnings({
 expl <- sample_n(data_fam, 5) %>%
   select(norm1:norm2) %>%
   mutate(intercept = TRUE)
-expl_mvnorm <- sample_n(art_data, 5) %>%
-  select(x1:x3) %>%
-  mutate(intercept = TRUE)
-
 
 ### --- Save models --- ###
 save(file = "models_data.RData",
-     list = c(ls()[grepl("model|expl", ls())]), "art_data", "data_fam")
+     list = c(ls()[grepl("model", ls())]), "data_fam", "expl")
 
diff --git a/tests/testthat/test_02_make_predictions.R b/tests/testthat/test_02_make_predictions.R
@@ -10,7 +10,8 @@ library(bamlss.vis)
 load("models_data.RData")
 
 ## --- Predictions --- ##
-# Gaussian missing
+# Normal
+normal_p <- preds(normal_model, expl)
 
 # Beta
 beta_p <- bamlss.vis:::preds(beta_model, expl)
@@ -35,7 +36,7 @@ multinomial_p <- bamlss.vis:::preds(multinomial_model, expl)
 
 # MVnorm model
 suppressWarnings({
-  mvnorm_p <- bamlss.vis:::preds(mvnorm_model, expl_mvnorm)
+  mvnorm_p <- bamlss.vis:::preds(mvnorm_model, expl)
 })
 
 ## --- Save predictions --- ##

diff --git a/tests/testthat/test_03_main_plot.R b/tests/testthat/test_03_main_plot.R
@@ -22,6 +22,7 @@ plot_f <- function(model, preds)
   return(list(plot_dist(model, preds),
               plot_dist(model, preds, type = "cdf")))
 
+normal_plots <- plot_f(normal_model, normal_p)
 beta_plots <- plot_f(beta_model, beta_p)
 binomial_plots <- plot_f(binomial_model, binomial_p)
 cnorm_plots <- plot_f(cnorm_model, cnorm_p)

diff --git a/tests/testthat/test_04_moments_plot.R b/tests/testthat/test_04_moments_plot.R
@@ -13,6 +13,8 @@ library(bamlss.vis)
 load("models_data.RData")
 
 ### --- Make plots --- ###
+expect_error(plot_moments(normal_model, int_var = "norm1", expl),
+             regexp = NA) # Normal
 expect_error(plot_moments(beta_model, int_var = "norm1", expl),
              regexp = NA) # Beta
 expect_error(plot_moments(binomial_model, int_var = "norm1", expl),
@@ -26,7 +28,7 @@ expect_error(plot_moments(gpareto_model, int_var = "norm1", expl),
 expect_error(plot_moments(multinomial_model, int_var = "norm1", expl),
              regexp = NA) # multinomial
 suppressWarnings({
-  expect_error(plot_moments(mvnorm_model, int_var = "x2", expl_mvnorm),
+  expect_error(plot_moments(mvnorm_model, int_var = "norm2", expl),
                regexp = NA) # multivariate normal
 })
 expect_error(plot_moments(poisson_model, int_var = "norm1", expl),

diff --git a/tests/testthat/test_99_cleanup.R b/tests/testthat/test_99_cleanup.R
@@ -1,5 +1,8 @@
 ## -- Clean Up -- ##
 
+# Options to old options
+options(warn = 0)
+
 # Remove plots file
 file.remove("models_data.RData")
 file.remove("Rplots.pdf")