Сортировка данных из другого столбца в строке таблицы данных, в зависимости от текста другого столбца

Question

Я хотел бы добавить новый столбец в мою таблицу данных, которая содержит данные из одного из других столбцов. Однако выбор столбца зависит от строки в зависимости от содержимого другого столбца. Итак:

для набора данных:

 a_data b_data column_choice 
[1,]  55  1    a 
[2,]  56  2    a 
[3,]  57  3    b 

порождена:

dat=data.table(a_data = c(55, 56, 57), 
       b_data = c(1, 2, 3), 
       column_choice = c("a", "a", "b")) 

Я хотел бы новый столбец, 'выбранный', который содержит (для каждой строки) либо данные из «a_data» или «b_data», в зависимости от значения «column_choice». Таким образом, результирующая таблица данных будет:

 a_data b_data column_choice chosen 
[1,]  55  1    a  55 
[2,]  56  2    a  56 
[3,]  57  3    b  3 

мне удалось получить желаемый эффект, используя:

dat=dat[, data.table(.SD, chosen=.SD[[paste0(.SD$column_choice, "_data")]]), 
     by=1:nrow(a)] 
dat$nrow = NULL 

однако это чувствует себя довольно неуклюжим; возможно, есть более простой способ сделать это (это, несомненно, также научит меня чему-то о R)?

На практике в кадре данных также имеется множество других столбцов, которые необходимо сохранить, больше вариантов, чем просто «a» или «b», и некоторые из этих типов столбцов для генерации, поэтому я бы предпочел не использовать базовое решение ifelse, которое может быть применимо для основного примера выше.

Большое спасибо за помощь.

Answer 1

Я думаю, что я в настоящее время нашел правильно vectorised один вкладыш, который также быстрее, чем другие ответы в данном случае.

petesFun2 использует data.table aggregation как petesFun, однако теперь векторизован через column_choice (а не на элемент, как ранее).

Хотя petesFun2 подходит для моих целей, он оставляет строки и столбцы в другом порядке. Поэтому, в интересах сравнения с другими ответами, я добавил petesFun2Clean, который поддерживает тот же порядок, что и другие ответы.

petesFun2 <-function(myDat) { 
    return(myDat[, cbind(.SD, chosen=.SD[[paste0(.BY$column_choice, "_data")]]), 
       by=column_choice]) 
} 

petesFun2Clean <-function(myDat) { 
    myDat = copy(myDat) # To prevent reference issues 
    myDat[, id := seq_len(nrow(myDat))] # Assign an id 
    result = myDat[, cbind(.SD, chosen=.SD[[.BY$choice]]), 
       by=list(column_choice, choice=paste0(column_choice, "_data"))] 

    # recover ordering and column order. 
    return(result[order(id), 
       list(a_data, b_data, c_data, column_choice, chosen)]) 
} 

benchmark(benRes<- myFun(test.dat), 
      petesRes<- petesFun(test.dat), 
      dowleRes<- dowleFun(test.dat), 
      petesRes2<-petesFun2(test.dat), 
      petesRes2Clean<- petesFun2Clean(test.dat), 
      replications=25, 
      columns=c("test", "replications", "elapsed", "relative")) 

#           test replications elapsed relative 
# 1     benRes <- myFun(test.dat)   25 0.337 4.160494 
# 3    dowleRes <- dowleFun(test.dat)   25 0.191 2.358025 
# 5 petesRes2Clean <- petesFun2Clean(test.dat)   25 0.122 1.506173 
# 4   petesRes2 <- petesFun2(test.dat)   25 0.081 1.000000 
# 2    petesRes <- petesFun(test.dat)   25 4.018 49.604938 

identical(petesRes2, benRes) 
# FALSE (due to row and column ordering) 
identical(petesRes2Clean, benRes) 
# TRUE 

EDIT: Я заметил (как упоминал Матфей в комментариях), что у нас теперь есть группа: =. Таким образом, мы можем опустить cbind и просто сделать:

myDat [, выбранный: = .sd [[paste0 (.BY $ column_choice, "_data")]], от = column_choice]

Answer 2

Когда я думаю о неуклюже, на ум приходят вещи, такие как старые велосипеды или старые машины, но и делающие вещи в R, итерируя по рядам. Таким образом, нижеследующее оказалось более clunkier чем то, что вы разместили в своем вопросе, но оно идет после решения в том, что я считаю более векторным способом. Ниже показано примерно в 10 раз быстрее (и возвращать идентичные результаты как) более гладкий код, который вы указали выше.

Это предложение основано на reshape2 пакете:

library(data.table) 
library(reshape2) 

я добавил «с» в качестве возможного column_choice, чтобы сделать вещи немного более интересным:

