Permalink
Browse files

Trim trailing whitespace

  • Loading branch information...
1 parent bb0ac9c commit e2b8eb343cb36ae27a9257742fe333dac68553b7 @hadley committed Dec 4, 2012
Showing with 165 additions and 165 deletions.
  1. +35 −35 R/cast.r
  2. +22 −22 R/data.r
  3. +9 −9 R/formula.r
  4. +4 −4 R/helper-colsplit.r
  5. +4 −4 R/helper-guess-value.r
  6. +11 −11 R/helper-margins.r
  7. +26 −26 R/melt.r
  8. +3 −3 R/recast.r
  9. +6 −6 bench/bench.r
  10. BIN bench/dialects.csv.bz2
  11. +31 −31 inst/tests/test-cast.r
  12. +3 −3 inst/tests/test-margins.r
  13. +10 −10 inst/tests/test-melt.r
  14. +1 −1 tests/test-all.R
View
@@ -1,16 +1,16 @@
#' Cast functions
#' Cast a molten data frame into an array or data frame.
#'
-#' Use \code{acast} or \code{dcast} depending on whether you want
-#' vector/matrix/array output or data frame output. Data frames can have at
+#' Use \code{acast} or \code{dcast} depending on whether you want
+#' vector/matrix/array output or data frame output. Data frames can have at
#' most two dimensions.
#'
-#' The cast formula has the following format:
+#' The cast formula has the following format:
#' \code{x_variable + x_2 ~ y_variable + y_2 ~ z_variable ~ ... }
#' The order of the variables makes a difference. The first varies slowest,
#' and the last fastest. There are a couple of special variables: "..."
-#' represents all other variables not used in the formula and "." represents
-#' no variable, so you can do \code{formula = var1 ~ .}.
+#' represents all other variables not used in the formula and "." represents
+#' no variable, so you can do \code{formula = var1 ~ .}.
#'
#' Alternatively, you can supply a list of quoted expressions, in the form
#' \code{list(.(x_variable, x_2), .(y_variable, y_2), .(z))}. The advantage
@@ -30,7 +30,7 @@
#' @keywords manip
#' @param data molten data frame, see \code{\link{melt}}.
#' @param formula casting formula, see details for specifics.
-#' @param fun.aggregate aggregation function needed if variables do not
+#' @param fun.aggregate aggregation function needed if variables do not
#' identify a single observation for each output cell. Defaults to length
#' (with a message) if needed but not specified.
#' @param ... further arguments are passed to aggregating function
@@ -54,7 +54,7 @@
#' #Air quality example
#' names(airquality) <- tolower(names(airquality))
#' aqm <- melt(airquality, id=c("month", "day"), na.rm=TRUE)
-#'
+#'
#' acast(aqm, day ~ month ~ variable)
#' acast(aqm, month ~ variable, mean)
#' acast(aqm, month ~ variable, mean, margins = TRUE)
@@ -67,27 +67,27 @@
#' #Chick weight example
#' names(ChickWeight) <- tolower(names(ChickWeight))
#' chick_m <- melt(ChickWeight, id=2:4, na.rm=TRUE)
-#'
+#'
#' dcast(chick_m, time ~ variable, mean) # average effect of time
#' dcast(chick_m, diet ~ variable, mean) # average effect of diet
#' acast(chick_m, diet ~ time, mean) # average effect of diet & time
-#'
+#'
#' # How many chicks at each time? - checking for balance
#' acast(chick_m, time ~ diet, length)
#' acast(chick_m, chick ~ time, mean)
#' acast(chick_m, chick ~ time, mean, subset = .(time < 10 & chick < 20))
-#'
+#'
#' acast(chick_m, time ~ diet, length)
-#'
+#'
#' dcast(chick_m, diet + chick ~ time)
#' acast(chick_m, diet + chick ~ time)
#' acast(chick_m, chick ~ time ~ diet)
#' acast(chick_m, diet + chick ~ time, length, margins="diet")
#' acast(chick_m, diet + chick ~ time, length, drop = FALSE)
-#'
+#'
#' #Tips example
#' dcast(melt(tips), sex ~ smoker, mean, subset = .(variable == "total_bill"))
-#'
+#'
#' ff_d <- melt(french_fries, id=1:4, na.rm=TRUE)
#' acast(ff_d, subject ~ time, length)
#' acast(ff_d, subject ~ time, length, fill=0)
@@ -97,53 +97,53 @@
NULL
cast <- function(data, formula, fun.aggregate = NULL, ..., subset = NULL, fill = NULL, drop = TRUE, value.var = guess_value(data)) {
-
+
if (!is.null(subset)) {
include <- data.frame(eval.quoted(subset, data))
data <- data[rowSums(include) == ncol(include), ]
}
-
+
formula <- parse_formula(formula, names(data), value.var)
value <- data[[value.var]]
-
+
# Need to branch here depending on whether or not we have strings or
# expressions - strings should avoid making copies of the data
vars <- lapply(formula, eval.quoted, envir = data, enclos = parent.frame(2))
-
+
# Compute labels and id values
ids <- lapply(vars, id, drop = drop)
labels <- mapply(split_labels, vars, ids, MoreArgs = list(drop = drop),
SIMPLIFY = FALSE, USE.NAMES = FALSE)
overall <- id(rev(ids), drop = FALSE)
-
+
ns <- vapply(ids, attr, 0, "n")
n <- attr(overall, "n")
-
+
# Aggregate duplicates
if (any(duplicated(overall)) || !is.null(fun.aggregate)) {
if (is.null(fun.aggregate)) {
message("Aggregation function missing: defaulting to length")
fun.aggregate <- length
}
-
- ordered <- vaggregate(.value = value, .group = overall,
+
+ ordered <- vaggregate(.value = value, .group = overall,
.fun = fun.aggregate, ..., .default = fill, .n = n)
overall <- seq_len(n)
-
+
} else {
# Add in missing values, if necessary
if (length(overall) < n) {
overall <- match(seq_len(n), overall, nomatch = NA)
} else {
overall <- order(overall)
- }
-
+ }
+
ordered <- value[overall]
if (!is.null(fill)) {
ordered[is.na(ordered)] <- fill
}
}
-
+
list(
data = structure(ordered, dim = ns),
labels = labels
@@ -156,33 +156,33 @@ dcast <- function(data, formula, fun.aggregate = NULL, ..., margins = NULL, subs
if (length(formula) > 2) {
stop("Dataframes have at most two output dimensions")
}
-
+
if (!is.null(margins)) {
data <- add_margins(data, lapply(formula, names), margins)
}
-
- res <- cast(data, formula, fun.aggregate, ...,
- subset = subset, fill = fill, drop = drop,
+
+ res <- cast(data, formula, fun.aggregate, ...,
+ subset = subset, fill = fill, drop = drop,
value.var = value.var)
data <- as.data.frame.matrix(res$data, stringsAsFactors = FALSE)
names(data) <- array_names(res$labels[[2]])
-
+
stopifnot(nrow(res$labels[[1]]) == nrow(data))
cbind(res$labels[[1]], data)
}
acast <- function(data, formula, fun.aggregate = NULL, ..., margins = NULL, subset = NULL, fill=NULL, drop = TRUE, value.var = guess_value(data)) {
formula <- parse_formula(formula, names(data), value.var)
-
+
if (!is.null(margins)) {
- data <- add_margins(data, lapply(formula, names), margins)
+ data <- add_margins(data, lapply(formula, names), margins)
}
-
- res <- cast(data, formula, fun.aggregate, ...,
+
+ res <- cast(data, formula, fun.aggregate, ...,
subset = subset, fill = fill, drop = drop, value.var = value.var)
-
+
dimnames(res$data) <- lapply(res$labels, array_names)
res$data
}
View
@@ -3,21 +3,21 @@
#' This data was collected from a sensory experiment conducted at Iowa State
#' University in 2004. The investigators were interested in the effect of
#' using three different fryer oils had on the taste of the fries.
-#'
+#'
#' Variables:
-#'
+#'
#' \itemize{
#' \item time in weeks from start of study.
-#' \item treatment (type of oil),
-#' \item subject,
-#' \item replicate,
-#' \item potato-y flavour,
-#' \item buttery flavour,
+#' \item treatment (type of oil),
+#' \item subject,
+#' \item replicate,
+#' \item potato-y flavour,
+#' \item buttery flavour,
#' \item grassy flavour,
#' \item rancid flavour,
-#' \item painty flavour
+#' \item painty flavour
#' }
-#'
+#'
#' @docType data
#' @name french_fries
#' @usage data(french_fries)
@@ -39,22 +39,22 @@ NULL
#' Tipping data
-#'
-#'
-#' One waiter recorded information about each tip he received over a
+#'
+#'
+#' One waiter recorded information about each tip he received over a
#' period of a few months working in one restaurant. He collected several
-#' variables:
-#'
+#' variables:
+#'
#' \itemize{
-#' \item tip in dollars,
-#' \item bill in dollars,
-#' \item sex of the bill payer,
-#' \item whether there were smokers in the party,
-#' \item day of the week,
-#' \item time of day,
-#' \item size of the party.
+#' \item tip in dollars,
+#' \item bill in dollars,
+#' \item sex of the bill payer,
+#' \item whether there were smokers in the party,
+#' \item day of the week,
+#' \item time of day,
+#' \item size of the party.
#' }
-#'
+#'
#' In all he recorded 244 tips. The data was reported in a collection of
#' case studies for business statistics (Bryant & Smith 1995).
#'
View
@@ -1,12 +1,12 @@
#' Parse casting formulae.
-#'
+#'
#' There are a two ways to specify a casting formula: either as a string, or
#' a list of quoted variables. This function converts the former to the
-#' latter.
-#'
+#' latter.
+#'
#' Casting formulas separate dimensions with \code{~} and variables within
-#' a dimension with \code{+} or \code{*}. \code{.} can be used as a
-#' placeholder, and \code{...} represents all other variables not otherwise
+#' a dimension with \code{+} or \code{*}. \code{.} can be used as a
+#' placeholder, and \code{...} represents all other variables not otherwise
#' used.
#'
#' @param formula formula to parse
@@ -21,11 +21,11 @@ parse_formula <- function(formula = "... ~ variable", varnames, value.var = "va
replace.remainder <- function(x) {
if (any(x == "...")) c(x[x != "..."], remainder) else x
}
-
+
if (is.formula(formula)) {
formula <- str_c(deparse(formula, 500), collapse = "")
}
-
+
if (is.character(formula)) {
dims <- str_split(formula, fixed("~"))[[1]]
formula <- lapply(str_split(dims, "[+*]"), str_trim)
@@ -38,10 +38,10 @@ parse_formula <- function(formula = "... ~ variable", varnames, value.var = "va
formula <- lapply(formula, replace.remainder)
}
}
-
+
if (!is.list(formula)) {
stop("Don't know how to parse", formula, call. = FALSE)
}
-
+
lapply(formula, as.quoted)
}
View
@@ -1,9 +1,9 @@
#' Split a vector into multiple columns
-#'
-#' Useful for splitting variable names that a combination of multiple
+#'
+#' Useful for splitting variable names that a combination of multiple
#' variables. Uses \code{\link{type.convert}} to convert each column to
#' correct type, but will not convert character to factor.
-#'
+#'
#' @param string character vector or factor to split up
#' @param pattern regular expression to split on
#' @param names names for output columns
@@ -20,7 +20,7 @@ colsplit <- function(string, pattern, names) {
df <- data.frame(alply(vars, 2, type.convert, as.is = TRUE),
stringsAsFactors = FALSE)
names(df) <- names
-
+
df
}
View
@@ -1,19 +1,19 @@
#' Guess name of value column
-#'
+#'
#' Strategy:
#' \enumerate{
#' \item Is value or (all) column present? If so, use that
#' \item Otherwise, guess that last column is the value column
#' }
-#'
+#'
#' @param df data frame to guess value column from
#' @keywords internal
guess_value <- function(df) {
if ("value" %in% names(df)) return("value")
if ("(all)" %in% names(df)) return("(all)")
-
+
last <- names(df)[ncol(df)]
message("Using ", last, " as value column: use value.var to override.")
-
+
last
}
Oops, something went wrong.

0 comments on commit e2b8eb3

Please sign in to comment.