R数据表：使用条件用另一列替换多列中的行值子集答案

【问题标题】：R data table: replace subset of row values across multiple columns using conditional with another columnR数据表：使用条件用另一列替换多列中的行值子集
【发布时间】：2017-03-22 20:28:12
【问题描述】：

这是我在堆栈溢出中的第一篇文章，请原谅任何错误。我对 R 语法和数据表也很陌生。

特别是对于数据表，我想与第五列中的值进行比较，有条件地测试和替换四列中的行值。示例数据如下：

head(loadProfiles)
    load_ev_ag load_ev_res load_ev_res_tou load_ev_workplace maxICA
 1:   8469.231    2317.895        36700.00        220200.000   8808
 2:   8768.000    2609.524        36533.33         36533.333   8768
 3:   8744.000    3168.116        27325.00         10409.524   8744
 4:   7006.452    3810.526        24133.33          3620.000   8688
 5:   5794.595    4660.870        19490.91          2144.000   8576
 6:   6057.143    5888.889        16307.69          2208.333   8480
 7:   7036.667    7279.310        14073.33          2814.667   8444
 8:   8107.692    8107.692        14053.33          3634.483   8432
 9:   8138.462    9200.000        11755.56          3992.453   8464
10:   8173.077   10625.000        10119.05          4427.083   8500

我想做的是在前 4 列中的每一列上循环执行以下操作，将每一列与第五列中的值进行比较。

loadProfiles[load_ev_ag >= maxICA, load_ev_ag := maxICA]

我想要的结果应该如下所示：

head(loadProfiles)
    load_ev_ag load_ev_res load_ev_res_tou load_ev_workplace maxICA
 1:   8469.231    2317.895            8808              8808   8808
 2:   8768.000    2609.524            8768              8768   8768
 3:   8744.000    3168.116            8744              8744   8744
 4:   7006.452    3810.526            8688          3620.000   8688
 5:   5794.595    4660.870            8576          2144.000   8576
 6:   6057.143    5888.889            8480          2208.333   8480
 7:   7036.667    7279.310            8444          2814.667   8444
 8:   8107.692    8107.692            8432          3634.483   8432
 9:   8138.462        8464            8464          3992.453   8464
10:   8173.077        8500            8500          4427.083   8500

我尝试了以下方法，但没有成功：

loadProfileNames <- colnames(loadProfiles)[1:4]
loadProfiles[i = (loadProfileNames) >= maxICA,j = (loadProfileNames) := maxICA]

这会产生以下警告，并将前四列中的所有值更改为第五列中的值

Warning message:
In (loadProfileNames) >= maxICA :
  longer object length is not a multiple of shorter object length

我还尝试了以下操作，将满足 i = (loadProfileNames) >= maxICA 条件的 x 行的子集更改为 maxICA 中的前 x 个条目，而不是 maxICA 中与 x 行子集中的第 i 行对应的值

for(j in loadProfileNames) { set(loadProfiles,i=which(loadProfiles[[j]] >= loadProfiles[["maxICA"]]),j=j,value=loadProfiles[["maxICA"]]) }

并产生以下警告

