R中data.frames的expand.grid函数

Question

我有 2 个带有以下列的 data.frames。

1) A,B,C,D 2) E,F,G,H

我想做的是创建一个新的 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

Answer 1

我想，你正在寻找：

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

Answer 2

在某一时刻，我修改了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)

Answer 3

你可以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

Answer 4

复制上面的示例，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