remove print function, out of scope

DESCRIPTION

@@ -32,7 +32,6 @@ Imports:
     clipr,
     curl,
     dplyr (>= 0.7.0),
-    data.table (>= 1.10.0),
     reshape2 (>= 1.4.0),
     xml2 (>= 1.0.0),
     knitr (>= 1.0.0),

NAMESPACE

@@ -15,12 +15,9 @@ S3method(kurtosis,matrix)
 S3method(plot,frequency_tbl)
 S3method(plot,mic)
 S3method(plot,rsi)
-S3method(print,data.table)
 S3method(print,frequency_tbl)
 S3method(print,mic)
 S3method(print,rsi)
-S3method(print,tbl)
-S3method(print,tbl_df)
 S3method(skewness,data.frame)
 S3method(skewness,default)
 S3method(skewness,matrix)
@@ -83,12 +80,9 @@ exportMethods(kurtosis.matrix)
 exportMethods(plot.frequency_tbl)
 exportMethods(plot.mic)
 exportMethods(plot.rsi)
-exportMethods(print.data.table)
 exportMethods(print.frequency_tbl)
 exportMethods(print.mic)
 exportMethods(print.rsi)
-exportMethods(print.tbl)
-exportMethods(print.tbl_df)
 exportMethods(skewness)
 exportMethods(skewness.data.frame)
 exportMethods(skewness.default)
@@ -99,7 +93,6 @@ importFrom(broom,tidy)
 importFrom(clipr,read_clip_tbl)
 importFrom(clipr,write_clip)
 importFrom(curl,nslookup)
-importFrom(data.table,data.table)
 importFrom(dplyr,"%>%")
 importFrom(dplyr,all_vars)
 importFrom(dplyr,any_vars)
@@ -112,14 +105,11 @@ importFrom(dplyr,filter)
 importFrom(dplyr,filter_at)
 importFrom(dplyr,group_by)
 importFrom(dplyr,group_by_at)
-importFrom(dplyr,group_size)
-importFrom(dplyr,group_vars)
 importFrom(dplyr,if_else)
 importFrom(dplyr,lag)
 importFrom(dplyr,left_join)
 importFrom(dplyr,mutate)
 importFrom(dplyr,n_distinct)
-importFrom(dplyr,n_groups)
 importFrom(dplyr,progress_estimated)
 importFrom(dplyr,pull)
 importFrom(dplyr,row_number)

NEWS.md

@@ -21,6 +21,7 @@ ratio(c(772, 1611, 737), ratio = "1:2:1")
 * Functions `clipboard_import` and `clipboard_export` as helper functions to quickly copy and paste from/to software like Excel and SPSS
 
 #### Changed
+* Pretty printing for tibbles removed as it is not really the scope of this package
 * `%like%` now supports multiple patterns
 * Frequency tables are now actual `data.frame`s with altered console printing to make it look like a frequency table. Because of this, the parameter `toConsole` is not longer needed.
 * Small translational improvements to the `septic_patients` dataset
