[Robast-commits] r191 - in pkg/RobAStBase: R man

[noreply at r-forge.r-project.org]

Author: stamats
Date: 2008-10-31 09:39:21 +0100 (Fri, 31 Oct 2008)
New Revision: 191

Modified:
   pkg/RobAStBase/R/bALEstimate.R
   pkg/RobAStBase/man/ALEstimate-class.Rd
Log:
added confidence intervals for ALEstimate class incorporating bias; Peter please check ...

Modified: pkg/RobAStBase/R/bALEstimate.R
===================================================================
--- pkg/RobAStBase/R/bALEstimate.R	2008-10-31 07:50:41 UTC (rev 190)
+++ pkg/RobAStBase/R/bALEstimate.R	2008-10-31 08:39:21 UTC (rev 191)
@@ -6,3 +6,147 @@
 setMethod("asbias", "ALEstimate", function(object) object at asbias)
 setMethod("steps", "kStepEstimate", function(object) object at steps)
 setMethod("Mroot", "MEstimate", function(object) object at Mroot)
+
+setMethod("confint", signature(object="ALEstimate", method="missing"),
+          function(object, method, level = 0.95) {
+    objN <- paste(deparse(substitute(object)),sep="",collapse="")
+
+    if(is.null(object at asvar)){ 
+        cat(gettextf("Slot 'asvar' of object %s has not (yet) been filled.\n", objN))
+        return(NULL) 
+    }
+
+    sd0 <- sqrt(diag(object at asvar)/object at samplesize)
+    names(sd0) <- names(object at estimate)
+
+### code borrowed from confint.default from package stats
+    a <- (1 - level)/2
+    a <- c(a, 1 - a)
+    pct <- stats:::format.perc(a, 3)
+    fac <- qnorm(a)
+    ci <- array(NA, dim = c(length(object at estimate), 2),
+                dimnames = list(names(object at estimate), pct))
+    ci[] <- main(object) + sd0 %o% fac
+### end of borrowed code
+
+    new("Confint", type = gettext("asymptotic (LAN-based)"),
+                   samplesize.estimate = object at samplesize,
+                   call.estimate = object at estimate.call,
+                   name.estimate = object at name,
+                   trafo.estimate = object at trafo,
+                   nuisance.estimate = nuisance(object),
+                   fixed.estimate = fixed(object),
+                   confint = ci)
+})
+
+setMethod("confint", signature(object="ALEstimate", method="symmetricBias"),
+          function(object, method, level = 0.95) {
+    objN <- paste(deparse(substitute(object)),sep="",collapse="")
+
+    if(is.null(object at asvar)){ 
+        cat(gettextf("Slot 'asvar' of object %s has not (yet) been filled.\n", objN))
+        return(NULL) 
+    }
+    if(is.null(object at asbias)){ 
+        cat(gettextf("Slot 'asbias' of object %s has not (yet) been filled.\n", objN))
+        return(confint(object)) 
+    }
+
+    sd0 <- sqrt(diag(object at asvar)/object at samplesize)
+    names(sd0) <- names(object at estimate)
+
+### code borrowed from confint.default from package stats
+    a <- (1 - level)/2
+    a <- c(a, 1 - a)
+    pct <- stats:::format.perc(a, 3)
+    fac <- qnorm(a, mean = c(-object at asbias, object at asbias))
+    ci <- array(NA, dim = c(length(object at estimate), 2),
+                dimnames = list(names(object at estimate), pct))
+    ci[] <- main(object) + sd0 %o% fac
+### end of borrowed code
+
+    new("Confint", type = gettext("asymptotic (LAN-based)"),
+                   samplesize.estimate = object at samplesize,
+                   call.estimate = object at estimate.call,
+                   name.estimate = object at name,
+                   trafo.estimate = object at trafo,
+                   nuisance.estimate = nuisance(object),
+                   fixed.estimate = fixed(object),
+                   confint = ci)
+})
+
+setMethod("confint", signature(object="ALEstimate", method="onesidedBias"),
+          function(object, method, level = 0.95) {
+    objN <- paste(deparse(substitute(object)),sep="",collapse="")
+
+    if(is.null(object at asvar)){ 
+        cat(gettextf("Slot 'asvar' of object %s has not (yet) been filled.\n", objN))
+        return(NULL) 
+    }
+    if(is.null(object at asbias)){ 
+        cat(gettextf("Slot 'asbias' of object %s has not (yet) been filled.\n", objN))
+        return(confint(object)) 
+    }
+
+    sd0 <- sqrt(diag(object at asvar)/object at samplesize)
+    names(sd0) <- names(object at estimate)
+
+### code borrowed from confint.default from package stats
+    a <- (1 - level)/2
+    a <- c(a, 1 - a)
+    pct <- stats:::format.perc(a, 3)
+    if(method at sign == -1)
+        M <- c(-object at asbias, 0)
+    else
+        M <- c(0, object at asbias)
+    fac <- qnorm(a, mean = M)
+    ci <- array(NA, dim = c(length(object at estimate), 2),
+                dimnames = list(names(object at estimate), pct))
+    ci[] <- main(object) + sd0 %o% fac
+### end of borrowed code
+
+    new("Confint", type = gettext("asymptotic (LAN-based)"),
+                   samplesize.estimate = object at samplesize,
+                   call.estimate = object at estimate.call,
+                   name.estimate = object at name,
+                   trafo.estimate = object at trafo,
+                   nuisance.estimate = nuisance(object),
+                   fixed.estimate = fixed(object),
+                   confint = ci)
+})
+
+setMethod("confint", signature(object="ALEstimate", method="symmetricBias"),
+          function(object, method, level = 0.95) {
+    objN <- paste(deparse(substitute(object)),sep="",collapse="")
+
+    if(is.null(object at asvar)){ 
+        cat(gettextf("Slot 'asvar' of object %s has not (yet) been filled.\n", objN))
+        return(NULL) 
+    }
+    if(is.null(object at asbias)){ 
+        cat(gettextf("Slot 'asbias' of object %s has not (yet) been filled.\n", objN))
+        return(confint(object)) 
+    }
+
+    sd0 <- sqrt(diag(object at asvar)/object at samplesize)
+    names(sd0) <- names(object at estimate)
+
+### code borrowed from confint.default from package stats
+    a <- (1 - level)/2
+    a <- c(a, 1 - a)
+    pct <- stats:::format.perc(a, 3)
+    fac <- qnorm(a, mean = c(-object at asbias, object at asbias)*method at nu)
+    ci <- array(NA, dim = c(length(object at estimate), 2),
+                dimnames = list(names(object at estimate), pct))
+    ci[] <- main(object) + sd0 %o% fac
+### end of borrowed code
+
+    new("Confint", type = gettext("asymptotic (LAN-based)"),
+                   samplesize.estimate = object at samplesize,
+                   call.estimate = object at estimate.call,
+                   name.estimate = object at name,
+                   trafo.estimate = object at trafo,
+                   nuisance.estimate = nuisance(object),
+                   fixed.estimate = fixed(object),
+                   confint = ci)
+})

