Оптимизация перекодирования в базе R

Я перекодирую переменную на основе некоторых довольно длинных строк, представленных здесь строками A, B, C, D, E и G. Мне было интересно, есть ли способ перекодировать это без повторения ссылки на df$foo 12 раз, используя базу R? Может быть, есть какой-то более умный и быстрый способ, который я мог бы изучить? это действительно самый умный способ сделать это в 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

Обновление от 11.03.2013 05:28:061Z,

Я переписал пять решений функций, чтобы можно было сравнить их с помощью пакета microbenchmark, и в результате решения Тайлера Ринкера и Флодела оказались самыми быстрыми решениями (см. результаты ниже), не говоря уже о том, что этот вопрос касается только скорости. Я также стремлюсь к лаконичности и сообразительности решения. Из любопытства я также добавил решение с использованием функции Recode из пакета car. Пожалуйста, не стесняйтесь, дайте мне знать, если бы я мог переписать решения более оптимальным образом или пакет 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)

Блочная диаграмма результатов микробенчмарка,

Коробчатая диаграмма результатов микробенчмарка


person Eric Fail    schedule 09.03.2013    source источник
comment
В A и B есть повторяющиеся значения. Это правильно?   -  person Arun    schedule 10.03.2013
comment
@Арун, нет. Это опечатка с моей стороны. Я обновил свой вопрос. Спасибо!   -  person Eric Fail    schedule 10.03.2013
comment
Вы также можете взглянуть на функции recode из пакетов memisc и car.   -  person juba    schedule 10.03.2013


Ответы (6)


Вот общий (масштабируемый) подход, тоже очень быстрый:

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)]
person flodel    schedule 10.03.2013
comment
Я обновил свой вопрос грубым эталонным тестом, в котором я сравниваю ваше решение с четырьмя другими решениями по скорости. Пожалуйста, не стесняйтесь исправлять функцию, которую я написал для представления вашего решения в тесте. - person Eric Fail; 11.03.2013

Использование 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})
person juba    schedule 09.03.2013
comment
Благодарю за ваш ответ. Мне нравится, что вам удалось удалить 12 * df$, но это все еще несколько повторяется на 'foo'. Could you explain the use of ;`? - person Eric Fail; 10.03.2013
comment
@EricFail within принимает выражение в качестве второго аргумента. Здесь мы хотим выполнить несколько операторов, поэтому я передаю их в within, заключенные в фигурные скобки { и разделенные ;. Точно так же вы можете передать несколько операторов в одной строке в R. - person juba; 10.03.2013
comment
Это может быть проблема с операционной системой, но на моей машине (*NIX) код отлично работает без ;. Я имею в виду, что у вас есть код в отдельных строках. - person Eric Fail; 10.03.2013
comment
@EricFail Упс, извините, вы совершенно правы, это работает без ;. Они необходимы только в том случае, если операторы находятся в одной строке. Спасибо за указание на это ! - person juba; 10.03.2013
comment
Я обновил свой вопрос грубым эталонным тестом, в котором я сравниваю ваше решение с четырьмя другими решениями по скорости. Пожалуйста, не стесняйтесь исправлять функцию, которую я написал для представления вашего решения в тесте. - person Eric Fail; 11.03.2013

Вы также можете сделать: (отредактировано)

> 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
person Arun    schedule 09.03.2013
comment
Спасибо, что ответили на мой вопрос. Я обновил свой вопрос, и теперь я получаю другую ошибку (относительно длины метки). Я нахожу ваше решение очень интересным! - person Eric Fail; 10.03.2013
comment
Я отредактировал решение для новых данных. Похоже, предупреждение все еще сохраняется, потому что уровни не имеют уникальных меток. Но он все равно возвращает правильный результат. - person Arun; 10.03.2013
comment
Спасибо, хотя должен признать, что предупреждение меня немного нервирует. - person Eric Fail; 10.03.2013
comment
Если после этого сделать еще раз: df$foo <- factor(df$foo) уровни факторов восстанавливаются. Так что я не думаю, что это проблема. Я оставлю это вам. - person Arun; 10.03.2013
comment
Я обновил свой вопрос грубым эталонным тестом, в котором я сравниваю ваше решение с четырьмя другими решениями по скорости. Пожалуйста, не стесняйтесь исправлять функцию, которую я написал для представления вашего решения в тесте. - person Eric Fail; 11.03.2013

Мой подход (потерять 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] 

Я не люблю писать поверх старых колонок, поэтому создал новую. Я бы также сохранил ключ как именованный список.

person Tyler Rinker    schedule 10.03.2013
comment
Я обновил свой вопрос грубым эталонным тестом, в котором я сравниваю ваше решение с четырьмя другими решениями по скорости. Пожалуйста, не стесняйтесь исправлять функцию, которую я написал для представления вашего решения в тесте. - person Eric Fail; 11.03.2013

Другой вариант - использовать 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 
person agstudy    schedule 10.03.2013
comment
Я обновил свой вопрос грубым эталонным тестом, в котором я сравниваю ваше решение с четырьмя другими решениями по скорости. Пожалуйста, не стесняйтесь исправлять функцию, которую я написал для представления вашего решения в тесте. - person Eric Fail; 11.03.2013

Я думаю, что это делает то, что вы хотите, хотя и использует немного другой формат. И, скорее всего, это будет самый быстрый способ.

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 строк (при условии, что у вас есть шесть групп).

person dnlbrky    schedule 22.06.2013
comment
Спасибо за ответ, однако я уже использовал ответ flodel, который он опубликовал 10 марта. Тем не менее, я ценю ваше вход! - person Eric Fail; 26.06.2013