reduce cpp files to avoid installed size warning

pachadotdev · Mar 3, 2024 · 489577e · 489577e
1 parent c88b614
commit 489577e
Show file tree

Hide file tree

Showing 22 changed files with 253 additions and 178 deletions.
diff --git a/R/apes.R b/R/apes.R
@@ -266,31 +266,26 @@ apes <- function(
     # Compute bias terms for requested bias correction
     if (panel.structure == "classic") {
       # Compute \hat{B} and \hat{D}
-      b <- as.vector(group_sums_(Delta2 + PPsi * z, w, k.list[[1L]])) / 2.0 / nt
+      b <- group_sums_(Delta2 + PPsi * z, w, k.list[[1L]]) / (2.0 * nt)
       if (k > 1L) {
-        b <- b + as.vector(group_sums_(Delta2 + PPsi * z, w, k.list[[2L]])) /
-          2.0 / nt
+        b <- (b + group_sums_(Delta2 + PPsi * z, w, k.list[[2L]])) / (2.0 * nt)
       }
 
       # Compute spectral density part of \hat{B}
       if (L > 0L) {
-        b <- b -
-          as.vector(group_sums_spectral_(MPsi * w, v, w, L, k.list[[1L]])) / nt
+        b <- (b - group_sums_spectral_(MPsi * w, v, w, L, k.list[[1L]])) / nt
       }
     } else {
       # Compute \hat{D}_{1}, \hat{D}_{2}, and \hat{B}
-      b <- as.vector(group_sums_(Delta2 + PPsi * z, w, k.list[[1L]])) / 2.0 / nt
-      b <- b + as.vector(group_sums_(Delta2 + PPsi * z, w, k.list[[2L]])) /
-        2.0 / nt
+      b <- group_sums_(Delta2 + PPsi * z, w, k.list[[1L]]) / (2.0 * nt)
+      b <- (b + group_sums_(Delta2 + PPsi * z, w, k.list[[2L]])) / (2.0 * nt)
       if (k > 2L) {
-        b <- b + as.vector(group_sums_(Delta2 + PPsi * z, w, k.list[[3L]])) /
-          2.0 / nt
+        b <- (b + group_sums_(Delta2 + PPsi * z, w, k.list[[3L]])) / (2.0 * nt)
       }
 
       # Compute spectral density part of \hat{B}
       if (k > 2L && L > 0L) {
-        b <- b -
-          as.vector(group_sums_spectral_(MPsi * w, v, w, L, k.list[[3L]])) / nt
+        b <- (b - group_sums_spectral_(MPsi * w, v, w, L, k.list[[3L]])) / nt
       }
     }
     rm(Delta2)
@@ -301,8 +296,8 @@ apes <- function(
   rm(eta, w, z, MPsi)
 
   # Compute covariance matrix
-  WinvJ <- solve_(object[["Hessian"]] / nt.full, J)
-  Gamma <- (MX %*% WinvJ - PPsi) * v / nt.full
+  # Gamma <- (MX %*% solve(object[["Hessian"]] / nt.full, J) - PPsi) * v / nt.full
+  Gamma <- gamma_(MX, object[["Hessian"]], J, PPsi, v, nt.full)
   V <- crossprod_(Gamma, NA_real_, FALSE, FALSE)
   if (adj > 0.0) {
     # Simplify covariance if sampling assumptions are imposed

diff --git a/R/bias_corr.R b/R/bias_corr.R
@@ -163,31 +163,28 @@ bias_corr <- function(
 
     # Compute spectral density part of \hat{B}
     if (L > 0L) {
-      b <- b + as.vector(group_sums_spectral_(MX * w, v, w, L, k.list[[1L]])) /
-        nt
+      b <- (b + group_sums_spectral_(MX * w, v, w, L, k.list[[1L]])) / nt
     }
   } else {
     # Compute \hat{D}_{1}, \hat{D}_{2}, and \hat{B}
-    b <- as.vector(group_sums_(MX * z, w, k.list[[1L]])) / 2.0 / nt
-    b <- b + as.vector(group_sums_(MX * z, w, k.list[[2L]])) / 2.0 / nt
+    b <- group_sums_(MX * z, w, k.list[[1L]]) / (2.0 * nt)
+    b <- (b + group_sums_(MX * z, w, k.list[[2L]])) / (2.0 * nt)
     if (k > 2L) {
-      b <- b + as.vector(group_sums_(MX * z, w, k.list[[3L]])) / 2.0 / nt
+      b <- (b + group_sums_(MX * z, w, k.list[[3L]])) / (2.0 * nt)
     }
 
     # Compute spectral density part of \hat{B}
     if (k > 2L && L > 0L) {
-      b <- b + as.vector(group_sums_spectral_(MX * w, v, w, L, k.list[[3L]])) /
-        nt
+      b <- (b + group_sums_spectral_(MX * w, v, w, L, k.list[[3L]])) / nt
     }
   }
 
   # Compute bias-corrected structural parameters
-  b <- solve_(object[["Hessian"]] / nt, -b)
-  beta <- beta.uncorr - b
+  beta <- solve_bias_(beta.uncorr, object[["Hessian"]], nt, -b)
   names(beta) <- nms.sp
 
   # Update \eta and first- and second-order derivatives
-  eta <- feglm_offset_(object, as.vector(X %*% beta))
+  eta <- feglm_offset_(object, solve_y_(X, beta))
   mu <- family[["linkinv"]](eta)
   mu.eta <- family[["mu.eta"]](eta)
   v <- wt * (y - mu)

diff --git a/R/cpp11.R b/R/cpp11.R
@@ -20,10 +20,6 @@ solve_eta2_ <- function(yadj, myadj, offset, eta) {
   .Call(`_capybara_solve_eta2_`, yadj, myadj, offset, eta)
 }
 
-crossprod_ <- function(x, w, weighted, root_weights) {
-  .Call(`_capybara_crossprod_`, x, w, weighted, root_weights)
-}
-
 group_sums_ <- function(M_r, w_r, jlist) {
   .Call(`_capybara_group_sums_`, M_r, w_r, jlist)
 }
@@ -40,6 +36,14 @@ group_sums_cov_ <- function(M_r, N_r, jlist) {
   .Call(`_capybara_group_sums_cov_`, M_r, N_r, jlist)
 }
 
+crossprod_ <- function(x, w, weighted, root_weights) {
+  .Call(`_capybara_crossprod_`, x, w, weighted, root_weights)
+}
+
+gamma_ <- function(mx, hessian, j, ppsi, v, nt_full) {
+  .Call(`_capybara_gamma_`, mx, hessian, j, ppsi, v, nt_full)
+}
+
 chol_crossprod_ <- function(x) {
   .Call(`_capybara_chol_crossprod_`, x)
 }
@@ -56,8 +60,16 @@ qr_rank_ <- function(x) {
   .Call(`_capybara_qr_rank_`, x)
 }
 
-solve_ <- function(a, b) {
-  .Call(`_capybara_solve_`, a, b)
+solve_bias_ <- function(beta_uncorr, hessian, nt, b) {
+  .Call(`_capybara_solve_bias_`, beta_uncorr, hessian, nt, b)
+}
+
+solve_y_ <- function(a, x) {
+  .Call(`_capybara_solve_y_`, a, x)
+}
+
+sandwich_ <- function(a, b) {
+  .Call(`_capybara_sandwich_`, a, b)
 }
 
 pairwise_cor_ <- function(y, yhat) {

diff --git a/R/fixed_effects.R b/R/fixed_effects.R
@@ -46,7 +46,7 @@ fixed_effects <- function(object = NULL, alpha.tol = 1.0e-08) {
   k.list <- get_index_list_(k.vars, data)
 
   # Recover fixed effects by alternating the solutions of normal equations
-  pie <- eta - as.vector(X %*% beta)
+  pie <- eta - solve_y_(X, beta)
   fe.list <- as.list(get_alpha_(pie, k.list, alpha.tol))
 
   # Assign names to the different fixed effects categories

diff --git a/R/generics_vcov.R b/R/generics_vcov.R
@@ -56,11 +56,11 @@ vcov.feglm <- function(
   p <- ncol(H)
   if (type == "hessian") {
     # Check if the Hessian is invertible and compute its inverse
-    R <- try(chol(H), silent = TRUE)
+    R <- try(chol_(H), silent = TRUE)
     if (inherits(R, "try-error")) {
       V <- matrix(Inf, p, p)
     } else {
-      V <- chol2inv(R)
+      V <- chol2inv_(R)
     }
   } else {
     G <- getScoreMatrix(object)
@@ -70,7 +70,6 @@ vcov.feglm <- function(
       if (inherits(R, "try-error")) {
         V <- matrix(Inf, p, p)
       } else {
-        saveRDS(R, "dev/R.rds")
         V <- chol2inv_(R)
       }
     } else {
@@ -147,7 +146,7 @@ vcov.feglm <- function(
         }
 
         # Sandwich formula
-        V <- A %*% B %*% A
+        V <- sandwich_(A, B)
       }
     }
   }

diff --git a/R/helpers.R b/R/helpers.R
@@ -284,7 +284,7 @@ start_guesses_ <- function(
 
       # Set starting guesses
       beta <- beta.start
-      eta <- as.vector(X %*% beta)
+      eta <- solve_y_(X, beta)
     } else {
       # Validity of input argument (eta.start)
       if (length(eta.start) != nt) {

diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
@@ -3,5 +3,5 @@ pkgdown: 2.0.7
 pkgdown_sha: ~
 articles:
   intro: intro.html
-last_built: 2024-03-03T06:00Z
+last_built: 2024-03-03T11:05Z
 
diff --git a/docs/reference/apes.html b/docs/reference/apes.html
diff --git a/docs/reference/bias_corr.html b/docs/reference/bias_corr.html
diff --git a/docs/reference/feglm.html b/docs/reference/feglm.html
diff --git a/docs/reference/felm.html b/docs/reference/felm.html
diff --git a/docs/reference/fenegbin.html b/docs/reference/fenegbin.html
diff --git a/docs/reference/fepoisson.html b/docs/reference/fepoisson.html
diff --git a/src/04_cross_product.cpp b/src/04_cross_product.cpp
diff --git a/src/04_group_sums.cpp b/src/04_group_sums.cpp
@@ -1,8 +1,8 @@
 #include "00_main.h"
 
-[[cpp11::register]] doubles_matrix<> group_sums_(const doubles_matrix<> &M_r,
-                                                 const doubles_matrix<> &w_r,
-                                                 const list &jlist) {
+[[cpp11::register]] doubles group_sums_(const doubles_matrix<> &M_r,
+                                        const doubles_matrix<> &w_r,
+                                        const list &jlist) {
   // Types conversion
   Mat<double> M = as_Mat(M_r);
   Mat<double> w = as_Mat(w_r);
@@ -39,13 +39,14 @@
 
   num = num / denom;
 
-  return as_doubles_matrix(num);
+  return as_doubles(num);
 }
 
-[[cpp11::register]] doubles_matrix<>
-group_sums_spectral_(const doubles_matrix<> &M_r, const doubles_matrix<> &v_r,
-                     const doubles_matrix<> &w_r, const int K,
-                     const list &jlist) {
+[[cpp11::register]] doubles group_sums_spectral_(const doubles_matrix<> &M_r,
+                                                 const doubles_matrix<> &v_r,
+                                                 const doubles_matrix<> &w_r,
+                                                 const int K,
+                                                 const list &jlist) {
   // Types conversion
   Mat<double> M = as_Mat(M_r);
   Mat<double> v = as_Mat(v_r);
@@ -93,11 +94,11 @@ group_sums_spectral_(const doubles_matrix<> &M_r, const doubles_matrix<> &v_r,
 
   num = num / denom;
 
-  return as_doubles_matrix(num);
+  return as_doubles(num);
 }
 
-[[cpp11::register]] doubles_matrix<>
-group_sums_var_(const doubles_matrix<> &M_r, const list &jlist) {
+[[cpp11::register]] doubles_matrix<> group_sums_var_(
+    const doubles_matrix<> &M_r, const list &jlist) {
   // Types conversion
   Mat<double> M = as_Mat(M_r);
 
@@ -140,9 +141,9 @@ group_sums_var_(const doubles_matrix<> &M_r, const list &jlist) {
   return as_doubles_matrix(V);
 }
 
-[[cpp11::register]] doubles_matrix<>
-group_sums_cov_(const doubles_matrix<> &M_r, const doubles_matrix<> &N_r,
-                const list &jlist) {
+[[cpp11::register]] doubles_matrix<> group_sums_cov_(
+    const doubles_matrix<> &M_r, const doubles_matrix<> &N_r,
+    const list &jlist) {
   // Types conversion
   Mat<double> M = as_Mat(M_r);
   Mat<double> N = as_Mat(N_r);
@@ -151,7 +152,7 @@ group_sums_cov_(const doubles_matrix<> &M_r, const doubles_matrix<> &N_r,
   const int J = jlist.size();
   const int P = M.n_cols;
   const int I = as_cpp<integers>(jlist[0])
-                    .size(); // assuming all groups have the same size
+                    .size();  // assuming all groups have the same size
 
   // Auxiliary variables (storage)
   Mat<double> V(P, P);