Version:	1.0.0
Title:	Sparse Regression for Related Problems
Description:	Estimates sparse regression models (i.e., with few non-zero coefficients) in high-dimensional multi-task learning and transfer learning settings, as proposed by Rauschenberger et al. (2025) https://orbilu.uni.lu/handle/10993/63425.
Depends:	R (≥ 3.0.0)
Imports:	glmnet, pROC, stats, mvtnorm, spls, xrnet
Suggests:	knitr, testthat, remotes, glmtrans, rmarkdown
Encoding:	UTF-8
VignetteBuilder:	knitr
RoxygenNote:	7.3.2
URL:	https://github.com/rauschenberger/sparselink, https://rauschenberger.github.io/sparselink/
BugReports:	https://github.com/rauschenberger/sparselink/issues
License:	MIT + file LICENSE
NeedsCompilation:	no
Packaged:	2025-05-30 08:47:19 UTC; arauschenberger
Author:	Armin Rauschenberger [aut, cre]
Maintainer:	Armin Rauschenberger <armin.rauschenberger@lih.lu>
Repository:	CRAN
Date/Publication:	2025-06-03 09:30:05 UTC

Sparse regression for related problems

Description

The R package 'sparselink' implements sparse regression for related problems (multi-task learning and transfer learning).

Details

Use function [sparselink()] for model fitting. Type 'library(sparselink)' and then '?sparselink' or 'help("sparselink")' to open its help file.

See the vignette for further examples. Type 'vignette("sparselink")' or 'browseVignettes("sparselink")' to open the vignette.

Author(s)

Maintainer: Armin Rauschenberger armin.rauschenberger@lih.lu (ORCID)

References

Armin Rauschenberger, Petr N. Nazarov, and Enrico Glaab (2025). "Estimating sparse regression models in multi-task learning and transfer learning through adaptive penalisation". Under revision. https://hdl.handle.net/10993/63425

See Also

First use sparselink to fit the models, and then coef to extract coefficients or predict to make predictions.

Examples

?sparselink
?coef.sparselink
?predict.sparselink

Calculate deviance

Description

Calculates Gaussian deviance (mean-squared error) and binomial deviance.

Usage

calc_metric(y, y_hat, family)

Arguments

Value

Returns the deviance (scalar).

Examples

n <- 100
family <- "gaussian"
y <- stats::rnorm(n=n)
y_hat <- stats::rnorm(n=n)
calc_metric(y=y,y_hat=y_hat,family=family)

family <- "binomial"
y <- stats::rbinom(n=n,size=1,prob=0.5)
y_hat <- stats::runif(n=n)
calc_metric(y=y,y_hat=y_hat,family=family)

Regression Coefficients

Description

Extracts coefficients from multi-task or transfer learning regression model.

Usage

## S3 method for class 'sparselink'
coef(object, ...)

Arguments

Value

Returns estimated coefficients. The output is a list with two slots: slot alpha with the estimated intercept (vector of length q), and slot beta with the estimated slopes (matrix with p rows and q columns).

References

Armin Rauschenberger, Petr N. Nazarov, and Enrico Glaab (2025). "Estimating sparse regression models in multi-task learning and transfer learning through adaptive penalisation". Under revision. https://hdl.handle.net/10993/63425

See Also

Use sparselink to fit the model and predict to make predictions.

Examples

family <- "gaussian"
type <- "multiple" #  try "multiple" or "transfer"
if(type=="multiple"){
 data <- sim_data_multi(family=family)
} else if(type=="transfer"){
 data <- sim_data_trans(family=family)
}

object <- sparselink(x=data$X_train,y=data$y_train,family=family)
coef <- coef(object=object)

Construct penalty factors

Description

Uses internal and external weights as well as internal and external exponents or factors for these weights to construct penalty factors.

Usage

construct_penfacs(w_int, w_ext, v_int, v_ext, type)

Arguments

Details

While internal weights are from the problem of interest ("supported" problem), external weights are from the other problems ("supporting" problems).

