简体   繁体   中英

apply custom function to a particular column rowise by group in data.table

I had a function to find the max value until current row number.

dt<- setDT(copy(mtcars),keep.rownames = TRUE)

apply(as.matrix(dt$rn), 1, function(x) {
 index = as.numeric(ifelse(match(x, dt$rn) == 1, 2, match(x, dt$rn)))
 max(dt[1:index-1,"mpg",with = FALSE])
 })
   # [1] 21.0 21.0 21.0 22.8 22.8 22.8 22.8 22.8 24.4 24.4 24.4 24.4 24.4 24.4 24.4 24.4 24.4 24.4 32.4 32.4 33.9 33.9 33.9 33.9 33.9 33.9 33.9 33.9 33.9 33.9 33.9
   # [32] 33.9

However, I would like to repeat the same based on a particular group say 'gear'. How would I modify the code. I feel it has to do with something like this.

dt[,max:=lapply(.SD,function(x){
         index = as.numeric(ifelse(match(x,dt$rn) == 1, 2, match(x, dt$rn)))
      return(max(dt[1:index-1,"mpg",with = FALSE]))
      }),by = gear,.SDcols = "rn"]

I feel I may be missing something..

Not sure in data.table, but relatively straightforward in dplyr . Set group_by then mutate which operates within the group.

res <-
  mtcars %>%
  group_by(gear) %>%
  mutate(currMax = cummax(mpg))

Here is a subset of the result, achieved with:

res %>%
  select(gear, mpg, currMax) %>%
  slice(1:3)

To limit the result to relevant columns and the first three rows from each group.

   gear   mpg currMax
  <dbl> <dbl>   <dbl>
1     3  21.4    21.4
2     3  18.7    21.4
3     3  18.1    21.4
4     4  21.0    21.0
5     4  21.0    21.0
6     4  22.8    22.8
7     5  26.0    26.0
8     5  30.4    30.4
9     5  15.8    30.4

If you want the maximum value for every row up to, but not including, the current row, you will need to do a bit more manipulating. Specifically, cummax does not have built in handling of NA and by definition your first value needs to be NA . So, I wrote a small function that temporarily changes NA to negative infinity, then sets those entries to NA before returning (this will be a problem if and only if your data actually has -Inf values, and even then only if they are first in the data). Then, I use that function as the trailing max:

my_cummax <- function(x){
  x <- ifelse(is.na(x), -Inf, x)
  out <- cummax(x)
  out[out == -Inf] <- NA
  return(out)
}

mtcars %>%
  group_by(gear) %>%
  mutate(currMax = cummax(mpg)
         , trailMax = my_cummax(lag(mpg)))

A limited slice of the return, similar to above, shows:

   gear   mpg currMax trailMax
  <dbl> <dbl>   <dbl>    <dbl>
1     3  21.4    21.4       NA
2     3  18.7    21.4     21.4
3     3  18.1    21.4     21.4
4     4  21.0    21.0       NA
5     4  21.0    21.0     21.0
6     4  22.8    22.8     21.0
7     5  26.0    26.0       NA
8     5  30.4    30.4     26.0
9     5  15.8    30.4     30.4

a data.table solution

dt[, currMax := cummax(shift(mpg, fill = -Inf)), by = gear], 
head(dt)
#                      rn  mpg cyl disp  hp drat    wt  qsec vs am gear carb currMax
# 1:         Mazda RX4 21.0   6  160 110 3.90 2.620 16.46  0  1    4    4    -Inf
# 2:     Mazda RX4 Wag 21.0   6  160 110 3.90 2.875 17.02  0  1    4    4    21.0
# 3:        Datsun 710 22.8   4  108  93 3.85 2.320 18.61  1  1    4    1    21.0
# 4:    Hornet 4 Drive 21.4   6  258 110 3.08 3.215 19.44  1  0    3    1    -Inf
# 5: Hornet Sportabout 18.7   8  360 175 3.15 3.440 17.02  0  0    3    2    21.4
# 6:           Valiant 18.1   6  225 105 2.76 3.460 20.22  1  0    3    1    21.4

Thanks @DavidArenburg for the edit.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM