[Distr-commits] r1148 - branches/distr-2.7/pkg/distr/demo
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jul 8 13:37:54 CEST 2018
Author: ruckdeschel
Date: 2018-07-08 13:37:51 +0200 (Sun, 08 Jul 2018)
New Revision: 1148
Modified:
branches/distr-2.7/pkg/distr/demo/ConvolutionNormalDistr.R
branches/distr-2.7/pkg/distr/demo/Expectation.R
branches/distr-2.7/pkg/distr/demo/StationaryRegressorDistr.R
branches/distr-2.7/pkg/distr/demo/nFoldConvolution.R
branches/distr-2.7/pkg/distr/demo/range.R
Log:
[branches: distr]: began with major update to version 2.7 / replace calls to q(distr) with q.l(distr) in demos
Modified: branches/distr-2.7/pkg/distr/demo/ConvolutionNormalDistr.R
===================================================================
--- branches/distr-2.7/pkg/distr/demo/ConvolutionNormalDistr.R 2018-07-08 11:36:18 UTC (rev 1147)
+++ branches/distr-2.7/pkg/distr/demo/ConvolutionNormalDistr.R 2018-07-08 11:37:51 UTC (rev 1148)
@@ -22,8 +22,8 @@
eps <- 1e-8
distroptions("TruncQuantile" = eps)
## support of A1+B1 for FFT convolution is
-## [q(A1)(TruncQuantile),
-## q(B1)(TruncQuantile, lower.tail = FALSE)]
+## [q.l(A1)(TruncQuantile),
+## q.l(B1)(TruncQuantile, lower.tail = FALSE)]
## convolution via FFT
AB1 <- A1+B1
@@ -32,8 +32,8 @@
## plots of the results
#############################
par(mfrow=c(1,3))
-low <- q(AB)(1e-15)
-upp <- q(AB)(1e-15, lower.tail = FALSE)
+low <- q.l(AB)(1e-15)
+upp <- q.l(AB)(1e-15, lower.tail = FALSE)
x <- seq(from = low, to = upp, length = 10000)
## densities
@@ -52,10 +52,10 @@
## quantile functions
x <- seq(from = eps, to = 1-eps, length = 1000)
-plot(x, q(AB)(x), type = "l", lwd = 5)
-lines(x , q(AB1)(x), col = "orange", lwd = 1)
+plot(x, q.l(AB)(x), type = "l", lwd = 5)
+lines(x , q.l(AB1)(x), col = "orange", lwd = 1)
title("Quantile functions")
-legend(0, q(AB)(eps, lower.tail = FALSE),
+legend(0, q.l(AB)(eps, lower.tail = FALSE),
legend = c("exact", "FFT"),
fill = c("black", "orange"))
Modified: branches/distr-2.7/pkg/distr/demo/Expectation.R
===================================================================
--- branches/distr-2.7/pkg/distr/demo/Expectation.R 2018-07-08 11:36:18 UTC (rev 1147)
+++ branches/distr-2.7/pkg/distr/demo/Expectation.R 2018-07-08 11:37:51 UTC (rev 1148)
@@ -11,8 +11,8 @@
function(object, fun){
integrand <- function(x) fun(x) * d(object)(x)
return(integrate(f = integrand,
- lower = q(object)(0),
- upper = q(object)(1))$value)
+ lower = q.l(object)(0),
+ upper = q.l(object)(1))$value)
})
setMethod("E",
Modified: branches/distr-2.7/pkg/distr/demo/StationaryRegressorDistr.R
===================================================================
--- branches/distr-2.7/pkg/distr/demo/StationaryRegressorDistr.R 2018-07-08 11:36:18 UTC (rev 1147)
+++ branches/distr-2.7/pkg/distr/demo/StationaryRegressorDistr.R 2018-07-08 11:37:51 UTC (rev 1148)
@@ -40,8 +40,8 @@
## plots of the results
#############################
par(mfrow=c(1,3))
-low <- q(X)(1e-15)
-upp <- q(X)(1e-15, lower.tail = FALSE)
+low <- q.l(X)(1e-15)
+upp <- q.l(X)(1e-15, lower.tail = FALSE)
x <- seq(from = low, to = upp, length = 10000)
## densities
@@ -60,8 +60,8 @@
## quantile functions
x <- seq(from = eps, to = 1-eps, length = 1000)
-plot(x, q(X)(x),type = "l", lwd = 5)
-lines(x , q(H)(x), col = "orange", lwd = 1)
+plot(x, q.l(X)(x),type = "l", lwd = 5)
+lines(x , q.l(H)(x), col = "orange", lwd = 1)
title("Quantile functions")
legend( "topleft",
legend=c("exact", "FFT"),
Modified: branches/distr-2.7/pkg/distr/demo/nFoldConvolution.R
===================================================================
--- branches/distr-2.7/pkg/distr/demo/nFoldConvolution.R 2018-07-08 11:36:18 UTC (rev 1147)
+++ branches/distr-2.7/pkg/distr/demo/nFoldConvolution.R 2018-07-08 11:37:51 UTC (rev 1148)
@@ -32,11 +32,11 @@
##STEP 1
- lower <- ifelse((q(D1)(0) > - Inf), q(D1)(0),
- q(D1)(getdistrOption("TruncQuantile"))
+ lower <- ifelse((q.l(D1)(0) > - Inf), q.l(D1)(0),
+ q.l(D1)(getdistrOption("TruncQuantile"))
)
- upper <- ifelse((q(D1)(1) < Inf), q(D1)(1),
- q(D1)(getdistrOption("TruncQuantile"),
+ upper <- ifelse((q.l(D1)(1) < Inf), q.l(D1)(1),
+ q.l(D1)(getdistrOption("TruncQuantile"),
lower.tail = FALSE)
)
@@ -95,10 +95,10 @@
## quantile with continuity correction h/2
- yleft <- ifelse(((q(D1)(0) == -Inf)|
- (q(D1)(0) == -Inf)), -Inf, N*lower)
- yright <- ifelse(((q(D1)(1) == Inf)|
- (q(D1)(1) == Inf)), Inf, N*upper)
+ yleft <- ifelse(((q.l(D1)(0) == -Inf)|
+ (q.l(D1)(0) == -Inf)), -Inf, N*lower)
+ yright <- ifelse(((q.l(D1)(1) == Inf)|
+ (q.l(D1)(1) == Inf)), Inf, N*upper)
w0 <- options("warn")
options(warn = -1)
qnfun1 <- approxfun(x = pnfun2(x+0.5*h), y = x+0.5*h,
@@ -138,8 +138,8 @@
## plots of the results
eps <- getdistrOption("TruncQuantile")
par(mfrow=c(1,3))
-low <- q(AN1)(eps)
-upp <- q(AN1)(eps, lower.tail = FALSE)
+low <- q.l(AN1)(eps)
+upp <- q.l(AN1)(eps, lower.tail = FALSE)
x <- seq(from = low, to = upp, length = 10000)
## densities
@@ -158,8 +158,8 @@
## quantile functions
x <- seq(from = eps, to = 1-eps, length = 1000)
-plot(x, q(AN1)(x), type = "l", lwd = 5)
-lines(x , q(AN)(x), col = "orange", lwd = 1)
+plot(x, q.l(AN1)(x), type = "l", lwd = 5)
+lines(x , q.l(AN)(x), col = "orange", lwd = 1)
title("Quantile functions")
legend("topleft",
legend = c("exact", "FFT"),
Modified: branches/distr-2.7/pkg/distr/demo/range.R
===================================================================
--- branches/distr-2.7/pkg/distr/demo/range.R 2018-07-08 11:36:18 UTC (rev 1147)
+++ branches/distr-2.7/pkg/distr/demo/range.R 2018-07-08 11:37:51 UTC (rev 1148)
@@ -28,7 +28,7 @@
fnt0 <- function(u0,s) d(object)(s)*d(object)(s+u0)*(p(object)(s+u0)-p(object)(s))^(e2-2)*e2*(e2-1)
fu0 <- function(u) integrate(fnt0, lower=-Inf, upper=Inf, u0=u)$value*(u>0)
xgrid <- seq(0,
- q(object)(1e-6, lower.tail = FALSE)-q(object)(1e-6),
+ q.l(object)(1e-6, lower.tail = FALSE)-q.l(object)(1e-6),
length = getdistrOption("DefaultNrGridPoints")/10)
fx <- sapply(xgrid, fu)
pnew <- approxfun(xgrid, fx, yleft = 0, yright = 1)
@@ -36,11 +36,11 @@
dnew <- approxfun(xgrid, fx0, yleft = 0, yright = 0)
## new quantile function
- lower <- q(object)(0)
- upper <- q(object)(1)
+ lower <- q.l(object)(0)
+ upper <- q.l(object)(1)
- maxquantile = q(object)(1e-6, lower.tail = FALSE)
- minquantile = q(object)(1e-6)
+ maxquantile = q.l(object)(1e-6, lower.tail = FALSE)
+ minquantile = q.l(object)(1e-6)
qfun1 <- function(x){
if(x == 0) return(lower)
More information about the Distr-commits
mailing list