Multiple options exist for scaling prior weights:

• "exp": w_{int}^{v_{int}}+w_{ext}^{v_{ext}}

• "ari": v_{int} w_{int} + v_{ext} w_{ext}

• "geo": w_{int}^{v_{int}} w_{ext}^{v_{ext}}

• "rem": w_{int}^{v_{int}}+w_{ext}^{v_{ext}}-\mathbb{I}(v_{int}=0)-\mathbb{I}(v_{ext}=0))

The constrained versions "exp.con", "ari.con", "geo.con", and "rem.con" impose v_{int}+v_{ext}=1. The penalty factors are the inverse weights. Suggested choices are "exp" for predictivity and "ari.con" for interpretability.

Value

Returns a vector of length q (non-negative entries).

See Also

Use construct_weights to obtain w_int and w_ext.

Examples

n <- 10
w_int <- stats::runif(n)
w_ext <- stats::runif(n)
construct_penfacs(w_int,w_ext,v_int=0.5,v_ext=0.5,type="exp")

Construct internal and external weights

Description

Construct internal and external weights

Usage

construct_weights(coef, id)

Arguments

Value

Returns a list with slots lower.limits, upper.limits, weight.source (external weights) and weight.target (internal weights). Each slot is a vector of length 2*p, with the first p entries for positive effects and the last p entries for negative effects.

See Also

Use construct_penfacs to obtain penalty factors (i.e., for scaling and inverting weights).

Examples

p <- 10
q <- 3
data <- stats::rbinom(p*q,size=1,prob=0.2)*stats::rnorm(p*q)
coef <- matrix(data=data,nrow=p,ncol=q)
construct_weights(coef=coef,id=1)

Metrics for sign detection

Description

Calculates sensitivity, specificity and precision for ternary data (with -1 for negative effect, 0 for no effect, 1 for positive effect).

Usage

count_vector(truth, estim)

count_matrix(truth, estim)

Arguments

Value

Returns a vector of length 3 (with names "sensitivity", "specificity" and "precision") or a matrix with 3 rows (with names "sensitivity", "specificity" and "precision") and n columns.

Examples

#--- vector ---
p <- 20
truth <- sample(x=c(-1,0,1),size=p,replace=TRUE)
estim <- sample(x=c(-1,0,1),size=p,replace=TRUE)
table(truth,estim)
count_vector(truth,estim)

#--- matrix ---
p <- 20
n <- 5
truth <- matrix(sample(x=c(-1,0,1),size=n*p,replace=TRUE),nrow=p,ncol=n)
estim <- matrix(sample(x=c(-1,0,1),size=n*p,replace=TRUE),nrow=p,ncol=n)
count_matrix(truth,estim)

Model comparison

Description

Compares predictive methods for multi-task learning (cv_multiple) or transfer learning (cv_transfer) by k-fold cross-validation.

Usage

cv_multiple(
  y,
  X,
  family,
  alpha = 1,
  nfolds = 10,
  method = c("wrap_separate", "wrap_mgaussian", "sparselink", "wrap_spls"),
  alpha.init = 0.95,
  type = "exp",
  cands = NULL
)

cv_transfer(
  y,
  X,
  family,
  alpha = 1,
  nfolds = 10,
  method = c("wrap_separate", "wrap_glmtrans", "sparselink", "wrap_xrnet"),
  alpha.init = 0.95,
  type = "exp",
  cands = NULL
)

Arguments

Value

Returns a list with slots deviance, auc (only relevant if family="binomial"), and refit.

Examples

#--- multi-task learning ---

family <- "gaussian"
data <- sim_data_multi(family=family)
metric <- cv_multiple(y=data$y_train,X=data$X_train,family=family)
metric$deviance

#--- transfer learning ---

family <- "gaussian"
data <- sim_data_trans(family=family)
metric <- cv_transfer(y=data$y_train,X=data$X_train,family=family)
metric$deviance

Data fusion

Description

Data fusion

Usage

fuse_data(x, y = NULL, foldid = NULL)

Arguments

