Add glance methods and IV diagnostics

.Rbuildignore

@@ -21,5 +21,6 @@ update_repo.R
 ^tests/testthat/test-zzzbroom\.R$
 ^estimatr_.*\.tar\.gz$
 ^tests/testthat/test-texreg\.R$
+^tests/testthat/test-gtsummary\.R$
 ^cran-comments\.md$
 

.travis.yml

@@ -47,6 +47,8 @@ addons:
 r_github_packages:
 - DeclareDesign/DDtools
 - ropensci/git2r
+- rstudio/gt
+- vincentarelbundock/gtsummary
 
 after_success:
 - Rscript -e DDtools::after_build

NAMESPACE

@@ -4,6 +4,9 @@ S3method(confint,difference_in_means)
 S3method(confint,horvitz_thompson)
 S3method(confint,iv_robust)
 S3method(confint,lm_robust)
+S3method(glance,difference_in_means)
+S3method(glance,iv_robust)
+S3method(glance,lm_robust)
 S3method(nobs,iv_robust)
 S3method(nobs,lm_robust)
 S3method(nobs,summary.lm_robust)
@@ -33,6 +36,7 @@ export(difference_in_means)
 export(extract.iv_robust)
 export(extract.lm_robust)
 export(gen_pr_matrix_cluster)
+export(glance)
 export(horvitz_thompson)
 export(iv_robust)
 export(lm_lin)
@@ -43,6 +47,7 @@ export(starprep)
 export(tidy)
 importFrom(Formula,as.Formula)
 importFrom(Rcpp,evalCpp)
+importFrom(generics,glance)
 importFrom(generics,tidy)
 importFrom(methods,className)
 importFrom(methods,isGeneric)

R/S3_glance.R