dat=data.table(a_data = c(55,56,57,65), 
    b_data = c(1,2,3,4),c_data=c(1000,1001,1002,1003), 
    column_choice = c("a", "c", "a", "b")) 

Ниже приведены шаги, завернутый в функцию, чтобы подготовить их к бенчмаркингу.

myFun<-function(myDat){ 
# convert data.table to data.frame for melt()ing 
    dat1<-data.frame(myDat) 
# add ID variable to keep track of things 
    dat1$ID<-seq_len(nrow(dat1)) 
# melt data - because of this line, it's important to only 
# pass those variables that are used to select the appropriate value 
# i.e., a_data,b_data,c_data,column_choice 
    dat2<-melt(dat1,id.vars=c("ID","column_choice")) 
# Determine which value to choose: a, b, or c 
    dat2$chosen<-as.numeric(dat2$column_choice==substr(dat2$variable, 
    1,1))*dat2$value 
# cast the data back into the original form 
    dat_cast<-dcast(dat2,ID+column_choice~., 
    fun.aggregate=sum,value.var="chosen") 
# rename the last variable 
    names(dat_cast)[ncol(dat_cast)]<-"chosen" 
# merge data back together and return results as a data.table 
    datOUT<-merge(dat1,dat_cast,by=c("ID","column_choice"),sort=FALSE) 
    return(data.table(datOUT[,c(names(myDat),"chosen")])) 
} 

Вот ваше решение упаковывается в функции:

petesFun<-function(myDat){ 
    datOUT=myDat[, data.table(.SD, 
    chosen=.SD[[paste0(.SD$column_choice, "_data")]]), 
    by=1:nrow(myDat)] 
    datOUT$nrow = NULL 
    return(datOUT) 
} 

Это выглядит гораздо более элегантно, чем myFun. Однако результаты сравнительного анализа показывают большую разницу:

Сделайте больше данных.Таблица:

test.df<-data.frame(lapply(dat,rep,100)) 
test.dat<-data.table(test.df) 

и ориентир:

library(rbenchmark) 

benchmark(myRes<-myFun(test.dat),petesRes<-petesFun(test.dat), 
replications=25,columns=c("test", "replications", "elapsed", "relative")) 
#        test replications elapsed relative 
# 1  myRes <- myFun(test.dat)   25 0.412 1.00000 
# 2 petesRes <- petesFun(test.dat)   25 5.429 13.17718 

identical(myRes,petesRes) 
# [1] TRUE 

Я предлагаю, чтобы «неуклюжим» можно интерпретировать по-разному :)

Answer 3

Мы начинаем использовать for петли все больше и больше для этого вид задачи с data.table. Опираясь на ответ Бена и используя свой тест, как о следующем:

dowleFun = function(DT) { 
    DT = copy(DT) # Faster to remove this line to add column by reference, but 
        # included copy() because benchmark repeats test 25 times and 
        # the other tests use the same input table 
    w = match(paste0(DT$column_choice,"_data"),names(DT)) 
    DT[,chosen:=NA_real_] # allocate new column (or clear it if already exists) 
    j = match("chosen",names(DT))  
    for (i in 1:nrow(DT)) 
     set(DT,i,j,DT[[w[i]]][i]) 
    DT 
} 

benchmark(benRes<-myFun(test.dat), 
    petesRes<-petesFun(test.dat), 
    dowleRes<-dowleFun(test.dat), 
    replications=25,columns=c("test", "replications", "elapsed", "relative"), 
    order="elapsed") 

#       test replications elapsed relative 
# 3 dowleRes <- dowleFun(test.dat)   25 0.30  1.0 
# 1  benRes <- myFun(test.dat)   25 0.39  1.3 
# 2 petesRes <- petesFun(test.dat)   25 5.79  19.3 

Если вы можете удалить copy(), то он должен быть быстрее и лучше масштабируется для больших наборов данных. Чтобы проверить это, возможно, создайте очень большую таблицу и время, сколько времени займет один прогон.

В этом случае простую петлю for можно будет легко выполнить.

Сказав, что, если i может быть 2-колонки matrix, то можно было бы использовать A[B] синтаксис в базе (где B содержит строки и столбца позиции, чтобы выбрать), и это один лайнер:

DT[,chosen:=DT[cbind(1:nrow(DT),paste0(column_choice,"_data"))]] 

на данный момент вы получите это:

> DT[cbind(1:3,c(4,4,5))] 
Error in `[.data.table`(test.dat, cbind(1:3, c(4, 4, 5))) : 
    i is invalid type (matrix). Perhaps in future a 2 column matrix could return 
    a list of elements of DT (in the spirit of A[B] in FAQ 2.14). Please let 
    maintainer('data.table') know if you'd like this, or add your comments to 
    FR #1611.