tests/testthat/test_intensityClasses.R

In OpenLand: Quantitative Analysis and Visualization of LUCC

context("intensityClass & generic_method")

set.seed(159)
demo_raster <- .demo_landscape(year =  2000:2005,
                               res = 1,
                               crs = "+proj=utm +zone=21 +south +ellps=GRS80 +units=m +no_defs")
demo_cont <- contingencyTable(demo_raster, pixelresolution = 1)

demo_int_pixel <-
  intensityAnalysis(
    dataset = demo_cont,
    category_n = "GUP",
    category_m = "SXQ",
    area_km2 = FALSE
  )


test_that("Behavior of the 3 s4 classes", {



  expect_visible(
  new("Interval", intervalData = demo_int_pixel$interval_lvl$intervalData))
  expect_visible(
  new("Category",
      categoryData = demo_int_pixel$category_lvlGain$categoryData,
      lookupcolor = demo_int_pixel$category_lvlGain$lookupcolor,
      categoryStationarity = demo_int_pixel$category_lvlGain$categoryStationarity))
  expect_visible(
  new("Transition",
      transitionData = demo_int_pixel$transition_lvlGain_n$transitionData,
      lookupcolor = demo_int_pixel$transition_lvlGain_n$lookupcolor,
      transitionStationarity = demo_int_pixel$transition_lvlGain_n$transitionStationarity))


  expect_s4_class(
    new("Interval", intervalData = demo_int_pixel$interval_lvl$intervalData),
    "Interval"
  )
  expect_s4_class(
    new("Category",
        categoryData = demo_int_pixel$category_lvlGain$categoryData,
        lookupcolor = demo_int_pixel$category_lvlGain$lookupcolor,
        categoryStationarity = demo_int_pixel$category_lvlGain$categoryStationarity),
    "Category"
  )
  expect_s4_class(
    new("Transition",
        transitionData = demo_int_pixel$transition_lvlGain_n$transitionData,
        lookupcolor = demo_int_pixel$transition_lvlGain_n$lookupcolor,
        transitionStationarity = demo_int_pixel$transition_lvlGain_n$transitionStationarity),
    "Transition"
  )
  expect_error(
    new("Interval", intervalData = demo_int_pixel$interval_lvl$intervalData[1:2]))
  expect_error(
    new("Category",
        categoryData = demo_int_pixel$category_lvlGain$categoryData[1:4],
        lookupcolor = demo_int_pixel$category_lvlGain$lookupcolor,
        categoryStationarity = demo_int_pixel$category_lvlGain$categoryStationarity))
  expect_error(
    new("Transition",
        transitionData = demo_int_pixel$transition_lvlGain_n$transitionData[1:4],
        lookupcolor = demo_int_pixel$transition_lvlGain_n$lookupcolor,
        transitionStationarity = demo_int_pixel$transition_lvlGain_n$transitionStationarity))



  expect_error(
    new("Interval", intervalData = as.data.frame(demo_int_pixel$interval_lvl$intervalData)))
  expect_error(
    new("Category",
        categoryData = as.data.frame(demo_int_pixel$category_lvlGain$categoryData),
        lookupcolor = demo_int_pixel$category_lvlGain$lookupcolor,
        categoryStationarity = demo_int_pixel$category_lvlGain$categoryStationarity))
  expect_error(
    new("Transition",
        transitionData = as.data.frame(demo_int_pixel$transition_lvlGain_n$transitionData),
        lookupcolor = demo_int_pixel$transition_lvlGain_n$lookupcolor,
        transitionStationarity = demo_int_pixel$transition_lvlGain_n$transitionStationarity))



})




test_that("Behavior of the acessor", {

  expect_equal(demo_int_pixel$interval_lvl@intervalData,
               demo_int_pixel$interval_lvl$intervalData)


  expect_equal(demo_int_pixel$category_lvlGain@lookupcolor,
               demo_int_pixel$category_lvlGain$lookupcolor)

  expect_equal(demo_int_pixel$transition_lvlGain_n@lookupcolor,
               demo_int_pixel$transition_lvlGain_n$lookupcolor)

})