[Archetypes-commits] r60 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jun 13 12:38:44 CEST 2012
Author: manuel
Date: 2012-06-13 12:38:44 +0200 (Wed, 13 Jun 2012)
New Revision: 60
Added:
pkg/man/archmap.Rd
pkg/man/archmap_projections.Rd
Modified:
pkg/DESCRIPTION
pkg/NAMESPACE
pkg/NEWS
pkg/R/archetypes-map.R
pkg/R/archetypes-movie.R
Log:
added archetypal maps.
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2012-06-13 08:15:46 UTC (rev 59)
+++ pkg/DESCRIPTION 2012-06-13 10:38:44 UTC (rev 60)
@@ -13,12 +13,10 @@
vcd,
mlbench,
ggplot2
-Author: Manuel J. A. Eugster
- <manuel.eugster at stat.uni-muenchen.de>,
- Friedrich leisch
- <friedrich.leisch at boku.ac.at>
-Maintainer: Manuel J. A. Eugster
- <manuel.eugster at stat.uni-muenchen.de>
+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"))
Description: The main function archetypes implements a
framework for archetypal analysis supporting arbitary
problem solving mechanisms for the different conceputal
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2012-06-13 08:15:46 UTC (rev 59)
+++ pkg/NAMESPACE 2012-06-13 10:38:44 UTC (rev 60)
@@ -1,6 +1,8 @@
export(archetypes)
export(archetypesFamily)
+export(archmap)
export(as.archetypes)
+export(atypes_projection)
export(bestModel)
export(jd)
export(moviepcplot)
@@ -11,6 +13,7 @@
export(pcplot)
export(robustArchetypes)
export(rss)
+export(simplex_projection)
export(skeletonplot)
export(stepArchetypes)
export(weightedArchetypes)
Modified: pkg/NEWS
===================================================================
--- pkg/NEWS 2012-06-13 08:15:46 UTC (rev 59)
+++ pkg/NEWS 2012-06-13 10:38:44 UTC (rev 60)
@@ -4,13 +4,15 @@
o Roxygen2-ified; added the Build-dep field to the DESCRIPTION
file.
+ o Added Author at R field to the DESCRIPTION file.
+
o Removed deprecated functions.
o Cleaned vignette 'archetypes.Rnw' and 'inst/doc' folder.
o Added predict function for 'original' archetypes.
- o Added archetype maps; based on cody by Friedrich Leisch.
+ o Added archetypal maps; based on code by Friedrich Leisch.
Changes in archetypes version 2.0-2
Modified: pkg/R/archetypes-map.R
===================================================================
--- pkg/R/archetypes-map.R 2012-06-13 08:15:46 UTC (rev 59)
+++ pkg/R/archetypes-map.R 2012-06-13 10:38:44 UTC (rev 60)
@@ -1,34 +1,82 @@
-# @export
-archmap <- function(object, cex = 1.5, rotate = 0, col = 1, pch = 1,
- xlab = "", ylab = "", axes = FALSE, asp = TRUE,
- space = alpha_space, ...) {
+#' Archetypal maps
+#'
+#' Two-dimensional projection of the observations based on the alpha
+#' coefficients into a space spanned by the (projected) archetypes.
+#'
+#' @param object An \code{\link{archetypes}} object
+#' @param projection Projection function; see
+#' \code{\link{archmap_projections}}
+#' @param rotate Rotation angle to rotate the projection
+#' @param cex Character expansion of archetypes
+#' @param col Color of observations
+#' @param pch Point character of observations
+#' @param xlab A label for the x-axis
+#' @param ylab A label for the y-axis
+#' @param axes Logical value to draw axes or not
+#' @param asp The y/x aspect ratio
+#' @param ... Arguments passed to the underlying plot function
+#'
+#' @return
+#' Invisible matrix with the projected archetypes
+#'
+#' @examples
+#' data("skel", package = "archetypes")
+#' skel2 <- subset(skel, select = -Gender)
+#'
+#' set.seed(1981)
+#' a <- archetypes(skel2, k = 5)
+#'
+#' ## Simplex projection:
+#' archmap(a, col = skel$Gender)
+#'
+#' ## MDS projection:
+#' archmap(a, projection = atypes_projection, col = skel$Gender)
+#'
+#' @family archmap
+#'
+#' @export
+archmap <- function(object, projection = simplex_projection, rotate = 0,
+ cex = 1.5, col = 1, pch = 1, xlab = "", ylab = "",
+ axes = FALSE, asp = TRUE, ...) {
+
+ stopifnot("archetypes" %in% class(object))
+ stopifnot(is.function(projection))
+
k <- object$k
- if(k<3) stop("Need at least 3 archetypes.\n")
- cmds <- space(dist(parameters(object)))
+ if( k < 3) {
+ stop("Need at least 3 archetypes.\n")
+ }
- if(rotate!=0){
- a <- pi*rotate/180
- A <- matrix(c(cos(a), -sin(a), sin(a),
- cos(a)), ncol=2)
- cmds <- cmds %*% A
+ ## Projection:
+ cmds <- projection(parameters(object))
+
+
+ ## Rotation:
+ if ( rotate != 0 ){
+ a <- pi*rotate/180
+ A <- matrix(c(cos(a), -sin(a), sin(a),
+ cos(a)), ncol=2)
+ cmds <- cmds %*% A
}
+
+ ## Active archetypes:
hmds <- chull(cmds)
active <- 1:k %in% hmds
- ## archetypes give border of plotting region
- plot(cmds, type="n", xlab=xlab, ylab=ylab, axes=axes, asp=asp, ...)
- points(coef(object) %*% cmds, col=col, pch=pch)
+ ## Plot region spanned by the projected archetypes:
+ plot(cmds, type = "n", xlab = xlab, ylab = ylab, axes = axes, asp = asp, ...)
+ points(coef(object) %*% cmds, col = col, pch = pch)
rad <- ceiling(log10(k)) + 1.5
polygon(cmds[hmds,])
points(cmds[active,], pch=21, cex=rad*cex, bg="grey")
text(cmds[active,], labels=(1:k)[active], cex=cex)
if(any(!active)){
- points(cmds[!active,,drop=FALSE], pch=21, cex=rad*cex,
- bg="white", fg="grey")
- text(cmds[!active,,drop=FALSE], labels=(1:k)[!active],
- cex=cex, col="grey20")
+ points(cmds[!active,,drop=FALSE], pch=21, cex=rad*cex,
+ bg="white", fg="grey")
+ text(cmds[!active,,drop=FALSE], labels=(1:k)[!active],
+ cex=cex, col="grey20")
}
invisible(cmds)
@@ -36,9 +84,21 @@
-# @export
-alpha_space <- function(x, r = 10) {
- n <- nrow(as.matrix(x))
+#' Archetypal map projections
+#'
+#' @param x Archetypes matrix
+#' @param r Radius of the simplex projection
+#'
+#' @return
+#' Matrix with the projected archetypes
+#'
+#' @family archmap
+#'
+#' @aliases archmap_projections
+#' @rdname archmap_projections
+#' @export
+simplex_projection <- function(x, r = 10) {
+ n <- nrow(x)
phi <- seq(-pi, pi, length.out = n + 1)
@@ -52,7 +112,8 @@
-# @export
-atypes_space <- function(x) {
- cmdscale(x)
+#' @rdname archmap_projections
+#' @export
+atypes_projection <- function(x) {
+ cmdscale(dist(x))
}
Modified: pkg/R/archetypes-movie.R
===================================================================
--- pkg/R/archetypes-movie.R 2012-06-13 08:15:46 UTC (rev 59)
+++ pkg/R/archetypes-movie.R 2012-06-13 10:38:44 UTC (rev 60)
@@ -35,7 +35,7 @@
xyplot(a, data, ...)
},
adata = {
- plot(adata(a), ...)
+ plot(fitted(a), ...)
},
rwdata = {
d <- zs$family$weightfn(data, a$reweights)
@@ -115,7 +115,7 @@
if ( atypesmovie )
pcplot(a, data, ...)
else
- pcplot(adata(a), rx=rx, ...)
+ pcplot(fitted(a), rx=rx, ...)
Sys.sleep(bsleep)
}
Added: pkg/man/archmap.Rd
===================================================================
--- pkg/man/archmap.Rd (rev 0)
+++ pkg/man/archmap.Rd 2012-06-13 10:38:44 UTC (rev 60)
@@ -0,0 +1,59 @@
+\name{archmap}
+\alias{archmap}
+\title{Archetypal maps}
+\usage{
+ archmap(object, projection = simplex_projection,
+ rotate = 0, cex = 1.5, col = 1, pch = 1, xlab = "",
+ ylab = "", axes = FALSE, asp = TRUE, ...)
+}
+\arguments{
+ \item{object}{An \code{\link{archetypes}} object}
+
+ \item{projection}{Projection function; see
+ \code{\link{archmap_projections}}}
+
+ \item{rotate}{Rotation angle to rotate the projection}
+
+ \item{cex}{Character expansion of archetypes}
+
+ \item{col}{Color of observations}
+
+ \item{pch}{Point character of observations}
+
+ \item{xlab}{A label for the x-axis}
+
+ \item{ylab}{A label for the y-axis}
+
+ \item{axes}{Logical value to draw axes or not}
+
+ \item{asp}{The y/x aspect ratio}
+
+ \item{...}{Arguments passed to the underlying plot
+ function}
+}
+\value{
+ Invisible matrix with the projected archetypes
+}
+\description{
+ Two-dimensional projection of the observations based on
+ the alpha coefficients into a space spanned by the
+ (projected) archetypes.
+}
+\examples{
+data("skel", package = "archetypes")
+ skel2 <- subset(skel, select = -Gender)
+
+ set.seed(1981)
+ a <- archetypes(skel2, k = 5)
+
+ ## Simplex projection:
+ archmap(a, col = skel$Gender)
+
+ ## MDS projection:
+ archmap(a, projection = atypes_projection, col = skel$Gender)
+}
+\seealso{
+ Other archmap: \code{\link{atypes_projection}},
+ \code{\link{simplex_projection}}
+}
+
Property changes on: pkg/man/archmap.Rd
___________________________________________________________________
Added: svn:keywords
+ Date Revision Author URL Id
Added: svn:eol-style
+ native
Added: pkg/man/archmap_projections.Rd
===================================================================
--- pkg/man/archmap_projections.Rd (rev 0)
+++ pkg/man/archmap_projections.Rd 2012-06-13 10:38:44 UTC (rev 60)
@@ -0,0 +1,25 @@
+\name{simplex_projection}
+\alias{archmap_projections}
+\alias{atypes_projection}
+\alias{simplex_projection}
+\title{Archetypal map projections}
+\usage{
+ simplex_projection(x, r = 10)
+
+ atypes_projection(x)
+}
+\arguments{
+ \item{x}{Archetypes matrix}
+
+ \item{r}{Radius of the simplex projection}
+}
+\value{
+ Matrix with the projected archetypes
+}
+\description{
+ Archetypal map projections
+}
+\seealso{
+ Other archmap: \code{\link{archmap}}
+}
+
Property changes on: pkg/man/archmap_projections.Rd
___________________________________________________________________
Added: svn:keywords
+ Date Revision Author URL Id
Added: svn:eol-style
+ native
More information about the Archetypes-commits
mailing list