[Archetypes-commits] r49 - in pkg: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Oct 25 17:27:51 CEST 2011
Author: manuel
Date: 2011-10-25 17:27:51 +0200 (Tue, 25 Oct 2011)
New Revision: 49
Added:
pkg/NAMESPACE
Removed:
pkg/R/archetypes-deprecated.R
pkg/man/archetypes-deprecated.Rd
pkg/man/archetypes-generics.Rd
Modified:
pkg/DESCRIPTION
pkg/NEWS
pkg/R/archetypes-class.R
pkg/R/archetypes-kit-blocks.R
pkg/R/archetypes-kit.R
pkg/R/archetypes-panorama.R
pkg/R/archetypes-pcplot.R
pkg/R/archetypes-robust.R
pkg/R/archetypes-step.R
pkg/R/archetypes-weighted.R
pkg/R/archetypes-xyplot.R
pkg/R/memento.R
pkg/R/pcplot.R
pkg/R/skeletonplot.R
Log:
Starting to roxygen2-ify ...
Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION 2011-10-12 20:06:01 UTC (rev 48)
+++ pkg/DESCRIPTION 2011-10-25 15:27:51 UTC (rev 49)
@@ -1,14 +1,42 @@
Package: archetypes
Type: Package
Title: Archetypal Analysis
-Version: 2.0-2
-Date: 2010-08-24
-Depends: methods, stats, modeltools, nnls (>= 1.1)
-Suggests: MASS, vcd, mlbench, ggplot2
-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
- archetypal analysis supporting arbitary problem solving mechanisms
- for the different conceputal parts of the algorithm.
+Version: 2.1
+Date: 2011-10-25
+Depends:
+ methods,
+ stats,
+ modeltools,
+ nnls (>= 1.1)
+Suggests:
+ MASS,
+ vcd,
+ mlbench,
+ ggplot2
+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 archetypal analysis supporting arbitary
+ problem solving mechanisms for the different conceputal
+ parts of the algorithm.
License: GPL (>= 2)
Revision: 44
+Collate:
+ 'archetypes-barplot.R'
+ 'archetypes-class.R'
+ 'archetypes-kit-blocks.R'
+ 'archetypes-kit.R'
+ 'archetypes-movie.R'
+ 'archetypes-panorama.R'
+ 'pcplot.R'
+ 'archetypes-pcplot.R'
+ 'archetypes-robust.R'
+ 'archetypes-screeplot.R'
+ 'archetypes-step.R'
+ 'archetypes-weighted.R'
+ 'archetypes-xyplot.R'
+ 'memento.R'
+ 'skeletonplot.R'
+ 'generics.R'
Added: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE (rev 0)
+++ pkg/NAMESPACE 2011-10-25 15:27:51 UTC (rev 49)
@@ -0,0 +1,53 @@
+export(archetypes)
+export(archetypesFamily)
+export(as.archetypes)
+export(bestModel)
+export(jd)
+export(moviepcplot)
+export(movieplot)
+export(movieplot2)
+export(new.memento)
+export(nparameters)
+export(panorama)
+export(pcplot)
+export(robustArchetypes)
+export(rss)
+export(skeletonplot)
+export(stepArchetypes)
+export(weightedArchetypes)
+export(xyplot)
+exportMethods(parameters)
+importFrom(graphics,barplot)
+importFrom(modeltools,parameters)
+importFrom(stats,coef)
+importFrom(stats,fitted)
+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(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)
Property changes on: pkg/NAMESPACE
___________________________________________________________________
Added: svn:keywords
+ Date Revision Author URL Id Header
Added: svn:eol-style
+ native
Modified: pkg/NEWS
===================================================================
--- pkg/NEWS 2011-10-12 20:06:01 UTC (rev 48)
+++ pkg/NEWS 2011-10-25 15:27:51 UTC (rev 49)
@@ -1,4 +1,12 @@
+Changes in archetypes version 2.1-0
+
+ o Roxygen2-ified; added the Build-dep field to the DESCRIPTION
+ file.
+
+ o Removed deprecated functions.
+
+
Changes in archetypes version 2.0-2
o Added analysis of the simulation study for robust archetypes
@@ -15,18 +23,18 @@
o Technical report on robust and weighted archetypes is cited.
-Changes in archetypes version 2.0
+Changes in archetypes version 2.0-0
- o cleaned up interface; see '?archetypes-deprecated' and
+ o Cleaned up interface; see '?archetypes-deprecated' and
'?archetypes-generics'.
- o added weighted and robust archetypes; see 'demo(robust-toy)' and
+ o Added weighted and robust archetypes; see 'demo(robust-toy)' and
'demo(robust-ozone)'.
- o added 'memento' environment to save internal states.
+ o Added 'memento' environment to save internal states.
- o added panorama plot; see '?panorama.archetypes'
+ o Added panorama plot; see '?panorama.archetypes'
- o improved 'barplot.archetypes'.
+ o Improved 'barplot.archetypes'.
Modified: pkg/R/archetypes-class.R
===================================================================
--- pkg/R/archetypes-class.R 2011-10-12 20:06:01 UTC (rev 48)
+++ pkg/R/archetypes-class.R 2011-10-25 15:27:51 UTC (rev 49)
@@ -1,12 +1,13 @@
-#' Archetypes object constructor and methods.
-#' @param archetypes The archetypes; a \eqn{p \times m} matrix, see
-#' \code{\link{atypes}}.
+#' Archetypes object constructor and methods
+#'
+#' @param object The archetypes; a \eqn{p \times m} matrix, see
+#' \code{\link{parameters}}.
#' @param k The number of archetypes;
#' @param alphas The coefficients; a \eqn{n \times p} matrix, see
-#' \code{\link{alphas}}.
-#' @param rss The residual sum of squares; see \link{rss}.
+#' \code{\link{coef}}.
+#' @param rss The residual sum of squares; see \code{\link{rss.archetypes}}.
#' @param iters The number of iterations to the convergence.
#' @param call The call of the \code{\link{archetypes}} function.
#' @param history If \code{saveHistory} set then an environment with the
@@ -19,17 +20,19 @@
#' @param residuals The residuals.
#' @param weights The data weights.
#' @param reweights The data reweights.
+#'
#' @return A list with an element for each parameter and class attribute
#' \code{archetypes}.
-#' @seealso \code{\link{archetypes}}
-#' @rdname archetypes-class
-#' @aliases archetypes-class
-as.archetypes <- function(archetypes, k, alphas, rss, iters = NULL, call = NULL,
+#'
+#' @family archetypes
+#'
+#' @export
+as.archetypes <- function(object, k, alphas, rss, iters = NULL, call = NULL,
history = NULL, kappas = NULL, betas = NULL, zas = NULL,
family = NULL, familyArgs = NULL, residuals = NULL,
weights = NULL, reweights = NULL) {
- return(structure(list(archetypes = archetypes,
+ return(structure(list(archetypes = object,
k = k,
alphas = alphas,
rss = rss,
@@ -53,14 +56,7 @@
-#' Print method for archetypes object.
-#' @param x An \code{archetypes} object.
-#' @param full Full information or just convergence and rss information.
-#' @param ... Ignored.
-#' @return Undefined.
-#' @method print archetypes
#' @S3method print archetypes
-#' @nord
print.archetypes <- function(x, full = TRUE, ...) {
if ( full ) {
cat('Archetypes object\n\n')
@@ -73,88 +69,83 @@
-#' Return fitted data, i.e. archetypes data approximation.
-#' @param object An \code{archetypes}-related object.
+#' Return fitted data
+#'
+#' Returns the approximated data.
+#'
+#' @param object An \code{archetypes} object.
#' @param ... Ignored.
#' @return Matrix with approximated data.
#' @method fitted archetypes
+#' @rdname fitted
+#'
#' @importFrom stats fitted
#' @S3method fitted archetypes
-#' @rdname archetypes-class
fitted.archetypes <- function(object, ...) {
t(t(object$archetypes) %*% t(object$alphas))
}
-#' Return fitted archetypes.
+#' Return fitted archetypes
+#'
#' @param object An \code{archetypes} object.
#' @param ... Ignored.
#' @return Matrix with \eqn{k} archetypes.
-#' @nord
-.parameters.archetypes <- function(object, ...) {
+#'
+#' @importFrom modeltools parameters
+#' @exportMethod parameters
+setMethod('parameters', signature = c(object = 'archetypes'),
+function(object, ...) {
object$archetypes
-}
+})
-#' Return fitted archetypes.
-#' @param object An \code{archetypes} object.
-#' @param ... Ignored.
-#' @return Matrix with \eqn{k} archetypes.
-#' @importFrom modeltools parameters
-#' @rdname archetypes-class
-setMethod('parameters',
- signature = signature(object = 'archetypes'),
- .parameters.archetypes)
-
-#' Return coefficients.
+#' Return coefficients
+#'
#' @param object An \code{archetypes} object.
-#' @param type Return alphas or betas.
+#' @param type Return alpha or beta coefficients.
#' @param ... Ignored.
#' @return Coefficient matrix.
#' @method coef archetypes
+#' @rdname coef
+#'
#' @importFrom stats coef
#' @S3method coef archetypes
-#' @rdname archetypes-class
coef.archetypes <- function(object, type = c('alphas', 'betas'), ...) {
type <- match.arg(type)
object[[type]]
}
-#' Return residuals.
+
+#' Return residuals
+#'
#' @param object An \code{archetypes} object.
#' @param ... Ignored.
#' @return Matrix with residuals.
#' @method residuals archetypes
+#' @rdname residuals
+#'
#' @importFrom stats residuals
#' @S3method residuals archetypes
-#' @rdname archetypes-class
residuals.archetypes <- function(object, ...) {
object$residuals
}
-#' Residual sum of squares.
-#' @param object An object.
-#' @param ... Ignored.
-#' @return Residual sum of squares.
-#' @export
-#' @rdname archetypes-generics
-rss <- function(object, ...) {
- UseMethod('rss')
-}
-
-#' Residual sum of squares getter.
+#' Return residual sum of squares
+#'
#' @param object An \code{archetypes} object.
#' @param type Return scaled, single or global RSS.
#' @param ... Ignored.
#' @return Residual sum of squares.
#' @method rss archetypes
+#' @rdname rss
+#'
#' @S3method rss archetypes
-#' @rdname archetypes-class
rss.archetypes <- function(object, type = c('scaled', 'single', 'global'), ...) {
type <- match.arg(type)
resid <- residuals(object)
@@ -167,16 +158,18 @@
-#' Return weights.
+#' Return weights
+#'
#' @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
+#' @rdname weights
+#'
#' @importFrom stats weights
#' @S3method weights archetypes
-#' @rdname archetypes-class
weights.archetypes <- function(object, type = c('weights', 'reweights'), ...) {
type <- match.arg(type)
object[[type]]
@@ -184,27 +177,38 @@
-#' Kappa getter.
+#' Return kappa
+#'
#' @param z An \code{archetypes} object.
#' @param ... Ignored.
#' @return A vector of kappas.
+#' @rdname kappa
+#'
#' @method kappa archetypes
#' @S3method kappa archetypes
-#' @rdname archetypes-class
kappa.archetypes <- function(z, ...) {
return(z$kappas)
}
-#' Predict coefficients or data based on archetypes.
+#' Return number of archetypes
+#'
#' @param object An \code{archetypes} object.
-#' @param type Predict alphas or data.
#' @param ... Ignored.
-#' @return Prediction.
-#' @method predict archetypes
-#' @S3method predict archetypes
-#' @nord
+#' @return Number of archetypes.
+#' @rdname nparameters
+#'
+#' @method nparameters archetypes
+#' @S3method nparameters archetypes
+nparameters.archetypes <- function(object, ...) {
+ return(object$k)
+}
+
+
+
+### Not implemented yet: #############################################
+
predict.archetypes <- function(object, newdata = NULL,
type = c('alphas', 'data'), ...) {
type <- match.arg(type)
@@ -220,28 +224,3 @@
#if ( type == 'alphas' )
# object$family$alphasfn(NULL, t(object$archetypes), t(newdata))
}
-
-
-
-#' Number of parameters.
-#' @param object An object.
-#' @param ... Further arguments.
-#' @return Number of parameters.
-#' @export
-#' @rdname archetypes-generics
-nparameters <- function(object, ...) {
- UseMethod('nparameters')
-}
-
-
-
-#' Number of archetypes
-#' @param object An \code{archetypes}-related object.
-#' @param ... Further arguments.
-#' @return Number of archetypes.
-#' @method nparameters archetypes
-#' @S3method nparameters archetypes
-#' @rdname archetypes-class
-nparameters.archetypes <- function(object, ...) {
- return(object$k)
-}
Deleted: pkg/R/archetypes-deprecated.R
===================================================================
--- pkg/R/archetypes-deprecated.R 2011-10-12 20:06:01 UTC (rev 48)
+++ pkg/R/archetypes-deprecated.R 2011-10-25 15:27:51 UTC (rev 49)
@@ -1,212 +0,0 @@
-
-
-#' 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: pkg/R/archetypes-kit-blocks.R
===================================================================
--- pkg/R/archetypes-kit-blocks.R 2011-10-12 20:06:01 UTC (rev 48)
+++ pkg/R/archetypes-kit-blocks.R 2011-10-25 15:27:51 UTC (rev 49)
@@ -5,7 +5,7 @@
#' Scaling block: standardize to mean 0 and standard deviation 1.
#' @param x Data matrix.
#' @return Standardized data matrix with some attribues.
-#' @nord
+#' @noRd
std.scalefn <- function(x, ...) {
m = rowMeans(x)
x = x - m
@@ -22,7 +22,7 @@
#' @param x Standardized data matrix.
#' @param zs Archetypes matrix
#' @return Rescaled archetypes.
-#' @nord
+#' @noRd
std.rescalefn <- function(x, zs, ...) {
m = attr(x, '.Meta')$mean
@@ -39,7 +39,7 @@
#' Scaling block: no scaling.
#' @param x Data matrix.
#' @return Data matrix.
-#' @nord
+#' @noRd
no.scalefn <- function(x, ...) {
return(x)
}
@@ -48,7 +48,7 @@
#' @param x Data matrix.
#' @param zs Archetypes matrix.
#' @return Archetypes zs.
-#' @nord
+#' @noRd
no.rescalefn <- function(x, zs, ...) {
if ( is.null(zs) )
return(matrix(NA, nrow = 0, ncol = 0))
@@ -65,7 +65,7 @@
#' @param huge The value.
#' @return A function which takes a data matrix and returns the
#' data matrix with an additonal row containing \code{huge} values.
-#' @nord
+#' @noRd
make.dummyfn <- function(huge=200) {
bp.dummyfn <- function(x, ...) {
@@ -85,7 +85,7 @@
#' @param x Data matrix.
#' @param zs Archetypes matrix.
#' @return Archetypes zs.
-#' @nord
+#' @noRd
rm.undummyfn <- function(x, zs, ...) {
dr = attr(x, '.Meta')$dummyrow
@@ -96,7 +96,7 @@
#' Dummy block: no dummy row.
#' @param x Data matrix.
#' @return Data matrix x.
-#' @nord
+#' @noRd
no.dummyfn <- function(x, ...) {
return(x)
}
@@ -105,7 +105,7 @@
#' @param x Data matrix.
#' @param zs Archetypes matrix.
#' @return Archetypes zs.
-#' @nord
+#' @noRd
no.undummyfn <- function(x, zs, ...) {
return(zs)
}
@@ -119,7 +119,7 @@
#' @param alphas The coefficients.
#' @param x Data matrix.
#' @return The solved linear system.
-#' @nord
+#' @noRd
qrsolve.zalphasfn <- function(alphas, x, ...) {
return(t(qr.solve(alphas %*% t(alphas)) %*% alphas %*% t(x)))
}
@@ -130,7 +130,7 @@
#' @param alphas The coefficients.
#' @param x Data matrix.
#' @return The solved linear system.
-#' @nord
+#' @noRd
ginv.zalphasfn <- function(alphas, x, ...) {
require(MASS)
@@ -143,7 +143,7 @@
#' @param alphas The coefficients.
#' @param x Data matrix.
#' @return The solved linear system.
-#' @nord
+#' @noRd
opt.zalphasfn <- function(alphas, x, ...) {
z <- rnorm(nrow(x)*nrow(alphas))
@@ -168,7 +168,7 @@
#' @param C The archetypes matrix.
#' @param d The data matrix.
#' @return Recalculated alpha.
-#' @nord
+#' @noRd
nnls.alphasfn <- function(coefs, C, d, ...) {
require(nnls)
@@ -185,7 +185,7 @@
#' @param C The archetypes matrix.
#' @param d The data matrix.
#' @return Recalculated alpha.
-#' @nord
+#' @noRd
snnls.alphasfn <- function(coefs, C, d, ...) {
require(nnls)
@@ -214,7 +214,7 @@
#' @param C The data matrix.
#' @param d The archetypes matrix.
#' @return Recalculated beta.
-#' @nord
+#' @noRd
nnls.betasfn <- nnls.alphasfn
@@ -224,7 +224,7 @@
#' @param C The data matrix.
#' @param d The archetypes matrix.
#' @return Recalculated beta.
-#' @nord
+#' @noRd
snnls.betasfn <- snnls.alphasfn
@@ -235,7 +235,7 @@
#' Norm block: standard matrix norm (spectral norm).
#' @param m Matrix.
#' @return The norm.
-#' @nord
+#' @noRd
norm2.normfn <- function(m, ...) {
return(max(svd(m)$d))
}
@@ -244,7 +244,7 @@
#' Norm block: euclidian norm.
#' @param m Matrix.
#' @return The norm.
-#' @nord
+#' @noRd
euc.normfn <- function(m, ...) {
return(sum(apply(m, 2, function(x){sqrt(sum(x^2))})))
}
@@ -257,7 +257,7 @@
#' Init block: generator for random initializtion.
#' @param k The proportion of beta for each archetype.
#' @return A function which returns a list with alpha and beta.
-#' @nord
+#' @noRd
make.random.initfn <- function(k) {
bp.initfn <- function(x, p, ...) {
@@ -279,7 +279,7 @@
#' Init block: generator for fix initializtion.
#' @param indizes The indizies of data points to use as archetypes.
#' @return A function which returns a list with alpha and beta.
-#' @nord
+#' @noRd
make.fix.initfn <- function(indizes) {
fix.initfn <- function(x, p, ...) {
@@ -305,7 +305,7 @@
#' @param data A numeric \eqn{m \times n} data matrix.
#' @param weights Vector of data weights within \eqn{[0, 1]}.
#' @return Weighted data matrix.
-#' @nord
+#' @noRd
center.weightfn <- function(data, weights, ...) {
if ( is.null(weights) )
return(data)
@@ -330,7 +330,7 @@
#' @param data A numeric \eqn{m \times n} data matrix.
#' @param weights Vector or matrix of data weights within \eqn{[0, 1]}.
#' @return Weighted data matrix.
-#' @nord
+#' @noRd
center.globweightfn <- function(data, weights, ...) {
if ( is.null(weights) )
return(data)
@@ -359,7 +359,7 @@
#' @param resid A numeric \eqn{m \times n} data matrix.
#' @param reweights Vector of data reweights within \eqn{[0, 1]}.
#' @return Reweights vector.
-#' @nord
+#' @noRd
bisquare0.reweightsfn <- function(resid, reweights, ...) {
resid <- apply(resid, 2, function(x) sum(abs(x)))
resid0 <- resid < sqrt(.Machine$double.eps)
@@ -377,7 +377,7 @@
#' @param reweights Vector of data reweights within \eqn{[0, 1]}.
#' @param threshold Threshold for binarization.
#' @return Reweights vector.
-#' @nord
+#' @noRd
binary.bisquare0.reweightsfn <- function(resid, reweights,
threshold = 0.1, ...) {
rw <- bisquare0.reweightsfn(resid, reweights, ...)
@@ -425,7 +425,7 @@
#' Original family constructor helper.
#' @return A list of blocks.
-#' @nord
+#' @noRd
.original.archetypesFamily <- function() {
list(normfn = norm2.normfn,
scalefn = std.scalefn,
Modified: pkg/R/archetypes-kit.R
===================================================================
--- pkg/R/archetypes-kit.R 2011-10-12 20:06:01 UTC (rev 48)
+++ pkg/R/archetypes-kit.R 2011-10-25 15:27:51 UTC (rev 49)
@@ -5,6 +5,7 @@
#' Perform archetypal analysis on a data matrix.
+#'
#' @param data A numeric \eqn{n \times m} data matrix.
#' @param k The number of archetypes.
#' @param weights Data weights matrix or vector (used as elements of
@@ -19,16 +20,20 @@
#' @param family Blocks defining the underlying problem solving mechanisms;
#' see \code{\link{archetypesFamily}}.
#' @param ... Additional arguments for family blocks.
+#'
#' @return An object of class \code{archetypes}, see
-#' \code{\link{archetypes-class}}.
-#' @seealso \code{\link{stepArchetypes}}, \code{\link{archetypes-class}}
+#' \code{\link{as.archetypes}}.
+#'
+#' @family archetypes
+#'
#' @references Cutler and Breiman. Archetypal Analysis. Technometrics,
#' 36(4), 1994. 338-348.
+#'
#' @examples
#' data(toy)
#' a <- archetypes(toy, 3)
+#'
#' @export
-#' @note Please see the vignette for a detailed explanation!
archetypes <- function(data, k, weights = NULL, maxIterations = 100,
minImprovement = sqrt(.Machine$double.eps),
maxKappa = 1000, verbose = FALSE, saveHistory = TRUE,
Modified: pkg/R/archetypes-panorama.R
===================================================================
--- pkg/R/archetypes-panorama.R 2011-10-12 20:06:01 UTC (rev 48)
+++ pkg/R/archetypes-panorama.R 2011-10-25 15:27:51 UTC (rev 49)
@@ -5,7 +5,6 @@
#' @param ... Further arguments.
#' @return Undefined.
#' @export
-#' @rdname archetypes-generics
panorama <- function(object, ...) {
UseMethod('panorama')
}
@@ -105,7 +104,7 @@
#' @param centers Archetypes
#' @return Matrix with euclidean distance between each
#' data point and each center.
-#' @nord
+#' @noRd
distEuclidean <- function (x, centers) {
if (ncol(x) != ncol(centers))
stop(sQuote("x"), " and ", sQuote("centers"), " must have the same number of columns")
Modified: pkg/R/archetypes-pcplot.R
===================================================================
--- pkg/R/archetypes-pcplot.R 2011-10-12 20:06:01 UTC (rev 48)
+++ pkg/R/archetypes-pcplot.R 2011-10-25 15:27:51 UTC (rev 49)
@@ -19,7 +19,6 @@
#' @return Undefined.
#' @method pcplot archetypes
#' @S3method pcplot archetypes
-#' @rdname pcplot
pcplot.archetypes <- function(x, data, data.col=gray(0.7), data.lwd=1,
atypes.col=2, atypes.lwd=2, atypes.lty=1,
chull=NULL, chull.col=1, chull.lwd=2, chull.lty=1, ...) {
Modified: pkg/R/archetypes-robust.R
===================================================================
--- pkg/R/archetypes-robust.R 2011-10-12 20:06:01 UTC (rev 48)
+++ pkg/R/archetypes-robust.R 2011-10-25 15:27:51 UTC (rev 49)
@@ -1,3 +1,5 @@
+#' @include archetypes-class.R
+#' @include archetypes-kit.R
#' @include archetypes-kit-blocks.R
{}
@@ -4,14 +6,16 @@
#' Robust archetypes.
-#' @param data A numeric \eqn{n \times m} data matrix.
-#' @param k The number of archetypes.
+#'
+#' @inheritParams archetypes
#' @param familyBlocks Exchange predefined family blocks.
-#' @param ... Arguments available for \code{\link{archetypes}}.
+#'
#' @return An object of class \code{robustArchetypes} and
-#' \code{\link{archetypes-class}}.
+#' \code{\link{as.archetypes}}.
+#'
+#' @family archetypes
+#'
#' @export
-#' @rdname archetypes
robustArchetypes <- function(data, k, familyBlocks = list(), ...) {
family <- do.call(archetypesFamily, c(list('robust'), familyBlocks))
@@ -21,9 +25,6 @@
-#' Robust family constructor helper.
-#' @return A list of blocks.
-#' @nord
.robust.archetypesFamily <- function() {
f <- .original.archetypesFamily()
f$class <- 'robustArchetypes'
@@ -34,17 +35,5 @@
-setOldClass('robustArchetypes')
-
-
-
-#' Return fitted archetypes.
-#' @param object An \code{robustArchetypes} object.
-#' @param ... Ignored.
-#' @return Matrix with \eqn{k} archetypes.
-#' @importFrom modeltools parameters
-#' @nord
-setMethod('parameters',
- signature = signature(object = 'robustArchetypes'),
- .parameters.archetypes)
-
+#setOldClass("robustArchetypes")
+#setIs("robustArchetypes", "archetypes")
Modified: pkg/R/archetypes-step.R
===================================================================
--- pkg/R/archetypes-step.R 2011-10-12 20:06:01 UTC (rev 48)
+++ pkg/R/archetypes-step.R 2011-10-25 15:27:51 UTC (rev 49)
@@ -1,9 +1,10 @@
-#' @include archetypes-kit.R
+#' @include archetypes-class.R
{}
-#' Runs archetypes algorithm repeatedly.
-#' @param ... Passed to \code{\link{archetypes}} function.
+#' Run archetypes algorithm repeatedly
+#'
+#' @param ... Passed to the specific archetype function.
#' @param k A vector of integers passed in turn to the k argument of
#' \code{\link{archetypes}}.
#' @param nrep For each value of \code{k} run \code{\link{archetypes}}
@@ -12,12 +13,14 @@
#' \code{\link{archetypes}}, \code{\link{weightedArchetypes}} or
#' \code{\link{robustArchetypes}},
#' @param verbose Show progress during exection.
+#'
#' @return A list with \code{k} elements and class attribute
#' \code{stepArchetypes}. Each element is a list of class
#' \code{repArchetypes} with \code{nrep} elements; only for internal
#' usage.
+#'
#' @seealso \code{\link{archetypes}}
-#' @export
+#'
#' @examples
#' \dontrun{
#' data(skel)
@@ -31,7 +34,8 @@
#' ## recurrence:
#' a3 <- bestModel(as[[3]])
#' }
-#' @note Please see the vignette for a detailed explanation!
+#'
+#' @export
stepArchetypes <- function(..., k, nrep = 3, method = archetypes, verbose = TRUE) {
mycall <- match.call()
@@ -59,7 +63,7 @@
-#' Extract method.
+#' Extract method
#'
#' An extraction on a \code{stepArchetypes} object returns again a
#' \code{stepArchetypes} object.
@@ -68,9 +72,10 @@
#' @param i The indizes to extract.
#' @return A \code{stepArchetypes} object containing only the parts
#' defined in \code{i}.
-#' @S3method "[" stepArchetypes
#' @method [ stepArchetypes
-#' @rdname stepArchetypes
+#' @rdname extract
+#'
+#' @S3method "[" stepArchetypes
`[.stepArchetypes` <- function(x, i) {
y <- unclass(x)[i]
attributes(y) <- attributes(x)
@@ -80,13 +85,7 @@
-#' Print method for stepArchetypes object.
-#' @param x A \code{stepArchetypes} object.
-#' @param ... Pass to underlying print function.
-#' @return Undefined.
-#' @method print stepArchetypes
#' @S3method print stepArchetypes
-#' @nord
print.stepArchetypes <- function(x, ...) {
cat('StepArchetypes object\n\n')
cat(deparse(attr(x, 'call')), '\n')
@@ -94,13 +93,16 @@
-#' Summary method for stepArchetypes object.
+#' Summary method for stepArchetypes object
+#'
#' @param object A \code{stepArchetypes} object.
#' @param ... Ignored.
#' @return Undefined.
+#'
#' @method summary stepArchetypes
+#' @rdname summary
+#'
#' @S3method summary stepArchetypes
-#' @rdname stepArchetypes
summary.stepArchetypes <- function(object, ...) {
print(object)
@@ -114,47 +116,28 @@
-#' Return fitted archetypes.
-#' @param object A \code{stepArchetypes} object.
-#' @param ... Ignored.
-#' @return A list of archetypes matrices.
-#' @nord
-.parameters.stepArchetypes <- function(object, ...) {
- return(lapply(object, parameters))
-}
+#' @exportMethod parameters
+setMethod('parameters', signature = c(object = 'stepArchetypes'),
+function(object, ...) {
+ lapply(object, parameters)
+})
-#' Return fitted archetypes.
-#' @param object An \code{stepArchetypes} object.
-#' @param ... Ignored.
-#' @return List of archetypes.
-#' @importFrom modeltools parameters
-#' @nord
-setMethod('parameters',
- signature = signature(object = 'stepArchetypes'),
- .parameters.stepArchetypes)
-
-#' Number of parameters.
-#' @param object A \code{stepArchetypes} object.
-#' @param ... Ignored.
-#' @return Vector of numbers of archetypes.
+#' @rdname nparameters
#' @method nparameters stepArchetypes
+#'
#' @S3method nparameters stepArchetypes
-#' @rdname stepArchetypes
nparameters.stepArchetypes <- function(object, ...) {
return(sapply(object, nparameters))
}
-#' Archetypes residual sum of squares getter.
-#' @param object A \code{stepArchetypes} object.
-#' @param ... Ignored.
-#' @return A vector of residual sum of squares.
+#' @rdname rss
#' @method rss stepArchetypes
+#'
#' @S3method rss stepArchetypes
-#' @rdname stepArchetypes
rss.stepArchetypes <- function(object, ...) {
ret <- t(sapply(object, rss))
rownames(ret) <- paste('k', nparameters(object), sep='')
@@ -163,23 +146,15 @@
-#' Best model getter.
-#' @param object An object.
-#' @param ... Further arguments.
-#' @return The best models.
-#' @export
-#' @rdname archetypes-generics
-bestModel <- function(object, ...) {
- UseMethod('bestModel')
-}
-
-#' \code{stepArchetypes} best model getter.
-#' @param object A \code{stepArchetypes} object.
-#' @param ... Ignored.
-#' @return A list of length \code{k} of best models.
+#' Return best model
+#'
+#' @param object An \code{archetypes} object.
+#' @param ... Ignored
+#'
+#' @rdname bestModel
#' @method bestModel stepArchetypes
+#'
#' @S3method bestModel stepArchetypes
-#' @rdname stepArchetypes
bestModel.stepArchetypes <- function(object, ...) {
zsmin <- lapply(object, bestModel)
@@ -191,13 +166,7 @@
-#' Print method for repArchetypes object.
-#' @param x A \code{repArchetypes} object.
-#' @param ... Pass to underlying print function.
-#' @return Undefined.
-#' @method print repArchetypes
#' @S3method print repArchetypes
-#' @nord
print.repArchetypes <- function(x, ...) {
for ( i in seq_along(x) )
print(x[[i]], ...)
@@ -207,34 +176,19 @@
-#' Return fitted archetypes.
-#' @param object A \code{repArchetypes} object.
-#' @param ... Ignored.
-#' @return A list of archetypes matrices.
-#' @nord
-.parameters.repArchetypes <- function(object, ...) {
+#' @importFrom modeltools parameters
+#' @exportMethod parameters
+setMethod('parameters', signature = signature(object = 'repArchetypes'),
+function(object, ...) {
lapply(object, parameters)
-}
+})
-#' Return fitted archetypes.
-#' @param object An \code{repArchetypes} object.
-#' @param ... Ignored.
-#' @return List of archetypes.
-#' @importFrom modeltools parameters
-#' @nord
-setMethod('parameters',
- signature = signature(object = 'repArchetypes'),
- .parameters.repArchetypes)
-
-#' Archetypes residual sum of squares getter.
-#' @param object A \code{repArchetypes} object.
-#' @param ... Ignored.
-#' @return A vector of residual sum of squares.
+#' @rdname rss
#' @method rss repArchetypes
+#'
#' @S3method rss repArchetypes
-#' @nord
rss.repArchetypes <- function(object, ...) {
ret <- sapply(object, rss)
names(ret) <- paste('r', seq_along(ret), sep='')
@@ -243,26 +197,21 @@
}
-#' Number of archetypes.
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/archetypes -r 49
More information about the Archetypes-commits
mailing list