我有一个数据框df
,它总结了不同深度(5米T5
,15米T15
,25米T25
和35米{{1 }})。例如:
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
),该变量反映整个水列中CONSECUTIVE列之间的最大水温变化。稍后,我还要计算变量“ 5至15米之间的水温变化”(MWTCC
),“ 15至25米之间的水温变化”(WTC10
)和“水温”在25至35米之间切换”({{1})。我希望从上述示例中得到下一个结果:
WTC20
是否有任何简便快速的方法来计算全部?我对使用软件包WTC30
尤其感兴趣,尽管任何方法都可以。
预先感谢
答案 0 :(得分:5)
在基数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
答案 1 :(得分: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)]
编辑:添加了一些参考时间:
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]>