[Distr-commits] r1146 - branches/distr-2.7/pkg/distr/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jul 8 13:24:37 CEST 2018
Author: ruckdeschel
Date: 2018-07-08 13:24:16 +0200 (Sun, 08 Jul 2018)
New Revision: 1146
Modified:
branches/distr-2.7/pkg/distr/R/AllInitialize.R
branches/distr-2.7/pkg/distr/R/ContDistribution.R
branches/distr-2.7/pkg/distr/R/Convpow.R
branches/distr-2.7/pkg/distr/R/DiscreteDistribution.R
branches/distr-2.7/pkg/distr/R/ExtraConvolutionMethods.R
branches/distr-2.7/pkg/distr/R/LatticeDistribution.R
branches/distr-2.7/pkg/distr/R/MinMaximum.R
branches/distr-2.7/pkg/distr/R/Truncate.R
branches/distr-2.7/pkg/distr/R/UnivarLebDecDistribution.R
branches/distr-2.7/pkg/distr/R/UnivarMixingDistribution.R
branches/distr-2.7/pkg/distr/R/getLow.R
branches/distr-2.7/pkg/distr/R/internalUtils_LCD.R
branches/distr-2.7/pkg/distr/R/internalUtils_trunc.R
branches/distr-2.7/pkg/distr/R/internals-qqplot.R
branches/distr-2.7/pkg/distr/R/liesInSupport.R
branches/distr-2.7/pkg/distr/R/makeAbscontDistribution.R
branches/distr-2.7/pkg/distr/R/plot-methods.R
branches/distr-2.7/pkg/distr/R/plot-methods_LebDec.R
branches/distr-2.7/pkg/distr/R/qqbounds.R
branches/distr-2.7/pkg/distr/R/qqplot.R
Log:
[branches: distr]: began with major update to version 2.7 / replace calls to q(distr) with q.l(distr) and http with https
Modified: branches/distr-2.7/pkg/distr/R/AllInitialize.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/AllInitialize.R 2018-07-08 11:16:55 UTC (rev 1145)
+++ branches/distr-2.7/pkg/distr/R/AllInitialize.R 2018-07-08 11:24:16 UTC (rev 1146)
@@ -1,5 +1,5 @@
#### as to whether to use Generating functions or to use initialize methods:
-#### http://tolstoy.newcastle.edu.au/R/e2/devel/07/01/1976.html
+#### https://tolstoy.newcastle.edu.au/R/e2/devel/07/01/1976.html
################################################################################
## SPACES
Modified: branches/distr-2.7/pkg/distr/R/ContDistribution.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/ContDistribution.R 2018-07-08 11:16:55 UTC (rev 1145)
+++ branches/distr-2.7/pkg/distr/R/ContDistribution.R 2018-07-08 11:24:16 UTC (rev 1146)
@@ -22,6 +22,7 @@
d1 <- d
wS <- .withSim
wA <- .withArith
+ q.l0 <- q
if(is.null(r)){
if(is.null(q)){
if(is.null(p)){
@@ -72,9 +73,9 @@
}
}
p <- .D2P(d = d1, ql = low1, qu = up1, ngrid = ngrid)
- q <- .P2Q(p = p, ql = low1, qu = up1, ngrid = ngrid,
+ q <- q.l0 <- .P2Q(p = p, ql = low1, qu = up1, ngrid = ngrid,
qL = low, qU = up)
- r <- function(n) q(runif(n))
+ r <- function(n) q.l0(runif(n))
}else{
if(is.null(low1)){
i <- 0; x0 <- -1
@@ -87,21 +88,22 @@
up1 <- x0
}
- q <- .P2Q(p = p, ql = low1, qu = up1, ngrid = ngrid,
+ q <- q.l0 <- .P2Q(p = p, ql = low1, qu = up1, ngrid = ngrid,
qL = low, qU = up)
- r <- function(n) q(runif(n))
+ r <- function(n) q.l0(runif(n))
if( is.null(d))
d <- .P2D(p = p, ql = low1, qu = up1, ngrid = ngrid)
}
}else{
+ q.l0 <- q
if(is.null(p))
- p <- .Q2P(q, ngrid = ngrid)
- r <- function(n) q(runif(n))
+ p <- .Q2P(q.l0, ngrid = ngrid)
+ r <- function(n) q.l0(runif(n))
if( is.null(d)){
if(is.null(low1))
- low1 <- q(ep)
+ low1 <- q.l0(ep)
if(is.null(up1))
- up1 <- q(1-ep)
+ up1 <- q.l0(1-ep)
d <- .P2D(p = p, ql = low1, qu = up1, ngrid = ngrid)
}
}
@@ -111,14 +113,15 @@
if(is.null(q)){
erg <- RtoDPQ(r = r, e = e, n = ngrid)
wS <- TRUE
- d <- erg$d; p <- erg$p; q<- erg$q
+ d <- erg$d; p <- erg$p; q<- q.l0<- erg$q
}else{
+ q.l0 <- q
p <- .Q2P(q, ngrid = ngrid)
if( is.null(d)){
if(is.null(low1))
- low1 <- q(ep)
+ low1 <- q.l0(ep)
if(is.null(up1))
- up1 <- q(1-ep)
+ up1 <- q.l0(1-ep)
d <- .P2D(p = p, ql = low1, qu = up1, ngrid = ngrid)
}
}
@@ -134,7 +137,7 @@
while(p(x0)< 1-ep && i < 20) x0 <- x0 * 2
up1 <- x0
}
- q <- .P2Q(p = p, ql = low1, qu = up1, ngrid = ngrid,
+ q <- q.l0 <- .P2Q(p = p, ql = low1, qu = up1, ngrid = ngrid,
qL = low, qU = up)
d <- .P2D(p = p, ql = low1, qu = up1, ngrid = ngrid)
}
@@ -192,7 +195,7 @@
}
p <- .D2P(d = d1, ql = low1, qu=up1, ngrid = ngrid)
- q <- .P2Q(p = p, ql = low1, qu=up1, ngrid = ngrid,
+ q <- q.l0 <- .P2Q(p = p, ql = low1, qu=up1, ngrid = ngrid,
qL = low, qU = up)
}else
p <- .Q2P(q, ngrid = ngrid)
@@ -208,13 +211,13 @@
while(p(x0)< 1-ep && i < 20) x0 <- x0 * 2
up1 <- x0
}
- q <- .P2Q(p = p, ql = low1, qu=up1, ngrid = ngrid,
+ q <- q.l0 <- .P2Q(p = p, ql = low1, qu=up1, ngrid = ngrid,
qL = low, qU = up)
}
}
}
}
- obj <- new("AbscontDistribution", r = r, d = d1, p = p, q = q,
+ obj <- new("AbscontDistribution", r = r, d = d1, p = p, q = q.l0,
gaps = gaps, param = param, img = img, .withSim = wS,
.withArith = wA, .lowerExact = .lowerExact, .logExact = .logExact,
Symmetry = Symmetry)
@@ -256,8 +259,8 @@
upper <- getUp(object, eps = getdistrOption("TruncQuantile")*2)
#lower <- 0 ; upper <- 8
dist <- upper - lower
- low1 <- max(q(object)(0),lower-0.1*dist)
- upp1 <- min(q(object)(1),upper+0.1*dist)
+ low1 <- max(q.l(object)(0),lower-0.1*dist)
+ upp1 <- min(q.l(object)(1),upper+0.1*dist)
grid <- seq(from = low1, to = upp1, length = ngrid)
dxg <- d(object)(grid)
@@ -322,9 +325,9 @@
## quantile function
- yL <- if ((q(e1)(0) == -Inf)||(q(e2)(0) == -Inf))
+ yL <- if ((q.l(e1)(0) == -Inf)||(q.l(e2)(0) == -Inf))
-Inf else getLow(e1)+getLow(e2)
- yR <- if ((q(e1)(1) == Inf)||(q(e2)(1) == Inf))
+ yR <- if ((q.l(e1)(1) == Inf)||(q.l(e2)(1) == Inf))
Inf else getUp(e1)+getUp(e2)
px.l <- pfun(x + 0.5*h)
@@ -352,8 +355,8 @@
###setMethod("m1df", "AbscontDistribution",
### function(object){
-### lower <- q(object)(TruncQuantile)
-### upper <- q(object)(1 - TruncQuantile)
+### lower <- q.l(object)(TruncQuantile)
+### upper <- q.l(object)(1 - TruncQuantile)
###
### gitter.x <- seq(from = lower, to = upper, length = DefaultNrGridPoints)
###
@@ -369,8 +372,8 @@
###setMethod("m2df", "AbscontDistribution",
### function(object){
-### lower <- q(object)(TruncQuantile)
-### upper <- q(object)(1 - TruncQuantile)
+### lower <- q.l(object)(TruncQuantile)
+### upper <- q.l(object)(1 - TruncQuantile)
###
### gitter.x <- seq(from = lower, to = upper, length = DefaultNrGridPoints)
###
@@ -426,7 +429,7 @@
n <- 10^getdistrOption("RtoDPQ.e")+1
u <- seq(0,1,length=n+1); u <- (u[1:n]+u[2:(n+1)])/2
- y <- callGeneric(q(x)(u))
+ y <- callGeneric(q.l(x)(u))
DPQnew <- RtoDPQ(r=rnew, y=y)
object <- AbscontDistribution(d = DPQnew$d, p = DPQnew$p,
@@ -466,18 +469,18 @@
else
quote({log(1-p(xx)(q))})
- qxlog <- if("lower.tail" %in% names(formals(q(xx))))
+ qxlog <- if("lower.tail" %in% names(formals(q.l(xx))))
quote({qx <- if(lower.tail)
- q(xx)((1+p1)/2)
+ q.l(xx)((1+p1)/2)
else
- q(xx)(p1/2,lower.tail=FALSE)})
+ q.l(xx)(p1/2,lower.tail=FALSE)})
else
- quote({qx <- q(xx)(if(lower.tail) (1+p1)/2 else 1-p1/2)})
- if("lower.tail" %in% names(formals(q(xx)))&&
- "log.p" %in% names(formals(q(xx))))
- qxlog <- quote({qx <- if(lower.tail) q(xx)((1+p1)/2)
+ quote({qx <- q.l(xx)(if(lower.tail) (1+p1)/2 else 1-p1/2)})
+ if("lower.tail" %in% names(formals(q.l(xx)))&&
+ "log.p" %in% names(formals(q.l(xx))))
+ qxlog <- quote({qx <- if(lower.tail) q.l(xx)((1+p1)/2)
else
- q(xx)(if(log.p)p-log(2)
+ q.l(xx)(if(log.p)p-log(2)
else p1/2,lower.tail=FALSE,log.p=log.p)})
dnew <- function(x, log = FALSE){}
body(dnew) <- substitute({
@@ -552,7 +555,7 @@
px.l <- pnew(x.g + 0.5*h)
px.u <- pnew(x.g + 0.5*h, lower.tail = FALSE)
- yR <- max(q(xx)(1), abs(q(xx)(0)))
+ yR <- max(q.l(xx)(1), abs(q.l(xx)(0)))
qnew <- .makeQNew(x.g + 0.5*h, px.l, px.u,
notwithLLarg = FALSE, lower, yR)
@@ -650,7 +653,7 @@
n <- 10^getdistrOption("RtoDPQ.e")+1
u <- seq(0,1,length=n+1); u <- (u[1:n]+u[2:(n+1)])/2
- y <- lgamma(q(x)(u))
+ y <- lgamma(q.l(x)(u))
DPQnew <- RtoDPQ(r=rnew, y=y)
object <- AbscontDistribution( r = rnew, d = DPQnew$d, p = DPQnew$p,
@@ -664,7 +667,7 @@
body(rnew) <- substitute({ gamma(g(n, ...)) }, list(g = x at r))
n <- 10^getdistrOption("RtoDPQ.e")+1
u <- seq(0,1,length=n+1); u <- (u[1:n]+u[2:(n+1)])/2
- y <- gamma(q(x)(u))
+ y <- gamma(q.l(x)(u))
DPQnew <- RtoDPQ(r=rnew, y=y)
object <- AbscontDistribution( r = rnew, d = DPQnew$d, p = DPQnew$p,
@@ -687,8 +690,8 @@
setMethod("q.r", signature(object = "AbscontDistribution"),
function(object){
if(!is.null(gaps(object)))
- .modifyqgaps(pfun = p(object), qfun = q(object),
+ .modifyqgaps(pfun = p(object), qfun = q.l(object),
gaps = gaps(object), leftright = "right")
else
- q(object)
+ q.l(object)
})
Modified: branches/distr-2.7/pkg/distr/R/Convpow.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/Convpow.R 2018-07-08 11:16:55 UTC (rev 1145)
+++ branches/distr-2.7/pkg/distr/R/Convpow.R 2018-07-08 11:24:16 UTC (rev 1146)
@@ -55,8 +55,8 @@
## continuity correction by h/2
## quantile function
- yL <- if (q(D1)(0) == -Inf) -Inf else N*lower
- yR <- if (q(D1)(1) == Inf) Inf else N*upper
+ yL <- if (q.l(D1)(0) == -Inf) -Inf else N*lower
+ yR <- if (q.l(D1)(1) == Inf) Inf else N*upper
px.l <- pfun(x + 0.5*h)
px.u <- pfun(x + 0.5*h, lower.tail = FALSE)
qfun <- .makeQNew(x + 0.5*h, px.l, px.u, .notwithLArg(D1), yL, yR)
Modified: branches/distr-2.7/pkg/distr/R/DiscreteDistribution.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/DiscreteDistribution.R 2018-07-08 11:16:55 UTC (rev 1145)
+++ branches/distr-2.7/pkg/distr/R/DiscreteDistribution.R 2018-07-08 11:24:16 UTC (rev 1146)
@@ -117,8 +117,8 @@
### right continuous quantile function
setMethod("q.r", "DiscreteDistribution", function(object){
- if (.inArgs("log.p", q(object))){
- if (.inArgs("lower.tail", q(object))){
+ if (.inArgs("log.p", q.l(object))){
+ if (.inArgs("lower.tail", q.l(object))){
function(p, lower.tail = TRUE, log.p = FALSE){
s <- support(object)
psx <- p(object)(s, lower.tail = lower.tail,
@@ -127,7 +127,7 @@
o.warn <- getOption("warn"); options(warn = -2)
on.exit(options(warn=o.warn))
- qx0 <- q(object)(ps0, lower.tail = lower.tail,
+ qx0 <- q.l(object)(ps0, lower.tail = lower.tail,
log.p = log.p)
options(warn = o.warn)
@@ -151,7 +151,7 @@
o.warn <- getOption("warn"); options(warn = -2)
on.exit(options(warn=o.warn))
- qx0 <- q(object)(ps0, lower.tail = lower.tail,
+ qx0 <- q.l(object)(ps0, lower.tail = lower.tail,
log.p = log.p)
options(warn = o.warn)
@@ -168,7 +168,7 @@
}
}
}else{
- if (.inArgs("lower.tail", q(object))){
+ if (.inArgs("lower.tail", q.l(object))){
function(p, lower.tail = TRUE, log.p = FALSE){
if (log.p) p <- exp(p)
s <- support(object)
@@ -177,7 +177,7 @@
o.warn <- getOption("warn"); options(warn = -2)
on.exit(options(warn=o.warn))
- qx0 <- q(object)(ps0, lower.tail = lower.tail,
+ qx0 <- q.l(object)(ps0, lower.tail = lower.tail,
log.p = log.p)
options(warn = o.warn)
@@ -202,7 +202,7 @@
o.warn <- getOption("warn"); options(warn = -2)
on.exit(options(warn=o.warn))
- qx0 <- q(object)(ps0, lower.tail = lower.tail,
+ qx0 <- q.l(object)(ps0, lower.tail = lower.tail,
log.p = log.p)
options(warn = o.warn)
@@ -332,18 +332,18 @@
quote({log(1-p(x)(q))})
- qxlog <- if("lower.tail" %in% names(formals(q(x))))
+ qxlog <- if("lower.tail" %in% names(formals(q.l(x))))
quote({qx <- if(lower.tail)
- q(x)((1+p1)/2)
+ q.l(x)((1+p1)/2)
else
- q(x)(p1/2,lower.tail=FALSE)})
+ q.l(x)(p1/2,lower.tail=FALSE)})
else
- quote({qx <- q(x)(if(lower.tail) (1+p1)/2 else 1-p1/2)})
- if("lower.tail" %in% names(formals(q(x)))&&
- "log.p" %in% names(formals(q(x))))
- qxlog <- quote({qx <- if(lower.tail) q(x)((1+p1)/2)
+ quote({qx <- q.l(x)(if(lower.tail) (1+p1)/2 else 1-p1/2)})
+ if("lower.tail" %in% names(formals(q.l(x)))&&
+ "log.p" %in% names(formals(q.l(x))))
+ qxlog <- quote({qx <- if(lower.tail) q.l(x)((1+p1)/2)
else
- q(x)(if(log.p)p-log(2)
+ q.l(x)(if(log.p)p-log(2)
else p1/2,lower.tail=FALSE,log.p=log.p)})
Modified: branches/distr-2.7/pkg/distr/R/ExtraConvolutionMethods.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/ExtraConvolutionMethods.R 2018-07-08 11:16:55 UTC (rev 1145)
+++ branches/distr-2.7/pkg/distr/R/ExtraConvolutionMethods.R 2018-07-08 11:24:16 UTC (rev 1146)
@@ -117,9 +117,9 @@
.notwithLArg(e1)||.notwithLArg(e2), pxl = pl , pxu = pu)
}
## quantile function
- yL <- if ((q(e1)(0) == -Inf)||(q(e2)(0) == -Inf))
+ yL <- if ((q.l(e1)(0) == -Inf)||(q.l(e2)(0) == -Inf))
-Inf else lower
- yR <- if ((q(e1)(1) == Inf)||(q(e2)(1) == Inf))
+ yR <- if ((q.l(e1)(1) == Inf)||(q.l(e2)(1) == Inf))
Inf else upper
## contintuity correction
Modified: branches/distr-2.7/pkg/distr/R/LatticeDistribution.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/LatticeDistribution.R 2018-07-08 11:16:55 UTC (rev 1145)
+++ branches/distr-2.7/pkg/distr/R/LatticeDistribution.R 2018-07-08 11:24:16 UTC (rev 1146)
@@ -82,7 +82,7 @@
}
return(new("LatticeDistribution", r = r(D), d = d(D),
- q = q(D), p = p(D), support = supp,
+ q = q.l(D), p = p(D), support = supp,
lattice = lattice, .withArith = .withArith,
.withSim = .withSim, Symmetry = Symmetry))
}
@@ -99,7 +99,7 @@
.withSim = .withSim,
Symmetry = Symmetry )
return(new("LatticeDistribution", r = r(D), d = d(D),
- q = q(D), p = p(D), support = supp,
+ q = q.l(D), p = p(D), support = supp,
lattice = lattice, .withArith = .withArith,
.withSim = .withSim, Symmetry = Symmetry))
}else{
@@ -118,7 +118,7 @@
.withSim = .withSim,
Symmetry = Symmetry )
return(new("LatticeDistribution", r = r(D), d = d(D),
- q = q(D), p = p(D), support = supp,
+ q = q.l(D), p = p(D), support = supp,
lattice = lattice, .withArith = .withArith,
.withSim = .withSim, Symmetry = Symmetry))
}
Modified: branches/distr-2.7/pkg/distr/R/MinMaximum.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/MinMaximum.R 2018-07-08 11:16:55 UTC (rev 1145)
+++ branches/distr-2.7/pkg/distr/R/MinMaximum.R 2018-07-08 11:24:16 UTC (rev 1146)
@@ -42,8 +42,8 @@
xseq <- seq(from = qL1, to = qU1, by = h)
px.l <- pnew(xseq, lower.tail = TRUE)
px.u <- pnew(xseq, lower.tail = FALSE)
- qL2 <- min(q(e1)(0),q(e2)(0))
- qU2 <- max(q(e1)(1),q(e2)(1))
+ qL2 <- min(q.l(e1)(0),q.l(e2)(0))
+ qU2 <- max(q.l(e1)(1),q.l(e2)(1))
qnew <- .makeQNew(xseq, px.l, px.u, FALSE, qL2, qU2)
@@ -183,8 +183,8 @@
}
## new quantile function
- qL <- q(e1)(0)
- qU <- q(e1)(1)
+ qL <- q.l(e1)(0)
+ qU <- q.l(e1)(1)
ql <- getLow(e1)
qu <- getUp(e1)
Modified: branches/distr-2.7/pkg/distr/R/Truncate.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/Truncate.R 2018-07-08 11:16:55 UTC (rev 1145)
+++ branches/distr-2.7/pkg/distr/R/Truncate.R 2018-07-08 11:24:16 UTC (rev 1146)
@@ -87,8 +87,8 @@
xseq <- seq(from = qL1, to = qU1, by = h)
px.l <- pnew(xseq, lower.tail = TRUE)
px.u <- pnew(xseq, lower.tail = FALSE)
- qL2 <- max(q(object)(0),lower)
- qU2 <- min(q(object)(1),upper)
+ qL2 <- max(q.l(object)(0),lower)
+ qU2 <- min(q.l(object)(1),upper)
qnew <- .makeQNew(xseq, px.l, px.u, FALSE, qL2, qU2)
@@ -113,9 +113,9 @@
if(is.finite(Length(lattice(object)))||
!.logExact(object)||
(width(lattice(object)) < 0 &&
- lower > q(object)(getdistrOption("TruncQuantile")))||
+ lower > q.l(object)(getdistrOption("TruncQuantile")))||
(width(lattice(object)) > 0 &&
- upper < q(object)(getdistrOption("TruncQuantile"),
+ upper < q.l(object)(getdistrOption("TruncQuantile"),
lower.tail = FALSE))
){
erg <- getMethod("Truncate","DiscreteDistribution")(object,
Modified: branches/distr-2.7/pkg/distr/R/UnivarLebDecDistribution.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/UnivarLebDecDistribution.R 2018-07-08 11:16:55 UTC (rev 1145)
+++ branches/distr-2.7/pkg/distr/R/UnivarLebDecDistribution.R 2018-07-08 11:24:16 UTC (rev 1146)
@@ -235,7 +235,7 @@
setMethod("q.r", "UnivarLebDecDistribution", function(object){
ep <- getdistrOption("TruncQuantile")
- if(discreteWeight(object)<ep) return(q(object))
+ if(discreteWeight(object)<ep) return(q.l(object))
supp <- support(object)
gaps <- gaps(object)
aP <- acPart(object)
Modified: branches/distr-2.7/pkg/distr/R/UnivarMixingDistribution.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/UnivarMixingDistribution.R 2018-07-08 11:16:55 UTC (rev 1145)
+++ branches/distr-2.7/pkg/distr/R/UnivarMixingDistribution.R 2018-07-08 11:24:16 UTC (rev 1146)
@@ -98,10 +98,10 @@
setMethod("q.r", signature(object = "UnivarMixingDistribution"),
function(object){
if(!is.null(gaps(object)))
- .modifyqgaps(pfun = p(object), qfun = q(object),
+ .modifyqgaps(pfun = p(object), qfun = q.l(object),
gaps = gaps(object), leftright = "right")
else
- q(object)
+ q.l(object)
})
#------------------------------------------------------------------------
Modified: branches/distr-2.7/pkg/distr/R/getLow.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/getLow.R 2018-07-08 11:16:55 UTC (rev 1145)
+++ branches/distr-2.7/pkg/distr/R/getLow.R 2018-07-08 11:24:16 UTC (rev 1146)
@@ -4,51 +4,51 @@
setMethod("getLow", "AbscontDistribution",
function(object, eps = getdistrOption("TruncQuantile")) {
- q0 <- q(object)(0)
+ q0 <- q.l(object)(0)
if (q0 > - Inf){
return(q0)
}else{
- qF <- q(object)
+ qF <- q.l(object)
qe <- qF(eps)
if (!is.na(qe) && qe > -Inf)
return(qe)
else{
if(.inArgs("log.p",qF))
- return(qF(p = .fm(x = .5, f = q(object)),
+ return(qF(p = .fm(x = .5, f = q.l(object)),
log.p = TRUE))
else
- return(qF(p = exp(.fm(x = .5, f = q(object)))))
+ return(qF(p = exp(.fm(x = .5, f = q.l(object)))))
}
}
})
setMethod("getUp", "AbscontDistribution",
function(object, eps = getdistrOption("TruncQuantile")) {
- q1 <- q(object)(1)
+ q1 <- q.l(object)(1)
if (q1 < Inf){
return(q1)
}else{
- qF <- q(object)
+ qF <- q.l(object)
if (.inArgs("lower.tail", qF)){
qe <- qF(eps, lower.tail = FALSE)
if (!is.na(qe) && qe < Inf)
return(qe)
else{
if(.inArgs("log.p",qF))
- return(qF(p = .fM2(x = .5, f = q(object)),
+ return(qF(p = .fM2(x = .5, f = q.l(object)),
log.p = TRUE))
else
- return(qF(p = exp(.fM2(x = .5, f = q(object)))))
+ return(qF(p = exp(.fM2(x = .5, f = q.l(object)))))
}
}else{
- qe <- q(object)(1-eps)
+ qe <- q.l(object)(1-eps)
if (!is.na(qe) && qe < Inf)
return(qe)
else{
if(.inArgs("log.p",qF))
- return(qF(p = .fM(x = .5, f = q(object)),
+ return(qF(p = .fM(x = .5, f = q.l(object)),
log.p = TRUE))
else
- return(qF(p = exp(.fM(x = .5, f = q(object)))))
+ return(qF(p = exp(.fM(x = .5, f = q.l(object)))))
}
}
}
@@ -61,32 +61,32 @@
setMethod("getLow", "LatticeDistribution",
function(object, ...){
lattice <- lattice(object)
- qF <- q(object)
+ qF <- q.l(object)
if(is.finite(Length(lattice)) || width(lattice)>0)
return(min(support(object)))
if(.inArgs("log.p",qF))
- return(qF(p = .fm(x = .5, f = q(object)), log.p = TRUE))
+ return(qF(p = .fm(x = .5, f = q.l(object)), log.p = TRUE))
else
- return(qF(p = exp(.fm(x = .5, f = q(object)))))
+ return(qF(p = exp(.fm(x = .5, f = q.l(object)))))
})
setMethod("getUp", "LatticeDistribution",
function(object, ...){
lattice <- lattice(object)
if(is.finite(Length(lattice)) || width(lattice)<0)
return(max(support(object)))
- qF <- q(object)
+ qF <- q.l(object)
if (.inArgs("lower.tail", qF)){
if(.inArgs("log.p",qF))
- return(qF(p = .fM(x = .5, f = q(object)),
+ return(qF(p = .fM(x = .5, f = q.l(object)),
log.p = TRUE))
else
- return(qF(p = exp(.fM(x = .5, f = q(object)))))
+ return(qF(p = exp(.fM(x = .5, f = q.l(object)))))
}
if(.inArgs("log.p",qF))
- return(qF(p = .fM2(x = .5, f = q(object)),
+ return(qF(p = .fM2(x = .5, f = q.l(object)),
lower.tail = FALSE, log.p = TRUE))
else
- return(qF(p = exp(.fM2(x = .5, f = q(object))),
+ return(qF(p = exp(.fM2(x = .5, f = q.l(object))),
lower.tail = FALSE))
})
Modified: branches/distr-2.7/pkg/distr/R/internalUtils_LCD.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/internalUtils_LCD.R 2018-07-08 11:16:55 UTC (rev 1145)
+++ branches/distr-2.7/pkg/distr/R/internalUtils_LCD.R 2018-07-08 11:24:16 UTC (rev 1146)
@@ -185,7 +185,7 @@
.loupmixfun <- function(mixDistr){
if(length(mixDistr)==0) return(list(qL = NA, ql = NA, qU = NA, qu = NA))
if(length(mixDistr)==1){
- q1 <- q(mixDistr[[1]])
+ q1 <- q.l(mixDistr[[1]])
return(list(qL = q1(p = 0, lower.tail = TRUE),
ql = q1(p = getdistrOption("TruncQuantile"), lower.tail = TRUE),
qU = q1(p = 0, lower.tail = FALSE),
Modified: branches/distr-2.7/pkg/distr/R/internalUtils_trunc.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/internalUtils_trunc.R 2018-07-08 11:16:55 UTC (rev 1145)
+++ branches/distr-2.7/pkg/distr/R/internalUtils_trunc.R 2018-07-08 11:24:16 UTC (rev 1146)
@@ -2,7 +2,7 @@
ep <- .Machine$double.eps^2
plN <- p(object)(upper, lower.tail = TRUE, log.p=TRUE)
rnew <- function(n){
- q(object)(plN-rexp(n), lower.tail = TRUE, log.p=TRUE)
+ q.l(object)(plN-rexp(n), lower.tail = TRUE, log.p=TRUE)
}
pnew <- function(q, lower.tail = TRUE, log.p = FALSE){
indNA <- is.na(q)
@@ -44,15 +44,15 @@
q0 <- 0*p
q0[ind1] <- NA
q0[indis1] <- if(lower.tail)
- upper else q(object)(0)
+ upper else q.l(object)(0)
q0[indis0] <- if(lower.tail)
- q(object)(0) else upper
+ q.l(object)(0) else upper
p1 <- p[in01]
if(log.p && lower.tail) p1l <- plN + p1
else{ if(log.p) p1 <- exp(p1)
p1l <- plN + if(lower.tail) log(p1) else log(1-p1)
}
- q0[in01] <- q(object)(p1l, log.p = TRUE)
+ q0[in01] <- q.l(object)(p1l, log.p = TRUE)
q0[indNA] <- NA
return(q0)
@@ -67,7 +67,7 @@
Qr <- q.r(object)
}else{
Pl <- p(object)
- Qr <- q(object)
+ Qr <- q.l(object)
}
plN <- Pl(lower, lower.tail = FALSE, log.p = TRUE)
rnew <- function(n){
@@ -113,14 +113,14 @@
q0 <- 0*p
q0[ind1] <- NA
q0[indis1] <- if(lower.tail)
- q(object)(1) else lower
+ q.l(object)(1) else lower
q0[indis0] <- if(lower.tail)
- lower else q(object)(1)
+ lower else q.l(object)(1)
p1 <- p[in01]
if(log.p && !lower.tail) p1l <- plN + p1
else{ if(log.p) p1 <- exp(p1)
p1l <- plN + if(lower.tail) log(1-p1) else log(p1) }
- q0[in01] <- q(object)(p1l, lower.tail = FALSE, log.p = TRUE)
+ q0[in01] <- q.l(object)(p1l, lower.tail = FALSE, log.p = TRUE)
q0[indNA] <- NA
return(q0)
}
Modified: branches/distr-2.7/pkg/distr/R/internals-qqplot.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/internals-qqplot.R 2018-07-08 11:16:55 UTC (rev 1145)
+++ branches/distr-2.7/pkg/distr/R/internals-qqplot.R 2018-07-08 11:24:16 UTC (rev 1146)
@@ -18,8 +18,8 @@
.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)))))
+ nInSupp <- which(x < q.l(D)(0))
+ nInSupp <- unique(sort(c(nInSupp,which(x > q.l(D)(1)))))
nInSuppo <-
if("support" %in% names(getSlots(class(D))))
@@ -48,7 +48,7 @@
lx[.NotInSupport(x,D)] <- 4
- idx.0 <- ((x>q(D)(1)) | (x<q(D)(0)))
+ idx.0 <- ((x>q.l(D)(1)) | (x<q.l(D)(0)))
iG <- rep(FALSE,length(x))
if(is(D, "DiscreteDistribution")){
Modified: branches/distr-2.7/pkg/distr/R/liesInSupport.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/liesInSupport.R 2018-07-08 11:16:55 UTC (rev 1145)
+++ branches/distr-2.7/pkg/distr/R/liesInSupport.R 2018-07-08 11:24:16 UTC (rev 1146)
@@ -14,14 +14,14 @@
setMethod("liesInSupport", signature(object = "AbscontDistribution",
x = "numeric"),
function(object, x){
- if(!is.nan(q(object)(0)))
- low <- q(object)(0)
+ if(!is.nan(q.l(object)(0)))
+ low <- q.l(object)(0)
else
- low <- q(object)(10*.Machine$double.eps)
- if(!is.nan(q(object)(1)))
- upp <- q(object)(1)
+ low <- q.l(object)(10*.Machine$double.eps)
+ if(!is.nan(q.l(object)(1)))
+ upp <- q.l(object)(1)
else
- upp <- q(object)(1-10*.Machine$double.eps)
+ upp <- q.l(object)(1-10*.Machine$double.eps)
(x >= low)&(x <= upp)
})
Modified: branches/distr-2.7/pkg/distr/R/makeAbscontDistribution.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/makeAbscontDistribution.R 2018-07-08 11:16:55 UTC (rev 1145)
+++ branches/distr-2.7/pkg/distr/R/makeAbscontDistribution.R 2018-07-08 11:24:16 UTC (rev 1146)
@@ -8,8 +8,8 @@
if(missing(img)) img0 <- img(object)
if(is.null(img)) img0 <- img(object)
pfun <- p(object)
- low0 <- q(object)(0)*1.001
- up0 <- q(object)(1)*1.001
+ low0 <- q.l(object)(0)*1.001
+ up0 <- q.l(object)(1)*1.001
low1 <- getLow(object,ep)*1.001
up1 <- getUp(object,ep)*1.001
wS <- object at .withSim
Modified: branches/distr-2.7/pkg/distr/R/plot-methods.R
===================================================================
--- branches/distr-2.7/pkg/distr/R/plot-methods.R 2018-07-08 11:16:55 UTC (rev 1145)
+++ branches/distr-2.7/pkg/distr/R/plot-methods.R 2018-07-08 11:24:16 UTC (rev 1146)
@@ -201,7 +201,7 @@
lower0 <- getLow(x, eps = getdistrOption("TruncQuantile")*2)
upper0 <- getUp(x, eps = getdistrOption("TruncQuantile")*2)
- me <- q(x)(1/2); s <- q(x)(3/4)-q(x)(1/4)
+ me <- q.l(x)(1/2); s <- q.l(x)(3/4)-q.l(x)(1/4)
lower1 <- me - 6 * s
upper1 <- me + 6 * s
lower <- max(lower0, lower1)
@@ -267,8 +267,8 @@
options(warn = -1)
}
- if(is.finite(q(x)(0))) {grid <- c(q(x)(0),grid); pxg <- c(0,pxg)}
- if(is.finite(q(x)(1))) {grid <- c(grid,q(x)(1)); pxg <- c(pxg,1)}
+ if(is.finite(q.l(x)(0))) {grid <- c(q.l(x)(0),grid); pxg <- c(0,pxg)}
+ if(is.finite(q.l(x)(1))) {grid <- c(grid,q.l(x)(1)); pxg <- c(pxg,1)}
if(2%in%to.draw){
dots.lowlevel$panel.first <- pF[[plotCount]]
@@ -288,7 +288,7 @@
### quantiles
### fix finite support bounds
- ixg <- grid>=max(q(x)(0),lower) & grid <= min(q(x)(1),upper)
+ ixg <- grid>=max(q.l(x)(0),lower) & grid <= min(q.l(x)(1),upper)
pxg <- pxg[ixg]
grid <- grid[ixg]
[TRUNCATED]
To get the complete diff run:
svnlook diff /svnroot/distr -r 1146
More information about the Distr-commits
mailing list