tests/testthat/test-time_varying.R

In rcausim: Generate Causally-Simulated Data

library(testthat)
library(rcausim)
library(dplyr)

paste0(
    "'time_varying' handles 'func' with a class beyond 'Functions'."
  ) |>
  test_that({
    functions0 <-
      list(
        B = function(n){
          B <- rnorm(n, 0, 1)
          return(B)
        }
        ,A = function(B){
          A <- 0.3 * B + rnorm(length(B), 0.1, 0.001)
        }
      )

    functions <- function_from_user(functions0)

    set.seed(1)
    simulated_data <- data_from_function(functions, n = 100)
    T_max <- rpois(nrow(simulated_data), lambda = 25)

    expect_error(time_varying(functions0, simulated_data, T_max))
  })

paste0(
    "'time_varying' handles 'func' with a vertex has not been defined for its "
    ,"function."
  ) |>
  test_that({
    data(edges)
    data(functions)

    functions2 <-
      edges |>
      function_from_edge()

    for(v in names(functions)[names(functions) != "C"]){
      functions2 <-
        functions2 |>
        define(v, functions[[v]])
    }

    set.seed(1)
    simulated_data <- data_from_function(functions, n = 100)
    T_max <- rpois(nrow(simulated_data), lambda = 25)

    expect_error(time_varying(functions2, simulated_data, T_max))
  })

paste0(
    "'time_varying' handles non-data-frame 'data'."
  ) |>
  test_that({
    data(functions)

    T_max <- rpois(100, lambda = 25)

    expect_error(time_varying(functions, "simulated_data", T_max))
  })

paste0(
    "'time_varying' handles non-numeric 'T_max'."
  ) |>
  test_that({
    data(functions)

    set.seed(1)
    simulated_data <- data_from_function(functions, n = 100)

    expect_error(time_varying(functions, simulated_data, "T_max"))
  })

paste0(
    "'time_varying' handles a numeric vector 'T_max' of a length not "
    ,"equal to 1."
  ) |>
  test_that({
    data(functions)

    set.seed(1)
    simulated_data <- data_from_function(functions, n = 100)
    T_max <- rpois(nrow(simulated_data), lambda = 25)

    expect_error(time_varying(functions, simulated_data, T_max[1]))
    expect_error(time_varying(functions, simulated_data, T_max[-1]))
  })

paste0(
    "'time_varying' handles negative or decimal numeric 'T_max'."
  ) |>
  test_that({
    data(functions)

    set.seed(1)
    simulated_data <- data_from_function(functions, n = 100)
    T_max <- rpois(nrow(simulated_data), lambda = 25)

    T_max[1] <- -1
    expect_error(time_varying(functions, simulated_data, T_max))

    T_max[1] <- 0.1
    expect_error(time_varying(functions, simulated_data, T_max))
  })

paste0(
    "'time_varying' handles non-directed cyclic graph (DCG) 'func'."
  ) |>
  test_that({
    data(functions)

    set.seed(1)
    simulated_data <- data_from_function(functions, n = 100)
    T_max <- rpois(nrow(simulated_data), lambda = 25)

    expect_error(time_varying(functions, simulated_data, T_max))
  })

paste0(
    "'time_varying' handles 'func' with the argument 'n', but it is not "
    ,"the only argument in any functions."
  ) |>
  test_that({
    data(edges)

    edges <-
      edges |>
      add_row(data.frame(from = "X", to = "Y"))

    data(functions)

    functions2 <-
      edges |>
      function_from_edge()

    for(v in names(functions)){
      functions2 <-
        functions2 |>
        define(v, functions[[v]])
    }

    function_X <- function(n){
      X <- rnorm(n, 0, 1)
      return(X)
    }

    function_Y <- function(X){
      Y <- 0.7 * X + rnorm(length(X), 0.1, 0.001)
      return(Y)
    }

    functions2 <-
      functions2 |>
      define("X", function_X) |>
      define("Y", function_Y)

    function_X <- function(E){
      X <- 0.3 * E + rnorm(length(E), 0, 1)
      return(X)
    }

    functions2 <- define(functions2, "X", function_X)

    set.seed(1)
    simulated_data <- data_from_function(functions2, n = 100)
    T_max <- rpois(nrow(simulated_data), lambda = 25)

    function_X <- function(n, Y){
      X <- 0.3 * E + rnorm(n, 0, 1)
      return(X)
    }

    functions2 <- define(functions2, "X", function_X)

    expect_error(time_varying(functions2, simulated_data, T_max))
  })

paste0(
    "'time_varying' handles 'func' where an argument in any functions does not "
    ,"have its own function, except when the argument is 'n'."
  ) |>
  test_that({
    functions <-
      list(
        B = function(n){
          B <- rnorm(n, 0, 1)
          return(B)
        }
        ,X = function(n){
          B <- rnorm(n, 0, 1)
          return(B)
        }
        ,A = function(B){
          A <- 0.3 * B + 0.1
          return(A)
        }
      ) |>
      function_from_user()

    set.seed(1)
    simulated_data <- data_from_function(functions, n = 100)
    T_max <- rpois(nrow(simulated_data), lambda = 25)

    function_B <- function(A, E){
      B <- 0.1 * G + 0.7
      return(B)
    }

    functions <- define(functions, "B", function_B)

    expect_error(time_varying(functions, simulated_data, T_max))
  })

