在 R 中查找具有模式的列 max/min
Find max/min for column with pattern in R
我在开发 data.table 时遇到问题，该 max/min 基于共享名称模式的多个列。
这是一个简化的 table:
int <- seq(as.POSIXct("2016-04-08"), as.POSIXct("2016-04-10"), by="6 h")
df <- data.frame(date = int, x_01 = runif(9), x_02 = runif(9), x_10 = runif(9), b_31 = runif(9))
df$date <- format(as.POSIXct(df$date), format = "%Y-%m-%dM")
我知道如何通过应用以下代码获取汇总统计信息：
sum <- setDT(df)[, list(x_01min=min(x_01), x_01max=max(x_01)), by=list(date)]
我的目标是获取具有模式 "x_" 的所有列的汇总统计信息
我尝试嵌套 for 循环并使用 lapply 和 grep 但似乎无法获得所需的结果。下面的代码应该显示我想要达到的目的。
sum <- setDT(df)[, list(x_01min=min(x_01), x_01max=max(x_01),
x_02min=min(x_02), x_02max=max(x_02),
x_10min=min(x_10), x_10max=max(x_10)), by=list(date)]
理想情况下，摘要 table 的列名称应包含原始 table 中的名称。我的实际数据集由多个数据框组成，这些数据框具有与模式匹配的不同列数。随着我收集更多数据，将添加新变量，因此能够根据 colname 模式执行函数很重要。
感谢您的帮助！
您可以试试这个代码：
## building the data.table
int <- seq(as.POSIXct("2016-04-08"), as.POSIXct("2016-04-10"), by="6 h")
df <- data.frame(date = int, x_01 = runif(9), x_02 = runif(9), x_10 = runif(9), b_31 = runif(9))
df$date <- format(as.POSIXct(df$date), format = "%Y-%m-%dM")
## actual work begins here
library(data.table)
setDT(df)
indices <- grep("x_",colnames(df))
col_names <- colnames(df)[indices]
query_min <- paste0(col_names,'min=min(',col_names,')')
query_max <- paste0(col_names,'max=max(',col_names,')')
query_1 <- paste(c(query_min,query_max),collapse=',')
eval(parse(text=paste0("df[,.(",query_1,"),by=date]")))
## date x_01min x_02min x_10min x_01max x_02max x_10max
##1: 2016-04-08M 0.07527176 0.026276086 0.3315467 0.9404001 0.906662120 0.7069425
##2: 2016-04-09M 0.34796983 0.065390319 0.2437374 0.8130796 0.739978420 0.6760062
##3: 2016-04-10M 0.45671821 0.003374905 0.7245515 0.4567182 0.003374905 0.7245515
library(data.table);
setDT(df); ## ensure df is a data.table
cns <- grep(value=T,'^x_',names(df));
df[,do.call(c,lapply(cns,function(cn) { x <- get(cn); setNames(nm=paste0(cn,c('min','max')),.(min(x),max(x))); })),.(date)];
## date x_01min x_01max x_02min x_02max x_10min x_10max
## 1: 2016-04-08M 0.2655087 0.9082078 0.06178627 0.6870228 0.21214252 0.93470523
## 2: 2016-04-09M 0.2016819 0.9446753 0.38410372 0.7698414 0.12555510 0.65167377
## 3: 2016-04-10M 0.6291140 0.6291140 0.99190609 0.9919061 0.01339033 0.01339033
首先，目标列名是通过使用 value=T 参数调用 grep() 派生的。这些名称存储在全局环境中的 cns 中。
然后，data.table 被编入索引，在 date 上分组。
对于每个组，lapply() 在 cns 向量上执行，将当前列名作为参数 cn。
在 lambda 中，通过在 cn 上调用 get() 来检索列向量并将其存储在局部变量 x 中，因为 data.table列始终对 j 参数表达式可见。
最后，使用 .() 在列表中计算摘要统计信息，并使用 setNames() 设置它们的名称，这允许我们从 cn 和 [=28] 动态计算它们=].
lapply() 调用的结果将是列表的列表，但是因为我们需要为组聚合结果生成单个非嵌套列表，所以我们必须 运行 通过do.call(c,...) 取消嵌套列表。这里的替代方案是 unlist(recursive=F,...)。两种选择都保留嵌套列表的名称，这正是我们想要的。
基准测试
library(data.table);
library(microbenchmark);
bgoldst <- function(df) { cns <- grep(value=T,'^x_',names(df)); df[,do.call(c,lapply(cns,function(cn) { x <- get(cn); setNames(nm=paste0(cn,c('min','max')),.(min(x),max(x))); })),.(date)]; };
kunal <- function(df) { indices <- grep('x_',colnames(df)); col_names <- colnames(df)[indices]; query_min <- paste0(col_names,'min=min(',col_names,')'); query_max <- paste0(col_names,'max=max(',col_names,')'); query_1 <- paste(c(query_min,query_max),collapse=','); eval(parse(text=paste0('df[,.(',query_1,'),by=date]'))); };
psidom <- function(df) { cols <- names(df)[grepl('x_',names(df))]; newCols <- paste0(rep(cols,each=2),c('max','min')); sumFun <- function(col) list(max(col),min(col)); df[,c(newCols):=unlist(lapply(.SD,sumFun),recursive=F),.(date),.SDcols=cols]; unique(df[,.SD,.SDcols=c('date',newCols)]); };
set.seed(1L);
int <- seq(as.POSIXct('2016-04-08'),as.POSIXct('2016-04-10'),by='6 h');
df <- data.frame(date=int,x_01=runif(9L),x_02=runif(9L),x_10=runif(9L),b_31=runif(9L));
df$date <- format(as.POSIXct(df$date),format='%Y-%m-%dM');
setDT(df);
expected <- bgoldst(copy(df)); co <- names(expected);
identical(expected,kunal(copy(df))[,co,with=F]);
## [1] TRUE
identical(expected,psidom(copy(df))[,co,with=F]);
## [1] TRUE
microbenchmark(bgoldst(copy(df)),kunal(copy(df)),psidom(copy(df)));
## Unit: milliseconds
## expr min lq mean median uq max neval
## bgoldst(copy(df)) 1.397569 1.445893 1.522512 1.490369 1.538908 2.749805 100
## kunal(copy(df)) 1.318453 1.362287 1.483356 1.403555 1.443968 4.733684 100
## psidom(copy(df)) 1.451881 1.532920 1.625494 1.573120 1.624010 3.097487 100
set.seed(1L);
NR <- 500L; NC <- 100L;
df <- data.frame(
date=seq(as.POSIXct('2016-04-08'),by='6 h',len=NR),
setNames(nm=paste0('x_',seq_len(NC)),as.data.frame(replicate(NC,runif(NR)))),
b_31=runif(NR)
);
df$date <- format(as.POSIXct(df$date),format='%Y-%m-%dM');
setDT(df);
expected <- bgoldst(copy(df)); co <- names(expected);
identical(expected,kunal(copy(df))[,co,with=F]);
## [1] TRUE
identical(expected,psidom(copy(df))[,co,with=F]);
## [1] TRUE
microbenchmark(bgoldst(copy(df)),kunal(copy(df)),psidom(copy(df)));
## Unit: milliseconds
## expr min lq mean median uq max neval
## bgoldst(copy(df)) 94.75322 100.94627 106.61343 102.37655 105.89292 164.58885 100
## kunal(copy(df)) 21.38946 23.04383 24.60639 24.20192 25.18723 69.29593 100
## psidom(copy(df)) 45.32431 48.76798 50.63476 49.60532 51.03667 92.41567 100
cols <- names(df)[grepl("x_", names(df))]
newCols <- paste0(rep(cols, each = 2), c("max", "min"))
sumFun <- function(col) list(max(col), min(col))
setDT(df)[, c(newCols) := unlist(lapply(.SD, sumFun), recursive = F), .(date), .SDcols = cols]
sum <- unique(df[, .SD, .SDcols = c("date", newCols)])
> sum
date x_01max x_01min x_02max x_02min x_10max x_10min
1: 2016-04-08M 0.8770486 0.1828969 0.99869872 0.159936264 0.8983131 0.3767007
2: 2016-04-09M 0.6475017 0.1429131 0.57890510 0.007439883 0.9242098 0.1077233
3: 2016-04-10M 0.9176341 0.9176341 0.05900942 0.059009423 0.2717861 0.2717861
我在开发 data.table 时遇到问题，该 max/min 基于共享名称模式的多个列。
这是一个简化的 table:
int <- seq(as.POSIXct("2016-04-08"), as.POSIXct("2016-04-10"), by="6 h")
df <- data.frame(date = int, x_01 = runif(9), x_02 = runif(9), x_10 = runif(9), b_31 = runif(9))
df$date <- format(as.POSIXct(df$date), format = "%Y-%m-%dM")
我知道如何通过应用以下代码获取汇总统计信息：
sum <- setDT(df)[, list(x_01min=min(x_01), x_01max=max(x_01)), by=list(date)]
我的目标是获取具有模式 "x_" 的所有列的汇总统计信息
我尝试嵌套 for 循环并使用 lapply 和 grep 但似乎无法获得所需的结果。下面的代码应该显示我想要达到的目的。
sum <- setDT(df)[, list(x_01min=min(x_01), x_01max=max(x_01),
x_02min=min(x_02), x_02max=max(x_02),
x_10min=min(x_10), x_10max=max(x_10)), by=list(date)]
理想情况下，摘要 table 的列名称应包含原始 table 中的名称。我的实际数据集由多个数据框组成，这些数据框具有与模式匹配的不同列数。随着我收集更多数据，将添加新变量，因此能够根据 colname 模式执行函数很重要。
感谢您的帮助！
您可以试试这个代码：
## building the data.table
int <- seq(as.POSIXct("2016-04-08"), as.POSIXct("2016-04-10"), by="6 h")
df <- data.frame(date = int, x_01 = runif(9), x_02 = runif(9), x_10 = runif(9), b_31 = runif(9))
df$date <- format(as.POSIXct(df$date), format = "%Y-%m-%dM")
## actual work begins here
library(data.table)
setDT(df)
indices <- grep("x_",colnames(df))
col_names <- colnames(df)[indices]
query_min <- paste0(col_names,'min=min(',col_names,')')
query_max <- paste0(col_names,'max=max(',col_names,')')
query_1 <- paste(c(query_min,query_max),collapse=',')
eval(parse(text=paste0("df[,.(",query_1,"),by=date]")))
## date x_01min x_02min x_10min x_01max x_02max x_10max
##1: 2016-04-08M 0.07527176 0.026276086 0.3315467 0.9404001 0.906662120 0.7069425
##2: 2016-04-09M 0.34796983 0.065390319 0.2437374 0.8130796 0.739978420 0.6760062
##3: 2016-04-10M 0.45671821 0.003374905 0.7245515 0.4567182 0.003374905 0.7245515
library(data.table);
setDT(df); ## ensure df is a data.table
cns <- grep(value=T,'^x_',names(df));
df[,do.call(c,lapply(cns,function(cn) { x <- get(cn); setNames(nm=paste0(cn,c('min','max')),.(min(x),max(x))); })),.(date)];
## date x_01min x_01max x_02min x_02max x_10min x_10max
## 1: 2016-04-08M 0.2655087 0.9082078 0.06178627 0.6870228 0.21214252 0.93470523
## 2: 2016-04-09M 0.2016819 0.9446753 0.38410372 0.7698414 0.12555510 0.65167377
## 3: 2016-04-10M 0.6291140 0.6291140 0.99190609 0.9919061 0.01339033 0.01339033
首先，目标列名是通过使用 value=T 参数调用 grep() 派生的。这些名称存储在全局环境中的 cns 中。
然后，data.table 被编入索引，在 date 上分组。
对于每个组，lapply() 在 cns 向量上执行，将当前列名作为参数 cn。
在 lambda 中，通过在 cn 上调用 get() 来检索列向量并将其存储在局部变量 x 中，因为 data.table列始终对 j 参数表达式可见。
最后，使用 .() 在列表中计算摘要统计信息，并使用 setNames() 设置它们的名称，这允许我们从 cn 和 [=28] 动态计算它们=].
lapply() 调用的结果将是列表的列表，但是因为我们需要为组聚合结果生成单个非嵌套列表，所以我们必须 运行 通过do.call(c,...) 取消嵌套列表。这里的替代方案是 unlist(recursive=F,...)。两种选择都保留嵌套列表的名称，这正是我们想要的。
基准测试
library(data.table);
library(microbenchmark);
bgoldst <- function(df) { cns <- grep(value=T,'^x_',names(df)); df[,do.call(c,lapply(cns,function(cn) { x <- get(cn); setNames(nm=paste0(cn,c('min','max')),.(min(x),max(x))); })),.(date)]; };
kunal <- function(df) { indices <- grep('x_',colnames(df)); col_names <- colnames(df)[indices]; query_min <- paste0(col_names,'min=min(',col_names,')'); query_max <- paste0(col_names,'max=max(',col_names,')'); query_1 <- paste(c(query_min,query_max),collapse=','); eval(parse(text=paste0('df[,.(',query_1,'),by=date]'))); };
psidom <- function(df) { cols <- names(df)[grepl('x_',names(df))]; newCols <- paste0(rep(cols,each=2),c('max','min')); sumFun <- function(col) list(max(col),min(col)); df[,c(newCols):=unlist(lapply(.SD,sumFun),recursive=F),.(date),.SDcols=cols]; unique(df[,.SD,.SDcols=c('date',newCols)]); };
set.seed(1L);
int <- seq(as.POSIXct('2016-04-08'),as.POSIXct('2016-04-10'),by='6 h');
df <- data.frame(date=int,x_01=runif(9L),x_02=runif(9L),x_10=runif(9L),b_31=runif(9L));
df$date <- format(as.POSIXct(df$date),format='%Y-%m-%dM');
setDT(df);
expected <- bgoldst(copy(df)); co <- names(expected);
identical(expected,kunal(copy(df))[,co,with=F]);
## [1] TRUE
identical(expected,psidom(copy(df))[,co,with=F]);
## [1] TRUE
microbenchmark(bgoldst(copy(df)),kunal(copy(df)),psidom(copy(df)));
## Unit: milliseconds
## expr min lq mean median uq max neval
## bgoldst(copy(df)) 1.397569 1.445893 1.522512 1.490369 1.538908 2.749805 100
## kunal(copy(df)) 1.318453 1.362287 1.483356 1.403555 1.443968 4.733684 100
## psidom(copy(df)) 1.451881 1.532920 1.625494 1.573120 1.624010 3.097487 100
set.seed(1L);
NR <- 500L; NC <- 100L;
df <- data.frame(
date=seq(as.POSIXct('2016-04-08'),by='6 h',len=NR),
setNames(nm=paste0('x_',seq_len(NC)),as.data.frame(replicate(NC,runif(NR)))),
b_31=runif(NR)
);
df$date <- format(as.POSIXct(df$date),format='%Y-%m-%dM');
setDT(df);
expected <- bgoldst(copy(df)); co <- names(expected);
identical(expected,kunal(copy(df))[,co,with=F]);
## [1] TRUE
identical(expected,psidom(copy(df))[,co,with=F]);
## [1] TRUE
microbenchmark(bgoldst(copy(df)),kunal(copy(df)),psidom(copy(df)));
## Unit: milliseconds
## expr min lq mean median uq max neval
## bgoldst(copy(df)) 94.75322 100.94627 106.61343 102.37655 105.89292 164.58885 100
## kunal(copy(df)) 21.38946 23.04383 24.60639 24.20192 25.18723 69.29593 100
## psidom(copy(df)) 45.32431 48.76798 50.63476 49.60532 51.03667 92.41567 100
cols <- names(df)[grepl("x_", names(df))]
newCols <- paste0(rep(cols, each = 2), c("max", "min"))
sumFun <- function(col) list(max(col), min(col))
setDT(df)[, c(newCols) := unlist(lapply(.SD, sumFun), recursive = F), .(date), .SDcols = cols]
sum <- unique(df[, .SD, .SDcols = c("date", newCols)])
> sum
date x_01max x_01min x_02max x_02min x_10max x_10min
1: 2016-04-08M 0.8770486 0.1828969 0.99869872 0.159936264 0.8983131 0.3767007
2: 2016-04-09M 0.6475017 0.1429131 0.57890510 0.007439883 0.9242098 0.1077233
3: 2016-04-10M 0.9176341 0.9176341 0.05900942 0.059009423 0.2717861 0.2717861