# Example: One true non-linear covariate function
# Define the function g1
g1 <- function(x) {
(3 * sin(2 * pi * x) / (2 - sin(2 * pi * x))) - 0.4641016
}
# Set parameters
n <- 100
p <- 50
err_sd <- 0.1 ** 2
tau <- 0.7
# Generate synthetic data
set.seed(1234)
x <- matrix(runif(n * p, min = 0, max = 1), n, p)
error_tau <- rnorm(n, sd = err_sd) - qnorm(tau, sd = err_sd)
y <- g1(x[, 1]) + error_tau
y <- y - mean(y)
# B-spline parameters
total_knots <- 5
degree <- 2
boundaries <- c(0, 1)
xx <- seq(from = 0, to = 1, length.out = total_knots)
knots <- xx[2:(total_knots - 1)]
# Create B-spline matrix W
L <- total_knots + degree - 1
bspline_results <- lapply(1:n, function(i) orthogonize_bspline(knots, boundaries, degree, x[i, ]))
W <- matrix(
t(sapply(bspline_results, function(result) sqrt(L) * result$bsplines[, -1])),
ncol = p * (L - 1),
byrow = TRUE
)
# Perform quantile regression with group Lasso
n_lambda <- 10
max_lambda <- 10
lambda <- c(0, exp(seq(log(max_lambda / 1e4), log(max_lambda), length = (n_lambda - 1))))
result <- qrglasso(as.matrix(y), W, p)
# BIC Results
plot(result)
# Prediction
estimate = predict(result, top_k = 1)
plot(estimate)
Run the code above in your browser using DataLab