# R functions for various processing with gdalraster
# Chris Toney <chris.toney at usda.gov>


#' List of default nodata values by raster data type
#'
#' These values are currently used in `gdalraster` when a nodata value is
#' needed but has not been specified:
#' \preformatted{
#'     list("Byte" = 255, "UInt8" = 255, "Int8" = -128,
#'          "UInt16" = 65535, "Int16" = -32767,
#'          "UInt32" = 4294967293, "Int32" = -2147483647,
#'          "Float32" = -99999.0, "Float64" = NaN)
#' }
#' @export
DEFAULT_NODATA <- list(
    "Byte" = 255, "UInt8" = 255, "Int8" = -128,
    "UInt16" = 65535, "Int16" = -32767,
    "UInt32" = 4294967293, "Int32" = -2147483647,
    "Float32" = -99999.0, "Float64" = NaN)


#' List of default DEM processing options
#'
#' These values are used in `dem_proc()` as the default processing options:
#' \preformatted{
#'     list(
#'          "hillshade" =    c("-z", "1", "-s", "1", "-az", "315",
#'                             "-alt", "45", "-alg", "Horn",
#'                             "-combined", "-compute_edges"),
#'          "slope" =        c("-s", "1", "-alg", "Horn", "-compute_edges"),
#'          "aspect" =       c("-alg", "Horn", "-compute_edges"),
#'          "color-relief" = character(),
#'          "TRI" =          c("-alg", "Riley", "-compute_edges"),
#'          "TPI" =          c("-compute_edges"),
#'          "roughness" =    c("-compute_edges"))
#' }
#' @seealso
#' [dem_proc()]
#'
#' \url{https://gdal.org/en/stable/programs/gdaldem.html} for a description of all
#' available command-line options for each processing mode
#' @export
DEFAULT_DEM_PROC <- list(
    "hillshade" = c("-z", "1", "-s", "1", "-az", "315",
                    "-alt", "45", "-alg", "Horn",
                    "-combined", "-compute_edges"),
    "slope" = c("-s", "1", "-alg", "Horn", "-compute_edges"),
    "aspect" = c("-alg", "Horn", "-compute_edges"),
    "color-relief" = character(),
    "TRI" = c("-alg", "Riley", "-compute_edges"),
    "TPI" = c("-compute_edges"),
    "roughness" = c("-compute_edges"))


#' @noRd
.getGDALformat <- function(file) {
    # Only for guessing common output formats
    file <- as.character(file)
    if (endsWith(tolower(file), ".tif")) {
        return("GTiff")
    }
    if (endsWith(tolower(file), ".vrt")) {
        return("VRT")
    }
    if (endsWith(tolower(file), ".img")) {
        return("HFA")
    }
    return(NULL)
}


#' @noRd
.getOGRformat <- function(file) {
    # Only for guessing common output formats
    file <- as.character(file)
    if (startsWith(file, "PG:")) {
        return("PostgreSQL")
    }
    if (endsWith(tolower(file), ".gpkg")) {
        return("GPKG")
    }
    if (endsWith(tolower(file), ".shp")) {
        return("ESRI Shapefile")
    }
    if (endsWith(tolower(file), ".sqlite")) {
        return("SQLite")
    }
    if (endsWith(tolower(file), ".fgb")) {
        return("FlatGeobuf")
    }
    if (endsWith(tolower(file), ".geojson") ||
        endsWith(tolower(file), ".json")) {

        return("GeoJSON")
    }
    return(NULL)
}


#' Get a pixel or line offset for a north-up raster
#' @param coord A georeferenced x or y
#' @param origin Raster xmin or ymax
#' @param gt_pixel_size Geotransform pixel x or y size (negative for y)
#' @returns pixel (column) or line (row) offset for coord x or y
#' @noRd
.getOffset <- function(coord, origin, gt_pixel_size) {
    (coord-origin)/gt_pixel_size
}


#' Convenience wrapper for `GDALRaster$read()`
#'
#' @description
#' `read_ds()` will read from a raster dataset that is already open in a
#' `GDALRaster` object. By default, it attempts to read the full raster
#' extent from all bands at full resolution. `read_ds()` is sometimes more
#' convenient than `GDALRaster$read()`, e.g., to read specific multiple bands
#' for display with [plot_raster()], or simply for the default arguments that
#' read an entire raster into memory (see Note).
#'
#' @details
#' `NA` will be returned in place of the nodata value if the raster dataset has
#' a nodata value defined for the band. Data are read as R `integer` type when
#' possible for the raster data type (Byte/UInt8, Int8, Int16, UInt16, Int32),
#' otherwise as type `double` (UInt32, Float32, Float64).
#'
#' The output object has attribute `gis`, a list containing:
#' \preformatted{
#'   $type = "raster"
#'   $bbox = c(xmin, ymin, xmax, ymax)
#'   $dim = c(xsize, ysize, nbands)
#'   $srs = <projection as WKT2 string>
#'   $datatype = <character vector of data type name by band>
#' }
#' The WKT version used for the projection string can be overridden by setting
#' the `OSR_WKT_FORMAT` configuration option. See [srs_to_wkt()] for a list of
#' supported values.
#'
#' @param ds An object of class `GDALRaster` in open state.
#' @param bands Integer vector of band numbers to read. By default all bands
#' will be read.
#' @param xoff Integer. The pixel (column) offset to the top left corner of the
#' raster region to be read (zero to start from the left side).
#' @param yoff Integer. The line (row) offset to the top left corner of the
#' raster region to be read (zero to start from the top).
#' @param xsize Integer. The width in pixels of the region to be read.
#' @param ysize Integer. The height in pixels of the region to be read.
#' @param out_xsize Integer. The width in pixels of the output buffer into
#' which the desired region will be read (e.g., to read a reduced resolution
#' overview).
#' @param out_ysize Integer. The height in pixels of the output buffer into
#' which the desired region will be read (e.g., to read a reduced resolution
#' overview).
#' @param as_list Logical. If `TRUE`, return output as a list of band vectors.
#' If `FALSE` (the default), output is a vector of pixel data interleaved by
#' band.
#' @param as_raw Logical. If `TRUE` and the underlying data type is Byte (or
#' UInt8 in GDAL >= 3.13), return output as \R `raw` vector type. This maps to
#' the setting \code{$readByteAsRaw} on the `GDALRaster` object, which will be
#' temporarily updated in this function. To control this behavior in a
#' persistent way on a dataset object see \code{$readByteAsRaw} in
#' [`GDALRaster-class`][GDALRaster].
#' @returns If `as_list = FALSE` (the default), a vector of `raw`, `integer`,
#' `double` or `complex` containing the values that were read. It is organized
#' in left to right, top to bottom pixel order, interleaved by band.
#' If `as_list = TRUE`, a list with number of elements equal to the number of
#' bands read. Each element contains a vector of `raw`, `integer`, `double` or
#' `complex` containing the pixel values that were read for the band.
#'
#' @note
#' There is small overhead in calling `read_ds()` compared with
#' calling `GDALRaster$read()` directly. This would only matter if calling
#' the function repeatedly to read a raster in chunks. For the case of reading
#' a large raster in many chunks, it will be optimal performance-wise to call
#' `GDALRaster$read()` directly.
#'
#' By default, this function will attempt to read the full raster into memory.
#' It generally should not be called on large raster datasets using the default
#' argument values. The memory size in bytes of the returned vector will be,
#' e.g., (xsize * ysize * number of bands * 4) for data read as
#' `integer`, or (xsize * ysize * number of bands * 8) for data read as
#' `double` (plus small object overhead for the vector).
#'
#' @seealso
#' [`GDALRaster$read()`][GDALRaster]
#'
#' @examples
#' # read three bands from a multi-band dataset
#' lcp_file <- system.file("extdata/storm_lake.lcp", package="gdalraster")
#' ds <- new(GDALRaster, lcp_file)
#'
#' # as a vector of pixel data interleaved by band
#' r <- read_ds(ds, bands = c(6,5,4))
#' typeof(r)
#' length(r)
#' object.size(r)
#'
#' # as a list of band vectors
#' r <- read_ds(ds, bands = c(6,5,4), as_list = TRUE)
#' typeof(r)
#' length(r)
#' object.size(r)
#'
#' # gis attributes
#' attr(r, "gis")
#'
#' ds$close()
#' @export
read_ds <- function(ds, bands = NULL, xoff = 0, yoff = 0,
                    xsize = ds$getRasterXSize(), ysize = ds$getRasterYSize(),
                    out_xsize = xsize, out_ysize = ysize,
                    as_list = FALSE, as_raw = FALSE) {

    if (!is(ds, "Rcpp_GDALRaster")) {
        stop("'ds' must be an object of class GDALRaster", call. = FALSE)
    }
    if (is.null(bands)) {
        bands <- seq_len(ds$getRasterCount())
    } else if (!is.numeric(bands)) {
        stop("'bands' must be a numeric vector", call. = FALSE)
    }
    if (is.null(xoff) || !(is.numeric(xoff) && length(xoff) == 1)) {
        stop("'xoff' must be a numeric value", call. = FALSE)
    }
    if (is.null(yoff) || !(is.numeric(yoff) && length(yoff) == 1)) {
        stop("'yoff' must be a numeric value", call. = FALSE)
    }
    if (is.null(xsize) || !(is.numeric(xsize) && length(xsize) == 1)) {
        stop("'xsize' must be a numeric value", call. = FALSE)
    }
    if (is.null(ysize) || !(is.numeric(ysize) && length(ysize) == 1)) {
        stop("'ysize' must be a numeric value", call. = FALSE)
    }
    if (is.null(out_xsize) ||
        !(is.numeric(out_xsize) && length(out_xsize) == 1)) {

        stop("'out_xsize' must be a numeric value", call. = FALSE)
    }
    if (is.null(out_ysize) ||
        !(is.numeric(out_ysize) && length(out_ysize) == 1)) {

        stop("'out_ysize' must be a numeric value", call. = FALSE)
    }
    if (is.null(as_list)) {
        as_list <- FALSE
    } else if (!(is.logical(as_list) && length(as_list) == 1)) {
        stop("'as_list' must be a logical value", call. = FALSE)
    }
    if (is.null(as_raw)) {
        as_raw <- FALSE
    } else if (!(is.logical(as_raw) && length(as_raw) == 1)) {
        stop("'as_raw' must be a logical value", call. = FALSE)
    }

    # get the unioned data type across all bands
    dtype <- "Byte"
    for (b in bands) {
        dtype <- dt_union(dtype, ds$getDataTypeName(b))
    }
    # sync as_raw with object property for Byte data
    if (!as_raw && ds$readByteAsRaw && dtype == "Byte") {
      as_raw <- TRUE
    }

    if (as_list) {
        r <- list()
    } else {
        # pre-allocate the output vector
        dtype_size <- dt_size(dtype)
        if (as_raw && dtype == "Byte") {
            r <- raw(out_xsize * out_ysize * length(bands))
        } else if (dt_is_complex(dtype)) {
            r <- complex(out_xsize * out_ysize * length(bands))
        } else if (dt_is_floating(dtype) || dtype_size > 4) {
            r <- numeric(out_xsize * out_ysize * length(bands))
        } else if (dtype_size == 4 && !dt_is_signed(dtype)) {
            r <- numeric(out_xsize * out_ysize * length(bands))
        } else {
            r <- integer(out_xsize * out_ysize * length(bands))
        }
    }

    readByteAsRaw <- ds$readByteAsRaw
    if (as_raw) {
        ds$readByteAsRaw <- TRUE
        if (dtype != "Byte") {
            warning("'as_raw = TRUE' only affects read for band type 'Byte'",
                    call. = FALSE)
        }
    }

    dtype <- character()
    i <- 1
    for (b in bands) {
        dtype <- c(dtype, ds$getDataTypeName(b))
        if (as_list) {
            r[[i]] <- ds$read(b, xoff, yoff, xsize, ysize,
                              out_xsize, out_ysize)
        } else {
            i_begin <- 1 + (i - 1) * out_xsize * out_ysize
            i_end <- i_begin + out_xsize * out_ysize - 1
            r[i_begin:i_end] <- ds$read(b, xoff, yoff, xsize, ysize,
                                        out_xsize, out_ysize)
        }
        i <- i + 1
    }

    ## restore the field, note that it may have had no impact
    ds$readByteAsRaw <- readByteAsRaw

    gt <- ds$getGeoTransform()
    ulxy <- .apply_geotransform(gt, xoff, yoff)
    urxy <- .apply_geotransform(gt, (xoff + xsize), yoff)
    lrxy <- .apply_geotransform(gt, (xoff + xsize), (yoff + ysize))
    llxy <- .apply_geotransform(gt, xoff, (yoff + ysize))
    corners_x <- c(ulxy[1], urxy[1], lrxy[1], llxy[1])
    corners_y <- c(ulxy[2], urxy[2], lrxy[2], llxy[2])
    bb <- c(min(corners_x), min(corners_y), max(corners_x), max(corners_y))

    # gis: a list with the bbox, dimensions, projection, nbands, datatype
    wkt_fmt_config <- get_config_option("OSR_WKT_FORMAT")
    if (wkt_fmt_config == "")
        set_config_option("OSR_WKT_FORMAT", "WKT2")
    attr(r, "gis") <- list(type = "raster",
                           bbox = bb,
                           dim = c(out_xsize, out_ysize, length(bands)),
                           srs = ds$getProjectionRef(),
                           datatype = dtype)
    set_config_option("OSR_WKT_FORMAT", wkt_fmt_config)

    return(r)
}


