[spcopula-commits] r146 - in pkg: . R

[noreply at r-forge.r-project.org]

Author: ben_graeler
Date: 2015-08-07 16:09:43 +0200 (Fri, 07 Aug 2015)
New Revision: 146

Modified:
   pkg/DESCRIPTION
   pkg/R/returnPeriods.R
Log:
- corrected wrong function names

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2015-08-07 07:38:06 UTC (rev 145)
+++ pkg/DESCRIPTION	2015-08-07 14:09:43 UTC (rev 146)
@@ -2,7 +2,7 @@
 Type: Package
 Title: Copula Driven Spatio-Temporal Analysis
 Version: 0.2-1
-Date: 2015-07-02
+Date: 2015-08-07
 Authors at R: c(person("Benedikt", "Graeler", role = c("aut", "cre"),
                     email = "ben.graeler at uni-muenster.de"),
              person("Marius", "Appel",role = "ctb"))

Modified: pkg/R/returnPeriods.R
===================================================================
--- pkg/R/returnPeriods.R	2015-08-07 07:38:06 UTC (rev 145)
+++ pkg/R/returnPeriods.R	2015-08-07 14:09:43 UTC (rev 146)
@@ -1,18 +1,15 @@
 genEmpKenFun <- function(copula, sample=NULL) {
-  if(is.null(sample)) sample <- rCopula(1e6,copula)
-  # as empirical copula:
-  # copula <- genEmpCop(copula, sample)
+  if(is.null(sample)) 
+    sample <- rCopula(1e6,copula)
   if(missing(copula)) {
-    ken <- mapply(function(x,y) sum(x > sample[,1] & y > sample[,2])/length(x), sample[,1], sample[,2])
+    # taken from package copula function "Kn"
+    stopifnot((n <- nrow(sample)) >= 1, (d <- ncol(sample)) >= 1)
+    ken <- vapply(seq_len(n), function(i) sum(colSums(t(sample) < sample[i, ]) == d)/(n + 1), NA_real_)
   } else {
     ken <- pCopula(sample, copula)
   }
   
-  empKenFun <- function(tlevel) {
-    sapply(tlevel,function(t) sum(ken<=t))/nrow(sample)
-  }
-  
-  return(empKenFun)
+  return(ecdf(ken))
 }
 
 ## inverse kendall function
@@ -39,17 +36,17 @@
 
 ## return periods
 kendallRP <- function(kendallFun, cl=c(.99,.999), mu=1, copula) {
-  if(is.missing(kendallFun) & is.missing(copula)) 
+  if(missing(kendallFun) & missing(copula)) 
       stop("Either the kendall distribution function or the copula must be provided. Note that the calculation of the kendall distribution function from the copula is pretty time consuming. Saving them separately might be advantageous.")
-  if(is.missing(kendallFun)) kendallFun <- genEmpKenFun(copula)
+  if(missing(kendallFun)) kendallFun <- genEmpKenFun(copula)
   if(length(mu)>1 & length(cl) > 1) stop("Either the critial level (cl) or mu may be of length larger than 1!")
   return(mu/(1-kendallFun(cl)))
 }   
 
 criticalLevel <- function(kendallFun, KRP=c(100,1000), mu=1, copula) {
-  if(is.missing(kendallFun) & is.missing(copula)) 
+  if(missing(kendallFun) & missing(copula)) 
       stop("Either the kendall distribution function or the copula must be provided. Note that the calculation of the kendall distribution function from the copula is pretty time consuming. Saving them separately might be advantageous.")
-  if(is.missing(kendallFun))
+  if(missing(kendallFun))
       kendallFun <- genEmpKenFun(copula)
   if(length(mu)>1 & length(KRP) > 1) 
       stop("Either the kendall return period or mu may be of length larger than 1!")