[Vinecopula-commits] r21 - / pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Di Aug 27 11:43:50 CEST 2013
Author: ulf
Date: 2013-08-27 11:43:49 +0200 (Tue, 27 Aug 2013)
New Revision: 21
Modified:
VineCopula_1.1-2.tar.gz
pkg/R/RVineStructureSelect.r
Log:
Diesmal mit der richtigen RVineStructureSelect.r von Eike.
Das pdf soll nicht mehr ins Paket.
Modified: VineCopula_1.1-2.tar.gz
===================================================================
(Binary files differ)
Modified: pkg/R/RVineStructureSelect.r
===================================================================
--- pkg/R/RVineStructureSelect.r 2013-08-27 07:52:03 UTC (rev 20)
+++ pkg/R/RVineStructureSelect.r 2013-08-27 09:43:49 UTC (rev 21)
@@ -8,20 +8,20 @@
d = dim(data)[1]
if(dim(data)[1]<2) stop("Number of observations has to be at least 2.")
- if(d<2) stop("Dimension has to be at least 2.")
- if(any(data>1) || any(data<0)) stop("Data has be in the interval [0,1].")
+ if(d<2) stop("Dimension has to be at least 2.")
+ if(any(data>1) || any(data<0)) stop("Data has be in the interval [0,1].")
- if(!is.na(familyset[1])) for(i in 1:length(familyset)) if(!(familyset[i] %in% c(0,1:10,13,14,16:20,23,24,26:30,33,34,36:40))) stop("Copula family not implemented.")
- if(selectioncrit != "AIC" && selectioncrit != "BIC") stop("Selection criterion not implemented.")
- if(level < 0 & level > 1) stop("Significance level has to be between 0 and 1.")
+ if(!is.na(familyset[1])) for(i in 1:length(familyset)) if(!(familyset[i] %in% c(0,1:10,13,14,16:20,23,24,26:30,33,34,36:40))) stop("Copula family not implemented.")
+ if(selectioncrit != "AIC" && selectioncrit != "BIC") stop("Selection criterion not implemented.")
+ if(level < 0 & level > 1) stop("Significance level has to be between 0 and 1.")
if(is.null(colnames(data))) colnames(data) = paste("V",1:n,sep="")
- if(is.na(trunclevel)) trunclevel = d
+ if(is.na(trunclevel)) trunclevel = d
RVine = list(Tree = NULL, Graph=NULL)
- if(trunclevel == 0) familyset = 0
+ if(trunclevel == 0) familyset = 0
g = initializeFirstGraph(data,weights)
mst = findMaximumTauTree(g,mode=type)
@@ -74,7 +74,7 @@
E(g)$name = paste(get.edgelist(g)[,1],get.edgelist(g)[,2],sep=",")
for(i in 1:ecount(g)){
- E(g)$conditionedSet[[i]] = get.edges(g,i-1)
+ E(g)$conditionedSet[[i]] = get.edges(g,i)
}
return(g)
}
@@ -90,9 +90,9 @@
{
M = abs(get.adjacency(g,attr="weight"))
sumtaus = rowSums(M)
- root = which.max(sumtaus) -1
+ root = which.max(sumtaus)
- Ecken = get.edges(g,0:(ecount(g)-1))
+ Ecken = get.edges(g,1:ecount(g))
pos = Ecken[,2]== root | Ecken[,1]== root
mst = delete.edges(g, E(g)[!pos])
@@ -112,40 +112,40 @@
{
parameterForACopula[[i]] = list()
- a = get.edges(mst,i-1)+1
+ a = get.edges(mst,i)
parameterForACopula[[i]]$zr1 = data.univ[,a[1]]
parameterForACopula[[i]]$zr2 = data.univ[,a[2]]
- E(mst)[i-1]$Copula.Data.1 = list(data.univ[,a[1]])
- E(mst)[i-1]$Copula.Data.2 = list(data.univ[,a[2]])
+ E(mst)[i]$Copula.Data.1 = list(data.univ[,a[1]])
+ E(mst)[i]$Copula.Data.2 = list(data.univ[,a[2]])
- if(is.null(V(mst)[a[1]-1]$name))
- E(mst)[i-1]$Copula.CondName.1 = a[1]-1
+ if(is.null(V(mst)[a[1]]$name))
+ E(mst)[i]$Copula.CondName.1 = a[1]
else
- E(mst)[i-1]$Copula.CondName.1 = V(mst)[a[1]-1]$name
+ E(mst)[i]$Copula.CondName.1 = V(mst)[a[1]]$name
- if(is.null(V(mst)[a[2]-1]$name))
- E(mst)[i-1]$Copula.CondName.2 = a[2]-1
+ if(is.null(V(mst)[a[2]]$name))
+ E(mst)[i]$Copula.CondName.2 = a[2]
else
- E(mst)[i-1]$Copula.CondName.2 = V(mst)[a[2]-1]$name
+ E(mst)[i]$Copula.CondName.2 = V(mst)[a[2]]$name
- if(is.null(V(mst)[a[1]-1]$name) || is.null(V(mst)[a[2]-1]$name))
- E(mst)[i-1]$Copula.Name = paste(a[1]-1,a[2]-1,sep=" , ")
+ if(is.null(V(mst)[a[1]]$name) || is.null(V(mst)[a[2]]$name))
+ E(mst)[i]$Copula.Name = paste(a[1],a[2],sep=" , ")
else
- E(mst)[i-1]$Copula.Name = paste(V(mst)[a[1]-1]$name,V(mst)[a[2]-1]$name,sep=" , ")
+ E(mst)[i]$Copula.Name = paste(V(mst)[a[1]]$name,V(mst)[a[2]]$name,sep=" , ")
}
outForACopula = lapply(X = parameterForACopula, FUN=wrapper_fit.ACopula, type,copulaSelectionBy,testForIndependence,testForIndependence.level,weights)
- for(i in 0:(d-1))
+ for(i in 1:d)
{
- E(mst)$Copula.param[[i+1]] = c(outForACopula[[i+1]]$par,outForACopula[[i+1]]$par2)
- E(mst)[i]$Copula.type = outForACopula[[i+1]]$family
- E(mst)[i]$Copula.out = list(outForACopula[[i+1]])
+ E(mst)$Copula.param[[i]] = c(outForACopula[[i]]$par,outForACopula[[i]]$par2)
+ E(mst)[i]$Copula.type = outForACopula[[i]]$family
+ E(mst)[i]$Copula.out = list(outForACopula[[i]])
- E(mst)[i]$Copula.CondData.1 <- list(outForACopula[[i+1]]$CondOn.1)
- E(mst)[i]$Copula.CondData.2 <- list(outForACopula[[i+1]]$CondOn.2)
+ E(mst)[i]$Copula.CondData.1 <- list(outForACopula[[i]]$CondOn.1)
+ E(mst)[i]$Copula.CondData.2 <- list(outForACopula[[i]]$CondOn.2)
}
return(mst)
@@ -157,9 +157,9 @@
parameterForACopula = list()
- for(i in 0:(d-1))
+ for(i in 1:d)
{
- parameterForACopula[[i+1]] = list()
+ parameterForACopula[[i]] = list()
con = get.edge(mst,i)
@@ -198,8 +198,8 @@
if(progress == TRUE) message(n1," + ",n2," --> ", E(mst)[i]$name)
- parameterForACopula[[i+1]]$zr1 = zr1
- parameterForACopula[[i+1]]$zr2 = zr2
+ parameterForACopula[[i]]$zr1 = zr1
+ parameterForACopula[[i]]$zr2 = zr2
E(mst)[i]$Copula.Data.1 = list(zr1)
E(mst)[i]$Copula.Data.2 = list(zr2)
@@ -210,14 +210,14 @@
outForACopula = lapply(X = parameterForACopula, FUN=wrapper_fit.ACopula, type,copulaSelectionBy,testForIndependence,testForIndependence.level,weights)
- for(i in 0:(d-1))
+ for(i in 1:d)
{
- E(mst)$Copula.param[[i+1]] = c(outForACopula[[i+1]]$par,outForACopula[[i+1]]$par2)
- E(mst)[i]$Copula.type = outForACopula[[i+1]]$family
- E(mst)[i]$Copula.out = list(outForACopula[[i+1]])
+ E(mst)$Copula.param[[i]] = c(outForACopula[[i]]$par,outForACopula[[i]]$par2)
+ E(mst)[i]$Copula.type = outForACopula[[i]]$family
+ E(mst)[i]$Copula.out = list(outForACopula[[i]])
- E(mst)[i]$Copula.CondData.2 <- list(outForACopula[[i+1]]$CondOn.1)
- E(mst)[i]$Copula.CondData.1 <- list(outForACopula[[i+1]]$CondOn.2)
+ E(mst)[i]$Copula.CondData.2 <- list(outForACopula[[i]]$CondOn.1)
+ E(mst)[i]$Copula.CondData.1 <- list(outForACopula[[i]]$CondOn.2)
}
return(mst)
@@ -238,7 +238,7 @@
V(g)$conditioningSet = E(oldVineGraph)$conditioningSet
}
- for(i in 0:(ecount(g)-1)){
+ for(i in 1:ecount(g)){
con = get.edge(g,i)
@@ -315,8 +315,8 @@
out = intern_SchnittDifferenz(l1,l2)
- suppressWarnings({E(g)$conditionedSet[i+1] = list(out$differenz)})
- suppressWarnings({E(g)$conditioningSet[i+1] = list(out$schnitt)})
+ suppressWarnings({E(g)$conditionedSet[i] = list(out$differenz)})
+ suppressWarnings({E(g)$conditioningSet[i] = list(out$schnitt)})
}
E(g)[i]$todel = !ok
@@ -452,7 +452,7 @@
}
- M = M+1
+ M = M#+1
M[is.na(M)]=0
Type[is.na(Type)]=0
Mehr Informationen über die Mailingliste Vinecopula-commits