Funkcja expand.grid dla data.frames w R

Question

Mam 2 data.frames z następującymi kolumnami.

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

Co I jak wykonać, jest stworzenie nowego data.frame, który zawiera wiersz dla każdego elementu of expand.grid (1 [, B] 2 [, F]) i zachowa wszystkie inne kolumny i wartości powiązane z wartościami col B i col F z oryginalnych danych.frames

Obecnie robię to za pomocą 2 dla pętli i to tworzy dość długi czas działania, ponieważ dane, z którymi mam do czynienia, są raczej duże.

Oto zrzut ekranu z czego szukam:

> 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

myślę, szukasz:

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

W pewnym momencie dostosować kod w expand.grid aby ułatwić grupować kępy kolumn. Oto kod

#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) 
} 

I wtedy można go używać jak

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 

Pozwala także na dodatkowe kombinacje nie bezpośrednio stosowanych do tej kwestii, takich jak

#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

Można expand.grid wiersz numery:

myg <- expand.grid(aa=1:nrow(aa),bb=1:nrow(bb)) 
cbind(aa[myg$aa,],bb[myg$bb,]) 

Nazwy wiersz w rezultacie są trochę brzydki:

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

Kopiowanie przykład z góry, funkcja przejście z pakietu tidyr również rade teraz.

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) 

Daje

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