paste0(
    "'time_varying' handles 'data' that includes 'i', 't', or 't_max'."
  ) |>
  test_that({
    data(functions)
    set.seed(1)
    simulated_data <- data_from_function(functions, n = 100)

    function_B <- function(B){
      B <- B + 1
      return(B)
    }

    set.seed(1)
    functions <- define(functions, "B", function_B)
    T_max <- rpois(nrow(simulated_data), lambda = 25)

    simulated_data2 <-
      simulated_data |>
      mutate(i = seq(n()))

    expect_error(time_varying(functions, simulated_data2, T_max))

    simulated_data2 <-
      simulated_data |>
      mutate(t = seq(n()))

    expect_error(time_varying(functions, simulated_data2, T_max))

    simulated_data2 <-
      simulated_data |>
      mutate(t_max = T_max)

    expect_error(time_varying(functions, simulated_data2, T_max))
  })

paste0(
    "'time_varying' handles 'data' that does not include all arguments, except "
    ,"n."
  ) |>
  test_that({
    data(functions)
    set.seed(1)
    simulated_data <- data_from_function(functions, n = 100)

    function_B <- function(B){
      B <- B + 1
      return(B)
    }

    functions <- define(functions, "B", function_B)
    set.seed(1)
    T_max <- rpois(nrow(simulated_data), lambda = 25)

    simulated_data <- simulated_data[-2]

    expect_error(time_varying(functions, simulated_data, T_max))
  })

paste0(
    "'time_varying' handles 'func' where the function of a vertex has an "
    ,"output length that does not match the input length."
  ) |>
  test_that({
    data(functions)
    set.seed(1)
    simulated_data <- data_from_function(functions, n = 100)

    function_B <- function(B){
      B <- B[1:2] + 1
      return(B)
    }

    functions <- define(functions, "B", function_B)
    set.seed(1)
    T_max <- rpois(nrow(simulated_data), lambda = 25)

    expect_error(time_varying(functions, simulated_data, T_max))
  })

paste0(
    "'time_varying' handles 'func' where the derived graph have >1 roots."
  ) |>
  test_that({
    data(edges)

    edges <-
      edges |>
      add_row(data.frame(from = "X", to = "Y")) |>
      add_row(data.frame(from = "B", to = "Y"))

    data(functions)

    functions2 <-
      edges |>
      function_from_edge()

    for(v in names(functions)){
      functions2 <-
        functions2 |>
        define(v, functions[[v]])
    }

    function_X <- function(n){
      X <- rnorm(n, 0, 1)
      return(X)
    }

    function_Y <- function(X, B){
      Y <- X + B
      return(Y)
    }

    functions2 <- define(functions2, "X", function_X)
    functions2 <- define(functions2, "Y", function_Y)

    set.seed(1)
    simulated_data <- data_from_function(functions2, n = 100)

    function_B <- function(B){
      B <- B + 1
      return(B)
    }

    functions <- define(functions, "B", function_B)
    set.seed(1)
    T_max <- rpois(nrow(simulated_data), lambda = 25)

    expect_no_condition(time_varying(functions, simulated_data, T_max))
  })

paste0(
    "'time_varying' handles 'func' where the classes of the generated data can "
    ,"be any classes."
  ) |>
  test_that({
    data(edges)

    edges <-
      edges |>
      add_row(data.frame(from = "E", to = "X")) |>
      add_row(data.frame(from = "E", to = "Y")) |>
      add_row(data.frame(from = "E", to = "Z"))

    data(functions)

    functions2 <-
      edges |>
      function_from_edge()

    for(v in names(functions)){
      functions2 <-
        functions2 |>
        define(v, functions[[v]])
    }

    function_X <- function(E){
      X <- sample(c(TRUE, FALSE), size = length(E), replace = TRUE)
      return(X)
    }

    function_Y <- function(E){
      Y <- sample(LETTERS[1:2], size = length(E), replace = TRUE)
      return(Y)
    }

    function_Z <- function(E){
      Z <- sample(factor(LETTERS[1:2]), size = length(E), replace = TRUE)
      return(Z)
    }

    functions2 <-
      functions2 |>
      define("X", function_X) |>
      define("Y", function_Y) |>
      define("Z", function_Z)

    set.seed(1)
    simulated_data <- data_from_function(functions2, n = 100)

    function_B <- function(B){
      B <- B + 1
      return(B)
    }

    functions2 <- define(functions2, "B", function_B)
    set.seed(1)
    T_max <- rpois(nrow(simulated_data), lambda = 25)

    expect_no_condition(time_varying(functions2, simulated_data, T_max))
  })