Several ways to avoid loops
morota edited this page Dec 19, 2012
·
1 revision
# Bind a lot of matrices by row
mat1 <- matrix (1:12,4,3)
mat2 <- matrix (13:24,4,3)
mat3 <- matrix (25:36,4,3)
mat4 <- matrix (37:48,4,3)
mat5 <- matrix (49:60,4,3)
lapply(paste('mat', 1:5, sep = ''), get)
[[1]]
[,1] [,2] [,3]
[1,] 1 5 9
[2,] 2 6 10
[3,] 3 7 11
[4,] 4 8 12
[[2]]
[,1] [,2] [,3]
[1,] 13 17 21
[2,] 14 18 22
[3,] 15 19 23
[4,] 16 20 24
[[3]]
[,1] [,2] [,3]
[1,] 25 29 33
[2,] 26 30 34
[3,] 27 31 35
[4,] 28 32 36
[[4]]
[,1] [,2] [,3]
[1,] 37 41 45
[2,] 38 42 46
[3,] 39 43 47
[4,] 40 44 48
[[5]]
[,1] [,2] [,3]
[1,] 49 53 57
[2,] 50 54 58
[3,] 51 55 59
[4,] 52 56 60
do.call(cbind, lapply(paste('mat', 1:5, sep = ''), get))
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14]
[1,] 1 5 9 13 17 21 25 29 33 37 41 45 49 53
[2,] 2 6 10 14 18 22 26 30 34 38 42 46 50 54
[3,] 3 7 11 15 19 23 27 31 35 39 43 47 51 55
[4,] 4 8 12 16 20 24 28 32 36 40 44 48 52 56
[,15]
[1,] 57
[2,] 58
[3,] 59
[4,] 60
# example 2
v1 <- c(1:5)
v2 <- c(6:10)
v3 <- c(11:15)
v4 <- c(16:20)
v5 <- c(21:25)
mget(paste("v", 1:5, sep=""), .GlobalEnv)
$v1
[1] 1 2 3 4 5
$v2
[1] 6 7 8 9 10
$v3
[1] 11 12 13 14 15
$v4
[1] 16 17 18 19 20
$v5
[1] 21 22 23 24 25
do.call(rbind,mget(paste("v", 1:5, sep=""), .GlobalEnv))
[,1] [,2] [,3] [,4] [,5]
v1 1 2 3 4 5
v2 6 7 8 9 10
v3 11 12 13 14 15
v4 16 17 18 19 20
v5 21 22 23 24 25
example 3
a1=1
a2=2
obs=objects(pattern=glob2rx("a?"))
obs
[1] "a1" "a2"
sum(sapply(obs, get))
[1] 3
sum(unlist(mget(obs, envir=.GlobalEnv)))
[1] 3dat <- data.frame(id = 1:10, x= rnorm(1:10))
i <- c(2,7,9)
subset(dat, id %in% i)
id x
2 2 -0.03961
7 7 -1.50066
9 9 1.00102
subset(dat, !(id %in% i))
id x
1 1 1.34246
3 3 -0.38720
4 4 -0.58040
5 5 -0.34281
6 6 0.13125
8 8 -0.66002
10 10 -0.01374#one numeric vector and several factors
head(warpbreaks)
breaks wool tension
1 26 A L
2 30 A L
3 54 A L
4 25 A L
5 70 A L
6 52 A L
tapply(warpbreaks$breaks, warpbreaks$tension, sum)
L M H
655 475 390
tapply(warpbreaks$breaks, list(warpbreaks$tension,warpbreaks$wool), sum)
A B
L 401 254
M 216 259
H 221 169
xtabs(breaks~ tension+wool, warpbreaks)
wool
tension A B
L 401 254
M 216 259
H 221 169
require(reshape2)
dcast(mydf,city~brand,sum)
city x y z
1 a 3 23 450
2 b 12 42 231
# one factor and several measurements
dat <- read.table(textConnection("PASTE DATA here"), header=TRUE)
# data
name ip Bsent Breceived
a 1 0.00 0.00
a 2 1.43 19.83
a 1 0.00 0.00
a 2 1.00 1.00
b 1 0.00 2.00
b 3 0.00 2.00
b 2 2.00 0.00
b 2 2.00 0.00
b 1 24.40 22.72
c 1 1.00 1.00
c 1 2.00 1.00
c 1 2.00 1.00
c 1 90.97 15.70
d 0 0.00 0.00
d 1 30.00 17.14
closeAllConnections()
# ex 1)
xtabs(cbind(ip,Bsent,Breceived)~ name, dat)
name ip Bsent Breceived
a 6.00 2.43 20.83
b 9.00 28.40 26.72
c 4.00 95.97 18.70
d 1.00 30.00 17.14
# ex 2)
aggregate(dat[,-1], list(dat[,1]), sum)
Group.1 ip Bsent Breceived
1 a 6 2.43 20.83
2 b 9 28.40 26.72
3 c 4 95.97 18.70
4 d 1 30.00 17.14
# another example
d <- data.frame(g = factor(rep(LETTERS[1:5], each = 5)),x = rpois(25, 10))
d$mean <- with(d, ave(x, g, FUN = mean))
d
g x mean
1 A 15 8.2
2 A 9 8.2
3 A 3 8.2
4 A 5 8.2
5 A 9 8.2
6 B 12 10.6
7 B 13 10.6
8 B 10 10.6
9 B 13 10.6
10 B 5 10.6
11 C 11 10.8
12 C 8 10.8
13 C 8 10.8
14 C 15 10.8
15 C 12 10.8
16 D 13 11.8
17 D 9 11.8
18 D 15 11.8
19 D 11 11.8
20 D 11 11.8
21 E 14 11.2
22 E 8 11.2
23 E 14 11.2
24 E 9 11.2
25 E 11 11.2
ave(d$x, d$g, FUN = mean)
[1] 8.2 8.2 8.2 8.2 8.2 10.6 10.6 10.6 10.6 10.6 10.8 10.8 10.8 10.8 10.8 11.8
[17] 11.8 11.8 11.8 11.8 11.2 11.2 11.2 11.2 11.2
tapply(d$x, d$g, mean)
A B C D E
8.2 10.6 10.8 11.8 11.2
# count frequencies
mypi <- c(0.1,0.2,0.2,0.1,0.3,0.4,0.4,0.4,0.4,0.2)
ave(mypi, mypi, FUN=length)
[1] 2 3 3 2 1 4 4 4 4 3
w
X1 X2
1 1 3
2 1 4
3 1 5
4 2 3
5 2 4
6 3 2
7 4 1
8 4 3
9 4 5
10 5 2
11 5 4
aggregate(X2~X1,w, paste, collapse=" ")
X1 X2
1 1 3 4 5
2 2 3 4
3 3 2
4 4 1 3 5
5 5 2 4
# also consider by() expand.grid(x = 1:3, sex=c("male", "female"))
x sex
1 1 male
2 2 male
3 3 male
4 1 female
5 2 female
6 3 female
expand.grid(month.abb, 2000:2001)
Var1 Var2
1 Jan 2000
2 Feb 2000
3 Mar 2000
4 Apr 2000
5 May 2000
6 Jun 2000
7 Jul 2000
8 Aug 2000
9 Sep 2000
10 Oct 2000
11 Nov 2000
12 Dec 2000
13 Jan 2001
14 Feb 2001
15 Mar 2001
16 Apr 2001
17 May 2001
18 Jun 2001
19 Jul 2001
20 Aug 2001
21 Sep 2001
22 Oct 2001
23 Nov 2001
24 Dec 2001
outer(month.abb, 2000:2001, FUN = "paste")
[,1] [,2]
[1,] "Jan 2000" "Jan 2001"
[2,] "Feb 2000" "Feb 2001"
[3,] "Mar 2000" "Mar 2001"
[4,] "Apr 2000" "Apr 2001"
[5,] "May 2000" "May 2001"
[6,] "Jun 2000" "Jun 2001"
[7,] "Jul 2000" "Jul 2001"
[8,] "Aug 2000" "Aug 2001"
[9,] "Sep 2000" "Sep 2001"
[10,] "Oct 2000" "Oct 2001"
[11,] "Nov 2000" "Nov 2001"
[12,] "Dec 2000" "Dec 2001"# ex 1
l <- list(a = c(1, 2), b = c(1, 2, 3))
l
$a
[1] 1 2
$b
[1] 1 2 3
t(sapply(l, '[', 1:max(sapply(l, length))))
[,1] [,2] [,3]
a 1 2 NA
b 1 2 3
# ex 2
x <- list(a=c(1,2,3,4), b=4, c=c(1:7))
x
$a
[1] 1 2 3 4
$b
[1] 4
$c
[1] 1 2 3 4 5 6 7
t(sapply(x, '[', seq(max(sapply(x, length)))))
[,1] [,2] [,3] [,4] [,5] [,6] [,7]
a 1 2 3 4 NA NA NA
b 4 NA NA NA NA NA NA
c 1 2 3 4 5 6 7
# ex 3
a <- seq(1:3)
b <- seq(1:6)
l <- list(a, b)
do.call(cbind, lapply(l, function(x) x[1:max(sapply(l, length))]))
[,1] [,2]
[1,] 1 1
[2,] 2 2
[3,] 3 3
[4,] NA 4
[5,] NA 5
[6,] NA 6
# ex4, indexing
sapply(l, '[', seq(max(sapply(l,length))))
[,1] [,2]
[1,] 1 1
[2,] 2 2
[3,] 3 3
[4,] NA 4
[5,] NA 5
[6,] NA 6
l <- list(c(1,2,3), c(4,5,6,7), c(8,9,10,11,12))
l
[[1]]
[1] 1 2 3
[[2]]
[1] 4 5 6 7
[[3]]
[1] 8 9 10 11 12
do.call(rbind, lapply(l, function(x) paste(x, collapse=" ")))
[,1]
[1,] "1 2 3"
[2,] "4 5 6 7"
[3,] "8 9 10 11 12"m <- matrix(1:9, nrow=3, dimnames=list(LETTERS[1:3], letters[1:3]))
l <- list(m1=m, m2=m*2, m3=m*3)
l
$m1
a b c
A 1 4 7
B 2 5 8
C 3 6 9
$m2
a b c
A 2 8 14
B 4 10 16
C 6 12 18
$m3
a b c
A 3 12 21
B 6 15 24
C 9 18 27
lapply(l, "[", 1, 1)
$m1
[1] 1
$m2
[1] 2
$m3
[1] 3
lapply(l,function(x) x[1,1])
$m1
[1] 1
$m2
[1] 2
$m3
[1] 3
# indexing
?"[" x <- c("a", "b", "c")
y1 <- 1:3
y2 <- 4:6
y3 <- 7:10
# ex1
dat <- list(y1, y2, y3)
names(dat) <- x
dat
$a
[1] 1 2 3
$b
[1] 4 5 6
$c
[1] 7 8 9 10
R>
# ex2
mapply(assign, x, list(y1, y2, y3), MoreArgs = list(envir = globalenv()))
$a
[1] 1 2 3
$b
[1] 4 5 6
$c
[1] 7 8 9 10x <- list(a=matrix(c(1,2,3,4),nrow=2),b=matrix(c(5,6,7,8),nrow=2))
x
$a
[,1] [,2]
[1,] 1 3
[2,] 2 4
$b
[,1] [,2]
[1,] 5 7
[2,] 6 8
do.call(`+`, x) / length(x)
[,1] [,2]
[1,] 3 5
[2,] 4 6
Reduce("+", x) / length(x)
[,1] [,2]
[1,] 3 5
[2,] 4 6M <- matrix(c(1:9), nrow=3)
M
[,1] [,2] [,3]
[1,] 1 4 7
[2,] 2 5 8
[3,] 3 6 9
sweep(M, 1, rowMeans(M), "-")
[,1] [,2] [,3]
[1,] -3 0 3
[2,] -3 0 3
[3,] -3 0 3mydat <- data.frame(date=paste('day', 1:9, sep=''), var=paste('v', rep(1:3, 3), sep=''), value=rnorm(9) )
mydat
date var value
1 day1 v1 -1.30334
2 day2 v2 -1.17771
3 day3 v3 -1.12660
4 day4 v1 0.41141
5 day5 v2 -1.02286
6 day6 v3 0.74264
7 day7 v1 -0.87138
8 day8 v2 1.46003
9 day9 v3 0.37177
# ex1
with(mydat, tapply(value, list(date, var),identity ))
v1 v2 v3
day1 -1.30334 NA NA
day2 NA -1.1777 NA
day3 NA NA -1.12660
day4 0.41141 NA NA
day5 NA -1.0229 NA
day6 NA NA 0.74264
day7 -0.87138 NA NA
day8 NA 1.4600 NA
day9 NA NA 0.37177
# ex2
require(reshape2)
acast(mydat, date~var)
v1 v2 v3
day1 -1.30334 NA NA
day2 NA -1.1777 NA
day3 NA NA -1.12660
day4 0.41141 NA NA
day5 NA -1.0229 NA
day6 NA NA 0.74264
day7 -0.87138 NA NA
day8 NA 1.4600 NA
day9 NA NA 0.37177mymat1 <- matrix(1:9, ncol=3)
mymat2 <- matrix(2:10, ncol=3)
mymat3 <- matrix(3:11, ncol=3)
# ex1
for (i in 1:3){
disp<-paste("mymat", i, sep="")
print(get(disp))
}
# ex2
disp <- paste("mymat", 1:3, sep="")
sapply(disp, function(x) get(x) )
# ex3
lapply(ls(pattern = 'mymat[0-3]'), get)