#' Create a raster from an existing raster as template
#'
#' @description
#' `rasterFromRaster()` creates a new raster with spatial reference,
#' extent and resolution taken from a template raster, without copying data.
#' Optionally changes the format, number of bands, data type and nodata value,
#' sets driver-specific dataset creation options, and initializes to a value.
#'
#' @param srcfile Source raster filename.
#' @param dstfile Output raster filename.
#' @param fmt Output raster format name (e.g., "GTiff" or "HFA"). Will attempt
#' to guess from the output filename if \code{fmt} is not specified.
#' @param nbands Number of output bands.
#' @param dtName Output raster data type name. Commonly used types include
#' `"Byte"` (or `"UInt8"` in GDAL >= 3.13), `"Int16"`, `"UInt16"`, `"Int32"`
#' and `"Float32"`.
#' @param options Optional list of format-specific creation options in a
#' vector of "NAME=VALUE" pairs
#' (e.g., \code{options = c("COMPRESS=LZW")} to set LZW compression
#' during creation of a GTiff file).
#' @param init Numeric value to initialize all pixels in the output raster.
#' @param dstnodata Numeric nodata value for the output raster.
#' @param quiet Logical value, `TRUE` to suppress informational messages.
#' @returns Returns the destination filename invisibly.
#'
#' @seealso
#' [`GDALRaster-class`][GDALRaster], [create()], [createCopy()],
#' [bandCopyWholeRaster()], [translate()]
#'
#' @examples
#' # band 2 in a FARSITE landscape file has slope degrees
#' # convert slope degrees to slope percent in a new raster
#' lcp_file <- system.file("extdata/storm_lake.lcp", package="gdalraster")
#' ds_lcp <- new(GDALRaster, lcp_file)
#' ds_lcp$getMetadata(band = 2, domain = "")
#'
#' slpp_file <- file.path(tempdir(), "storml_slpp.tif")
#' opt = c("COMPRESS=LZW")
#' rasterFromRaster(srcfile = lcp_file,
#'                  dstfile = slpp_file,
#'                  nbands = 1,
#'                  dtName = "Int16",
#'                  options = opt,
#'                  init = -32767)
#' ds_slp <- new(GDALRaster, slpp_file, read_only = FALSE)
#'
#' # slpp_file is initialized to -32767 and nodata value set
#' ds_slp$getNoDataValue(band=1)
#'
#' # extent and cell size are the same as lcp_file
#' ds_lcp$bbox()
#' ds_lcp$res()
#' ds_slp$bbox()
#' ds_slp$res()
#'
#' # convert slope degrees in lcp_file band 2 to slope percent in slpp_file
#' # bring through LCP nodata -9999 to the output nodata value
#' ncols <- ds_slp$getRasterXSize()
#' nrows <- ds_slp$getRasterYSize()
#' for (row in 0:(nrows-1)) {
#'     rowdata <- ds_lcp$read(band = 2,
#'                            xoff = 0, yoff = row,
#'                            xsize = ncols, ysize = 1,
#'                            out_xsize = ncols, out_ysize = 1)
#'     rowslpp <- tan(rowdata*pi/180) * 100
#'     rowslpp[rowdata==-9999] <- -32767
#'     dim(rowslpp) <- c(1, ncols)
#'     ds_slp$write(band = 1, xoff = 0, yoff = row,
#'                  xsize = ncols, ysize = 1,
#'                  rasterData = rowslpp)
#' }
#'
#' # min, max, mean, sd
#' ds_slp$getStatistics(band = 1, approx_ok = FALSE, force = TRUE)
#'
#' ds_slp$close()
#' ds_lcp$close()
#' \dontshow{deleteDataset(slpp_file)}
#' @export
rasterFromRaster <- function(srcfile, dstfile, fmt=NULL, nbands=NULL,
                             dtName=NULL, options=NULL, init=NULL,
                             dstnodata=init, quiet=FALSE) {

    if (is.null(fmt)) {
        fmt <- .getGDALformat(dstfile)
        if (is.null(fmt)) {
            stop("use 'fmt' to specify a GDAL raster format name",
                 call. = FALSE)
        }
    }

    if (!is.null(init)) {
        if (!(is.numeric(init) && length(init) == 1))
            stop("'init' must be a single numeric value", call. = FALSE)
    }

    src_ds <- new(GDALRaster, srcfile, read.only=TRUE)
    if (is.null(nbands)) {
        nbands <- src_ds$getRasterCount()
    }
    nrows <- src_ds$getRasterYSize()
    ncols <- src_ds$getRasterXSize()
    gt <- src_ds$getGeoTransform()
    if (is.null(dtName))
        dtName <- src_ds$getDataTypeName(1)
    srs <- src_ds$getProjectionRef()
    src_ds$close()

    create(fmt, dstfile, ncols, nrows, nbands, dtName, options)
    dst_ds <- new(GDALRaster, dstfile, FALSE)
    dst_ds$setGeoTransform(gt)
    dst_ds$setProjection(srs)
    if (!is.null(dstnodata)) {
        for (b in 1:nbands) {
            dst_ds$setNoDataValue(b, dstnodata)
        }
    }

    if (!is.null(init)) {
        if (!quiet) {
            cli::cli_progress_step(
                "initializing destination raster...",
                msg_done = "done")
        }
        for (b in 1:nbands) {
            dst_ds$fillRaster(b, init, 0)
        }
    }

    dst_ds$close()
    return(invisible(dstfile))
}


#' Create a GDAL virtual raster derived from one source dataset
#'
#' @description
#' `rasterToVRT()` creates a virtual raster dataset (VRT format) derived from
#' one source dataset with options for virtual subsetting, virtually resampling
#' the source data at a different pixel resolution, or applying a virtual
#' kernel filter. (See [buildVRT()] for virtual mosaicing.)
#'
#' @details
#' `rasterToVRT()` can be used to virtually clip and pixel-align
#' various raster layers with each other or in relation to vector
#' polygon boundaries. It also supports VRT kernel filtering.
#'
#' A VRT dataset is saved as a plain-text file with extension .vrt. This file
#' contains a description of the dataset in an XML format. The description
#' includes the source raster filename which can be a full path
#' (`relativeToVRT = FALSE`) or relative path (`relativeToVRT = TRUE`).
#' For relative path, `rasterToVRT()` assumes that the .vrt file will be in
#' the same directory as the source file and uses `basename(srcfile)`. The
#' elements of the XML schema describe how the source data will be read, along
#' with algorithms potentially applied and so forth. Documentation of the XML
#' format for .vrt is at:
#' \url{https://gdal.org/en/stable/drivers/raster/vrt.html}.
#'
#' Since .vrt is a small plain-text file it is fast to write and requires
#' little storage space. Read performance is not degraded for certain simple
#' operations (e.g., virtual clip without resampling). Reading will be
#' slower for virtual resampling to a different pixel resolution or virtual
#' kernel filtering since the operations are performed on-the-fly (but .vrt
#' does not require the up front writing of a resampled or kernel-filtered
#' raster to a regular format). VRT is sometimes useful as an intermediate
#' raster in a series of processing steps, e.g., as a `tempfile` (the
#' default).
#'
#' GDAL VRT format has several capabilities and uses beyond those
#' covered by `rasterToVRT()`. See the URL above for a full discussion.
#'
#' @note
#' Pixel alignment is specified in terms of the source raster pixels (i.e.,
#' `srcfile` of the virtual raster). The use case in mind is virtually
#' clipping a raster to the bounding box of a vector polygon and keeping
#' pixels aligned with `srcfile` (`src_align = TRUE`). `src_align` would be
#' set to `FALSE` if the intent is "target alignment". For example, if
#' `subwindow` is the bounding box of another raster with a different layout,
#' then also setting `resolution` to the pixel resolution of the target raster
#' and `src_align = FALSE` will result in a virtual raster pixel-aligned with
#' the target (i.e., pixels in the virtual raster are no longer aligned with
#' its `srcfile`). Resampling defaults to `nearest` if not specified.
#' Examples for both cases of `src_align` are given below.
#'
#' `rasterToVRT()` assumes `srcfile` is a north-up raster.
#'
#' @param srcfile Source raster filename.
#' @param relativeToVRT Logical. Indicates whether the source filename should
#' be interpreted as relative to the .vrt file (`TRUE`) or not relative
#' to the .vrt file (`FALSE`, the default). If `TRUE`, the .vrt
#' file is assumed to be in the same directory as `srcfile` and
#' `basename(srcfile)` is used in the .vrt file. Use `TRUE` if the .vrt file
#' will always be stored in the same directory with `srcfile`.
#' @param vrtfile Output VRT filename.
#' @param resolution A numeric vector of length two (xres, yres). The pixel
#' size must be expressed in georeferenced units. Both must be positive values.
#' The source pixel size is used if `resolution` is not specified.
#' @param subwindow A numeric vector of length four (xmin, ymin, xmax, ymax).
#' Selects `subwindow` of the source raster with corners given in
#' georeferenced coordinates (in the source CRS).
#' If not given, the upper left corner of the VRT will be the
#' same as source, and the VRT extent will be the same or larger than source
#' depending on `resolution`.
#' @param src_align Logical.
#'   * `TRUE`: the upper left corner of the VRT extent will be set to the
#'   upper left corner of the source pixel that contains `subwindow` xmin, ymax.
#'   The VRT will be pixel-aligned with source if the VRT `resolution` is the
#'   same as the source pixel size, otherwise VRT extent will be the minimum
#'   rectangle that contains `subwindow` for the given pixel size.
#'   Often, `src_align=TRUE` when selecting a raster minimum bounding box
#'   for a vector polygon.
#'   * `FALSE`: the VRT upper left corner will be exactly `subwindow`
#'   xmin, ymax, and the VRT extent will be the minimum rectangle that contains
#'   `subwindow` for the given pixel size. If `subwindow` is not given, the
#'   source raster extent is used in which case `src_align=FALSE` has no effect.
#'   Use `src_align=FALSE` to pixel-align two rasters of different sizes, i.e.,
#'   when the intent is target alignment.
#' @param resampling The resampling method to use if xsize, ysize of the VRT is
#' different than the size of the underlying source rectangle (in number of
#' pixels). The values allowed are nearest, bilinear, cubic, cubicspline,
#' lanczos, average and mode (as character).
#' @param krnl A filtering kernel specified as pixel coefficients.
#' `krnl` is a array with dimensions (size, size), where
#' size must be an odd number. `krnl` can also be given as a vector with
#' length size x size. For example, a 3x3 average filter is given by:
#' \preformatted{
#' krnl <- c(0.11111, 0.11111, 0.11111,
#'           0.11111, 0.11111, 0.11111,
#'           0.11111, 0.11111, 0.11111)
#' }
#' A kernel cannot be applied to sub-sampled or over-sampled data.
#' @param normalized Logical. Indicates whether the kernel is normalized.
#' Defaults to `TRUE`.
#' @param krnl_fn Character string specifying a function to compute on the
#' given `krnl`. Must be one of `"min"`, `"max"`, `"stddev"`, `"median"` or
#' `"mode"`. _Requires GDAL >= 3.12_. E.g., to compute the median value in a
#' 3x3 neighborhood around each pixel:
#' \preformatted{
#' krnl <- c(1, 1, 1,
#'           1, 1, 1,
#'           1, 1, 1)
#'
#' krnl_fn <- "median"
#' }
#' @returns Returns the VRT filename invisibly.
#'
#' @seealso
#' [`GDALRaster-class`][GDALRaster], [bbox_from_wkt()], [buildVRT()]
#'
#' [warp()] can write VRT for virtual reprojection
#'
#' @examples
#' ## resample
#'
#' evt_file <- system.file("extdata/storml_evt.tif", package="gdalraster")
#' ds <- new(GDALRaster, evt_file)
#' ds$res()
#' ds$bbox()
#' ds$close()
#'
#' # table of the unique pixel values and their counts
#' tbl <- buildRAT(evt_file)
#' print(tbl)
#' sum(tbl$COUNT)
#'
#' # resample at 90-m resolution
#' # EVT is thematic vegetation type so use a majority value
#' vrt_file <- rasterToVRT(evt_file,
#'                         resolution = c(90, 90),
#'                         resampling = "mode")
#'
#' # .vrt is a small xml file pointing to the source raster
#' file.size(vrt_file)
#'
#' tbl90m <- buildRAT(vrt_file)
#' print(tbl90m)
#' sum(tbl90m$COUNT)
#'
#' ds <- new(GDALRaster, vrt_file)
#' ds$res()
#' ds$bbox()
#' ds$close()
#' \dontshow{vsi_unlink(vrt_file)}
#'
#' ## clip
#'
#' evt_file <- system.file("extdata/storml_evt.tif", package="gdalraster")
#' ds_evt <- new(GDALRaster, evt_file)
#' ds_evt$bbox()
#'
#' # WKT string for a boundary within the EVT extent
#' bnd = "POLYGON ((324467.3 5104814.2, 323909.4 5104365.4, 323794.2
#' 5103455.8, 324970.7 5102885.8, 326420.0 5103595.3, 326389.6 5104747.5,
#' 325298.1 5104929.4, 325298.1 5104929.4, 324467.3 5104814.2))"
#'
#' # src_align = TRUE
#' vrt_file <- rasterToVRT(evt_file,
#'                         subwindow = bbox_from_wkt(bnd),
#'                         src_align = TRUE)
#' ds_vrt <- new(GDALRaster, vrt_file)
#'
#' # VRT is a virtual clip, pixel-aligned with the EVT raster
#' bbox_from_wkt(bnd)
#' ds_vrt$bbox()
#' ds_vrt$res()
#' ds_vrt$close()
#' \dontshow{vsi_unlink(vrt_file)}
#'
#' # src_align = FALSE
#' vrt_file <- rasterToVRT(evt_file,
#'                         subwindow = bbox_from_wkt(bnd),
#'                         src_align = FALSE)
#' ds_vrt_noalign <- new(GDALRaster, vrt_file)
#'
#' # VRT upper left corner (xmin, ymax) is exactly bnd xmin, ymax
#' ds_vrt_noalign$bbox()
#' ds_vrt_noalign$res()
#'
#' ds_vrt_noalign$close()
#' ds_evt$close()
#' \dontshow{vsi_unlink(vrt_file)}
#'
#'
#' ## subset and pixel align two rasters
#'
#' # FARSITE landscape file for the Storm Lake area
#' lcp_file <- system.file("extdata/storm_lake.lcp", package="gdalraster")
#' ds_lcp <- new(GDALRaster, lcp_file)
#'
#' # Landsat band 5 file covering the Storm Lake area
#' b5_file <- system.file("extdata/sr_b5_20200829.tif", package="gdalraster")
#' ds_b5 <- new(GDALRaster, b5_file)
#'
#' ds_lcp$bbox()  # 323476.1 5101872.0  327766.1 5105082.0
#' ds_lcp$res()   # 30 30
#'
#' ds_b5$bbox()   # 323400.9 5101815.8  327870.9 5105175.8
#' ds_b5$res()    # 30 30
#'
#' # src_align = FALSE because we need target alignment in this case:
#' vrt_file <- rasterToVRT(b5_file,
#'                         resolution = ds_lcp$res(),
#'                         subwindow = ds_lcp$bbox(),
#'                         src_align = FALSE)
#' ds_b5vrt <- new(GDALRaster, vrt_file)
#'
#' ds_b5vrt$bbox() # 323476.1 5101872.0  327766.1 5105082.0
#' ds_b5vrt$res()  # 30 30
#'
#' # read the the Landsat file pixel-aligned with the LCP file
#' # summarize band 5 reflectance where FBFM = 165
#' # LCP band 4 contains FBFM (a classification of fuel beds):
#' ds_lcp$getMetadata(band = 4, domain = "")
#'
#' # verify Landsat nodata (0):
#' ds_b5vrt$getNoDataValue(band=1)
#' # will be read as NA and omitted from stats
#' rs <- new(RunningStats, na_rm = TRUE)
#'
#' ncols <- ds_lcp$getRasterXSize()
#' nrows <- ds_lcp$getRasterYSize()
#' for (row in 0:(nrows-1)) {
#'     row_fbfm <- ds_lcp$read(band = 4, xoff = 0, yoff = row,
#'                             xsize = ncols, ysize = 1,
#'                             out_xsize = ncols, out_ysize = 1)
#'     row_b5 <- ds_b5vrt$read(band = 1, xoff = 0, yoff = row,
#'                             xsize = ncols, ysize = 1,
#'                             out_xsize = ncols, out_ysize = 1)
#' 	   rs$update(row_b5[row_fbfm == 165])
#' }
#' rs$get_count()
#' rs$get_mean()
#' rs$get_min()
#' rs$get_max()
#' rs$get_sum()
#' rs$get_var()
#' rs$get_sd()
#'
#' ds_b5vrt$close()
#' ds_lcp$close()
#' ds_b5$close()
#' \dontshow{vsi_unlink(vrt_file)}
#' @export
rasterToVRT <- function(srcfile,
                        relativeToVRT = FALSE,
                        vrtfile = tempfile("tmprast", fileext=".vrt"),
                        resolution = NULL,
                        subwindow = NULL,
                        src_align = TRUE,
                        resampling = "nearest",
                        krnl = NULL,
                        normalized = TRUE,
                        krnl_fn = NULL) {

    if (relativeToVRT) relativeToVRT <- 1 else relativeToVRT <- 0
    if (normalized) normalized <- 1 else normalized <- 0

    src_ds <- new(GDALRaster, srcfile)
    src_gt <- src_ds$getGeoTransform()
    src_bbox <- src_ds$bbox()
    src_xmin <- src_bbox[1]
    src_ymin <- src_bbox[2]
    src_xmax <- src_bbox[3]
    src_ymax <- src_bbox[4]
    src_xres <- src_gt[2]
    src_yres <- src_gt[6]
    src_bands <- src_ds$getRasterCount()
    src_ds$close()

    if (!is.null(resolution) && !is.null(krnl)) {
        if (src_xres != resolution[1] || src_yres != resolution[2])
            stop("cannot apply a kernel to sub-sampled or over-sampled data",
                 call. = FALSE)
    }

    if (!is.null(krnl)) {
        if ((length(krnl) %% 2) == 0)
            stop("kernel size must be an odd number", call. = FALSE)
    }

    if (!is.null(krnl_fn)) {
        if (gdal_version_num() < gdal_compute_version(3, 12, 0)) {
            stop("'krnl_fn' requires GDAL >= 3.12", call. = FALSE)
        }
        if (!(is.character(krnl_fn) && length(krnl_fn) == 1)) {
            stop("'krnl_fn' must be a character string", call. = FALSE)
        }
        if (!(tolower(krnl_fn) %in%
                c("min", "max", "stddev", "median", "mode"))) {
            stop("'krnl_fn' not recognized", call. = FALSE)
        }
    }

    tmp_vrtfile <- tempfile("src", fileext = ".vrt")
    createCopy("VRT", tmp_vrtfile, srcfile)

    if (is.null(resolution)) {
        vrt_xres <- src_xres
        vrt_yres <- src_yres
    } else {
        vrt_xres <- resolution[1]
        vrt_yres <- -resolution[2]
    }

    # src offsets
    if (is.null(subwindow)) {
        subwindow <- c(src_xmin, src_ymin, src_xmax, src_ymax)
    } else {
        if (subwindow[1] < src_xmin || subwindow[3] > src_xmax ||
                subwindow[2] < src_ymin || subwindow[4] > src_ymax) {

            stop("'subwindow' is not within source raster extent",
                 call. = FALSE)
        }
    }
    src_xoff <- floor(.getOffset(subwindow[1], src_xmin, src_xres))
    src_yoff <- floor(.getOffset(subwindow[4], src_ymax, src_yres))

    #get vrt geotransform and size (assuming a north-up raster)
    if (src_align) {
        #lay out the vrt raster so it is aligned with ul corner
        #of ul src pixel
        vrt_xmin <- src_xmin + src_xoff * src_xres
        vrt_ymax <- src_ymax + src_yoff * src_yres
    } else {
        #lay out the vrt raster with origin at the subwindow origin
        vrt_xmin <- subwindow[1]
        vrt_ymax <- subwindow[4]
    }
    vrt_ncols <- ceiling(.getOffset(subwindow[3], vrt_xmin, vrt_xres))
    vrt_xmax <- (vrt_xmin + vrt_ncols * vrt_xres)
    vrt_nrows <- ceiling(.getOffset(subwindow[2], vrt_ymax, vrt_yres))
    vrt_ymin <- (vrt_ymax + vrt_nrows * vrt_yres)
    vrt_gt <- c(vrt_xmin, vrt_xres, 0, vrt_ymax, 0, vrt_yres)
    srcwin_xsize <- ceiling(.getOffset(vrt_xmax, vrt_xmin, src_xres))
    srcwin_ysize <- ceiling(.getOffset(vrt_ymin, vrt_ymax, src_yres))

    x <- xml2::read_xml(tmp_vrtfile)

    xds <- xml2::xml_find_first(x, "/VRTDataset")
    xml2::xml_attrs(xds) <- c("rasterXSize" = as.character(vrt_ncols),
                              "rasterYSize" = as.character(vrt_nrows))

    xgt <- xml2::xml_find_first(x, "/VRTDataset/GeoTransform")
    xml2::xml_text(xgt) <- paste(vrt_gt, collapse=", ")

    xpath <- "/VRTDataset/VRTRasterBand/SimpleSource/SrcRect"
    xsrcrect <- xml2::xml_find_all(x, xpath)
    xml2::xml_attrs(xsrcrect) <- c("xOff" = as.character(src_xoff),
                                   "yOff" = as.character(src_yoff),
                                   "xSize" = as.character(srcwin_xsize),
                                   "ySize" = as.character(srcwin_ysize))

    xpath <- "/VRTDataset/VRTRasterBand/SimpleSource/DstRect"
    xdstrect <- xml2::xml_find_all(x, xpath)
    xml2::xml_attrs(xdstrect) <- c("xOff" = "0",
                                   "yOff" = "0",
                                   "xSize" = as.character(vrt_ncols),
                                   "ySize" = as.character(vrt_nrows))

    if (vrt_ncols != srcwin_xsize || vrt_nrows != srcwin_ysize) {
        xpath <- "/VRTDataset/VRTRasterBand/SimpleSource"
        xssrc <- xml2::xml_find_all(x, xpath)
        xml2::xml_attr(xssrc, "resampling") <- resampling
    }

    xpath <- "/VRTDataset/VRTRasterBand/SimpleSource/SourceFilename"
    xfn <- xml2::xml_find_all(x, xpath)
    if (relativeToVRT) {
        #this assumes the VRT file will be in the same directory as source file
        xml2::xml_attr(xfn, "relativeToVRT") <- "1"
        xml2::xml_text(xfn) <- basename(srcfile)
    } else {
        xml2::xml_attr(xfn, "relativeToVRT") <- "0"
        xml2::xml_text(xfn) <- srcfile
    }

    # clear statistics metadata if present
    xsrcstats <- xml2::xml_find_all(x,
                                    "//MDI[starts-with(@key, 'STATISTICS_')]")
    if (length(xsrcstats) != 0) {
        xml2::xml_text(xsrcstats) <- rep("", length(xsrcstats))
    }

    xml2::write_xml(x, vrtfile, options = c("format", "no_declaration"))

    if (!is.null(krnl)) {
        vrt_kernel_template <- paste0(
            "<KernelFilteredSource>\n",
            "  <SourceFilename relativeToVRT=\"%d\">%s</SourceFilename>\n",
            "  <SourceBand>%d</SourceBand>\n",
            "  <SrcRect xOff=\"%d\" yOff=\"%d\" xSize=\"%d\" ySize=\"%d\"/>\n",
            "  <DstRect xOff=\"0\" yOff=\"0\" xSize=\"%d\" ySize=\"%d\"/>\n",
            "  <Kernel normalized=\"%d\">\n",
            "    <Size>%d</Size>\n",
            "    <Coefs>%s</Coefs>\n",
            "  </Kernel>\n")

        if (!is.null(krnl_fn)) {
            # Function element as child of KernelFilteredSource in GDAL >= 3.12
            vrt_kernel_template <- paste0(
                vrt_kernel_template,
                "  <Function>_fn_</Function>\n")
        }

        vrt_kernel_template <- paste0(
            vrt_kernel_template,
            "</KernelFilteredSource>\n")

        vrt_ds <- new(GDALRaster, vrtfile, read_only = FALSE)
        if (relativeToVRT) srcfile <- basename(srcfile)
        for (band in seq_len(src_bands)) {
            krnl_xml <- enc2utf8(sprintf(vrt_kernel_template,
                                         relativeToVRT,
                                         srcfile,
                                         band,
                                         src_xoff,
                                         src_yoff,
                                         srcwin_xsize,
                                         srcwin_ysize,
                                         vrt_ncols,
                                         vrt_nrows,
                                         normalized,
                                         sqrt(length(krnl)),
                                         paste(krnl, collapse = " ")))

            if (!is.null(krnl_fn)) {
                krnl_xml <- gsub("_fn_", krnl_fn, krnl_xml, fixed = TRUE)
            }
            vrt_ds$setMetadataItem(band, "source_0", krnl_xml, "vrt_sources")
        }
        vrt_ds$close()
    }

    return(invisible(vrtfile))
}


