Как рассчитать переменную, которая выбирает максимальное значение диапазона из нескольких последовательных столбцов

Question

У меня есть датафрейм df, который суммирует почасовые температуры воды на разных глубинах (5 метров T5, 15 метров T15, 25 метров T25 и 35 метров T35) за несколько месяцев. В качестве примера:

df<- data.frame(DateTime=c("2018-08-09 08:00:00","2018-08-09 09:00:00","2018-08-09 10:00:00","2018-08-09 11:00:00","2018-08-09 12:00:00","2018-08-09 13:00:00"),
                T5=c(14.5,18.4,21.3,27.8,16.5,21.5),
                T15=c(13.8,16.3,16.2,17.8,19.3,20.1),
                T25=c(16.0,17.2,18.3,15.9,21.4,17.3),
                T35=c(16.1,15.7,16.2,15.6,17.0,16.3))

df$DateTime<- as.POSIXct(df$DateTime, formtat="%Y-%m-%d %H:%M:%S",tz="UTC")

df

             DateTime   T5  T15  T25  T35
1 2018-08-09 08:00:00 14.5 13.8 16.0 16.1
2 2018-08-09 09:00:00 18.4 16.3 17.2 15.7
3 2018-08-09 10:00:00 21.3 16.2 18.3 16.2
4 2018-08-09 11:00:00 27.8 17.8 15.9 15.6
5 2018-08-09 12:00:00 16.5 19.3 21.4 17.0
6 2018-08-09 13:00:00 21.5 20.1 17.3 16.3

Я хочу вычислить некоторые переменные, связанные с разницей температур между глубинами. Я хотел бы рассчитать переменную «Максимальный шанс температуры воды в столбце» (MWTCC), которая отражает максимальное изменение температуры воды между столбцами ПОСТОЯННЫЕ для всего столбца воды. Позже я хотел бы также рассчитать переменную «Изменение температуры воды от 5 до 15 метров» (WTC10), «Изменение температуры воды от 15 до 25 метров» (WTC20) и «Изменение температуры воды от 25 до35 метров "(WTC30). Я ожидал бы следующий результат из упомянутого примера:

> df
             DateTime   T5  T15  T25  T35 MWTCC WTC10 WTC20 WTC30
1 2018-08-09 08:00:00 14.5 13.8 16.0 16.1   2.2   0.7   2.2   0.1
2 2018-08-09 09:00:00 18.4 16.3 17.2 15.7   2.1   2.1   0.9   1.5
3 2018-08-09 10:00:00 21.3 16.2 18.3 16.2   5.1   5.1   2.1   2.1
4 2018-08-09 11:00:00 27.8 17.8 15.9 15.6  10.0  10.0   1.9   0.3
5 2018-08-09 12:00:00 16.5 19.3 21.4 17.0   4.4   2.8   2.1   4.4
6 2018-08-09 13:00:00 21.5 20.1 17.3 16.3   2.8   1.4   2.8   1.0

Есть ли простой и быстрый способ вычислить все? Я особенно заинтересован в использовании пакета data.table, хотя любой способ может быть в порядке.

Заранее спасибо

Answer 1

В базе R мы можем использовать apply построчно для вычисления различий

df[c("MWTCC", "WTC10","WTC20", "WTC30")] <- t(apply(df[-1], 1, function(x) {
     vals <- abs(diff(x))
     c(max(vals), vals)
}))

df
#             DateTime   T5  T15  T25  T35 MWTCC WTC10 WTC20 WTC30
#1 2018-08-09 08:00:00 14.5 13.8 16.0 16.1   2.2   0.7   2.2   0.1
#2 2018-08-09 09:00:00 18.4 16.3 17.2 15.7   2.1   2.1   0.9   1.5
#3 2018-08-09 10:00:00 21.3 16.2 18.3 16.2   5.1   5.1   2.1   2.1
#4 2018-08-09 11:00:00 27.8 17.8 15.9 15.6  10.0  10.0   1.9   0.3
#5 2018-08-09 12:00:00 16.5 19.3 21.4 17.0   4.4   2.8   2.1   4.4
#6 2018-08-09 13:00:00 21.5 20.1 17.3 16.3   2.8   1.4   2.8   1.0

