diff --git a/NAMESPACE b/NAMESPACE index 9808e3f..75031b3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,10 @@ # Generated by roxygen2: do not edit by hand S3method(aggregate,CompositionMatrix) +S3method(aggregate,GroupedComposition) S3method(as.data.frame,CompositionMatrix) +S3method(as.data.frame,GroupedComposition) +S3method(as.data.frame,GroupedLogRatio) S3method(as.data.frame,LogRatio) S3method(as.data.frame,OutlierIndex) S3method(barplot,CompositionMatrix) @@ -13,6 +16,7 @@ S3method(mahalanobis,CompositionMatrix) S3method(mahalanobis,ILR) S3method(mean,CompositionMatrix) S3method(plot,CompositionMatrix) +S3method(plot,GroupedComposition) S3method(plot,LogRatio) S3method(plot,OutlierIndex) S3method(quantile,CompositionMatrix) @@ -38,9 +42,9 @@ exportMethods("%power%") exportMethods("[") exportMethods("[<-") exportMethods("[[<-") -exportMethods("groups<-") exportMethods("totals<-") exportMethods(aggregate) +exportMethods(all_assigned) exportMethods(any_assigned) exportMethods(as_amounts) exportMethods(as_composition) @@ -52,8 +56,15 @@ exportMethods(covariance) exportMethods(describe) exportMethods(detect_outlier) exportMethods(dist) -exportMethods(extract) -exportMethods(groups) +exportMethods(group) +exportMethods(group_extract) +exportMethods(group_indices) +exportMethods(group_length) +exportMethods(group_levels) +exportMethods(group_names) +exportMethods(group_rows) +exportMethods(group_size) +exportMethods(group_split) exportMethods(hist) exportMethods(is_assigned) exportMethods(is_element_major) @@ -86,6 +97,7 @@ exportMethods(transform_ilr) exportMethods(transform_inverse) exportMethods(transform_lr) exportMethods(transform_plr) +exportMethods(ungroup) exportMethods(univariate_ilr) exportMethods(variance) exportMethods(variance_total) diff --git a/NEWS.md b/NEWS.md index 4cb948c..48c53c7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,11 @@ # nexus 0.3.0.9000 +## New classes and methods +* Add `ReferenceGroups`, `GroupedComposition` and `GroupedLogRatio` classes to represent grouped data. +* Add `group()`, `ungroup()`, `group_levels()`, `group_names()`, `group_indices()`, `group_rows()`, `group_length()`, `group_size()`, `group_extract()` and `group_split()` to work with grouped data. +* Add `transform_lr()`, `transform_clr()`, `transform_alr()`, `transform_ilr()`, `transform_plr()` and `transform_inverse()` methods for `GroupedComposition` and `GroupedLogRatio` objects. + ## Breaking changes +* Redesign the internal mechanism for grouping data. * `hist()` now produces a single histogram. # nexus 0.3.0 diff --git a/R/AllClasses.R b/R/AllClasses.R index 72c26c8..63b9669 100644 --- a/R/AllClasses.R +++ b/R/AllClasses.R @@ -8,36 +8,43 @@ setOldClass("dist") ## (for 'i' in x[i], x[i, ], x[, i], etc.) setClassUnion("index", members = c("logical", "numeric", "character")) -# CompositionMatrix ============================================================ -#' Numeric Matrix +# ReferenceGroups ============================================================== +#' Grouped Data #' -#' S4 classes that represent a \eqn{m \times p}{m x p} numeric matrix. -#' @slot .Data A \eqn{m \times p}{m x p} `numeric` [`matrix`]. -#' @note -#' This class inherits from [`matrix`]. +#' A virtual S4 class to represent reference groups. +#' @slot group_indices An [`integer`] vector to store the group that each value +#' belongs to. +#' @slot group_levels A [`character`] vector to store the values of the grouping +#' variables. +#' @example inst/examples/ex-matrix.R #' @author N. Frerebeau #' @family classes #' @docType class -#' @aliases NumericMatrix-class +#' @aliases ReferenceGroups-class #' @keywords internal -.NumericMatrix <- setClass( - Class = "NumericMatrix", - contains = "matrix" +.ReferenceGroups <- setClass( + Class = "ReferenceGroups", + slots = c( + group_indices = "integer", + group_levels = "character" + ), + contains = c("VIRTUAL") ) -#' Logical Matrix +# CompositionMatrix ============================================================ +#' Numeric Matrix #' -#' S4 classes that represent a \eqn{m \times p}{m x p} logical matrix. -#' @slot .Data A \eqn{m \times p}{m x p} `logical` [`matrix`]. +#' S4 classes that represent a \eqn{m \times p}{m x p} numeric matrix. +#' @slot .Data A \eqn{m \times p}{m x p} `numeric` [`matrix`]. #' @note #' This class inherits from [`matrix`]. #' @author N. Frerebeau #' @family classes #' @docType class -#' @aliases LogicalMatrix-class +#' @aliases NumericMatrix-class #' @keywords internal -.LogicalMatrix <- setClass( - Class = "LogicalMatrix", +.NumericMatrix <- setClass( + Class = "NumericMatrix", contains = "matrix" ) @@ -46,7 +53,6 @@ setClassUnion("index", members = c("logical", "numeric", "character")) #' An S4 class to represent compositional data. #' @slot totals A [`numeric`] vector to store the absolute row sums (before #' the closure of the compositions). -#' @slot groups A [`factor`] vector to store the group names. #' @section Coerce: #' In the code snippets below, `x` is a `CompositionMatrix` object. #' \describe{ @@ -58,7 +64,7 @@ setClassUnion("index", members = c("logical", "numeric", "character")) #' \item{`x[i, j]`}{Extract parts of a matrix (see [`[`][subset]).} #' } #' @note -#' This class inherits from [`matrix`]. +#' This class inherits from [`NumericMatrix-class`]. #' @seealso [as_composition()] #' @example inst/examples/ex-matrix.R #' @author N. Frerebeau @@ -69,19 +75,40 @@ setClassUnion("index", members = c("logical", "numeric", "character")) .CompositionMatrix <- setClass( Class = "CompositionMatrix", slots = c( - totals = "numeric", - groups = "factor" + totals = "numeric" ), contains = c("NumericMatrix") ) +#' Grouped Compositional Matrix +#' +#' An S4 class to represent grouped compositional data. +#' @section Coerce: +#' In the code snippets below, `x` is a `GroupedComposition` object. +#' \describe{ +#' \item{`as.data.frame(x)`}{Coerces to a [`data.frame`].} +#' } +#' @note +#' This class inherits from [`CompositionMatrix-class`] and +#' [`ReferenceGroups-class`]. +#' @seealso [as_composition()] +#' @example inst/examples/ex-matrix.R +#' @author N. Frerebeau +#' @family classes +#' @docType class +#' @aliases GroupedComposition-class +#' @keywords internal +.GroupedComposition <- setClass( + Class = "GroupedComposition", + contains = c("CompositionMatrix", "ReferenceGroups") +) + # Transformations ============================================================== #' Log-Ratio Matrix #' #' S4 classes to represent log-ratio data transformations. #' @slot totals A [`numeric`] vector to store the absolute row sums (before #' the closure of the compositions). -#' @slot groups A [`factor`] vector to store the group names. #' @slot parts A [`character`] vector to store the original part names. #' @slot ratio A [`character`] vector to store the ratio names. #' @slot order An [`integer`] vector to store the original ordering of the @@ -107,8 +134,6 @@ setClassUnion("index", members = c("logical", "numeric", "character")) Class = "LogRatio", slots = c( totals = "numeric", - groups = "factor", - parts = "character", ratio = "character", order = "integer", @@ -153,12 +178,71 @@ setClassUnion("index", members = c("logical", "numeric", "character")) contains = "ILR" ) +#' Grouped Log-Ratio Matrix +#' +#' An S4 class to represent grouped log-ratio. +#' @section Coerce: +#' In the code snippets below, `x` is a `GroupedLogRatio` object. +#' \describe{ +#' \item{`as.data.frame(x)`}{Coerces to a [`data.frame`].} +#' } +#' @note +#' This class inherits from [`LogRatio-class`] and +#' [`ReferenceGroups-class`]. +#' @example inst/examples/ex-matrix.R +#' @author N. Frerebeau +#' @family classes +#' @docType class +#' @name GroupedLogRatio-class +#' @rdname GroupedLogRatio-class +#' @keywords internal +NULL + +#' @rdname GroupedLogRatio-class +#' @aliases GroupedLR-class +.GroupedLR <- setClass( + Class = "GroupedLR", + contains = c("LR", "ReferenceGroups") +) + +#' @rdname GroupedLogRatio-class +#' @aliases GroupedCLR-class +.GroupedCLR <- setClass( + Class = "GroupedCLR", + contains = c("CLR", "ReferenceGroups") +) + +#' @rdname GroupedLogRatio-class +#' @aliases GroupedALR-class +.GroupedALR <- setClass( + Class = "GroupedALR", + contains = c("ALR", "ReferenceGroups") +) + +#' @rdname GroupedLogRatio-class +#' @aliases GroupedILR-class +.GroupedILR <- setClass( + Class = "GroupedILR", + contains = c("ILR", "ReferenceGroups") +) + +#' @rdname GroupedLogRatio-class +#' @aliases GroupedPLR-class +.GroupedPLR <- setClass( + Class = "GroupedPLR", + contains = c("PLR", "ReferenceGroups") +) + +setClassUnion( + name = "GroupedLogRatio", + members = c("GroupedLR", "GroupedCLR", "GroupedALR", "GroupedILR", "GroupedPLR") +) + # OutlierIndex ================================================================= #' Outliers #' #' An S4 class to store the result of outlier detection. #' @slot samples A [`character`] vector to store the sample identifiers. -#' @slot groups A [`factor`] vector to store the group names. #' @slot standard A [`numeric`] matrix giving the standard squared Mahalanobis #' distances. #' @slot robust A [`numeric`] matrix giving the robust squared Mahalanobis @@ -180,7 +264,6 @@ setClassUnion("index", members = c("logical", "numeric", "character")) Class = "OutlierIndex", slots = c( samples = "character", - groups = "factor", standard = "numeric", robust = "numeric", limit = "numeric", diff --git a/R/AllGenerics.R b/R/AllGenerics.R index 65ca4f6..5bca1f6 100644 --- a/R/AllGenerics.R +++ b/R/AllGenerics.R @@ -183,6 +183,54 @@ setGeneric( ) # Extract ====================================================================== + + +## Subset ---------------------------------------------------------------------- +#' Extract or Replace Parts of an Object +#' +#' Operators acting on objects to extract or replace parts. +#' @param x An object from which to extract element(s) or in which to replace +#' element(s). +#' @param i,j Indices specifying elements to extract or replace. Indices are +#' [`numeric`], [`integer`] or [`character`] vectors or empty (missing) or +#' `NULL`. Numeric values are coerced to [`integer`] as by [as.integer()]. +#' Character vectors will be matched to the name of the elements. +#' An empty index (a comma separated blank) indicates that all entries in that +#' dimension are selected. +#' @param value A possible value for the element(s) of `x`. +#' @param drop A [`logical`] scalar: should the result be coerced to +#' the lowest possible dimension? This only works for extracting elements, +#' not for the replacement. Defaults to `FALSE`. +#' @param ... Currently not used. +# @section Subcomposition: +# If `drop` is `FALSE`, subsetting some of the possible components of a +# [`CompositionMatrix-class`] object will produce a closed *subcomposition* +# (see examples). +#' @return +#' A subsetted object of the same sort as `x`. +#' @example inst/examples/ex-subset.R +#' @author N. Frerebeau +#' @docType methods +#' @family subsetting methods +#' @name subset +#' @rdname subset +NULL + +#' Combine Two Composition Matrices +#' +#' @param x,y A [`CompositionMatrix-class`] object. +#' @details +#' `rbind2()` combine by rows. +#' @return +#' A [`CompositionMatrix-class`] objects. +#' @example inst/examples/ex-split.R +#' @author N. Frerebeau +#' @docType methods +#' @family subsetting methods +#' @name bind +#' @rdname bind +NULL + ## Mutators -------------------------------------------------------------------- #' Get or Set Parts of an Object #' @@ -224,55 +272,173 @@ setGeneric( def = function(object, value) standardGeneric("totals<-") ) +#' Matrix Transpose +#' +#' @param x A [`CompositionMatrix-class`] object. +#' @return +#' A `matrix`, with dim and dimnames constructed appropriately from those of `x`. +#' @note +#' Implemented only to ensure that `t()` always returns a base `matrix`. +#' @example inst/examples/ex-subset.R +#' @author N. Frerebeau +#' @docType methods +# @family mutators +#' @keywords internal +#' @name t +#' @rdname t +NULL + +# Groups ======================================================================= #' Working With Groups #' -#' Retrieves or defines the (reference) groups to which the observations belong. -#' @param object An object from which to get or set `groups`. -#' @param value A possible value for the `groups` of `x` (typically, a -#' [`character`] vector). -#' If `value` is a [`list`], [`interaction(value)`][interaction()] defines the -#' grouping. +#' Define or remove the (reference) groups to which the observations belong. +#' @param object An \R object from which to set groups. +#' @param by A possible value for the groups of `object` (typically, a +#' [`character`] vector). If `value` is a [`list`], +#' [`interaction(by)`][interaction()] defines the grouping. +#' @param add A [`logical`] scalar. If `TRUE`, add to existing groups. +#' @param verbose A [`logical`] scalar: should \R report extra information +#' on progress? +#' @param ... Further parameters to be passed to internal methods. #' @details -#' Missing values (`NA`) or empty strings (`""`) can be used to specify that a -#' sample does not belong to any group. +#' Missing values (`NA`) can be used to specify that a sample does not belong +#' to any group. #' @return -#' * `groups() <- value` returns an object of the same sort as `x` with the new -#' group names assigned. -#' * `groups()` returns a [`character`] vector giving the group names of `x`. -#' * `any_assigned()` returns a [`logical`] scalar specifying whether or not -#' `x` has groups. -#' * `is_assigned()` returns a [`logical`] vector specifying whether or not an -#' observation belongs to a group. -#' @example inst/examples/ex-groups.R +#' * `group()` returns an object of the same sort as `object` with the new +#' groups assigned. +#' * `ungroup()` returns a [`character`] vector giving the group names of `x`. +#' @example inst/examples/ex-group.R #' @author N. Frerebeau #' @docType methods -#' @family mutators -#' @aliases groups-method +#' @family grouping methods +#' @aliases group-method setGeneric( - name = "groups", - def = function(object) standardGeneric("groups") + name = "group", + def = function(object, ...) standardGeneric("group") ) -#' @rdname groups +#' @rdname group setGeneric( - name = "groups<-", - def = function(object, value) standardGeneric("groups<-") + name = "ungroup", + def = function(object, ...) standardGeneric("ungroup") ) -#' @rdname groups -#' @aliases any_assigned-method +#' Grouping Metadata +#' +#' Retrieve the (reference) groups to which the observations belong. +#' @param object A [grouped][group()] \R object. +#' @example inst/examples/ex-group.R +#' @author N. Frerebeau +#' @docType methods +#' @family grouping methods +#' @name group_metadata +#' @rdname group_metadata +NULL + +#' @rdname group_metadata +#' @aliases group_levels-method setGeneric( - name = "any_assigned", - def = function(object) standardGeneric("any_assigned") + name = "group_levels", + def = function(object) standardGeneric("group_levels") +) + +#' @rdname group_metadata +#' @aliases group_names-method +setGeneric( + name = "group_names", + def = function(object) standardGeneric("group_names") +) + +#' @rdname group_metadata +#' @aliases group_rows-method +setGeneric( + name = "group_rows", + def = function(object) standardGeneric("group_rows") +) + +#' @rdname group_metadata +#' @aliases group_length-method +setGeneric( + name = "group_length", + def = function(object) standardGeneric("group_length") +) + +#' @rdname group_metadata +#' @aliases group_size-method +setGeneric( + name = "group_size", + def = function(object) standardGeneric("group_size") ) -#' @rdname groups +#' @rdname group_metadata +#' @aliases group_indices-method +setGeneric( + name = "group_indices", + def = function(object) standardGeneric("group_indices") +) + +#' @rdname group_metadata #' @aliases is_assigned-method setGeneric( name = "is_assigned", def = function(object) standardGeneric("is_assigned") ) +#' @rdname group_metadata +#' @aliases any_assigned-method +setGeneric( + name = "any_assigned", + def = function(object) standardGeneric("any_assigned") +) + +#' @rdname group_metadata +#' @aliases any_assigned-method +setGeneric( + name = "all_assigned", + def = function(object) standardGeneric("all_assigned") +) + +#' Divide into Groups +#' +#' Divides a compositional matrix by groups. +#' @param object,x A [`CompositionMatrix-class`] object. +#' @param by A `vector` or a list of grouping elements, each as long as the +#' variables in `object` (see [group()]). +#' @param f A 'factor' in the sense that [`as.factor(f)`][as.factor()] defines +#' the grouping, or a list of such factors in which case their interaction is +#' used for the grouping (see [base::split()]). +#' @param drop A [`logical`] scalar: should levels that do not occur be dropped? +#' @param ... Currently not used. +#' @return +#' A `list` of [`CompositionMatrix-class`] objects. +#' @example inst/examples/ex-split.R +#' @author N. Frerebeau +#' @docType methods +#' @family grouping methods +#' @aliases group_split-method +setGeneric( + name = "group_split", + def = function(object, ...) standardGeneric("group_split") +) + +#' Group-based Subset +#' +#' @param object A [`GroupedComposition-class`] object. +#' @param which A [`character`] vector specifying the [groups][group()] of +#' `object` to extract. +#' @param ... Currently not used. +#' @return +#' A [`CompositionMatrix-class`] object. +#' @example inst/examples/ex-group.R +#' @author N. Frerebeau +#' @docType methods +#' @family grouping methods +#' @aliases group_extract-method +setGeneric( + name = "group_extract", + def = function(object, ...) standardGeneric("group_extract") +) + # Tools ======================================================================== #' Chemical Elements and Oxides #' @@ -339,105 +505,6 @@ setGeneric( valueClass = "logical" ) -## Subset ---------------------------------------------------------------------- -#' Extract or Replace Parts of an Object -#' -#' Operators acting on objects to extract or replace parts. -#' @param x An object from which to extract element(s) or in which to replace -#' element(s). -#' @param i,j Indices specifying elements to extract or replace. Indices are -#' [`numeric`], [`integer`] or [`character`] vectors or empty (missing) or -#' `NULL`. Numeric values are coerced to [`integer`] as by [as.integer()]. -#' Character vectors will be matched to the name of the elements. -#' An empty index (a comma separated blank) indicates that all entries in that -#' dimension are selected. -#' @param value A possible value for the element(s) of `x`. -#' @param drop A [`logical`] scalar: should the result be coerced to -#' the lowest possible dimension? This only works for extracting elements, -#' not for the replacement. Defaults to `FALSE`. -#' @param ... Currently not used. -# @section Subcomposition: -# If `drop` is `FALSE`, subsetting some of the possible components of a -# [`CompositionMatrix-class`] object will produce a closed *subcomposition* -# (see examples). -#' @return -#' A subsetted object of the same sort as `x`. -#' @example inst/examples/ex-subset.R -#' @author N. Frerebeau -#' @docType methods -#' @family subsetting methods -#' @name subset -#' @rdname subset -NULL - -#' Group-based Subset -#' -#' @param object A [`CompositionMatrix-class`] object. -#' @param name A [`character`] vector specifying the [group][groups()] of -#' `object` to extract. -#' @param ... Currently not used. -#' @return -#' A [`CompositionMatrix-class`] object. -#' @example inst/examples/ex-groups.R -#' @author N. Frerebeau -#' @docType methods -#' @family subsetting methods -#' @aliases extract-method -setGeneric( - name = "extract", - def = function(object, ...) standardGeneric("extract") -) - -#' Divide into Groups -#' -#' Divides the compositional matrix `x` into the groups defined by `f`. -#' @param x A [`CompositionMatrix-class`] object. -#' @param f A 'factor' in the sense that [`as.factor(f)`][as.factor()] defines -#' the grouping, or a list of such factors in which case their interaction is -#' used for the grouping (see [base::split()]). -#' @param drop A [`logical`] scalar: should levels that do not occur be dropped? -#' @param ... Currently not used. -#' @return -#' A `list` of [`CompositionMatrix-class`] objects. -#' @example inst/examples/ex-split.R -#' @author N. Frerebeau -#' @docType methods -#' @family subsetting methods -#' @name split -#' @rdname split -NULL - -#' Combine Two Composition Matrices -#' -#' @param x,y A [`CompositionMatrix-class`] object. -#' @details -#' `rbind2()` combine by rows. -#' @return -#' A [`CompositionMatrix-class`] objects. -#' @example inst/examples/ex-split.R -#' @author N. Frerebeau -#' @docType methods -#' @family subsetting methods -#' @name bind -#' @rdname bind -NULL - -#' Matrix Transpose -#' -#' @param x A [`CompositionMatrix-class`] object. -#' @return -#' A `matrix`, with dim and dimnames constructed appropriately from those of `x`. -#' @note -#' Implemented only to ensure that `t()` always returns a base `matrix`. -#' @example inst/examples/ex-subset.R -#' @author N. Frerebeau -#' @docType methods -# @family mutators -#' @keywords internal -#' @name t -#' @rdname t -NULL - # Log-Ratio ==================================================================== ## LR -------------------------------------------------------------------------- #' Pairwise Log-Ratios (LR) @@ -690,8 +757,7 @@ setGeneric( #' returns the result. #' @param x A [`CompositionMatrix-class`] object. #' @param by A `vector` or a list of grouping elements, each as long as the -#' variables in `x`. The elements are coerced to factors before use -#' (in the sense that [`interaction(by)`][interaction()] defines the grouping). +#' variables in `x` (see [group()]). #' @param FUN A [`function`] to compute the summary statistics. #' @param simplify A [`logical`] scalar: should the results be simplified to a #' matrix if possible? @@ -751,8 +817,9 @@ NULL #' Splits the data into subsets and computes compositional mean for each. #' @param x A [`CompositionMatrix-class`] object. #' @param by A `vector` or a list of grouping elements, each as long as the -#' variables in `x`. The elements are coerced to factors before use -#' (in the sense that [`interaction(by)`][interaction()] defines the grouping). +#' variables in `x` (see [group()]). +#' @param verbose A [`logical`] scalar: should \R report extra information +#' on progress? #' @param ... Further arguments to be passed to [mean()]. #' @return A [`CompositionMatrix-class`] object. #' @seealso [mean()], [aggregate()] @@ -1038,8 +1105,6 @@ NULL #' #' Displays a compositional bar chart. #' @param height A [`CompositionMatrix-class`] object. -#' @param by A `vector` of grouping elements, as long as the variables in -#' `height`. #' @param order_columns A [`logical`] scalar: should should columns be reorderd? #' @param order_rows An [`integer`] vector giving the index of the column to be #' used for the ordering of the data. @@ -1111,7 +1176,6 @@ NULL #' #' Displays a matrix of ternary plots. #' @param x A [`CompositionMatrix-class`] object. -#' @param by A `vector` of grouping elements, as long as the variables in `x`. #' @param color A palette [`function`] that when called with a single #' argument returns a `character` vector of colors. #' @param symbol A palette [`function`] that when called with a single @@ -1125,8 +1189,8 @@ NULL #' @author N. Frerebeau #' @docType methods #' @family plot methods -#' @name plot -#' @rdname plot +#' @name pairs +#' @rdname pairs NULL ## Density --------------------------------------------------------------------- @@ -1134,10 +1198,9 @@ NULL #' #' Displays a density plot. #' @param x A [`LogRatio-class`] object. -#' @param by A `vector` of grouping elements, as long as the variables in -#' `x`. If set, a matrix of panels defined by `groups` will be drawn. #' @param color A palette [`function`] that when called with a single -#' argument returns a `character` vector of colors. +#' argument returns a `character` vector of colors (only used if `x` +#' [is grouped][group()]). #' @param rug A [`logical`] scalar: should a *rug* representation (1-d plot) of #' the data be added to the plot? #' @param ticksize A length-one [`numeric`] vector giving the length of the @@ -1166,8 +1229,8 @@ NULL #' @author N. Frerebeau #' @docType methods #' @family plot methods -#' @name plot_logratio -#' @rdname plot_logratio +#' @name plot +#' @rdname plot NULL ## Graph ----------------------------------------------------------------------- @@ -1382,9 +1445,6 @@ setGeneric( #' Any unambiguous substring can be given. #' @param robust A [`logical`] scalar: should robust Mahalanobis distances be #' displayed? Only used if `type` is "`dotchart`". -#' @param colors A vector of colors or a `function` that when called with a -#' single argument (an integer specifying the number of colors) returns a -#' vector of colors. Will be mapped to the group names. #' @param symbols A lenth-three vector of symbol specification for non-outliers #' and outliers (resp.). #' @param xlim A length-two [`numeric`] vector giving the x limits of the plot. @@ -1409,7 +1469,7 @@ setGeneric( #' @param legend A [`list`] of additional arguments to be passed to #' [graphics::legend()]; names of the list are used as argument names. #' If `NULL`, no legend is displayed. -#' @param ... Further [graphical parameters][graphics::par()]. +#' @param ... Further parameters to be passed to [graphics::points()]. #' @return #' `plot()` is called for its side-effects: is results in a graphic being #' displayed (invisibly return `x`). diff --git a/R/aggregate.R b/R/aggregate.R index b3a697e..bd7a51e 100644 --- a/R/aggregate.R +++ b/R/aggregate.R @@ -7,23 +7,25 @@ NULL #' @method aggregate CompositionMatrix aggregate.CompositionMatrix <- function(x, by, FUN, ..., simplify = TRUE, drop = TRUE) { - m <- nrow(x) + x <- group(x, by = by, drop_levels = drop) + aggregate(x, FUN, ..., simplify = simplify) +} - ## Grouping - index <- as_groups(by) - if (nlevels(index) == 0 || nlevels(index) == m) { - warning("Nothing to group by.", call. = FALSE) - return(x) - } +#' @export +#' @rdname aggregate +#' @aliases aggregate,CompositionMatrix-method +setMethod("aggregate", "CompositionMatrix", aggregate.CompositionMatrix) - aggr <- tapply( - X = seq_len(m), - INDEX = index, +#' @export +#' @method aggregate GroupedComposition +aggregate.GroupedComposition <- function(x, FUN, ..., simplify = TRUE) { + ## Grouping + aggr <- lapply( + X = group_rows(x), FUN = function(i, data, fun, ...) fun(data[i, , drop = FALSE], ...), data = x, fun = FUN, - ..., - simplify = FALSE + ... ) has_dim <- vapply( @@ -33,10 +35,12 @@ aggregate.CompositionMatrix <- function(x, by, FUN, ..., ) if (any(has_dim) || !simplify) return(aggr) - do.call(rbind, aggr) + aggr <- do.call(rbind, aggr) + rownames(aggr) <- group_levels(x) + aggr } #' @export #' @rdname aggregate -#' @aliases aggregate,CompositionMatrix-method -setMethod("aggregate", "CompositionMatrix", aggregate.CompositionMatrix) +#' @aliases aggregate,GroupedComposition-method +setMethod("aggregate", "GroupedComposition", aggregate.GroupedComposition) diff --git a/R/barplot.R b/R/barplot.R index 1ba786a..a038b85 100644 --- a/R/barplot.R +++ b/R/barplot.R @@ -6,7 +6,6 @@ NULL #' @export #' @method barplot CompositionMatrix barplot.CompositionMatrix <- function(height, ..., - by = groups(height), order_columns = FALSE, order_rows = NULL, decreasing = TRUE, space = 0.2, offset = 0.025, @@ -18,7 +17,7 @@ barplot.CompositionMatrix <- function(height, ..., } ## Prepare data - xy <- prepare_barplot(height, groups = by, order_columns = order_columns, + xy <- prepare_barplot(height, order_columns = order_columns, order_rows = order_rows, decreasing = decreasing, offset = offset) parts <- factor(xy$data$column, levels = colnames(height)) @@ -99,27 +98,20 @@ barplot.CompositionMatrix <- function(height, ..., #' @aliases barplot,CompositionMatrix-method setMethod("barplot", c(height = "CompositionMatrix"), barplot.CompositionMatrix) -prepare_barplot <- function(x, groups = NULL, - order_rows = NULL, order_columns = FALSE, +prepare_barplot <- function(x, order_rows = NULL, order_columns = FALSE, decreasing = TRUE, offset = 0.025) { - ## Prepare groups - n <- nrow(x) - grp <- as_groups(groups, drop_na = FALSE) - if (nlevels(grp) == 0 || nlevels(grp) == n) grp <- rep("", n) - ## Relative frequencies + n <- nrow(x) x <- x / rowSums(x) ## Validation - stopifnot(methods::is(x, "CompositionMatrix")) - arkhe::assert_length(grp, n) + stopifnot(is_coda(x)) ## Row order if (!is.null(order_rows)) { j <- x[, order_rows, drop = TRUE] i <- order(j, decreasing = decreasing) x <- x[i, , drop = FALSE] - grp <- grp[i] } ## Columns order @@ -131,7 +123,10 @@ prepare_barplot <- function(x, groups = NULL, } ## Grouping - spl <- split(x = x, f = grp) + if (!is_grouped(x)) { + x <- group(x, by = rep(NA, n), verbose = FALSE) + } + spl <- group_split(x) z <- do.call(rbind, spl) ## Build a long table @@ -150,8 +145,8 @@ prepare_barplot <- function(x, groups = NULL, data$y <- as.vector(n + 1 - as.numeric(row)) / n # Reverse levels order ## Offset - n_grp <- length(spl) - n_spl <- tapply(X = grp, INDEX = grp, FUN = length) + n_grp <- group_length(x) + n_spl <- group_size(x) offset <- rev(seq_len(n_grp)) * offset - offset data$y <- data$y + rep(offset, n_spl)[as.numeric(row)] diff --git a/R/coerce.R b/R/coerce.R index 6dd7121..24683d7 100644 --- a/R/coerce.R +++ b/R/coerce.R @@ -31,8 +31,7 @@ setMethod( totals <- rowSums(from, na.rm = TRUE) from <- from / totals - grp <- as_groups(rep(NA, nrow(from))) - .CompositionMatrix(from, totals = unname(totals), groups = grp) + .CompositionMatrix(from, totals = unname(totals)) } ) @@ -49,20 +48,14 @@ setMethod( rownames(from) <- if (has_rownames(from)) rownames(from) else lab colnames(from) <- make_names(x = colnames(from), n = ncol(from), prefix = "V") - ## Group names - grp <- rep(NA_character_, nrow(from)) - if (!is.null(groups)) grp <- from[, groups, drop = FALSE] - grp <- as_groups(grp) - ## Remove non-numeric columns if (is.null(parts)) { parts <- arkhe::detect(from, f = is.double, margin = 2) # Logical - if (verbose) { + if (isTRUE(verbose)) { n <- sum(parts) - what <- ngettext(n, "part", "parts") + what <- ngettext(n, "Found %g part (%s)", "Found %g parts (%s)") cols <- paste0(colnames(from)[parts], collapse = ", ") - msg <- "Found %g %s (%s)." - message(sprintf(msg, n, what, cols)) + message(sprintf(what, n, cols)) } } else { if (is.numeric(parts)) parts <- seq_len(ncol(from)) %in% parts @@ -76,7 +69,12 @@ setMethod( totals <- rowSums(coda, na.rm = TRUE) coda <- coda / totals - .CompositionMatrix(coda, totals = unname(totals), groups = grp) + z <- .CompositionMatrix(coda, totals = unname(totals)) + if (is.null(groups)) return(z) + + ## Group names + grp <- from[, groups, drop = FALSE] + group(z, by = grp, verbose = verbose) } ) @@ -93,46 +91,40 @@ setMethod( ) # To data.frame ================================================================ -# @export -# @rdname augment -# @aliases augment,CompositionMatrix-method -# setMethod( -# f = "augment", -# signature = c(x = "CompositionMatrix"), -# definition = function(x) { -# data.frame( -# .group = groups(x), -# x -# ) -# } -# ) - -# @export -# @rdname augment -# @aliases augment,LogRatio-method -# setMethod( -# f = "augment", -# signature = c(x = "LogRatio"), -# definition = function(x) { -# data.frame( -# .group = groups(x), -# x -# ) -# } -# ) - #' @method as.data.frame CompositionMatrix #' @export as.data.frame.CompositionMatrix <- function(x, ...) { as.data.frame(methods::as(x, "matrix"), row.names = rownames(x)) } +#' @method as.data.frame GroupedComposition +#' @export +as.data.frame.GroupedComposition <- function(x, ..., group_var = ".group") { + z <- data.frame( + methods::as(x, "matrix"), + row.names = rownames(x) + ) + z[[group_var]] <- group_names(x) + z +} + #' @method as.data.frame LogRatio #' @export as.data.frame.LogRatio <- function(x, ...) { as.data.frame(methods::as(x, "matrix"), row.names = rownames(x)) } +#' @method as.data.frame GroupedLogRatio +#' @export +as.data.frame.GroupedLogRatio <- function(x, ..., group_var = ".group") { + z <- data.frame( + methods::as(x, "matrix"), + row.names = rownames(x) + ) + z[[group_var]] <- group_names(x) + z +} + #' @method as.data.frame OutlierIndex #' @export as.data.frame.OutlierIndex <- function(x, ...) { diff --git a/R/condense.R b/R/condense.R index 1aba536..4677c26 100644 --- a/R/condense.R +++ b/R/condense.R @@ -7,36 +7,36 @@ NULL #' @aliases condense,CompositionMatrix-method setMethod( f = "condense", - signature = c("CompositionMatrix"), - definition = function(x, by = groups(x), ...) { - m <- nrow(x) + signature = "CompositionMatrix", + definition = function(x, by, verbose = getOption("nexus.verbose"), ...) { + x <- group(x, by = by) + methods::callGeneric(x = x, verbose = verbose, ...) + } +) +#' @export +#' @rdname condense +#' @aliases condense,GroupedComposition-method +setMethod( + f = "condense", + signature = "GroupedComposition", + definition = function(x, by = NULL, verbose = getOption("nexus.verbose"), ...) { ## Grouping - index <- as_groups(by) - if (nlevels(index) == 0 || nlevels(index) == m) { - warning("Nothing to group by.", call. = FALSE) - return(x) - } - - z <- tapply( - X = seq_len(m), - INDEX = index, - FUN = function(i, data, ...) { - mean(data[i, , drop = FALSE], ...) - }, - data = x, - ..., - simplify = FALSE - ) - z <- do.call(rbind, z) + grp <- group_factor(x) + if (!is.null(by)) x <- group(x, by = by, verbose = verbose) - tot <- tapply(X = totals(x), INDEX = index, FUN = mean, simplify = TRUE) - grp <- groups(x) + ## Compute mean + z <- aggregate(x, FUN = mean, ..., simplify = TRUE) + tot <- tapply(X = totals(x), INDEX = group_factor(x), FUN = mean) - if (nlevels(grp) > 0) grp <- flatten_chr(x = grp, by = index) - else grp <- rep(NA, nlevels(index)) - - rownames(z) <- levels(index) - .CompositionMatrix(z, totals = as.numeric(tot), groups = as_groups(grp)) + z <- .CompositionMatrix(z, totals = as.numeric(tot)) + group(z, by = flatten_chr(x = grp, by = group_factor(x)), verbose = verbose) } ) + +flatten_chr <- function(x, by) { + x <- as.character(x) + z <- tapply(X = x, INDEX = by, FUN = unique, simplify = FALSE) + z <- vapply(X = z, FUN = paste0, FUN.VALUE = character(1), collapse = ":") + z +} diff --git a/R/describe.R b/R/describe.R index aa6a687..be2fe1b 100644 --- a/R/describe.R +++ b/R/describe.R @@ -12,48 +12,75 @@ setMethod( ## Dimensions m <- nrow(x) p <- ncol(x) + rows <- sprintf(ngettext(m, "%d composition", "%d compositions"), m) + cols <- sprintf(ngettext(p, "with %d part", "with %d parts"), p) + msg_tbl <- sprintf("%s %s:", rows, cols) - rows <- ngettext(m, "composition", "compositions") - cols <- ngettext(p, "part", "parts") + ## Message + cat(msg_tbl) + .describe(x) - msg_tbl <- sprintf("%d %s with %d %s:", m, rows, p, cols) - - ## Missing values - m_NA <- sum(arkhe::detect(x, f = is.na, margin = 1)) - p_NA <- sum(arkhe::detect(x, f = is.na, margin = 2)) - - rows_NA <- ngettext(m_NA, "composition", "compositions") - cols_NA <- ngettext(p_NA, "part", "parts") - - pc <- arkhe::label_percent(c(m_NA / m, p_NA / p), digits = 1, trim = TRUE) - pc_NA <- sprintf(" (%s)", pc) - - msg_row_NA <- sprintf("%d %s%s containing missing values.", m_NA, rows_NA, pc_NA[[1]]) - msg_col_NA <- sprintf("%d %s%s containing missing values.", p_NA, cols_NA, pc_NA[[2]]) + invisible(x) + } +) - ## Constant columns - p_var <- sum(arkhe::detect(x, f = function(x) is_unique(x), margin = 2)) - cols_var <- ngettext(p_var, "part", "parts") - msg_col_var <- sprintf("%d %s with no variance.", p_var, cols_var) +#' @export +#' @rdname describe +#' @aliases describe,GroupedComposition-method +setMethod( + f = "describe", + signature = c(x = "GroupedComposition"), + definition = function(x) { + ## Dimensions + m <- nrow(x) + p <- ncol(x) - ## Sparsity - spa <- arkhe::sparsity(x, count = FALSE) - msg_spa <- sprintf("%s of values are zero.", label_percent(spa, digits = 1)) + rows <- sprintf(ngettext(m, "%d composition", "%d compositions"), m) + cols <- sprintf(ngettext(p, "with %d part", "with %d parts"), p) + msg_tbl <- sprintf("%s %s:", rows, cols) ## Groups - groups <- groups(x) - grp <- unique(groups[!is.na(groups)]) - n_grp <- length(grp) - n_ung <- sum(is.na(groups)) - ls_grp <- if (n_grp == 0) "" else paste0(": ", paste0(dQuote(grp), collapse = ", ")) - msg_grp <- sprintf("%d %s%s.", n_grp, ngettext(n_grp, "group", "groups"), - ls_grp) - msg_ung <- sprintf("%d unassigned %s.", n_ung, ngettext(n_ung, "sample", "samples")) + i <- group_length(x) + ls_grp <- paste0(dQuote(group_levels(x)), collapse = ", ") + msg_grp <- sprintf(ngettext(i, "%d group", "%d groups"), i) + msg_grp <- sprintf("%s: %s.", msg_grp, ls_grp) + + j <- sum(!is_assigned(x)) + msg_ung <- sprintf(ngettext(j, "%d unassigned sample.", "%d unassigned samples."), j) cat(msg_tbl, msg_grp, msg_ung, sep = "\n* ") - cat("\nData checking:", msg_spa, msg_col_var, sep = "\n* ") - cat("\nMissing values:", msg_row_NA, msg_col_NA, sep = "\n* ") + .describe(x) invisible(x) } ) + +.describe <- function(x) { + m <- nrow(x) + p <- ncol(x) + + ## Missing values + m_NA <- sum(arkhe::detect(x, f = is.na, margin = 1)) + p_NA <- sum(arkhe::detect(x, f = is.na, margin = 2)) + + rows_NA <- ngettext(m_NA, "composition", "compositions") + cols_NA <- ngettext(p_NA, "part", "parts") + + pc <- arkhe::label_percent(c(m_NA / m, p_NA / p), digits = 1, trim = TRUE) + pc_NA <- sprintf(" (%s)", pc) + + msg_row_NA <- sprintf("%d %s%s containing missing values.", m_NA, rows_NA, pc_NA[[1]]) + msg_col_NA <- sprintf("%d %s%s containing missing values.", p_NA, cols_NA, pc_NA[[2]]) + + ## Constant columns + p_var <- sum(arkhe::detect(x, f = function(x) is_unique(x), margin = 2)) + cols_var <- ngettext(p_var, "%d part with no variance.", "%d parts with no variance.") + msg_col_var <- sprintf(cols_var, p_var) + + ## Sparsity + spa <- arkhe::sparsity(x, count = FALSE) + msg_spa <- sprintf("%s of values are zero.", label_percent(spa, digits = 1)) + + cat("\nData checking:", msg_spa, msg_col_var, sep = "\n* ") + cat("\nMissing values:", msg_row_NA, msg_col_NA, sep = "\n* ") +} diff --git a/R/group.R b/R/group.R index 4189a9d..c619afa 100644 --- a/R/group.R +++ b/R/group.R @@ -3,21 +3,21 @@ NULL #' @export -#' @rdname extract -#' @aliases extract,CompositionMatrix-method +#' @rdname group_extract +#' @aliases group_extract,GroupedComposition-method setMethod( - f = "extract", - signature = c("CompositionMatrix"), - definition = function(object, name) { + f = "group_extract", + signature = c("GroupedComposition"), + definition = function(object, which) { ## Validation - arkhe::assert_type(name, "character") + arkhe::assert_type(which, "character") if (!any_assigned(object)) stop("No group is defined.", call. = FALSE) - ok <- groups(object) %in% name + ok <- group_names(object) %in% which if (!any(ok)) { - g <- ngettext(length(name), "group", "groups") - msg <- "No sample belongs to the %s %s." - message(sprintf(msg, g, paste0(dQuote(name), collapse = ", "))) + msg <- ngettext(length(which), "No sample belongs to the group: %s.", + "No sample belongs to the groups: %s.") + message(sprintf(msg, paste0(dQuote(which), collapse = ", "))) return(object) } @@ -26,88 +26,238 @@ setMethod( ) # Groups ======================================================================= -as_groups <- function(x, drop_levels = TRUE, drop_na = TRUE) { - if (!is.factor(x)) { - if (!is.list(x)) x <- list(x) - x <- rapply( - object = x, - f = function(x) { - x[x == ""] <- NA - x - }, - classes = "character", - how = "replace" - ) - x <- interaction(x, sep = "_") - } +#' Compute Groups +#' +#' @param x A ([`list`] of) [`factors`] for which interaction is to be computed. +#' @param drop_levels A [`logical`] scalar: should unused factor levels be +#' dropped? +#' @param allow_na A [`logical`] scalar: should `NA` be considered an extra +#' level? +#' @return A [`factor`] vector. +#' @keywords internal +#' @noRd +compute_groups <- function(x, drop_levels = TRUE, allow_na = TRUE) { + if (!is.list(x)) x <- list(x) + x <- interaction(x, sep = "_") if (drop_levels) x <- droplevels(x) - if (!drop_na) x <- addNA(x, ifany = TRUE) + if (allow_na) x <- addNA(x, ifany = TRUE) + x } -in_groups <- function(x) { - !is.na(x) & x != "" -} #' @export -#' @rdname groups -#' @aliases is_assigned,CompositionMatrix-method -setMethod("is_assigned", "CompositionMatrix", function(object) in_groups(groups(object))) +#' @rdname group +#' @aliases group,CompositionMatrix-method +setMethod( + f = "group", + signature = "CompositionMatrix", + definition = function(object, by, verbose = getOption("nexus.verbose"), ...) { + ## Compute groups + by <- compute_groups(by, ...) + + ## Validation + arkhe::assert_length(by, nrow(object)) + if (nlevels(by) == 0) { + stop("Nothing to group by.", call. = FALSE) + } + if (isTRUE(verbose)) { + if (nlevels(by) == nrow(object)) { + message("As many groups as individuals.") + } + + n <- nlevels(by) + what <- ngettext(n, "Found %g group (%s)", "Found %g groups (%s)") + grp <- paste0(levels(by), collapse = ", ") + message(sprintf(what, n, grp)) + } + + .GroupedComposition( + object, + group_indices = as.integer(by), + group_levels = levels(by) + ) + } +) #' @export -#' @rdname groups -#' @aliases is_assigned,LogRatio-method -setMethod("is_assigned", "LogRatio", function(object) in_groups(groups(object))) +#' @rdname group +#' @aliases group,GroupedComposition-method +setMethod( + f = "group", + signature = "GroupedComposition", + definition = function(object, by, add = FALSE, + verbose = getOption("nexus.verbose"), ...) { + ## Compute groups + if (isTRUE(add)) { + if (!is.list(by)) by <- list(by) + by <- c(list(group_factor(object)), by) + } + methods::callNextMethod(object, by = by, verbose = verbose, ...) + } +) #' @export -#' @rdname groups -#' @aliases any_assigned,CompositionMatrix-method -setMethod("any_assigned", "CompositionMatrix", function(object) any(is_assigned(object))) +#' @rdname group +#' @aliases ungroup,GroupedComposition-method +setMethod( + f = "ungroup", + signature = "GroupedComposition", + definition = function(object) { + methods::as(object, "CompositionMatrix", strict = TRUE) + } +) #' @export -#' @rdname groups -#' @aliases any_assigned,LogRatio-method -setMethod("any_assigned", "LogRatio", function(object) any(is_assigned(object))) +#' @rdname group +#' @aliases ungroup,GroupedLR-method +setMethod( + f = "ungroup", + signature = "GroupedLR", + definition = function(object) { + methods::as(object, "LR", strict = TRUE) + } +) #' @export -#' @rdname groups -#' @aliases groups,CompositionMatrix-method -setMethod("groups", "CompositionMatrix", function(object) object@groups) +#' @rdname group +#' @aliases ungroup,GroupedCLR-method +setMethod( + f = "ungroup", + signature = "GroupedCLR", + definition = function(object) { + methods::as(object, "CLR", strict = TRUE) + } +) #' @export -#' @rdname groups -#' @aliases groups,LogRatio-method -setMethod("groups", "LogRatio", function(object) object@groups) +#' @rdname group +#' @aliases ungroup,GroupedALR-method +setMethod( + f = "ungroup", + signature = "GroupedALR", + definition = function(object) { + methods::as(object, "ALR", strict = TRUE) + } +) #' @export -#' @rdname groups -#' @aliases groups,OutlierIndex-method -setMethod("groups", "OutlierIndex", function(object) object@groups) +#' @rdname group +#' @aliases ungroup,GroupedILR-method +setMethod( + f = "ungroup", + signature = "GroupedILR", + definition = function(object) { + methods::as(object, "ILR", strict = TRUE) + } +) #' @export -#' @rdname groups -#' @aliases groups,CompositionMatrix,ANY-method +#' @rdname group +#' @aliases ungroup,GroupedPLR-method setMethod( - f = "groups<-", - signature = c(object = "CompositionMatrix", value = "ANY"), - definition = function(object, value) { - if (is.null(value)) value <- rep(NA_character_, nrow(object)) - value <- as_groups(value) - object@groups <- value - methods::validObject(object) - object + f = "ungroup", + signature = "GroupedPLR", + definition = function(object) { + methods::as(object, "PLR", strict = TRUE) } ) +# Metadata ===================================================================== #' @export -#' @rdname groups -#' @aliases groups,CompositionMatrix,list-method +#' @describeIn group_metadata returns a [`character`] vector giving the group +#' names. +#' @aliases group_levels,ReferenceGroups-method setMethod( - f = "groups<-", - signature = c(object = "CompositionMatrix", value = "list"), - definition = function(object, value) { - value <- as_groups(value) - object@groups <- value - methods::validObject(object) - object + f = "group_levels", + signature = "ReferenceGroups", + definition = function(object) object@group_levels +) + +#' @export +#' @describeIn group_metadata returns a [`character`] vector giving the name of +#' the group that each observation belongs to. +#' @aliases group_names,ReferenceGroups-method +setMethod( + f = "group_names", + signature = "ReferenceGroups", + definition = function(object) group_levels(object)[group_indices(object)] +) + +group_factor <- function(object) { + factor( + x = group_names(object), + levels = group_levels(object), + exclude = NULL + ) +} + +#' @export +#' @describeIn group_metadata returns an [`integer`] vector giving the group +#' that each value belongs to. +#' @aliases group_indices,ReferenceGroups-method +setMethod( + f = "group_indices", + signature = "ReferenceGroups", + definition = function(object) object@group_indices +) + +#' @export +#' @describeIn group_metadata returns a `list` of [`integer`] vectors giving the +#' observation that each group contains. +#' @aliases group_rows,ReferenceGroups-method +setMethod( + f = "group_rows", + signature = "ReferenceGroups", + definition = function(object) { + i <- group_factor(object) + split(seq_along(i), f = i) } ) + +#' @export +#' @describeIn group_metadata gives the total number of groups. +#' @aliases group_length,ReferenceGroups-method +setMethod( + f = "group_length", + signature = "ReferenceGroups", + definition = function(object) length(group_levels(object)) +) + +#' @export +#' @describeIn group_metadata gives the size of each group. +#' @aliases group_size,ReferenceGroups-method +setMethod( + f = "group_size", + signature = "ReferenceGroups", + definition = function(object) lengths(group_rows(object)) +) + +#' @export +#' @describeIn group_metadata returns a [`logical`] vector specifying whether or +#' not an observation belongs to a group. +#' @aliases is_assigned,ReferenceGroups-method +setMethod( + f = "is_assigned", + signature = "ReferenceGroups", + definition = function(object) !is.na(group_names(object)) +) + +#' @export +#' @describeIn group_metadata returns an [`logical`] scalar specifying if any +#' observation belongs to a group. +#' @aliases any_assigned,ReferenceGroups-method +setMethod( + f = "any_assigned", + signature = "ReferenceGroups", + definition = function(object) any(is_assigned(object)) +) + +#' @export +#' @describeIn group_metadata returns an [`logical`] scalar specifying if all +#' observations belong to a group. +#' @aliases all_assigned,ReferenceGroups-method +setMethod( + f = "all_assigned", + signature = "ReferenceGroups", + definition = function(object) all(is_assigned(object)) +) diff --git a/R/mutators.R b/R/mutators.R index a5c4f97..0a40d38 100644 --- a/R/mutators.R +++ b/R/mutators.R @@ -4,14 +4,18 @@ NULL # Not exported get_transformation <- function(x) { - switch( - class(x), - LR = "Pairwise Log-Ratio", - CLR = "Centered Log-Ratio", - ALR = "Additive Log-Ratio", - ILR = "Isometric Log-Ratio", - PLR = "Pivot Log-Ratio" - ) + if (methods::is(x, "LR")) return("Pairwise Log-Ratio") + if (methods::is(x, "CLR")) return("Centered Log-Ratio") + if (methods::is(x, "ALR")) return("Additive Log-Ratio") + if (methods::is(x, "ILR")) return("Isometric Log-Ratio") + if (methods::is(x, "PLR")) return("Pivot Log-Ratio") +} + +is_coda <- function(object) { + methods::is(object, "CompositionMatrix") +} +is_grouped <- function(object) { + methods::is(object, "ReferenceGroups") } # Getter ======================================================================= diff --git a/R/nexus-internal.R b/R/nexus-internal.R index 557ad5f..ce19de6 100644 --- a/R/nexus-internal.R +++ b/R/nexus-internal.R @@ -15,12 +15,6 @@ make_names <- function(x, n = length(x), prefix = "X") { x } -flatten_chr <- function(x, by) { - z <- tapply(X = x, INDEX = by, FUN = unique, simplify = FALSE) - z <- vapply(X = z, FUN = paste0, FUN.VALUE = character(1), collapse = ":") - z -} - #' Plotting Dimensions of Character Strings #' #' Convert string length in inch to number of (margin) lines. diff --git a/R/nexus-package.R b/R/nexus-package.R index 2415b01..456c2ad 100644 --- a/R/nexus-package.R +++ b/R/nexus-package.R @@ -8,9 +8,9 @@ #' } #' #' @section Package options: -#' `nexus` uses the following [options()] to configure behavior: +#' \pkg{nexus} uses the following [options()] to configure behavior: #' * `nexus.verbose`: a [`logical`] scalar. Should \R report extra information -#' on progress? Defaults to `TRUE`. +#' on progress? Defaults to [interactive()]. #' #' @author #' **Full list of authors and contributors** (alphabetic order) diff --git a/R/outliers.R b/R/outliers.R index ef6841a..77755e2 100644 --- a/R/outliers.R +++ b/R/outliers.R @@ -61,9 +61,8 @@ setMethod( ## Threshold limit <- sqrt(stats::qchisq(p = quantile, df = p)) - .OutlierIndex( + z <- .OutlierIndex( samples = rownames(z), - groups = groups(z), standard = sqrt(dc), robust = sqrt(dr), limit = limit, @@ -92,7 +91,6 @@ setMethod( plot.OutlierIndex <- function(x, ..., type = c("dotchart", "distance"), robust = TRUE, - colors = color("discreterainbow"), symbols = c(16, 1, 3), xlim = NULL, ylim = NULL, xlab = NULL, ylab = NULL, @@ -104,7 +102,6 @@ plot.OutlierIndex <- function(x, ..., ## Get data dc <- x@standard dr <- x@robust - grp <- x@groups dof <- x@dof limit <- x@limit n <- length(dc) @@ -121,11 +118,8 @@ plot.OutlierIndex <- function(x, ..., if (robust || type == "distance") shape[dr > limit] <- symbols[[3L]] if (!robust || type == "distance") shape[dc > limit] <- symbols[[2L]] - col <- rep("black", length(grp)) - if (nlevels(grp) > 0) col <- khroma::palette_color_discrete(colors)(grp) - cy <- if (robust) dr else dc - dlab <- sprintf("%s Mahalanobis distance", ifelse(robust, "Robust", "Standard")) + dlab <- ifelse(robust, "Robust Mahalanobis distance", "Standard Mahalanobis distance") ylab <- ylab %||% dlab if (type == "dotchart") { @@ -133,7 +127,7 @@ plot.OutlierIndex <- function(x, ..., cx <- seq_along(dc) xlab <- xlab %||% "Index" panel <- function() { - graphics::points(x = cx, y = cy, pch = shape, col = col) + graphics::points(x = cx, y = cy, pch = shape, ...) graphics::abline(h = limit, lty = 1) } } @@ -144,7 +138,7 @@ plot.OutlierIndex <- function(x, ..., xlab <- xlab %||% "Standard Mahalanobis distance" ylab <- ylab %||% "Robust Mahalanobis distance" panel <- function() { - graphics::points(x = cx, y = cy, pch = shape, col = col) + graphics::points(x = cx, y = cy, pch = shape, ...) graphics::abline(h = limit, lty = 1) graphics::abline(v = limit, lty = 1) graphics::abline(a = 0, b = 1, lty = 2, col = "darkgrey") diff --git a/R/pca.R b/R/pca.R index c350807..8a3ac33 100644 --- a/R/pca.R +++ b/R/pca.R @@ -28,10 +28,11 @@ setMethod( definition = function(object, center = TRUE, scale = FALSE, rank = NULL, sup_row = NULL, sup_col = NULL, weight_row = NULL, weight_col = NULL) { - x <- methods::callNextMethod(object = object, center = center, scale = scale, - rank = rank, sup_row = sup_row, sup_col = sup_col, - weight_row = weight_row, weight_col = weight_col) - if (any_assigned(object)) x@rows@groups <- as.character(groups(object)) + x <- methods::callNextMethod(object, center = center, scale = scale, + rank = rank, sup_row = sup_row, + sup_col = sup_col, weight_row = weight_row, + weight_col = weight_col) + if (is_grouped(object)) x@rows@groups <- group_names(object) x } ) diff --git a/R/plot.R b/R/plot.R index 8ea92d6..a36a2df 100644 --- a/R/plot.R +++ b/R/plot.R @@ -5,35 +5,38 @@ NULL # CompositionMatrix ============================================================ #' @export #' @method plot CompositionMatrix -plot.CompositionMatrix <- function(x, ..., by = groups(x), margin = NULL, +plot.CompositionMatrix <- function(x, margin = NULL, ...) { + isopleuros::ternary_pairs(x, margin = margin, ...) + invisible(x) +} + +#' @export +#' @rdname pairs +#' @aliases plot,CompositionMatrix,missing-method +setMethod("plot", c(x = "CompositionMatrix", y = "missing"), plot.CompositionMatrix) + +#' @export +#' @method plot GroupedComposition +plot.GroupedComposition <- function(x, ..., margin = NULL, color = palette_color_discrete(), symbol = palette_shape()) { - m <- nrow(x) - - ## Grouping - grp <- as_groups(by, drop_na = TRUE) - if (nlevels(grp) == 0 || nlevels(grp) == m) { - col <- list(...)$col %||% graphics::par("col") - pch <- list(...)$pch %||% graphics::par("pch") - } else { - arkhe::assert_length(grp, m) - col <- color(grp) - pch <- symbol(grp) - } + ## Aesthetics + col <- color(group_names(x)) + pch <- symbol(group_names(x)) isopleuros::ternary_pairs(x, margin = margin, col = col, pch = pch, ...) invisible(x) } #' @export -#' @rdname plot -#' @aliases plot,CompositionMatrix,missing-method -setMethod("plot", c(x = "CompositionMatrix", y = "missing"), plot.CompositionMatrix) +#' @rdname pairs +#' @aliases plot,GroupedComposition,missing-method +setMethod("plot", c(x = "GroupedComposition", y = "missing"), plot.GroupedComposition) # LogRatio ===================================================================== #' @export #' @method plot LogRatio -plot.LogRatio <- function(x, ..., by = groups(x), +plot.LogRatio <- function(x, ..., color = palette_color_discrete(), rug = TRUE, ticksize = 0.05, ncol = NULL, flip = FALSE, @@ -50,15 +53,12 @@ plot.LogRatio <- function(x, ..., by = groups(x), nrow <- ceiling(p / ncol) ## Grouping - by <- as_groups(by, drop_na = TRUE) - if (nlevels(by) == 0 || nlevels(by) == m) { - by <- rep("", m) + if (!is_grouped(x)) { grp <- list(x) border <- list(...)$border %||% graphics::par("col") } else { - arkhe::assert_length(by, m) - grp <- split(x, f = by) - border <- color(by) + grp <- group_split(x) + border <- color(group_names(x)) } k <- length(grp) @@ -171,6 +171,6 @@ plot.LogRatio <- function(x, ..., by = groups(x), } #' @export -#' @rdname plot_logratio +#' @rdname plot #' @aliases plot,LogRatio,missing-method setMethod("plot", c(x = "LogRatio", y = "missing"), plot.LogRatio) diff --git a/R/simplex.R b/R/simplex.R index 6f9ef42..ce0fcc3 100644 --- a/R/simplex.R +++ b/R/simplex.R @@ -41,7 +41,11 @@ setMethod( z <- x * y z <- as_composition(z) rownames(z) <- rownames(x) - groups(z) <- groups(x) + + if (is_grouped(x)) { + x@group_indices <- group_indices(x) + x@group_levels <- group_levels(x) + } z } @@ -95,7 +99,11 @@ setMethod( z <- x ^ y z <- as_composition(z) rownames(z) <- rownames(x) - groups(z) <- groups(x) + + if (is_grouped(x)) { + x@group_indices <- group_indices(x) + x@group_levels <- group_levels(x) + } z } diff --git a/R/split.R b/R/split.R index 7d0dc1f..cfb7bbb 100644 --- a/R/split.R +++ b/R/split.R @@ -3,6 +3,46 @@ NULL # Split ======================================================================== +#' @export +#' @rdname group_split +#' @aliases group_split,CompositionMatrix-method +setMethod( + f = "group_split", + signature = "CompositionMatrix", + definition = function(object, by, ...) { + x <- group(object, by = by, ...) + methods::callGeneric(object = x) + } +) + +#' @export +#' @rdname group_split +#' @aliases group_split,GroupedComposition-method +setMethod( + f = "group_split", + signature = "GroupedComposition", + definition = function(object, ...) { + lapply( + X = group_rows(object), + FUN = function(ind) ungroup(object[ind, , drop = FALSE]) + ) + } +) + +#' @export +#' @rdname group_split +#' @aliases group_split,GroupedLogRatio-method +setMethod( + f = "group_split", + signature = "GroupedLogRatio", + definition = function(object, ...) { + lapply( + X = group_rows(object), + FUN = function(ind) object[ind, , drop = FALSE] + ) + } +) + #' @export #' @method split CompositionMatrix split.CompositionMatrix <- function(x, f, drop = FALSE, ...) { @@ -13,7 +53,7 @@ split.CompositionMatrix <- function(x, f, drop = FALSE, ...) { } #' @export -#' @rdname split +#' @rdname group_split #' @aliases split,CompositionMatrix-method setMethod("split", "CompositionMatrix", split.CompositionMatrix) @@ -27,7 +67,7 @@ split.LogRatio <- function(x, f, drop = FALSE, ...) { } #' @export -#' @rdname split +#' @rdname group_split #' @aliases split,LogRatio-method setMethod("split", "LogRatio", split.LogRatio) @@ -53,8 +93,7 @@ setMethod( .CompositionMatrix( z, - totals = c(totals(x), totals(y)), - groups = c(groups(x), groups(y)) + totals = c(totals(x), totals(y)) ) } ) diff --git a/R/subset.R b/R/subset.R index f1f40eb..cb00380 100644 --- a/R/subset.R +++ b/R/subset.R @@ -12,7 +12,6 @@ NULL if (missing(i)) i <- seq_len(nrow(x)) if (is.character(i)) i <- match(i, dimnames(x)[1L]) totals <- totals(x)[i] - groups <- groups(x)[i] ## Columns if (missing(j)) j <- seq_len(ncol(x)) @@ -28,7 +27,17 @@ NULL # z <- z / tot # } - methods::initialize(x, z, totals = totals, groups = groups) + if (is_grouped(x)) { + g <- droplevels(group_factor(x)[i]) + methods::initialize( + x, z, + totals = totals, + group_indices = as.integer(g), + group_levels = levels(g) + ) + } else { + methods::initialize(x, z, totals = totals) + } } wrong_dimensions <- function(i, j) { diff --git a/R/transform_alr.R b/R/transform_alr.R index a7716ba..24c9e26 100644 --- a/R/transform_alr.R +++ b/R/transform_alr.R @@ -42,12 +42,24 @@ setMethod( order = order(ordering), base = base, weights = weights, - totals = totals(object), - groups = groups(object) + totals = totals(object) ) } ) +#' @export +#' @rdname transform_alr +#' @aliases transform_alr,GroupedComposition-method +setMethod( + f = "transform_alr", + signature = c(object = "GroupedComposition"), + definition = function(object, j = ncol(object), weights = FALSE) { + z <- methods::callNextMethod() + .GroupedALR(z, group_indices = group_indices(object), + group_levels = group_levels(object)) + } +) + #' @export #' @rdname transform_alr #' @aliases transform_alr,CLR-method @@ -77,8 +89,20 @@ setMethod( order = order(ordering), base = base, weights = object@weights, - totals = totals(object), - groups = groups(object) + totals = totals(object) ) } ) + +#' @export +#' @rdname transform_alr +#' @aliases transform_alr,GroupedCLR-method +setMethod( + f = "transform_alr", + signature = c(object = "GroupedCLR"), + definition = function(object, j = ncol(object), weights = FALSE) { + z <- methods::callNextMethod() + .GroupedALR(z, group_indices = group_indices(object), + group_levels = group_levels(object)) + } +) diff --git a/R/transform_clr.R b/R/transform_clr.R index f1042d0..ec2f84b 100644 --- a/R/transform_clr.R +++ b/R/transform_clr.R @@ -29,12 +29,24 @@ setMethod( order = seq_len(D), base = base, weights = weights, - totals = totals(object), - groups = groups(object) + totals = totals(object) ) } ) +#' @export +#' @rdname transform_clr +#' @aliases transform_clr,GroupedComposition-method +setMethod( + f = "transform_clr", + signature = c(object = "GroupedComposition"), + definition = function(object, weights = FALSE) { + z <- methods::callNextMethod() + .GroupedCLR(z, group_indices = group_indices(object), + group_levels = group_levels(object)) + } +) + #' @export #' @rdname transform_clr #' @aliases transform_clr,ALR-method @@ -56,8 +68,20 @@ setMethod( order = seq_len(D), base = base, weights = w, - totals = totals(object), - groups = groups(object) + totals = totals(object) ) } ) + +#' @export +#' @rdname transform_clr +#' @aliases transform_clr,GroupedALR-method +setMethod( + f = "transform_clr", + signature = c(object = "GroupedALR"), + definition = function(object) { + z <- methods::callNextMethod() + .GroupedCLR(z, group_indices = group_indices(object), + group_levels = group_levels(object)) + } +) diff --git a/R/transform_ilr.R b/R/transform_ilr.R index 546d0bc..ae6d57e 100644 --- a/R/transform_ilr.R +++ b/R/transform_ilr.R @@ -36,6 +36,19 @@ setMethod( } ) +#' @export +#' @rdname transform_ilr +#' @aliases transform_ilr,GroupedComposition,missing-method +setMethod( + f = "transform_ilr", + signature = c(object = "GroupedComposition"), + definition = function(object) { + z <- methods::callNextMethod() + .GroupedILR(z, group_indices = group_indices(object), + group_levels = group_levels(object)) + } +) + #' @export #' @rdname transform_ilr #' @aliases transform_ilr,CLR,missing-method @@ -50,6 +63,19 @@ setMethod( } ) +#' @export +#' @rdname transform_ilr +#' @aliases transform_ilr,GroupedCLR,missing-method +setMethod( + f = "transform_ilr", + signature = c(object = "GroupedCLR"), + definition = function(object) { + z <- methods::callNextMethod() + .GroupedILR(z, group_indices = group_indices(object), + group_levels = group_levels(object)) + } +) + #' @export #' @rdname transform_ilr #' @aliases transform_ilr,ALR,missing-method @@ -62,6 +88,19 @@ setMethod( } ) +#' @export +#' @rdname transform_ilr +#' @aliases transform_ilr,GroupedALR,missing-method +setMethod( + f = "transform_ilr", + signature = c(object = "GroupedALR"), + definition = function(object) { + z <- methods::callNextMethod() + .GroupedILR(z, group_indices = group_indices(object), + group_levels = group_levels(object)) + } +) + .transform_ilr <- function(object, base, weights) { D <- ncol(object) seq_parts <- seq_len(D - 1) @@ -89,8 +128,7 @@ setMethod( order = seq_len(D), base = base, weights = weights, - totals = totals(object), - groups = groups(object) + totals = totals(object) ) } diff --git a/R/transform_inverse.R b/R/transform_inverse.R index 8aa1317..28f6c62 100644 --- a/R/transform_inverse.R +++ b/R/transform_inverse.R @@ -16,11 +16,20 @@ setMethod( y <- y / rowSums(y) dimnames(y) <- list(rownames(object), object@parts) - .CompositionMatrix( - y, - totals = totals(object), - groups = groups(object) - ) + .CompositionMatrix(y, totals = totals(object)) + } +) + +#' @export +#' @rdname transform_inverse +#' @aliases transform_inverse,GroupedCLR,missing-method +setMethod( + f = "transform_inverse", + signature = c(object = "GroupedCLR", origin = "missing"), + definition = function(object) { + z <- methods::callNextMethod() + .GroupedComposition(z, group_indices = group_indices(object), + group_levels = group_levels(object)) } ) @@ -40,11 +49,20 @@ setMethod( dimnames(y) <- list(rownames(object), object@parts) y <- y[, object@order] - .CompositionMatrix( - y, - totals = totals(object), - groups = groups(object) - ) + .CompositionMatrix(y, totals = totals(object)) + } +) + +#' @export +#' @rdname transform_inverse +#' @aliases transform_inverse,GroupedALR,missing-method +setMethod( + f = "transform_inverse", + signature = c(object = "GroupedALR", origin = "missing"), + definition = function(object) { + z <- methods::callNextMethod() + .GroupedComposition(z, group_indices = group_indices(object), + group_levels = group_levels(object)) } ) @@ -63,11 +81,20 @@ setMethod( dimnames(y) <- list(rownames(object), object@parts) y <- y[, object@order] - .CompositionMatrix( - y, - totals = totals(object), - groups = groups(object) - ) + .CompositionMatrix(y, totals = totals(object)) + } +) + +#' @export +#' @rdname transform_inverse +#' @aliases transform_inverse,GroupedILR,missing-method +setMethod( + f = "transform_inverse", + signature = c(object = "GroupedILR", origin = "missing"), + definition = function(object) { + z <- methods::callNextMethod() + .GroupedComposition(z, group_indices = group_indices(object), + group_levels = group_levels(object)) } ) diff --git a/R/transform_lr.R b/R/transform_lr.R index cfa3151..182c1df 100644 --- a/R/transform_lr.R +++ b/R/transform_lr.R @@ -37,8 +37,20 @@ setMethod( ratio = ratio, order = seq_len(J), weights = weights, - totals = totals(object), - groups = groups(object) + totals = totals(object) ) } ) + +#' @export +#' @rdname transform_lr +#' @aliases transform_lr,GroupedComposition-method +setMethod( + f = "transform_lr", + signature = c(object = "GroupedComposition"), + definition = function(object, weights = FALSE) { + z <- methods::callNextMethod() + .GroupedLR(z, group_indices = group_indices(object), + group_levels = group_levels(object)) + } +) diff --git a/R/transform_plr.R b/R/transform_plr.R index e62455b..2259375 100644 --- a/R/transform_plr.R +++ b/R/transform_plr.R @@ -48,8 +48,20 @@ setMethod( order = order(ordering), base = H, weights = rep(1 / J, J), - totals = totals(object), - groups = groups(object) + totals = totals(object) ) } ) + +#' @export +#' @rdname transform_plr +#' @aliases transform_plr,GroupedComposition-method +setMethod( + f = "transform_plr", + signature = c(object = "GroupedComposition"), + definition = function(object, pivot = 1) { + z <- methods::callNextMethod() + .GroupedPLR(z, group_indices = group_indices(object), + group_levels = group_levels(object)) + } +) diff --git a/R/validate.R b/R/validate.R index 30de0da..9828f19 100644 --- a/R/validate.R +++ b/R/validate.R @@ -2,6 +2,21 @@ #' @include AllClasses.R NULL +# ReferenceGroups ============================================================== +# setValidity( +# Class = "ReferenceGroups", +# method = function(object) { +# ## Get data +# group_indices <- object@group_indices +# group_levels <- object@group_levels +# +# cnd <- list( +# arkhe::validate() +# ) +# arkhe::check_class(object, cnd) +# } +# ) + # NumericMatrix ================================================================ setValidity( Class = "NumericMatrix", @@ -18,11 +33,9 @@ setValidity( ## Get data n <- nrow(object) totals <- object@totals - groups <- object@groups cnd <- list( - arkhe::validate(arkhe::assert_length(totals, n, empty = FALSE)), - arkhe::validate(arkhe::assert_length(groups, n, empty = FALSE)), + arkhe::validate(arkhe::assert_length(totals, n)), arkhe::validate(arkhe::assert_positive(object, strict = FALSE, na.rm = TRUE)) ) arkhe::check_class(object, cnd) @@ -41,7 +54,6 @@ setValidity( weights <- object@weights totals <- object@totals - groups <- object@groups n <- nrow(object) m <- length(parts) @@ -49,9 +61,8 @@ setValidity( cnd <- list( arkhe::validate(arkhe::assert_missing(object)), arkhe::validate(arkhe::assert_infinite(object)), - arkhe::validate(arkhe::assert_length(totals, n, empty = FALSE)), - arkhe::validate(arkhe::assert_length(groups, n, empty = FALSE)), - arkhe::validate(arkhe::assert_length(order, m, empty = FALSE)) + arkhe::validate(arkhe::assert_length(totals, n)), + arkhe::validate(arkhe::assert_length(order, m)) ) arkhe::check_class(object, cnd) } diff --git a/README.Rmd b/README.Rmd index 02c6545..eae8656 100644 --- a/README.Rmd +++ b/README.Rmd @@ -97,7 +97,7 @@ data("bronze", package = "folio") coda <- as_composition(bronze, parts = 4:11) ## Use dynasties as groups -groups(coda) <- bronze$dynasty +coda <- group(coda, by = bronze$dynasty) ``` ```{r barplot, fig.width=5, fig.height=7} diff --git a/README.md b/README.md index 646b8a1..4317f93 100644 --- a/README.md +++ b/README.md @@ -68,7 +68,7 @@ To cite nexus in publications use: Frerebeau N, Philippe A (2024). *nexus: Sourcing Archaeological Materials by Chemical Composition*. Université Bordeaux Montaigne, Pessac, France. -, R package version 0.3.0, +, R package version 0.3.0.9000, . This package is a part of the tesselle project @@ -119,7 +119,7 @@ data("bronze", package = "folio") coda <- as_composition(bronze, parts = 4:11) ## Use dynasties as groups -groups(coda) <- bronze$dynasty +coda <- group(coda, by = bronze$dynasty) ``` ``` r diff --git a/inst/examples/ex-group.R b/inst/examples/ex-group.R new file mode 100644 index 0000000..f468fbf --- /dev/null +++ b/inst/examples/ex-group.R @@ -0,0 +1,18 @@ +## Data from Aitchison 1986 +data("slides") + +## Coerce to compositional data +coda <- as_composition(slides, groups = 2) + +## Grouping metadata +group_levels(coda) + +group_names(coda) + +group_indices(coda) + +group_rows(coda) + +group_length(coda) + +group_size(coda) diff --git a/inst/examples/ex-groups.R b/inst/examples/ex-groups.R deleted file mode 100644 index 5353364..0000000 --- a/inst/examples/ex-groups.R +++ /dev/null @@ -1,8 +0,0 @@ -## Data from Aitchison 1986 -data("slides") -head(slides) - -## Coerce to compositional data -coda <- as_composition(slides, groups = 2) - -groups(coda) diff --git a/inst/examples/ex-outliers.R b/inst/examples/ex-outliers.R index e8579cb..02ae908 100644 --- a/inst/examples/ex-outliers.R +++ b/inst/examples/ex-outliers.R @@ -10,6 +10,6 @@ plot(out, type = "dotchart") plot(out, type = "distance") ## Detect outliers according to CJ -ref <- extract(coda, "CJ") +ref <- group_extract(coda, "CJ") out <- detect_outlier(coda, reference = ref, method = "mcd") plot(out, type = "dotchart") diff --git a/inst/examples/ex-split.R b/inst/examples/ex-split.R index 90f5e94..acb0fc5 100644 --- a/inst/examples/ex-split.R +++ b/inst/examples/ex-split.R @@ -11,12 +11,14 @@ X <- data.frame( Y <- as_composition(X) ## Split by group -## /!\ Unassigned samples are discarded ! /!\ +## /!\ Unassigned samples (NA) are discarded ! /!\ (s1 <- split(Y, f = X$groups)) -## Split by group -## Keep unassigned samples, see help(factor) -(s2 <- split(Y, f = factor(X$groups, exclude = NULL))) +## Better to use grouped matrix +(s2 <- group_split(Y, by = X$groups)) + +Z <- as_composition(X, groups = 2) +(s3 <- group_split(Z)) ## Bind by rows -do.call(rbind, s2) +do.call(rbind, s3) diff --git a/inst/tinytest/_snaps/coerce.rds b/inst/tinytest/_snaps/coerce.rds deleted file mode 100644 index b3de970..0000000 Binary files a/inst/tinytest/_snaps/coerce.rds and /dev/null differ diff --git a/inst/tinytest/_snaps/coerce_group.rds b/inst/tinytest/_snaps/coerce_group.rds new file mode 100644 index 0000000..39569ed Binary files /dev/null and b/inst/tinytest/_snaps/coerce_group.rds differ diff --git a/inst/tinytest/_snaps/coerce_nogroup.rds b/inst/tinytest/_snaps/coerce_nogroup.rds new file mode 100644 index 0000000..2916ccf Binary files /dev/null and b/inst/tinytest/_snaps/coerce_nogroup.rds differ diff --git a/inst/tinytest/_snaps/condense.rds b/inst/tinytest/_snaps/condense.rds index 55f1bad..615f982 100644 Binary files a/inst/tinytest/_snaps/condense.rds and b/inst/tinytest/_snaps/condense.rds differ diff --git a/inst/tinytest/_snaps/detect_outlier.rds b/inst/tinytest/_snaps/detect_outlier.rds index adde5c5..f2b022f 100644 Binary files a/inst/tinytest/_snaps/detect_outlier.rds and b/inst/tinytest/_snaps/detect_outlier.rds differ diff --git a/inst/tinytest/_snaps/margin.rds b/inst/tinytest/_snaps/margin.rds index 1ffb382..c569ca1 100644 Binary files a/inst/tinytest/_snaps/margin.rds and b/inst/tinytest/_snaps/margin.rds differ diff --git a/inst/tinytest/_snaps/missing_multiplicative.rds b/inst/tinytest/_snaps/missing_multiplicative.rds index 5de38ed..81c215d 100644 Binary files a/inst/tinytest/_snaps/missing_multiplicative.rds and b/inst/tinytest/_snaps/missing_multiplicative.rds differ diff --git a/inst/tinytest/_snaps/scale.rds b/inst/tinytest/_snaps/scale.rds index 8f7d6cd..2e078c8 100644 Binary files a/inst/tinytest/_snaps/scale.rds and b/inst/tinytest/_snaps/scale.rds differ diff --git a/inst/tinytest/_snaps/transform_alr.rds b/inst/tinytest/_snaps/transform_alr.rds index ad099bc..db96895 100644 Binary files a/inst/tinytest/_snaps/transform_alr.rds and b/inst/tinytest/_snaps/transform_alr.rds differ diff --git a/inst/tinytest/_snaps/transform_clr.rds b/inst/tinytest/_snaps/transform_clr.rds index d0331e6..bf620cb 100644 Binary files a/inst/tinytest/_snaps/transform_clr.rds and b/inst/tinytest/_snaps/transform_clr.rds differ diff --git a/inst/tinytest/_snaps/transform_ilr.rds b/inst/tinytest/_snaps/transform_ilr.rds index 0351138..666e9da 100644 Binary files a/inst/tinytest/_snaps/transform_ilr.rds and b/inst/tinytest/_snaps/transform_ilr.rds differ diff --git a/inst/tinytest/_snaps/transform_lr.rds b/inst/tinytest/_snaps/transform_lr.rds index f6d9b5d..2180d7b 100644 Binary files a/inst/tinytest/_snaps/transform_lr.rds and b/inst/tinytest/_snaps/transform_lr.rds differ diff --git a/inst/tinytest/_snaps/transform_plr.rds b/inst/tinytest/_snaps/transform_plr.rds index 72e9a52..086a68b 100644 Binary files a/inst/tinytest/_snaps/transform_plr.rds and b/inst/tinytest/_snaps/transform_plr.rds differ diff --git a/inst/tinytest/_snaps/zero_multiplicative.rds b/inst/tinytest/_snaps/zero_multiplicative.rds index b9e58bb..259a6a1 100644 Binary files a/inst/tinytest/_snaps/zero_multiplicative.rds and b/inst/tinytest/_snaps/zero_multiplicative.rds differ diff --git a/inst/tinytest/test_coerce.R b/inst/tinytest/test_coerce.R index 2016378..2db532f 100644 --- a/inst/tinytest/test_coerce.R +++ b/inst/tinytest/test_coerce.R @@ -1,8 +1,3 @@ -# Data with groups ============================================================= -data("slides") -coda <- as_composition(slides, group = 1) -expect_equal_to_reference(coda, file = "_snaps/coerce.rds") - # Back transform to count ====================================================== data("hongite") coda <- as_composition(hongite) diff --git a/inst/tinytest/test_condense.R b/inst/tinytest/test_condense.R index 1ee2271..694b0eb 100644 --- a/inst/tinytest/test_condense.R +++ b/inst/tinytest/test_condense.R @@ -2,9 +2,12 @@ data("slides") coda <- as_composition(slides, groups = 2) ## Compositional mean by sample -flat <- condense(coda, by = groups(coda)) +flat <- condense(coda) expect_equal_to_reference(as.data.frame(flat), file = "_snaps/condense.rds") +## Override groups +flat <- condense(coda, by = slides$analyst) + ## With zeros X1 <- data.frame( Ca = c(7.72, 0, 3.11, 7.19, 7.41, 5, 0, 1, 4.51), diff --git a/inst/tinytest/test_group.R b/inst/tinytest/test_group.R new file mode 100644 index 0000000..81a26af --- /dev/null +++ b/inst/tinytest/test_group.R @@ -0,0 +1,25 @@ +# Data with groups ============================================================= +data("slides") +coda <- as_composition(slides, group = NULL) +expect_equal_to_reference(coda, file = "_snaps/coerce_nogroup.rds") +coda <- as_composition(slides, group = 1) +expect_equal_to_reference(coda, file = "_snaps/coerce_group.rds") + +expect_message(group(coda, by = slides$analyst, add = TRUE, verbose = TRUE)) + +expect_equal(group_levels(coda), c("A1", "A2", "A3", "A4", "A5")) +expect_equal(group_names(coda), slides$analyst) +expect_equal(group_indices(coda), c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, + 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, + 5L, 5L, 5L, 5L, 5L)) +expect_equal(group_rows(coda), list(A1 = 1:5, A2 = 6:10, A3 = 11:15, A4 = 16:20, A5 = 21:25)) +expect_equal(group_length(coda), 5L) +expect_equal(group_size(coda), c(A1 = 5L, A2 = 5L, A3 = 5L, A4 = 5L, A5 = 5L)) +expect_equal(is_assigned(coda), rep(TRUE, 25)) +expect_true(any_assigned(coda)) +expect_true(all_assigned(coda)) +expect_false(any_assigned(group(coda, by = rep(NA, nrow(coda))))) + +# Invalid values +# Try wrong length +expect_error(group(coda, by = LETTERS), class = "error_bad_length") diff --git a/inst/tinytest/test_mutators.R b/inst/tinytest/test_mutators.R index a2967fd..22f4eff 100644 --- a/inst/tinytest/test_mutators.R +++ b/inst/tinytest/test_mutators.R @@ -1,22 +1,3 @@ -# CompositionMatrix groups ===================================================== -data("hongite") -coda <- as_composition(hongite) - -expect_equal(groups(coda), factor(rep(NA_character_, nrow(coda)))) -expect_false(any_assigned(coda)) - -groups(coda) <- rep(c("A", "B", "C", "D", NA), each = 5) -expect_equal(groups(coda), factor(rep(c("A", "B", "C", "D", NA), each = 5))) -expect_true(any_assigned(coda)) -expect_equal(is_assigned(coda), rep(c(TRUE, FALSE), c(20, 5))) - -groups(coda) <- NULL -expect_false(any_assigned(coda)) - -# Invalid values -# Try wrong length -expect_error(groups(coda) <- LETTERS, class = "arkhe_error_class") - # CompositionMatrix totals ===================================================== mtx <- matrix(sample(1:100, 75, TRUE), ncol = 5) coda <- as_composition(mtx) diff --git a/inst/tinytest/test_plot.R b/inst/tinytest/test_plot.R index b90c7ad..58e5b0a 100644 --- a/inst/tinytest/test_plot.R +++ b/inst/tinytest/test_plot.R @@ -13,7 +13,7 @@ if (at_home()) { plot_pairs <- function() plot(coda) expect_snapshot_plot(plot_pairs, "plot_pairs") - plot_pairs <- function() plot(coda, by = rep(1:5, 5)) + plot_pairs <- function() plot(group(coda, by = rep(1:5, 5))) expect_snapshot_plot(plot_pairs, "plot_pairs_group") # Histogram ================================================================== @@ -24,7 +24,7 @@ if (at_home()) { expect_snapshot_plot(plot_hist_count, "plot_hist_count") # Barplot ==================================================================== - plot_barplot <- function() barplot(coda, by = NULL, order_columns = FALSE, border = "black") + plot_barplot <- function() barplot(coda, order_columns = FALSE, border = "black") expect_snapshot_plot(plot_barplot, "plot_barplot") plot_barplot_order <- function() barplot(coda, order_columns = TRUE, border = "black") @@ -33,7 +33,7 @@ if (at_home()) { plot_barplot_order <- function() barplot(coda, order_rows = 2, border = "black") expect_snapshot_plot(plot_barplot_order, "plot_barplot_order_rows") - plot_barplot_group <- function() barplot(coda, by = rep(1:5, 5), order_columns = TRUE, border = "black") + plot_barplot_group <- function() barplot(group(coda, by = rep(1:5, 5)), order_columns = TRUE, border = "black") expect_snapshot_plot(plot_barplot_group, "plot_barplot_group") # Density ==================================================================== @@ -41,10 +41,12 @@ if (at_home()) { if (getRversion() >= "4.4.0") { ilr <- transform_ilr(coda) - plot_ratio <- function() plot(ilr, by = NULL, ncol = 2) + plot_ratio <- function() plot(ilr, ncol = 2) expect_snapshot_plot(plot_ratio, "plot_ratio") - plot_ratio <- function() plot(ilr, by = rep(1:5, 5), ncol = 2) + gilr <- transform_ilr(group(coda, by = rep(1:5, 5))) + + plot_ratio <- function() plot(gilr, ncol = 2) expect_snapshot_plot(plot_ratio, "plot_ratio_group") } } diff --git a/inst/tinytest/test_replace.R b/inst/tinytest/test_replace.R index 76a4252..019ae9e 100644 --- a/inst/tinytest/test_replace.R +++ b/inst/tinytest/test_replace.R @@ -1,3 +1,5 @@ +Sys.setlocale("LC_MESSAGES", 'en_GB.UTF-8') # Force locale + # Replace zeros ================================================================ X <- data.frame( Ca = c(7.72, 0, 3.11, 7.19, 7.41, 5, 0, 1, 4.51), diff --git a/man/CompositionMatrix-class.Rd b/man/CompositionMatrix-class.Rd index 472d157..19e3520 100644 --- a/man/CompositionMatrix-class.Rd +++ b/man/CompositionMatrix-class.Rd @@ -13,12 +13,10 @@ An S4 class to represent compositional data. \describe{ \item{\code{totals}}{A \code{\link{numeric}} vector to store the absolute row sums (before the closure of the compositions).} - -\item{\code{groups}}{A \code{\link{factor}} vector to store the group names.} }} \note{ -This class inherits from \code{\link{matrix}}. +This class inherits from \code{\linkS4class{NumericMatrix}}. } \section{Coerce}{ @@ -59,10 +57,12 @@ colnames(coda) # Get the column names \code{\link[=as_composition]{as_composition()}} Other classes: +\code{\link{GroupedComposition-class}}, +\code{\link{GroupedLogRatio-class}}, \code{\link{LogRatio-class}}, -\code{\link{LogicalMatrix-class}}, \code{\link{NumericMatrix-class}}, -\code{\link{OutlierIndex-class}} +\code{\link{OutlierIndex-class}}, +\code{\link{ReferenceGroups-class}} } \author{ N. Frerebeau diff --git a/man/GroupedComposition-class.Rd b/man/GroupedComposition-class.Rd new file mode 100644 index 0000000..0293c6f --- /dev/null +++ b/man/GroupedComposition-class.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllClasses.R +\docType{class} +\name{GroupedComposition-class} +\alias{GroupedComposition-class} +\alias{.GroupedComposition} +\title{Grouped Compositional Matrix} +\description{ +An S4 class to represent grouped compositional data. +} +\note{ +This class inherits from \code{\linkS4class{CompositionMatrix}} and +\code{\linkS4class{ReferenceGroups}}. +} +\section{Coerce}{ + +In the code snippets below, \code{x} is a \code{GroupedComposition} object. +\describe{ +\item{\code{as.data.frame(x)}}{Coerces to a \code{\link{data.frame}}.} +} +} + +\examples{ +## Data from Aitchison 1986 +data("hongite") + +## Coerce to compositional data +coda <- as_composition(hongite) + +## codaccess +dim(coda) # Get the matrix dimensions +row(coda) # Get the row indexes +col(coda, as.factor = TRUE) # Get the column indexes +nrow(coda) # Get the number of rows +ncol(coda) # Get the number of columns +dimnames(coda) # Get the dimension names +rownames(coda) <- LETTERS[1:25] # Set the row names +rownames(coda) # Get the rownames +colnames(coda) <- letters[21:25] # Set the column names +colnames(coda) # Get the column names +} +\seealso{ +\code{\link[=as_composition]{as_composition()}} + +Other classes: +\code{\link{CompositionMatrix-class}}, +\code{\link{GroupedLogRatio-class}}, +\code{\link{LogRatio-class}}, +\code{\link{NumericMatrix-class}}, +\code{\link{OutlierIndex-class}}, +\code{\link{ReferenceGroups-class}} +} +\author{ +N. Frerebeau +} +\concept{classes} +\keyword{internal} diff --git a/man/GroupedLogRatio-class.Rd b/man/GroupedLogRatio-class.Rd new file mode 100644 index 0000000..f836673 --- /dev/null +++ b/man/GroupedLogRatio-class.Rd @@ -0,0 +1,64 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllClasses.R +\docType{class} +\name{GroupedLogRatio-class} +\alias{GroupedLogRatio-class} +\alias{GroupedLR-class} +\alias{.GroupedLR} +\alias{GroupedCLR-class} +\alias{.GroupedCLR} +\alias{GroupedALR-class} +\alias{.GroupedALR} +\alias{GroupedILR-class} +\alias{.GroupedILR} +\alias{GroupedPLR-class} +\alias{.GroupedPLR} +\title{Grouped Log-Ratio Matrix} +\description{ +An S4 class to represent grouped log-ratio. +} +\note{ +This class inherits from \code{\linkS4class{LogRatio}} and +\code{\linkS4class{ReferenceGroups}}. +} +\section{Coerce}{ + +In the code snippets below, \code{x} is a \code{GroupedLogRatio} object. +\describe{ +\item{\code{as.data.frame(x)}}{Coerces to a \code{\link{data.frame}}.} +} +} + +\examples{ +## Data from Aitchison 1986 +data("hongite") + +## Coerce to compositional data +coda <- as_composition(hongite) + +## codaccess +dim(coda) # Get the matrix dimensions +row(coda) # Get the row indexes +col(coda, as.factor = TRUE) # Get the column indexes +nrow(coda) # Get the number of rows +ncol(coda) # Get the number of columns +dimnames(coda) # Get the dimension names +rownames(coda) <- LETTERS[1:25] # Set the row names +rownames(coda) # Get the rownames +colnames(coda) <- letters[21:25] # Set the column names +colnames(coda) # Get the column names +} +\seealso{ +Other classes: +\code{\link{CompositionMatrix-class}}, +\code{\link{GroupedComposition-class}}, +\code{\link{LogRatio-class}}, +\code{\link{NumericMatrix-class}}, +\code{\link{OutlierIndex-class}}, +\code{\link{ReferenceGroups-class}} +} +\author{ +N. Frerebeau +} +\concept{classes} +\keyword{internal} diff --git a/man/LogRatio-class.Rd b/man/LogRatio-class.Rd index f1b5588..a192326 100644 --- a/man/LogRatio-class.Rd +++ b/man/LogRatio-class.Rd @@ -24,8 +24,6 @@ S4 classes to represent log-ratio data transformations. \item{\code{totals}}{A \code{\link{numeric}} vector to store the absolute row sums (before the closure of the compositions).} -\item{\code{groups}}{A \code{\link{factor}} vector to store the group names.} - \item{\code{parts}}{A \code{\link{character}} vector to store the original part names.} \item{\code{ratio}}{A \code{\link{character}} vector to store the ratio names.} @@ -56,9 +54,11 @@ In the code snippets below, \code{x} is a \code{LogRatio} object. Other classes: \code{\link{CompositionMatrix-class}}, -\code{\link{LogicalMatrix-class}}, +\code{\link{GroupedComposition-class}}, +\code{\link{GroupedLogRatio-class}}, \code{\link{NumericMatrix-class}}, -\code{\link{OutlierIndex-class}} +\code{\link{OutlierIndex-class}}, +\code{\link{ReferenceGroups-class}} } \author{ N. Frerebeau diff --git a/man/LogicalMatrix-class.Rd b/man/LogicalMatrix-class.Rd deleted file mode 100644 index 56736d6..0000000 --- a/man/LogicalMatrix-class.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/AllClasses.R -\docType{class} -\name{LogicalMatrix-class} -\alias{LogicalMatrix-class} -\alias{.LogicalMatrix} -\title{Logical Matrix} -\description{ -S4 classes that represent a \eqn{m \times p}{m x p} logical matrix. -} -\section{Slots}{ - -\describe{ -\item{\code{.Data}}{A \eqn{m \times p}{m x p} \code{logical} \code{\link{matrix}}.} -}} - -\note{ -This class inherits from \code{\link{matrix}}. -} -\seealso{ -Other classes: -\code{\link{CompositionMatrix-class}}, -\code{\link{LogRatio-class}}, -\code{\link{NumericMatrix-class}}, -\code{\link{OutlierIndex-class}} -} -\author{ -N. Frerebeau -} -\concept{classes} -\keyword{internal} diff --git a/man/NumericMatrix-class.Rd b/man/NumericMatrix-class.Rd index ed41813..931389d 100644 --- a/man/NumericMatrix-class.Rd +++ b/man/NumericMatrix-class.Rd @@ -20,9 +20,11 @@ This class inherits from \code{\link{matrix}}. \seealso{ Other classes: \code{\link{CompositionMatrix-class}}, +\code{\link{GroupedComposition-class}}, +\code{\link{GroupedLogRatio-class}}, \code{\link{LogRatio-class}}, -\code{\link{LogicalMatrix-class}}, -\code{\link{OutlierIndex-class}} +\code{\link{OutlierIndex-class}}, +\code{\link{ReferenceGroups-class}} } \author{ N. Frerebeau diff --git a/man/OutlierIndex-class.Rd b/man/OutlierIndex-class.Rd index 1a371ac..04cea52 100644 --- a/man/OutlierIndex-class.Rd +++ b/man/OutlierIndex-class.Rd @@ -13,8 +13,6 @@ An S4 class to store the result of outlier detection. \describe{ \item{\code{samples}}{A \code{\link{character}} vector to store the sample identifiers.} -\item{\code{groups}}{A \code{\link{factor}} vector to store the group names.} - \item{\code{standard}}{A \code{\link{numeric}} matrix giving the standard squared Mahalanobis distances.} @@ -38,9 +36,11 @@ In the code snippets below, \code{x} is an \code{OutlierIndex} object. \seealso{ Other classes: \code{\link{CompositionMatrix-class}}, +\code{\link{GroupedComposition-class}}, +\code{\link{GroupedLogRatio-class}}, \code{\link{LogRatio-class}}, -\code{\link{LogicalMatrix-class}}, -\code{\link{NumericMatrix-class}} +\code{\link{NumericMatrix-class}}, +\code{\link{ReferenceGroups-class}} } \author{ N. Frerebeau diff --git a/man/ReferenceGroups-class.Rd b/man/ReferenceGroups-class.Rd new file mode 100644 index 0000000..fc71d26 --- /dev/null +++ b/man/ReferenceGroups-class.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllClasses.R +\docType{class} +\name{ReferenceGroups-class} +\alias{ReferenceGroups-class} +\alias{.ReferenceGroups} +\title{Grouped Data} +\description{ +A virtual S4 class to represent reference groups. +} +\section{Slots}{ + +\describe{ +\item{\code{group_indices}}{An \code{\link{integer}} vector to store the group that each value +belongs to.} + +\item{\code{group_levels}}{A \code{\link{character}} vector to store the values of the grouping +variables.} +}} + +\examples{ +## Data from Aitchison 1986 +data("hongite") + +## Coerce to compositional data +coda <- as_composition(hongite) + +## codaccess +dim(coda) # Get the matrix dimensions +row(coda) # Get the row indexes +col(coda, as.factor = TRUE) # Get the column indexes +nrow(coda) # Get the number of rows +ncol(coda) # Get the number of columns +dimnames(coda) # Get the dimension names +rownames(coda) <- LETTERS[1:25] # Set the row names +rownames(coda) # Get the rownames +colnames(coda) <- letters[21:25] # Set the column names +colnames(coda) # Get the column names +} +\seealso{ +Other classes: +\code{\link{CompositionMatrix-class}}, +\code{\link{GroupedComposition-class}}, +\code{\link{GroupedLogRatio-class}}, +\code{\link{LogRatio-class}}, +\code{\link{NumericMatrix-class}}, +\code{\link{OutlierIndex-class}} +} +\author{ +N. Frerebeau +} +\concept{classes} +\keyword{internal} diff --git a/man/aggregate.Rd b/man/aggregate.Rd index 316b26a..e02ae85 100644 --- a/man/aggregate.Rd +++ b/man/aggregate.Rd @@ -4,16 +4,18 @@ \name{aggregate} \alias{aggregate} \alias{aggregate,CompositionMatrix-method} +\alias{aggregate,GroupedComposition-method} \title{Compute Summary Statistics of Data Subsets} \usage{ \S4method{aggregate}{CompositionMatrix}(x, by, FUN, ..., simplify = TRUE, drop = TRUE) + +\S4method{aggregate}{GroupedComposition}(x, FUN, ..., simplify = TRUE) } \arguments{ \item{x}{A \code{\linkS4class{CompositionMatrix}} object.} \item{by}{A \code{vector} or a list of grouping elements, each as long as the -variables in \code{x}. The elements are coerced to factors before use -(in the sense that \code{\link[=interaction]{interaction(by)}} defines the grouping).} +variables in \code{x} (see \code{\link[=group]{group()}}).} \item{FUN}{A \code{\link{function}} to compute the summary statistics.} diff --git a/man/as_graph.Rd b/man/as_graph.Rd index 29912ee..d846bc4 100644 --- a/man/as_graph.Rd +++ b/man/as_graph.Rd @@ -64,8 +64,8 @@ plot(plr_graph) Other plot methods: \code{\link{barplot}()}, \code{\link{hist}()}, -\code{\link{plot}()}, -\code{\link{plot_logratio}} +\code{\link{pairs}()}, +\code{\link{plot}()} } \author{ N. Frerebeau diff --git a/man/barplot.Rd b/man/barplot.Rd index 805fd0d..1fbfd0d 100644 --- a/man/barplot.Rd +++ b/man/barplot.Rd @@ -9,7 +9,6 @@ \S4method{barplot}{CompositionMatrix}( height, ..., - by = groups(height), order_columns = FALSE, order_rows = NULL, decreasing = TRUE, @@ -26,9 +25,6 @@ \item{...}{Further graphical parameters.} -\item{by}{A \code{vector} of grouping elements, as long as the variables in -\code{height}.} - \item{order_columns}{A \code{\link{logical}} scalar: should should columns be reorderd?} \item{order_rows}{An \code{\link{integer}} vector giving the index of the column to be @@ -87,8 +83,8 @@ barplot(minor, order_columns = TRUE) Other plot methods: \code{\link{as_graph}()}, \code{\link{hist}()}, -\code{\link{plot}()}, -\code{\link{plot_logratio}} +\code{\link{pairs}()}, +\code{\link{plot}()} } \author{ N. Frerebeau diff --git a/man/bind.Rd b/man/bind.Rd index 29cfe43..6369536 100644 --- a/man/bind.Rd +++ b/man/bind.Rd @@ -34,20 +34,20 @@ X <- data.frame( Y <- as_composition(X) ## Split by group -## /!\ Unassigned samples are discarded ! /!\ +## /!\ Unassigned samples (NA) are discarded ! /!\ (s1 <- split(Y, f = X$groups)) -## Split by group -## Keep unassigned samples, see help(factor) -(s2 <- split(Y, f = factor(X$groups, exclude = NULL))) +## Better to use grouped matrix +(s2 <- group_split(Y, by = X$groups)) + +Z <- as_composition(X, groups = 2) +(s3 <- group_split(Z)) ## Bind by rows -do.call(rbind, s2) +do.call(rbind, s3) } \seealso{ Other subsetting methods: -\code{\link{extract}()}, -\code{\link{split}()}, \code{\link{subset}()} } \author{ diff --git a/man/condense.Rd b/man/condense.Rd index d42399c..54fe5f2 100644 --- a/man/condense.Rd +++ b/man/condense.Rd @@ -5,11 +5,14 @@ \alias{condense} \alias{condense-method} \alias{condense,CompositionMatrix-method} +\alias{condense,GroupedComposition-method} \title{Compositional Mean of Data Subsets} \usage{ condense(x, ...) -\S4method{condense}{CompositionMatrix}(x, by = groups(x), ...) +\S4method{condense}{CompositionMatrix}(x, by, verbose = getOption("nexus.verbose"), ...) + +\S4method{condense}{GroupedComposition}(x, by = NULL, verbose = getOption("nexus.verbose"), ...) } \arguments{ \item{x}{A \code{\linkS4class{CompositionMatrix}} object.} @@ -17,8 +20,10 @@ condense(x, ...) \item{...}{Further arguments to be passed to \code{\link[=mean]{mean()}}.} \item{by}{A \code{vector} or a list of grouping elements, each as long as the -variables in \code{x}. The elements are coerced to factors before use -(in the sense that \code{\link[=interaction]{interaction(by)}} defines the grouping).} +variables in \code{x} (see \code{\link[=group]{group()}}).} + +\item{verbose}{A \code{\link{logical}} scalar: should \R report extra information +on progress?} } \value{ A \code{\linkS4class{CompositionMatrix}} object. diff --git a/man/describe.Rd b/man/describe.Rd index 5646069..ba4b15b 100644 --- a/man/describe.Rd +++ b/man/describe.Rd @@ -4,9 +4,12 @@ \name{describe} \alias{describe} \alias{describe,CompositionMatrix-method} +\alias{describe,GroupedComposition-method} \title{Data Description} \usage{ \S4method{describe}{CompositionMatrix}(x) + +\S4method{describe}{GroupedComposition}(x) } \arguments{ \item{x}{A \code{\linkS4class{CompositionMatrix}} object.} diff --git a/man/detect_outlier.Rd b/man/detect_outlier.Rd index d419a6b..ce28e23 100644 --- a/man/detect_outlier.Rd +++ b/man/detect_outlier.Rd @@ -91,7 +91,7 @@ plot(out, type = "dotchart") plot(out, type = "distance") ## Detect outliers according to CJ -ref <- extract(coda, "CJ") +ref <- group_extract(coda, "CJ") out <- detect_outlier(coda, reference = ref, method = "mcd") plot(out, type = "dotchart") } diff --git a/man/extract.Rd b/man/extract.Rd deleted file mode 100644 index 678a70c..0000000 --- a/man/extract.Rd +++ /dev/null @@ -1,47 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/AllGenerics.R, R/group.R -\docType{methods} -\name{extract} -\alias{extract} -\alias{extract-method} -\alias{extract,CompositionMatrix-method} -\title{Group-based Subset} -\usage{ -extract(object, ...) - -\S4method{extract}{CompositionMatrix}(object, name) -} -\arguments{ -\item{object}{A \code{\linkS4class{CompositionMatrix}} object.} - -\item{...}{Currently not used.} - -\item{name}{A \code{\link{character}} vector specifying the \link[=groups]{group} of -\code{object} to extract.} -} -\value{ -A \code{\linkS4class{CompositionMatrix}} object. -} -\description{ -Group-based Subset -} -\examples{ -## Data from Aitchison 1986 -data("slides") -head(slides) - -## Coerce to compositional data -coda <- as_composition(slides, groups = 2) - -groups(coda) -} -\seealso{ -Other subsetting methods: -\code{\link{bind}}, -\code{\link{split}()}, -\code{\link{subset}()} -} -\author{ -N. Frerebeau -} -\concept{subsetting methods} diff --git a/man/figures/README-lra-2.png b/man/figures/README-lra-2.png index 775f651..ed33962 100644 Binary files a/man/figures/README-lra-2.png and b/man/figures/README-lra-2.png differ diff --git a/man/group.Rd b/man/group.Rd new file mode 100644 index 0000000..ec0dae6 --- /dev/null +++ b/man/group.Rd @@ -0,0 +1,95 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/group.R +\docType{methods} +\name{group} +\alias{group} +\alias{group-method} +\alias{ungroup} +\alias{group,CompositionMatrix-method} +\alias{group,GroupedComposition-method} +\alias{ungroup,GroupedComposition-method} +\alias{ungroup,GroupedLR-method} +\alias{ungroup,GroupedCLR-method} +\alias{ungroup,GroupedALR-method} +\alias{ungroup,GroupedILR-method} +\alias{ungroup,GroupedPLR-method} +\title{Working With Groups} +\usage{ +group(object, ...) + +ungroup(object, ...) + +\S4method{group}{CompositionMatrix}(object, by, verbose = getOption("nexus.verbose"), ...) + +\S4method{group}{GroupedComposition}(object, by, add = FALSE, verbose = getOption("nexus.verbose"), ...) + +\S4method{ungroup}{GroupedComposition}(object) + +\S4method{ungroup}{GroupedLR}(object) + +\S4method{ungroup}{GroupedCLR}(object) + +\S4method{ungroup}{GroupedALR}(object) + +\S4method{ungroup}{GroupedILR}(object) + +\S4method{ungroup}{GroupedPLR}(object) +} +\arguments{ +\item{object}{An \R object from which to set groups.} + +\item{...}{Further parameters to be passed to internal methods.} + +\item{by}{A possible value for the groups of \code{object} (typically, a +\code{\link{character}} vector). If \code{value} is a \code{\link{list}}, +\code{\link[=interaction]{interaction(by)}} defines the grouping.} + +\item{verbose}{A \code{\link{logical}} scalar: should \R report extra information +on progress?} + +\item{add}{A \code{\link{logical}} scalar. If \code{TRUE}, add to existing groups.} +} +\value{ +\itemize{ +\item \code{group()} returns an object of the same sort as \code{object} with the new +groups assigned. +\item \code{ungroup()} returns a \code{\link{character}} vector giving the group names of \code{x}. +} +} +\description{ +Define or remove the (reference) groups to which the observations belong. +} +\details{ +Missing values (\code{NA}) can be used to specify that a sample does not belong +to any group. +} +\examples{ +## Data from Aitchison 1986 +data("slides") + +## Coerce to compositional data +coda <- as_composition(slides, groups = 2) + +## Grouping metadata +group_levels(coda) + +group_names(coda) + +group_indices(coda) + +group_rows(coda) + +group_length(coda) + +group_size(coda) +} +\seealso{ +Other grouping methods: +\code{\link{group_extract}()}, +\code{\link{group_metadata}}, +\code{\link{group_split}()} +} +\author{ +N. Frerebeau +} +\concept{grouping methods} diff --git a/man/group_extract.Rd b/man/group_extract.Rd new file mode 100644 index 0000000..668f680 --- /dev/null +++ b/man/group_extract.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/group.R +\docType{methods} +\name{group_extract} +\alias{group_extract} +\alias{group_extract-method} +\alias{group_extract,GroupedComposition-method} +\title{Group-based Subset} +\usage{ +group_extract(object, ...) + +\S4method{group_extract}{GroupedComposition}(object, which) +} +\arguments{ +\item{object}{A \code{\linkS4class{GroupedComposition}} object.} + +\item{...}{Currently not used.} + +\item{which}{A \code{\link{character}} vector specifying the \link[=group]{groups} of +\code{object} to extract.} +} +\value{ +A \code{\linkS4class{CompositionMatrix}} object. +} +\description{ +Group-based Subset +} +\examples{ +## Data from Aitchison 1986 +data("slides") + +## Coerce to compositional data +coda <- as_composition(slides, groups = 2) + +## Grouping metadata +group_levels(coda) + +group_names(coda) + +group_indices(coda) + +group_rows(coda) + +group_length(coda) + +group_size(coda) +} +\seealso{ +Other grouping methods: +\code{\link{group}()}, +\code{\link{group_metadata}}, +\code{\link{group_split}()} +} +\author{ +N. Frerebeau +} +\concept{grouping methods} diff --git a/man/group_metadata.Rd b/man/group_metadata.Rd new file mode 100644 index 0000000..74b1caa --- /dev/null +++ b/man/group_metadata.Rd @@ -0,0 +1,133 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/group.R +\docType{methods} +\name{group_metadata} +\alias{group_metadata} +\alias{group_levels} +\alias{group_levels-method} +\alias{group_names} +\alias{group_names-method} +\alias{group_rows} +\alias{group_rows-method} +\alias{group_length} +\alias{group_length-method} +\alias{group_size} +\alias{group_size-method} +\alias{group_indices} +\alias{group_indices-method} +\alias{is_assigned} +\alias{is_assigned-method} +\alias{any_assigned} +\alias{any_assigned-method} +\alias{all_assigned} +\alias{group_levels,ReferenceGroups-method} +\alias{group_names,ReferenceGroups-method} +\alias{group_indices,ReferenceGroups-method} +\alias{group_rows,ReferenceGroups-method} +\alias{group_length,ReferenceGroups-method} +\alias{group_size,ReferenceGroups-method} +\alias{is_assigned,ReferenceGroups-method} +\alias{any_assigned,ReferenceGroups-method} +\alias{all_assigned,ReferenceGroups-method} +\title{Grouping Metadata} +\usage{ +group_levels(object) + +group_names(object) + +group_rows(object) + +group_length(object) + +group_size(object) + +group_indices(object) + +is_assigned(object) + +any_assigned(object) + +all_assigned(object) + +\S4method{group_levels}{ReferenceGroups}(object) + +\S4method{group_names}{ReferenceGroups}(object) + +\S4method{group_indices}{ReferenceGroups}(object) + +\S4method{group_rows}{ReferenceGroups}(object) + +\S4method{group_length}{ReferenceGroups}(object) + +\S4method{group_size}{ReferenceGroups}(object) + +\S4method{is_assigned}{ReferenceGroups}(object) + +\S4method{any_assigned}{ReferenceGroups}(object) + +\S4method{all_assigned}{ReferenceGroups}(object) +} +\arguments{ +\item{object}{A \link[=group]{grouped} \R object.} +} +\description{ +Retrieve the (reference) groups to which the observations belong. +} +\section{Functions}{ +\itemize{ +\item \code{group_levels(ReferenceGroups)}: returns a \code{\link{character}} vector giving the group +names. + +\item \code{group_names(ReferenceGroups)}: returns a \code{\link{character}} vector giving the name of +the group that each observation belongs to. + +\item \code{group_indices(ReferenceGroups)}: returns an \code{\link{integer}} vector giving the group +that each value belongs to. + +\item \code{group_rows(ReferenceGroups)}: returns a \code{list} of \code{\link{integer}} vectors giving the +observation that each group contains. + +\item \code{group_length(ReferenceGroups)}: gives the total number of groups. + +\item \code{group_size(ReferenceGroups)}: gives the size of each group. + +\item \code{is_assigned(ReferenceGroups)}: returns a \code{\link{logical}} vector specifying whether or +not an observation belongs to a group. + +\item \code{any_assigned(ReferenceGroups)}: returns an \code{\link{logical}} scalar specifying if any +observation belongs to a group. + +\item \code{all_assigned(ReferenceGroups)}: returns an \code{\link{logical}} scalar specifying if all +observations belong to a group. + +}} +\examples{ +## Data from Aitchison 1986 +data("slides") + +## Coerce to compositional data +coda <- as_composition(slides, groups = 2) + +## Grouping metadata +group_levels(coda) + +group_names(coda) + +group_indices(coda) + +group_rows(coda) + +group_length(coda) + +group_size(coda) +} +\seealso{ +Other grouping methods: +\code{\link{group}()}, +\code{\link{group_extract}()}, +\code{\link{group_split}()} +} +\author{ +N. Frerebeau +} +\concept{grouping methods} diff --git a/man/split.Rd b/man/group_split.Rd similarity index 57% rename from man/split.Rd rename to man/group_split.Rd index c1deabb..cb174e0 100644 --- a/man/split.Rd +++ b/man/group_split.Rd @@ -1,32 +1,47 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/AllGenerics.R, R/split.R \docType{methods} -\name{split} -\alias{split} +\name{group_split} +\alias{group_split} +\alias{group_split-method} +\alias{group_split,CompositionMatrix-method} +\alias{group_split,GroupedComposition-method} +\alias{group_split,GroupedLogRatio-method} \alias{split,CompositionMatrix-method} \alias{split,LogRatio-method} \title{Divide into Groups} \usage{ +group_split(object, ...) + +\S4method{group_split}{CompositionMatrix}(object, by, ...) + +\S4method{group_split}{GroupedComposition}(object, ...) + +\S4method{group_split}{GroupedLogRatio}(object, ...) + \S4method{split}{CompositionMatrix}(x, f, drop = FALSE, ...) \S4method{split}{LogRatio}(x, f, drop = FALSE, ...) } \arguments{ -\item{x}{A \code{\linkS4class{CompositionMatrix}} object.} +\item{object, x}{A \code{\linkS4class{CompositionMatrix}} object.} + +\item{...}{Currently not used.} + +\item{by}{A \code{vector} or a list of grouping elements, each as long as the +variables in \code{object} (see \code{\link[=group]{group()}}).} \item{f}{A 'factor' in the sense that \code{\link[=as.factor]{as.factor(f)}} defines the grouping, or a list of such factors in which case their interaction is used for the grouping (see \code{\link[base:split]{base::split()}}).} \item{drop}{A \code{\link{logical}} scalar: should levels that do not occur be dropped?} - -\item{...}{Currently not used.} } \value{ A \code{list} of \code{\linkS4class{CompositionMatrix}} objects. } \description{ -Divides the compositional matrix \code{x} into the groups defined by \code{f}. +Divides a compositional matrix by groups. } \examples{ ## Create a data.frame @@ -42,23 +57,25 @@ X <- data.frame( Y <- as_composition(X) ## Split by group -## /!\ Unassigned samples are discarded ! /!\ +## /!\ Unassigned samples (NA) are discarded ! /!\ (s1 <- split(Y, f = X$groups)) -## Split by group -## Keep unassigned samples, see help(factor) -(s2 <- split(Y, f = factor(X$groups, exclude = NULL))) +## Better to use grouped matrix +(s2 <- group_split(Y, by = X$groups)) + +Z <- as_composition(X, groups = 2) +(s3 <- group_split(Z)) ## Bind by rows -do.call(rbind, s2) +do.call(rbind, s3) } \seealso{ -Other subsetting methods: -\code{\link{bind}}, -\code{\link{extract}()}, -\code{\link{subset}()} +Other grouping methods: +\code{\link{group}()}, +\code{\link{group_extract}()}, +\code{\link{group_metadata}} } \author{ N. Frerebeau } -\concept{subsetting methods} +\concept{grouping methods} diff --git a/man/groups.Rd b/man/groups.Rd deleted file mode 100644 index 2d9d5c7..0000000 --- a/man/groups.Rd +++ /dev/null @@ -1,95 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/AllGenerics.R, R/group.R -\docType{methods} -\name{groups} -\alias{groups} -\alias{groups-method} -\alias{groups<-} -\alias{any_assigned} -\alias{any_assigned-method} -\alias{is_assigned} -\alias{is_assigned-method} -\alias{is_assigned,CompositionMatrix-method} -\alias{is_assigned,LogRatio-method} -\alias{any_assigned,CompositionMatrix-method} -\alias{any_assigned,LogRatio-method} -\alias{groups,CompositionMatrix-method} -\alias{groups,LogRatio-method} -\alias{groups,OutlierIndex-method} -\alias{groups<-,CompositionMatrix,ANY-method} -\alias{groups,CompositionMatrix,ANY-method} -\alias{groups<-,CompositionMatrix,list-method} -\alias{groups,CompositionMatrix,list-method} -\title{Working With Groups} -\usage{ -groups(object) - -groups(object) <- value - -any_assigned(object) - -is_assigned(object) - -\S4method{is_assigned}{CompositionMatrix}(object) - -\S4method{is_assigned}{LogRatio}(object) - -\S4method{any_assigned}{CompositionMatrix}(object) - -\S4method{any_assigned}{LogRatio}(object) - -\S4method{groups}{CompositionMatrix}(object) - -\S4method{groups}{LogRatio}(object) - -\S4method{groups}{OutlierIndex}(object) - -\S4method{groups}{CompositionMatrix,ANY}(object) <- value - -\S4method{groups}{CompositionMatrix,list}(object) <- value -} -\arguments{ -\item{object}{An object from which to get or set \code{groups}.} - -\item{value}{A possible value for the \code{groups} of \code{x} (typically, a -\code{\link{character}} vector). -If \code{value} is a \code{\link{list}}, \code{\link[=interaction]{interaction(value)}} defines the -grouping.} -} -\value{ -\itemize{ -\item \code{groups() <- value} returns an object of the same sort as \code{x} with the new -group names assigned. -\item \code{groups()} returns a \code{\link{character}} vector giving the group names of \code{x}. -\item \code{any_assigned()} returns a \code{\link{logical}} scalar specifying whether or not -\code{x} has groups. -\item \code{is_assigned()} returns a \code{\link{logical}} vector specifying whether or not an -observation belongs to a group. -} -} -\description{ -Retrieves or defines the (reference) groups to which the observations belong. -} -\details{ -Missing values (\code{NA}) or empty strings (\code{""}) can be used to specify that a -sample does not belong to any group. -} -\examples{ -## Data from Aitchison 1986 -data("slides") -head(slides) - -## Coerce to compositional data -coda <- as_composition(slides, groups = 2) - -groups(coda) -} -\seealso{ -Other mutators: -\code{\link{mutators}}, -\code{\link{totals}()} -} -\author{ -N. Frerebeau -} -\concept{mutators} diff --git a/man/hist.Rd b/man/hist.Rd index 892d22b..9945baa 100644 --- a/man/hist.Rd +++ b/man/hist.Rd @@ -78,8 +78,8 @@ Analysis of Environmental (Compositional) Data: Problems and Possibilities. Other plot methods: \code{\link{as_graph}()}, \code{\link{barplot}()}, -\code{\link{plot}()}, -\code{\link{plot_logratio}} +\code{\link{pairs}()}, +\code{\link{plot}()} } \author{ N. Frerebeau diff --git a/man/mutators.Rd b/man/mutators.Rd index 9486593..035a055 100644 --- a/man/mutators.Rd +++ b/man/mutators.Rd @@ -32,7 +32,6 @@ Getters and setters to retrieve or set parts of an object. } \seealso{ Other mutators: -\code{\link{groups}()}, \code{\link{totals}()} } \author{ diff --git a/man/nexus-package.Rd b/man/nexus-package.Rd index c8ce690..4ad6d1c 100644 --- a/man/nexus-package.Rd +++ b/man/nexus-package.Rd @@ -21,10 +21,10 @@ Exploration and analysis of compositional data in the framework of Aitchison (19 } \section{Package options}{ -\code{nexus} uses the following \code{\link[=options]{options()}} to configure behavior: +\pkg{nexus} uses the following \code{\link[=options]{options()}} to configure behavior: \itemize{ \item \code{nexus.verbose}: a \code{\link{logical}} scalar. Should \R report extra information -on progress? Defaults to \code{TRUE}. +on progress? Defaults to \code{\link[=interactive]{interactive()}}. } } diff --git a/man/pairs.Rd b/man/pairs.Rd new file mode 100644 index 0000000..f2094ed --- /dev/null +++ b/man/pairs.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AllGenerics.R, R/plot.R +\docType{methods} +\name{pairs} +\alias{pairs} +\alias{plot,CompositionMatrix,missing-method} +\alias{plot,GroupedComposition,missing-method} +\title{Plot Compositional Data} +\usage{ +\S4method{plot}{CompositionMatrix,missing}(x, margin = NULL, ...) + +\S4method{plot}{GroupedComposition,missing}( + x, + ..., + margin = NULL, + color = palette_color_discrete(), + symbol = palette_shape() +) +} +\arguments{ +\item{x}{A \code{\linkS4class{CompositionMatrix}} object.} + +\item{margin}{A \code{\link{character}} string or an \code{\link{integer}} giving the index of +the column to be used as the third part of the ternary plots. If \code{NULL} +(the default), marginal compositions will be used (i.e. the geometric mean +of the non-selected parts).} + +\item{...}{Further \link[graphics:par]{graphical parameters}.} + +\item{color}{A palette \code{\link{function}} that when called with a single +argument returns a \code{character} vector of colors.} + +\item{symbol}{A palette \code{\link{function}} that when called with a single +argument returns a vector of symbols.} +} +\value{ +\code{plot()} is called for its side-effects: is results in a graphic being +displayed (invisibly return \code{x}). +} +\description{ +Displays a matrix of ternary plots. +} +\examples{ +## Data from Day et al. 2011 +data("kommos", package = "folio") # Coerce to compositional data +kommos <- remove_NA(kommos, margin = 1) # Remove cases with missing values +coda <- as_composition(kommos, parts = 3:8, groups = 1) + +## Use ceramic types for grouping +plot(coda) + +## Center and scale ternary plots +plot(coda, by = NULL, center = TRUE, scale = TRUE) +} +\seealso{ +\code{\link[isopleuros:ternary_pairs]{isopleuros::ternary_pairs()}}, \code{\link[isopleuros:ternary_plot]{isopleuros::ternary_plot()}} + +Other plot methods: +\code{\link{as_graph}()}, +\code{\link{barplot}()}, +\code{\link{hist}()}, +\code{\link{plot}()} +} +\author{ +N. Frerebeau +} +\concept{plot methods} diff --git a/man/plot.Rd b/man/plot.Rd index 7469c66..d2e8528 100644 --- a/man/plot.Rd +++ b/man/plot.Rd @@ -3,63 +3,93 @@ \docType{methods} \name{plot} \alias{plot} -\alias{plot,CompositionMatrix,missing-method} -\title{Plot Compositional Data} +\alias{plot,LogRatio,missing-method} +\title{Plot Log-Ratios} \usage{ -\S4method{plot}{CompositionMatrix,missing}( +\S4method{plot}{LogRatio,missing}( x, ..., - by = groups(x), - margin = NULL, color = palette_color_discrete(), - symbol = palette_shape() + rug = TRUE, + ticksize = 0.05, + ncol = NULL, + flip = FALSE, + xlab = NULL, + ylab = NULL, + main = NULL, + ann = graphics::par("ann"), + axes = TRUE, + frame.plot = axes, + legend = list(x = "top") ) } \arguments{ -\item{x}{A \code{\linkS4class{CompositionMatrix}} object.} +\item{x}{A \code{\linkS4class{LogRatio}} object.} -\item{...}{Further \link[graphics:par]{graphical parameters}.} +\item{...}{Further \link[graphics:par]{graphical parameters}, particularly, +\code{border} and \code{col}.} -\item{by}{A \code{vector} of grouping elements, as long as the variables in \code{x}.} +\item{color}{A palette \code{\link{function}} that when called with a single +argument returns a \code{character} vector of colors (only used if \code{x} +\link[=group]{is grouped}).} -\item{margin}{A \code{\link{character}} string or an \code{\link{integer}} giving the index of -the column to be used as the third part of the ternary plots. If \code{NULL} -(the default), marginal compositions will be used (i.e. the geometric mean -of the non-selected parts).} +\item{rug}{A \code{\link{logical}} scalar: should a \emph{rug} representation (1-d plot) of +the data be added to the plot?} -\item{color}{A palette \code{\link{function}} that when called with a single -argument returns a \code{character} vector of colors.} +\item{ticksize}{A length-one \code{\link{numeric}} vector giving the length of the +ticks making up the \emph{rug}. Positive lengths give inwards ticks. Only used if +\code{rug} is \code{TRUE}.} + +\item{ncol}{An \code{\link{integer}} specifying the number of columns to use. +Defaults to 1 for up to 4 groups, otherwise to 2.} + +\item{flip}{A \code{\link{logical}} scalar: should the y-axis (ticks and numbering) be +flipped from side 2 (left) to 4 (right) from variable to variable?} + +\item{xlab, ylab}{A \code{\link{character}} vector giving the x and y axis labels.} + +\item{main}{A \code{\link{character}} string giving a main title for the plot.} + +\item{ann}{A \code{\link{logical}} scalar: should the default annotation (title and x +and y axis labels) appear on the plot?} -\item{symbol}{A palette \code{\link{function}} that when called with a single -argument returns a vector of symbols.} +\item{axes}{A \code{\link{logical}} scalar: should axes be drawn on the plot?} + +\item{frame.plot}{A \code{\link{logical}} scalar: should a box be drawn around the +plot?} + +\item{legend}{A \code{\link{list}} of additional arguments to be passed to +\code{\link[graphics:legend]{graphics::legend()}}; names of the list are used as argument names. +If \code{NULL}, no legend is displayed.} } \value{ \code{plot()} is called for its side-effects: is results in a graphic being displayed (invisibly return \code{x}). } \description{ -Displays a matrix of ternary plots. +Displays a density plot. } \examples{ ## Data from Day et al. 2011 data("kommos", package = "folio") # Coerce to compositional data kommos <- remove_NA(kommos, margin = 1) # Remove cases with missing values -coda <- as_composition(kommos, parts = 3:8, groups = 1) +coda <- as_composition(kommos, groups = 1) -## Use ceramic types for grouping -plot(coda) +## Log ratio +clr <- transform_clr(coda) -## Center and scale ternary plots -plot(coda, by = NULL, center = TRUE, scale = TRUE) +## Density plot +plot(clr, by = NULL, flip = TRUE) + +## Use ceramic types for grouping +plot(clr, flip = TRUE) } \seealso{ -\code{\link[isopleuros:ternary_pairs]{isopleuros::ternary_pairs()}}, \code{\link[isopleuros:ternary_plot]{isopleuros::ternary_plot()}} - Other plot methods: \code{\link{as_graph}()}, \code{\link{barplot}()}, \code{\link{hist}()}, -\code{\link{plot_logratio}} +\code{\link{pairs}()} } \author{ N. Frerebeau diff --git a/man/plot_logratio.Rd b/man/plot_logratio.Rd deleted file mode 100644 index c9f5a5f..0000000 --- a/man/plot_logratio.Rd +++ /dev/null @@ -1,100 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/AllGenerics.R, R/plot.R -\docType{methods} -\name{plot_logratio} -\alias{plot_logratio} -\alias{plot,LogRatio,missing-method} -\title{Plot Log-Ratios} -\usage{ -\S4method{plot}{LogRatio,missing}( - x, - ..., - by = groups(x), - color = palette_color_discrete(), - rug = TRUE, - ticksize = 0.05, - ncol = NULL, - flip = FALSE, - xlab = NULL, - ylab = NULL, - main = NULL, - ann = graphics::par("ann"), - axes = TRUE, - frame.plot = axes, - legend = list(x = "top") -) -} -\arguments{ -\item{x}{A \code{\linkS4class{LogRatio}} object.} - -\item{...}{Further \link[graphics:par]{graphical parameters}, particularly, -\code{border} and \code{col}.} - -\item{by}{A \code{vector} of grouping elements, as long as the variables in -\code{x}. If set, a matrix of panels defined by \code{groups} will be drawn.} - -\item{color}{A palette \code{\link{function}} that when called with a single -argument returns a \code{character} vector of colors.} - -\item{rug}{A \code{\link{logical}} scalar: should a \emph{rug} representation (1-d plot) of -the data be added to the plot?} - -\item{ticksize}{A length-one \code{\link{numeric}} vector giving the length of the -ticks making up the \emph{rug}. Positive lengths give inwards ticks. Only used if -\code{rug} is \code{TRUE}.} - -\item{ncol}{An \code{\link{integer}} specifying the number of columns to use. -Defaults to 1 for up to 4 groups, otherwise to 2.} - -\item{flip}{A \code{\link{logical}} scalar: should the y-axis (ticks and numbering) be -flipped from side 2 (left) to 4 (right) from variable to variable?} - -\item{xlab, ylab}{A \code{\link{character}} vector giving the x and y axis labels.} - -\item{main}{A \code{\link{character}} string giving a main title for the plot.} - -\item{ann}{A \code{\link{logical}} scalar: should the default annotation (title and x -and y axis labels) appear on the plot?} - -\item{axes}{A \code{\link{logical}} scalar: should axes be drawn on the plot?} - -\item{frame.plot}{A \code{\link{logical}} scalar: should a box be drawn around the -plot?} - -\item{legend}{A \code{\link{list}} of additional arguments to be passed to -\code{\link[graphics:legend]{graphics::legend()}}; names of the list are used as argument names. -If \code{NULL}, no legend is displayed.} -} -\value{ -\code{plot()} is called for its side-effects: is results in a graphic being -displayed (invisibly return \code{x}). -} -\description{ -Displays a density plot. -} -\examples{ -## Data from Day et al. 2011 -data("kommos", package = "folio") # Coerce to compositional data -kommos <- remove_NA(kommos, margin = 1) # Remove cases with missing values -coda <- as_composition(kommos, groups = 1) - -## Log ratio -clr <- transform_clr(coda) - -## Density plot -plot(clr, by = NULL, flip = TRUE) - -## Use ceramic types for grouping -plot(clr, flip = TRUE) -} -\seealso{ -Other plot methods: -\code{\link{as_graph}()}, -\code{\link{barplot}()}, -\code{\link{hist}()}, -\code{\link{plot}()} -} -\author{ -N. Frerebeau -} -\concept{plot methods} diff --git a/man/plot_outlier.Rd b/man/plot_outlier.Rd index ce9e3d1..78e962c 100644 --- a/man/plot_outlier.Rd +++ b/man/plot_outlier.Rd @@ -11,7 +11,6 @@ ..., type = c("dotchart", "distance"), robust = TRUE, - colors = color("discreterainbow"), symbols = c(16, 1, 3), xlim = NULL, ylim = NULL, @@ -30,7 +29,7 @@ \arguments{ \item{x}{An \code{\linkS4class{OutlierIndex}} object.} -\item{...}{Further \link[graphics:par]{graphical parameters}.} +\item{...}{Further parameters to be passed to \code{\link[graphics:points]{graphics::points()}}.} \item{type}{A \code{\link{character}} string specifying the type of plot that should be made. It must be one of "\code{dotchart}" or "\code{distance}". @@ -39,10 +38,6 @@ Any unambiguous substring can be given.} \item{robust}{A \code{\link{logical}} scalar: should robust Mahalanobis distances be displayed? Only used if \code{type} is "\code{dotchart}".} -\item{colors}{A vector of colors or a \code{function} that when called with a -single argument (an integer specifying the number of colors) returns a -vector of colors. Will be mapped to the group names.} - \item{symbols}{A lenth-three vector of symbol specification for non-outliers and outliers (resp.).} @@ -99,7 +94,7 @@ plot(out, type = "dotchart") plot(out, type = "distance") ## Detect outliers according to CJ -ref <- extract(coda, "CJ") +ref <- group_extract(coda, "CJ") out <- detect_outlier(coda, reference = ref, method = "mcd") plot(out, type = "dotchart") } diff --git a/man/subset.Rd b/man/subset.Rd index aa28f96..aaa1db3 100644 --- a/man/subset.Rd +++ b/man/subset.Rd @@ -80,9 +80,7 @@ head(subcoda) } \seealso{ Other subsetting methods: -\code{\link{bind}}, -\code{\link{extract}()}, -\code{\link{split}()} +\code{\link{bind}} } \author{ N. Frerebeau diff --git a/man/totals.Rd b/man/totals.Rd index 575336b..c3be161 100644 --- a/man/totals.Rd +++ b/man/totals.Rd @@ -54,7 +54,6 @@ head(X) } \seealso{ Other mutators: -\code{\link{groups}()}, \code{\link{mutators}} } \author{ diff --git a/man/transform_alr.Rd b/man/transform_alr.Rd index 68a4059..d5e2d2d 100644 --- a/man/transform_alr.Rd +++ b/man/transform_alr.Rd @@ -5,14 +5,20 @@ \alias{transform_alr} \alias{transform_alr-method} \alias{transform_alr,CompositionMatrix-method} +\alias{transform_alr,GroupedComposition-method} \alias{transform_alr,CLR-method} +\alias{transform_alr,GroupedCLR-method} \title{Additive Log-Ratios (ALR)} \usage{ transform_alr(object, ...) \S4method{transform_alr}{CompositionMatrix}(object, j = ncol(object), weights = FALSE) +\S4method{transform_alr}{GroupedComposition}(object, j = ncol(object), weights = FALSE) + \S4method{transform_alr}{CLR}(object, j = ncol(object)) + +\S4method{transform_alr}{GroupedCLR}(object, j = ncol(object), weights = FALSE) } \arguments{ \item{object}{A \code{\linkS4class{CompositionMatrix}} object.} diff --git a/man/transform_clr.Rd b/man/transform_clr.Rd index 5442410..400709d 100644 --- a/man/transform_clr.Rd +++ b/man/transform_clr.Rd @@ -5,14 +5,20 @@ \alias{transform_clr} \alias{transform_clr-method} \alias{transform_clr,CompositionMatrix-method} +\alias{transform_clr,GroupedComposition-method} \alias{transform_clr,ALR-method} +\alias{transform_clr,GroupedALR-method} \title{Centered Log-Ratios (CLR)} \usage{ transform_clr(object, ...) \S4method{transform_clr}{CompositionMatrix}(object, weights = FALSE) +\S4method{transform_clr}{GroupedComposition}(object, weights = FALSE) + \S4method{transform_clr}{ALR}(object) + +\S4method{transform_clr}{GroupedALR}(object) } \arguments{ \item{object}{A \code{\linkS4class{CompositionMatrix}} object.} diff --git a/man/transform_ilr.Rd b/man/transform_ilr.Rd index ed817d3..ad44200 100644 --- a/man/transform_ilr.Rd +++ b/man/transform_ilr.Rd @@ -6,19 +6,31 @@ \alias{transform_ilr-method} \alias{transform_ilr,CompositionMatrix-method} \alias{transform_ilr,CompositionMatrix,missing-method} +\alias{transform_ilr,GroupedComposition-method} +\alias{transform_ilr,GroupedComposition,missing-method} \alias{transform_ilr,CLR-method} \alias{transform_ilr,CLR,missing-method} +\alias{transform_ilr,GroupedCLR-method} +\alias{transform_ilr,GroupedCLR,missing-method} \alias{transform_ilr,ALR-method} \alias{transform_ilr,ALR,missing-method} +\alias{transform_ilr,GroupedALR-method} +\alias{transform_ilr,GroupedALR,missing-method} \title{Isometric Log-Ratios (ILR)} \usage{ transform_ilr(object, ...) \S4method{transform_ilr}{CompositionMatrix}(object) +\S4method{transform_ilr}{GroupedComposition}(object) + \S4method{transform_ilr}{CLR}(object) +\S4method{transform_ilr}{GroupedCLR}(object) + \S4method{transform_ilr}{ALR}(object) + +\S4method{transform_ilr}{GroupedALR}(object) } \arguments{ \item{object}{A \code{\linkS4class{CompositionMatrix}} object.} diff --git a/man/transform_inverse.Rd b/man/transform_inverse.Rd index b3706f7..4f11563 100644 --- a/man/transform_inverse.Rd +++ b/man/transform_inverse.Rd @@ -5,8 +5,11 @@ \alias{transform_inverse} \alias{transform_inverse-method} \alias{transform_inverse,CLR,missing-method} +\alias{transform_inverse,GroupedCLR,missing-method} \alias{transform_inverse,ALR,missing-method} +\alias{transform_inverse,GroupedALR,missing-method} \alias{transform_inverse,ILR,missing-method} +\alias{transform_inverse,GroupedILR,missing-method} \alias{transform_inverse,matrix,ILR-method} \title{Inverse Log-Ratio Transformation} \usage{ @@ -14,10 +17,16 @@ transform_inverse(object, origin, ...) \S4method{transform_inverse}{CLR,missing}(object) +\S4method{transform_inverse}{GroupedCLR,missing}(object) + \S4method{transform_inverse}{ALR,missing}(object) +\S4method{transform_inverse}{GroupedALR,missing}(object) + \S4method{transform_inverse}{ILR,missing}(object) +\S4method{transform_inverse}{GroupedILR,missing}(object) + \S4method{transform_inverse}{matrix,ILR}(object, origin) } \arguments{ diff --git a/man/transform_lr.Rd b/man/transform_lr.Rd index 5f77c85..c1cb095 100644 --- a/man/transform_lr.Rd +++ b/man/transform_lr.Rd @@ -5,11 +5,14 @@ \alias{transform_lr} \alias{transform_lr-method} \alias{transform_lr,CompositionMatrix-method} +\alias{transform_lr,GroupedComposition-method} \title{Pairwise Log-Ratios (LR)} \usage{ transform_lr(object, ...) \S4method{transform_lr}{CompositionMatrix}(object, weights = FALSE) + +\S4method{transform_lr}{GroupedComposition}(object, weights = FALSE) } \arguments{ \item{object}{A \code{\linkS4class{CompositionMatrix}} object.} diff --git a/man/transform_plr.Rd b/man/transform_plr.Rd index 9bf7d84..9d852f2 100644 --- a/man/transform_plr.Rd +++ b/man/transform_plr.Rd @@ -5,11 +5,14 @@ \alias{transform_plr} \alias{transform_plr-method} \alias{transform_plr,CompositionMatrix-method} +\alias{transform_plr,GroupedComposition-method} \title{Pivot Log-Ratios (PLR)} \usage{ transform_plr(object, ...) \S4method{transform_plr}{CompositionMatrix}(object, pivot = 1) + +\S4method{transform_plr}{GroupedComposition}(object, pivot = 1) } \arguments{ \item{object}{A \code{\linkS4class{CompositionMatrix}} object.} diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index 42fc6c5..b371db6 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -7,6 +7,9 @@ reference: - title: Compositional Data contents: - has_concept("compositional data tools") +- title: Reference Groups + contents: + - has_concept("grouping methods") - title: Operations in the Simplex contents: - has_concept("operations in the simplex") diff --git a/vignettes/groups.Rmd b/vignettes/groups.Rmd new file mode 100644 index 0000000..8812737 --- /dev/null +++ b/vignettes/groups.Rmd @@ -0,0 +1,91 @@ +--- +title: "Working with Groups" +author: "N. Frerebeau" +date: "`r Sys.Date()`" +output: + markdown::html_format: + options: + toc: true + number_sections: true +bibliography: bibliography.bib +vignette: > + %\VignetteIndexEntry{Working with Groups} + %\VignetteEngine{knitr::knitr} + %\VignetteEncoding{UTF-8} +--- + +```{r, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r setup} +## Install extra packages (if needed) +# install.packages("folio") + +library(nexus) +``` + +Provenance studies typically rely on two approaches, which can be used together: + +* Identification of groups among the artifacts being studied, based on mineralogical or geochemical criteria (*clustering*). +* Comparison with so-called reference groups, i.e. known geological sources or archaeological contexts (*classification*). + +When coercing a `data.frame` to a `CompositionMatrix` object, **nexus** allows to specify whether an observation belongs to a specific group (or not): + +```{r} +## Data from Wood and Liu 2023 +data("bronze", package = "folio") + +## Use the third column (dynasties) for grouping +coda <- as_composition(bronze, groups = 3) +``` + +`groups(x)` and `groups(x) <- value` allow to retrieve or set groups of an existing `CompositionMatrix`. Missing values (`NA`) or empty strings can be used to specify that a sample does not belong to any group. + +Once groups have been defined, they can be used by further methods (e.g. plotting). +Note that for better readability, you can `select` only some of the parts (e.g. major elements): + +```{r barplot, fig.width=7, fig.height=7, out.width='100%'} +## Select major elements +major <- coda[, is_element_major(coda)] + +## Compositional bar plot +barplot(major, order_rows = "Cu", space = 0) +``` + +```{r mean, eval=FALSE} +## Compositional mean by artefact +coda <- condense(coda, by = list(bronze$dynasty, bronze$reference)) +``` + +# Multivariate Analysis +## Log-Ratio Analysis + +```{r pca, fig.width=7, fig.height=7, out.width='50%', fig.show='hold'} +## CLR +clr <- transform_clr(coda, weights = TRUE) + +## PCA +lra <- pca(clr) + +## Visualize results +viz_individuals(lra, color = c("#004488", "#DDAA33", "#BB5566")) +viz_hull(x = lra, border = c("#004488", "#DDAA33", "#BB5566")) + +viz_variables(lra) +``` + +# References + +Aitchison, J. (1986). *The Statistical Analysis of Compositional Data. Monographs on Statistics and Applied Probability*. Londres, UK ; New York, USA: Chapman and Hall. + +Egozcue, J. J., Pawlowsky-Glahn, V., Mateu-Figueras, G. and Barceló-Vidal, C. (2003). Isometric Logratio Transformations for Compositional Data Analysis. *Mathematical Geology*, 35(3): 279-300. DOI: [10.1023/A:1023818214614](https://doi.org/10.1023/A:1023818214614). + +Greenacre, M. (2021). Compositional Data Analysis. *Annual Review of Statistics and Its Application*, 8(1): 271-299. DOI: [10.1146/annurev-statistics-042720-124436](https://doi.org/10.1146/annurev-statistics-042720-124436). + +Hron, K., Filzmoser, P., de Caritat, P., Fišerová, E. and Gardlo, A. (2017). Weighted Pivot Coordinates for Compositional Data and Their Application to Geochemical Mapping. *Mathematical Geosciences*, 49(6): 797-814. DOI : [10.1007/s11004-017-9684-z](https://doi.org/10.1007/s11004-017-9684-z). + +Weigand, P. C., Harbottle, G. and Sayre, E. (1977). Turquoise Sources and Source Analysisis: Mesoamerica and the Southwestern U.S.A. In J. Ericson & T. K. Earle (Eds.), *Exchange Systems in Prehistory*, 15-34. New York, NY: Academic Press. diff --git a/vignettes/nexus.Rmd b/vignettes/nexus.Rmd index 92e267c..d8d99e5 100644 --- a/vignettes/nexus.Rmd +++ b/vignettes/nexus.Rmd @@ -66,7 +66,7 @@ counts <- as_amounts(coda) all.equal(hongite, as.data.frame(counts)) ``` -The `parts` argument of the function `as_composition()` is used to define the columns to be used as the compositional part. If `parts` is `NULL` (the default), all non-integer numeric columns (i.e. of type `double`) are used. In the case of a `data.frame` coercion, additional columns are removed. +The `parts` argument of the function `as_composition()` is used to define the columns to be used as the compositional part. If `parts` is `NULL` (the default), all `numeric` columns are used. In the case of a `data.frame` coercion, additional columns are removed. ```{r} ## Create a data.frame @@ -82,40 +82,6 @@ X <- data.frame( Y <- as_composition(X) ``` -# Working with (reference) groups - -Provenance studies typically rely on two approaches, which can be used together: - -* Identification of groups among the artifacts being studied, based on mineralogical or geochemical criteria (*clustering*). -* Comparison with so-called reference groups, i.e. known geological sources or archaeological contexts (*classification*). - -When coercing a `data.frame` to a `CompositionMatrix` object, **nexus** allows to specify whether an observation belongs to a specific group (or not): - -```{r} -## Data from Wood and Liu 2023 -data("bronze", package = "folio") - -## Use the third column (dynasties) for grouping -coda <- as_composition(bronze, groups = 3) -``` - -`groups(x)` and `groups(x) <- value` allow to retrieve or set groups of an existing `CompositionMatrix`. Missing values (`NA`) or empty strings can be used to specify that a sample does not belong to any group. - -Once groups have been defined, they can be used by further methods (e.g. plotting). -Note that for better readability, you can `select` only some of the parts (e.g. major elements): - -```{r barplot, fig.width=7, fig.height=7, out.width='100%'} -## Compositional bar plot -barplot(coda, select = is_element_major(coda), order_rows = "Cu", space = 0) -``` - -# Descriptive statistics - -```{r mean, eval=FALSE} -## Compositional mean by artefact -coda <- condense(coda, by = list(bronze$dynasty, bronze$reference)) -``` - # Log-ratio transformations The package provides the following (inverse) transformations: centered log ratio (*CLR*, Aitchison 1986), additive log ratio (*ALR*, Aitchison 1986), isometric log ratio (*ILR*, Egozcue et al. 2003) and pivot log-ratio (*PLR*, Hron et al. 2017). @@ -130,64 +96,6 @@ back <- transform_inverse(clr) all.equal(back, coda) ``` -# Multivariate Analysis - -```{r} -## Assume that about a third of the samples does not belong to any group -grp <- groups(coda) -grp[sample(length(grp), size = 100)] <- NA - -## Set groups -groups(coda) <- grp - -## Retrieve groups -# groups(coda) -``` - -## Log-Ratio Analysis - -```{r pca, fig.width=7, fig.height=7, out.width='50%', fig.show='hold'} -## CLR -clr <- transform_clr(coda, weights = TRUE) - -## PCA -lra <- pca(clr) - -## Visualize results -viz_individuals(lra, color = c("#004488", "#DDAA33", "#BB5566")) -viz_hull(x = lra, border = c("#004488", "#DDAA33", "#BB5566")) - -viz_variables(lra) -``` - -## MANOVA - -The log-transformed data can be assigned to a new column, allowing us to keep working with the data in the context of the original `data.frame`: - -```{r manova} -## ILR -ilr <- transform_ilr(coda) - -bronze$ilr <- ilr - -## MANOVA -fit <- manova(ilr ~ groups(ilr), data = bronze) -summary(fit) -``` - -The MANOVA results suggest that there are statistically significant differences between groups. - -## Linear Discriminant Analysis - -```{r lda, fig.width=7, fig.height=7, out.width='100%'} -## LDA -discr <- MASS::lda(groups(ilr) ~ ilr, data = bronze) -plot(discr) - -## Back transform results -transform_inverse(discr$means, origin = ilr) -``` - # References Aitchison, J. (1986). *The Statistical Analysis of Compositional Data. Monographs on Statistics and Applied Probability*. Londres, UK ; New York, USA: Chapman and Hall.