2015-12-02 4 views
2

Я написал этот цикл, чтобы извлечь имена каждого элемента вектора, который встречается в течение интервала времени (bin). Я задавался вопросом, не хватает ли у меня более быстрого способа сделать это ... Я хочу реализовать аспект рандомизации для векторов длиной 1000 и, следовательно, не хочу полагаться на цикл.Извлечение имен вектора по времени bin

mydata <- structure(c(1199.91666666667, 1200.5, 1204.63333333333, 1205.5, 
         1206.3, 1208.73333333333, 1209.06666666667, 1209.93333333333, 
         1210.98333333333, 1214.56666666667, 1216.06666666667, 1216.63333333333, 
         1216.91666666667, 1219.13333333333, 1221.35, 1221.51666666667, 
         1225.35, 1225.53333333333, 1225.96666666667, 1227.61666666667, 
         1228.91666666667, 1230.31666666667, 1233.53333333333, 1235.8, 
         1237.51666666667, 1239.41666666667, 1241.6, 1247.08333333333, 
         1247.45, 1252.7, 1253.26666666667), .Names = c("B", "A", "B", 
                    "E", "A", "A", "B", "G", "G", "C", "A", "D", "E", "B", "B", "E", 
                    "E", "G", "F", "A", "C", "A", "F", "B", "A", "F", "F", "G", "F", 
                    "G", "F")) 


mydata 

     B  A  B  E  A  A  B  G  G  C  A  D  E  B  B  E  E 
1199.917 1200.500 1204.633 1205.500 1206.300 1208.733 1209.067 1209.933 1210.983 1214.567 1216.067 1216.633 1216.917 1219.133 1221.350 1221.517 1225.350 
     G  F  A  C  A  F  B  A  F  F  G  F  G  F 
1225.533 1225.967 1227.617 1228.917 1230.317 1233.533 1235.800 1237.517 1239.417 1241.600 1247.083 1247.450 1252.700 1253.267 

Они представляют собой последовательные времена в секундах событий. Скажем, мы хотим сделать наши интервалы длинными. Мой подход, чтобы сделать вектор в начале каждого интервала, а затем использовать цикл, чтобы найти имена элементов, входящих в пределах этого интервала:

N=5 
ints <- seq(mydata[1], mydata[length(mydata)], N) 

out<-list() 
for(i in 1:length(ints)){ 
    out[[i]] <- names(mydata[mydata>=ints[i] & mydata<ints[i]+N]) 
} 

out 


[[1]] 
[1] "B" "A" "B" 

[[2]] 
[1] "E" "A" "A" "B" 

[[3]] 
[1] "G" "G" "C" 

[[4]] 
[1] "A" "D" "E" "B" 

[[5]] 
[1] "B" "E" 

[[6]] 
[1] "E" "G" "F" "A" "C" 

[[7]] 
[1] "A" "F" 

[[8]] 
[1] "B" "A" "F" 

[[9]] 
[1] "F" 

[[10]] 
[1] "G" "F" 

[[11]] 
[1] "G" "F" 

Это хорошо для небольших образцов - но я могу видеть, это было бы получить медленный при работе с очень большими образцами, которые перестраиваются 1000 раз.

+0

Я сделал хороший опыт ускоряя аналогичные проблемы с 'findInterval'. – mts

+0

или используйте 'cut' или' hmisc :: cut2' –

+0

