2017-03-18 8 views
0

datetimes1は不定期のdatetimesであり、datetimes2は定期的なdatetimesです。 datetimes1には、最初の表に示すように、5:10などの欠落した日時があります。私が欲しいもの定期的な日時スケジュールに不規則な日付時刻を合わせる

は、各datetimes1datetimes2に近いものであり、全てのdatetimes1が上品正しい行になるように、datetimes2datetimes1を一致させようとすることです。

最初に、datetimes1を最も近い5分に丸めて、datetimes2に一致させようとしましたが、一部の日付は3分ずれているので、間違った値に丸められます。私が試した

次のものがdatetimes1datetimes2に正確に等しいである見つけ、0からtoleranceを設定することで、最初のものをdatetimes1datetimes2に一致するようにし、その後、すべてのループで1によってtoleranceを増やし始める、とされていないdatetimes1と一致datetimes2に一致しており、指定されたtoleranceによってオフになっています。

この方法の問題は、5:33と5:37の両方が5:35から2分ずれているため、5:33が最初に5:35に一致してから5:37が含まれないことですテーブル。与えられたコードを使って得られた結果については、2番目の表を参照してください。

この問題をどのように解決できるかご存知ですか?

私が見たい:

  datetimes1   datetimes2 
1 2014-07-24 05:05:00 2014-07-24 05:05:00 
2    <NA> 2014-07-24 05:10:00 
3 2014-07-24 05:15:00 2014-07-24 05:15:00 
4 2014-07-24 05:23:00 2014-07-24 05:20:00 
5 2014-07-24 05:27:00 2014-07-24 05:25:00 
6 2014-07-24 05:33:00 2014-07-24 05:30:00 
7 2014-07-24 05:37:00 2014-07-24 05:35:00 
8 2014-07-24 05:41:00 2014-07-24 05:40:00 
9 2014-07-24 05:45:00 2014-07-24 05:45:00 

しかし、私はこの代わりました:ここ

  datetimes1   datetimes2 
1 2014-07-24 05:05:00 2014-07-24 05:05:00 
2    <NA> 2014-07-24 05:10:00 
3 2014-07-24 05:15:00 2014-07-24 05:15:00 
4    <NA> 2014-07-24 05:20:00 
5 2014-07-24 05:23:00 2014-07-24 05:25:00 
6 2014-07-24 05:27:00 2014-07-24 05:30:00 
7 2014-07-24 05:33:00 2014-07-24 05:35:00 
8 2014-07-24 05:41:00 2014-07-24 05:40:00 
9 2014-07-24 05:45:00 2014-07-24 05:45:00 

は私のコードは次のとおりです。

irregulars <- c("2014-07-24 05:05", 
       "2014-07-24 05:15", 
       "2014-07-24 05:23", 
       "2014-07-24 05:27", 
       "2014-07-24 05:33", 
       "2014-07-24 05:37", 
       "2014-07-24 05:41", 
       "2014-07-24 05:45") 

df1 <- data.frame(datetimes <- as.POSIXct(irregulars, "GMT")) 

regulars <- c("2014-07-24 05:05", 
       "2014-07-24 05:10", 
       "2014-07-24 05:15", 
       "2014-07-24 05:20", 
       "2014-07-24 05:25", 
       "2014-07-24 05:30", 
       "2014-07-24 05:35", 
       "2014-07-24 05:40", 
       "2014-07-24 05:45") 

df2 <- setNames(data.frame(matrix(NA,length(regulars),2)),c("datetimes1","datetimes2")) 
df2$datetimes2 <- as.POSIXct(regulars, "GMT") 

# Match irregulars to regulars 
for(tolerance in c(0:3)) { 
    for(idx in which(!df1$datetimes %in% df2$datetimes1)) { 
    dt <- abs(difftime(df2$datetimes2, df1$datetimes[idx], "GMT", "mins")) 
    dt.min <- min(dt[is.na(df2$datetimes1)]) 
    if (dt.min > tolerance) next 
    idx2 <- which(dt == dt.min) 
    df2$datetimes1[idx2] <- df1$datetimes[idx] 
    } 
} 

df2$datetimes1 <- as.POSIXct(df2$datetimes1, "GMT", origin = "1970-01-01 00:00:00") 

答えて

1

