tests/testthat/test-bam.R

library(testthat)
library(bamm)
library(sp)
testthat::context_start_file("check-output")

# Test
test_that("model2sparse returns an object of class setA", {
  # Adjacency matrix from a niche model
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  model <- raster::raster(model_path)
  sparse_mod <- bamm::model2sparse(model,threshold=0.1)
  print(sparse_mod)
  expect_s4_class(sparse_mod, "setA")
})

# Test
test_that("model2sparse, test if setA matrix is a square matrix", {
  # Adjacency matrix from a niche model
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  model <- raster::raster(model_path)
  sparese_mod <- bamm::model2sparse(model,threshold=0.1)
  setA_dim <- dim(sparese_mod@sparse_model)
  expect_equal(setA_dim, setA_dim)
})


# Test
test_that("model2sparse using non-numeric value to binarize returns error", {
  # Adjacency matrix from a niche model
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  model <- raster::raster(model_path)

  expect_error(bamm::model2sparse(model,threshold="a"))
})

# Test whether the output is a setM object and inherits s4 class
test_that("adj_mat() returns an object of class setM", {
  # Adjacency matrix from a niche model
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  model <- raster::raster(model_path)

  sparse_mod <- bamm::model2sparse(model,threshold=0.05)
  adj_mod <- bamm::adj_mat(sparse_mod,ngbs=1)
  print(adj_mod)
  expect_s4_class(adj_mod, "setM")
})

# Test whether the output is a setM object and inherits s4 class
test_that("adj_mat() returns an object of class setM", {
  # Adjacency matrix from a niche model
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  model <- raster::raster(model_path)

  sparse_mod <- bamm::model2sparse(model,threshold=0.05)
  adj_mod <- bamm::adj_mat(sparse_mod,ngbs=1,eigen_sys = TRUE,which_eigs = 1)
  expect_s4_class(adj_mod, "setM")
})

test_that("adj_mat()  expects an object of class setA", {
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  expect_error(bamm::adj_mat(model_path,ngbs=1))
})

test_that("occs2sparse()  expects an object of class setA", {
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  expect_error(bamm::occs2sparse(modelsparse = model_path,occs = model_path))
})

test_that("occs2sparse()  returns a sparse vector of zeros and ones", {
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  model <- raster::raster(model_path)

  sparse_mod <- bamm::model2sparse(model,threshold=0.05)

  occs_lep_cal <- data.frame(longitude = c(-115.10417,
                                           -104.90417),
                             latitude = c(29.61846,
                                          29.81846))

  occs_sparse <- bamm::occs2sparse(modelsparse = sparse_mod,
                                   occs = occs_lep_cal)

  expect_s4_class(occs_sparse,"dgCMatrix")
})


test_that("shape2Grid()  converts a shapefile to a raster of a given resolution"
          , {
  x_coord <- c(16.48438,  17.49512,  24.74609, 22.59277, 16.48438)
  y_coord <- c(59.736328125, 55.1220703125, 55.0341796875,
               61.142578125, 59.736328125)
  xy <- cbind(x_coord, y_coord)
  p <- sp::Polygon(xy)
  ps <- sp::Polygons(list(p),1)
  sps <- sp::SpatialPolygons(list(ps))
  r1 <- bamm::shape2Grid(sps,resolution = 0.5,ones = TRUE)
  expect_s4_class(r1,class = "RasterLayer")
})

test_that("shape2Grid()  converts a shapefile to a raster of a given resolution"
          , {
  x_coord <- c(16.48438,  17.49512,  24.74609, 22.59277, 16.48438)
  y_coord <- c(59.736328125, 55.1220703125, 55.0341796875,
               61.142578125, 59.736328125)
  xy <- cbind(x_coord, y_coord)
  p <- sp::Polygon(xy)
  ps <- sp::Polygons(list(p),1)
  sps <- sp::SpatialPolygons(list(ps))
  r1 <- bamm::shape2Grid(sps,resolution = 0.5,ones = FALSE)
  expect_s4_class(r1,class = "RasterLayer")
})

