Ja genau mind. 10 Abmessungen sonst soll "insufficient Data" ausgegeben werden.
DANKE
Code: Alles auswählen
library("data.table")
library("readxl")
Example_Set <- read_excel("Example_Set.xlsx")
setDT(Example_Set)
#Gruppen <- Example_Set[, unique(V1)]
Example_Set[, Level_diff := Level - shift(Level), V1]
Example_Set[, Zykl:=rleidv(Level_diff>0), V1]
Example_Set[, .(.N, m=max(Level)), by=.(V1, Zykl)]
whichZykl <- function(Gruppe) {
Z <- Gruppe[, .(m=max(Level)), by=Zykl]
if (Z[, .N] %% 2) Z <- tail(Z, -1)
Z[m>=60, last(Zykl)]
}
date_forecast<-function(Gruppe, Level_alert=10) {
regZyk <- whichZykl(Gruppe)
regData <- Gruppe[Zykl %in% c(regZyk-1, regZyk)]
if (regData[, .N] < 10) return("insufficient Data")
lm1.model <- lm(Date ~ Level, data=regData)
D <- predict.lm(lm1.model, newdata = data.frame(Level=10))
as.character(as.POSIXct(D, origin="1970-01-01"))
}
Example_Set[, date_forecast(.SD), by=V1]
Code: Alles auswählen
whichZykl <- function(Gruppe) {
Z <- Gruppe[, .(.N, m=max(Level)), by=Zykl]
#nZ <- Z[, .N]
#if (nZ %% 2) { Z <- tail(Z, -1); nZ <- nZ -1 }
Z[m>=60&N>=3]
}
medianLC_forecast<-function(Gruppe, Level_alert=10) {
D<-c()
regZyk <- whichZykl(Gruppe)
for (i in 1:length(regZyk)) {
regData <- Gruppe[Zykl %in% c(regZyk[i]-1, regZyk[i])]
if (regData[, .N] < 10){ return("insufficient Data")}
else{
lm1.model <- lm(Date ~ Level, data=regData)
D_0 <- predict.lm(lm1.model, newdata = data.frame(Level=0))
D_0<-as.Date(D_0, origin="1970-01-01")
D_100 <- predict.lm(lm1.model, newdata = data.frame(Level=100))
D_100<-as.Date(D_100, origin="1970-01-01")
d<-c(D_0,D_100)
D<-c(D,abs(diff.Date(d)))
}
}
return(median(D))
}
Code: Alles auswählen
medianLC_forecast<-function(Gruppe, Level_alert=10) {
D<-c()
regZyk <- whichZykl(Gruppe)
for (i in 1:length(regZyk)) {
regData <- Gruppe[Zykl %in% c(regZyk[i]-1, regZyk[i])]
if (regData[, .N] < 10){ return("insufficient Data")}
else{
lm1.model <- lm(Date ~ Level, data=regData)
D_0 <- predict.lm(lm1.model, newdata = data.frame(Level=0))
D_0<-as.Date(D_0, origin="1970-01-01")
D_100 <- predict.lm(lm1.model, newdata = data.frame(Level=100))
D_100<-as.Date(D_100, origin="1970-01-01")
d<-c(D_0,D_100)
D<-c(D,abs(diff.Date(d)))
}
}
return(median(D))
}
Code: Alles auswählen
if (regData[, .N] < 10) { return("insufficient Data") }
Code: Alles auswählen
Example_Set[, Zykl:=rleidv(Level_diff>0), V1]
In diesem Fall ja, da ich nur zwei Lebenszyklen habe, allerdings habe ich auch gruppen die bis zu 10 Lebenszyklen haben.
Wie meinst Du es?
Hier kann ich Dir leider nicht folgenjogo hat geschrieben: ↑Mi Mär 07, 2018 2:22 pm Nachtrag (nur so eine Idee):
Wenn man statthier eine richtige Nummer für den Zyklus generiert, wird vieles einfacher ...Code: Alles auswählen
Example_Set[, Zykl:=rleidv(Level_diff>0), V1]
z.B. (rleidv(...) +1) %/% 2
Was hältst Du davon?
Code: Alles auswählen
Example_Set[, Zykl:=rleidv(Level_diff>0), V1]
Es gehören momentan immer zwei Werte von $Zykl zu einem Zyklus:Regression hat geschrieben: ↑Do Mär 08, 2018 10:41 amIn diesem Fall ja, da ich nur zwei Lebenszyklen habe, allerdings habe ich auch gruppen die bis zu 10 Lebenszyklen haben.
Code: Alles auswählen
library("data.table")
library("readxl")
Example_Set <- read_excel("Example_Set.xlsx")
setDT(Example_Set)
Gruppen <- Example_Set[, unique(V1)]
Example_Set[, Level_diff := Level - shift(Level), V1]
Example_Set[, Zykl:=rleidv(Level_diff>0), V1]
Example_Set[, .(.N, m=max(Level)), by=.(V1, Zykl)]
Example_Set[V1==Gruppen[5]]
# oder besser noch:
Example_Set[V1==Gruppen[7]]
ach so; und von der Lebensdauer willst Du dann über die Zyklen hinweg den Median bestimmen, richtig?Wie meinst Du es?
da, die Daten meist unvollständig sind, Berechne ich den Zeitpunkt mit Level=100 und den mit Level=0, damit ich zwei Daten zum "Start und Endpunkt" habe. Die Differenz der beiden Werte ergibt dann die Lebensdauer von diesem Zyklus.
siehe obenHier kann ich Dir leider nicht folgenjogo hat geschrieben: ↑Mi Mär 07, 2018 2:22 pm Nachtrag (nur so eine Idee):
Wenn man statthier eine richtige Nummer für den Zyklus generiert, wird vieles einfacher ...Code: Alles auswählen
Example_Set[, Zykl:=rleidv(Level_diff>0), V1]
z.B. (rleidv(...) +1) %/% 2
Was hältst Du davon?Generiert doch bereits eine Richtige Nummer für den Zyklus, entsprechend der Gruppe.Code: Alles auswählen
Example_Set[, Zykl:=rleidv(Level_diff>0), V1]
Code: Alles auswählen
library("data.table")
library("readxl")
Example_Set <- read_excel("Example_Set.xlsx")
setDT(Example_Set)
Gruppen <- Example_Set[, unique(V1)]
Example_Set[, Level_diff := Level - shift(Level), V1]
Example_Set[, z:=rleidv(Level_diff>0), V1]
Example_Set[, Zykl := (z+1) %/% 2]
Example_Set[, .(.N, m=max(Level)), by=.(V1, Zykl, z)]
# Example_Set[V1==Gruppen[5]]
# Example_Set[V1==Gruppen[7]]
# Gruppen
whichZykl <- function(Gruppe) {
Z <- Gruppe[, .(.N, m=max(Level)), by=.(Zykl, z)]
if (Z[, .N] %% 2) Z <- tail(Z, -1)
Z[m>=60, last(Zykl)]
}
date_forecast<-function(Gruppe, Level_alert=10) {
regZyk <- whichZykl(Gruppe)
regData <- Gruppe[Zykl==regZyk]
if (regData[, .N] < 10) return("insufficient Data")
lm1.model <- lm(Date ~ Level, data=regData)
D <- predict.lm(lm1.model, newdata = data.frame(Level=10))
as.character(as.POSIXct(D, origin="1970-01-01"))
}
Example_Set[, date_forecast(.SD), by=V1]
Example_Set[, head(.SD,1), by=.(V1, Zykl)]
Example_Set[, tail(.SD,1), by=.(V1, Zykl)]
#######################
ZyklDauer <- function(ZyklData) { ### berechnet nicht wirklich die Dauer, sondern
### die Zeitpunkte für Level=100 und Level=0
lm1.model <- lm(Date ~ Level, data=ZyklData)
D <- predict.lm(lm1.model, newdata = data.frame(Level=c(100, 0)))
D <- as.POSIXct(D, origin="1970-01-01")
return(list(D100=D[1], D000=D[2], n=ZyklData[, .N]))
}
D <- Example_Set[, ZyklDauer(.SD), by=.(V1, Zykl)]
D[, Dauer := D000-D100]
D[n>=10, .(medDauer=median(Dauer)), V1]
Code: Alles auswählen
plot_last_flanc<-function(Gruppe) {
regZyk <- whichZykl(Gruppe)
regData <- Gruppe[Zykl %in% c(regZyk-1, regZyk)]
lm1.model <- lm(Date ~ Level, data=regData)
t<-regData$V1[1]
plot( regData$Date ~ regData$Level, main=t)
abline(lm1.model, col="red")
}
Example_Set[, plot_last_flanc(.SD), by=V1]