Model: lm in summary(design)

DeclareDesign · Apr 3, 2018 · b8457ac · b8457ac
1 parent 451fdc3
commit b8457ac
Show file tree

Hide file tree

Showing 4 changed files with 14 additions and 2 deletions.
diff --git a/R/declare_design.R b/R/declare_design.R
@@ -281,7 +281,7 @@ summary.design <- function(object, ...) {
 
   variables_added <- variables_modified <-
     quantities_added <- quantities_modified <-
-    N <-
+    N <- extra_summary <-
     vector("list", length(design))
 
   formulae <- lapply(design, get_formula_from_step)
@@ -302,6 +302,7 @@ summary.design <- function(object, ...) {
       causal_type <- attr(design[[i]], "causal_type")
       if(is.null(causal_type)) next;
 
+      extra_summary[i] <- list(attr(design[[i]], "extra_summary"))
 
       # if it's a dgp
       if (causal_type == "dgp") {
@@ -367,7 +368,8 @@ summary.design <- function(object, ...) {
          title = title,
          authors = authors,
          description = description,
-         citation = citation
+         citation = citation,
+         extra_summary = extra_summary
     ),
     class = c("summary.design", "list")
 

diff --git a/R/declare_estimator.R b/R/declare_estimator.R
@@ -158,6 +158,7 @@ validation_fn(model_handler) <-  function(ret, dots, label){
     if(!is.function(model) || ! "data" %in% names(formals(model))){
       declare_time_error("Must provide a function for `model` which takes a `data` argument.", ret)
     }
+    attr(ret, "extra_summary") <- sprintf("Model:\t%s", as.character(f_rhs(dots$model)))
   }
   ret
 }

diff --git a/R/design_helper_functions.R b/R/design_helper_functions.R
@@ -256,6 +256,9 @@ print.summary.design <- function(x, ...) {
     if (!is.null(x$formulae[[i]])) {
       cat("Formula:", deparse(x$formula[[i]]), "\n\n")
     }
+    if (is.character(x$extra_summary[[i]])) {
+      cat(x$extra_summary[[i]], "\n\n")
+    }
 
     if (!is.null(x$quantities_added[[i]])) {
       if (class(x$quantities_added[[i]]) == "data.frame") {

diff --git a/tests/testthat/test-design-summary.R b/tests/testthat/test-design-summary.R
@@ -83,3 +83,9 @@ test_that("summary, estimator formula print formula", {
 
 })
 
+test_that("summary, estimator print model", {
+  d <- declare_design(sleep, declare_estimator(extra~group, model=lm))
+
+  expect_output(print(d), "Model:\\s*lm")
+
+})