test_that("permute_pam()  returns a permuted matrix with row
          sums and colum sums fixed", {
  set.seed(111)
  pam <- matrix(rbinom(100,1,0.3),nrow = 10,ncol = 10)
  ppam <- bamm::permute_pam(m = pam,niter = NULL,as_sparse = FALSE)
  # Check if matrices are different
  expect_equal(object = Matrix::rowSums(pam),Matrix::rowSums(ppam))
  expect_equal(object = Matrix::colSums(pam),Matrix::colSums(ppam))

})

test_that("permute_pam()  returns a permuted matrix of class sparese", {
  set.seed(111)
  pam <- matrix(rbinom(100,1,0.3),nrow = 10,ncol = 10)
  ppam <- bamm::permute_pam(m = pam,niter = NULL,as_sparse = TRUE)
  # Check if matrices are different
  expect_s4_class(ppam,"dgCMatrix")

})
test_that("permute_pam()  returns a permuted matrix of class sparese", {
  set.seed(111)
  pam <- data.frame(matrix(rbinom(100,1,0.3),nrow = 10,ncol = 10))
  ppam <- bamm::permute_pam(m = pam,niter = NULL,as_sparse = TRUE)
  # Check if matrices are different
  expect_s4_class(ppam,"dgCMatrix")

})

test_that("permute_pam()  returns a permuted matrix of class sparese", {
  set.seed(111)
  pam <- list(matrix(rbinom(100,1,0.3),nrow = 10,ncol = 10))
  # Check if matrices are different
  expect_error(bamm::permute_pam(m = pam,niter = NULL,as_sparse = TRUE))

})

test_that("permute_pam()  returns a permuted matrix of class sparese", {
  set.seed(111)
  pam <- matrix(rbinom(100,1,0.3),nrow = 10,ncol = 10)
  # Check if matrices are different
  expect_error(bamm::permute_pam(m = pam,niter = "a",as_sparse = FALSE))

})


test_that("bam_clusters() returns an object of class csd", {
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  model <- raster::raster(model_path)
  model <- model > 0.7
  #raster::crs(model) <- "+proj=longlat +datum=WGS84 +no_defs"
  clusterin <- bamm::bam_clusters(model,ngbs=1,plot_model=FALSE)
  expect_s4_class(clusterin, "csd")
})

test_that("bam_clusters() expects a RasterLayer or a sparse model", {
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  expect_error(bamm::bam_clusters(model_path,ngbs=1,plot_model=FALSE))
})

test_that("bam_clusters() expects a RasterLayer or a sparse model", {
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  model <- raster::raster(model_path)
  model <- bamm::model2sparse(model,threshold = 0.7)
  #raster::crs(model) <- "+proj=longlat +datum=WGS84 +no_defs"
  clusterin <- bamm::bam_clusters(model,ngbs=1,plot_model=FALSE)
  print(clusterin)
  expect_s4_class(clusterin, "csd")
})


test_that("bam_clusters() returns leaflet plot with model", {
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  model <- raster::raster(model_path)
  model <- model > 0.7
  raster::crs(model) <- "+proj=longlat"
  clusterin <- bamm::bam_clusters(model,ngbs=1,plot_model=TRUE)
  expect_s3_class(clusterin@interactive_map, "leaflet")
})

# Test eigen_bam

test_that("eigen_bam returns a list",{
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  model <- raster::raster(model_path)
  sparse_mod <- bamm::model2sparse(model = model,threshold = 0.2)
  adj_mod <- bamm::adj_mat(sparse_mod,ngbs = 1,eigen_sys = TRUE)
  eig_bam <- bamm::eigen_bam(A=sparse_mod,M=adj_mod,
                             which_eigen = 1,rmap = TRUE)
  expect_error(bamm::eigen_bam(A="sparse_mod",
                               M=adj_mod,which_eigen = 1,rmap = TRUE))
  expect_error(bamm::eigen_bam(A=sparse_mod,M="adj_mod",
                               which_eigen = 1,rmap = TRUE))

  expect_match(class(eig_bam),"list")
})

# Test for csd_estimate

