2011-04-13 18 views
6

Estoy intentando escribir una función que se comporta de la siguiente manera, pero está resultando muy difícil:dividir una trama de datos en tramas de datos superpuestos

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 

No he pensado mucho acerca de lo que sucedería si intentado algo así como OverLapSplit(DF,nsplits=2,overlap=1)

Tal vez el siguiente:

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

Gracias!

+0

¿Existe esta función o no sabe cómo manejar las cajas de borde? – Chase

+0

@Chase la función no existe. Si obtengo una versión viable (aunque poco elegante) codificada, la publicaré. – Zach

+0

@Zach es este Q _apropos_ su anterior Q? http://stackoverflow.com/q/5652058/429846 –

Respuesta

6

Pruebe algo como:

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

con Nsplit el número de divisiones! (nsplit = 1 devuelve 2 marcos de datos). Esto generará un último marco de datos incompleto en caso de que las divisiones de superposición no encajen realmente en el marco de datos, y emite una advertencia.

> 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 

y otro con una advertencia

> 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. 
+0

+1 buena respuesta desde los primeros principios --- soy demasiado [flojo | estúpido] * para primeros principios. [* Eliminar según corresponda] ;-) –

+0

@ Gavin Simpson: Publiqué mi propia respuesta con el flujo de trabajo completo que tengo en mente. Definitivamente hay margen de mejora, pero creo que servirá a mis necesidades por ahora. ¡Gracias por todas las sugerencias! – Zach

+0

@Joris Meys ¿cómo podría hacer para no incluir los cuadros de datos superpuestos "incompletos" (es decir, ir un paso más allá de una simple advertencia) –

4

Este utiliza la idea de tejas de gráficos de celosía y así aprovecha código del paquete lattice para generar los intervalos y luego utiliza un bucle para romper el DF original en el subconjuntos correctos.

No estaba exactamente seguro de lo que se entiende por overlap = 1 - Supongo que quiere decir superposición en 1 muestra/observación. Si es así, el código siguiente hace esto.

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 
} 

que da:

> 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 
+0

Solo tenga cuidado con la definición de 'superposición'; 'co.intervals()' quiere que la fracción de superposición no sea el número absoluto de muestras superpuestas, por lo que podría haber un problema de redondeo en algunas situaciones. Si eso sucede y obtienes un número menor o más de superposiciones de las que deseas –

+0

+1 woo-yeah! Nunca pensé en hackear celosía para hacer eso por mí. Buena esa –

0

Sólo para que quede claro lo que estoy haciendo aquí:

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

De esta manera, se puede reemplazar lapply al final con un paralelo versión de aplicar y aumentar un poco la velocidad.

Por supuesto, ahora existe la cuestión de optimizar la división/superposición, dado el número de procesadores y el tamaño de su conjunto de datos.

Cuestiones relacionadas