#' Raster calculation
#'
#' @description
#' `calc()` evaluates an \R expression for each pixel in a raster layer or
#' stack of layers. Each layer is defined by a raster filename or dataset
#' object, band number, and a variable name to use in the \R expression. If not
#' specified, band defaults to `1` for each input raster. Variable names
#' default to `LETTERS` if not specified (`A` (layer 1), `B` (layer 2), ...).
#' All of the input layers must have the same extent and cell size.
#' The projection will be read from the first raster in the list of inputs.
#' Individual pixel coordinates are also available as variables in the
#' \R expression, as either x/y in the raster projected coordinate system or
#' inverse projected longitude/latitude.
#' Multi-band output is supported as of gdalraster 1.11.0.
#'
#' @details
#' The variables in `expr` are vectors of length raster xsize (i.e., row
#' vectors of the input raster layer(s), with length the number of raster
#' columns). The expression should return a vector also of length raster xsize
#' (an output row). Four special variable names are available in `expr`:
#' `pixelX` and `pixelY` provide pixel center coordinates in projection units.
#' `pixelLon` and `pixelLat` can also be used, in which case the pixel x/y
#' coordinates will be inverse projected to longitude/latitude
#' (in the same geographic coordinate system used by the input projection,
#' which is read from the first input raster). Note that inverse projection
#' adds computation time.
#'
#' To refer to specific bands in a multi-band input file, repeat the filename
#' or dataset object in `rasterfiles` and specify corresponding band numbers in
#' `bands`, along with optional variable names in `var.names`, e.g.,
#' \preformatted{
#' rasterfiles = c("multiband.tif", "multiband.tif")
#' bands = c(4, 5)
#' var.names = c("B4", "B5")
#' }
#'
#' Output will be written to `dstfile`. To update a file that already
#' exists, set `write_mode = "update"` and set `out_band` to an existing
#' band number(s) in `dstfile` (new bands cannot be created in `dstfile`).
#' `dstfile` can optionally be given as an object of class `GDALRaster` open
#' for write access.
#'
#' To write multi-band output, `expr` must return a vector of values
#' interleaved by band. This is equivalent to, and can also be returned as,
#' a matrix `m` with `nrow(m)` equal to `length()` of an input vector, and
#' `ncol(m)` equal to the number of output bands. In matrix form, each column
#' contains a vector of output values for a band.
#' `length(m)` must be equal to the `length()` of an input vector multiplied by
#' `length(out_band)`. The dimensions described above are assumed and not
#' read from the return value of `expr`.
#'
#' @param expr An \R expression as a character string (e.g., `"A + B"`).
#' @param rasterfiles Input rasters, either a character vector of filenames,
#' or a list with each element either a filename as character string or an
#' object of class `GDALRaster` (must be an open dataset for the latter).
#' @param bands Integer vector of band numbers to use for each raster layer.
#' @param var.names Character vector of variable names to use for each raster
#' layer.
#' @param dstfile Either a character string with the output raster filename, or
#' an object of class `GDALRaster` with which to write output. If given as an
#' object, the dataset must be open for write access, and the arguments below
#' related to raster creation are ignored (i.e., `fmt`, `dtName`, `options`,
#' `setRasterNodataValue`). The `write_mode` must be set to `"update"` for
#' writing with an existing dataset object.
#' @param fmt Output raster format name (e.g., "GTiff" or "HFA"). Will attempt
#' to guess from the output filename if not specified.
#' @param dtName Character name of output data type (e.g., Byte, UInt8
#' (GDAL >= 3.13), Int16, UInt16, Int32, UInt32, Float32).
#' @param out_band Integer band number(s) in `dstfile` for writing output.
#' Defaults to `1L`. Multi-band output is supported as of gdalraster 1.11.0,
#' in which case `out_band` would be a vector of band numbers.
#' @param options Optional list of format-specific creation options in a
#' vector of "NAME=VALUE" pairs
#' (e.g., \code{options = c("TILED=YES", "COMPRESS=LZW")} to set LZW compression
#' during creation of a tiled GTiff file).
#' @param nodata_value Numeric value to assign if `expr` returns `NA`.
#' @param setRasterNodataValue Logical value. `TRUE` will attempt to set the
#' raster format nodata value to `nodata_value`, or `FALSE` not to set a raster
#' nodata value on the output dataset.
#' @param write_mode Character string. Name of the file write mode for output.
#' One of:
#'   * `safe` - execution stops if `dstfile` already exists (no output written)
#'   * `overwrite` - if `dstfile` exists it will be overwritten with a new file
#'   * `update` - if `dstfile` exists, will attempt to open in update mode, or
#'   write to the existing dataset if `dstfile` is given as an object
#' @param quiet Logical value. If `TRUE`, a progress bar and informational
#' messages will not be displayed. Defaults to `FALSE`.
#' @param return_obj Logical value. If `TRUE`, an object of class
#' [`GDALRaster`][GDALRaster] opened on the newly created dataset will be
#' returned. The default is `FALSE`.
#' @param ... Additional arguments, none currently supported.
#' @returns By default, returns the output filename invisibly. An object of
#' class [`GDALRaster`][GDALRaster] open on the output dataset will be returned
#' if `return_obj = TRUE`.
#'
#' @seealso
#' [`GDALRaster-class`][GDALRaster], [combine()], [rasterToVRT()]
#'
#' @examples
#' ## Using pixel longitude/latitude
#'
#' # Hopkins bioclimatic index (HI) as described in:
#' # Bechtold, 2004, West. J. Appl. For. 19(4):245-251.
#' # Integrates elevation, latitude and longitude into an index of the
#' # phenological occurrence of springtime. Here it is relativized to
#' # mean values for an eight-state region in the western US.
#' # Positive HI means spring is delayed by that number of days relative
#' # to the reference position, while negative values indicate spring is
#' # advanced. The original equation had elevation units as feet, so
#' # converting m to ft in `expr`.
#'
#' elev_file <- system.file("extdata/storml_elev.tif", package="gdalraster")
#'
#' # expression to calculate HI
#' expr <- "round( ((ELEV_M * 3.281 - 5449) / 100) +
#'                 ((pixelLat - 42.16) * 4) +
#'                 ((-116.39 - pixelLon) * 1.25) )"
#'
#' # calc() writes to a tempfile by default
#' hi_file <- calc(expr = expr,
#'                 rasterfiles = elev_file,
#'                 var.names = "ELEV_M",
#'                 dtName = "Int16",
#'                 nodata_value = -32767,
#'                 setRasterNodataValue = TRUE)
#'
#' ds <- new(GDALRaster, hi_file)
#' # min, max, mean, sd
#' ds$getStatistics(band = 1, approx_ok = FALSE, force = TRUE)
#' ds$close()
#' \dontshow{deleteDataset(hi_file)}
#'
#' ## Calculate normalized difference vegetation index (NDVI)
#' ## input rasters given as dataset objects
#' ## output to an in-memory raster (MEM format)
#'
#' # Landast band 4 (red) and band 5 (near infrared):
#' b4_file <- system.file("extdata/sr_b4_20200829.tif", package="gdalraster")
#' b4 <- new(GDALRaster, b4_file)
#' b5_file <- system.file("extdata/sr_b5_20200829.tif", package="gdalraster")
#' b5 <- new(GDALRaster, b5_file)
#'
#' expr <- "((B5 * 0.0000275 - 0.2) - (B4 * 0.0000275 - 0.2)) /
#'          ((B5 * 0.0000275 - 0.2) + (B4 * 0.0000275 - 0.2))"
#'
#' (ndvi <- calc(expr, list(b4, b5), var.names = c("B4", "B5"), fmt = "MEM",
#'               dtName = "Float32", setRasterNodataValue = TRUE,
#'               return_obj = TRUE))
#'
#' plot_raster(ndvi, legend = TRUE,
#'             col_map_fn = c("#7b3294", "#c2a5cf", "#a6dba0", "#008837"),
#'             main = "Storm Lake NDVI 2020-08-29")
#'
#' ndvi$close()
#' b4$close()
#' b5$close()
#'
#' ## Reclassify a variable by rule set
#'
#' # Combine two raster layers and look for specific combinations. Then
#' # recode to a new value by rule set.
#' #
#' # Based on example in:
#' #   Stratton, R.D. 2009. Guidebook on LANDFIRE fuels data acquisition,
#' #   critique, modification, maintenance, and model calibration.
#' #   Gen. Tech. Rep. RMRS-GTR-220. U.S. Department of Agriculture,
#' #   Forest Service, Rocky Mountain Research Station. 54 p.
#' # Context: Refine national-scale fuels data to improve fire simulation
#' #   results in localized applications.
#' # Issue: Areas with steep slopes (40+ degrees) were mapped as
#' #   GR1 (101; short, sparse dry climate grass) and
#' #   GR2 (102; low load, dry climate grass) but were not carrying fire.
#' # Resolution: After viewing these areas in Google Earth,
#' #   NB9 (99; bare ground) was selected as the replacement fuel model.
#'
#' # look for combinations of slope >= 40 and FBFM 101 or 102
#' lcp_file <- system.file("extdata/storm_lake.lcp", package="gdalraster")
#' rasterfiles <- c(lcp_file, lcp_file)
#' var.names <- c("SLP", "FBFM")
#' bands <- c(2, 4)
#' tbl <- combine(rasterfiles, var.names, bands)
#' nrow(tbl)
#' tbl_subset <- subset(tbl, SLP >= 40 & FBFM %in% c(101,102))
#' print(tbl_subset)       # twelve combinations meet the criteria
#' sum(tbl_subset$count)   # 85 total pixels
#'
#' # recode these pixels to 99 (bare ground)
#' # the LCP driver does not support in-place write so make a copy as GTiff
#' tif_file <- file.path(tempdir(), "storml_lndscp.tif")
#' createCopy("GTiff", tif_file, lcp_file)
#'
#' expr <- "ifelse( SLP >= 40 & FBFM %in% c(101,102), 99, FBFM)"
#' calc(expr = expr,
#'      rasterfiles = c(lcp_file, lcp_file),
#'      bands = c(2, 4),
#'      var.names = c("SLP", "FBFM"),
#'      dstfile = tif_file,
#'      out_band = 4,
#'      write_mode = "update")
#'
#' # verify the ouput
#' rasterfiles <- c(tif_file, tif_file)
#' tbl <- combine(rasterfiles, var.names, bands)
#' tbl_subset <- subset(tbl, SLP >= 40 & FBFM %in% c(101,102))
#' print(tbl_subset)
#' sum(tbl_subset$count)
#'
#' # if LCP file format is needed:
#' # createCopy("LCP", "storml_edited.lcp", tif_file)
#' \dontshow{deleteDataset(tif_file)}
#' @export
calc <- function(expr,
                 rasterfiles,
                 bands = NULL,
                 var.names = NULL,
                 dstfile = tempfile("rastcalc", fileext = ".tif"),
                 fmt = NULL,
                 dtName = "Int16",
                 out_band = 1L,
                 options = NULL,
                 nodata_value = NULL,
                 setRasterNodataValue = FALSE,
                 write_mode = "safe",
                 quiet = FALSE,
                 return_obj = FALSE,
                 ...) {

    calc_expr <- parse(text = expr)

    dstfile_exists <- TRUE
    dstfile_is_object <- FALSE
    output_name <- ""

    if (is(dstfile, "Rcpp_GDALRaster")) {
        dstfile_is_object <- TRUE
        if (!dstfile$isOpen() || dstfile$isReadOnly()) {
            stop("'dstfile' as dataset object must be open with write access",
                 call. = FALSE)
        }
        output_name <- dstfile$getDescription(0)
        fmt <- dstfile$getDriverShortName()
    } else if (is.character(dstfile) && length(dstfile) == 1) {
        output_name <- dstfile
        if (!vsi_stat_exists(dstfile))
            dstfile_exists <- FALSE
    } else {
        stop("'dstfile' must be a character string or GDALRaster object",
             call. = FALSE)
    }

    if (write_mode == "safe" && dstfile_exists)
        stop("'dstfile' already exists and 'write_mode' is \"safe\"",
             call. = FALSE)

    if (write_mode == "update" && is.null(out_band))
        stop("'out_band' must be specified for \"update\" mode",
             call. = FALSE)

    if (write_mode == "update") {
        update_mode <- TRUE
    } else if (write_mode == "safe" || write_mode == "overwrite") {
        update_mode <- FALSE
        if (is.null(out_band))
            out_band <- 1L
    } else {
        stop("unknown 'write_mode'", call. = FALSE)
    }

    nrasters <- length(rasterfiles)
    if (nrasters == 0)
        stop("'rasterfiles' is empty", call. = FALSE)

    if (!is.null(bands)) {
        if (length(bands) != nrasters) {
            stop("'bands' must have the same length as 'rasterfiles'",
                 call. = FALSE)
        }
    } else {
        bands <- rep(1L, nrasters)
    }

    if (!is.null(var.names)) {
        if (length(var.names) != nrasters) {
            stop("'var.names' must have the same length as 'rasterfiles'",
                 call. = FALSE)
        }
    } else {
        var.names <- LETTERS[1:nrasters]
    }

    for (nm in var.names) {
        if (!length(grep(nm, expr, fixed = TRUE)))
            stop("variable name '", nm, "' not in 'expr'", call. = FALSE)
    }

    if (is.null(fmt) && !dstfile_is_object) {
        fmt <- .getGDALformat(output_name)
        if (is.null(fmt)) {
            stop("use 'fmt' to specify the short name of a GDAL raster format",
                 call. = FALSE)
        }
    }
    fmt <- toupper(fmt)
    if (fmt == "MEM" && !return_obj) {
        stop("'return_obj' must be TRUE for \"MEM\" format", call. = FALSE)
    } else if (fmt == "MEM") {
        # by default, dstfile is a temporary .tif
        if (endsWith(dstfile, ".tif")) {
            # make a temp name for the MEM dataset
            f_tmp <- tempfile()
            suf <- substr(f_tmp, nchar(f_tmp) - 12 + 1, nchar(f_tmp))
            output_name <- paste0("calc", suf)
        }
    }

    if (is.null(nodata_value)) {
        nodata_value <- DEFAULT_NODATA[[dtName]]
        if (is.null(nodata_value)) {
            stop("a default nodata value is unknown for the given 'dtName'",
                 call. = FALSE)
        }
    }
    if (!(is.numeric(nodata_value) && length(nodata_value) == 1))
        stop("'nodata_value' must be a single numeric value", call. = FALSE)

    in_raster_is_object <- rep(FALSE, nrasters)
    if (is.list(rasterfiles)) {
        for (i in seq_along(rasterfiles)) {
            if (is(rasterfiles[[i]], "Rcpp_GDALRaster")) {
                if (!rasterfiles[[i]]$isOpen()) {
                    stop("'rasterfiles[[", i, "]]:' dataset is not open",
                         call. = FALSE)
                }
                in_raster_is_object[i] <- TRUE
            }
            else if (!is.character(rasterfiles[[i]])) {
                stop("'rasterfiles[[", i, "]]' is not a valid input type",
                     call. = FALSE)
            }
        }
    } else if (!is.character(rasterfiles)) {
        stop("'rasterfiles' must be a list or character vector", call. = FALSE)
    }

    # use first raster as reference
    if (in_raster_is_object[1])
        ref <- rasterfiles[[1]]
    else
        ref <- new(GDALRaster, rasterfiles[[1]])
    nrows <- as.integer(ref$getRasterYSize())
    ncols <- as.integer(ref$getRasterXSize())
    cellsizeX <- ref$res()[1]
    cellsizeY <- ref$res()[2]
    bb <- ref$bbox()
    xmin <- bb[1]
    ymax <- bb[4]
    gt <- ref$getGeoTransform()
    srs <- ref$getProjection()
    if (!in_raster_is_object[1])
        ref$close()

    if (nrasters > 1) {
        # currently only checking that raster dims are the same
        for (i in seq_along(rasterfiles[2:length(rasterfiles)])) {
            if (in_raster_is_object[i])
                ds <- rasterfiles[[i]]
            else
                ds <- new(GDALRaster, rasterfiles[[i]])

            dm <- ds$dim()
            fname <- ds$getDescription(0)

            if (!in_raster_is_object[i])
                ds$close()

            if (dm[1] != ncols || dm[2] != nrows) {
                cli::cli_alert_danger("incompatible dimension: {.val {fname}}")
                stop("all input rasters must have the same X size, Y size",
                     call. = FALSE)
            }
        }
    }

    if (update_mode) {
        # write to an existing raster
        if (dstfile_is_object)
            dst_ds <- dstfile
        else
            dst_ds <- new(GDALRaster, output_name, read_only = FALSE)

        dm <- dst_ds$dim()
        if (dm[2] != nrows || dm[1] != ncols) {
            if (!dstfile_is_object)
                dst_ds$close()
            stop("'dstfile' must have the same extent as the input rasters",
                 call. = FALSE)
        }

    } else {
        # create the output raster
        out_band <- as.integer(out_band)
        if (isFALSE(all.equal(out_band, seq_along(out_band)))) {
            stop("raster create: 'out_band' must be sequential starting at 1",
                 call. = FALSE)
        }

        dst_ds <- create(fmt, output_name, ncols, nrows, length(out_band),
                         dtName, options, TRUE)

        dst_ds$setGeoTransform(gt)
        dst_ds$setProjection(srs)
        if (setRasterNodataValue) {
            for (band in out_band) {
                dst_ds$setNoDataValue(band, nodata_value)
            }
        }
    }

    # list of GDALRaster objects for each raster layer
    ds_list <- vector("list", nrasters)
    for (i in seq_len(nrasters)) {
        if (in_raster_is_object[i])
            ds_list[[i]] <- rasterfiles[[i]]
        else
            ds_list[[i]] <- new(GDALRaster, rasterfiles[[i]])
    }

    # are pixel coordinates being used
    usePixelX <- FALSE
    usePixelY <- FALSE
    usePixelLonLat <- FALSE
    if (length(grep("pixelX", expr, fixed = TRUE)))
        usePixelX <- TRUE

    if (length(grep("pixelY", expr, fixed = TRUE)))
        usePixelY <- TRUE

    if (length(grep("pixelLon", expr, fixed = TRUE)) ||
            length(grep("pixelLat", expr, fixed = TRUE)))
        usePixelLonLat <- TRUE

    if (usePixelLonLat) {
        usePixelX <- TRUE
        usePixelY <- TRUE
    }

    if (usePixelX) {
        x <- seq(from = xmin + (cellsizeX / 2),
                 by = cellsizeX,
                 length.out = ncols)
        assign("pixelX", x)
    }

    # expected size of vector returned by expr
    num_out_bands <- length(out_band)
    expect_outrow_len <- ncols * num_out_bands

    process_row <- function(row) {
        if (usePixelY) {
            y <- rep((ymax - (cellsizeY / 2) - (cellsizeY * row)), ncols)
            assign("pixelY", y)
        }

        if (usePixelLonLat) {
            lonlat <- inv_project(cbind(x, y), srs)
            assign("pixelLon", lonlat[, 1])
            assign("pixelLat", lonlat[, 2])
        }

        for (i in seq_len(nrasters)) {
            inrow <- ds_list[[i]]$read(bands[i], 0, row, ncols, 1, ncols, 1)
            assign(var.names[i], inrow)
        }

        outrow <- eval(calc_expr)

        if (length(outrow) != expect_outrow_len) {
            if (!dstfile_is_object)
                dst_ds$close()
            for (i in seq_len(nrasters)) {
                if (!in_raster_is_object[i])
                    ds_list[[i]]$close()
            }
            stop("result vector is the wrong size", call. = FALSE)
        }

        outrow[is.na(outrow)] <- nodata_value
        dim(outrow) <- c(ncols, num_out_bands)
        i <- 1L
        for (b in out_band) {
            dst_ds$write(b, 0, row, ncols, 1, outrow[, i])
            i <- i + 1L
        }

        return()
    }

    # process by rows
    if (!quiet) {
        cli::cli_progress_bar(
            "Calculating...",
            format_done =
                "{cli::col_green(cli::symbol$tick)} Done ({cli::pb_elapsed})",
            total = nrows,
            clear = FALSE)
    }

    for (i in seq.int(0L, (nrows - 1L), 1L)) {
        process_row(i)
        if (!quiet)
            cli::cli_progress_update()
    }

    if (!quiet)
        cli::cli_progress_done()

    dst_ds$flushCache()
    if (!quiet)
        cli::cli_alert_info("output written to: {.val {output_name}}")

    for (i in seq_len(nrasters)) {
        if (!in_raster_is_object[i])
            ds_list[[i]]$close()
    }

    if (return_obj) {
        return(dst_ds)
    } else {
        if (!dstfile_is_object)
            dst_ds$close()
        return(invisible(output_name))
    }
}