test_that("csd_estimate returns a list",{
  ## Not run:
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  model <- raster::raster(model_path)
  model <- model > 0.7
  csd_plot <- bamm::csd_estimate(model,
                                 dispersal_steps=c(1,2))
  expect_equal(class(csd_plot),"list")
})

# Tests for sdm_sim function

test_that("sdm_sim returns an object of class bam with results from simulation"
          ,{
  ## Not run:
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  model <- raster::raster(model_path)

  sparse_mod <- bamm::model2sparse(model,threshold=0.05)
  adj_mod <- bamm::adj_mat(sparse_mod,ngbs=1)
  occs_lep_cal <- data.frame(longitude = c(-110.08880,
                                           -98.89638),
                             latitude = c(30.43455,
                                          25.19919))

  occs_sparse <- bamm::occs2sparse(modelsparse = sparse_mod,
                                   occs = occs_lep_cal)
  expect_error(bamm::sdm_sim(set_A = "a",
                             set_M = adj_mod,
                             initial_points = occs_sparse,
                             nsteps = 10,
                             stochastic_dispersal = TRUE,
                             disp_prop2_suitability=TRUE,
                             disper_prop=0.5,
                             progress_bar=TRUE))
  expect_error(bamm::sdm_sim(set_A = sparse_mod,
                             set_M = "adj_mod",
                             initial_points = occs_sparse,
                             nsteps = 10,
                             stochastic_dispersal = TRUE,
                             disp_prop2_suitability=TRUE,
                             disper_prop=0.5,
                             progress_bar=TRUE))

  sdm_lep_cal <- bamm::sdm_sim(set_A = sparse_mod,
                               set_M = adj_mod,
                               initial_points = occs_sparse,
                               nsteps = 10,
                               stochastic_dispersal = TRUE,
                               disp_prop2_suitability=FALSE,
                               disper_prop=0.5,
                               progress_bar=TRUE)

  sdm_lep_cal <- bamm::sdm_sim(set_A = sparse_mod,
                               set_M = adj_mod,
                               initial_points = occs_sparse,
                               nsteps = 10,
                               stochastic_dispersal = FALSE,
                               disp_prop2_suitability=FALSE,
                               disper_prop=0.5,
                               progress_bar=TRUE)

  sdm_lep_cal <- bamm::sdm_sim(set_A = sparse_mod,
                               set_M = adj_mod,
                               initial_points = occs_sparse,
                               nsteps = 10,
                               stochastic_dispersal = TRUE,
                               disp_prop2_suitability=TRUE,
                               disper_prop=0.5,
                               progress_bar=TRUE)

  expect_s4_class(sdm_lep_cal,"bam")

})

# Tests for bam_sim

test_that("bam_sim A simple simultation of predator-prey interaction.
          Returns an object of class",{
  upa <- "extdata/urania_omph/urania_guanahacabibes.tif"
  ura <- raster::raster(system.file(upa,
                                    package = "bamm"))
  opa <- "extdata/urania_omph/omphalea_guanahacabibes.tif"
  omp <- raster::raster(system.file(opa,
                                    package = "bamm"))
  msparse <- bamm::model2sparse(ura)
  init_coordsdf <- data.frame(x=-84.38751, y= 22.02932)
  initial_points <- bamm::occs2sparse(modelsparse = msparse,init_coordsdf)
  set_M <- bamm::adj_mat(modelsparse = msparse,ngbs = 1)

  expect_error(bamm::bam_sim(sp1="ura", sp2=omp, set_M=set_M,
                             initial_points=initial_points,
                             periods_toxic=3,
                             periods_suitable=3,
                             nsteps=10))
  expect_error(bamm::bam_sim(sp1=ura, sp2=omp, set_M="set_M",
                             initial_points=initial_points,
                             periods_toxic=3,
                             periods_suitable=3,
                             nsteps=10))
  ura_sim <- bamm::bam_sim(sp1=ura, sp2=omp, set_M=set_M,
                           initial_points=initial_points,
                           periods_toxic=3,
                           periods_suitable=3,
                           nsteps=10)
  expect_s4_class(ura_sim,"bam")
})

