パターンのある列の最大/最小値の検索R

Question

名前パターンを共有する複数の列に基づいて最大/最小値を与える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") 

は、私は次のコードを適用することによって、要約統計情報を取得する方法を知っている：

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)] 

理想的には、サマリー表の列名に元の表の名前を組み込む必要があります。実際のデータセットは、パターンと一致する列数が異なる複数のデータフレームで構成されています。より多くのデータを収集すると、新しい変数が追加されるので、colnameパターンに基づいて関数を実行できることが重要です。

ご協力いただき誠にありがとうございます。

Answer 1

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にグループ化されます。

各グループについて、は、現在の列名をパラメータcnとして、cnsベクトルに対して実行されます。

data.tableの列は常にj引数式に表示されているので働く、cnにget()を呼び出すことによって、ラムダ内で、列ベクトルが検索され、ローカル変数xに格納されています。

最後に、要約統計量は.()を使用して、リストで計算され、それらの名前は、私たちが動的paste0()でcnからそれらを計算することができますsetNames()を使用して設定されています。

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 

Answer 2

あなたは、このコードを試してください：

## 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 

Answer 3

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