与唯一列转置中的R

Question

我有一个数据帧，看起来类似于下面：

  X1 X2 
DocumentID 12345 
    Check# 9876 
Investment Tran1 
Investment$ 200 
Investment Tran5 
Investment$ 100 
DocumentID 23456 
    Check# 8765 
Investment Tran1 
Investment$ 100 
Investment Tran9 
Investment$ 50 
DocumentID 34567 
    Check# 7654 
Investment Tran4 
Investment$ 300 
DocumentID 45678 
    Check# 6543 
Investment Tran2 
Investment$ 10 
Investment Tran5 
Investment$ 20 
Investment Tran9 
Investment$ 70 

每个文档ID范围将在投资的＃但我想重塑数据帧，使得其按每个DocumentID转换（宽）并具有唯一列。

我想为表如下看：

DocumentID Check# Investment Investment$ 
    12345 9876  Tran1   200 
    12345 9876  Tran5   100 
    23456 8765  Tran1   100 
    23456 8765  Tran9   50 
    34567 7654  Tran4   300 
    45678 6543  Tran2   10 
    45678 6543  Tran5   20 
    45678 6543  Tran9   70 

，使得文档ID和检查＃如果在每个文档ID超过1个投资重复的。

感谢帮助！

Answer 1

您的数据不佳形成，因为它缺少对每一组键值对的唯一的ID，所以通常宽至长期的办法可能不会没有一些按摩工作。你可以做一个合适的栏，然后在适当的列蔓延的每一行，然后填写和过滤：

library(dplyr) 
library(tidyr) 

     # add row index so spreading will work 
df %>% mutate(row = seq_along(X1)) %>% 
    # spread long to wide, shifting each value into the appropriate column, filling with NA 
    spread(X1, X2, convert = TRUE) %>% 
    # get rid of row index 
    select(-row) %>% 
    # fill in NA values for all but one column... 
    fill(-`Investment$`) %>% 
    # ...so extra NAs in that column make extra rows easy to eliminate 
    filter(complete.cases(.)) 

# Check# DocumentID Investment Investment$ 
# 1 9876  12345  Tran1   200 
# 2 9876  12345  Tran5   100 
# 3 8765  23456  Tran1   100 
# 4 8765  23456  Tran9   50 
# 5 7654  34567  Tran4   300 
# 6 6543  45678  Tran2   10 
# 7 6543  45678  Tran5   20 
# 8 6543  45678  Tran9   70 

Answer 2

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 

---

数据

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"); 

---

说明

cns.grp <- c('DocumentID','Check#'); 

输入data.frame的哪些行应被视为分组标记不是从输入data.frame本身派生的;因此它们必须由程序员进行硬编码。因此，我选派了X1值cns.grp。这代表分组列的列名（因为它们将作为输出分组列）。

ris.dat <- which(!df$X1%in%cns.grp); 

鉴于cns.grp，我们可以通过寻找X1指标是不等于cns.grp任何值获得的数据列的排索引。

cns.dat <- as.character(unique(df$X1[ris.dat])); 

鉴于ris.dat，我们可以通过跨ris.dat行获得的唯一X1值获得的数据列的列名。我添加了一个as.character()胁迫来处理输入data.frame具有系数列，相对于字符列的可能性。

gs <- cumsum(df$X1==cns.grp[1L])[ris.dat[c(T,rep(F,length(cns.dat)-1L))]]; 

为了正确地分割输入数据帧，我们必须派生一个分组向量。假设第一个分组列名称表示组的开始（这是一个合理的假设，似乎是输入数据框架的基本属性），我们可以使用cumsum()在每次出现第一个分组列时递增产生一个对应于输入数据帧的所有行的分组向量。为了向前跳，我们将使用这个分组向量来扩展沿着唯一数据列实例从unstack()收到的唯一分组值向量。例如，对于每个Investment输入行，我们将索引与其对应的DocumentID元素。因此，我们必须针对每个数据子组中的每个组的单个实例过滤cumsum()的结果。换句话说，对于长度为length(cns.dat)的每个范围，我们都必须获得该分组索引的一个且仅有的一个实例。这可以通过用单个真值构建该长度的逻辑向量来实现（无论哪个都是重要的，因为所有分组元素在整个范围内都是相同的）。我们可以用c(T,rep(F,length(cns.dat)-1L))构建这个逻辑向量，从ris.dat中索引出所选行索引，然后在选定行索引上过滤cumsum()结果。我存储在gs中的结果。

ar <- list(check.names=F); 

在这里，我只是预先计算额外的参数给data.frame()通话将构建输出data.frame。指定check.names=F对于保护非句法列名称Check#和Investment$免于由标准化data.frame()。您也可以选择指定stringsAsFactors=F来获取字符列而不是默认因子列。

with(unstack(df,X2~X1),do.call(data.frame,c(lapply(mget(cns.grp),`[`,gs),mget(cns.dat),ar))); 

最后，我们可以将unstack() data.frame获得每个分组列和数据列作为一个独立的列表组件，并且在使用这些with()矢量的上下文中执行的表达式。

在这种情况下，我们只需要对data.frame()运行一次调用即可产生所需的输出。基本上，我们需要将分组列，通过mget()检索和gs适当扩大相结合，用数据列，也可以通过mget()检索，以及包括预先计算的附加参数ar生产参数列表data.frame()将由do.call()中继。结果是所需的输出。

---

标杆

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