# Tests for bam_ssim

test_that("bam_ssim A simple simultation of predator-prey interaction.
          Returns an object of class",{
            upa <- "extdata/urania_omph/urania_guanahacabibes.tif"
  ura <- raster::raster(system.file(upa,
                                    package = "bamm"))
  opa <- "extdata/urania_omph/omphalea_guanahacabibes.tif"
  omp <- raster::raster(system.file(opa,
                                    package = "bamm"))
  msparse <- bamm::model2sparse(ura)
  init_coordsdf <- data.frame(x=-84.38751, y= 22.02932)
  initial_points <- bamm::occs2sparse(modelsparse = msparse,init_coordsdf)
  set_M <- bamm::adj_mat(modelsparse = msparse,ngbs = 1)

  expect_error(bamm::bam_ssim(sp1="ura", sp2=omp, set_M=set_M,
                             initial_points=initial_points,
                             periods_toxic=1,
                             periods_suitable=3,
                             nsteps=10))
  expect_error(bamm::bam_ssim(sp1=ura, sp2=omp, set_M="set_M",
                             initial_points=initial_points,
                             periods_toxic=1,
                             periods_suitable=3,
                             nsteps=10))
  ura_sim <- bamm::bam_ssim(sp1=ura, sp2=omp, set_M=set_M,
                            dispersal_prob = 0.1,
                            initial_points=initial_points,
                            periods_toxic=2,
                            periods_suitable=3,
                            palatable_matrices = TRUE,
                            nsteps=10)
  ura_sim <- bamm::bam_ssim(sp1=ura, sp2=omp, set_M=set_M,
                            dispersal_prob = 0.25,
                            initial_points=initial_points,
                            periods_toxic=1,
                            periods_suitable=3,
                            palatable_matrices = TRUE,
                            nsteps=10)
  expect_s4_class(ura_sim,"bam")
})

# Tests for sim2Raster

test_that("sim2Raster returns a stack of the distribution at time t",{
  ## Not run:
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  model <- raster::raster(model_path)
  sparse_mod <- bamm::model2sparse(model,0.2)
  adj_mod <- bamm::adj_mat(sparse_mod,ngbs = 1,eigen_sys = TRUE,1)
  print(adj_mod)
  occs_lep_cal <- data.frame(longitude = c(-115.10417,
                                           -104.90417),
                             latitude = c(29.61846,
                                          29.81846))
  occs_sparse <- bamm::occs2sparse(modelsparse = sparse_mod,
                                   occs = occs_lep_cal)
  sdm_lep_cal <- bamm::sdm_sim(set_A = sparse_mod,
                               set_M = adj_mod,
                               initial_points = occs_sparse,
                               nsteps = 10)
  expect_error(bamm::sim2Raster(sdm_simul = "sdm_lep_cal",
                                which_steps = seq(1,10,by=1)))
  expect_error(bamm::sim2Raster(sdm_simul = sdm_lep_cal,
                                which_steps = seq(1,11,by=1)))
  expect_error(bamm::sim2Raster(sdm_simul = sdm_lep_cal,
                                which_steps = 1.5))

  sdm_lep_cal_st <- bamm::sim2Raster(sdm_simul = sdm_lep_cal,
                                     which_steps = seq(1,10,by=1))
  sdm_lep_cal_st <- bamm::sim2Raster(sdm_simul = sdm_lep_cal,
                                     which_steps = NULL)
  expect_s4_class(sdm_lep_cal_st, "RasterStack")
})

# Tests for community_sim

