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

library(dtplyr)

agg_dtyplr <- function(dt,mass, ratio = 2 / 3) {
  
  lazy_dt(dt) |> group_by(group, species, year)   |>
    summarise(
       total = sum({{mass}}, na.rm = TRUE),
    
       n_female = sum(1 * (sex == "female"),na.rm=TRUE),
       n = n())|> 
      mutate(
       flag = if_else(n_female >= ratio * n,
         "F", "M"
       )
     ) |> 
    select(group,species,year,total,flag) |> 
   as.data.table()
}

  agg_dtyplr(penguin_table,body_mass_g)

Вот более быстрая функция.
Он не создает, а затем подмножество data. Он работает непосредственно с входными векторами.

library(data.table)
library(palmerpenguins)

# Create data
GROUPS <- 1:100
penguin_list <- lapply(GROUPS, \(x) data.table(group = x, penguins))
penguin_table <- rbindlist(penguin_list)

# Aggregation function (OP)
aggregatePenguinMass <- function(mass, sex, ratio = 2/3){
  data <- data.table(mass, sex)
  
  total <- sum(data[,mass], na.rm = TRUE)
  
  n_sex <- data[,.N, by = sex]
  n_male <- n_sex[sex == "male", N]
  n_female <- n_sex[sex == "female", N]
  
  if (n_female >= ratio * (n_male + n_female)){
    return(data.table(total = total,
                      flag = "F"))
  } else {
    return(data.table(total = total,
                      flag = "M"))
  }
}

# Aggregation function 2
aggregatePenguinMass2 <- function(mass, sex, ratio = 2/3){
  i <- !is.na(mass) & !is.na(sex)  
  total <- sum(mass[!is.na(mass)])
  
  f <- sum(sex[i] == "female")  
  if (f >= ratio * total){
    data.table(total = total, flag = "F")
  } else {
    data.table(total = total, flag = "M")
  }
}

# Perform aggregation and time
system.time(
  res <- penguin_table[, aggregatePenguinMass(body_mass_g, sex), by = .(group, species, year)]
)
#>    user  system elapsed 
#>    0.41    0.08    2.40

system.time(
  res2 <- penguin_table[, aggregatePenguinMass2(body_mass_g, sex), by = .(group, species, year)]
)
#>    user  system elapsed 
#>    0.04    0.00    0.11

all.equal(res, res2)
#> [1] TRUE

^{Created on 2024-07-11 with reprex v2.1.0}

В этом случае с dplyr работать быстрее:

Оригинальная версия

system.time(
  a<- penguin_table[, aggregatePenguinMass(body_mass_g, sex), by = .(group, species, year)]
)

#user  system elapsed 
#1.45    0.47    1.61 

Использование dplyr Включая пару оптимизаций в суммирование

library(dplyr)

aggregatePenguinMass2 <- function(mass, sex, ratio = 2/3){
  total <- sum(mass, na.rm = TRUE)
  n_sex <- table(sex)

  n_male <- n_sex["male"]
  n_female <- n_sex["female"]
  
  if (n_female >= ratio * sum(n_sex)){
    return(data.table(total = total,
                      flag = "F"))
  } else {
    return(data.table(total = total,
                      flag = "M"))
  }
}

system.time(
 b <- penguin_table %>% summarise(aggregatePenguinMass2(body_mass_g, sex), .by = c(group, species, year))
)

#user  system elapsed 
#0.19    0.00    0.19 

all.equal(as.data.frame(a), b)
#[1] TRUE

Преобразование в data.table в конце мало влияет на время, если важно иметь вывод в этом формате.

Пара более быстрых вариантов. Опция 1:

ratio <- 2/3
r <- 2 - ratio

jblood1 <- function() {
  penguin_table[, s := match(sex, c("female", "male"))][
    ,.(total = sum(body_mass_g, na.rm = TRUE),
       flag = if (mean(s, na.rm = TRUE) > r) "M" else "F"),
    .(group, species, year)
  ]
}

microbenchmark::microbenchmark(
  base(),
  jblood1(),
  check = "equal",
  times = 10
)
#> Unit: milliseconds
#>       expr      min        lq       mean     median        uq       max neval
#>     base() 1546.044 1554.1209 1582.18637 1569.23260 1606.2057 1661.9998    10
#>  jblood1()    7.428    7.5738   10.16692    8.15465   11.2894   20.9406    10

Вариант 2 работает еще быстрее, поскольку полностью исключает операции группировки с помощью сортировки за счет дополнительной сложности:

jblood2 <- function() {
  setorder(penguin_table, group, species, year)[
    , `:=`(csSex = cumsum(c(1, 1i, 0)[match(sex, c("female", "male", NA))]),
           csMass = fcumsum(body_mass_g))
  ][
    (grp <- rleid(group, species, year)) != shift(grp, -1, 0L),
    .(group, species, year, total = diff(c(0, csMass)),
      flag = fifelse(Im(d <- diff(c(0, csSex)))/Re(d) > 1/ratio - 1, "M", "F"))
  ]
}

all.equal(setorder(jblood1(), group, species, year), jblood2())
#> [1] TRUE

microbenchmark::microbenchmark(
  jblood1(),
  jblood2()
)
#> Unit: milliseconds
#>       expr    min      lq     mean  median      uq     max neval
#>  jblood1() 7.2552 7.45605 8.469040 7.75345 8.21155 12.9634   100
#>  jblood2() 2.6411 2.82530 3.122956 3.06550 3.37760  4.5615   100

Использование коллапса с Rcpp:

library(collapse)
penguin_table |>
  fgroup_by(group, species, year) |>
  fsummarise(total = fsum(body_mass_g, na.rm = TRUE), flag = create_flag(sex))

Или, альтернативно, с помощью data.table (медленнее по данным, но может лучше масштабироваться (?))

penguin_table[, .(sum(body_mass_g, na.rm = TRUE), flag = create_flag(sex)),
              .(group, species, year)]

Где

Rcpp::cppFunction("char create_flag(const SEXP sex_vector, const double ratio = 2.0 / 3.0) {
  int m = 0;
  int f = 0;
  
  const R_xlen_t n = XLENGTH(sex_vector);
  const int* sex_ptr = INTEGER(sex_vector);
  
  for (R_xlen_t i = 0; i < n; i++) {
    int val = sex_ptr[i];
    if (val == NA_INTEGER) {
      continue;
    } else if (val == 1) {
      f += 1;
    } else {
      m += 1;
    }
  }
  
  return (f >= ratio * (f + m)) ? 'F' : 'M';
}")

Тесты

microbenchmark::microbenchmark(
  op = penguin_table[, aggregatePenguinMass(body_mass_g, sex), by = .(group, species, year)],
  sb = penguin_table |>
    fgroup_by(group, species, year) |>
    fsummarise(total = fsum(body_mass_g, na.rm = TRUE), flag = create_flag(sex)),
  sbdt = penguin_table[, .(sum(body_mass_g, na.rm = TRUE), flag = create_flag(sex)),
                       .(group, species, year)],
  times = 10
)

# Unit: milliseconds
#  expr       min        lq       mean     median        uq       max neval
#    op 1421.3494 1475.1812 1495.12772 1510.03970 1528.2198 1537.4873    10
#    sb    1.7398    1.7904    1.91444    1.84415    1.9116    2.5670    10
#  sbdt    3.3524    3.3710    3.78065    3.62835    4.1727    4.6842    10