-
Notifications
You must be signed in to change notification settings - Fork 0
/
extract_legacy_sample.R
41 lines (41 loc) · 1.62 KB
/
extract_legacy_sample.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
#' Extract the GRTS sample with legacy sites
#' @inheritParams add_level
#' @inheritParams extract_sample
#' @export
#' @importFrom assertthat assert_that is.count
#' @importFrom RSQLite dbListTables dbListFields dbGetQuery
#' @family legacy
extract_legacy_sample <- function(
grtsdb = connect_db(), samplesize, bbox, cellsize, verbose = TRUE, offset
) {
assert_that(is.count(samplesize))
assert_that(missing(offset) || is.count(offset))
level <- n_level(bbox = bbox, cellsize = cellsize)
if (!has_index(grtsdb = grtsdb, level = level, legacy = TRUE)) {
show_message(
"Creating index for legacy level ", level, ". May take some time...",
appendLF = FALSE, verbose = verbose
)
create_index(
grtsdb = grtsdb, level = level, bbox = bbox, cellsize = cellsize,
verbose = verbose, legacy = TRUE
)
show_message(" Done.", verbose = verbose)
}
fields <- dbListFields(grtsdb, sprintf("legacy%02i", level))
fields <- fields[grep("^x[[:digit:]]*$", fields)]
center <- rowMeans(bbox)
midpoint <- 2 ^ (level - 1) - 0.5
where <- sprintf("%s %s %f", rep(fields, 2),
rep(c(">=", "<="), each = length(center)),
(as.vector(bbox) - center) / cellsize + midpoint)
where <- paste(where, collapse = " AND ")
fields <- sprintf("(%1$s - %2$f) * %3$f + %4$f AS %1$sc",
fields, midpoint, cellsize, center)
sql <- sprintf(
"SELECT %s, ranking FROM legacy%02i WHERE %s ORDER BY ranking LIMIT %i%s",
paste(fields, collapse = ", "), level, where, samplesize,
ifelse(missing(offset), "", paste(" OFFSET", offset))
)
dbGetQuery(grtsdb, sql)
}