Nothing
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")
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.