1 #' Generate sample inputs-outputs
3 #' Generate input matrix X of size nxd and binary output of size n, where Y is subdivided
4 #' into K groups of proportions p. Inside one group, the probability law P(Y=1) is
5 #' described by the corresponding column parameter in the matrix β + intercept b.
7 #' @param n Number of individuals
8 #' @param p Vector of K(-1) populations relative proportions (sum (<)= 1)
9 #' @param β Vectors of model parameters for each population, of size dxK
10 #' @param b Vector of intercept values (use rep(0,K) for no intercept)
11 #' @param link Link type; "logit" or "probit"
13 #' @return A list with
15 #' \item{X: the input matrix (size nxd)}
16 #' \item{Y: the output vector (size n)}
17 #' \item{index: the population index (in 1:K) for each row in X}
21 generateSampleIO = function(n, p, β, b, link)
24 tryCatch({n = as.integer(n)}, error=function(e) stop("Cannot convert n to integer"))
26 warning("n is a vector but should be scalar: only first element used")
28 stop("n: positive integer")
29 if (!is.matrix(β) || !is.numeric(β) || any(is.na(β)))
30 stop("β: real matrix, no NAs")
32 if (!is.numeric(p) || length(p)<K-1 || any(is.na(p)) || any(p<0) || sum(p) > 1)
33 stop("p: positive vector of size >= K-1, no NA, sum(<)=1")
36 if (!is.numeric(b) || length(b)!=K || any(is.na(b)))
37 stop("b: real vector of size K, no NA")
39 # Random generation of the size of each population in X~Y (unordered)
40 classes <- rmultinom(1, n, p)
44 id_sigma <- diag(rep(1,d))
45 X <- matrix(nrow=0, ncol=d)
50 index <- c(index, rep(i, classes[i]))
51 newXblock <- MASS::mvrnorm(classes[i], zero_mean, id_sigma)
52 arg_link <- newXblock %*% β[,i] + b[i]
56 e_arg_link = exp(arg_link)
57 e_arg_link / (1 + e_arg_link)
61 probas[is.nan(probas)] = 1 #overflow of exp(x)
62 X <- rbind(X, newXblock)
63 Y <- c( Y, vapply(probas, function(p) (rbinom(1,1,p)), 1) )
66 list("X"=X[shuffle,], "Y"=Y[shuffle], "index"=index[shuffle])