R - Transponiert und berechnet Differenzen zwischen einer unbekannten Anzahl von Datumsspalten. Eine lesbarere Möglichkeit?

Question

Ich passe eine unbekannte Anzahl von mehreren Datumsperioden innerhalb einer Hauptreihenfolge von Perioden an. Gibt es einen besser lesbaren oder kompakteren Weg als meinen Weg? Ich mische sqldf und data.table hier, da ich beide librarys im Projekt verwende, aber könnte es in reiner data.table wenn erforderlich tun. Oder umgekehrt. Andere gut entwickelte Bibliotheken sind auch in Ordnung.

Keine Hardcoding, ich habe dies mit mehreren Optionen ausgeführt und kenne nicht die maximale Anzahl von Perioden in Perioden. Die Anzahl der Perioden innerhalb der Perioden hat keine theoretische Obergrenze (gut vielleicht 365), aber eine grundlegende Überprüfung der Gesundheit sollte das Maximum um 6-15 Perioden, abhängig von der Spezifikation, setzen.

Dies ist eine Darstellung des Arbeitscodes, den ich atm (als eine Funktion im ursprünglichen Skript geschrieben) verwenden.

Ich würde gerne glauben, dass es eine kürzere/besser lesbare Funktion geben sollte. Können wir im DBT-Teil etwas tun, das die Differenzen berechnet und eine Summenfunktion anwendet? Ich habe versucht, aber das fun.aggregate scheint auf einfachere Operationen beschränkt zu sein.

library("data.table") 
library("sqldf") 

Data <- data.table(
    Fnr  = c(22516, 22516, 22516, 45459, 45459), 
    Vernr = c(1,1,1,1,2), 
    Startdat = c("2010-01-01", "2010-01-01", "2012-01-01", 
       "2013-04-01", "2013-04-01"), 
    Endat = c("2010-12-31", "2010-12-31", "2012-05-19", 
       "2014-03-31", "2014-03-31"), 
    Fromdat = c("2010-02-21", "2010-08-16", NA, "2013-08-31", "2014-01-02"), 
    Tomdat = c("2010-05-16", "2010-09-11", NA, "2013-10-27", "2014-02-13") 
) 

tmp.eval <- "list(Fnr, Vernr, Startdat, Endat)" 

dt_tmp <- Data[, nobs_id := order(Fromdat), 
       by = eval(parse(text = tmp.eval))] 

dt_tmp <- dt_tmp[, c("Fromdat", "Tomdat") := list(as.Date(Fromdat), 
                as.Date(Tomdat))] 

dt_tmp <- dcast(dt_tmp, Fnr + Vernr + ... ~ nobs_id, 
       value.var = c("Fromdat", "Tomdat")) 

dt.colnames <- data.table(colnames(dt_tmp)) 
dt.col1 <- dt.colnames[substr(V1,1,3) == "Fro"][, c("nobs_id", "Fromdat") := 
               list(order(V1),V1)] 
dt.col2 <- dt.colnames[substr(V1,1,3) == "Tom"][, c("nobs_id", "Tomdat") := 
               list(order(V1),V1)] 
dt.set <- merge(dt.col1[,V1 := NULL], dt.col2[,V1 := NULL], 
       by = "nobs_id") 
dt.set <- dt.set[, diff_col := paste(Tomdat,Fromdat, sep = "-")] 
dt.set <- dt.set[, diff_col := paste(diff_col, " diff_",nobs_id, sep = "")] 
dt.set <- dt.set[, diffvar_col := paste("as.numeric(diff_",nobs_id,")", 
             sep = "")] 

str.diff <- paste(dt.set$diff_col, collapse = ",") 
str.diffvar <- paste(dt.set$diffvar_col, collapse = ",") 
str.diffvar <- paste("sum(", str.diffvar, ", na.rm = TRUE)") 

dt_tmp <- sqldf(sprintf("SELECT *, %s FROM dt_tmp", 
         str.diff) 
       ) 

dt_tmp <- setDT(dt_tmp)[Startdat <= Endat, 
         corr_days := eval(parse (text = str.diffvar)),  
         by = list(Fnr, Vernr, Startdat, Endat)] 

Answer 1

Ich bin nicht 100% sicher, was Sie versuchen, hier zu tun, sondern ist ein Weg, um die gleiche endgültige Ausgabe von dt_tmp zu bekommen. Angenommen, ich interpretiere, was Sie versuchen, richtig zu machen, dann ist der Trick, zuerst Ihre Berechnungen zu machen, dann zu schmelzen und dann zu werfen.

Data[, nobs_id := order(Fromdat), 
    by = list(Fnr, Vernr, Startdat, Endat)] 
Data[,Tomdat:=as.IDate(Tomdat)] 
Data[,Fromdat:=as.IDate(Fromdat)] 
Data[,diff:=as.integer(Tomdat-Fromdat)] 
Data[,corr_days:=sum(diff),by= list(Fnr, Vernr, Startdat, Endat)] 
mytemp<-dcast(melt(Data,id.vars=c('Fnr','Vernr','Startdat','Endat','nobs_id','corr_days')),Fnr+Vernr+Startdat+Endat+corr_days~variable+nobs_id,value.var='value') 

#if you want them in the same order as your dt_tmp 
setcolorder(mytemp, c(names(mytemp)[!names(mytemp)%in%'corr_days'],'corr_days')) 



#if you want the date columns to be type character again 
datecols<-names(mytemp)[grepl('dat',names(mytemp))] 
mytemp[,(datecols):=lapply(.SD,as.character),.SDcols=datecols]