Сравнение векторов POSIX - эффективный поиск и нахождение соответствия между векторами DATE? - PullRequest
Новая
       21

Сравнение векторов POSIX - эффективный поиск и нахождение соответствия между векторами DATE?

1 голос
/ 27 августа 2011

У меня есть пять пятых POSIXct типов векторов. ptime вектор - опорный вектор. Я хочу найти совпадающие даты между ptime и остальными векторами. Как только дата сопоставлена, я хочу провести сравнение времени. Затем проводится сравнение времени, и результаты заносятся в data.frame(test) с соответствующим классификационным номером. 

# create the reference and the other vectors 
ptime <- sample(seq(as.POSIXct('2005-08-01'),as.POSIXct('2006-05-31'), by='hour'),1051)
dawn <- sample(seq(as.POSIXct('2005-01-01'),as.POSIXct('2007-12-31'),by='hour'),1095)
sunrise <- sample(seq(as.POSIXct('2005-01-01'),as.POSIXct('2007-12-31'),by='hour'),1095)
sunset <- sample(seq(as.POSIXct('2005-01-01'),as.POSIXct('2007-12-31'),by='hour'),1095)
dusk <- sample(seq(as.POSIXct('2005-01-01'),as.POSIXct('2007-12-31'),by='hour'),1095)

# extract the date to compare using only the `dawn` vector
# all other vectors (except ptime) have the same date and length
pt <- as.Date(ptime)
dw <- as.Date(dawn)

# create data.frame
time <- c(1:1051)
test<-data.frame(time)

# I use a data.frame because I want to re-populate an existing data.frame
> str(test)
'data.frame':   1051 obs. of  1 variable:
 $ time: int  1 2 3 4 5 6 7 8 9 10 ...

# this is the loop that matches and assigns
for( b in 1:length(ptime) ){
    for( a in 1:length(dawn) ) {
      if( dw[a] == pt[b] ){
            if( ptime[b] < dawn[a] ) {
                test$time[b] <- 1
            }else if( ptime[b] < sunrise[a] ) {
                test$time[b] <- 2
            }else if( ptime[b] < sunset[a] ) {
                test$time[b] <- 3
            }else if( ptime[b] < dusk[a] ) {
                test$time[b] <- 4
            }else
                test$time[b] <- 1
        }
    }
}

# output result shows the categorization sequence of 1, 2, 3, and 4
> head(test)
  time
1    1
2    1
3    3
4    1
5    1
6    3

Приведенный выше код выполняет то, что я хочу сделать ... но это занимает 98.58 секунд. У меня есть больше данных, которые варьируются по длине (до 5000).

Так как я новичок в этом, я думаю ... что так много времени занимает сравнение ДАТ. Каждый раз, когда нужно сделать новое сравнение dw[a] == pt[b], процесс должен искать через dw[a]. Кроме того, if-else операторы необходимы для выполнения задачи?

Может ли кто-нибудь предоставить более быстрый / более эффективный метод для loop поиска, поиска совпадений и сохранения результатов? Очень ценю это. Спасибо

Ответы [ 2 ]

3 голосов
/ 27 августа 2011

Отредактировано на основе обновлений ОП

То, что следует, до сих пор остается в основном догадкой с моей стороны.Я исправил некоторые опечатки в вашем редакторе, чтобы получить это: 

ptime <- sample(seq(as.POSIXct('2005-08-01'),as.POSIXct('2006-05-31'), 
                by='hour'),1051)
dawn <- sample(seq(as.POSIXct('2005-01-01'),as.POSIXct('2007-12-31'),
                by='hour'),1095)
sunrise <- sample(seq(as.POSIXct('2005-01-01'),as.POSIXct('2007-12-31'),
                by='hour'),1095)
sunset <- sample(seq(as.POSIXct('2005-01-01'),as.POSIXct('2007-12-31'),
                by='hour'),1095)
dusk <- sample(seq(as.POSIXct('2005-01-01'),as.POSIXct('2007-12-31'),
                by='hour'),1095)

# extract the date to compare using only the `dawn` vector
# all other vectors (except ptime) have the same date and length
pt <- as.Date(ptime)
dw <- as.Date(dawn)

# create data.frame
time <- c(1:1051)
test<-data.frame(time)

Вот мой дикий удар в этом: 

tmp <- outer(pt, dw, "==")
tmp[upper.tri(tmp)] <- NA
tmp <- which(tmp,arr.ind = TRUE)

test$time[ tmp[ ptime[ tmp[,1] ] < dawn[ tmp[,2] ],1] ] <- 1
test$time[ tmp[ ptime[ tmp[,1] ] < sunrise[ tmp[,2] ],1 ] ] <- 2
test$time[ tmp[ ptime[ tmp[,1] ] < sunset[ tmp[,2] ],1 ] ] <- 3
test$time[ tmp[ ptime[ tmp[,1] ] < dusk[ tmp[,2] ],1] ] <- 4

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

2 голосов
/ 28 августа 2011

Очень быстрое решение 

ptime <- sample(seq(as.POSIXct('2005-08-01'),as.POSIXct('2006-05-31'), by='hour'),1051)
dawn <- sample(seq(as.POSIXct('2005-01-01'),as.POSIXct('2007-12-31')),1095)
sunrise <- sample(seq(as.POSIXct('2005-01-01'),as.POSIXct('2007-12-31')),1095)
sunset <- sample(seq(as.POSIXct('2005-01-01'),as.POSIXct('2007-12-31')),1095)
dusk <- sample(seq(as.POSIXct('2005-01-01'),as.POSIXct('2007-12-31')),1095)

time <- c(1:1051)
test<-data.frame(time)

# From joran
#creates a matrix that lists the IDs that match each other
d <- which(outer(as.Date(ptime, tz='MST'),as.Date(dawn, tz='MST'),"=="),arr.ind = TRUE)

>head(d)
     row col
[1,]  86 213
[2,] 226 213
[3,] 346 213
[4,] 492 214
[5,] 272 215

#This `ifelse` handles multivalued vectors
test$time <- ifelse( (ptime[d[,1]] < dawn[d[,2]]) | (ptime[d[,1]] > dusk[d[,2]]), 1, 
             ifelse(ptime[d[,1]] < sunrise[d[,2]], 2, 
             ifelse( ptime[d[,1]] < sunset[d[,2]], 3, 4 ) ) )

Благодаря Джорану это работает на 0.00 для моей машины. Ключ к векторизации.

...