From 374b894d6135e09735ebbb0681e885126097e543 Mon Sep 17 00:00:00 2001
From: Benjamin Nutter <benjamin.nutter@gmail.com>
Date: Fri, 15 Jun 2018 13:52:42 +0000
Subject: [PATCH 1/4] first gaze

---
 .Rbuildignore |   2 +-
 DESCRIPTION   |   2 +-
 R/gaze.R      | 139 ++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 141 insertions(+), 2 deletions(-)
 create mode 100644 R/gaze.R

diff --git a/.Rbuildignore b/.Rbuildignore
index eecc6fb..c492997 100644
--- a/.Rbuildignore
+++ b/.Rbuildignore
@@ -9,4 +9,4 @@
 ^xtable_vs_pixiedust.html$
 ^xtable_vs_pixiedust.Rmd$
 ^\inst\save_sprinkles_rda.R$
-^\revdep\*
\ No newline at end of file
+^revdep$
\ No newline at end of file
diff --git a/DESCRIPTION b/DESCRIPTION
index 059e3bc..74228a1 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: pixiedust
 Title: Tables so Beautifully Fine-Tuned You Will Believe It's Magic
-Version: 0.8.3
+Version: 0.8.4
 Authors@R: c(person("Benjamin", "Nutter", email = "benjamin.nutter@gmail.com", role = c("aut", "cre")),
              person("David", "Kretch", role = c("ctb")))
 Description: The introduction of the 'broom' package has made converting model
diff --git a/R/gaze.R b/R/gaze.R
new file mode 100644
index 0000000..caeae61
--- /dev/null
+++ b/R/gaze.R
@@ -0,0 +1,139 @@
+#' @name gaze
+#' @title Mimic Stargazer Output to Display Multiple Models
+#' 
+#' @description Tidy multiple models and display coefficients and 
+#'   test statistics in a side-by-side format.
+#'   
+#' @param ... models to be tidied.  Arguments may be named or unnamed.
+#'   For named arguments, the model will be identfied by the argument 
+#'   name; for unnamed arguments, the object name will be the identifier.
+#' @param include_glance \code{logical(1)} Determines if \code{glance} (fit)
+#'   statistics are displayed under the models.
+#' @param glance_vars \code{character}. A vector of statistics returned by
+#'   \code{glance} that are to be displayed for each model.
+#' @param digits \code{numeric(1)} The number of digits used for rounding.
+#'
+#' @examples 
+#' fit1 <- lm(mpg ~ qsec + am + wt + gear + factor(vs), data = mtcars)
+#' fit2 <- lm(mpg ~ am + wt + gear + factor(vs), data = mtcars)
+#' 
+#' gaze(fit1, fit2)
+#' gaze(with_qsec = fit1, 
+#'      without_qsec = fit2)
+#' gaze(fit1, fit2, include_glance = FALSE)
+#' gaze(fit1, fit2, glance_vars = c("AIC", "BIC"))
+
+gaze <- function(..., include_glance = TRUE,
+                 glance_vars = c("adj.r.squared", "sigma", "AIC"),
+                 digits = 3){
+  fits <- list(...)
+  if (is.null(names(fits))) names(fits) <- character(length(fits))
+  
+  # If a fit isn't named, use the object name
+  dots <- match.call(expand.dots = FALSE)$...
+  fit_names <- vapply(dots, deparse, character(1))
+  names(fits)[names(fits) == ""] <- fit_names[names(fits) == ""]
+
+  res <- prep_gaze_tidy(fits, names(fits), digits)
+  if (include_glance){
+    res <- rbind(res, 
+                 prep_gaze_glance(fits, names(fits), glance_vars, digits))
+  }
+  res
+}
+
+
+# UNEXPORTED METHODS ------------------------------------------------
+
+prep_gaze_tidy <- function(fits, fit_names, digits){
+  res <- 
+    mapply(
+      FUN = 
+        function(fit, name)
+        {
+          data.frame(model = name,
+                     broom::tidy(fit),
+                     stringsAsFactors = FALSE)
+        },
+      fit = fits,
+      name = fit_names,
+      SIMPLIFY = FALSE
+    ) 
+  
+  res <- dplyr::bind_rows(res)
+  
+  res <- res[c("model", "term", "estimate", "statistic")]
+  res[["term"]] <- factor(res[["term"]], 
+                          levels = unique(res[["term"]]))
+  
+  res <-
+    stats::reshape(
+      data = res,
+      direction = "long",
+      varying = list(value = c("estimate", "statistic")),
+      v.names = "value",
+      timevar = "variable",
+      times = c("estimate", "statistic")
+    )
+  
+  rownames(res) <- NULL
+  
+  res[["value"]] <- round(res[["value"]], digits)
+  statistic_row <- res[["variable"]] == "statistic"
+  res[["value"]][statistic_row] <- 
+    sprintf("(%s)",
+            res[["value"]][statistic_row])
+  
+  res <- reshape(data = res[!names(res) %in% "id"],
+                 direction = "wide",
+                 v.names = "value",
+                 idvar = c("term", "variable"),
+                 timevar = c("model"))
+  
+  res <- res[order(res[["term"]], res[["variable"]]), ]
+  names(res) <- sub("^value\\.", "", names(res))
+  res[!names(res) %in% "variable"]
+}
+
+
+prep_gaze_glance <- function(fits, fit_names, glance_vars, digits){
+  res <- 
+    mapply(
+      FUN = 
+        function(fit, name)
+        {
+          data.frame(model = name,
+                     broom::glance(fit),
+                     stringsAsFactors = FALSE)
+        },
+      fit = fits,
+      name = fit_names,
+      SIMPLIFY = FALSE
+    ) 
+  
+  res <- dplyr::bind_rows(res)
+  res <- res[c("model", glance_vars)]
+  
+  res <- 
+    stats::reshape(
+      data = res,
+      direction = "long",
+      times = glance_vars,
+      varying = list(value = glance_vars)
+    )
+  
+  names(res)[2:3] <- c("term", "value")
+  res[["value"]] <- round(res[["value"]], digits)
+  
+  
+  res <-
+    reshape(data = res[!names(res) %in% "id"],
+                 direction = "wide",
+                 v.names = "value",
+                 idvar = c("term"),
+                 timevar = c("model"))
+
+  names(res) <- sub("^value\\.", "", names(res))
+  rownames(res) <- NULL
+  res
+}

