Разделить фрейм данных на перекрывающиеся фреймы данных

Я пытаюсь написать функцию, которая ведет себя следующим образом, но это оказывается очень сложно:

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

Я не особо задумывался о том, что произойдет, если вы попробуете что-то вроде OverLapSplit(DF,nsplits=2,overlap=1)

Возможно следующее:

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

Спасибо!


person Zach    schedule 13.04.2011    source источник
comment
Так существует ли эта функция, или вы не знаете, как обрабатывать крайние случаи?   -  person Chase    schedule 13.04.2011
comment
@Chase функция не существует. Если я получу работоспособную (хотя и неэлегантную) закодированную версию, я опубликую ее.   -  person Zach    schedule 13.04.2011
comment
@ Зак, это вопрос по поводу вашего предыдущего вопроса? stackoverflow.com/q/5652058/429846   -  person Gavin Simpson    schedule 13.04.2011
comment
@Gavin Simpson: Да, этот вопрос основан на моем предыдущем. По сути, я пытаюсь разработать способ распараллеливания функции rollapply. Может быть, я должен просто задать вопрос напрямую?   -  person Zach    schedule 13.04.2011
comment
Обратите внимание, что на 100% уверен, что это поможет там, вы, вероятно, захотите разбить данные на куски нужного вам размера, 1:31, 2:32 и т. д., и извергнуть их на свои узлы - что @Joris и я сделали, так это разделили данные на равные перекрывающиеся разделы, и это не совсем то, что я думал, что ваш код rollapply() делал.   -  person Gavin Simpson    schedule 14.04.2011
comment
@ Гэвин Симпсон: Идея состоит в том, чтобы свести к минимуму количество данных, которые я выбрасываю на свои фрагменты, а затем запускать rollapply для каждого фрагмента. например, вместо того, чтобы разбивать мои данные 1:31... на 100:131, может иметь смысл разделить их на 1:81 и 50:131.   -  person Zach    schedule 14.04.2011
comment
@Зак, теперь я с тобой. Насколько велик ваш набор данных, который вам понадобится для этого, и, что важно, проверить его работу после ускорения, которое я показал с помощью lm.fit()? Интересная проблема однако.   -  person Gavin Simpson    schedule 14.04.2011
comment
@Gavin Simpson: Для набора данных, который у меня сейчас есть, написанный вами код lm.fit() отлично работает, и распараллеливание не требуется. Проблема в том, что в будущем я могу использовать glm, glmnet или какой-то другой алгоритм, если обнаружу, что он дает лучшие прогнозирующие результаты. Поэтому я пытаюсь найти способ распараллелить анализ.   -  person Zach    schedule 14.04.2011
comment
@Gavin Simpson: Я также задавал этот вопрос некоторое время назад, и вы можете видеть, что это сделает 1:31 2:32 сплиты подходящими для фермерства, как вы описали. stackoverflow.com/questions/5543387/   -  person Zach    schedule 14.04.2011
comment
Подумайте о векторе индексов, который вы будете использовать для подмножества каждого фрейма данных — это должна быть всего пара строк кода.   -  person hadley    schedule 14.04.2011


Ответы (3)


Попробуйте что-то вроде:

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 количество сплитов! (nsplit=1 возвращает 2 фрейма данных). Это приведет к отображению неполного последнего фрейма данных в случае, если перекрывающиеся разбиения действительно не вписываются в фрейм данных, и выдаст предупреждение.

> 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

И один с предупреждением

> 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.
person Joris Meys    schedule 13.04.2011
comment
+1 хороший ответ из первых принципов --- я слишком [ленив | глупо]* для первых принципов. [*удалить, если применимо] ;-) - person Gavin Simpson; 14.04.2011
comment
@ Гэвин Симпсон: я опубликовал свой собственный ответ с полным рабочим процессом, который я имею в виду. Определенно есть возможности для улучшения, но я думаю, что на данный момент он будет удовлетворять мои потребности. Спасибо за все предложения! - person Zach; 14.04.2011
comment
@Joris Meys, как бы вы поступили, не включая неполные перекрывающиеся кадры данных (т. Е. Пройдя еще один шаг после предупреждения) - person road_to_quantdom; 02.12.2015

Здесь используется идея гальки из графики Lattice, поэтому используется код из пакета lattice для генерации интервалов, а затем используется цикл для разбиения исходного DF на правильные подмножества.

Я не был точно уверен, что подразумевается под overlap = 1 - я полагаю, вы имели в виду перекрытие на 1 образец / наблюдение. Если это так, приведенный ниже код делает это.

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
}

Который дает:

> 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
person Gavin Simpson    schedule 13.04.2011
comment
Просто будьте осторожны с определением overlap; co.intervals() нужна доля перекрытия, а не абсолютное количество перекрывающихся выборок, поэтому в некоторых ситуациях может возникнуть проблема с округлением. Если это произойдет, и вы получите на одно меньше/больше перекрытий, чем хотите - person Gavin Simpson; 14.04.2011
comment
+1 у-у-у! никогда не думал взломать решетку, чтобы сделать это для меня. Хороший - person Joris Meys; 14.04.2011

Просто чтобы было понятно, что я здесь делаю:

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

Таким образом, вы можете заменить lapply в конце на параллельную версию lapply и несколько увеличить скорость.

Конечно, теперь возникает проблема оптимизации разделения/перекрытия с учетом количества процессоров и размера набора данных.

person Zach    schedule 13.04.2011