[Archetypes-commits] r36 - in branches/pkg-robust: . R demo man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Apr 1 13:54:20 CEST 2010
Author: manuel
Date: 2010-04-01 13:54:20 +0200 (Thu, 01 Apr 2010)
New Revision: 36
Added:
branches/pkg-robust/R/archetypes-deprecated.R
branches/pkg-robust/R/memento.R
branches/pkg-robust/man/archetypes-deprecated.Rd
branches/pkg-robust/man/archetypes-generics.Rd
Removed:
branches/pkg-robust/R/archetypes-class-bc.R
branches/pkg-robust/man/pcplot-methods.Rd
branches/pkg-robust/man/plot-methods.Rd
Modified:
branches/pkg-robust/DESCRIPTION
branches/pkg-robust/NEWS
branches/pkg-robust/R/archetypes-barplot.R
branches/pkg-robust/R/archetypes-class.R
branches/pkg-robust/R/archetypes-kit-blocks.R
branches/pkg-robust/R/archetypes-kit.R
branches/pkg-robust/R/archetypes-movie.R
branches/pkg-robust/R/archetypes-panorama.R
branches/pkg-robust/R/archetypes-step.R
branches/pkg-robust/R/archetypes-xyplot.R
branches/pkg-robust/R/pcplot.R
branches/pkg-robust/R/skeletonplot.R
branches/pkg-robust/demo/00Index
Log:
Modified: branches/pkg-robust/DESCRIPTION
===================================================================
--- branches/pkg-robust/DESCRIPTION 2010-03-31 15:58:20 UTC (rev 35)
+++ branches/pkg-robust/DESCRIPTION 2010-04-01 11:54:20 UTC (rev 36)
@@ -1,10 +1,10 @@
-Package: archetypes.dev.robust
+Package: archetypes
Type: Package
Title: Archetypal Analysis
-Version: 1.0
-Date: 2009-04-23
-Depends: nnls (>= 1.1), modeltools
-Suggests: MASS, vcd
+Version: 2.0
+Date: 2010-04-01
+Depends: methods, modeltools, nnls (>= 1.1)
+Suggests: MASS, vcd, mlbench
Author: Manuel J. A. Eugster <manuel.eugster at stat.uni-muenchen.de>
Maintainer: Manuel J. A. Eugster <manuel.eugster at stat.uni-muenchen.de>
Description: The main function archetypes implements a framework for
Modified: branches/pkg-robust/NEWS
===================================================================
--- branches/pkg-robust/NEWS 2010-03-31 15:58:20 UTC (rev 35)
+++ branches/pkg-robust/NEWS 2010-04-01 11:54:20 UTC (rev 36)
@@ -1,19 +1,15 @@
Changes in archetypes version 2.0
- o Cleaned up interface.
+ o cleaned up interface; see '?archetypes-deprecated'.
- Rename to common names:
- atypes -> parameters
- adata -> fitted
- alphas -> coef
- betas -> coef
- plot -> xyplot
- ntypes <- nparameters
-
- Remove unneeded:
- iters -> NA
+ o added weighted and robust archetypes; see 'demo(robust-toy)' and
+ 'demo(robust-ozone)'.
- o added weighted and robust archetypes.
+ o added 'memento' environment to save internal states.
+ o added panorama plot; see '?panorama.archetypes'
+ o improved 'barplot.archetypes'.
+
+
Modified: branches/pkg-robust/R/archetypes-barplot.R
===================================================================
--- branches/pkg-robust/R/archetypes-barplot.R 2010-03-31 15:58:20 UTC (rev 35)
+++ branches/pkg-robust/R/archetypes-barplot.R 2010-04-01 11:54:20 UTC (rev 36)
@@ -7,8 +7,9 @@
#' \code{beside} creates one barplot with bars side by side.
#' @param which.beside Barplot according to \code{atypes} or \code{variables}.
#' @param which.below \code{compressed} plots the labels only once.
-#' @param percentage Show real values or percentages according to the
-#' original data.
+#' @param percentiles Show real values or percentile profiles.
+#' @param below.compressed.height Height of additional tail subplot.
+#' @param below.compressed.srt Rotations of the x-labels.
#' @param ... Passed to the underlying \code{\link{barplot}} call.
#' @return Undefined.
#' @method barplot archetypes
Deleted: branches/pkg-robust/R/archetypes-class-bc.R
===================================================================
--- branches/pkg-robust/R/archetypes-class-bc.R 2010-03-31 15:58:20 UTC (rev 35)
+++ branches/pkg-robust/R/archetypes-class-bc.R 2010-04-01 11:54:20 UTC (rev 36)
@@ -1,191 +0,0 @@
-
-
-#' Archetypes getter.
-#' @param zs An \code{archetypes}-related object.
-#' @param ... Further arguments.
-#' @return Archetypes matrix.
-#' @export
-#' @rdname archetypes-deprecated
-atypes <- function(zs, ...) {
- .Deprecated('parameters')
- UseMethod('atypes')
-}
-
-#' @S3method atypes archetypes
-#' @nord
-atypes.archetypes <- function(zs, ...) {
- return(zs$archetypes)
-}
-
-#' @S3method atypes stepArchetypes
-#' @nord
-atypes.stepArchetypes <- function(zs, ...) {
- return(lapply(zs, atypes))
-}
-
-#' @S3method atypes repArchetypes
-#' @nord
-atypes.repArchetypes <- function(zs, ...) {
- lapply(zs, atypes)
-}
-
-
-#' Number of archetypes getter.
-#' @param zs An \code{archetypes}-related object.
-#' @param ... Further arguments.
-#' @return Archetypes matrix.
-#' @export
-#' @rdname archetypes-deprecated
-ntypes <- function(zs, ...) {
- .Deprecated('nparameters')
- UseMethod('ntypes')
-}
-
-#' @S3method atypes archetypes
-#' @nord
-ntypes.archetypes <- function(zs, ...) {
- return(zs$k)
-}
-
-#' @S3method ntypes stepArchetypes
-#' @nord
-ntypes.stepArchetypes <- function(zs, ...) {
- return(sapply(zs, ntypes))
-}
-
-#' @S3method ntypes repArchetypes
-#' @nord
-ntypes.repArchetypes <- function(zs, ...) {
- ntypes(object[[1]])
-}
-
-
-
-#' Archetypes data approximation.
-#' @param zs An \code{archetypes}-related object.
-#' @param ... Further arguments.
-#' @return Approximated data matrix.
-#' @export
-#' @rdname archetypes-deprecated
-adata <- function(zs, ...) {
- .Deprecated('fitted')
- UseMethod('adata')
-}
-
-#' @S3method adata archetypes
-#' @nord
-adata.archetypes <- function(zs, ...) {
- return(t(t(zs$archetypes) %*% t(zs$alphas)))
-}
-
-
-
-#' Alpha getter.
-#' @param zs An \code{archetypes}-related object.
-#' @param ... Further arguments.
-#' @return Alpha matrix.
-#' @export
-#' @rdname archetypes-deprecated
-alphas <- function(zs, ...) {
- .Deprecated('coef')
- UseMethod('alphas')
-}
-
-#' @S3method alphas archetypes
-#' @nord
-alphas.archetypes <- function(zs, ...) {
- return(zs$alphas)
-}
-
-
-
-#' Beta getter.
-#' @param zs An \code{archetypes}-related object.
-#' @param ... Further arguments.
-#' @return Beta matrix.
-#' @export
-#' @rdname archetypes-deprecated
-betas <- function(zs, ...) {
- .Deprecated('coef')
- UseMethod('betas')
-}
-
-#' @S3method betas archetypes
-#' @nord
-betas.archetypes <- function(zs, ...) {
- return(zs$betas)
-}
-
-
-
-#' Iteration getter.
-#' @param zs An \code{archetypes}-related object.
-#' @param ... Further arguments.
-#' @return Number of iterations.
-#' @export
-#' @rdname archetypes-deprecated
-iters <- function(zs, ...) {
- .Deprecated()
- UseMethod('iters')
-}
-
-#' @S3method iters archetypes
-#' @nord
-iters.archetypes <- function(zs, ...) {
- return(zs$iters)
-}
-
-
-
-#' Archetypes history getter.
-#' @param zs An \code{archetypes}-related object.
-#' @param ... Further arguments.
-#' @return The \code{archetypes} object of the requested step.
-#' @export
-ahistory <- function(zs, ...) {
- UseMethod('ahistory')
-}
-
-#' Archetypes history getter.
-#' @param zs An \code{archetypes} object.
-#' @param step The step number to return.
-#' @param ... Ignored.
-#' @return The \code{archetypes} object of the requested step.
-#' @method ahistory archetypes
-#' @S3method ahistory archetypes
-ahistory.archetypes <- function(zs, step, ...) {
- if ( is.null(zs$history) )
- stop('No history available')
-
- if ( step >= 0 )
- s <- paste('s', step, sep='')
- else
- s <- paste('s', nhistory(zs) + step - 1, sep='')
-
- return(zs$history[[s]][[1]])
-}
-
-
-
-#' Number of history steps getter.
-#' @param zs An \code{archetypes}-related object.
-#' @param ... Further arguments.
-#' @return The number of history steps available.
-#' @export
-nhistory <- function(zs, ...) {
- UseMethod('nhistory')
-}
-
-#' Archetypes number of history steps getter.
-#' @param zs An \code{archetypes} object.
-#' @param ... Ignored.
-#' @return The number of history steps available.
-#' @method nhistory archetypes
-#' @S3method nhistory archetypes
-nhistory.archetypes <- function(zs, ...) {
- if ( is.null(zs$history) )
- stop('No history available')
-
- return(length(zs$history))
-}
-
Modified: branches/pkg-robust/R/archetypes-class.R
===================================================================
--- branches/pkg-robust/R/archetypes-class.R 2010-03-31 15:58:20 UTC (rev 35)
+++ branches/pkg-robust/R/archetypes-class.R 2010-04-01 11:54:20 UTC (rev 36)
@@ -128,11 +128,11 @@
#' Residual sum of squares.
-#' @param object An \code{archetypes}-related object.
+#' @param object An object.
#' @param ... Ignored.
#' @return Residual sum of squares.
#' @export
-#' @nord
+#' @rdname archetypes-generics
rss <- function(object, ...) {
UseMethod('rss')
}
@@ -145,7 +145,7 @@
#' @method rss archetypes
#' @S3method rss archetypes
#' @rdname archetypes-class
-rss.archetypes <- function(object, type = c('scaled', 'single', 'global')) {
+rss.archetypes <- function(object, type = c('scaled', 'single', 'global'), ...) {
type <- match.arg(type)
resid <- residuals(object)
@@ -161,11 +161,12 @@
#' @param object An \code{archetypes} object.
#' @param type Return global weights (weighted archetypes) or
#' weights calculated during the iterations (robust archetypes).
+#' @param ... Ignored.
#' @return Vector of weights.
#' @method weights archetypes
#' @S3method weights archetypes
#' @rdname archetypes-class
-weights.archetypes <- function(object, type = c('weights', 'reweights')) {
+weights.archetypes <- function(object, type = c('weights', 'reweights'), ...) {
type <- match.arg(type)
object[[type]]
}
@@ -212,11 +213,11 @@
#' Number of parameters.
-#' @param object An \code{archetypes}-related object.
+#' @param object An object.
#' @param ... Further arguments.
-#' @return Number of archetypes.
+#' @return Number of parameters.
#' @export
-#' @nord
+#' @rdname archetypes-generics
nparameters <- function(object, ...) {
UseMethod('nparameters')
}
Copied: branches/pkg-robust/R/archetypes-deprecated.R (from rev 35, branches/pkg-robust/R/archetypes-class-bc.R)
===================================================================
--- branches/pkg-robust/R/archetypes-deprecated.R (rev 0)
+++ branches/pkg-robust/R/archetypes-deprecated.R 2010-04-01 11:54:20 UTC (rev 36)
@@ -0,0 +1,212 @@
+
+
+#' Archetypes getter.
+#'
+#' replaced by \code{\link{parameters}}.
+#'
+#' @param zs An \code{archetypes}-related object.
+#' @param ... Further arguments.
+#' @return Archetypes matrix.
+#' @export
+#' @rdname archetypes-deprecated
+atypes <- function(zs, ...) {
+ .Deprecated('parameters')
+ UseMethod('atypes')
+}
+
+#' @S3method atypes archetypes
+#' @nord
+atypes.archetypes <- function(zs, ...) {
+ return(zs$archetypes)
+}
+
+#' @S3method atypes stepArchetypes
+#' @nord
+atypes.stepArchetypes <- function(zs, ...) {
+ return(lapply(zs, atypes))
+}
+
+#' @S3method atypes repArchetypes
+#' @nord
+atypes.repArchetypes <- function(zs, ...) {
+ lapply(zs, atypes)
+}
+
+
+#' Number of archetypes getter.
+#'
+#' replaced by \code{\link{nparameters}}.
+#'
+#' @param zs An \code{archetypes}-related object.
+#' @param ... Further arguments.
+#' @return Number of archetypes.
+#' @export
+#' @rdname archetypes-deprecated
+ntypes <- function(zs, ...) {
+ .Deprecated('nparameters')
+ UseMethod('ntypes')
+}
+
+#' @S3method atypes archetypes
+#' @nord
+ntypes.archetypes <- function(zs, ...) {
+ return(zs$k)
+}
+
+#' @S3method ntypes stepArchetypes
+#' @nord
+ntypes.stepArchetypes <- function(zs, ...) {
+ return(sapply(zs, ntypes))
+}
+
+#' @S3method ntypes repArchetypes
+#' @nord
+ntypes.repArchetypes <- function(zs, ...) {
+ ntypes(zs[[1]])
+}
+
+
+
+#' Archetypes data approximation.
+#'
+#' replaced by \code{\link{fitted}}.
+#'
+#' @param zs An \code{archetypes}-related object.
+#' @param ... Further arguments.
+#' @return Approximated data matrix.
+#' @export
+#' @rdname archetypes-deprecated
+adata <- function(zs, ...) {
+ .Deprecated('fitted')
+ UseMethod('adata')
+}
+
+#' @S3method adata archetypes
+#' @nord
+adata.archetypes <- function(zs, ...) {
+ return(t(t(zs$archetypes) %*% t(zs$alphas)))
+}
+
+
+
+#' Alpha getter.
+#'
+#' replaced by \code{\link{coef}}.
+#'
+#' @param zs An \code{archetypes}-related object.
+#' @param ... Further arguments.
+#' @return Alpha matrix.
+#' @export
+#' @rdname archetypes-deprecated
+alphas <- function(zs, ...) {
+ .Deprecated('coef')
+ UseMethod('alphas')
+}
+
+#' @S3method alphas archetypes
+#' @nord
+alphas.archetypes <- function(zs, ...) {
+ return(zs$alphas)
+}
+
+
+
+#' Beta getter.
+#'
+#' replaced by \code{\link{coef}}.
+#'
+#' @param zs An \code{archetypes}-related object.
+#' @param ... Further arguments.
+#' @return Beta matrix.
+#' @export
+#' @rdname archetypes-deprecated
+betas <- function(zs, ...) {
+ .Deprecated('coef')
+ UseMethod('betas')
+}
+
+#' @S3method betas archetypes
+#' @nord
+betas.archetypes <- function(zs, ...) {
+ return(zs$betas)
+}
+
+
+
+#' Iteration getter.
+#'
+#' removed.
+#'
+#' @param zs An \code{archetypes}-related object.
+#' @param ... Further arguments.
+#' @return Number of iterations.
+#' @export
+#' @rdname archetypes-deprecated
+iters <- function(zs, ...) {
+ .Deprecated()
+ UseMethod('iters')
+}
+
+#' @S3method iters archetypes
+#' @nord
+iters.archetypes <- function(zs, ...) {
+ return(zs$iters)
+}
+
+
+
+#' Archetypes history getter.
+#'
+#' removed; see \code{\link{memento}}.
+#'
+#' @param zs An \code{archetypes}-related object.
+#' @param ... Further arguments.
+#' @return The \code{archetypes} object of the requested step.
+#' @export
+#' @rdname archetypes-deprecated
+ahistory <- function(zs, ...) {
+ .Deprecated('memento')
+ UseMethod('ahistory')
+}
+
+
+#' @S3method ahistory archetypes
+#' @nord
+ahistory.archetypes <- function(zs, step, ...) {
+ if ( is.null(zs$history) )
+ stop('No history available')
+
+ if ( step >= 0 )
+ s <- paste('s', step, sep='')
+ else
+ s <- paste('s', nhistory(zs) + step - 1, sep='')
+
+ return(zs$history[[s]][[1]])
+}
+
+
+
+#' Number of history steps getter.
+#'
+#' removed; see \code{\link{memento}}.
+#'
+#' @param zs An \code{archetypes}-related object.
+#' @param ... Further arguments.
+#' @return The number of history steps available.
+#' @export
+#' @rdname archetypes-deprecated
+nhistory <- function(zs, ...) {
+ .Deprecated('memento')
+ UseMethod('nhistory')
+}
+
+
+#' @S3method nhistory archetypes
+#' @nord
+nhistory.archetypes <- function(zs, ...) {
+ if ( is.null(zs$history) )
+ stop('No history available')
+
+ return(length(zs$history))
+}
+
Modified: branches/pkg-robust/R/archetypes-kit-blocks.R
===================================================================
--- branches/pkg-robust/R/archetypes-kit-blocks.R 2010-03-31 15:58:20 UTC (rev 35)
+++ branches/pkg-robust/R/archetypes-kit-blocks.R 2010-04-01 11:54:20 UTC (rev 36)
@@ -354,7 +354,7 @@
binary.bisquare0.reweightsfn <- function(resid, reweights,
threshold = 0.1, ...) {
rw <- bisquare0.reweightsfn(resid, reweights, ...)
- ifelse(rw < cutpoint, 0, 1)
+ ifelse(rw < threshold, 0, 1)
}
Modified: branches/pkg-robust/R/archetypes-kit.R
===================================================================
--- branches/pkg-robust/R/archetypes-kit.R 2010-03-31 15:58:20 UTC (rev 35)
+++ branches/pkg-robust/R/archetypes-kit.R 2010-04-01 11:54:20 UTC (rev 36)
@@ -37,14 +37,15 @@
mycall <- match.call()
famargs <- list(...)
- history <- NULL
+ memento <- NULL
snapshot <- function(i) {
- history[[sprintf('s%s', i)]] <-
- list(archetypes = as.archetypes(t(family$rescalefn(x, family$undummyfn(x, zs))),
- k, alphas = t(alphas), betas = t(betas), rss = rss, kappas = kappas,
- zas = t(family$rescalefn(x, family$undummyfn(x, zas))),
- residuals = resid, reweights = reweights, weights = weights,
- family = list(class = family$class)))
+ a <- list(archetypes = as.archetypes(t(family$rescalefn(x, family$undummyfn(x, zs))),
+ k, alphas = t(alphas), betas = t(betas), rss = rss, kappas = kappas,
+ zas = t(family$rescalefn(x, family$undummyfn(x, zas))),
+ residuals = resid, reweights = reweights, weights = weights,
+ family = list(class = family$class)))
+
+ memento$save(i, a)
}
printIter <- function(i) {
@@ -85,7 +86,7 @@
errormsg <- NULL
if ( saveHistory ) {
- history <- new.env(parent=emptyenv())
+ memento <- new.memento()
snapshot(0)
}
@@ -166,7 +167,7 @@
return(as.archetypes(t(zs), k, t(alphas), rss, iters = (i-1),
- call = mycall, history = history, kappas = kappas,
+ call = mycall, history = memento, kappas = kappas,
betas = t(betas), family = family,
familyArgs = famargs, residuals = t(resid),
weights = weights, reweights = reweights))
Modified: branches/pkg-robust/R/archetypes-movie.R
===================================================================
--- branches/pkg-robust/R/archetypes-movie.R 2010-03-31 15:58:20 UTC (rev 35)
+++ branches/pkg-robust/R/archetypes-movie.R 2010-04-01 11:54:20 UTC (rev 36)
@@ -8,16 +8,18 @@
#' @param bsleep Seconds to sleep between each plot.
#' @param postfn Post plot function; is called in each
#' iteration after the plot call.
+#' @param rwdata.col1 If \code{show = 'rwdata'}: color of base data set.
+#' @param rwdata.col2 If \code{show = 'rwdata'}: color of weighted data set.
#' @param ... Passed to underlying plot functions.
#' @return Undefined.
#' @aliases movieplot
#' @export
-movieplot <- function(zs, data, show=c('atypes', 'adata', 'rwdata'),
- ssleep=0, bsleep=0, postfn=function(iter){},
+movieplot <- function(zs, data, show = c('atypes', 'adata', 'rwdata'),
+ ssleep = 0, bsleep = 0, postfn = function(iter){},
rwdata.col1 = gray(0.7), rwdata.col2 = 2, ...) {
show <- match.arg(show)
- steps <- length(zs$history)
+ steps <- length(zs$history$states())
if ( show == 'rwdata' )
data <- zs$family$scalefn(t(data))
@@ -26,18 +28,15 @@
Sys.sleep(ssleep)
for ( i in seq_len(steps)-1 ) {
- a <- ahistory(zs, step=i)
+ a <- zs$history$get(i)[[1]]
switch(show,
-
atypes = {
xyplot(a, data, ...)
},
-
adata = {
plot(adata(a), ...)
},
-
rwdata = {
d <- zs$family$weightfn(data, a$reweights)
@@ -73,22 +72,22 @@
zas.col=2, zas.pch=13,
old.col=rgb(1,0.5,0.5), ...) {
- steps <- length(zs$history)
+ steps <- length(zs$history$states())
Sys.sleep(ssleep)
# Initial archetypes:
- a <- ahistory(zs, step=0)
+ a <- zs$history$get(0)[[1]]
plot(a, data, ...)
Sys.sleep(bsleep)
# Alternating loop:
for ( i in seq_len(steps-1) ) {
- a0 <- ahistory(zs, step=(i-1))
- a <- ahistory(zs, step=i)
+ a0 <- zs$history$get(i-1)[[1]]
+ a <- zs$history$get(i)[[1]]
- xyplot(a0, data, atypes.col=old.col, ...)
- points(a$zas, col=zas.col, pch=zas.pch, ...)
+ xyplot(a0, data, atypes.col = old.col, ...)
+ points(a$zas, col = zas.col, pch = zas.pch, ...)
Sys.sleep(bsleep)
xyplot(a0, data, atypes.col=old.col, ...)
@@ -115,7 +114,7 @@
moviepcplot <- function(zs, data, show=c('atypes', 'adata'),
ssleep=0, bsleep=0, ...) {
- steps <- length(zs$history)
+ steps <- length(zs$history$states())
atypesmovie <- ifelse(show[1] == 'atypes', TRUE, FALSE)
rx <- apply(data, 2, range, na.rm=TRUE)
@@ -123,7 +122,7 @@
# ... and play:
for ( i in seq_len(steps)-1 ) {
- a <- ahistory(zs, step=i)
+ a <- zs$history$get(i)
if ( atypesmovie )
pcplot(a, data, ...)
Modified: branches/pkg-robust/R/archetypes-panorama.R
===================================================================
--- branches/pkg-robust/R/archetypes-panorama.R 2010-03-31 15:58:20 UTC (rev 35)
+++ branches/pkg-robust/R/archetypes-panorama.R 2010-04-01 11:54:20 UTC (rev 36)
@@ -1,10 +1,11 @@
-#' Generic function for panorama plot.
+#' Panorama plot.
#' @param object An object.
#' @param ... Further arguments.
+#' @return Undefined.
#' @export
-#' @nord
+#' @rdname archetypes-generics
panorama <- function(object, ...) {
UseMethod('panorama')
}
@@ -23,16 +24,26 @@
#' @param cex magnification of the distances.
#' @param atypes.col Color of archetype distances.
#' @param atypes.pch Plot character of archetype distances.
-#' @param atypes.cex magnification of the archetype distances.
+#' @param atypes.cex Magnification of the archetype distances.
+#' @param ylim The y limits of the plot.
#' @param ... Passed to the underlying \code{plot} call.
#' @S3method panorama archetypes
#' @method panorama archetypes
+#' @examples
+#' \dontrun{
+#' data(toy)
+#' a <- archetypes(toy, 3)
+#' panorama(a, toy)
+#'
+#' ## See demo(robust-ozone).
+#' }
panorama.archetypes <- function(object, data, distfn = distEuclidean,
xlab = 'Index', ylab = 'Distance',
order = TRUE, col = 1, pch = 1, cex = 1,
atypes.col = (seq(length = nparameters(object)) + 1),
atypes.pch = rep(19, nparameters(object)),
- atypes.cex = rep(1, nparameters(object)), ylim = NULL, ...) {
+ atypes.cex = rep(1, nparameters(object)),
+ ylim = NULL, ...) {
n1 <- nrow(data)
n2 <- nparameters(object)
Modified: branches/pkg-robust/R/archetypes-step.R
===================================================================
--- branches/pkg-robust/R/archetypes-step.R 2010-03-31 15:58:20 UTC (rev 35)
+++ branches/pkg-robust/R/archetypes-step.R 2010-04-01 11:54:20 UTC (rev 36)
@@ -117,7 +117,7 @@
#' @S3method parameters stepArchetypes
#' @rdname stepArchetypes
parameters.stepArchetypes <- function(object, ...) {
- return(lapply(zs, parameters))
+ return(lapply(object, parameters))
}
@@ -130,38 +130,38 @@
#' @S3method nparameters stepArchetypes
#' @rdname stepArchetypes
nparameters.stepArchetypes <- function(object, ...) {
- return(sapply(zs, nparameters))
+ return(sapply(object, nparameters))
}
#' Archetypes residual sum of squares getter.
-#' @param zs A \code{stepArchetypes} object.
+#' @param object A \code{stepArchetypes} object.
#' @param ... Ignored.
#' @return A vector of residual sum of squares.
#' @method rss stepArchetypes
#' @S3method rss stepArchetypes
#' @rdname stepArchetypes
-rss.stepArchetypes <- function(zs, ...) {
- ret <- t(sapply(zs, rss))
- rownames(ret) <- paste('k', ntypes(zs), sep='')
+rss.stepArchetypes <- function(object, ...) {
+ ret <- t(sapply(object, rss))
+ rownames(ret) <- paste('k', nparameters(object), sep='')
return(ret)
}
#' Best model getter.
-#' @param object An \code{\link{stepArchetypes}} object.
+#' @param object An object.
#' @param ... Further arguments.
-#' @return A list of length \code{k} of best models.
+#' @return The best models.
#' @export
-#' @nord
+#' @rdname archetypes-generics
bestModel <- function(object, ...) {
UseMethod('bestModel')
}
#' \code{stepArchetypes} best model getter.
-#' @param zs A \code{stepArchetypes} object.
+#' @param object A \code{stepArchetypes} object.
#' @param ... Ignored.
#' @return A list of length \code{k} of best models.
#' @method bestModel stepArchetypes
@@ -208,14 +208,14 @@
#' Archetypes residual sum of squares getter.
-#' @param zs A \code{repArchetypes} object.
+#' @param object A \code{repArchetypes} object.
#' @param ... Ignored.
#' @return A vector of residual sum of squares.
#' @method rss repArchetypes
#' @S3method rss repArchetypes
#' @nord
-rss.repArchetypes <- function(zs, ...) {
- ret <- sapply(zs, rss)
+rss.repArchetypes <- function(object, ...) {
+ ret <- sapply(object, rss)
names(ret) <- paste('r', seq_along(ret), sep='')
return(ret)
@@ -230,7 +230,7 @@
#' @S3method nparameters repArchetypes
#' @nord
nparameters.repArchetypes <- function(object, ...) {
- ntypes(object[[1]])
+ nparameters(object[[1]])
}
Modified: branches/pkg-robust/R/archetypes-xyplot.R
===================================================================
--- branches/pkg-robust/R/archetypes-xyplot.R 2010-03-31 15:58:20 UTC (rev 35)
+++ branches/pkg-robust/R/archetypes-xyplot.R 2010-04-01 11:54:20 UTC (rev 36)
@@ -1,10 +1,11 @@
-#' Plot of two-dimensional data and archetypes.
+#' Two-dimensional plot.
#' @param x An object.
#' @param ... Further arguments.
+#' @return Undefined.
#' @export
-#' @nord
+#' @rdname archetypes-generics
xyplot <- function(x, ...) {
UseMethod('xyplot')
}
@@ -36,6 +37,7 @@
#' @param y A matrix or data frame.
#' @param data.col Color of data points.
#' @param data.pch Type of data points.
+#' @param data.bg Background of data points.
#' @param atypes.col Color of archetypes points.
#' @param atypes.pch Type of archetypes points.
#' @param ahull.show Show approximated convex hull.
@@ -50,6 +52,8 @@
#' @param adata.pch Type of approximated data points.
#' @param link.col Color of link between approximated and original data
#' points.
+#' @param link.lty Line type of link between approximated and original
+#' data points.
#' @param ... Passed to the underlying plot functions.
#' @return Undefined.
#' @note The link between approximated and original data is based on an
@@ -97,11 +101,21 @@
#' Plot of two-dimensional data and weighted archetypes.
-#' @method xyplot archetypes
-#' @S3method xyplot archetypes
+#' @param x An \code{\link{archetypes}} object.
+#' @param y A matrix or data frame.
+#' @param data.col Color of data points.
+#' @param data.pch Type of data points.
+#' @param data.bg Background of data points.
+#' @param link.col Color of link between approximated and original data
+#' points.
+#' @param link.lty Line type of link between approximated and original
+#' data points.
+#' @param weights.type Weights to display; see \code{\link{weights.archetypes}}.
+#' @param ... Arguments of \code{\link{xyplot.archetypes}}.
+#' @method xyplot weightedArchetypes
+#' @S3method xyplot weightedArchetypes
#' @rdname xyplot
-xyplot.weightedArchetypes <- function(x, y,
- adata.show = FALSE, data.col = 1,
+xyplot.weightedArchetypes <- function(x, y, data.col = 1,
data.pch = 21, data.bg = gray,
link.col = NULL, link.lty = NULL,
weights.type = 'weights', ...) {
@@ -117,17 +131,20 @@
if ( is.function(data.col) )
data.col <- data.col(w)
- xyplot.archetypes(x, y, adata.show = adata.show,
- data.pch = data.pch, data.col = data.col,
- data.bg = data.bg(w), link.col = link.col,
- link.lty = link.lty, ...)
+ xyplot.archetypes(x, y, data.pch = data.pch,
+ data.col = data.col, data.bg = data.bg(w),
+ link.col = link.col, link.lty = link.lty, ...)
}
#' Plot of two-dimensional data and robust archetypes.
-#' @method xyplot archetypes
-#' @S3method xyplot archetypes
+#' @param x An \code{\link{archetypes}} object.
+#' @param y A matrix or data frame.
+#' @param ... Arguments of \code{\link{xyplot.weightedArchetypes}} and
+#' \code{\link{xyplot.robustArchetypes}}
+#' @method xyplot robustArchetypes
+#' @S3method xyplot robustArchetypes
#' @rdname xyplot
xyplot.robustArchetypes <- function(x, y, ...) {
xyplot.weightedArchetypes(x, y, weights.type = 'reweights', ...)
Added: branches/pkg-robust/R/memento.R
===================================================================
--- branches/pkg-robust/R/memento.R (rev 0)
+++ branches/pkg-robust/R/memento.R 2010-04-01 11:54:20 UTC (rev 36)
@@ -0,0 +1,41 @@
+
+
+#' Memento environment.
+#'
+#' Simple implementation of the 'Memento' design pattern.
+#'
+#' @param i The number of the state.
+#' @param state The state to save.
+#' @return Memento environment.
+#' @export
+#' @examples
+#' \dontrun{
+#' m <- new.memento()
+#' m$save(i, state)
+#' m$states()
+#' m$get(i)
+#' }
+#' @rdname memento
+#' @aliases memento
+new.memento <- function() {
+
+ memento <- new.env(parent = emptyenv())
+
+ memento$save <- function(i, state) {
+ assign(sprintf('s%s', i), state, envir = memento)
+ }
+
+ memento$get <- function(i) {
+ if ( i < 0 )
+ i <- length(memento$states()) + i - 1
+
+ get(sprintf('s%s', i), envir = memento)
+ }
+
+ memento$states <- function() {
+ ls(pattern = 's\\d+', envir = memento)
+ }
+
+
+ structure(memento, class = 'memento')
+}
Property changes on: branches/pkg-robust/R/memento.R
___________________________________________________________________
Name: svn:keywords
+ Date Revision Author URL Id
Name: svn:eol-style
+ native
Modified: branches/pkg-robust/R/pcplot.R
===================================================================
--- branches/pkg-robust/R/pcplot.R 2010-03-31 15:58:20 UTC (rev 35)
+++ branches/pkg-robust/R/pcplot.R 2010-04-01 11:54:20 UTC (rev 36)
@@ -1,10 +1,10 @@
-#' Generic function for parallel coordinates plot.
+#' Parallel coordinates plot.
#' @param x An object.
#' @param ... Further arguments.
#' @export
-#' @noRd
+#' @rdname archetypes-generics
pcplot <- function(x, ...) {
UseMethod('pcplot')
}
@@ -71,7 +71,7 @@
#' @param lty Line types.
#' @param ... Passed to underlying \code{\link[graphics]{matlines}}.
#' @return Undefined.
-#' @nord
+#' @rdname pcplot
lines.pcplot <- function(x, data, col=1, lty=1, ...) {
rx <- apply(data, 2, range, na.rm=TRUE)
Modified: branches/pkg-robust/R/skeletonplot.R
===================================================================
--- branches/pkg-robust/R/skeletonplot.R 2010-03-31 15:58:20 UTC (rev 35)
+++ branches/pkg-robust/R/skeletonplot.R 2010-04-01 11:54:20 UTC (rev 36)
@@ -20,12 +20,13 @@
#' @return List of skeleton instances.
#' @export
#' @seealso \code{\link{skel}}
-skeletonplot <- function(x, skel.width=100, skel.height=200,
- base.radius=2, xlab='', ylab='Height (cm)',
- 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, ...) {
+skeletonplot <- function(x, skel.width = 100, skel.height = 200,
+ 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, ...) {
if ( is.data.frame(x) )
x <- as.matrix(x)
Modified: branches/pkg-robust/demo/00Index
===================================================================
--- branches/pkg-robust/demo/00Index 2010-03-31 15:58:20 UTC (rev 35)
+++ branches/pkg-robust/demo/00Index 2010-04-01 11:54:20 UTC (rev 36)
@@ -1,2 +1,2 @@
-robust-toy Weighted and robust archetypal analysis by means of an artificial toy data set
-robust-ozone Weighted and robust archetypal analysis by means of the Ozone (mlbench) data set
+robust-toy Weighted and robust archetypal analysis by means of an artificial toy data set
+robust-ozone Weighted and robust archetypal analysis by means of the Ozone (mlbench) data set
Added: branches/pkg-robust/man/archetypes-deprecated.Rd
===================================================================
--- branches/pkg-robust/man/archetypes-deprecated.Rd (rev 0)
+++ branches/pkg-robust/man/archetypes-deprecated.Rd 2010-04-01 11:54:20 UTC (rev 36)
@@ -0,0 +1,5 @@
+\name{archetypes-deprecated}
+\title{Deprecated functions in archetypes package}
+\description{These functions are provided for compatibility with older
+ versions of archetypes only, and may be defunct as soon as the next
+ release.}
Property changes on: branches/pkg-robust/man/archetypes-deprecated.Rd
___________________________________________________________________
Name: svn:keywords
+ Date Revision Author URL Id
Name: svn:eol-style
+ native
Added: branches/pkg-robust/man/archetypes-generics.Rd
===================================================================
--- branches/pkg-robust/man/archetypes-generics.Rd (rev 0)
+++ branches/pkg-robust/man/archetypes-generics.Rd 2010-04-01 11:54:20 UTC (rev 36)
@@ -0,0 +1,4 @@
+\name{archetypes-generics}
+\title{Generic functions in archetypes package}
+\description{These generic functions are defined in the package
+ archetypes.}
Property changes on: branches/pkg-robust/man/archetypes-generics.Rd
___________________________________________________________________
Name: svn:keywords
+ Date Revision Author URL Id
Name: svn:eol-style
+ native
Deleted: branches/pkg-robust/man/pcplot-methods.Rd
===================================================================
--- branches/pkg-robust/man/pcplot-methods.Rd 2010-03-31 15:58:20 UTC (rev 35)
+++ branches/pkg-robust/man/pcplot-methods.Rd 2010-04-01 11:54:20 UTC (rev 36)
@@ -1,41 +0,0 @@
-\name{pcplot-methods}
-\alias{pcplot}
-\alias{pcplot.default}
-\alias{pcplot.archetypes}
-\title{Parallel coordinates plot.}
-\usage{
-pcplot(x, ...)
-\method{pcplot}{default} (x, col=gray(0.7), lty=1, var.label=TRUE,
- rx=NULL, ...)
-\method{pcplot}{archetypes} (x, data, data.col=gray(0.7), data.lwd=1,
- atypes.col=2, atypes.lwd=2, atypes.lty=1, chull, chull.col=1,
- chull.lwd=2, chull.lty=1, ...)
-}
-\description{Parallel coordinates plot.}
-\arguments{
- \item{x}{An data.frame or a \code{\link{archetypes}} object.}
- \item{col}{Line color.}
- \item{lty}{Line type.}
- \item{var.label}{Axes labels.}
- \item{rx}{A \eqn{2 \times m} matrix with ranges for each dimension.}
- \item{data}{A matrix or data frame.}
- \item{data.col}{Color of data lines.}
- \item{data.lwd}{Width of data lines.}
- \item{atypes.col}{Color of archetypes lines.}
- \item{atypes.lwd}{Width of archetypes lines.}
- \item{atypes.lty}{Type of archetypes lines.}
- \item{chull}{An integer vector giving the indices of the points from
- \code{data} lying on the convex hull.}
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/archetypes -r 36
More information about the Archetypes-commits
mailing list