diff --git a/R/generics_summary.R b/R/generics_summary.R index 7469acd..39ed59f 100644 --- a/R/generics_summary.R +++ b/R/generics_summary.R @@ -89,7 +89,8 @@ 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( @@ -97,8 +98,8 @@ summary.felm <- function( 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 diff --git a/R/helpers.R b/R/helpers.R index 57bde2d..8d078f4 100644 --- a/R/helpers.R +++ b/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 ) } diff --git a/src/cpp11.cpp b/src/cpp11.cpp index 5d10912..821bd32 100644 --- a/src/cpp11.cpp +++ b/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>(eta_r), cpp11::as_cpp>(y_r), cpp11::as_cpp>(offset_r), cpp11::as_cpp>(wt_r), cpp11::as_cpp>(family), cpp11::as_cpp>(control), cpp11::as_cpp>(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 &>>(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 diff --git a/tests/testthat/test-felm.R b/tests/testthat/test-felm.R index 8aa0991..d354189 100644 --- a/tests/testthat/test-felm.R +++ b/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)) })