örtüşen dataframes

Question

ben şöyle davranan bir işlev yazmaya çalışıyorum bir veri çerçevesi Bölünmüş, ama çok zor kanıtlıyor:

DF <- data.frame(x = seq(1,10), y = rep(c('a','b','c','d','e'),2)) 
> DF 
    x y 
1 1 a 
2 2 b 
3 3 c 
4 4 d 
5 5 e 
6 6 a 
7 7 b 
8 8 c 
9 9 d 
10 10 e 

>OverLapSplit(DF,nsplits=2,overlap=2) 
[[1]] 
    x y 
1 1 a 
2 2 b 
3 3 c 
4 4 d 
5 5 e 
6 6 a 

[[2]] 
    x y 
1 5 a 
2 6 b 
3 7 c 
4 8 d 
5 9 e 
6 10 a 

>OverLapSplit(DF,nsplits=1) 
[[1]] 
    x y 
1 1 a 
2 2 b 
3 3 c 
4 4 d 
5 5 e 
6 6 a 
7 7 b 
8 8 c 
9 9 d 
10 10 e 

>OverLapSplit(DF,nsplits=2,overlap=4) 
[[1]] 
    x y 
1 1 a 
2 2 b 
3 3 c 
4 4 d 
5 5 e 
6 6 a 
7 7 b 

[[2]] 
    x y 
1 4 e 
2 5 a 
3 6 b 
4 7 c 
5 8 d 
6 9 e 
7 10 a 

>OverLapSplit(DF,nsplits=5,overlap=1) 
[[1]] 
    x y 
1 1 a 
2 2 b 
3 3 c 

[[2]] 
    x y 
1 3 c 
2 4 d 
3 5 e 

[[3]] 
    x y 
1 5 e 
2 6 a 
3 7 b 

[[4]] 
    x y 
1 7 b 
2 8 c 
3 9 d 

[[5]] 
    x y 
1 8 d 
2 9 e 
3 10 f 

Sana ne olacağını çok düşündüm değil Belki şu OverLapSplit(DF,nsplits=2,overlap=1)

gibi çalıştı şey:

[[1]] 
    x y 
1 1 a 
2 2 b 
3 3 c 
4 4 d 
5 5 e 

[[2]] 
    x y 
1 5 a 
2 6 b 
3 7 c 
4 8 d 
5 9 e 
6 10 a 

teşekkürler!

Answer 1

gibi bir şey deneyin:

OverlapSplit <- function(x,nsplit=1,overlap=2){ 
    nrows <- NROW(x) 
    nperdf <- ceiling((nrows + overlap*nsplit)/(nsplit+1)) 
    start <- seq(1, nsplit*(nperdf-overlap)+1, by= nperdf-overlap) 

    if(start[nsplit+1] + nperdf != nrows) 
     warning("Returning an incomplete dataframe.") 

    lapply(start, function(i) x[c(i:(i+nperdf-1)),]) 
} 

nsplit ile bölünme sayısı! (nsplit = 1, 2 veri çerçevesini döndürür). Bu, örtüşme ayırmalarının veri çerçevesine gerçekten uymaması durumunda eksik bir son veri çerçevesi oluşturacaktır ve bir uyarı verir.

> OverlapSplit(DF,nsplit=3,overlap=2) 
[[1]] 
    x y 
1 1 a 
2 2 b 
3 3 c 
4 4 d 

[[2]] 
    x y 
3 3 c 
4 4 d 
5 5 e 
6 6 a 

[[3]] 
    x y 
5 5 e 
6 6 a 
7 7 b 
8 8 c 

[[4]] 
    x y 
7 7 b 
8 8 c 
9 9 d 
10 10 e 

Ve bir uyarı ile tek

> OverlapSplit(DF,nsplit=1,overlap=1) 
[[1]] 
    x y 
1 1 a 
2 2 b 
3 3 c 
4 4 d 
5 5 e 
6 6 a 

[[2]] 
    x y 
