R/samplingFunctions.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 n sample dimensionality
#' @param p number of sample points to generate
#' @param t thickness of circle, default=0.1
#' @return sample points in tibble format
#' @export
#' @examples
#' pipeData(4, 100)
#' pipeData(2, 100, 0.5)
pipeData <- function(n, p, t=0.1){
  i <- 1
  dRet <- NULL
  while(i <= p){
    v <- stats::runif(n, -1, 1)
    if(abs(v[n-1]*v[n-1] + v[n]*v[n] - 1) < t){
      dRet <- rbind(dRet, v)
      i <- i+1
    }
  }
  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 n sample dimensionality
#' @param p number of sample points to generate
#' @param f jitter factor, default=1
#' @return sample points in tibble format
#' @export
#' @examples
#' sinData(4, 100)
#' sinData(2, 100, 200)
sinData <- function(n, p, f=1){
  m <- matrix(stats::rnorm((n)*p), ncol=(n))
  m[,n] <- jitter(sin(m[,n-1]), factor = f)
  dRet <- tibble::as_tibble(m, .name_repair = "universal") #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 sample dimensionality
#' @param p number of sample points to generate
#' @return sample points in matrix format
#' @export
#' @examples
#' spiralData(4, 100)
spiralData <- function(n, p){
  i <- 1
  a <- 0.1
  b <- 0.1
  dRet <- NULL
  while(i <= p){
    v <- stats::rnorm(n-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
  }
  return(dRet)
}