Seite 1 von 2

.SD Blockade lösen

Verfasst: Fr Sep 14, 2018 8:15 am
von Regression
Guten morgen,

sei folgender Datensatz gegeben:

Code: Alles auswählen

dt<-data.table(Level=c(100,100,100,98:3,100,100,99,98,2,2,2,1,1,0,100,100,99:87,100,100,100,98:3,100,100,99,98,97,2,2,2,1,1,0,100,98:85), Zykl=c(rep(1,109),rep(2,15),rep(1,110),rep(2,15)),ID= c(rep(1,124),rep(2,125)))
Dieser beinhaltet zwei ID die über mehrere Zyklen. Dabei läuft ein Zyklus von 100 bis 0 (Level) runter.
Nun möchte ich Ausreißer kurz vor dem Ende des Zyklus beseitigen. Hierzu habe ich folgende Funktion geschrieben:
(Womit ich noch nicht zufrieden bin da es eine while-Schleife beinhaltet, aber mir ist kein anderer Weg eingefallen, da ich i.A. nicht weiß wie lange der Außreißer andauert)

Code: Alles auswählen

outlier_deletion<-function(Maindata){
  Maindata[,test_var:=ifelse(Level>90 &  shift(Level,type = "lead")<10  , 1,0)]
  if(max(Maindata$test_var, na.rm = TRUE)>0){i<-1}else{i<-0}
    while (i==1) {
      Maindata[,test_var:=ifelse(Level>90 &  shift(Level,type = "lead")<10  , 1,0)]
      if(max(Maindata$test_var, na.rm = TRUE)>0){i<-1}else{i<-0}
      Maindata<-Maindata[test_var!=1]
      Maindata[, Level_diff := Level - shift(Level)]
    }
   return(Maindata)
 } 
Diese Funktion funktioniert zuverlässig, wenn ich es auf jedes ID einzeln anwende:

Code: Alles auswählen

dt1<-dt[ID==1]
dt2<-fake_flanc_deletion(dt1)
Wenn ich allerdings auf den gesamten Datensatz es tue:

Code: Alles auswählen

