Nothing
#' Get Spatial polygons (SpatVectors) of species based on its distribution
#' (states and biomes) according to Flora e Funga do Brasil
#'
#' @param data (data.frame) the data.frame imported with the
#' \code{\link{load_florabr}} function.
#' @param species (character) one or more species names (only genus and
#' specific epithet, eg. "Araucaria angustifolia")
#' @param state (logical) get SpatVector of states with occurrence of the
#' species? Default = TRUE
#' @param biome (logical) get SpatVector of biomes with occurrence of the
#' species? Default = TRUE
#' @param intersection (character) get a Spatvector representing the
#' intersection between states and biomes with occurrence of the specie?
#' To use intersection = TRUE, you must define state = TRUE and biome = TRUE".
#' Default = TRUE
#' @param state_vect (SpatVector) a SpatVector of the Brazilian states. By
#' default, it uses the SpatVector provided by geobr::read_state(). It can be
#' another Spatvector, but the structure must be identical to
#' geobr::read_state().
#' @param state_column (character) name of the column in state_vect containing
#' state abbreviations. Only use if biome_vect is not null.
#' @param biome_vect (SpatVector) a SpatVector of the Brazilian biomes. By
#' default, it uses the SpatVector provided by geobr::read_biomes(). It can be
#' another SpatVector, but the structure must be identical to
#' geobr::read_biomes().
#' @param biome_column (character) name of the column in biome_vect containing
#' names of brazilian biomes (in English: "Amazon", "Atlantic_Forest",
#' "Caatinga", "Cerrado", "Pampa" and "Pantanal". Only use if biome_vect is not
#' null.
#' @param verbose (logical) Whether to display species being filtered during
#' function execution. Set to TRUE to enable display, or FALSE to run silently.
#' Default = TRUE.
#'
#' @return A list with SpatVectors of states and/or biomes and/or Intersections
#' for each specie.
#' @importFrom terra subset unwrap intersect mask
#' @importFrom data.table rbindlist
#' @export
#' @references
#' Flora e Funga do Brasil. Jardim Botânico do Rio de Janeiro. Available at:
#' http://floradobrasil.jbrj.gov.br/
#' @examples
#' library(terra)
#' data("bf_data") #Load Flora e Funga do Brasil data
#' spp <- c("Araucaria angustifolia", "Adesmia paranensis") #Example species
#' #Get states, biomes and intersection states-biomes of species
#' spp_spt <- get_spat_occ(data = bf_data, species = spp, state = TRUE,
#' biome = TRUE, intersection = TRUE, state_vect = NULL,
#' biome_vect = NULL, verbose = TRUE)
#'
#'
#' #Plot states of occurrence of Araucaria angustifolia
#' plot(spp_spt[[1]]$states, main = names(spp_spt)[[1]])
#' #Plot biomes of occurrence of Araucaria angustifolia
#' plot(spp_spt[[2]]$biomes, main = names(spp_spt)[[2]])
#' #Plot intersection between states and biomes of occurrence of
#' #Araucaria angustifolia
#' plot(spp_spt[[1]]$states_biomes)
#'
get_spat_occ <- function(data, species, state = TRUE,
biome = TRUE,
intersection = TRUE,
state_vect = NULL, state_column = NULL,
biome_vect = NULL, biome_column = NULL,
verbose = TRUE) {
if (missing(data)) {
stop("Argument data is not defined")
}
if (missing(species)) {
stop("Argument occ is not defined")
}
if (!inherits(data, "data.frame")) {
stop(paste0("Argument data must be a data.frame, not ", class(data)))
}
if (!is.character(species)) {
stop(paste0("Argument species must be a character, not ", class(species)))
}
if (!is.logical(state)) {
stop(paste0("Argument state must be logical, not ", class(state)))
}
if (!is.logical(biome)) {
stop(paste0("Argument biome must be logical, not ", class(biome)))
}
if (!is.logical(intersection)) {
stop(paste0("Argument intersection must be logical, not ",
class(intersection)))
}
if (!is.null(state_vect) && !inherits(state_vect, "SpatVector")) {
stop(paste0("Argument state_vect must be NULL or a SpatVector, not ",
class(state_vect)))
}
if (!is.null(biome_vect) && !inherits(biome_vect, "SpatVector")) {
stop(paste0("Argument biome_vect must be NULL or a SpatVector, not ",
class(biome_vect)))
}
if (!is.null(state_vect) && !is.character(state_column)) {
stop(paste0("Argument state_column must be a character, not ",
class(state_column)))
}
if (!is.null(biome_vect) && !is.character(biome_column)) {
stop(paste0("Argument biome_column must be a character, not ",
class(biome_column)))
}
if (!is.logical(verbose)) {
stop(paste0("Argument verbose must be logical, not ", class(verbose)))
}
#Check colnames in data
if(!all(c("species", "states", "biome") %in%
colnames(data))) {
stop("Important columns are missing in data. Check if data is an object
created by 'load_florabr()")
}
#Check if there is at least one TRUE in states or biomes
if(!state & !biome){
stop("At least one of the parameters state or biome must be TRUE")
}
if(intersection & (!state | !biome)) {
stop("To use intersection = TRUE, you must define state = TRUE and
biome = TRUE")
}
#Load data
d <- data[,c("species", "states", "biome")]
#Check if all species are in Flora e Funga do Brasil data
spp <- get_binomial(species_names = species)
#Get binomial names of species
spp_out <- setdiff(spp, unique(data$species))
if(length(spp_out) > 0) {
stop(paste(length(spp_out), "species are not in the data. Check the species
names using the check_names() function"))
}
#Subset info
d_info <- subset(d, d$species %in% spp)
d_info[d_info == ""] <- NA
#Get only one line by species, merging information of same species
sp_info <- lapply(seq_along(spp), function(i) {
sp <- subset(d_info, d_info$species == spp[i])
sp$states <- paste0(na.omit(unique(sp$states)),
collapse = ";")
sp$biome <- paste0(na.omit(unique(sp$biome)),
collapse = ";")
return(sp)
})
sp_info <- unique(data.table::rbindlist(sp_info))
#Load data
if(state) {
states <- terra::unwrap(florabr::states)
}
if(biome) {
biomes <- terra::unwrap(florabr::biomes)
}
#Check personal vectors (if provided)
#states
if(!is.null(state_vect)){
names(state_vect)[which(names(state_vect) == state_column)] <-"abbrev_state"
check_matches <- setdiff(states$abbrev_state, state_vect$abbrev_state)
if(length(check_matches) > 0) {
stop(paste0("Invalid states in ", state_column,
"\nCheck the structure of the Spatvector provided in
state_vect"))
} else {
states <- state_vect
}}
#biomes
if(!is.null(biome_vect)){
names(biome_vect)[which(names(biome_vect) == biome_column)] <- "name_biome"
check_matches <- setdiff(biomes$name_biome, biome_vect$name_biome)
if(length(check_matches) > 0) {
stop(paste0("Invalid biomes in ", biome_column,
"\nCheck the structure of the Spatvector provided in
biome_vect"))
} else {
biomes <- biome_vect
}}
#Get state
l_occ <- lapply(seq_along(spp), function(i){
occ_i <- subset(sp_info, sp_info$species == spp[i])
if(!state) {states_v <- NULL}
if(state) {
if(verbose) {
message("Getting states of ", spp[i], "\n") }
sp_i_state <- unique(gsub(";", "|", occ_i$states[1]))
if(sp_i_state == "" | is.na(sp_i_state)) {
if(verbose) {
message(spp[i], "lacks info about state - SpatialVector not
returned")}
states_v <- "No_info"
} else {
states_v <- terra::subset(states, grepl(sp_i_state,
states$abbrev_state)) }
}
if(!biome) {biomes_v <- NULL}
if(biome) {
if(verbose) {
message("Getting biomes of ", spp[i], "\n") }
sp_i_biome<- unique(gsub(";", "|", occ_i$biome[1]))
if(sp_i_biome == "" | is.na(sp_i_biome)) {
if(verbose){
message(spp[i], "lacks info about biome - SpatialVector not
returned")}
biomes_v <- "No_info"
} else {
biomes_v <- terra::subset(biomes, grepl(sp_i_biome,
biomes$name_biome)) }
}
if(!intersection) {int_v <- NULL}
if(intersection) {
if(verbose) {
message("Getting biomes of ", spp[i], "\n") }
if((sp_i_biome == "" | is.na(sp_i_biome)) & verbose) {
message(spp[i], "lacks info about states - Impossible to get
intersection with states")
}
if((sp_i_biome == "" | is.na(sp_i_biome)) & verbose) {
message(spp[i], "lacks info about biomes - Impossible to get
intersection with biomes")
}
int_v <- terra::intersect(biomes_v, states_v) }
#Save objects in a list
final_list <- list(states_v, biomes_v, int_v)
names(final_list) <- c("states", "biomes", "states_biomes")
return(final_list)
})
names(l_occ) <- spp
#Drop off null elements
l_occ <- lapply(l_occ, function(x) x[lengths(x) > 0])
return(l_occ)
} #End if function
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.