[Robast-commits] r323 - in branches/robast-0.7/pkg/RobAStBase: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Jul 15 12:06:43 CEST 2009


Author: stamats
Date: 2009-07-15 12:06:41 +0200 (Wed, 15 Jul 2009)
New Revision: 323

Modified:
   branches/robast-0.7/pkg/RobAStBase/DESCRIPTION
   branches/robast-0.7/pkg/RobAStBase/R/oneStepEstimator.R
   branches/robast-0.7/pkg/RobAStBase/man/0RobAStBase-package.Rd
   branches/robast-0.7/pkg/RobAStBase/man/oneStepEstimator.Rd
Log:
implementation of oneStepEstimator simplified, no longer dispatching on argument "start".

Modified: branches/robast-0.7/pkg/RobAStBase/DESCRIPTION
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/DESCRIPTION	2009-07-15 09:16:25 UTC (rev 322)
+++ branches/robast-0.7/pkg/RobAStBase/DESCRIPTION	2009-07-15 10:06:41 UTC (rev 323)
@@ -1,6 +1,6 @@
 Package: RobAStBase
 Version: 0.7
-Date: 2009-04-14
+Date: 2009-07-15
 Title: Robust Asymptotic Statistics
 Description: Base S4-classes and functions for robust asymptotic
         statistics.