#' Raster overlay for unique combinations
#'
#' @description
#' `combine()` overlays multiple rasters so that a unique ID is assigned to
#' each unique combination of input values. The input raster layers
#' typically have integer data types (floating point will be coerced to
#' integer by truncation), and must have the same projection, extent and cell
#' size. Pixel counts for each unique combination are obtained, and
#' combination IDs are optionally written to an output raster.
#'
#' @details
#' To specify input raster layers that are bands of a multi-band
#' raster file, repeat the filename in `rasterfiles` and provide the
#' corresponding band numbers in `bands`. For example:
#' \preformatted{
#' rasterfiles <- c("multi-band.tif", "multi-band.tif", "other.tif")
#' bands <- c(4, 5, 1)
#' var.names <- c("multi_b4", "multi_b5", "other")
#' }
#'
#' [rasterToVRT()] provides options for virtual clipping, resampling and pixel
#' alignment, which may be helpful here if the input rasters are not already
#' aligned on a common extent and cell size.
#'
#' If an output raster of combination IDs is written, the user should verify
#' that the number of combinations obtained did not exceed the range of the
#' output data type. Combination IDs are sequential integers starting at 1.
#' Typical output data types are the unsigned types:
#' Byte (`0` to `255`), UInt16 (`0` to `65535`) and UInt32 (the default, `0` to
#' `4294967295`).
#'
#' @param rasterfiles Character vector of raster filenames to combine.
#' @param var.names Character vector of `length(rasterfiles)` containing
#' variable names for each raster layer. Defaults will be assigned if
#' `var.names` are omitted.
#' @param bands Numeric vector of `length(rasterfiles)` containing the band
#' number to use for each raster in `rasterfiles`. Band 1 will be used for
#' each input raster if `bands` are not specified.
#' @param dstfile Character. Optional output raster filename for writing the
#' per-pixel combination IDs. The output raster will be created (and
#' overwritten if it already exists).
#' @param fmt Character. Output raster format name (e.g., "GTiff" or "HFA").
#' @param dtName Character. Output raster data type name. Combination IDs are
#' sequential integers starting at 1. The data type for the output raster
#' should be large enough to accommodate the potential number of unique
#' combinations of the input values
#' (e.g., "UInt16" or the default "UInt32").
#' @param options Optional list of format-specific creation options in a
#' vector of "NAME=VALUE" pairs
#' (e.g., \code{options = c("COMPRESS=LZW")} to set LZW compression
#' during creation of a GTiff file).
#' @param quiet Logical scalar. If `TRUE`, progress bar and messages will be
#' suppressed. Defaults to `FALSE`.
#' @returns A data frame with column `cmbid` containing the combination IDs,
#' column `count` containing the pixel counts for each combination,
#' and `length(rasterfiles)` columns named `var.names` containing the integer
#' values comprising each unique combination.
#'
#' @seealso
#' [`CmbTable-class`][CmbTable], [`GDALRaster-class`][GDALRaster], [calc()],
#' [rasterToVRT()]
#'
#' [buildRAT()] to compute a table of the unique pixel values and their counts
#' for a single raster layer
#'
#' @examples
#' evt_file <- system.file("extdata/storml_evt.tif", package="gdalraster")
#' evc_file <- system.file("extdata/storml_evc.tif", package="gdalraster")
#' evh_file <- system.file("extdata/storml_evh.tif", package="gdalraster")
#' rasterfiles <- c(evt_file, evc_file, evh_file)
#' var.names <- c("veg_type", "veg_cov", "veg_ht")
#' tbl <- combine(rasterfiles, var.names)
#' nrow(tbl)
#' tbl <- tbl[order(-tbl$count),]
#' head(tbl, n = 20)
#'
#' # combine two bands from a multi-band file and write the combination IDs
#' # to an output raster
#' lcp_file <- system.file("extdata/storm_lake.lcp", package="gdalraster")
#' rasterfiles <- c(lcp_file, lcp_file)
#' bands <- c(4, 5)
#' var.names <- c("fbfm", "tree_cov")
#' cmb_file <- file.path(tempdir(), "fbfm_cov_cmbid.tif")
#' opt <- c("COMPRESS=LZW")
#' tbl <- combine(rasterfiles, var.names, bands, cmb_file, options = opt)
#' head(tbl)
#' ds <- new(GDALRaster, cmb_file)
#' ds$info()
#' ds$close()
#' \dontshow{deleteDataset(cmb_file)}
#' @export
combine <- function(rasterfiles, var.names=NULL, bands=NULL,
                    dstfile=NULL, fmt=NULL, dtName="UInt32",
                    options=NULL, quiet=FALSE) {

    if ((!is.null(dstfile)) && (is.null(fmt))) {
        fmt <- .getGDALformat(dstfile)
        if (is.null(fmt)) {
            stop("use 'fmt' to specify a GDAL raster format name",
                 call. = FALSE)
        }
    }

    if (!is.null(options)) {
        if (!is.character(options))
            stop("'options' must be a character vector", call. = FALSE)
    }

    if (is.null(dstfile))
        dstfile <- ""

    if (is.null(fmt))
        fmt <- ""

    nrasters <- length(rasterfiles)
    if (is.null(var.names)) {
        for (n in 1:nrasters) {
            var.names[n] <- tools::file_path_sans_ext(basename(rasterfiles[n]))
        }
    }

    if (is.null(bands)) {
        bands <- rep(1, nrasters)
    }

    ref_ds <- new(GDALRaster, rasterfiles[1], read.only=TRUE)
    ref_nrows <- ref_ds$getRasterYSize()
    ref_ncols <- ref_ds$getRasterXSize()
    ref_res <- ref_ds$res()
    ref_ds$close()

    if (nrasters > 1) {
        for (i in 2:length(rasterfiles)) {
            ds <- new(GDALRaster, rasterfiles[i], read.only=TRUE)
            if ((ds$getRasterYSize() != ref_nrows) ||
                    (ds$getRasterXSize() != ref_ncols))
                stop("all input rasters must have the same extent/cell size",
                     call. = FALSE)
            if (!all(ds$res() == ref_res))
                stop("all input rasters must have the same extent/cell size",
                     call. = FALSE)
            ds$close()
        }
    }

    d <- .combine(rasterfiles, var.names, bands, dstfile, fmt, dtName,
                  options, quiet)

    return(d)
}


