-
Notifications
You must be signed in to change notification settings - Fork 0
/
gpkg-util.R
113 lines (103 loc) · 4.09 KB
/
gpkg-util.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
# GeoPackage utilities
#' Get Tables from a _geopackage_ object
#'
#' @param x A _geopackage_ object
#' @param collect Default: `FALSE`. Should tables be materialized as 'data.frame' objects in memory? (i.e. not "lazy") Default: `FALSE`; if `TRUE` 'dbplyr' is not required. Always `TRUE` for `pragma=TRUE` (pragma information are always "collected").
#' @param pragma Default: `FALSE`. Use `gpkg_table_pragma()` instead of `gpkg_table()`? The former does not require 'dbplyr'.
#'
#' @return a list of SpatVectorProxy, SpatRaster, data.frame (lazy tbl?)
#' @export
#' @rdname gpkg_tables
gpkg_tables <- function(x, collect = FALSE, pragma = FALSE)
UseMethod("gpkg_tables", x)
#' @export
#' @rdname gpkg_tables
gpkg_tables.geopackage <- function(x, collect = FALSE, pragma = FALSE) {
src <- gpkg_source(x)
xx <- .gpkg_connection_from_x(x)
contents <- gpkg_contents(xx)
y <- split(contents, contents$data_type)
.LAZY.FUN <- ifelse(isTRUE(pragma), gpkg_table_pragma,
function(x, ...) {
gpkg_table(x, ..., collect = collect)
})
unlist(lapply(names(y), function(z) {
switch(z,
"2d-gridded-coverage" = { sapply(y[[z]]$table_name, function(i) terra::rast(src, i)) },
"features" = { sapply(y[[z]]$table_name, function(i) {
res <- try(terra::vect(src, proxy = !collect, layer = i), silent = TRUE)
if (inherits(res, 'try-error')) {
message(i, " : ", res[1])
res <- .LAZY.FUN(xx, table_name = i)
}
res
}) },
"attributes" = { sapply(y[[z]]$table_name, function(i) list(.LAZY.FUN(xx, table_name = i))) })
}), recursive = FALSE)
}
#' Get Source File of a _geopackage_ object
#'
#' @param x A _geopackage_ object
#' @return _character_ file path
#' @export
#' @rdname gpkg_source
gpkg_source <- function(x)
UseMethod("gpkg_source", x)
#' @export
#' @rdname gpkg_source
gpkg_source.geopackage <- function(x) {
x$dsn
}
#' List Tables in a GeoPackage
#'
#' @param x A _geopackage_ object, path to a GeoPackage or an _SQLiteConnection_
#' @return a character vector with names of all tables and views in the database
#' @importFrom DBI dbListTables dbDisconnect
#' @export
gpkg_list_tables <- function(x) {
con <- .gpkg_connection_from_x(x)
res <- character(0)
if (!is.null(con) && DBI::dbIsValid(con)) {
res <- DBI::dbListTables(con)
if (attr(con, 'disconnect')) {
DBI::dbDisconnect(con)
}
}
res
}
#' Set `data_null` Metadata for a GeoPackage Tile Dataset
#'
#' @param x A _geopackage_ object, path to a GeoPackage or an _SQLiteConnection_
#' @param name character. Tile matrix set name(s) (`tile_matrix_set_name`)
#' @param value numeric. Value to use as "NoData" (`data_null` value)
#' @param query_string logical. Return SQLite query rather than executing it? Default: `FALSE`
#' @return logical. `TRUE` if number of `data_null` records updated is greater than `0`.
#' @importFrom DBI dbDisconnect
#' @export
gpkg_tile_set_data_null <- function(x, name, value, query_string = FALSE) {
if (!requireNamespace("RSQLite", quietly = TRUE)) {
stop('package `RSQLite` is required to set `data_null`', call. = FALSE)
}
invisible(
gpkg_update_table(
x,
table_name = "gpkg_2d_gridded_coverage_ancillary",
updatecol = "data_null",
updatevalue = value,
wherecol = "tile_matrix_set_name",
wherevector = name
) > 0
)
}
#' Get `gpkg_2d_gridded_coverage_ancillary` Table
#'
#' @param x A _geopackage_ object, path to a GeoPackage or an _SQLiteConnection_
#' @return a data.frame containing columns `id`, `tile_matrix_set_name`, `datatype`, `scale`, `offset`, `precision`, `data_null`, `grid_cell_encoding`, `uom`, `field_name`, `quantity_definition`
#' @importFrom DBI dbDisconnect
#' @export
gpkg_2d_gridded_coverage_ancillary <- function(x) {
if (!requireNamespace("RSQLite", quietly = TRUE)) {
stop('package `RSQLite` is required to get the `gpkg_2d_gridded_coverage_ancillary` table', call. = FALSE)
}
gpkg_table(x, "gpkg_2d_gridded_coverage_ancillary", collect = TRUE)
}