From noreply at r-forge.r-project.org Tue Jul 22 18:47:58 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 22 Jul 2014 18:47:58 +0200 (CEST) Subject: [Distr-commits] r938 - in branches/distr-2.6/pkg/distr: R man Message-ID: <20140722164758.F0677187586@r-forge.r-project.org> Author: ruckdeschel Date: 2014-07-22 18:47:58 +0200 (Tue, 22 Jul 2014) New Revision: 938 Modified: branches/distr-2.6/pkg/distr/R/internals-qqplot.R branches/distr-2.6/pkg/distr/R/qqbounds.R branches/distr-2.6/pkg/distr/R/qqplot.R branches/distr-2.6/pkg/distr/man/internals-qqplot.Rd branches/distr-2.6/pkg/distr/man/qqbounds.Rd branches/distr-2.6/pkg/distr/man/qqplot.Rd Log: [distr] integrated debug argument for qqplot qqbounds Modified: branches/distr-2.6/pkg/distr/R/internals-qqplot.R =================================================================== --- branches/distr-2.6/pkg/distr/R/internals-qqplot.R 2014-06-26 22:52:18 UTC (rev 937) +++ branches/distr-2.6/pkg/distr/R/internals-qqplot.R 2014-07-22 16:47:58 UTC (rev 938) @@ -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{ - ### 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 + ### from ks.test from package stats: + 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) @@ -213,7 +194,7 @@ with.legend = TRUE, legend.bg = "white", legend.pos = "topleft", legend.cex = 0.8, legend.pref = "", legend.postf = "", - legend.alpha = alpha, qqb0=NULL){ + legend.alpha = alpha, qqb0=NULL, debug = FALSE){ x <- sort(unique(x)) if("gaps" %in% names(getSlots(class(D)))) @@ -231,7 +212,7 @@ qqb <- if(is.null(qqb0)) qqbounds(x,D,alpha,n,withConf.pw, withConf.sim, - exact.sCI,exact.pCI,nosym.pCI) else qqb0 + exact.sCI,exact.pCI,nosym.pCI, debug) else qqb0 qqb$crit <- qqb$crit[SI.in,] Modified: branches/distr-2.6/pkg/distr/R/qqbounds.R =================================================================== --- branches/distr-2.6/pkg/distr/R/qqbounds.R 2014-06-26 22:52:18 UTC (rev 937) +++ branches/distr-2.6/pkg/distr/R/qqbounds.R 2014-07-22 16:47:58 UTC (rev 938) @@ -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 - + c.crit.i <- if(withConf.pw) try(distr:::.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: branches/distr-2.6/pkg/distr/R/qqplot.R =================================================================== --- branches/distr-2.6/pkg/distr/R/qqplot.R 2014-06-26 22:52:18 UTC (rev 937) +++ branches/distr-2.6/pkg/distr/R/qqplot.R 2014-07-22 16:47:58 UTC (rev 938) @@ -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)) @@ -105,10 +105,11 @@ 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) + exact.sCI,exact.pCI,nosym.pCI,debug) } } } Modified: branches/distr-2.6/pkg/distr/man/internals-qqplot.Rd =================================================================== --- branches/distr-2.6/pkg/distr/man/internals-qqplot.Rd 2014-06-26 22:52:18 UTC (rev 937) +++ branches/distr-2.6/pkg/distr/man/internals-qqplot.Rd 2014-07-22 16:47:58 UTC (rev 938) @@ -40,7 +40,7 @@ nosym.pCI = FALSE, with.legend = TRUE, legend.bg = "white", legend.pos = "topleft", legend.cex = 0.8, legend.pref = "", legend.postf = "", - legend.alpha = alpha, qqb0 = NULL) + legend.alpha = alpha, qqb0 = NULL, debug = FALSE) .deleteItemsMCL(mcl) .distrExInstalled @@ -94,6 +94,7 @@ \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{ Modified: branches/distr-2.6/pkg/distr/man/qqbounds.Rd =================================================================== --- branches/distr-2.6/pkg/distr/man/qqbounds.Rd 2014-06-26 22:52:18 UTC (rev 937) +++ branches/distr-2.6/pkg/distr/man/qqbounds.Rd 2014-07-22 16:47:58 UTC (rev 938) @@ -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: branches/distr-2.6/pkg/distr/man/qqplot.Rd =================================================================== --- branches/distr-2.6/pkg/distr/man/qqplot.Rd 2014-06-26 22:52:18 UTC (rev 937) +++ branches/distr-2.6/pkg/distr/man/qqplot.Rd 2014-07-22 16:47:58 UTC (rev 938) @@ -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{ From noreply at r-forge.r-project.org Tue Jul 22 19:04:32 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 22 Jul 2014 19:04:32 +0200 (CEST) Subject: [Distr-commits] r939 - in branches/distr-2.6/pkg/distrMod: R man Message-ID: <20140722170432.B2873187638@r-forge.r-project.org> Author: ruckdeschel Date: 2014-07-22 19:04:31 +0200 (Tue, 22 Jul 2014) New Revision: 939 Modified: branches/distr-2.6/pkg/distrMod/R/qqplot.R branches/distr-2.6/pkg/distrMod/man/qqplot.Rd Log: [distrMod] debug option for qqbounds Modified: branches/distr-2.6/pkg/distrMod/R/qqplot.R =================================================================== --- branches/distr-2.6/pkg/distrMod/R/qqplot.R 2014-07-22 16:47:58 UTC (rev 938) +++ branches/distr-2.6/pkg/distrMod/R/qqplot.R 2014-07-22 17:04:31 UTC (rev 939) @@ -96,7 +96,8 @@ legend.cex = 0.8, ## magnification factor for the legend legend.pref = "", ## prefix for legend text legend.postf = "", ## postfix for legend text - legend.alpha = alpha.CI ## nominal level of CI + legend.alpha = alpha.CI, ## nominal level of CI + debug = FALSE ## shall additional debug output be printed out? ){ ## return value as in stats::qqplot mc <- match.call(call = sys.call(sys.parent(1))) @@ -214,10 +215,10 @@ 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) + exact.sCI,exact.pCI,nosym.pCI, debug = debug) } } } Modified: branches/distr-2.6/pkg/distrMod/man/qqplot.Rd =================================================================== --- branches/distr-2.6/pkg/distrMod/man/qqplot.Rd 2014-07-22 16:47:58 UTC (rev 938) +++ branches/distr-2.6/pkg/distrMod/man/qqplot.Rd 2014-07-22 17:04:31 UTC (rev 939) @@ -23,7 +23,8 @@ 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.pref = "", legend.postf = "", legend.alpha = alpha.CI, + debug = FALSE) \S4method{qqplot}{ANY,ProbFamily}(x, y, n = length(x), withIdLine = TRUE, withConf = TRUE, withConf.pw = withConf, withConf.sim = withConf, @@ -110,6 +111,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{ We generalize function \code{\link[stats:qqnorm]{qqplot}} from package \pkg{stats} to From noreply at r-forge.r-project.org Tue Jul 22 19:37:32 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Tue, 22 Jul 2014 19:37:32 +0200 (CEST) Subject: [Distr-commits] r940 - branches/distr-2.6/pkg/distrMod/man Message-ID: <20140722173732.7802F187403@r-forge.r-project.org> Author: ruckdeschel Date: 2014-07-22 19:37:31 +0200 (Tue, 22 Jul 2014) New Revision: 940 Modified: branches/distr-2.6/pkg/distrMod/man/returnlevelplot.Rd Log: distrMod: fixed an issue with foreign character sets in Rd (apostrophes...) Modified: branches/distr-2.6/pkg/distrMod/man/returnlevelplot.Rd =================================================================== --- branches/distr-2.6/pkg/distrMod/man/returnlevelplot.Rd 2014-07-22 17:04:31 UTC (rev 939) +++ branches/distr-2.6/pkg/distrMod/man/returnlevelplot.Rd 2014-07-22 17:37:31 UTC (rev 940) @@ -51,7 +51,7 @@ \item{datax}{logical; shall data be plotted on x-axis?} \item{MaxOrPOT}{a character string specifying whether it is used for block maxima ("Max") or for points over threshold ("POT"); - must be one of ?"Max"? (default) or ?"POT"?. + must be one of "Max" (default) or "POT". You can specify just the initial letter.} \item{npy}{number of observations per year/block.} \item{main}{Main title} From noreply at r-forge.r-project.org Thu Jul 24 13:27:44 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 24 Jul 2014 13:27:44 +0200 (CEST) Subject: [Distr-commits] r941 - in branches/distr-2.6/pkg: distr/R distrMod/R Message-ID: <20140724112744.57FF9186BCB@r-forge.r-project.org> Author: ruckdeschel Date: 2014-07-24 13:27:43 +0200 (Thu, 24 Jul 2014) New Revision: 941 Modified: branches/distr-2.6/pkg/distr/R/qqplot.R branches/distr-2.6/pkg/distrMod/R/qqplot.R Log: [distr,distrMod] eliminated argument "debug" from internal mingling of the call in qqplot-methods Modified: branches/distr-2.6/pkg/distr/R/qqplot.R =================================================================== --- branches/distr-2.6/pkg/distr/R/qqplot.R 2014-07-22 17:37:31 UTC (rev 940) +++ branches/distr-2.6/pkg/distr/R/qqplot.R 2014-07-24 11:27:43 UTC (rev 941) @@ -26,6 +26,7 @@ mcl <- as.list(mc)[-1] mcl$withSweave <- NULL mcl$mfColRow <- NULL + mcl$debug <- NULL force(x) Modified: branches/distr-2.6/pkg/distrMod/R/qqplot.R =================================================================== --- branches/distr-2.6/pkg/distrMod/R/qqplot.R 2014-07-22 17:37:31 UTC (rev 940) +++ branches/distr-2.6/pkg/distrMod/R/qqplot.R 2014-07-24 11:27:43 UTC (rev 941) @@ -106,6 +106,7 @@ mcl <- as.list(mc)[-1] mcl$withSweave <- NULL mcl$mfColRow <- NULL + mcl$debug <- NULL force(x) From noreply at r-forge.r-project.org Thu Jul 24 14:22:36 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 24 Jul 2014 14:22:36 +0200 (CEST) Subject: [Distr-commits] r942 - in branches/distr-2.6/pkg/distr: R man Message-ID: <20140724122236.4C5EF185C3C@r-forge.r-project.org> Author: ruckdeschel Date: 2014-07-24 14:22:35 +0200 (Thu, 24 Jul 2014) New Revision: 942 Modified: branches/distr-2.6/pkg/distr/R/internalUtils.R branches/distr-2.6/pkg/distr/man/internals.Rd Log: [distr] enhanced utility function .fillList by an automatic cast to list if the argument not yet is of class list. Modified: branches/distr-2.6/pkg/distr/R/internalUtils.R =================================================================== --- branches/distr-2.6/pkg/distr/R/internalUtils.R 2014-07-24 11:27:43 UTC (rev 941) +++ branches/distr-2.6/pkg/distr/R/internalUtils.R 2014-07-24 12:22:35 UTC (rev 942) @@ -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: branches/distr-2.6/pkg/distr/man/internals.Rd =================================================================== --- branches/distr-2.6/pkg/distr/man/internals.Rd 2014-07-24 11:27:43 UTC (rev 941) +++ branches/distr-2.6/pkg/distr/man/internals.Rd 2014-07-24 12:22:35 UTC (rev 942) @@ -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, From noreply at r-forge.r-project.org Thu Jul 24 18:24:27 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Thu, 24 Jul 2014 18:24:27 +0200 (CEST) Subject: [Distr-commits] r943 - in branches/distr-2.6/pkg/distr: R man Message-ID: <20140724162427.195A7186B18@r-forge.r-project.org> Author: ruckdeschel Date: 2014-07-24 18:24:26 +0200 (Thu, 24 Jul 2014) New Revision: 943 Modified: branches/distr-2.6/pkg/distr/R/qqbounds.R branches/distr-2.6/pkg/distr/R/setIsRelations.R branches/distr-2.6/pkg/distr/man/DiscreteDistribution-class.Rd Log: [distr] fixed an issue with casting AffLinDiscreteDistributions to LatticeDistributions (discovered by Kostas Oikonomou, ko at research.att.com ) Modified: branches/distr-2.6/pkg/distr/R/qqbounds.R =================================================================== --- branches/distr-2.6/pkg/distr/R/qqbounds.R 2014-07-24 12:22:35 UTC (rev 942) +++ branches/distr-2.6/pkg/distr/R/qqbounds.R 2014-07-24 16:24:26 UTC (rev 943) @@ -26,7 +26,7 @@ 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(distr:::.q2pw(x.in,p.r,D,n,alpha,exact.pCI,nosym.pCI),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)) Modified: branches/distr-2.6/pkg/distr/R/setIsRelations.R =================================================================== --- branches/distr-2.6/pkg/distr/R/setIsRelations.R 2014-07-24 12:22:35 UTC (rev 942) +++ branches/distr-2.6/pkg/distr/R/setIsRelations.R 2014-07-24 16:24:26 UTC (rev 943) @@ -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: branches/distr-2.6/pkg/distr/man/DiscreteDistribution-class.Rd =================================================================== --- branches/distr-2.6/pkg/distr/man/DiscreteDistribution-class.Rd 2014-07-24 12:22:35 UTC (rev 942) +++ branches/distr-2.6/pkg/distr/man/DiscreteDistribution-class.Rd 2014-07-24 16:24:26 UTC (rev 943) @@ -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}.} From noreply at r-forge.r-project.org Mon Jul 28 12:47:09 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 28 Jul 2014 12:47:09 +0200 (CEST) Subject: [Distr-commits] r944 - branches/distr-2.6/pkg/distrTeach/R Message-ID: <20140728104709.F330B184E98@r-forge.r-project.org> Author: ruckdeschel Date: 2014-07-28 12:47:09 +0200 (Mon, 28 Jul 2014) New Revision: 944 Modified: branches/distr-2.6/pkg/distrTeach/R/illustLLN.R Log: [distrTeach] removed ::: internal dependencies (within distr-Fam of pkgs) by copying respective routines Modified: branches/distr-2.6/pkg/distrTeach/R/illustLLN.R =================================================================== --- branches/distr-2.6/pkg/distrTeach/R/illustLLN.R 2014-07-24 16:24:26 UTC (rev 943) +++ branches/distr-2.6/pkg/distrTeach/R/illustLLN.R 2014-07-28 10:47:09 UTC (rev 944) @@ -90,7 +90,7 @@ .mpresubs <- function(inx) - distr:::.presubs(inx, c("%C", "%D", "%N", "%P", "%Q", "%A", + .presubs(inx, c("%C", "%D", "%N", "%P", "%Q", "%A", "%X"), list(as.character(class(Distr)[1]), as.character(date()), @@ -169,4 +169,37 @@ } +#------------------------------------ +#### utility copied from package distr v.2.6 svn-rev 943 +#------------------------------------ +.presubs <- function(inp, frompat, topat){ +### replaces in an expression or a string all frompat patterns to topat patterns +logic <- FALSE +inCx <- sapply(inp, + function(inpx){ + inC <- deparse(inpx) + l <- length(frompat) + for(i in 1:l) + { if (is.language(topat[[i]])){ + totxt <- deparse(topat[[i]]) + totxt <- gsub("expression\\(", "\", ", gsub("\\)$",", \"",totxt)) + if (length(grep(frompat[i],inC))) logic <<- TRUE + inC <- gsub(frompat[i],totxt,inC) + }else inC <- gsub(frompat[i], topat[[i]], inC) + } + return(inC) + }) +if(length(grep("expression",inCx))>0) + inCx <- gsub("expression\\(", "", gsub("\\)$","",inCx)) +if (length(inCx) > 1) { + inCx <- paste(inCx, c(rep(",", length(inCx)-1), ""), + sep = "", collapse = "\"\\n\",") + if ( any(as.logical(c(lapply(inp,is.language)))) | logic ) + inCx <- paste("expression(paste(", gsub("\\\\n"," ", inCx), "))", sep ="") + else + inCx <- paste("paste(",inCx,")", sep ="") +}else inCx <- paste("expression(paste(",inCx,"))",sep="") +outC <- eval(parse(text = eval(inCx))) +return(outC) +} From noreply at r-forge.r-project.org Mon Jul 28 12:52:52 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 28 Jul 2014 12:52:52 +0200 (CEST) Subject: [Distr-commits] r945 - branches/distr-2.6/pkg/distrEllipse/R Message-ID: <20140728105253.088F01861DD@r-forge.r-project.org> Author: ruckdeschel Date: 2014-07-28 12:52:52 +0200 (Mon, 28 Jul 2014) New Revision: 945 Modified: branches/distr-2.6/pkg/distrEllipse/R/01.R branches/distr-2.6/pkg/distrEllipse/R/AllClasses.R branches/distr-2.6/pkg/distrEllipse/R/AllShow.R branches/distr-2.6/pkg/distrEllipse/R/EllipticalDistribution.R branches/distr-2.6/pkg/distrEllipse/R/MVMixingDistribution.R Log: [distrEllipse] removed ::: internal dependencies (within distr-Fam of pkgs) by copying respective routines Modified: branches/distr-2.6/pkg/distrEllipse/R/01.R =================================================================== --- branches/distr-2.6/pkg/distrEllipse/R/01.R 2014-07-28 10:47:09 UTC (rev 944) +++ branches/distr-2.6/pkg/distrEllipse/R/01.R 2014-07-28 10:52:52 UTC (rev 945) @@ -35,3 +35,37 @@ { infoShow(pkg = "distrEllipse", filename="MASKING", library = library) } + +#------------------------------------ +#### utilities copied from package distr v.2.6 svn-rev 943 +#------------------------------------ +.isInteger <- function(x, tol = .Machine$double.eps) abs(as.integer(x)-x)< tol +.isNatural <- function(x, tol = .Machine$double.eps) .isInteger(x, tol) & (x>0) + +.inArgs <- function(arg, fct) + {as.character(arg) %in% names(formals(fct))} + +.isEqual <- function(p0, p1, tol = min( getdistrOption("TruncQuantile")/2, + .Machine$double.eps^.7 + )) + abs(p0-p1)< tol + +#------------------------------------------------------------------------------ +# issue warnings in show / print as to Arith or print +#------------------------------------------------------------------------------ +.IssueWarn <- function(Arith,Sim){ + msgA1 <- msgA2 <- msgS1 <- msgS2 <- NULL + if(Arith && getdistrOption("WarningArith")){ + msgA1 <- gettext( + "arithmetics on distributions are understood as operations on r.v.'s\n") + msgA2 <- gettext( + "see 'distrARITH()'; for switching off this warning see '?distroptions'") + } + if(Sim && getdistrOption("WarningSim")){ + msgS1 <- gettext( + "slots d,p,q have been filled using simulations; ") + msgS2 <- gettext( + "for switching off this warning see '?distroptions'") + } + return(list(msgA=c(msgA1,msgA2), msgS = c(msgS1,msgS2))) + } Modified: branches/distr-2.6/pkg/distrEllipse/R/AllClasses.R =================================================================== --- branches/distr-2.6/pkg/distrEllipse/R/AllClasses.R 2014-07-28 10:47:09 UTC (rev 944) +++ branches/distr-2.6/pkg/distrEllipse/R/AllClasses.R 2014-07-28 10:52:52 UTC (rev 945) @@ -37,7 +37,7 @@ contains = "EllipticalParameter", validity = function(object){ dim0 <- length(object at loc) - if(!distr:::.isNatural(object at df)) stop("'df' must be an integer") + if(!.isNatural(object at df)) stop("'df' must be an integer") if(!length(object at ncp)==1) stop("wrong dimension for ncp") if(!nrow(object at scale)==dim0) stop("wrong dimensions") else return(TRUE) Modified: branches/distr-2.6/pkg/distrEllipse/R/AllShow.R =================================================================== --- branches/distr-2.6/pkg/distrEllipse/R/AllShow.R 2014-07-28 10:47:09 UTC (rev 944) +++ branches/distr-2.6/pkg/distrEllipse/R/AllShow.R 2014-07-28 10:52:52 UTC (rev 945) @@ -35,7 +35,7 @@ function(object){ cls <- class(object)[1] cat(showobj(object, className = cls)) - ws <- distr:::.IssueWarn(object at .withArith, object at .withSim) + ws <- .IssueWarn(object at .withArith, object at .withSim) if(!is.null(ws$msgA)) warning(ws$msgA) if(!is.null(ws$msgS)) warning(ws$msgS) } Modified: branches/distr-2.6/pkg/distrEllipse/R/EllipticalDistribution.R =================================================================== --- branches/distr-2.6/pkg/distrEllipse/R/EllipticalDistribution.R 2014-07-28 10:47:09 UTC (rev 944) +++ branches/distr-2.6/pkg/distrEllipse/R/EllipticalDistribution.R 2014-07-28 10:52:52 UTC (rev 945) @@ -17,7 +17,7 @@ stop("distr must have pos. support") dr <- d(radDistr) - dlog <- if(distr:::.inArgs("log", dr)) + dlog <- if(.inArgs("log", dr)) quote(dr(r, log = TRUE)) else quote(log(dr(r))) if(is(radDistr,"AbscontDistribution")){ Modified: branches/distr-2.6/pkg/distrEllipse/R/MVMixingDistribution.R =================================================================== --- branches/distr-2.6/pkg/distrEllipse/R/MVMixingDistribution.R 2014-07-28 10:47:09 UTC (rev 944) +++ branches/distr-2.6/pkg/distrEllipse/R/MVMixingDistribution.R 2014-07-28 10:52:52 UTC (rev 945) @@ -1,4 +1,3 @@ -.isEqual <- distr:::.isEqual MultivarMixingDistribution <- function(..., Dlist, mixCoeff #, # withSimplify = getdistrOption("simplifyD") @@ -177,7 +176,7 @@ function(object){ cls <- class(object)[1] cat(showobj(object, className = cls)) - ws <- distr:::.IssueWarn(object at .withArith, object at .withSim) + ws <- .IssueWarn(object at .withArith, object at .withSim) if(!is.null(ws$msgA)) warning(ws$msgA) if(!is.null(ws$msgS)) warning(ws$msgS) } From noreply at r-forge.r-project.org Mon Jul 28 13:09:12 2014 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 28 Jul 2014 13:09:12 +0200 (CEST) Subject: [Distr-commits] r946 - in branches/distr-2.6/pkg/distrMod: . R Message-ID: <20140728110912.8DA87180624@r-forge.r-project.org> Author: ruckdeschel Date: 2014-07-28 13:09:12 +0200 (Mon, 28 Jul 2014) New Revision: 946 Modified: branches/distr-2.6/pkg/distrMod/DESCRIPTION branches/distr-2.6/pkg/distrMod/R/0distrModUtils.R branches/distr-2.6/pkg/distrMod/R/AllPlot.R branches/distr-2.6/pkg/distrMod/R/SimpleL2ParamFamilies.R branches/distr-2.6/pkg/distrMod/R/confint.R branches/distr-2.6/pkg/distrMod/R/internalMleCalc.R branches/distr-2.6/pkg/distrMod/R/qqplot.R Log: [distrMod] removed ::: internal dependencies (within distr-Fam of pkgs) by copying respective routines Modified: branches/distr-2.6/pkg/distrMod/DESCRIPTION =================================================================== --- branches/distr-2.6/pkg/distrMod/DESCRIPTION 2014-07-28 10:52:52 UTC (rev 945) +++ branches/distr-2.6/pkg/distrMod/DESCRIPTION 2014-07-28 11:09:12 UTC (rev 946) @@ -4,8 +4,10 @@ Title: Object oriented implementation of probability models Description: Object oriented implementation of probability models based on packages 'distr' and 'distrEx' -Author: Matthias Kohl, Peter Ruckdeschel -Maintainer: Peter Ruckdeschel +Authors at R: c(person("Matthias", "Kohl", role=c("aut", "cph")), + person("Peter", "Ruckdeschel", role=c("cre", "cph"), email="Peter.Ruckdeschel at itwm.fraunhofer.de"), + person("R Core Team", role = c("ctb", "cph"), + comment="for source file 'format.perc'")) Depends: R(>= 2.14.0), distr(>= 2.5.2), distrEx(>= 2.4), RandVar(>= 0.6.3), MASS, stats4, methods ByteCompile: yes Modified: branches/distr-2.6/pkg/distrMod/R/0distrModUtils.R =================================================================== --- branches/distr-2.6/pkg/distrMod/R/0distrModUtils.R 2014-07-28 10:52:52 UTC (rev 945) +++ branches/distr-2.6/pkg/distrMod/R/0distrModUtils.R 2014-07-28 11:09:12 UTC (rev 946) @@ -89,10 +89,6 @@ return(ret) } -##caching: -.csimpsum <- distr:::.csimpsum -### still to be tested and improved: -## covariance for minimum CvM distance estimator acc. Ri:94, pp.132-133 .CvMMDCovariance<- function(L2Fam, param, mu = distribution(L2Fam), withplot = FALSE, withpreIC = FALSE, @@ -406,3 +402,315 @@ } +#------------------------------------ +#### utilities copied from package distr v.2.6 svn-rev 943 +#------------------------------------ +.inArgs <- function(arg, fct) + {as.character(arg) %in% names(formals(fct))} + +.isEqual <- function(p0, p1, tol = min( getdistrOption("TruncQuantile")/2, + .Machine$double.eps^.7 + )) + abs(p0-p1)< tol + +.csimpsum <- function(fx){ + l <- length(fx) + l2 <- l%/%2 + if (l%%2 == 0) { + fx <- c(fx[1:l2],(fx[l2]+fx[l2+1])/2,fx[(l2+1):l]) + l <- l+1} + f.even <- fx[seq(l) %% 2 == 0] + f.odd <- fx[seq(l) %% 2 == 1] + fs <- 2 * cumsum(f.odd) - f.odd - f.odd[1] + fsm <- 4 * cumsum(f.even) + ff <- c(0,(fs[2:(l2+1)]+fsm)/3 ) + ff +} + +.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 + ll0 <- length(list0) + li0 <- vector("list",len) + if(ll0) + while(i < len){ + j <- 1 + ( i %% ll0) + i <- i + 1 + li0[[i]] <- list0[[j]] + } + return(li0) +} + +.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, qqb0=NULL, debug = FALSE){ + + x <- sort(unique(x)) + if("gaps" %in% names(getSlots(class(D)))) + {if(!is.null(gaps(D))) + x <- sort(unique(c(x, gaps(D)))) + } + SI <- .SingleDiscrete(x,D) +# print(SI) + SI.in <- SI<4 + SIi <- SI[SI.in] + SI.c <- SIi>0 + x.in <- x[SI.in] + x.c <- x.in[SI.c] + x.d <- x.in[!SI.c] + + + 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){ + 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){ + 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){ + 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"], + 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){ + 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"], + 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){ + if( qqb$err["pw"] || qqb$err["sim"] ){ + expression1 <- substitute( + legpf~nosym0~"pointw."~ex.p~alpha==alpha0~"%- conf. interval"~legpof, + list(legpf = legend.pref, legpof = legend.postf, + ex.p = if(exact.pCI) "exact" else "asympt.", + alpha0 = round(legend.alpha*100,2), + nosym0 = if(nosym.pCI&&exact.pCI) "shortest asymm." else "symm")) + expression2 <- substitute( + legpf~"simult."~ex.s~alpha==alpha0~"%- conf. interval"~legpof, + list(legpf = legend.pref, legpof = legend.postf, + ex.s = if(exact.sCI) "exact" else "asympt.", + alpha0 = round(legend.alpha*100,2))) + + lcl <- list() + if(!qqb$err["sim"]){ + expression3 <- expression1 + lcl$pch <- if(sum(!SI.c)>0) pch.pCI else NULL + lcl$lty <- if(sum(SI.c)>0) lty.pCI else NULL + lcl$col <- col.pCI + lcl$lwd <- if(sum(SI.c)>0) 2 else NULL + } + if(!qqb$err["pw"]){ + expression3 <- expression2 + lcl$pch <- if(sum(!SI.c)>0) pch.sCI else NULL + lcl$lty <- if(sum(SI.c)>0) lty.sCI else NULL + lcl$col <- col.sCI + lcl$lwd <- if(sum(SI.c)>0) 2 else NULL + } + if( qqb$err["pw"] && qqb$err["sim"]){ + expression3 <- eval(substitute(expression(expression1, expression2))) + lcl$pch <- if(sum(!SI.c)>0) c(pch.pCI, pch.sCI) else NULL + lcl$lty <- if(sum(SI.c)>0) c(lty.pCI, lty.sCI) else NULL + lcl$col <- c(col.pCI,col.sCI) + lcl$lwd <- if(sum(SI.c)>0) 2 else NULL + } + do.call(legend, c(list(legend.pos, legend = expression3, bg = legend.bg, + merge = FALSE, cex = legend.cex), lcl)) + } + } + return(invisible(qqb)) +} + +.deleteItemsMCL <- function(mcl){ + mcl$n <- NULL + mcl$col.IdL <- mcl$alpha.CI <- mcl$lty.IdL <- NULL + mcl$col.NotInSupport <- mcl$check.NotInSupport <- NULL + mcl$exact.sCI <- mcl$exact.pCI <- NULL + mcl$withConf <- mcl$withConf.sim <- mcl$withConf.pw <- NULL + mcl$withIdLine <- mcl$distance <- NULL + mcl$col.pCI <- mcl$lty.pCI <- mcl$col.sCI <- mcl$lty.sCI <- NULL + mcl$lwd.IdL <- mcl$lwd.pCI <- mcl$lwd.sCI <- NULL + mcl$withLab <- mcl$lab.pts <- mcl$which.lbs <- NULL + mcl$which.Order <- mcl$order.traf <- NULL + mcl$col.pch <- mcl$cex.pch <- mcl$jit.fac <- NULL + mcl$col.lbl <- mcl$cex.lbl <- mcl$adj.lbl <- NULL + mcl$exp.cex2.pch <- mcl$exp.cex2.lbl <- NULL + mcl$exp.fadcol.pch <- mcl$exp.fadcol.lbl <- NULL + mcl$nosym.pCI <- mcl$n.CI <- mcl$n.adj <- NULL + mcl$legend.cex <- mcl$with.legend <- mcl$legend.bg <- NULL + mcl$legend.pos <- mcl$legend.pref <- mcl$legend.postf <- NULL + mcl$legend.alpha <- NULL +mcl} + +## helpers +.inGaps <- function(x,gapm){ + if(is.null(gapm)) return(rep(FALSE,length(x))) + fct <- function(x,m){ m[,2]>=x & m[,1]<=x} + sapply(x, function(y) length(which(fct(y,gapm)))>0) +} + +.isReplicated <- function(x){ + tx <- table(x) + rx <- as.numeric(names(tx[tx>1])) + sapply(x, function(y) any(abs(y-rx)<.Machine$double.eps)) +} + +.NotInSupport <- function(x,D){ + if(length(x)==0) return(logical(0)) + nInSupp <- which(x < q(D)(0)) + nInSupp <- unique(sort(c(nInSupp,which(x > q(D)(1))))) + + nInSuppo <- + if("support" %in% names(getSlots(class(D)))) + which( ! x %in% support(D)) else numeric(0) + if("gaps" %in% names(getSlots(class(D)))){ + InGap <- which( .inGaps(x,gaps(D))) + if("support" %in% names(getSlots(class(D)))) + nInSupp <- unique(sort(c(nInSupp, intersect(InGap,nInSuppo)))) + else + nInSupp <- unique(sort(c(nInSupp, InGap))) + }else{ + nInSupp <- unique(sort(c(nInSupp, nInSuppo))) + } + return((1:length(x)) %in% nInSupp) +} + +.SingleDiscrete <- function(x,D){ + ## produces a logical vector of + ## 0 : discrete mass point + ## 1 : within continuous support + ## 2 : left gap point + ## 3 : right gap point + ## 4 : not in support + lx <- x * 0 + + lx[.NotInSupport(x,D)] <- 4 + + idx.0 <- ((x>q(D)(1)) | (xq.ac(D)(1)) | (x0) + inCx <- gsub("expression\\(", "", gsub("\\)$","",inCx)) +if (length(inCx) > 1) { + inCx <- paste(inCx, c(rep(",", length(inCx)-1), ""), + sep = "", collapse = "\"\\n\",") + if ( any(as.logical(c(lapply(inp,is.language)))) | logic ) + inCx <- paste("expression(paste(", gsub("\\\\n"," ", inCx), "))", sep ="") + else + inCx <- paste("paste(",inCx,")", sep ="") +}else inCx <- paste("expression(paste(",inCx,"))",sep="") +outC <- eval(parse(text = eval(inCx))) +return(outC) +} + +#--------------------------------------------------- +### from packages stats: +#--------------------------------------------------- +format.perc <- function (probs, digits) +paste(format(100 * probs, trim = TRUE, scientific = FALSE, digits = digits), + "%") Modified: branches/distr-2.6/pkg/distrMod/R/AllPlot.R =================================================================== --- branches/distr-2.6/pkg/distrMod/R/AllPlot.R 2014-07-28 10:52:52 UTC (rev 945) +++ branches/distr-2.6/pkg/distrMod/R/AllPlot.R 2014-07-28 11:09:12 UTC (rev 946) @@ -47,7 +47,7 @@ iL <- length(to.draw[to.draw <= 3])+length(l2dpl) iLD <- (1:iL)[to.draw <= 3] iLL <- (1:iL)[to.draw > 3] - inner <- distr:::.fillList(inner,iL) + inner <- .fillList(inner,iL) innerD <- if(length(iLD)) inner[iLD] else NULL innerL <- if(length(iLL)) inner[iLL] else NULL }else{innerLog <- innerD <- innerL <- inner} @@ -115,7 +115,7 @@ lineT <- NA .mpresubs <- function(inx) - distr:::.presubs(inx, c("%C", "%D", "%A"), + .presubs(inx, c("%C", "%D", "%A"), c(as.character(class(x)[1]), as.character(date()), as.character(deparse(xc)))) Modified: branches/distr-2.6/pkg/distrMod/R/SimpleL2ParamFamilies.R =================================================================== --- branches/distr-2.6/pkg/distrMod/R/SimpleL2ParamFamilies.R 2014-07-28 10:52:52 UTC (rev 945) +++ branches/distr-2.6/pkg/distrMod/R/SimpleL2ParamFamilies.R 2014-07-28 11:09:12 UTC (rev 946) @@ -4,7 +4,7 @@ BinomFamily <- function(size = 1, prob = 0.5, trafo){ name <- "Binomial family" distribution <- Binom(size = size, prob = prob) - if(distr:::.isEqual(prob,0.5)) + if(.isEqual(prob,0.5)) distrSymm <- SphericalSymmetry(SymmCenter = size*prob) else distrSymm <- NoSymmetry() @@ -34,7 +34,7 @@ return(fct)} L2derivSymm <- FunSymmList(OddSymmetric(SymmCenter = size*prob)) L2derivDistr <- UnivarDistrList((distribution - size*prob)/(prob*(1-prob))) - if(distr:::.isEqual(prob,0.5)) + if(.isEqual(prob,0.5)) L2derivDistrSymm <- DistrSymmList(SphericalSymmetry(SymmCenter = 0)) else L2derivDistrSymm <- DistrSymmList(NoSymmetry()) Modified: branches/distr-2.6/pkg/distrMod/R/confint.R =================================================================== --- branches/distr-2.6/pkg/distrMod/R/confint.R 2014-07-28 10:52:52 UTC (rev 945) +++ branches/distr-2.6/pkg/distrMod/R/confint.R 2014-07-28 11:09:12 UTC (rev 946) @@ -26,7 +26,7 @@ ### code borrowed from confint.default from package stats a <- (1 - level)/2 a <- c(a, 1 - a) - pct <- stats:::format.perc(a, 3) + 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) Modified: branches/distr-2.6/pkg/distrMod/R/internalMleCalc.R =================================================================== --- branches/distr-2.6/pkg/distrMod/R/internalMleCalc.R 2014-07-28 10:52:52 UTC (rev 945) +++ branches/distr-2.6/pkg/distrMod/R/internalMleCalc.R 2014-07-28 11:09:12 UTC (rev 946) @@ -146,8 +146,6 @@ ########################################################################## -## caching to speed up things: -.inArgs <- distr:::.inArgs .callParamFamParameter <- function(PFam, theta, idx, nuis, fixed){ Modified: branches/distr-2.6/pkg/distrMod/R/qqplot.R =================================================================== --- branches/distr-2.6/pkg/distrMod/R/qqplot.R 2014-07-28 10:52:52 UTC (rev 945) +++ branches/distr-2.6/pkg/distrMod/R/qqplot.R 2014-07-28 11:09:12 UTC (rev 946) @@ -30,14 +30,7 @@ } -### helper functions from distr -.confqq <- distr:::.confqq -.isReplicated <- distr:::.isReplicated -.makeLenAndOrder <- distr:::.makeLenAndOrder -.inGaps <- distr:::.inGaps -.deleteItemsMCL <- distr:::.deleteItemsMCL -.NotInSupport <- distr:::.NotInSupport setMethod("qqplot", signature(x = "ANY", y = "UnivariateDistribution"),