[Archetypes-commits] r37 - in branches/pkg-robust: R demo
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Apr 1 15:42:22 CEST 2010
Author: manuel
Date: 2010-04-01 15:42:22 +0200 (Thu, 01 Apr 2010)
New Revision: 37
Added:
branches/pkg-robust/demo/robust-ozone.R
Modified:
branches/pkg-robust/R/archetypes-class.R
branches/pkg-robust/R/archetypes-robust.R
branches/pkg-robust/R/archetypes-step.R
branches/pkg-robust/R/archetypes-weighted.R
branches/pkg-robust/demo/robust-toy.R
Log:
S4 hick-hack.
Modified: branches/pkg-robust/R/archetypes-class.R
===================================================================
--- branches/pkg-robust/R/archetypes-class.R 2010-04-01 11:54:20 UTC (rev 36)
+++ branches/pkg-robust/R/archetypes-class.R 2010-04-01 13:42:22 UTC (rev 37)
@@ -46,6 +46,8 @@
class = c(family$class, 'archetypes')))
}
+
+
setOldClass('archetypes')
@@ -87,16 +89,20 @@
#' @param object An \code{archetypes} object.
#' @param ... Ignored.
#' @return Matrix with \eqn{k} archetypes.
-#' @method parameters archetypes
-#' @S3method parameters archetypes
-#' @rdname archetypes-class
-parameters.archetypes <- function(object, ...) {
+#' @nord
+.parameters.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
-#' @nord
-setMethod('parameters', 'archetypes', parameters.archetypes)
+#' @rdname archetypes-class
+setMethod('parameters',
+ signature = signature(object = 'archetypes'),
+ .parameters.archetypes)
Modified: branches/pkg-robust/R/archetypes-robust.R
===================================================================
--- branches/pkg-robust/R/archetypes-robust.R 2010-04-01 11:54:20 UTC (rev 36)
+++ branches/pkg-robust/R/archetypes-robust.R 2010-04-01 13:42:22 UTC (rev 37)
@@ -32,11 +32,19 @@
f
}
+
+
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', 'robustArchetypes', parameters.archetypes)
+setMethod('parameters',
+ signature = signature(object = 'robustArchetypes'),
+ .parameters.archetypes)
Modified: branches/pkg-robust/R/archetypes-step.R
===================================================================
--- branches/pkg-robust/R/archetypes-step.R 2010-04-01 11:54:20 UTC (rev 36)
+++ branches/pkg-robust/R/archetypes-step.R 2010-04-01 13:42:22 UTC (rev 37)
@@ -54,6 +54,11 @@
+setOldClass('repArchetypes')
+setOldClass('stepArchetypes')
+
+
+
#' Extract method.
#'
#' An extraction on a \code{stepArchetypes} object returns again a
@@ -109,19 +114,27 @@
-#' Archetypes getter.
+#' Return fitted archetypes.
#' @param object A \code{stepArchetypes} object.
#' @param ... Ignored.
#' @return A list of archetypes matrices.
-#' @method parameters stepArchetypes
-#' @S3method parameters stepArchetypes
-#' @rdname stepArchetypes
-parameters.stepArchetypes <- function(object, ...) {
+#' @nord
+.parameters.stepArchetypes <- function(object, ...) {
return(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.
@@ -194,19 +207,27 @@
-#' Archetypes getter.
+#' Return fitted archetypes.
#' @param object A \code{repArchetypes} object.
#' @param ... Ignored.
#' @return A list of archetypes matrices.
-#' @method parameters repArchetypes
-#' @S3method parameters repArchetypes
#' @nord
-parameters.repArchetypes <- function(object, ...) {
+.parameters.repArchetypes <- function(object, ...) {
lapply(object, atypes)
}
+#' 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.
Modified: branches/pkg-robust/R/archetypes-weighted.R
===================================================================
--- branches/pkg-robust/R/archetypes-weighted.R 2010-04-01 11:54:20 UTC (rev 36)
+++ branches/pkg-robust/R/archetypes-weighted.R 2010-04-01 13:42:22 UTC (rev 37)
@@ -33,10 +33,18 @@
f
}
+
+
setOldClass('weightedArchetypes')
+#' Return fitted archetypes.
+#' @param object An \code{weightedArchetypes} object.
+#' @param ... Ignored.
+#' @return Matrix with \eqn{k} archetypes.
#' @importFrom modeltools parameters
#' @nord
-setMethod('parameters', 'weightedArchetypes', parameters.archetypes)
+setMethod('parameters',
+ signature = signature(object = 'weightedArchetypes'),
+ .parameters.archetypes)
Added: branches/pkg-robust/demo/robust-ozone.R
===================================================================
--- branches/pkg-robust/demo/robust-ozone.R (rev 0)
+++ branches/pkg-robust/demo/robust-ozone.R 2010-04-01 13:42:22 UTC (rev 37)
@@ -0,0 +1,73 @@
+### Weighted and robust archetypal analysis: ozone data set
+###
+### Analysis used in 'Weighted and Robust Archetypal Analysis' by
+### Manuel J. A. Eugster and Friedrich Leisch.
+
+library('archetypes')
+
+
+
+### Data set:
+
+data('Ozone', package = 'mlbench')
+
+oz <- Ozone[, -c(1, 2, 3, 9)]
+oz <- na.omit(oz)
+colnames(oz) <- c('OZONE', '500MH', 'WDSP', 'HMDTY', 'STMP',
+ 'INVHT', 'PRGRT', 'INVTMP', 'VZBLTY')
+
+oz0 <- scale(oz)
+
+
+
+### The three original archetypes:
+
+set.seed(1234)
+a.oz <- archetypes(oz0, 3)
+
+parameters(a.oz)
+barplot(a.oz, oz0, percentiles = TRUE)
+
+panorama(a.oz, oz0)
+
+
+
+### Data set with outliers:
+
+set.seed(1234)
+outliers <- t(sapply(runif(5, min = 1.5, max = 2),
+ function(x)
+ x * apply(oz, 2, max) + apply(oz, 2, IQR)))
+
+oz1 <- scale(rbind(oz, outliers))
+
+
+pairs(oz1)
+
+
+
+### Original archetypal algorithm:
+
+set.seed(1234)
+a.oz1 <- archetypes(oz1, 3)
+
+parameters(a.oz1)
+barplot(a.oz1, oz1, percentiles = TRUE)
+
+panorama(a.oz1, oz1)
+
+
+
+### Robust archetypal algorithm:
+
+set.seed(1236)
+ra.oz1 <- robustArchetypes(oz1, 3)
+
+parameters(ra.oz1)
+barplot(ra.oz1, oz1, percentiles = TRUE)
+
+panorama(a.oz1, oz1)
+
+plot(rss(ra.oz1, type = 'single'), xlab = '', ylab = 'RSS')
+plot(weights(ra.oz1, type = 'reweights'), xlab = '', ylab = 'Weight')
+
Property changes on: branches/pkg-robust/demo/robust-ozone.R
___________________________________________________________________
Name: svn:keywords
+ Date Revision Author URL Id
Name: svn:eol-style
+ native
Modified: branches/pkg-robust/demo/robust-toy.R
===================================================================
--- branches/pkg-robust/demo/robust-toy.R 2010-04-01 11:54:20 UTC (rev 36)
+++ branches/pkg-robust/demo/robust-toy.R 2010-04-01 13:42:22 UTC (rev 37)
@@ -21,6 +21,7 @@
a <- archetypes(toy, 3)
a
+parameters(a)
barplot(a, toy, percentiles = TRUE)
@@ -120,6 +121,7 @@
ra <- robustArchetypes(toy.o1, 3)
ra
+parameters(ra)
barplot(ra, toy.o1, percentiles = TRUE)
More information about the Archetypes-commits
mailing list