print.draws_rvars (for #8)

NAMESPACE

@@ -15,6 +15,7 @@ S3method("variables<-",draws_array)
 S3method("variables<-",draws_df)
 S3method("variables<-",draws_list)
 S3method("variables<-",draws_matrix)
+S3method("variables<-",draws_rvars)
 S3method(Math,rvar)
 S3method(Ops,rvar)
 S3method(Summary,rvar)
@@ -122,6 +123,8 @@ S3method(nchains,draws_array)
 S3method(nchains,draws_df)
 S3method(nchains,draws_list)
 S3method(nchains,draws_matrix)
+S3method(nchains,draws_rvars)
+S3method(nchains,rvar)
 S3method(ndraws,"NULL")
 S3method(ndraws,draws_array)
 S3method(ndraws,draws_df)
@@ -134,11 +137,14 @@ S3method(niterations,draws_array)
 S3method(niterations,draws_df)
 S3method(niterations,draws_list)
 S3method(niterations,draws_matrix)
+S3method(niterations,draws_rvars)
+S3method(niterations,rvar)
 S3method(nvariables,"NULL")
 S3method(nvariables,draws_array)
 S3method(nvariables,draws_df)
 S3method(nvariables,draws_list)
 S3method(nvariables,draws_matrix)
+S3method(nvariables,draws_rvars)
 S3method(order_draws,draws_array)
 S3method(order_draws,draws_df)
 S3method(order_draws,draws_list)
@@ -147,6 +153,7 @@ S3method(print,draws_array)
 S3method(print,draws_df)
 S3method(print,draws_list)
 S3method(print,draws_matrix)
+S3method(print,draws_rvars)
 S3method(print,rvar)
 S3method(quantile,rvar)
 S3method(range,rvar)
@@ -177,6 +184,7 @@ S3method(variables,draws_array)
 S3method(variables,draws_df)
 S3method(variables,draws_list)
 S3method(variables,draws_matrix)
+S3method(variables,draws_rvars)
 S3method(vec_cast,rvar)
 S3method(vec_cast.rvar,default)
 S3method(vec_cast.rvar,double)

R/draws-index.R

@@ -71,6 +71,14 @@ variables.draws_list <- function(x) {
   names(x[[1]])
 }
 
+#' @export
+variables.draws_rvars <- function(x) {
+  if (!length(x)) {
+    return(character(0))
+  }
+  names(x)
+}
+
 #' @rdname draws-index
 #' @export
 `variables<-` <- function(x, value) {
@@ -107,6 +115,13 @@ variables.draws_list <- function(x) {
   x
 }
 
+#' @export
+`variables<-.draws_rvars` <- function(x, value) {
+  check_new_variables(value)
+  names(x) <- value
+  x
+}
+
 #' @rdname draws-index
 #' @export
 iteration_ids <- function(x) {
@@ -243,6 +258,11 @@ nvariables.draws_list <- function(x) {
   length(x[[1]])
 }
 
+#' @export
+nvariables.draws_rvars <- function(x) {
+  length(x)
+}
+
 #' @rdname draws-index
 #' @export
 niterations <- function(x) {
@@ -277,6 +297,16 @@ niterations.draws_list <- function(x) {
   length(x[[1]][[1]])
 }
 
+#' @export
+niterations.rvar <- function(x) {
+  ndraws(x) / nchains(x)
+}
+
+#' @export
+niterations.draws_rvars <- function(x) {
+  if (!length(x)) 0 else niterations(x[[1]])
+}
+
 #' @rdname draws-index
 #' @export
 nchains <- function(x) {
@@ -308,6 +338,17 @@ nchains.draws_list <- function(x) {
   length(x)
 }
 
+#' @export
+nchains.rvar <- function(x) {
+  # TODO: implement
+  1L
+}
+
+#' @export
+nchains.draws_rvars <- function(x) {
+  if (!length(x)) 0 else nchains(x[[1]])
+}
+
 #' @rdname draws-index
 #' @export
 ndraws <- function(x) {
@@ -346,7 +387,7 @@ ndraws.rvar <- function(x) {
 
 #' @export
 ndraws.draws_rvars <- function(x) {
-  ndraws(x[[1]])
+  if (!length(x)) 0 else ndraws(x[[1]])
 }
 
 # check validity of existing variable names: e.g., that

R/print.R

@@ -238,3 +238,54 @@ print.draws_list <- function(x, digits = 2,
   }
   invisible(x)
 }
+
+#' Print `draws_rvars` objects
+#'
+#' Pretty printing for [`draws_rvars`] objects.
+#'
+#' @encoding UTF-8
+#' @template args-methods-x
+#' @template args-print-digits
+#' @template args-print-max_variables
+#' @template args-print-summary
+#' @template args-print-dots
+#' @template return-draws
+#'
+#' @examples
+#' x <- as_draws_rvars(example_draws())
+#' print(x)
+#'
+#' @export
+print.draws_rvars <- function(x,
+  digits = 2,
+  max_variables = getOption("max_variables", 8),
+  summary = getOption("rvar_summary", "mean_sd"),
+  ...
+) {
+  max_variables <- as_one_integer(max_variables)
+  niterations <- niterations(x)
+  nchains <- nchains(x)
+  nvariables <- nvariables(x)
+  header <- paste0(
+    "# A draws_rvars: ", niterations, " iterations, ",
+    nchains, " chains, and ", nvariables, " variables\n"
+  )
+  cat(header)
+
+  sel_variables <- seq_len(min(max_variables, nvariables))
+  y <- x[sel_variables]
+  for (i in seq_along(y)) {
+    cat0("$", names(y)[[i]], ": ")
+    print(y[[i]], summary = summary, digits = digits, ...)
+    cat("\n")
+  }
+
+  more_variables <- nvariables - max_variables
+  if (more_variables > 0) {
+    comment <- paste0(more_variables, " more variables")
+    comment <- paste0("# ... with ", comment, "\n")
+    cat(comment)
+  }
+
+  invisible(x)
+}

R/rvar-print.R

@@ -4,16 +4,15 @@
 #'
 #' @encoding UTF-8
 #' @param x,object An [`rvar`].
+#' @template args-print-digits
+#' @template args-print-summary
+#' @template args-print-dots
 #' @param color Whether or not to use color when formatting the output. If `TRUE`,
 #' the [pillar::style_num()] functions may be used to produce strings containing
 #' control sequences to produce colored output on the terminal.
 #' @param vec.len Numeric (>= 0) indicating how many 'first few' elements are
 #' displayed of each vector. If `NULL`, defaults to `getOption("str")$vec.len`,
 #' which defaults to 4.
-#' @param summary What style of summary to display: `"mean_sd"` displays `mean±sd`,
-#' `"median_mad"` displays `median±mad`. If `NULL`, `getOption("rvar_summary")` is
-#' used (default `"mean_sd`).
-#' @param ... Further arguments passed to other functions.
 #'
 #' @details
 #' `print()` and `str()` print out [`rvar`] objects by summarizing each element
@@ -23,9 +22,11 @@
 #' mean±sd or median±mad form.
 #'
 #' @return
-#' An invisible character vector (for `print()` and `str()`). For `format()`, a
-#' character vector of the same dimensions as `x` where each entry is of the
-#' form mean±sd or median±mad, depending on the value of `summary`.
+#' For `print()` and `str()`, an invisible version of the input object.
+#'
+#' For `format()`, a character vector of the same dimensions as `x` where each
+#' entry is of the form `"mean±sd"` or `"median±mad"`, depending on the value
+#' of `summary`.
 #'
 #' @examples
 #'
@@ -43,19 +44,19 @@
 #' format(x)
 #'
 #' @export
-print.rvar <- function(x, ..., summary = NULL) {
+print.rvar <- function(x, ..., summary = NULL, digits = 2) {
   # \u00b1 = plus/minus sign
   summary_functions <- get_summary_functions(summary)
   summary_string <- paste(summary_functions, collapse = "\u00b1")
   cat0(rvar_type_abbr(x), " ", pillar::style_subtle(paste0(summary_string, ":")), "\n")
-  print(format(x, summary = summary, color = FALSE), quote = FALSE)
+  print(format(x, summary = summary, digits = digits, color = FALSE), quote = FALSE)
   invisible(x)
 }
 
 #' @rdname print.rvar
 #' @export
-format.rvar <- function(x, ..., summary = NULL, color = FALSE) {
-  format_rvar_draws(draws_of(x), ..., summary = summary, color = color)
+format.rvar <- function(x, ..., summary = NULL, digits = 2, color = FALSE) {
+  format_rvar_draws(draws_of(x), ..., summary = summary, digits = digits, color = color)
 }
 
 #' @rdname print.rvar
@@ -112,7 +113,7 @@ rvar_type_abbr <- function(x, dim1 = TRUE) {
 
 # formats a draws array for display as individual "variables" (i.e. maintaining
 # its dimensions except for the dimension representing draws)
-format_rvar_draws <- function(draws, ..., summary = NULL, color = FALSE) {
+format_rvar_draws <- function(draws, ..., summary = NULL, digits = 2, color = FALSE) {
   if (prod(dim(draws)) == 0) {
     # NULL: no draws
     return(NULL)
@@ -124,29 +125,32 @@ format_rvar_draws <- function(draws, ..., summary = NULL, color = FALSE) {
   # these will be mean/sd or median/mad depending on `summary`
   .mean <- apply(draws, summary_dimensions, summary_functions[[1]])
   .sd <- apply(draws, summary_dimensions, summary_functions[[2]])
-  out <- format_mean_sd(.mean, .sd, color = color)
+  out <- format_mean_sd(.mean, .sd, digits = digits, color = color)
 
   dim(out) <- dim(draws)[summary_dimensions]
   dimnames(out) <- dimnames(draws)[summary_dimensions]
   out
 }
 
-format_mean <- function(x, color = FALSE) {
-  format(x, justify = "right", digits = 2, scientific = 2)
+format_mean <- function(x, digits = 2, color = FALSE) {
+  format(x, justify = "right", digits = digits, scientific = 2)
 }
 
-format_sd <- function(x, color = FALSE) {
+format_sd <- function(x, digits = 2, color = FALSE) {
   # \u00b1 = plus/minus sign
-  sd_string <- paste0("\u00b1", format(x, justify = "left", trim = TRUE, digits = 2, scientific = 2))
+  sd_string <- paste0("\u00b1", format(x, justify = "left", trim = TRUE, digits = digits, scientific = 2))
   if (color) {
     pillar::style_subtle(sd_string)
   } else {
     sd_string
   }
 }
 
-format_mean_sd <- function(.mean, .sd, color = FALSE) {
-  format(paste0(format_mean(.mean, color = color), format_sd(.sd, color = color)), justify = "left")
+format_mean_sd <- function(.mean, .sd, digits = 2, color = FALSE) {
+  format(paste0(
+    format_mean(.mean, digits = digits, color = color),
+    format_sd(.sd, digits = digits, color = color)),
+  justify = "left")
 }
 
 # check that summary is a valid name of the type of summary to do and

man-roxygen/args-print-summary.R

@@ -0,0 +1,3 @@
+#' @param summary What style of summary to display: `"mean_sd"` displays `mean±sd`,
+#' `"median_mad"` displays `median±mad`. If `NULL`, `getOption("rvar_summary")` is
+#' used (default `"mean_sd`).