simulate.R 3.74 KB
 Eric Coissac committed Jan 24, 2019 1 2 #' Simulate n points of dimension p. #'  Eric Coissac committed Sep 12, 2019 3 4 5 6 7 8 9 #' Points are simulated by drawing values of each dimension from a normal #' distribution of mean 0 and standard deviation equals to 1. #' The mean of each dimension is forced to 0 (data are centred). #' By default variable are also scaled to enforce a strandard deviation #' strictly equal to 1. Covariances between dimensions are not controled. #' Therefore they are expected to be equal to 0 and reflect only the #' random distribution of the covariance between two random vectors.  Eric Coissac committed Jan 24, 2019 10 #'  Eric Coissac committed Sep 12, 2019 11 12 13 #' @param n an \code{int} value indicating the number of observations. #' @param p an \code{int} value indicating the number of dimensions (variables) #' simulated  Eric Coissac committed Oct 01, 2019 14 #' @param equal_var a \code{logical} value indicating if the dimensions must be scaled  Eric Coissac committed Sep 12, 2019 15 16 17 18 19 #' to force \code{sd=1}. \code{TRUE} by default. #' #' @return a numeric matrix of \code{n} rows and \code{p} columns #' #' @examples  Eric Coissac committed Oct 15, 2019 20 #' sim1 <- simulate_matrix(25,10)  Eric Coissac committed Sep 12, 2019 21 22 23 24 25 #' class(sim1) #' dim(sim1) #' #' @author Eric Coissac #' @author Christelle Gonindard-Melodelima  Eric Coissac committed Jan 24, 2019 26 #' @export  Eric Coissac committed Oct 15, 2019 27 simulate_matrix <- function(n, p, equal_var = TRUE) {  Eric Coissac committed Apr 30, 2019 28 29  new <- rnorm(n * p, mean = 0, sd = 1) dim(new) <- c(n, p)  Eric Coissac committed Jan 24, 2019 30   Eric Coissac committed Oct 01, 2019 31  new <- scale(new, center = TRUE, scale = equal_var)  Eric Coissac committed Jan 24, 2019 32   Eric Coissac committed Apr 30, 2019 33 34 35  attributes(new)$scaled:center <- NULL attributes(new)$scaled:scale <- NULL new.sd <- sqrt(sum(new^2) / (n - 1))  Eric Coissac committed Oct 15, 2019 36  new / new.sd  Eric Coissac committed Jan 24, 2019 37 38 }  Eric Coissac committed Oct 15, 2019 39 #' Simulate n points of dimension p correlated to a reference matrix.  Eric Coissac committed Jan 24, 2019 40 #'  Eric Coissac committed Sep 12, 2019 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 #' Simulates a set of point correlated to another set according to the #' procrustean correlation definition. #' Points are simulated by drawing values of each dimension from a normal #' distribution of mean 0 and standard deviation equals to 1. #' The mean of each dimension is forced to 0 (data are centred). #' By default variable are also scaled to enforce a strandard deviation #' strictly equal to 1. Covariances between dimensions are not controled. #' Therefore they are expected to be equal to 0 and reflect only the #' random distribution of the covariance between two random vectors. #' The intensity of the correlation is determined by the \code{r2} #' parameter. #' #' @param reference a numeric matrix to which the simulated data will be correlated #' @param p an \code{int} value indicating the number of dimensions (variables) #' simulated #' @param r2 the fraction of variation shared between the \code{reference} and the #' simulated data  Eric Coissac committed Oct 01, 2019 58 #' @param equal_var a \code{logical} value indicating if the dimensions must be scaled  Eric Coissac committed Sep 12, 2019 59 60 61 62 63 #' to force \code{sd=1}. \code{TRUE} by default. #' #' @return a numeric matrix of \code{nrow(reference)} rows and \code{p} columns #' #' @examples  Eric Coissac committed Oct 16, 2019 64 #' sim1 <- simulate_matrix(25,10)  Eric Coissac committed Sep 12, 2019 65 66 #' class(sim1) #' dim(sim1)  Eric Coissac committed Oct 16, 2019 67 #' sim2 <- simulate_correlation(sim1,20,0.8)  Eric Coissac committed Sep 12, 2019 68 69 70 71 #' corls(sim1, sim2)^2 #' #' @author Eric Coissac #' @author Christelle Gonindard-Melodelima  Eric Coissac committed Jan 24, 2019 72 #' @export  Eric Coissac committed May 27, 2019 73   Eric Coissac committed Oct 01, 2019 74 simulate_correlation <- function(reference, p, r2, equal_var = TRUE) {  Eric Coissac committed Apr 30, 2019 75 76  n <- nrow(reference) maxdim <- max(ncol(reference), p)  Eric Coissac committed Jan 24, 2019 77   Eric Coissac committed Oct 15, 2019 78  noise <- simulate_matrix(n, p, equal_var = equal_var)  Eric Coissac committed Jan 24, 2019 79 80  if (maxdim == p && maxdim > ncol(reference)) {  Eric Coissac committed May 27, 2019 81 82 83 84 85  # noise is the largest matrix YX <- crossprod(noise, reference) svd.YX <- svd(YX) rot <- svd.YX$v %*% t(svd.YX$u) rotr <- svd.YX$u %*% t(svd.YX$v)  Eric Coissac committed Jan 24, 2019 86   Eric Coissac committed May 27, 2019 87 88 89 90 91 92 93 94 95  new = ((reference %*% rot) * sqrt(r2) + noise * sqrt(1 - r2)) %*% rotr } else { # reference is the largest matrix YX <- crossprod(reference, noise) svd.YX <- svd(YX) rot <- svd.YX$v %*% t(svd.YX$u) rotr <- svd.YX$u %*% t(svd.YX$v)  Eric Coissac committed Jan 24, 2019 96   Eric Coissac committed May 27, 2019 97 98  new = (reference * sqrt(r2) + (noise %*% rot) * sqrt(1 - r2)) %*% rotr  Eric Coissac committed Apr 30, 2019 99  }  Eric Coissac committed Jan 24, 2019 100   Eric Coissac committed Apr 30, 2019 101 102 103  new <- scale(new, scale = FALSE) attributes(new)\$scaled:center <- NULL new.sd <- sqrt(sum(new^2) / (n - 1))  Eric Coissac committed Oct 15, 2019 104  new / new.sd  Eric Coissac committed Jan 24, 2019 105 106 }  Eric Coissac committed Oct 15, 2019 107 #simulate_matrix_tree