Creating epmGrid objects from point occurrences
With the epm package, it is also possible to generate epmGrid objects from point occurrence records instead of polygons.
Here, we will download GBIF occurrence records for the same set of squirrel genera that we considered from the IUCN range polygons.
library(rgbif)
squirrelGenera <- c('Spermophilus', 'Citellus', 'Tamias', 'Sciurus', 'Glaucomys', 'Marmota', 'Cynomys')
There are many ways to acquire occurrence records, and that is not the focus of this demonstration. I will do this one particular way, but it is probably not the best way.
First I will loop across the genera and download georeferenced occurrence records.
spOccList <- vector('list', length(squirrelGenera))
names(spOccList) <- squirrelGenera
for (i in 1:length(squirrelGenera)) {
message('\t', squirrelGenera[i])
key <- name_suggest(q = squirrelGenera[i], rank='genus')$data$key[1]
xx <- occ_data(taxonKey = key, hasCoordinate = TRUE, hasGeospatialIssue = FALSE, limit = 10000)
spOccList[[i]] <- as.data.frame(xx$data)
}
Not all the genus downloads have the same columns. Let's reduce to the common set of headers and collapse into a table.
sharedHeaders <- Reduce(intersect, lapply(spOccList, colnames))
spOccList <- lapply(spOccList, function(x) x[, sharedHeaders])
occTable <- do.call(rbind, spOccList)
nrow(occTable) # 40206
Oddly, the 'species' header was not always present, so for the purposes of this demo, I will extract Genus species from the "acceptaedScientificName" field. I will then add it to the table.
# a little cleanup: Let's strip out the genus and species from the scientific name field, and drop any that are genus only
newNames <- occTable$acceptedScientificName
newNames <- lapply(strsplit(newNames, '\\s+'), function(x) x[1:2])
newNames <- sapply(newNames, function(x) paste0(x, collapse = '_'))
nrow(occTable) == length(newNames)
occTable <- cbind(occTable, genSp = newNames)
occTable <- occTable[!grepl('^BOLD:|,', occTable$genSp),]
Here are the species that we have.
> sort(unique(occTable$genSp))
[1] "Arctomys_minor" "Arctomys_nevadensis"
[3] "Arctomys_vetus" "Citellus_bensoni"
[5] "Citellus_cochisei" "Citellus_cragini"
[7] "Citellus_dotti" "Citellus_finlayensis"
[9] "Citellus_fricki" "Citellus_gidleyi"
[11] "Citellus_howelli" "Citellus_matachicensis"
[13] "Citellus_matthewi" "Citellus_mcgheei"
[15] "Citellus_mckayensis" "Citellus_meadensis"
[17] "Citellus_primitivus" "Citellus_rexroadensis"
[19] "Citellus_shotwelli" "Citellus_tuitus"
[21] "Citellus_wilsoni" "Cynomys_gunnisoni"
[23] "Cynomys_hibbardi" "Cynomys_leucurus"
[25] "Cynomys_ludovicianus" "Cynomys_mexicanus"
[27] "Cynomys_niobrarius" "Cynomys_parvidens"
[29] "Cynomys_sappaensis" "Cynomys_socialis"
[31] "Cynomys_spenceri" "Cynomys_vetus"
[33] "Glaucomys_sabrinus" "Glaucomys_volans"
[35] "Marmota_arizonae" "Marmota_korthi"
[37] "Neotamias_ruficaudus" "Otospermophilus_argonautus"
[39] "Sciurus_aberti" "Sciurus_aestuans"
[41] "Sciurus_alleni" "Sciurus_arizonensis"
[43] "Sciurus_aureogaster" "Sciurus_carolinensis"
[45] "Sciurus_colliaei" "Sciurus_deppei"
[47] "Sciurus_granatensis" "Sciurus_griseus"
[49] "Sciurus_ignitus" "Sciurus_nayaritensis"
[51] "Sciurus_niger" "Sciurus_oculatus"
[53] "Sciurus_stramineus" "Sciurus_variegatoides"
[55] "Sciurus_vulgaris" "Sciurus_yucatanensis"
[57] "Spermophilus_alashanicus" "Spermophilus_boothi"
[59] "Spermophilus_brevicauda" "Spermophilus_citellus"
[61] "Spermophilus_cyanocittus" "Spermophilus_dauricus"
[63] "Spermophilus_erythrogenys" "Spermophilus_fulvus"
[65] "Spermophilus_jerae" "Spermophilus_johnstoni"
[67] "Spermophilus_lorisrusselli" "Spermophilus_major"
[69] "Spermophilus_meltoni" "Spermophilus_musicus"
[71] "Spermophilus_pallidicauda" "Spermophilus_pygmaeus"
[73] "Spermophilus_relictus" "Spermophilus_russelli"
[75] "Spermophilus_suslicus" "Spermophilus_taurensis"
[77] "Spermophilus_wellingtonensis" "Spermophilus_xanthoprymnus"
[79] "Tamias_alpinus" "Tamias_amoenus"
[81] "Tamias_cinereicollis" "Tamias_dorsalis"
[83] "Tamias_durangae" "Tamias_merriami"
[85] "Tamias_minimus" "Tamias_obscurus"
[87] "Tamias_palmeri" "Tamias_panamintinus"
[89] "Tamias_quadrimaculatus" "Tamias_quadrivittatus"
[91] "Tamias_rufus" "Tamias_senex"
[93] "Tamias_sibiricus" "Tamias_sonomae"
[95] "Tamias_speciosus" "Tamias_striatus"
[97] "Tamias_townsendii" "Tamias_umbrinus"
I will now split this table into a species-specific list of tables.
# split into a list of species tables
spOccList2 <- split(occTable, occTable$genSp)
How many records did we get?
> sort(sapply(spOccList2, nrow))
Arctomys_minor Citellus_cragini Citellus_finlayensis
1 1 1
Citellus_fricki Citellus_mcgheei Citellus_tuitus
1 1 1
Cynomys_sappaensis Marmota_arizonae Marmota_korthi
1 1 1
Neotamias_ruficaudus Spermophilus_jerae Spermophilus_johnstoni
1 1 1
Spermophilus_meltoni Tamias_panamintinus Arctomys_nevadensis
1 1 2
Arctomys_vetus Citellus_dotti Citellus_gidleyi
2 2 2
Citellus_meadensis Citellus_primitivus Cynomys_hibbardi
2 2 2
Cynomys_socialis Cynomys_vetus Spermophilus_russelli
2 2 2
Spermophilus_wellingtonensis Tamias_alpinus Citellus_cochisei
2 2 3
Citellus_matachicensis Citellus_matthewi Citellus_mckayensis
3 3 3
Citellus_rexroadensis Otospermophilus_argonautus Sciurus_ignitus
3 3 3
Sciurus_nayaritensis Spermophilus_brevicauda Spermophilus_cyanocittus
3 3 3
Spermophilus_lorisrusselli Tamias_obscurus Spermophilus_relictus
3 3 4
Tamias_senex Citellus_howelli Sciurus_arizonensis
4 5 5
Tamias_quadrimaculatus Sciurus_stramineus Citellus_bensoni
5 6 7
Citellus_shotwelli Spermophilus_boothi Sciurus_aestuans
7 7 8
Sciurus_colliaei Sciurus_deppei Sciurus_oculatus
8 9 9
Cynomys_spenceri Sciurus_aberti Tamias_rufus
11 11 13
Tamias_umbrinus Tamias_palmeri Spermophilus_taurensis
13 14 15
Tamias_cinereicollis Spermophilus_pallidicauda Tamias_durangae
15 19 19
Tamias_quadrivittatus Cynomys_niobrarius Sciurus_alleni
19 20 20
Spermophilus_musicus Sciurus_yucatanensis Sciurus_variegatoides
20 23 32
Citellus_wilsoni Tamias_sonomae Tamias_speciosus
33 36 36
Spermophilus_alashanicus Sciurus_granatensis Spermophilus_dauricus
38 40 47
Spermophilus_fulvus Sciurus_aureogaster Tamias_dorsalis
62 86 99
Spermophilus_erythrogenys Spermophilus_pygmaeus Spermophilus_xanthoprymnus
101 112 137
Tamias_merriami Spermophilus_major Cynomys_parvidens
161 170 176
Tamias_townsendii Sciurus_griseus Tamias_amoenus
185 194 201
Tamias_minimus Tamias_sibiricus Spermophilus_suslicus
316 543 707
Cynomys_leucurus Cynomys_gunnisoni Spermophilus_citellus
991 1353 1437
Sciurus_niger Cynomys_mexicanus Sciurus_vulgaris
1867 2288 3633
Glaucomys_sabrinus Glaucomys_volans Sciurus_carolinensis
3651 3948 4042
Cynomys_ludovicianus Tamias_striatus
4867 8227
For a real analysis, we would do more here to validate these records and ensure that we are only using occurrence records that we trust.
We still want to work with an equal area grid system, so we will convert these tables into sf points objects and transform.
sfPtsList <- lapply(spOccList2, function(x) st_as_sf(x[, c('genSp', 'decimalLongitude', 'decimalLatitude', 'basisOfRecord', 'year')], coords = c('decimalLongitude', 'decimalLatitude'), crs = 4326))
spPtsListEA <- lapply(sfPtsList, function(x) st_transform(x, crs = EAproj))
We will reuse the same extent polygon we drew for the IUCN range analysis.
extentPoly <- "POLYGON ((-2906193 4690015, -3110223 4376122, -3377032 4172092, -3769399 3873894, -4083291 3340276, -4067597 2728184, -2702163 -1509370, 782048.5 -4036208, 1425529 -3973429, 1802200 -3785093, 2163177 -2639384, 3622779 -2027293, 2900826 5396274, 578018.1 5207938, -2906193 4690015))"
And now we can generate an epmGrid object from these occurrences. Here I chose a resolution of 100km. Some of the options, such as method and retainSmallRanges, don't apply since points are either in a cell or not in a cell. That is the only criterion.
squirrelPtsEPM100 <- createEPMgrid(spPtsListEA, resolution = 100000, extent = extentPoly, cellType = 'hex')
plot(squirrelPtsEPM100)
