Nothing
#' Fit a trend surface to sky digital numbers
#'
#' Fit a trend surface using [spatial::surf.ls()] as workhorse function.
#'
#' This function is meant to be used after [fit_coneshaped_model()].
#'
#' This method was presented in \insertCite{Diaz2018;textual}{rcaiman}, under
#' the heading *Estimation of the sky DN as a previous step for our method*. If
#' you use this function in your research, please cite that paper in addition to
#' this package (`citation("rcaiman"`).
#'
#'
#' @inheritParams ootb_mblt
#' @param filling_source [SpatRaster-class]. An actual or reconstructed
#' above-canopy image to complement the sky pixels detected through the gaps
#' of `r`. A photograph taken immediately after or before taking `r` under the
#' open sky with the same equipment and configuration is a very good option
#' but not recommended under fleeting clouds. The orientation relative to the
#' North must be the same as for `r`. If it is set to `NULL` (default), only
#' sky pixels from `r` will be used as input.
#' @inheritParams spatial::surf.ls
#'
#' @note If an incomplete above-canopy image is available as filling source,
#' non-sky pixels should be turned `NA` or they will be erroneously considered
#' as sky pixels.
#'
#' @return A list with an object of class [SpatRaster-class] and of class `trls`
#' (see [spatial::surf.ls()]).
#' @export
#'
#' @family Sky Reconstruction Functions
#' @seealso [thr_mblt()]
#'
#' @references \insertAllCited{}
#'
#' @examples
#' \dontrun{
#' caim <- read_caim()
#' r <- caim$Blue
#' caim <- normalize(caim, 0, 20847, TRUE)
#' z <- zenith_image(ncol(caim), lens())
#' a <- azimuth_image(z)
#' m <- !is.na(z)
#'
#' bin <- ootb_obia(caim, z, a, m, HSV(239, 0.85, 0.5), gamma = NULL)
#'
#' g <- sky_grid_segmentation(z, a, 10)
#' sky_points <- extract_sky_points(r, bin, g, dist_to_plant = 5)
#' plot(bin)
#' points(sky_points$col, nrow(caim) - sky_points$row, col = 2, pch = 10)
#' rl <- extract_rl(r, z, a, sky_points)
#'
#' model <- fit_coneshaped_model(rl$sky_points)
#' summary(model$model)
#' sky_cs <- model$fun(z, a)
#' persp(terra::aggregate(sky_cs, 10), theta = 90, phi = 45)
#'
#' sky_s <- fit_trend_surface(r, z, a, bin, sky_cs)
#' persp(terra::aggregate(sky_s$image, 10), theta = 90, phi = 45)
#' }
fit_trend_surface <- function(r,
z,
a,
bin,
filling_source = NULL,
np = 6) {
.check_if_r_z_and_a_are_ok(r, z, a)
.is_single_layer_raster(bin, "bin")
.is_logic_and_NA_free(bin, "bin")
terra::compareGeom(bin, r)
if (!is.null(filling_source)) {
.is_single_layer_raster(filling_source, "filling_source")
terra::compareGeom(r, filling_source)
}
stopifnot(length(np) == 1)
r[!bin] <- NA
if (!is.null(filling_source)) {
terra::compareGeom(bin, filling_source)
r <- terra::cover(r, filling_source)
}
.fit_trend_surface <- function(x, np) {
tmp <- data.frame(
terra::xFromCell(x, 1:ncell(x)),
terra::yFromCell(x, 1:ncell(x)),
terra::values(x)
) %>%
.[!is.na(.[,3]), ]
colnames(tmp) <- c("x", "y", names(x))
fit <- spatial::surf.ls(x = tmp[, 1], y = tmp[, 2], z = tmp[, 3], np)
xl <- xmin(x)
xu <- xmax(x)
yl <- ymin(x)
yu <- ymax(x)
out <- spatial::trmat(fit, xl, xu, yl, yu, ncol(x))
out <- terra::rast(out$z) %>% t %>% flip
crs(out) <- crs(x)
terra::ext(out) <- terra::ext(x)
out <- terra::resample(out, x)
list(image = out, model = fit)
}
out <- .fit_trend_surface(r, np)
out$image[is.na(z)] <- NA
out
}
# pano = FALSE
# if (pano) {
# r[!bin] <- filling_source[!bin]
# angle_width <- 5
# r <- fisheye_to_pano(r, z, a, angle_width = angle_width)
# out <- .fit_trend_surface(r, np)
# image <- out$image
# .a <- .z <- r
# terra::values(.a) <- .col(dim(r)[1:2])
# terra::values(.z) <- .row(dim(r)[1:2])
# g <- sky_grid_segmentation(z, a, angle_width)
# cells <- 1:terra::ncell(image)
# fun <- function(s, r) s * 1000 + r
# .labels <- fun(.a[cells], .z[cells])
# image <- terra::subst(g, .labels, image[cells])
# out$image <- image
# } else {
# out <- .fit_trend_surface(r, np)
# }
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.