tests/testthat/test_methods.R

In convdistr: Convolute Probabilistic Distributions

# Test for methods
# 20181028 by JJAV
# # # # # # # # # #

context("Test for methods")

test_that("Replacement is not possible for DISTRIBUTION objects", {
  myDistr <- new_NORMAL(0,1)
  expect_error(myDistr$new_field <-  "hola", "Objects of class DISTRIBUTION are immutable")
  expect_error(myDistr$oval <- 3 , "Objects of class DISTRIBUTION are immutable")
  expect_error(myDistr["oval"] <- 3 , "Objects of class DISTRIBUTION are immutable")
  expect_error(myDistr[["oval"]] <- 3, "Objects of class DISTRIBUTION are immutable")
  expect_error(myDistr["new_field"] <- 3 , "Objects of class DISTRIBUTION are immutable")
})

test_that("The metadata function works well", {
  myDistr <- new_NORMAL(0,1)
  df <- data.frame(distribution = "NORMAL", rvar = 0, stringsAsFactors = FALSE)
  expect_equivalent(metadata(myDistr), df)
})

test_that("The print.DISTRIBUTION function works well" , {
  myDistr <- new_NORMAL(0,1)
  expect_output_file(print(myDistr), "print_myDistr.txt")
})

test_that(
  "The summary function works" ,
  {
    myDistr <- new_NORMAL(0, 1)
    mySummary <- summary(myDistr)
    expect_is(mySummary, "data.frame")
    expect_equal(
      names(mySummary),
      c(
        "distribution",
        "varname",
        "oval",
        "nsample",
        "mean_",
        "sd_",
        "lci_",
        "median_",
        "uci_"
      )
    )
    expect_equal(nrow(mySummary),1)
    expect_is(summary(new_NA()), "data.frame")
    expect_is(summary(new_DIRAC(1)), "data.frame")
    expect_is(summary(new_DIRICHLET(c(0.1,0.9))), "data.frame")
    expect_equal(nrow(summary(new_DIRICHLET(c(0.1,0.9)))), 2)
  })


test_that("The rfunc works well", {
  myDistr <- new_NORMAL(0,1)
  expect_is(rfunc(myDistr,10),"matrix")
  expect_equal(nrow(rfunc(myDistr,10)),10)
  expect_equal(ncol(rfunc(myDistr,10)),1)
  expect_equal(ncol(rfunc(new_DIRICHLET(c(0.2,0.3,0.4)),10)),3)
  expect_equal(nrow(rfunc(new_DIRICHLET(c(0.2,0.3,0.4)),10)),10)
})

test_that("The dimnames works well" , {
  myDistr <- new_NORMAL(0,1)
  expect_equal(dimnames(myDistr), "rvar")
})


test_that("The Summary does not change the system seed", {
  d1 <- new_NORMAL(0,1)

  #test start
  set.seed(123456789)
  v1 <- runif(1000)
  v2 <- runif(1000)
  set.seed(123456789)
  v3 <- runif(1000)
  summary(d1)
  v4 <- runif(1000)
  set.seed(123456789)
  v5 <- runif(1000)
  rfunc(d1,10000)
  v6 <- runif(1000)
  expect_equal(v1,v3)
  expect_equal(v1,v5)
  expect_equal(v2,v4)
  expect_true(all(v2 == v4))
  expect_false(all(v2 == v6))
})


test_that("The seed only affects the latest created object", {
  d1 <- new_NORMAL(0,1)
  d2 <- new_NORMAL(0,1)
  d3 <- new_NORMAL(0,1)
  
  # Setup the fixture
  if (exists(".Random.seed", .GlobalEnv))
    oldseed <- .GlobalEnv$.Random.seed
  else
    oldseed <- NULL
  
  set.seed(123456789)
  d4 <- d1 + d2
  set.seed(123456789)
  d5 <- d1 + d3
  
  s1 <- summary(d4)
  s2 <- summary(d5)
  
  expect_equal(s2,s2)
  
  # Return back the fixture
  if (!is.null(oldseed))
    .GlobalEnv$.Random.seed <- oldseed
  else
    rm(".Random.seed", envir = .GlobalEnv)
  
})


test_that("The set_seed function", {
  d1 <- new_NORMAL(1,0)
  s1 <- d1$seed
  d2 <- set_seed(d1,123456790)
  s2 <- d2$seed
  expect_equal(s2,123456790)
  expect_false(s1 == s2)
})