-
Notifications
You must be signed in to change notification settings - Fork 52
/
count_facet.r
114 lines (106 loc) · 3.63 KB
/
count_facet.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
#' Facetted count occurrence search.
#'
#' @param keys (numeric) GBIF keys, a vector. optional
#' @param by (character) One of georeferenced, basisOfRecord, country, or
#' publishingCountry. default: country
#' @param countries (numeric) Number of countries to facet on, or a vector of
#' country names. default: 10
#' @param removezeros (logical) remove zeros or not? default: `FALSE`
#' @export
#' @examples \dontrun{
#' # Select number of countries to facet on
#' count_facet(by='country', countries=3, removezeros = TRUE)
#' # Or, pass in country names
#' count_facet(by='country', countries='AR', removezeros = TRUE)
#'
#' spplist <- c('Geothlypis trichas','Tiaris olivacea','Pterodroma axillaris',
#' 'Calidris ferruginea','Pterodroma macroptera',
#' 'Gallirallus australis',
#' 'Falco cenchroides','Telespiza cantans','Oreomystis bairdi',
#' 'Cistothorus palustris')
#' keys <- sapply(spplist,
#' function(x) name_backbone(x, rank="species")$usageKey)
#' count_facet(keys, by='country', countries=3, removezeros = TRUE)
#' count_facet(keys, by='country', countries=3, removezeros = FALSE)
#' count_facet(by='country', countries=20, removezeros = TRUE)
#' count_facet(keys, by='basisOfRecord', countries=5, removezeros = TRUE)
#'
#' # get occurrences by georeferenced state
#' ## across all records
#' count_facet(by='georeferenced')
#'
#' ## by keys
#' count_facet(keys, by='georeferenced')
#'
#' # by basisOfRecord
#' count_facet(by="basisOfRecord")
#' }
count_facet <- function(keys = NULL,
by = 'country',
countries = 10,
removezeros = FALSE) {
.Deprecated(msg="count_facet() is deprecated since rgbif 3.7.6. Use occ_count(facet='x') instead.")
assert(by, "character")
assert(countries, c("numeric", "integer", "character"))
assert(removezeros, "logical")
# faceting data vectors
if (is.numeric(countries)) {
countrynames <- list(country = as.character(enumeration_country()$iso2)[1:countries])
} else{
countrynames <- list(country = as.character(countries))
}
georefvals <- list(georeferenced = c(TRUE, FALSE))
basisvals <- list(basisOfRecord =
c("FOSSIL_SPECIMEN", "HUMAN_OBSERVATION", "LITERATURE",
"LIVING_SPECIMEN", "MACHINE_OBSERVATION", "OBSERVATION",
"PRESERVED_SPECIMEN", "UNKNOWN"))
byvar <- switch(by,
georeferenced = georefvals,
basisOfRecord = basisvals,
country = countrynames,
publishingCountry = countrynames)
if (!is.null(keys)) {
out <- lapply(keys, occ_by_keys, tt = byvar)
names(out) <- keys
df <- ldfast_names(lapply(out, function(x){
rbind_rows(x, by)
}))
} else {
out <- occ_by(byvar)
df <- rbind_rows(out, by)
}
# remove NAs (which were caused by errors in country names)
df <- stats::na.omit(df)
if (removezeros) {
df[!df$count == 0, ]
} else {
df
}
}
# Function to get data for each name
occ_by_keys <- function(spkey=NULL, tt){
occ_count_safe <- fail_with(NULL, occ_count)
tmp <- lapply(tt[[1]], function(x){
xx <- list(x)
names(xx) <- names(tt)
if (!is.null(spkey)) {
xx$taxonKey <- spkey
}
do.call(occ_count_safe, xx)
})
names(tmp) <- tt[[1]]
tmp[grep("No enum", tmp)] <- NA
tmp
}
# Function to get data for each name
occ_by <- function(tt){
occ_count_safe <- fail_with(NULL, occ_count)
tmp <- lapply(tt[[1]], function(x){
xx <- list(x)
names(xx) <- names(tt)
do.call(occ_count_safe, xx)
})
names(tmp) <- tt[[1]]
tmp[grep("No enum", tmp)] <- NA
tmp
}