upperLower.R

x <- as.numeric(flu1$Date)
y <- flu1$Paraguay
a <- lowess(x,y,f=2/3)
yhat <- a$y
r <- y-yhat
rplus <- lowess(x[sign(r)==1],yhat[sign(r)==1],f=2/3)$y
rminus <- lowess(x[sign(r)==-1],yhat[sign(r)==-1],f=2/3)$y

plot(x,y,xlab="Anteil Winterschlaf [%]",ylab="Alter zum Todeszeitpunkt [Tage]")

lines(x[sign(r)==1],yhat[sign(r)==1]+rplus)
lines(x[sign(r)==-1],yhat[sign(r)==-1]+rminus)

# Selecting Time Frame
x <- flu$Date[45:583]
y <- log(flu$Switzerland[45:583])
plot(x,y,main="\nSchweizer Flu-Daten mit LOWESS Glättung (Span: 0,07) und Upper/Lower-Smoothing\n", xlab="flu$Date",ylab="log(flu$Switzerland)")
# Repeating Loess-Trend-Calculation with Span = 0,07
trend <- loess(y~as.numeric(x), data=flu, span=0.07)
prediction <- predict(trend, as.numeric(x))
# Calculating and Subsetting Upper and Lower Residuals
res <- residuals(trend)
high <- res > 0
set1.x <- x[high]
set1.y <- res[high]
set2.x <- x[!high]
set2.y <- res[!high]
# Smooth Upper and Lower Residuals
trend.high <- loess(set1.y ~ as.numeric(set1.x))
trend.low <- loess(set2.y ~ as.numeric(set2.x))
# Add to the Middle Smooth
yhat <- predict(trend)
upper <- predict(trend.high, as.numeric(set1.x)) + yhat[high]
lower <- predict(trend.low, as.numeric(set2.x)) + yhat[!high]
# Implement into Graphic
lines(x, yhat, lwd=1, col="red")
lines(set1.x, upper, lty = "dotted", col = "red")
lines(set2.x, lower, lty ="dotted", col = "red")

etwas komplexer, aber funzt ;-)