R/sampling_functions.R

In spinebil: Investigating New Projection Pursuit Index Functions

#' Generating a sample of points on a pipe
#'
#' Points are drawn from a uniform distribution between -1 and 1,
#' the pipe structure is generated by rejecting points if they are
#' not on a circle with radius 1 and thickness t in the last two parameters.
#'
#' @param p sample dimensionality
#' @param n number of sample points to generate
#' @param t thickness of circle, default=0.1
#' @return sample points in tibble format
#' @export
#' @examples
#' pipe_data(100, 4)
#' pipe_data(100, 2, 0.5)
pipe_data <- function(n, p, t=0.1){
  i <- 1
  dRet <- NULL
  while(i <= n){
    v <- stats::runif(p, -1, 1)
    if(abs(v[p-1]*v[p-1] + v[p]*v[p] - 1) < t){
      dRet <- rbind(dRet, v)
      i <- i+1
    }
  }
  colnames(dRet) <- paste0("V", seq_len(p))
  dRet[,1:2] <- apply(dRet[,1:2], 2, function(x) (x-mean(x)/stats::sd(x)))
  return(tibble::as_tibble(dRet, .name_repair = "universal"))
}

#' Generating sine wave sample
#'
#' n-1 points are drawn from a normal distribution with mean=0, sd=1,
#' the points in the final direction are calculated as the sine of the
#' values of direction n-1 with additional jittering controled by
#' the jitter factor f.
#'
#' @param p sample dimensionality
#' @param n number of sample points to generate
#' @param f jitter factor, default=1
#' @return sample points in tibble format
#' @export
#' @examples
#' sin_data(100, 4)
#' sin_data(100, 2, 200)
sin_data <- function(n, p, f=1){
  m <- matrix(stats::rnorm((n)*p), ncol=(p))
  m[,p] <- jitter(sin(m[,p-1]), factor = f)
  colnames(m) <- paste0("V", seq_len(p))
  m[,1:2] <- apply(m[,1:2], 2, function(x) (x-mean(x)/stats::sd(x)))
  dRet <- tibble::as_tibble(m) #generate normal distributed n-1 dim data
  return(dRet)
}

#' Generating spiral sample
#'
#' n-2 points are drawn from a normal distribution with mean=0, sd=1,
#' the points in the final two direction are sampled along a spiral
#' by samping the angle from a normal distribution with mean=0, sd=2*pi
#' (absolute values are used to fix the orientation of the spiral).
#'
#' @param n number of sample points to generate
#' @param p sample dimensionality
#' @return sample points in matrix format
#' @export
#' @examples
#' spiral_data(100, 4)
spiral_data <- function(n , p){
  i <- 1
  a <- 0.1
  b <- 0.1
  dRet <- NULL
  while(i <= n){
    v <- stats::rnorm(p-2)
    theta <- abs(stats::rnorm(1,0,2*pi))
    r <- a + b * theta
    x <- r * cos(theta)
    y <- r * sin(theta)
    v <- c(v, x, y)
    dRet <- rbind(dRet, v)
    i <- i+1
  }
  colnames(dRet) <- paste0("V", seq_len(p))
  dRet[,1:2] <- apply(dRet[,1:2], 2, function(x) (x-mean(x)/stats::sd(x)))
  tibble::as_tibble(dRet)
}