R/utils.R

In lucas-castillo/SampleR: Tools To Compare Human Performance To Sampling Algorithms

#' Euclidean Distance Calculator
#'
#' Calculates the distance between two points. If instead given two matrices A and B of size n x d, for n number of items of d dimensions each, it will return an n - 1 length vector with the distances between each of the items (i.e. the distance between the item A\[1,\] and B\[1,\]; between A\[2,\] and B\[2,\], and so on).
#'
#'
#'
#' It assumes that all dimensions have the same units or that all dimensions are normalized (mean = 0 and std = 1). Adapted from [here](https://hlab.stanford.edu/brian/euclidean_distance_in.html)
#'
#' @param x,y Vector or Matrix. If vector of length d, a d-dimensional point. If matrix of size n x d, n points of d dimensions.
#'
#' @return Numeric or Vector. Distance between points. If vector, distances between the ith points in the matrices.
#'
#' @export
#'
#' @examples
#' # distance between two points
#' euc_d(c(0,0), c(3,4))
#'
#' # ask for multiple distances
#' M <- matrix(0, nrow = 3, ncol = 2)
#' M2 <- matrix(0, nrow = 3, ncol = 2)
#' for (i in 1:3){
#'   M[i,] <- stats::runif(2) * 5
#'   M2[i,] <- stats::runif(2) * 5
#' }
#'euc_d(M, M2)
euc_d <- function(x,y){
  euclidean_distance <- function(a,b){
    counter = 0
    for (i in 1:length(a)){
      counter <- counter + (a[i] - b[i]) ** 2
    }
    return(sqrt(counter))
  }

  if (!(is.matrix(x) & is.matrix(y)) & !(is.vector(x) & is.vector(y))){
    warning("The two items must be both vectors or matrices")
    return()
  }
  if (is.vector(x)){
    if (length(x) != length(y)){
      warning("The two points must have the same dimensions")
    } else {
      return(euclidean_distance(x,y))
    }
  } else {
    if (ncol(x) != ncol(y)){
      warning("The two matrices must have the same number of columns, representing each of the dimensions of the points they contain")
    } else{
      distances <- vector()
      for (i in 1:min(nrow(x),nrow(y))){
        distances[i] <- euclidean_distance(x[i,], y[i,])
      }
      if (nrow(x) != nrow(y)){
        warning(paste("Because the matrices have uneven number of rows, only the distances for the first",min(nrow(x),nrow(y)),"rows were done"))
      }
      return(distances)
    }
  }

  #

}

#' Change Calculator
#'
#' Given a one-dimensional chain, it returns a 1d chain of step sizes and direction (e.g. given a chain \[1,4,1\], it returns \[3, -3\])
#'
#' @param X one-dimensional chain.
#'
#' @return one-dimensional chain of step sizes
#' @export
#'
#' @examples
#' chain <- stats::runif(10, 1, 10)
#' change_1d(chain)
change_1d <- function(X){
  if (length(X) > 1){
    return(X[2:length(X)] - X[1:(length(X)-1)])
  } else{
        warning("X must be longer than 1")
  }
}


#' Make pdf (from distr)
#'
#' Given a distr distribution, it returns a probability density function as used by the sampler functions of the current package
#'
#' @param distrib Distr6 distribution
#'
#' @return
#' @export
#'
#' @examples
#' distribution <- distr::Norm()
#' density_function <- make_distr_pdf(distribution)
make_distr_pdf <- function(distrib){
  pdf_func <- function(x, log=FALSE){return(distr::d(distrib)(x, log=log))}
}

#' Make pdf (from distr6)
#'
#' Given a distr6 distribution, it returns a probability density function as used by the sampler functions of the current package
#' @param distrib Distr6 distribution
#'
#' @return
#' @export
#'
#' @examples
#' distribution <- distr6::Normal$new()
#' density_function <- make_distr6_pdf(distribution)
make_distr6_pdf <- function(distrib){
  pdf <- function(x, log=FALSE){
    distrib$pdf(log=log, data=matrix(x, nrow=1))
  }
}