Nothing
#' Retrieve the distances between i and j from a 'dist' object.
#'
#' @param x An object of class 'dist'.
#' @param i Either a two column matrix of integer indices or a vector of
#' indices that are paired with the corresponding elements in j.
#' @param j A vector of indices where each element forms a pair with the
#' corresponding element in argument i.
#' @param return_indices Logical indicating whether a three column matrix
#' containing the provided indices (columns 1 and 2) and their corresponding
#' distances (column 3) should be returned. The default behavior is to return
#' a vector of distances.
#'
#' @return A vector giving the distances between the provided indices.
#'
#' @export
#'
#' @examples
#' test <- matrix(rnorm(20), ncol = 2)
#' test_dists <- dist(test)
#' indices <- matrix(sample(1:8),ncol=2)
#' get_dists(test_dists, indices)
get_dists <- function(x, i, j = NULL, return_indices = FALSE){
# Determine whether j was supplied or not.
j_supplied <- !is.null(j)
if(is.null(return_indices)){
stop("return_indices must be TRUE or FALSE.")
}
return_indices <- as.logical(return_indices)[1]
if(is.na(return_indices)){stop("return_indices cannot be NA.")}
# Check that x is a dist object.
if(
is.null(x) ||
!((length(class(x)) == 1) && (class(x) == "dist"))
){
stop(
"
x must be an object of class 'dist'.
"
)
}
# Retrieve the size of x.
size <- attr(x,"Size")
if(is.null(i)){
stop("Argument i cannot be NULL.")
}
# If j is not null then check and merge i and j into a matrix.
if(!is.null(j)){
if(
!(
(length(class(i)) == 1) && (length(class(j)) == 1) &&
((class(i) == "integer") || (class(i) == "numeric")) &&
((class(j) == "integer") || (class(j) == "numeric")) &&
all(as.integer(i) == i) && all(as.integer(j) == j) &&
(length(i) == length(j))
)
){
stop(
"
If both i and j are supplied, then both must be equal length integer or
numeric vectors.
"
)
}else{
# Create a matrix i from vectors i and j.
i <- matrix(c(i,j), ncol = 2)
}
}
# Check that the input indices are valid.
if(
!(
(
(class(i)[1] == "matrix") &&
(class(i[1]) %in% c("numeric","integer")) &&
all(as.integer(i) == i) &&
all((i >= 1) & (i <= size))
)
)
){
if(j_supplied){
stop("Vector arguments i and j must be integers between 1 and
attr(x, 'Size')")
}else{
stop(
"i must be a two column matrix filled with integers between 1 and
attr(x, 'Size'), inclusive"
)
}
}
# Sort the indices within each row.
left_smaller <- i[,1] < i[,2]
right_smaller <- !left_smaller
s <- numeric(nrow(i))
b <- s
s[left_smaller] <- i[left_smaller,1]
s[right_smaller] <- i[right_smaller,2]
b[left_smaller] <- i[left_smaller,2]
b[right_smaller] <- i[right_smaller,1]
# Determine the indices to retrieve.
linear_index <- 0.5*size*(size-1)-0.5*(size-s)*(size-s-1)-(size-b)
# For cases where s == b, ensure that the output gets set to 0. Ensure that
# the output equals the corresponding distance everywhere else.
linear_index[s == b] <- NA
output <- x[linear_index]
output[is.na(output)] <- 0
# Create the final output.
if(return_indices){
output <- matrix(c(s,b,output), ncol = 3)
colnames(output) <- c("Small_Index","Large_Index","Distance")
}
# Return the values.
return(output)
}
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.