[Distr-commits] r1164 - branches/distr-2.7/pkg/distrMod/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jul 8 14:21:57 CEST 2018
Author: ruckdeschel
Date: 2018-07-08 14:21:29 +0200 (Sun, 08 Jul 2018)
New Revision: 1164
Modified:
branches/distr-2.7/pkg/distrMod/R/0distrModUtils.R
branches/distr-2.7/pkg/distrMod/R/L2GroupFamilies.R
branches/distr-2.7/pkg/distrMod/R/qqplot.R
branches/distr-2.7/pkg/distrMod/R/returnlevelplot.R
Log:
[branches: distrMod]: began with major update to version 2.7 / in R-code changed calls to q(.) to q.l(.) and added a default value for adj.lbl in returnlevelplot.R
Modified: branches/distr-2.7/pkg/distrMod/R/0distrModUtils.R
===================================================================
--- branches/distr-2.7/pkg/distrMod/R/0distrModUtils.R 2018-07-08 12:15:29 UTC (rev 1163)
+++ branches/distr-2.7/pkg/distrMod/R/0distrModUtils.R 2018-07-08 12:21:29 UTC (rev 1164)
@@ -16,8 +16,8 @@
lowerTruncQuantile = getdistrExOption("ElowerTruncQuantile"),
upperTruncQuantile = getdistrExOption("EupperTruncQuantile"),
IQR.fac = getdistrExOption("IQR.fac")){
- low0 <- q(distr)(lowerTruncQuantile)
- upp0 <- q(distr)(upperTruncQuantile,lower.tail=FALSE)
+ low0 <- q.l(distr)(lowerTruncQuantile)
+ upp0 <- q.l(distr)(upperTruncQuantile,lower.tail=FALSE)
me <- median(distr)
s1 <- IQR(distr)
low1 <- me - IQR.fac * s1
@@ -116,8 +116,8 @@
distr <- L2Fam at distribution
### get a sensible integration range:
- low0 <- q(distr)(TruncQuantile)
- up0 <- q(distr)(TruncQuantile, lower.tail = FALSE)
+ low0 <- q.l(distr)(TruncQuantile)
+ up0 <- q.l(distr)(TruncQuantile, lower.tail = FALSE)
m0 <- median(distr); s0 <- IQR(distr)
low1 <- m0 - IQR.fac * s0
up1 <- m0 + IQR.fac * s0
@@ -125,8 +125,8 @@
### get a sensible integration range:
if(missing(mu)) mu <- distr
- low0.mu <- q(mu)(TruncQuantile)
- up0.mu <- q(mu)(TruncQuantile, lower.tail = FALSE)
+ low0.mu <- q.l(mu)(TruncQuantile)
+ up0.mu <- q.l(mu)(TruncQuantile, lower.tail = FALSE)
m0.mu <- median(mu); s0.mu <- IQR(mu)
low1.mu <- m0.mu - IQR.fac * s0.mu
up1.mu <- m0.mu + IQR.fac * s0.mu
@@ -138,7 +138,7 @@
else
{if(is(distr,"AbscontDistribution")){
x.seq0 <- seq(low, up, length = N1)
- h0 <- x.seq0[1:2]%*%c(-1,1)
+ h0 <- diff(x.seq0[2:1])
x.seq <- x.seq0[odd]
}else{
x.seq <- seq(low,up, length = N)
@@ -149,7 +149,7 @@
else
{if(is(mu,"AbscontDistribution")){
x.mu.seq0 <- seq(low.mu, up.mu, length = N1)
- h0.mu <- x.mu.seq0[1:2]%*%c(-1,1)
+ h0.mu <- diff(x.mu.seq0[2:1])
x.mu.seq <- x.mu.seq0[odd]
}else{
x.mu.seq <- seq(low.mu, up.mu, length = N)
@@ -618,8 +618,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))))
@@ -647,7 +647,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/distrMod/R/L2GroupFamilies.R
===================================================================
--- branches/distr-2.7/pkg/distrMod/R/L2GroupFamilies.R 2018-07-08 12:15:29 UTC (rev 1163)
+++ branches/distr-2.7/pkg/distrMod/R/L2GroupFamilies.R 2018-07-08 12:21:29 UTC (rev 1164)
@@ -333,7 +333,7 @@
}
mad.const <- 1/ if (is(distrSymm, "NoSymmetry"))
- mad(centraldistribution) else q(centraldistribution)(.75)
+ mad(centraldistribution) else q.l(centraldistribution)(.75)
param0 <- c(loc, scale)
names(param0) <- locscalename
Modified: branches/distr-2.7/pkg/distrMod/R/qqplot.R
===================================================================
--- branches/distr-2.7/pkg/distrMod/R/qqplot.R 2018-07-08 12:15:29 UTC (rev 1163)
+++ branches/distr-2.7/pkg/distrMod/R/qqplot.R 2018-07-08 12:21:29 UTC (rev 1164)
@@ -122,7 +122,7 @@
ord.x <- order(xj)
pp <- ppoints(n)
- yc <- q(y)(pp)
+ yc <- q.l(y)(pp)
yc.o <- yc
@@ -146,9 +146,9 @@
if(check.NotInSupport){
xo <- x[ord.x]
- nInSupp <- which(xo < q(y)(0))
+ nInSupp <- which(xo < q.l(y)(0))
- nInSupp <- unique(sort(c(nInSupp,which( xo > q(y)(1)))))
+ nInSupp <- unique(sort(c(nInSupp,which( xo > q.l(y)(1)))))
if("support" %in% names(getSlots(class(y))))
nInSupp <- unique(sort(c(nInSupp,which( ! xo %in% support(y)))))
if("gaps" %in% names(getSlots(class(y))))
Modified: branches/distr-2.7/pkg/distrMod/R/returnlevelplot.R
===================================================================
--- branches/distr-2.7/pkg/distrMod/R/returnlevelplot.R 2018-07-08 12:15:29 UTC (rev 1163)
+++ branches/distr-2.7/pkg/distrMod/R/returnlevelplot.R 2018-07-08 12:21:29 UTC (rev 1164)
@@ -54,7 +54,7 @@
col.pch = par("col"),## color for the plotted symbols
cex.lbl = par("cex"),## magnification factor for the plotted observation labels
col.lbl = par("col"),## color for the plotted observation labels
- adj.lbl = NULL, ## adj parameter for the plotted observation labels
+ adj.lbl = par("adj"),## adj parameter for the plotted observation labels
alpha.trsp = NA, ## alpha transparency to be added afterwards
jit.fac = 0, ## jittering factor used for discrete distributions
jit.tol = .Machine$double.eps, ## tolerance for jittering: if distance
@@ -120,13 +120,13 @@
}
pp <- ppoints(length(xj))
- yc.o <- q(y)(pp)
+ yc.o <- q.l(y)(pp)
ycl <- p2rl(yc.o)
### extend range somewhat
# pyn <- p(y)(10^(seq(-1, 3.75 + log10(npy), by = 0.1)))
xyall <- force(sort(unique(c(yc.o,x,
- q(y)(c(seq(0.01, 0.09, by = 0.01),(1:9)/10,
+ q.l(y)(c(seq(0.01, 0.09, by = 0.01),(1:9)/10,
0.95, 0.99, 0.995, 0.999))
))))
rxyall <- (max(xyall)-min(xyall))*0.6
@@ -162,9 +162,9 @@
if(check.NotInSupport){
xo <- x[ord.x]
- nInSupp <- which(xo < q(y)(0))
+ nInSupp <- which(xo < q.l(y)(0))
- nInSupp <- unique(sort(c(nInSupp,which( xo > q(y)(1)))))
+ nInSupp <- unique(sort(c(nInSupp,which( xo > q.l(y)(1)))))
if("support" %in% names(getSlots(class(y))))
nInSupp <- unique(sort(c(nInSupp,which( ! xo %in% support(y)))))
if("gaps" %in% names(getSlots(class(y))))
More information about the Distr-commits
mailing list