[Distr-commits] r1225 - branches/distr-2.8/pkg/distrMod/R branches/distr-2.8/pkg/distrMod/tests/Examples pkg/distrMod/R pkg/distrMod/tests/Examples
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jul 29 00:54:42 CEST 2018
Author: ruckdeschel
Date: 2018-07-29 00:54:42 +0200 (Sun, 29 Jul 2018)
New Revision: 1225
Modified:
branches/distr-2.8/pkg/distrMod/R/0distrModUtils.R
branches/distr-2.8/pkg/distrMod/R/qqplot.R
branches/distr-2.8/pkg/distrMod/R/returnlevelplot.R
branches/distr-2.8/pkg/distrMod/tests/Examples/distrMod-Ex.Rout.save
pkg/distrMod/R/0distrModUtils.R
pkg/distrMod/R/qqplot.R
pkg/distrMod/R/returnlevelplot.R
pkg/distrMod/tests/Examples/distrMod-Ex.Rout.save
Log:
distrMod: [in trunk and branch 2.8]
+ changed default (of the distinction by attr.pre) for lab.pts in qqplot and returnlevelplot; this is always attr.pre==TRUE now
+ unnecessary variable n2 is deleted in .labelprep
+ qqplot did not have an args attribute in
+ now also delete .with.lab from dots list
+ updated distrMod-Ex.Rout.save
Modified: branches/distr-2.8/pkg/distrMod/R/0distrModUtils.R
===================================================================
--- branches/distr-2.8/pkg/distrMod/R/0distrModUtils.R 2018-07-26 06:24:55 UTC (rev 1224)
+++ branches/distr-2.8/pkg/distrMod/R/0distrModUtils.R 2018-07-28 22:54:42 UTC (rev 1225)
@@ -599,7 +599,7 @@
mcl$legend.alpha <- NULL
mcl$withSweave <- NULL
mcl$mfColRow <- NULL
- mcl$debug <- NULL
+ mcl$debug <- mcl$with.lab <- mcl$MaxOrPOT <- NULL
mcl$added.points.CI <- NULL
mcl$pch.pts <- mcl$pch.npts <- mcl$cex.pts <- mcl$cex.npts <- NULL
mcl$col.pts <- mcl$col.npts <- mcl$which.nonlbs <- mcl$attr.pre <- NULL
Modified: branches/distr-2.8/pkg/distrMod/R/qqplot.R
===================================================================
--- branches/distr-2.8/pkg/distrMod/R/qqplot.R 2018-07-26 06:24:55 UTC (rev 1224)
+++ branches/distr-2.8/pkg/distrMod/R/qqplot.R 2018-07-28 22:54:42 UTC (rev 1225)
@@ -23,8 +23,6 @@
ind2 <- ind1
if(!is.null(which.Order)) ind2 <- ind1[rk1 %in% which.Order]
#
- n2 <- length(ind2)
- #
x2 <- x[ind2]
or2.0 <- order(x2, decreasing = TRUE)
#
@@ -37,7 +35,7 @@
#------------------------------------------------------------------------
x0 <- x[ind.s]
y0 <- x[ind.s]
-
+
col.lbs <- col.lbs[ind.s]
lab.pts <- lab.pts[ind.s]
cex.lbs <- cex.lbs[ind.s]
@@ -164,6 +162,7 @@
as.character(date()),
xcc))
}else function(inx)inx
+
rank0x <- rank(x)
xj <- sort(x)
@@ -181,7 +180,7 @@
if("support" %in% names(getSlots(class(y))))
yc <- sort(jitter(yc, factor=jit.fac))
-#-------------------------------------------------------------------------------
+
alp.v <- .makeLenAndOrder(alpha.trsp,ind.x)
alp.t <- function(x,a1) if(is.na(x)) x else addAlphTrsp2col(x,a1)
alp.f <- if(length(alpha.trsp)==1L && is.na(alpha.trsp))
@@ -223,9 +222,10 @@
if(missing(col.npts)) col.npts <- par("col")
if(missing(pch.npts)) pch.npts <- 20
+ if(with.lab) lab.pts <- lbprep$lab.pts
+
if(attr.pre){
if(with.lab){
- lab.pts <- lbprep$lab.pts
col.lbs <- lbprep$col.lbs
cex.lbs <- lbprep$cex.lbs
adj.lbs <- lbprep$adj.lbs
@@ -240,8 +240,6 @@
ind.s <- 1:n.s
ind.ns <- 1:n.ns
if(with.lab){
- if(missing(lab.pts)||is.null(lab.pts)) lab.pts <- ind.ns else
- lab.pts <- .makeLenAndOrder(lab.pts,ind.ns)
if(missing(cex.lbs)) cex.lbs <- par("cex")
cex.lbs <- (.makeLenAndOrder(cex.lbs,ind.s))
if(missing(adj.lbs)) adj.lbs <- par("adj")
@@ -293,7 +291,9 @@
ycso <- ycso[idx]
}
- if(datax){
+
+
+ if(datax){
mcl$x <- xso#xj
mcl$y <- ycso #yc
}else{
@@ -308,6 +308,7 @@
mcl$xlab <- .mpresubs(mcl$xlab)
mcl$ylab <- .mpresubs(mcl$ylab)
+
if (!is.null(eval(mcl$main)))
mcl$main <- .mpresubs(eval(mcl$main))
if (!is.null(eval(mcl$sub)))
Modified: branches/distr-2.8/pkg/distrMod/R/returnlevelplot.R
===================================================================
--- branches/distr-2.8/pkg/distrMod/R/returnlevelplot.R 2018-07-26 06:24:55 UTC (rev 1224)
+++ branches/distr-2.8/pkg/distrMod/R/returnlevelplot.R 2018-07-28 22:54:42 UTC (rev 1225)
@@ -107,6 +107,7 @@
plotInfo <- list(call = mc, dots=dots, args=args0)
MaxOrPOT <- match.arg(MaxOrPOT)
+
xcc <- as.character(deparse(mc$x))
.mpresubs <- if(withSubst){
@@ -133,9 +134,7 @@
if(is.null(mcl$datax)) datax <- FALSE
force(x)
-# if(!is.function(order.traf)) order.traf <- mcl$order.traf
-
- thresh0 <- threshold
+ thresh0 <- threshold
if(is(y,"GPareto")){
if(is.na(threshold)) thresh0 <- location(y)
y <- y - thresh0
@@ -227,9 +226,9 @@
if(missing(col.npts)) col.npts <- par("col")
if(missing(pch.npts)) pch.npts <- 20
+ if(with.lab) lab.pts <- lbprep$lab.pts
if(attr.pre){
if(with.lab){
- lab.pts <- lbprep$lab.pts
col.lbs <- lbprep$col.lbs
cex.lbs <- lbprep$cex.lbs
adj.lbs <- lbprep$adj.lbs
@@ -298,12 +297,15 @@
ycso <- ycso[idx]
}
-
mcl <- .deleteItemsMCL(mcl)
- mcl$cex <- cex.pch
- mcl$col <- col.pch
+ mcl$pch <- pch.pts
+ mcl$cex <- cex.pts
+ mcl$col <- col.pts
mcl$MaxOrPOT <- NULL
+ mcl$xlab <- .mpresubs(mcl$xlab)
+ mcl$ylab <- .mpresubs(mcl$ylab)
+
if (!withSweave){
devNew(width = width, height = height)
}
@@ -453,7 +455,6 @@
plot.it = TRUE, xlab = deparse(substitute(x)),
ylab = deparse(substitute(y)), ...){
-
mc <- match.call(call = sys.call(sys.parent(1)))
dots <- match.call(call = sys.call(sys.parent(1)),
expand.dots = FALSE)$"..."
Modified: branches/distr-2.8/pkg/distrMod/tests/Examples/distrMod-Ex.Rout.save
===================================================================
--- branches/distr-2.8/pkg/distrMod/tests/Examples/distrMod-Ex.Rout.save 2018-07-26 06:24:55 UTC (rev 1224)
+++ branches/distr-2.8/pkg/distrMod/tests/Examples/distrMod-Ex.Rout.save 2018-07-28 22:54:42 UTC (rev 1225)
@@ -402,7 +402,7 @@
dimnames = list(nms, nms0))
list(fval = fval0, mat = mat0)
}
-<bytecode: 0x08241ff8>
+<bytecode: 0x08365580>
Trafo / derivative matrix at which estimate was produced:
scale shape
shape 0.000 1
@@ -615,7 +615,7 @@
((x - 0)/c(scale = 1) * LogDeriv((x - 0)/c(scale = 1)) -
1)/c(scale = 1)
}
-<environment: 0x0c3937c0>
+<environment: 0x0cb065a8>
> checkL2deriv(E1)
precision of centering: -1.51181e-06
@@ -803,8 +803,8 @@
Slot "fct":
function (x)
QuadFormNorm(x, A = A)
-<bytecode: 0x0d06f378>
-<environment: 0x0d070918>
+<bytecode: 0x0d7ad168>
+<environment: 0x0d7acfa8>
>
> ## The function is currently defined as
@@ -1119,7 +1119,7 @@
((x - 0)/c(meanlog = 1) * LogDeriv((x - 0)/c(meanlog = 1)) -
1)/c(meanlog = 1)
}
-<environment: 0x0e876ce0>
+<environment: 0x0d7dc4f8>
> checkL2deriv(L1)
precision of centering: -0.003003394
@@ -2133,7 +2133,7 @@
return(abs(x))
else return(sqrt(colSums(x^2)))
}
-<bytecode: 0x089fc548>
+<bytecode: 0x0b630700>
<environment: namespace:distrMod>
> name(EuclNorm)
[1] "EuclideanNorm"
@@ -2168,7 +2168,7 @@
return(abs(x))
else return(sqrt(colSums(x^2)))
}
-<bytecode: 0x089fc548>
+<bytecode: 0x0b630700>
<environment: namespace:distrMod>
>
@@ -2651,8 +2651,8 @@
Slot "fct":
function (x)
QuadFormNorm(x, A = A0)
-<bytecode: 0x0ecda6d0>
-<environment: 0x0ea872a8>
+<bytecode: 0x0d519518>
+<environment: 0x0d519318>
>
> ## The function is currently defined as
@@ -2693,8 +2693,8 @@
Slot "fct":
function (x)
QuadFormNorm(x, A = A)
-<bytecode: 0x0f95a3f0>
-<environment: 0x0f95a230>
+<bytecode: 0x0cda00e8>
+<environment: 0x0cd9ff28>
>
> ## The function is currently defined as
@@ -3820,7 +3820,7 @@
dimnames(mat) <- list(nfval, c("mean", "sd"))
return(list(fval = fval, mat = mat))
}
-<bytecode: 0x0d4d9ab0>
+<bytecode: 0x0dab35d8>
> print(param(NS), show.details = "minimal")
An object of class "ParamWithScaleFamParameter"
name: location and scale
@@ -3869,7 +3869,7 @@
dimnames(mat) <- list(nfval, c("mean", "sd"))
return(list(fval = fval, mat = mat))
}
-<bytecode: 0x0d4d9ab0>
+<bytecode: 0x0dab35d8>
Trafo / derivative matrix:
mean sd
mu/sig 0.3668695 -0.3024814
@@ -3912,7 +3912,7 @@
dimnames(mat) <- list(nfval, c("mean", "sd"))
return(list(fval = fval, mat = mat))
}
-<bytecode: 0x0d4d9ab0>
+<bytecode: 0x0dab35d8>
Trafo / derivative matrix:
mean sd
mu/sig 0.3669 -0.3025
@@ -3969,7 +3969,7 @@
> x <- rnorm(40,mean=15,sd=30)
> qqplot(x, Chisq(df=15))
> NF <- NormLocationScaleFamily(mean=15, sd=30)
-> qqplot(x, NF)
+> qqplot(x, NF, with.lab=TRUE, which.Order=1:5, cex.lbs=1.3)
> mlE <- MLEstimator(x, NF)
> qqplot(x, mlE)
>
@@ -4333,7 +4333,7 @@
> cleanEx()
> options(digits = 7L)
> base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed: 38.54 0.81 41.47 NA NA
+Time elapsed: 21.91 0.34 22.31 NA NA
> grDevices::dev.off()
null device
1
Modified: pkg/distrMod/R/0distrModUtils.R
===================================================================
--- pkg/distrMod/R/0distrModUtils.R 2018-07-26 06:24:55 UTC (rev 1224)
+++ pkg/distrMod/R/0distrModUtils.R 2018-07-28 22:54:42 UTC (rev 1225)
@@ -599,7 +599,7 @@
mcl$legend.alpha <- NULL
mcl$withSweave <- NULL
mcl$mfColRow <- NULL
- mcl$debug <- NULL
+ mcl$debug <- mcl$with.lab <- mcl$MaxOrPOT <- NULL
mcl$added.points.CI <- NULL
mcl$pch.pts <- mcl$pch.npts <- mcl$cex.pts <- mcl$cex.npts <- NULL
mcl$col.pts <- mcl$col.npts <- mcl$which.nonlbs <- mcl$attr.pre <- NULL
Modified: pkg/distrMod/R/qqplot.R
===================================================================
--- pkg/distrMod/R/qqplot.R 2018-07-26 06:24:55 UTC (rev 1224)
+++ pkg/distrMod/R/qqplot.R 2018-07-28 22:54:42 UTC (rev 1225)
@@ -23,8 +23,6 @@
ind2 <- ind1
if(!is.null(which.Order)) ind2 <- ind1[rk1 %in% which.Order]
#
- n2 <- length(ind2)
- #
x2 <- x[ind2]
or2.0 <- order(x2, decreasing = TRUE)
#
@@ -199,9 +197,10 @@
if(missing(col.npts)) col.npts <- par("col")
if(missing(pch.npts)) pch.npts <- 20
+ if(with.lab) lab.pts <- lbprep$lab.pts
+
if(attr.pre){
if(with.lab){
- lab.pts <- lbprep$lab.pts
col.lbs <- lbprep$col.lbs
cex.lbs <- lbprep$cex.lbs
adj.lbs <- lbprep$adj.lbs
@@ -216,8 +215,6 @@
ind.s <- 1:n.s
ind.ns <- 1:n.ns
if(with.lab){
- if(missing(lab.pts)||is.null(lab.pts)) lab.pts <- ind.ns else
- lab.pts <- .makeLenAndOrder(lab.pts,ind.ns)
if(missing(cex.lbs)) cex.lbs <- par("cex")
cex.lbs <- (.makeLenAndOrder(cex.lbs,ind.s))
if(missing(adj.lbs)) adj.lbs <- par("adj")
Modified: pkg/distrMod/R/returnlevelplot.R
===================================================================
--- pkg/distrMod/R/returnlevelplot.R 2018-07-26 06:24:55 UTC (rev 1224)
+++ pkg/distrMod/R/returnlevelplot.R 2018-07-28 22:54:42 UTC (rev 1225)
@@ -200,9 +200,9 @@
if(missing(col.npts)) col.npts <- par("col")
if(missing(pch.npts)) pch.npts <- 20
+ if(with.lab) lab.pts <- lbprep$lab.pts
if(attr.pre){
if(with.lab){
- lab.pts <- lbprep$lab.pts
col.lbs <- lbprep$col.lbs
cex.lbs <- lbprep$cex.lbs
adj.lbs <- lbprep$adj.lbs
Modified: pkg/distrMod/tests/Examples/distrMod-Ex.Rout.save
===================================================================
--- pkg/distrMod/tests/Examples/distrMod-Ex.Rout.save 2018-07-26 06:24:55 UTC (rev 1224)
+++ pkg/distrMod/tests/Examples/distrMod-Ex.Rout.save 2018-07-28 22:54:42 UTC (rev 1225)
@@ -36,7 +36,7 @@
> library('distrMod')
Loading required package: distr
Loading required package: startupmsg
-:startupmsg> Utilities for Start-Up Messages (version 0.9.5)
+:startupmsg> Utilities for Start-Up Messages (version 0.9.6)
:startupmsg>
:startupmsg> For more information see ?"startupmsg",
:startupmsg> NEWS("startupmsg")
@@ -69,7 +69,7 @@
df, qqplot, sd
Loading required package: distrEx
-:distrEx> Extensions of Package 'distr' (version 2.7.0)
+:distrEx> Extensions of Package 'distr' (version 2.8.0)
:distrEx>
:distrEx> Note: Packages "e1071", "moments", "fBasics" should be
:distrEx> attached /before/ package "distrEx". See
@@ -402,7 +402,7 @@
dimnames = list(nms, nms0))
list(fval = fval0, mat = mat0)
}
-<bytecode: 0x0acdb588>
+<bytecode: 0x0af01c68>
Trafo / derivative matrix at which estimate was produced:
scale shape
shape 0.000 1
@@ -615,7 +615,7 @@
((x - 0)/c(scale = 1) * LogDeriv((x - 0)/c(scale = 1)) -
1)/c(scale = 1)
}
-<environment: 0x08574f50>
+<environment: 0x08457f28>
> checkL2deriv(E1)
precision of centering: -1.51181e-06
@@ -803,8 +803,8 @@
Slot "fct":
function (x)
QuadFormNorm(x, A = A)
-<bytecode: 0x0c75ac20>
-<environment: 0x0c75aa60>
+<bytecode: 0x0c56aad0>
+<environment: 0x0c56a910>
>
> ## The function is currently defined as
@@ -1119,7 +1119,7 @@
((x - 0)/c(meanlog = 1) * LogDeriv((x - 0)/c(meanlog = 1)) -
1)/c(meanlog = 1)
}
-<environment: 0x0d0fd510>
+<environment: 0x04fc6f80>
> checkL2deriv(L1)
precision of centering: -0.003003394
@@ -2155,7 +2155,7 @@
return(abs(x))
else return(sqrt(colSums(x^2)))
}
-<bytecode: 0x0f2cf438>
+<bytecode: 0x0f7cedc0>
<environment: namespace:distrMod>
> name(EuclNorm)
[1] "EuclideanNorm"
@@ -2190,7 +2190,7 @@
return(abs(x))
else return(sqrt(colSums(x^2)))
}
-<bytecode: 0x0f2cf438>
+<bytecode: 0x0f7cedc0>
<environment: namespace:distrMod>
>
@@ -2673,8 +2673,8 @@
Slot "fct":
function (x)
QuadFormNorm(x, A = A0)
-<bytecode: 0x0f4d2960>
-<environment: 0x0f4d1bd0>
+<bytecode: 0x0a0f47e0>
+<environment: 0x0a0f3af0>
>
> ## The function is currently defined as
@@ -2715,8 +2715,8 @@
Slot "fct":
function (x)
QuadFormNorm(x, A = A)
-<bytecode: 0x0ed8a828>
-<environment: 0x0ed89ab8>
+<bytecode: 0x09e68070>
+<environment: 0x09e683b0>
>
> ## The function is currently defined as
@@ -3842,7 +3842,7 @@
dimnames(mat) <- list(nfval, c("mean", "sd"))
return(list(fval = fval, mat = mat))
}
-<bytecode: 0x0c794e48>
+<bytecode: 0x07f80e80>
> print(param(NS), show.details = "minimal")
An object of class "ParamWithScaleFamParameter"
name: location and scale
@@ -3891,7 +3891,7 @@
dimnames(mat) <- list(nfval, c("mean", "sd"))
return(list(fval = fval, mat = mat))
}
-<bytecode: 0x0c794e48>
+<bytecode: 0x07f80e80>
Trafo / derivative matrix:
mean sd
mu/sig 0.3668695 -0.3024814
@@ -3934,7 +3934,7 @@
dimnames(mat) <- list(nfval, c("mean", "sd"))
return(list(fval = fval, mat = mat))
}
-<bytecode: 0x0c794e48>
+<bytecode: 0x07f80e80>
Trafo / derivative matrix:
mean sd
mu/sig 0.3669 -0.3025
@@ -3991,7 +3991,16 @@
> x <- rnorm(40,mean=15,sd=30)
> qqplot(x, Chisq(df=15))
> NF <- NormLocationScaleFamily(mean=15, sd=30)
-> qqplot(x, NF)
+> qqplot(x, NF, with.lab=TRUE, which.Order=1:5, cex.lbs=1.3)
+Warning in plot.window(...) : "with.lab" is not a graphical parameter
+Warning in plot.xy(xy, type, ...) :
+ "with.lab" is not a graphical parameter
+Warning in axis(side = side, at = at, labels = labels, ...) :
+ "with.lab" is not a graphical parameter
+Warning in axis(side = side, at = at, labels = labels, ...) :
+ "with.lab" is not a graphical parameter
+Warning in box(...) : "with.lab" is not a graphical parameter
+Warning in title(...) : "with.lab" is not a graphical parameter
> mlE <- MLEstimator(x, NF)
> qqplot(x, mlE)
>
@@ -4355,7 +4364,7 @@
> cleanEx()
> options(digits = 7L)
> base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed: 36 0.82 45.78 NA NA
+Time elapsed: 31.01 0.47 37.36 NA NA
> grDevices::dev.off()
null device
1
More information about the Distr-commits
mailing list