การใช้ Apply ใน R พร้อมอาร์กิวเมนต์เวกเตอร์เพิ่มเติม

หากคุณเข้าใจว่า R เป็นเวกเตอร์และรู้ฟังก์ชันที่ถูกต้อง คุณสามารถหลีกเลี่ยงการวนซ้ำได้ทั้งหมด และทำทั้งหมดด้วยบรรทัดที่ค่อนข้างง่ายเส้นเดียว...

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

เมื่อใช้เวกเตอร์ไรเซชัน R จะรีไซเคิลแต่ละองค์ประกอบใน y ในแต่ละคอลัมน์ของ X (โดยค่าเริ่มต้น มันจะทำเช่นนี้ข้ามแถว ดังนั้นเราจึงใช้ฟังก์ชันการย้าย t เพื่อเปลี่ยนคอลัมน์เป็นแถว ใช้การเปรียบเทียบเชิงตรรกะ <= แล้วจึงย้ายกลับอีกครั้ง

เนื่องจาก TRUE และ FALSE ประเมินเป็น 1 และ 0 ตามลำดับ เราสามารถใช้ colSums เพื่อรับจำนวนแถวในแต่ละคอลัมน์ที่ตรงตามเงื่อนไขได้อย่างมีประสิทธิภาพ จากนั้นหาร แต่ละคอลัมน์ ด้วยจำนวนแถวทั้งหมด (จำการรีไซเคิลได้) กฎ!). มันคือผลลัพธ์เดียวกัน....

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

เห็นได้ชัดว่าสิ่งนี้ไม่ได้ใช้ R ลูปใด ๆ มันจึงเร็วกว่า มาก (ประมาณ 10 เท่าสำหรับเมทริกซ์ขนาดเล็กนี้)

ยิ่งไปกว่านั้น ควรใช้ rowMeans แบบนี้ (ขอบคุณ @flodel):

     rowMeans(  t(X) <= y  ) 

ฉันคิดว่าวิธีที่ง่ายที่สุดและชัดเจนที่สุดคือการใช้ for ลูป:

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

วิธีแก้ปัญหาที่เร็วและสั้นที่สุดที่ฉันนึกได้คือ:

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

SimonO101มีคำอธิบายในคำตอบของเขาว่ามันทำงานอย่างไร อย่างที่บอกไปว่ามันเร็วมาก อย่างไรก็ตาม ข้อเสียคือ ไม่ค่อยชัดเจนว่ามีการคำนวณอะไรที่นี่ แม้ว่าคุณจะสามารถแก้ไขปัญหานี้ได้โดยการวางโค้ดส่วนนี้ในฟังก์ชันที่มีชื่อดีก็ตาม

flodel ยังแนะนำวิธีแก้ปัญหาโดยใช้ mapply ซึ่งเป็น apply ที่สามารถทำงานกับเวกเตอร์หลายตัวได้ อย่างไรก็ตาม เพื่อให้ได้ผล คุณต้องใส่แต่ละคอลัมน์หรือเมทริกซ์ใน list หรือ data.frame ก่อน:

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

ความเร็วที่ชาญฉลาด (ดูด้านล่างสำหรับการเปรียบเทียบบางส่วน) for-loop ไม่ได้แย่ขนาดนั้นและเร็วกว่าการใช้ apply (อย่างน้อยในกรณีนี้) เคล็ดลับการใช้ rowSums และการรีไซเคิลเวกเตอร์นั้นเร็วกว่า เร็วกว่าโซลูชันที่ใช้ apply มากกว่า 10 เท่า

> 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