[Distr-commits] r947 - in pkg/distr: . R inst man tests tests/unitTests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Aug 8 18:34:54 CEST 2014
Author: ruckdeschel
Date: 2014-08-08 18:34:53 +0200 (Fri, 08 Aug 2014)
New Revision: 947
Added:
pkg/distr/inst/unitTests/
pkg/distr/tests/doSvUnit.R
pkg/distr/tests/unitTests/
pkg/distr/tests/unitTests/runit.dontrunMinimum.R
pkg/distr/tests/unitTests/runit.dontrunMinimum.save
pkg/distr/tests/unitTests/runit.dontrunOperatorsMethods.R
pkg/distr/tests/unitTests/runit.dontrunOperatorsMethods.save
pkg/distr/tests/unitTests/runit.dontrunQQPlot.R
pkg/distr/tests/unitTests/runit.dontrunQQPlot1.save
pkg/distr/tests/unitTests/runit.dontrunQQPlot2.save
pkg/distr/tests/unitTests/runit.dontrunQQPlot3.save
Modified:
pkg/distr/DESCRIPTION
pkg/distr/R/internalUtils.R
pkg/distr/R/internalUtils_LCD.R
pkg/distr/R/internals-qqplot.R
pkg/distr/R/qqbounds.R
pkg/distr/R/qqplot.R
pkg/distr/R/setIsRelations.R
pkg/distr/inst/CITATION
pkg/distr/inst/NEWS
pkg/distr/man/DiscreteDistribution-class.Rd
pkg/distr/man/internals-qqplot.Rd
pkg/distr/man/internals.Rd
pkg/distr/man/qqbounds.Rd
pkg/distr/man/qqplot.Rd
Log:
[distr] prepared trunk version 2.5.3 for publishing on CRAN / included new CITATION file
Modified: pkg/distr/DESCRIPTION
===================================================================
--- pkg/distr/DESCRIPTION 2014-07-28 11:09:12 UTC (rev 946)
+++ pkg/distr/DESCRIPTION 2014-08-08 16:34:53 UTC (rev 947)
@@ -1,6 +1,6 @@
Package: distr
-Version: 2.5.2
-Date: 2013-09-12
+Version: 2.5.3
+Date: 2014-08-08
Title: Object oriented implementation of distributions
Description: S4 Classes and Methods for distributions
Authors at R: c(person("Florian", "Camphausen", role=c("aut")),
@@ -10,7 +10,7 @@
person("R Core Team", role = c("ctb", "cph"),
comment="for source file ks.c/ routines 'pKS2' and 'pKolmogorov2x'"))
Depends: R(>= 2.14.0), methods, graphics, startupmsg, sfsmisc, SweaveListingUtils
-Suggests: distrEx
+Suggests: distrEx, svUnit (>= 0.7-11)
Imports: stats
ByteCompile: yes
Encoding: latin1
Modified: pkg/distr/R/internalUtils.R
===================================================================
--- pkg/distr/R/internalUtils.R 2014-07-28 11:09:12 UTC (rev 946)
+++ pkg/distr/R/internalUtils.R 2014-08-08 16:34:53 UTC (rev 947)
@@ -1233,7 +1233,10 @@
#------------------------------------------------------------------------------
# fill a list acc. recycling rules
#------------------------------------------------------------------------------
+.List <- function(list0) if(is.list(list0)) list0 else list(list0)
+
.fillList <- function(list0, len = length(list0)){
+ list0 <- .List(list0)
if(len == length(list0))
return(list0)
i <- 0
Modified: pkg/distr/R/internalUtils_LCD.R
===================================================================
--- pkg/distr/R/internalUtils_LCD.R 2014-07-28 11:09:12 UTC (rev 946)
+++ pkg/distr/R/internalUtils_LCD.R 2014-08-08 16:34:53 UTC (rev 947)
@@ -82,7 +82,7 @@
state2 <- 0
}
}
- erg <- if (jj > 0) gaps.new[1:jj, ] else NULL
+ erg <- if (jj > 0) gaps.new[1:jj, ,drop=FALSE] else NULL
return(.consolidategaps(erg))
}
Modified: pkg/distr/R/internals-qqplot.R
===================================================================
--- pkg/distr/R/internals-qqplot.R 2014-07-28 11:09:12 UTC (rev 946)
+++ pkg/distr/R/internals-qqplot.R 2014-08-08 16:34:53 UTC (rev 947)
@@ -86,18 +86,12 @@
.C("pkolmogorov2x", p = as.double(p0),
as.integer(n), PACKAGE = "stats")$p
}else function(p0,n){
-# .Call(stats:::C_pKolmogorov2x, p0, n) #, PACKAGE = "stats")
-# .C("pkolmogorov2x", p = as.double(p0),
-# as.integer(n))$p
.Call("pKolmogorov2x", p0, n) #, PACKAGE = "stats")
}
.pks2 <- if(getRversion()<"2.16.0") function(x, tol){
.C("pkstwo", as.integer(1),
p = as.double(x), as.double(tol), PACKAGE = "stats")$p
}else function(x, tol){
-# .Call(stats:::C_pKS2, p = x, tol) #, PACKAGE = "stats")
-# .C("pkstwo", as.integer(1),
-# p = as.double(x), as.double(tol))$p
.Call("pKS2", p = x, tol) #, PACKAGE = "stats")
}
@@ -113,23 +107,10 @@
}
res <- uniroot(fct,lower=0,upper=1)$root*sqrt(n)
}else{
+ fct <- function(p0){
### from ks.test from package stats:
- pkstwo <- function(x, tol = 1e-09) {
- #if (is.numeric(x))
- # x <- as.vector(x)
- #else stop("argument 'x' must be numeric")
- #p <- rep(0, length(x))
- #p[is.na(x)] <- NA
- #IND <- which(!is.na(x) & (x > 0))
- #if (length(IND)) {
- .pks2(x,tol) -alpha
- #}
- # return(p)
- }
- ### end of code from package stats
- fct <- function(p0){
- 1 - pkstwo(p0)-alpha }
- res <- uniroot(fct,lower=0,upper=sqrt(n))$root
+ 1 - .pks2(p0,1e-09)-alpha }
+ res <- uniroot(fct,lower=1e-12,upper=sqrt(n))$root
}
return(res)
}
@@ -184,7 +165,7 @@
pq <- log(p.b)+log(1-p.b)
if(is(D,"AbscontDistribution")){
dp <- d(D)(x,log=TRUE)
- dsupp.p <- dsupp.m<-1
+ dsupp.p <- dsupp.m <- 1
}else{ ## have E and sd available ?
if(!.distrExInstalled) stop("")
supp.ind <- sapply(x, function(y)
@@ -205,14 +186,15 @@
-.confqq <- function(x,D, withConf.pw = TRUE, withConf.sim = TRUE, alpha,
+.confqq <- function(x,D, datax = TRUE, withConf.pw = TRUE,
+ withConf.sim = TRUE, alpha,
col.pCI, lty.pCI, lwd.pCI, pch.pCI, cex.pCI,
col.sCI, lty.sCI, lwd.sCI, pch.sCI, cex.sCI,
n,exact.sCI=(n<100),exact.pCI=(n<100), nosym.pCI = FALSE,
with.legend = TRUE, legend.bg = "white",
legend.pos = "topleft", legend.cex = 0.8,
legend.pref = "", legend.postf = "",
- legend.alpha = alpha){
+ legend.alpha = alpha, qqb0=NULL, debug = FALSE){
x <- sort(unique(x))
if("gaps" %in% names(getSlots(class(D))))
@@ -229,36 +211,65 @@
x.d <- x.in[!SI.c]
- qqb <- qqbounds(x,D,alpha,n,withConf.pw, withConf.sim,
- exact.sCI,exact.pCI,nosym.pCI)
+ qqb <- if(is.null(qqb0)) qqbounds(x,D,alpha,n,withConf.pw, withConf.sim,
+ exact.sCI,exact.pCI,nosym.pCI, debug) else qqb0
+
qqb$crit <- qqb$crit[SI.in,]
if(qqb$err["pw"]){
if(sum(SI.c)>0){
- lines(x.c, qqb$crit[SI.c,"pw.right"],
- col=col.pCI,lty=lty.pCI,lwd=lwd.pCI)
- lines(x.c, qqb$crit[SI.c,"pw.left"],
- col=col.pCI,lty=lty.pCI,lwd=lwd.pCI)
+ if(datax){
+ lines(x.c, qqb$crit[SI.c,"pw.right"],
+ col=col.pCI,lty=lty.pCI,lwd=lwd.pCI)
+ lines(x.c, qqb$crit[SI.c,"pw.left"],
+ col=col.pCI,lty=lty.pCI,lwd=lwd.pCI)
+ }else{
+ lines(qqb$crit[SI.c,"pw.right"], x.c,
+ col=col.pCI,lty=lty.pCI,lwd=lwd.pCI)
+ lines(qqb$crit[SI.c,"pw.left"], x.c,
+ col=col.pCI,lty=lty.pCI,lwd=lwd.pCI)
+ }
}
if(sum(!SI.c)>0){
- points(x.d, qqb$crit[!SI.c,"pw.right"],
- col=col.pCI, pch=pch.pCI, cex = cex.pCI)
- points(x.d, qqb$crit[!SI.c,"pw.left"],
- col=col.pCI, pch=pch.pCI, cex = cex.pCI)
+ if(datax){
+ points(x.d, qqb$crit[!SI.c,"pw.right"],
+ col=col.pCI, pch=pch.pCI, cex = cex.pCI)
+ points(x.d, qqb$crit[!SI.c,"pw.left"],
+ col=col.pCI, pch=pch.pCI, cex = cex.pCI)
+ }else{
+ points(qqb$crit[!SI.c,"pw.right"], x.d,
+ col=col.pCI, pch=pch.pCI, cex = cex.pCI)
+ points(qqb$crit[!SI.c,"pw.left"], x.d,
+ col=col.pCI, pch=pch.pCI, cex = cex.pCI)
+ }
}
}
if(qqb$err["sim"]){
if(sum(SI.c)>0){
- lines(x.c, qqb$crit[SI.c,"sim.right"],
+ if(datax){
+ lines(x.c, qqb$crit[SI.c,"sim.right"],
col=col.sCI,lty=lty.sCI,lwd=lwd.sCI)
- lines(x.c, qqb$crit[SI.c,"sim.left"],
+ lines(x.c, qqb$crit[SI.c,"sim.left"],
col=col.sCI,lty=lty.sCI,lwd=lwd.sCI)
+ }else{
+ lines(qqb$crit[SI.c,"sim.right"], x.c,
+ col=col.sCI,lty=lty.sCI,lwd=lwd.sCI)
+ lines(qqb$crit[SI.c,"sim.left"], x.c,
+ col=col.sCI,lty=lty.sCI,lwd=lwd.sCI)
+ }
}
if(sum(!SI.c)>0){
- points(x.d, qqb$crit[!SI.c,"sim.right"],
+ if(datax){
+ points(x.d, qqb$crit[!SI.c,"sim.right"],
col=col.sCI, pch=pch.sCI, cex = cex.sCI)
- points(x.d, qqb$crit[!SI.c,"sim.left"],
+ points(x.d, qqb$crit[!SI.c,"sim.left"],
col=col.sCI, pch=pch.sCI, cex = cex.sCI)
+ }else{
+ points(qqb$crit[!SI.c,"sim.right"], x.d,
+ col=col.sCI, pch=pch.sCI, cex = cex.sCI)
+ points(qqb$crit[!SI.c,"sim.left"], x.d,
+ col=col.sCI, pch=pch.sCI, cex = cex.sCI)
+ }
}
}
if(with.legend){
@@ -301,7 +312,7 @@
merge = FALSE, cex = legend.cex), lcl))
}
}
- return(invisible(NULL))
+ return(invisible(qqb))
}
.deleteItemsMCL <- function(mcl){
Modified: pkg/distr/R/qqbounds.R
===================================================================
--- pkg/distr/R/qqbounds.R 2014-07-28 11:09:12 UTC (rev 946)
+++ pkg/distr/R/qqbounds.R 2014-08-08 16:34:53 UTC (rev 947)
@@ -1,7 +1,7 @@
## to be exported: berechnet Konfidenzbänder, simultan und punktweise
qqbounds <- function(x,D,alpha,n,withConf.pw, withConf.sim,
exact.sCI=(n<100),exact.pCI=(n<100),
- nosym.pCI = FALSE){
+ nosym.pCI = FALSE, debug = FALSE){
x <- sort(unique(x))
if("gaps" %in% names(getSlots(class(D))))
{if(!is.null(gaps(D)))
@@ -17,10 +17,21 @@
p.r <- p(D)(x.in)
p.l <- p.l(D)(x.in)
l.x <- length(x.in)
-
+ if(debug){
+ print(SI)
+ print(x.in)
+ print(sum(SI.in))
+ print(cbind(p.r,p.l))
+ print(l.x)
+ print(c(alpha,n,exact.sCI))
+ }
c.crit <- if(withConf.sim) try(.q2kolmogorov(alpha,n,exact.sCI), silent=TRUE) else NULL
c.crit.i <- if(withConf.pw) try(.q2pw(x.in,p.r,D,n,alpha,exact.pCI,nosym.pCI),silent=TRUE) else NULL
-
+ #print(cbind(c.crit,c.crit.i))
+ if(debug){
+ print(str(c.crit))
+ print(str(c.crit.i))
+ }
te.i <- withConf.pw & !is(c.crit.i,"try-error")
te.s <- withConf.sim & !is(c.crit, "try-error")
@@ -46,3 +57,4 @@
}
return(list(crit = c.c, err=c(sim=te.s,pw=te.i)))
}
+# returnlevelplot(xex,datax=FALSE,GEVFamilyMuUnknown(loc=es[1],shape=es[3],scale=es[2]))
Modified: pkg/distr/R/qqplot.R
===================================================================
--- pkg/distr/R/qqplot.R 2014-07-28 11:09:12 UTC (rev 946)
+++ pkg/distr/R/qqplot.R 2014-08-08 16:34:53 UTC (rev 947)
@@ -18,7 +18,7 @@
jit.fac = 0, check.NotInSupport = TRUE,
col.NotInSupport = "red", with.legend = TRUE, legend.bg = "white",
legend.pos = "topleft", legend.cex = 0.8, legend.pref = "",
- legend.postf = "", legend.alpha = alpha.CI){
+ legend.postf = "", legend.alpha = alpha.CI, debug = FALSE){
mc <- match.call(call = sys.call(sys.parent(1)))
if(missing(xlab)) mc$xlab <- as.character(deparse(mc$x))
@@ -26,6 +26,7 @@
mcl <- as.list(mc)[-1]
mcl$withSweave <- NULL
mcl$mfColRow <- NULL
+ mcl$debug <- NULL
force(x)
@@ -73,9 +74,9 @@
if(mfColRow) opar1 <- par(mfrow = c(1,1), no.readonly = TRUE)
ret <- do.call(stats::qqplot, args=mcl)
-
- if(withIdLine&& plot.it){
- abline(0,1,col=col.IdL,lty=lty.IdL,lwd=lwd.IdL)
+ qqb <- NULL
+ if(withIdLine){
+ if(plot.it)abline(0,1,col=col.IdL,lty=lty.IdL,lwd=lwd.IdL)
if(#is(y,"AbscontDistribution") &&
withConf){
xy <- unique(sort(c(xc.o,yc.o)))
@@ -97,16 +98,22 @@
xy <- sort(c(xy,xy0,xy1))
}
}
- .confqq(xy, y, withConf.pw, withConf.sim, alpha.CI,
+ if(plot.it){
+ qqb <- .confqq(xy, y, datax=TRUE, withConf.pw, withConf.sim, alpha.CI,
col.pCI, lty.pCI, lwd.pCI, pch.pCI, cex.pCI,
col.sCI, lty.sCI, lwd.sCI, pch.sCI, cex.sCI,
n, exact.sCI = exact.sCI, exact.pCI = exact.pCI,
nosym.pCI = nosym.pCI, with.legend = with.legend,
legend.bg = legend.bg, legend.pos = legend.pos,
legend.cex = legend.cex, legend.pref = legend.pref,
- legend.postf = legend.postf, legend.alpha = legend.alpha)
+ legend.postf = legend.postf, legend.alpha = legend.alpha,
+ debug = debug)
+ }else{
+ qqb <- qqbounds(sort(unique(xy)),y,alpha.CI,n,withConf.pw, withConf.sim,
+ exact.sCI,exact.pCI,nosym.pCI,debug)
+ }
}
}
- return(ret)
+ return(c(ret,qqb))
})
Modified: pkg/distr/R/setIsRelations.R
===================================================================
--- pkg/distr/R/setIsRelations.R 2014-07-28 11:09:12 UTC (rev 946)
+++ pkg/distr/R/setIsRelations.R 2014-08-08 16:34:53 UTC (rev 947)
@@ -55,6 +55,22 @@
slot(to, name = names(lst)[i]) <- lst[[i]]
return(to)}
})
+
+## if support is affine linear, a DiscreteDistribution is a LatticeDistribution
+setAs("AffLinDiscreteDistribution", "LatticeDistribution",
+ function(from){
+ if(!.is.vector.lattice(from at support))
+ return(from)
+ else{ to <- new("AffLinLatticeDistribution")
+ slotNames <- slotNames(from)
+ lst <- sapply(slotNames, function(x) slot(from,x))
+ names(lst) <- slotNames
+ lst$lattice <- .make.lattice.es.vector(from at support)
+ for (i in 1: length(lst))
+ slot(to, name = names(lst)[i]) <- lst[[i]]
+ return(to)}
+ })
+
#setIs("DiscreteDistribution", "LatticeDistribution",
# test = function(object) .is.vector.lattice(support(object)),
# coerce = function(from)
Modified: pkg/distr/inst/CITATION
===================================================================
--- pkg/distr/inst/CITATION 2014-07-28 11:09:12 UTC (rev 946)
+++ pkg/distr/inst/CITATION 2014-08-08 16:34:53 UTC (rev 947)
@@ -1,20 +1,42 @@
citHeader("To cite package distr in publications use:")
citEntry(entry="Article",
- title = "S4 Classes for Distributions",
- author = personList(as.person("P. Ruckdeschel"),
- as.person("M. Kohl"),
- as.person("T. Stabla"),
- as.person("F. Camphausen")),
- language = "English",
- year = 2006,
- journal = "R News",
- year = 2006,
- volume = 6,
- number = 2,
- pages = "2--6",
- month = "May",
- url = "http://www.uni-bayreuth.de/departments/math/org/mathe7/DISTR/distr.pdf",
- pdf = "http://CRAN.R-project.org/doc/Rnews/Rnews_2006-2.pdf",
-textVersion = paste("Ruckdeschel, P., Kohl, M., Stabla, T., & Camphausen, F. (2006)",
- "S4 Classes for Distributions"))
+ title = "S4 Classes for Distributions",
+ author = personList(as.person("P. Ruckdeschel"),
+ as.person("M. Kohl"),
+ as.person("T. Stabla"),
+ as.person("F. Camphausen")),
+ language = "English",
+ year = 2006,
+ journal = "R News",
+ year = 2006,
+ volume = 6,
+ number = 2,
+ pages = "2--6",
+ month = "May",
+ url = "http://www.uni-bayreuth.de/departments/math/org/mathe7/DISTR/distr.pdf",
+ pdf = "http://CRAN.R-project.org/doc/Rnews/Rnews_2006-2.pdf",
+ textVersion =
+ paste("Peter Ruckdeschel, Matthias Kohl, Thomas Stabla, Florian Camphausen (2006).",
+ "S4 Classes for Distributions.", "R News, 6(2), 2-6.",
+ "URL http://CRAN.R-project.org/doc/Rnews/")
+)
+
+citEntry(entry = "Article",
+ title = "General Purpose Convolution Algorithm in {S}4 Classes by Means of FFT",
+ author = personList(as.person("Peter Ruckdeschel"),
+ as.person("Matthias Kohl")),
+ journal = "Journal of Statistical Software",
+ year = "2014",
+ volume = "59",
+ number = "4",
+ pages = "1--25",
+ url = "http://www.jstatsoft.org/v59/i04/",
+ textVersion =
+ paste("Peter Ruckdeschel, Matthias Kohl (2014).",
+ "General Purpose Convolution Algorithm in S4 Classes by Means of FFT.",
+ "Journal of Statistical Software, 59(4), 1-25.",
+ "URL http://www.jstatsoft.org/v59/i04/."),
+ header = "If you employ convolution, please also cite:"
+)
+
Modified: pkg/distr/inst/NEWS
===================================================================
--- pkg/distr/inst/NEWS 2014-07-28 11:09:12 UTC (rev 946)
+++ pkg/distr/inst/NEWS 2014-08-08 16:34:53 UTC (rev 947)
@@ -8,6 +8,25 @@
information)
##############
+v 2.5.3
+##############
+
+user-visible CHANGES:
++ CITATION file updated after JSS publication
+
+under the hood:
++ tests: long-running tests with large pre-calculated results successfully implemented
++ enhanced utility function .fillList by an automatic cast to list if the argument
+ not yet is of class list.
++ some minor changes in qqplot
+
+bug fixes:
++ bug in LatticeDistribution found by Mikhail.Spivakov at babraham.ac.uk
++ found a missing drop=FALSE in .mergegaps2
++ fixed an issue with casting AffLinDiscreteDistributions to LatticeDistributions
+ (discovered by Kostas Oikonomou, ko at research.att.com )
+
+##############
v 2.5
##############
Modified: pkg/distr/man/DiscreteDistribution-class.Rd
===================================================================
--- pkg/distr/man/DiscreteDistribution-class.Rd 2014-07-28 11:09:12 UTC (rev 946)
+++ pkg/distr/man/DiscreteDistribution-class.Rd 2014-08-08 16:34:53 UTC (rev 947)
@@ -6,6 +6,7 @@
\alias{initialize,AffLinDiscreteDistribution-method}
\alias{sqrt,DiscreteDistribution-method}
\alias{coerce,DiscreteDistribution,LatticeDistribution-method}
+\alias{coerce,AffLinDiscreteDistribution,LatticeDistribution-method}
\title{Class "DiscreteDistribution"}
\description{The \code{DiscreteDistribution}-class is the mother-class of the class \code{LatticeDistribution}.}
Modified: pkg/distr/man/internals-qqplot.Rd
===================================================================
--- pkg/distr/man/internals-qqplot.Rd 2014-07-28 11:09:12 UTC (rev 946)
+++ pkg/distr/man/internals-qqplot.Rd 2014-08-08 16:34:53 UTC (rev 947)
@@ -33,14 +33,14 @@
.q2kolmogorov(alpha,n,exact=(n<100))
.q2pw(x,p.b,D,n,alpha,exact=(n<100),nosym=FALSE)
-.confqq(x,D, withConf.pw = TRUE, withConf.sim = TRUE, alpha,
+.confqq(x,D, datax=TRUE, withConf.pw = TRUE, withConf.sim = TRUE, alpha,
col.pCI, lty.pCI, lwd.pCI, pch.pCI, cex.pCI,
col.sCI, lty.sCI, lwd.sCI, pch.sCI, cex.sCI,
n,exact.sCI=(n<100),exact.pCI=(n<100),
nosym.pCI = FALSE, with.legend = TRUE,
legend.bg = "white", legend.pos = "topleft",
legend.cex = 0.8, legend.pref = "", legend.postf = "",
- legend.alpha = alpha)
+ legend.alpha = alpha, qqb0 = NULL, debug = FALSE)
.deleteItemsMCL(mcl)
.distrExInstalled
@@ -54,6 +54,7 @@
object.
}
\item{D}{object of class \code{"UnivariateDistribution"}}
+\item{datax}{logical; (to be used in \pkg{distrMod}) shall data be plotted on x-axis?}
\item{ord}{integer; the result of a call to \code{order}}
\item{alpha}{numeric in [0,1]; confidence level}
\item{n}{integer; sample size}
@@ -92,6 +93,8 @@
\item{legend.postf}{character to be appended to legend text}
\item{legend.alpha}{nominal coverage probability}
\item{mcl}{arguments in call as a list}
+\item{qqb0}{precomputed return value of \code{qqbounds}}
+\item{debug}{logical; if \code{TRUE} additional output to debug confidence bounds.}
}
\details{
@@ -157,7 +160,7 @@
columns will be filled with \code{NA}.
\code{.confqq} calls \code{qqbound} to compute the confidence intervals
-and plots them.
+and plots them; returns the return value of qqbound.
\code{.deleteItemsMCL} deletes arguments from a call list which
functions like \code{plot}, \code{lines}, \code{points} cannot digest;
Modified: pkg/distr/man/internals.Rd
===================================================================
--- pkg/distr/man/internals.Rd 2014-07-28 11:09:12 UTC (rev 946)
+++ pkg/distr/man/internals.Rd 2014-08-08 16:34:53 UTC (rev 947)
@@ -124,6 +124,7 @@
.csimpsum(fx)
.primefun(f,x, nm = NULL)
.IssueWarn(Arith,Sim)
+.List(list0)
.fillList(list0, len=length(list0))
.trunc.up(object, upper)
.trunc.low(object, lower)
@@ -364,8 +365,13 @@
of \code{cumsum}. \code{.primefun} is similar but more flexible and
produces the prime function as a function.
+\code{.List} checks if argument already is a list, and if so leaves it as
+ it is, otherwise casts it to a list by a call to \code{list}.
+
\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.
+ Argument \code{list0} is cast to \code{list} by a call
+ to \code{.List} if necessary.
\code{.trunc.up}, \code{.trunc.low} provide common routines for
classes \code{DiscreteDistribution} and \code{AbscontDistribution} for
@@ -442,6 +448,7 @@
\item{.csimpsum}{a vector of evaluations of the prime function at the grid points.}
\item{.primefun}{the prime function as a function.}
\item{.IssueWarn}{a list with two warnings to be issued each of which may be empty.}
+\item{.List}{a list.}
\item{.fillList}{a list.}
\item{.trunc.up,.trunc.low}{a list with elements \code{r,p,d,q} (in this order).}
\item{.DistrCollapse}{upon a suggestion by Jacob van Etten,
Modified: pkg/distr/man/qqbounds.Rd
===================================================================
--- pkg/distr/man/qqbounds.Rd 2014-07-28 11:09:12 UTC (rev 946)
+++ pkg/distr/man/qqbounds.Rd 2014-08-08 16:34:53 UTC (rev 947)
@@ -3,7 +3,7 @@
\usage{
qqbounds(x,D,alpha,n,withConf.pw, withConf.sim,
exact.sCI=(n<100),exact.pCI=(n<100),
- nosym.pCI = FALSE)
+ nosym.pCI = FALSE, debug = FALSE)
}
\alias{qqbounds}
@@ -19,6 +19,7 @@
\item{exact.pCI}{logical; shall pointwise CIs be determined with exact Binomial distribution?}
\item{exact.sCI}{logical; shall simultaneous CIs be determined with exact kolmogorov distribution?}
\item{nosym.pCI}{logical; shall we use (shortest) asymmetric CIs?}
+\item{debug}{logical; if \code{TRUE} additional output to debug confidence bounds.}
}
\description{
We compute confidence intervals for QQ plots.
Modified: pkg/distr/man/qqplot.Rd
===================================================================
--- pkg/distr/man/qqplot.Rd 2014-07-28 11:09:12 UTC (rev 946)
+++ pkg/distr/man/qqplot.Rd 2014-08-08 16:34:53 UTC (rev 947)
@@ -24,7 +24,7 @@
jit.fac = 0, check.NotInSupport = TRUE,
col.NotInSupport = "red", with.legend = TRUE, legend.bg = "white",
legend.pos = "topleft", legend.cex = 0.8, legend.pref = "",
- legend.postf = "", legend.alpha = alpha.CI)
+ legend.postf = "", legend.alpha = alpha.CI, debug = FALSE)
\S4method{qqplot}{ANY,ANY}(x, y,
plot.it = TRUE, xlab = deparse(substitute(x)),
ylab = deparse(substitute(y)), ...)
@@ -79,6 +79,7 @@
\item{legend.pref}{character to be prepended to legend text}
\item{legend.postf}{character to be appended to legend text}
\item{legend.alpha}{nominal coverage probability}
+\item{debug}{logical; if \code{TRUE} additional output to debug confidence bounds.}
}
\description{
@@ -105,6 +106,11 @@
\item{x}{The x coordinates of the points that were/would be plotted}
\item{y}{The corresponding quantiles of the second distribution,
\emph{including \code{\link{NA}}s}.}
+ \item{crit}{A matrix with the lower and upper confidence bounds
+ (computed by \code{qqbounds}).}
+ \item{err}{logical vector of length 2.}
+ (elements \code{crit} and \code{err} are taken from the return
+ value(s) of \code{qqbounds}).
}
\references{
Becker, R. A., Chambers, J. M. and Wilks, A. R. (1988)
Added: pkg/distr/tests/doSvUnit.R
===================================================================
--- pkg/distr/tests/doSvUnit.R (rev 0)
+++ pkg/distr/tests/doSvUnit.R 2014-08-08 16:34:53 UTC (rev 947)
@@ -0,0 +1,73 @@
+# we only run the tests, if svUnit is available
+if (require(svUnit, quietly=TRUE)) {
+ pkg <- "distr"
+ require("distr")
+
+ # we must investigate whether R CMD check is running or not
+ # and if the check is running, whether a time limit exists
+ RCMDCHECK <- FALSE
+ RCMDCHECKCRAN <- FALSE
+
+ for (actual.name in names(Sys.getenv())) {
+ if (substr(actual.name, 1, 9) == "_R_CHECK_") {
+ RCMDCHECK <- TRUE
+
+ if (actual.name == "_R_CHECK_TIMINGS_") {
+ RCMDCHECKCRAN <- (as.numeric(Sys.getenv("_R_CHECK_TIMINGS_")) > 0)
+ }
+ }
+ }
+
+ # we must determine the path for tests in the installation and outside installation
+ if (RCMDCHECK) {
+ ## Path to unit tests for R CMD check
+ ## PKG.Rcheck/tests/../PKG/unitTests
+ ## PKG.Rcheck/tests/unitTests
+
+ # we determine the two paths
+ pathTestsInInstallation <- system.file(package=pkg, "unitTests")
+ pathTestsOutsideInstallation <- file.path(getwd(), "unitTests")
+ } else {
+ ## Path to unit tests for standalone running as script with "PKG/tests" as working directory
+ ## PKG/tests/../inst/unitTests
+ ## PKG/tests/unitTests
+
+ # we determine the two paths
+ pathTestsInInstallation <- file.path(getwd(), "..", "inst", "unitTests")
+ pathTestsOutsideInstallation <- file.path(getwd(), "unitTests")
+ }
+
+ print(pathTestsInInstallation)
+ print(pathTestsOutsideInstallation)
+
+ # it depends whether we want to skip the long running tests or not
+ if (RCMDCHECKCRAN) {
+ mypkgSuite <- svSuiteList(packages=pkg, dirs=pathTestsInInstallation)
+ } else {
+ mypkgSuite <- svSuiteList(packages=pkg, dirs=c(pathTestsInInstallation, pathTestsOutsideInstallation))
+ }
+
+ unlink("report.txt") # Make sure we generate a new report
+
+ print(svSuiteList(packages=FALSE, dirs=c(pathTestsInInstallation, pathTestsOutsideInstallation)))
+
+ runTest(mypkgSuite, name = pkg) # Run them...
+
+ ## makeTestListFromExamples is in svUnit 0.7.8 or more
+ #doRunExamples <- TRUE
+ #svUnitVersion = as.integer(strsplit(installed.packages()[which(installed.packages()[, 'Package'] == "svUnit"), "Version"], "[\\.-]")[[1]])
+ #if (svUnitVersion[1] == 0) {
+ # if (svUnitVersion[2] < 7) {
+ # doRunExamples <- FALSE
+ # } else {
+ # if (svUnitVersion[2] == 7)
+ # doRunExamples <- svUnitVersion[3] >= 8
+ # }
+ #}
+ #if(doRunExamples)
+ # runTest(tryCatch(makeTestListFromExamples(pkg, "../../pkg/man/"), error=function(e) NULL))
+
+
+ protocol(Log(), type = "text", file = "report.txt") # ... and write report
+}
+
Added: pkg/distr/tests/unitTests/runit.dontrunMinimum.R
===================================================================
--- pkg/distr/tests/unitTests/runit.dontrunMinimum.R (rev 0)
+++ pkg/distr/tests/unitTests/runit.dontrunMinimum.R 2014-08-08 16:34:53 UTC (rev 947)
@@ -0,0 +1,19 @@
+# test for equality of the saved result and the actual result of a dontrun example
+test.minimum <- function() {
+ # we compute the actual object
+ runit.dontrunMinimum.actual <- Minimum(Norm(), Pois())
+
+ # we load the saved object for comparison
+ # we assume that this test is called from within the script in the upper directory
+ load("unitTests/runit.dontrunMinimum.save")
+
+ # we compare the stored result with the calculated one
+ # (a comparison with identical (ignoring the environment) gives FALSE...
+ result <- all.equal(runit.dontrunMinimum.actual,
+ runit.dontrunMinimum.save)
+
+ # we check whether the result is TRUE and if not, we write the message
+ # coming from the result
+ checkEquals(is.logical(result) && result, TRUE, msg=paste(result, sep="", collapse="\n"))
+}
+
Added: pkg/distr/tests/unitTests/runit.dontrunMinimum.save
===================================================================
(Binary files differ)
Property changes on: pkg/distr/tests/unitTests/runit.dontrunMinimum.save
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: pkg/distr/tests/unitTests/runit.dontrunOperatorsMethods.R
===================================================================
--- pkg/distr/tests/unitTests/runit.dontrunOperatorsMethods.R (rev 0)
+++ pkg/distr/tests/unitTests/runit.dontrunOperatorsMethods.R 2014-08-08 16:34:53 UTC (rev 947)
@@ -0,0 +1,21 @@
+# test for equality of the saved result and the actual result of a dontrun example
+test.operatorsMethods <- function() {
+ # we compute the actual result
+ N <- Norm(0,3)
+ P <- Pois(4)
+ runit.dontrunOperatorsMethods.actual <- N ^ P
+
+ # we load the stored result
+ # we assume that this test is called from within the script in the upper directory
+ load("unitTests/runit.dontrunOperatorsMethods.save")
+
+ # we compare the stored result with the calculated one
+ # (a comparison with identical (ignoring the environment) gives FALSE...
+ result <- all.equal(runit.dontrunOperatorsMethods.actual,
+ runit.dontrunOperatorsMethods.save)
+
+ # we check whether the result is TRUE and if not, we write the message
+ # coming from the result
+ checkEquals(is.logical(result) && result, TRUE, msg=paste(result, sep="", collapse="\n"))
+}
+
Added: pkg/distr/tests/unitTests/runit.dontrunOperatorsMethods.save
===================================================================
(Binary files differ)
Property changes on: pkg/distr/tests/unitTests/runit.dontrunOperatorsMethods.save
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: pkg/distr/tests/unitTests/runit.dontrunQQPlot.R
===================================================================
--- pkg/distr/tests/unitTests/runit.dontrunQQPlot.R (rev 0)
+++ pkg/distr/tests/unitTests/runit.dontrunQQPlot.R 2014-08-08 16:34:53 UTC (rev 947)
@@ -0,0 +1,68 @@
+# test for equality of the saved result and the actual result of a dontrun example
+test.qqplot1 <- function() {
+ # we compute the actual result
+ P <- Pois(5)
+ B <- Binom(size=2000,prob=5/2000)
+ runit.dontrunQQPlot1.actual <- qqplot(B,P, nosym.pCI=TRUE)
+
+ # we load the stored result
+ # we assume that this test is called from within the script in the upper directory
+ load("unitTests/runit.dontrunQQPlot1.save")
+
+ # we compare the stored result with the calculated one
+ # (a comparison with identical (ignoring the environment) gives FALSE...
+ result <- all.equal(runit.dontrunQQPlot1.actual,
+ runit.dontrunQQPlot1.save)
+
+ # we check whether the result is TRUE and if not, we write the message
+ # coming from the result
+ checkEquals(is.logical(result) && result, TRUE, msg=paste(result, sep="", collapse="\n"))
+}
+
+
+# test for equality of the saved result and the actual result of a dontrun example
+test.qqplot2 <- function() {
+ # we compute the actual result
+ mylist <- UnivarLebDecDistribution(discretePart=Binom(3,.3), acPart=Norm(2,2),
+ acWeight=11/20)
+ mylist2 <- mylist+0.1
+
+ runit.dontrunQQPlot2.actual <- qqplot(mylist,mylist2,nosym.pCI=TRUE)
+
+ # we load the stored result
+ # we assume that this test is called from within the script in the upper directory
+ load("unitTests/runit.dontrunQQPlot2.save")
+
+ # we compare the stored result with the calculated one
+ # (a comparison with identical (ignoring the environment) gives FALSE...
+ result <- all.equal(runit.dontrunQQPlot2.actual,
+ runit.dontrunQQPlot2.save)
+
+ # we check whether the result is TRUE and if not, we write the message
+ # coming from the result
+ checkEquals(is.logical(result) && result, TRUE, msg=paste(result, sep="", collapse="\n"))
+}
+
+
+# test for equality of the saved result and the actual result of a dontrun example
+test.qqplot3 <- function() {
+ # we compute the actual result
+ mylist3 <- UnivarMixingDistribution(Unif(0,0.3),Unif(0.6,1),mixCoeff=c(0.8,0.2))
+ mylist4 <- UnivarMixingDistribution(Unif(0,0.3),Unif(0.6,1),mixCoeff=c(0.6,0.4))
+
+ runit.dontrunQQPlot3.actual <- qqplot(mylist3,mylist4,nosym.pCI=TRUE)
+
+ # we load the stored result
+ # we assume that this test is called from within the script in the upper directory
+ load("unitTests/runit.dontrunQQPlot3.save")
+
+ # we compare the stored result with the calculated one
+ # (a comparison with identical (ignoring the environment) gives FALSE...
+ result <- all.equal(runit.dontrunQQPlot3.actual,
+ runit.dontrunQQPlot3.save)
+
+ # we check whether the result is TRUE and if not, we write the message
+ # coming from the result
+ checkEquals(is.logical(result) && result, TRUE, msg=paste(result, sep="", collapse="\n"))
+}
+
Added: pkg/distr/tests/unitTests/runit.dontrunQQPlot1.save
===================================================================
(Binary files differ)
Property changes on: pkg/distr/tests/unitTests/runit.dontrunQQPlot1.save
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: pkg/distr/tests/unitTests/runit.dontrunQQPlot2.save
===================================================================
(Binary files differ)
Property changes on: pkg/distr/tests/unitTests/runit.dontrunQQPlot2.save
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: pkg/distr/tests/unitTests/runit.dontrunQQPlot3.save
===================================================================
(Binary files differ)
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/distr -r 947
More information about the Distr-commits
mailing list