[Archetypes-commits] r67 - in pkg: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Apr 9 15:27:05 CEST 2014
Author: manuel
Date: 2014-04-09 15:27:05 +0200 (Wed, 09 Apr 2014)
New Revision: 67
Added:
pkg/R/simplex-pot.R
pkg/man/simplexplot.Rd
Removed:
pkg/inst/doc/
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/NEWS
pkg/R/archetypes-map.R
pkg/R/generics.R
pkg/inst/CITATION
pkg/man/archmap.Rd
pkg/man/parameters.Rd
pkg/man/skeletonplot.Rd
Log:
simplexplot
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2013-12-15 18:26:07 UTC (rev 66)
+++ pkg/DESCRIPTION 2014-04-09 13:27:05 UTC (rev 67)
@@ -1,8 +1,8 @@
Package: archetypes
Type: Package
Title: Archetypal Analysis
-Version: 2.1-2
-Date: 2013-12-15
+Version: 2.2-0
+Date: 2014-04-08
Depends:
methods,
stats,
@@ -14,9 +14,9 @@
mlbench,
ggplot2,
TSP
-Authors at R: c(person("Manuel", "J. A. Eugster", role = c("aut", "cre"),
- email = "manuel.eugster at stat.uni-muenchen.de"),
- person("Friedrich", "Leisch", role = "aut"))
+Authors at R: c(person("Manuel", "J. A. Eugster", role = c("aut", "cre"), email =
+ "manuel at mjae.net"), person("Friedrich", "Leisch", role = "aut"),
+ person("Sohan", "Seth", role = "ctb"))
Description: The main function archetypes implements a
framework for archetypal analysis supporting arbitary
problem solving mechanisms for the different conceputal
@@ -40,3 +40,4 @@
'memento.R'
'skeletonplot.R'
'archetypes-map.R'
+ 'simplex-pot.R'
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2013-12-15 18:26:07 UTC (rev 66)
+++ pkg/NAMESPACE 2014-04-09 13:27:05 UTC (rev 67)
@@ -1,5 +1,31 @@
-import(nnls)
-import(methods)
+S3method("[",stepArchetypes)
+S3method(barplot,archetypes)
+S3method(bestModel,repArchetypes)
+S3method(bestModel,stepArchetypes)
+S3method(coef,archetypes)
+S3method(fitted,archetypes)
+S3method(kappa,archetypes)
+S3method(nparameters,archetypes)
+S3method(nparameters,repArchetypes)
+S3method(nparameters,stepArchetypes)
+S3method(panorama,archetypes)
+S3method(pcplot,archetypes)
+S3method(pcplot,default)
+S3method(predict,archetypes)
+S3method(print,archetypes)
+S3method(print,repArchetypes)
+S3method(print,stepArchetypes)
+S3method(residuals,archetypes)
+S3method(rss,archetypes)
+S3method(rss,repArchetypes)
+S3method(rss,stepArchetypes)
+S3method(screeplot,stepArchetypes)
+S3method(summary,stepArchetypes)
+S3method(weights,archetypes)
+S3method(xyplot,archetypes)
+S3method(xyplot,robustArchetypes)
+S3method(xyplot,stepArchetypes)
+S3method(xyplot,weightedArchetypes)
export(archetypes)
export(archetypesFamily)
export(archmap)
@@ -16,6 +42,7 @@
export(robustArchetypes)
export(rss)
export(simplex_projection)
+export(simplexplot)
export(skeletonplot)
export(stepArchetypes)
export(tspsimplex_projection)
@@ -29,31 +56,3 @@
importFrom(stats,residuals)
importFrom(stats,screeplot)
importFrom(stats,weights)
-S3method("[",stepArchetypes)
-S3method(barplot,archetypes)
-S3method(bestModel,repArchetypes)
-S3method(bestModel,stepArchetypes)
-S3method(coef,archetypes)
-S3method(fitted,archetypes)
-S3method(kappa,archetypes)
-S3method(nparameters,archetypes)
-S3method(nparameters,repArchetypes)
-S3method(nparameters,stepArchetypes)
-S3method(panorama,archetypes)
-S3method(pcplot,archetypes)
-S3method(pcplot,default)
-S3method(predict,archetypes)
-S3method(print,archetypes)
-S3method(print,repArchetypes)
-S3method(print,stepArchetypes)
-S3method(residuals,archetypes)
-S3method(rss,archetypes)
-S3method(rss,repArchetypes)
-S3method(rss,stepArchetypes)
-S3method(screeplot,stepArchetypes)
-S3method(summary,stepArchetypes)
-S3method(weights,archetypes)
-S3method(xyplot,archetypes)
-S3method(xyplot,robustArchetypes)
-S3method(xyplot,stepArchetypes)
-S3method(xyplot,weightedArchetypes)
Modified: pkg/NEWS
===================================================================
--- pkg/NEWS 2013-12-15 18:26:07 UTC (rev 66)
+++ pkg/NEWS 2014-04-09 13:27:05 UTC (rev 67)
@@ -1,4 +1,11 @@
+Changes in archetypes version 2.2-0
+
+ o Added simplex plot with examples and reference.
+
+ o Updated weighted and robust archetypes reference.
+
+
Changes in archetypes version 2.1-2
o Moved vignette to 'vignettes' directory.
Modified: pkg/R/archetypes-map.R
===================================================================
--- pkg/R/archetypes-map.R 2013-12-15 18:26:07 UTC (rev 66)
+++ pkg/R/archetypes-map.R 2014-04-09 13:27:05 UTC (rev 67)
@@ -23,6 +23,7 @@
#' Invisible matrix with the projected archetypes
#'
#' @examples
+#' \dontrun{
#' data("skel", package = "archetypes")
#' skel2 <- subset(skel, select = -Gender)
#'
@@ -43,6 +44,7 @@
#' ## MDS projection:
#' archmap(a, col = skel$Gender,
#' projection = atypes_projection)
+#' }
#'
#' @family archmap
#'
@@ -51,6 +53,8 @@
projection_args = list(), rotate = 0,
cex = 1.5, col = 1, pch = 1, xlab = "", ylab = "",
axes = FALSE, asp = TRUE, ...) {
+
+ .Deprecated("simplexplot", old = "archmap")
stopifnot("archetypes" %in% class(object))
stopifnot(is.function(projection))
Modified: pkg/R/generics.R
===================================================================
--- pkg/R/generics.R 2013-12-15 18:26:07 UTC (rev 66)
+++ pkg/R/generics.R 2014-04-09 13:27:05 UTC (rev 67)
@@ -51,9 +51,10 @@
#' Parallel coordinates plot
#'
#' @param x An object.
-#' @rdname archetypes-generics
+#' @rdname archetypes-generics
#'
#' @export
pcplot <- function(x, ...) {
UseMethod('pcplot')
}
+
Added: pkg/R/simplex-pot.R
===================================================================
--- pkg/R/simplex-pot.R (rev 0)
+++ pkg/R/simplex-pot.R 2014-04-09 13:27:05 UTC (rev 67)
@@ -0,0 +1,190 @@
+#' @include archetypes-map.R
+{}
+
+
+#' Simplex visualization
+#'
+#' The stochastic nature of the alpha coefficients implies that they
+#' exist on a standard (K-1)-simplex with the K archetypes Z as the
+#' corners, and the coefficients as the coordinate with respect to these
+#' corners. A standard simplex can be projected to two dimensions via
+#' a skew orthogonal projection, where all the vertices of the simplex
+#' are shown on a circle connected by edges. The individual alpha
+#' coefficients can be then projected into this circle.
+#'
+#' @param object An \code{\link{archetypes}} object
+#' @param radius Radius of the projection
+#' @param order Order of the archetypes
+#' @param labels_cex Label expansion
+#' @param labels Labels
+#' @param show_labels Show labels
+#' @param points_col Color of the points
+#' @param points_pch Plot character of the points
+#' @param points_cex Character expansion of the points
+#' @param projection Projection function; see
+#' \code{\link{archmap_projections}}
+#' @param show_points Show the points
+#' @param show_circle Show the circle
+#' @param circle_col Color of the circle
+#' @param show_edges Show the edges
+#' @param edges_col Color of the edges
+#' @param direction_length Expansion of the direction pointers
+#' @param directions_col Color of the direction pointers
+#' @param show_direction Show direction pointers
+#' @param ... Additional arguments; currently ignored
+#'
+#' @return
+#' Invisible list of all computed components needed for the simplex
+#' visualization.
+#'
+#' @examples
+#' ### This example reproduces parts of the Figure 7 shown in
+#' ### "Probabilistic Archetypal Analysis" by Seth and Eugster (2014)
+#'
+#' data("toy", package = "archetypes")
+#'
+#' set.seed(1234); a3 <- archetypes(toy, k = 3)
+#' set.seed(1237); a4 <- archetypes(toy, k = 4)
+#' set.seed(1238); a5 <- archetypes(toy, k = 5)
+#'
+#' simplexplot(a3)
+#' simplexplot(a3, show_direction = TRUE, show_points = FALSE)
+#' simplexplot(a4, projection = tspsimplex_projection)
+#' simplexplot(a5, show_direction = TRUE, show_points = FALSE,
+#' direction_length = 2, directions_col = "black")
+#'
+#' @references
+#' See Section 6 in "Probabilistic Archetypal Analysis" by Seth and
+#' Eugster (2014), http://arxiv.org/abs/1312.7604.
+#'
+#' @family simplexplot
+#'
+#' @export
+simplexplot <- function(object, radius = 10, order = NULL,
+ labels_cex = 1, labels = NULL, show_labels = TRUE,
+ points_col = "#00000044", points_pch = 19, points_cex = 1,
+ projection = simplex_projection, show_points = TRUE,
+ show_circle = TRUE, circle_col = "lightgray",
+ show_edges = TRUE, edges_col = "lightgray",
+ show_direction = FALSE,
+ direction_length = 1, directions_col = points_col, ...) {
+
+ stopifnot("archetypes" %in% class(object))
+ stopifnot(is.function(projection))
+
+ k <- object$k
+
+ if ( is.null(order) )
+ order <- 1:k
+
+ if ( is.null(labels) )
+ labels <- sprintf("A%s", order)
+
+ if ( length(points_col) == 1 )
+ points_col <- rep(points_col, nrow(coef(object)))
+
+ if ( length(points_cex) == 1 )
+ points_cex <- rep(points_cex, nrow(coef(object)))
+
+ if ( length(directions_col) == 1)
+ directions_col <- rep(directions_col, nrow(coef(object)))
+
+
+ params <- parameters(object)[order, ]
+ coefs <- coef(object)[, order]
+
+
+ proj_z <- projection(params, r = radius - 1)
+ proj_h <- coefs %*% proj_z
+
+ proj_labels <- proj_z
+ t <- cbind(x = acos(proj_z[, "x"] / (radius-1)), y = asin(proj_z[, "y"] / (radius-1)))
+ proj_labels <- cbind(x = radius * cos(t[, "x"]), y = radius * sin(t[, "y"]))
+
+ proj_circle <- list(center = cbind(x = 0, y = 0), radius = radius - 1)
+ proj_edges <- proj_z[as.integer(combn(1:k, 2)), ]
+
+ proj_directions <- vector("list", length = nrow(object$alphas))
+
+ for ( j in 1:nrow(object$alphas)) {
+ s <- proj_h[j, , drop = FALSE]
+ d <- matrix(NA_real_, ncol = 2, nrow = ncol(object$alphas))
+ for ( i in 1:ncol(object$alphas) ) {
+ e <- proj_z[i, , drop = FALSE]
+
+ v <- e - s
+ m <- sqrt(sum(v^2))
+ v <- v / m
+
+ px <- s[1] + v[1] * direction_length * object$alphas[j, i]
+ py <- s[2] + v[2] * direction_length * object$alphas[j, i]
+
+ d[i, ] <- c(px, py)
+ }
+ proj_directions[[j]] <- list(s = s, e = d)
+ }
+
+
+ ### Plot:
+ plot(proj_z, type = "n", asp = TRUE,
+ xlim = c(-radius, radius), ylim = c(-radius, radius),
+ axes = FALSE, xlab = "", ylab = "")
+
+ if ( show_circle ) {
+ symbols(proj_circle$center, circles = radius - 1,
+ inches = FALSE, add = TRUE, asp = TRUE, fg = circle_col)
+ }
+
+ if ( show_edges ) {
+ lines(proj_edges, col = edges_col)
+ }
+
+ if ( show_labels ) {
+ text(proj_labels, labels = labels, cex = labels_cex)
+ }
+
+ if ( show_direction ) {
+ for ( d in proj_directions ) {
+ for ( i in 1:nrow(d$e) ) {
+ lines(rbind(d$s, d$e[i, ,drop = FALSE]), col = directions_col) #[j])
+ }
+ }
+ }
+
+ if ( show_points ) {
+ points(proj_h, col = points_col, pch = points_pch, cex = points_cex)
+ }
+
+
+ ret <- list(proj_z = proj_z, proj_h = proj_h, proj_labels = proj_labels,
+ proj_directions = proj_directions, proj_circle = proj_circle,
+ proj_edges = proj_edges)
+ class(ret) <- "simplexplot"
+
+
+ invisible(ret)
+}
+
+
+
+### Deviance: ########################################################
+
+gaussian_deviance <- function(object, data) {
+ y <- object$alphas %*% object$archetypes
+ sqrt(rowSums((y - data)^2))
+}
+
+
+poission_deviance <- function(object, data) {
+ t <- object$alphas %*% object$archetypes
+ rowSums(2 * (data * log((data +.Machine$double.eps)/t) - data + t))
+}
+
+
+bernoulli_deviance <- function(object, data) {
+ t <- object$alphas %*% object$archetypes
+ t[t > 1] <- 1.0
+ rowSums(2 * (data * log((data +.Machine$double.eps)/(t+.Machine$double.eps)) +
+ (1-data) * log(((1-data) +.Machine$double.eps)/(1-t+.Machine$double.eps))))
+}
+
Modified: pkg/inst/CITATION
===================================================================
--- pkg/inst/CITATION 2013-12-15 18:26:07 UTC (rev 66)
+++ pkg/inst/CITATION 2014-04-09 13:27:05 UTC (rev 67)
@@ -1,39 +1,58 @@
-
-citEntry(entry="Article",
- title="{From {S}pider-{M}an to {H}ero -- Archetypal Analsis in {R}",
- author=personList(as.person("Manuel J. A. Eugster"),
- as.person("Friedrich Leisch")),
- journal="Journal of Statistical Software",
- year="2009",
- volume="30",
- number="8",
- pages="1--23",
- url="http://www.jstatsoft.org/v30/i08/",
-
- header="To cite package archetypes in publications use:",
-
- textVersion=paste("Manuel J. A. Eugster and Friedrich Leisch.",
- "From Spider-Man to Hero -- Archetypal Analysis in R.",
- "Journal of Statistical Software, 30(8), 1-23, 2009.",
- "http://www.jstatsoft.org/v30/i08/")
-)
-
-
-citEntry(entry="Article",
- title="Weighted and Robust Archetypal Analysis",
- author=personList(as.person("Manuel J. A. Eugster"),
- as.person("Friedrich Leisch")),
- journal="Technical Report 82, Department of Statistics, Ludwig-Maximilians-Universitaet Muenchen, Germany",
- year="2010",
- volume="82",
- pages="1--13",
- url="http://epub.ub.uni-muenchen.de/11498/",
-
- header="To cite weighted and robust archetypes in publications use:",
-
- textVersion=paste("Manuel J. A. Eugster and Friedrich Leisch.",
- "Weighted and Robust Archetypal Analysis",
- "Technical Report 82, Department of Statistics, Ludwig-Maximilians-Universitaet Muenchen, Germany. 2010.",
- "http://epub.ub.uni-muenchen.de/11498/")
-)
-
+
+citEntry(entry="Article",
+ title="{From {S}pider-{M}an to {H}ero -- Archetypal Analsis in {R}",
+ author=personList(as.person("Manuel J. A. Eugster"),
+ as.person("Friedrich Leisch")),
+ journal="Journal of Statistical Software",
+ year="2009",
+ volume="30",
+ number="8",
+ pages="1--23",
+ url="http://www.jstatsoft.org/v30/i08/",
+
+ header="To cite package archetypes in publications use:",
+
+ textVersion=paste("Manuel J. A. Eugster and Friedrich Leisch.",
+ "From Spider-Man to Hero -- Archetypal Analysis in R.",
+ "Journal of Statistical Software, 30(8), 1-23, 2009.",
+ "http://www.jstatsoft.org/v30/i08/")
+)
+
+
+citEntry(entry="Article",
+ title="Weighted and Robust Archetypal Analysis",
+ author=personList(as.person("Manuel J. A. Eugster"),
+ as.person("Friedrich Leisch")),
+ journal="Computational Statistics and Data Analysis",
+ year = "2011",
+ volume = "55",
+ number = "3",
+ pages = "1215--1225",
+ url = "http://www.sciencedirect.com/science/article/pii/S0167947310004056",
+ preprint = "http://epub.ub.uni-muenchen.de/11498/",
+
+ header="To cite weighted and robust archetypes in publications use:",
+
+ textVersion=paste("Manuel J. A. Eugster and Friedrich Leisch.",
+ "Weighted and Robust Archetypal Analysis",
+ "Computational Statistics and Data Analysis, 55(3):1215-1225, 2011.",
+ "http://www.sciencedirect.com/science/article/pii/S0167947310004056")
+)
+
+
+citEntry(entry="TechReport",
+ title="Probabilistic Archetypal Analysis",
+ author=personList(as.person("Sohan Seth"),
+ as.person("Manuel J. A. Eugster")),
+ institution="arXiv.org",
+ year = "2014",
+ url = "http://arxiv.org/abs/1312.7604",
+
+ header="To cite the simplex visualization in publications use:",
+
+ textVersion=paste("Sohan Seth and Manuel J. A. Eugster.",
+ " Probabilistic Archetypal Analysis",
+ "arXiv.org, 2014.",
+ "http://arxiv.org/abs/1312.7604")
+)
+
Modified: pkg/man/archmap.Rd
===================================================================
--- pkg/man/archmap.Rd 2013-12-15 18:26:07 UTC (rev 66)
+++ pkg/man/archmap.Rd 2014-04-09 13:27:05 UTC (rev 67)
@@ -44,7 +44,8 @@
(projected) archetypes.
}
\examples{
-data("skel", package = "archetypes")
+\dontrun{
+ data("skel", package = "archetypes")
skel2 <- subset(skel, select = -Gender)
set.seed(1981)
@@ -65,6 +66,7 @@
archmap(a, col = skel$Gender,
projection = atypes_projection)
}
+}
\seealso{
Other archmap: \code{\link{atypes_projection}},
\code{\link{simplex_projection}},
Modified: pkg/man/parameters.Rd
===================================================================
--- pkg/man/parameters.Rd 2013-12-15 18:26:07 UTC (rev 66)
+++ pkg/man/parameters.Rd 2014-04-09 13:27:05 UTC (rev 67)
@@ -1,19 +1,19 @@
-\name{parameters}
-\alias{parameters}
-\alias{parameters-methods}
-\alias{parameters,archetypes-method}
-\alias{parameters,repArchetypes-method}
-\alias{parameters,stepArchetypes-method}
-\title{Return fitted archetypes}
-\arguments{
- \item{object}{An \code{archetypes} object.}
-
- \item{...}{Ignored.}
-}
-\value{
- Matrix with \eqn{k} archetypes.
-}
-\description{
- Return fitted archetypes
-}
-
+\name{parameters}
+\alias{parameters}
+\alias{parameters,archetypes-method}
+\alias{parameters,repArchetypes-method}
+\alias{parameters,stepArchetypes-method}
+\alias{parameters-methods}
+\title{Return fitted archetypes}
+\arguments{
+ \item{object}{An \code{archetypes} object.}
+
+ \item{...}{Ignored.}
+}
+\value{
+ Matrix with \eqn{k} archetypes.
+}
+\description{
+ Return fitted archetypes
+}
+
Added: pkg/man/simplexplot.Rd
===================================================================
--- pkg/man/simplexplot.Rd (rev 0)
+++ pkg/man/simplexplot.Rd 2014-04-09 13:27:05 UTC (rev 67)
@@ -0,0 +1,90 @@
+\name{simplexplot}
+\alias{simplexplot}
+\title{Simplex visualization}
+\usage{
+ simplexplot(object, radius = 10, order = NULL,
+ labels_cex = 1, labels = NULL, show_labels = TRUE,
+ points_col = "#00000044", points_pch = 19,
+ points_cex = 1, projection = simplex_projection,
+ show_points = TRUE, show_circle = TRUE,
+ circle_col = "lightgray", show_edges = TRUE,
+ edges_col = "lightgray", show_direction = FALSE,
+ direction_length = 1, directions_col = points_col, ...)
+}
+\arguments{
+ \item{object}{An \code{\link{archetypes}} object}
+
+ \item{radius}{Radius of the projection}
+
+ \item{order}{Order of the archetypes}
+
+ \item{labels_cex}{Label expansion}
+
+ \item{labels}{Labels}
+
+ \item{show_labels}{Show labels}
+
+ \item{points_col}{Color of the points}
+
+ \item{points_pch}{Plot character of the points}
+
+ \item{points_cex}{Character expansion of the points}
+
+ \item{projection}{Projection function; see
+ \code{\link{archmap_projections}}}
+
+ \item{show_points}{Show the points}
+
+ \item{show_circle}{Show the circle}
+
+ \item{circle_col}{Color of the circle}
+
+ \item{show_edges}{Show the edges}
+
+ \item{edges_col}{Color of the edges}
+
+ \item{direction_length}{Expansion of the direction
+ pointers}
+
+ \item{directions_col}{Color of the direction pointers}
+
+ \item{show_direction}{Show direction pointers}
+
+ \item{...}{Additional arguments; currently ignored}
+}
+\value{
+ Invisible list of all computed components needed for the
+ simplex visualization.
+}
+\description{
+ The stochastic nature of the alpha coefficients implies
+ that they exist on a standard (K-1)-simplex with the K
+ archetypes Z as the corners, and the coefficients as the
+ coordinate with respect to these corners. A standard
+ simplex can be projected to two dimensions via a skew
+ orthogonal projection, where all the vertices of the
+ simplex are shown on a circle connected by edges. The
+ individual alpha coefficients can be then projected into
+ this circle.
+}
+\examples{
+### This example reproduces parts of the Figure 7 shown in
+ ### "Probabilistic Archetypal Analysis" by Seth and Eugster (2014)
+
+ data("toy", package = "archetypes")
+
+ set.seed(1234); a3 <- archetypes(toy, k = 3)
+ set.seed(1237); a4 <- archetypes(toy, k = 4)
+ set.seed(1238); a5 <- archetypes(toy, k = 5)
+
+ simplexplot(a3)
+ simplexplot(a3, show_direction = TRUE, show_points = FALSE)
+ simplexplot(a4, projection = tspsimplex_projection)
+ simplexplot(a5, show_direction = TRUE, show_points = FALSE,
+ direction_length = 2, directions_col = "black")
+}
+\references{
+ See Section 6 in "Probabilistic Archetypal Analysis" by
+ Seth and Eugster (2014), http://arxiv.org/abs/1312.7604.
+}
+
Modified: pkg/man/skeletonplot.Rd
===================================================================
--- pkg/man/skeletonplot.Rd 2013-12-15 18:26:07 UTC (rev 66)
+++ pkg/man/skeletonplot.Rd 2014-04-09 13:27:05 UTC (rev 67)
@@ -7,9 +7,8 @@
ylab = "Height (cm)", base.radius = 2, xlab = "",
xlim = (nrow(x) * c(0, skel.width)),
ylim = c(0, skel.height),
- col = c(hipbase = 1, hip = 1, shoulderbase = 1, shoulder = 1,
- head = 1, elbow = 2, wrist = 3, knee = 4, ankle = 5, chest = "purple1",
- pelvis = 6), mtext = TRUE, skel.lwd = 1, ...)
+ col = c(hipbase = 1, hip = 1, shoulderbase = 1, shoulder = 1, head = 1, elbow = 2, wrist = 3, knee = 4, ankle = 5, chest = "purple1", pelvis = 6),
+ mtext = TRUE, skel.lwd = 1, ...)
jd()
}
More information about the Archetypes-commits
mailing list