test_that("community_sim simulates community dynamics and returns an
          object of class ",{
  ## Not run:
  lagos_path <- system.file("extdata/conejos",
                            package = "bamm")
  enm_path <- list.files(lagos_path,
                         pattern = ".tif",
                         full.names = TRUE)[1:5]
  en_models <- raster::stack(enm_path) >0.1
  ngbs_vect <- sample(1:2,replace = TRUE,
                      size = raster::nlayers(en_models))
  init_coords <- read.csv(file.path(lagos_path,
                                    "lagos_initit.csv"))
  nsteps <- 10
  sdm_comm <- bamm::community_sim(en_models = enm_path,
                                  ngbs_vect = ngbs_vect,
                                  init_coords = init_coords[1:5,],
                                  nsteps = nsteps,
                                  threshold = 0.1)
  expect_error(bamm::community_sim(en_models = enm_path,
                                   ngbs_vect = 1,
                                   init_coords = init_coords[1:5,],
                                   nsteps = nsteps,
                                   threshold = 0.1))
  expect_error(bamm::community_sim(en_models = enm_path,
                                   ngbs_vect = ngbs_vect,
                                   init_coords = init_coords[c(-1,2,3,4,5),],
                                   nsteps = nsteps,
                                   threshold = 0.1))
  expect_s4_class(sdm_comm,"community_sim")

  # Tests for pam2richness function

  expect_s4_class(sdm_comm,"community_sim")
  pams <-bamm::csim2pam(community_sim = sdm_comm ,
                        which_steps = c(1:10))

  expect_error(bamm::csim2pam(community_sim = "a" ,
                              which_steps = c(1:10)))

  expect_s4_class(pams,"pam")
  print(pams)
  richness_stack <- bamm::pam2richness(pams,which_steps=pams@which_steps)
  expect_error(bamm::pam2richness(pamobj = "a",which_steps=pams@which_steps))

  expect_s4_class(richness_stack,"RasterStack")

  # Tests for models2pam

  expect_error(bamm::models2pam(mods_stack = "en_models",
                                sparse=FALSE,parallel=FALSE,
                                ncores=2))
  pam <- bamm::models2pam(mods_stack = en_models,sparse=TRUE,
                          parallel=TRUE,ncores=2)
  expect_s4_class(pam,"dgCMatrix")
  pam <- bamm::models2pam(mods_stack = en_models,sparse=TRUE,
                          parallel=FALSE,ncores=2)
  expect_s4_class(pam,"dgCMatrix")
  pam <- bamm::models2pam(mods_stack = en_models,
                          sparse=FALSE,parallel=TRUE,ncores=2)
  expect_match(class(pam)[1],"matrix")
  pam <- bamm::models2pam(mods_stack = en_models,sparse=FALSE,
                          parallel=FALSE,ncores=2)
  expect_match(class(pam)[1],"matrix")

  # Test for diversity_range_analysis

  nonas <- which(!is.na(en_models[[1]][]))
  xy_mat <- sp::coordinates(en_models[[1]])[ nonas,]
  pam <- bamm::models2pam(en_models,sparse=FALSE)
  rdivan <- bamm::diversity_range_analysis(pam=pam,parallel = TRUE,
                                           xy_mat=xy_mat,
                                           raster_templete = en_models[[1]],
                                           return_null_dfield=TRUE)
  expect_error(bamm::plot(rdivan,plot_type="diversity_range1"))
  bamm::plot(rdivan,plot_type="diversity_range_map")
  #bamm::plot(rdivan,plot_type="diversity_range_interactive")
  bamm::plot(rdivan,plot_type="alpha")
  bamm::plot(rdivan,plot_type="dispersion_field")
  bamm::plot(rdivan,plot_type="dispersion_field_map")
  expect_s4_class(rdivan,"diversity_range")
  rdivan <- bamm::diversity_range_analysis(pam=pam,parallel = TRUE,
                                           xy_mat=xy_mat,
                                           raster_templete = NULL,
                                           return_null_dfield=TRUE)
  bamm::plot(rdivan,plot_type="diversity_range_map")

})

# Tests for pam2richness function

