#' Display Data
#'
#' Display the contents of an object by pages.
#'
#' @param x any valid object, generally a data frame, matrix, or table.
#' @param n a positive integer indicating how many lines to print for a page.
#' @param \dots additional arguments to be passed to methods for \code{head} or
#'\code{tail}.
#'
#' @return The object \code{x} is returned invisibly. Sections of \code{x} of
#'length \code{n} are displayed during the execution of the function.
#'
#' @note The function \code{more} is intended for interactive sessions. If used
#'in a non-interactive session, it simply returns \code{x} invisibly.
#'
#'Several keyboard commands can be used to view the contents of \code{x}. The
#'function \code{more} will display \code{n} lines of \code{x} and wait for
#'user input. Any of the following commands can be entered by the user;
#'either upper- or lowercase letters are accepted.
#'
#'\code{q} Quit
#'
#'\code{t} Go to top of \code{x}
#'
#'\code{b} Go to bottom of \code{x}
#'
#'\code{u} Go up 1/2 page
#'
#'\code{p} Go to previous page
#'
#'\code{d} Go down 1/2 page
#'
#'\code{colName/pattern} Search for pattern in the column named colName
#'
#'\code{h} or \code{?} Print help
#'
#'\code{any other letter} Go down full page
#'
#'Searching for a pattern in a column uses \code{grep} to search for the
#'specified pattern in the character representation of the data in the column.
#'This makes it possible to search columns that are not type character.
#' @seealso
#Flip for production/manual
#'\code{\link[utils]{head}}, \code{\link[utils]{tail}}, \code{\link[base]{grep}}
#\code{head} and \code{tail} (both in utils package), \code{grep} (in base package)
#' @keywords print
#' @export
more <- function(x, n=20L, ...) {
if(!interactive())
return(invisible(x))
## OK, show parts of the object
cur <- 0L
ck <- ""
skip <- FALSE
while(!(ck %in% c("q", "Q"))) {
if(!skip) {
if(cur == 0L) {
print(head(x, n=n, ...))
cur <- n
} else {
print(head(tail(x, n=-cur, ...), n=n, ...))
cur <- cur + n
}
}
skip <- FALSE # get here from help
ck <- readline()
if(nchar(ck) > 1L) {
# Set up to search column
cat("searching...\n")
sep <- regexpr("/", ck)
if(sep < 0) {
cat(ck, " is not understood\n", sep="")
skip <- TRUE
} else {
# Search for pattern in named column
colNm <- substring(ck, 1L, sep-1L)
pat <- substring(ck, sep+1L)
dta <- eval(x)[[colNm]]
if(is.null(dta)) {
cat("Column ", colNm, " not found in dataset\n", sep="")
skip <- TRUE
} else {
dta <- as.character(dta)
pos <- grep(pat, dta)
pos <- pos[pos > cur]
if(length(pos) == 0L) {
cat(pat, " not found in column ", colNm, "\n", sep="")
skip <- TRUE
} else {
# Finally found it, point to line above
cur <- pos[1L] - 1L
}
}
}
} else if(ck %in% c("t", "T")) { # goto top
cur <- 0L
} else if(ck %in% c("b", "B")) { # goto bottom if possible
bottom <- nrow(x)
if(is.null(bottom)) {
cat("Cannot go to the bottom of an object that is not rectangular\n")
} else
cur <- bottom - n + 1L
} else if(ck %in% c("u", "U")) { # go up 1/2 page
cur <- max(0L, cur - as.integer(1.5*n))
} else if(ck %in% c("p", "P")) { # go up full page
cur <- max(0L, cur - 2L*n)
} else if(ck %in% c("d", "D")) { # go down 1/2 page
cur <- max(0L, cur - as.integer(0.5*n))
} else if(ck %in% c("?", "h", "H")) { # help!
cat("Commands:\n",
"t ob T go to the top\n",
"b or B go to the bottom (data frames or matrices only)\n",
"u or U go up 1/2 page\n",
"p or P go up full page\n",
"d or D go down 1/2 page\n",
"col/pat search for string pat in column col",
"?, h, or H Get this help\n",
"q, Q, or <Esc> Quit\n",
"otherwise go down full page", sep="")
skip <- TRUE
}
}
invisible(x)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.