cns.grp <- c('DocumentID','Check#');
ris.dat <- which(!df$X1%in%cns.grp);
cns.dat <- as.character(unique(df$X1[ris.dat]));
gs <- cumsum(df$X1==cns.grp[1L])[ris.dat[c(T,rep(F,length(cns.dat)-1L))]];
ar <- list(check.names=F);
with(unstack(df,X2~X1),do.call(data.frame,c(lapply(mget(cns.grp),`[`,gs),mget(cns.dat),ar)));
## DocumentID Check# Investment Investment$
## 1 12345 9876 Tran1 200
## 2 12345 9876 Tran5 100
## 3 23456 8765 Tran1 100
## 4 23456 8765 Tran9 50
## 5 34567 7654 Tran4 300
## 6 45678 6543 Tran2 10
## 7 45678 6543 Tran5 20
## 8 45678 6543 Tran9 70
données
df <- structure(list(X1=structure(c(2L,1L,3L,4L,3L,4L,2L,1L,3L,4L,3L,4L,2L,1L,3L,4L,2L,1L,3L,
4L,3L,4L,3L,4L),.Label=c("Check#","DocumentID","Investment","Investment$"),class="factor"),
X2=structure(c(3L,15L,16L,5L,19L,2L,6L,14L,16L,2L,20L,10L,8L,13L,18L,7L,9L,11L,17L,1L,19L,
4L,20L,12L),.Label=c("10","100","12345","20","200","23456","300","34567","45678","50",
"6543","70","7654","8765","9876","Tran1","Tran2","Tran4","Tran5","Tran9"),class="factor")),
.Names=c("X1","X2"),row.names=c(NA,-24L),class="data.frame");
Explication
Quelles lignes du data.frame d'entrée doivent être considérées comme des marqueurs de regroupement ne peuvent pas être dérivées de l'entrée data.frame elle-même; par conséquent, ils doivent être codés en dur par le programmeur. J'ai donc attribué leurs valeurs X1 à cns.grp. Cela correspond aux noms des colonnes des colonnes de regroupement (car elles serviront de colonnes de regroupement dans la sortie).
ris.dat <- which(!df$X1%in%cns.grp);
Compte tenu cns.grp, nous pouvons tirer les indices de ligne des colonnes de données en trouvant les indices de X1 qui sont pas égale à l'une des valeurs dans cns.grp.
cns.dat <- as.character(unique(df$X1[ris.dat]));
ris.dat Étant donné, nous pouvons tirer les noms de colonnes des colonnes de données en obtenant les valeurs X1 uniques à travers les rangées de ris.dat. J'ai ajouté une coercition as.character() pour gérer la possibilité que l'entrée data.frame ait des colonnes de facteur, par opposition aux colonnes de caractères. Afin de diviser correctement le data.frame d'entrée le long de ses groupes, nous devons dériver un vecteur de regroupement. En supposant que le nom de la première colonne de regroupement indique le début d'un groupe (ce qui est une hypothèse raisonnable et semble être la propriété fondamentale de l'entrée data.frame), nous pouvons utiliser cumsum() pour incrémenter chaque occurrence de la première colonne de regroupement. produire un vecteur de regroupement correspondant à toutes les lignes du nom de données d'entrée.Pour aller de l'avant, nous allons utiliser ce vecteur de regroupement pour développer les vecteurs de valeur de regroupement uniques reçus de unstack() le long des instances de colonnes de données uniques. Par exemple, pour chaque ligne d'entrée Investment, nous allons indexer l'élément DocumentID qui lui correspond. Par conséquent, nous devons filtrer le résultat du cumsum() pour une seule instance de chaque groupe par sous-groupe de données. En d'autres termes, pour chaque longueur de length(cns.dat), nous devons obtenir une et une seule instance de cet index de regroupement. Cela peut être réalisé en construisant un vecteur logique de cette longueur avec une seule vraie valeur (peu importe laquelle, puisque tous les éléments de regroupement seront les mêmes sur l'étendue). Nous pouvons construire ce vecteur logique avec c(T,rep(F,length(cns.dat)-1L)), indexer les index de ligne sélectionnés de ris.dat, puis filtrer le résultat cumsum() sur les index de ligne sélectionnés. Le résultat que je stocke dans gs.
ar <- list(check.names=F);
Ici je viens Précalculer arguments supplémentaires à l'appel data.frame() qui construira la data.frame de sortie. La spécification check.names=F est nécessaire pour protéger les noms de colonnes non-syntaxiques Check# et Investment$ de la normalisation par data.frame(). Vous pouvez également spécifier stringsAsFactors=F pour obtenir des colonnes de caractères au lieu des colonnes de facteur par défaut.
with(unstack(df,X2~X1),do.call(data.frame,c(lapply(mget(cns.grp),`[`,gs),mget(cns.dat),ar)));
Enfin, nous pouvons unstack() la data.frame pour obtenir chaque colonne de regroupement et de la colonne de données en tant que composante de liste indépendante, et exécuter une expression dans le contexte de ces vecteurs en utilisant with().
Il suffit d'exécuter un seul appel à data.frame() dans ce contexte pour produire la sortie requise. Fondamentalement, nous devons combiner les colonnes de regroupement, récupérées via mget() et correctement étendues par gs, avec les colonnes de données, également récupérées via mget(), et inclure les arguments supplémentaires précalculés ar pour produire la liste d'arguments à data.frame() qui sera relayée par do.call(). Le résultat est la sortie requise.
Analyse comparative
library(dplyr);
library(tidyr);
library(microbenchmark);
bgoldst <- function(df) { cns.grp <- c('DocumentID','Check#'); ris.dat <- which(!df$X1%in%cns.grp); cns.dat <- as.character(unique(df$X1[ris.dat])); gs <- cumsum(df$X1==cns.grp[1L])[ris.dat[c(T,rep(F,length(cns.dat)-1L))]]; ar <- list(check.names=F); with(unstack(df,X2~X1),do.call(data.frame,c(lapply(mget(cns.grp),`[`,gs),mget(cns.dat),ar))); };
alistaire <- function(df) { df %>% mutate(row = seq_along(X1)) %>% spread(X1, X2, convert = TRUE) %>% select(-row) %>% fill(-`Investment$`) %>% filter(complete.cases(.)); };
## OP's input
df <- structure(list(X1=structure(c(2L,1L,3L,4L,3L,4L,2L,1L,3L,4L,3L,4L,2L,1L,3L,4L,2L,1L,3L,
4L,3L,4L,3L,4L),.Label=c("Check#","DocumentID","Investment","Investment$"),class="factor"),
X2=structure(c(3L,15L,16L,5L,19L,2L,6L,14L,16L,2L,20L,10L,8L,13L,18L,7L,9L,11L,17L,1L,19L,
4L,20L,12L),.Label=c("10","100","12345","20","200","23456","300","34567","45678","50",
"6543","70","7654","8765","9876","Tran1","Tran2","Tran4","Tran5","Tran9"),class="factor")),
.Names=c("X1","X2"),row.names=c(NA,-24L),class="data.frame");
ex <- lapply(bgoldst(df),as.character); o <- names(ex);
identical(ex,lapply(alistaire(df)[o],as.character));
## [1] TRUE
microbenchmark(bgoldst(df),alistaire(df));
## Unit: microseconds
## expr min lq mean median uq max neval
## bgoldst(df) 794.151 862.362 917.3149 891.4415 934.2075 1488.659 100
## alistaire(df) 2560.782 2677.318 3376.1405 2758.5720 2861.6365 53457.399 100
## scale test
set.seed(1L); NR <- 2L*1e5L; ND <- 8L; probG <- 0.25; X1 <- character(NR); cns.grp <- c('DocumentID','Check#'); NG <- length(cns.grp); cns.dat <- c(LETTERS[seq_len(ND-1L)],'Investment$'); X1[seq_len(NG)] <- cns.grp; i <- NG+1L; while (i<=NR-ND+1L) { if (runif(1L)<probG) { X1[seq(i,len=NG)] <- cns.grp; i <- i+NG; } else { X1[seq(i,len=ND)] <- cns.dat; i <- i+ND; }; }; if (i<=NR) { X1[seq(i,NR)] <- cns.grp; }; df <- data.frame(X1=X1,X2=seq_len(NR));
ex <- lapply(bgoldst(df),as.character); o <- names(ex);
identical(ex,lapply(alistaire(df)[o],as.character));
## [1] TRUE
microbenchmark(bgoldst(df),alistaire(df));
## Unit: milliseconds
## expr min lq mean median uq max neval
## bgoldst(df) 34.20791 35.90591 47.60333 44.02403 46.78709 119.4467 100
## alistaire(df) 482.73097 540.84550 568.00577 557.26885 572.44025 741.9781 100
comme toujours, réponse très agréable. J'apprécie vraiment vos explications détaillées et mes repères complets. –
Merci @JosephWood, j'apprécie vraiment cela. – bgoldst