函数中的 R 向量化实现

Question

我无法理解如何利用 R 向量化的优势以更有效的方式完成我想做的事情。

简而言之，对于每一行，我想将当前行的第二列（$start）与上一行和下一行的 $start 进行比较（所有值都是整数，我们称这些值为 prev_dist 和next_dist)。接下来，打印当前行的第 4 列（$condition），后跟 5 个前一个 $condition 或 5 个下一个 $condition，具体取决于哪个较低的距离值（即上一行或下一行的 $start 最接近当前行的 $start）。

weather    146   17   Rainy 
weather    147   17   Rainy 
weather    163   16   Sunny 
weather    173   15   Sunny 
weather    176   15   Rainy   
weather    197   12   Rainy

我希望我的输出类似于（在数据框中）：

Rainy Rainy Sunny Sunny Sunny Rainy
Rainy Sunny Sunny Sunny Rainy Rainy
etc.

我尝试在下面编写一个函数，但是这个函数对于大型模拟数据集永远运行。

有人可以帮助我了解在这种情况下如何实现矢量化吗？

buildMatrix <- function(input){
 len <- nrow(input)-6
 sequence_matrix <- data.frame()

 for(line in 6:len){

   start <- input[line,]$start
   prev_start <- input[line-1,]$start
   next_start <- input[line+1,]$start
   prev_dist <- abs(start-prev_start)
   next_dist <- abs(start-next_start)
   current_seq <- input[line,]$condition

   if(prev_dist < next_dist || prev_dist == next_dist){
     for(i in 1:5){
       prev_seq <- input[line-i,]$condition
       current_seq <- c(current_seq, prev_seq)}
   } else if(prev_dist > next_dist){
     for(i in 1:5){
       next_seq <- input[line+i,]$condition
       current_seq <- c(current_seq, next_seq)}
   }
   sequence_matrix <- rbind(sequence_matrix, current_seq)
  }
 colnames(sequence_matrix) <- c("p0", "p1", "p2", "p3", "p4", "p5")
 sequence_matrix
}

修改后的代码：

library(dplyr)
islessthan <- abs(df$V2-lead(df$V2)) < abs(df$V2-lag(df$V2))

ans <- lapply(seq_along(islessthan), function(i) if (is.na(islessthan[i])) {
   NA
} else if(islessthan[i]==FALSE) {
c(df$V4[i], head(lag(df$V4, pmax(6-i, 0)), 5))
} else {
c(df$V4[i], head(lead(df$V4, i), 5))
})

Answer 1

利用 dplyr::lead/lag 功能发挥你的优势

您的数据

df <- read.table(text="weather    146   17   Rainy 
weather    147   17   Rainy 
weather    163   16   Sunny 
weather    173   15   Sunny 
weather    176   15   Rainy   
weather    197   12   Rainy", header=FALSE, stringsAsFactors=F)

判断每一行（0行）是否有+1-row < -1-row

library(dplyr)
islessthan <- lead(df$V2) < lag(df$V2)
# [1]    NA FALSE FALSE FALSE FALSE    NA

使用 lapply 遍历上面创建的逻辑向量和您的数据框。 is.na(row) == TRUE 将 return NA 的行； islessthan == FALSE 的行 return 0-row + +5-rows of column V4；以及 islessthan == TRUE 将 return -5-rows of column V4 + 0-row

的行

ans <- lapply(seq_along(islessthan), function(i) if (is.na(islessthan[i])) {
                                    NA
                                } else if(islessthan[i]==FALSE) { 
                                    c(df$V4[i], head(lead(df$V4, i), 6))
                                } else { 
                                    c(head(lag(df$V4, 6-i), 6))
                                })

输出

# [[1]]
# [1] NA

# [[2]]
# [1] "Rainy" "Sunny" "Sunny" "Rainy" "Rainy" NA      NA     

# [[3]]
# [1] "Sunny" "Sunny" "Rainy" "Rainy" NA      NA      NA     

# [[4]]
# [1] "Sunny" "Rainy" "Rainy" NA      NA      NA      NA     

# [[5]]
# [1] "Rainy" "Rainy" NA      NA      NA      NA      NA     

# [[6]]
# [1] NA

请注意，您尚未指定如何处理边缘情况（第 1 行和第 N 行），并且您的示例没有足够的观察结果来 return 一个完整的向量，因此， NAs 作为填充符出现在输出中。

函数中的 R 向量化实现

R vectorization implementation in a function

performance

r

function

vectorization

large-data