Modified: branches/robast-0.7/pkg/RobAStBase/R/oneStepEstimator.R
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/R/oneStepEstimator.R	2009-07-15 09:16:25 UTC (rev 322)
+++ branches/robast-0.7/pkg/RobAStBase/R/oneStepEstimator.R	2009-07-15 10:06:41 UTC (rev 323)
@@ -3,152 +3,16 @@
 ###############################################################################
 setMethod("oneStepEstimator", signature(x = "numeric", 
                                         IC = "InfluenceCurve",
-                                        start = "numeric"),
+                                        start = "ANY"),
     function(x, IC, start, useLast = getRobAStBaseOption("kStepUseLast")){
         es.call <- match.call()
         es.call[[1]] <- as.name("oneStepEstimator")
         nrvalues <- dimension(IC at Curve)
-        if(is.list(start)) start <- unlist(start)
-        if(nrvalues != length(start))
-            stop("dimension of 'start' != dimension of 'Curve'")
-
-        res <- start + rowMeans(evalIC(IC, as.matrix(x)), na.rm = TRUE)
-
-        if(is(IC, "IC")){
-            L2Fam <- eval(CallL2Fam(IC))
-            Infos <- matrix(c("oneStepEstimator", 
-                            paste("1-step estimate for", name(L2Fam))),
-                            ncol = 2)
-            colnames(Infos) <- c("method", "message")
-            if(is(L2Fam, "L2GroupParamFamily")) useLast <- TRUE
-            if(useLast && !is(modifyIC(IC), "NULL") ){
-                newParam <- param(L2Fam)
-                main(newParam)[] <- res
-                newL2Fam <- modifyModel(L2Fam, newParam)
-                IC <- modifyIC(IC)(newL2Fam, IC)
-                Infos <- rbind(Infos, c("oneStepEstimator", 
-                                        "computation of IC, asvar and asbias via useLast = TRUE"))
-            }else{
-                if(useLast && is(modifyIC(IC), "NULL")){
-                    warning("'useLast = TRUE' only possible if slot 'modifyIC' of 'IC'
-                             is filled with some function!")
-                    Infos <- rbind(Infos, c("oneStepEstimator", 
-                                            "slot 'modifyIC' of 'IC' was not filled!"))
-                }
-                Infos <- rbind(Infos, c("oneStepEstimator", 
-                                        "computation of IC, asvar and asbias via useLast = FALSE"))
-            }
-            if("asCov" %in% names(Risks(IC)))
-                if(is.matrix(Risks(IC)$asCov) || length(Risks(IC)$asCov) == 1)
-                    asVar <- Risks(IC)$asCov
-                else
-                    asVar <- Risks(IC)$asCov$value
-            else
-                asVar <- getRiskIC(IC, risk = asCov())$asCov$value
-
-            if("asBias" %in% names(Risks(IC))){
-                if(length(Risks(IC)$asBias) == 1)
-                    asBias <- neighborRadius(IC)*Risks(IC)$asBias
-                else
-                    asBias <- neighborRadius(IC)*Risks(IC)$asBias$value
-            }else{
-                if(is(IC, "HampIC")){
-                    r <- neighborRadius(IC)
-                    asBias <- r*getRiskIC(IC, risk = asBias(), neighbor = neighbor(IC))$asBias$value
-                }else{
-                    asBias <- NULL
-                }
-            }
+        if(is(start, "Estimate")){ 
+            start0 <- estimate(start)
         }else{
-            Infos <- matrix(c("oneStepEstimator", "1-step estimate"), ncol = 2)
-            colnames(Infos) <- c("method", "message")
-            asVar <- NULL
-            asBias <- NULL
+            start0 <- start
         }
-
-        new("kStepEstimate", name = "1-step estimate", estimate = res, 
-            estimate.call = es.call, samplesize = length(x), asvar = asVar, 
-            asbias = asBias, pIC = IC, steps = 1L, Infos = Infos)
-    })
-setMethod("oneStepEstimator", signature(x = "matrix", 
-                                        IC = "InfluenceCurve",
-                                        start = "numeric"),
-    function(x, IC, start, useLast = getRobAStBaseOption("kStepUseLast")){
-        es.call <- match.call()
-        es.call[[1]] <- as.name("oneStepEstimator")
-        nrvalues <- dimension(IC at Curve)
-        if(is.list(start)) start <- unlist(start)
-        if(nrvalues != length(start))
-            stop("dimension of 'start' != dimension of 'Curve'")
-        if(ncol(x) != IC at Curve[[1]]@Domain at dimension)
-            stop("'x' has wrong dimension")
-
-        res <- start + rowMeans(evalIC(IC, x), na.rm = TRUE)
-
-        if(is(IC, "IC")){
-            L2Fam <- eval(CallL2Fam(IC))
-            Infos <- matrix(c("oneStepEstimator", 
-                            paste("1-step estimate for", name(L2Fam))),
-                            ncol = 2)
-            colnames(Infos) <- c("method", "message")
-            if(is(L2Fam, "L2GroupParamFamily")) useLast <- TRUE
-            if(useLast && !is(modifyIC(IC), "NULL") ){
-                newParam <- param(L2Fam)
-                main(newParam)[] <- res
-                newL2Fam <- modifyModel(L2Fam, newParam)
-                IC <- modifyIC(IC)(newL2Fam, IC)
-                Infos <- rbind(Infos, c("oneStepEstimator", 
-                                        "computation of IC, asvar and asbias via useLast = TRUE"))
-            }else{
-                if(useLast && is(modifyIC(IC), "NULL")){
-                    warning("'useLast = TRUE' only possible if slot 'modifyIC' of 'IC'
-                             is filled with some function!")
-                    Infos <- rbind(Infos, c("oneStepEstimator", 
-                                            "slot 'modifyIC' of 'IC' was not filled!"))
-                }
-                Infos <- rbind(Infos, c("oneStepEstimator", 
-                                        "computation of IC, asvar and asbias via useLast = FALSE"))
-            }
-            if("asCov" %in% names(Risks(IC)))
-                if(is.matrix(Risks(IC)$asCov) || length(Risks(IC)$asCov) == 1)
-                    asVar <- Risks(IC)$asCov
-                else
-                    asVar <- Risks(IC)$asCov$value
-            else
-                asVar <- getRiskIC(IC, risk = asCov())$asCov$value
-
-            if("asBias" %in% names(Risks(IC))){
-                if(length(Risks(IC)$asBias) == 1)
-                    asBias <- neighborRadius(IC)*Risks(IC)$asBias
-                else
-                    asBias <- neighborRadius(IC)*Risks(IC)$asBias$value
-            }else{
-                if(is(IC, "HampIC")){
-                    r <- neighborRadius(IC)
-                    asBias <- r*getRiskIC(IC, risk = asBias(), neighbor = neighbor(IC))$asBias$value
-                }else{
-                    asBias <- NULL
-                }
-            }
-        }else{
-            Infos <- matrix(c("oneStepEstimator", "1-step estimate"), ncol = 2)
-            colnames(Infos) <- c("method", "message")
-            asVar <- NULL
-            asBias <- NULL
-        }
-
-        new("kStepEstimate", name = "1-step estimate", estimate = res, 
-            estimate.call = es.call, samplesize = ncol(x), asvar = asVar, 
-            asbias = asBias, pIC = IC, steps = 1L, Infos = Infos)
-    })
-setMethod("oneStepEstimator", signature(x = "numeric", 
-                                        IC = "InfluenceCurve",
-                                        start = "Estimate"),
-    function(x, IC, start, useLast = getRobAStBaseOption("kStepUseLast")){
-        es.call <- match.call()
-        es.call[[1]] <- as.name("oneStepEstimator")
-        nrvalues <- dimension(IC at Curve)
-        start0 <- estimate(start)
         if(is.list(start0)) start0 <- unlist(start0)
         if(nrvalues != length(start0))
             stop("dimension of slot 'estimate' of 'start' != dimension of 'Curve'")
@@ -168,7 +32,7 @@
                 newL2Fam <- modifyModel(L2Fam, newParam)
                 IC <- modifyIC(IC)(newL2Fam, IC)
                 Infos <- rbind(Infos, c("oneStepEstimator", 
-                                        "computation of IC, asvar and asbias via useLast = TRUE"))
+                                        "computation of IC, asVar and asBias via useLast = TRUE"))
             }else{
                 if(useLast && is(modifyIC(IC), "NULL")){
                     warning("'useLast = TRUE' only possible if slot 'modifyIC' of 'IC' 
@@ -177,7 +41,7 @@
                                             "slot 'modifyIC' of 'IC' was not filled!"))
                 }
                 Infos <- rbind(Infos, c("oneStepEstimator", 
-                                        "computation of IC, asvar and asbias via useLast = FALSE"))
+                                        "computation of IC, asVar and asBias via useLast = FALSE"))
             }
             if("asCov" %in% names(Risks(IC)))
                 if(is.matrix(Risks(IC)$asCov) || length(Risks(IC)$asCov) == 1)
