Data.table vs dplyr: применить функцию, возвращающую изменение имен столбцов в группах

Вы можете попробовать лучше ratefunc.

> ratefunc <- function(data, x_col = "x", y_col = "y") {
+   res <- sum(data[[x_col]] + data[[y_col]])
+   o <- t(array(, c(2L, nrow(data)), list(c('a', 'b'), NULL)))
+   if (res < 25) {
+       o[, 'a'] <- 'a'
+   } else {
+       o[, 'b'] <- 'b'
+   }
+   o |> as.data.frame()
+ }
> 
> dt[
+   ,
+   ratefunc(
+     data=.SD
+   )
+   ,
+   by=group
+ ]
    group      a      b
   <char> <char> <char>
1:      A      a   <NA>
2:      A      a   <NA>
3:      A      a   <NA>
4:      B   <NA>      b
5:      B   <NA>      b
6:      B   <NA>      b

Ваш ratefunc — это не то, что я бы создал. Я бы сделал что-то вроде этого. При необходимости это можно обернуть в функцию.

dt[, tmp := fifelse(sum(Reduce(`+`, .SD)) < 25, "a", "b"), 
   by = group, .SDcols = c("x", "y")]
dt[, ind := .I]
dcast(dt, group + ind ~ tmp, value.var = "tmp")
#Key: <group, ind>
#    group   ind      a      b
#   <char> <int> <char> <char>
#1:      A     1      a   <NA>
#2:      A     2      a   <NA>
#3:      A     3      a   <NA>
#4:      B     4   <NA>      b
#5:      B     5   <NA>      b
#6:      B     6   <NA>      b

Изменить адрес дополнительных требований из комментариев:

dt[, colnames := fifelse(sum(Reduce(`+`, .SD)) < 25, "col1", "col2"), 
   by = group, .SDcols = c("x", "y")]

dt[data.table(colnames = c("col1", "col2"),
              colvalues = c("a", "b")), 
   colvalues := i.colvalues, on = .(colnames)]

dt[, ind := .I]
dcast(dt, group + ind ~ colnames, value.var = "colvalues")
# Key: <group, ind>
#     group   ind   col1   col2
#    <char> <int> <char> <char>
# 1:      A     1      a   <NA>
# 2:      A     2      a   <NA>
# 3:      A     3      a   <NA>
# 4:      B     4   <NA>      b
# 5:      B     5   <NA>      b
# 6:      B     6   <NA>      b

Вот еще один подход:

library(data.table)

dt <- data.table:::data.table(
  group=c(rep("A", 3), rep("B", 3)), 
  x=c(1:3, 6:8), 
  y=c(4:6, 9:11)
)

ratefunc <- function(data, x_col = "x", y_col = "y") {
  DT <- copy(data) # avoid modifying dt
  DT[, c("a", "b") := .(
    fifelse(sum(.SD) < 25L, yes = "a", no = NA_character_),
    fifelse(sum(.SD) < 25L, yes = NA_character_, no = "b")
  ), .SDcols = c(x_col, y_col) , by = group][, c(x_col, y_col) := NULL]
}

resultDT <- ratefunc(dt, x_col = "x", y_col = "y")
resultDT[]

Альтернатива: применяется непосредственно к dt:

x_col <- "x"
y_col <- "y"

dt[, c("a", "b") := .(
  fifelse(sum(.SD) < 25L, yes = "a", no = NA_character_),
  fifelse(sum(.SD) < 25L, yes = NA_character_, no = "b")
), .SDcols = c(x_col, y_col) , by = group][, c(x_col, y_col) := NULL]

Тест (возможно, вам придется проверить, как он масштабируется с вашими данными):

Unit: milliseconds
               expr     min      lq    mean  median      uq     max neval
 B.ChristianKamgang  1.0797  1.0797  1.0797  1.0797  1.0797  1.0797     1
             Roland  4.5069  4.5069  4.5069  4.5069  4.5069  4.5069     1
             jay.sf 15.7749 15.7749 15.7749 15.7749 15.7749 15.7749     1
      ismirsehregal  1.5379  1.5379  1.5379  1.5379  1.5379  1.5379     1

