tests/testthat/test-nonparametric_dsmm.R

In dsmmR: Estimation and Simulation of Drifting Semi-Markov Models

# Setup.
states <- c("AA", "AC", "CC")
s <- length(states)
d <- 2
k_max <- 3

# `p_dist` has dimensions of: (s, s, d + 1).
# Sums over v must be 1 for all u and i = 0, ..., d.
p_dist_1 <- matrix(c(0,   0.1, 0.9,
                     0.5, 0,   0.5,
                     0.3, 0.7, 0),
                   ncol = s, byrow = TRUE)

p_dist_2 <- matrix(c(0,   0.6, 0.4,
                     0.7, 0,   0.3,
                     0.6, 0.4, 0),
                   ncol = s, byrow = TRUE)

p_dist_3 <- matrix(c(0,   0.2, 0.8,
                     0.6, 0,   0.4,
                     0.7, 0.3, 0),
                   ncol = s, byrow = TRUE)

# `f_dist` has dimensions of: (s, s, k_max, d + 1).
# First f distribution. Dimensions: (s, s, k_max).
# Sums over l must be 1, for every u, v and i = 0, ..., d.
f_dist_1_l_1 <- matrix(c(0,   0.2, 0.7,
                         0.3, 0,   0.4,
                         0.2, 0.8, 0),
                       ncol = s, byrow = TRUE)

f_dist_1_l_2 <- matrix(c(0,   0.3,  0.2,
                         0.2, 0,    0.5,
                         0.1, 0.15, 0),
                       ncol = s, byrow = TRUE)

f_dist_1_l_3 <- matrix(c(0,   0.5,  0.1,
                         0.5, 0,    0.1,
                         0.7, 0.05, 0),
                       ncol = s, byrow = TRUE)
# Get f_dist_1
f_dist_1 <- array(c(f_dist_1_l_1, f_dist_1_l_2, f_dist_1_l_3),
                  dim = c(s, s, k_max))

# Second f distribution. Dimensions: (s, s, k_max)
f_dist_2_l_1 <- matrix(c(0,   1/3, 0.4,
                         0.3, 0,   0.4,
                         0.2, 0.1, 0),
                       ncol = s, byrow = TRUE)

f_dist_2_l_2 <- matrix(c(0,   1/3, 0.4,
                         0.4, 0,   0.2,
                         0.3, 0.4, 0),
                       ncol = s, byrow = TRUE)

f_dist_2_l_3 <- matrix(c(0,   1/3, 0.2,
                         0.3, 0,   0.4,
                         0.5, 0.5, 0),
                       ncol = s, byrow = TRUE)

# Get f_dist_2
f_dist_2 <- array(c(f_dist_2_l_1, f_dist_2_l_2, f_dist_2_l_3),
                  dim = c(s, s, k_max))

# Third f distribution. Dimensions: (s, s, k_max)
f_dist_3_l_1 <- matrix(c(0,    0.3, 0.3,
                         0.3,  0,   0.5,
                         0.05, 0.1, 0),
                       ncol = s, byrow = TRUE)

f_dist_3_l_2 <- matrix(c(0,   0.2, 0.6,
                         0.3, 0,   0.35,
                         0.9, 0.2, 0),
                       ncol = s, byrow = TRUE)

f_dist_3_l_3 <- matrix(c(0,    0.5, 0.1,
                         0.4,  0,   0.15,
                         0.05, 0.7, 0),
                       ncol = s, byrow = TRUE)

# Get f_dist_3
f_dist_3 <- array(c(f_dist_3_l_1, f_dist_3_l_2, f_dist_3_l_3),
                  dim = c(s, s, k_max))

test_that("nonparametric_dsmm(); p and f are drifting", {
    
    # ---------------------------------------------------------------------------
    # Defining distributions for Model 1 - both p and f are drifting.
    # ---------------------------------------------------------------------------
    # Get `p_dist` as an array of p_dist_1, p_dist_2 and p_dist_3.
    p_dist <- array(c(p_dist_1, p_dist_2, p_dist_3),
                    dim = c(s, s, d + 1))
    
    # Get f_dist as an array of f_dist_1, f_dist_2 and f_dist_3.
    f_dist <- array(c(f_dist_1, f_dist_2, f_dist_3),
                    dim = c(s, s, k_max, d + 1))
    
    # ---------------------------------------------------------------------------
    # Non-Parametric object for Model 1.
    # ---------------------------------------------------------------------------
    expect_no_condition(
        obj_nonpar_model_1 <- nonparametric_dsmm(
            model_size = 8000,
            states = states,
            initial_dist = c(0.3, 0.5, 0.2),
            degree = d,
            k_max = k_max,
            p_dist = p_dist,
            f_dist = f_dist,
            p_is_drifting = TRUE,
            f_is_drifting = TRUE
        )
    )
    
    expect_snapshot(obj_nonpar_model_1)
    
})

test_that("nonparametric_dsmm(); p is drifting, f is not drifting.", {
    # ---------------------------------------------------------------------------
    # Defining Model 2 - p is drifting, f is not drifting.
    # -----------------------i----------------------------------------------------
    
    # p_dist has the same dimensions as in Model 1: (s, s, d + 1).
    p_dist_model_2 <- array(c(p_dist_1, p_dist_2, p_dist_3),
                            dim = c(s, s, d + 1))
    
    # f_dist has dimensions of: (s,s,k_{max}).
    f_dist_model_2 <- f_dist_2
    
    # ---------------------------------------------------------------------------
    # Non-Parametric object for Model 2.
    # ---------------------------------------------------------------------------
    
    expect_no_condition(
        obj_nonpar_model_2 <- nonparametric_dsmm(
            model_size = 10000,
            states = states,
            initial_dist = c(0.7, 0.1, 0.2),
            degree = d,
            k_max = k_max,
            p_dist = p_dist_model_2,
            f_dist = f_dist_model_2,
            p_is_drifting = TRUE,
            f_is_drifting = FALSE
        )
    )
    
    expect_snapshot(obj_nonpar_model_2)
    
})

test_that("nonparametric_dsmm(); f is drifting, p is not drifting.", {
    # ---------------------------------------------------------------------------
    # Defining Model 3 - f is drifting, p is not drifting.
    # ---------------------------------------------------------------------------
    
    # `p_dist` has dimensions of: (s, s, d + 1).
    p_dist_model_3 <- p_dist_3
    
    # `f_dist` has the same dimensions as in Model 1: (s, s, d + 1).
    f_dist_model_3 <- array(c(f_dist_1, f_dist_2, f_dist_3),
                            dim = c(s, s, k_max, d + 1))
    
    
    # ---------------------------------------------------------------------------
    # Non-Parametric object for Model 3.
    # ---------------------------------------------------------------------------
    expect_no_condition(
        obj_nonpar_model_3 <- nonparametric_dsmm(
            model_size = 10000,
            states = states,
            initial_dist = c(0.3, 0.4, 0.3),
            degree = d,
            k_max = k_max,
            p_dist = p_dist_model_3,
            f_dist = f_dist_model_3,
            p_is_drifting = FALSE,
            f_is_drifting = TRUE
        )
    )
    
    expect_snapshot(obj_nonpar_model_3)
    
})
#' # ===========================================================================
#' # Using methods for non-parametric objects.
#' # ===========================================================================
#'
#' kernel_parametric <- get_kernel(obj = obj_nonpar_model_3)
#' str(kernel_parametric)
#'
#' sim_seq_par <- simulate(obj_nonpar_model_3, nsim = 50)
#' str(sim_seq_par)