R语言循环函数提速及向量化改写技术求助

Loops in R can be painfully slow for large datasets, so let's refactor your code using vectorized operations and optimized functions to get a massive speed boost. Here's how to do it:

1. Optimizing the Accels Column Calculation #

First, let's break down the logic of your original loop to make sure we replicate it exactly:

• Start with Accels[1] = 0
• For each subsequent row:
  • Set to 0 if Acceleration[i] <= 0
  • Set to 2 if:
    • Current and next 4 Acceleration values are >=2, and the previous Accels value was 0
  • Set to 1 if the previous Accels value was >0
  • Otherwise, set to 0

Solution Using Tidyverse & Zoo #

We'll use purrr::accumulate (for efficient recursive state tracking) and zoo::rollapplyr (for vectorized rolling window checks):

# Load required packages (install first if needed: install.packages(c("tidyverse", "zoo")))
library(tidyverse)
library(zoo)

# Your original data
Acceleration <- c(0.16, 0.37, 0.37, 0.48, 1.05, 1.05, 1.93, 2.04, 2.04, 2.07, 2.35, 2.35, 2.03, 1.93, 1.93, 1.75, 1.82, 1.82, 1.49, 0.82, 0.82, 0.34, -1.69, -1.69, -2.62, -2.38, -2.38, -2.01, -0.86, -0.86, 1.14, 0.98, 0.98, 1.69, 1.64, 1.64, 2.16, 2.43, 2.43, 2.52, 2.89, 2.89, 2.25, 2.28, 2.28, 1.76, 1.09, 1.09, 1.56, 1.44, 1.44, 0.85, 1.35, 1.35, 0.78, 0.38, 0.38, 0.11, 0.14, 0.14, -0.78)
Velocity <- c(1.67, 1.77, 1.77, 1.91, 2.19, 2.19, 2.82, 3.05, 3.05, 3.47, 3.79, 3.79, 4.1, 4.26, 4.26, 4.55, 4.76, 4.76, 4.81, 4.8, 4.8, 4.69, 3.86, 3.86, 3.32, 2.89, 2.89, 2.8, 2.91, 2.91, 3.62, 3.67, 3.67, 4.2, 4.34, 4.34, 4.95, 5.27, 5.27, 5.8, 6.2, 6.2, 6.46, 6.69, 6.69, 6.86, 6.76, 6.76, 7.15, 7.26, 7.26, 7.3, 7.59, 7.59, 7.67, 7.59, 7.59, 7.45, 7.48, 7.48, 7.16)
Test <- data.frame(Acceleration, Velocity)

# Step 1: Create a trigger flag for 5 consecutive Acceleration values >=2
Test <- Test %>%
  mutate(trigger = rollapplyr(Acceleration, width = 5, FUN = function(x) all(x >= 2), align = "left", fill = FALSE))

# Step 2: Calculate Accels using accumulate for efficient state transitions
Test$Accels <- c(0, accumulate(2:nrow(Test), function(prev_accel, i) {
  acc <- Test$Acceleration[i]
  trig <- Test$trigger[i]
  
  if (acc <= 0) {
    0
  } else if (trig && prev_accel == 0) {
    2
  } else if (prev_accel > 0) {
    1
  } else {
    0
  }
}, .init = 0)[-1])

# Verify it matches your expected output
all(Test$Accels == c(0, 0, 0, 0, 0, 0, 0, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0))
# Should return TRUE

Even Faster with Data.Table (For Large Datasets) #

If you're working with very large data, data.table is unbeatable for speed. Here's the equivalent implementation:

install.packages("data.table")
library(data.table)

setDT(Test)

# Create trigger flag
Test[, trigger := frollapply(Acceleration, n = 5, FUN = function(x) all(x >= 2), align = "left", fill = FALSE)]

# Calculate Accels
Test[, Accels := 0]
for (i in 2:.N) {
  acc <- Acceleration[i]
  trig <- trigger[i]
  prev_accel <- Accels[i-1]
  
  Accels[i] <- case_when(
    acc <= 0 ~ 0,
    trig && prev_accel == 0 ~ 2,
    prev_accel > 0 ~ 1,
    TRUE ~ 0
  )
}

2. Optimizing the Velocity Condition Check #

Your original condition checks if any of the current or next 4 Velocity values are <1.4. We can vectorize this with a rolling window function:

# Using tidyverse/zoo
Test <- Test %>%
  mutate(velocity_flag = rollapplyr(Velocity, width = 5, FUN = function(x) any(x < 1.4), align = "left", fill = FALSE))

# Use this flag in your calculation, e.g.:
Test <- Test %>%
  mutate(new_column = ifelse(velocity_flag, 0, 1)) # Adjust based on your needs

# Using data.table
Test[, velocity_flag := frollapply(Velocity, n = 5, FUN = function(x) any(x < 1.4), align = "left", fill = FALSE)]
Test[, new_column := fifelse(velocity_flag, 0, 1)]

Key Improvements #

• Vectorized Rolling Windows: Replaces manual element-wise checks with optimized functions that process entire vectors at once.
• Efficient State Tracking: accumulate (tidyverse) or optimized data.table loops avoid the slow repeated data frame modifications of your original loop.
• Bug Fix: Your original loop accessed out-of-bounds indices (e.g., i+4 when i is the last row) — our solution handles this gracefully with fill=FALSE.

内容的提问来源于stack exchange，提问作者Aman Shergill