#test_that("pam2richness returns a raster of richness",{
#  lagos_path <- system.file("extdata/conejos",
#                            package = "bamm")
#  enm_path <- list.files(lagos_path,
#                         pattern = ".tif",
#                         full.names = TRUE)
#  en_models <- raster::stack(enm_path)
#  ngbs_vect <- sample(1:2,replace = TRUE,
#                      size = raster::nlayers(en_models))
#  init_coords <- read.csv(file.path(lagos_path,
#                                    "lagos_initit.csv"))
#  nsteps <- 10
#  sdm_comm <- bamm::community_sim(en_models = enm_path,
#                                  ngbs_vect = ngbs_vect,
#                                  init_coords = init_coords,
#                                  nsteps = nsteps,
#                                  threshold = 0.3)
#  expect_s4_class(sdm_comm,"community_sim")
#  pams <-bamm::csim2pam(community_sim = sdm_comm ,
#                        which_steps = c(1:10))

#  expect_error(bamm::csim2pam(community_sim = "a" ,
#                              which_steps = c(1:10)))

#  expect_s4_class(pams,"pam")
#  print(pams)
#  richness_stack <- bamm::pam2richness(pams,which_steps=pams@which_steps)
#  expect_error(bamm::pam2richness(pamobj = "a",which_steps=pams@which_steps))

#  expect_s4_class(richness_stack,"RasterStack")

#})

# Test for null_distribution_field_distribution

test_that("null_distribution_field_distribution expects a matrix",{
  set.seed(111)
  pam <- data.frame(matrix(rbinom(100,1,0.3),nrow = 10,ncol = 10))
  dfield_rand <- bamm::null_dispersion_field_distribution(pam,n_iter=10,
                                                          parallel=FALSE,
                                                          n_cores = 2)
  dfield_rand <- bamm::null_dispersion_field_distribution(pam,n_iter=10,
                                                          parallel=TRUE,
                                                          n_cores = 2)
  expect_error(bamm::null_dispersion_field_distribution("pam",n_iter=10,
                                                        parallel=FALSE,
                                                        n_cores = 2))
  expect_vector(dfield_rand)
})

# Tests for jaccard.R

test_that("jaccard returns a data.frame", {
  m1_path <- system.file("extdata/conejos/Lepus_othus_cont.tif",
                         package = "bamm")
  m2_path <- system.file("extdata/conejos/Brachylagus_idahoensis_cont.tif",
                         package = "bamm")
  m1 <- raster::raster(m1_path) > 0.01
  m2 <- raster::raster(m2_path) >0.01
  m1s <- bamm::model2sparse(m1,threshold = 0.1)
  m2s <- bamm::model2sparse(m2,threshold = 0.1)
  jcc <- bamm::jaccard(m1,m2)
  jccs <- bamm::jaccard(m1s,m2s)
  expect_error(bamm::jaccard("m1",m2))
  expect_error(bamm::jaccard(m1,"m2"))
  expect_equal(jcc,jccs)
  expect_equal(class(jcc),"data.frame")
})

# Tests for pam2bioindex

test_that("pam2bioindex returns an object of class bioindex",{
  set.seed(111)
  pam <- matrix(rbinom(100,1,0.3),nrow = 10,ncol = 10)
  bioindices <- bamm::pam2bioindex(pam=data.frame(pam),biodiv_index="all")
  expect_s4_class(bioindices,"bioindex")
  # Return results as sparse models
  bioindices <- bamm::pam2bioindex(pam=pam,biodiv_index="all",as_sparse=TRUE)
  print(bioindices)
  expect_s4_class(bioindices,"bioindex_sparse")
  expect_error(bamm::pam2bioindex(pam="pam",biodiv_index="all",as_sparse=TRUE))

})

# Tests for models2pam
#test_that("models2pam returns a PAM as a sparsematrix",{
#  lagos_path <- system.file("extdata/conejos",
#                            package = "bamm")
#  enm_path <- list.files(lagos_path,
#                         pattern = ".tif",
#                         full.names = TRUE)
#  en_models <- raster::stack(enm_path) >0.01
#  expect_error(bamm::models2pam(mods_stack = "en_models",
#                                sparse=FALSE,parallel=FALSE,
#                                ncores=2))
#  pam <- bamm::models2pam(mods_stack = en_models,sparse=TRUE,
#                          parallel=TRUE,ncores=2)
#  expect_s4_class(pam,"dgCMatrix")
#  pam <- bamm::models2pam(mods_stack = en_models,sparse=TRUE,
#                          parallel=FALSE,ncores=2)
#  expect_s4_class(pam,"dgCMatrix")
#  pam <- bamm::models2pam(mods_stack = en_models,
#                          sparse=FALSE,parallel=TRUE,ncores=2)
#  expect_match(class(pam)[1],"matrix")
#  pam <- bamm::models2pam(mods_stack = en_models,sparse=FALSE,
#                          parallel=FALSE,ncores=2)
#  expect_match(class(pam)[1],"matrix")
#})

