R 中 data.frames 的 expand.grid 函数
expand.grid function for data.frames in R
我有 2 个 data.frames 以下列。
1) A,B,C,D
2) 英、法、绿、高
我想做的是创建一个新的 data.frame,它为 expand.grid(1[B]2[F]) 的每个元素创建一行,然后保留与原始 data.frames
的 col B 和 col F 的值关联的所有其他列和值
我目前正在使用 2 个 for 循环执行此操作,这会创建相当长的 运行 时间,因为我正在处理的 data.frames 相当大。
这是我要查找的内容的屏幕截图:
> aa
A B C D
1 1 x 3 5
2 2 y 4 6
> bb
E F G H
1 7 j 9 11
2 8 k 10 12
> cc
A B C D E F G H
1 1 x 3 5 7 j 9 11
2 2 y 4 6 7 j 9 11
3 1 x 3 5 8 k 10 12
4 2 y 4 6 8 k 10 12
我想,您正在寻找:
merge(aa,bb)
A B C D E F G H
1 1 x 3 5 7 j 9 11
2 2 y 4 6 7 j 9 11
3 1 x 3 5 8 k 10 12
4 2 y 4 6 8 k 10 12
有一次我修改了 expand.grid
中的代码,以便更轻松地对列块进行分组。这是代码
#available from
#https://gist.github.com/MrFlick/00e2c589a2fa4b6d91f2
Expand.Grid<-function (..., stringsAsFactors = TRUE)
{
nargs <- length(args <- list(...))
if (!nargs)
return(as.data.frame(list()))
if (nargs == 0L)
return(as.data.frame(list()))
Names <- function(x) {if(!is.null(names(x))) names(x) else rep("",length(x))}
Paste <- function(...) {a<-list(...); r<-do.call("paste", c(list(sep="."),
a[sapply(a, function(x) !is.character(x) || any(nzchar(x)))]));
nx <- max(sapply(a, length))
if (length(r)) return(rep(r, length.out=nx)) else return(rep("", nx))
}
contribcols <- sapply(args, function(x) ifelse(class(x)=="data.frame", ncol(x), 1))
outargs <- sum(contribcols)
cargs <- vector("list", outargs)
nmc <- paste0("Var", seq.int(sum(contribcols)))
nm <- unlist(lapply(seq_along(args), function(x) if(class(args[[x]])=="data.frame") {
Paste(Names(args)[x], Names(args[[x]])) } else {Names(args)[x]}))
if (is.null(nm))
nm <- nmc
else if (any(ng0 <- !nzchar(nm)))
nm[ng0] <- nmc[ng0]
names(cargs) <- make.unique(make.names(nm))
rep.fac <- 1L
d <- sapply(args, function(x) ifelse(class(x)=="data.frame", nrow(x), length(x)))
orep <- prod(d)
if (orep == 0L) {
i<-1
for (a in seq_along(args)) {
if (contribcols[a]==1) {
args[[a]]=list(a)
}
for(j in seq_len(contribcols[a])) {
cargs[[i]] <- args[[a]][[j]][FALSE]
i <- i+1
}
}
} else {
i<-1
for (a in seq_along(args)) {
nx <- d[a]
orep <- orep/nx
x<-args[[a]]
if (contribcols[a]==1) {
x<-list(x)
}
for(j in seq_len(contribcols[a])) {
y <- x[[j]]
y <- y[rep.int(rep.int(seq_len(nx), rep.int(rep.fac,
nx)), orep)]
if (stringsAsFactors && !is.factor(y) && is.character(y))
y <- factor(y, levels = unique(y))
cargs[[i]] <- y
i <- i+1
}
rep.fac <- rep.fac * nx
}
}
rn <- .set_row_names(as.integer(prod(d)))
structure(cargs, class = "data.frame", row.names = rn)
}
然后你可以像这样使用它
aa<-read.table(text=" A B C D
1 1 x 3 5
2 2 y 4 6", header=T)
bb<-read.table(text=" E F G H
1 7 j 9 11
2 8 k 10 12", header=T)
Expand.Grid(aa,bb)
# A B C D E F G H
# 1 1 x 3 5 7 j 9 11
# 2 2 y 4 6 7 j 9 11
# 3 1 x 3 5 8 k 10 12
# 4 2 y 4 6 8 k 10 12
它还允许不直接适用于此问题的其他组合,例如
#combine any number of data.frames and atomic vectors
Expand.Grid(aa,other=1:2, bb)
#give columns a prefix
Expand.Grid(x=aa,y=aa)
您可以 expand.grid
行号:
myg <- expand.grid(aa=1:nrow(aa),bb=1:nrow(bb))
cbind(aa[myg$aa,],bb[myg$bb,])
结果中的行名有点难看:
A B C D E F G H
1 1 x 3 5 7 j 9 11
2 2 y 4 6 7 j 9 11
1.1 1 x 3 5 8 k 10 12
2.1 2 y 4 6 8 k 10 12
复制上面的示例,tidyr 包中的交叉函数现在也可以做到这一点。
aa <- read.table(text = " A B C D
1 1 x 3 5
2 2 y 4 6", header = T)
bb <- read.table(text = " E F G H
1 7 j 9 11
2 8 k 10 12", header = T)
crossing(aa, bb)
给予
Source: local data frame [4 x 8]
A B C D E F G H
(int) (fctr) (int) (int) (int) (fctr) (int) (int)
1 1 x 3 5 7 j 9 11
2 1 x 3 5 8 k 10 12
3 2 y 4 6 7 j 9 11
4 2 y 4 6 8 k 10 12
我有 2 个 data.frames 以下列。
1) A,B,C,D 2) 英、法、绿、高
我想做的是创建一个新的 data.frame,它为 expand.grid(1[B]2[F]) 的每个元素创建一行,然后保留与原始 data.frames
的 col B 和 col F 的值关联的所有其他列和值我目前正在使用 2 个 for 循环执行此操作,这会创建相当长的 运行 时间,因为我正在处理的 data.frames 相当大。
这是我要查找的内容的屏幕截图:
> aa
A B C D
1 1 x 3 5
2 2 y 4 6
> bb
E F G H
1 7 j 9 11
2 8 k 10 12
> cc
A B C D E F G H
1 1 x 3 5 7 j 9 11
2 2 y 4 6 7 j 9 11
3 1 x 3 5 8 k 10 12
4 2 y 4 6 8 k 10 12
我想,您正在寻找:
merge(aa,bb)
A B C D E F G H
1 1 x 3 5 7 j 9 11
2 2 y 4 6 7 j 9 11
3 1 x 3 5 8 k 10 12
4 2 y 4 6 8 k 10 12
有一次我修改了 expand.grid
中的代码,以便更轻松地对列块进行分组。这是代码
#available from
#https://gist.github.com/MrFlick/00e2c589a2fa4b6d91f2
Expand.Grid<-function (..., stringsAsFactors = TRUE)
{
nargs <- length(args <- list(...))
if (!nargs)
return(as.data.frame(list()))
if (nargs == 0L)
return(as.data.frame(list()))
Names <- function(x) {if(!is.null(names(x))) names(x) else rep("",length(x))}
Paste <- function(...) {a<-list(...); r<-do.call("paste", c(list(sep="."),
a[sapply(a, function(x) !is.character(x) || any(nzchar(x)))]));
nx <- max(sapply(a, length))
if (length(r)) return(rep(r, length.out=nx)) else return(rep("", nx))
}
contribcols <- sapply(args, function(x) ifelse(class(x)=="data.frame", ncol(x), 1))
outargs <- sum(contribcols)
cargs <- vector("list", outargs)
nmc <- paste0("Var", seq.int(sum(contribcols)))
nm <- unlist(lapply(seq_along(args), function(x) if(class(args[[x]])=="data.frame") {
Paste(Names(args)[x], Names(args[[x]])) } else {Names(args)[x]}))
if (is.null(nm))
nm <- nmc
else if (any(ng0 <- !nzchar(nm)))
nm[ng0] <- nmc[ng0]
names(cargs) <- make.unique(make.names(nm))
rep.fac <- 1L
d <- sapply(args, function(x) ifelse(class(x)=="data.frame", nrow(x), length(x)))
orep <- prod(d)
if (orep == 0L) {
i<-1
for (a in seq_along(args)) {
if (contribcols[a]==1) {
args[[a]]=list(a)
}
for(j in seq_len(contribcols[a])) {
cargs[[i]] <- args[[a]][[j]][FALSE]
i <- i+1
}
}
} else {
i<-1
for (a in seq_along(args)) {
nx <- d[a]
orep <- orep/nx
x<-args[[a]]
if (contribcols[a]==1) {
x<-list(x)
}
for(j in seq_len(contribcols[a])) {
y <- x[[j]]
y <- y[rep.int(rep.int(seq_len(nx), rep.int(rep.fac,
nx)), orep)]
if (stringsAsFactors && !is.factor(y) && is.character(y))
y <- factor(y, levels = unique(y))
cargs[[i]] <- y
i <- i+1
}
rep.fac <- rep.fac * nx
}
}
rn <- .set_row_names(as.integer(prod(d)))
structure(cargs, class = "data.frame", row.names = rn)
}
然后你可以像这样使用它
aa<-read.table(text=" A B C D
1 1 x 3 5
2 2 y 4 6", header=T)
bb<-read.table(text=" E F G H
1 7 j 9 11
2 8 k 10 12", header=T)
Expand.Grid(aa,bb)
# A B C D E F G H
# 1 1 x 3 5 7 j 9 11
# 2 2 y 4 6 7 j 9 11
# 3 1 x 3 5 8 k 10 12
# 4 2 y 4 6 8 k 10 12
它还允许不直接适用于此问题的其他组合,例如
#combine any number of data.frames and atomic vectors
Expand.Grid(aa,other=1:2, bb)
#give columns a prefix
Expand.Grid(x=aa,y=aa)
您可以 expand.grid
行号:
myg <- expand.grid(aa=1:nrow(aa),bb=1:nrow(bb))
cbind(aa[myg$aa,],bb[myg$bb,])
结果中的行名有点难看:
A B C D E F G H
1 1 x 3 5 7 j 9 11
2 2 y 4 6 7 j 9 11
1.1 1 x 3 5 8 k 10 12
2.1 2 y 4 6 8 k 10 12
复制上面的示例,tidyr 包中的交叉函数现在也可以做到这一点。
aa <- read.table(text = " A B C D
1 1 x 3 5
2 2 y 4 6", header = T)
bb <- read.table(text = " E F G H
1 7 j 9 11
2 8 k 10 12", header = T)
crossing(aa, bb)
给予
Source: local data frame [4 x 8]
A B C D E F G H
(int) (fctr) (int) (int) (int) (fctr) (int) (int)
1 1 x 3 5 7 j 9 11
2 1 x 3 5 8 k 10 12
3 2 y 4 6 7 j 9 11
4 2 y 4 6 8 k 10 12