#' GDAL DEM processing
#'
#' @description
#' `dem_proc()` generates DEM derivatives from an input elevation raster. This
#' function is a wrapper for the \command{gdaldem} command-line utility.
#' See \url{https://gdal.org/en/stable/programs/gdaldem.html} for details.
#'
#' @param mode Character. Name of the DEM processing mode. One of hillshade,
#' slope, aspect, color-relief, TRI, TPI or roughness.
#' @param srcfile Filename of the source elevation raster.
#' @param dstfile Filename of the output raster.
#' @param mode_options An optional character vector of command-line options
#' (see [DEFAULT_DEM_PROC] for default values).
#' @param color_file Filename of a text file containing lines formatted as:
#' "elevation_value red green blue". Only used when `mode = "color-relief"`.
#' @param quiet Logical scalar. If `TRUE`, a progress bar will not be
#' displayed. Defaults to `FALSE`.
#' @returns Logical indicating success (invisible `TRUE`).
#' An error is raised if the operation fails.
#'
#' @note
#' Band 1 of the source elevation raster is read by default, but this can be
#' changed by including a `-b` command-line argument in `mode_options`.
#' See the \href{https://gdal.org/en/stable/programs/gdaldem.html}{documentation for
#' `gdaldem`} for a description of all available options for each processing
#' mode.
#'
#' @examples
#' ## hillshade
#' elev_file <- system.file("extdata/storml_elev.tif", package="gdalraster")
#' out_file <- file.path(tempdir(), "storml_hillshade.tif")
#' dem_proc("hillshade", elev_file, out_file)
#'
#' ds <- new(GDALRaster, out_file)
#' plot_raster(ds)
#'
#' ds$close()
#' \dontshow{deleteDataset(out_file)}
#' @export
dem_proc <- function(mode,
                     srcfile,
                     dstfile,
                     mode_options = DEFAULT_DEM_PROC[[mode]],
                     color_file = NULL,
                     quiet = FALSE) {

    if (is.null(DEFAULT_DEM_PROC[[mode]]))
        stop("DEM processing 'mode' not recognized", call.=FALSE)

    return(invisible(.dem_proc(mode,
                               srcfile,
                               dstfile,
                               mode_options,
                               color_file,
                               quiet)))
}


#' Check line of sight between pairs of point locations
#'
#' @description
#' `is_los_visible()` is an interface to GDAL's line-of-sight algorithm
#' implemented by `GDALIsLineOfSightVisible()` in the Algorithms C API
#' (\url{https://gdal.org/en/stable/api/gdal_alg.html}). It checks line of sight
#' across a DEM surface using a Bresenham algorithm. The function can operate
#' pairwise on sets of input points, or one-to-many. Requires GDAL >= 3.9.
#'
#' @param dem Either a character string giving the filename of the DEM
#' raster, or an object of class `GDALRaster` for the DEM.
#' @param ptsA A data frame or numeric matrix containing geospatial point
#' coordinates, or point geometries (with Z values) as a list of WKB raw vectors
#' or character vector of WKT strings. If data frame or matrix, the number of
#' columns must be three (x, y, z). May be also be given as a numeric vector for
#' one point (`c(x, y, z)`). If this argument contains a single point, then
#' line of sight will be checked between it and each point in `ptsB`, otherwise
#' `length(ptsA)` must equal `length(ptsB)`, and line of sight will be checked
#' pairwise.
#' @param ptsB The second set of points, as described above for `ptsA`.
#' @param band An integer value specifying the band number in `dem` to use.
#' Defaults to `1L`.
#' @param srsA An optional character string specifying the spatial reference
#' system for `ptsA`. May be in WKT format or any of the formats supported by
#' [srs_to_wkt()]. If this argument is `NULL` (the default), then `ptsA` are
#' assumed to be in the same coordinate reference system as `dem`. Otherwise,
#' `ptsA` will be reprojected from `srsA` to the spatial reference of `dem`.
#' @param srsB An optional character string specifying the spatial reference
#' system for `ptsB` (see above). Defaults to `NULL`. If not `NULL`, `ptsB` will
#' be reprojected from `srsB` to the spatial reference of `dem`.
#' @param ZinterpA A character string specifying the interpretation of the Z
#' values for `ptsA`. The default is `"RELATIVE_TO_DEM"`, in which case the
#' location heights of `ptsA` are obtained by querying the DEM surface and
#' adding the Z value given in `ptsA`. Alternatively, the Z values can be
#' interpreted as absolute heights to be used unmodified by setting this
#' argument to `"ACTUAL"`.
#' @param ZinterpB A character string specifying the interpretation of the Z
#' values for `ptsB`. See the description above for `ZinterpA`.
#' @param quiet A logical value with default of `FALSE`. If set to `TRUE`, will
#' suppress a progress bar and informational messages.
#' @returns A logical vector of `length(ptsB)`, `TRUE` for each pair of points
#' that are within line of sight, otherwise `FALSE`.
#' The checks are done pairwise if `(length(ptsA) == length(ptsB))`, or
#' one-to-many if `length(ptsA) == 1` and multiple points are given in `ptsB`.
#'
#' @note
#' Input coordinates must be within the raster bounds. `NA` will be returned if
#' either coordinate is outside the raster extent, or is missing a Z value.
#'
#' The GDAL documentation notes that line of sight is computed in raster
#' coordinate space, and thus may not be appropriate for some applications. For
#' example, datasets referenced against geographic coordinates at high latitudes
#' may have issues.
#'
#' In GDAL 3.9 through 3.12, a point exactly on the surface of the DEM is never
#' visible with `GDALIsLineOfSightVisible()`, even if viewed from a point
#' directly above. For a detailed description, see
#' \url{https://github.com/OSGeo/gdal/issues/12458}. A workaround for that case
#' is to set a small but negligible positive Z value (if using
#' `"RELATIVE_TO_DEM"`) for points that are intended to be on the DEM surface,
#' if appropriate for the use case. GDAL as of version 3.13 treats a point
#' exactly on the surface as visible
#' (\url{https://github.com/OSGeo/gdal/pull/14237}).
#'
#' @references
#' Roberto de Beauclair Seixas, Maur Riguette Mediano and Marcelo Gattass. 1999.
#' Efficient Line-of-Sight Algorithms for Real Terrain Data.
#'
#' @examplesIf gdal_version_num() >= gdal_compute_version(3, 9, 0)
#' dem <- system.file("extdata/storml_elev.tif", package="gdalraster")
#'
#' ## no reprojection, the point coordinates are in the same projection as DEM
#'
#' ## one-to-many
#' ptA <- c(324625.0, 5104724.0, 1.7)
#' ptsB <-c(324803.0, 5104517.0, 10,
#'          325286.0, 5102923.0, 10,
#'          323847.0, 5104538.0, 10)
#' ptsB <- matrix(ptsB, nrow = 3, ncol = 3, byrow = TRUE)
#'
#' is_los_visible(dem, ptA, ptsB)
#'
#' ## pairwise, same ptA location with varying height
#' ptsA <- c(324625.0, 5104724.0, 1,
#'           324625.0, 5104724.0, 10,
#'           324625.0, 5104724.0, 1000)
#' ptsA <- matrix(ptsA, nrow = 3, ncol = 3, byrow = TRUE)
#'
#' is_los_visible(dem, ptsA, ptsB)
#'
#' ## WKB points
#' (ptsA_wkb <- g_create("POINT", ptsA))
#'
#' # as WKT
#' g_wk2wk(ptsA_wkb)
#'
#' # or as ISO WKT
#' g_wk2wk(ptsA_wkb, as_iso = TRUE)
#'
#' is_los_visible(dem, ptsA_wkb, ptsB)
#'
#' ## reprojecting ptsA, and the DEM given as a dataset object
#' (ds <- new(GDALRaster, dem))
#'
#' ptsA_wkb_wgs84 <- g_transform(ptsA_wkb, ds$getSpatialRef(), "WGS84")
#' g_wk2wk(ptsA_wkb_wgs84)
#'
#' is_los_visible(ds, ptsA_wkb_wgs84, ptsB, srsA = "WGS84")
#'
#' ## read ptsB from a vector dataset, use original ptA
#'
#' dsn <- system.file("extdata/storml_los_pts_b.geojson", package="gdalraster")
#' (lyr <- new(GDALVector, dsn))
#'
#' (features <- lyr$fetch(-1))
#'
#' is_los_visible(ds, ptA, features$geom, srsB = lyr$getSpatialRef(),
#'                ZinterpB = "ACTUAL")
#'
#' ds$close()
#' lyr$close()
#' @export
is_los_visible <- function(dem, ptsA, ptsB, band = 1L,
                           srsA = NULL, srsB = NULL,
                           ZinterpA = "RELATIVE_TO_DEM",
                           ZinterpB = "RELATIVE_TO_DEM",
                           quiet = FALSE) {

    if (gdal_version_num() < gdal_compute_version(3, 9, 0))
        stop("is_los_visible() requires GDAL >= 3.9", call. = FALSE)

    ds <- NULL
    close_ds <- FALSE
    if (is(dem, "Rcpp_GDALRaster")) {
        ds <- dem
        if (!ds$isOpen()) {
            stop("raster dataset is not open", call. = FALSE)
        }
    } else if (is.character(dem) && length(dem) == 1) {
        ds <- new(GDALRaster, dem)
        close_ds <- TRUE
    } else {
        stop("'dem' must be a character string or GDALRaster object",
             call. = FALSE)
    }

    if (is.null(band))
        band <- 1L
    if (!(is.numeric(band) && length(band == 1)))
        stop("'band' must be a single numeric value", call. = FALSE)

    if (missing(ptsA) || is.null(ptsA))
        stop("'ptsA' is required", call. = FALSE)

    if (missing(ptsB) || is.null(ptsB))
        stop("'ptsB' is required", call. = FALSE)

    if (is.null(srsA))
        srsA <- ""
    else if (!is.character(srsA) || length(srsA) > 1)
        stop("'srsA' must be a character string", call. = FALSE)

    if (is.null(srsB))
        srsB <- ""
    else if (!is.character(srsB) || length(srsB) > 1)
        stop("'srsB' must be a character string", call. = FALSE)

    if (is.null(ZinterpA))
        ZinterpA <- "RELATIVE_TO_DEM"
    else if (!is.character(ZinterpA) || length(ZinterpA) > 1)
        stop("'ZinterpA' must be a character string", call. = FALSE)
    if (!(toupper(ZinterpA) %in% c("ACTUAL", "RELATIVE_TO_DEM"))) {
        stop("'ZinterpA' must be one of \"ACTUAL\" or \"RELATIVE_TO_DEM\"",
             call. = FALSE)
    }

    if (is.null(ZinterpB))
        ZinterpB <- "RELATIVE_TO_DEM"
    else if (!is.character(ZinterpB) || length(ZinterpB) > 1)
        stop("'ZinterpB' must be a character string", call. = FALSE)
    if (!(toupper(ZinterpB) %in% c("ACTUAL", "RELATIVE_TO_DEM"))) {
        stop("'ZinterpB' must be one of \"ACTUAL\" or \"RELATIVE_TO_DEM\"",
             call. = FALSE)
    }

    ptsA_in <- NULL
    if (is.raw(ptsA) || (is.list(ptsA) && is.raw(ptsA[[1]]) ||
        is.character(ptsA))) {

        if (is.character(ptsA))
            ptsA <- g_wk2wk(ptsA)

        if (is.raw(ptsA)) {
            geom_type <- g_name(ptsA)
        } else {
            geom_type <- g_name(ptsA[[1]])
        }
        if (!startsWith(geom_type, "POINT"))
            stop("'ptsA' does not contain a POINT geometry type", call. = FALSE)

        coords <- g_coords(ptsA)
        if (!is.null(coords$z)) {
            ptsA_in <- coords[, c("x", "y", "z")]
        } else {
            stop("'ptsA' does not contain Z values", call. = FALSE)
        }
    } else if (is.data.frame(ptsA) || is.matrix(ptsA) || is.vector(ptsA)) {
        ptsA_in <- ptsA
    } else {
        stop("'ptsA' is not a valid input type", call. = FALSE)
    }

    ptsB_in <- NULL
    if (is.raw(ptsB) || (is.list(ptsB) && is.raw(ptsB[[1]]) ||
        is.character(ptsB))) {

        if (is.character(ptsB))
            ptsB <- g_wk2wk(ptsB)

        if (is.raw(ptsB)) {
            geom_type <- g_name(ptsB)
        } else {
            geom_type <- g_name(ptsB[[1]])
        }
        if (!startsWith(geom_type, "POINT"))
            stop("'ptsB' does not contain a POINT geometry type", call. = FALSE)

        coords <- g_coords(ptsB)
        if (!is.null(coords$z)) {
            ptsB_in <- coords[, c("x", "y", "z")]
        } else {
            stop("'ptsB' does not contain Z values", call. = FALSE)
        }
    } else if (is.data.frame(ptsB) || is.matrix(ptsB) || is.vector(ptsB)) {
        ptsB_in <- ptsB
    } else {
        stop("'ptsB' is not a valid input type", call. = FALSE)
    }

    if (is.null(quiet))
        quiet <- FALSE
    if (!is.logical(quiet) || length(quiet) > 1)
        stop("'quiet' must be a single logical value", call. = FALSE)

    ret <- .isLineOfSightVisible(ds, band, ptsA_in, srsA, ZinterpA,
                                 ptsB_in, srsB, ZinterpB, quiet)

    if (close_ds)
        ds$close()

    return(ret)
}