Warning messages:
1: In set(loadProfiles, i = which(loadProfiles[[j]] >= loadProfiles[["maxICA"]]),  :
  Supplied 288 items to be assigned to 24 items of column 'load_ev_ag' (264 unused)
2: In set(loadProfiles, i = which(loadProfiles[[j]] >= loadProfiles[["maxICA"]]),  :
  Supplied 288 items to be assigned to 108 items of column 'load_ev_res' (180 unused)
3: In set(loadProfiles, i = which(loadProfiles[[j]] >= loadProfiles[["maxICA"]]),  :
  Supplied 288 items to be assigned to 156 items of column 'load_ev_res_tou' (132 unused)
4: In set(loadProfiles, i = which(loadProfiles[[j]] >= loadProfiles[["maxICA"]]),  :
  Supplied 288 items to be assigned to 156 items of column 'load_ev_workplace' (132 unused)

我几乎被困在这一点上。任何指导将不胜感激。

【问题讨论】：

我发现github.com/Rdatatable/data.table/wiki/Getting-started 上的小插曲和文章非常有助于理解data.table 的好处。

标签： r data.table

【解决方案1】：

比使用get()和eval()更“data.table-way”修改loadProfiles通过引用。它使用lapply(.SD, ...) 和.SDcols 来标识要操作的列。使用pmin() 代替ifelse()。

    cols_to_change <- stringr::str_subset(names(loadProfiles), "^load_ev")
    loadProfiles[, (cols_to_change) := lapply(.SD, function(x) pmin(x, maxICA)),
                 .SDcols = cols_to_change]
    loadProfiles
#    load_ev_ag load_ev_res load_ev_res_tou load_ev_workplace maxICA
# 1:   8469.231    2317.895            8808          8808.000   8808
# 2:   8768.000    2609.524            8768          8768.000   8768
# 3:   8744.000    3168.116            8744          8744.000   8744
# 4:   7006.452    3810.526            8688          3620.000   8688
# 5:   5794.595    4660.870            8576          2144.000   8576
# 6:   6057.143    5888.889            8480          2208.333   8480
# 7:   7036.667    7279.310            8444          2814.667   8444
# 8:   8107.692    8107.692            8432          3634.483   8432
# 9:   8138.462    8464.000            8464          3992.453   8464
#10:   8173.077    8500.000            8500          4427.083   8500

上面的代码可以重写为使用set()函数：

for (j in cols_to_change) { 
  set(loadProfiles, ,j = j, value = pmin(loadProfiles[[j]], loadProfiles[["maxICA"]])) 
}

基准测试

受 Frank 的 comment 启发，我想知道在性能方面最好的方法是什么。为了进行基准测试，通过复制 OP 的数据来创建一个包含 100000 行的 data.table。

# create data.table with 100 000 rows
lp <- copy(loadProfiles0)
dummy <- lapply(1:4, function(x) lp <<- 
                  rbindlist(list(lp, lp, lp, lp, lp, lp, lp, lp, lp, lp)))
nrow(lp)
#100000

由于所有方法都修改了loadProfiles，因此我们需要在每次运行前复制一份。复制操作也进行了基准比较。

microbenchmark::microbenchmark(
  copy = loadProfiles <- copy(lp),
  chris = {
    loadProfiles <- copy(lp)
    for (i in cols_to_change) { 
      loadProfiles[get(i) >= maxICA, eval(i) := as.double(maxICA)]
    }
  },
  frank = {
    loadProfiles <- copy(lp)
    for (i in cols_to_change) { 
      loadProfiles[get(i) >= maxICA, (i) := as.double(maxICA)]
    }
  },
  uwe = {
    loadProfiles <- copy(lp)
    loadProfiles[, (cols_to_change) := lapply(.SD, function(x) pmin(x, maxICA)),
                 .SDcols = cols_to_change]
  },
  set = {
    loadProfiles <- copy(lp)
    for (j in cols_to_change) { 
      set(loadProfiles, , j = j, value = pmin(loadProfiles[[j]], loadProfiles[["maxICA"]])) 
    }
  }
)

结果：

#Unit: microseconds
#  expr      min        lq      mean    median        uq        max neval
#  copy  592.427  1007.012  1170.425  1111.224  1238.281   3977.826   100
# chris 8525.045 10614.394 12704.450 11499.447 12152.475 140577.520   100
# frank 4972.000  6799.118  8566.945  7339.060  7819.344 133202.589   100
#   uwe 4201.354  6297.689  6711.409  6585.595  6914.846  10546.996   100
#   set 3716.539  5580.662  7138.738  5907.836  6264.840 127311.557   100

Frank 的 suggestion 将 eval() 从 christoph 的 solution 中删除，速度显着提高。但是，其他两个解决方案仍然更快，set 略领先。

数据

loadProfiles0 <- fread("load_ev_ag load_ev_res load_ev_res_tou load_ev_workplace maxICA
         8469.231    2317.895        36700.00        220200.000   8808
         8768.000    2609.524        36533.33         36533.333   8768
         8744.000    3168.116        27325.00         10409.524   8744
         7006.452    3810.526        24133.33          3620.000   8688
         5794.595    4660.870        19490.91          2144.000   8576
         6057.143    5888.889        16307.69          2208.333   8480
         7036.667    7279.310        14073.33          2814.667   8444
         8107.692    8107.692        14053.33          3634.483   8432
         8138.462    9200.000        11755.56          3992.453   8464
         8173.077   10625.000        10119.05          4427.083   8500")

【讨论】：

其实我觉得在这个和christoph's之间，很难说哪种方式更data.tabley。只修改列的相关部分可以避免复制；对于这样的不等式条件，如果DT[i,j] 中的i 编写正确，则索引可以快速找到相关部分......然后再次，一旦修改列，它的索引就会被破坏，所以也许不是如此重要/有价值。
@Frank 也许，您可能想检查基准测试结果。你有什么建议吗？
有趣。您能否也提供 loadProfiles0 （可能编辑到 OP 中，所以我不必刮掉 OP 或其他什么）？
@Frank Data 添加。
也感谢您添加set() 示例。对于范围蔓延，我深表歉意，但从逻辑上讲，在我看来，在使用来自不同数据表的值对 loadProfiles 执行操作时，还需要使用 set()。例如，在“设置”建议中使用value = pmin(loadProfiles[[j]], differentDataTable[["maxICA"]])。我是否正确，“克里斯”、“坦率”或“uwe”的建议都不能假设differentDataTable[,maxICA]？

【解决方案2】：

您的第一次尝试几乎是正确的：

profilenames <- names(loadProfiles)[1:4]
for (i in profilenames) { 
  loadProfiles[get(i) >= maxICA, eval(i) := as.double(maxICA)]
}

【讨论】：

谢谢克里斯托夫。通过这个例子，我对 get() 和 eval() 有了更好的处理。我想我对何时以及何时不使用 set() 感到困惑。我的印象是在循环中对数据表进行操作时需要 set()。
你可以只使用 (i) := 而不是 eval(i) :=
@christoph 我已将您的代码的基准测试结果和 Frank 的修改添加到我的 answer

【解决方案3】：

您也可以使用lapply 和ifelse 解决这个问题，甚至对data.frames 有效：

loadProfiles[loadProfileNames] <- lapply(loadProfiles[loadProfileNames],
  function (i) ifelse (i >= loadProfiles$maxICA, loadProfiles$maxICA, i))

对于data.tables，.SD 变量是一个很好的资源：

loadProfile[, lapply(.SD, function(i) ifelse(i >= maxICA, maxICA, i)), .SDcols = loadProfileNames]

【讨论】：

谢谢 Uwe Block 和 setempler。关于lapply 和.SD，我有很多话要说。