[Distr-commits] r363 - in branches/distr-2.1/pkg/distr: R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat Nov 29 05:34:23 CET 2008
Author: ruckdeschel
Date: 2008-11-29 05:34:23 +0100 (Sat, 29 Nov 2008)
New Revision: 363
Modified:
branches/distr-2.1/pkg/distr/R/internalUtils.R
branches/distr-2.1/pkg/distr/R/plot-methods.R
branches/distr-2.1/pkg/distr/R/plot-methods_LebDec.R
branches/distr-2.1/pkg/distr/man/internals.Rd
branches/distr-2.1/pkg/distr/man/plot-methods.Rd
Log:
fixed some buglets in plot for distr (only in branch)
Modified: branches/distr-2.1/pkg/distr/R/internalUtils.R
===================================================================
--- branches/distr-2.1/pkg/distr/R/internalUtils.R 2008-11-29 01:46:20 UTC (rev 362)
+++ branches/distr-2.1/pkg/distr/R/internalUtils.R 2008-11-29 04:34:23 UTC (rev 363)
@@ -973,3 +973,20 @@
}
return(list(msgA=c(msgA1,msgA2), msgS = c(msgS1,msgS2)))
}
+
+#------------------------------------------------------------------------------
+# fill a list acc. recycling rules
+#------------------------------------------------------------------------------
+.fillList <- function(list0, len = length(list0)){
+ if(len == length(list0))
+ return(list0)
+ i <- 0
+ ll0 <- length(list0)
+ li0 <- vector("list",len)
+ while(i < len){
+ j <- 1 + ( i %% ll0)
+ i <- i + 1
+ li0[[i]] <- list0[[j]]
+ }
+ return(li0)
+}
Modified: branches/distr-2.1/pkg/distr/R/plot-methods.R
===================================================================
--- branches/distr-2.1/pkg/distr/R/plot-methods.R 2008-11-29 01:46:20 UTC (rev 362)
+++ branches/distr-2.1/pkg/distr/R/plot-methods.R 2008-11-29 04:34:23 UTC (rev 363)
@@ -16,6 +16,8 @@
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
+ dots$col.hor <- NULL
+
dots.for.points <- dots[names(dots) %in% c("bg", "lwd", "lty")]
if (length(dots.for.points) == 0 ) dots.for.points <- NULL
@@ -24,9 +26,10 @@
x <- .ULC.cast(x)
###
if(!is.logical(inner))
- if(!is.list(inner)||length(inner) != 3)
- stop("Argument 'inner' must either be 'logical' or a 'list' vector of length 3")
-
+ {if(!is.list(inner))
+ stop("Argument 'inner' must either be 'logical' or a 'list'")
+ else inner <- .fillList(inner,3)
+ }
cex <- if (hasArg(cex)) dots$cex else 1
if (hasArg(cex) && missing(cex.points))
@@ -277,6 +280,7 @@
### manipulating the ... - argument
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
+ dots$ngrid <- NULL
dots.for.points <- dots[names(dots) %in% c("bg", "lwd", "lty")]
if (length(dots.for.points) == 0 ) dots.for.points <- NULL
@@ -288,8 +292,10 @@
x <- .ULC.cast(x)
if(!is.logical(inner))
- if(!is.list(inner)||length(inner) != 3)
- stop("Argument 'inner' must either be 'logical' or a 'list' vector of length 3")
+ {if(!is.list(inner))
+ stop("Argument 'inner' must either be 'logical' or a 'list'")
+ else inner <- .fillList(inner,3)
+ }
cex <- if (hasArg(cex)) dots$cex else 1
@@ -533,7 +539,7 @@
if (subL)
mtext(text = sub, side = 1, cex = cex.sub, adj = .5,
outer = TRUE, line = -1.6, col = col.sub)
- return(invisible())
+ return(invisible())
}
)
@@ -545,4 +551,5 @@
devNew()
plot(x[[i]],...)
}
+ return(invisible())
})
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-29 01:46:20 UTC (rev 362)
+++ branches/distr-2.1/pkg/distr/R/plot-methods_LebDec.R 2008-11-29 04:34:23 UTC (rev 363)
@@ -32,7 +32,6 @@
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 = TRUE)[-1]
xc <- mc$x
### manipulating the ... - argument
@@ -45,35 +44,64 @@
y = "missing"))
if(!is(x, "UnivarLebDecDistribution"))
- x <- .ULC.cast(x)
+ x <- .ULC.cast(x)
if(is(x,"DiscreteDistribution")){
- do.call(plotD, as.list(mc))
+ mcl <- as.list(mc)
+ mcl$ngrid <- NULL
+ if(!is.logical(inner)){
+ if(length(inner)!=3)
+ {inner <- .fillList(inner, 8)
+ mcl$inner <- inner[6:8]}
+ }
+ do.call(plotD, mcl)
return(invisible())
}
if(is(x,"AbscontDistribution")){
- do.call(plotC, as.list(mc))
+ mcl <- as.list(mc)
+ mcl$col.hor <- NULL
+ if(!is.logical(inner)){
+ if(length(inner)!=3)
+ {inner <- .fillList(inner, 8)
+ mcl$inner <- inner[6:8]}
+ }
+ do.call(plotC, as.list(mcl))
return(invisible())
}
if(.isEqual(x at mixCoeff[1],0)){
x <- x at mixDistr[[2]]
- mc$x <- x
- do.call(plotD, as.list(mc))
+ mcl <- as.list(mc)
+ mcl$x <- x
+ mcl$ngrid <- NULL
+ if(!is.logical(inner)){
+ if(length(inner)!=3)
+ {inner <- .fillList(inner, 8)
+ mcl$inner <- inner[6:8]}
+ }
+ do.call(plotD, as.list(mcl))
return(invisible())
}
if(.isEqual(x at mixCoeff[1],1)){
x <- x at mixDistr[[1]]
- mc$x <- x
- do.call(plotC, as.list(mc))
+ mcl <- as.list(mc)
+ mcl$x <- x
+ mcl$col.hor <- NULL
+ if(!is.logical(inner)){
+ if(length(inner)!=3)
+ {inner <- .fillList(inner, 8)
+ mcl$inner <- inner[6:8]}
+ }
+ do.call(plotC, as.list(mcl))
return(invisible())
}
+
dots.for.points <- dots[names(dots) %in% c("bg", "lwd", "lty","ngrid")]
if (length(dots.for.points) == 0 ) dots.for.points <- NULL
@@ -85,9 +113,10 @@
dots.v$col <- NULL
###
if(!is.logical(inner))
- if(!is.list(inner)||length(inner) != 2)
- stop("Argument 'inner' must either be 'logical' or a 'list' vector of length 2")
-
+ {if(!is.list(inner))
+ stop("Argument 'inner' must either be 'logical' or a 'list'")
+ else inner <- .fillList(inner,8)
+ }
cex <- if (hasArg(cex)) dots$cex else 1
if (hasArg(cex) && missing(cex.points))
@@ -351,7 +380,11 @@
outer = TRUE, line = -1.6, col = col.sub)
mc.ac <- mc
- if(!is.logical(inner)) mc.ac$inner <- inner[3:5]
+ if(!is.logical(inner))
+ mc.ac$inner <- lapply(inner[3:5], function(x)
+ if(is.character(x))
+ as.character(eval(.mpresubs(x)))
+ else .mpresubs(x))
mc.ac$mfColRow <- FALSE
mc.ac$main <- FALSE
mc.ac$sub <- FALSE
@@ -361,7 +394,11 @@
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]
+ if(!is.logical(inner))
+ mc.di$inner <- lapply(inner[6:8], function(x)
+ if(is.character(x))
+ as.character(eval(.mpresubs(x)))
+ else .mpresubs(x))
mc.di$mfColRow <- FALSE
mc.di$main <- FALSE
mc.di$sub <- FALSE
@@ -375,7 +412,6 @@
}
)
-
setMethod("plot", signature(x="CompoundDistribution", y = "missing"),
function(x,...) {
mc <- as.list(match.call(call = sys.call(sys.parent(1)),
Modified: branches/distr-2.1/pkg/distr/man/internals.Rd
===================================================================
--- branches/distr-2.1/pkg/distr/man/internals.Rd 2008-11-29 01:46:20 UTC (rev 362)
+++ branches/distr-2.1/pkg/distr/man/internals.Rd 2008-11-29 04:34:23 UTC (rev 363)
@@ -50,6 +50,7 @@
\alias{.csimpsum}
\alias{.primefun}
\alias{.IssueWarn}
+\alias{.fillList}
\alias{devNew}
\title{Internal functions of package distr}
@@ -114,6 +115,7 @@
.csimpsum(fx)
.primefun(f,x, nm = NULL)
.IssueWarn(Arith,Sim)
+.fillList(list0, len=length(list0))
devNew(...)
}
@@ -206,6 +208,9 @@
or logically-``any'' of these slots in a collection of such objects}
\item{Sim}{logical; slot \code{.withSim} of a distribution object,
or logically-``any'' of these slots in a collection of such objects}
+ \item{list0}{list, the elements of which are to be copied to a new list using
+ recycling if necessary}
+ \item{len}{length of the list to be filled}
\item{...}{arguments passed through to other functions}
}
@@ -328,6 +333,9 @@
of \code{cumsum}. \code{.primefun} is similar but more flexible and
produces the prime function as a function.
+\code{.fillList}{fills a new list with the elements of a given list \code{list0}
+ until length \code{len} is reached using recycling if necessary.}
+
\code{devNew} opens a new device. This function is for back compatibility
with R versions < 2.8.0.
}
@@ -384,6 +392,7 @@
\code{.csimpsum}{a vector of evaluations of the prime function at the grid points}
\code{.primefun}{the prime function as a function}
\code{.IssueWarn}{a list with two warnings to be issued each of which may be empty}
+\code{.fillList}{a list}
\code{devNew}{returns the return value of the device opened, usually invisible 'NULL'}
}
Modified: branches/distr-2.1/pkg/distr/man/plot-methods.Rd
===================================================================
--- branches/distr-2.1/pkg/distr/man/plot-methods.Rd 2008-11-29 01:46:20 UTC (rev 362)
+++ branches/distr-2.1/pkg/distr/man/plot-methods.Rd 2008-11-29 04:34:23 UTC (rev 363)
@@ -67,7 +67,10 @@
just as argument \code{main} in \code{\link{plot.default}}.}
\item{inner}{logical: panels for density/probability function -
cdf - quantile function have their own titles? or \cr
- list of length 3: titles for density/probability function -
+ list which is filled to length 3 (resp. 8 for class
+ \code{UnivarLebDecDistribution}) if necessary
+ (possibly using recycling rules): titles for
+ density/probability function -
cdf - quantile function (each of the same form as argument
\code{main} in \code{\link{plot.default}})}
\item{sub}{logical: is a sub-title to be used? or \cr
More information about the Distr-commits
mailing list