تذوب مجموعة في البيانات.الإطار ولكن تحويل بعد واحد إلى أعمدة

Question

أود تحويل مصفوفة ذات أبعاد متعددة (على سبيل المثال.س ، ص ، ض;انظر ' آر ' أدناه) في البيانات.الإطار ، ولكن الحفاظ على البعد في الأعمدة (على سبيل المثال .ض ، انظر 'دف 2' أدناه).

حاليا ، يمكنني استخدام وظائف تذوب و دكاست في حزمة ريشاب2.

set.seed(1111)
num <- 1000
dim_names <- list(x = seq(num), y = seq(num), 
    z = paste0('Z', 1:5))
dim_arr <- as.numeric(lapply(dim_names, length))
arr <- array(runif(prod(dim_arr)), dim = dim_arr)
dimnames(arr) <- dim_names

library(reshape2)
df <- melt(arr)
head(df)
system.time(df2 <- dcast(df, x + y ~ z, value.var = 'value'))
head(df2)

  x y        Z1        Z2        Z3        Z4         Z5
1 1 1 0.4655026 0.8027921 0.1950717 0.0403759 0.04669389
2 1 2 0.5156263 0.5427343 0.5799924 0.1911539 0.26069063
3 1 3 0.2788747 0.9394142 0.9081274 0.7712205 0.68748300
4 1 4 0.2827058 0.8001632 0.6995503 0.9913805 0.25421346
5 1 5 0.7054767 0.8013255 0.2511769 0.6556174 0.07780849
6 1 6 0.5576141 0.6452644 0.3362980 0.7353494 0.93147223

ومع ذلك ، استغرق الأمر حوالي 10 ثوان لتحويل قيم 5 أمتار

  user  system elapsed 
  8.13    1.11    9.39 

هل هناك طرق أكثر كفاءة?شكرا على أي اقتراحات.

Answer 1

وهنا قليلا حل أكثر عمومية لمجموعة 4 الأبعاد باستخدام مزيج من aperm(...) و matrix(...).أنا لست ساحرا بما يكفي لتعميم هذا أكثر.

nx <- 2 ; ny <- 3 ; nz <- 4 ; nw <- 5
original <- array(rnorm(nx*ny*nz*nw), dim=c(nx,ny,nz,nw), 
              dimnames=list(x=sprintf('x%s', 1:nx), y=sprintf('y%s', 1:ny), 
                            z=sprintf('z%s', 1:nz), w=sprintf('w%s', 1:nw)))

هذه هي طريقتك الحالية التي تستخدم melt(...) و dcast(...) لإزالة كل ما عدا البعد الأخير:

f.dcast <- function(a) dcast(melt(a), x + y + z ~ w)

ما يلي يفعل نفس الشيء باستخدام aperm(...) لكتابة البيانات كمتجه في ترتيب معين بحيث ينتهي بها الأمر كمصفوفة منسقة بشكل صحيح ، ثم cbindمع أسماء المتغيرات:

f.aperm <- function(a) {
  d <- dim(a)

  data <- matrix(as.vector(aperm(a, c(4,3,2,1))), ncol=d[4], byrow=T)
  colnames(data) <- dimnames(a)[[4]]

  # specify levels in the same order as the input so they don't wind up alphabetical  
  varnames <- data.frame(
    factor(rep(dimnames(a)[[1]], times=1,         each=d[2]*d[3]), levels=dimnames(a)[[1]]),
    factor(rep(dimnames(a)[[2]], times=d[1],      each=d[3]     ), levels=dimnames(a)[[2]]),
    factor(rep(dimnames(a)[[3]], times=d[1]*d[2], each=1        ), levels=dimnames(a)[[3]])
  )

  names(varnames) <- names(dimnames(a))[1:3]

  cbind(varnames, data)
}

كلاهما يعطيني نفس النتيجة:

> desired <- f.dcast(original)
> test <- f.aperm(original)
> all.equal(desired, test)
[1] TRUE

الطريقة الثانية هي 6 مرات أسرع لمجموعة بهذا الحجم:

> microbenchmark::microbenchmark(f.dcast(original), f.aperm(original))
Unit: milliseconds
              expr      min       lq     mean   median       uq       max neval
 f.dcast(original) 7.270208 7.343227 7.703360 7.481984 7.698812 10.392141   100
 f.aperm(original) 1.218162 1.244595 1.327204 1.259987 1.291986  4.182391   100

إذا قمت بزيادة حجم المصفوفة الأصلية:

nx <- 10 ; ny <- 20 ; nz <- 30 ; nw <- 40

ثم الطريقة الثانية أسرع بعشر مرات:

> microbenchmark::microbenchmark(f.dcast(original), f.aperm(original))
Unit: milliseconds
              expr       min        lq      mean    median        uq       max neval
 f.dcast(original) 303.21812 385.44857 381.29150 392.11693 394.81721 472.80343   100
 f.aperm(original)  18.62788  22.25814  28.85363  23.90133  24.54939  97.96776   100

Answer 2

giveacodicetagpre.

الوقت المنقضي لذلك كان حوالي العاشر من الثانية.كانت هذه نتيجة STR ()

giveacodicetagpre.

أفترض أنك يمكن أن تضع في الصف. أما، على الرغم من أنها تزيد من الوقت المنقضي إلى بعض الشيء أكثر من ثانية.