6 6 a 
7 7 b 
8 8 c 
9 9 d 
10 10 e 
NA NA <NA> 

Warning message: 
In OverlapSplit(DF, nsplit = 1, overlap = 1) : 
    Returning an incomplete dataframe. 

Answer 2

Bu Kafes grafiklerden çakıl fikrini kullanır ve böylece aralıkları oluşturmak için paketin lattice kodu güçlendirir ve daha sonra orijinal DF kırmak için bir döngü kullanır doğru altkümeler.

overlap = 1 ile ne demek istediğinden tam olarak emin değildim - 1 örnek/gözlemle çakışmayı kastettiğinizi varsayarım. Eğer öyleyse, aşağıdaki kod bunu yapar.

OverlapSplit <- function(x, nsplits = 1, overlap = 0) { 
    stopifnot(require(lattice)) 
    N <- seq_len(nr <- nrow(x)) 
    interv <- co.intervals(N, nsplits, overlap/nr) 
    out <- vector(mode = "list", length = nrow(interv)) 
    for(i in seq_along(out)) { 
     out[[i]] <- x[interv[i,1] < N & N < interv[i,2], , drop = FALSE] 
    } 
    out 
} 

verir Hangi:

> OverlapSplit(DF, 2, 2) 
[[1]] 
    x y 
1 1 a 
2 2 b 
3 3 c 
4 4 d 
5 5 e 
6 6 a 

[[2]] 
    x y 
5 5 e 
6 6 a 
7 7 b 
8 8 c 
9 9 d 
10 10 e 

> OverlapSplit(DF) 
[[1]] 
    x y 
1 1 a 
2 2 b 
3 3 c 
4 4 d 
5 5 e 
6 6 a 
7 7 b 
8 8 c 
9 9 d 
10 10 e 

> OverlapSplit(DF, 4, 1) 
[[1]] 
    x y 
1 1 a 
2 2 b 
3 3 c 

[[2]] 
    x y 
3 3 c 
4 4 d 
5 5 e 

[[3]] 
    x y 
6 6 a 
7 7 b 
8 8 c 

[[4]] 
    x y 
8 8 c 
9 9 d 
10 10 e 

Answer 3

Sadece burada ne işim açıkça ne yapmak: Bu şekilde

#Load Libraries 
library(PerformanceAnalytics) 
library(quantmod) 

#Function to Split Data Frame 
OverlapSplit <- function(x,nsplit=1,overlap=0){ 
    nrows <- NROW(x) 
    nperdf <- ceiling((nrows + overlap*nsplit)/(nsplit+1)) 
    start <- seq(1, nsplit*(nperdf-overlap)+1, by= nperdf-overlap) 

    if(start[nsplit+1] + nperdf != nrows) 
     warning("Returning an incomplete dataframe.") 

    lapply(start, function(i) x[c(i:(i+nperdf-1)),]) 
} 

#Function to run regression on 30 days to predict the next day 
FL <- as.formula(Next(HAM1)~HAM1+HAM2+HAM3+HAM4) 
MyRegression <- function(df,FL) { 
    df <- as.data.frame(df) 
    model <- lm(FL,data=df[1:30,]) 
    predict(model,newdata=df[31,]) 
} 

#Function to roll the regression 
RollMyRegression <- function(data,ModelFUN,FL) { 
    rollapply(data, width=31,FUN=ModelFUN,FL, 
    by.column = FALSE, align = "right", na.pad = FALSE) 
} 

#Load Data 
data(managers) 

#Split Dataset 
split.data <- OverlapSplit(managers,2,30) 
sapply(split.data,dim) 

#Run rolling regression on each split 
output <- lapply(split.data,RollMyRegression,MyRegression,FL) 
output 
unlist(output) 

, bir paralel olan sonunda lapply yerine geçebilir lapply sürümü ve hızınızı biraz artırın.

Elbette, şimdi size işlemci sayısını ve veri kümenizin boyutunu göz önünde bulundurarak bölünmüş/çakışmayı en iyi duruma getirme sorunu var.