Nothing
#'@title Adjusted actual values
#'
#'@description Adjusts actual presence/absence data based on the autocorrelation
#'in the predictions of a model. The function will optionally plot results of
#'model predictions, un-modified actual presence/absence, and adjusted values.
#'
#'@param data a dataframe or matrix containing actual presence/absence (binary,
#'0 or 1) values in 1st column and predicted values (numeric between 0 and 1)
#'in 2nd column.
#'@param coord a matrix of two columns of the same length providing integer,
#'consecutively numbered coordinates for each occurrence and prediction in
#'\code{data}.
#'@param plot.maps A logical indicating whether maps should be plotted.
#'Default is FALSE.
#' @param color.maps A logical value. If \code{TRUE}, produces colorful maps.
#' If \code{FALSE}, produces grayscale maps. Default is grayscale. NOW DEPRECATED,
#' color maps will not be produced in future versions.
#'
#'@return A vector of adjusted actual values.
#'
#'@author Gudrun Carl
#'
#'@examples
#'data(hook)
#'data <- hook[ ,1:2]
#'coord <- hook[ ,3:4]
#'aa <- adjusted.actuals(data, coord, plot.maps = TRUE)
#'
#'@importFrom lattice trellis.par.get levelplot trellis.par.set
#'@importFrom grDevices gray
#'@importFrom stats dist
#'
#'@export
adjusted.actuals<-function(data, coord, plot.maps = FALSE, color.maps = FALSE){
x <- coord[ ,1]
y <- coord[ ,2]
fb <- data[ ,1]
fa <- data[ ,2]
if(length(x) != length(fa)){
stop("coordinates and data have different dimensions")
}
logic1 <- identical(as.numeric(x), round(x, 0))
logic2 <- identical(as.numeric(y), round(y, 0))
if(!logic1 | !logic2) stop("coordinates not integer")
fbs <- fb
ac01a <- acfft(coord, fa, lim1 = 0, lim2 = 1, dmax = 1)
ac01b <- acfft(coord, fb, lim1 = 0, lim2 = 1, dmax = 1)
if(ac01a > 0.05 & ac01b > 0.05){
ac01 <- ac01a - ac01b
if(ac01 > 0.02){
alpha <- ac01
D <- as.matrix(stats::dist(coord))
R <- alpha^D
spatial.W <- R^3
ac01s <- acfft(coord, fbs, lim1 = 0, lim2 = 1, dmax = 1)
while(ac01a > ac01s){
fbs <- spatial.W %*% fbs
ac01s <- acfft(coord, fbs, lim1 = 0, lim2 = 1, dmax = 1)
}
fbs <- fbs - min(fbs)
fbs <- fbs / max(fbs)
}
}
if (plot.maps){
if(color.maps){
colours <- list(
colorRampPalette(RColorBrewer::brewer.pal(10, 'Spectral'))(50)
)
warning('"color.maps" is now soft deprecated and will be removed in future versions')
} else {
colours <- list(rev(grDevices::gray((0:45)/50)))
}
a <- lattice::levelplot(fa ~ x + y,
col.regions = colours[[1]],
colorkey = FALSE,
scales = list(draw = FALSE),
xlab = "", ylab = "",
main = "predictions")
b <- lattice::levelplot(fb ~ x + y,
col.regions = colours[[1]],
colorkey = FALSE,
scales = list(draw = FALSE),
xlab = "", ylab = "",
main = "actuals")
c <- lattice::levelplot(fbs ~ x + y,
col.regions = colours[[1]],
colorkey = list(space = "bottom"),
scales = list(draw = FALSE),
xlab = "", ylab = "",
main = "adjusted actuals")
tp <- lattice::trellis.par.get()
lattice::trellis.par.set(list(axis.line = list(col = "transparent")))
print(a, position = c(0.1, 0.09, 0.92, 0.98),
split = c(1, 1, 2, 2), more = TRUE)
print(b, position = c(0.12, 0.09, 0.94, 0.98),
split = c(2, 1, 2, 2), more = TRUE)
print(c, position = c(0.12, 0, 0.94, 1.02),
split = c(2, 2, 2, 2), more = FALSE)
} # plot
fbs <- as.vector(fbs)
return(fbs)
}
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.