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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
reShape <- function(x, ..., id, colvar, base, reps,
times=1:reps, timevar='seqno', constant=NULL)
{
if(!missing(base)) {
if(!is.list(x))
stop('x must be a list or data frame when base is given')
repvars <- as.vector(outer(base,1:reps,paste,sep=''))
nam <- names(x)
nonrep <- nam[nam %nin% repvars]
res <- vector('list', 1+length(nonrep)+length(base))
names(res) <- c(timevar, nonrep, base)
x1 <- x[[1]]
n <- if(is.matrix(x1)) nrow(x1)
else length(x1)
res[[1]] <- rep(times[1:reps], n)
for(i in nonrep) res[[i]] <- rep(x[[i]], rep(reps,n))
## Get indexes that will put unlist() in right order
k <- as.vector(matrix(1:(reps*n), nrow=reps, byrow=TRUE))
for(i in base) {
bn <- paste(i, 1:reps, sep='')
x1 <- x[[bn[1]]]
at <- attributes(x1)
at$names <- NULL
x1 <- unlist(x[bn])[k]
if(length(at)) attributes(x1) <- at
res[[i]] <- x1
}
if(is.data.frame(x)) {
rn <- attr(x,'row.names')
ln <- length(rn)
if(ln) {
## R calls data.frame even if specify structure, and R does
## not have dup.row.names argument to data.frame as does S+
return(data.frame(res,
row.names=paste(rep(rn,rep(reps,ln)),
rep(1:reps,n))))
}
}
return(res)
}
if(is.matrix(x)) {
y <- as.vector(x)
v1 <- all.is.numeric(dimnames(x)[[1]][row(x)],'vector')
v2 <- all.is.numeric(dimnames(x)[[2]][col(x)],'vector')
w <- list(v1, v2, y)
names(w) <- c('rowvar','colvar',as.character(substitute(x)))
if(length(nd <- names(dimnames(x))))
names(w)[1:2] <- nd
w
} else {
listid <- is.list(id)
i <- as.factor(if(listid) do.call('paste', c(id, sep='~'))
else id)
colvar <- as.factor(colvar)
m <- matrix(NA, nrow=length(levels(i)), ncol=length(levels(colvar)),
dimnames=list(levels(i), levels(colvar)))
dotlist <- list(...)
if(!length(dotlist)) {
m[cbind(i, colvar)] <- x
if(listid) {
j <- match(as.character(dimnames(m)[[1]]), as.character(i))
if(length(constant))
data.frame(id[j,,drop=FALSE], constant[j,,drop=FALSE], m)
else data.frame(id[j,,drop=FALSE], m)
} else m
} else {
res <- vector('list',nx <- 1+length(dotlist))
names(res) <- (as.character(sys.call())[-1])[1:nx]
nam2 <- names(sys.call()[-1])[1:nx]
if(length(nam2))
names(res) <- ifelse(nam2=='',names(res),nam2)
w <- m;
w[cbind(i, colvar)] <- x;
res[[1]] <- w
for(j in 2:nx) {
w <- m;
w[cbind(i, colvar)] <- dotlist[[j-1]]
res[[j]] <- w
}
res
}
}
}
|
