# An important internal function that does the work for create_set_spatial_buffer
create_set <- function(exclude_set,sample_list,probability_weights){
while(!all(is.na(unlist(exclude_set)))){
remove <-
sample(x = subset(sample_list,is.na(sample_list)==F),
size = 1,replace = F,prob = subset(probability_weights,is.na(sample_list)==F))
sample_list[remove] <- NA
remove_list <- exclude_set[[remove]]
for(i in 1:length(exclude_set)){
if(any(remove_list%in%exclude_set[[i]])){
exclude_set[[i]] <- exclude_set[[i]][-which(exclude_set[[i]]%in%remove_list)]
}else{}
}
exclude_set[remove_list] <- NA
}
# Return the villages that made it through
return(which(sapply(exclude_set,class)=="integer"))
}
#' Find sets of units that are separated by a minimum distance (spatial buffer).
#' @param distance_matrix A distance matrix (see create_distance_matrix()).
#' @param sims The number of iterations to run in order to find sets.
#' @param threshold The minimum distance one unit should be from another (expressed in same units as distance matrix)
#' @param exclude_set A list of vectors (can be created with find_proximate_units()), each element of the list corresponds to each unit, and contains a vector of all of the units to which that unit is proximate.
#' @return A list of admissable sets of units that meet the spatial criterion.
#' @export
create_set_spatial_buffer <- function(
distance_matrix,threshold,
sims = 1000,
probability_weights = NULL,
exclude_set = NULL,
...){
if(is.null(exclude_set)){
exclude_set <- find_proximate_units(distance_matrix = distance_matrix,
threshold = threshold,...)
}
if(is.null(probability_weights)){
proximity_summary <- sapply(exclude_set,length)
probability_weights <- proximity_summary/sum(proximity_summary)
probability_weights <- probability_weights/sum(probability_weights)
}
sample_list <- 1:dim(distance_matrix)[1]
admissable_sets <-
replicate(n = sims,
expr = create_set(exclude_set = exclude_set,
sample_list = sample_list,
probability_weights = probability_weights))
class(admissable_sets) <- "sample_selection"
return(admissable_sets)
}
environment(create_set_spatial_buffer) <- list2env(list(
create_set = create_set
))
#' For each unit, find the units that are within some distance
#' @param distance_matrix A distance matrix (see create_distance_matrix()).
#' @param threshold The minimum distance one unit should be from another (expressed in same units as distance matrix)
#' @return A list of vectors indicating, for each unit, the units within the spatial threshold.
#' @export
find_proximate_units <- function(distance_matrix,threshold,...) {
adjacency_matrix <-
create_adjacency_matrix(distance_matrix = distance_matrix,
threshold = threshold,
...)
proximate_unit_list <- sapply(1:(dim(adjacency_matrix)[1]),function(i){
which(adjacency_matrix[i,]==1)
})
return(proximate_unit_list)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.