基於R的優化重新編碼

Question

我是一個基於一些相當長的字符串重新編碼的變量，這裏以字符串A，B，C，D，E和G爲例。我想知道是否有方法來重新編碼無需使用base R重複12次對df$foo的引用？也許有一些更聰明的更快的方式我可以探索？這真的是R中最聰明的方法嗎？

df <- data.frame(
    foo = 1000:1010, 
    bar = letters[1:11]) 
df 
    foo bar 
1 1000 a 
2 1001 b 
3 1002 c 
4 1003 d 
5 1004 e 
6 1005 f 
7 1006 g 
8 1007 h 
9 1008 i 
10 1009 j 
11 1010 k 

A <- c(1002) 
B <- c(1007, 1008) 
C <- c(1001, 1003) 
D <- c(1004, 1006) 
E <- c(1000, 1005) 
G <- c(1010, 1009) 

df$foo[df$foo %in% A] <- 1 
df$foo[df$foo %in% B] <- 2 
df$foo[df$foo %in% C] <- 3 
df$foo[df$foo %in% D] <- 4 
df$foo[df$foo %in% E] <- 5 
df$foo[df$foo %in% G] <- 7 
df 
    foo bar 
1 5 a 
2 3 b 
3 1 c 
4 3 d 
5 4 e 
6 5 f 
7 4 g 
8 2 h 
9 2 i 
10 7 j 
11 7 k 

更新於2013年3月11日05：28：061Z，

我已經重寫五大解決方案的功能，能夠使用微基準測試包對它們進行比較，其結果是，泰勒林克而flodel的解決方案是最快的解決方案（請參見下面的結果），並不是說這個問題是關於速度問題。我也在尋求簡潔和智能的解決方案。出於好奇，我還添加了一個使用汽車包裝中的Recode功能的解決方案。如果我能夠以更優化的方式重寫解決方案，或者如果microbenchmark軟件包不是比較這些功能的最佳方法，請隨時告訴我。

df <- data.frame(
    foo = sample(1000:1010, 1e5+22, replace = TRUE), 
    bar = rep(letters, 3847)) 
str(df) 

A <- c(1002) 
B <- c(1007, 1008) 
C <- c(1001, 1003) 
D <- c(1004, 1006) 
E <- c(1000, 1005) 
G <- c(1010, 1009) 

# juba's solution 
juba <- function(df,foo) within(df, {foo[foo %in% A] <- 1; foo[foo %in% B] <- 2;foo[foo %in% C] <- 3;foo[foo %in% D] <- 4;foo[foo %in% E] <- 5;foo[foo %in% G] <- 7}) 
# Arun's solution 
Arun <- function(df,x) factor(df[,x], levels=c(A,B,C,D,E,G), labels=c(1, rep(c(2:5, 7), each=2))) 
# flodel's solution 
flodel <- function(df,x) rep(c(1, 2, 3, 4, 5, 7), sapply(list(A, B, C, D, E, G), length))[match(df[,x], unlist(list(A, B, C, D, E, G)))] 
# Tyler Rinker's solution 
TylerRinker <- function(df,x) data.frame(vals = unlist(list(A = c(1002),B = c(1007, 1008),C = c(1001, 1003),D = c(1004, 1006),E = c(1000, 1005), G = c(1010, 1009))), labs = c(1, rep(c(2:5, 7), each=2)))[match(df[,x], unlist(list(A = c(1002),B = c(1007, 1008),C = c(1001, 1003),D = c(1004, 1006),E = c(1000, 1005), G = c(1010, 1009)))), 2] 
# agstudy's solution 
agstudy <- function(df,foo) merge(df,data.frame(foo=unlist(list(A, B, C, D, E, G)), val =rep((1:7)[-6],rapply(list(A, B, C, D, E, G), length)))) 
# Recode from the car package 
ReINcar <- function(df,x) Recode(df[,x], "A='A'; B='B'; C='C'; D='D'; E='E'; G='G'") 

# install.packages("microbenchmark", dependencies = TRUE) 
require(microbenchmark) 

# run test 
res <- microbenchmark(juba(df, foo), Arun(df, 1), flodel(df, 1), TylerRinker(df,1) ,agstudy(df, foo), ReINcar(df, 1), times = 25) 
There were 15 warnings (use warnings() to see them) # warning duo to x's solution 

## Print results: 
print(res) 

數字，

Unit: milliseconds 
        expr  min   lq  median   uq  max neval 
      juba(df, foo) 37.944355 39.521603 41.987174 46.385974 79.559750 25 
      Arun(df, 1) 23.833334 24.115776 24.648842 26.987431 55.466448 25 
      flodel(df, 1) 3.586179 3.637024 3.956814 6.468735 28.404166 25 
    TylerRinker(df, 1) 3.919563 4.115994 4.529926 5.532688 8.508956 25 
     agstudy(df, foo) 301.487732 324.641734 334.801005 352.753496 415.421212 25 
     ReINcar(df, 1) 73.655566 77.903088 81.745037 101.038791 125.158208 25 


