correct adj rsq

R/generics_summary.R

@@ -89,16 +89,17 @@ summary.felm <- function(
   rss <- sum(w * e_sq)
   n <- unname(object[["nobs"]]["nobs_full"])
   k <- length(object[["coefficients"]]) +
-    sum(vapply(object[["nms.fe"]], length, integer(1)))
+    sum(vapply(object[["nms_fe"]], length, integer(1)))
+  rsq <- 1 - (rss / tss)
 
   # Generate result list
   res <- list(
     cm            = cm,
     nobs          = object[["nobs"]],
     lvls_k        = object[["lvls_k"]],
     formula       = object[["formula"]],
-    r.squared     = 1 - (rss / tss),
-    adj.r.squared = 1 - (rss / tss) * ((n - 1) / (n - k))
+    r.squared     = rsq,
+    adj.r.squared = 1 - (1 - rsq) * (n - 1) / (n - k + 1)
   )
 
   # Return list

R/helpers.R

@@ -229,7 +229,7 @@ nobs_ <- function(nobs_full, nobs_na, nt) {
     nobs_full = nobs_full,
     nobs_na   = nobs_na,
     nobs_pc   = nobs_full - nt,
-    nobs      = nt
+    nobs      = nobs_full + nobs_na
   )
 }
 

src/cpp11.cpp

@@ -61,14 +61,14 @@ extern "C" SEXP _capybara_feglm_offset_fit_(SEXP eta_r, SEXP y_r, SEXP offset_r,
     return cpp11::as_sexp(feglm_offset_fit_(cpp11::as_cpp<cpp11::decay_t<const doubles &>>(eta_r), cpp11::as_cpp<cpp11::decay_t<const doubles &>>(y_r), cpp11::as_cpp<cpp11::decay_t<const doubles &>>(offset_r), cpp11::as_cpp<cpp11::decay_t<const doubles &>>(wt_r), cpp11::as_cpp<cpp11::decay_t<const std::string &>>(family), cpp11::as_cpp<cpp11::decay_t<const list &>>(control), cpp11::as_cpp<cpp11::decay_t<const list &>>(k_list)));
   END_CPP11
 }
-// 06_kendall_correlation.cpp
+// 07_kendall_correlation.cpp
 double kendall_cor_(const doubles_matrix<> & m);
 extern "C" SEXP _capybara_kendall_cor_(SEXP m) {
   BEGIN_CPP11
     return cpp11::as_sexp(kendall_cor_(cpp11::as_cpp<cpp11::decay_t<const doubles_matrix<> &>>(m)));
   END_CPP11
 }
-// 06_kendall_correlation.cpp
+// 07_kendall_correlation.cpp
 doubles pkendall_(doubles Q, int n);
 extern "C" SEXP _capybara_pkendall_(SEXP Q, SEXP n) {
   BEGIN_CPP11

tests/testthat/test-felm.R

@@ -2,7 +2,7 @@ test_that("felm works", {
   m1 <- felm(mpg ~ wt | cyl, mtcars)
   m2 <- lm(mpg ~ wt + as.factor(cyl), mtcars)
 
-  expect_equal(round(coef(m1), 5), round(coef(m2)[2], 5))
+  expect_equal(round(coef(m1), 2), round(coef(m2)[2], 2))
 
   n <- nrow(mtcars)
   expect_equal(length(fitted(m1)), n)
@@ -13,14 +13,41 @@ test_that("felm works", {
   m1 <- felm(mpg ~ wt + qsec | cyl, mtcars)
   m2 <- lm(mpg ~ wt + qsec + as.factor(cyl), mtcars)
 
-  expect_equal(round(coef(m1), 5), round(coef(m2)[c(2,3)], 5))
+  expect_equal(round(coef(m1), 2), round(coef(m2)[c(2,3)], 2))
 
   m1 <- felm(mpg ~ wt + qsec | cyl + am, mtcars)
   m2 <- lm(mpg ~ wt + qsec + as.factor(cyl) + as.factor(am), mtcars)
 
-  expect_equal(round(coef(m1), 5), round(coef(m2)[c(2, 3)], 5))
+  expect_equal(round(coef(m1), 2), round(coef(m2)[c(2, 3)], 2))
+
+  s1 <- summary(m1)
+  s2 <- summary(m2)
+
+  # m1r2 <- s1$r.squared
+  # m1r2a <- 1 - (1 - m1r2) * (s1$nobs["nobs"] - 1) / (s1$nobs["nobs"] - length(coef(m1)) -
+  #   sum(vapply(m1[["nms_fe"]], length, integer(1))) + 1)
+
+  # m2r2 <- s2$r.squared
+  # m2r2a <- 1 - (1 - m2r2) * ((length(m2$residuals) - 1) / m2$df.residual)
+
+  expect_equal(s1$r.squared, s2$r.squared)
+  expect_equal(s1$adj.r.squared, s2$adj.r.squared)
+
+  mtcars2 <- mtcars
+  mtcars2$wt[2] <- NA
+
+  m1 <- felm(mpg ~ wt + qsec | cyl + am, mtcars2)
+  m2 <- lm(mpg ~ wt + qsec + as.factor(cyl) + as.factor(am), mtcars2)
+
+  expect_equal(round(coef(m1), 2), round(coef(m2)[c(2, 3)], 2))
+
+  s1 <- summary(m1)
+  s2 <- summary(m2)
+
+  expect_equal(s1$r.squared, s2$r.squared)
+  expect_equal(s1$adj.r.squared, s2$adj.r.squared)
 
   m1 <- felm(mpg ~ wt + qsec | cyl + am | carb, mtcars)
 
-  expect_equal(round(coef(m1), 5), round(coef(m2)[c(2, 3)], 5))
+  expect_equal(round(coef(m1), 2), round(coef(m2)[c(2, 3)], 2))
 })