Чтобы получить представление о требуемой производительности: сколько «очень больших выборок» и как часто приходится применять логику группировки «временного бина» («перестановленные 1000s времени")? –

ответ

3

Мое предложение заключается в использовании findInterval (на основе ответа на):

mydata2 = c(-Inf, mydata) 
ints <- seq(mydata[1], mydata[length(mydata)]+5, N) 
idx = findInterval(ints-1e-10, mydata2) 

out<-list() 
for(i in 1:(length(ints)-1)){ 
    out[[i]] <- names(mydata2[(idx[i]+1):(idx[i+1])]) 
} 

Как вы можете видеть, что я должен сделать немного мастерить с самого начала (добавление первое значение, которое меньше, чем первая точка останова, добавив epsilon). Вот результат, он идентичен с вашими:

> out 
[[1]] 
[1] "B" "A" "B" 

[[2]] 
[1] "E" "A" "A" "B" 

[[3]] 
[1] "G" "G" "C" 

[[4]] 
[1] "A" "D" "E" "B" 

[[5]] 
[1] "B" "E" 

[[6]] 
[1] "E" "G" "F" "A" "C" 

[[7]] 
[1] "A" "F" 

[[8]] 
[1] "B" "A" "F" 

[[9]] 
[1] "F" 

[[10]] 
[1] "G" "F" 

[[11]] 
[1] "G" "F" 

С точки зрения скорости для примера есть некоторое улучшение:

> microbenchmark(jalapic = {out<-list(); for(i in 1:length(ints)){out[[i]] <- names(mydata[mydata>=ints[i] & mydata<ints[i]+N])}}, 
+ mts = {idx = findInterval(ints2-1e-10, mydata2); out<-list(); for(i in 1:(length(ints)-1)){out[[i]] <- names(mydata2[(idx[i]+1):(idx[i+1])])}}, 
+ alexis = {split(names(mydata), findInterval(mydata, ints))}, 
+ R_Yoda = {dt[, groups := cut2(data,ints)]; result <- dt[, paste0(names, collapse=", "), by=groups]}) 
Unit: microseconds 
    expr  min  lq  mean median  uq  max neval 
jalapic 67.177 76.9725 85.73347 82.8035 95.866 119.890 100 
    mts 43.851 52.7150 62.72116 58.3130 73.007 96.099 100 
    alexis 75.573 86.5360 95.72593 91.4340 100.531 234.649 100 
    R_Yoda 2032.066 2158.4870 2303.68887 2191.3750 2281.409 8719.314 100 

Для больших векторов (я выбрал длину 2000) это понятнее:

set.seed(123) 
mydata = sort(runif(n = 2000, min = 0, max = 100)) 
names(mydata) = sample(LETTERS[1:7], size = 2000, replace = T) 
mydata2 = c(-Inf, mydata) 
ints2 <- seq(mydata[1], mydata[length(mydata)]+5, N) 
dt <- data.table(data=mydata, names=names(mydata)) 
> microbenchmark(jalapic = {out<-list(); for(i in 1:length(ints)){out[[i]] <- names(mydata[mydata>=ints[i] & mydata<ints[i]+N])}}, 
+     mts = {idx = findInterval(ints2-1e-10, mydata2); out<-list(); for(i in 1:(length(ints)-1)){out[[i]] <- names(mydata2[(idx[i]+1):(idx[i+1])])}}, 
+     alexis = {split(names(mydata), findInterval(mydata, ints))}, 
+     R_Yoda = {dt[, groups := cut2(data,ints)]; result <- dt[, paste0(names, collapse=", "), by=groups]}) 
Unit: microseconds 
    expr  min  lq  mean median  uq  max neval 
jalapic 804.243 846.9275 993.9957 862.0890 883.3140 7140.218 100 
    mts 77.439 88.8685 100.6148 100.0640 106.5955 188.466 100 
    alexis 187.066 204.7930 220.1689 215.5225 225.3190 299.026 100 
    R_Yoda 3831.348 4066.4640 4366.5382 4140.1700 4248.8635 11829.923 100 
+2

С помощью 'findInterval' вы могли бы также выполнить разделение (имена (mydata), findInterval (mydata, ints))' –

+0

@alexis_laz Молодцы !!! я только протестированные cut2 против findInterval (очень интересно!): 'microbenchmark (findInterval = {findInterval (MyData, Интс)}, cut2 = {cut2 (MYDATA, Интс)}) Единица измерения: микросекунд выраж мин LQ среднее среднее значение uq max neval cld findInterval 2.307 3.434 4.963 4.8250 5.8595 26.001 100 a cut2 590.122 623.445 709.359 714.8175 755.1235 1292.948 100 b' Ясный победитель: findInterval !!! –

+0

@mts my prev.комментарий предназначался для вас, конечно :-) –

1

По соображениям производительности я использую data.table:

Редактировать: Это решение работает, но не очень быстро (как доказано ответом мтс)

library(Hmisc) 
library(data.table) 

# assuming that your mydata vector from the question is loaded 
N=5 # code from your question... 
ints <- seq(mydata[1], mydata[length(mydata)], N) # code from your question... 

dt <- data.table(data=mydata, names=names(mydata)) 
dt[, groups := cut2(data,ints)] # attention: shall the interval ends be included in the group or not? 
groups <- dt[ , .(result=list(names)), by=groups] # the elements of a data.table can be a list itself! 
# to get the result as list: 
out <- groups[,result] 
out 

Edit: Вы можете заменить cut2 на findInterval и делать это все в одной строке, но он по-прежнему медленнее:

out <- dt[, .(result=list(names)), by = findInterval(data,ints) ] 

Это результат:

[[1]] 
[1] "B" "A" "B" 

[[2]] 
[1] "E" "A" "A" "B" 

[[3]] 
[1] "G" "G" "C" 

[[4]] 
[1] "A" "D" "E" "B" 

[[5]] 
[1] "B" "E" 

[[6]] 
[1] "E" "G" "F" "A" "C" 

[[7]] 
[1] "A" "F" 

[[8]] 
[1] "B" "A" "F" 

[[9]] 
[1] "F" 

[[10]] 
[1] "G" "F" 

[[11]] 
[1] "G" "F" 
+0

Извините, результатом будет просто строка (потребуется переставить ее вместо вставки ...) –

+0

OK, теперь у вас есть «выход» в качестве список ... –

+0

спасибо - это выглядит многообещающим. Что касается интервальных концов, ящики не должны перекрываться. Поэтому любое событие, которое происходит именно на разделительной линии, должно идти в прежний бин, а не в последнюю. Поэтому бункеры являются, например, 4.9999999 секунд не 5 – jalapic

Смежные вопросы