與唯一列轉置中的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