Value

Returns a list with the concatenated feature matrices in slot x ((\sum_i^q n_i) \times p matrix), the concatenated target vectors in slot y (vector of length (\sum_i^q n_i)), and the indices of the problems in slot index (vector of length (\sum_i^q n_i) with entries 1,\ldots,q).

Examples

data <- sim_data_trans()
sapply(X=data$y_train,FUN=length)
sapply(X=data$X_train,FUN=dim)
fuse <- fuse_data(x=data$X_train,y=data$y_train)
length(fuse$y)
dim(fuse$x)
table(fuse$index)

Extract dimensionality.

Description

Extract dimensionality.

Usage

get_info(x, y)

Arguments

Value

Returns a list with the slots q (scalar, number of problems), n (vector of length q, number of samples) and p (scalar, number of features)

Examples

data <- sim_data_trans()
get_info(x=data$X_train,y=data$y_train)

Link function

Description

Applies the link function.

Usage

link_function(mu, family)

Arguments

Value

Returns a numeric vector of the transformed values.

Examples

family <- "binomial"
from <- ifelse(family=="binomial",0,-3)
to <- ifelse(family=="binomial",1,3)
mu <- seq(from=from,to=to,length.out=100)
eta <- link_function(mu=mu,family=family)
graphics::plot(x=mu,y=eta,type="l",main=family)
v <- ifelse(family=="binomial",0.5,0)
graphics::abline(v=v,lty=2)
graphics::abline(h=0,lty=2)

logit function

Description

logit function

Usage

logit(x)

Arguments

Value

Returns a numeric vector of the transformed values.

Examples

x <- seq(from=0,to=1,length.out=100)
y <- logit(x=x)
graphics::plot(x=x,y=y,type="l")
graphics::abline(v=0.5,lty=2)
graphics::abline(h=0,lty=2)

Create folds for multi-task and transfer learning

Description

Create folds for multi-task and transfer learning

Usage

make_folds_multi(y, family, nfolds = 10)

make_folds_trans(y, family, nfolds = 10)

Arguments

Value

Returns the fold identifiers in a vector of length n with entries 1,\ldots,nfolds (multi-task learning) on in a list of q vectors of lengths n_1,\ldots,n_q (transfer learning).

Examples

#--- multi-task learning ---
family <- "binomial"
y <- sim_data_multi(family=family)$y_train
fold <- make_folds_multi(y=y,family=family)

#--- transfer learning ---
family <- "binomial"
y <- sim_data_trans(family=family)$y_train
fold <- make_folds_trans(y,family=family)

Mean function

Description

Applies the mean function (inverse link function).

Usage

mean_function(eta, family)

Arguments

Value

Returns a numeric vector of the transformed values.

Examples

family <- "binomial"
eta <- seq(from=-3,to=3,length.out=100)
mu <- mean_function(eta=eta,family=family)
graphics::plot(x=eta,y=mu,type="l",main=family)
graphics::abline(v=0,lty=2)
h <- ifelse(family=="binomial",0.5,0)
graphics::abline(h=h,lty=2)

Available methods

Description

Wrapper functions of available methods for related problems.

Usage

wrap_empty(x, y, family, alpha = 1)

wrap_separate(x, y, family, alpha = 1, lambda = NULL)

## S3 method for class 'wrap_separate'
predict(object, newx, ...)

## S3 method for class 'wrap_separate'
coef(object, ...)

wrap_common(x, y, family, alpha = 1)

## S3 method for class 'wrap_common'
predict(object, newx, ...)

## S3 method for class 'wrap_common'
coef(object, ...)

wrap_mgaussian(x, y, family = "gaussian", alpha = 1)

## S3 method for class 'wrap_mgaussian'
predict(object, newx, ...)

## S3 method for class 'wrap_mgaussian'
coef(object, ...)

wrap_spls(x, y, family = "gaussian", alpha = 1, nfolds = 10)

## S3 method for class 'wrap_spls'
predict(object, newx, ...)

