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

update printing and clean deps #51

Merged
merged 4 commits into from
Nov 18, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 0 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -22,7 +22,6 @@ Imports:
checkmate,
numDeriv,
MASS,
prediction,
sandwich,
stats
Suggests:
Expand Down
4 changes: 3 additions & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
# Generated by roxygen2: do not edit by hand

S3method(find_data,glm)
S3method(find_data,lm)
S3method(predict_counterfactual,glm)
S3method(predict_counterfactual,lm)
S3method(print,prediction_cf)
Expand All @@ -9,6 +11,7 @@ S3method(treatment_effect,lm)
S3method(treatment_effect,prediction_cf)
S3method(vcovHC,prediction_cf)
export(bias)
export(find_data)
export(gvcov)
export(h_diff)
export(h_jac_diff)
Expand All @@ -22,7 +25,6 @@ export(treatment_effect)
import(checkmate)
importFrom(MASS,negative.binomial)
importFrom(numDeriv,jacobian)
importFrom(prediction,find_data)
importFrom(sandwich,vcovHC)
importFrom(stats,as.formula)
importFrom(stats,coefficients)
Expand Down
1 change: 0 additions & 1 deletion R/RobinCar2-package.R
Original file line number Diff line number Diff line change
Expand Up @@ -11,5 +11,4 @@
#' gaussian terms glm var family pnorm var as.formula
#' @importFrom sandwich vcovHC
#' @importFrom MASS negative.binomial
#' @importFrom prediction find_data
NULL
15 changes: 15 additions & 0 deletions R/find_data.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,15 @@
#' Find Data in a Fit
#' @export
#' @param fit A fit object.
#' @param ... Additional arguments.
find_data <- function(fit, ...) {
UseMethod("find_data")
}
#' @export
find_data.glm <- function(fit, ...) {
fit$data
}
#' @export
find_data.lm <- function(fit, ...) {
stop("data must be provided explicitly for lm objects")
}
2 changes: 2 additions & 0 deletions R/robin_glm.R
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,8 @@ robin_glm <- function(
attr(formula, ".Environment") <- environment()
# check if using negative.binomial family with NA as theta.
# If so, use MASS::glm.nb instead of glm.
assert_subset(all.vars(formula), names(data))
assert_subset(all.vars(treatment), names(data))
if (identical(family$family, "Negative Binomial(NA)")) {
fit <- MASS::glm.nb(formula, data = data, ...)
} else {
Expand Down
9 changes: 8 additions & 1 deletion R/treatment_effect.R
Original file line number Diff line number Diff line change
Expand Up @@ -53,6 +53,7 @@ treatment_effect.prediction_cf <- function(
}
trt_var <- trt_jac %*% inner_variance %*% t(trt_jac)
} else {
inner_variance <- NULL
trt_var <- diag(NULL)
}

Expand All @@ -63,6 +64,7 @@ treatment_effect.prediction_cf <- function(
marginal_mean = object,
fit = attr(object, "fit"),
vartype = variance_name,
mmvariance = inner_variance,
treatment = attr(object, "treatment_formula"),
variance = diag(trt_var),
class = "treatment_effect"
Expand Down Expand Up @@ -183,7 +185,12 @@ print.treatment_effect <- function(x, ...) {
cat("Randomization: ", deparse(attr(x, "treatment")), "\n")
cat("Marginal Mean: \n")
print(attr(x, "marginal_mean"))

if (!identical(attr(x, "vartype"), "none")) {
v <- attr(x, "mmvariance")
cat("Marginal Mean Variance: \n")
print(sqrt(diag(v)))
cat("\n\n")
}
cat("Variance Type: ", attr(x, "vartype"), "\n")
if (identical(attr(x, "vartype"), "none")) {
trt_sd <- rep(NA, length(x))
Expand Down
16 changes: 16 additions & 0 deletions man/find_data.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

18 changes: 17 additions & 1 deletion tests/testthat/_snaps/treatment_effect.md
Original file line number Diff line number Diff line change
Expand Up @@ -13,6 +13,11 @@
pbo trt1 trt2
0.3560965 0.5806957 0.6213865

Marginal Mean Variance:
pbo trt1 trt2
0.03359913 0.03441801 0.03401864


Variance Type: gvcov
Estimate Std.Err Z Value Pr(>|z|)
trt1 - pbo 0.2246 0.0477 4.71 2.5e-06 ***
Expand All @@ -24,7 +29,8 @@
---

Code
treatment_effect(fit_lm, treatment = treatment ~ s1, eff_measure = h_diff)
treatment_effect(fit_lm, treatment = treatment ~ s1, eff_measure = h_diff,
data = dummy_data)
Output
Treatment Effect
-------------
Expand All @@ -36,6 +42,11 @@
pbo trt1 trt2
0.2003208 0.7639709 0.9712499

Marginal Mean Variance:
pbo trt1 trt2
0.06768998 0.07592944 0.07654319


Variance Type: gvcov
Estimate Std.Err Z Value Pr(>|z|)
trt1 - pbo 0.564 0.101 5.60 2.2e-08 ***
Expand Down Expand Up @@ -82,6 +93,11 @@
pbo trt1 trt2
0.3560965 0.5806957 0.6213865

Marginal Mean Variance:
pbo trt1
0.03359913 0.03441801


Variance Type: gvcov
Estimate Std.Err Z Value Pr(>|z|)
trt1 - pbo 0.2246 0.0477 4.71 2.5e-06 ***
Expand Down
13 changes: 13 additions & 0 deletions tests/testthat/test-find_data.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,13 @@
test_that("find_data works for glm", {
expect_identical(
find_data(fit_glm),
fit_glm$data
)
})

test_that("find_data fails for lm", {
expect_error(
find_data(fit_lm),
"data must be provided explicitly for lm objects"
)
})
2 changes: 1 addition & 1 deletion tests/testthat/test-treatment_effect.R
Original file line number Diff line number Diff line change
Expand Up @@ -147,7 +147,7 @@ test_that("treatment_effect works as expected for custom contrast", {

test_that("treatment_effect works for lm/glm object", {
expect_snapshot(treatment_effect(fit_binom, treatment = treatment ~ s1, eff_measure = h_diff))
expect_snapshot(treatment_effect(fit_lm, treatment = treatment ~ s1, eff_measure = h_diff))
expect_snapshot(treatment_effect(fit_lm, treatment = treatment ~ s1, eff_measure = h_diff, data = dummy_data))
})

test_that("treatment_effect works if variance is not used", {
Expand Down
Loading