Path/studentization error fixed

SGDinference-Lab · Nov 6, 2023 · 9120513 · 9120513
1 parent 4f11880
commit 9120513
Show file tree

Hide file tree

Showing 15 changed files with 204 additions and 73 deletions.
diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -1,16 +1,16 @@
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
-sgd_lm_cpp <- function(x, y, burn, gamma_0, alpha, bt_start, x_mean, x_sd) {
-    .Call('_SGDinference_sgd_lm_cpp', PACKAGE = 'SGDinference', x, y, burn, gamma_0, alpha, bt_start, x_mean, x_sd)
+sgd_lm_cpp <- function(x, y, burn, gamma_0, alpha, bt_start, x_mean, x_sd, path, path_index) {
+    .Call('_SGDinference_sgd_lm_cpp', PACKAGE = 'SGDinference', x, y, burn, gamma_0, alpha, bt_start, x_mean, x_sd, path, path_index)
 }
 
-sgd_qr_cpp <- function(x, y, burn, gamma_0, alpha, bt_start, tau, x_mean, x_sd, path) {
-    .Call('_SGDinference_sgd_qr_cpp', PACKAGE = 'SGDinference', x, y, burn, gamma_0, alpha, bt_start, tau, x_mean, x_sd, path)
+sgd_qr_cpp <- function(x, y, burn, gamma_0, alpha, bt_start, tau, x_mean, x_sd, path, path_index) {
+    .Call('_SGDinference_sgd_qr_cpp', PACKAGE = 'SGDinference', x, y, burn, gamma_0, alpha, bt_start, tau, x_mean, x_sd, path, path_index)
 }
 
-sgdi_lm_cpp <- function(x, y, burn, gamma_0, alpha, bt_start, inference, rss_idx, x_mean, x_sd) {
-    .Call('_SGDinference_sgdi_lm_cpp', PACKAGE = 'SGDinference', x, y, burn, gamma_0, alpha, bt_start, inference, rss_idx, x_mean, x_sd)
+sgdi_lm_cpp <- function(x, y, burn, gamma_0, alpha, bt_start, inference, rss_idx, x_mean, x_sd, path, path_index) {
+    .Call('_SGDinference_sgdi_lm_cpp', PACKAGE = 'SGDinference', x, y, burn, gamma_0, alpha, bt_start, inference, rss_idx, x_mean, x_sd, path, path_index)
 }
 
 sgdi_qr_cpp <- function(x, y, burn, gamma_0, alpha, bt_start, inference, tau, rss_idx, x_mean, x_sd, path, path_index) {

diff --git a/R/sgd_lm.R b/R/sgd_lm.R
@@ -13,11 +13,14 @@
 #' @param no_studentize numeric. The number of observations to compute the mean and std error for studentization. Default is 100. 
 #' @param intercept logical. Use the intercept term for regressors. Default is TRUE. 
 #'    If this option is TRUE, the first element of the parameter vector is the intercept term.
+#' @param path logical. The whole path of estimation results is out. Default is FALSE.
+#' @param path_index numeric. A vector of indices to print out the path. Default is 1.
 #'
 #' @return
 #' An object of class \code{"sgdi"}, which is a list containing the following
 #' \describe{
 #' \item{\code{coefficients}}{a vector of estimated parameter values}
+#' \item{\code{path_coefficients}}{The path of coefficients.}
 #' }
 #' @note{The dimension of \code{coefficients} is (p+1) if \code{intercept}=TRUE or p otherwise.}
 #'
@@ -40,8 +43,9 @@ sgd_lm = function(formula,
                   bt_start = NULL,  
                   studentize = TRUE, 
                   no_studentize = 100L,
-                  intercept = TRUE
-                ){
+                  intercept = TRUE,
+                  path = FALSE,
+                  path_index = c(1)){
   cl <- match.call()
   mf <- match.call(expand.dots = FALSE)
   m <- match(c("formula", "data"), names(mf), 0L)
@@ -103,7 +107,7 @@ sgd_lm = function(formula,
   #----------------------------------------------
   # Linear (Mean) Regression 
   #----------------------------------------------
-  out = sgd_lm_cpp(x, y, burn, gamma_0, alpha, bt_start, x_mean=x_mean_in, x_sd=x_sd_in)
+  out = sgd_lm_cpp(x, y, burn, gamma_0, alpha, bt_start, x_mean=x_mean_in, x_sd=x_sd_in, path=path, path_index=path_index)
   beta_hat = out$beta_hat
 
   # Re-scale parameters to reflect the studentization
@@ -137,6 +141,14 @@ result.out$ci.lower = NULL
 result.out$ci.upper = NULL
 result.out$gamma_0 = gamma_0
 
+if (path){
+  if (studentize){
+    result.out$path_coefficients = (out$beta_hat_path) %*% t(rescale_matrix[path_index, path_index] )
+  } else {
+    result.out$path_coefficients = out$beta_hat_path
+  }
+}
+
 return(result.out)
 
 }

diff --git a/R/sgd_qr.R b/R/sgd_qr.R
@@ -14,12 +14,14 @@
 #' @param no_studentize numeric. The number of observations to compute the mean and std error for studentization. Default is 100. 
 #' @param intercept logical. Use the intercept term for regressors. Default is TRUE. 
 #'    If this option is TRUE, the first element of the parameter vector is the intercept term.
-#' @param path logical. Compute the whole path of parameters. Default is FALSE.    
+#' @param path logical. The whole path of estimation results is out. Default is FALSE.
+#' @param path_index numeric. A vector of indices to print out the path. Default is 1.
 #'
 #' @return
 #' An object of class \code{"sgdi"}, which is a list containing the following
 #' \describe{
 #' \item{\code{coefficients}}{a vector of estimated parameter values}
+#' \item{\code{path_coefficients}}{The path of coefficients.}
 #' }
 #' @note{The dimension of \code{coefficients} is (p+1) if \code{intercept}=TRUE or p otherwise.}
 #'
@@ -44,8 +46,8 @@ sgd_qr = function(formula,
                   studentize = TRUE, 
                   no_studentize = 100L,
                   intercept = TRUE,
-                  path = FALSE
-                ){
+                  path = FALSE,
+                  path_index = c(1)){
   cl <- match.call()
   mf <- match.call(expand.dots = FALSE)
   m <- match(c("formula", "data"), names(mf), 0L)
@@ -108,7 +110,7 @@ sgd_qr = function(formula,
   # Quantile Regression
   #----------------------------------------------
 
-    out = sgd_qr_cpp(x, y, burn, gamma_0, alpha, bt_start=bt_start, tau=qt, x_mean=x_mean_in, x_sd=x_sd_in, path=path)
+    out = sgd_qr_cpp(x, y, burn, gamma_0, alpha, bt_start=bt_start, tau=qt, x_mean=x_mean_in, x_sd=x_sd_in, path=path, path_index=path_index)
     beta_hat = out$beta_hat
 
   # Re-scale parameters to reflect the studentization
@@ -142,7 +144,14 @@ result.out$V <- NULL
 result.out$ci.lower = NULL
 result.out$ci.upper = NULL
 result.out$gamma_0 = gamma_0
-
+
+if (path){
+  if (studentize){
+    result.out$path_coefficients = (out$beta_hat_path) %*% t(rescale_matrix[path_index, path_index])
+  } else {
+    result.out$path_coefficients = out$beta_hat_path
+  }
+}
 return(result.out)
 
 }
diff --git a/R/sgdi_lm.R b/R/sgdi_lm.R
@@ -18,6 +18,8 @@
 #' @param rss_idx numeric. Index of x for random scaling subset inference. Default is 1, the first regressor of x. 
 #'    For example, if we want to focus on the 1st and 3rd covariates of x, then set it to be c(1,3).
 #' @param level numeric. The confidence level required. Default is 0.95. Can choose 0.90 and 0.80.
+#' @param path logical. The whole path of estimation results is out. Default is FALSE.
+#' @param path_index numeric. A vector of indices to print out the path. Default is 1.
 #'
 #' @return
 #' An object of class \code{"sgdi"}, which is a list containing the following
@@ -26,6 +28,8 @@
 #' \item{\code{var}}{A (p+1)x (p+1) variance-covariance matrix of \code{coefficient}}
 #' \item{\code{ci.lower}}{The lower part of the 95\% confidence interval}
 #' \item{\code{ci.upper}}{The upper part of the 95\% confidence interval}
+#' \item{\code{level}}{The confidence level required. Default is 0.95.}
+#' \item{\code{path_coefficients}}{The path of coefficients.}
 #' }
 #' @export
 #'
@@ -49,7 +53,9 @@ sgdi_lm = function(formula,
                   no_studentize = 100L,
                   intercept = TRUE,
                   rss_idx = c(1), 
-                  level = 0.95){
+                  level = 0.95,
+                  path = FALSE,
+                  path_index = c(1)){
   cl <- match.call()
   mf <- match.call(expand.dots = FALSE)
   m <- match(c("formula", "data"), names(mf), 0L)
@@ -124,7 +130,7 @@ sgdi_lm = function(formula,
   #----------------------------------------------
   # Linear (Mean) Regression 
   #----------------------------------------------
-  out = sgdi_lm_cpp(x, y, burn, gamma_0, alpha, bt_start, inference, rss_idx, x_mean=x_mean_in, x_sd=x_sd_in)
+  out = sgdi_lm_cpp(x, y, burn, gamma_0, alpha, bt_start, inference, rss_idx, x_mean=x_mean_in, x_sd=x_sd_in, path=path, path_index=path_index)
   beta_hat = out$beta_hat
   if (inference == "rs"){
     V_out = out$V_hat
@@ -205,6 +211,14 @@ sgdi_lm = function(formula,
     result.out$rss_idx_r = rss_idx_r
   }
 
+  if (path){
+    if (studentize){
+      result.out$path_coefficients = (out$beta_hat_path) %*% t(rescale_matrix[path_index, path_index])
+    } else {
+      result.out$path_coefficients = out$beta_hat_path
+    }
+  }
+
   return(result.out)
 
 }

diff --git a/R/sgdi_qr.R b/R/sgdi_qr.R
@@ -31,6 +31,8 @@
 #' \item{\code{ci.lower}}{a vector of lower confidence limits}
 #' \item{\code{ci.upper}}{a vector of upper confidence limits}
 #' \item{\code{inference}}{character that specifies the inference method}
+#' \item{\code{level}}{The confidence level required. Default is 0.95.}
+#' \item{\code{path_coefficients}}{The path of coefficients.}
 #' }
 #' @note{The dimension of \code{coefficients} is (p+1) if \code{intercept}=TRUE or p otherwise.
 #' The random scaling matrix \code{V} is a full matrix if "rs" is chosen;
@@ -188,9 +190,7 @@ sgdi_qr = function(formula,
   result.out$terms <- mt
   result.out$V <- V_out
 
-  if (path){
-    result.out$beta_hat_path = out$beta_hat_path
-  }
+
 
   if (level == 0.95) {
     critical.value = 6.747       # From Abadir and Paruolo (1997) Table 1. 97.5%  
@@ -228,6 +228,14 @@ sgdi_qr = function(formula,
     result.out$rss_idx_r = rss_idx_r
   }
 
+  if (path){
+    if (studentize){
+      result.out$path_coefficients = (out$beta_hat_path) %*% t(rescale_matrix[path_index, path_index])
+    } else {
+      result.out$path_coefficients = out$beta_hat_path
+    }
+  }
+
   return(result.out)
 
 }
diff --git a/man/sgd_lm.Rd b/man/sgd_lm.Rd
diff --git a/man/sgd_qr.Rd b/man/sgd_qr.Rd
diff --git a/man/sgdi_lm.Rd b/man/sgdi_lm.Rd
diff --git a/man/sgdi_qr.Rd b/man/sgdi_qr.Rd