-
Notifications
You must be signed in to change notification settings - Fork 0
/
get_spat_occ.R
258 lines (227 loc) · 9.16 KB
/
get_spat_occ.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
#' 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