dt<-dt[,fake_flanc_deletion(.SD),ID]
kommt folgende Meldung raus:
Error in `[.data.table`(Maindata, , `:=`(test_var, ifelse(Level > 90 & :
.SD is locked. Using := in .SD's j is reserved for possible future use; a tortuously flexible way to modify by group. Use := in j directly to modify by group by reference.
Die Recherche hat bislang kaum was ergeben, ich weiß dass ich j manipuliere und damit den Datensatz verändere, aber genau das ist ja auch gewollt. Nun Blockiert der .SD und ich weiß nicht wie ich es umgehen kann.

Besten Dank für Eure Unterstützung im Voraus!

Re: .SD Blockade lösen

Verfasst: Fr Sep 14, 2018 8:44 am
von jogo
Du benötigst hier die Funktion copy()

Code: Alles auswählen

library(data.table)
dt<-data.table(Level=c(100,100,100,98:3,100,100,99,98,2,2,2,1,1,0,100,100,99:87,100,100,100,98:3,100,100,99,98,97,2,2,2,1,1,0,100,98:85), Zykl=c(rep(1,109),rep(2,15),rep(1,110),rep(2,15)),ID= c(rep(1,124),rep(2,125)))

fake_flanc_deletion <- function(M) {
  Maindata <- copy(M)
  Maindata[, test_var:=ifelse(Level>90 &  shift(Level,type = "lead")<10, 1, 0)]
  if (max(Maindata$test_var, na.rm=TRUE)>0) i <- 1 else i <- 0
  while (i==1) {
    Maindata[, test_var:=ifelse(Level>90 &  shift(Level,type = "lead")<10, 1, 0)]
    if (max(Maindata$test_var, na.rm = TRUE)>0) i <-1 else i <- 0
    Maindata <- Maindata[test_var!=1]
    Maindata[, Level_diff := Level - shift(Level)]
  }
  return(Maindata)
} 

dt[, fake_flanc_deletion(.SD), ID]
Gruß, Jörg

Re: .SD Blockade lösen

Verfasst: Fr Sep 14, 2018 8:47 am
von Athomas
Dabei läuft ein Zyklus von 100 bis 0 (Level) runter.
Definier doch bitte mal "Zyklus" und sag dabei, in welcher Beziehung die Variable "Level" zu "Zykl" steht...
Nun möchte ich Ausreißer kurz vor dem Ende des Zyklus beseitigen.
Was ist denn das Wesen eines Ausreißers?

Re: .SD Blockade lösen

Verfasst: Fr Sep 14, 2018 9:43 am
von jogo
Hallo Regression,

taugt dies hier als Modell:

Code: Alles auswählen

dt2 <- dt[ID==1 & Zykl==1]
dt2[-((1+dt2[, which(Level<shift(Level, type="lead"))]):
    dt2[, which(Level>90 &  shift(Level, type="lead")<10)]) ]
:?:
Hier einige vorbereitende Berechnungen:

Code: Alles auswählen

dt[, .N, .(Zykl, ID)]
dt[, .(.SD[, which(Level<shift(Level, type="lead"))],
         .SD[, which(Level>90 &  shift(Level, type="lead")<10)]), by=.(ID, Zykl)]
Gruß, Jörg

Re: .SD Blockade lösen

Verfasst: Fr Sep 14, 2018 11:31 am
von Regression
Ich bin begeistert, vielen Dank Jörg!
sowohl die Lösung mit der copy() Funktion hat funktioniert, als auch Dein deutlich eleganterer Ansatz ohne Schleife !


Freundliche Grüße
Regression

Re: .SD Blockade lösen

Verfasst: Fr Sep 14, 2018 11:35 am
von jogo
Dann schau Dir doch mal dies an:

Code: Alles auswählen

ffdel <- function(M) {
  up <- M[, Level<shift(Level, type="lead")]
  if (!any(up, na.rm=TRUE)) return(M)
  M[-((1+which(up)):M[, which(Level>90 &  shift(Level, type="lead")<10)])]
}
  
dt[, ffdel(.SD), .(Zykl, ID)]
Falls die zu entfernenden Zeilen die letzten im Zyklus sind, gibt es wahrscheinlich Probleme.
(soll heißen: dieser Fall ist noch nicht berücksichtigt)

Gruß, Jörg

Re: .SD Blockade lösen

Verfasst: Fr Sep 14, 2018 2:28 pm
von Regression
Sehr schöne und effiziente Lösung :) Danke
Error in (1 + which(up)):M[, which(Level > 90 & shift(Level, type = "lead") < :
argument of length 0
Error in `[.data.table`(dt, , ffdel(.SD), :
j doesn't evaluate to the same number of columns for each group
Habe allerdings jetzt oben genannte Fehlermeldung, diese resultiert vermutlich dadurch, dass in einigen ID's keine Ausreißer sind oder?
Ist es Sinnvoll in diesem Fall es mit try()- Funktion zu umgehen, oder lieber dirkt in der ffdel()-Funktion nach der Länge abfregen?

LG

Re: .SD Blockade lösen

Verfasst: Fr Sep 14, 2018 2:36 pm
von jogo
Regression hat geschrieben: Fr Sep 14, 2018 2:28 pm
Error in (1 + which(up)):M[, which(Level > 90 & shift(Level, type = "lead") < :
argument of length 0
Error in `[.data.table`(dt, , ffdel(.SD), :
j doesn't evaluate to the same number of columns for each group
Habe allerdings jetzt oben genannte Fehlermeldung, diese resultiert vermutlich dadurch, dass in einigen ID's keine Ausreißer sind oder?
Ist es Sinnvoll in diesem Fall es mit try()- Funktion zu umgehen, oder lieber direkt in der ffdel()-Funktion nach der Länge abfragen?
Hast Du andere Daten für mich, damit auch ich den Fehler reproduzieren kann?
(mit den bisherigen Daten läuft der Code ohne Fehler)
Hast Du die Funktion modifiziert?

Ich habe bisher nie try() eingesetzt. :roll:

Gruß, Jörg

Re: .SD Blockade lösen

Verfasst: Fr Sep 14, 2018 2:46 pm
von Regression
Die Funktion habe ich nicht modiefieziert, mein kompletter Datensatz über 500k Zeilen :?
Ich versuche rauszufinden, wo es tatsächlich hängen bleibt und stelle es Dir zur Verfügung.
Danke schon mal!

----
EDIT:

Kann ich eventuell mit der Debug Funtion feststellen an welcher Stelle (an welcher ID) es scheitert?
Und Falls ja, wo finde ich die Information wie man die Debug funktion benutzt? :oops:

Re: .SD Blockade lösen

Verfasst: Fr Sep 14, 2018 2:51 pm
von jogo
Vielleicht kannst Du so die kritische Gruppe identifizieren:

Code: Alles auswählen

dt[, { print(.BY); ffdel(.SD)}, .(Zykl, ID)]
Für das Debuggen gibt es zwei Möglichkeiten:

Code: Alles auswählen

debug(ffdel)
hiermit wird der Debugger für die Funktion ffdel() eingeschaltet. Immer wenn die Funktion aufgerufen wird, landet man im Browser und kann dann die Verarbeitung Schritt für Schritt steuern und hat dabei die Console zur Verfügung, um die Ergebnisse zu kontrollieren oder zu manipulieren.
Die zweite Möglichkeit ist, den Aufruf der Funktion browser() direkt in den Code zu setzen - man sollte allerdings wissen, wann dieser Aufruf erfolgen soll ;)

hier noch eine Variente für die Diagnose:

Code: Alles auswählen

dt[, { print(.BY); ffdel(.SD)[, .N]}, .(Zykl, ID)]
Da es sich um einen Laufzeitfehler handelt, sollte R bis zum Auftreten des Fehlers problemlos arbeiten.

Gruß, Jörg
p.s.:
ich habe eine Idee, woran es liegt. Entscheidend ist der erste Teil der Meldung ...
Ich habe die Daten etwas geändert:

Code: Alles auswählen

dt<-data.table(Level=c(100,100,100,98:3,100,100,99,98,22,2,2,1,1,0,100,100,99:87,100,100,100,98:3,100,100,99,98,97,2,2,2,1,1,0,100,98:85), Zykl=c(rep(1,109),rep(2,15),rep(1,110),rep(2,15)),ID= c(rep(1,124),rep(2,125)))


ffdel <- function(M) {
  up <- M[, Level<shift(Level, type="lead")]
  if (!any(up, na.rm=TRUE)) return(M)
  M[-((1+which(up)):M[, which(Level>90 &  shift(Level, type="lead")<10)])]
}

dt[ID==1 & Zykl==1, { print(.BY); ffdel(.SD)[, .N]}, .(Zykl, ID)]
Die Frage ist also wenn die ff z.B. so endet: 97, 22, 2, 2, 1, 1, 1, 0 - welche Zeilen soll dann gelöscht werden :?: