डेटाटेबल

Question

पर कॉलम-वार मतभेद लें I डेटा.table बनाने के लिए डेटाटेबल सिंटैक्स का उपयोग कैसे कर सकते हैं जहां प्रत्येक कॉलम में मूल डेटा.table और अगले कॉलम के कॉलम के बीच अंतर होता है?

उदाहरण: मैं एक data.table जहां प्रत्येक पंक्ति एक समूह है, और प्रत्येक स्तंभ के रूप में इस तरह के साल 0 के बाद जनसंख्या जीवित है, साल 1, 2 के बाद, आदि:

pop <- data.table(group_id = c(1, 2, 3), 
        N = c(4588L, 4589L, 4589L), 
        N_surv_1 = c(4213, 4243, 4264), 
        N_surv_2 = c(3703, 3766, 3820), 
        N_surv_3 = c(2953, 3054, 3159)) 
# group_id N N_surv_1 N_surv_2 N_surv_3 
#  1 4588  4213  3703  2953 
#  2 4589  4243  3766  3054 
#  3 4589  4264  3820  3159 

(डेटा प्रकार भिन्न होती हैं क्योंकि एन एक सच्चे पूर्णांक गिनती और N_surv_1, आदि अनुमानों कि आंशिक हो सकता है कर रहे हैं)

मैंने क्या किया:। आधार diff और मैट्रिक्स स्थानांतरण का उपयोग कर, हम कर सकते हैं:

+०१२३५१६४१०६

diff <- data.table(t(diff(t(as.matrix(pop[,-1,with=FALSE]))))) 
setnames(diff, paste0("deaths_",1:ncol(diff))) 
cbind(group_id = pop[,group_id],diff) 
# produces desired output: 
# group_id deaths_1 deaths_2 deaths_3 
#   1  -375  -510  -750 
#   2  -346  -477  -712 
#   3  -325  -444  -661 

मुझे पता है कि मैं एक एकल स्तंभ melt.data.table द्वारा उत्पादित पर समूह द्वारा आधार diff उपयोग कर सकते हैं, तो यह काम करता है लेकिन सुंदर नहीं है:

melt(pop, 
    id.vars = "group_id" 
    )[order(group_id)][, setNames(as.list(diff(value)), 
            paste0("deaths_",1:(ncol(pop)-2))), 
          keyby = group_id] 

है कि करने के लिए सबसे data.table-riffic रास्ता ऐसा करें, या डेटा.table में बहु-कॉलम ऑपरेशन के रूप में ऐसा करने का कोई तरीका है?

Answer 1

ठीक है, आप सबसेट घटाना सकता है:

ncols = grep("^N(_surv_[0-9]+)?", names(pop), value=TRUE) 
pop[, Map(
    `-`, 
    utils:::tail.default(.SD, -1), 
    utils:::head.default(.SD, -1) 
), .SDcols=ncols] 

# N_surv_1 N_surv_2 N_surv_3 
# 1:  -375  -510  -750 
# 2:  -346  -477  -712 
# 3:  -325  -444  -661 

आप इन मानों को := के साथ नए कॉलम पर असाइन कर सकते हैं। मुझे नहीं पता कि tail और head अधिक आसानी से उपलब्ध नहीं कराए गए हैं ... जैसा कि @akrun द्वारा इंगित किया गया है, आप pop[, .SD[, -1, with=FALSE] - .SD[, -ncol(.SD), with=FALSE], .SDcols=ncols] जैसे with=FALSE का उपयोग कर सकते हैं।

वैसे भी, यह केवल देगी की तुलना में बहुत जटिल है:

melt(pop, id="group_id")[, tail(value, -1) - head(value, -1), by=group_id] 
# group_id V1 
# 1:  1 -375 
# 2:  1 -510 
# 3:  1 -750 
# 4:  2 -346 
# 5:  2 -477 
# 6:  2 -712 
# 7:  3 -325 
# 8:  3 -444 
# 9:  3 -661 

Answer 2

में एक विशिष्ट आईडी के साथ डेटा और प्रत्येक पंक्ति देगी बिना, आप आईडी कॉलम के आधार पर समूह और फिर अंतर diff के साथ प्रत्येक पंक्ति पर, गणना कर सकते हैं यानी unlist(.SD):

pop[, setNames(as.list(diff(unlist(.SD))), paste0("deaths_", 1:(ncol(pop)-2))), group_id] 

# group_id deaths_1 deaths_2 deaths_3 
# 1:  1  -375  -510  -750 
# 2:  2  -346  -477  -712 
# 3:  3  -325  -444  -661 

अनिवार्य रूप से, आप अगर कुछ इस तरह स्तंभ नाम की स्थापना पर ध्यान न दें:

pop[, as.list(diff(unlist(.SD))), group_id] 

Answer 3

यहाँ एक और तरीका देगी अथवा समुदाय को जो यह तेजी से कर सकता है बिना यह करने के लिए है। यदि यह पंक्तियों की छोटी संख्या है तो शायद यह एक उल्लेखनीय अंतर नहीं होगा।

cols<-names(pop)[-1] 
combs<-list() 
for(i in 2:length(cols)) { 
    combs[[length(combs)+1]]<-c(cols[i-1], cols[i]) 
} 
newnames<-sapply(combs,function(x) gsub('N_surv','death',x[2])) 
deathpop<-copy(pop) 
deathpop[,(newnames):=lapply(combs,function(x) get(x[2])-get(x[1]))] 
deathpop[,(cols):=NULL] 

मैंने किया था कुछ

rows<-10000000 
pop <- data.table(group_id = 1:rows, 
        N = runif(rows,3000,4000), 
        N_surv_1 = runif(rows,3000,4000), 
        N_surv_2 = runif(rows,3000,4000), 
        N_surv_3 = runif(rows,3000,4000)) 
system.time({ 
    cols<-names(pop)[-1] 
    combs<-list() 
    for(i in 2:length(cols)) { 
     combs[[length(combs)+1]]<-c(cols[i-1], cols[i]) 
    } 
    newnames<-sapply(combs,function(x) gsub('N_surv','death',x[2])) 
    deathpop<-copy(pop) 
    deathpop[,(newnames):=lapply(combs,function(x) get(x[2])-get(x[1]))] 
    deathpop[,(cols):=NULL]}) 

बेंचमार्किंग और यह

user system elapsed 
0.192 0.808 1.003 

लौटे विपरीत मैं

system.time(pop[, as.list(diff(unlist(.SD))), group_id]) 

किया और यह

0 लौटे

user system elapsed 
169.836 0.428 170.469 

मैं भी

system.time({ 
    ncols = grep("^N(_surv_[0-9]+)?", names(pop), value=TRUE) 
    pop[, Map(
    `-`, 
    utils:::tail.default(.SD, -1), 
    utils:::head.default(.SD, -1) 
), .SDcols=ncols] 
}) 

जो

user system elapsed 
0.044 0.044 0.089 

अंत में लौट आए,

system.time(melt(pop, id="group_id")[, tail(value, -1) - head(value, -1), by=group_id]) 

रिटर्न

user system elapsed 
223.360 1.736 225.315 

कर किया

फ्रैंक का Map समाधान सबसे तेज़ है। यदि आप मेरी प्रतिलिपि लेते हैं तो यह फ्रैंक के समय के बहुत करीब आता है लेकिन वह अभी भी इस टेस्ट केस के लिए जीतता है।