Correction1Vect: Correction on two vectors

In PPLasso: Prognostic Predictive Lasso for Biomarker Selection

Correction on two vectors

Description

For the estimation of β in Zhu et al. (2022), this function keeps only the M largest values coefficientss set the others to 0.

Usage

Correction1Vect(X, Y, te = NULL, vector, top_grill. = c(1:length(vector)), delta = 0.95)

Arguments

X	Design matrix
Y	Response vector
te	treatment effects
vector	The vector on which we performe the thresholding
top_grill.	grill of the thresholding
delta	parameter δ in the thresholding

Value

This function returns the thresholded vector.

Author(s)

Wencan Zhu, Celine Levy-Leduc, Nils Ternes

Examples

vect_sample=sample(1:20,20)
X=t(sapply(c(1:10),FUN=function(x) rnorm(20)))
Y=rnorm(10)

Correction1Vect(X=X, Y=Y, vector=vect_sample)

## The function is currently defined as
function(X, Y, te=NULL, vector, top_grill.=c(1:length(vector)), delta=0.95){
  
  beta_interm <- sapply(top_grill., top, vect = vector)
  beta_te <- rbind(rep(te[1],length(top_grill.)), rep(te[2],length(top_grill.)), beta_interm)
  yhat <- as.matrix(X %*% beta_te)
  residuals <- sweep(yhat, 1, Y)
  mse_final_top <- colMeans(residuals^2)
  ratio_mse <- c()
  for (k in 1:(length(top_grill.) - 1)) {
    ratio_mse[k] <- round(mse_final_top[k + 1]/mse_final_top[k],6)
  }
  top_ratio <- min(which(ratio_mse >= delta))
  if (is.infinite(top_ratio)) {
    opt_final_top <- length(vector)
  }
  else {
    opt_final_top <- top_grill.[top_ratio]
  }
  
  return(round(top(vect = vector, thresh = opt_final_top), 6))
  
}

PPLasso documentation built on March 7, 2023, 6:33 p.m.