r - 多个类别的 ifelse 风格重新编码的成语

Question

我经常遇到这个问题，以至于我认为必须有一个好的成语。假设我有一个带有一堆属性的 data.frame，包括“产品”。我还有一把将产品转化为品牌+尺寸的钥匙。产品代码 1-3 是 Tylenol，4-6 是 Advil，7-9 是 Bayer，10-12 是 Generic。

编码这个的最快（就人类时间而言）方法是什么？

ifelse如果有 3 个或更少的类别，我倾向于使用 nested ，如果超过 3 个，我会输入数据表并将其合并。有更好的想法吗？Stata 有一个非常适合这类事情的recode命令，尽管我认为它过度促进了数据代码混合。

dat <- structure(list(product = c(11L, 11L, 9L, 9L, 6L, 1L, 11L, 5L, 
7L, 11L, 5L, 11L, 4L, 3L, 10L, 7L, 10L, 5L, 9L, 8L)), .Names = "product", row.names = c(NA, 
-20L), class = "data.frame")

score 19 · Accepted Answer

您可以将变量转换为因子并通过levels<-函数更改其水平。在一个命令中，它可能像：

`levels<-`(
    factor(dat$product),
    list(Tylenol=1:3, Advil=4:6, Bayer=7:9, Generic=10:12)
)

在步骤：

brands <- factor(dat$product)
levels(brands) <- list(Tylenol=1:3, Advil=4:6, Bayer=7:9, Generic=10:12)

score 14 · Accepted Answer

可以使用列表作为关联数组来定义brand -> product code映射，即：

brands <- list(Tylenol=1:3, Advil=4:6, Bayer=7:9, Generic=10:12)

一旦你有了这个，你可以将其反转以创建一个product code -> brand列表（可能会占用大量内存），或者只使用搜索功能：

find.key <- function(x, li, default=NA) {
    ret <- rep.int(default, length(x))
    for (key in names(li)) {
        ret[x %in% li[[key]]] <- key
    }
    return(ret)
}

我确信有更好的方法来编写这个函数（for循环让我很烦！），但至少它是矢量化的，所以它只需要一次遍历列表。

使用它会是这样的：

> dat$brand <- find.key(dat$product, brands)
> dat
   product   brand
1       11 Generic
2       11 Generic
3        9   Bayer
4        9   Bayer
5        6   Advil
6        1 Tylenol
7       11 Generic
8        5   Advil
9        7   Bayer
10      11 Generic
11       5   Advil
12      11 Generic
13       4   Advil
14       3 Tylenol
15      10 Generic
16       7   Bayer
17      10 Generic
18       5   Advil
19       9   Bayer
20       8   Bayer

和解决方案非常好recode，levels<-但它们也比这个慢得多（一旦你有了find.key它，这对人类来说比recode和更容易levels<-）：

> microbenchmark(
     recode=recode(dat$product,recodes="1:3='Tylenol';4:6='Advil';7:9='Bayer';10:12='Generic'"), 
     find.key=find.key(dat$product, brands),
     levels=`levels<-`(factor(dat$product),brands))
Unit: microseconds
      expr      min        lq    median        uq      max
1 find.key   64.325   69.9815   76.8950   83.8445  221.748
2   levels  240.535  248.1470  274.7565  306.8490 1477.707
3   recode 1636.039 1683.4275 1730.8170 1855.8320 3095.938

（我无法让该switch版本正确地进行基准测试，但它似乎比上述所有版本都快，尽管它对人类来说甚至比recode解决方案更糟糕。）

score 13 · Accepted Answer

我喜欢包recode中的功能car：

library(car)

dat$brand <- recode(dat$product,
  recodes="1:3='Tylenol';4:6='Advil';7:9='Bayer';10:12='Generic'")

# > dat
#    product   brand
# 1       11 Generic
# 2       11 Generic
# 3        9   Bayer
# 4        9   Bayer
# 5        6   Advil
# 6        1 Tylenol
# 7       11 Generic
# 8        5   Advil
# 9        7   Bayer
# 10      11 Generic
# 11       5   Advil
# 12      11 Generic
# 13       4   Advil
# 14       3 Tylenol
# 15      10 Generic
# 16       7   Bayer
# 17      10 Generic
# 18       5   Advil
# 19       9   Bayer
# 20       8   Bayer

score 8 · Accepted Answer

我经常使用以下技术：

key <- c()
key[1:3] <- "Tylenol"
key[4:6] <- "Advil"
key[7:9] <- "Bayer"
key[10:12] <- "Generic"

然后，

> key[dat$product]
 [1] "Generic" "Generic" "Bayer"   "Bayer"   "Advil"   "Tylenol" "Generic" "Advil"   "Bayer"   "Generic"
