unregelmäßige Zeitverschiebung

[Ilonia]

Hallo zusammen!
Ich bräuchte mal wieder eure Hilfe!

Ich habe zwei dfs (Df1 und DF2).

Code: Alles auswählen

DF1 <- dput(DF1)
structure(list(date = structure(c(17722, 17722, 17722, 17722, 
17722, 17722, 17723, 17723, 17723, 17723, 17723, 17723, 17723, 
17723, 17723, 17723, 17723, 17723, 17723, 17723, 17723, 17723, 
17723, 17723, 17723, 17723, 17723, 17723, 17723, 17723, 17723, 
17723, 17723, 17723, 17723, 17723, 17723, 17723, 17723, 17723, 
17723, 17723, 17723, 17723, 17723, 17723, 17723, 17723, 17723, 
17723, 17723, 17723, 17723, 17723, 17723, 17723, 17723, 17723, 
17723, 17723, 17723, 17723, 17723, 17723, 17723, 17723, 17723, 
17723, 17723, 17723, 17723, 17723, 17723, 17723, 17723, 17723, 
17723, 17723, 17723, 17723, 17723, 17723, 17723, 17723, 17723, 
17723, 17723, 17723), class = "Date"), time = c("23:54:00", "23:55:00", 
"23:56:00", "23:57:00", "23:58:00", "23:59:00", "00:00:00", "00:01:00", 
"00:02:00", "00:03:00", "00:04:00", "00:05:00", "00:06:00", "00:07:00", 
"00:08:00", "00:09:00", "00:10:00", "00:11:00", "00:12:00", "00:13:00", 
"00:14:00", "00:15:00", "00:16:00", "00:17:00", "00:18:00", "00:19:00", 
"00:20:00", "00:21:00", "00:22:00", "00:23:00", "00:24:00", "00:25:00", 
"00:26:00", "00:27:00", "00:28:00", "00:29:00", "00:30:00", "00:31:00", 
"00:32:00", "00:33:00", "00:34:00", "00:35:00", "00:36:00", "00:37:00", 
"00:38:00", "00:39:00", "00:40:00", "00:41:00", "00:42:00", "00:43:00", 
"00:44:00", "00:45:00", "00:46:00", "00:47:00", "00:48:00", "00:49:00", 
"00:50:00", "00:51:00", "00:52:00", "00:53:00", "00:54:00", "00:55:00", 
"00:56:00", "00:57:00", "00:58:00", "00:59:00", "01:00:00", "01:01:00", 
"01:02:00", "01:03:00", "01:04:00", "01:05:00", "01:06:00", "01:07:00", 
"01:08:00", "01:09:00", "01:10:00", "01:11:00", "01:12:00", "01:13:00", 
"01:14:00", "01:15:00", "01:16:00", "01:17:00", "01:18:00", "01:19:00", 
"01:20:00", "01:21:00"), RR = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0), datetime = structure(c(1531266840, 
1531266900, 1531266960, 1531267020, 1531267080, 1531267140, 1531267200, 
1531267260, 1531267320, 1531267380, 1531267440, 1531267500, 1531267560, 
1531267620, 1531267680, 1531267740, 1531267800, 1531267860, 1531267920, 
1531267980, 1531268040, 1531268100, 1531268160, 1531268220, 1531268280, 
1531268340, 1531268400, 1531268460, 1531268520, 1531268580, 1531268640, 
1531268700, 1531268760, 1531268820, 1531268880, 1531268940, 1531269000, 
1531269060, 1531269120, 1531269180, 1531269240, 1531269300, 1531269360, 
1531269420, 1531269480, 1531269540, 1531269600, 1531269660, 1531269720, 
1531269780, 1531269840, 1531269900, 1531269960, 1531270020, 1531270080, 
1531270140, 1531270200, 1531270260, 1531270320, 1531270380, 1531270440, 
1531270500, 1531270560, 1531270620, 1531270680, 1531270740, 1531270800, 
1531270860, 1531270920, 1531270980, 1531271040, 1531271100, 1531271160, 
1531271220, 1531271280, 1531271340, 1531271400, 1531271460, 1531271520, 
1531271580, 1531271640, 1531271700, 1531271760, 1531271820, 1531271880, 
1531271940, 1531272000, 1531272060), class = c("POSIXct", "POSIXt"
), tzone = "UTC")), row.names = 70088:70175, class = "data.frame")

Code: Alles auswählen

