Revision f64e14b64fb7985b724358c00e7a2493729e6047 authored by Martin Maechler on 21 September 2011, 00:00:00 UTC, committed by Gabor Csardi on 21 September 2011, 00:00:00 UTC
1 parent 69748f9
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
}
Computing file changes ...