#' Extract pixel values at geospatial point locations
#'
#' @description
#' `pixel_extract()` returns raster pixel values for a set of geospatial
#' point locations. The coordinates are given as a two-column matrix of x/y
#' values in the same spatial reference system as the input raster (unless
#' `xy_srs` is specified). Coordinates can also be given in a data frame with
#' an optional column of point IDs.
#' Values are extracted from all bands of the raster by default, or specific
#' band numbers may be given. An optional interpolation method may be specified
#' for bilinear (2 x 2 kernel), cubic convolution (4 x 4 kernel, GDAL >= 3.10),
#' or cubic spline (4 x 4 kernel, GDAL >= 3.10). Alternatively, an optional
#' kernel dimension `N` may be given to extract values of the individual pixels
#' within an `N x N` kernel centered on the pixel containing the point location.
#' If `xy_srs` is given, the function will attempt to transform the input points
#' to the projection of the raster with a call to `transform_xy()`.
#'
#' @param raster Either a character string giving the filename of a raster, or
#' an object of class `GDALRaster` for the source dataset.
#' @param xy A two-column numeric matrix or two-column data frame of geospatial
#' coordinates (x, y), or a vector for a single point (x, y), in the same
#' spatial reference system as `raster`. Can also be given as a data frame with
#' three or more columns, in which the first column must be a vector of point
#' IDs (`character` or `numeric`), and the second and third columns must contain
#' the geospatial coordinates (x, y).
#' @param bands Optional numeric vector of band numbers. All bands in `raster`
#' will be processed by default if not specified, or if `0` is given.
#' @param interp Optional character string specifying an interpolation method.
#' Must be one of `"bilinear"`, `"cubic"`, `"cubicspline"`, or `"nearest"` (the
#' default if not specified, i.e., no interpolation).
#' GDAL >= 3.10 is required for `"cubic"` and `"cubicspline"`.
#' @param krnl_dim Optional numeric value specifying the dimension `N` pixels
#' of an `N x N` kernel for which all individual pixel values will be returned.
#' Should be a positive whole number (will be coerced to integer by truncation).
#' Currently only supported when extracting from a single raster band. Ignored
#' if `interp` is specified as other than `"nearest"` (i.e., the kernel implied
#' by the interpolation method will always be used).
#' @param xy_srs Optional character string specifying the spatial reference
#' system for `xy`. May be in WKT format or any of the formats supported by
#' [srs_to_wkt()].
#' @param max_ram Numeric value giving the maximum amount of RAM (in MB) to
#' use for potentially copying a remote raster into memory for processing
#' (see Note). Defaults to 300 MB. Set to zero to disable potential copy of
#' remote files into memory.
#' @param as_data_frame Logical value, `TRUE` to return output as a data frame.
#' The default is to return a numeric matrix unless point IDs are present in
#' the first column of `xy` given as a data frame. In that latter case, the
#' output will always be a data frame with the point IDs in the first column.
#' @returns A numeric matrix or data frame of pixel values with number of rows
#' equal to the number of rows in `xy`. The number of columns is equal to the
#' number of `bands` (plus optional point ID column), or if `krnl_dim = N`
#' is used, number of columns is equal to `N * N` (plus optional point ID
#' column). Output is always a data frame if `xy` is given as a data frame with
#' a column of point IDs (`as_data_frame` will be ignored in that case).
#' Named columns indicate the band, e.g., `"b1"`. If `krnl_dim` is used, named
#' columns indicate band and pixel, e.g., `"b1_p1"`, `"b1_p2"`, ..., `"b1_p9"`
#' if `krnl_dim = 3`. Pixels are in left-to-right, top-to-bottom order in the
#' kernel.
#'
#' @note
#' Depending on the number of input points, extracting from a raster on a
#' remote filesystem may require a large number of HTTP range requests which
#' may be slow (i.e., URLs/remote VSI filesystems). In that case, it may be
#' faster to copy the raster into memory first (either as MEM format or to a
#' /vsimem/ filesystem).
#' `pixel_extract()` will attempt to automate that process if the total size
#' of file(s) that would be copied does not exceed the threshold given by
#' `max_ram`, and `nrow(xy) > 10` (requires GDAL >= 3.6).
#'
#' For alternative workflows that involve copying to local storage, the data
#' management functions (e.g., [copyDatasetFiles()]) and the VSI filesystem
#' functions (e.g., [vsi_is_local()], [vsi_stat()], [vsi_copy_file()]) may be
#' of interest.
#'
#' @examples
#' pt_file <- system.file("extdata/storml_pts.csv", package="gdalraster")
#' # id, x, y in NAD83 / UTM zone 12N, same as the raster
#' pts <- read.csv(pt_file)
#' print(pts)
#'
#' raster_file <- system.file("extdata/storml_elev.tif", package="gdalraster")
#'
#' pixel_extract(raster_file, pts)
#'
#' # or as GDALRaster object
#' ds <- new(GDALRaster, raster_file)
#' # optionally suppress progress reporting
#' # ds$quiet <- TRUE
#' pixel_extract(ds, pts)
#'
#' # interpolated values
#' pixel_extract(raster_file, pts, interp = "bilinear")
#'
#' # individual pixel values within a kernel
#' pixel_extract(raster_file, pts, krnl_dim = 3)
#'
#' # lont/lat xy
#' pts_wgs84 <- transform_xy(pts[-1], srs_from = ds$getProjection(),
#'                           srs_to = "WGS84")
#'
#' # transform the input xy
#' pixel_extract(ds, xy = pts_wgs84, xy_srs = "WGS84")
#'
#' ds$close()
pixel_extract <- function(raster, xy, bands = NULL, interp = NULL,
                          krnl_dim = NULL, xy_srs = NULL, max_ram = 300,
                          as_data_frame = NULL) {

    if (missing(xy) || is.null(xy))
        stop("'xy' is required", call. = FALSE)

    if (is.null(as_data_frame) || any(is.na(as_data_frame)))
        as_data_frame <- FALSE
    else if (!is.logical(as_data_frame) || length(as_data_frame) > 1)
        stop("'as_data_frame' must be a single logical value", call. = FALSE)

    return_df <- as_data_frame
    pt_ids <- NULL
    pt_id_name <- "ptid"
    xy_in <- NULL
    if (is.data.frame(xy)) {
        if (ncol(xy) >= 3) {
            if (!(is.character(xy[, 1]) || is.numeric(xy[, 1])) ||
                !is.numeric(xy[, 2]) || !is.numeric(xy[, 3])) {

                cat("xy[1:3] must have types: character or numeric, numeric, numeric\n")
                stop("the first three columns of 'xy' must contain point ID, x, y",
                     call. = FALSE)
            } else {
                return_df <- TRUE
                pt_ids <- xy[, 1]
                pt_id_name <- names(xy)[1]
                xy_in <- xy[, 2:3]
            }
        } else {
            if (ncol(xy) !=2 || !is.numeric(xy[, 1]) || !is.numeric(xy[, 2])) {
                stop("'xy' must have at least two numeric columns of x, y",
                     call. = FALSE)
            } else {
                xy_in <- xy
            }
        }
    } else if (!is.numeric(xy)) {
        stop("'xy' must be a numeric matrix or data frame", call. = FALSE)
    } else {
        xy_in <- xy
    }

    if (is.null(bands))
        bands <- 0
    else if (!is.numeric(bands) || any(is.na(bands))) {
        stop("'bands' must be a numeric vector of valid band numbers",
             call. = FALSE)
    }

    if (is.null(interp) || all(is.na(interp)))
        interp <- "nearest"
    else if (!is.character(interp) || length(interp) > 1)
        stop("'interp' must be a character string", call. = FALSE)

    if (is.null(krnl_dim) || all(is.na(krnl_dim)))
        krnl_dim <- 1L
    else if (!is.numeric(krnl_dim) || length(krnl_dim) > 1)
        stop("'krnl_dim' must be a numeric (integer) scalar", call. = FALSE)
    else
        krnl_dim <- trunc(krnl_dim)

    if (is.null(xy_srs) || all(is.na(xy_srs)))
        xy_srs <- ""
    else if (!is.character(xy_srs) || length(xy_srs) > 1)
        stop("'xy_srs' must be a character string", call. = FALSE)

    if (is.null(max_ram) || all(is.na(max_ram)))
        max_ram <- 0
    else if (!is.numeric(max_ram) || length(max_ram) > 1)
        stop("'max_ram' must be a numeric scalar", call. = FALSE)

    if (max_ram > (get_usable_physical_ram() / 1e6))
        stop("'max_ram' exceeds usable physical RAM", call. = FALSE)

    ds <- NULL
    if (is(raster, "Rcpp_GDALRaster")) {
        ds <- raster
        if (!ds$isOpen()) {
            stop("raster dataset is not open", call. = FALSE)
        }
    } else if (is.character(raster) && length(raster) == 1) {
        ds <- new(GDALRaster, raster)
        on.exit(ds$close(), add = TRUE)
    } else {
        stop("'raster' must be a character string or GDALRaster object",
             call. = FALSE)
    }

    # potentially copy to memory
    use_mem <- FALSE
    ds_mem <- NULL
    mem_dir <- ""
    f_mem <- ""
    f_in <- ds$getDescription(band = 0)
    if (max_ram > 0 && nrow(xy_in) > 10 &&
        gdal_version_num() >= gdal_compute_version(3, 6, 0) &&
        !vsi_is_local(f_in)) {

        # use MEM dataset if possible
        dm <- ds$dim()
        num_pixels <- dm[1] * dm[2] * dm[3]
        bytes_per_pixel <- 1
        for (b in seq_len(ds$getRasterCount())) {
            if (dt_size(ds$getDataTypeName(b)) > bytes_per_pixel) {
                bytes_per_pixel <- dt_size(ds$getDataTypeName(b))
            }
        }
        raw_size <- num_pixels * bytes_per_pixel
        if ((raw_size / 1e6) < max_ram) {
            if (!ds$quiet) {
                cli::cli_alert_info("copying to MEM dataset...")
            }
            ds_mem <- try(createCopy("MEM", "", f_in, return_obj = TRUE),
                          silent = ds$quiet)
            if (!is(ds_mem, "Rcpp_GDALRaster")) {
                if (!ds$quiet) {
                    cli::cli_alert_warning("copy to MEM failed")
                }
            } else {
                if (!ds$quiet) {
                    cli::cli_alert_success("using in-memory raster")
                }
                use_mem <- TRUE
                on.exit(ds_mem$close(), add = TRUE)
            }
        } else {

            # try copying to /vsimem instead
            f_size <- 0
            for (f in ds$getFileList()) {
                this_f_size <- vsi_stat(f, "size")
                if (this_f_size == -1) {
                    f_size <- -1
                    if (!ds$quiet) {
                        cli::cli_alert_warning("failed to get file size")
                    }
                    break
                }
                f_size <- f_size + this_f_size
            }
            if (f_size > 0 && (f_size / 1e6) < max_ram) {
                f_nopath <- .cpl_get_filename(f_in)
                mem_dir <- file.path("/vsimem", tempdir() |>
                    .cpl_get_basename())

                f_mem <- file.path(mem_dir, f_nopath)
                if (!ds$quiet) {
                    cli::cli_alert_info(
                        "copying remote file(s) to /vsimem/...")
                }

                res <- copyDatasetFiles(new_filename = f_mem,
                                        old_filename = f_in)

                if (!res) {
                    vsi_rmdir(mem_dir, recursive = TRUE)
                    if (!ds$quiet) {
                        cli::cli_alert_warning("copy to {.val {f_mem}} failed")
                    }
                } else {
                    ds_mem <- try(new(GDALRaster, f_mem), silent = TRUE)
                    if (!is(ds_mem, "Rcpp_GDALRaster")) {
                        vsi_rmdir(mem_dir, recursive = TRUE)
                        if (!ds$quiet) {
                            cli::cli_alert_warning("open {.val {f_mem}} failed")
                        }
                    } else {
                        use_mem <- TRUE
                        on.exit(ds_mem$close(), add = TRUE)
                        on.exit(res <- deleteDataset(f_mem), add = TRUE)
                        on.exit(res <- vsi_rmdir(mem_dir, recursive = TRUE),
                                add = TRUE)

                        if (!ds$quiet) {
                            cli::cli_alert_success("using in-memory raster")
                        }
                    }
                }
            }
        }

        if (!ds$quiet && !use_mem) {
            cli::cli_alert_info(
                "not using in-memory raster, processing remote file...")
        }
    }

    if (krnl_dim > 1 && (tolower(interp) == "nearest" ||
                         tolower(interp) == "near")) {

        # extend with VRT to handle krnl_dim > 1 along raster edges
        bb <- ds$bbox()
        res <- ds$res()
        xmin <- bb[1] - krnl_dim * res[1]
        ymin <- bb[2] - krnl_dim * res[2]
        xmax <- bb[3] + krnl_dim * res[1]
        ymax <- bb[4] + krnl_dim * res[2]

        args <- c("-of", "VRT", "-ot", "Float64", "-dstnodata", "NaN")
        args <- c(args, "-te", xmin, ymin, xmax, ymax)
        args <- c(args, "-tr", res[1], res[2])
        args <- c(args, "-ovr", "NONE")

        vrt_file <- tempfile(fileext = ".vrt")

        if (use_mem)
            warp(ds_mem, vrt_file, t_srs = "", cl_arg = args, quiet = TRUE)
        else
            warp(ds, vrt_file, t_srs = "", cl_arg = args, quiet = TRUE)

        ds_vrt <- new(GDALRaster, vrt_file)
        ret <- ds_vrt$pixel_extract(xy_in, bands, interp, krnl_dim, xy_srs)

        ds_vrt$close()
        vsi_unlink(vrt_file)

    } else {
        if (use_mem)
            ret <- ds_mem$pixel_extract(xy_in, bands, interp, krnl_dim, xy_srs)
        else
            ret <- ds$pixel_extract(xy_in, bands, interp, krnl_dim, xy_srs)
    }

    col_names <- colnames(ret)
    band_nums <- NULL
    if (bands[1] == 0)
        band_nums <- seq_len(ds$getRasterCount())
    else
        band_nums <- bands

    if (!((tolower(interp) %in% c("near", "nearest")) && krnl_dim > 1L)) {
        if (length(col_names) != length(band_nums)) {
            # should not be possible
            warning("number of output columns does not match number of bands",
                    call. = FALSE)
            cat("matrix output of GDALRaster::pixel_extract() returned\n")
            return(ret)
        }
        i <- 1
        ds_name <- tools::file_path_sans_ext(basename(ds$getDescription(0)))
        for (b in band_nums) {
            band_desc <- ds$getDescription(b)
            if (all(nzchar(band_desc))) {
                if (length(band_nums) > 1)
                    col_names[i] <- paste0(col_names[i], "_", band_desc)
                else
                    col_names[i] <- band_desc
            } else if (all(nzchar(ds_name))) {
                if (length(band_nums) > 1)
                    col_names[i] <- paste0(ds_name, "_", col_names[i])
                else
                    col_names[i] <- ds_name
            }
            i <- i + 1
        }
    }

    if (return_df) {
        if (is.null(pt_ids))
            pt_ids <- seq_len(nrow(ret))
        ret <- data.frame(pt_ids, ret)
        names(ret) <- make.names(c(pt_id_name, col_names), unique = TRUE)
    } else {
        colnames(ret) <- make.names(col_names, unique = TRUE)
    }

    return(ret)
}


