reshape2/0000755000176200001440000000000012057472355011775 5ustar liggesusersreshape2/MD50000644000176200001440000000346212057472355012312 0ustar liggesusers6259d21bc9b5e65334b961ac79f6a8af *DESCRIPTION 2d170d25c55bab58f33ea60fdbb8afe5 *NAMESPACE 96cb5b94a33b800bdbc9ed1c659d2466 *NEWS 3b8a9f6833d4944a0b4330b1063a4f07 *R/cast.r 827ca227c89be29638317fd0cf09810d *R/data.r 64787f81028fc99b399324ea1e20d388 *R/formula.r be60b82da1500a97b295ec2eedcbcecd *R/helper-colsplit.r b88bd2b7d2e7ee40cefcf33e6b5145ab *R/helper-guess-value.r 6d720bda805d2903c1cde371a58611ba *R/helper-margins.r 5b4dddf778fd06aad455818ef1c97f72 *R/melt.r 3f85fc6e083cff5060dabc1571f0a9e5 *R/recast.r 72e84fd8dbe786407e625134b251238b *R/utils.r a29aec5b95e38f7eab2ab9c2141abd5c *README.md 11d6f343f97ca34edc7cb5ad4a174d05 *data/french_fries.rda 931bb9da3bce71ebcb25ba53c5dcd1e5 *data/smiths.rda 6a3f0a74f813cd68547e665f42b8a3cb *data/tips.rda dd664ad85751a470cf0b7414a1c4c3ec *inst/CITATION dcc9587c4ec1230deb72e502b86fc62d *inst/tests/test-cast.r c450402fc64e0d1a35d777917ff93ad0 *inst/tests/test-margins.r a60729e4f0dfd33aa100363287947386 *inst/tests/test-melt.r a7216e25cec082f3395da6863de83ccd *man/add_margins.Rd edde7408a7544589fc74e3552127ace8 *man/cast.Rd 8214d531229d90c6de5b6bcac3c11015 *man/colsplit.Rd 67acc8e7ad2943eb7acc9f358e2917ac *man/french_fries.Rd 609a308bc03f2dbf5adff51742ad6146 *man/guess_value.Rd d5328616df8fb8e14c41cfe30788741a *man/margins.Rd 634fc988a0bb7e6b29555b2cee7f2b56 *man/melt.Rd 445dc1f03f79093822e9534b143b8b3f *man/melt.array.Rd 2b423890570dd38eac40372e7922d937 *man/melt.data.frame.Rd b46a0ca7a796832651627834753b40af *man/melt.default.Rd 0a8569287d6651219b0ba13d0b3eb5d7 *man/melt.list.Rd 543444d9fb2c8533aae8a71b6bd880e2 *man/melt_check.Rd fa5c27a9488bc1a21b58a95752f38e07 *man/parse_formula.Rd c4573be1672fa0361040a596567b38ea *man/recast.Rd 220f9b410ae11557d8f7e1d8f5424903 *man/smiths.Rd 3995a24a8f5afd24dd6077c8f34e00c4 *man/tips.Rd e269149e26f67e8befc86829c303bd49 *tests/test-all.R reshape2/tests/0000755000176200001440000000000011700354630013124 5ustar liggesusersreshape2/tests/test-all.R0000644000176200001440000000007612057435674015015 0ustar liggesuserslibrary(testthat) library(reshape2) test_package("reshape2") reshape2/README.md0000644000176200001440000000330712057435674013262 0ustar liggesusersReshape2 is a reboot of the reshape package. It's been over five years since the first release of the package, and in that time I've learned a tremendous amount about R programming, and how to work with data in R. Reshape2 uses that knowledge to make a new package for reshaping data that is much more focussed and much much faster. This version improves speed at the cost of functionality, so I have renamed it to `reshape2` to avoid causing problems for existing users. Based on user feedback I may reintroduce some of these features. What's new in `reshape2`: * considerably faster and more memory efficient thanks to a much better underlying algorithm that uses the power and speed of subsetting to the fullest extent, in most cases only making a single copy of the data. * cast is replaced by two functions depending on the output type: `dcast` produces data frames, and `acast` produces matrices/arrays. * multidimensional margins are now possible: `grand_row` and `grand_col` have been dropped: now the name of the margin refers to the variable that has its value set to (all). * some features have been removed such as the `|` cast operator, and the ability to return multiple values from an aggregation function. I'm reasonably sure both these operations are better performed by plyr. * a new cast syntax which allows you to reshape based on functions of variables (based on the same underlying syntax as plyr): * better development practices like namespaces and tests. Initial benchmarking has shown `melt` to be up to 10x faster, pure reshaping `cast` up to 100x faster, and aggregating `cast()` up to 10x faster. This work has been generously supported by BD (Becton Dickinson). reshape2/R/0000755000176200001440000000000012057435727012200 5ustar liggesusersreshape2/R/utils.r0000644000176200001440000000006312057435674013523 0ustar liggesusers"%||%" <- function(a, b) if (!is.null(a)) a else b reshape2/R/recast.r0000644000176200001440000000152312057435674013646 0ustar liggesusers#' Recast: melt and cast in a single step #' #' This conveniently wraps melting and casting a data frame into #' a single step. #' #' @param data data set to melt #' @param formula casting formula, see \link{cast} for specifics #' @param ... other arguments passed to \link{cast} #' @param id.var identifying variables. If blank, will use all non #' measure.var variables #' @param measure.var measured variables. If blank, will use all non #' id.var variables #' @keywords manip #' @seealso \url{http://had.co.nz/reshape/} #' @export #' @examples #' recast(french_fries, time ~ variable, id.var = 1:4) recast <- function(data, formula, ..., id.var, measure.var) { if (any(c("id.vars", "measure.vars") %in% names(match.call()))) { stop("Use var, not vars\n") } molten <- melt(data, id.var, measure.var) cast(molten, formula, ...) } reshape2/R/melt.r0000644000176200001440000001732112057435674013331 0ustar liggesusers#' Convert an object into a molten data frame. #' #' This the generic melt function. See the following functions #' for the details about different data structures: #' #' \itemize{ #' \item \code{\link{melt.data.frame}} for data.frames #' \item \code{\link{melt.array}} for arrays, matrices and tables #' \item \code{\link{melt.list}} for lists #' } #' #' @keywords manip #' @param data Data set to melt #' @param na.rm Should NA values be removed from the data set? This will #' convert explicit missings to implicit missings. #' @param ... further arguments passed to or from other methods. #' @param value.name name of variable used to store values #' @export melt <- function(data, ..., na.rm = FALSE, value.name = "value") { UseMethod("melt", data) } #' Melt a vector. #' For vectors, makes a column of a data frame #' #' @param data vector to melt #' @param na.rm Should NA values be removed from the data set? This will #' convert explicit missings to implicit missings. #' @param ... further arguments passed to or from other methods. #' @param value.name name of variable used to store values #' @S3method melt default #' @method melt default #' @keywords manip melt.default <- function(data, ..., na.rm = FALSE, value.name = "value") { if (na.rm) data <- data[!is.na(data)] setNames(data.frame(data), value.name) } #' Melt a list by recursively melting each component. #' #' @keywords manip #' @S3method melt list #' @method melt list #' @param data list to recursively melt #' @param ... further arguments passed to or from other methods. #' @param level list level - used for creating labels #' @examples #' a <- as.list(c(1:4, NA)) #' melt(a) #' names(a) <- letters[1:4] #' melt(a) #' a <- list(matrix(1:4, ncol=2), matrix(1:6, ncol=2)) #' melt(a) #' a <- list(matrix(1:4, ncol=2), array(1:27, c(3,3,3))) #' melt(a) #' melt(list(1:5, matrix(1:4, ncol=2))) #' melt(list(list(1:3), 1, list(as.list(3:4), as.list(1:2)))) melt.list <- function(data, ..., level = 1) { parts <- lapply(data, melt, level = level + 1, ...) result <- rbind.fill(parts) # Add labels names <- names(data) %||% seq_along(data) lengths <- vapply(parts, nrow, integer(1)) labels <- rep(names, lengths) label_var <- attr(data, "varname") %||% paste("L", level, sep = "") result[[label_var]] <- labels # result <- cbind(labels, result) # result[, c(setdiff(names(result), "value"), "value")] result } #' Melt a data frame into form suitable for easy casting. #' #' You need to tell melt which of your variables are id variables, and which #' are measured variables. If you only supply one of \code{id.vars} and #' \code{measure.vars}, melt will assume the remainder of the variables in the #' data set belong to the other. If you supply neither, melt will assume #' factor and character variables are id variables, and all others are #' measured. #' #' @param data data frame to melt #' @param id.vars vector of id variables. Can be integer (variable position) #' or string (variable name)If blank, will use all non-measured variables. #' @param measure.vars vector of measured variables. Can be integer (variable #' position) or string (variable name)If blank, will use all non id.vars # variables. #' @param variable.name name of variable used to store measured variable names #' @param value.name name of variable used to store values #' @param na.rm Should NA values be removed from the data set? This will #' convert explicit missings to implicit missings. #' @param ... further arguments passed to or from other methods. #' @keywords manip #' @method melt data.frame #' @S3method melt data.frame #' @examples #' names(airquality) <- tolower(names(airquality)) #' melt(airquality, id=c("month", "day")) #' names(ChickWeight) <- tolower(names(ChickWeight)) #' melt(ChickWeight, id=2:4) melt.data.frame <- function(data, id.vars, measure.vars, variable.name = "variable", ..., na.rm = FALSE, value.name = "value") { var <- melt_check(data, id.vars, measure.vars) ids <- unrowname(data[, var$id, drop = FALSE]) if (length(var$measure) == 0) { return(ids) } # Turn factors to characters factors <- vapply(data, is.factor, logical(1)) data[factors] <- lapply(data[factors], as.character) value <- unlist(unname(data[var$measure])) variable <- factor(rep(var$measure, each = nrow(data)), levels = var$measure) df <- data.frame(ids, variable, value, stringsAsFactors = FALSE) names(df) <- c(names(ids), variable.name, value.name) if (na.rm) { subset(df, !is.na(value)) } else { df } } #' Melt an array. #' #' This code is conceptually similar to \code{\link{as.data.frame.table}} #' #' @param data array to melt #' @param varnames variable names to use in molten data.frame #' @param ... further arguments passed to or from other methods. #' @param value.name name of variable used to store values #' @param na.rm Should NA values be removed from the data set? This will #' convert explicit missings to implicit missings. #' @keywords manip #' @S3method melt table #' @S3method melt matrix #' @S3method melt array #' @method melt array #' @examples #' a <- array(c(1:23, NA), c(2,3,4)) #' melt(a) #' melt(a, na.rm = TRUE) #' melt(a, varnames=c("X","Y","Z")) #' dimnames(a) <- lapply(dim(a), function(x) LETTERS[1:x]) #' melt(a) #' melt(a, varnames=c("X","Y","Z")) #' dimnames(a)[1] <- list(NULL) #' melt(a) melt.array <- function(data, varnames = names(dimnames(data)), ..., na.rm = FALSE, value.name = "value") { var.convert <- function(x) if(is.character(x)) type.convert(x) else x dn <- amv_dimnames(data) names(dn) <- varnames labels <- expand.grid(lapply(dn, var.convert), KEEP.OUT.ATTRS = FALSE, stringsAsFactors = FALSE) if (na.rm) { missing <- is.na(data) data <- data[!missing] labels <- labels[!missing, ] } value_df <- setNames(data.frame(as.vector(data)), value.name) cbind(labels, value_df) } melt.table <- melt.array melt.matrix <- melt.array #' Check that input variables to melt are appropriate. #' #' If id.vars or measure.vars are missing, \code{melt_check} will do its #' best to impute them. If you only supply one of id.vars and measure.vars, #' melt will assume the remainder of the variables in the data set belong to #' the other. If you supply neither, melt will assume discrete variables are #' id variables and all other are measured. #' #' @param data data frame #' @param id.vars vector of identifying variable names or indexes #' @param measure.vars vector of Measured variable names or indexes #' @return a list giving id and measure variables names. melt_check <- function(data, id.vars, measure.vars) { varnames <- names(data) # Convert positions to names if (!missing(id.vars) && is.numeric(id.vars)) { id.vars <- varnames[id.vars] } if (!missing(measure.vars) && is.numeric(measure.vars)) { measure.vars <- varnames[measure.vars] } # Check that variables exist if (!missing(id.vars)) { unknown <- setdiff(id.vars, varnames) if (length(unknown) > 0) { vars <- paste(unknown, collapse=", ") stop("id variables not found in data: ", vars, call. = FALSE) } } if (!missing(measure.vars)) { unknown <- setdiff(measure.vars, varnames) if (length(unknown) > 0) { vars <- paste(unknown, collapse=", ") stop("measure variables not found in data: ", vars, call. = FALSE) } } # Fill in missing pieces if (missing(id.vars) && missing(measure.vars)) { discrete <- sapply(data, is.discrete) id.vars <- varnames[discrete] measure.vars <- varnames[!discrete] message("Using ", paste(id.vars, collapse = ", "), " as id variables") } else if (missing(id.vars)) { id.vars <- setdiff(varnames, measure.vars) } else if (missing(measure.vars)) { measure.vars <- setdiff(varnames, id.vars) } list(id = id.vars, measure = measure.vars) } reshape2/R/helper-margins.r0000644000176200001440000000511312057435674015301 0ustar liggesusers#' Figure out margining variables. #' #' Given the variables that form the rows and columns, and a set of desired #' margins, works out which ones are possible. Variables that can't be #' margined over are dropped silently. #' #' @param vars a list of character vectors giving the variables in each #' dimension #' @param margins a character vector of variable names to compute margins for. #' \code{TRUE} will compute all possible margins. #' @keywords manip internal #' @return list of margining combinations, or \code{NULL} if none. These are #' the combinations of variables that should have their values set to #' \code{(all)} margins <- function(vars, margins = NULL) { if (is.null(margins) || identical(margins, FALSE)) return(NULL) all_vars <- unlist(vars) if (isTRUE(margins)) { margins <- all_vars } # Start by grouping margins by dimension dims <- lapply(vars, intersect, margins) # Next, ensure high-level margins include lower-levels dims <- mapply(function(vars, margin) { lapply(margin, downto, vars) }, vars, dims, SIMPLIFY = FALSE, USE.NAMES = FALSE) # Finally, find intersections across all dimensions seq_0 <- function(x) c(0, seq_along(x)) indices <- expand.grid(lapply(dims, seq_0), KEEP.OUT.ATTRS = FALSE) # indices <- indices[rowSums(indices) > 0, ] lapply(seq_len(nrow(indices)), function(i){ unlist(mapply("[", dims, indices[i, ], SIMPLIFY = FALSE)) }) } upto <- function(a, b) { b[seq_len(match(a, b, nomatch = 0))] } downto <- function(a, b) { rev(upto(a, rev(b))) } #' Add margins to a data frame. #' #' Rownames are silently stripped. All margining variables will be converted #' to factors. #' #' @param df input data frame #' @param vars a list of character vectors giving the variables in each #' dimension #' @param margins a character vector of variable names to compute margins for. #' \code{TRUE} will compute all possible margins. #' @export add_margins <- function(df, vars, margins = TRUE) { margin_vars <- margins(vars, margins) # Return data frame if no margining necessary if (length(margin_vars) == 0) return(df) # Prepare data frame for addition of margins addAll <- function(x) { x <- addNA(x, TRUE) factor(x, levels = c(levels(x), "(all)"), exclude = NULL) } vars <- unique(unlist(margin_vars)) df[vars] <- lapply(df[vars], addAll) rownames(df) <- NULL # Loop through all combinations of margin variables, setting # those variables to (all) margin_dfs <- llply(margin_vars, function(vars) { df[vars] <- rep(list(factor("(all)")), length(vars)) df }) rbind.fill(margin_dfs) } reshape2/R/helper-guess-value.r0000644000176200001440000000077112057435674016106 0ustar liggesusers#' 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 } reshape2/R/helper-colsplit.r0000644000176200001440000000140612057435674015473 0ustar liggesusers#' Split a vector into multiple columns #' #' 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 #' @keywords manip #' @export #' @examples #' x <- c("a_1", "a_2", "b_2", "c_3") #' vars <- colsplit(x, "_", c("trt", "time")) #' vars #' str(vars) colsplit <- function(string, pattern, names) { vars <- str_split_fixed(string, pattern, n = length(names)) df <- data.frame(alply(vars, 2, type.convert, as.is = TRUE), stringsAsFactors = FALSE) names(df) <- names df } reshape2/R/formula.r0000644000176200001440000000301512057435674014030 0ustar liggesusers#' 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. #' #' 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 #' used. #' #' @param formula formula to parse #' @param varnames names of all variables in data #' @param value.var name of variable containing values #' @examples #' reshape2:::parse_formula("a + ...", letters[1:6]) #' reshape2:::parse_formula("a ~ b + d") #' reshape2:::parse_formula("a + b ~ c ~ .") parse_formula <- function(formula = "... ~ variable", varnames, value.var = "value") { remove.placeholder <- function(x) x[x != "."] 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) formula <- lapply(formula, remove.placeholder) all_vars <- unlist(formula) if (any(all_vars == "...")) { remainder <- setdiff(varnames, c(all_vars, value.var)) formula <- lapply(formula, replace.remainder) } } if (!is.list(formula)) { stop("Don't know how to parse", formula, call. = FALSE) } lapply(formula, as.quoted) } reshape2/R/data.r0000644000176200001440000000350312057435674013276 0ustar liggesusers#' Sensory data from a french fries experiment. #' #' 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 grassy flavour, #' \item rancid flavour, #' \item painty flavour #' } #' #' @docType data #' @name french_fries #' @usage data(french_fries) #' @format A data frame with 696 rows and 9 variables #' @keywords datasets NULL #' Demo data describing the Smiths. #' #' A small demo dataset describing John and Mary Smith. Used in the #' introductory vignette. #' #' @docType data #' @name smiths #' @usage data(smiths) #' @format A data frame with 2 rows and 5 variables #' @keywords datasets NULL #' Tipping data #' #' #' One waiter recorded information about each tip he received over a #' period of a few months working in one restaurant. He collected several #' 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. #' } #' #' In all he recorded 244 tips. The data was reported in a collection of #' case studies for business statistics (Bryant & Smith 1995). #' #' @references Bryant, P. G. and Smith, M (1995) \emph{Practical Data #' Analysis: Case Studies in Business Statistics}. Homewood, IL: Richard D. #' Irwin Publishing: #' @docType data #' @name tips #' @usage data(tips) #' @format A data frame with 244 rows and 7 variables #' @keywords datasets NULL reshape2/R/cast.r0000644000176200001440000001675412057435727013332 0ustar liggesusers#' 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 #' most two dimensions. #' #' 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 ~ .}. #' #' 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 #' of this form is that you can cast based on transformations of the #' variables: \code{list(.(a + b), (c = round(c)))}. See the documentation #' for \code{\link[plyr]{.}} for more details and alternative formats. #' #' If the combination of variables you supply does not uniquely identify one #' row in the original data set, you will need to supply an aggregating #' function, \code{fun.aggregate}. This function should take a vector of #' numbers and return a single summary statistic. #' #' @usage acast(data, formula, fun.aggregate = NULL, ..., margins = NULL, #' subset = NULL, fill=NULL, drop = TRUE, value.var = guess_value(data)) #' @usage dcast(data, formula, fun.aggregate = NULL, ..., margins = NULL, #' subset = NULL, fill=NULL, drop = TRUE, value.var = guess_value(data)) #' @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 #' 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 #' @param margins vector of variable names (can include "grand\_col" and #' "grand\_row") to compute margins for, or TRUE to compute all margins . #' Any variables that can not be margined over will be silently dropped. #' @param subset quoted expression used to subset data prior to reshaping, #' e.g. \code{subset = .(variable=="length")}. #' @param fill value with which to fill in structural missings, defaults to #' value from applying \code{fun.aggregate} to 0 length vector #' @param drop should missing combinations dropped or kept? #' @param value.var name of column which stores values, see #' \code{\link{guess_value}} for default strategies to figure this out. #' @seealso \code{\link{melt}}, \url{http://had.co.nz/reshape/} #' @name cast #' @aliases cast dcast acast #' @export dcast acast #' @import plyr #' @import stringr #' @examples #' #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) #' dcast(aqm, month ~ variable, mean, margins = c("month", "variable")) #' #' library(plyr) # needed to access . function #' acast(aqm, variable ~ month, mean, subset = .(variable == "ozone")) #' acast(aqm, variable ~ month, mean, subset = .(month == 5)) #' #' #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) #' dcast(ff_d, treatment ~ variable, mean, margins = TRUE) #' dcast(ff_d, treatment + subject ~ variable, mean, margins="treatment") #' lattice::xyplot(`1` ~ `2` | variable, dcast(ff_d, ... ~ rep), aspect="iso") 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") # Replace zeros (empty inputs) with 1 for dimensions of output ns[ns == 0] <- 1 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, .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 ) } dcast <- 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 (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, 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) } 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 } array_names <- function(df) { do.call(paste, c(df, list(sep = "_"))) } reshape2/NEWS0000644000176200001440000000233412057436106012470 0ustar liggesusersVersion 1.2.2 ------------- * Fix incompatibility with plyr 1.8 * Fix evaluation bug revealed by knitr. (Fixes #18) * Fixed a bug in `melt` where it didn't automatically get variable names when used with tables. (Thanks to Winston Chang) Version 1.2.1 ------------- * Fix bug in multiple margins revealed by plyr 1.7, but caused by mis-use of data frame subsetting. Version 1.2 ----------- * Fixed bug in melt where factors were converted to integers, instead of to characters * When the measured variable is a factor, `dcast` now converts it to a character rather than throwing an error. `acast` still returns a factor matrix. (Thanks to Brian Diggs.) * `acast` is now much faster, due to fixing a very slow way of naming the output. (Thanks to José Bartolomei Díaz for the bug report) * `value_var` argument to `acast` and `dcast` renamed to `value.var` to be consistent with other argument names * Order `NA` factor levels before `(all)` when creating margins * Corrected reshape citation. Version 1.1 ----------- * `melt.data.frame` no longer turns characters into factors * All melt methods gain a `na.rm` and `value.name` arguments - these previously were only possessed by `melt.data.frame` (Fixes #5)reshape2/NAMESPACE0000644000176200001440000000037712057435712013217 0ustar liggesusersS3method(melt,array) S3method(melt,data.frame) S3method(melt,default) S3method(melt,list) S3method(melt,matrix) S3method(melt,table) export(acast) export(add_margins) export(colsplit) export(dcast) export(melt) export(recast) import(plyr) import(stringr) reshape2/man/0000755000176200001440000000000012057444557012553 5ustar liggesusersreshape2/man/tips.Rd0000644000176200001440000000147412057444556014026 0ustar liggesusers\docType{data} \name{tips} \alias{tips} \title{Tipping data} \format{A data frame with 244 rows and 7 variables} \description{ One waiter recorded information about each tip he received over a period of a few months working in one restaurant. He collected several variables: } \details{ \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. } In all he recorded 244 tips. The data was reported in a collection of case studies for business statistics (Bryant & Smith 1995). } \references{ Bryant, P. G. and Smith, M (1995) \emph{Practical Data Analysis: Case Studies in Business Statistics}. Homewood, IL: Richard D. Irwin Publishing: } \keyword{datasets} reshape2/man/smiths.Rd0000644000176200001440000000040712057444556014351 0ustar liggesusers\docType{data} \name{smiths} \alias{smiths} \title{Demo data describing the Smiths.} \format{A data frame with 2 rows and 5 variables} \description{ A small demo dataset describing John and Mary Smith. Used in the introductory vignette. } \keyword{datasets} reshape2/man/recast.Rd0000644000176200001440000000130512057444557014322 0ustar liggesusers\name{recast} \alias{recast} \title{Recast: melt and cast in a single step} \usage{ recast(data, formula, ..., id.var, measure.var) } \arguments{ \item{data}{data set to melt} \item{formula}{casting formula, see \link{cast} for specifics} \item{...}{other arguments passed to \link{cast}} \item{id.var}{identifying variables. If blank, will use all non measure.var variables} \item{measure.var}{measured variables. If blank, will use all non id.var variables} } \description{ This conveniently wraps melting and casting a data frame into a single step. } \examples{ recast(french_fries, time ~ variable, id.var = 1:4) } \seealso{ \url{http://had.co.nz/reshape/} } \keyword{manip} reshape2/man/parse_formula.Rd0000644000176200001440000000155212057444556015703 0ustar liggesusers\name{parse_formula} \alias{parse_formula} \title{Parse casting formulae.} \usage{ parse_formula(formula = "... ~ variable", varnames, value.var = "value") } \arguments{ \item{formula}{formula to parse} \item{varnames}{names of all variables in data} \item{value.var}{name of variable containing values} } \description{ 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. } \details{ 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 used. } \examples{ reshape2:::parse_formula("a + ...", letters[1:6]) reshape2:::parse_formula("a ~ b + d") reshape2:::parse_formula("a + b ~ c ~ .") } reshape2/man/melt_check.Rd0000644000176200001440000000135412057444557015143 0ustar liggesusers\name{melt_check} \alias{melt_check} \title{Check that input variables to melt are appropriate.} \usage{ melt_check(data, id.vars, measure.vars) } \arguments{ \item{data}{data frame} \item{id.vars}{vector of identifying variable names or indexes} \item{measure.vars}{vector of Measured variable names or indexes} } \value{ a list giving id and measure variables names. } \description{ If id.vars or measure.vars are missing, \code{melt_check} will do its best to impute them. If you only supply one of id.vars and measure.vars, melt will assume the remainder of the variables in the data set belong to the other. If you supply neither, melt will assume discrete variables are id variables and all other are measured. } reshape2/man/melt.Rd0000644000176200001440000000141112057444556013777 0ustar liggesusers\name{melt} \alias{melt} \title{Convert an object into a molten data frame.} \usage{ melt(data, ..., na.rm = FALSE, value.name = "value") } \arguments{ \item{data}{Data set to melt} \item{na.rm}{Should NA values be removed from the data set? This will convert explicit missings to implicit missings.} \item{...}{further arguments passed to or from other methods.} \item{value.name}{name of variable used to store values} } \description{ This the generic melt function. See the following functions for the details about different data structures: } \details{ \itemize{ \item \code{\link{melt.data.frame}} for data.frames \item \code{\link{melt.array}} for arrays, matrices and tables \item \code{\link{melt.list}} for lists } } \keyword{manip} reshape2/man/melt.list.Rd0000644000176200001440000000130512057444556014753 0ustar liggesusers\name{melt.list} \alias{melt.list} \title{Melt a list by recursively melting each component.} \usage{ \method{melt}{list} (data, ..., level = 1) } \arguments{ \item{data}{list to recursively melt} \item{...}{further arguments passed to or from other methods.} \item{level}{list level - used for creating labels} } \description{ Melt a list by recursively melting each component. } \examples{ a <- as.list(c(1:4, NA)) melt(a) names(a) <- letters[1:4] melt(a) a <- list(matrix(1:4, ncol=2), matrix(1:6, ncol=2)) melt(a) a <- list(matrix(1:4, ncol=2), array(1:27, c(3,3,3))) melt(a) melt(list(1:5, matrix(1:4, ncol=2))) melt(list(list(1:3), 1, list(as.list(3:4), as.list(1:2)))) } \keyword{manip} reshape2/man/melt.default.Rd0000644000176200001440000000111612057444556015424 0ustar liggesusers\name{melt.default} \alias{melt.default} \title{Melt a vector. For vectors, makes a column of a data frame} \usage{ \method{melt}{default} (data, ..., na.rm = FALSE, value.name = "value") } \arguments{ \item{data}{vector to melt} \item{na.rm}{Should NA values be removed from the data set? This will convert explicit missings to implicit missings.} \item{...}{further arguments passed to or from other methods.} \item{value.name}{name of variable used to store values} } \description{ Melt a vector. For vectors, makes a column of a data frame } \keyword{manip} reshape2/man/melt.data.frame.Rd0000644000176200001440000000300112057444556015775 0ustar liggesusers\name{melt.data.frame} \alias{melt.data.frame} \title{Melt a data frame into form suitable for easy casting.} \usage{ \method{melt}{data.frame} (data, id.vars, measure.vars, variable.name = "variable", ..., na.rm = FALSE, value.name = "value") } \arguments{ \item{data}{data frame to melt} \item{id.vars}{vector of id variables. Can be integer (variable position) or string (variable name)If blank, will use all non-measured variables.} \item{measure.vars}{vector of measured variables. Can be integer (variable position) or string (variable name)If blank, will use all non id.vars} \item{variable.name}{name of variable used to store measured variable names} \item{value.name}{name of variable used to store values} \item{na.rm}{Should NA values be removed from the data set? This will convert explicit missings to implicit missings.} \item{...}{further arguments passed to or from other methods.} } \description{ You need to tell melt which of your variables are id variables, and which are measured variables. If you only supply one of \code{id.vars} and \code{measure.vars}, melt will assume the remainder of the variables in the data set belong to the other. If you supply neither, melt will assume factor and character variables are id variables, and all others are measured. } \examples{ names(airquality) <- tolower(names(airquality)) melt(airquality, id=c("month", "day")) names(ChickWeight) <- tolower(names(ChickWeight)) melt(ChickWeight, id=2:4) } \keyword{manip} reshape2/man/melt.array.Rd0000644000176200001440000000160212057444557015117 0ustar liggesusers\name{melt.array} \alias{melt.array} \title{Melt an array.} \usage{ \method{melt}{array} (data, varnames = names(dimnames(data)), ..., na.rm = FALSE, value.name = "value") } \arguments{ \item{data}{array to melt} \item{varnames}{variable names to use in molten data.frame} \item{...}{further arguments passed to or from other methods.} \item{value.name}{name of variable used to store values} \item{na.rm}{Should NA values be removed from the data set? This will convert explicit missings to implicit missings.} } \description{ This code is conceptually similar to \code{\link{as.data.frame.table}} } \examples{ a <- array(c(1:23, NA), c(2,3,4)) melt(a) melt(a, na.rm = TRUE) melt(a, varnames=c("X","Y","Z")) dimnames(a) <- lapply(dim(a), function(x) LETTERS[1:x]) melt(a) melt(a, varnames=c("X","Y","Z")) dimnames(a)[1] <- list(NULL) melt(a) } \keyword{manip} reshape2/man/margins.Rd0000644000176200001440000000134612057444556014505 0ustar liggesusers\name{margins} \alias{margins} \title{Figure out margining variables.} \usage{ margins(vars, margins = NULL) } \arguments{ \item{vars}{a list of character vectors giving the variables in each dimension} \item{margins}{a character vector of variable names to compute margins for. \code{TRUE} will compute all possible margins.} } \value{ list of margining combinations, or \code{NULL} if none. These are the combinations of variables that should have their values set to \code{(all)} } \description{ Given the variables that form the rows and columns, and a set of desired margins, works out which ones are possible. Variables that can't be margined over are dropped silently. } \keyword{internal} \keyword{manip} reshape2/man/guess_value.Rd0000644000176200001440000000053512057444556015366 0ustar liggesusers\name{guess_value} \alias{guess_value} \title{Guess name of value column} \usage{ guess_value(df) } \arguments{ \item{df}{data frame to guess value column from} } \description{ Strategy: \enumerate{ \item Is value or (all) column present? If so, use that \item Otherwise, guess that last column is the value column } } \keyword{internal} reshape2/man/french_fries.Rd0000644000176200001440000000125012057444556015474 0ustar liggesusers\docType{data} \name{french_fries} \alias{french_fries} \title{Sensory data from a french fries experiment.} \format{A data frame with 696 rows and 9 variables} \description{ 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. } \details{ 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 grassy flavour, \item rancid flavour, \item painty flavour } } \keyword{datasets} reshape2/man/colsplit.Rd0000644000176200001440000000116012057444556014670 0ustar liggesusers\name{colsplit} \alias{colsplit} \title{Split a vector into multiple columns} \usage{ colsplit(string, pattern, names) } \arguments{ \item{string}{character vector or factor to split up} \item{pattern}{regular expression to split on} \item{names}{names for output columns} } \description{ 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. } \examples{ x <- c("a_1", "a_2", "b_2", "c_3") vars <- colsplit(x, "_", c("trt", "time")) vars str(vars) } \keyword{manip} reshape2/man/cast.Rd0000644000176200001440000001017712057444556014001 0ustar liggesusers\name{cast} \alias{acast} \alias{cast} \alias{dcast} \title{Cast functions Cast a molten data frame into an array or data frame.} \arguments{ \item{data}{molten data frame, see \code{\link{melt}}.} \item{formula}{casting formula, see details for specifics.} \item{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.} \item{...}{further arguments are passed to aggregating function} \item{margins}{vector of variable names (can include "grand\_col" and "grand\_row") to compute margins for, or TRUE to compute all margins . Any variables that can not be margined over will be silently dropped.} \item{subset}{quoted expression used to subset data prior to reshaping, e.g. \code{subset = .(variable=="length")}.} \item{fill}{value with which to fill in structural missings, defaults to value from applying \code{fun.aggregate} to 0 length vector} \item{drop}{should missing combinations dropped or kept?} \item{value.var}{name of column which stores values, see \code{\link{guess_value}} for default strategies to figure this out.} } \description{ 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. } \details{ 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 ~ .}. 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 of this form is that you can cast based on transformations of the variables: \code{list(.(a + b), (c = round(c)))}. See the documentation for \code{\link[plyr]{.}} for more details and alternative formats. If the combination of variables you supply does not uniquely identify one row in the original data set, you will need to supply an aggregating function, \code{fun.aggregate}. This function should take a vector of numbers and return a single summary statistic. } \examples{ #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) dcast(aqm, month ~ variable, mean, margins = c("month", "variable")) library(plyr) # needed to access . function acast(aqm, variable ~ month, mean, subset = .(variable == "ozone")) acast(aqm, variable ~ month, mean, subset = .(month == 5)) #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) dcast(ff_d, treatment ~ variable, mean, margins = TRUE) dcast(ff_d, treatment + subject ~ variable, mean, margins="treatment") lattice::xyplot(`1` ~ `2` | variable, dcast(ff_d, ... ~ rep), aspect="iso") } \seealso{ \code{\link{melt}}, \url{http://had.co.nz/reshape/} } \keyword{manip} reshape2/man/add_margins.Rd0000644000176200001440000000075612057444556015321 0ustar liggesusers\name{add_margins} \alias{add_margins} \title{Add margins to a data frame.} \usage{ add_margins(df, vars, margins = TRUE) } \arguments{ \item{df}{input data frame} \item{vars}{a list of character vectors giving the variables in each dimension} \item{margins}{a character vector of variable names to compute margins for. \code{TRUE} will compute all possible margins.} } \description{ Rownames are silently stripped. All margining variables will be converted to factors. } reshape2/inst/0000755000176200001440000000000012057444616012751 5ustar liggesusersreshape2/inst/tests/0000755000176200001440000000000011743767313014116 5ustar liggesusersreshape2/inst/tests/test-melt.r0000644000176200001440000000245412057435673016224 0ustar liggesuserscontext("Melt") test_that("Missing values removed when na.rm = TRUE", { v <- c(1:3, NA) expect_equal(melt(v)$value, v) expect_equal(melt(v, na.rm = TRUE)$value, 1:3) m <- matrix(v, nrow = 2) expect_equal(melt(m)$value, v) expect_equal(melt(m, na.rm = TRUE)$value, 1:3) l1 <- list(v) expect_equal(melt(l1)$value, v) expect_equal(melt(l1, na.rm = TRUE)$value, 1:3) l2 <- as.list(v) expect_equal(melt(l2)$value, v) expect_equal(melt(l2, na.rm = TRUE)$value, 1:3) df <- data.frame(x = v) expect_equal(melt(df)$value, v) expect_equal(melt(df, na.rm = TRUE)$value, 1:3) }) test_that("value col name set by value.name", { v <- c(1:3, NA) expect_equal(names(melt(v, value.name = "v")), "v") m <- matrix(v, nrow = 2) expect_equal(names(melt(m, value.name = "v"))[3], "v") l1 <- list(v) expect_equal(names(melt(l1, value.name = "v"))[1], "v") df <- data.frame(x = v) expect_equal(names(melt(df, value.name = "v"))[2], "v") }) test_that("lists can have zero element components", { l <- list(a = 1:10, b = integer(0)) m <- melt(l) expect_equal(nrow(m), 10) }) test_that("factors coerced to characters, not integers", { df <- data.frame( id = 1:3, v1 = 1:3, v2 = factor(letters[1:3])) dfm <- melt(df, 1) expect_equal(dfm$value, c(1:3, letters[1:3])) }) reshape2/inst/tests/test-margins.r0000644000176200001440000000217412057435673016722 0ustar liggesuserscontext("Margins") vars <- list(c("a", "b", "c"), c("d", "e", "f")) test_that("margins expanded", { expect_that(margins(vars, "c")[[2]], equals(c("c"))) expect_that(margins(vars, "b")[[2]], equals(c("b", "c"))) expect_that(margins(vars, "a")[[2]], equals(c("a", "b", "c"))) expect_that(margins(vars, "f")[[2]], equals(c("f"))) expect_that(margins(vars, "e")[[2]], equals(c("e", "f"))) expect_that(margins(vars, "d")[[2]], equals(c("d", "e", "f"))) }) test_that("margins intersect", { expect_that(margins(vars, c("c", "f"))[-1], equals(list("c", "f", c("c", "f")))) }) test_that("(all) comes after NA", { df <- data.frame(a = c("a", "b", NA), b = c("a", "b", NA), value = 1) df2 <- add_margins(df, "a") expect_that(levels(df2$a), equals(c("a", "b", NA, "(all)"))) df3 <- add_margins(df, c("a", "b")) expect_that(levels(df3$a), equals(c("a", "b", NA, "(all)"))) expect_that(levels(df3$b), equals(c("a", "b", NA, "(all)"))) dc <- dcast(df, a ~ ., margins = TRUE, fun = length) expect_that(levels(dc$a), equals(c("a", "b", NA, "(all)"))) expect_that(as.character(dc$a), equals(c("a", "b", NA, "(all)"))) }) reshape2/inst/tests/test-cast.r0000644000176200001440000001335312057435674016216 0ustar liggesuserscontext("cast") s2 <- array(seq.int(3 * 4), c(3,4)) s2m <- melt(s2) colnames(s2m) <- c("X1", "X2", "value") s3 <- array(seq.int(3 * 4 * 5), c(3,4,5)) s3m <- melt(s3) colnames(s3m) <- c("X1", "X2", "X3", "value") test_that("reshaping matches t and aperm", { # 2d expect_equivalent(s2, acast(s2m, X1 ~ X2)) expect_equivalent(t(s2), acast(s2m, X2 ~ X1)) expect_equivalent(as.vector(s2), as.vector(acast(s2m, X2 + X1 ~ .))) # 3d expect_equivalent(s3, acast(s3m, X1 ~ X2 ~ X3)) expect_equivalent(as.vector(s3), as.vector(acast(s3m, X3 + X2 + X1 ~ .))) expect_equivalent(aperm(s3, c(1,3,2)), acast(s3m, X1 ~ X3 ~ X2)) expect_equivalent(aperm(s3, c(2,1,3)), acast(s3m, X2 ~ X1 ~ X3)) expect_equivalent(aperm(s3, c(2,3,1)), acast(s3m, X2 ~ X3 ~ X1)) expect_equivalent(aperm(s3, c(3,1,2)), acast(s3m, X3 ~ X1 ~ X2)) expect_equivalent(aperm(s3, c(3,2,1)), acast(s3m, X3 ~ X2 ~ X1)) }) test_that("aggregation matches apply", { # 2d -> 1d expect_equivalent(colMeans(s2), as.vector(acast(s2m, X2 ~ ., mean))) expect_equivalent(rowMeans(s2), as.vector(acast(s2m, X1 ~ ., mean))) # 3d -> 1d expect_equivalent(apply(s3, 1, mean), as.vector(acast(s3m, X1 ~ ., mean))) expect_equivalent(apply(s3, 1, mean), as.vector(acast(s3m, . ~ X1, mean))) expect_equivalent(apply(s3, 2, mean), as.vector(acast(s3m, X2 ~ ., mean))) expect_equivalent(apply(s3, 3, mean), as.vector(acast(s3m, X3 ~ ., mean))) # 3d -> 2d expect_equivalent(apply(s3, c(1,2), mean), acast(s3m, X1 ~ X2, mean)) expect_equivalent(apply(s3, c(1,3), mean), acast(s3m, X1 ~ X3, mean)) expect_equivalent(apply(s3, c(2,3), mean), acast(s3m, X2 ~ X3, mean)) }) names(ChickWeight) <- tolower(names(ChickWeight)) chick_m <- melt(ChickWeight, id=2:4, na.rm=TRUE) test_that("aggregation matches table", { tab <- unclass(with(chick_m, table(chick, time))) cst <- acast(chick_m, chick ~ time, length) expect_that(tab, is_equivalent_to(cst)) }) test_that("grand margins are computed correctly", { col <- acast(s2m, X1 ~ X2, mean, margins = "X1")[4, ] row <- acast(s2m, X1 ~ X2, mean, margins = "X2")[, 5] grand <- acast(s2m, X1 ~ X2, mean, margins = TRUE)[4, 5] expect_equivalent(col, colMeans(s2)) expect_equivalent(row, rowMeans(s2)) expect_equivalent(grand, mean(s2)) }) # test_that("internal margins are computed correctly", { cast <- dcast(chick_m, diet + chick ~ time, length, margins="diet") marg <- subset(cast, diet == "(all)")[-(1:2)] expect_that(as.vector(as.matrix(marg)), equals(as.vector(acast(chick_m, time ~ ., length)))) joint <- subset(cast, diet != "(all)") expect_that(joint, is_equivalent_to(dcast(chick_m, diet + chick ~ time, length))) }) test_that("missing combinations filled correctly", { s2am <- subset(s2m, !(X1 == 1 & X2 == 1)) expect_equal(acast(s2am, X1 ~ X2)[1, 1], NA_integer_) expect_equal(acast(s2am, X1 ~ X2, length)[1, 1], 0) expect_equal(acast(s2am, X1 ~ X2, length, fill = 1)[1, 1], 1) }) test_that("drop = FALSE generates all combinations", { df <- data.frame(x = c("a", "b"), y = c("a", "b"), value = 1:2) expect_that(as.vector(acast(df, x + y ~ ., drop = FALSE)), is_equivalent_to(as.vector(acast(df, x ~ y)))) }) test_that("aggregated values computed correctly", { ffm <- melt(french_fries, id = 1:4) count_c <- function(vars) as.table(acast(ffm, as.list(vars), length)) count_t <- function(vars) table(ffm[vars], useNA = "ifany") combs <- matrix(names(ffm)[1:5][t(combn(5, 2))], ncol = 2) a_ply(combs, 1, function(vars) { expect_that(count_c(vars), is_equivalent_to(count_t(vars)), label = paste(vars, collapse = ", ")) }) }) test_that("value.var overrides value col", { df <- data.frame( id1 = rep(letters[1:2],2), id2 = rep(LETTERS [1:2],each=2), var1=1:4) df.m <- melt(df) df.m$value2 <- df.m$value * 2 expect_that(acast(df.m, id2 + id1 ~ ., value.var="value")[, 1], equals(1:4, check.attributes = FALSE)) expect_that(acast(df.m, id2 + id1 ~ ., value.var="value2")[, 1], equals(2 * 1:4, check.attributes = FALSE)) }) test_that("labels are correct when missing combinations dropped/kept", { df <- data.frame(fac1 = letters[1:4], fac2 = LETTERS[1:4], x = 1:4) mx <- melt(df, id = c("fac1", "fac2"), measure.var = "x") c1 <- dcast(mx[1:2, ], fac1 + fac2 ~ variable, length, drop = F) expect_that(nrow(c1), equals(16)) c2 <- dcast(droplevels(mx[1:2, ]), fac1 + fac2 ~ variable, length, drop = F) expect_that(nrow(c2), equals(4)) c3 <- dcast(mx[1:2, ], fac1 + fac2 ~ variable, length, drop = T) expect_that(nrow(c3), equals(2)) }) test_that("factor value columns are handled", { df <- data.frame(fac1 = letters[1:4], fac2 = LETTERS[1:4], x = factor(1:4)) mx <- melt(df, id = c("fac1", "fac2"), measure.var = "x") c1 <- dcast(mx, fac1 + fac2 ~ variable) expect_that(nrow(c1), equals(4)) expect_that(ncol(c1), equals(3)) expect_is(c1$x, "character") c2 <- dcast(mx, fac1 ~ fac2 + variable) expect_that(nrow(c2), equals(4)) expect_that(ncol(c2), equals(5)) expect_is(c2$A_x, "character") expect_is(c2$B_x, "character") expect_is(c2$C_x, "character") expect_is(c2$D_x, "character") c3 <- acast(mx, fac1 + fac2 ~ variable) expect_that(nrow(c3), equals(4)) expect_that(ncol(c3), equals(1)) expect_true(is.character(c3)) c4 <- acast(mx, fac1 ~ fac2 + variable) expect_that(nrow(c4), equals(4)) expect_that(ncol(c4), equals(4)) expect_true(is.character(c4)) }) test_that("dcast evaluated in correct argument", { g <- c("a", "b") expr <- quote({ df <- data.frame(x = letters[1:2], y = letters[1:3], z = rnorm(6)) g <- c('b', 'a') dcast(df, y ~ ordered(x, levels = g)) }) res <- eval(expr, envir = new.env()) expect_equal(names(res), c("y", "b", "a")) }) reshape2/inst/CITATION0000644000176200001440000000117412057435674014115 0ustar liggesuserscitHeader("To cite reshape in publications use:") citEntry(entry = "Article", title = "Reshaping Data with the {reshape} Package", author = personList(as.person("Hadley Wickham")), journal = "Journal of Statistical Software", year = "2007", volume = "21", number = "12", pages = "1--20", url = "http://www.jstatsoft.org/v21/i12/", textVersion = paste("Hadley Wickham (2007).", "Reshaping Data with the reshape Package.", "Journal of Statistical Software, 21(12), 1-20.", "URL http://www.jstatsoft.org/v21/i12/.") ) reshape2/DESCRIPTION0000644000176200001440000000124512057472355013505 0ustar liggesusersPackage: reshape2 Type: Package Title: Flexibly reshape data: a reboot of the reshape package. Version: 1.2.2 Author: Hadley Wickham Maintainer: Hadley Wickham Description: Reshape lets you flexibly restructure and aggregate data using just two functions: melt and cast. URL: http://had.co.nz/reshape Imports: plyr (>= 1.5), stringr, lattice Suggests: testthat License: MIT LazyData: true Collate: 'cast.r' 'data.r' 'formula.r' 'helper-colsplit.r' 'helper-guess-value.r' 'helper-margins.r' 'melt.r' 'recast.r' 'utils.r' Packaged: 2012-12-04 19:05:50 UTC; hadley Repository: CRAN Date/Publication: 2012-12-04 23:10:53 reshape2/data/0000755000176200001440000000000011440164053012672 5ustar liggesusersreshape2/data/tips.rda0000644000176200001440000000504412057435674014363 0ustar liggesusersݚoh]g￤mZWX풦I&69YVe6p\ƥIMRA"7n/ Ad"|DͶ{~ޛ4cN9y=7>28/rBZTSv+ss{k]koV޼+t+y/ϥc_y}Swe=_h%-L+eǹE\זMOg.`-p_MS˵S>È3yƈ5Tq~(q;sA~=p+lW8`}f?ca̗Kl{YA Giik:7?x9[3lokOם>CWv~` 3x uyc/n}ޟ&y<ž=vaN $\'Cw|A^帏B&_chWsb_=< a_?}5x;Os\DC>8#8Ãw1;Α[kO|O#ϱ؅]Aa[A8C;>:T+3S߹q9^SA}שd eĽ']grn~qKn.Y8;gUԃ^Ĺ w Gv~r؃,q">ĥON`O?OP‘u;3Ů}&7QWu~Ս{vv#.E֡5rΓۍcrMĻvx77ޔrЋ~~2u~H1ޏn_6oF>Uًv qv>u uzLVqN>S vnd(mϑyӱC4}*~/,~-u*-y=coֿ1y^Y8[Ռ~ȷwش4eYk7׊ĨUΛ堝lM+?NFvͬZfk^X;3{:?Qk :WeY^[Y\ng|*VѬiU5e{qunfǨ}v=սfn\F(|b<(VPk'RzTƵclǾUMdލw#wuAvҜth.\^ڒlowõNowus|jsznaav //ЎHD$f!V mtջ>͞~)e1s3Ilݤ?Mf,_:ʮlpY>7Ү nq]^k&;?M7ٻUmg_ g,,T?y)]v._\|Jd+V.sW{t/-~yl=&t\xH'N$Sў=Ҟ=O{ڋ R)A e2H R)U W2\ep*U O2?HEp0_|ccu.ۂ%KM9 Ҥ($37fNL1S33`2<9`VrA2G ĒDDP>breshape2/data/french_fries.rda0000644000176200001440000001630612057435674016044 0ustar liggesusersˎ]uOTK(7I$%K6E]}Qs'ȳD.E'(ϑ #HFi@8A0CN\^iQdpwSUתU7o~«yݕ h収?zc?c;8~惏o}N+m[__?R?K,R?K,cc'>ty~x?z+E,t2A^px!'⻬Ye/_Z{ZzD?FNY R? 7_-nqTR٭a|C|٣Ǘ2L/2L/2L/2L/2L/2H"{{Z\܏/Ͽݼ_~'oR_4.F>8CrWsl\F^ryitw~(w-XGK9ވD7i?ҧz1\\"_jG_"ވzE4'?C8Џ [ 2)x%Y\O}RJ_4.G{~ߥzZ;i-rkqq}9厡F?gWZ\^4CIQy7Gv>~MWEyx&?W~>G>pR q}5O&Sp4.\c\~}Dя+@Ips% W+F=ػ oE(wD~p=%Ww!z?DOgqPo _Ni:8^|=CwW*# }?1/#WG81iWЧ%?'hȳu%vG/6̯oowI<~[ /E?w?~3,I~||'G瓾b_3ɟI//E? ;߯sbݳ-b}LUOy?7۟1>wv>, d'-<}Ob/ce~ KQp#O^>ᑘOp3˸OX\3Obw/#㌞X¯">QN~Og7Ɠy xI)_roZD~pz$a]߸߰lxS<^ZME~w'f~5~o6H/6qwCW5ޯ$}/[ד}iט4?ߎr!I  ^S/ ~Th3~3ƉQkh|NJd"'|"}a.x1߇}xx`ޔ>΄w"%3_E9%<*i><>t4;Ǖ86cqYh ~f5w3zX灗8G pql\^r ~kwio* Nx^X O*8_W?_ dډtCq3yu!;îT/|)˒?nNsOi4gȏ}'}k}AKi}1pj<3ߙg3`W8I>r+`,L{~79i,۳C5e< JC*}ߏqW~O`suljIsIwbǒB;&_Kwq?&4~oOiC~o"):?Ƀ%k^Kŭ<(y#h4~LZ?f;d=?Ӿ~vIX9óӷ+yq?~=+^P|qn-xWbٗ /vϵ^uat"Јw*~|ӢͯWsSIoƼ[8 xg8qC^Z\<~W3}`^&'/WM3 f.n~X^oڭG>S~_%8Oy_ӳ ވE{q{cG<?ܓk~(] qKqǬͧSg\DԃmEOuEM}dkB)я ?M +n~҄RtweA9Q:xM?=ˏ[ci9CTSv[s8radדq"p_7?\,-ɸ_MSY/s/^^x957 F|V~A^8.on_8Pڧc!_WszU:kMC~}Y8j8i}OOz8_gjxaOߖa_a&0'71N?i}~/co,K,lᾺH8x|z^SssO{'yj 釕z' Uyi+q'̍'EIGI [w8nKwG)\Pwߪ|Wٯ`>b^1^o9S?su!7Lr_O`~_ܥ'G+7y>lbŞ@ɏIq@Ϋ}O_Ccpy!~Gw7KXi\9WB1@O87qu'kB%9yN|ySrwmJxu.x.=ΎCzy״jSMbn2~Ǿ\Zsw9k+~styQߟXǩƸH?/ri I9Pcٙ+ U^I|>OzLByey|#u>ʽ5{9s I}wp^u-7{GҼ}D3z;vq~NҰ ) >*qxHS"ުyyijy0cW[qXC'R{/jGx?g<'˼gS.~V>͘g_%?Nc=j̛1˂_'5K%1s ύz/@9?YtD|˯|7L_-ޓr3Ngh7r9r<;*4o Wi^{: ߌ)];X|^Tz}9!Dyx\*X;3%~ϸ^®S}ȏ~hOnH:'ZQ Ir7h51JXg·$y v/~/' 08>Hۓ|N?9˫T9JS53~a8;~Ls~fUq=5=Yy'_cnqHzxUĿWr׬ W>|]N`?OWw*}aϹ}齂'|` .T{q?12o}K5{ĉny3?O\=}7p_u~OCտJd4|KVQ<ߓ Ƽki=/ OvOD ycs1I>s<67T?Lg{g/S#{ɕ3{<ݏ>M۷~rӻqɣwn:\gwo|ݻέ?WέO?W*xO6vgBGgpd௦׽FkuoS:=ljiuO`P-$TK+ 6UK+ 6UK+ 6UK+ :[QV5qEM{~\Q{~\Q{~\Q{ujӯno]$o]UKv7TKvUKg΀Q-Z:IШN4[rtUo 6}SomjM r{7%v㛒sMjMȶ{d vl"s]unNgu>ٴ MkXڴ -khڲ -kxr -qfmlZضmܺEjBkRlbwlrwlCѹujq:WnqDG^]+ٻz!{w]&͆ b﮻)b﮻Ib﮻ib﮻9omo C+ VXZ VK^ Rl lBb, ы(DX8pg7pg7pg7pLӹjz7QpM& D6(wŸᾀX֪p֪64U8Ck73} qLAM qSPS؛))f j {35Yc5Yc5Yc5Yc5Yc5Yc5Yc5Yc5Yc5Yc5Yc5YS̼Tli *64oJu杦bNSPy);m9N[@μ3Lmao&ݶ7n[؛I-ͤfm {3鶶֤Znk{kM5鶶֤ZO­$ZO­$ZO­$ZO­$ZO­$ZO­$Zok{kͿ5Zok{kͿ5}{7l{kmdm9Y[@Fu̿]9oW@3v̿]9oW@3v̿]9oW@3v̿]9oW@3v̿]9oW@3v̿]9oW@3v̿5vۙ[ogmͿ5v۵7og ștr&ݮI+ g ștr&ݮI+ g ștr&ݮI+ g ștr&ݮI+ g ștr&ݮI+ g ștr&ݮI+ g ștr&ݮI+ g̿3vۙ{ogͿ7v~M^C7\o ޤwE۾&L!כt{C7\o ޤrI7zno&ސM!כt{C7\o ޤrI7zno&ސM!כt{C7L}9n_@Τ3̿7ۛ{ooͿ7owÛEw(`o ؛t&ݡIw(`o ؛t&ݡIw(`o ؛t&ݡIw(`o ؛t&ݡIw(`o ؛t&ݡIw(`o ؛tBͰLa?t~0` ;wh?7`Xlo>`{Lm0?`{Lm0LCaz&0=P(L?g 3LCaz&0=P(L?g 3LCaz&=ܜ=_ݺ{޹hJ