Permalink
Browse files

Move functions into own files

  • Loading branch information...
1 parent fbd7ba1 commit 3ee18e5833238986eacacb676302a687532fbbee @hadley committed Oct 11, 2012
Showing with 549 additions and 554 deletions.
  1. +21 −7 DESCRIPTION
  2. +15 −0 R/a_ply.r
  3. +37 −0 R/aaply.r
  4. +15 −0 R/adply.r
  5. +19 −0 R/alply.r
  6. +16 −0 R/d_ply.r
  7. +40 −0 R/daply.r
  8. +2 −35 R/{ply-data-frame.r → ddply.r}
  9. +28 −0 R/dlply.r
  10. +35 −0 R/l_ply.r
  11. +31 −0 R/laply.r
  12. 0 R/{ply-iterator.r → liply.r}
  13. +0 −49 R/{ply-list.r → llply.r}
  14. +16 −0 R/lply.r
  15. +17 −0 R/m_ply.r
  16. +22 −0 R/maply.r
  17. +21 −0 R/mdply.r
  18. +23 −0 R/mlply.r
  19. +0 −111 R/ply-array.r
  20. +0 −94 R/ply-mapply.r
  21. +0 −68 R/ply-null.r
  22. +0 −160 R/ply-replicate.r
  23. +38 −0 R/r_ply.r
  24. +41 −0 R/raply.r
  25. +35 −0 R/rdply.r
  26. +42 −0 R/rlply.r
  27. +8 −0 R/utils.r
  28. +5 −5 man/adply.Rd
  29. +5 −5 man/alply.Rd
  30. +5 −5 man/ddply.Rd
  31. +3 −3 man/dlply.Rd
  32. +3 −4 man/laply.Rd
  33. +3 −4 man/ldply.Rd
  34. +3 −4 man/llply.Rd