library(data.table)
library(microbenchmark)

dt <- data.table:::data.table(
  group = c(rep("A", 3), rep("B", 3)),
  x = c(1:3, 6:8),
  y = c(4:6, 9:11)
)

dt1 <- copy(dt)
dt2 <- copy(dt)
dt3 <- copy(dt)
dt4 <- copy(dt)

ratefunc_jay.sf <- function(data, x_col = "x", y_col = "y") {
  res <- sum(data[[x_col]] + data[[y_col]])
  o <- t(array(, c(2L, nrow(data)), list(c('a', 'b'), NULL)))
  if (res < 25) {
    o[, 'a'] <- 'a'
  } else {
    o[, 'b'] <- 'b'
  }
  o |> as.data.frame()
}

microbenchmark(
  B.ChristianKamgang = {
    res <- dt4[, if (sum(.SD) > 25) 
      .(a = rep("a", .N), b = NA_character_) 
      else 
        .(a = NA_character_, b = rep("b", .N)), 
      by = group, 
      .SDcols = c("x", "y")]
  },
  Roland = {
    dt1[, tmp := fifelse(sum(Reduce(`+`, .SD)) < 25, "a", "b"), by = group, .SDcols = c("x", "y")]
    dt1[, ind := .I]
    dcast(dt1, group + ind ~ tmp, value.var = "tmp")
  },
  jay.sf = {
    dt2[, ratefunc_jay.sf(data = .SD), by = group]
  },
  ismirsehregal = {
    dt3[, c("a", "b") := .(
      fifelse(sum(.SD) < 25L, yes = "a", no = NA_character_),
      fifelse(sum(.SD) < 25L, yes = NA_character_, no = "b")
    ), .SDcols = c("x", "y") , by = group][, c("x", "y") := NULL]
  },
  times = 1L
)

Я не думаю, что создавать функцию для этой проблемы — хорошая идея, но если вы считаете обратное, вам нужно будет изменить ее (см. конец ответа):

Найдите способ решить свою проблему ниже:

Если вы хотите добавить новые столбцы в свой набор данных, используйте

dt[, a := if (sum(.SD) > 25L) "a", by=group, .SDcols=c("x", "y")][is.na(a), b := "b"]

или функцию ниже (более динамичную/гибкую):

ratefunc = function(dt, x_col = "x", y_col = "y", nm1, nm2, val1, val2) {
    dt[, (nm1) := if (sum(x_col, y_col) > 25L) val1, by=group, env=list(x_col=x_col, y_col=y_col, val1=I(val1))]
    dt[is.na(nm1), (nm2) := val2, env=list(nm1=nm1, val2=I(val2))][]  
}

ratefunc(dt=dt, nm1 = "a", nm2 = "b", val1 = "a", val2 = "b")

    group     x     y      a      b
   <char> <int> <int> <char> <char>
1:      A     1     4   <NA>      b
2:      A     2     5   <NA>      b
3:      A     3     6   <NA>      b
4:      B     6     9      a   <NA>
5:      B     7    10      a   <NA>
6:      B     8    11      a   <NA>

В противном случае используйте:

dt[, if (sum(.SD) > 25) 
     .(a = rep("a", .N), b = NA_character_) 
     else 
     .(a = NA_character_, b = rep("b", .N)), 
   by = group, 
   .SDcols = c("x", "y")]

    group      a      b
   <char> <char> <char>
1:      A   <NA>      b
2:      A   <NA>      b
3:      A   <NA>      b
4:      B      a   <NA>
5:      B      a   <NA>
6:      B      a   <NA>

Найдите модифицированную версию вашей функции ниже, если вы предпочитаете использовать ее вместо этого.

ratefunc <- function(data, x_col = "x", y_col = "y") {
  res <- sum(data[[x_col]] + data[[y_col]])
    if (res < 25) {
    return(
      list(a=rep("a", nrow(data)), b=NA_character_)     # modified line
    )
  } else {
    return(
      list(a = NA_character_, b=rep("b", nrow(data)))   # modified line
    )
  }
}

dt[, ratefunc(data=.SD), by=group]