[Robast-commits] r856 - branches/robast-1.0/pkg/RobAStBase/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Nov 7 11:26:24 CET 2015
Author: ruckdeschel
Date: 2015-11-07 11:26:23 +0100 (Sat, 07 Nov 2015)
New Revision: 856
Modified:
branches/robast-1.0/pkg/RobAStBase/R/bALEstimate.R
Log:
RobAStBase: in bALEstimate.R : format.perc -> stats:::format.perc
Modified: branches/robast-1.0/pkg/RobAStBase/R/bALEstimate.R
===================================================================
--- branches/robast-1.0/pkg/RobAStBase/R/bALEstimate.R 2015-11-06 11:24:07 UTC (rev 855)
+++ branches/robast-1.0/pkg/RobAStBase/R/bALEstimate.R 2015-11-07 10:26:23 UTC (rev 856)
@@ -1,163 +1,163 @@
-###############################################################################
-## Functions and methods for "ALEstimate" classes and subclasses
-###############################################################################
-
-setMethod("pIC", "ALEstimate", function(object) object at pIC)
-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(as.matrix(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 <- .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(as.matrix(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 <- .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 = c(
- gettext("asymptotic (LAN-based), uniform (bias-aware)\n"),
- gettextf("for %s", name(method))
- ),
- 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(as.matrix(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 <- .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 = c(
- gettext("asymptotic (LAN-based), uniform (bias-aware)\n"),
- gettextf("for %s", name(method))
- ),
- 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="asymmetricBias"),
- 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(as.matrix(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 <- .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
-
- nuround <- round(nu,3)
- new("Confint", type = c(
- gettext("asymptotic (LAN-based), uniform (bias-aware)\n"),
- gettextf("for %s with nu =(%f,%f)",
- name(method), nuround[1], nuround[2])
- ),
- 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)
-})
+###############################################################################
+## Functions and methods for "ALEstimate" classes and subclasses
+###############################################################################
+
+setMethod("pIC", "ALEstimate", function(object) object at pIC)
+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(as.matrix(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 <- .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(as.matrix(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 <- .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 = c(
+ gettext("asymptotic (LAN-based), uniform (bias-aware)\n"),
+ gettextf("for %s", name(method))
+ ),
+ 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(as.matrix(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 <- .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 = c(
+ gettext("asymptotic (LAN-based), uniform (bias-aware)\n"),
+ gettextf("for %s", name(method))
+ ),
+ 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="asymmetricBias"),
+ 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(as.matrix(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 <- .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
+
+ nuround <- round(nu,3)
+ new("Confint", type = c(
+ gettext("asymptotic (LAN-based), uniform (bias-aware)\n"),
+ gettextf("for %s with nu =(%f,%f)",
+ name(method), nuround[1], nuround[2])
+ ),
+ 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)
+})
More information about the Robast-commits
mailing list