Modified: pkg/RobAStBase/man/ALEstimate-class.Rd
===================================================================
--- pkg/RobAStBase/man/ALEstimate-class.Rd	2008-10-31 07:50:41 UTC (rev 190)
+++ pkg/RobAStBase/man/ALEstimate-class.Rd	2008-10-31 08:39:21 UTC (rev 191)
@@ -6,6 +6,10 @@
 \alias{asbias}
 \alias{asbias,ALEstimate-method}
 \alias{show,ALEstimate-method}
+\alias{confint,ALEstimate,missing-method}
+\alias{confint,ALEstimate,symmetricBias-method}
+\alias{confint,ALEstimate,onesidedBias-method}
+\alias{confint,ALEstimate,asymmetricBias-method}
 
 \title{ALEstimate-class.}
 \description{Class of asymptotically linear estimates.}
@@ -42,6 +46,21 @@
       accessor function for slot \code{pIC}. }
 
     \item{show}{\code{signature(object = "ALEstimate")} }
+
+    \item{confint}{\code{signature(object = "ALEstimate", method = "missing")}: 
+      compute asymptotic (LAN-based) confidence interval neglecting any bias. }
+
+    \item{confint}{\code{signature(object = "ALEstimate", method = "symmetricBias")}: 
+      compute asymptotic (LAN-based) confidence interval incorporating bias
+      symmetrically. }
+
+    \item{confint}{\code{signature(object = "ALEstimate", method = "onesidedBias")}: 
+      compute asymptotic (LAN-based) confidence interval incorporating bias
+      one-sided; i.e., positive or negative, respectively. }
+
+    \item{confint}{\code{signature(object = "ALEstimate", method = "asymmetricBias")}: 
+      compute asymptotic (LAN-based) confidence interval incorporating bias
+      asymmetrically. }
   }
 }
 %\references{}