[81de4e]: / CountDataSet.R

Download this file

48 lines (46 with data), 2.1 kB

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
CountDataSet <- function(n,p,K,param,sdsignal){
if(n < 4*K) stop("We require n to be at least 4*K.")
q0 <- rexp(p, rate = 1/25)
isDE <- runif(p) < 0.3
classk <- matrix(NA, nrow=K, ncol=p)
for(k in 1:K){
lfc <- rnorm(p, sd = sdsignal)
classk[k,] <- ifelse(isDE, q0*exp(lfc), q0)
}
truesf <- runif(n)*2+.2 #size factors for training observations
truesfte <- runif(n)*2+.2 #size factors for test observations
conds <- sample(c(rep(1:K, 4), sample(1:K, n-4*K, replace=TRUE))) # class labels for training observations
condste <- sample(c(rep(1:K, 4), sample(1:K, n-4*K, replace=TRUE))) # class labels for test observations
x <- xte <- matrix(NA, nrow=n, ncol=p)
for(i in 1:n){
for(k in 1:K){
if(conds[i]==k) x[i,] <- rnbinom(p, mu = truesf[i]*classk[k,], size=param)
if(condste[i]==k) xte[i,] <- rnbinom(p, mu = truesfte[i]*classk[k,], size=param)
}
}
rm <- apply(x,2,sum)==0
return(list(x=x[,!rm],xte=xte[,!rm],y=conds,yte=condste, truesf=truesf, truesfte=truesfte))
}
#CountDataSet <- function(n,p,K,param,sdsignal){
# if(n < 4*K) stop("We require n to be at least 4*K.")
# q0 <- rexp(p, rate = 1/250)/10
# isDE <- runif(p) < 0.3
# classk <- matrix(NA, nrow=K, ncol=p)
# for(k in 1:K){
# lfc <- rnorm(p, sd = sdsignal)
# classk[k,] <- ifelse(isDE, q0*2^(lfc/2), q0)
# }
# truesf <- pmax(.6+.3*rnorm(n), .2) #size factors for training observations
# truesfte <- pmax(.6+.3*rnorm(n), .2) #size factors for test observations
# conds <- sample(c(rep(1:K, 4), sample(1:K, n-4*K, rep=TRUE))) # class labels for training observations
# condste <- sample(c(rep(1:K, 4), sample(1:K, n-4*K, rep=TRUE))) # class labels for test observations
# x <- xte <- matrix(NA, nrow=n, ncol=p)
# for(i in 1:n){
# for(k in 1:K){
# if(conds[i]==k) x[i,] <- rnbinom(p, mu = truesf[i]*classk[k,], size=param)
# if(condste[i]==k) xte[i,] <- rnbinom(p, mu = truesfte[i]*classk[k,], size=param)
# }
# }
# rm <- apply(x,2,sum)==0
# return(list(x=x[,!rm],xte=xte[,!rm],y=conds,yte=condste, truesf=truesf, truesfte=truesfte))
#}