## S3 method for class 'wrap_spls'
coef(object, ...)

wrap_glmtrans(x, y, family = "gaussian", alpha = 1)

## S3 method for class 'wrap_glmtrans'
predict(object, newx, ...)

## S3 method for class 'wrap_glmtrans'
coef(object, ...)

wrap_xrnet(
  x,
  y,
  alpha.init = 0.95,
  alpha = 1,
  nfolds = 10,
  family = "gaussian"
)

## S3 method for class 'wrap_xrnet'
predict(object, newx, ...)

## S3 method for class 'wrap_xrnet'
coef(object, ...)

Arguments

Value

The wrapper functions wrap_empty, wrap_separate, wrap_common, wrap_mgaussian, wrap_spls, wrap_glmtrans, and wrap_xrnet return fitted models, and the generic functions coef and predict return coefficients or predicted values in a standardised format.

Functions

• wrap_empty(): intercept-only model (MTL and TL)

• wrap_separate(): separate model for each problem (MTL and TL)

• wrap_common(): common model for all problems (TL)

• wrap_mgaussian(): multivariate Gaussian regression (MTL)

• wrap_spls(): sparse partial least squares (MTL)

• wrap_glmtrans(): transfer generalised linear model (TL)

• wrap_xrnet(): hierarchical regression (TL)

References

Noah Simon, Jerome H. Friedman, and Trevor Hastie (2013). arXiv (Preprint). doi:10.48550/arXiv.1311.6529. (cv.glmnet)

Hyonho Chun and Sündüz Keleş (2010). "Sparse Partial Least Squares Regression for Simultaneous Dimension Reduction and Variable Selection". Journal of the Royal Statistical Society Series B: Statistical Methodology 72(1);3–25. doi:10.1111/j.1467-9868.2009.00723.x. (spls)

Ye Tian and Yang Feng (2022). "Transfer learning under high-dimensional generalized linear models". Journal of the American Statistical Association 118(544):2684-2697. doi:10.1080/01621459.2022.2071278. (glmtrans)

Garrett M. Weaver and Juan Pablo Lewinger (2019). "xrnet: Hierarchical Regularized Regression to Incorporate External Data". Journal of Open Source Software 4(44):1761. doi:10.21105/joss.01761. (xrnet)

See Also

See original functions cv.glmnet (with argument family="mgaussian") spls, glmtrans, and xrnet.

Examples

#--- multi-task learning ---
n_train <- 100
n_test <- 10
p <- 50
q <- 3
family <- "gaussian"
x <- matrix(data=rnorm(n=n_train*p),nrow=n_train,ncol=p)
newx <- matrix(data=rnorm(n=n_test*p),nrow=n_test,ncol=p)
y <- matrix(data=rnorm(n_train*q),nrow=n_train,ncol=q)
object <- wrap_empty(x=x,y=y,family=family)
model <- "empty" # try "empty", "separate", "mgaussian" or "spls"
if(model=="empty"){
  object <- wrap_empty(x=x,y=y,family=family)
} else if(model=="separate"){
  object <- wrap_separate(x=x,y=y,family=family)
} else if(model=="mgaussian"){
  object <- wrap_mgaussian(x=x,y=y,family=family)
} else if(model=="spls"){
  object <- wrap_spls(x=x,y=y,family=family)
}
coef(object)
predict(object,newx=newx)

#--- transfer learning ---
n_train <- c(100,50)
n_test <- c(10,10)
p <- 50
x <- lapply(X=n_train,function(n) matrix(data=stats::rnorm(n*p),nrow=n,ncol=p))
newx <- lapply(X=n_test,function(n) matrix(data=stats::rnorm(n*p),nrow=n,ncol=p))
y <- lapply(X=n_train,function(n) stats::rnorm(n))
family <- "gaussian"
model <- "empty" # try "empty", "separate", "common", "glmtrans", or "xrnet"
if(model=="empty"){
 object <- wrap_empty(x=x,y=y,family=family)
} else if(model=="separate"){
 object <- wrap_separate(x=x,y=y,family=family)
} else if(model=="common"){
 object <- wrap_common(x=x,y=y,family=family)
} else if(model=="glmtrans"){
 object <- wrap_glmtrans(x=x,y=y,family=family)
} else if(model=="xrnet"){
 object <- wrap_xrnet(x=x,y=y,family=family)
}
coef(object)
predict(object,newx=newx)

