[Distr-commits] r362 - branches/distr-2.1/pkg/distr/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Nov 29 02:46:20 CET 2008
Author: ruckdeschel
Date: 2008-11-29 02:46:20 +0100 (Sat, 29 Nov 2008)
New Revision: 362
Modified:
branches/distr-2.1/pkg/distr/R/AllClasses.R
branches/distr-2.1/pkg/distr/R/ExtraConvolutionMethods.R
branches/distr-2.1/pkg/distr/R/UnivarMixingDistribution.R
branches/distr-2.1/pkg/distr/R/plot-methods.R
branches/distr-2.1/pkg/distr/R/plot-methods_LebDec.R
Log:
+fixed some errors in plotting LCD and CompoundDistribution(and enhanced automatic axis labels by some tricky castings...)
+UnivarMixingDistribution was too strict with sum mixCoeff == 1
+deleted some erroneous prints left over from debugging in ExtraConvolutionMethods.R
Modified: branches/distr-2.1/pkg/distr/R/AllClasses.R
===================================================================
--- branches/distr-2.1/pkg/distr/R/AllClasses.R 2008-11-28 22:35:30 UTC (rev 361)
+++ branches/distr-2.1/pkg/distr/R/AllClasses.R 2008-11-29 01:46:20 UTC (rev 362)
@@ -945,7 +945,8 @@
prototype = prototype(mixCoeff = 1, mixDistr = new("UnivarDistrList")),
contains = "UnivariateDistribution",
validity = function(object){
- if(any(object at mixCoeff<0) || sum(object at mixCoeff)>1)
+ if(any(object at mixCoeff< -.Machine$double.eps) ||
+ sum(object at mixCoeff)>1+.Machine$double.eps)
stop("mixing coefficients are no probabilities")
return(TRUE)
})
Modified: branches/distr-2.1/pkg/distr/R/ExtraConvolutionMethods.R
===================================================================
--- branches/distr-2.1/pkg/distr/R/ExtraConvolutionMethods.R 2008-11-28 22:35:30 UTC (rev 361)
+++ branches/distr-2.1/pkg/distr/R/ExtraConvolutionMethods.R 2008-11-29 01:46:20 UTC (rev 362)
@@ -140,8 +140,6 @@
setMethod("+", c("numeric", "LatticeDistribution"),
function(e1, e2){
- print(class(e1))
- print(class(e2))
e2 + e1
})
Modified: branches/distr-2.1/pkg/distr/R/UnivarMixingDistribution.R
===================================================================
--- branches/distr-2.1/pkg/distr/R/UnivarMixingDistribution.R 2008-11-28 22:35:30 UTC (rev 361)
+++ branches/distr-2.1/pkg/distr/R/UnivarMixingDistribution.R 2008-11-29 01:46:20 UTC (rev 362)
@@ -3,11 +3,12 @@
{
ldots <- list(...)
l <- length(ldots)
+ ep <- .Machine$double.eps
if(missing(mixCoeff))
mixCoeff <- rep(1,l)/l
else{ if (l!=length(mixCoeff))
stop("argument 'mixCoeff' and the mixing distributions must have the same length")
- if(any(mixCoeff < 0) || sum(mixCoeff)>1)
+ if(any(mixCoeff < -ep) || sum(mixCoeff)>1+ep)
stop("mixing coefficients are no probabilities")
}
mixDistr <- new("UnivarDistrList", ldots)
Modified: branches/distr-2.1/pkg/distr/R/plot-methods.R
===================================================================
--- branches/distr-2.1/pkg/distr/R/plot-methods.R 2008-11-28 22:35:30 UTC (rev 361)
+++ branches/distr-2.1/pkg/distr/R/plot-methods.R 2008-11-29 01:46:20 UTC (rev 362)
@@ -20,7 +20,8 @@
if (length(dots.for.points) == 0 ) dots.for.points <- NULL
dots.without.pch <- dots[! (names(dots) %in% c("pch", "log"))]
-
+ if(!is(x,"AbscontDistribution"))
+ x <- .ULC.cast(x)
###
if(!is.logical(inner))
if(!is.list(inner)||length(inner) != 3)
@@ -235,7 +236,7 @@
xu <- c(gaps(x)[,1],gaps(x)[,2],rep(NA,ndots))
o <- order(pu)
dots.without.pch0 <- dots.without.pch
- dots.without.pch0 $col <- NULL
+ dots.without.pch0$col <- NULL
do.call(lines, c(list(pu[o], xu[o],
col = col.vert), dots.without.pch0))
}
@@ -255,6 +256,7 @@
if (subL)
mtext(text = sub, side = 1, cex = cex.sub, adj = .5,
outer = TRUE, line = -1.6, col = col.sub)
+ return(invisible())
}
)
# -------- DiscreteDistribution -------- #
@@ -282,6 +284,8 @@
dots.without.pch <- dots[! (names(dots) %in% c("pch",
"main", "sub", "log"))]
###
+ if(!is(x,"DiscreteDistribution"))
+ x <- .ULC.cast(x)
if(!is.logical(inner))
if(!is.list(inner)||length(inner) != 3)
@@ -529,6 +533,7 @@
if (subL)
mtext(text = sub, side = 1, cex = cex.sub, adj = .5,
outer = TRUE, line = -1.6, col = col.sub)
+ return(invisible())
}
)
@@ -537,7 +542,7 @@
setMethod("plot", signature(x = "DistrList", y = "missing"),
function(x, ...){
for(i in 1:length(x)){
- #devNew()
+ devNew()
plot(x[[i]],...)
}
})
Modified: branches/distr-2.1/pkg/distr/R/plot-methods_LebDec.R
===================================================================
--- branches/distr-2.1/pkg/distr/R/plot-methods_LebDec.R 2008-11-28 22:35:30 UTC (rev 361)
+++ branches/distr-2.1/pkg/distr/R/plot-methods_LebDec.R 2008-11-29 01:46:20 UTC (rev 362)
@@ -13,12 +13,9 @@
col.sub = par("col.sub"), cex.points = 2.0,
pch.u = 21, pch.a = 16, mfColRow = TRUE){
- mc <- match.call(call = sys.call(sys.parent(1)), expand.dots = FALSE)[-1]
- mc$x <- NULL
- x <- as(x,"UnivarLebDecDistribution")
- mc <- c(list(x=x), mc)
+ mc <- as.list(match.call(call = sys.call(sys.parent(1)), expand.dots = TRUE)[-1])
do.call(getMethod("plot",
- signature(x="UnivarLebDecDistribution",y="missing")), mc)
+ signature(x="UnivarLebDecDistribution",y="missing")), args = mc)
return(invisible())
})
@@ -35,39 +32,57 @@
col.sub = par("col.sub"), cex.points = 2.0,
pch.u = 21, pch.a = 16, mfColRow = TRUE){
-
- mc <- match.call(call = sys.call(sys.parent(1)), expand.dots = FALSE)[-1]
+
+ mc <- match.call(call = sys.call(sys.parent(1)), expand.dots = TRUE)[-1]
xc <- mc$x
### manipulating the ... - argument
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
- if(x at mixCoeff[1]==0){
- mc$x <- NULL
+ plotD <- getMethod("plot", signature(x = "DiscreteDistribution",
+ y = "missing"))
+ plotC <- getMethod("plot", signature(x = "AbscontDistribution",
+ y = "missing"))
+
+ if(!is(x, "UnivarLebDecDistribution"))
+ x <- .ULC.cast(x)
+
+ if(is(x,"DiscreteDistribution")){
+ do.call(plotD, as.list(mc))
+ return(invisible())
+ }
+
+ if(is(x,"AbscontDistribution")){
+ do.call(plotC, as.list(mc))
+ return(invisible())
+ }
+
+
+ if(.isEqual(x at mixCoeff[1],0)){
x <- x at mixDistr[[2]]
- mc <- c(list(x=x), mc)
- do.call(getMethod("plot",signature(x = "DiscreteDistribution",
- y = "missing")), mc)
+ mc$x <- x
+ do.call(plotD, as.list(mc))
return(invisible())
}
- if(x at mixCoeff[1]==1){
- mc$x <- NULL
+ if(.isEqual(x at mixCoeff[1],1)){
x <- x at mixDistr[[1]]
- mc <- c(list(x=x), mc)
- do.call(getMethod("plot",signature(x = "AbscontDistribution",
- y = "missing")), mc)
+ mc$x <- x
+ do.call(plotC, as.list(mc))
return(invisible())
}
- dots.for.points <- dots[names(dots) %in% c("bg", "lwd", "lty")]
+ dots.for.points <- dots[names(dots) %in% c("bg", "lwd", "lty","ngrid")]
if (length(dots.for.points) == 0 ) dots.for.points <- NULL
dots.without.pch <- dots[! (names(dots) %in% c("pch",
"main", "sub", "log"))]
-
+ dots.for.lines <- dots.without.pch[! (names(dots.without.pch) %in% c("panel.first",
+ "panel.last", "ngrid", "frame.plot"))]
+ dots.v <- dots.for.lines
+ dots.v$col <- NULL
###
if(!is.logical(inner))
if(!is.list(inner)||length(inner) != 2)
@@ -244,7 +259,7 @@
}
if(verticals){
do.call(lines, c(list(x = xv, y = pxv, col = col.vert),
- dots.without.pch))
+ dots.v))
}
title(main = inner.p, line = lineT, cex.main = cex.inner,
@@ -288,7 +303,7 @@
options(warn = -1)
do.call(plot, c(list(x = po, xo, type = "n",
xlim = ylim, ylim = xlim, ylab = "q(p)", xlab = "p",
- log = logq), dots.without.pch))
+ log = logq), dots.without.pch), envir = parent.frame(2))
options(warn = o.warn)
@@ -296,7 +311,7 @@
col.main = col.inner)
options(warn = -1)
- lines(po,xo, ...)
+ do.call(lines, c(list(x=po, y=xo), dots.for.lines))
# if (verticals && !is.null(gaps(x))){
# do.call(lines, c(list(rep(pu1,2), c(gaps(x)[,1],gaps(x)[,2]),
# col = col.vert), dots.without.pch))
@@ -309,7 +324,7 @@
xu <- c(gaps(x)[,1],gaps(x)[,2],rep(NA,ndots))
o <- order(pu)
do.call(lines, c(list(pu[o], xu[o],
- col = col.vert), dots.without.pch))
+ col = col.vert), dots.v))
}
if(!is.null(gaps(x)) && do.points){
do.call(points, c(list(x = pu1, y = gaps(x)[,1], pch = pch.a,
@@ -343,7 +358,7 @@
mc.ac$x <- NULL
mc.ac$withSweave <- TRUE
if(is.null(mc.ac$cex.inner)) mc.ac$cex.inner <- 0.9
- do.call(plot, c(list(acPart(x)),mc.ac))
+ do.call(plotC, c(list(acPart(x)),mc.ac), envir = parent.frame(2))
mc.di <- mc
if(!is.logical(inner)) mc.di$inner <- inner[6:8]
@@ -351,14 +366,22 @@
mc.di$main <- FALSE
mc.di$sub <- FALSE
mc.di$x <- NULL
+ mc.di$ngrid <- NULL
mc.di$withSweave <- TRUE
if(is.null(mc.di$cex.inner)) mc.di$cex.inner <- 0.9
- do.call(plot, c(list(discretePart(x)),mc.di))
+ do.call(plotD, c(list(discretePart(x)),mc.di), envir = parent.frame(2))
+ return(invisible())
}
)
setMethod("plot", signature(x="CompoundDistribution", y = "missing"),
- function(x,...) plot(simplifyD(x),...))
+ function(x,...) {
+ mc <- as.list(match.call(call = sys.call(sys.parent(1)),
+ expand.dots = TRUE)[-1])
+ do.call(getMethod("plot",signature(x = "UnivarLebDecDistribution",
+ y = "missing")),args=mc)
+ return(invisible())
+ })
More information about the Distr-commits
mailing list