tests/testthat/test-dist_objects.R

In SSN2: Spatial Modeling on Stream Networks

# Copy the mf04p .ssn data to a local directory and read it into R
# When modeling with your .ssn object, you will load it using the relevant
# path to the .ssn data on your machine
copy_lsn_to_temp()
temp_path <- paste0(tempdir(), "/MiddleFork04.ssn")
mf04p <- ssn_import(
  temp_path,
  predpts = c("pred1km", "CapeHorn", "Knapp"),
  overwrite = TRUE
)

ssn_create_distmat(
  ssn.object = mf04p,
  predpts = c("pred1km"),
  overwrite = TRUE,
  among_predpts = TRUE
)

# fit an example model
ssn_mod <- ssn_lm(Summer_mn ~ ELEV_DEM, mf04p, tailup_type = "exponential", additive = "afvArea")

# create an example initial object
initial_object_val <- get_initial_object(
  tailup_type = "exponential",
  taildown_type = "exponential",
  euclid_type = "exponential",
  nugget_type = "nugget",
  tailup_initial = NULL,
  taildown_initial = NULL,
  euclid_initial = NULL,
  nugget_initial = NULL
)

test_that("dist object output appropriate", {
  # create distance object
  object <- get_dist_object(
    ssn.object = mf04p,
    initial_object = initial_object_val,
    additive = "afvArea",
    anisotropy = FALSE
  )

  # store names and dimensions
  names_vec <- c(
    "distjunc_mat", "mask_mat", "a_mat", "b_mat",
    "hydro_mat", "w_mat", "euclid_mat", "network_index", "pid",
    "dist_order", "inv_dist_order"
  )
  n_obs <- NROW(mf04p$obs)
  n_obs_dim <- c(n_obs, n_obs)

  # run test on object structure
  expect_true(identical(names(object), names_vec))
  expect_equal(dim(object$distjunc_mat), n_obs_dim)
  expect_equal(dim(object$mask_mat), n_obs_dim)
  expect_equal(dim(object$a_mat), n_obs_dim)
  expect_equal(dim(object$b_mat), n_obs_dim)
  expect_equal(dim(object$hydro_mat), n_obs_dim)
  expect_equal(dim(object$w_mat), n_obs_dim)
  expect_equal(dim(object$euclid_mat), n_obs_dim)
  expect_true(is.vector(object$network_index))
  expect_true(is.vector(object$pid))
  expect_true(is.vector(object$dist_order))
  expect_true(is.vector(object$inv_dist_order))
})

test_that("dist pred object output appropriate", {
  # create distance object
  dist_pred_object <- get_dist_pred_object(
    object = ssn_mod,
    newdata_name = "pred1km",
    initial_object = initial_object_val
  )

  # store names and dimensions
  names_vec <- c(
    "distjunca_pred_mat", "distjuncb_pred_mat", "mask_pred_mat",
    "a_pred_mat", "b_pred_mat",
    "hydro_pred_mat", "w_pred_mat", "euclid_pred_mat",
    "network_index", "pid", "dist_order", "inv_dist_order",
    "network_index_pred", "pid_pred", "dist_order_pred", "inv_dist_order_pred"
  )

  n_obs <- NROW(ssn_mod$ssn.object$obs)
  n_pred <- NROW(ssn_mod$ssn.object$preds[["pred1km"]])
  n_dim <- c(n_pred, n_obs)

  # run test on object structure
  expect_true(identical(names(dist_pred_object), names_vec))
  expect_equal(dim(dist_pred_object$distjunca_pred_mat), n_dim)
  expect_equal(dim(t(dist_pred_object$distjuncb_pred_mat)), n_dim)
  expect_equal(dim(dist_pred_object$mask_pred_mat), n_dim)
  expect_equal(dim(dist_pred_object$a_pred_mat), n_dim)
  expect_equal(dim(dist_pred_object$b_pred_mat), n_dim)
  expect_equal(dim(dist_pred_object$hydro_pred_mat), n_dim)
  expect_equal(dim(dist_pred_object$w_pred_mat), n_dim)
  expect_equal(dim(dist_pred_object$euclid_pred_mat), n_dim)
  expect_true(is.vector(dist_pred_object$network_index))
  expect_true(is.vector(dist_pred_object$pid))
  expect_true(is.vector(dist_pred_object$dist_order))
  expect_true(is.vector(dist_pred_object$inv_dist_order))
  expect_true(is.vector(dist_pred_object$network_index_pred))
  expect_true(is.vector(dist_pred_object$pid_pred))
  expect_true(is.vector(dist_pred_object$dist_order_pred))
  expect_true(is.vector(dist_pred_object$inv_dist_order_pred))
})

test_that("dist pred bk object output appropriate", {
  # create distance object
  object <- get_dist_predbk_object(
    object = ssn_mod,
    newdata_name = "pred1km",
    initial_object = initial_object_val
  )

  # store names and dimensions
  names_vec <- c(
    "distjunc_mat", "mask_mat", "a_mat", "b_mat",
    "hydro_mat", "w_mat", "euclid_mat", "network_index", "pid",
    "dist_order", "inv_dist_order"
  )
  n_pred <- NROW(mf04p$preds[["pred1km"]])
  n_pred_dim <- c(n_pred, n_pred)

  # run test on object structure
  expect_true(identical(names(object), names_vec))
  expect_equal(dim(object$distjunc_mat), n_pred_dim)
  expect_equal(dim(object$mask_mat), n_pred_dim)
  expect_equal(dim(object$a_mat), n_pred_dim)
  expect_equal(dim(object$b_mat), n_pred_dim)
  expect_equal(dim(object$hydro_mat), n_pred_dim)
  expect_equal(dim(object$w_mat), n_pred_dim)
  expect_equal(dim(object$euclid_mat), n_pred_dim)
  expect_true(is.vector(object$network_index))
  expect_true(is.vector(object$pid))
  expect_true(is.vector(object$dist_order))
  expect_true(is.vector(object$inv_dist_order))
})