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

时间:2019-04-03 13:52:11

标签: r conditional

我正在将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是否可行。老实说,任何使它更快的事情将不胜感激。

欢呼

1 个答案:

答案 0 :(得分:3)

这是向量化的解决方案,比您的初始for循环要快(〜40倍)。主要区别是我取出了您最初的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