Nothing
# Internal functions
prepdata <- function(knownpts, unknownpts, matdist, bypassctrl, longlat, mask,
resolution){
if(is(knownpts, "Spatial")){knownpts <- st_as_sf(knownpts)}
if (!missing(unknownpts)){
if(is(unknownpts, "Spatial")){unknownpts <- st_as_sf(unknownpts)}
if (!missing(matdist)){
matdist <- UseDistMatrix(matdist = matdist, knownpts = knownpts,
unknownpts = unknownpts)
}else{
matdist <- CreateDistMatrix(knownpts = knownpts, unknownpts = unknownpts,
bypassctrl = bypassctrl, longlat = longlat)
}
}else{
if(missing(mask)){
mask <- knownpts
} else {
if(is(mask, "Spatial")){unknownpts <- st_as_sf(mask)}
}
unknownpts <- CreateGrid(w = mask, resolution = resolution,
returnclass = "sf")
matdist <- CreateDistMatrix(knownpts = knownpts, unknownpts = unknownpts,
bypassctrl = bypassctrl, longlat = longlat)
}
return(list(knownpts=knownpts, unknownpts = unknownpts, matdist = matdist))
}
UseDistMatrix <- function(matdist, knownpts, unknownpts){
i <- factor(row.names(knownpts), levels = row.names(knownpts))
j <- factor(row.names(unknownpts), levels = row.names(unknownpts))
matdist <- matdist[levels(i), levels(j)]
return(round(matdist, digits = 8))
}
ComputeInteractDensity <- function(matdist, typefct, beta, span)
{
if(typefct == "pareto") {
alpha <- (2 ^ (1 / beta) - 1) / span
matDens <- (1 + alpha * matdist) ^ (-beta)
} else if(typefct == "exponential") {
alpha <- log(2) / span ^ beta
matDens <- exp(- alpha * matdist ^ beta)
} else {
stop("Please choose a valid interaction function argument (typefct)")
}
matDens <- round(matDens, digits = 8)
return(matDens)
}
ComputeOpportunity <- function(knownpts, matdens, varname = varname)
{
matOpport <- knownpts[[varname]] * matdens
return(round(matOpport, digits = 8))
}
ComputePotentials <- function(unknownpts, matopport)
{
unknownpts$OUTPUT <- apply(matopport, 2, sum, na.rm = TRUE)
return(unknownpts)
}
ComputeReilly <- function(unknownpts, matopport)
{
unknownpts$OUTPUT <- row.names(matopport)[apply(matopport, 2, which.max)]
return(unknownpts)
}
ComputeHuff <- function(unknownpts, matopport)
{
sumCol <- colSums(x = matopport, na.rm = TRUE)
matOpportPct <- 100 * t(t(matopport) / sumCol)
matOpportPct[is.na(matOpportPct) | is.infinite(matOpportPct)] <- 0
unknownpts$OUTPUT <- apply(matOpportPct, 2, max, na.rm = TRUE)
return(unknownpts)
}
ComputeSmooth<- function(unknownpts, matopport, matdens)
{
unknownpts$OUTPUT <- apply(matopport, 2, sum, na.rm = TRUE) /
colSums(matdens, na.rm = TRUE)
return(unknownpts)
}
projError <- function(x,y){
if(identicalCRS(x,y) == FALSE){
stop("Inputs do not use the same coordinate reference system.",
call. = FALSE)
}
}
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.