From e6146d2eae7db0c1f3828f5ea0bc31d3ef60f5b7 Mon Sep 17 00:00:00 2001
From: Benjamin Nutter <benjamin.nutter@gmail.com>
Date: Fri, 29 Jun 2018 07:49:36 +0000
Subject: [PATCH 2/4] Prepping CRAN update

---
 NAMESPACE                              |  1 +
 R/gaze.R                               | 59 +++++++++++++++++-----
 R/glance_foot.R                        |  4 +-
 cran-comments.md                       |  5 +-
 man/gaze.Rd                            | 54 ++++++++++++++++++++
 tests/testthat/test-dust.R             |  7 ++-
 tests/testthat/test-gaze.R             | 69 ++++++++++++++++++++++++++
 tests/testthat/test-perform_function.R |  4 +-
 vignettes/pixiedust.Rmd                | 17 ++++---
 9 files changed, 195 insertions(+), 25 deletions(-)
 create mode 100644 man/gaze.Rd
 create mode 100644 tests/testthat/test-gaze.R

diff --git a/NAMESPACE b/NAMESPACE
index e81f62a..1a69b01 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -79,6 +79,7 @@ export("%<>%")
 export("%>%")
 export(dust)
 export(fixed_header_css)
+export(gaze)
 export(get_dust_part)
 export(get_pixie_count)
 export(increment_pixie_count)
diff --git a/R/gaze.R b/R/gaze.R
index caeae61..0cd2610 100644
--- a/R/gaze.R
+++ b/R/gaze.R
@@ -10,8 +10,22 @@
 #' @param include_glance \code{logical(1)} Determines if \code{glance} (fit)
 #'   statistics are displayed under the models.
 #' @param glance_vars \code{character}. A vector of statistics returned by
