version 4022.85

cran · Jan 7, 2023 · 7c3d32b · 7c3d32b
1 parent 513f857
commit 7c3d32b
Show file tree

Hide file tree

Showing 8 changed files with 59 additions and 23 deletions.
diff --git a/ChangeLog b/ChangeLog
@@ -2,6 +2,21 @@
 ChangeLog
 Package fCopulae
 
+2023-01-03 smith
+
+	* R/ArchimedieanGenerator.R further work on uniroot to refine
+	  handling of cases where .invK was limited by numerical tolerance
+	  of uniroot
+
+2022-12-11 smith
+
+	* DESCRIPTION: Updated version number
+	* R/ArchimedieanGenerator.R fixed bounds on uniroot in .invK
+	  function to avoid intermitent warnings on CRAN
+	* inst/unitTest/runTests.R alter options to recommended
+	  warn=1. Set random number generators to match R4.2.2 defaults-
+	  avoids warnings in the test output
+
 2021-07-18  smith
 
 	* DESCRIPTION: Updated version number and maintainer

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: fCopulae
 Title: Rmetrics - Bivariate Dependence Structures with Copulae
-Date: 2022-07-14
-Version: 4021.84
+Date: 2023-01-03
+Version: 4022.85
 Author: Diethelm Wuertz [aut],
 	Tobias Setz [aut],
 	Yohan Chalabi [ctb],
@@ -16,10 +16,7 @@ Imports: grDevices, graphics, stats
 Suggests: methods, RUnit, tcltk, mvtnorm, sn
 License: GPL (>= 2)
 URL: https://www.rmetrics.org
-Repository: CRAN
-Repository/R-Forge/Project: rmetrics
-Repository/R-Forge/Revision: 6224
-Repository/R-Forge/DateTimeStamp: 2022-07-19 14:29:47
-Date/Publication: 2022-07-20 08:20:02 UTC
 NeedsCompilation: no
-Packaged: 2022-07-19 14:52:09 UTC; rforge
+Packaged: 2023-01-07 20:15:28 UTC; paul
+Repository: CRAN
+Date/Publication: 2023-01-07 22:50:11 UTC
diff --git a/MD5 b/MD5
@@ -1,10 +1,10 @@
-456eba40e6c30f71057b679c81f707d1 *ChangeLog
-2121663662b4e49bafd66ca0adac1678 *DESCRIPTION
+098b86eccc9d2c314ead0418bf493955 *ChangeLog
+3cf99cf568e2d3aa9331568723af9898 *DESCRIPTION
 9d365d9b1fff0b1a443e7a7bcdade222 *NAMESPACE
-b224c94b7b4cadb927e4bb7f10fb39d3 *R/ArchimedeanCopulae.R
+b8d5908432d8c6a53460e80c917489a6 *R/ArchimedeanCopulae.R
 2ecff1b4ef03dca8bd390416e70d7728 *R/ArchimedeanDependency.R
-cb195a3002bdeaf47dcf8213e0086f58 *R/ArchimedeanGenerator.R
-df46e935e2e8fe9c0b8389a11398c745 *R/ArchimedeanModelling.R
+f1d90931e92891488195c69aa258a21a *R/ArchimedeanGenerator.R
+da9998da89be52ffc8a917768c86511b *R/ArchimedeanModelling.R
 d1448727aeb5c2bfb70ea051f3d29b14 *R/ArchimedeanSlider.R
 6bab46620fac6baf5493156b3c0874a9 *R/EllipticalCopulae.R
 d648d61dfc570f419e48ea47a03779aa *R/EllipticalDependency.R
@@ -19,8 +19,8 @@ dccbc5d81da8cecb6c2d24a43a0488f0 *R/ExtremeValueModelling.R
 cc66b4093da5eaf07f5692f598fed2a3 *R/aaaCopulaeEnv.R
 03c202578e38501cae6fb4e1c599c7e2 *R/zzz.R
 5073775e2caf6351d1b1e15479b1c73c *inst/unitTests/Makefile
-b3dfb205136831d39e558c232cdb025a *inst/unitTests/runTests.R
-7b2fb68b07b1bcb3031af0bbaae9401d *inst/unitTests/runit.ArchimedeanCopulae.R
+15d9197eafec4b5e5bda5249e9e3f8dc *inst/unitTests/runTests.R
+ae0c5c6d8359da416c80a253ed6c0f75 *inst/unitTests/runit.ArchimedeanCopulae.R
 c621d826877c3bfa872a49a1065d47f1 *inst/unitTests/runit.ArchimedeanDependency.R
 c88b95efbb2d4bc75b1ebd9df8aeb8a3 *inst/unitTests/runit.ArchimedeanGenerator.R
 d38397d2fc0dc6eb89002fefaf079088 *inst/unitTests/runit.ArchimedeanModelling.R

