#' Extend select points for the local Gaussian inspections
#'
#' @description This internal function adds diagonally related points
#' to the computation of the local Gaussian (auto- and cross-)
#' correlations. If a point (v1,v2) is present, then this
#' function will ensure that the three points (v1,v1), (v2,v2) and
#' (v2,v1) also will be included in the analysis.
#'
#' @param LG_points The result of the function \code{LG_select_points}.
#'
#' @return An extended version of the array from \code{LG_points} will
#' be returned, with column names "v1" and "v2" and row names
#' which identifies the points of interest (to be used in the
#' argument grids). The returned array has been screened for
#' duplicates, and only contains unique points.
#'
#' @keywords internal
LG_extend_points <- function(LG_points) {
## Sanity check the argument.
if (! LG_default$class$points %in% class(LG_points))
error(.argument = "LG_points",
c("Argument must be created by",
sQuote("LG_select_points"),
"and it must have the class attribute",
sQuote(LG_default$class$points)))
## Extract the attributes from 'LG_points'.
.attributes <- attributes(LG_points)
## Find the on-diagonal points of interest.
.on_diagonal <- local({
.tmp <- sort(union(x = .attributes$Horizontal,
y = .attributes$Vertical))
structure(
.Data = cbind(.tmp, .tmp),
.Dim = c(length(.tmp), 2),
.Dimnames = list(
paste(.tmp, .tmp, sep = "_"),
colnames(LG_points)))
})
## Find the off-diagonal points of interest.
.off_diagonal <- local({
.tmp_reflected <- LG_points[, c(2,1)]
.tmp_all <- rbind(LG_points,
.tmp_reflected)
## Remove points that lies on the diagonal.
.diagonal <- .tmp_all[, 1] == .tmp_all[, 2]
.tmp_all <- .tmp_all[! .diagonal, ]
## Remove duplicates, by exploting the way subsetting by
## names works when duplicates are present.
rownames(.tmp_all) <- paste(.tmp_all[, 1],
.tmp_all[, 2],
sep = "_")
.tmp_all[unique(rownames(.tmp_all)), ]
})
## Combine the results to one array.
.result <- rbind(
.on_diagonal,
.off_diagonal)
## Add attributes needed later on.
attributes(.result) <- c(
attributes(.result),
local({
.select_old <- setdiff(
x = names(.attributes),
y = c("dim", "dimnames"))
.attributes[.select_old]
}),
list(on_diagonal = rownames(.on_diagonal),
off_diagonal = rownames(.off_diagonal)))
## Return the result to the workflow.
.result
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.