# Test for diversity_range_analysis

#test_that("diversity_range_analysis returns an object of class diversity_range",
#          {
#  set.seed(111)
#  pam <- matrix(rbinom(10000,1,0.5),nrow = 100,ncol = 1000)
#  rdivan <- bamm::diversity_range_analysis(pam=pam,parallel = FALSE,
#                                           return_null_dfield=TRUE)
#  print(rdivan)
#  expect_s4_class(rdivan,"diversity_range")

#  bamm::plot(rdivan,plot_type="diversity_range")
  # Lagomorphos
#  lagos_path <- system.file("extdata/conejos",
#                            package = "bamm")
#  enm_path <- list.files(lagos_path,
#                         pattern = ".tif",
#                         full.names = TRUE)
#  en_models <- raster::stack(enm_path) >0.01
#  nonas <- which(!is.na(en_models[[1]][]))
#  xy_mat <- sp::coordinates(en_models[[1]])[ nonas,]
#  pam <- bamm::models2pam(en_models,sparse=FALSE)
#  rdivan <- bamm::diversity_range_analysis(pam=pam,parallel = TRUE,
#                                           xy_mat=xy_mat,
#                                           raster_templete = en_models[[1]],
#                                           return_null_dfield=TRUE)
#  expect_error(bamm::plot(rdivan,plot_type="diversity_range1"))
#  bamm::plot(rdivan,plot_type="diversity_range_map")
  #bamm::plot(rdivan,plot_type="diversity_range_interactive")
#  bamm::plot(rdivan,plot_type="alpha")
#  bamm::plot(rdivan,plot_type="dispersion_field")
#  bamm::plot(rdivan,plot_type="dispersion_field_map")
#  expect_s4_class(rdivan,"diversity_range")
#  rdivan <- bamm::diversity_range_analysis(pam=pam,parallel = TRUE,
#                                           xy_mat=xy_mat,
#                                           raster_templete = NULL,
#                                           return_null_dfield=TRUE)
#  bamm::plot(rdivan,plot_type="diversity_range_map")
#})

# Testing predic method

