New as.table.tbl_cube() (tidyverse#1889)

* implement as.table.tbl_cube()

* document

* add test

NAMESPACE

@@ -17,6 +17,7 @@ S3method(as.data.frame,tbl_sql)
 S3method(as.fun_list,"function")
 S3method(as.fun_list,character)
 S3method(as.fun_list,fun_list)
+S3method(as.table,tbl_cube)
 S3method(as.tbl,data.frame)
 S3method(as.tbl,tbl)
 S3method(as.tbl_cube,array)

R/tbl-cube.r

@@ -142,6 +142,25 @@ print.tbl_cube <- function(x, ...) {
   invisible(x)
 }
 
+# Coercion methods (from tbl_cube) ---------------------------------------------
+
+#' Coerce a \code{tbl_cube} to other data structures
+#'
+#' Supports conversion to tables, data frames, tibbles.
+#'
+#' @param x a \code{tbl_cube}
+#' @param ... Passed on to individual methods; otherwise ignored.
+#' @param measure A measure name or index, default: the first measure
+#' @name as.table.tbl_cube
+#' @export
+as.table.tbl_cube <- function(x, ..., measure = 1L) {
+  ret <- x$mets[[measure]]
+  dimnames(ret) <- x$dims
+  class(ret) <- "table"
+  ret
+}
+
+#' @rdname as.table.tbl_cube
 #' @export
 as.data.frame.tbl_cube <- function(x, ...) {
   dims <- expand.grid(x$dims, KEEP.OUT.ATTRS = FALSE, ...)
@@ -154,12 +173,12 @@ as.data.frame.tbl_cube <- function(x, ...) {
   all
 }
 
-#' @export
-#' @rdname tbl_cube
-#' @details For a cube, the data frame returned by
+
+#' @rdname as.table.tbl_cube
+#' @description For a cube, the data frame returned by
 #'   \code{\link[tibble]{as_data_frame}} resulting data frame contains the
 #'   dimensions as character values (and not as factors).
-#' @inheritParams tibble::as_data_frame
+#' @export
 as_data_frame.tbl_cube <- function(x, ...) {
   as_data_frame(as.data.frame(x, ..., stringsAsFactors = FALSE))
 }

tests/testthat/test-tbl-cube.R

@@ -53,3 +53,11 @@ test_that("can coerce to data_frame", {
   expect_identical(tbl_df(as.data.frame(slice, stringsAsFactors = FALSE)),
                    as_data_frame(slice))
 })
+
+test_that("can coerce to table", {
+  expect_is(as.table(nasa), "table")
+  expect_equal(length(dim(as.table(nasa))), 4L)
+  expect_equal(dimnames(as.table(nasa)), lapply(nasa$dims, as.character))
+  expect_equal(as.vector(as.table(nasa)), as.vector(nasa$mets[[1]]))
+  expect_identical(as.table(nasa, measure = "ozone"), as.table(select(nasa, ozone)))
+})