if (FALSE) {
data("green")
x.green <- seq(min(log(green$COST)), max(log(green$COST)), length.out=101)
# 1. Unconstrained quadratic spline fits
# Optimal number of inter-knot segments via the BIC criterion
(kn.bic.green.u<-quad_spline_kn(log(green$COST),
log(green$OUTPUT), method="u", type="BIC"))
# Unconstrained spline estimate
y.quad.green.u<-quad_spline_est(log(green$COST),
log(green$OUTPUT), x.green, kn=kn.bic.green.u, method="u")
# 2. Monotonicity constraint
# Optimal number of inter-knot segments via the BIC criterion
(kn.bic.green.m<-quad_spline_kn(log(green$COST),
log(green$OUTPUT), method="m", type="BIC"))
# Monotonic splines estimate
y.quad.green.m<-quad_spline_est(log(green$COST),
log(green$OUTPUT), x.green, kn=kn.bic.green.m, method="m")
# 3. Monotonicity and Concavity constraints
# Optimal number of inter-knot segments via the BIC criterion
(kn.bic.green.mc<-quad_spline_kn(log(green$COST),
log(green$OUTPUT), method="mc", type="BIC"))
# Monotonic/Concave splines estimate
y.quad.green.mc<-quad_spline_est(log(green$COST),
log(green$OUTPUT), x.green, kn=kn.bic.green.mc,
method="mc", all.dea=TRUE)
# Representation
plot(x.green, y.quad.green.u, lty=1, lwd=4, col="green",
type="l", xlab="log(COST)", ylab="log(OUTPUT)")
lines(x.green, y.quad.green.m, lty=2, lwd=4, col="cyan")
lines(x.green, y.quad.green.mc, lwd=4, lty=3, col="magenta")
points(log(OUTPUT)~log(COST), data=green)
legend("topleft", col=c("green","cyan","magenta"),
lty=c(1,2,3), legend=c("unconstrained", "monotone",
"monotone + concave"), lwd=4, cex=0.8)
}
Run the code above in your browser using DataLab