[11] "Advil"   "Generic" "Advil"   "Tylenol" "Generic" "Bayer"   "Generic" "Advil"   "Bayer"   "Bayer"

score 7 · Accepted Answer

“数据库方法”是为您的产品密钥定义保留一个单独的表（data.frame）。这更有意义，因为您说您的产品密钥不仅可以转化为品牌，还可以转化为尺寸：

product.keys <- read.table(textConnection("

product brand   size
1       Tylenol small
2       Tylenol medium
3       Tylenol large
4       Advil   small
5       Advil   medium
6       Advil   large
7       Bayer   small
8       Bayer   medium
9       Bayer   large
10      Generic small
11      Generic medium
12      Generic large

"), header = TRUE)

然后，您可以使用以下方法加入您的数据merge：

merge(dat, product.keys, by = "product")
#    product   brand   size
# 1        1 Tylenol  small
# 2        3 Tylenol  large
# 3        4   Advil  small
# 4        5   Advil medium
# 5        5   Advil medium
# 6        5   Advil medium
# 7        6   Advil  large
# 8        7   Bayer  small
# 9        7   Bayer  small
# 10       8   Bayer medium
# 11       9   Bayer  large
# 12       9   Bayer  large
# 13       9   Bayer  large
# 14      10 Generic  small
# 15      10 Generic  small
# 16      11 Generic medium
# 17      11 Generic medium
# 18      11 Generic medium
# 19      11 Generic medium
# 20      11 Generic medium

正如您所注意到的，行的顺序并没有被保留merge。如果这是一个问题，则该plyr包具有join保留顺序的功能：

library(plyr)
join(dat, product.keys, by = "product")
#    product   brand   size
# 1       11 Generic medium
# 2       11 Generic medium
# 3        9   Bayer  large
# 4        9   Bayer  large
# 5        6   Advil  large
# 6        1 Tylenol  small
# 7       11 Generic medium
# 8        5   Advil medium
# 9        7   Bayer  small
# 10      11 Generic medium
# 11       5   Advil medium
# 12      11 Generic medium
# 13       4   Advil  small
# 14       3 Tylenol  large
# 15      10 Generic  small
# 16       7   Bayer  small
# 17      10 Generic  small
# 18       5   Advil medium
# 19       9   Bayer  large
# 20       8   Bayer medium

最后，如果您的表很大并且速度是一个问题，请考虑使用 data.tables（来自data.table包）而不是 data.frames。

score 6 · Accepted Answer

这需要一些打字，但如果你真的有一个庞大的数据集，这可能是要走的路。talkstats.com 的 Bryangoodrich 和 Dason 教了我这个。它使用哈希表或创建包含查找表的环境。实际上，我将这个保留在我的 .Rprofile（即哈希函数）上，用于字典类型查找。

我将您的数据复制了 1000 次以使其更大一些。

#################################################
# THE HASH FUNCTION (CREATES A ENW ENVIRONMENT) #
#################################################
hash <- function(x, type = "character") {
    e <- new.env(hash = TRUE, size = nrow(x), parent = emptyenv())
    char <- function(col) assign(col[1], as.character(col[2]), envir = e)
    num <- function(col) assign(col[1], as.numeric(col[2]), envir = e)
    FUN <- if(type=="character") char else num
    apply(x, 1, FUN)
    return(e)
}
###################################
# YOUR DATA REPLICATED 1000 TIMES #
###################################
dat <- dat <- structure(list(product = c(11L, 11L, 9L, 9L, 6L, 1L, 11L, 5L, 
    7L, 11L, 5L, 11L, 4L, 3L, 10L, 7L, 10L, 5L, 9L, 8L)), .Names = "product", row.names = c(NA, 
    -20L), class = "data.frame")
dat <- dat[rep(seq_len(nrow(dat)), 1000), , drop=FALSE]
rownames(dat) <-NULL
dat
#########################
# CREATE A LOOKUP TABLE #
#########################
med.lookup <- data.frame(val=as.character(1:12), 
    med=rep(c('Tylenol', 'Advil', 'Bayer', 'Generic'), each=3))  

########################################
# USE hash TO CREATE A ENW ENVIRONMENT #
########################################  
meds <- hash(med.lookup)  

##############################
# CREATE A RECODING FUNCTION #
##############################          
recoder <- function(x){
    x <- as.character(x) #turn the numbers to character
    rc <- function(x){
       if(exists(x, env = meds))get(x, e = meds) else NA 
    }  
    sapply(x, rc, USE.NAMES = FALSE) 
}
#############
# HASH AWAY #
#############
recoder(dat[, 1])

在这种情况下，散列很慢，但是如果您有更多级别要重新编码，那么它的速度会比其他级别提高。

score 3 · Accepted Answer

比嵌套ifelse的更具可读性：

unlist(lapply(as.character(dat$product), switch,
              `1`=,`2`=,`3`='tylenol',
              `4`=,`5`=,`6`='advil',
              `7`=,`8`=,`9`='bayer',
              `10`=,`11`=,`12`='generic'))

警告：效率不高。

score 2 · Accepted Answer

我倾向于使用这个功能：

recoder <- function (x, from = c(), to = c()) {
  missing.levels <- unique(x)
  missing.levels <- missing.levels[!missing.levels %in% from]
  if (length(missing.levels) > 0) {
    from <- append(x = from, values = missing.levels)
    to <- append(x = to, values = missing.levels)
  }
  to[match(x, from)]
}

如：

recoder(x = dat$product, from = 1:12, to = c(rep("Product1", 3), rep("Product2", 3), rep("Product3", 3), rep("Product4", 3)))

score 1 · Accepted Answer

如果您在示例中的顺序组中有代码，这可能cut是芥末：

cut(dat$product,seq(0,12,by=3),labels=c("Tylenol","Advil","Bayer","Generic"))
 [1] Generic Generic Bayer   Bayer   Advil   Tylenol Generic Advil   Bayer  
[10] Generic Advil   Generic Advil   Tylenol Generic Bayer   Generic Advil  
[19] Bayer   Bayer  
Levels: Tylenol Advil Bayer Generic

score 0 · Accepted Answer

还有arules:discretize，但我不喜欢它，因为它使您可以将标签与值范围分开：

library(arules)
discretize( dat$product, method = "fixed", categories = c( 1,3,6,9,12 ), labels = c("Tylenol","Advil","Bayer","Generic") )

[1] Generic Generic Generic Generic Bayer   Tylenol Generic Advil   Bayer   Generic Advil   Generic Advil   Advil   Generic Bayer   Generic Advil   Generic Bayer  
Levels: Tylenol Advil Bayer Generic

score 0 · Accepted Answer

为了完整性（可能是最快和最简单的解决方案），可以创建并命名向量并将其用于查找。信用：http ://adv-r.had.co.nz/Subsetting.html#applications

product.code <- c(1='Tylenol', 2='Tylenol', 3='Tylenon', 4='Advil', 5 ='Advil', 6='Advil', 7='Bayer', 8='Bayer', 9='Bayer', 10='Generic', 11='Generic', 12='Generic')

获取输出

$unname(product.code[dat$product])

使用顶级解决方案对速度进行基准测试

$microbenchmark(
 named_vector = unname(product.code[dat$product]), 
 find.key = find.key(dat$product, brands),
 levels = `levels<-`(factor(dat$product),brands))
Unit: microseconds
         expr     min       lq      mean   median       uq     max neval
 named_vector  11.777  20.4810  26.12832  23.0410  28.1610 207.360   100
     find.key  34.305  55.8090  58.75804  59.1370  65.5370 130.049   100
       levels 143.361 224.7685 234.02545 247.5525 255.7445 338.944   100

此解决方案与@kohske 的解决方案非常相似，但适用于非数字查找。

score 0 · Accepted Answer

另一个版本，在这种情况下可以工作：

c("Tylenol","Advil","Bayer","Generic")[(dat$product %/% 3.1) + 1]

score 0 · Accepted Answer

规范 tidyverse 方法从查找表中更新向量的某些值

基于上述问题的代码，该问题通过查找表和 tidyverse 风格的 left_join 得到了很好的解决方案。

library(tidyverse)

首先，我们应该设置一个查找表。您可以在 csv 文件中设置查找表，以缩短人工时间。

lookup <- tribble(
  ~brand, ~code, ~size,
  "Tylenol", 1, "small",
  "Tylenol", 2, "medium",
  "Tylenol", 3, "large",
  "Advil", 4, "small",
  "Advil", 5, "medium",
  "Advil", 6, "large",
  "Bayer", 7, "small",
  "Bayer", 8, "medium",
  "Bayer", 9, "large",
  "Generic", 10, "small",
  "Generic", 11, "medium",
  "Generic", 12, "large"
)

然后，我们可以使用查找表创建新变量。

newdat <- dat %>% 
  left_join(lookup, by = c("product" = "code")) %>%
  select(-product)

虽然这个答案可能已经过时，但由于这是我在搜索此类答案时遇到的第一个问题，而且我花了几个小时才找到一个整洁的答案，我相信我的答案是有道理的。

r - 多个类别的 ifelse 风格重新编码的成语

13 回答 13

Related

Reference