load_tree_data(): auto-detect CSV data types and force PLT_CN type

Author: ctoney

R/load_tree_data.R

@@ -5,9 +5,7 @@
 #' .gpkg), or a PostgreSQL database connection. Other data sources are also
 #' possible. File-based sources can be read from compressed archives without
 #' prior extraction if desired (e.g., .zip), and network-hosted files can be
-#' read directly without prior download (see Details). This function provides
-#' certain conveniences, but tree data could also be loaded in various other
-#' ways (e.g., `read.csv()`).
+#' read directly without prior download (see Details).
 #'
 #' @details
 #' A data source is most commonly specified as one of the following:
@@ -71,6 +69,9 @@
 #' @param sql Optional character string containing a SQL SELECT statement to
 #' execute on `src` (instead of selecting all records, potentially from a subset
 #' of columns, i.e., mutually exclusive with `table` and/or `columns`).
+#' @param quoted_cols_as_char A logical value indicating whether to auto-detect
+#' columns that contain quoted values as `"character"` type, `TRUE` by default.
+#' Only used when `src` is a CSV file.
 #' @return
 #' A data frame containing tree records fetched from `src`.
 #'
@@ -84,6 +85,13 @@
 #'
 #' For more details: \url{https://gdal.org/en/stable/drivers/vector/index.html}
 #'
+#' `load_tree_data()` from a PostgreSQL database requires GDAL built with
+#' support for the PostgreSQL client library (can be checked with
+#' `gdalraster::gdal_formats("postgresql")`).
+#'
+#' Column names are case-sensitive in \pkg{FIAstemmap} functions, and are
+#' assumed to follow the FIADB upper case naming convention.
+#'
 #' @seealso
 #' [DEFAULT_TREE_COLUMNS]
 #'
@@ -95,7 +103,7 @@
 #' head(tree)
 #' @export
 load_tree_data <- function(src, table = NULL, columns = DEFAULT_TREE_COLUMNS,
-                           sql = NULL) {
+                           sql = NULL, quoted_cols_as_char = TRUE) {
 
     if (missing(src) || is.null(src))
         stop("'src' is required")
@@ -108,6 +116,12 @@ load_tree_data <- function(src, table = NULL, columns = DEFAULT_TREE_COLUMNS,
         stop("could not connect to 'src'", call. = FALSE)
     }
 
+    src_fmt <- gdalraster::ogr_ds_format(src)
+    if (is.null(src_fmt)) {
+        cli::cli_alert_danger("unsupported format: {.path {src}}")
+        stop("'src' is not recognized as a supported format", call. = FALSE)
+    }
+
     if (!is.null(table) && !is.null(sql))
         stop("'table' and 'sql' are mutually exclusive", call. = FALSE)
 
@@ -120,18 +134,26 @@ load_tree_data <- function(src, table = NULL, columns = DEFAULT_TREE_COLUMNS,
     if (!is.null(sql) && !(is.character(sql) && length(sql == 1)))
         stop("'sql' must be a single character string")
 
+    if (missing(quoted_cols_as_char) || is.null(quoted_cols_as_char)) {
+        quoted_cols_as_char <- TRUE
+    } else if (!(is.logical(quoted_cols_as_char) ||
+                 length(quoted_cols_as_char) != 1)) {
+        stop("'quoted_cols_as_char' must be a single logical value",
+             call. = FALSE)
+    }
+
     if (is.null(sql) && !is.null(columns)) {
         if (any(c("DIST", "AZIMUTH") %in% columns)) {
-            tbl <- ""
+            tbl_tmp <- ""
             if (!is.null(table))
-                tbl <- table
+                tbl_tmp <- table
 
-            if (gdalraster::ogr_field_index(src, tbl, "DIST") < 0 ||
-                gdalraster::ogr_field_index(src, tbl, "AZIMUTH") < 0) {
+            if (gdalraster::ogr_field_index(src, tbl_tmp, "DIST") < 0 ||
+                gdalraster::ogr_field_index(src, tbl_tmp, "AZIMUTH") < 0) {
 
-                cli::cli_alert_warning(c(
-                    "The data source does not have ",
-                    "{.field DIST} and/or {.field AZIMUTH}"))
+                cli::cli_alert_warning(
+                    c("The data source does not have ",
+                      "{.field DIST} and/or {.field AZIMUTH}"))
 
                 columns <- columns[!columns %in% c("DIST", "AZIMUTH")]
                 if (length(columns) == 0)
@@ -141,14 +163,49 @@ load_tree_data <- function(src, table = NULL, columns = DEFAULT_TREE_COLUMNS,
     }
 
     ds <- NULL
+    open_options <- character(0)
+
+    if (src_fmt == "CSV") {
+        # auto-detect column data types
+        open_options <- c(open_options, "AUTODETECT_TYPE=YES")
+        if (quoted_cols_as_char) {
+            open_options <- c(open_options, "QUOTED_FIELDS_AS_STRING=YES")
+        }
+
+        # force PLT_CN as string data type by schema override (GDAL >= 3.11)
+        # avoids copy, versus changing it later in the data frame
+        tbl_tmp <- table
+        if (is.null(tbl_tmp) || tbl_tmp == "") {
+            tbl_tmp <- gdalraster:::.cpl_get_basename(src)
+        }
+
+        if (gdalraster::ogr_field_index(src, tbl_tmp, "PLT_CN") >= 0 &&
+            gdalraster::gdal_version_num() >=
+                gdalraster::gdal_compute_version(3, 11, 0)) {
+
+            schema <- 'OGR_SCHEMA={"layers": [{"name": "%s", "fields":[{
+                                   "name": "PLT_CN", "type": "String" }]}]}'
+
+            override_schema <- sprintf(schema, tbl_tmp)
+            open_options <- c(open_options, override_schema)
+        }
+    }
+
+    gdalraster::push_error_handler("quiet")
     if (is.null(table) && is.null(sql)) {
-        ds <- try(methods::new(gdalraster::GDALVector, src), silent = TRUE)
+        ds <- try(methods::new(gdalraster::GDALVector, src, "", TRUE,
+                               open_options),
+                  silent = TRUE)
     } else if (!is.null(table)) {
-        ds <- try(methods::new(gdalraster::GDALVector, src, table),
+        ds <- try(methods::new(gdalraster::GDALVector, src, table, TRUE,
+                               open_options),
                   silent = TRUE)
     } else if (!is.null(sql)) {
-        ds <- try(methods::new(gdalraster::GDALVector, src, sql), silent = TRUE)
+        ds <- try(methods::new(gdalraster::GDALVector, src, sql, TRUE,
+                               open_options),
+                  silent = TRUE)
     }
+    gdalraster::pop_error_handler()
 
     if (!methods::is(ds, "Rcpp_GDALVector")) {
         cli::cli_alert_danger("Failed to access tree data in {.path {src}}")