Pairwise differences

Description

Visualises differences within sets of three values in different settings.

Usage

plot_change(
  x,
  y0,
  y1,
  y2,
  dist = 0.15,
  main = "",
  cex.axis = 0.5,
  cex.main = 1,
  increase = TRUE
)

Arguments

Value

Returns NULL. Generates a plot.

Examples

m <- 3 # number of settings
n <- 5 # number of repetitions
x <- rep(LETTERS[1:m],each=n)
y0 <- stats::rnorm(n*m,mean=0)
y1 <- stats::rnorm(n*m,mean=ifelse(x=="A",2,-2))
y2 <- stats::rnorm(n*m,mean=ifelse(x=="A",4,-4))
plot_change(x,y0,y1,y2)

Visualise metric that depends on two parameters

Description

Displays values in y in a grey scale (white=lowest, black=highest), for different combinations of the two variables in x. The lowest value is indicated by a red cross, and the lowest value on the diagonal is indicated by a red circle.

Usage

plot_weight(x, y)

Arguments

Value

Returns NULL. Generates a plot.

Examples

values <- seq(from=0,to=1,by=0.2)
x <- expand.grid(source=values,target=values)
y <- stats::rexp(n=length(values)*length(values))
plot_weight(x=x,y=y)

Out-of-sample Predictions

Description

Predicts outcomes with a multi-task or transfer learning regression model.

Usage

## S3 method for class 'sparselink'
predict(object, newx, weight = NULL, ...)

Arguments

Value

Returns predicted values or predicted probabilities. The output is a list of q column vectors of length n_k for k in 1,\ldots,q. Each vector corresponds to one target (multi-task learning) or one dataset (transfer learning).

References

Armin Rauschenberger, Petr N. Nazarov, and Enrico Glaab (2025). "Estimating sparse regression models in multi-task learning and transfer learning through adaptive penalisation". Under revision. https://hdl.handle.net/10993/63425

See Also

Use sparselink to fit the model and coef to extract coefficients.

Examples

family <- "gaussian"
type <- "multiple" # try "multiple" or "transfer"
if(type=="multiple"){
 data <- sim_data_multi(family=family)
} else if(type=="transfer"){
 data <- sim_data_trans(family=family)
}

object <- sparselink(x=data$X_train,y=data$y_train,family=family)
y_hat <- predict(object=object,newx=data$X_test)

Print sparselink object

Description

Prints an object of class sparselink

Usage

## S3 method for class 'sparselink'
print(x, ...)

Arguments

Value

Returns NULL. Writes information on the sparselink-object to the console.

Examples

n <- 100; p <- 50; q <- 3
family <- "gaussian"
x <- matrix(data=rnorm(n=n*p),nrow=n,ncol=p)
y <- matrix(data=rnorm(n*q),nrow=n,ncol=q)
object <- sparselink(x=x,y=y,family=family)
object

Sigmoid function

Description

Sigmoid function

Usage

sigmoid(x)

Arguments

Value

Returns a numeric vector of the transformed values.

Examples

x <- seq(from=-3,to=3,length.out=100)
y <- sigmoid(x)
graphics::plot(x=x,y=y,type="l")
graphics::abline(v=0,lty=2)
graphics::abline(h=0.5,lty=2)

Data simulation for related problems

Description

Simulates data for multi-task learning and transfer learning.

Usage

sim_data_multi(
  prob.common = 0.05,
  prob.separate = 0.05,
  q = 3,
  n0 = 100,
  n1 = 10000,
  p = 200,
  rho = 0.5,
  family = "gaussian"
)