@@ -213,12 +77,16 @@
     })
 setMethod("oneStepEstimator", signature(x = "matrix", 
                                         IC = "InfluenceCurve",
-                                        start = "Estimate"),
+                                        start = "ANY"),
     function(x, IC, start, useLast = getRobAStBaseOption("kStepUseLast")){
         es.call <- match.call()
         es.call[[1]] <- as.name("oneStepEstimator")
         nrvalues <- dimension(IC at Curve)
-        start0 <- estimate(start)
+        if(is(start, "Estimate")){ 
+            start0 <- estimate(start)
+        }else{
+            start0 <- start
+        }
         if(is.list(start0)) start0 <- unlist(start0)
         if(nrvalues != length(start0))
             stop("dimension of slot 'estimate' of 'start' != dimension of 'Curve'")
@@ -240,7 +108,7 @@
                 newL2Fam <- modifyModel(L2Fam, newParam)
                 IC <- modifyIC(IC)(newL2Fam, IC)
                 Infos <- rbind(Infos, c("oneStepEstimator", 
-                                        "computation of IC, asvar and asbias via useLast = TRUE"))
+                                        "computation of IC, asVar and asBias via useLast = TRUE"))
             }else{
                 if(useLast && is(modifyIC(IC), "NULL")){
                     warning("'useLast = TRUE' only possible if slot 'modifyIC' of 'IC'
@@ -249,7 +117,7 @@
                                             "slot 'modifyIC' of 'IC' was not filled!"))
                 }
                 Infos <- rbind(Infos, c("oneStepEstimator", 
-                                        "computation of IC, asvar and asbias via useLast = FALSE"))
+                                        "computation of IC, asVar and asBias via useLast = FALSE"))
             }
             if("asCov" %in% names(Risks(IC)))
                 if(is.matrix(Risks(IC)$asCov) || length(Risks(IC)$asCov) == 1)

