https://github.com/cran/nacopula
Raw File
Tip revision: 5bc804b03d066ef4a2ab9cf3af6f4f2df5bcda4e authored by Martin Maechler on 23 September 2011, 00:00 UTC
version 0.7-9-1
Tip revision: 5bc804b
timing.R
## Copyright (C) 2010 Marius Hofert and Martin Maechler
##
## 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/>.

#### Timing for the implemented nested Archimedean copulas

## ==== timing =================================================================

##' Computes user times for the admissible parameter combinations provided by "taus"
##'
##' @title Timing frailties 
##' @param n number of variates to be generated
##' @param family the (nested) Archimedean family to be timed
##' @param taus the sequence of Kendall's tau to be tested
##' @param digits number of digits for the output
##' @param verbose print current state of the timing during timing
##' @return a (tau_0 x tau_1)-matrix with first column indicating the user run
##'         times for V0 and the other cells the run time for V01 corresponding
##'         to two given taus among "taus" based on the generated V0's
##' @author Marius Hofert
timing <- function(n, family, taus, digits=3, verbose=FALSE)
{
    ## setup
    f <- function(x) formatC(x, digits=digits, width = 8)
    mTime <- function(x) 1000 * system.time(x)[1] # measuring milliseconds
    l <- length(taus)
    f.taus <- format(taus, digits=digits)
    res <- matrix(,nrow=l,ncol=l)
    copFamily <- getAcop(family)
    thetas <- copFamily@tauInv(taus)

    ## timing (based on user time)
    for(i in seq_along(thetas)) { # run over all theta0
        ## run times for V0 go into the first column:
        res[i,1] <- mTime(V0 <- copFamily@V0(n,thetas[i]))
        if(verbose) cat("V0:  tau_0 = ",f.taus[i],
                        "; time = ", f(res[i,1]), " ms\n",sep="")
        if(i < l) for(j in (i+1):l) {   # run over all theta1
            res[i,j] <- mTime(V01 <- copFamily@V01(V0,thetas[i], thetas[j]))
            if(verbose) cat("  V01: tau_0 = ",f.taus[i],", tau_1 = ", f.taus[j],
                            "; time = ",f(res[i,j])," ms\n", sep="")
        }
    }
    ## use taus as row and column headers:
    dimnames(res) <- list('outer tau' = f.taus,
                          '   inner tau' = c(" ", f.taus[-1]))
    res
}
back to top