sim_data_trans(
  prob.common = 0.05,
  prob.separate = 0.05,
  q = 3,
  n0 = c(50, 100, 200),
  n1 = 10000,
  p = 200,
  rho = 0.5,
  family = "gaussian"
)

Arguments

Value

• Multi-task learning: Returns a list with slots y_train (n_0 \times q matrix), X_train(n_0 \times p matrix), y_test (n_1 \times q matrix), X_test (n_1 \times p matrix), and beta (p \times q matrix).

• Transfer learning: Returns a list with slots y_train (q vectors) and X_train (q matrices with p columns) for training data, and y_test (vectors) and X_test (q matrices with p columns) for testing data, and beta for effects (p \times q matrix).

Examples

#--- multi-task learning ---
data <- sim_data_multi()
sapply(X=data,FUN=dim)

#--- transfer learning ---
data <- sim_data_trans()
sapply(X=data$y_train,FUN=length)
sapply(X=data$X_train,FUN=dim)
sapply(X=data$y_test,FUN=length)
sapply(X=data$X_test,FUN=dim)
dim(data$beta)

Sparse regression for related problems

Description

Estimates sparse regression models (i.e., performing feature selection) in multi-task learning or transfer learning. Multi-task learning involves multiple targets, and transfer learning involves multiple datasets.

Usage

sparselink(
  x,
  y,
  family,
  alpha.init = 0.95,
  alpha = 1,
  type = "exp",
  nfolds = 10,
  cands = NULL
)

Arguments

Value

Returns an object of class sparselink, a list with multiple slots:

• Stage 1 regressions (before sharing information): Slot glm.one contains q objects of type cv.glmnet (one for each problem).

• Candidate scaling parameters (exponents): Slot weight contains a data frame with n combinations of exponents for the external (source) and internal (target) weights

• Stage 2 regressions (after sharing information): Slot glm.two contains q lists (one for each problem) of n objects of type cv.glmnet (one for each combination of exponents).

• Optimal regularisation parameters: Slot lambda.min contains the cross-validated regularisation parameters for the stage 2 regressions.

• Optimal scaling parameters: Slots weight.ind and weight.min indicate or contain the cross-validated scaling parameters.

References

Armin Rauschenberger, Petr N. Nazarov, and Enrico Glaab (2025). "Estimating sparse regression models in multi-task learning and transfer learning through adaptive penalisation". Under revision. https://hdl.handle.net/10993/63425

See Also

Use coef to extract coefficients and predict to make predictions.

Examples

#--- multi-task learning ---
n <- 100
p <- 200
q <- 3

family <- "gaussian"
x <- matrix(data=rnorm(n=n*p),nrow=n,ncol=p)
y <- matrix(data=rnorm(n*q),nrow=n,ncol=q)
object <- sparselink(x=x,y=y,family=family)

#--- transfer learning ---
n <- c(100,50)
p <- 200

x <- lapply(X=n,function(x) matrix(data=stats::rnorm(n*p),nrow=x,ncol=p))
y <- lapply(X=n,function(x) stats::rnorm(x))
family <- "gaussian"
object <- sparselink(x=x,y=y,family=family)

Train and test model

Description

Trains and tests prediction models

Usage

traintest(
  y_train,
  X_train,
  y_test = NULL,
  X_test = NULL,
  family = "gaussian",
  alpha = 1,
  method = c("wrap_empty", "wrap_separate", "sparselink"),
  alpha.init = 0.95,
  type = "exp",
  cands = NULL
)

Arguments

Value

Returns a list with the computation time in slot time, the out-of-sample deviance in slot deviance, the out-of-sample ROC-AUC in slot auc, the coefficients in slot coef, the predicted value in slot y_hat, and the optimal hyperparameters in slot hyperpar.

Examples

#--- multi-task learning ---

family <- "gaussian"
data <- sim_data_multi(family=family)
result <- traintest(data$y_train,data$X_train,family=family)

#--- transfer learning ---

family <- "gaussian"
data <- sim_data_trans(family=family)
result <- traintest(data$y_train,data$X_train,family=family)