Answer 2

Другое базовое решение, которое должно быть довольно производительным:

#define columns to help automate
cols <- grep('^T', names(df))
Ts <- as.integer(substring(names(df)[cols], 2))
new_cols <- paste0('WTC', Ts[-1] - Ts[1])

# do the column difference calculation
df[, new_cols] <- abs(df[, cols[-1]] - df[, cols[-length(cols)]])
df[['MWTCC']] <- do.call(pmax, df[, new_cols])

df

data.table несколько сложнее с этим подходом из-за способа обработки нестандартной оценки. Вот эквивалент:

library(data.table)
dt <- as.data.table(df)

dt[, (new_cols) := abs(dt[, .SD, .SDcols = cols[-1]] - dt[, .SD, .SDcols = cols[-length(cols)]])]
dt[, MWTCC := do.call(pmax, .SD)]

# or perhaps this - I assume tidyverse would use purrr::map() in a similar fashion

dt[, (new_cols) := lapply(seq_len(length(cols) - 1),
                          function(i) {
                            abs(dt[[cols[i+1]]] - dt[[cols[i]]])
                          }
                          )]
dt[, MWTCC := do.call(pmax, .SD)]

---

edit: добавлены некоторые тайминги для справки:

set.seed(0L)
nr <- 1e6
df <- data.frame(T5=rnorm(nr), T15=rnorm(nr), T25=rnorm(nr), T35=rnorm(nr))
cols <- c("T5", "T15", "T25", "T35")
cols <- grep('^T', names(df))
Ts <- as.integer(substring(names(df)[cols], 2))
new_cols <- paste0('WTC', Ts[-1] - Ts[1])

library(data.table)
dt <- as.data.table(df)


mtd0 <- function() {
    df[c("MWTCC", new_cols)] <- t(apply(df[cols], 1, function(x) {
        vals <- abs(diff(x))
        c(max(vals), vals)
    }))
    df
}

mtd2 <- function() {
    # do the column difference calculation
    df[, new_cols] <- abs(df[, cols[-1]] - df[, cols[-length(cols)]])
    df[['MWTCC']] <- do.call(pmax, df[, new_cols])

    df[, c(names(df)[cols], 'MWTCC', new_cols)]
}

mtd_DT <- function() {

    dt[, (new_cols) := abs(dt[, .SD, .SDcols = cols[-1]] - dt[, .SD, .SDcols = cols[-length(cols)]])]
    dt[, MWTCC := do.call(pmax, .SD)]

    # or perhaps this - I assume tidyverse would use purrr::map() in a similar fashion

    dt[, (new_cols) := lapply(seq_len(length(cols) - 1),
        function(i) {
            abs(dt[[cols[i+1]]] - dt[[cols[i]]])
        }
    )]
    dt[, MWTCC := do.call(pmax, .SD)]   
}

bench::mark(mtd0(), mtd2(), mtd_DT(), check=FALSE)

тайминги:

# A tibble: 3 x 13
  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result                   memory                time     gc              
  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list>                   <list>                <list>   <list>          
1 mtd0()        14.1s    14.1s    0.0707   405.8MB     4.39     1    62      14.1s <df[,8] [1,000,000 x 8]> <df[,3] [46,873 x 3]> <bch:tm> <tibble [1 x 3]>
2 mtd2()       30.7ms   42.9ms   16.6       57.2MB     3.69     9     2    542.5ms <df[,8] [1,000,000 x 8]> <df[,3] [8 x 3]>      <bch:tm> <tibble [9 x 3]>
3 mtd_DT()    170.4ms  172.6ms    4.85     215.7MB     6.47     3     4      618ms <df[,8] [1,000,000 x 8]> <df[,3] [588 x 3]>    <bch:tm> <tibble [3 x 3]>