R Under development (unstable) (2024-08-15 r87022 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> ## Copyright (C) 2012 Marius Hofert, Ivan Kojadinovic, Martin Maechler, and Jun Yan
> ##
> ## This program is free software; you can redistribute it and/or modify it under
> ## the terms of the GNU General Public License as published by the Free Software
> ## Foundation; either version 3 of the License, or (at your option) any later
> ## version.
> ##
> ## This program is distributed in the hope that it will be useful, but WITHOUT
> ## ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
> ## FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
> ## details.
> ##
> ## You should have received a copy of the GNU General Public License along with
> ## this program; if not, see <http://www.gnu.org/licenses/>.
> 
> require(copula)
Loading required package: copula
> source(system.file("Rsource", "utils.R",     package="copula", mustWork=TRUE))
Loading required package: tools
> ##-> assertError(), assert.EQ(), ... showProc.time()  +  comparederiv()
> showProc.time()
Time (user system elapsed): 0 0 0 
> 
> (doExtras <- copula:::doExtras())
[1] FALSE
> 
> m <- 10 # number of random points
> tau <- 0.5
> set.seed(47)
> 
> ## bivariate comparisons
> d <- 2
> u <- pobs(matrix(runif(d * m), m, d))
> 
> ## (Warnings suppressed now via default may.warn=FALSE)
> cDer <- rbind(
+     clayton = comparederiv(claytonCopula (iTau(claytonCopula(), tau)), u),
+     gumbel  = comparederiv(gumbelCopula  (iTau(gumbelCopula(),  tau)), u),
+     frank   = comparederiv(frankCopula   (iTau(frankCopula(),   tau)), u),
+     plackett= comparederiv(plackettCopula(iTau(plackettCopula(),tau)), u),
+     normal  = comparederiv(normalCopula  (iTau(normalCopula(),  tau)), u),
+     tC.fixed= comparederiv(tCopula       (iTau(tCopula(), tau), df.fixed = TRUE), u))
> cDer
                dCdu     dCdtheta      dlogcdu  dlogcdtheta
clayton  0.001950773 9.364037e-15 2.831400e-08 2.298252e-09
gumbel   0.001979802 1.411718e-14 1.916444e-08 5.804636e-10
frank    0.001890827 3.620802e-15 2.143723e-08 5.840500e-10
plackett 0.001864747 8.752981e-15 3.025289e-08 1.021851e-09
normal   0.002166104 1.777745e-14 7.513569e-08 2.924120e-09
tC.fixed 0.001868378 5.537237e-14 6.062690e-09 2.839019e-09
> stopifnot(cDer[,"dCdu"      ] <= 0.004, # max: normal   = 0.002166
+           #cDer[,"dCdtheta"  ] <= 11e-14,# max: tC.fixed = 5.537e-14
+           cDer[,"dCdtheta"  ] <= 1e-8,  # max: normal   = 4.86e-9
+           cDer[,"dlogcdu"   ] <= 15e-8, # max: normal   = 7.51e-8
+           cDer[,"dlogcdtheta"]<= 6e-9)  # max: normal   = 2.92e-9
> showProc.time()
Time (user system elapsed): 0.8 0.06 0.86 
> 
> 
> if (doExtras)
+ {
+     ## d-dimensional
+     d <- 4 ; set.seed(44)
+     u <- pobs(matrix(runif(d * m), m, d))
+ 
+     nC4 <- normalCopula(rep(iTau(normalCopula(), tau), d * (d-1)/2), dim=d, dispstr = "un")
+     tC4 <- tCopula     (rep(iTau(tCopula(),      tau), d * (d-1)/2), dim=d, dispstr = "un",
+                         df.fixed = TRUE)
+     cD <- rbind(comparederiv(nC4, u),
+                 comparederiv(tC4, u))
+     print(cD, digits = 5)
+     stopifnot(apply(cD, 2, max) < c(0.42, 0.18, 2.1e-07, 1.6e-08))
+     showProc.time()
+ }
> 
> 
> proc.time()
   user  system elapsed 
   1.84    0.15    1.98