gofar_sim | R Documentation |
Genertate random samples from a generalize sparse factor regression model
gofar_sim(U, D, V, n, Xsigma, C0, familygroup, snr)
U |
specified value of U |
D |
specified value of D |
V |
specified value of V |
n |
sample size |
Xsigma |
covariance matrix for generating sample of X |
C0 |
Specified coefficient matrix with first row being intercept |
familygroup |
index set of the type of multivariate outcomes: "1" for Gaussian, "2" for Bernoulli, "3" for Poisson outcomes |
snr |
signal to noise ratio specified for gaussian type outcomes |
Y |
Generated response matrix |
X |
Generated predictor matrix |
sigmaG |
standard deviation for gaussian error |
Mishra, Aditya, Dipak K. Dey, Yong Chen, and Kun Chen. Generalized co-sparse factor regression. Computational Statistics & Data Analysis 157 (2021): 107127
## Model specification: SD <- 123 set.seed(SD) n <- 200 p <- 100 pz <- 0 # Model I in the paper # n <- 200; p <- 300; pz <- 0 ; # Model II in the paper # q1 <- 0; q2 <- 30; q3 <- 0 # Similar response cases q1 <- 15 q2 <- 15 q3 <- 0 # mixed response cases nrank <- 3 # true rank rank.est <- 4 # estimated rank nlam <- 40 # number of tuning parameter s <- 1 # multiplying factor to singular value snr <- 0.25 # SNR for variance Gaussian error # q <- q1 + q2 + q3 respFamily <- c("gaussian", "binomial", "poisson") family <- list(gaussian(), binomial(), poisson()) familygroup <- c(rep(1, q1), rep(2, q2), rep(3, q3)) cfamily <- unique(familygroup) nfamily <- length(cfamily) # control <- gofar_control() # # ## Generate data D <- rep(0, nrank) V <- matrix(0, ncol = nrank, nrow = q) U <- matrix(0, ncol = nrank, nrow = p) # U[, 1] <- c(sample(c(1, -1), 8, replace = TRUE), rep(0, p - 8)) U[, 2] <- c(rep(0, 5), sample(c(1, -1), 9, replace = TRUE), rep(0, p - 14)) U[, 3] <- c(rep(0, 11), sample(c(1, -1), 9, replace = TRUE), rep(0, p - 20)) # if (nfamily == 1) { # for similar type response type setting V[, 1] <- c(rep(0, 8), sample(c(1, -1), 8, replace = TRUE ) * runif(8, 0.3, 1), rep(0, q - 16)) V[, 2] <- c(rep(0, 20), sample(c(1, -1), 8, replace = TRUE ) * runif(8, 0.3, 1), rep(0, q - 28)) V[, 3] <- c( sample(c(1, -1), 5, replace = TRUE) * runif(5, 0.3, 1), rep(0, 23), sample(c(1, -1), 2, replace = TRUE) * runif(2, 0.3, 1), rep(0, q - 30) ) } else { # for mixed type response setting # V is generated such that joint learning can be emphasised V1 <- matrix(0, ncol = nrank, nrow = q / 2) V1[, 1] <- c(sample(c(1, -1), 5, replace = TRUE), rep(0, q / 2 - 5)) V1[, 2] <- c( rep(0, 3), V1[4, 1], -1 * V1[5, 1], sample(c(1, -1), 3, replace = TRUE), rep(0, q / 2 - 8) ) V1[, 3] <- c( V1[1, 1], -1 * V1[2, 1], rep(0, 4), V1[7, 2], -1 * V1[8, 2], sample(c(1, -1), 2, replace = TRUE), rep(0, q / 2 - 10) ) # V2 <- matrix(0, ncol = nrank, nrow = q / 2) V2[, 1] <- c(sample(c(1, -1), 5, replace = TRUE), rep(0, q / 2 - 5)) V2[, 2] <- c( rep(0, 3), V2[4, 1], -1 * V2[5, 1], sample(c(1, -1), 3, replace = TRUE), rep(0, q / 2 - 8) ) V2[, 3] <- c( V2[1, 1], -1 * V2[2, 1], rep(0, 4), V2[7, 2], -1 * V2[8, 2], sample(c(1, -1), 2, replace = TRUE), rep(0, q / 2 - 10) ) # V <- rbind(V1, V2) } U[, 1:3] <- apply(U[, 1:3], 2, function(x) x / sqrt(sum(x^2))) V[, 1:3] <- apply(V[, 1:3], 2, function(x) x / sqrt(sum(x^2))) # D <- s * c(4, 6, 5) # signal strength varries as per the value of s or <- order(D, decreasing = TRUE) U <- U[, or] V <- V[, or] D <- D[or] C <- U %*% (D * t(V)) # simulated coefficient matrix intercept <- rep(0.5, q) # specifying intercept to the model: C0 <- rbind(intercept, C) # Xsigma <- 0.5^abs(outer(1:p, 1:p, FUN = "-")) # Simulated data sim.sample <- gofar_sim(U, D, V, n, Xsigma, C0, familygroup, snr) # Dispersion parameter pHI <- c(rep(sim.sample$sigmaG, q1), rep(1, q2), rep(1, q3)) X <- sim.sample$X[1:n, ] Y <- sim.sample$Y[1:n, ] simulate_gofar <- list(Y = Y,X = X, U = U, D = D, V = V, n=n, Xsigma = Xsigma, C0 = C0, familygroup = familygroup)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.