View
@@ -50,13 +50,6 @@ Collate:
'indexed.r'
'join.r'
'loop-apply.r'
- 'ply-array.r'
- 'ply-data-frame.r'
- 'ply-iterator.r'
- 'ply-list.r'
- 'ply-mapply.r'
- 'ply-null.r'
- 'ply-replicate.r'
'progress.r'
'quote.r'
'rbind-matrix.r'
@@ -80,3 +73,24 @@ Collate:
'progress-time.r'
'helper-name-rows.r'
'helper-here.r'
+ 'a_ply.r'
+ 'aaply.r'
+ 'adply.r'
+ 'alply.r'
+ 'd_ply.r'
+ 'daply.r'
+ 'ddply.r'
+ 'dlply.r'
+ 'l_ply.r'
+ 'laply.r'
+ 'llply.r'
+ 'lply.r'
+ 'm_ply.r'
+ 'maply.r'
+ 'mdply.r'
+ 'mlply.r'
+ 'r_ply.r'
+ 'raply.r'
+ 'rdply.r'
+ 'rlply.r'
+ 'liply.r'
View
@@ -0,0 +1,15 @@
+#' Split array, apply function, and discard results.
+#'
+#' For each slice of an array, apply function and discard results
+#'
+#' @template ply
+#' @template a-
+#' @template -_
+#' @export
+a_ply <- function(.data, .margins, .fun = NULL, ..., .expand = TRUE,
+ .progress = "none", .print = FALSE, .parallel = FALSE) {
+ pieces <- splitter_a(.data, .margins, .expand)
+
+ l_ply(.data = pieces, .fun = .fun, ...,
+ .progress = .progress, .print = .print, .parallel = .parallel)
+}
View
@@ -0,0 +1,37 @@
+#' Split array, apply function, and return results in an array.
+#'
+#' For each slice of an array, apply function, keeping results as an array.
+#' This function is very similar to \code{\link{apply}}, except that it will
+#' always return an array, and when the function returns >1 d data structures,
+#' those dimensions are added on to the highest dimensions, rather than the
+#' lowest dimensions. This makes \code{aaply} idempotent, so that
+#' \code{apply(input, X, identity)} is equivalent to \code{aperm(input, X)}.
+#'
+#' @template ply
+#' @template a-
+#' @template -a
+#' @export
+#' @examples
+#' dim(ozone)
+#' aaply(ozone, 1, mean)
+#' aaply(ozone, 1, mean, .drop = FALSE)
+#' aaply(ozone, 3, mean)
+#' aaply(ozone, c(1,2), mean)
+#'
+#' dim(aaply(ozone, c(1,2), mean))
+#' dim(aaply(ozone, c(1,2), mean, .drop = FALSE))
+#'
+#' aaply(ozone, 1, each(min, max))
+#' aaply(ozone, 3, each(min, max))
+#'
+#' standardise <- function(x) (x - min(x)) / (max(x) - min(x))
+#' aaply(ozone, 3, standardise)
+#' aaply(ozone, 1:2, standardise)
+#'
+#' aaply(ozone, 1:2, diff)
+aaply <- function(.data, .margins, .fun = NULL, ..., .expand = TRUE, .progress = "none", .drop = TRUE, .parallel = FALSE) {
+ pieces <- splitter_a(.data, .margins, .expand)
+
+ laply(.data = pieces, .fun = .fun, ...,
+ .progress = .progress, .drop = .drop, .parallel = .parallel)
+}
View
@@ -0,0 +1,15 @@
+#' Split array, apply function, and return results in a data frame.
+#'
+#' For each slice of an array, apply function then combine results into a data
+#' frame.
+#'
+#' @template ply
+#' @template a-
+#' @template -d
+#' @export
+adply <- function(.data, .margins, .fun = NULL, ..., .expand = TRUE, .progress = "none", .parallel = FALSE) {
+ pieces <- splitter_a(.data, .margins, .expand)
+
+ ldply(.data = pieces, .fun = .fun, ...,
+ .progress = .progress, .parallel = .parallel)
+}
View
@@ -0,0 +1,19 @@
+#' Split array, apply function, and return results in a list.
+#'
+#' For each slice of an array, apply function then combine results into a
+#' list. \code{alply} is somewhat similar to \code{\link{apply}} for cases
+#' where the results are not atomic.
+#'
+#' @template ply
+#' @template a-
+#' @template -l
+#' @export
+#' @examples
+#' alply(ozone, 3, quantile)
+#' alply(ozone, 3, function(x) table(round(x)))
+alply <- function(.data, .margins, .fun = NULL, ..., .expand = TRUE, .progress = "none", .parallel = FALSE) {
+ pieces <- splitter_a(.data, .margins, .expand)
+
+ llply(.data = pieces, .fun = .fun, ...,
+ .progress = .progress, .parallel = .parallel)
+}
View
@@ -0,0 +1,16 @@
+#' Split data frame, apply function, and discard results.
+#'
+#' For each subset of a data frame, apply function and discard results
+#'
+#' @template ply
+#' @template d-
+#' @template -_
+#' @export
+d_ply <- function(.data, .variables, .fun = NULL, ..., .progress = "none",
+ .drop = TRUE, .print = FALSE, .parallel = FALSE) {
+ .variables <- as.quoted(.variables)
+ pieces <- splitter_d(.data, .variables, .drop = .drop)
+
+ l_ply(.data = pieces, .fun = .fun, ...,
+ .progress = .progress, .print = .print, .parallel = .parallel)
+}
View
@@ -0,0 +1,40 @@
+#' Split data frame, apply function, and return results in an array.
+#'
+#' For each subset of data frame, apply function then combine results into
+#' an array. \code{daply} with a function that operates column-wise is
+#' similar to \code{\link{aggregate}}.
+#'
+#' @template ply
+#' @section Input: This function splits data frames by variables.
+#' @section Output:
+#' If there are no results, then this function will return a vector of
+#' length 0 (\code{vector()}).
+#' @param .data data frame to be processed
+#' @param .variables variables to split data frame by, as quoted
+#' variables, a formula or character vector
+#' @param .drop_i should combinations of variables that do not appear in the
+#' input data be preserved (FALSE) or dropped (TRUE, default)
+#' @return if results are atomic with same type and dimensionality, a
+#' vector, matrix or array; otherwise, a list-array (a list with
+#' dimensions)
+#' @param .drop_o should extra dimensions of length 1 in the output be
+#' dropped, simplifying the output. Defaults to \code{TRUE}
+#' @family array output
+#' @family data frame input
+#' @export
+#' @examples
+#' daply(baseball, .(year), nrow)
+#'
+#' # Several different ways of summarising by variables that should not be
+#' # included in the summary
+#'
+#' daply(baseball[, c(2, 6:9)], .(year), colwise(mean))
+#' daply(baseball[, 6:9], .(baseball$year), colwise(mean))
+#' daply(baseball, .(year), function(df) colwise(mean)(df[, 6:9]))
+daply <- function(.data, .variables, .fun = NULL, ..., .progress = "none", .drop_i = TRUE, .drop_o = TRUE, .parallel = FALSE) {
+ .variables <- as.quoted(.variables)
+ pieces <- splitter_d(.data, .variables, drop = .drop_i)
+
+ laply(.data = pieces, .fun = .fun, ...,
+ .progress = .progress, .drop = .drop_o, .parallel = .parallel)
+}
@@ -1,20 +1,3 @@
-#' Split list, apply function, and return results in a data frame.
-#'
-#' For each element of a list, apply function then combine results into a data
-#' frame.
-#'
-#' @template ply
-#' @template l-
-#' @template -d
-#' @export
-ldply <- function(.data, .fun = NULL, ..., .progress = "none", .parallel = FALSE) {
- if (!inherits(.data, "split")) .data <- as.list(.data)
- res <- llply(.data = .data, .fun = .fun, ...,
- .progress = .progress, .parallel = .parallel)
-
- list_to_dataframe(res, attr(.data, "split_labels"))
-}
-
#' Split data frame, apply function, and return results in a data frame.
#'
#' For each subset of a data frame, apply function then combine results into a
@@ -36,8 +19,8 @@ ldply <- function(.data, .fun = NULL, ..., .progress = "none", .parallel = FALSE
#' # Note the use of the '.' function to allow
#' # group and sex to be used without quoting
#' ddply(dfx, .(group, sex), summarize,
-#' mean <- round(mean(age), 2),
-#' sd <- round(sd(age), 2))
+#' mean <- round(mean(age), 2),
+#' sd <- round(sd(age), 2))
#'
#' # group sex mean sd
#' # 1 A F 35.89 8.53
@@ -71,19 +54,3 @@ ddply <- function(.data, .variables, .fun = NULL, ..., .progress = "none", .drop
ldply(.data = pieces, .fun = .fun, ...,
.progress = .progress, .parallel = .parallel)
}
-
-#' Split array, apply function, and return results in a data frame.
-#'
-#' For each slice of an array, apply function then combine results into a data
-#' frame.
-#'
-#' @template ply
-#' @template a-
-#' @template -d
-#' @export
-adply <- function(.data, .margins, .fun = NULL, ..., .expand = TRUE, .progress = "none", .parallel = FALSE) {
- pieces <- splitter_a(.data, .margins, .expand)
-
- ldply(.data = pieces, .fun = .fun, ...,
- .progress = .progress, .parallel = .parallel)
-}
View
@@ -0,0 +1,28 @@
+#' Split data frame, apply function, and return results in a list.
+#'
+#' For each subset of a data frame, apply function then combine results into a
+#' list. \code{dlply} is similar to \code{\link{by}} except that the results
+#' are returned in a different format.
+#'
+#' @template ply
+#' @template d-
+#' @template -l
+#' @export
+#' @examples
+#' linmod <- function(df) {
+#' lm(rbi ~ year, data = mutate(df, year = year - min(year)))
+#' }
+#' models <- dlply(baseball, .(id), linmod)
+#' models[[1]]
+#'
+#' coef <- ldply(models, coef)
+#' with(coef, plot(`(Intercept)`, year))
+#' qual <- laply(models, function(mod) summary(mod)$r.squared)
+#' hist(qual)
+dlply <- function(.data, .variables, .fun = NULL, ..., .progress = "none", .drop = TRUE, .parallel = FALSE) {
+ .variables <- as.quoted(.variables)
+ pieces <- splitter_d(.data, .variables, drop = .drop)
+
+ llply(.data = pieces, .fun = .fun, ...,
+ .progress = .progress, .parallel = .parallel)
+}
View
@@ -0,0 +1,35 @@
+#' Split list, apply function, and discard results.
+#'
+#' For each element of a list, apply function and discard results
+#'
+#' @template ply
+#' @template l-
+#' @template -_
+#' @export
+l_ply <- function(.data, .fun = NULL, ..., .progress = "none", .print = FALSE,
+ .parallel = FALSE) {
+ if (is.character(.fun) || is.list(.fun)) .fun <- each(.fun)
+ if (!is.function(.fun)) stop(".fun is not a function.")
+
+ progress <- create_progress_bar(.progress)
+ progress$init(length(.data))
+ on.exit(progress$term())
+
+ if (.parallel) {
+ if (.print) message("Printing disabled for parallel processing")
+ if (.progress != "none") message("Progress disabled for parallel processing")
+
+ setup_parallel()
+ ignore <- function(...) NULL
+ foreach(d = .data, .combine = ignore) %dopar% .fun(d, ...)
+ } else {
+ .data <- as.list(.data)
+ for(i in seq_along(.data)) {
+ x <- .fun(.data[[i]], ...)
+ if (.print) print(x)
+ progress$step()
+ }
+ }
+
+ invisible()
+}
View
@@ -0,0 +1,31 @@
+#' Split list, apply function, and return results in an array.
+#'
+#' For each element of a list, apply function then combine results into an
+#' array. \code{laply} is similar in spirit to \code{\link{sapply}} except
+#' that it will always return an array, and the output is transposed with
+#' respect \code{sapply} - each element of the list corresponds to a column,
+#' not a row.
+#'
+#' @template ply
+#' @template l-
+#' @template -a
+#' @export
+#' @examples
+#' laply(baseball, is.factor)
+#' # cf
+#' ldply(baseball, is.factor)
+#' colwise(is.factor)(baseball)
+#'
+#' laply(seq_len(10), identity)
+#' laply(seq_len(10), rep, times = 4)
+#' laply(seq_len(10), matrix, nrow = 2, ncol = 2)
+laply <- function(.data, .fun = NULL, ..., .progress = "none", .drop = TRUE, .parallel = FALSE) {
+ if (is.character(.fun)) .fun <- do.call("each", as.list(.fun))
+ if (!is.function(.fun)) stop(".fun is not a function.")
+
+ if (!inherits(.data, "split")) .data <- as.list(.data)
+ res <- llply(.data = .data, .fun = .fun, ...,
+ .progress = .progress, .parallel = .parallel)
+
+ list_to_array(res, attr(.data, "split_labels"), .drop)
+}
File renamed without changes.
View
@@ -93,52 +93,3 @@ llply <- function(.data, .fun = NULL, ..., .progress = "none", .inform = FALSE,
result
}
-
-#' Split data frame, apply function, and return results in a list.
-#'
-#' For each subset of a data frame, apply function then combine results into a
-#' list. \code{dlply} is similar to \code{\link{by}} except that the results
-#' are returned in a different format.
-#'
-#' @template ply
-#' @template d-
-#' @template -l
-#' @export
-#' @examples
-#' linmod <- function(df) {
-#' lm(rbi ~ year, data = mutate(df, year = year - min(year)))
-#' }
-#' models <- dlply(baseball, .(id), linmod)
-#' models[[1]]
-#'
-#' coef <- ldply(models, coef)
-#' with(coef, plot(`(Intercept)`, year))
-#' qual <- laply(models, function(mod) summary(mod)$r.squared)
-#' hist(qual)
-dlply <- function(.data, .variables, .fun = NULL, ..., .progress = "none", .drop = TRUE, .parallel = FALSE) {
- .variables <- as.quoted(.variables)
- pieces <- splitter_d(.data, .variables, drop = .drop)
-
- llply(.data = pieces, .fun = .fun, ...,
- .progress = .progress, .parallel = .parallel)
-}
-
-#' Split array, apply function, and return results in a list.
-#'
-#' For each slice of an array, apply function then combine results into a
-#' list. \code{alply} is somewhat similar to \code{\link{apply}} for cases
-#' where the results are not atomic.
-#'
-#' @template ply
-#' @template a-
-#' @template -l
-#' @export
-#' @examples
-#' alply(ozone, 3, quantile)
-#' alply(ozone, 3, function(x) table(round(x)))
-alply <- function(.data, .margins, .fun = NULL, ..., .expand = TRUE, .progress = "none", .parallel = FALSE) {
- pieces <- splitter_a(.data, .margins, .expand)
-
- llply(.data = pieces, .fun = .fun, ...,
- .progress = .progress, .parallel = .parallel)
-}
Oops, something went wrong.

0 comments on commit 3ee18e5

Please sign in to comment.