Menggunakan apply di R dengan argumen vektor tambahan

Saya memiliki matriks berukuran 10.000 x 100 dan vektor dengan panjang 100. Saya ingin menerapkan fungsi khusus, persentil, yang menggunakan argumen vektor dan argumen skalar, ke setiap kolom matriks sedemikian rupa sehingga pada iterasi j, argumen yang digunakan dengan persentil adalah kolom j dari matriks dan entri j dari vektor. Apakah ada cara untuk menggunakan salah satu fungsi apply untuk melakukan ini?

Ini kode saya. Ini berjalan, tetapi tidak memberikan hasil yang benar.

percentile <- function(x, v){
  length(x[x <= v]) / length(x)
}

X <- matrix(runif(10000 * 100), nrow = 10000, ncol = 100)
y <- runif(100)
result <- apply(X, 2, percentile, v = y)

Solusi yang saya gunakan adalah menambahkan y ke X, dan menulis ulang fungsi persentil, seperti yang ditunjukkan di bawah ini.

X <- rbind(X, y)
percentile2 <- function(x){
  v <- x[length(x)]
  x <- x[-length(x)]
  length(x[x <= v]) / length(x)
}
result <- apply(X, 2, percentile2)

Kode ini memberikan hasil yang benar, tetapi saya lebih memilih sesuatu yang lebih elegan.


r apply matrix vector
person tilleyand    schedule 23.08.2013    source sumber
comment
Hai, selamat datang di SO. Karena Anda masih baru di sini, Anda mungkin ingin membaca about dan FAQ bagian situs web untuk membantu Anda memaksimalkannya. Jika suatu jawaban menyelesaikan masalah Anda, Anda mungkin ingin mempertimbangkan untuk memberi suara positif dan/atau menandainya sebagai diterima untuk menunjukkan bahwa pertanyaan telah terjawab, dengan mencentang tanda centang hijau kecil di sebelah jawaban yang sesuai. Anda tidak diwajibkan melakukan hal ini, namun hal ini membantu menjaga situs tetap bersih dari pertanyaan yang belum terjawab dan memberikan penghargaan kepada mereka yang meluangkan waktu untuk memecahkan masalah Anda.   -  person Simon O'Hanlon    schedule 24.08.2013

Jawaban (2)


arrow_upward
2
arrow_downward

Jika Anda memahami bahwa R di-vektorkan dan mengetahui fungsi yang tepat, Anda dapat menghindari loop sepenuhnya, dan melakukan semuanya dalam satu baris yang relatif sederhana...

 colSums(  t( t( X ) <= y ) ) / nrow( X )

Melalui vektorisasi, R akan mendaur ulang setiap elemen di y di setiap kolom X (secara default, ia akan melakukan ini di seluruh baris, jadi kita menggunakan fungsi transpose t untuk mengubah kolom menjadi baris, menerapkan perbandingan logis <= dan kemudian melakukan transpose kembali.

Karena TRUE dan FALSE masing-masing bernilai 1 dan 0, kita dapat menggunakan colSums untuk secara efektif mendapatkan jumlah baris di setiap kolom yang memenuhi kondisi dan kemudian membagi setiap kolom dengan jumlah total baris (ingat daur ulang aturan!). Hasilnya sama persis....

res1 <- apply(X2, 2, percentile2)
res2 <- colSums(  t( t( X ) <= y ) ) / nrow( X )
identical( res1 , res2 )
[1] TRUE

Jelas karena ini tidak menggunakan loop R apa pun, ini banyak lebih cepat (~10 kali pada matriks kecil ini).

Lebih baik lagi menggunakan rowMeans seperti ini (terima kasih kepada @flodel):

     rowMeans(  t(X) <= y  )
person Simon O'Hanlon    schedule 23.08.2013
comment
Bekerja dengan sempurna! Terima kasih! - person tilleyand; 23.08.2013

arrow_upward
2
arrow_downward

Saya pikir cara termudah dan paling jelas adalah dengan menggunakan loop for:

result2 <- numeric(ncol(X))
for (i in seq_len(ncol(X))) {
  result2[i] <- sum(X[,i] <= y[i])
}
result2 <- result2 / nrow(X)

solusi tercepat dan terpendek yang dapat saya pikirkan adalah:

result1 <- rowSums(t(X) <= y) / nrow(X)

SimonO101 memiliki penjelasan dalam jawabannya cara kerjanya. Seperti yang saya katakan, ini cepat. Namun, kelemahannya adalah kurang jelas apa sebenarnya yang dihitung di sini, meskipun Anda dapat menyelesaikannya dengan menempatkan potongan kode ini dalam fungsi yang diberi nama baik.

flodel juga menyarankan solusi menggunakan mapply yang merupakan apply yang dapat bekerja pada banyak vektor. Namun, agar dapat berfungsi, pertama-tama Anda harus meletakkan setiap kolom atau matriks Anda di list atau data.frame:

result3 <- mapply(percentile, as.data.frame(X), y)

Dari segi kecepatan (lihat di bawah untuk beberapa pembandingan), for-loop tidak terlalu buruk dan lebih cepat daripada menggunakan apply (setidaknya dalam kasus ini). Triknya dengan rowSums dan daur ulang vektor lebih cepat, 10 kali lebih cepat dibandingkan solusi menggunakan apply.

> X <- matrix(rnorm(10000 * 100), nrow = 10000, ncol = 100)
> y <- runif(100)
> 
> system.time({result1 <- rowSums(t(X) <= y) / nrow(X)})
   user  system elapsed 
  0.020   0.000   0.018 
> 
> system.time({
+   X2 <- rbind(X, y)
+   percentile2 <- function(x){
+     v <- x[length(x)]
+     x <- x[-length(x)]
+     length(x[x <= v]) / length(x)
+   }
+   result <- apply(X2, 2, percentile2)
+ })
   user  system elapsed 
  0.252   0.000   0.249 
> 
> 
> system.time({
+   result2 <- numeric(ncol(X))
+   for (i in seq_len(ncol(X))) {
+     result2[i] <- sum(X[,i] <= y[i])
+   }
+   result2 <- result2 / nrow(X)
+ })
   user  system elapsed 
  0.024   0.000   0.024 
>
> system.time({
+   result3 <- mapply(percentile, as.data.frame(X), y)
+ })
   user  system elapsed 
  0.076   0.000   0.073 
>
> all(result2 == result1)
[1] TRUE
> all(result2 == result)
[1] TRUE
> all(result3 == result)
[1] TRUE
person Jan van der Laan    schedule 23.08.2013
comment
+1 Saya tidak melihat Anda memiliki jawaban rowSums di antara semua hal lainnya. Saya pikir Anda harus lebih menyorotinya karena ini jawaban yang bagus. Saya meninggalkan jawaban saya karena saya telah menjelaskan cara kerjanya. - person Simon O'Hanlon; 23.08.2013
comment
@ SimonO101 Saya mengedit jawaban saya. Saya harap sekarang ini lebih menonjol. Saya juga merujuk pada jawaban Anda untuk penjelasan. - person Jan van der Laan; 23.08.2013