.Rhistory

# Project potential distribution using bioclimatic layers for 1970-2000
# period.
layers_70_00_dir <- system.file("extdata/bio_1970_2000",package = "tenm")
suit_1970_2000 <- predict(mod_sel,model_variables = NULL,
layers_path = layers_70_00_dir,
layers_ext = ".tif$")
mod_sel
suit_1970_2000 <- predict(mod_sel,model_variables = c("bio_01","bio_04","bio_07"),
layers_path = layers_70_00_dir,
layers_ext = ".tif$")
suit_1970_2000 <- predict(mod_sel,model_variables = c("bio_01","bio_04","bio_07"),
layers_path = layers_70_00_dir,
layers_ext = ".tif$",output="mahalanobis")
object = mod_sel
model_variables = c("bio_01","bio_04","bio_07")
layers_path = layers_70_00_dir
layers_ext = ".tif$"
output="mahalanobis"
mod_table <- object$mods_table
model_vars <- stringr::str_split(mod_table$fitted_vars,",")
#layers_in <- which(!layers_path %in% unique(object$temporal_df$layers_path))
#if(length(layers_in)>0){
# stop(paste("Not a valid path:",layers_path[layers_in],
#             "please provide a valid path"))
#}
if(is.null(model_variables)){
message(paste0("No selected variables. Using the first model in mods_table"))
mod_vars <- model_vars[[1]]
} else{
mod_vars <- model_variables
idvars <- which(!mod_vars %in% names(object$env_bg))
if(length(idvars)>0L){
stop(paste("Not valid variable names:",model_vars[idvars],
"please provide valid variable names"))
}
}
#----------------------------------------------------------
# Fit ellipsoid model in E-space
trian_ids <- object$temporal_df$trian_test== "Train"
env_data <- object$temporal_df[trian_ids,mod_vars]
env_data <- stats::na.omit(env_data)
mod <- tenm::cov_center(env_data,mve = mve,
level = level,vars = mod_vars)
mve=T
mod <- tenm::cov_center(env_data,mve = mve,
level = level,vars = mod_vars)
level=0.975
mod <- tenm::cov_center(env_data,mve = mve,
level = level,vars = mod_vars)
projmods <- tenm::ellipsoid_projection(envlayers = terra::rast(layers),
centroid = mod$centroid,
covar = mod$covariance,
level = 0.9999,
plot = TRUE,size = 2,
output = output)
layers
layers = NULL
pb <- utils::txtProgressBar(min = 0,max = length(layers_path),style = 3)
layers_path
x=1
lnames <- list.files(layers_path[x],pattern = layers_ext)
lnames
lanames <- gsub(layers_ext,"",lnames)
lanames
var_ids <- which(lanames %in% mod_vars)
var_ids
layer2proj <- list.files(layers_path[x],full.names = T,
pattern = layers_ext)[var_ids]
layer2proj
slayers <- terra::rast(layer2proj)
suitmod <- tenm::ellipsoid_projection(envlayers = slayers,
centroid = mod$centroid,
covar = mod$covariance,
level = 0.9999,
plot = TRUE,
size = 2,
output = output)
envlayers = slayers
centroid = mod$centroid
covar = mod$covariance
level = 0.9999
plot = TRUE
size = 2
output = output
if(methods::is(envlayers, "SpatRaster")){
suitRaster <- envlayers[[1]]
names(suitRaster) <- "Suitability"
nonaids <- which(!is.na(suitRaster[]))
env_vars <- 1:terra::nlyr(envlayers) |> purrr::map_dfc(function(x){
val <- envlayers[[x]][]
dfv <- data.frame(val[nonaids])
names(dfv) <- names(envlayers[[x]])
return(dfv)
})
}
# Calculating distance to the centroid
mahalanobisD <- stats::mahalanobis(env_vars,
center = centroid,
cov = covar)
suit <- function( mahalanobisD){
expo <- exp(-0.5* mahalanobisD)
return(expo)
}
output
# Computing the suitabilities
if(output =="suitability"){
suits <- suit( mahalanobisD)
} else if(output == "mahalanobis"){
suits <- mahalanobisD
}
rm(list = c("mahalanobisD"))
suitVals <- rep(NA,terra::ncell(envlayers[[1]]))
suitVals[nonaids] <- suits
suitRaster[] <- suitVals
plotsuitRaster
plot(suitRaster)
data1 <- env_vars
dfd <- dim(data1)[1] - 1
dfn <- dim(data1)[2] - 1
ellips_E  <- rgl::ellipse3d(covar,centre = centroid,level = 0.99)
if(dfd > 50000)
np <- 50000
else
if(dfd > 50000)
np <- 50000
else
dfd > 50000
np <- dim(data1)[1]
toSam <- sample(1:length(data1[,1]),np)
data1 <- data1[toSam,]
if(output == "suitability"){
suits2 <- suits[toSam]
} else if(output == "mahalanobis"){
suits2 <- suit(data1)
}
suits2
suit <- function( mahalanobisD){
expo <- exp(-0.5* mahalanobisD)
return(expo)
}
suits2 <- suit(data1)
suits2
suit(data1)
suits2 <- suit(suits[toSam])
suits2
library(tenm)
ntbox::biaslayer()
ntbox::biaslayer
?ntbox::biaslayer
?ovellip::
?ovellip
library(overllip)
?overllip::stack_overlap()
# Check spelling
# usethis::use_spell_check()
spelling::spell_check_package()
?ntbox::bin_model
model_p <- system.file("extdata/ambystoma_model.tif",
package = "ntbox")
model <- raster::raster(model_p)
data_p <- system.file("extdata/ambystoma_validation.csv",
package = "ntbox")
data <- read.csv(data_p)
occs <- data[which(data$presence_absence==1),]
occs
binary <- bin_model(model,occs,percent = 5)
binary
binary <- bin_model(model,occs,percent = 5)
binary <- ntbox::bin_model(model,occs,percent = 5)
data <- read.csv(data_p)
occs <- data[which(data$presence_absence==1),]
binary <- ntbox::bin_model(model,occs,percent = 5)
binary <- ntbox::bin_model(model,occs[,1:2],percent = 5)
binary
ntbox::bin_model
plot(model)
raster::extract(model,occs[,1:2])
sort(na.omit(raster::extract(model,occs[,1:2])))
suits <- sort(na.omit(raster::extract(model,occs[,1:2])))
fiveperID <- ceiling(length(suits)*0.05)
fiveperID
umbralID <- ceiling(length(suits)*0.05)
umbral <- suits[umbralID]
umbral
#-------------------------------------------------------------------------------
# Calculo del umbral
#-------------------------------------------------------------------------------
# Primero se extraen los valores ordenados de idoneidad
suits <- sort(na.omit(raster::extract(model,occs[,1:2])))
umbralID <- ceiling(length(suits)*0.05)
# Binarizando el mapa
binmod <- model > umbral
install.packages("bamm")
?bamm::permute_pam
pam <- matrix(rbinom(1000000,1,0.3),nrow = 1000,ncol = 1000)
ppam <- bamm::permute_pam(m = pam,niter = NULL,as_sparse = FALSE)
ppam
pam <- matrix(rbinom(10000000000,1,0.3),nrow = 100000,ncol = 100000)
dim(pam)
ppam <- bamm::permute_pam(m = pam,niter = NULL,as_sparse = FALSE)
gc()
gc()
# Check if matrices are different
all(pam == ppam)
gc()
all(Matrix::rowSums(pam) == Matrix::rowSums(ppam))
covr::codecov()
testthat::context_start_file("check-output")
rm(list = ls())
rhub::rhub_check(platforms = c("linux","macos",
"macos-arm64","windows",
"ubuntu-clang"))# launch manually
#testthat::context_start_file("check-output")
# Test
test_that("sp_temporal_data, returns an object of class sp.temporal.modeling", {
data("abronia")
tempora_layers_dir <- system.file("extdata/bio",package = "tenm")
abt <- tenm::sp_temporal_data(occs = abronia,
longitude = "decimalLongitude",
latitude = "decimalLatitude",
sp_date_var = "year",
occ_date_format="y",
layers_date_format= "y",
layers_by_date_dir = tempora_layers_dir,
layers_ext="*.tif$")
expect_s3_class(abt, "sp.temporal.modeling")
})
library(testthat)
library(tenm)
#testthat::context_start_file("check-output")
# Test
test_that("sp_temporal_data, returns an object of class sp.temporal.modeling", {
data("abronia")
tempora_layers_dir <- system.file("extdata/bio",package = "tenm")
abt <- tenm::sp_temporal_data(occs = abronia,
longitude = "decimalLongitude",
latitude = "decimalLatitude",
sp_date_var = "year",
occ_date_format="y",
layers_date_format= "y",
layers_by_date_dir = tempora_layers_dir,
layers_ext="*.tif$")
expect_s3_class(abt, "sp.temporal.modeling")
})
# Test
test_that("clean_dup, returns a data.frame of cleaned occurrences", {
data(abronia)
tempora_layers_dir <- system.file("extdata/bio",package = "tenm")
tenm_mask <- terra::rast(file.path(tempora_layers_dir,"1939/bio_01.tif"))
# Clean duplicates without raster mask (just by distance threshold)
# Clean duplicated records using a distance of ~ 18 km (0.1666667 grades)
ab_1 <- tenm::clean_dup(data =abronia,
longitude = "decimalLongitude",
latitude = "decimalLatitude",
threshold = terra::res(tenm_mask),
by_mask = FALSE,
raster_mask = NULL)
expect_match(class(ab_1),"data.frame")
ab_2 <- tenm::clean_dup(data =abronia,
longitude = "decimalLongitude",
latitude = "decimalLatitude",
threshold = terra::res(tenm_mask)[1],
by_mask = TRUE,
raster_mask = tenm_mask,
n_ngbs = 0)
expect_match(class(ab_2),"data.frame")
})
test_that("clean_dup_by_date, returns an object of class sp.temporal.modeling",{
data("abronia")
tempora_layers_dir <- system.file("extdata/bio",package = "tenm")
tenm_mask <- terra::rast(file.path(tempora_layers_dir,"1939/bio_01.tif"))
# Clean duplicates without raster mask (just by distance threshold)
abt <- tenm::sp_temporal_data(occs = abronia,
longitude = "decimalLongitude",
latitude = "decimalLatitude",
sp_date_var = "year",
occ_date_format="y",
layers_date_format= "y",
layers_by_date_dir = tempora_layers_dir,
layers_ext="*.tif$")
abtc1 <- tenm::clean_dup_by_date(abt,threshold = terra::res(tenm_mask)[1])
# Clean duplicates using a raster mask
abtc2 <- tenm::clean_dup_by_date(this_species = abt,
by_mask = TRUE,
threshold = terra::res(tenm_mask)[1],
raster_mask = tenm_mask,
n_ngbs = 0)
testthat::expect_equal(class(abtc1),"sp.temporal.modeling")
testthat::expect_equal(class(abtc2),"sp.temporal.modeling")
})
test_that("correlation_finder, returns a list with non-correlated variables",{
temperature <- rnorm(n = 100,mean = 25, sd= 5)
precip <- rnorm(n = 100,mean = 1000, sd= 5)
dfp <- data.frame(temperature, precip)
cf1 <-   correlation_finder(environmental_data = dfp,method = "spearman",
threshold = 0.5,verbose = FALSE)
cf2 <-   correlation_finder(environmental_data = dfp,method = "pearson",
threshold = 0.5,verbose = FALSE)
cf3 <-   correlation_finder(environmental_data = dfp,method = "spearman",
threshold = 0.5,verbose = TRUE)
cf4 <-   correlation_finder(environmental_data = dfp,method = "pearson",
threshold = 0.5,verbose = TRUE)
expect_equal(class(cf1), "list")
expect_equal(class(cf2), "list")
testthat::expect_null(cf3)
testthat::expect_null(cf3)
})
test_that("cells2samp, returns the cell ids of a raster layer to be sampled",{
data(abronia)
temporal_layer <- system.file("extdata/bio/2016/bio_01.tif",package = "tenm")
raster_mask <- terra::rast(temporal_layer)
set.seed(123)
samp_01 <- tenm::cells2samp(data = abronia,
longitude = "decimalLongitude",
latitude = "decimalLatitude",
cell_ids = NULL,
buffer_ngbs = 4,
raster_mask = raster_mask,
process_ngbs_by = 10,
n_bg = 50000,
progress =TRUE)
samp_02 <- tenm::cells2samp(data = abronia,
longitude = "decimalLongitude",
latitude = "decimalLatitude",
cell_ids = c(26,49),
buffer_ngbs = 4,
raster_mask = raster_mask,
process_ngbs_by = 10,
n_bg = 50000,
progress =TRUE)
samp_03 <- tenm::cells2samp(data = abronia,
longitude = "decimalLongitude",
latitude = "decimalLatitude",
cell_ids = c(26,49),
buffer_ngbs = 4,
raster_mask = raster_mask,
process_ngbs_by = 10,
n_bg = 50000,
progress =FALSE)
testthat::expect_vector(samp_01)
testthat::expect_vector(samp_02)
testthat::expect_vector(samp_03)
})
test_that("tests for pROC",{
data(abronia)
# pROC test
# ----------------------------------------------------------------------------
suit_1970_2000 <- terra::rast(system.file("extdata/suit_1970_2000.tif",
package = "tenm"))
testthat::expect_vector(tenm::metaras(suit_1970_2000))
proc_test <- tenm::pROC(continuous_mod = suit_1970_2000,
test_data = abronia[,c("decimalLongitude",
"decimalLatitude")],
n_iter = 500, E_percent=5,
boost_percent=50)
testthat::expect_type(proc_test,"list")
# ----------------------------------------------------------------------------
})
# pROC test
# ----------------------------------------------------------------------------
suit_1970_2000 <- terra::rast(system.file("extdata/suit_1970_2000.tif",
package = "tenm"))
testthat::expect_vector(tenm::metaras(suit_1970_2000))
tenm::metaras
library(tenm)
testthat::expect_vector(tenm::metaras(suit_1970_2000))
# pROC test
# ----------------------------------------------------------------------------
suit_1970_2000 <- terra::rast(system.file("extdata/suit_1970_2000.tif",
package = "tenm"))
testthat::expect_vector(tenm::metaras(suit_1970_2000))
proc_test <- tenm::pROC(continuous_mod = suit_1970_2000,
test_data = abronia[,c("decimalLongitude",
"decimalLatitude")],
n_iter = 500, E_percent=5,
boost_percent=50)
testthat::expect_type(proc_test,"list")
test_that("tests for pROC",{
data(abronia)
# pROC test
# ----------------------------------------------------------------------------
suit_1970_2000 <- terra::rast(system.file("extdata/suit_1970_2000.tif",
package = "tenm"))
testthat::expect_vector(tenm::metaras(suit_1970_2000))
proc_test <- tenm::pROC(continuous_mod = suit_1970_2000,
test_data = abronia[,c("decimalLongitude",
"decimalLatitude")],
n_iter = 500, E_percent=5,
boost_percent=50)
testthat::expect_type(proc_test,"list")
# ----------------------------------------------------------------------------
})
library(tenm)
data("abronia")
tempora_layers_dir <- system.file("extdata/bio",package = "tenm")
abt <- tenm::sp_temporal_data(occs = abronia,
longitude = "decimalLongitude",
latitude = "decimalLatitude",
sp_date_var = "year",
occ_date_format="y",
layers_date_format= "y",
layers_by_date_dir = tempora_layers_dir,
layers_ext="*.tif$")
abtc <- tenm::clean_dup_by_date(abt,threshold = 10/60)
future::plan("multisession",workers=2)
abex <- tenm::ex_by_date(this_species = abtc,train_prop=0.7)
tenm::ex_by_date
tenm::bg_by_date
rhub::rhub_check(platforms = c("linux","macos",
"macos-arm64","windows",
"ubuntu-clang"))# launch manually
covr::codecov()
devtools::test_coverage()
devtools::test_coverage
?covr::codecov()
covr::codecov(path="tests")
covr::codecov(path="tests")
covr::codecov(path="tests")
covr::codecov(path="tests",token = "ead8a99c-ce46-4642-8545-792ed5c9752f")
covr::codecov(path="tests",token = "ead8a99c-ce46-4642-8545-792ed5c9752f")
rhub::rhub_check(platforms = c("linux","macos",
"macos-arm64","windows",
"ubuntu-clang"))# launch manually
# if [Exit Code] is not 0, there is a problem !
# to see the problem: execute the command in a new terminal manually.
devtools::check_win_devel()
# Verify you're ready for release, and release
devtools::release()
# Check spelling
# usethis::use_spell_check()
spelling::spell_check_package()
library(tenm)
library(pkgdown)
build_site()
rhub::rhub_check(platforms = c("linux","macos",
"macos-arm64","windows",
"ubuntu-clang"))# launch manually
# Verify you're ready for release, and release
devtools::release()
# Verify you're ready for release, and release
devtools::release()
# Check spelling
# usethis::use_spell_check()
spelling::spell_check_package()
# Verify you're ready for release, and release
devtools::release()
# Verify you're ready for release, and release
devtools::release()
library(pkgdown)
build_site()
library(tenm)
library(tenm)
library(tenm)
devtools::document()
library(tenm)
library(pkgdown)
build_site()
rhub::rhub_check(platforms = c("linux","macos",
"macos-arm64","windows",
"ubuntu-clang"))# launch manually
library(tenm)
?ellipsoid_selection
library(tenm)
?ellipsoid_selection
?ellipsoid_omr
library(tenm)
?ellipsoid_omr
library(pkgdown)
build_site()
build_site()
rhub::rhub_check(platforms = c("linux","macos",
"macos-arm64","windows",
"ubuntu-clang"))# launch manually
# if [Exit Code] is not 0, there is a problem !
# to see the problem: execute the command in a new terminal manually.
devtools::check_win_devel()
# Verify you're ready for release, and release
devtools::release()
# Check spelling
# usethis::use_spell_check()
spelling::spell_check_package()
library(tenm)
library(tenm)
devtools::document()
library(tenm)
library(pkgdown)
build_site()
# Check spelling
# usethis::use_spell_check()
spelling::spell_check_package()
# Verify you're ready for release, and release
devtools::release()
devtools::document()
library(tenm)
devtools::document()
library(tenm)
library(tenm)
# Check spelling
# usethis::use_spell_check()
spelling::spell_check_package()
library(tenm)
rhub::rhub_check(platforms = c("linux","macos",
"macos-arm64","windows",
"ubuntu-clang"))# launch manually
library(pkgdown)
build_site()
# Verify you're ready for release, and release
devtools::release()
# Verify you're ready for release, and release
devtools::release()
install.packages("tenm")
install.packages("tenm")