tests/testthat/test-frank.flm.R

In myllym/GET: Global Envelopes

test_that("frank.flm-methods", {
  nargs <- 3
  nobs <- 5
  nperm <- 22
  iset <- create_curve_set(list(obs=matrix(runif(nargs*nobs), nargs)))
  xset <- create_curve_set(list(obs=matrix(runif(nargs*nobs), nargs)))
  x <- data.frame(X=runif(nobs))

  # X = curve set
  f <- function(method) {
    set.seed(1)
    r <- frank.flm(nperm, Y ~ X, Y ~ 1, curve_sets = list(Y=iset, X=xset), GET.args=list(typeone="fwer"), savefuns=TRUE, method=method)
    attr(r, "runtime") <- NULL
    r
  }
  r1 <- f("lm")
  expect_equal(r1, f("ne"))
  expect_error(f("mlm"), "Curvesets in factors not allowed")
  expect_equal(r1, f("best"))

  # X = constant
  f <- function(method) {
    set.seed(1)
    r <- frank.flm(nperm, Y ~ X, Y ~ 1, curve_sets = list(Y=iset), factors=x, GET.args=list(typeone="fwer"), savefuns=TRUE, method=method)
    attr(r, "runtime") <- NULL
    r
  }
  r1 <- f("lm")
  expect_equal(r1, f("ne"))
  expect_equal(r1, f("best"))
  expect_equal(r1, f("mlm"))

  # X = curve_set + constant
  f <- function(method) {
    set.seed(1)
    r <- frank.flm(nperm, Y ~ X + Z, Y ~ 1, curve_sets = list(Y=iset, Z=xset), factors=x, GET.args=list(typeone="fwer"), savefuns=TRUE, method=method)
    attr(r, "runtime") <- NULL
    r
  }
  r1 <- f("lm")
  expect_equal(r1, f("ne"))
  expect_error(f("mlm"), "Curvesets in factors not allowed")
  expect_equal(r1, f("best"))
})

test_that("graph.flm-methods", {
  nargs <- 3
  nobs <- 5
  nperm <- 22
  iset <- create_curve_set(list(obs=matrix(runif(nargs*nobs), nargs)))
  xset <- create_curve_set(list(obs=matrix(runif(nargs*nobs), nargs)))
  x <- data.frame(X=runif(nobs), Z=runif(nobs))

  f <- function(method) {
    set.seed(1)
    r <- graph.flm(nperm, Y ~ X, Y ~ 1, curve_sets = list(Y=iset, X=xset), GET.args=list(typeone="fwer"), savefuns=TRUE, fast=method)
    attr(r, "runtime") <- NULL
    r
  }
  r1 <- f(FALSE)
  expect_equal(r1, f(TRUE))
  expect_equal(r1, f("mlm"))
  expect_equal(r1, f("ne"))
  expect_equal(r1, f("qr"))

  f <- function(method) {
    set.seed(1)
    r <- graph.flm(nperm, Y ~ X, Y ~ 1, curve_sets = list(Y=iset), factors=x, GET.args=list(typeone="fwer"), savefuns=TRUE, fast=method)
    attr(r, "runtime") <- NULL
    r
  }
  r1 <- f(FALSE)
  expect_equal(r1, f(TRUE))
  expect_equal(r1, f("mlm"))
  expect_equal(r1, f("ne"))
  expect_equal(r1, f("qr"))

  f <- function(method) {
    set.seed(1)
    r <- graph.flm(nperm, Y ~ X + Z, Y ~ 1, curve_sets = list(Y=iset), factors=x, GET.args=list(typeone="fwer"), savefuns=TRUE, fast=method)
    attr(r, "runtime") <- NULL
    r
  }
  r1 <- f(FALSE)
  expect_equal(r1, f(TRUE))
  expect_equal(r1, f("mlm"))
  expect_equal(r1, f("ne"))
  expect_equal(r1, f("qr"))

  f <- function(method) {
    set.seed(1)
    r <- graph.flm(nperm, Y ~ X + Z, Y ~ 1, curve_sets = list(Y=iset, Z=xset), factors=x, GET.args=list(typeone="fwer"), savefuns=TRUE, fast=method)
    attr(r, "runtime") <- NULL
    r
  }
  r1 <- f(FALSE)
  expect_equal(r1, f(TRUE))
  expect_equal(r1, f("mlm"))
  expect_equal(r1, f("ne"))
  expect_equal(r1, f("qr"))
})