Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

ivreg #927

Closed
wants to merge 13 commits into from
4 changes: 3 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -556,6 +556,7 @@ Suggests:
gmm,
Hmisc,
irlba,
ivreg (>= 0.5.1),
joineRML,
Kendall,
knitr,
Expand Down Expand Up @@ -622,7 +623,6 @@ RoxygenNote: 7.1.1
Language: en-US
Collate:
'aaa-documentation-helper.R'
'null-and-default-tidiers.R'
'aer-tidiers.R'
'auc-tidiers.R'
'base-tidiers.R'
Expand All @@ -645,12 +645,14 @@ Collate:
'ergm-tidiers.R'
'fixest-tidiers.R'
'gam-tidiers.R'
'null-and-default-tidiers.R'
'gee.R'
'geepack-tidiers.R'
'glmnet-cv-glmnet-tidiers.R'
'glmnet-glmnet-tidiers.R'
'gmm-tidiers.R'
'hmisc-tidiers.R'
'ivreg-tidiers.R'
'joinerml-tidiers.R'
'kendall-tidiers.R'
'ks-tidiers.R'
Expand Down
5 changes: 5 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -24,6 +24,11 @@ in the overwriting of entries in the `curve` column (#914)
* Fixed bug related to univariate zoo series in `tidy.zoo()` (#916 by @WillemVervoort)
* Fixed a bug related to `tidy.prcomp()` assigning the wrong PC labels from "loadings"
and "scores" matrices (#910 by @tavareshugo)
* Update ivreg tidiers after upstream split from AER package. Includes support
for stage-1 regression components and alternative VCOV error matrices, as well
as "interval" argument for `augment.ivreg`. (#922 by @grantmcdermott)
* Added `tidy` method for `AER:tobit`. (#922 by @grantmcdermott above)


# broom 0.7.0

Expand Down
171 changes: 19 additions & 152 deletions R/aer-tidiers.R
Original file line number Diff line number Diff line change
@@ -1,173 +1,40 @@
#' @templateVar class ivreg
#' @templateVar class tobit
#' @template title_desc_tidy
#'
#' @param x An `ivreg` object created by a call to [AER::ivreg()].
#' @param x A `tobit` object created by a call to [AER::tobit()].
#' @template param_confint
#' @param instruments Logical indicating whether to return
#' coefficients from the second-stage or diagnostics tests for
#' each endogenous regressor (F-statistics). Defaults to `FALSE`.
#' @template param_unused_dots
#'
#' @details This tidier currently only supports `ivreg`-classed objects
#' outputted by the `AER` package. The `ivreg` package also outputs
#' objects of class `ivreg`, and will be supported in a later release.
#'
#' @evalRd return_tidy(
#' "statistic.Sargan",
#' "p.value.Sargan",
#' "statistic.Wu.Hausman",
#' "p.value.Wu.Hausman",
#' "statistic.weakinst",
#' "p.value.weakinst",
#' regression = TRUE
#' )
#' @evalRd return_tidy(regression = TRUE)
#'
#' @examples
#'
#' library(AER)
#'
#' data("CigarettesSW", package = "AER")
#' data("Affairs", package = "AER")
#'
#' ivr <- ivreg(
#' log(packs) ~ income | population,
#' data = CigarettesSW,
#' subset = year == "1995"
#' )
#'
#' summary(ivr)
#'
#' tidy(ivr)
#' tidy(ivr, conf.int = TRUE)
#' tidy(ivr, conf.int = TRUE, instruments = TRUE)
#'
#' augment(ivr)
#' augment(ivr, data = CigarettesSW)
#' augment(ivr, newdata = CigarettesSW)
#'
#' glance(ivr)
#' @export
#' @seealso [tidy()], [AER::ivreg()]
#' @family ivreg tidiers
#' @aliases ivreg_tidiers aer_tidiers
tidy.ivreg <- function(x,
conf.int = FALSE,
conf.level = 0.95,
instruments = FALSE,
...) {

# TODO: documentation on when you get what needs to be updated !!!

# case 1: user does not ask for instruments

if (!instruments) {
ret <- as_tibble(summary(x)$coefficients, rownames = "term")
colnames(ret) <- c("term", "estimate", "std.error", "statistic", "p.value")

if (conf.int) {
ci <- broom_confint_terms(x, level = conf.level)
ret <- dplyr::left_join(ret, ci, by = "term")
}

return(ret)
}

# case 2: user asks for instruments

end_vars <- names(coef(x))[-1] # subtract off the intercept
d <- summary(x, diagnostics = TRUE)$diagnostics

# drop last two rows, the Wu-Hausman and Sargan diagnostics
last_two_rows <- c(nrow(d) - 1, nrow(d))
d <- as_tibble(d)[-last_two_rows, ]
tibble::add_column(d, term = end_vars, .before = TRUE) %>%
rename2("p.value" = "p-value", "num.df" = "df1", "den.df" = "df2")
}

#' @templateVar class ivreg
#' @template title_desc_augment
#'
#' @inherit tidy.ivreg params examples
#' @template param_data
#' @template param_newdata
#' @template param_unused_dots
#'
#' @details This tidier currently only supports `ivreg`-classed objects
#' outputted by the `AER` package. The `ivreg` package also outputs
#' objects of class `ivreg`, and will be supported in a later release.
#'
#' @evalRd return_augment()
#' tob <- tobit(affairs ~ age + yearsmarried + religiousness + occupation + rating,
#' data = Affairs)
#'
#' tidy(tob)
#' tidy(tob, conf.int = TRUE)
#' @export
#' @seealso [augment()], [AER::ivreg()]
#' @family ivreg tidiers
augment.ivreg <- function(x, data = model.frame(x), newdata = NULL, ...) {
augment_columns(x, data, newdata)
}

#' @templateVar class ivreg
#' @template title_desc_glance
#'
#' @inherit tidy.ivreg params examples
#' @param diagnostics Logical indicating whether or not to return the
#' Wu-Hausman and Sargan diagnostic information.
#'
#' @note Beginning 0.7.0, `glance.ivreg` returns statistics for the
#' Wu-Hausman test for endogeneity and the Sargan test of
#' overidentifying restrictions. Sargan test values are returned as `NA`
#' if the number of instruments is not greater than the number of
#' endogenous regressors.
#'
#' @details This tidier currently only supports `ivreg`-classed objects
#' outputted by the `AER` package. The `ivreg` package also outputs
#' objects of class `ivreg`, and will be supported in a later release.
#'
#' @evalRd return_glance(
#' "r.squared",
#' "adj.r.squared",
#' "sigma",
#' "df",
#' "df.residual",
#' "nobs",
#' statistic = "Wald test statistic.",
#' p.value = "P-value for the Wald test."
#' )
#'
#' @export
#' @seealso [glance()], [AER::ivreg()]
#' @family ivreg tidiers
glance.ivreg <- function(x, diagnostics = FALSE, ...) {

s <- summary(x, diagnostics = FALSE)
#' @seealso [tidy()], [AER::tobit()]
#' @family AER tidiers
#' @aliases AER_tidiers
tidy.tobit <- function(x, conf.int = FALSE, conf.level = 0.95, ...) {

ret <- as_glance_tibble(
r.squared = s$r.squared,
adj.r.squared = s$adj.r.squared,
sigma = s$sigma,
statistic = s$waldtest[1],
p.value = s$waldtest[2],
df = s$df[1],
df.residual = df.residual(x),
nobs = stats::nobs(x),
na_types = "rrrrriii"
)

if (diagnostics) {
s_ <- summary(x, diagnostics = TRUE)

diags <- as_glance_tibble(
statistic.Sargan = s_$diagnostics["Sargan", "statistic"],
p.value.Sargan = s_$diagnostics["Sargan", "p-value"],
statistic.Wu.Hausman = s_$diagnostics["Wu-Hausman", "statistic"],
p.value.Wu.Hausman = s_$diagnostics["Wu-Hausman", "p-value"],
na_types = "rrrr"
)

return(bind_cols(ret, diags))
ret <- as_tibble(unclass(summary(x)$coefficients), rownames = "term")
colnames(ret) <- c("term", "estimate", "std.error", "statistic", "p.value")

if (conf.int) {
ci <- broom_confint_terms(summary(x)$coefficients, level = conf.level)
ret <- dplyr::left_join(ret, ci, by = "term")
}

ret
}

#' @include null-and-default-tidiers.R
#' @export
tidy.tobit <- tidy.default
Loading