[Distr-commits] r304 - branches/distr-2.1/pkg/distrMod/R pkg/distrMod/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Oct 10 22:32:05 CEST 2008
Author: ruckdeschel
Date: 2008-10-10 22:32:05 +0200 (Fri, 10 Oct 2008)
New Revision: 304
Modified:
branches/distr-2.1/pkg/distrMod/R/AllPlot.R
pkg/distrMod/R/AllPlot.R
Log:
plot-L2ParamFamily now also digests ... , in particular grid()
Modified: branches/distr-2.1/pkg/distrMod/R/AllPlot.R
===================================================================
--- branches/distr-2.1/pkg/distrMod/R/AllPlot.R 2008-10-10 20:12:55 UTC (rev 303)
+++ branches/distr-2.1/pkg/distrMod/R/AllPlot.R 2008-10-10 20:32:05 UTC (rev 304)
@@ -8,10 +8,14 @@
})
setMethod("plot", "L2ParamFamily",
function(x,y=NULL,...){
+
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
+
e1 <- x at distribution
if(!is(e1, "UnivariateDistribution")) stop("not yet implemented")
- plot(e1)
+ do.call(plot, c(list(e1),dots))
if(is(e1, "AbscontDistribution")){
lower <- ifelse(is.finite(q(e1)(0)), q(e1)(0), q(e1)(getdistrOption("TruncQuantile")))
@@ -33,6 +37,11 @@
}
}
+ dots["lty"] <- NULL
+ dots["type"] <- NULL
+ dots["xlab"] <- NULL
+ dots["ylab"] <- NULL
+
dims <- length(x at param)
L2deriv <- as(diag(dims) %*% x at L2deriv, "EuclRandVariable")
@@ -43,21 +52,28 @@
nrows <- trunc(sqrt(dims))
ncols <- ceiling(dims/nrows)
par(mfrow = c(nrows, ncols))
+
+ if(is.null(dots[["cex.main"]])) dots[["cex.main"]] <- 0.8
+
for(i in 1:dims){
- plot(x.vec, sapply(x.vec, L2deriv at Map[[i]]), type = plty, lty = lty,
- xlab = "x", ylab = expression(paste(L[2], " derivative")))
+ do.call(plot, args=c(list(x=x.vec, y=sapply(x.vec, L2deriv at Map[[i]]),
+ type = plty, lty = lty,
+ xlab = "x",
+ ylab = expression(paste(L[2], " derivative"))),
+ dots))
if(is(e1, "DiscreteDistribution")){
x.vec1 <- seq(from = min(x.vec), to = max(x.vec), length = 1000)
lines(x.vec1, sapply(x.vec1, L2deriv at Map[[i]]), lty = "dotted")
}
if(is.null(x at param@nuisance))
- title(paste("Component", i, "of L_2 derivative\nof", name(x)[1],
- "\nwith main parameter (", paste(round(x at param@main, 3), collapse = ", "), ")"), cex.main = 0.8)
+ do.call(title, args = c(list(paste("Component", i, "of L_2 derivative\nof", name(x)[1],
+ "\nwith main parameter (", paste(round(x at param@main, 3), collapse = ", "), ")")),
+ dots))
else
- title(paste("Component", i, "of L_2 derivative of", name(x)[1],
+ do.call(title, args = c(list(paste("Component", i, "of L_2 derivative of", name(x)[1],
"\nwith main parameter (", paste(round(x at param@main, 3), collapse = ", "),
- ")\nand nuisance parameter (", paste(round(x at param@nuisance, 3), collapse = ", "), ")"),
- cex.main = 0.8)
+ ")\nand nuisance parameter (", paste(round(x at param@nuisance, 3), collapse = ", "), ")")),
+ dots))
}
par(opar)
options(w0)
Modified: pkg/distrMod/R/AllPlot.R
===================================================================
--- pkg/distrMod/R/AllPlot.R 2008-10-10 20:12:55 UTC (rev 303)
+++ pkg/distrMod/R/AllPlot.R 2008-10-10 20:32:05 UTC (rev 304)
@@ -8,10 +8,14 @@
})
setMethod("plot", "L2ParamFamily",
function(x,y=NULL,...){
+
+ dots <- match.call(call = sys.call(sys.parent(1)),
+ expand.dots = FALSE)$"..."
+
e1 <- x at distribution
if(!is(e1, "UnivariateDistribution")) stop("not yet implemented")
- plot(e1)
+ do.call(plot, c(list(e1),dots))
if(is(e1, "AbscontDistribution")){
lower <- ifelse(is.finite(q(e1)(0)), q(e1)(0), q(e1)(getdistrOption("TruncQuantile")))
@@ -33,6 +37,11 @@
}
}
+ dots["lty"] <- NULL
+ dots["type"] <- NULL
+ dots["xlab"] <- NULL
+ dots["ylab"] <- NULL
+
dims <- length(x at param)
L2deriv <- as(diag(dims) %*% x at L2deriv, "EuclRandVariable")
@@ -43,21 +52,28 @@
nrows <- trunc(sqrt(dims))
ncols <- ceiling(dims/nrows)
par(mfrow = c(nrows, ncols))
+
+ if(is.null(dots[["cex.main"]])) dots[["cex.main"]] <- 0.8
+
for(i in 1:dims){
- plot(x.vec, sapply(x.vec, L2deriv at Map[[i]]), type = plty, lty = lty,
- xlab = "x", ylab = expression(paste(L[2], " derivative")))
+ do.call(plot, args=c(list(x=x.vec, y=sapply(x.vec, L2deriv at Map[[i]]),
+ type = plty, lty = lty,
+ xlab = "x",
+ ylab = expression(paste(L[2], " derivative"))),
+ dots))
if(is(e1, "DiscreteDistribution")){
x.vec1 <- seq(from = min(x.vec), to = max(x.vec), length = 1000)
lines(x.vec1, sapply(x.vec1, L2deriv at Map[[i]]), lty = "dotted")
}
if(is.null(x at param@nuisance))
- title(paste("Component", i, "of L_2 derivative\nof", name(x)[1],
- "\nwith main parameter (", paste(round(x at param@main, 3), collapse = ", "), ")"), cex.main = 0.8)
+ do.call(title, args = c(list(paste("Component", i, "of L_2 derivative\nof", name(x)[1],
+ "\nwith main parameter (", paste(round(x at param@main, 3), collapse = ", "), ")")),
+ dots))
else
- title(paste("Component", i, "of L_2 derivative of", name(x)[1],
+ do.call(title, args = c(list(paste("Component", i, "of L_2 derivative of", name(x)[1],
"\nwith main parameter (", paste(round(x at param@main, 3), collapse = ", "),
- ")\nand nuisance parameter (", paste(round(x at param@nuisance, 3), collapse = ", "), ")"),
- cex.main = 0.8)
+ ")\nand nuisance parameter (", paste(round(x at param@nuisance, 3), collapse = ", "), ")")),
+ dots))
}
par(opar)
options(w0)
More information about the Distr-commits
mailing list