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

Question

我正在将一个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是否可行。老实说，任何使这更快的事情将非常感激。

干杯

Answer 1

这是一个矢量化解决方案，比您最初的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