[Robast-commits] r231 - in pkg: . ROptEstOld ROptEstOld/R ROptEstOld/inst ROptEstOld/inst/scripts ROptEstOld/inst/tests ROptEstOld/man ROptEstOld/tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Nov 29 14:16:57 CET 2008
Author: stamats
Date: 2008-11-29 14:16:57 +0100 (Sat, 29 Nov 2008)
New Revision: 231
Added:
pkg/ROptEstOld/
pkg/ROptEstOld/DESCRIPTION
pkg/ROptEstOld/NAMESPACE
pkg/ROptEstOld/R/
pkg/ROptEstOld/R/AllClass.R
pkg/ROptEstOld/R/AllGeneric.R
pkg/ROptEstOld/R/AllPlot.R
pkg/ROptEstOld/R/AllShow.R
pkg/ROptEstOld/R/ContIC.R
pkg/ROptEstOld/R/DistrSymmList.R
pkg/ROptEstOld/R/Expectation.R
pkg/ROptEstOld/R/FixRobModel.R
pkg/ROptEstOld/R/FunSymmList.R
pkg/ROptEstOld/R/IC.R
pkg/ROptEstOld/R/InfRobModel.R
pkg/ROptEstOld/R/InfluenceCurve.R
pkg/ROptEstOld/R/L2ParamFamily.R
pkg/ROptEstOld/R/Neighborhood.R
pkg/ROptEstOld/R/ParamFamParameter.R
pkg/ROptEstOld/R/ParamFamily.R
pkg/ROptEstOld/R/PosDefSymmMatrix.R
pkg/ROptEstOld/R/ProbFamily.R
pkg/ROptEstOld/R/RiskType.R
pkg/ROptEstOld/R/RobModel.R
pkg/ROptEstOld/R/SimpleL2ParamFamilies.R
pkg/ROptEstOld/R/Symmetry.R
pkg/ROptEstOld/R/TotalVarIC.R
pkg/ROptEstOld/R/UncondNeighborhood.R
pkg/ROptEstOld/R/getAsRisk.R
pkg/ROptEstOld/R/getFiRisk.R
pkg/ROptEstOld/R/getFixClip.R
pkg/ROptEstOld/R/getFixRobIC_fiUnOvShoot.R
pkg/ROptEstOld/R/getIneffDiff.R
pkg/ROptEstOld/R/getInfCent.R
pkg/ROptEstOld/R/getInfClip.R
pkg/ROptEstOld/R/getInfGamma.R
pkg/ROptEstOld/R/getInfRobIC_asBias.R
pkg/ROptEstOld/R/getInfRobIC_asCov.R
pkg/ROptEstOld/R/getInfRobIC_asGRisk.R
pkg/ROptEstOld/R/getInfRobIC_asHampel.R
pkg/ROptEstOld/R/getInfRobIC_asUnOvShoot.R
pkg/ROptEstOld/R/getInfStand.R
pkg/ROptEstOld/R/getRiskIC.R
pkg/ROptEstOld/R/infoPlot.R
pkg/ROptEstOld/R/ksEstimator.R
pkg/ROptEstOld/R/leastFavorableRadius.R
pkg/ROptEstOld/R/locMEstimator.R
pkg/ROptEstOld/R/lowerCaseRadius.R
pkg/ROptEstOld/R/oneStepEstimator.R
pkg/ROptEstOld/R/optIC.R
pkg/ROptEstOld/R/optRisk.R
pkg/ROptEstOld/R/radiusMinimaxIC.R
pkg/ROptEstOld/inst/
pkg/ROptEstOld/inst/scripts/
pkg/ROptEstOld/inst/scripts/BinomialModel.R
pkg/ROptEstOld/inst/scripts/ExponentialScaleModel.R
pkg/ROptEstOld/inst/scripts/GammaModel.R
pkg/ROptEstOld/inst/scripts/GumbelLocationModel.R
pkg/ROptEstOld/inst/scripts/LognormalAndNormalModel.R
pkg/ROptEstOld/inst/scripts/NormalLocationScaleModel.R
pkg/ROptEstOld/inst/scripts/NormalScaleModel.R
pkg/ROptEstOld/inst/scripts/PoissonModel.R
pkg/ROptEstOld/inst/scripts/UnderOverShootRisk.R
pkg/ROptEstOld/inst/tests/
pkg/ROptEstOld/inst/tests/tests.R
pkg/ROptEstOld/man/
pkg/ROptEstOld/man/BinomFamily.Rd
pkg/ROptEstOld/man/ContIC-class.Rd
pkg/ROptEstOld/man/ContIC.Rd
pkg/ROptEstOld/man/ContNeighborhood-class.Rd
pkg/ROptEstOld/man/ContNeighborhood.Rd
pkg/ROptEstOld/man/DistrSymmList-class.Rd
pkg/ROptEstOld/man/DistrSymmList.Rd
pkg/ROptEstOld/man/DistributionSymmetry-class.Rd
pkg/ROptEstOld/man/EllipticalSymmetry-class.Rd
pkg/ROptEstOld/man/EllipticalSymmetry.Rd
pkg/ROptEstOld/man/EvenSymmetric-class.Rd
pkg/ROptEstOld/man/EvenSymmetric.Rd
pkg/ROptEstOld/man/ExpScaleFamily.Rd
pkg/ROptEstOld/man/FixRobModel-class.Rd
pkg/ROptEstOld/man/FixRobModel.Rd
pkg/ROptEstOld/man/FunSymmList-class.Rd
pkg/ROptEstOld/man/FunSymmList.Rd
pkg/ROptEstOld/man/FunctionSymmetry-class.Rd
pkg/ROptEstOld/man/GammaFamily.Rd
pkg/ROptEstOld/man/GumbelLocationFamily.Rd
pkg/ROptEstOld/man/IC-class.Rd
pkg/ROptEstOld/man/IC.Rd
pkg/ROptEstOld/man/InfRobModel-class.Rd
pkg/ROptEstOld/man/InfRobModel.Rd
pkg/ROptEstOld/man/InfluenceCurve-class.Rd
pkg/ROptEstOld/man/InfluenceCurve.Rd
pkg/ROptEstOld/man/L2ParamFamily-class.Rd
pkg/ROptEstOld/man/L2ParamFamily.Rd
pkg/ROptEstOld/man/LnormScaleFamily.Rd
pkg/ROptEstOld/man/Neighborhood-class.Rd
pkg/ROptEstOld/man/NoSymmetry-class.Rd
pkg/ROptEstOld/man/NoSymmetry.Rd
pkg/ROptEstOld/man/NonSymmetric-class.Rd
pkg/ROptEstOld/man/NonSymmetric.Rd
pkg/ROptEstOld/man/NormLocationFamily.Rd
pkg/ROptEstOld/man/NormLocationScaleFamily.Rd
pkg/ROptEstOld/man/NormScaleFamily.Rd
pkg/ROptEstOld/man/OddSymmetric-class.Rd
pkg/ROptEstOld/man/OddSymmetric.Rd
pkg/ROptEstOld/man/OptionalNumeric-class.Rd
pkg/ROptEstOld/man/ParamFamParameter-class.Rd
pkg/ROptEstOld/man/ParamFamParameter.Rd
pkg/ROptEstOld/man/ParamFamily-class.Rd
pkg/ROptEstOld/man/ParamFamily.Rd
pkg/ROptEstOld/man/PoisFamily.Rd
pkg/ROptEstOld/man/PosDefSymmMatrix-class.Rd
pkg/ROptEstOld/man/PosDefSymmMatrix.Rd
pkg/ROptEstOld/man/ProbFamily-class.Rd
pkg/ROptEstOld/man/RiskType-class.Rd
pkg/ROptEstOld/man/RobModel-class.Rd
pkg/ROptEstOld/man/SphericalSymmetry-class.Rd
pkg/ROptEstOld/man/SphericalSymmetry.Rd
pkg/ROptEstOld/man/Symmetry-class.Rd
pkg/ROptEstOld/man/TotalVarIC-class.Rd
pkg/ROptEstOld/man/TotalVarIC.Rd
pkg/ROptEstOld/man/TotalVarNeighborhood-class.Rd
pkg/ROptEstOld/man/TotalVarNeighborhood.Rd
pkg/ROptEstOld/man/UncondNeighborhood-class.Rd
pkg/ROptEstOld/man/asBias-class.Rd
pkg/ROptEstOld/man/asBias.Rd
pkg/ROptEstOld/man/asCov-class.Rd
pkg/ROptEstOld/man/asCov.Rd
pkg/ROptEstOld/man/asGRisk-class.Rd
pkg/ROptEstOld/man/asHampel-class.Rd
pkg/ROptEstOld/man/asHampel.Rd
pkg/ROptEstOld/man/asMSE-class.Rd
pkg/ROptEstOld/man/asMSE.Rd
pkg/ROptEstOld/man/asRisk-class.Rd
pkg/ROptEstOld/man/asUnOvShoot-class.Rd
pkg/ROptEstOld/man/asUnOvShoot.Rd
pkg/ROptEstOld/man/checkIC.Rd
pkg/ROptEstOld/man/checkL2deriv.Rd
pkg/ROptEstOld/man/evalIC.Rd
pkg/ROptEstOld/man/fiBias-class.Rd
pkg/ROptEstOld/man/fiBias.Rd
pkg/ROptEstOld/man/fiCov-class.Rd
pkg/ROptEstOld/man/fiCov.Rd
pkg/ROptEstOld/man/fiHampel-class.Rd
pkg/ROptEstOld/man/fiHampel.Rd
pkg/ROptEstOld/man/fiMSE-class.Rd
pkg/ROptEstOld/man/fiMSE.Rd
pkg/ROptEstOld/man/fiRisk-class.Rd
pkg/ROptEstOld/man/fiUnOvShoot-class.Rd
pkg/ROptEstOld/man/fiUnOvShoot.Rd
pkg/ROptEstOld/man/generateIC.Rd
pkg/ROptEstOld/man/getAsRisk.Rd
pkg/ROptEstOld/man/getFiRisk.Rd
pkg/ROptEstOld/man/getFixClip.Rd
pkg/ROptEstOld/man/getFixRobIC.Rd
pkg/ROptEstOld/man/getIneffDiff.Rd
pkg/ROptEstOld/man/getInfCent.Rd
pkg/ROptEstOld/man/getInfClip.Rd
pkg/ROptEstOld/man/getInfGamma.Rd
pkg/ROptEstOld/man/getInfRobIC.Rd
pkg/ROptEstOld/man/getInfStand.Rd
pkg/ROptEstOld/man/getRiskIC.Rd
pkg/ROptEstOld/man/infoPlot.Rd
pkg/ROptEstOld/man/ksEstimator.Rd
pkg/ROptEstOld/man/leastFavorableRadius.Rd
pkg/ROptEstOld/man/locMEstimator.Rd
pkg/ROptEstOld/man/lowerCaseRadius.Rd
pkg/ROptEstOld/man/oneStepEstimator.Rd
pkg/ROptEstOld/man/optIC.Rd
pkg/ROptEstOld/man/optRisk.Rd
pkg/ROptEstOld/man/radiusMinimaxIC.Rd
pkg/ROptEstOld/man/trAsCov-class.Rd
pkg/ROptEstOld/man/trAsCov.Rd
pkg/ROptEstOld/man/trFiCov-class.Rd
pkg/ROptEstOld/man/trFiCov.Rd
pkg/ROptEstOld/tests/
pkg/ROptEstOld/tests/tests.R
Log:
introduced package ROptEstOld for use with ROptRegTS and RobRex
Added: pkg/ROptEstOld/DESCRIPTION
===================================================================
--- pkg/ROptEstOld/DESCRIPTION (rev 0)
+++ pkg/ROptEstOld/DESCRIPTION 2008-11-29 13:16:57 UTC (rev 231)
@@ -0,0 +1,12 @@
+Package: ROptEstOld
+Version: 0.5.2
+Date: 2008-11-29
+Title: Optimally robust estimation - old version
+Description: Optimally robust estimation using S4 classes and methods. Old version still needed for current versions of ROptRegTS and RobRex.
+Depends: R(>= 2.4.0), methods, distr(>= 2.0), distrEx(>= 2.0), RandVar(>= 0.6)
+Author: Matthias Kohl
+Maintainer: Matthias Kohl <Matthias.Kohl at stamats.de>
+LazyLoad: yes
+License: LGPL-3
+URL: http://robast.r-forge.r-project.org/
+Packaged: Mon Aug 6 08:05:26 2007; kohl
Added: pkg/ROptEstOld/NAMESPACE
===================================================================
--- pkg/ROptEstOld/NAMESPACE (rev 0)
+++ pkg/ROptEstOld/NAMESPACE 2008-11-29 13:16:57 UTC (rev 231)
@@ -0,0 +1,149 @@
+import("distr")
+import("distrEx")
+import("RandVar")
+
+exportClasses("PosDefSymmMatrix",
+ "OptionalNumeric")
+exportClasses("Symmetry",
+ "DistributionSymmetry",
+ "NoSymmetry",
+ "EllipticalSymmetry",
+ "SphericalSymmetry",
+ "FunctionSymmetry",
+ "NonSymmetric",
+ "EvenSymmetric",
+ "OddSymmetric",
+ "FunSymmList",
+ "DistrSymmList")
+exportClasses("ParamFamParameter",
+ "ProbFamily",
+ "ParamFamily",
+ "L2ParamFamily")
+exportClasses("Neighborhood",
+ "UncondNeighborhood",
+ "ContNeighborhood",
+ "TotalVarNeighborhood")
+exportClasses("RobModel",
+ "FixRobModel",
+ "InfRobModel")
+exportClasses("RiskType",
+ "asRisk",
+ "asCov",
+ "trAsCov",
+ "asHampel",
+ "asBias",
+ "asGRisk",
+ "asMSE",
+ "asUnOvShoot",
+ "fiRisk",
+ "fiCov",
+ "trFiCov",
+ "fiHampel",
+ "fiMSE",
+ "fiBias",
+ "fiUnOvShoot")
+exportClasses("InfluenceCurve",
+ "IC",
+ "ContIC",
+ "TotalVarIC")
+
+exportMethods("show",
+ "plot",
+ "coerce",
+ "length",
+ "E")
+exportMethods("type",
+ "SymmCenter")
+exportMethods("name", "name<-",
+ "distribution",
+ "distrSymm",
+ "props", "props<-", "addProp<-",
+ "main", "main<-",
+ "nuisance", "nuisance<-",
+ "trafo", "trafo<-",
+ "param",
+ "L2deriv",
+ "L2derivSymm",
+ "L2derivDistr",
+ "L2derivDistrSymm",
+ "FisherInfo",
+ "checkL2deriv",
+ "infoPlot")
+exportMethods("radius")
+exportMethods("center", "center<-",
+ "neighbor", "neighbor<-")
+exportMethods("bound",
+ "width")
+exportMethods("Curve",
+ "Risks", "Risks<-", "addRisk<-",
+ "Infos", "Infos<-", "addInfo<-",
+ "CallL2Fam", "CallL2Fam<-",
+ "generateIC",
+ "checkIC",
+ "evalIC",
+ "clip", "clip<-",
+ "cent", "cent<-",
+ "stand", "stand<-",
+ "lowerCase", "lowerCase<-",
+ "neighborRadius", "neighborRadius<-",
+ "clipLo", "clipLo<-",
+ "clipUp", "clipUp<-")
+exportMethods("optIC",
+ "getInfRobIC",
+ "getFixRobIC",
+ "getAsRisk",
+ "getFiRisk",
+ "getInfClip",
+ "getFixClip",
+ "getInfGamma",
+ "getInfCent",
+ "getInfStand",
+ "getRiskIC",
+ "optRisk",
+ "radiusMinimaxIC",
+ "getIneffDiff",
+ "leastFavorableRadius",
+ "lowerCaseRadius")
+exportMethods("ksEstimator",
+ "oneStepEstimator",
+ "locMEstimator")
+
+export("PosDefSymmMatrix")
+export("NoSymmetry",
+ "EllipticalSymmetry",
+ "SphericalSymmetry",
+ "NonSymmetric",
+ "EvenSymmetric",
+ "OddSymmetric",
+ "DistrSymmList",
+ "FunSymmList")
+export("ParamFamParameter",
+ "ParamFamily",
+ "L2ParamFamily",
+ "BinomFamily",
+ "PoisFamily",
+ "NormLocationFamily",
+ "GumbelLocationFamily",
+ "NormScaleFamily",
+ "ExpScaleFamily",
+ "LnormScaleFamily",
+ "GammaFamily",
+ "NormLocationScaleFamily")
+export("ContNeighborhood", "TotalVarNeighborhood")
+export("FixRobModel", "InfRobModel")
+export("asCov",
+ "trAsCov",
+ "asHampel",
+ "asBias",
+ "asMSE",
+ "asUnOvShoot",
+ "fiCov",
+ "trFiCov",
+ "fiHampel",
+ "fiMSE",
+ "fiBias",
+ "fiUnOvShoot")
+export("InfluenceCurve",
+ "IC",
+ "ContIC",
+ "TotalVarIC")
Added: pkg/ROptEstOld/R/AllClass.R
===================================================================
--- pkg/ROptEstOld/R/AllClass.R (rev 0)
+++ pkg/ROptEstOld/R/AllClass.R 2008-11-29 13:16:57 UTC (rev 231)
@@ -0,0 +1,399 @@
+.onLoad <- function(lib, pkg){
+ require("methods", character = TRUE, quietly = TRUE)
+ require("distr", character = TRUE, quietly = TRUE)
+ require("distrEx", character = TRUE, quietly = TRUE)
+ require("RandVar", character = TRUE, quietly = TRUE)
+}
+
+# positive definite, symmetric matrices with finite entries
+setClass("PosDefSymmMatrix", contains = "matrix",
+ prototype = prototype(matrix(1)),
+ validity = function(object){
+ if(nrow(object) != ncol(object))
+ stop("no square matrix")
+ if(any(!is.finite(object)))
+ stop("inifinite or missing values in matrix")
+ if(!isTRUE(all.equal(object, t(object), .Machine$double.eps^0.5)))
+ stop("matrix is not symmetric")
+ if(!all(eigen(object)$values > 100*.Machine$double.eps))
+ stop("matrix is (numerically) not positive definite")
+ return(TRUE)
+ })
+
+# optional numeric
+setClassUnion("OptionalNumeric", c("numeric", "NULL"))
+
+# class of symmetries
+setClass("Symmetry", representation(type = "character",
+ SymmCenter = "ANY"),
+ contains = "VIRTUAL")
+
+# symmetry of distributions
+setClass("DistributionSymmetry", contains = c("Symmetry", "VIRTUAL"))
+
+# spherical symmetry
+setClass("NoSymmetry", contains = "DistributionSymmetry",
+ prototype = prototype(type = "non-symmetric distribution",
+ SymmCenter = NULL))
+
+# elliptical symmetry
+setClass("EllipticalSymmetry", contains = "DistributionSymmetry",
+ prototype = prototype(type = "elliptically symmetric distribution",
+ SymmCenter = numeric(0)))
+
+# spherical symmetry
+setClass("SphericalSymmetry", contains = "EllipticalSymmetry",
+ prototype = prototype(type = "spherically symmetric distribution",
+ SymmCenter = numeric(0)))
+
+# symmetry of distributions
+setClass("FunctionSymmetry", contains = c("Symmetry", "VIRTUAL"))
+
+# non-symmetric functions
+setClass("NonSymmetric", contains = "FunctionSymmetry",
+ prototype = prototype(type = "non-symmetric function",
+ SymmCenter = NULL))
+
+# even functions
+setClass("EvenSymmetric", contains = "FunctionSymmetry",
+ prototype = prototype(type = "even function",
+ SymmCenter = numeric(0)))
+
+# odd functions
+setClass("OddSymmetric", contains = "FunctionSymmetry",
+ prototype = prototype(type = "odd function",
+ SymmCenter = numeric(0)))
+
+# list of symmetry types
+setClass(Class = "DistrSymmList",
+ prototype = prototype(list(new("NoSymmetry"))),
+ contains = "list",
+ validity = function(object){
+ nrvalues <- length(object)
+ for(i in 1:nrvalues)
+ if(!is(object[[i]], "DistributionSymmetry"))
+ stop("element ", i, " is no 'DistributionSymmetry'")
+ return(TRUE)
+ })
+
+# list of symmetry types
+setClass(Class = "FunSymmList",
+ prototype = prototype(list(new("NonSymmetric"))),
+ contains = "list",
+ validity = function(object){
+ nrvalues <- length(object)
+ for(i in 1:nrvalues)
+ if(!is(object[[i]], "FunctionSymmetry"))
+ stop("element ", i, " is no 'FunctionSymmetry'")
+ return(TRUE)
+ })
+
+# Parameter of a parametric family of probability measures
+setClass("ParamFamParameter",
+ representation(main = "numeric",
+ nuisance = "OptionalNumeric",
+ trafo = "matrix"),
+ prototype(name = "parameter of a parametric family of probability measures",
+ main = numeric(0), nuisance = NULL, trafo = new("matrix")),
+ contains = "Parameter",
+ validity = function(object){
+ dimension <- length(object at main) + length(object at nuisance)
+ if(ncol(object at trafo) != dimension)
+ stop("invalid transformation:\n",
+ "number of columns of 'trafo' not equal to ",
+ "dimension of the parameter")
+ if(nrow(object at trafo) > dimension)
+ stop("invalid transformation:\n",
+ "number of rows of 'trafo' larger than ",
+ "dimension of the parameter")
+ if(any(!is.finite(object at trafo)))
+ stop("infinite or missing values in 'trafo'")
+ return(TRUE)
+ })
+
+# family of probability measures
+setClass("ProbFamily", representation(name = "character",
+ distribution = "Distribution",
+ distrSymm = "DistributionSymmetry",
+ props = "character"),
+ contains = "VIRTUAL")
+
+# parametric family of probability measures
+setClass("ParamFamily", representation(param = "ParamFamParameter"),
+ prototype(name = "parametric family of probability measures",
+ distribution = new("Norm"),
+ distrSymm = new("NoSymmetry"),
+ props = character(0),
+ param = new("ParamFamParameter", main = 0, trafo = as.matrix(1))),
+ contains = "ProbFamily")
+
+# L_2 differentiable parametric family
+setClass("L2ParamFamily",
+ representation(L2deriv = "EuclRandVarList",
+ L2derivSymm = "FunSymmList",
+ L2derivDistr = "DistrList",
+ L2derivDistrSymm = "DistrSymmList",
+ FisherInfo = "PosDefSymmMatrix"),
+ prototype(name = "L_2 differentiable parametric family of probability measures",
+ distribution = new("Norm"),
+ distrSymm = new("NoSymmetry"),
+ param = new("ParamFamParameter", main = 0, trafo = matrix(1)),
+ props = character(0),
+ L2deriv = EuclRandVarList(RealRandVariable(Map = list(function(x){x}),
+ Domain = Reals())),
+ L2derivSymm = new("FunSymmList"),
+ L2derivDistr = UnivarDistrList(new("Norm")),
+ L2derivDistrSymm = new("DistrSymmList"),
+ FisherInfo = new("PosDefSymmMatrix", matrix(1))),
+ contains = "ParamFamily",
+ validity = function(object){
+ if(is(object at distribution, "UnivariateCondDistribution"))
+ stop("conditional distributions are not allowed in slot 'distribution'")
+
+ if(!is(object at distrSymm, "NoSymmetry")){
+ if(!is(object at distrSymm@SymmCenter, "numeric"))
+ stop("slot 'SymmCenter' of 'distrSymm' has to be of class 'numeric'")
+ if(length(object at distrSymm@SymmCenter) != dimension(img(object at distribution)))
+ stop("slot 'SymmCenter' of 'distrSymm' has wrong dimension")
+ }
+
+ dims <- length(object at param)
+ if(ncol(object at FisherInfo) != dims)
+ stop(paste("dimension of 'FisherInfo' should be", dims))
+ nrvalues <- numberOfMaps(object at L2deriv)
+ if(nrvalues != length(object at L2derivSymm))
+ stop("number of Maps of 'L2deriv' != length of 'L2derivSymm'")
+ if(nrvalues != length(object at L2derivDistr))
+ stop("number of Maps of 'L2deriv' != length of 'L2derivDistr'")
+ if(nrvalues != length(object at L2derivDistrSymm))
+ stop("number of Maps of 'L2deriv' != length of 'L2derivDistrSymm'")
+ if(dimension(Domain(object at L2deriv[[1]])) != dimension(img(object at distribution)))
+ stop("dimension of 'Domain' of 'L2deriv' != dimension of 'img' of 'distribution'")
+ if(dimension(object at L2deriv) != dims)
+ stop("dimension of 'L2deriv' != dimension of parameters")
+
+ return(TRUE)
+ })
+
+# neighborhood
+setClass("Neighborhood",
+ representation(type = "character",
+ radius = "numeric"),
+ contains = "VIRTUAL")
+# unconditional (errors-in-variables) neighborhood
+setClass("UncondNeighborhood", contains = c("Neighborhood", "VIRTUAL"))
+# unconditional convex contamination neighborhood
+setClass("ContNeighborhood", contains = "UncondNeighborhood",
+ prototype = prototype(type = "(uncond.) convex contamination neighborhood",
+ radius = 0))
+# unconditional total variation neighborhood
+setClass("TotalVarNeighborhood", contains = "UncondNeighborhood",
+ prototype = prototype(type = "(uncond.) total variation neighborhood",
+ radius = 0))
+# robust model
+setClass("RobModel",
+ representation(center = "ProbFamily",
+ neighbor = "Neighborhood"),
+ contains = "VIRTUAL")
+# robust model with fixed (unconditional) neighborhood
+setClass("FixRobModel",
+ prototype = prototype(center = new("ParamFamily"),
+ neighbor = new("ContNeighborhood")),
+ contains = "RobModel",
+ validity = function(object){
+ if(!is(object at neighbor, "UncondNeighborhood"))
+ stop("'neighbor' is no unconditional neighborhood")
+ if(any(object at neighbor@radius < 0 || object at neighbor@radius > 1))
+ stop("neighborhood radius has to be in [0, 1]")
+ else return(TRUE)
+ })
+# robust model with infinitesimal (unconditional) neighborhood
+setClass("InfRobModel",
+ prototype = prototype(center = new("L2ParamFamily"),
+ neighbor = new("ContNeighborhood")),
+ contains = "RobModel",
+ validity = function(object){
+ if(!is(object at neighbor, "UncondNeighborhood"))
+ stop("'neighbor' is no unconditional neighborhood")
+ if(any(object at neighbor@radius < 0))
+ stop("'radius' has to be in [0, Inf]")
+ else return(TRUE)
+ })
+# risks (e.g., risk of estimator)
+setClass("RiskType", representation(type = "character"), contains = "VIRTUAL")
+# asymptotic risk
+setClass("asRisk", contains = c("RiskType", "VIRTUAL"))
+# asymptotic covariance
+setClass("asCov", contains = "asRisk",
+ prototype = prototype(type = "asymptotic covariance"))
+# trace of asymptotic covariance
+setClass("trAsCov", contains = "asRisk",
+ prototype = prototype(type = "trace of asymptotic covariance"))
+# asymptotic Hampel risk
+setClass("asHampel", representation(bound = "numeric"),
+ prototype = prototype(bound = Inf,
+ type = "trace of asymptotic covariance for given bias bound"),
+ contains = "asRisk",
+ validity = function(object){
+ if(any(object at bound <= 0))
+ stop("'bound' has to be positive")
+ else TRUE
+ })
+# asymptotic bias
+setClass("asBias", contains = "asRisk",
+ prototype = prototype(type = "asymptotic bias"))
+
+# convex asymptotic risk
+setClass("asGRisk", contains = c("asRisk", "VIRTUAL"))
+# asymptotic mean square error
+setClass("asMSE", contains = "asGRisk",
+ prototype = prototype(type = "asymptotic mean square error"))
+# asymptotic under-/overshoot probability
+setClass("asUnOvShoot", representation(width = "numeric"),
+ prototype = prototype(type = "asymptotic under-/overshoot probability"),
+ contains = "asGRisk",
+ validity = function(object){
+ if(length(object at width) != 1)
+ stop("length of 'width' has to be 1")
+ if(any(object at width <= 0))
+ stop("'width' has to be positive")
+ else TRUE
+ })
+# finite-sample risk
+setClass("fiRisk", contains = c("RiskType", "VIRTUAL"))
+# finite-sample covariance
+setClass("fiCov", contains = "fiRisk",
+ prototype = prototype(type = "finite-sample covariance"))
+# trace of finite-sample covariance
+setClass("trFiCov", contains = "fiRisk",
+ prototype = prototype(type = "trace of finite-sample covariance"))
+# finite-sample Hampel risk
+setClass("fiHampel", representation(bound = "numeric"),
+ prototype = prototype(bound = Inf,
+ type = "finite-sample variance for given bias bound"),
+ contains = "fiRisk",
+ validity = function(object){
+ if(any(object at bound <= 0))
+ stop("'bound' has to be positive")
+ else TRUE
+ })
+# finite-sample mean square error
+setClass("fiMSE", contains = "fiRisk",
+ prototype = prototype(type = "finite-sample mean square error"))
+# finite-sample bias
+setClass("fiBias", contains = "fiRisk",
+ prototype = prototype(type = "finite-sample bias"))
+# finite-sample under-/overshoot probability
+setClass("fiUnOvShoot", representation(width = "numeric"),
+ prototype = prototype(type = "finite-sample under-/overshoot probability"),
+ contains = "fiRisk",
+ validity = function(object){
+ if(length(object at width) != 1)
+ stop("length of 'width' has to be 1")
+ if(any(object at width <= 0))
+ stop("'width' has to be positive")
+ else TRUE
+ })
+# Influence curve/function with domain: EuclideanSpace
+setClass("InfluenceCurve",
+ representation(name = "character",
+ Curve = "EuclRandVarList",
+ Risks = "list",
+ Infos = "matrix"),
+ validity = function(object){
+ if(!is(Domain(object at Curve[[1]]), "EuclideanSpace"))
+ stop("The domain of 'Curve' has to be a Euclidean space")
+ if(!is.character(object at Infos))
+ stop("'Infos' contains no matrix of characters")
+ for(char in names(object at Risks))
+ if(!extends(char, "RiskType"))
+ stop(paste(char, "is no valid 'RiskType'"))
+ if(ncol(object at Infos)!=2)
+ stop("'Infos' must have two columns")
+ else TRUE
+ })
+# partial incluence curve
+setClass("IC", representation(CallL2Fam = "call"),
+ prototype(name = "square integrable (partial) influence curve",
+ Curve = EuclRandVarList(RealRandVariable(Map = list(function(x){x}),
+ Domain = Reals())),
+ Risks = list(),
+ Infos = matrix(c(character(0),character(0)), ncol=2,
+ dimnames=list(character(0), c("method", "message"))),
+ CallL2Fam = call("L2ParamFamily")),
+ contains = "InfluenceCurve",
+ validity = function(object){
+ L2Fam <- eval(object at CallL2Fam)
+ trafo <- L2Fam at param@trafo
+ if(nrow(trafo) != dimension(object at Curve))
+ stop("wrong dimension of 'Curve'")
+ if(dimension(Domain(L2Fam at L2deriv[[1]])) != dimension(Domain(object at Curve[[1]])))
+ stop("dimension of 'Domain' of 'L2deriv' != dimension of 'Domain' of 'Curve'")
+
+ return(TRUE)
+ })
+# (partial) influence curve of contamination type
+setClass("ContIC",
+ representation(clip = "numeric",
+ cent = "numeric",
+ stand = "matrix",
+ lowerCase = "OptionalNumeric",
+ neighborRadius = "numeric"),
+ prototype(name = "IC of contamination type",
+ Curve = EuclRandVarList(RealRandVariable(Map = list(function(x){x}),
+ Domain = Reals())),
+ Risks = list(),
+ Infos = matrix(c(character(0),character(0)), ncol=2,
+ dimnames=list(character(0), c("method", "message"))),
+ CallL2Fam = call("L2ParamFamily"),
+ clip = Inf, cent = 0, stand = as.matrix(1),
+ lowerCase = NULL,
+ neighborRadius = 0),
+ contains = "IC",
+ validity = function(object){
+ if(any(object at neighborRadius < 0)) # radius vector?!
+ stop("'neighborRadius' has to be in [0, Inf]")
+ if(length(object at cent) != nrow(object at stand))
+ stop("length of centering constant != nrow of standardizing matrix")
+ if((length(object at clip) != 1) && (length(object at clip) != length(object at Curve)))
+ stop("length of clipping bound != 1 and != length of 'Curve'")
+ if(!is.null(object at lowerCase))
+ if(length(object at lowerCase) != nrow(object at stand))
+ stop("length of 'lowerCase' != nrow of standardizing matrix")
+ L2Fam <- eval(object at CallL2Fam)
+ if(!identical(dim(L2Fam at param@trafo), dim(object at stand)))
+ stop(paste("dimension of 'trafo' of 'param'",
+ "!= dimension of 'stand'"))
+ return(TRUE)
+ })
+# (partial) influence curve of total variation type
+setClass("TotalVarIC",
+ representation(clipLo = "numeric",
+ clipUp = "numeric",
+ stand = "matrix",
+ lowerCase = "OptionalNumeric",
+ neighborRadius = "numeric"),
+ prototype(name = "IC of total variation type",
+ Curve = EuclRandVarList(RealRandVariable(Map = list(function(x){x}),
+ Domain = Reals())),
+ Risks = list(),
+ Infos = matrix(c(character(0),character(0)), ncol=2,
+ dimnames=list(character(0), c("method", "message"))),
+ CallL2Fam = call("L2ParamFamily"),
+ clipLo = -Inf, clipUp = Inf, stand = as.matrix(1),
+ lowerCase = NULL,
+ neighborRadius = 0),
+ contains = "IC",
+ validity = function(object){
+ if(any(object at neighborRadius < 0)) # radius vector?!
+ stop("'neighborRadius' has to be in [0, Inf]")
+ if((length(object at clipLo) != 1) && (length(object at clipLo) != length(object at Curve)))
+ stop("length of lower clipping bound != 1 and != length of 'Curve'")
+ if((length(object at clipLo) != 1) && (length(object at clipLo) != length(object at Curve)))
+ stop("length of upper clipping bound != 1 and != length of 'Curve'")
+ L2Fam <- eval(object at CallL2Fam)
+ if(!identical(dim(L2Fam at param@trafo), dim(object at stand)))
+ stop(paste("dimension of 'trafo' of 'param'",
+ "!= dimension of 'stand'"))
+ return(TRUE)
+ })
Added: pkg/ROptEstOld/R/AllGeneric.R
===================================================================
--- pkg/ROptEstOld/R/AllGeneric.R (rev 0)
+++ pkg/ROptEstOld/R/AllGeneric.R 2008-11-29 13:16:57 UTC (rev 231)
@@ -0,0 +1,238 @@
+if(!isGeneric("type")){
+ setGeneric("type", function(object) standardGeneric("type"))
+}
+if(!isGeneric("SymmCenter")){
+ setGeneric("SymmCenter", function(object) standardGeneric("SymmCenter"))
+}
+if(!isGeneric("distrSymm")){
+ setGeneric("distrSymm", function(object) standardGeneric("distrSymm"))
+}
+if(!isGeneric("distribution")){
+ setGeneric("distribution", function(object) standardGeneric("distribution"))
+}
+if(!isGeneric("props")){
+ setGeneric("props", function(object) standardGeneric("props"))
+}
+if(!isGeneric("props<-")){
+ setGeneric("props<-", function(object, value) standardGeneric("props<-"))
+}
+if(!isGeneric("addProp<-")){
+ setGeneric("addProp<-", function(object, value) standardGeneric("addProp<-"))
+}
+if(!isGeneric("main")){
+ setGeneric("main", function(object) standardGeneric("main"))
+}
+if(!isGeneric("main<-")){
+ setGeneric("main<-", function(object, value) standardGeneric("main<-"))
+}
+if(!isGeneric("nuisance")){
+ setGeneric("nuisance", function(object) standardGeneric("nuisance"))
+}
+if(!isGeneric("nuisance<-")){
+ setGeneric("nuisance<-", function(object, value) standardGeneric("nuisance<-"))
+}
+if(!isGeneric("trafo")){
+ setGeneric("trafo", function(object) standardGeneric("trafo"))
+}
+if(!isGeneric("trafo<-")){
+ setGeneric("trafo<-", function(object, value) standardGeneric("trafo<-"))
+}
+if(!isGeneric("param<-")){
+ setGeneric("param<-", function(object, value) standardGeneric("param<-"))
+}
+if(!isGeneric("L2deriv")){
+ setGeneric("L2deriv", function(object) standardGeneric("L2deriv"))
+}
+if(!isGeneric("L2derivSymm")){
+ setGeneric("L2derivSymm", function(object) standardGeneric("L2derivSymm"))
+}
+if(!isGeneric("L2derivDistr")){
+ setGeneric("L2derivDistr", function(object) standardGeneric("L2derivDistr"))
+}
+if(!isGeneric("L2derivDistrSymm")){
+ setGeneric("L2derivDistrSymm", function(object) standardGeneric("L2derivDistrSymm"))
+}
+if(!isGeneric("FisherInfo")){
+ setGeneric("FisherInfo", function(object) standardGeneric("FisherInfo"))
+}
+if(!isGeneric("radius")){
+ setGeneric("radius", function(object) standardGeneric("radius"))
+}
+if(!isGeneric("center")){
+ setGeneric("center", function(object) standardGeneric("center"))
+}
+if(!isGeneric("center<-")){
+ setGeneric("center<-", function(object, value) standardGeneric("center<-"))
+}
+if(!isGeneric("neighbor")){
+ setGeneric("neighbor", function(object) standardGeneric("neighbor"))
+}
+if(!isGeneric("neighbor<-")){
+ setGeneric("neighbor<-", function(object, value) standardGeneric("neighbor<-"))
+}
+if(!isGeneric("bound")){
+ setGeneric("bound", function(object) standardGeneric("bound"))
+}
+if(!isGeneric("width")){
+ setGeneric("width", function(object) standardGeneric("width"))
+}
+if(!isGeneric("Curve")){
+ setGeneric("Curve", function(object) standardGeneric("Curve"))
+}
+if(!isGeneric("Risks")){
+ setGeneric("Risks", function(object) standardGeneric("Risks"))
+}
+if(!isGeneric("Risks<-")){
+ setGeneric("Risks<-", function(object, value) standardGeneric("Risks<-"))
+}
+if(!isGeneric("addRisk<-")){
+ setGeneric("addRisk<-", function(object, value) standardGeneric("addRisk<-"))
+}
+if(!isGeneric("Infos")){
+ setGeneric("Infos", function(object) standardGeneric("Infos"))
+}
+if(!isGeneric("Infos<-")){
+ setGeneric("Infos<-", function(object, value) standardGeneric("Infos<-"))
+}
+if(!isGeneric("addInfo<-")){
+ setGeneric("addInfo<-", function(object, value) standardGeneric("addInfo<-"))
+}
+if(!isGeneric("CallL2Fam")){
+ setGeneric("CallL2Fam", function(object) standardGeneric("CallL2Fam"))
+}
+if(!isGeneric("CallL2Fam<-")){
+ setGeneric("CallL2Fam<-", function(object, value) standardGeneric("CallL2Fam<-"))
+}
+if(!isGeneric("checkL2deriv")){
+ setGeneric("checkL2deriv", function(L2Fam, ...) standardGeneric("checkL2deriv"))
+}
+if(!isGeneric("generateIC")){
+ setGeneric("generateIC", function(neighbor, L2Fam, ...) standardGeneric("generateIC"))
+}
+if(!isGeneric("checkIC")){
+ setGeneric("checkIC", function(IC, L2Fam, ...) standardGeneric("checkIC"))
+}
+if(!isGeneric("evalIC")){
+ setGeneric("evalIC", function(IC, x) standardGeneric("evalIC"))
+}
+if(!isGeneric("clip")){
+ setGeneric("clip", function(object) standardGeneric("clip"))
+}
+if(!isGeneric("clip<-")){
+ setGeneric("clip<-", function(object, value) standardGeneric("clip<-"))
+}
+if(!isGeneric("cent")){
+ setGeneric("cent", function(object) standardGeneric("cent"))
+}
+if(!isGeneric("cent<-")){
+ setGeneric("cent<-", function(object, value) standardGeneric("cent<-"))
+}
+if(!isGeneric("stand")){
+ setGeneric("stand", function(object) standardGeneric("stand"))
+}
+if(!isGeneric("stand<-")){
+ setGeneric("stand<-", function(object, value) standardGeneric("stand<-"))
+}
+if(!isGeneric("lowerCase")){
+ setGeneric("lowerCase", function(object) standardGeneric("lowerCase"))
+}
+if(!isGeneric("lowerCase<-")){
+ setGeneric("lowerCase<-", function(object, value) standardGeneric("lowerCase<-"))
+}
+if(!isGeneric("neighborRadius")){
+ setGeneric("neighborRadius", function(object) standardGeneric("neighborRadius"))
+}
+if(!isGeneric("neighborRadius<-")){
+ setGeneric("neighborRadius<-", function(object, value) standardGeneric("neighborRadius<-"))
+}
+if(!isGeneric("clipLo")){
+ setGeneric("clipLo", function(object) standardGeneric("clipLo"))
+}
+if(!isGeneric("clipLo<-")){
+ setGeneric("clipLo<-", function(object, value) standardGeneric("clipLo<-"))
+}
+if(!isGeneric("clipUp")){
+ setGeneric("clipUp", function(object) standardGeneric("clipUp"))
+}
+if(!isGeneric("clipUp<-")){
+ setGeneric("clipUp<-", function(object, value) standardGeneric("clipUp<-"))
+}
+if(!isGeneric("optIC")){
+ setGeneric("optIC", function(model, risk, ...) standardGeneric("optIC"))
+}
+if(!isGeneric("getInfRobIC")){
+ setGeneric("getInfRobIC",
+ function(L2deriv, risk, neighbor, ...) standardGeneric("getInfRobIC"))
+}
+if(!isGeneric("getFixRobIC")){
+ setGeneric("getFixRobIC",
+ function(Distr, risk, neighbor, ...) standardGeneric("getFixRobIC"))
+}
+if(!isGeneric("getAsRisk")){
+ setGeneric("getAsRisk",
+ function(risk, L2deriv, neighbor, ...) standardGeneric("getAsRisk"))
+}
+if(!isGeneric("getFiRisk")){
+ setGeneric("getFiRisk",
+ function(risk, Distr, neighbor, ...) standardGeneric("getFiRisk"))
+}
+if(!isGeneric("getInfClip")){
+ setGeneric("getInfClip",
+ function(clip, L2deriv, risk, neighbor, ...) standardGeneric("getInfClip"))
+}
+if(!isGeneric("getFixClip")){
+ setGeneric("getFixClip",
+ function(clip, Distr, risk, neighbor, ...) standardGeneric("getFixClip"))
+}
+if(!isGeneric("getInfGamma")){
+ setGeneric("getInfGamma",
+ function(L2deriv, risk, neighbor, ...) standardGeneric("getInfGamma"))
+}
+if(!isGeneric("getInfCent")){
+ setGeneric("getInfCent",
+ function(L2deriv, neighbor, ...) standardGeneric("getInfCent"))
+}
+if(!isGeneric("getInfStand")){
+ setGeneric("getInfStand",
+ function(L2deriv, neighbor, ...) standardGeneric("getInfStand"))
+}
+if(!isGeneric("getRiskIC")){
+ setGeneric("getRiskIC",
+ function(IC, risk, neighbor, L2Fam, ...) standardGeneric("getRiskIC"))
+}
+if(!isGeneric("optRisk")){
+ setGeneric("optRisk", function(model, risk, ...) standardGeneric("optRisk"))
+}
+if(!isGeneric("radiusMinimaxIC")){
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/robast -r 231
More information about the Robast-commits
mailing list