### Plot results: 
boxplot(res) 

微基準測試結果的

箱線圖，

Answer 1

這是一個普遍的（可擴展）的方式，速度非常快過：

sets <- list(A, B, C, D, E, G) 
vals <- c(1, 2, 3, 4, 5, 7) 

keys <- unlist(sets) 
values <- rep(vals, sapply(sets, length)) 
df$foo <- values[match(df$foo, keys)] 

Answer 2

使用within可以幫你節省一些按鍵：

df <- within(df, 
     {foo[foo %in% A] <- 1; 
     foo[foo %in% B] <- 2; 
     foo[foo %in% C] <- 3; 
     foo[foo %in% D] <- 4; 
     foo[foo %in% E] <- 5; 
     foo[foo %in% G] <- 7}) 

Answer 3

你也可以這樣做：（編輯）

> df$foo <- factor(df$foo, levels=c(A,B,C,D,E,G), labels=c(1, rep(c(2:5, 7), each=2))) 

# Warning message: 
# In `levels<-`(`*tmp*`, value = if (nl == nL) as.character(labels) else paste0(labels, : 
# duplicated levels will not be allowed in factors anymore 

# foo bar 
# 1 5 a 
# 2 3 b 
# 3 1 c 
# 4 3 d 
# 5 4 e 
# 6 5 f 
# 7 4 g 
# 8 2 h 
# 9 2 i 
# 10 7 j 
# 11 7 k 

Answer 4

我的做法（失去了A，B，C ...所有在一起，但我看到flodel的是非常相似的）。

keyL <- list(
    A = c(1002), 
    B = c(1007, 1008), 
    C = c(1001, 1003), 
    D = c(1004, 1006), 
    E = c(1000, 1005), 
    G = c(1010, 1009) 
) 

key <- data.frame(vals = unlist(keyL), labs = c(1, rep(c(2:5, 7), each=2))) 

df$foo2 <- key[match(df$foo, key$vals), 2] 

我不喜歡寫舊的列，所以創建了一個新的。我也會將密鑰存儲爲一個命名列表。

Answer 5

另一種選擇是使用merge，非常類似於@flodel和@Tyler方法

sets <- list(A, B, C, D, E, G) 
df.code = data.frame(foo=unlist(sets), 
        val =rep((1:7)[-6],rapply(sets, length))) 
> merge(df,df.code) 
    foo bar val 
1 1000 a 5 
2 1001 b 3 
3 1002 c 1 
4 1003 d 3 
5 1004 e 4 
6 1005 f 5 
7 1006 g 4 
8 1007 h 2 
9 1008 i 2 
10 1009 j 7 
11 1010 k 7 

Answer 6

我想這你想要做什麼，儘管使用格式稍有不同。它可能是最快的方法。

library(data.table) 

## Create the sample data: 
dt <- data.table(foo=sample(1000:1010, 1e5+22, replace = TRUE), bar=rep(letters, 3847), key="foo") 

## Create the table that maps the old value of foo to the new one: 
dt.recode<-data.table(foo_old=1000:1010, foo_new=c(5L, 3L, 1L, 3L, 4L, 5L, 4L, 2L, 2L, 7L, 7L), key="foo_old") 

## Show the result of the join/merge between the original and recoded table: 
## (not necesary if you only want to update the original table) 
dt[dt.recode] 
##  foo bar foo_new 
## 1: 1000 a  5 
## 2: 1001 b  3 
## 3: 1002 c  1 
## 4: 1003 d  3 
## 5: 1004 e  4 
## 6: 1005 f  5 
## 7: 1006 g  4 
## 8: 1007 h  2 
## 9: 1008 i  2 
## 10: 1009 j  7 
## 11: 1010 k  7 

## Same as above, but updates the value of foo in the original table: 
dt[dt.recode,foo:=foo_new][] 
##  foo bar 
## 1: 5 a 
## 2: 3 b 
## 3: 1 c 
## 4: 3 d 
## 5: 4 e 
## 6: 5 f 
## 7: 4 g 
## 8: 2 h 
## 9: 2 i 
## 10: 7 j 
## 11: 7 k 

以下是如何將數據幀轉換爲數據表（並添加是必要的關鍵，爲後來加入），如果你喜歡的，而不是從零開始創建數據表：

dt <- as.data.table(df) 
setkey(dt,foo) 

我不知道你想如何計算這種方法的時間，但假設dt和dt.recode已經存在並且已被鍵入，然後運行更新該表的單行顯示0在我的系統上經過的時間。此外，如果您的A，B，C，D，E，G組有任何內在含義，我會將它們作爲列添加到您的原始表中。那麼你可以加入這個領域，dt.recode只需要6行（假設你有6個組）。