Modified: branches/robast-0.7/pkg/RobAStBase/man/0RobAStBase-package.Rd
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/man/0RobAStBase-package.Rd	2009-07-15 09:16:25 UTC (rev 322)
+++ branches/robast-0.7/pkg/RobAStBase/man/0RobAStBase-package.Rd	2009-07-15 10:06:41 UTC (rev 323)
@@ -12,7 +12,7 @@
 \tabular{ll}{
 Package: \tab RobAStBase\cr
 Version: \tab 0.7 \cr
-Date: \tab 2009-04-14 \cr
+Date: \tab 2009-07-17 \cr
 Depends: \tab R(>= 2.7.0), methods, distr(>= 2.0), distrEx(>= 2.0),
 distrMod(>= 2.0), RandVar(>= 0.6.3)\cr
 LazyLoad: \tab yes\cr

Modified: branches/robast-0.7/pkg/RobAStBase/man/oneStepEstimator.Rd
===================================================================
--- branches/robast-0.7/pkg/RobAStBase/man/oneStepEstimator.Rd	2009-07-15 09:16:25 UTC (rev 322)
+++ branches/robast-0.7/pkg/RobAStBase/man/oneStepEstimator.Rd	2009-07-15 10:06:41 UTC (rev 323)
@@ -1,10 +1,10 @@
 \name{oneStepEstimator}
 \alias{oneStepEstimator}
 \alias{oneStepEstimator-methods}
-\alias{oneStepEstimator,numeric,InfluenceCurve,numeric-method}
-\alias{oneStepEstimator,matrix,InfluenceCurve,numeric-method}
-\alias{oneStepEstimator,numeric,InfluenceCurve,Estimate-method}
-\alias{oneStepEstimator,matrix,InfluenceCurve,Estimate-method}
+\alias{oneStepEstimator,numeric,InfluenceCurve-method}
+\alias{oneStepEstimator,matrix,InfluenceCurve-method}
+\alias{oneStepEstimator,numeric,InfluenceCurve,ANY-method}
+\alias{oneStepEstimator,matrix,InfluenceCurve,ANY-method}
 
 \title{Generic function for the computation of one-step estimates}
 \description{
@@ -13,14 +13,10 @@
 \usage{
 oneStepEstimator(x, IC, start, ...)
 
-\S4method{oneStepEstimator}{numeric,InfluenceCurve,numeric}(x, IC, start, 
+\S4method{oneStepEstimator}{numeric,InfluenceCurve,ANY}(x, IC, start, 
     useLast = getRobAStBaseOption("kStepUseLast"))
-\S4method{oneStepEstimator}{matrix,InfluenceCurve,numeric}(x, IC, start, 
+\S4method{oneStepEstimator}{matrix,InfluenceCurve,ANY}(x, IC, start, 
     useLast = getRobAStBaseOption("kStepUseLast"))
-\S4method{oneStepEstimator}{numeric,InfluenceCurve,Estimate}(x, IC, start, 
-    useLast = getRobAStBaseOption("kStepUseLast"))
-\S4method{oneStepEstimator}{matrix,InfluenceCurve,Estimate}(x, IC, start, 
-    useLast = getRobAStBaseOption("kStepUseLast"))
 }
 \arguments{
   \item{x}{ sample }
@@ -61,14 +57,10 @@
 \value{Object of class \code{"kStepEstimate"}}
 \section{Methods}{
 \describe{
-  \item{x = "numeric", IC = "InfluenceCurve", start = "numeric"}{ 
+  \item{x = "numeric", IC = "InfluenceCurve", start = "ANY"}{ 
     univariate samples. }
-  \item{x = "matrix", IC = "InfluenceCurve", start = "numeric"}{ 
+  \item{x = "matrix", IC = "InfluenceCurve", start = "ANY"}{ 
     multivariate samples. }
-  \item{x = "matrix", IC = "InfluenceCurve", start = "Estimate"}{ 
-    multivariate samples. }
-  \item{x = "matrix", IC = "InfluenceCurve", start = "Estimate"}{ 
-    multivariate samples. }
 }}
 \references{
   Rieder, H. (1994) \emph{Robust Asymptotic Statistics}. New York: Springer.



More information about the Robast-commits mailing list