DF2 <- dput(DF2)
structure(list(Verschiebung = c(0L, 0L, 2L, 2L, 6L, 7L), date = structure(c(17683, 
17692, 17723, 17724, 17797, 17827), class = "Date")), na.action = structure(c(`5` = 5L, 
`6` = 6L, `24` = 24L, `36` = 36L, `38` = 38L, `45` = 45L, `49` = 49L, 
`64` = 64L, `65` = 65L, `71` = 71L, `73` = 73L, `75` = 75L, `78` = 78L, 
`81` = 81L, `83` = 83L, `89` = 89L, `91` = 91L, `94` = 94L, `97` = 97L, 
`98` = 98L, `99` = 99L, `100` = 100L, `101` = 101L, `102` = 102L, 
`103` = 103L), class = "omit"), row.names = c(1L, 2L, 3L, 4L, 
7L, 8L), class = "data.frame")

DF1 enthält Minutenwerte (datetime) einer Variable RR (diese spielt hierbei keine Rolle), DF2 enthält pro Datum eine Zeitverschiebung (Verschiebung) in Minuten. Die erste Zeile in DF2 hat eine Zeitverschiebung von 0 (also keine Zeitverschiebung), ab der dritten Spalte habe ich dann eine Zeitverschiebung von 2, bis zum nächsten Datum, wo sich dieser ändert. Die Änderungen sind nicht konstant.

Folgendes habe ich bis jetzt probiert:

Code: Alles auswählen

for(i in 1:nrow(DF1)){
  
  DF1$newDatetime[i] <- format(strptime(DF1$datetime,format ="%Y-%m-%d %H:%M:%S")-(DF2$Verschiebung*60)[
  which( DF2$date >= DF1$date[i] &
    DF2$date <= DF1$date[i])])
    
}

Leider funktioniert es nicht, und ich weiß auch nicht, woran das liegt.
Über jede Hilfe und Input bin ich dankbar. Gerne auch ohne for-loop, dass ich einen sehr großen df habe, wo es sicherlich schnellere Möglichkeiten gibt.

Liebe Grüße
Ilonia

[bigben]

Hallo Ilonia,

ich denke der einfachste Weg wird darüber gehen, dass man die beiden Tabellen zu einem kombinierten Dataframe zusammenführt:

Code: Alles auswählen

comb.DF <- merge(DF1, DF2, by = "date", all.x = TRUE)
head(comb.DF, 20)

Jetzt steht in jeder Zeile, welche Verschiebung angewandt werden soll. Zumindest fast, denn wir müssen erst noch die NA durch 0 ersetzen, wo ein Datum in DF2 nicht vorkam:

Code: Alles auswählen

comb.DF$Verschiebung <- ifelse(is.na(comb.DF$Verschiebung), yes = 0, no = comb.DF$Verschiebung)
head(comb.DF, 20)

So, nun stimmt es. Jetzt gilt es noch, die Verschiebung pro Reihe zu berechnen. Du hast nicht geschrieben, in welcher Einheit die Verschiebung gemessen wird. Das hier addiert Sekunden, lässt sich aber bestimmt für Deine Zwecke anpassen:

Code: Alles auswählen

comb.DF$newdatetime <- comb.DF$datetime + comb.DF$Verschiebung
head(comb.DF, 20)

Das kommt wunschgemäß ohne for-Schleife aus und sollte alles in allem auch große Datenmengen zügig abarbeiten können.

LG,
Bernhard

[Athomas]

Ohne sicher zu sein, dass ich Dich richtig verstanden habe - aber das sollte mit den "rolling joins" aus data.table bestens und superschnell funktionieren:

https://www.gormanalysis.com/blog/r-dat ... ing-joins/

[Ilonia]

Hallo Bernhard,
erstmal vielen Dank für die schnelle Antwort.
Auf die Idee alles in ein DF zu schreiben, bin ich gar nicht gekommen...
Allerdings passt folgendes nur bedingt:

Jetzt steht in jeder Zeile, welche Verschiebung angewandt werden soll. Zumindest fast, denn wir müssen erst noch die NA durch 0 ersetzen, wo ein Datum in DF2 nicht vorkam:

Code: Alles auswählen

comb.DF$Verschiebung <- ifelse(is.na(comb.DF$Verschiebung), yes = 0, no = comb.DF$Verschiebung)
head(comb.DF, 20)

Da ist mein Beispiel vielleicht nicht schlau gewählt gewesen, da es in diesem Fall stimmt. Wenn man sich DF2 nochmal anschaut, habe ich zB auch die Daten "2018-07-12" und "2018-09-23". Wenn ich die DFs merge und alle NAs auf 0 setze, hätte ich zwischen diesen beiden Zeitschritte ja eine Verschiebung von 0. Ich bräuchte aber eine Verschiebung vom letzten Datum, also in diesem Fall vom "2018-07-12". Also zwischen "2018-07-12" bis einschließlich "2018-09-22" die Verschiebung vom "2018-07-12". Deswegen kann ich die NAs nicht einfach mit 0 auffüllen.
Vielleicht hatte ich mich vorher auch etwas unklug ausgedrückt. Hoffe es ist klarer.
Hast du hierfür eine Idee, wie es gehen würde?