ここに1つのアプローチです。我々のマッチングアルゴリズムが、差異が許容レベル(例えば、5分または300秒)以下でなければならないターゲットとの絶対差が最小である候補セットから時間を見つけると仮定する:

closest <- function(x, candidates, tol = 300) { 
    timediff <- abs(difftime(x, candidates, units = "secs")) 
    if (all(timediff >= tol)) return(NA) 
    candidates[which.min(timediff)] 
} 

私たちの場合の候補は「不規則」のセットであり、私たちのターゲットは「レギュラー」です。ここでの主なアイデアは、「常連」を反復処理することであり、私たちは候補のセットから一致するものを見つけたときに、私たちは、候補の集合からそれを削除します。

candidates <- irregulars 
out <- sapply(regulars, function(x) { 
    matched <- closest(x, candidates, tol = 300) 
    candidates <<- setdiff(candidates, matched) 
    matched 
}) 

ここで完全MWEです。初めてのベクトルを設定します。

irregulars <- c("2014-07-24 05:05", 
       "2014-07-24 05:15", 
       "2014-07-24 05:23", 
       "2014-07-24 05:27", 
       "2014-07-24 05:33", 
       "2014-07-24 05:37", 
       "2014-07-24 05:41", 
       "2014-07-24 05:45") 

regulars <- c("2014-07-24 05:05", 
       "2014-07-24 05:10", 
       "2014-07-24 05:15", 
       "2014-07-24 05:20", 
       "2014-07-24 05:25", 
       "2014-07-24 05:30", 
       "2014-07-24 05:35", 
       "2014-07-24 05:40", 
       "2014-07-24 05:45") 

closest関数を定義し、反復:

closest <- function(x, candidates, tol = 600) { 
    timediff <- abs(difftime(x, candidates, units = "secs")) 
    if (all(timediff >= tol)) return(NA) 
    candidates[which.min(timediff)] 
} 

candidates <- irregulars 
out <- sapply(regulars, function(x) { 
    matched <- closest(x, candidates, tol = 300) 
    candidates <<- setdiff(candidates, matched) 
    matched 
}) 

は出力を表示します。

不規則な時間が5分間隔になることはありませんと仮定すると
data.frame(datetimes1 = out, 
      datetimes2 = names(out), 
      row.names = NULL) 
#  datetimes1  datetimes2 
# 1 2014-07-24 05:05 2014-07-24 05:05 
# 2    <NA> 2014-07-24 05:10 
# 3 2014-07-24 05:15 2014-07-24 05:15 
# 4 2014-07-24 05:23 2014-07-24 05:20 
# 5 2014-07-24 05:27 2014-07-24 05:25 
# 6 2014-07-24 05:33 2014-07-24 05:30 
# 7 2014-07-24 05:37 2014-07-24 05:35 
# 8 2014-07-24 05:41 2014-07-24 05:40 
# 9 2014-07-24 05:45 2014-07-24 05:45 
0

通常の時間から両方のベクトルを繰り返し処理し、その差が5分未満の場合にのみ選択することができます。

i=1 
j=1 
while(i<=nrow(df2) & j<=nrow(df1)) 
{ 
    d <-difftime(df2$datetimes2[i], df1$datetimes[j], "GMT",unit="mins") 

    if (abs(d) < 5) { 
      df2$datetimes1[i] <- df1$datetimes[j] 
      j=j+1 
      i=i+1 
     } else if(d>0) j=j+1 
    else i=i+1 


} 
df2$datetimes1 <- as.POSIXct(df2$datetimes1, "GMT", origin = "1970-01-01 00:00:00") 


> df2 
      datetimes1   datetimes2 
1 2014-07-24 05:05:00 2014-07-24 05:05:00 
2    <NA> 2014-07-24 05:10:00 
3 2014-07-24 05:15:00 2014-07-24 05:15:00 
4 2014-07-24 05:23:00 2014-07-24 05:20:00 
5 2014-07-24 05:27:00 2014-07-24 05:25:00 
6 2014-07-24 05:33:00 2014-07-24 05:30:00 
7 2014-07-24 05:37:00 2014-07-24 05:35:00 
8 2014-07-24 05:41:00 2014-07-24 05:40:00 
9 2014-07-24 05:45:00 2014-07-24 05:45:00 
関連する問題