tests/testthat/test-readme.R

In forestecology: Fitting and Assessing Neighborhood Models of the Effect of Interspecific Competition on the Growth of Trees

context("utilities")

test_that("readme code works", {
  set.seed(76)

  library(dplyr)
  library(ggplot2)
  library(stringr)
  library(blockCV)

  comp_dist <- 1

  growth_ex <-
    compute_growth(
      census_1 = census_1_ex %>%
        mutate(sp = to_any_case(sp) %>% factor()),
      census_2 = census_2_ex %>%
        filter(!str_detect(codes, "R")) %>%
        mutate(sp = to_any_case(sp) %>% factor()),
      id = "ID"
    ) %>%
    # Compute basal area:
    mutate(basal_area = 0.0001 * pi * (dbh1 / 2)^2) %>%
    add_buffer_variable(direction = "in", size = comp_dist, region = study_region_ex)

  expect_true(check_inherits(growth_ex, "data.frame"))

  buffer_region <- study_region_ex %>%
    compute_buffer_region(direction = "in", size = comp_dist)

  expect_true(check_inherits(buffer_region, "data.frame"))

  fold1 <- rbind(c(0, 0), c(5, 0), c(5, 5), c(0, 5), c(0, 0))
  fold2 <- rbind(c(5, 0), c(10, 0), c(10, 5), c(5, 5), c(5, 0))

  blocks_ex <- bind_rows(
    sf_polygon(fold1),
    sf_polygon(fold2)
  ) %>%
    mutate(folds = c(1, 2) %>% factor())

  SpatialBlock_ex <- spatialBlock(
    speciesData = growth_ex, k = 2, selection = "systematic", blocks = blocks_ex,
    showBlocks = FALSE, verbose = FALSE
  )

  growth_ex <- growth_ex %>%
    mutate(foldID = SpatialBlock_ex$foldID %>% factor())

  focal_vs_comp_ex <- growth_ex %>%
    create_focal_vs_comp(comp_dist, blocks = blocks_ex, id = "ID", comp_x_var = "basal_area")

  # Checks each column in focal_vs_comp is of appropriate type
  expect_true(check_inherits(focal_vs_comp_ex, "data.frame"))
  expect_true(
    check_focal_vs_comp(focal_vs_comp_ex) %>%
      unlist() %>%
      all()
  )

  comp_bayes_lm_ex <- focal_vs_comp_ex %>%
    comp_bayes_lm(prior_param = NULL)

  # Check comp_bayes_lm fit works
  expect_true(check_comp_bayes_lm(comp_bayes_lm_ex))

  focal_vs_comp_ex <- focal_vs_comp_ex %>%
    mutate(growth_hat = predict(comp_bayes_lm_ex, focal_vs_comp_ex))

  # Check model fit outputs:
  expect_true(check_inherits(focal_vs_comp_ex, "data.frame"))
  expect_true(
    check_inherits(comp_bayes_lm_ex %>% autoplot(type = "intercepts"), "ggplot")
  )
  expect_true(
    check_inherits(
      focal_vs_comp_ex %>%
        run_cv(comp_dist = comp_dist, blocks = blocks_ex) %>%
        right_join(growth_ex, by = c("focal_ID" = "ID")),
      "data.frame"
    )
  )

  # Check RMSE's are within tolerance
  expect_equal(
    focal_vs_comp_ex %>%
      rmse(truth = growth, estimate = growth_hat) %>%
      pull(.estimate),
    0.1900981,
    tolerance = .01
  )

  focal_vs_comp_ex <- focal_vs_comp_ex %>%
    run_cv(comp_dist = comp_dist, blocks = blocks_ex)

  expect_equal(
    focal_vs_comp_ex %>%
      rmse(truth = growth, estimate = growth_hat) %>%
      pull(.estimate),
    0.4068709,
    tolerance = .01
  )
})