So, nun stimmt es. Jetzt gilt es noch, die Verschiebung pro Reihe zu berechnen. Du hast nicht geschrieben, in welcher Einheit die Verschiebung gemessen wird. Das hier addiert Sekunden, lässt sich aber bestimmt für Deine Zwecke anpassen:

Code: Alles auswählen

comb.DF$newdatetime <- comb.DF$datetime + comb.DF$Verschiebung
head(comb.DF, 20)

ah genau, die Verschiebung ist in Minuten und wird nicht addiert sondern subtrahiert. Nur Kleinigkeiten, aber der Vollständigkeit halber mal ergänzt

Code: Alles auswählen

comb.DF$newdatetime <- comb.DF$datetime - (comb.DF$Verschiebung*60) 
head(comb.DF, 20)

Vielen Dank und liebe Grüße!

[bigben]

Hallo Ilonia,

das gibt Dein reproduzierbares Beispiel tatsächlich nicht her, deshalb solltest Du am besten ein neues machen. Solange alles weitere nur unter Vorbehalt.

Ich nehme an, dass sich hinter Athomas' Link eine sehr effiziente Lösung verstecken dürfte. Ich würde tatsächlich eine for-Schleife basteln, die ungefähr so aussehen könnte:

Code: Alles auswählen

comb.DF <- merge(DF1, DF2, by = "date", all.x = TRUE)
head(comb.DF, 30)

comb.DF$Verschiebung[1] <- 0
for(i in 2:nrow(comb.DF))
  if(is.na(comb.DF$Verschiebung[i]))
    comb.DF$Verschiebung[i] <- comb.DF$Verschiebung[i-1]

head(comb.DF, 30)

Das setzt voraus, dass DF1 nach datetime sortiert ist. Falls das nicht vorausgesetzt werden kann, bitte ebenfalls im reproduzierbaren Minimalbeispiel berücksichtigen.

Alternativ könnte zum Vermeiden der for-Schleife die Funktion na.locf aus dem Paket zoo vielleicht hilfreich sein: https://www.rdocumentation.org/packages ... cs/na.locf
Oder die Funktion fill aus dem Paket tidyr: https://tidyr.tidyverse.org/reference/fill.html

LG,
Bernhard

[Athomas]

Ich nehme an, dass sich hinter Athomas' Link eine sehr effiziente Lösung verstecken dürfte.

Nicht nur sehr effizient, sondern auch sehr elegant !
Deshalb habe ich es ja auch zur gefälligen Kenntnisnahme empfohlen !

[Athomas]

Falls jemand irgendwann ein ähnliches Problem hat, hier noch die von mir angeregte data.table-Umsetzung:

Code: Alles auswählen

library(data.table)

# Erzeugung von 1 Mio zufälligen Zeitpunkten mit "Messwerten"

Anzahl_Zeitpunkte <- 1000000

startZeit    <- as.POSIXct("2018-01-01 00:00:00")
endZeit      <- as.POSIXct("2021-12-01 00:00:00")

diff <- endZeit - startZeit

DT <- data.table(Zeit = startZeit + diff*runif(Anzahl_Zeitpunkte), 
                 Wert = sample(1:5, Anzahl_Zeitpunkte, replace=TRUE))

# 8 davon werden (für dieses Beispiel!) als Startpunkte neuer "Verschiebungsphasen" ausgewählt.
# Damit sie nicht exakt mit dem Messzeitpunkt zusammenfallen, werden sie
# um 10*pi Sekunden verschoben (funktioniert natürlich auch mit 0!)
# Größe der Verschiebung wird in Minuten angegeben (zufällig, -2 bis 2)

Verschiebungen <- DT[sample(1:Anzahl_Zeitpunkte, 8), .(Zeit)]
Verschiebungen[  , ":="(Zeit=Zeit + 10*pi, Verschiebung=sample(-2:2, 8, replace=TRUE))]
setnames(Verschiebungen, "Zeit", "letzteVerschiebung")

# und für den "rolling join" vorbereitet

Verschiebungen[  , RollDate:=letzteVerschiebung]
setkey(Verschiebungen, RollDate)

DT[  , RollDate:=Zeit]
setkey(DT, RollDate)

# jetzt der eigentliche "rolling join"

Ergebnis <- Verschiebungen[DT, roll = TRUE]

# wenn es keinen vorherigen Verschiebungs-Zeitpunkt gibt (Phase vor der ersten
# Störung) wird 0 als Größe der Verschiebung eingetragen

Ergebnis[is.na(Verschiebung), Verschiebung:=0]

# Die Verschiebung wird in Sekunden umgewandelt und zur Zeitangabe addiert

Ergebnis[  , korrigierteZeit:=Zeit + 60*Verschiebung]