## ----setup, include=FALSE-----------------------------------------------------
knitr::opts_chunk$set(echo = TRUE, fig.width = 7, fig.height = 5)
library(BsplineQuantReg)

## ----demos--------------------------------------------------------------------
# Example of available demos
dev.new()
demo(package = "BsplineQuantReg",temperature2)

# Run specific demos:
# demo("monotonicity")      - Increasing/decreasing constraints
# demo("convexity")         - Convexity/concavity constraints  
# demo("der3")              - Third derivative constraints
# demo("comprehensive")     - All constraint types
# demo("temperature")       - Real-world example with temperature data

## ----monotonicity-------------------------------------------------------------
# Generate data
set.seed(42)
n <- 100
x <- seq(0, 1, length.out = n)
y <- 2*x + 0.5*sin(4*pi*x) + 0.1*rnorm(n)
knots <- quantile(x, probs = seq(0, 1, length.out = 10))

# Unconstrained
fit_uncon <- quantile_spline(x, y, knots, tau = 0.5)

# Increasing constraint
fit_inc <- quantile_spline(x, y, knots, tau = 0.5, monot = 1)

# Decreasing constraint
fit_dec <- quantile_spline(x, y, knots, tau = 0.5, monot = -1)

# Compare
x_eval <- seq(0, 1, length.out = 200)
plot(x, y, pch = 16, cex = 0.5, col = "gray", main = "Monotonicity Constraints")
lines(x_eval, spline_eval(fit_uncon, x_eval), col = "red", lwd = 2, lty = 2)
lines(x_eval, spline_eval(fit_inc, x_eval), col = "blue", lwd = 2)
lines(x_eval, spline_eval(fit_dec, x_eval), col = "green", lwd = 2)
legend("topleft", legend = c("Unconstrained", "Increasing", "Decreasing"),
       col = c("red", "blue", "green"), lty = c(2, 1, 1), lwd = 2)

## ----convexity----------------------------------------------------------------
# Convex function
y_conv <- (x - 0.5)^2 + 0.05*rnorm(n)

fit_convex <- quantile_spline(x, y_conv, knots, tau = 0.5, convcons = 1)

plot(x, y_conv, pch = 16, cex = 0.5, col = "gray", main = "Convexity Constraint")
lines(x_eval, spline_eval(fit_convex, x_eval), col = "blue", lwd = 2)

## ----der3---------------------------------------------------------------------
# Cubic function with varying third derivative
y_cubic <- x^3 - 1.5*x^2 + 0.5*x + 0.05*rnorm(n)

fit_der3_pos <- quantile_spline(x, y_cubic, knots, tau = 0.5, der3cons = 1)

plot(x, y_cubic, pch = 16, cex = 0.5, col = "gray", main = "Third Derivative Constraint")
lines(x_eval, spline_eval(fit_der3_pos, x_eval), col = "blue", lwd = 2)

## ----partial-monot------------------------------------------------------------
# Increasing only on first half
monot_partial <- c(rep(1, 5), rep(0, 4))  # 5 intervals increasing, 4 unconstrained

fit_partial <- quantile_spline(x, y, knots, tau = 0.5, monot = monot_partial)

plot(x, y, pch = 16, cex = 0.5, col = "gray", main = "Partial Monotonicity")
lines(x_eval, spline_eval(fit_partial, x_eval), col = "blue", lwd = 2)
abline(v = knots[6], col = "red", lty = 2)  # Boundary of constrained region

## ----partial-convex-----------------------------------------------------------
# Convex on right half only
conv_partial <- rep(0, length(knots))
for (i in 1:length(knots)) {
  if (knots[i] > 0.5) conv_partial[i] <- 1
}

fit_conv_partial <- quantile_spline(x, y, knots, tau = 0.5, convcons = conv_partial)
plot(x, y, pch = 16, cex = 0.5, col = "gray", main = "Partial Convexity")
lines(x_eval, spline_eval(fit_conv_partial, x_eval), col = "blue", lwd = 2)
abline(v = knots[6], col = "red", lty = 2)  # Boundary of constrained region

## -----------------------------------------------------------------------------
# Increasing AND convex
fit_both <- quantile_spline(x, y, knots, tau = 0.5, 
                            monot = 1, convcons = 1)

plot(x, y, pch = 16, cex = 0.5, col = "gray", 
     main = "Mixed Constraints: Increasing + Convex")
lines(x_eval, spline_eval(fit_both, x_eval), col = "blue", lwd = 2)

## ----multiple-knots-----------------------------------------------------------
# Create knots with multiplicity at a point
sn_mult <- c(0, 0, 0, 0, 0.3, 0.5, 0.5,0.5,0.5, 0.7, 1, 1, 1, 1)
basis_mult <- Bspline_base(sn_mult, degree = 3)
knots_mult <- basis_mult$knot

# Fit with constraints
fit_mult <- quantile_spline(x, y, knots_mult, tau = 0.5, monot = 1)
plot(x, y, pch = 16, cex = 0.5, col = "gray", 
     main = "Constraints with Multiple knots")
lines(x_eval, spline_eval(fit_mult, x_eval), col = "blue", lwd = 2)

## ----visualize-constraints----------------------------------------------------
par(mfrow = c(2, 2))

# No constraints
plot(x, y, pch = 16, cex = 0.4, col = "gray", main = "Unconstrained")
lines(x_eval, spline_eval(fit_uncon, x_eval), col = "red", lwd = 2)

# Monotonicity
plot(x, y, pch = 16, cex = 0.4, col = "gray", main = "Monotonicity")
lines(x_eval, spline_eval(fit_inc, x_eval), col = "blue", lwd = 2)

# Convexity
plot(x, y, pch = 16, cex = 0.4, col = "gray", main = "Convexity")
lines(x_eval, spline_eval(fit_convex, x_eval), col = "blue", lwd = 2)

# Mixed
plot(x, y, pch = 16, cex = 0.4, col = "gray", main = "Mixed")
lines(x_eval, spline_eval(fit_both, x_eval), col = "blue", lwd = 2)

par(mfrow = c(1, 1))

## -----------------------------------------------------------------------------
demo(package = "BsplineQuantReg")