@@ -0,0 +1,184 @@
+#' @importFrom generics glance
+#' @export
+generics::glance
+
+#' Glance at an estimatr object
+#' @name estimatr_glancers
+#' @templateVar class lm_robust
+#' @return A data.frame with columns:
+#'   \item{r.squared}{the \eqn{R^2},
+#'   \deqn{R^2 = 1 - Sum(e[i]^2) / Sum((y[i] - y^*)^2),} where \eqn{y^*}
+#'   is the mean of \eqn{y[i]} if there is an intercept and zero otherwise,
+#'   and \eqn{e[i]} is the ith residual.}
+#'   \item{adj.r.squared}{the \eqn{R^2} but penalized for having more parameters, \code{rank}}
+#'   \item{se_type}{the standard error type specified by the user}
+#'   \item{statistic}{the value of the F-statistic}
+#'   \item{p.value}{p-value from the F test}
+#'   \item{df.residual}{residual degrees of freedom}
+#'   \item{N}{the number of observations used}
+#'
+#' @param x An object returned by one of the estimators
+#' @param ... extra arguments (not used)
+#'
+#' @export
+#' @family estimatr glancers
+#' @seealso [generics::glance()], [estimatr::lm_robust()], [estimatr::lm_lin()]
+#' @md
+glance.lm_robust <- function(x, ...) {
+
+  if (length(x[["outcome"]]) > 1) {
+    stop("Cannot use `glance` on linear models with multiple responses.")
+  }
+
+  ret <- cbind(
+    data.frame(
+      r.squared = x[["r.squared"]],
+      adj.r.squared = x[["adj.r.squared"]]
+    ),
+    if (exists("fstatistic", x)) {
+      data.frame(
+        statistic = x[["fstatistic"]][1],
+        p.value = pf(x[["fstatistic"]][1], x[["fstatistic"]][2], x[["fstatistic"]][3], lower.tail = FALSE)
+      )
+    } else {
+      data.frame(statistic = NA_real_, p.value = NA_real_)
+    },
+    data.frame(
+      df.residual = x[["df"]][1],
+      N = x[["N"]],
+      se_type = x[["se_type"]]
+    )
+  )
+
+  rownames(ret) <- NULL
+
+  as.data.frame(ret)
+}
+
+#' Glance at an estimatr object
+#' @name estimatr_glancers
+#' @templateVar class iv_robust
+#' @return A data.frame with columns:
+#'   \item{r.squared}{The \eqn{R^2} of the second stage regression}
+#'   \item{adj.r.squared}{The \eqn{R^2} but penalized for having more parameters, \code{rank}}
+#'   \item{df.residual}{residual degrees of freedom}
+#'   \item{N}{the number of observations used}
+#'   \item{se_type}{the standard error type specified by the user}
+#'   \item{statistic}{the value of the F-statistic}
+#'   \item{p.value}{p-value from the F test}
+#'   \item{statistic.weakinst}{the value of the first stage F-statistic, useful for the weak instruments test}
+#'   \item{p.value.weakinst}{p-value from the first-stage F test, a test of weak instruments}
+#'
+#' @param x An object returned by one of the estimators
+#' @param ... extra arguments (not used)
+#'
+#' @export
+#' @family estimatr glancers
+#' @seealso [generics::glance()], [estimatr::iv_robust()]
+#' @md
+glance.iv_robust <- function(x, ...) {
+
+  if (length(x[["outcome"]]) > 1) {
+    stop("Cannot use `glance` on linear models with multiple responses.")
+  }
+
+  ret <- cbind(
+    data.frame(
+      r.squared = x[["r.squared"]],
+      adj.r.squared = x[["adj.r.squared"]],
+      df.residual = x[["df.residual"]],
+      N = x[["N"]],
+      se_type = x[["se_type"]]
+    ),
+    if (exists("fstatistic", x)) {
+      data.frame(
+        statistic = x[["fstatistic"]][1],
+        p.value = pf(x[["fstatistic"]][1], x[["fstatistic"]][2], x[["fstatistic"]][3], lower.tail = FALSE)
+      )
+    } else {
+      data.frame(statistic = NA_real_, p.value = NA_real_)
+    },
+    if (exists("diagnostic_firststage_fstatistic", x) && length(x[["diagnostic_firststage_fstatistic"]] == 4)) {
+      data.frame(
+        statistic.weakinst = x[["diagnostic_firststage_fstatistic"]]["value"],
+        p.value.weakinst = x[["diagnostic_firststage_fstatistic"]]["p.value"]
+      )
+    } else {
+      data.frame(statistic.weakinst = NA_real_, p.value.weakinst = NA_real_)
+    },
+    if (exists("diagnostic_endogeneity_fstatistic", x)) {
+      data.frame(
+        statistic.endogeneity = x[["diagnostic_endogeneity_fstatistic"]]["value"],
+        p.value.endogeneity = x[["diagnostic_endogeneity_fstatistic"]]["p.value"]
+      )
+    } else {
+      data.frame(statistic.endogeneity = NA_real_, p.value.endogeneity = NA_real_)
+    },
+    if (exists("diagnostic_overid_fstatistic", x)) {
+      data.frame(
+        statistic.overid = x[["diagnostic_overid_fstatistic"]]["value"],
+        p.value.overid = x[["diagnostic_overid_fstatistic"]]["p.value"]
+      )
+    } else {
+      data.frame(statistic.overid = NA_real_, p.value.overid = NA_real_)
+    }
+  )
+
+  as.data.frame(ret)
+}
+
+#' Glance at an estimatr object
+#' @name estimatr_glancers
+#' @templateVar class difference_in_means
+#' @return A data.frame with columns:
+#'   \item{r.squared}{The \eqn{R^2} of the second stage regression}
+#'   \item{adj.r.squared}{The \eqn{R^2} but penalized for having more parameters, \code{rank}}
+#'   \item{df.residual}{residual degrees of freedom}
+#'   \item{N}{the number of observations used}
+#'   \item{statistic}{the value of the F-statistic}
+#'   \item{p.value}{p-value from the F test}
+#'   \item{statistic.weakinst}{the value of the first stage F-statistic, useful for the weak instruments test}
+#'   \item{p.value.weakinst}{p-value from the first-stage F test, a test of weak instruments}
+#'
+#' @param x An object returned by one of the estimators
+#' @param ... extra arguments (not used)
+#'
+#' @export
+#' @family estimatr glancers
+#' @seealso [generics::glance()], [estimatr::difference_in_means()]
+#' @md
+glance.difference_in_means <- function(x, ...) {
+  ret <- cbind(
+    data.frame(
+      design = x[["design"]],
+      df = x[["df"]],
+      N = x[["N"]]
+    ),
+    if (exists("N_blocks", x)) {
+      data.frame(N_blocks = x[["N_blocks"]])
+    } else {
+      data.frame(N_blocks = NA_real_)
+    },
+    if (exists("N_clusters", x)) {
+      data.frame(N_clusters = x[["N_clusters"]])
+    } else {
+      data.frame(N_clusters = NA_real_)
+    }
+  )
+
+  as.data.frame(ret)
+}
+
+
+#' @export
+#' @family estimatr glancers
+#' @seealso [generics::glance()], [estimatr::horvitz_thompson()]
+#' @md
+glance.horvitz_thompson <- function(x, ...) {
+  ret <- data.frame(
+      N = x[["N"]]
+  )
+  # TODO: add standard error type
+
+  as.data.frame(ret)
+}

R/S3_print.R

@@ -56,7 +56,7 @@ print_summary_lm_like <- function(x,
     fstat
   )
 
-  if (!is.null(x$proj_fstatistic)) {
+  if (exists("proj_fstatistic", x)) {
     cat(
       "\nMultiple R-squared (proj. model): ",
       formatC(x$proj_r.squared, digits = digits),

R/S3_summary.R

@@ -57,23 +57,31 @@ summary.iv_robust <- function(object, ...) {
 
 
 summary_lm_model <- function(object) {
-  return_list <-
-    object[c(
-      "call",
-      "k",
-      "rank",
-      "df.residual",
-      "r.squared",
-      "adj.r.squared",
-      "fstatistic",
+
+  out_values <- c(
+    "call",
+    "k",
+    "rank",
+    "df.residual",
+    "res_var",
+    "weighted",
+    "se_type",
+    "fes",
+    "r.squared",
+    "adj.r.squared",
+    "fstatistic"
+  )
+  # Different returns if fixed effects in the output
+  if (object[["fes"]]) {
+    out_values <- c(
+      out_values,
       "proj_r.squared",
       "proj_adj.r.squared",
-      "proj_fstatistic",
-      "res_var",
-      "weighted",
-      "se_type",
-      "fes"
-    )]
+      "proj_fstatistic"
+    )
+  }
+
+  return_list <- object[out_values]
 
   # Split into two lists if multivariate linear model