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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
#
# Copyright (C) 2004-2016 Friedrich Leisch and Bettina Gruen
# $Id: examples.R 5079 2016-01-31 12:21:12Z gruen $
#
ExNPreg = function(n)
{
if(n %% 2 != 0) stop("n must be even")
x <- runif(2*n, 0, 10)
mp <- exp(c(2-0.2*x[1:n], 1+0.1*x[(n+1):(2*n)]))
mb <- binomial()$linkinv(c(x[1:n]-5, 5-x[(n+1):(2*n)]))
data.frame(x=x,
yn=c(5*x[1:n], 40-(x[(n+1):(2*n)]-5)^2)+3*rnorm(n),
yp=rpois(2*n, mp),
yb=rbinom(2*n, size=1, prob=mb),
class = rep(1:2, c(n,n)),
id1 = factor(rep(1:n, rep(2, n))),
id2 = factor(rep(1:(n/2), rep(4, n/2))))
}
ExNclus = function(n=100)
{
if(n %% 2 != 0) stop("n must be even")
rbind(mvtnorm::rmvnorm(n, mean=rep(0,2)),
mvtnorm::rmvnorm(n, mean=c(8,0), sigma=diag(1:2)),
mvtnorm::rmvnorm(1.5*n, mean=c(-2,6), sigma=diag(2:1)),
mvtnorm::rmvnorm(2*n, mean=c(4,4), sigma=matrix(c(1,.9,.9,1), 2)))
}
ExLinear <- function(beta, n, xdist="runif", xdist.args=NULL,
family=c("gaussian", "poisson"), sd=1, ...)
{
family <- match.arg(family)
X <- NULL
y <- NULL
k <- ncol(beta)
d <- nrow(beta)-1
n <- rep(n, length.out=k)
if(family=="gaussian") sd <- rep(sd, length.out=k)
xdist <- rep(xdist, length.out=d)
if(is.null(xdist.args)){
xdist.args <- list(list(...))
}
if(!is.list(xdist.args[[1]]))
xdist.args <- list(xdist.args)
xdist.args <- rep(xdist.args, length.out=d)
for(i in 1:k)
{
X1 <- 1
for(j in 1:d){
xdist.args[[j]]$n <- n[i]
X1 <- cbind(X1, do.call(xdist[j], xdist.args[[j]]))
}
X <- rbind(X, X1)
xb <- X1 %*% beta[,i,drop=FALSE]
if(family=="gaussian")
y1 <- xb + rnorm(n[i], sd=sd[i])
else
y1 <- rpois(n[i], exp(xb))
y <- c(y, y1)
}
X <- X[,-1,drop=FALSE]
colnames(X) <- paste("x", 1:d, sep="")
z <- data.frame(y=y, X)
attr(z, "clusters") <- rep(1:k, n)
z
}
|