@@ -34,7 +35,6 @@ ratio(c(772, 1611, 737), ratio = "1:2:1")
 * Improved `first_isolate` algorithm to exclude isolates where bacteria ID or genus is unavailable
 * Fix for warning *hybrid evaluation forced for row_number* ([`924b62`](https://github.com/tidyverse/dplyr/commit/924b62)) from the `dplyr` package v0.7.5 and above
 * Support for 1 or 2 columns as input for `guess_bactid`
-* Fix for printing tibbles where characters would be accidentally transformed to factors
 
 #### Other
 * Unit testing for R 3.0 and the latest available release: https://travis-ci.org/msberends/AMR

R/print.R

@@ -1,352 +0,0 @@
-# ==================================================================== #
-# TITLE                                                                #
-# Antimicrobial Resistance (AMR) Analysis                              #
-#                                                                      #
-# AUTHORS                                                              #
-# Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl)           #
-#                                                                      #
-# LICENCE                                                              #
-# This program is free software; you can redistribute it and/or modify #
-# it under the terms of the GNU General Public License version 2.0,    #
-# as published by the Free Software Foundation.                        #
-#                                                                      #
-# This program is distributed in the hope that it will be useful,      #
-# but WITHOUT ANY WARRANTY; without even the implied warranty of       #
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the        #
-# GNU General Public License for more details.                         #
-# ==================================================================== #
-
-#' Printing Data Tables and Tibbles
-#'
-#' Print a data table or tibble. It prints: \cr- The \strong{first and last rows} like \code{data.table}s are printed by the \code{data.table} package,\cr- A \strong{header} and \strong{left aligned text} like \code{tibble}s are printed by the \code{tibble} package with info about grouped variables,\cr- \strong{Unchanged values} and \strong{support for row names} like \code{data.frame}s are printed by the \code{base} package.
-#' @inheritParams base::print.data.frame
-#' @param nmax amount of rows to print in total. When the total amount of rows exceeds this limit, the first and last \code{nmax / 2} rows will be printed. Use \code{nmax = NA} to print all rows.
-#' @param header print header with information about data size and tibble grouping
-#' @param print.keys print keys for \code{data.table}
-#' @param na value to print instead of NA
-#' @param width amount of white spaces to keep between columns, must be at least 1
-#' @rdname print
-#' @name print
-#' @importFrom dplyr %>% n_groups group_vars group_size filter pull select
-#' @importFrom data.table data.table
-#' @importFrom utils object.size
-#' @exportMethod print.tbl_df
-#' @export
-#' @examples
-#' # more reliable data view:
-#' library(dplyr)
-#' starwars
-#' print(starwars, width = 3)
-#'
-#' # This is how the tibble package prints since v1.4.0:
-#' # (mind the quite unfamiliar underscores and ending dots)
-#' tibble(now_what = c(1.2345, 2345.67, 321.456)) %>% tibble:::print.tbl_df()
-#'
-#' # This is how this AMR package prints:
-#' # (every number shown as you would expect)
-#' tibble(now_what = c(1.2345, 2345.67, 321.456))
-#'
-#' # also supports info about groups (look at header)
-#' starwars %>% group_by(homeworld, gender)
-print.tbl_df <- function(x,
-                         nmax = 10,
-                         header = TRUE,
-                         row.names = TRUE,
-                         right = FALSE,
-                         width = 1,
-                         na = "<NA>",
-                         ...) {
-  prettyprint_df(x = x,
-                 nmax = nmax,
-                 header = header,
-                 row.names = row.names,
-                 print.keys = FALSE,
-                 right = right,
-                 width = width,
-                 na = na,
-                 ...)
-}
-
-#' @rdname print
-#' @exportMethod print.tbl
-#' @export
-print.tbl <- function(x, ...) {
-  prettyprint_df(x, ...)
-}
-
-#' @rdname print
-#' @exportMethod print.data.table
-#' @export
-print.data.table <- function(x,
-                             print.keys = FALSE,
-                             ...) {
-  prettyprint_df(x = x,
-                 print.keys = print.keys,
-                 ...)
-}
-
-printDT <- data.table:::print.data.table
-prettyprint_df <- function(x,
-                           nmax = 10,
-                           header = TRUE,
-                           row.names = TRUE,
-                           print.keys = FALSE,
-                           right = FALSE,
-                           width = 1,
-                           na = "<NA>",
-                           ...) {
-
-  ansi_reset <- "\u001B[0m"
-  ansi_black <- "\u001B[30m"
-  ansi_red <- "\u001B[31m"
-  ansi_green <- "\u001B[32m"
-  ansi_yellow <- "\u001B[33m"
-  ansi_blue <- "\u001B[34m"
-  ansi_purple <- "\u001B[35m"
-  ansi_cyan <- "\u001B[36m"
-  ansi_white <- "\u001B[37m"
-  ansi_gray <- "\u001B[38;5;246m"
-
-  if (width < 1) {
-    stop('`width` must be at least 1.', call. = FALSE)
-  }
-
-  if (is.na(nmax)) {
-    nmax <- NROW(x)
-  }
-  n <- nmax
-  if (n %% 2 == 1) {
-    # odd number; add 1
-    n <- n + 1
-  }
-
-  width <- width - 1
-
-  if ('tbl_df' %in% class(x)) {
-    type <- 'tibble'
-  } else if ('data.table' %in% class(x)) {
-    type <- 'data.table'
-  } else {
-    type <- 'data.frame'
-  }
-
-  if (header == TRUE) {
-    if (NCOL(x) == 1) {
-      vars <- 'variable'
-    } else {
-      vars <- 'variables'
-    }
-
-    size <- object.size(x) %>% as.double() %>% size_humanreadable()
-
-    cat(paste0("A ", type,": ",
-               format(NROW(x)),
-               " obs. of ",
-               format(NCOL(x)),
-               " ", vars,
-               ansi_gray, " (", size, ")\n", ansi_reset))
-    if ('grouped_df' %in% class(x) & n_groups(x) > 0) {
-      cat(paste0("Grouped by ",
-                 x %>% group_vars() %>% paste0(ansi_red, ., ansi_reset) %>% paste0(collapse = " and "),
-                 ansi_gray,
-                 " (",
-                 x %>% n_groups(),
-                 " groups with sizes between ",
-                 x %>% group_size() %>% min(),
-                 " and ",
-                 x %>% group_size() %>% max(),
-                 ")\n",
-                 ansi_reset))
-    }
-    if (!is.null(attributes(x)$qry)) {
-      cat(paste0(ansi_gray, "This data contains a query. Use qry() to view it.\n", ansi_reset))
-    }
-    cat("\n")
-  }
-
-  # data.table where keys should be printed
-  if (print.keys == TRUE) {
-    printDT(x,
-            class = header,
-            row.names = row.names,
-            print.keys = TRUE,
-            right = right,
-            ...
-    )
-    return(invisible())
-  }
-
-  # tibbles give warning when setting column names
-  x <- x %>% base::as.data.frame(stringsAsFactors = FALSE)
-
-  # extra space of 3 chars, right to row name or number
-  if (NROW(x) > 0) {
-    maxrowchars <- rownames(x) %>% nchar() %>% max() + 3
-    rownames(x) <- paste0(rownames(x), strrep(" ", maxrowchars - nchar(rownames(x))))
-  } else {
-    maxrowchars <- 0
-  }
-
-  x.bak <- x
-
-  if (n + 1 < nrow(x)) {
-    # remove in between part, 1 extra for ~~~~ between first and last part
-    rows_list <- c(1:(n / 2 + 1), (nrow(x) - (n / 2) + 1):nrow(x))
-    x <- as.data.frame(x.bak[rows_list,], stringsAsFactors = FALSE)
-    colnames(x) <- colnames(x.bak)
-    rownames(x) <- rownames(x.bak)[rows_list]
-    # set inbetweener between parts
-    rownames(x)[n / 2 + 1] <- strrep("~", maxrowchars)
-  }
-
-  if (header == TRUE) {
-    # add 1 row for classes
-    # class will be marked up per column
-    if (NROW(x.bak) > 0) {
-      rownames.x <- rownames(x)
-      # suppress warnings because dplyr want us to use library(dplyr) when using filter(row_number())
-      suppressWarnings(
-        x <- x %>%
-          filter(row_number() == 1) %>%
-          rbind(x, stringsAsFactors = FALSE)
-      )
-      rownames(x) <- c('*', rownames.x)
-    }
-
-    # select 1st class per column and abbreviate
-    classes <- x.bak %>%
-      sapply(class) %>%
-      lapply(
-        function(c) {
-          # do print all POSIX classes like "POSct/t"
-          if ('POSIXct' %in% c) {
-            paste0('POS',
-                   c %>%
-                     gsub('POSIX', '', .) %>%
-                     paste0(collapse = '/'))
-          } else {
-            if (NCOL(.) > 1) {
-              .[1, ]
-            } else {
-              c[[1]]
-            }
-          }
-        }) %>%
-      unlist() %>%
-      gsub("character",  "chr", ., fixed = TRUE) %>%
-      gsub("complex",    "cplx", ., fixed = TRUE) %>%
-      gsub("Date",       "Date", ., fixed = TRUE) %>%
-      gsub("double",     "dbl", ., fixed = TRUE) %>%
-      gsub("expression", "expr", ., fixed = TRUE) %>%
-      gsub("factor",     "fct", ., fixed = TRUE) %>%
-      gsub("IDate",      "IDat", ., fixed = TRUE) %>%
-      gsub("integer",    "int", ., fixed = TRUE) %>%
-      gsub("integer64",  "i64", ., fixed = TRUE) %>%
-      gsub("list",       "list", ., fixed = TRUE) %>%
-      gsub("logical",    "lgl", ., fixed = TRUE) %>%
-      gsub("numeric",    "dbl", ., fixed = TRUE) %>%
-      gsub("ordered",    "ord", ., fixed = TRUE) %>%
-      gsub("percent",    "pct", ., fixed = TRUE) %>%
-      gsub("single",     "sgl", ., fixed = TRUE) %>%
-      paste0("<", ., ">")
-  }
-
-  # markup cols
-
-  for (i in 1:ncol(x)) {
-    if (all(!class(x[, i]) %in% class(x.bak[, i]))) {
-      class(x[, i]) <- class(x.bak[, i])
-    }
-    try(x[, i] <- format(x %>% pull(i)), silent = TRUE)
-    # replace NAs
-    if (nchar(na) < 2) {
-      # make as long as the text "NA"
-      na <- paste0(na, strrep(" ", 2 - nchar(na)))
-    }
-    try(x[, i] <- gsub("^NA$", na, trimws(x[, i], 'both')), silent = TRUE)
-    # place class into 1st row
-    if (header == TRUE) {
-      x[1, i] <- classes[i]
-    }
-    # dashes between two parts when exceeding nmax
-    maxvalchars <- max(colnames(x)[i] %>% nchar(), x[, i] %>% nchar() %>% max())
-    if (n + 1 < nrow(x.bak)) {
-      x[n / 2 + if_else(header == TRUE, 2, 1), i] <- strrep("~", maxvalchars)
-    }
-
-    # align according to `right` parameter, but only factors, logicals text, but not MICs
-    if (any(x.bak %>% pull(i) %>% class() %in% c('factor', 'character', 'logical'))
-        & !("mic" %in% (x.bak %>% pull(i) %>% class()))) {
-      vals <- x %>% pull(i) %>% trimws('both')
-      colname <- colnames(x)[i] %>% trimws('both')
-      if (right == FALSE) {
-        vals <- paste0(vals, strrep(" ", maxvalchars - nchar(vals)))
-        colname <- paste0(colname, strrep(" ", maxvalchars - nchar(colname)))
-      } else {
-        vals <- paste0(strrep(" ", maxvalchars - nchar(vals)), vals)
-        colname <- paste0(strrep(" ", maxvalchars - nchar(colname)), colname)
-      }
-      x[, i] <- vals
-      colnames(x)[i] <- colname
-    }
-
-    # add left padding according to `width` parameter
-    # but not in 1st col when row names are off
-    if (row.names == TRUE | i > 1) {
-      x[, i] <- paste0(strrep(" ", width), x[, i])
-      colnames(x)[i] <- paste0(strrep(" ", width), colnames(x)[i])
-    }
-
-    # strip columns that do not fit (width + 2 extra chars as margin)
-    width_console <- options()$width
-    width_until_col <- x %>%
-      select(1:i) %>%
-      apply(1, paste, collapse = strrep(" ", width + 2)) %>%
-      nchar() %>%
-      max()
-    width_until_col_before <- x %>%
-      select(1:(max(i, 2) - 1)) %>%
-      apply(1, paste, collapse = strrep(" ", width + 2)) %>%
-      nchar() %>%
-      max()
-    extraspace <- maxrowchars + nchar(rownames(x)[length(rownames(x))])
-    width_until_colnames <- colnames(x)[1:i] %>% paste0(collapse = strrep(" ", width + 1)) %>% nchar() + extraspace
-    width_until_colnames_before <- colnames(x)[1:(max(i, 2) - 1)] %>% paste0(collapse = strrep(" ", width + 1)) %>% nchar() + extraspace
-
-    if (i > 1 &
-        (width_until_col > width_console
-         | width_until_colnames > width_console)) {
-      if (width_until_col_before > width_console
-          | width_until_colnames_before > width_console) {
-        x <- x[, 1:(i - 2)]
-      } else {
-        x <- x[, 1:(i - 1)]
-      }
-      break
-    }
-  }
-
-  # empty table, row name of header should be "*"
-  if (NROW(x.bak) == 0) {
-    rownames(x) <- '* '
-  }
-
-  # and here it is...
-  suppressWarnings(
-    base::print.data.frame(x, row.names = row.names, ...)
-  )
-
-  # print rest of col names when they were stripped
-  if (ncol(x) < ncol(x.bak)) {
-    x.notshown <- x.bak %>% select((ncol(x) + 1):ncol(x.bak))
-    if (ncol(x.notshown) == 1) {
-      cat('... and 1 more column: ')
-    } else {
-      cat('... and', ncol(x.notshown), 'more columns: ')
-    }
-    cat(x.notshown %>%
-          colnames() %>%
-          paste0(' ', ansi_gray, classes[(ncol(x) + 1):ncol(x.bak)], ansi_reset) %>%
-          paste0(collapse = ", "), '\n')
-  }
-}

man/print.Rd

@@ -1,57 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/print.R
-\name{print}
-\alias{print}
-\alias{print.tbl_df}
-\alias{print.tbl}
-\alias{print.data.table}
-\title{Printing Data Tables and Tibbles}
-\usage{
-\method{print}{tbl_df}(x, nmax = 10, header = TRUE, row.names = TRUE,
-  right = FALSE, width = 1, na = "<NA>", ...)
-
-\method{print}{tbl}(x, ...)
-
-\method{print}{data.table}(x, print.keys = FALSE, ...)
-}
-\arguments{
-\item{x}{object of class \code{data.frame}.}
-
-\item{nmax}{amount of rows to print in total. When the total amount of rows exceeds this limit, the first and last \code{nmax / 2} rows will be printed. Use \code{nmax = NA} to print all rows.}
-
-\item{header}{print header with information about data size and tibble grouping}
-
-\item{row.names}{logical (or character vector), indicating whether (or
-    what) row names should be printed.}
-
-\item{right}{logical, indicating whether or not strings should be
-    right-aligned.  The default is right-alignment.}
-
-\item{width}{amount of white spaces to keep between columns, must be at least 1}
-
-\item{na}{value to print instead of NA}
-
-\item{...}{optional arguments to \code{print} or \code{plot} methods.}
-
-\item{print.keys}{print keys for \code{data.table}}
-}
-\description{
-Print a data table or tibble. It prints: \cr- The \strong{first and last rows} like \code{data.table}s are printed by the \code{data.table} package,\cr- A \strong{header} and \strong{left aligned text} like \code{tibble}s are printed by the \code{tibble} package with info about grouped variables,\cr- \strong{Unchanged values} and \strong{support for row names} like \code{data.frame}s are printed by the \code{base} package.
-}
-\examples{
-# more reliable data view:
-library(dplyr)
-starwars
-print(starwars, width = 3)
-
-# This is how the tibble package prints since v1.4.0:
-# (mind the quite unfamiliar underscores and ending dots)
-tibble(now_what = c(1.2345, 2345.67, 321.456)) \%>\% tibble:::print.tbl_df()
-
-# This is how this AMR package prints:
-# (every number shown as you would expect)
-tibble(now_what = c(1.2345, 2345.67, 321.456))
-
-# also supports info about groups (look at header)
-starwars \%>\% group_by(homeworld, gender)
-}

tests/testthat/test-print.R

@@ -1,11 +0,0 @@
-context("print.R")
-
-
-test_that("tibble printing works", {
-  library(dplyr)
-  library(data.table)
-  expect_output(print(starwars))
-  expect_output(print(starwars %>% group_by(homeworld, gender)))
-  expect_output(print(starwars %>% as.data.table(), print.keys = TRUE))
-  expect_output(print(septic_patients))
-})