#' Function to simulate coordinate and weights data
#'
#' @param n Number of points.
#' @param w_dist_params Parameters for weight distribution.
#' @param coord_dist Distribution for coordinates.
#' @param w_dist Distribution for weights.
#'
#' @return Data.frame of simulated data.
#' @export
simulate_data <- function(n,
w_dist_params = c(1, 100),
coord_dist = "uniform",
w_dist = "uniform") {
x <- switch(
coord_dist,
"uniform" = runif(n),
"normal" = rnorm(n),
"laplace" = rmutil::rlaplace(n)
)
y <- switch(
coord_dist,
"uniform" = runif(n),
"normal" = rnorm(n),
"laplace" = rmutil::rlaplace(n)
)
w <- switch(
w_dist,
"uniform" = floor(runif(n, min = w_dist_params[1], max = w_dist_params[2] + 1)),
"normal" = c(round(
rnorm(n, mean = w_dist_params[1], sd = w_dist_params[2])
)))
w <- ifelse(
w > 0,
w,
floor(
runif(n, min = 1, max = quantile(w, probs = c(0.25))
)))
return(tibble::tibble(
id = 1:n,
x = x,
y = y,
w = w
))
}
#' Simulates random sigma for the normal and laplace distribution.
#'
#' @param no_corr Is there correlation between x and y?
#' @return Covariance matrix.
#' @export
random_sigma <- function(no_corr = TRUE) {
if (no_corr) {
r_diag <- runif(1, min = 1, max = 1.5)
Sigma <- diag(x = rep(r_diag, 2))
} else {
A <- matrix(runif(4, min = 0.1, max = 0.8),
ncol = 2,
nrow = 2)
Sigma <- t(A) %*% A
Sigma[1, 1] <- Sigma[1, 1] + runif(1)
Sigma[2, 2] <- Sigma[2, 2] + runif(1)
}
return(Sigma)
}
#' Simulate from normal mixture distribution.
#'
#' @param n Total number of points simulated.
#' @param k Number of different normals.
#' @param w_dist_params Parameters for weight distribution
#' @param w_dist Distribution for weights.
#'
#' @return Data.frame of simulated data.
#' @export
simulate_normal_mixture <- function(n,
k,
w_dist_params = c(1, 100),
w_dist = "uniform") {
n_sub <- round(n / k)
# Mus for the normal distributions
mu <- matrix(runif(2 * k, min = -10, max = 10),
ncol = 2,
nrow = k)
# Sigmas for the normal distributions
coords <- MASS::mvrnorm(n = n_sub,
mu = mu[1, ],
Sigma = random_sigma())
orig_group <- rep(1, n_sub)
for (i in 2:k) {
coords <- rbind(coords,
MASS::mvrnorm(
n = n_sub,
mu = mu[i, ],
Sigma = random_sigma()
))
orig_group <- c(orig_group, rep(i, n_sub))
}
# Weights
w <- floor(runif(n, min = w_dist_params[1], max = w_dist_params[2] + 1))
return(tibble::tibble(
id = 1:length(coords[, 1]),
x = coords[, 1],
y = coords[, 2],
w = w,
orig_group = as.factor(orig_group)
))
}
#' Simulate from Laplace mixture distribution.
#'
#' @param n Total number of points simulated.
#' @param k Number of different normals.
#' @param w_dist_params Parameters for weight distribution
#' @param w_dist Distribution for weights.
#'
#' @return Data.frame of simulated data.
#' @export
simulate_laplace_mixture <-
function(n,
k,
w_dist_params = c(1, 100),
w_dist = "uniform") {
n_sub <- round(n / k)
# Mus for the normal distributions
mu <- matrix(runif(2 * k, min = -10, max = 10),
ncol = 2,
nrow = k)
# Sigmas for the normal distributions
coords <- LaplacesDemon::rmvl(n = n_sub,
mu = mu[1, ],
Sigma = random_sigma())
orig_group <- rep(1, n_sub)
for (i in 2:k) {
coords <- rbind(coords,
LaplacesDemon::rmvl(
n = n_sub,
mu = mu[i, ],
Sigma = random_sigma()
))
orig_group <- c(orig_group, rep(i, n_sub))
}
# Weights
w <- floor(runif(n, min = w_dist_params[1], max = w_dist_params[2] + 1))
return(tibble::tibble(
x = coords[, 1],
y = coords[, 2],
w = w,
orig_group = as.factor(orig_group)
))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.