R 使用嵌套 If 语句简化大型数据集

R Streamline Large Dataset with Nested If Statements

我正在将 SAS 脚本转录到 R 中,想知道是否有更简化的方法 运行 通过多个条件语句

我有一个包含近 900,000 行和 44 列的数据框,因此 for 循环将永远持续下去。下面是我的数据的一个子集,其中包含我将使用的脚本版本。我 运行 关注的一个主要问题是如何在 if 语句中执行第 7-10 行以创建值,然后在层次结构中使用这些值。

dt <- data.frame(v1 = c(0.0449, 0.0462, 0.1899, 0.2074, 0.1778), 
              v2 = c(0.8637, 0.9417, 0.4258, 0.7083, 0.6962), 
              v3 = c(0,0, 0.2501, 0.0474, 0.126))

for(i in seq_len(nrow(dt))){
  if(sum(dt$v1[i],dt$v2[i],dt$v3[i], na.rm = T) >= 0.5){
    dt$scale[i] = 1/sum(dt$v1[i],dt$v2[i],dt$v3[i], na.rm = T)
    dt$v1_scale[i] <- dt$v1[i] * dt$scale[i]
    dt$v2_scale[i] <- dt$v2[i] * dt$scale[i]
    dt$v3_scale[i] <- dt$v3[i] * dt$scale[i]

    if(dt$v1_scale[i] >= 0.75){
      dt$cat[i] <- "D"
    } else if(dt$v2_scale[i] >= 0.9){
      dt$cat[i] <- "F2"
    }else if(dt$v2_scale[i] >= 0.75){
      dt$cat[i] <- "F1"
    } else if(dt$v3_scale[i] >= 0.75){
      dt$cat[i] <- "A"
    } else if(dt$v3_scale[i] >= max(dt$v1_scale[i], dt$v2_scale[i], na.rm = T)){
      if(dt$v1_scale[i] >= dt$v2_scale[i]){
        dt$cat[i] <- "B"
      } else{
        dt$cat[i] <- "C"
      }
    } else if(dt$v1_scale[i] >= max(dt$v3_scale[i], dt$v2_scale[i], na.rm = T)){
      if(dt$v3_scale[i] >= dt$v2_scale[i]){
        dt$cat[i] <- "B"
      } else{
        dt$cat[i] <- "E"
      }
    } else if(dt$v3_scale[i] >= dt$v1_scale[i]){
      dt$cat[i] <- "C"
    } else{
      dt$cat[i] <- "E"
    }
  }
}

我最近一直在尝试了解有关 data.table API 的更多信息,因此我很想知道 data.table API 是否可行。老实说,如果能加快速度,我们将不胜感激。

干杯

这是一个矢量化解决方案,它比您最初的 for 循环快得多 (~40x)。主要区别是我去掉了你最初的 if 条件,因为那似乎没用。即使在某些情况下条件不成立,这些情况也可以在以后以矢量化的方式删除。这减少了计算负担。我还包括了一个基准测试以供比较。对其进行测试,看看您是否获得任何计算优势。

dt=data.frame(v1 = c(0.0449, 0.0462, 0.1899, 0.2074, 0.1778), 
              v2 = c(0.8637, 0.9417, 0.4258, 0.7083, 0.6962), 
              v3 = c(0,0, 0.2501, 0.0474, 0.126))
dt.sum <- rowSums(dt)
scale <- 1/dt.sum
v1_scale <- scale * dt$v1
v2_scale <- scale * dt$v2
v3_scale <- scale * dt$v3
cat <- rep("E", nrow(dt))

cat <- sapply(seq_along(cat), function(i) {
  if(v1_scale[i] >= 0.75) {
    "D"
  } else if(v2_scale[i] >= 0.9){
    "F2"
  } else if(v2_scale[i] >= 0.75){
    "F1"
  } else if(v3_scale[i] >= 0.75){
    "A"
  } else if(v3_scale[i] >= max(v1_scale[i], v2_scale[i], na.rm = T)){
    if(v1_scale[i] >= v2_scale[i]){
      "B"
    } else {
      "C"
    }
  } else if(v1_scale[i] >= max(v3_scale[i], v2_scale[i], na.rm = T)){
    if(v3_scale[i] >= v2_scale[i]){
      "B"
    }
  } else if(v3_scale[i] >= v1_scale[i]){
    "C"
  } else {
    "E"
  }
}
)

dt <- data.frame(dt, scale, v1_scale, v2_scale, v3_scale, cat, stringsAsFactors = F)

微基准测试

Unit: microseconds
     expr       min         lq       mean     median         uq      max neval
 original 33401.067 36136.9285 38588.6041 38226.7850 39607.3545 95425.23   100
 modified   688.127   762.4395   962.0771   847.9485   901.8755 12690.76   100