Deutsches R-Forum

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) {
  regData <- Gruppe[Zykl==whichZykl(Gruppe)]
  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) {
  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]

########################

plot_last_flanc<-function(Gruppe) {
  regData <- Gruppe[Zykl==whichZykl(Gruppe)]
  
  lm1.model <- lm(Date ~ Level, data=regData)
  plot(Date ~ Level, data=regData)
  abline(lm1.model, col="red")
}

Example_Set[V1==Gruppen[7], { plot_last_flanc(.SD); title(main=first(V1)) }, by=V1]

Code: Alles auswählen

Example_Set[V1==Gruppen[7], { plot_last_flanc(.SD); title(main=first(V1)) }, by=V1]

Code: Alles auswählen

Example_Set[, { plot_last_flanc(.SD); title(main=first(V1)) }, by=V1]