我有一个类似于下面的数据框:
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中有超过1个投资,则重复文档ID和检查#。
感谢帮助!
答案 0 :(得分:3)
您的数据形成不佳,因为它缺少每组键值对的唯一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
答案 1 :(得分: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
,我们可以通过获取X1
行中的唯一ris.dat
值来推导数据列的列名称。我添加了一个as.character()
强制来处理输入data.frame有因子列的可能性,而不是字符列。
gs <- cumsum(df$X1==cns.grp[1L])[ris.dat[c(T,rep(F,length(cns.dat)-1L))]];
为了在其组中正确地分割输入data.frame,我们必须派生一个分组向量。假设第一个分组列名称表示组的开头(这是一个合理的假设并且似乎是输入data.frame的基本属性),我们可以在每次出现时使用cumsum()
递增首先对列进行分组以生成对应于输入data.frame的所有行的分组向量。
为了向前跳,我们将使用此分组向量来扩展从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()
检索)合并,并包含预先计算的其他参数{{1生成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