[spcopula-commits] r133 - pkg/demo

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

Author: ben_graeler
Date: 2014-03-25 14:44:05 +0100 (Tue, 25 Mar 2014)
New Revision: 133

Modified:
   pkg/demo/stCoVarVineCop.R
Log:
- updated demo/stCoVarVineCop.R

Modified: pkg/demo/stCoVarVineCop.R
===================================================================
--- pkg/demo/stCoVarVineCop.R	2014-03-24 19:35:13 UTC (rev 132)
+++ pkg/demo/stCoVarVineCop.R	2014-03-25 13:44:05 UTC (rev 133)
@@ -1,7 +1,12 @@
-# demo related to the JSS paper 
-##
+######################################################################
+# demo related to a paper (in preparation for JSS)
+# Different than the study presented in the above paper, only a tempo-
+# ral subset of the European air quality data is used and the set of
+# copula family candidates is limited. These chnages have been neces-
+# sary to maintain the "runability" of this demo.
+######################################################################
+library(spcopula)
 library(evd)
-
 data(EU_RB)
 
 # estimate a GEV at each location for PM10 and EMEP
@@ -26,25 +31,6 @@
 ## correlation between EMEP and PM10? ##
 ########################################
 
-# monCor <- NULL
-# monCop <- NULL
-# for(month in c("2005-01", "2005-02", "2005-03", "2005-04",
-#                "2005-05", "2005-06", "2005-07", "2005-08",
-#                "2005-09", "2005-10", "2005-11", "2005-12")) {
-#   
-#   smpl <- cbind(EU_RB_2005[,month,"marPM10"]@data[[1]],
-#                 EU_RB_2005[,month,"marEMEP"]@data[[1]])
-#   bool <- !apply(smpl,1,function(row) any(is.na(row)))
-#   smpl <- smpl[bool,]
-#   
-#   monCor <- c(monCor, VineCopula:::fasttau(smpl[,1], smpl[,2]))
-#   monCop <- append(monCop,list(BiCopSelect(smpl[,1], smpl[,2], familyset=c(2,4))))
-# }
-# 
-# plot(monCor)
-# 
-# table(sapply(monCop, function(x) x$family))
-
 dayCor <- numeric(61)
 for(day in 1:61) {
   smpl <- cbind(EU_RB[,day, "marPM10"]@data[[1]],
@@ -104,8 +90,6 @@
 abline(h=0)
 abline(h=0.025,col="grey")
 
-which(tlags==time)
-
 fun1 <- function(x) stDepFun(x*1000, 1, 5:1)
 curve(fun1, 0, 1600, add=T, col=fiveColors[5])
 fun2 <- function(x) stDepFun(x*1000, 2, 5:1)