-#'   \code{glance} that are to be displayed for each model.
+#'   \code{glance} that are to be displayed for each model. Defaults are 
+#'   subject to change in future versions.
 #' @param digits \code{numeric(1)} The number of digits used for rounding.
+#' 
+#' @details This function is still in development.  Significant stars 
+#'   will be added in a future version. Note that function defaults may 
+#'   be subject to change.
+#' 
+#' @section Functional Requirements:
+#' \enumerate{
+#'   \item Return a data frame object
+#'   \item Cast an error if \code{include_glance} is not \code{logical(1)}
+#'   \item Cast an error if \code{glance_vars} is not a \code{character} 
+#'     vector.
+#'   \item Cast an error if \code{digits} is not \code{"integerish(1)"}.
+#' }
 #'
 #' @examples 
 #' fit1 <- lm(mpg ~ qsec + am + wt + gear + factor(vs), data = mtcars)
@@ -22,10 +36,28 @@
 #'      without_qsec = fit2)
 #' gaze(fit1, fit2, include_glance = FALSE)
 #' gaze(fit1, fit2, glance_vars = c("AIC", "BIC"))
+#' 
+#' @export
 
 gaze <- function(..., include_glance = TRUE,
                  glance_vars = c("adj.r.squared", "sigma", "AIC"),
                  digits = 3){
+  
+  coll <- checkmate::makeAssertCollection()
+  
+  checkmate::assert_logical(x = include_glance,
+                            len = 1,
+                            add = coll)
+  
+  checkmate::assert_character(x = glance_vars,
+                              add = coll)
+  
+  checkmate::assert_integerish(x = digits,
+                               len = 1,
+                               add = 1)
+  
+  checkmate::reportAssertions(coll)
+  
   fits <- list(...)
   if (is.null(names(fits))) names(fits) <- character(length(fits))
   
@@ -84,11 +116,13 @@ prep_gaze_tidy <- function(fits, fit_names, digits){
     sprintf("(%s)",
             res[["value"]][statistic_row])
   
-  res <- reshape(data = res[!names(res) %in% "id"],
-                 direction = "wide",
-                 v.names = "value",
-                 idvar = c("term", "variable"),
-                 timevar = c("model"))
+  res <- 
+    stats::reshape(
+      data = res[!names(res) %in% "id"],
+      direction = "wide",
+      v.names = "value",
+      idvar = c("term", "variable"),
+      timevar = c("model"))
   
   res <- res[order(res[["term"]], res[["variable"]]), ]
   names(res) <- sub("^value\\.", "", names(res))
@@ -127,12 +161,13 @@ prep_gaze_glance <- function(fits, fit_names, glance_vars, digits){
   
   
   res <-
-    reshape(data = res[!names(res) %in% "id"],
-                 direction = "wide",
-                 v.names = "value",
-                 idvar = c("term"),
-                 timevar = c("model"))
-
+    stats::reshape(
+      data = res[!names(res) %in% "id"],
+      direction = "wide",
+      v.names = "value",
+      idvar = c("term"),
+      timevar = c("model"))
+  
   names(res) <- sub("^value\\.", "", names(res))
   rownames(res) <- NULL
   res
diff --git a/R/glance_foot.R b/R/glance_foot.R
index 76969f8..c8d7bf3 100644
--- a/R/glance_foot.R
+++ b/R/glance_foot.R
@@ -89,7 +89,9 @@ glance_foot <- function(fit, col_pairs, total_cols,
   
   checkmate::reportAssertions(coll)
   
-  g <- broom::tidy(t(g[glance_stats])) 
+  g <- data.frame(.rownames = names(g[glance_stats]),
+                  unrowname.x. = unname(unlist(g[glance_stats][1, ])),
+                  stringsAsFactors = FALSE)
   # return(g)
   if (nrow(g) %% col_pairs > 0){
     n_fill <- (col_pairs - nrow(g) %% col_pairs)
diff --git a/cran-comments.md b/cran-comments.md
index f9e44b2..5685e60 100644
--- a/cran-comments.md
+++ b/cran-comments.md
@@ -1,11 +1,12 @@
 ## Test environments
-* local Linux install (R-3.4.3; #135-Ubuntu SMP Fri Jan 19 11:48:36 UTC 2018)
+* local Linux install (R-3.4.4; #135-Ubuntu SMP Fri Jan 19 11:48:36 UTC 2018)
 * remote Linux install (R-3.4.2; ubuntu 4.8.4-2ubuntu1~14.04.3)
 * win-builder (release R 3.5.0)
 * win-builder (2018-05-05 r74699)
 
 ## R CMD check results
-This update corrects one of the tests related to a change in how errors are reported from the `checkmate` package.
+This update adjusts for changes coming with a pending update to the `broom`
+package.
 
 
 ## Downstream dependencies
diff --git a/man/gaze.Rd b/man/gaze.Rd
new file mode 100644
index 0000000..dbf0fb9
--- /dev/null
+++ b/man/gaze.Rd
@@ -0,0 +1,54 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/gaze.R
+\name{gaze}
+\alias{gaze}
+\title{Mimic Stargazer Output to Display Multiple Models}
+\usage{
+gaze(..., include_glance = TRUE, glance_vars = c("adj.r.squared", "sigma",
+  "AIC"), digits = 3)
+}
+\arguments{
+\item{...}{models to be tidied.  Arguments may be named or unnamed.
+For named arguments, the model will be identfied by the argument 
+name; for unnamed arguments, the object name will be the identifier.}
+
+\item{include_glance}{\code{logical(1)} Determines if \code{glance} (fit)
+statistics are displayed under the models.}
+
+\item{glance_vars}{\code{character}. A vector of statistics returned by
+\code{glance} that are to be displayed for each model. Defaults are 
+subject to change in future versions.}
+
+\item{digits}{\code{numeric(1)} The number of digits used for rounding.}
+}
+\description{
+Tidy multiple models and display coefficients and 
+  test statistics in a side-by-side format.
+}
+\details{
+This function is still in development.  Significant stars 
+  will be added in a future version. Note that function defaults may 
+  be subject to change.
+}
+\section{Functional Requirements}{
+
+\enumerate{
+  \item Return a data frame object
+  \item Cast an error if \code{include_glance} is not \code{logical(1)}
+  \item Cast an error if \code{glance_vars} is not a \code{character} 
+    vector.
+  \item Cast an error if \code{digits} is not \code{"integerish(1)"}.
+}
+}
+
+\examples{
+fit1 <- lm(mpg ~ qsec + am + wt + gear + factor(vs), data = mtcars)
+fit2 <- lm(mpg ~ am + wt + gear + factor(vs), data = mtcars)
+
+gaze(fit1, fit2)
+gaze(with_qsec = fit1, 
+     without_qsec = fit2)
+gaze(fit1, fit2, include_glance = FALSE)
+gaze(fit1, fit2, glance_vars = c("AIC", "BIC"))
+
+}
diff --git a/tests/testthat/test-dust.R b/tests/testthat/test-dust.R
index 78e9ded..4cfc9ab 100644
--- a/tests/testthat/test-dust.R
+++ b/tests/testthat/test-dust.R
@@ -47,7 +47,12 @@ test_that("dust runs when passed a data frame with tidy_df = FALSE",
 
 test_that("dust runs when passed a data frame with tidy_df = TRUE",
 {
-  expect_silent(dust(mtcars, tidy_df = TRUE))
+  # 25 Jun 2018 Changed to expect warning since broom is deprecating data frame
+  #             tidiers
+  if (utils::compareVersion(as.character(packageVersion("broom")), "0.4.4") == 1)
+    expect_warning(dust(mtcars, tidy_df = TRUE))
+  else
+    expect_silent(dust(mtcars, tidy_df = TRUE))
 })
 
 test_that("dust with keep_rownames = TRUE adds rownames to object",
diff --git a/tests/testthat/test-gaze.R b/tests/testthat/test-gaze.R
new file mode 100644
index 0000000..bd274f4
--- /dev/null
+++ b/tests/testthat/test-gaze.R
@@ -0,0 +1,69 @@
+context("gaze.R")
+
+fit1 <- lm(mpg ~ qsec + wt + factor(gear),
+           data = mtcars)
+
+fit2 <- lm(mpg ~ disp + qsec + wt + factor(gear),
+           data = mtcars)
+
+# Functional Requirement 1 ------------------------------------------
+
+test_that(
+  "Return a data frame object",
+  {
+    checkmate::expect_data_frame(
+      gaze(fit1, fit2)
+    )
+  }
+)
+
+# Functional Requirement 2 ------------------------------------------
+
+test_that(
+  "Cast an error if include_glance is not logical(1)",
+  {
+    expect_error(
+      gaze(fit1, fit2, include_gaze = "yes")
+    )
+  }
+)
+
+test_that(
+  "Cast an error if include_glance is not logical(1)",
+  {
+    expect_error(
+      gaze(fit1, fit2, include_gaze = c(TRUE, FALSE))
+    )
+  }
+)
+
+# Functional Requirement 3 ------------------------------------------
+
+test_that(
+  "Cast an error if glance_vars is not a character vector.",
+  {
+    expect_error(
+      gaze(fit1, fit2, glance_vars = list(1:3, letters))
+    )
+  }
+)
+
+# Functional Requirement 4 ------------------------------------------
+
+test_that(
+  "Cast an error if digits is not integerish(1)",
+  {
+    expect_error(
+      gaze(fit1, fit2, digits = "two")
+    )
+  }
+)
+
+test_that(
+  "Cast an error if digits is not integerish(1)",
+  {
+    expect_error(
+      gaze(fit1, fit2, digits = c(2, 3))
+    )
+  }
+)
\ No newline at end of file
diff --git a/tests/testthat/test-perform_function.R b/tests/testthat/test-perform_function.R
index 8fa6475..6ea0e93 100644
--- a/tests/testthat/test-perform_function.R
+++ b/tests/testthat/test-perform_function.R
@@ -8,7 +8,7 @@ test_that("Apply a calculation",
   
   x <- perform_function(x$body)
   
-  expect_equal(x[x$row == 2 & x$col %in% 2:3, "value"],
+  expect_equal(x$value[x$row == 2 & x$col %in% 2:3],
                c("-1.24", "-0.38"))
 })
 
@@ -20,6 +20,6 @@ test_that("Apply a string manipulation",
             
   x <- perform_function(x$body)
             
-  expect_equal(x[x$row %in% 5:6 & x$col == 1, "value"],
+  expect_equal(x$value[x$row %in% 5:6 & x$col == 1],
                c("Gears: 4", "Gears: 5"))
 })
\ No newline at end of file
diff --git a/vignettes/pixiedust.Rmd b/vignettes/pixiedust.Rmd
index c23f047..2bae572 100644
--- a/vignettes/pixiedust.Rmd
+++ b/vignettes/pixiedust.Rmd
@@ -276,16 +276,19 @@ basetable %>%
 ```
 # Rotating Text
 
-There is a sprinkle available to rotate the text in a cell. I don't recommend using it.  Rotated text is harder to read, and communicating concepts is the whole point of the table.  However, sometimes it might be necessary.  For our example, we'll take the summary of the `mtcars` data set as returned by `broom`.
+There is a sprinkle available to rotate the text in a cell. I don't recommend using it.  Rotated text is harder to read, and communicating concepts is the whole point of the table.  However, sometimes it might be necessary.  For our example, we'll use the first few rows of the `mtcars` data set.
 
 Notice here that when I apply the rotation, I added an argument to `sprinkle` in which I denoted that the rotation should apply to the head of the table.  The head and body of the table are stored separately in the `dust` object and all of the sprinkles may be applied to either part of the table.  
+
 ```{r}
-dust(mtcars, tidy_df = TRUE) %>% 
-  sprinkle(cols = c("mean", "sd", "median", "trimmed", "mad", 
-                    "min", "max", "range", "skew", "kurtosis", "se"),
-           round = 2) %>% 
-  sprinkle(rows = 1, rotate_degree = -90, 
-           height = 60, part = "head") %>% 
+head(mtcars) %>% 
+  dust() %>%
+  sprinkle(cols = c("mpg", "disp", "drat", "qsec"),
+           round = 2) %>%
+  sprinkle(rows = 1,
+           rotate_degree = -90,
+           height = 60,
+           part = "head") %>%
   sprinkle_print_method("html")
 ```
 

From 45d8d51d656311656bbfe450201183aa823cb96f Mon Sep 17 00:00:00 2001
From: Benjamin Nutter <benjamin.nutter@gmail.com>
Date: Fri, 29 Jun 2018 17:50:24 +0000
Subject: [PATCH 3/4] fix vignette

---
 cran-comments.md        | 1 +
 vignettes/pixiedust.Rmd | 3 +--
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/cran-comments.md b/cran-comments.md
index 5685e60..ff36089 100644
--- a/cran-comments.md
+++ b/cran-comments.md
@@ -1,6 +1,7 @@
 ## Test environments
 * local Linux install (R-3.4.4; #135-Ubuntu SMP Fri Jan 19 11:48:36 UTC 2018)
 * remote Linux install (R-3.4.2; ubuntu 4.8.4-2ubuntu1~14.04.3)
+* local Windows install (R 3.5.0)
 * win-builder (release R 3.5.0)
 * win-builder (2018-05-05 r74699)
 
diff --git a/vignettes/pixiedust.Rmd b/vignettes/pixiedust.Rmd
index 2bae572..47414f1 100644
--- a/vignettes/pixiedust.Rmd
+++ b/vignettes/pixiedust.Rmd
@@ -281,8 +281,7 @@ There is a sprinkle available to rotate the text in a cell. I don't recommend us
 Notice here that when I apply the rotation, I added an argument to `sprinkle` in which I denoted that the rotation should apply to the head of the table.  The head and body of the table are stored separately in the `dust` object and all of the sprinkles may be applied to either part of the table.  
 
 ```{r}
-head(mtcars) %>% 
-  dust() %>%
+dust(Formaldehyde) %>%
   sprinkle(cols = c("mpg", "disp", "drat", "qsec"),
            round = 2) %>%
   sprinkle(rows = 1,

From aa1e7182d4c31ecca384e666319140ba7304ba31 Mon Sep 17 00:00:00 2001
From: Benjamin Nutter <benjamin.nutter@gmail.com>
Date: Fri, 29 Jun 2018 18:19:23 +0000
Subject: [PATCH 4/4] Release code

---
 NEWS             | 5 +++++
 cran-comments.md | 7 +++++--
 2 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/NEWS b/NEWS
index 64e22f3..0baa07e 100644
--- a/NEWS
+++ b/NEWS
@@ -1,3 +1,8 @@
+### 0.8.4 (2018-06-29)
+
+* Added `gaze` function to produce model summaries side-by-side (#80)
+* Small adjustments to work with upcoming version of `broom`.
+
 ### 0.8.3 (2018-03-22)
 
 * Repaired recycling in several sprinkles.  Sprinkles that permit more than 
diff --git a/cran-comments.md b/cran-comments.md
index ff36089..be77f00 100644
--- a/cran-comments.md
+++ b/cran-comments.md
@@ -1,14 +1,17 @@
 ## Test environments
 * local Linux install (R-3.4.4; #135-Ubuntu SMP Fri Jan 19 11:48:36 UTC 2018)
-* remote Linux install (R-3.4.2; ubuntu 4.8.4-2ubuntu1~14.04.3)
+* remote Linux install (R-3.5.0; Ubuntu 14.04.5 LTS, Travis CI)
 * local Windows install (R 3.5.0)
 * win-builder (release R 3.5.0)
-* win-builder (2018-05-05 r74699)
+* win-builder (2018-06-26 r74934)
 
 ## R CMD check results
 This update adjusts for changes coming with a pending update to the `broom`
 package.
 
+There were no warnings, errors, or notes returned by CHECK on any of the 
+test environments.
+
 
 ## Downstream dependencies
 `HydeNet` and `tadaatoolbox` show no warnings, errors, or notes.