diff --git a/R/ArchimedeanCopulae.R b/R/ArchimedeanCopulae.R
@@ -67,6 +67,7 @@
         U = .invPhi(X*.Phi(t, alpha, type), alpha, type)
         V = .invPhi((1-X)*.Phi(t, alpha, type), alpha, type)
         ans = cbind(U, V)
+
         # Add Control Attribute:
         colnames(ans) = NULL
     }
@@ -603,7 +604,7 @@ darchmCopula <-
         v = u[, 1]
         u = u[, 2]
     }
-        
+
     # Density:
     c.uv = .invPhiSecondDer( 
         .Phi(u, alpha, type) + .Phi(v, alpha, type), alpha, type ) / ( 

diff --git a/R/ArchimedeanGenerator.R b/R/ArchimedeanGenerator.R
@@ -157,6 +157,7 @@ archmCheck <-
     # Check:
     ans = TRUE
     range = as.vector(archmRange(type))
+
     if (alpha < range[1] | alpha > range[2]) {
         print(c(alpha = alpha))
         print(c(range = range))
@@ -1419,15 +1420,33 @@ KfuncSlider <-
     # Compute Inverse:
     .fKC = function(x, p, alpha, type) { .Kfunc (x, alpha, type) - p }
     p = x
+
     z = NULL
     for (P in p) {
-        if (P > 1 - lower/2) {
+       if (P >= 1){ ## - lower/2) {
             res = 1
-        } else if (P < .Kfunc(0, alpha, type) + lower/2 ) {
+        } else if (P <= .Kfunc(0, alpha, type)){ ## + lower/2 ) {
             res = 0
         } else {
-            res = uniroot(.fKC, c(lower, 1),
-                p = P, alpha = alpha, type = type)$root
+            ## for small values of P (e.g. 1e-5) uniroot can return
+            ## values of 0 despite then above catch due to the numerical precision
+            ## try a cascading increase in precsion to catch this
+            for(pwr in c(0.25,0.5,1)){
+                res = uniroot(.fKC, c(0,1),
+                              p = P, alpha = alpha, type = type,tol=.Machine$double.eps^pwr)
+
+                if( (res$root - 2*res$estim.prec) > 0 &
+                    (res$root + 2*res$estim.prec) < 1 ){ break }
+            }
+            if( (res$root - 2*res$estim.prec < 0) & res$root==0 ){
+                warning(paste("Inversion close to 0, using default lower value",lower))
+                res <- lower
+            }else if ( (res$root + 2*res$estim.prec > 1) & res$root==1 ){
+                warning(paste("Inversion close to 1, using default upper value",1-lower))
+                res <- 1-lower
+            }else{
+                res <- res$root
+            }
         }
         z = c(z, res)
     }

diff --git a/R/ArchimedeanModelling.R b/R/ArchimedeanModelling.R
@@ -95,7 +95,7 @@ archmCopulaFit <-
         -mean( log(darchmCopula(u = U, v = V, alpha = x, type = type)) )
     }
     range = archmRange(type)
-
+    
     fit = nlminb(start = alpha, objective = fun, 
         lower = range[1], upper = range[2],  type = type, U = U, V = V, ...)
 

diff --git a/inst/unitTests/runTests.R b/inst/unitTests/runTests.R
@@ -1,5 +1,8 @@
 pkg <- "fCopulae"
 
+initial_opt <- options(warn = 1)
+on.exit(initial_opt)
+
 if(require("RUnit", quietly = TRUE))
 {
 
@@ -11,7 +14,9 @@ if(require("RUnit", quietly = TRUE))
 
     ## Define tests
     testSuite <- defineTestSuite(name = paste(pkg, "unit testing"),
-                                 dirs = path)
+                                 dirs = path,
+                                 rngKind = "Mersenne-Twister",
+                                 rngNormalKind = "Inversion")
 
     if(interactive()) {
         cat("Now have RUnit Test Suite 'testSuite' for package '",

diff --git a/inst/unitTests/runit.ArchimedeanCopulae.R b/inst/unitTests/runit.ArchimedeanCopulae.R
@@ -270,4 +270,3 @@ function()
 
 
 ################################################################################
-