#' Create a polygon feature layer from raster data
#'
#' @description
#' `polygonize()` creates vector polygons for all connected regions of pixels
#' in a source raster sharing a common pixel value. Each polygon is created
#' with an attribute indicating the pixel value of that polygon. A raster mask
#' may also be provided to determine which pixels are eligible for processing.
#' The function will create the output vector layer if it does not already
#' exist, otherwise it will try to append to an existing one.
#' This function is a wrapper of `GDALPolygonize` in the GDAL Algorithms API.
#' It provides essentially the same functionality as the `gdal_polygonize.py`
#' command-line program
#' (\url{https://gdal.org/en/stable/programs/gdal_polygonize.html}).
#'
#' @details
#' Polygon features will be created on the output layer, with polygon
#' geometries representing the polygons. The polygon geometries will be in the
#' georeferenced coordinate system of the raster (based on the geotransform of
#' the source dataset). It is acceptable for the output layer to already have
#' features. If the output layer does not already exist, it will be created
#' with coordinate system matching the source raster.
#'
#' The algorithm attempts to minimize memory use so that very large rasters can
#' be processed. However, if the raster has many polygons or very large/complex
#' polygons, the memory use for holding polygon enumerations and active polygon
#' geometries may grow to be quite large.
#'
#' The algorithm will generally produce very dense polygon geometries, with
#' edges that follow exactly on pixel boundaries for all non-interior pixels.
#' For non-thematic raster data (such as satellite images) the result will
#' essentially be one small polygon per pixel, and memory and output layer
#' sizes will be substantial. The algorithm is primarily intended for
#' relatively simple thematic rasters, masks, and classification results.
#'
#' @param raster_file Filename of the source raster.
#' @param out_dsn The destination vector filename to which the polygons will be
#' written (or database connection string).
#' @param out_layer Name of the layer for writing the polygon features. For
#' single-layer file formats such as `"ESRI Shapefile"`, the layer name is the
#' same as the filename without the path or extension (e.g., `out_dsn =
#' "path_to_file/polygon_output.shp"`, the layer name is `"polygon_output"`).
#' @param fld_name Name of an integer attribute field in `out_layer` to which
#' the pixel values will be written. Will be created if necessary when using an
#' existing layer.
#' @param out_fmt GDAL short name of the output vector format. If unspecified,
#' the function will attempt to guess the format from the filename/connection
#' string.
#' @param connectedness Integer scalar. Must be either `4` or `8`. For the
#' default 4-connectedness, pixels with the same value are considered connected
#' only if they touch along one of the four sides, while 8-connectedness
#' also includes pixels that touch at one of the corners.
#' @param src_band The band on `raster_file` to build the polygons from
#' (default is `1`).
#' @param mask_file Use the first band of the specified raster as a
#' validity mask (zero is invalid, non-zero is valid). If not specified, the
#' default validity mask for the input band (such as nodata, or alpha masks)
#' will be used (unless `nomask` is set to `TRUE`).
#' @param nomask Logical scalar. If `TRUE`, do not use the default validity
#' mask for the input band (such as nodata, or alpha masks).
#' Default is `FALSE`.
#' @param overwrite Logical scalar. If `TRUE`, overwrite `out_layer` if it
#' already exists. Default is `FALSE`.
#' @param dsco Optional character vector of format-specific creation options
#' for `out_dsn` (`"NAME=VALUE"` pairs).
#' @param lco Optional character vector of format-specific creation options
#' for `out_layer` (`"NAME=VALUE"` pairs).
#' @param quiet Logical scalar. If `TRUE`, a progress bar will not be
#' displayed. Defaults to `FALSE`.
#'
#' @note
#' The source pixel band values are read into a signed 64-bit integer buffer
#' (`Int64`) by `GDALPolygonize`, so floating point or complex bands will be
#' implicitly truncated before processing.
#'
#' When 8-connectedness is used, many of the resulting polygons will likely be
#' invalid due to ring self-intersection (in the strict OGC definition of
#' polygon validity). See `g_is_valid()` / `g_make_valid()` (single polygons
#' can become MultiPolygon' in the case of self-intersections).
#'
#' If writing to a SQLite database format as either `GPKG` (GeoPackage
#' vector) or `SQLite` (Spatialite vector), setting the
#' `SQLITE_USE_OGR_VFS` and `OGR_SQLITE_JOURNAL` configuration options may
#' increase performance substantially. If writing to `PostgreSQL`
#' (PostGIS vector), setting `PG_USE_COPY=YES` is faster:
#' ```
#' # SQLite: GPKG (.gpkg) and Spatialite (.sqlite)
#' # enable extra buffering/caching by the GDAL/OGR I/O layer
#' set_config_option("SQLITE_USE_OGR_VFS", "YES")
#' # set the journal mode for the SQLite database to MEMORY
#' set_config_option("OGR_SQLITE_JOURNAL", "MEMORY")
#'
#' # PostgreSQL / PostGIS
#' # use COPY for inserting data rather than INSERT
#' set_config_option("PG_USE_COPY", "YES")
#' ```
#'
#' @seealso
#' [rasterize()]
#'
#' `vignette("gdal-config-quick-ref")`
#'
#' @examples
#' evt_file <- system.file("extdata/storml_evt.tif", package="gdalraster")
#' dsn <- file.path(tempdir(), "storm_lake.gpkg")
#' layer <- "lf_evt"
#' fld <- "evt_value"
#' set_config_option("SQLITE_USE_OGR_VFS", "YES")
#' set_config_option("OGR_SQLITE_JOURNAL", "MEMORY")
#' polygonize(evt_file, dsn, layer, fld)
#' set_config_option("SQLITE_USE_OGR_VFS", "")
#' set_config_option("OGR_SQLITE_JOURNAL", "")
#' \dontshow{deleteDataset(dsn)}
#' @export
polygonize <- function(raster_file,
                       out_dsn,
                       out_layer,
                       fld_name = "DN",
                       out_fmt = NULL,
                       connectedness = 4,
                       src_band = 1,
                       mask_file = NULL,
                       nomask = FALSE,
                       overwrite = FALSE,
                       dsco = NULL,
                       lco = NULL,
                       quiet = FALSE) {

    if (connectedness !=4 && connectedness != 8)
        stop("'connectedness' must be either 4 or 8", call. = FALSE)

    ds <- new(GDALRaster, raster_file, TRUE)
    srs <- ds$getProjectionRef()
    ds$close()

    if (!is.null(mask_file)) {
        ds <- new(GDALRaster, mask_file, TRUE)
        ds$close()
    } else {
        mask_file <- ""
    }

    if (!ogr_ds_exists(out_dsn, with_update = TRUE)) {
        if (ogr_ds_exists(out_dsn) && !overwrite) {
            msg <- "'out_dsn' exists but cannot be updated.\n"
            msg <- paste0(msg, "You may need to remove it first, ")
            msg <- paste0(msg, "or use 'overwrite = TRUE'.")
            stop(msg, call. = FALSE)
        }
    }

    if (ogr_ds_exists(out_dsn, with_update = TRUE) && overwrite) {
        deleted <- FALSE
        if (ogr_layer_exists(out_dsn, out_layer)) {
            deleted <- ogr_layer_delete(out_dsn, out_layer)
        }
        if (!deleted) {
            if (ogr_ds_layer_count(out_dsn) == 1) {
                if (vsi_stat(out_dsn, "type") == "file")
                    deleted <- deleteDataset(out_dsn)
            }
        }
        if (!deleted) {
            stop("cannot overwrite 'out_layer'", call. = FALSE)
        }
    }

    if (ogr_layer_exists(out_dsn, out_layer)) {
        if (!is.null(lco)) {
            warning("'lco' ignored since the layer already exists",
                    call. = FALSE)
        }
    }

    if (!ogr_ds_exists(out_dsn, with_update = TRUE)) {
        if (is.null(out_fmt))
            out_fmt <- .getOGRformat(out_dsn)
        if (is.null(out_fmt)) {
            cli::cli_alert_danger(
                "format driver cannot be determined for: {.val {out_dsn}}")
            stop("specify 'out_fmt' to create a new dataset", call. = FALSE)
        }
        if (!ogr_ds_create(out_fmt, out_dsn, out_layer, geom_type = "POLYGON",
                           srs = srs, fld_name = fld_name,
                           fld_type = "OFTInteger", dsco= dsco, lco = lco)) {

            stop("failed to create 'out_dsn'", call. = FALSE)
        }
    }

    if (!ogr_layer_exists(out_dsn, out_layer)) {
        res <- ogr_layer_create(out_dsn, out_layer, NULL, "POLYGON", srs, lco)
        if (!res)
            stop("failed to create 'out_layer'", call. = FALSE)
        if (fld_name != "") {
            res <- ogr_field_create(out_dsn, out_layer, fld_name = fld_name,
                                    fld_type = "OFTInteger")
            if (!res)
                stop("failed to create the output field", call. = FALSE)
        }
    }

    return(invisible(.polygonize(raster_file, src_band, out_dsn, out_layer,
                                 fld_name, mask_file, nomask, connectedness,
                                 quiet)))
}


