require("ggplot2")
## Generate some data
#------------------------------------------------------
# Simulate regression data according to the cubic model
# f(x) = 0.8x - 1.8x^2 + 1.05x^3 for x in [0,1]
par <- c(0,0.8,-1.8,1.05) # Parameters of the true polynomial model
res <- 100 # Resolution
x <- seq(0, 1, by=1/res); x2=x^2; x3=x^3;
f <- par[1] + par[2]*x + par[3]*x^2 + par[4]*x^3 # The true function
d <- f + rnorm(length(x), 0, 0.04) # Data
# Estimate polynomial regression model
reg <- lm(d ~ x + x2 + x3)
ftheta <- reg$fitted.values
resid0 <- reg$residuals
# Bootstrap regression
B <- 200 # Number of bootstrap samples
df <- NULL
for(i in 1:B) {
u <- sample(resid0, size=length(resid0), replace=TRUE)
reg1 <- lm((ftheta+u) ~ x + x2 + x3)
df <- rbind(df, data.frame(y=reg1$fitted.values, x=x, i=i,
g=ifelse(i<14, "A", "B"), g2=ifelse(i<100, "A", "B")))
}
ggplot(df) + geom_line(aes(x, y, group=i))
ggplot(df) + geom_central_region(aes(x=x, y=y, curveid=i), coverage=0.50)
ggplot(df) + geom_central_region(aes(x=x, y=y, curveid=i), coverage=0.50, filled=FALSE)
# Central regions for two groups as specified by 'g2'
ggplot(df) + geom_central_region(aes(x=x, y=y, curveid=i, col=g2), coverage=0.90, filled=FALSE)
ggplot(df) + geom_central_region(aes(x=x, y=y, curveid=i), coverage=0.90) + facet_wrap(vars(g2))
# \dontshow{
# If nr. of functions < 20, then the functions are drawn; otherwise the 100*coverage% central region
ggplot(df[df$i < 10,]) + geom_central_region(aes(x=x, y=y, curveid=i), coverage=0.90)
# Central regions for two groups split by 'g'; <20 functions in the first group
ggplot(df) + geom_central_region(aes(x=x, y=y, curveid=i, col=g, fill=g), coverage=0.90)
ggplot(df) + geom_central_region(aes(x=x, y=y, curveid=i, col=g), coverage=0.90, filled=FALSE)
# }
# Central regions with multiple coverage levels
ggplot(df) + geom_central_region(aes(x=x, y=y, curveid=i), coverage=c(0.2,0.4,0.6)) +
theme_minimal()
ggplot(df) + geom_central_region(aes(x=x, y=y, curveid=i), coverage=seq(0.1, 0.9, length=20),
colours=rainbow(20))
# \donttest{
# Colors for multiregions are not supported
ggplot(df) + geom_central_region(aes(x=x, y=y+0.1*(g2=="B"),
curveid=i, col=as.factor(g2)), coverage=c(0.05, 0.2,0.4,0.6))
# }
ggplot(df) + geom_central_region(aes(x=x, y=y, curveid=i),
coverage=c(0.05, 0.2,0.4,0.6)) + facet_wrap(vars(g2))
# Using stat_central_region with geom_linerange and geom_rect
ggplot(df) +
geom_linerange(aes(curveid=i, x=x, y=y, ymax=after_stat(ymax), ymin=after_stat(ymin),
group=g2, col=factor(g2)),
stat="central_region", coverage = 0.90, position=position_dodge(0.01))
ggplot(within(df, {x = x+0.004*(g2=="B")})) +
geom_rect(aes(curveid=i, x=x, y=y, xmax=after_stat(x), xmin=after_stat(x+0.004),
ymax=after_stat(ymax), ymin=after_stat(ymin), group=g2, fill=factor(g2)),
stat="central_region", coverage = 0.90)
# \donttest{
# Non-finite values are not supported
ggplot(within(df, {y = ifelse(runif(length(y)) < 0.001, Inf, y)})) +
geom_central_region(aes(x=x, y=y, curveid=i))
# }
Run the code above in your browser using DataLab