######***###### standard parameterization ######***######
# generate data
set.seed(0)
n <- 101
x <- factor(sort(rep(LETTERS[1:4], length.out = n)))
knots <- LETTERS[1:3]
eta <- 1:4
y <- eta[x] + rnorm(n, sd = 0.5)
# ordinal smoothing spline basis
X <- basis.ord(x, knots, intercept = TRUE)
# ordinal smoothing spline penalty
Q <- penalty.ord(knots, K = 4)
# pad Q with zeros (for intercept)
Q <- rbind(0, cbind(0, Q))
# define smoothing parameter
lambda <- 1e-5
# estimate coefficients
coefs <- solve(crossprod(X) + n * lambda * Q) %*% crossprod(X, y)
# estimate eta
yhat <- X %*% coefs
# check rmse
sqrt(mean((eta[x] - yhat)^2))
######***###### ridge parameterization ######***######
# generate data
set.seed(0)
n <- 101
x <- factor(sort(rep(LETTERS[1:4], length.out = n)))
knots <- LETTERS[1:3]
eta <- 1:4
y <- eta[x] + rnorm(n, sd = 0.5)
# ordinal smoothing spline basis
X <- basis.ord(x, knots, intercept = TRUE, ridge = TRUE)
# ordinal smoothing spline penalty (ridge)
Q <- diag(rep(c(0, 1), times = c(1, ncol(X) - 1)))
# define smoothing parameter
lambda <- 1e-5
# estimate coefficients
coefs <- solve(crossprod(X) + n * lambda * Q) %*% crossprod(X, y)
# estimate eta
yhat <- X %*% coefs
# check rmse
sqrt(mean((eta[x] - yhat)^2))
Run the code above in your browser using DataLab