#' Burn vector geometries into a raster
#'
#' @description
#' `rasterize()` burns vector geometries (points, lines, or polygons) into
#' the band(s) of a raster dataset. Vectors are read from any GDAL
#' OGR-supported vector format.
#' This function is a wrapper for the \command{gdal_rasterize} command-line
#' utility (\url{https://gdal.org/en/stable/programs/gdal_rasterize.html}).
#'
#' @param src_dsn Data source name for the input vector layer (filename or
#' connection string).
#' @param dstfile Either a character string giving the filename of the
#' output raster dataset, or an object of class `GDALRaster` for the output.
#' Must support update mode access. If given as a filename, this file will
#' be created (or overwritten if it already exists - see Note).
#' If given as a `GDALRaster` object for an existing dataset, then the affected
#' pixels are updated in-place (object must be open with write access).
#' @param band Numeric vector. The band(s) to burn values into (for existing
#' `dstfile`). The default is to burn into band 1. Not used when creating a
#' new raster.
#' @param layer Character vector of layer names(s) from `src_dsn`  that will be
#' used for input features. At least one layer name or a `sql` option must be
#' specified.
#' @param where An optional SQL WHERE style query string to select features to
#' burn in from the input `layer`(s).
#' @param sql An SQL statement to be evaluated against `src_dsn` to produce a
#' virtual layer of features to be burned in (alternative to `layer`).
#' @param burn_value A fixed numeric value to burn into a band for all
#' features. A numeric vector can be supplied, one burn value per band being
#' written to.
#' @param burn_attr Character string. Name of an attribute field on the
#' features to be used for a burn-in value. The value will be burned into all
#' output bands.
#' @param invert Logical scalar. `TRUE` to invert rasterization. Burn the fixed
#' burn value, or the burn value associated with the first feature, into all
#' parts of the raster not inside the provided polygon.
#' @param te Numeric vector of length four. Sets the output raster extent. The
#' values must be expressed in georeferenced units. If not specified, the
#' extent of the output raster will be the extent of the vector layer.
#' @param tr Numeric vector of length two. Sets the target pixel resolution.
#' The values must be expressed in georeferenced units. Both must be positive.
#' @param tap Logical scalar. (target aligned pixels) Align the coordinates of
#' the extent of the output raster to the values of `tr`, such that the
#' aligned extent includes the minimum extent. Alignment means that
#' xmin / resx, ymin / resy, xmax / resx and ymax / resy are integer values.
#' @param ts Numeric vector of length two. Sets the output raster size in
#' pixels (xsize, ysize). Note that `ts` cannot be used with `tr`.
#' @param dtName Character name of output raster data type, e.g., `Byte`,
#' `UInt8` (GDAL >= 3.13), `Int16`, `UInt16`, `Int32`, `UInt32`, `Float32`,
#' `Float64`. Defaults to `Float64`.
#' @param dstnodata	Numeric scalar. Assign a nodata value to output bands.
#' @param init Numeric vector. Pre-initialize the output raster band(s) with
#' these value(s). However, it is not marked as the nodata value in the output
#' file. If only one value is given, the same value is used in all the bands.
#' @param fmt Output raster format short name (e.g., `"GTiff"`). Will attempt
#' to guess from the output filename if `fmt` is not specified.
#' @param co Optional list of format-specific creation options for the output
#' raster in a vector of "NAME=VALUE" pairs
#' (e.g., \code{options = c("TILED=YES","COMPRESS=LZW")} to set LZW compression
#' during creation of a tiled GTiff file).
#' @param add_options An optional character vector of additional command-line
#' options to `gdal_rasterize` (see the `gdal_rasterize` documentation at the
#' URL above for all available options).
#' @param quiet Logical scalar. If `TRUE`, a progress bar will not be
#' displayed. Defaults to `FALSE`.
#' @returns Logical indicating success (invisible `TRUE`).
#' An error is raised if the operation fails.
#'
#' @note
#' `rasterize()` creates a new target raster when `dstfile` is given as a
#' filename (character string). In that case, some combination of the `fmt`,
#' `dstnodata`, `init`, `co`, `te`, `tr`, `tap`, `ts`, and `dtName` arguments
#' will be used. The resolution or size must be specified using either the `tr`
#' or `ts` argument for all new rasters. The target raster will be overwritten
#' if it already exists and any of these creation-related options are used.
#'
#' To update an existing raster in-place, an object of class `GDALRaster` may
#' be given for the `dstfile` argument. The `GDALRaster` object should be open
#' for write access.
#'
#' @seealso
#' [polygonize()]
#'
#' @examples
#' # MTBS fire perimeters for Yellowstone National Park 1984-2022
#' dsn <- system.file("extdata/ynp_fires_1984_2022.gpkg", package="gdalraster")
#' sql <- "SELECT * FROM mtbs_perims ORDER BY mtbs_perims.ig_year"
#' out_file <- file.path(tempdir(), "ynp_fires_1984_2022.tif")
#'
#' rasterize(src_dsn = dsn,
#'           dstfile = out_file,
#'           sql = sql,
#'           burn_attr = "ig_year",
#'           tr = c(90,90),
#'           tap = TRUE,
#'           dtName = "Int16",
#'           dstnodata = -9999,
#'           init = -9999,
#'           co = c("TILED=YES", "COMPRESS=LZW"))
#'
#' (ds <- new(GDALRaster, out_file))
#'
#' if (requireNamespace("scales")) {
#'   pal <- scales::viridis_pal(end = 0.8, direction = -1)(6)
#'   ramp <- scales::colour_ramp(pal)
#'   plot_raster(ds, legend = TRUE, col_map_fn = ramp, na_col = "#d9d9d9",
#'               main = "YNP Fires 1984-2022 - Most Recent Burn Year")
#' }
#'
#' ds$close()
#' \dontshow{deleteDataset(out_file)}
#' @export
rasterize <- function(src_dsn,
                      dstfile,
                      band = NULL,
                      layer = NULL,
                      where = NULL,
                      sql = NULL,
                      burn_value = NULL,
                      burn_attr = NULL,
                      invert = NULL,
                      te = NULL,
                      tr = NULL,
                      tap = NULL,
                      ts = NULL,
                      dtName = NULL,
                      dstnodata = NULL,
                      init = NULL,
                      fmt = NULL,
                      co = NULL,
                      add_options = NULL,
                      quiet = FALSE) {

    src_dsn <- .check_gdal_filename(src_dsn)

    dst_ds <- NULL
    if (is(dstfile, "Rcpp_GDALRaster")) {
        dst_ds <- dstfile
        if (!dst_ds$isOpen()) {
            stop("destination dataset is not open", call. = FALSE)
        }
    } else if (!(is.character(dstfile) && length(dstfile) == 1)) {
        stop("'dstfile' must be a character string or GDALRaster object",
             call. = FALSE)
    } else {
        dstfile <- .check_gdal_filename(dstfile)
    }

    argv <- character(0)

    if (!is.null(band)) {
        if (!is.numeric(band))
            stop("'band' must be numeric", call. = FALSE)
        for (b in band) {
            argv <- c(argv, "-b", b)
        }
    }

    if (!is.null(layer)) {
        if (!is.character(layer) || length(layer) > 1)
            stop("'layer' must be a length-1 character vector", call. = FALSE)
        for (l in layer) {
            argv <- c(argv, "-l", l)
        }
    }

    if (!is.null(where)) {
        if (is.character(where) && length(where) == 1)
            argv <- c(argv, "-where", where)
        else
            stop("'where' must be a length-1 character vector", call. = FALSE)
    }

    if (!is.null(sql)) {
        if (is.character(sql) && length(sql) == 1)
            argv <- c(argv, "-sql", sql)
        else
            stop("'sql' must be a length-1 character vector", call. = FALSE)
    }

    if (!is.null(burn_value)) {
        if (!is.numeric(burn_value))
            stop("'burn_value' must be numeric", call. = FALSE)
        for (value in burn_value) {
            argv <- c(argv, "-burn", value)
        }
    }

    if (!is.null(burn_attr)) {
        if (is.character(burn_attr) && length(burn_attr) == 1)
            argv <- c(argv, "-a", burn_attr)
        else
            stop("'burn_attr' must be a length-1 character vector",
                 call. = FALSE)
    }

    if (!is.null(invert)) {
        if (is.logical(invert) && length(invert) == 1) {
            if (invert)
                argv <- c(argv, "-i")
        } else {
            stop("'invert' must be a logical scalar", call. = FALSE)
        }
    }

    if (!is.null(te)) {
        if (is.numeric(te) && length(te) == 4)
            argv <- c(argv, "-te", te)
        else
            stop("'te' must be a numeric vector of length 4", call. = FALSE)
    }

    if (!is.null(tr)) {
        if (is.numeric(tr) && length(tr) == 2)
            argv <- c(argv, "-tr", tr)
        else
            stop("'tr' must be a numeric vector of length 2", call. = FALSE)
    }

    if (!is.null(tap)) {
        if (is.logical(tap) && length(tap) == 1) {
            if (tap)
                argv <- c(argv, "-tap")
        } else {
            stop("'tap' must be a logical scalar", call. = FALSE)
        }
    }

    if (!is.null(ts)) {
        if (!is.null(tr))
            stop("'ts' cannot be used with 'tr'", call. = FALSE)
        if (is.numeric(ts) && length(ts) == 2)
            argv <- c(argv, "-ts", ts)
        else
            stop("'ts' must be a numeric vector of length 2", call. = FALSE)
    }

    if (!is.null(dtName)) {
        if (is.character(dtName) && length(dtName) == 1)
            argv <- c(argv, "-ot", dtName)
        else
            stop("'dtName' must be a length-1 character vector",
                 call. = FALSE)
    }

    if (!is.null(dstnodata)) {
        if (is.numeric(dstnodata) && length(dstnodata) == 1)
            argv <- c(argv, "-a_nodata", dstnodata)
        else
            stop("'dstnodata' must be a numeric scalar", call. = FALSE)
    }

    if (!is.null(init)) {
        if (!is.numeric(init))
            stop("'init' must be numeric", call. = FALSE)
        for (value in init) {
            argv <- c(argv, "-init", value)
        }
    }

    if (!is.null(fmt)) {
        if (is.character(fmt) && length(fmt) == 1)
            argv <- c(argv, "-of", fmt)
        else
            stop("'fmt' must be a length-1 character vector",
                 call. = FALSE)
    }

    if (!is.null(co)) {
        if (!is.character(co))
            stop("'co' must be a character vector", call. = FALSE)
        for (name_value in co) {
            argv <- c(argv, "-co", name_value)
        }
    }

    if (!is.null(add_options)) {
        if (!is.character(add_options))
            stop("'add_options' must be a character vector", call. = FALSE)
        else
            argv <- c(argv, add_options)
    }

    if (!is.null(dst_ds)) {
        ret <- .rasterize(src_dsn, "", list(dst_ds), argv, quiet)
    } else {
        ret <- .rasterize(src_dsn, dstfile, list(), argv, quiet)
    }

    return(invisible(ret))
}


#' Read raster data as nativeRaster
#'
#' @description
#' `read_to_nativeRaster()` will read from a raster dataset that is already open
#' in a `GDALRaster` object and return a `nativeRaster` object suitable for fast
#' rendering. By default, it attempts to read the full raster extent at full
#' resolution.
#'
#' @details
#' The dataset must have 1, 3, or 4 bands of Byte/UInt8 data type. For 1-band
#' (grayscale) data, the value is replicated across RGB channels. For 3-band
#' data, bands are interpreted as RGB. For 4-band data, bands are interpreted
#' as RGBA.
#'
#' @param ds An object of class `GDALRaster` in open state, with 1, 3, or 4
#' bands of Byte/UInt8 data type.
#' @param xoff Integer. The pixel (column) offset to the top left corner of the
#' raster region to be read (zero to start from the left side).
#' @param yoff Integer. The line (row) offset to the top left corner of the
#' raster region to be read (zero to start from the top).
#' @param xsize Integer. The width in pixels of the region to be read.
#' @param ysize Integer. The height in pixels of the region to be read.
#' @param out_xsize Integer. The width in pixels of the output buffer into
#' which the desired region will be read (e.g., to read a reduced resolution
#' overview).
#' @param out_ysize Integer. The height in pixels of the output buffer into
#' which the desired region will be read (e.g., to read a reduced resolution
#' overview).
#' @returns An object of class `nativeRaster`.
#'
#' @note
#' By default, this function will attempt to read the full raster into memory.
#' It generally should not be called on large raster datasets using the default
#' argument values. Use `out_xsize` and `out_ysize` for quick setting to smallish values,
#' such as 1024.
#'
#' @seealso
#' [read_ds()], [`GDALRaster$readToNativeRaster()`][GDALRaster]
#'
#' @examples
#' # read an RGB image as nativeRaster
#' img_file <- system.file("help/figures/logo.png", package="survival")
#' if (file.exists(img_file)) {
#' ds <- new(GDALRaster, img_file)
#' r <- read_to_nativeRaster(ds)
#' bb <- ds$bbox()  ## will warn for non-spatial image but is harmless
#' ds$close()
#' plot(NA, xlab = "", ylab = "", asp = 1, xlim = bb[c(1, 3)], ylim = bb[c(2, 4)])
#' rasterImage(r, bb[1], bb[2], bb[3], bb[4])
#' }
#' @export
read_to_nativeRaster <- function(ds, xoff = 0, yoff = 0,
                                 xsize = ds$getRasterXSize(),
                                 ysize = ds$getRasterYSize(),
                                 out_xsize = xsize, out_ysize = ysize) {

  if (!is(ds, "Rcpp_GDALRaster")) {
    stop("'ds' must be an object of class GDALRaster", call. = FALSE)
  }
  if (is.null(xoff) || !(is.numeric(xoff) && length(xoff) == 1)) {
    stop("'xoff' must be a numeric value", call. = FALSE)
  }
  if (is.null(yoff) || !(is.numeric(yoff) && length(yoff) == 1)) {
    stop("'yoff' must be a numeric value", call. = FALSE)
  }
  if (is.null(xsize) || !(is.numeric(xsize) && length(xsize) == 1)) {
    stop("'xsize' must be a numeric value", call. = FALSE)
  }
  if (is.null(ysize) || !(is.numeric(ysize) && length(ysize) == 1)) {
    stop("'ysize' must be a numeric value", call. = FALSE)
  }
  if (is.null(out_xsize) ||
      !(is.numeric(out_xsize) && length(out_xsize) == 1)) {

    stop("'out_xsize' must be a numeric value", call. = FALSE)
  }
  if (is.null(out_ysize) ||
      !(is.numeric(out_ysize) && length(out_ysize) == 1)) {

    stop("'out_ysize' must be a numeric value", call. = FALSE)
  }

  ds$readToNativeRaster(xoff, yoff, xsize, ysize, out_xsize, out_ysize)
}