test_that("predict retuns a prediction",{
  # Not run:
  # Load R packages
  # rm(list = ls())
  # Read raster model for Lepus californicus
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  model <- raster::raster(model_path)
  # Convert model to sparse
  sparse_mod <- bamm::model2sparse(model = model,0.1)
  # Compute adjacency matrix
  adj_mod <- bamm::adj_mat(sparse_mod,ngbs=1)

  # Initial points to start dispersal process

  occs_lep_cal <- data.frame(longitude = c(-115.10417,
                                           -104.90417),
                             latitude = c(29.61846,
                                          29.81846))
  # Convert to sparse the initial points
  occs_sparse <- bamm::occs2sparse(modelsparse = sparse_mod,
                                   occs = occs_lep_cal)

  # Run the bam (sdm) simultation for 100 time steps
  smd_lep_cal <- bamm::sdm_sim(set_A = sparse_mod,
                               set_M = adj_mod,
                               initial_points = occs_sparse,
                               nsteps = 10)
  #----------------------------------------------------------------------------
  # Predict species' distribution under suitability change
  # scenarios (could be climate chage scenarios).
  #----------------------------------------------------------------------------

  # Read suitability layers (two suitability change scenarios)
  layers_path <- system.file("extdata/suit_change",
                             package = "bamm")
  niche_mods_stack <- raster::stack(list.files(layers_path,
                                               pattern = ".tif$",
                                               full.names = TRUE))
  raster::plot(niche_mods_stack)
  # Predict
  new_preds <- predict(object = smd_lep_cal,
                       niche_layers = niche_mods_stack,
                       nsteps_vec = c(10,10))
  fname <- tempfile(pattern = "animation_",fileext = ".html")
  # Generate the dispersal animation for time period 1 and 2
  new_preds <- predict(object = smd_lep_cal,
                       niche_layers = niche_mods_stack,
                       nsteps_vec = c(10,10),
                       animate=TRUE,
                       filename=fname,
                       fmt="HTML")
  expect_error(predict(object = smd_lep_cal,
                       niche_layers = "niche_mods_stack",
                       nsteps_vec = c(10,10),
                       animate=TRUE,
                       filename=fname,
                       fmt="HTML"))
  expect_error(predict(object = smd_lep_cal,
                       niche_layers = "niche_mods_stack",
                       nsteps_vec = c(10,10),
                       animate=TRUE,
                       filename=fname,
                       fmt="nn"))
  expect_error(predict(object = smd_lep_cal,
                       niche_layers = niche_mods_stack,
                       nsteps_vec = c(10,1,5),
                       animate=TRUE,
                       filename=fname,
                       fmt="HTML"))
  expect_error(predict(object = smd_lep_cal,
                       niche_layers = niche_mods_stack,
                       nsteps_vec = c(10,1),
                       nbgs_vec=c(1,2,5),
                       animate=TRUE,
                       filename=fname,
                       fmt="HTML"))
  fname <- tempfile(pattern = "animation_",fileext = ".gif")
  new_preds <- predict(object = smd_lep_cal,
                       niche_layers = niche_mods_stack[[1]],
                       nsteps_vec = c(10),
                       animate=TRUE,
                       filename=fname,
                       fmt="GIF")
  new_preds <- predict(object = smd_lep_cal,
                       niche_layers = niche_mods_stack,
                       nsteps_vec = c(1),
                       stochastic_dispersal=TRUE,
                       nbgs_vec=c(1,2),
                       disp_prop2_suitability	=TRUE,
                       disper_prop= 0.5,
                       period_names	=c("P1","P2"),
                       bg_color	="gray97",
                       suit_color	= "red",
                       occupied_color="blue",
                       animate=TRUE,
                       filename=fname,
                       fmt="GIF")


})
# Test for sim2Animation
testthat::test_that("sim2Animation",{
  model_path <- system.file("extdata/Lepus_californicus_cont.tif",
                            package = "bamm")
  model <- raster::raster(model_path)
  sparse_mod <- bamm::model2sparse(model,0.1)
  adj_mod <- bamm::adj_mat(sparse_mod,ngbs=2)
  occs_lep_cal <- data.frame(longitude = c(-115.10417,
                                           -104.90417),
                             latitude = c(29.61846,
                                          29.81846))
  occs_sparse <- bamm::occs2sparse(modelsparse = sparse_mod,
                                   occs = occs_lep_cal)
  sdm_lep_cal <- bamm::sdm_sim(set_A = sparse_mod,
                               set_M = adj_mod,
                               initial_points = occs_sparse,
                               nsteps = 20)
  ani_name <- tempfile(pattern = "anima_",fileext = ".html")
  sdm_lep_cal_st <- bamm::sim2Animation(sdm_simul = sdm_lep_cal,
                                        which_steps = seq(1,20,by=1),
                                        fmt = "HTML",ani.width = 1200,
                                        ani.height = 1200,
                                        filename = ani_name)
  expect_s4_class(sdm_lep_cal_st,"RasterLayer")
  ani_name <- tempfile(pattern = "anima_",fileext = ".gif")
  sdm_lep_cal_st <- bamm::sim2Animation(sdm_simul = sdm_lep_cal,
                                        which_steps = seq(1,20,by=1),
                                        fmt = "GIF",ani.width = 1200,
                                        ani.height = 1200,
                                        filename = ani_name)

  expect_s4_class(sdm_lep_cal_st,"RasterLayer")

})

Try the bamm package in your browser

Any scripts or data that you put into this service are public.

bamm documentation built on Sept. 11, 2024, 6:19 p.m.