From noreply at r-forge.r-project.org  Thu Apr  4 19:33:11 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Thu,  4 Apr 2013 19:33:11 +0200 (CEST)
Subject: [Vinecopula-commits] r6 - / pkg/R
Message-ID: <20130404173311.2EF4E184639@r-forge.r-project.org>

Author: ben_graeler
Date: 2013-04-04 19:33:10 +0200 (Thu, 04 Apr 2013)
New Revision: 6

Modified:
   /
   pkg/R/RVineAIC.r
   pkg/R/RVineGrad.r
   pkg/R/RVineHessian.r
   pkg/R/RVineLogLik.r
   pkg/R/RVineMLE.R
   pkg/R/RVinePar2Tau.r
   pkg/R/RVineSeqEst.R
   pkg/R/RVineSim.R
   pkg/R/RVineTreePlot.r
Log:
- replaced is(RVM) != "RVineMatrix" with !is(RVM, "RVineMatrix") in several if-statetments to avoid warnings in case "RVM" possesses several S3-classes.


Property changes on: 
___________________________________________________________________
Added: svn:ignore
   + .Rproj.user
.Rhistory
.RData


Modified: pkg/R/RVineAIC.r
===================================================================
--- pkg/R/RVineAIC.r	2013-04-04 09:24:02 UTC (rev 5)
+++ pkg/R/RVineAIC.r	2013-04-04 17:33:10 UTC (rev 6)
@@ -11,7 +11,7 @@
 	n<-d
 	N<-T
 	if(n != dim(RVM)) stop("Dimensions of 'data' and 'RVM' do not match.")
-  if(is(RVM) != "RVineMatrix") stop("'RVM' has to be an RVineMatrix object.")
+  if(!is(RVM,"RVineMatrix")) stop("'RVM' has to be an RVineMatrix object.")
   
 	npar = sum(RVM$family >= 1, na.rm=TRUE) + sum(RVM$family %in% c(2,7:10,17:20,27:30,37:40),na.rm=TRUE)
   npar_pair = (RVM$family>=1)+(RVM$family%in%c(2,7:10,17:20,27:30,37:40))


Property changes on: pkg/R/RVineAIC.r
___________________________________________________________________
Added: svn:eol-style
   + LF

Modified: pkg/R/RVineGrad.r
===================================================================
--- pkg/R/RVineGrad.r	2013-04-04 09:24:02 UTC (rev 5)
+++ pkg/R/RVineGrad.r	2013-04-04 17:33:10 UTC (rev 6)
@@ -1,150 +1,150 @@
-#################################################################
-#								#
-# RVineGrad							#
-#								#
-# Function to calculate the derivative of one			#
-# pair-copula in an R-vine					#
-#								#
-# Input:							#
-# data		data set					#
-# RVM		R-Vine matrix object				#
-# calcupdate	array of Update-Matrices (output of RVineMatrixUpdate)	#
-# par, par2	Copula parameter stored in an RVM-Matrix	#
-# start.V	log-liklihoods (output of RVineLogLik)		#
-#								#
-# Output:							#
-# gradient	gradient of the R-vine				#
-#################################################################
-
-RVineGrad <-function(data,RVM,par=RVM$par,par2=RVM$par2,start.V=NA, posParams=(RVM$family > 0))
-{
-
-if(any(!(RVM$family %in% c(0,1:6,13,14,16,23,24,26,33,34,36)))) stop("Copula family not implemented.")
-
-if(is.vector(data)){
-      data = t(as.matrix(data))
-    }else{
-      data=as.matrix(data)
-    }
-
-    if(any(data>1) || any(data<0)) stop("Data has be in the interval [0,1].")
-    d=dim(data)[2]
-    T=dim(data)[1]
-    n<-d
-    N<-T
-	  if(n != dim(RVM)) stop("Dimensions of 'data' and 'RVM' do not match.")
-    if(is(RVM) != "RVineMatrix") stop("'RVM' has to be an RVineMatrix object.")
-  
-
-#if(any(is.na(calcupdate)))
-#{
-#	n=dim(RVM)
-#	calcupdate=array(0,dim=c(n,n,n,n))
-#	for(i in (n-1):1){
-#	    for(k in n:(i+1)){
-#		calcupdate[, ,k,i ]=RVineMatrixUpdate(RVM,k,i)
-#	    }
-#	}
-#}
-
-o = diag(RVM$Matrix)
-	if(any(o != length(o):1))
-	{
-		oldRVM = RVM
-		RVM = normalizeRVineMatrix(RVM)
-		#RVM = getFromNamespace("normalizeRVineMatrix","VineCopula")(RVM)
-		data = data[,o[length(o):1]]
-	}
-
-    if(any(is.na(start.V)))
-    {
-	loglik=RVineLogLik(data,RVM,par=par, par2=par2,separate=TRUE)
-	V=loglik$V
-		
-	}
-	else
-	{
-  		V = start.V
-  		V$value[V$value %in% c(NA,NaN,-Inf)]<- -1e10
-  		if(any(is.na(V$value))) message("NA in LogL call")
-	}
-    
-    
-    ll=as.vector(V$value)
-    vv=as.vector(V$direct)
-    vv2=as.vector(V$indirect)
-    #calcup=as.vector(calcupdate)
-    
-    w1=as.vector(RVM$family)
-    w1[is.na(w1)]<-0
-    th=as.vector(par)
-	  th[is.na(th)]<-0
-    th2=as.vector(par2)
-	  th2[is.na(th2)]<-0
-    condirect=as.vector(as.numeric(RVM$CondDistr$direct))
-    conindirect=as.vector(as.numeric(RVM$CondDistr$indirect))
-    maxmat=as.vector(RVM$MaxMat)
-    matri=as.vector(RVM$Matrix)
-    matri[is.na(matri)]<-0
-    maxmat[is.na(maxmat)]<-0
-    condirect[is.na(condirect)]<-0
-    conindirect[is.na(conindirect)]<-0
-   # tilde_vdirect_array=array(0,dim=c(n,n,N,n,n))
-   # tilde_vindirect_array=array(0,dim=c(n,n,N,n,n))
-   # tilde_value_array=array(0,dim=c(n,n,N,n,n))
-   
-    
-   out=rep(0,sum(posParams[lower.tri(posParams, diag=FALSE)])+sum(w1==2))
-
-
-out <- .C("VineLogLikRvineGradient",
-              as.integer(T),
-              as.integer(d),
-              as.integer(w1),
-              as.integer(maxmat),
-              as.integer(matri),
-              as.integer(condirect),
-              as.integer(conindirect),
-              as.double(th),
-              as.double(th2),
-              as.double(data),
-              as.double(out),
-              as.double(ll),
-              as.double(vv),
-              as.double(vv2),
-              #as.integer(calcup),
-	      as.integer(as.vector(posParams)),
-	      #as.double(as.vector(tilde_vdirect_array)),
-	      #as.double(as.vector(tilde_vindirect_array)),
-	      #as.double(as.vector(tilde_value_array)),
-		PACKAGE = 'VineCopula')
-
-
-	gradient2 <- out[[11]]
-	gradient2[gradient2 %in% c(NA,NaN,-Inf)] <- -1e10
-
-	dd=sum(RVM$family>0)
-	tt=sum(w1==2)
-	grad1=gradient2[1:dd]
-	gradient=grad1[dd:1]
-	if(tt>0)
-	{
-		grad2=gradient2[(dd+1):(dd+tt)]
-		gradient=c(gradient,grad2[tt:1])
-	}
-
-
-	#tilde_vdirect=out[[16]]
-	#tilde_vindirect=out[[17]]
-	#tilde_value=out[[18]]
-	#V$tilde_direct = array(tilde_vdirect,dim=c(n,n,N,n,n))
-	#V$tilde_indirect = array(tilde_vindirect,dim=c(n,n,N,n,n))
-	#V$tilde_value = array(tilde_value,dim=c(n,n,N,n,n))
-
-	
-
-
-#out2=list(gradient=gradient,V=V)
-out2=list(gradient=gradient)
-return(out2)
-}
+#################################################################
+#								#
+# RVineGrad							#
+#								#
+# Function to calculate the derivative of one			#
+# pair-copula in an R-vine					#
+#								#
+# Input:							#
+# data		data set					#
+# RVM		R-Vine matrix object				#
+# calcupdate	array of Update-Matrices (output of RVineMatrixUpdate)	#
+# par, par2	Copula parameter stored in an RVM-Matrix	#
+# start.V	log-liklihoods (output of RVineLogLik)		#
+#								#
+# Output:							#
+# gradient	gradient of the R-vine				#
+#################################################################
+
+RVineGrad <-function(data,RVM,par=RVM$par,par2=RVM$par2,start.V=NA, posParams=(RVM$family > 0))
+{
+
+if(any(!(RVM$family %in% c(0,1:6,13,14,16,23,24,26,33,34,36)))) stop("Copula family not implemented.")
+
+if(is.vector(data)){
+      data = t(as.matrix(data))
+    }else{
+      data=as.matrix(data)
+    }
+
+    if(any(data>1) || any(data<0)) stop("Data has be in the interval [0,1].")
+    d=dim(data)[2]
+    T=dim(data)[1]
+    n<-d
+    N<-T
+	  if(n != dim(RVM)) stop("Dimensions of 'data' and 'RVM' do not match.")
+    if(!is(RVM,"RVineMatrix")) stop("'RVM' has to be an RVineMatrix object.")
+  
+
+#if(any(is.na(calcupdate)))
+#{
+#	n=dim(RVM)
+#	calcupdate=array(0,dim=c(n,n,n,n))
+#	for(i in (n-1):1){
+#	    for(k in n:(i+1)){
+#		calcupdate[, ,k,i ]=RVineMatrixUpdate(RVM,k,i)
+#	    }
+#	}
+#}
+
+o = diag(RVM$Matrix)
+	if(any(o != length(o):1))
+	{
+		oldRVM = RVM
+		RVM = normalizeRVineMatrix(RVM)
+		#RVM = getFromNamespace("normalizeRVineMatrix","VineCopula")(RVM)
+		data = data[,o[length(o):1]]
+	}
+
+    if(any(is.na(start.V)))
+    {
+	loglik=RVineLogLik(data,RVM,par=par, par2=par2,separate=TRUE)
+	V=loglik$V
+		
+	}
+	else
+	{
+  		V = start.V
+  		V$value[V$value %in% c(NA,NaN,-Inf)]<- -1e10
+  		if(any(is.na(V$value))) message("NA in LogL call")
+	}
+    
+    
+    ll=as.vector(V$value)
+    vv=as.vector(V$direct)
+    vv2=as.vector(V$indirect)
+    #calcup=as.vector(calcupdate)
+    
+    w1=as.vector(RVM$family)
+    w1[is.na(w1)]<-0
+    th=as.vector(par)
+	  th[is.na(th)]<-0
+    th2=as.vector(par2)
+	  th2[is.na(th2)]<-0
+    condirect=as.vector(as.numeric(RVM$CondDistr$direct))
+    conindirect=as.vector(as.numeric(RVM$CondDistr$indirect))
+    maxmat=as.vector(RVM$MaxMat)
+    matri=as.vector(RVM$Matrix)
+    matri[is.na(matri)]<-0
+    maxmat[is.na(maxmat)]<-0
+    condirect[is.na(condirect)]<-0
+    conindirect[is.na(conindirect)]<-0
+   # tilde_vdirect_array=array(0,dim=c(n,n,N,n,n))
+   # tilde_vindirect_array=array(0,dim=c(n,n,N,n,n))
+   # tilde_value_array=array(0,dim=c(n,n,N,n,n))
+   
+    
+   out=rep(0,sum(posParams[lower.tri(posParams, diag=FALSE)])+sum(w1==2))
+
+
+out <- .C("VineLogLikRvineGradient",
+              as.integer(T),
+              as.integer(d),
+              as.integer(w1),
+              as.integer(maxmat),
+              as.integer(matri),
+              as.integer(condirect),
+              as.integer(conindirect),
+              as.double(th),
+              as.double(th2),
+              as.double(data),
+              as.double(out),
+              as.double(ll),
+              as.double(vv),
+              as.double(vv2),
+              #as.integer(calcup),
+	      as.integer(as.vector(posParams)),
+	      #as.double(as.vector(tilde_vdirect_array)),
+	      #as.double(as.vector(tilde_vindirect_array)),
+	      #as.double(as.vector(tilde_value_array)),
+		PACKAGE = 'VineCopula')
+
+
+	gradient2 <- out[[11]]
+	gradient2[gradient2 %in% c(NA,NaN,-Inf)] <- -1e10
+
+	dd=sum(RVM$family>0)
+	tt=sum(w1==2)
+	grad1=gradient2[1:dd]
+	gradient=grad1[dd:1]
+	if(tt>0)
+	{
+		grad2=gradient2[(dd+1):(dd+tt)]
+		gradient=c(gradient,grad2[tt:1])
+	}
+
+
+	#tilde_vdirect=out[[16]]
+	#tilde_vindirect=out[[17]]
+	#tilde_value=out[[18]]
+	#V$tilde_direct = array(tilde_vdirect,dim=c(n,n,N,n,n))
+	#V$tilde_indirect = array(tilde_vindirect,dim=c(n,n,N,n,n))
+	#V$tilde_value = array(tilde_value,dim=c(n,n,N,n,n))
+
+	
+
+
+#out2=list(gradient=gradient,V=V)
+out2=list(gradient=gradient)
+return(out2)
+}


Property changes on: pkg/R/RVineGrad.r
___________________________________________________________________
Added: svn:eol-style
   + LF

Modified: pkg/R/RVineHessian.r
===================================================================
--- pkg/R/RVineHessian.r	2013-04-04 09:24:02 UTC (rev 5)
+++ pkg/R/RVineHessian.r	2013-04-04 17:33:10 UTC (rev 6)
@@ -1,91 +1,91 @@
-RVineHessian <-function(data,RVM)
-{
-
-	if(any(!(RVM$family %in% c(0,1:6,13,14,16,23,24,26,33,34,36)))) stop("Copula family not implemented.")
-
-	if(is.vector(data)){
-		data = t(as.matrix(data))
-	}else{
-		data=as.matrix(data)
-	}
-	if(any(data>1) || any(data<0)) stop("Data has be in the interval [0,1].")
-	if(is.null(dim(data)))
-	{
-		d=length(data)
-		T=1
-	}
-	else
-	{
-		d=dim(data)[2]
-		T=dim(data)[1]
-	}
-	n<-d
-	N<-T
-	if(n != dim(RVM)) stop("Dimensions of 'data' and 'RVM' do not match.")
-	if(is(RVM) != "RVineMatrix") stop("'RVM' has to be an RVineMatrix object.")
-  
-
-	o = diag(RVM$Matrix)
-	if(any(o != length(o):1))
-	{
-		oldRVM = RVM
-		#RVM = normalizeRVineMatrix(RVM)
-		RVM = getFromNamespace("normalizeRVineMatrix","VineCopula")(RVM)
-		data = data[,o[length(o):1]]
-	}
-	
-	dd=d*(d-1)/2
-	tt=sum(RVM$family==2)
-	hessian=matrix(0,dd+tt,dd+tt)
-	subhess=matrix(0,dd+tt,dd+tt)
-	der=matrix(0,dd+tt,dd+tt)
-	subder=matrix(0,dd+tt,dd+tt)
-
-	out <- .C("hesse",
-		as.integer(T),
-		as.integer(d),
-		as.integer(as.vector(RVM$family)),
-		as.integer(as.vector(RVM$MaxMat)),
-		as.integer(as.vector(RVM$Matrix)),
-		as.integer(as.vector(RVM$CondDistr$direct)),
-		as.integer(as.vector(RVM$CondDistr$indirect)),
-		as.double(as.vector(RVM$par)),
-		as.double(as.vector(RVM$par2)),
-		as.double(as.vector(data)),
-		as.double(as.vector(hessian)),
-		as.double(as.vector(subhess)),
-		as.double(as.vector(der)),
-		as.double(as.vector(subder)),
-		PACKAGE = 'VineCopula')
-	
-	hessian=matrix(out[[11]],dd+tt,dd+tt)
-	subhess=matrix(out[[12]],dd+tt,dd+tt)
-	der=matrix(out[[13]],dd+tt,dd+tt)
-	subder=matrix(out[[14]],dd+tt,dd+tt)
-	
-	# der[1:dd,1:dd]=der[dd:1,dd:1]
-	# if(tt>0)
-	# {
-		# der[(dd+1):(dd+tt),1:dd]=der[(dd+tt):(dd+1),dd:1]
-		# der[1:dd,(dd+1):(dd+tt)]=der[dd:1,(dd+tt):(dd+1)]
-		# der[(dd+1):(dd+tt),(dd+1):(dd+tt)]=der[(dd+tt):(dd+1),(dd+tt):(dd+1)]
-	# }
-	# hessian[1:dd,1:dd]=hessian[dd:1,dd:1]
-	# if(tt>0)
-	# {
-		# hessian[(dd+1):(dd+tt),1:dd]=hessian[(dd+tt):(dd+1),dd:1]
-		# hessian[1:dd,(dd+1):(dd+tt)]=hessian[dd:1,(dd+tt):(dd+1)]
-		# hessian[(dd+1):(dd+tt),(dd+1):(dd+tt)]=hessian[(dd+tt):(dd+1),(dd+tt):(dd+1)]
-	# }
-		
-	test=apply(hessian,2,function(x) max(abs(x)))
-  hessian=hessian[test>0,test>0]
-  subhess=subhess[test>0,test>0]
-  der=der[test>0,test>0]
-  subder=subder[test>0,test>0]
-  
-  
-	out=list(hessian=hessian, der=der)
-
-return(out)
-}
+RVineHessian <-function(data,RVM)
+{
+
+	if(any(!(RVM$family %in% c(0,1:6,13,14,16,23,24,26,33,34,36)))) stop("Copula family not implemented.")
+
+	if(is.vector(data)){
+		data = t(as.matrix(data))
+	}else{
+		data=as.matrix(data)
+	}
+	if(any(data>1) || any(data<0)) stop("Data has be in the interval [0,1].")
+	if(is.null(dim(data)))
+	{
+		d=length(data)
+		T=1
+	}
+	else
+	{
+		d=dim(data)[2]
+		T=dim(data)[1]
+	}
+	n<-d
+	N<-T
+	if(n != dim(RVM)) stop("Dimensions of 'data' and 'RVM' do not match.")
+	if(!is(RVM,"RVineMatrix")) stop("'RVM' has to be an RVineMatrix object.")
+  
+
+	o = diag(RVM$Matrix)
+	if(any(o != length(o):1))
+	{
+		oldRVM = RVM
+		#RVM = normalizeRVineMatrix(RVM)
+		RVM = getFromNamespace("normalizeRVineMatrix","VineCopula")(RVM)
+		data = data[,o[length(o):1]]
+	}
+	
+	dd=d*(d-1)/2
+	tt=sum(RVM$family==2)
+	hessian=matrix(0,dd+tt,dd+tt)
+	subhess=matrix(0,dd+tt,dd+tt)
+	der=matrix(0,dd+tt,dd+tt)
+	subder=matrix(0,dd+tt,dd+tt)
+
+	out <- .C("hesse",
+		as.integer(T),
+		as.integer(d),
+		as.integer(as.vector(RVM$family)),
+		as.integer(as.vector(RVM$MaxMat)),
+		as.integer(as.vector(RVM$Matrix)),
+		as.integer(as.vector(RVM$CondDistr$direct)),
+		as.integer(as.vector(RVM$CondDistr$indirect)),
+		as.double(as.vector(RVM$par)),
+		as.double(as.vector(RVM$par2)),
+		as.double(as.vector(data)),
+		as.double(as.vector(hessian)),
+		as.double(as.vector(subhess)),
+		as.double(as.vector(der)),
+		as.double(as.vector(subder)),
+		PACKAGE = 'VineCopula')
+	
+	hessian=matrix(out[[11]],dd+tt,dd+tt)
+	subhess=matrix(out[[12]],dd+tt,dd+tt)
+	der=matrix(out[[13]],dd+tt,dd+tt)
+	subder=matrix(out[[14]],dd+tt,dd+tt)
+	
+	# der[1:dd,1:dd]=der[dd:1,dd:1]
+	# if(tt>0)
+	# {
+		# der[(dd+1):(dd+tt),1:dd]=der[(dd+tt):(dd+1),dd:1]
+		# der[1:dd,(dd+1):(dd+tt)]=der[dd:1,(dd+tt):(dd+1)]
+		# der[(dd+1):(dd+tt),(dd+1):(dd+tt)]=der[(dd+tt):(dd+1),(dd+tt):(dd+1)]
+	# }
+	# hessian[1:dd,1:dd]=hessian[dd:1,dd:1]
+	# if(tt>0)
+	# {
+		# hessian[(dd+1):(dd+tt),1:dd]=hessian[(dd+tt):(dd+1),dd:1]
+		# hessian[1:dd,(dd+1):(dd+tt)]=hessian[dd:1,(dd+tt):(dd+1)]
+		# hessian[(dd+1):(dd+tt),(dd+1):(dd+tt)]=hessian[(dd+tt):(dd+1),(dd+tt):(dd+1)]
+	# }
+		
+	test=apply(hessian,2,function(x) max(abs(x)))
+  hessian=hessian[test>0,test>0]
+  subhess=subhess[test>0,test>0]
+  der=der[test>0,test>0]
+  subder=subder[test>0,test>0]
+  
+  
+	out=list(hessian=hessian, der=der)
+
+return(out)
+}


Property changes on: pkg/R/RVineHessian.r
___________________________________________________________________
Added: svn:eol-style
   + LF

Modified: pkg/R/RVineLogLik.r
===================================================================
--- pkg/R/RVineLogLik.r	2013-04-04 09:24:02 UTC (rev 5)
+++ pkg/R/RVineLogLik.r	2013-04-04 17:33:10 UTC (rev 6)
@@ -11,7 +11,7 @@
 	n<-d
 	N<-T
 	if(n != dim(RVM)) stop("Dimensions of 'data' and 'RVM' do not match.")
-  if(is(RVM) != "RVineMatrix") stop("'RVM' has to be an RVineMatrix object.")
+  if(!is(RVM, "RVineMatrix")) stop("'RVM' has to be an RVineMatrix object.")
   
 	o = diag(RVM$Matrix)
 	if(any(o != length(o):1))


Property changes on: pkg/R/RVineLogLik.r
___________________________________________________________________
Added: svn:eol-style
   + LF

Modified: pkg/R/RVineMLE.R
===================================================================
--- pkg/R/RVineMLE.R	2013-04-04 09:24:02 UTC (rev 5)
+++ pkg/R/RVineMLE.R	2013-04-04 17:33:10 UTC (rev 6)
@@ -1,361 +1,361 @@
-RVineMLE <- function(data, RVM, start=RVM$par, start2=RVM$par2, maxit=200, max.df=30, max.BB=list(BB1=c(5,6),BB6=c(6,6),BB7=c(5,6),BB8=c(6,1)), grad=FALSE, hessian=FALSE, se=FALSE, ...)
-{
-  if(is(RVM) != "RVineMatrix") stop("'RVM' has to be an RVineMatrix object.")
-	if(maxit<=0) stop("'maxit' has to be greater than zero.")	
-                                               
-  if(max.df<=2) stop("The upper bound for the degrees of freedom parameter has to be larger than 2.")
-  if(!is.list(max.BB)) stop("'max.BB' has to be a list.")
-  if(max.BB$BB1[1] < 0.001) stop("The upper bound for the first parameter of the BB1 copula should be greater than 0.001 (lower bound for estimation).")
-  if(max.BB$BB1[2] < 1.001) stop("The upper bound for the second parameter of the BB1 copula should be greater than 1.001 (lower bound for estimation).")
-  if(max.BB$BB6[1] < 1.001) stop("The upper bound for the first parameter of the BB6 copula should be greater than 1.001 (lower bound for estimation).")
-  if(max.BB$BB6[2] < 1.001) stop("The upper bound for the second parameter of the BB6 copula should be greater than 1.001 (lower bound for estimation).")
-  if(max.BB$BB7[1] < 1.001) stop("The upper bound for the first parameter of the BB7 copula should be greater than 1.001 (lower bound for estimation).")
-  if(max.BB$BB7[2] < 0.001) stop("The upper bound for the second parameter of the BB7 copula should be greater than 0.001 (lower bound for estimation).")
-  if(max.BB$BB8[1] < 1.001) stop("The upper bound for the first parameter of the BB1 copula should be greater than 0.001 (lower bound for estimation).")
-  if(max.BB$BB8[2] < 0.001 || max.BB$BB8[2] > 1) stop("The upper bound for the second parameter of the BB1 copula should be in the interval [0,1].")
-
-
-  Matrix=RVM$Matrix
-
-  if(!all(start %in% c(0,NA)))
-	{
-	for(i in 2:dim(Matrix)[1]){
-    for(j in 1:(i-1)){
-    	if((RVM$family[i,j]==1 || RVM$family[i,j]==2) && abs(start[i,j])>=1) stop("The parameter of the Gaussian and t-copula has to be in the interval (-1,1).")
-	if(RVM$family[i,j]==2 && start2[i,j]<=1) stop("The degrees of freedom parameter of the t-copula has to be larger than 1.")    	
-	if((RVM$family[i,j]==3 || RVM$family[i,j]==13) && start[i,j]<=0) stop("The parameter of the Clayton copula has to be positive.")
-    	if((RVM$family[i,j]==4 || RVM$family[i,j]==14) && start[i,j]<1) stop("The parameter of the Gumbel copula has to be in the interval [1,oo).")
-    	if((RVM$family[i,j]==6 || RVM$family[i,j]==16) && start[i,j]<=1) stop("The parameter of the Joe copula has to be in the interval (1,oo).")	
-    	if(RVM$family[i,j]==5 && start[i,j]==0) stop("The parameter of the Frank copula has to be unequal to 0.")
-    	if((RVM$family[i,j]==7 || RVM$family[i,j]==17) && start[i,j]<=0) stop("The first parameter of the BB1 copula has to be positive.")
-    	if((RVM$family[i,j]==7 || RVM$family[i,j]==17) && start2[i,j]<1) stop("The second parameter of the BB1 copula has to be in the interval [1,oo).")
-	if((RVM$family[i,j]==8 || RVM$family[i,j]==18) && start[i,j]<=0) stop("The first parameter of the BB6 copula has to be in the interval [1,oo).")
-	if((RVM$family[i,j]==8 || RVM$family[i,j]==18) && start2[i,j]<1) stop("The second parameter of the BB6 copula has to be in the interval [1,oo).")
-    	if((RVM$family[i,j]==9 || RVM$family[i,j]==19) && start[i,j]<1) stop("The first parameter of the BB7 copula has to be in the interval [1,oo).")
-    	if((RVM$family[i,j]==9 || RVM$family[i,j]==19) && start2[i,j]<=0) stop("The second parameter of the BB7 copula has to be positive.")
-	if((RVM$family[i,j]==10 || RVM$family[i,j]==20) && start[i,j]<1) stop("The first parameter of the BB8 copula has to be in the interval [1,oo).")
-	if((RVM$family[i,j]==10 || RVM$family[i,j]==20) && (start2[i,j]<=0 || start2[i,j]>1)) stop("The second parameter of the BB8 copula has to be in the interval (0,1].")      	
-      if((RVM$family[i,j]==23 || RVM$family[i,j]==33) && start[i,j]>=0) stop("The parameter of the rotated Clayton copula has to be negative.")
-    	if((RVM$family[i,j]==24 || RVM$family[i,j]==34) && start[i,j]>-1) stop("The parameter of the rotated Gumbel copula has to be in the interval (-oo,-1].")
-    	if((RVM$family[i,j]==26 || RVM$family[i,j]==36) && start[i,j]>=-1) stop("The parameter of the rotated Joe copula has to be in the interval (-oo,-1).")
-  	if((RVM$family[i,j]==27 || RVM$family[i,j]==37) && start[i,j]>=0) stop("The first parameter of the rotated BB1 copula has to be negative.")
-	if((RVM$family[i,j]==27 || RVM$family[i,j]==37) && start2[i,j]>-1) stop("The second parameter of the rotated BB1 copula has to be in the interval (-oo,-1].")
-	if((RVM$family[i,j]==28 || RVM$family[i,j]==38) && start[i,j]>=0) stop("The first parameter of the rotated BB6 copula has to be in the interval (-oo,-1].")
-	if((RVM$family[i,j]==28 || RVM$family[i,j]==38) && start2[i,j]>-1) stop("The second parameter of the rotated BB6 copula has to be in the interval (-oo,-1].")
-	if((RVM$family[i,j]==29 || RVM$family[i,j]==39) && start[i,j]>-1) stop("The first parameter of the rotated BB7 copula has to be in the interval (-oo,-1].")
-	if((RVM$family[i,j]==29 || RVM$family[i,j]==39) && start2[i,j]>=0) stop("The second parameter of the rotated BB7 copula has to be negative.")
-	if((RVM$family[i,j]==30 || RVM$family[i,j]==40) && start[i,j]>-1) stop("The first parameter of the rotated BB8 copula has to be in the interval (-oo,-1].")
-	if((RVM$family[i,j]==30 || RVM$family[i,j]==40) && (start2[i,j]>=0 || start2[i,j]<(-1))) stop("The second parameter of the rotated BB8 copula has to be in the interval [-1,0).")
-	  }
-	  }
-	}
-
-	data<-as.matrix(data)
-	if(any(data>1) || any(data<0)) stop("Data has be in the interval [0,1].")
-	d=dim(data)[2]
-	T=dim(data)[1]
-	n<-d
-	N<-T
-	if(n != dim(RVM)) stop("Dimensions of 'data' and 'RVM' do not match.")
-	if(T<2) stop("Number of observations has to be at least 2.")
-
-	o = diag(RVM$Matrix)
-	oldRVM = RVM
-	RVM = normalizeRVineMatrix(RVM)
-	data = data[,o[length(o):1]]
-	
-	
-	n = dim(RVM)
-	N = dim(data)[1]
-
-	if(all(start==0))
-	{
-		est_start=RVineSeqEst(data,RVM,max.df=max.df,max.BB=max.BB)
-		start=est_start$RVM$par
-		start2=est_start$RVM$par2
-	}
-
-	posParams = (RVM$family > 0)
-	posParams2 = (RVM$family %in% c(2,7,8,9,10,17,18,19,20,27,28,29,30,37,38,39,40)) 
-
-	posParams[is.na(posParams)] = FALSE
-	posParams2[is.na(posParams2)] = FALSE
-	
-	nParams = sum(posParams, na.rm=TRUE)
-	nParams2 = sum(posParams2, na.rm=TRUE)
-	
-	startpar = double(nParams+nParams2)
-
-	Copula.Types = RVM$family[posParams]
-	
-	startpar[1:nParams] = start[posParams]
-	if(nParams2 > 0){
-		startpar[(nParams+1):(nParams+nParams2)] = start2[posParams2]
-	}
-	
-	#Grenzen
-	lb = double(nParams+nParams2)
-	ub = double(nParams+nParams2)
-	
-	for(i in 1:nParams){
-		if(Copula.Types[i] %in% c(1,2)){ #Normal
-				lb[i] = -0.98
-				ub[i] = 0.98
-		}else if(Copula.Types[i] %in% c(3,13)){ #clayton
-				lb[i] = 0.0001
-				ub[i] = Inf
-		}else if(Copula.Types[i] %in% c(23,33)){ #rotated clayton
-				lb[i] = -Inf
-				ub[i] = -0.0001
-		}else if(Copula.Types[i] %in% c(4,14)){ #gumbel
-				lb[i] = 1.0001
-				ub[i] = Inf
-		}else if(Copula.Types[i] %in% c(24,34)){ #rotated gumbel
-				lb[i] = -Inf
-				ub[i] = -1.0001 
-		}else if(Copula.Types[i]==5){ #frank
-				lb[i] = -Inf
-				ub[i] = Inf
-		}else if(Copula.Types[i] %in% c(6,16)){ #joe
-				lb[i] = 1.0001
-				ub[i] = Inf
-		}else if(Copula.Types[i] %in% c(26,36)){ #rotated joe
-				lb[i] = -Inf
-				ub[i] = -1.0001				
-		}else if(Copula.Types[i] %in% c(7,17)){ #bb1
-				lb[i] = 0.001
-				ub[i] = max.BB$BB1[1]
-		}else if(Copula.Types[i] %in% c(8,18)){ #bb6
-				lb[i] = 1.001
-				ub[i] = max.BB$BB6[1]
-		}else if(Copula.Types[i] %in% c(9,19)){ #bb7
-				lb[i] = 1.001
-				ub[i] = max.BB$BB7[1]
-		}else if(Copula.Types[i] %in% c(10,20)){ #bb8
-				lb[i] = 1.001
-				ub[i] = max.BB$BB8[1]
-		}else if(Copula.Types[i] %in% c(27,37)){ #rotated bb1
-				lb[i] = -max.BB$BB1[1]
-				ub[i] = -0.001
-		}else if(Copula.Types[i] %in% c(28,38)){ #rotated bb6
-				lb[i] = -max.BB$BB6[1]
-				ub[i] = -1.001
-		}else if(Copula.Types[i] %in% c(29,39)){ #rotated bb7
-				lb[i] = -max.BB$BB7[1]
-				ub[i] = -1.001
-		}else if(Copula.Types[i] %in% c(30,40)){ #rotated bb8
-				lb[i] = -max.BB$BB8[1]
-				ub[i] = -1.001
-		}else if(Copula.Types[i] %in% c(43,44)){ #double Clayton, Gumbel
-				lb[i] = -0.9999
-				ub[i] = 0.9999
-		}
-
-	}
-	
-	if(nParams2 > 0){
-	    todo = which(Copula.Types %in% c(2,7:10,17:20,27:30,37:40))	
-		
-	    for(i in 1:nParams2){
-  		if(Copula.Types[todo[i]]==2){ #t
-  				lb[nParams+i] = 2.001
-  				ub[nParams+i] = max.df
-		}else if(Copula.Types[todo[i]] %in% c(7,17)){ #bb1
-				lb[nParams+i] = 1.001
-  				ub[nParams+i] = max.BB$BB1[2]
-		}else if(Copula.Types[todo[i]] %in% c(8,18)){ #bb6
-				lb[nParams+i] = 1.001
-  				ub[nParams+i] = max.BB$BB6[2]
-		}else if(Copula.Types[todo[i]] %in% c(9,19)){ #bb7
-  				lb[nParams+i] = 0.001
-  				ub[nParams+i] = max.BB$BB7[2]
-		}else if(Copula.Types[todo[i]] %in% c(10,20)){ #bb8
-				lb[nParams+i] = 0.001
-  				ub[nParams+i] = max.BB$BB1[2]
-		}else if(Copula.Types[todo[i]] %in% c(27,37)){ #rotated bb1
-				lb[nParams+i] = -max.BB$BB1[2]
-  				ub[nParams+i] = -1.001
-		}else if(Copula.Types[todo[i]] %in% c(28,38)){ #rotated bb6
-				lb[nParams+i] = -max.BB$BB6[2]
-  				ub[nParams+i] = -1.001
-		}else if(Copula.Types[todo[i]] %in% c(29,39)){ #rotated bb7
-				lb[nParams+i] = -max.BB$BB7[2]
-  				ub[nParams+i] = -1.001
-		}else if(Copula.Types[todo[i]] %in% c(30,40)){ #rotated bb8
-				lb[nParams+i] = -max.BB$BB8[2]
-  				ub[nParams+i] = -0.001
-		}
-  	    }
-	}
-	
-	startpar1=startpar[Copula.Types!=0]
-
-	#calcupdate=NA
-	#V=NA
-	
-	optim_LL <- function(parm,data,posParams,posParams2,Copula.Types,start,start2,RVM, calcupdate=NA){
-
-		nParams = sum(posParams, na.rm=TRUE)
-		nParams2 = sum(posParams2, na.rm=TRUE)
-
-		#for(k in 1:nParams)		
-		#{
-		#	if(Copula.Types[k]==0)
-		#	{
-		#		if(k==1){parm=c(0,parm)}
-		#		else if(k>length(parm)){parm=c(parm,0)}
-		#		else {parm=c(parm[1:(k-1)],0,parm[k:length(parm)])}
-		#	}
-		#}
-
-		matrixParams = start
-		matrixParams2 = start2
-
-		matrixParams[posParams] <- parm[1:nParams]
-
-		if(nParams2 > 0){
-			matrixParams2[posParams2] <- parm[(nParams+1):(nParams+nParams2)]
-		}
-		
-		ll=RVineLogLik(data,RVM,par=matrixParams, par2=matrixParams2)
-		
-		#V=ll$V
-
-		if(is.finite(ll$loglik))
-		{
-			return(ll$loglik)
-		}
-		else
-		{
-			if(is.na(ll$loglik)){message(parm)}
-			message(ll$loglik)
-			return(-10^305)
-		}
- 	}
-
-
-	ableitung <- function(parm,data,posParams,posParams2,Copula.Types,start,start2,RVM,calcupdate)
-	{
-		nParams = sum(posParams, na.rm=TRUE)
-		nParams2 = sum(posParams2, na.rm=TRUE)
-		
-	#	outparm=parm
-	#	for (i in 1:length(parm)) {
-	#		handle_parm=parm
-	#		handle_parm[i]=handle_parm[i]+0.000001
-	#		handle_parm2=parm
-	#		handle_parm2[i]=handle_parm2[i]-0.000001
-	#		outparm[i]=(optim_LL(handle_parm,data,posParams,posParams2,Copula.Types,start,start2,RVM,calcupdate=NA)-optim_LL(handle_parm2,data,posParams,posParams2,Copula.Types,start,start2,RVM,calcupdate=NA))/(2*0.000001)
-	#	}
-	#	print("finite differences:")
-	#	print(outparm)
-
-		#for(k in 1:nParams)		
-		#{
-	#		if(Copula.Types[k]==0)
-	#		{
-	#			if(k==1){parm=c(0,parm)}
-	#			else if(k>length(parm)){parm=c(parm,0)}
-	#			else {parm=c(parm[1:(k-1)],0,parm[k:length(parm)])}
-	#		}
-	#	}
-
-		matrixParams = start
-		matrixParams2 = start2
-
-		matrixParams[posParams] <- parm[1:nParams]
-		if(nParams2 > 0){
-			matrixParams2[posParams2] <- parm[(nParams+1):(nParams+nParams2)]
-		}
-	
-		grad=RVineGrad(data=data,RVM=RVM,par=matrixParams, par2=matrixParams2, posParams=posParams)$gradient
-		return(grad)
-	}
-
-	pscale=numeric()
-	for(i in 1:nParams)
-	{
-		pscale[i] = ifelse(Copula.Types[i] %in% c(1,2,43,44), 0.01, 1)
-	}
-	pscale=c(pscale,rep(1,nParams2))
-
-	if(!exists("factr"))		# Toleranz etwas hoch setzen (gröber)
-		factr=1e8
-
-	if(all(Copula.Types %in% c(0,1,2,3:6,13,14,16,23,24,26,33,34,36,43,44)) && grad==TRUE)
-	{
-		
-			#n=dim(RVM)
-			#calcupdate=array(0,dim=c(n,n,n,n))
-			#for(i in (n-1):1){
-			#    for(k in n:(i+1)){
-			#	calcupdate[, ,k,i ]=RVineMatrixUpdate(RVM,k,i)
-			#    }
-			#}
-		if(hessian==TRUE || se==TRUE)
-		{
-			out1 = optim(par=startpar1,fn=optim_LL, gr=ableitung,
-			data=data,posParams=posParams,posParams2=posParams2,Copula.Types=Copula.Types,start=start,start2=start2,RVM=RVM,
-			method="L-BFGS-B",control=list(fnscale=-1,maxit=maxit,trace=1,parscale=pscale,factr=factr),lower=lb,upper=ub,hessian=TRUE)
-		}
-		else
-		{
-			out1 = optim(par=startpar1,fn=optim_LL, gr=ableitung,
-			data=data,posParams=posParams,posParams2=posParams2,Copula.Types=Copula.Types,start=start,start2=start2,RVM=RVM,
-			method="L-BFGS-B",control=list(fnscale=-1,maxit=maxit,trace=1,parscale=pscale,factr=factr),lower=lb,upper=ub)
-		}
-	}
-	else
-	{
-		if(hessian==TRUE || se==TRUE)
-		{
-			out1 = optim(par=startpar1,fn=optim_LL,
-			data=data,posParams=posParams,posParams2=posParams2,Copula.Types=Copula.Types,start=start,start2=start2,RVM=RVM, calcupdate=NA,
-			method="L-BFGS-B",control=list(fnscale=-1,maxit=maxit,trace=1,parscale=pscale,factr=factr,...),lower=lb,upper=ub,hessian=TRUE)
-		}
-		else
-		{
-			out1 = optim(par=startpar1,fn=optim_LL,
-			data=data,posParams=posParams,posParams2=posParams2,Copula.Types=Copula.Types,start=start,start2=start2,RVM=RVM, calcupdate=NA,
-			method="L-BFGS-B",control=list(fnscale=-1,maxit=maxit,trace=1,parscale=pscale,factr=factr,...),lower=lb,upper=ub)
-		}
-	}
-
-  out = list()
-  
-  out$value = out1$value
-  out$convergence = out1$convergence
-  out$message = out1$message
-  out$counts=out1$counts
-  if(hessian==TRUE)
-	out$hessian = out1$hessian
-  
-  if(se==TRUE)
-	out1$se=sqrt((diag(solve(-out1$hessian))))
-
-	out$RVM = oldRVM
-
-	kk=1
-	for (ll in 1:nParams)
-	{
-		out1$par[ll]=out1$par[ll]
-		if(Copula.Types[ll] %in% c(2,7:10,17:20,27:30,37:40))
-		{
-			out1$par[nParams+kk]=out1$par[nParams+kk]
-			kk=kk+1
-		}
-	}
-
-	out$RVM$par[posParams] = out1$par[1:nParams]
-	out$RVM$par2[posParams2] = out1$par[(nParams+1):(nParams+nParams2)]
-	
-	if(se==TRUE)
-	{
-		out$se=matrix(0,d,d)
-		out$se2=matrix(0,d,d)
-		out$se[posParams] = out1$se[1:nParams]
-		out$se2[posParams2] = out1$se[(nParams+1):(nParams+nParams2)]
-	}
-
-  return(out)
-}
+RVineMLE <- function(data, RVM, start=RVM$par, start2=RVM$par2, maxit=200, max.df=30, max.BB=list(BB1=c(5,6),BB6=c(6,6),BB7=c(5,6),BB8=c(6,1)), grad=FALSE, hessian=FALSE, se=FALSE, ...)
+{
+  if(!is(RVM, "RVineMatrix")) stop("'RVM' has to be an RVineMatrix object.")
+	if(maxit<=0) stop("'maxit' has to be greater than zero.")	
+                                               
+  if(max.df<=2) stop("The upper bound for the degrees of freedom parameter has to be larger than 2.")
+  if(!is.list(max.BB)) stop("'max.BB' has to be a list.")
+  if(max.BB$BB1[1] < 0.001) stop("The upper bound for the first parameter of the BB1 copula should be greater than 0.001 (lower bound for estimation).")
+  if(max.BB$BB1[2] < 1.001) stop("The upper bound for the second parameter of the BB1 copula should be greater than 1.001 (lower bound for estimation).")
+  if(max.BB$BB6[1] < 1.001) stop("The upper bound for the first parameter of the BB6 copula should be greater than 1.001 (lower bound for estimation).")
+  if(max.BB$BB6[2] < 1.001) stop("The upper bound for the second parameter of the BB6 copula should be greater than 1.001 (lower bound for estimation).")
+  if(max.BB$BB7[1] < 1.001) stop("The upper bound for the first parameter of the BB7 copula should be greater than 1.001 (lower bound for estimation).")
+  if(max.BB$BB7[2] < 0.001) stop("The upper bound for the second parameter of the BB7 copula should be greater than 0.001 (lower bound for estimation).")
+  if(max.BB$BB8[1] < 1.001) stop("The upper bound for the first parameter of the BB1 copula should be greater than 0.001 (lower bound for estimation).")
+  if(max.BB$BB8[2] < 0.001 || max.BB$BB8[2] > 1) stop("The upper bound for the second parameter of the BB1 copula should be in the interval [0,1].")
+
+
+  Matrix=RVM$Matrix
+
+  if(!all(start %in% c(0,NA)))
+	{
+	for(i in 2:dim(Matrix)[1]){
+    for(j in 1:(i-1)){
+    	if((RVM$family[i,j]==1 || RVM$family[i,j]==2) && abs(start[i,j])>=1) stop("The parameter of the Gaussian and t-copula has to be in the interval (-1,1).")
+	if(RVM$family[i,j]==2 && start2[i,j]<=1) stop("The degrees of freedom parameter of the t-copula has to be larger than 1.")    	
+	if((RVM$family[i,j]==3 || RVM$family[i,j]==13) && start[i,j]<=0) stop("The parameter of the Clayton copula has to be positive.")
+    	if((RVM$family[i,j]==4 || RVM$family[i,j]==14) && start[i,j]<1) stop("The parameter of the Gumbel copula has to be in the interval [1,oo).")
+    	if((RVM$family[i,j]==6 || RVM$family[i,j]==16) && start[i,j]<=1) stop("The parameter of the Joe copula has to be in the interval (1,oo).")	
+    	if(RVM$family[i,j]==5 && start[i,j]==0) stop("The parameter of the Frank copula has to be unequal to 0.")
+    	if((RVM$family[i,j]==7 || RVM$family[i,j]==17) && start[i,j]<=0) stop("The first parameter of the BB1 copula has to be positive.")
+    	if((RVM$family[i,j]==7 || RVM$family[i,j]==17) && start2[i,j]<1) stop("The second parameter of the BB1 copula has to be in the interval [1,oo).")
+	if((RVM$family[i,j]==8 || RVM$family[i,j]==18) && start[i,j]<=0) stop("The first parameter of the BB6 copula has to be in the interval [1,oo).")
+	if((RVM$family[i,j]==8 || RVM$family[i,j]==18) && start2[i,j]<1) stop("The second parameter of the BB6 copula has to be in the interval [1,oo).")
+    	if((RVM$family[i,j]==9 || RVM$family[i,j]==19) && start[i,j]<1) stop("The first parameter of the BB7 copula has to be in the interval [1,oo).")
+    	if((RVM$family[i,j]==9 || RVM$family[i,j]==19) && start2[i,j]<=0) stop("The second parameter of the BB7 copula has to be positive.")
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/vinecopula -r 6

From noreply at r-forge.r-project.org  Thu Apr 18 17:10:56 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Thu, 18 Apr 2013 17:10:56 +0200 (CEST)
Subject: [Vinecopula-commits] r7 - pkg/src
Message-ID: <20130418151057.1BDDD18138F@r-forge.r-project.org>

Author: ben_graeler
Date: 2013-04-18 17:10:56 +0200 (Thu, 18 Apr 2013)
New Revision: 7

Modified:
   pkg/src/logderiv.c
   pkg/src/tools.c
Log:
- fixed bug in ktau, occasional issue in difflPDF_mod remains


Modified: pkg/src/logderiv.c
===================================================================
--- pkg/src/logderiv.c	2013-04-04 17:33:10 UTC (rev 6)
+++ pkg/src/logderiv.c	2013-04-18 15:10:56 UTC (rev 7)
@@ -249,8 +249,8 @@
   negu = (double *) malloc(*n*sizeof(double));
   nparam = (double *) malloc(2*sizeof(double));
   int ncopula;
-  nparam[0]=-param[0];
-  nparam[1]=-param[1];
+  nparam[0]= -param[0];
+  nparam[1]= -param[1];
   int i;
 
 

Modified: pkg/src/tools.c
===================================================================
--- pkg/src/tools.c	2013-04-04 17:33:10 UTC (rev 6)
+++ pkg/src/tools.c	2013-04-18 15:10:56 UTC (rev 7)
@@ -84,152 +84,162 @@
 
 void ktau(double *X, double *Y, int *N, double *tau, double *S, double *D, int *T, int *U, int *V)
 {
-  // Defining variables
-  int K, L, I, J, Iend, Jend;
-  int i, j, m;
-  //double *Y2=(double *)malloc((*N)*sizeof(double));
-  double *Y2 = (double*) Calloc(*N, double);
-  //double *X2=(double *)malloc((*N)*sizeof(double));
-  double *X2 = (double*) Calloc(*N, double);
-  double *xptr,*yptr; // HJ addition for swapping
-  boolean Iflag, Jflag, Xflag;
-  *S = 0.; *D = 0.; *T = 0; *U = 0; *V = 0;
+	// Defining variables
+	int K, L, I, J, Iend, Jend;
+	int i, j, m;
+	// double *Y2, *X2;
+	//double *Y2=(double *)malloc((*N)*sizeof(double));
+	double *Y2 = Calloc(*N, double);
+	//double *X2=(double *)malloc((*N)*sizeof(double));
+	double *X2 = Calloc(*N, double);
+	double *xptr,*yptr; // HJ addition for swapping
+	boolean Iflag, Jflag, Xflag;
+	*S = 0.; *D = 0.; *T = 0; *U = 0; *V = 0;
 
-  /* 1.1 Sort X and Y in X order */
-  /* Break ties in X according to Y */
-  K=1;
-  do
-  {
-    L=0;
-    do
-    {
-      I = L;
-      J = (I+K)<(*N)?(I+K):(*N);
-      Iend = J;
-      Jend = (J+K)<(*N)?(J+K):(*N);
-      do
-      {
-	Iflag = (I < Iend);
-	Jflag = (J < Jend);
-	Xflag = ((X[I] > X[J]) | ((X[I] == X[J]) & (Y[I] > Y[J])));
-	if((Iflag & !Jflag) | (Iflag & Jflag & !Xflag))
+	/* 1.1 Sort X and Y in X order */
+	/* Break ties in X according to Y */
+	K=1;
+	do
 	{
-	  X2[L] = X[I];
-	  Y2[L] = Y[I];
-	  I++;
-	  L++;
-	};
-	if((!Iflag && Jflag) | (Iflag && Jflag && Xflag))
-	{
-	  X2[L] = X[J];
-	  Y2[L] = Y[J];
-	  J++;
-	  L++;
-	};
-      } while(Iflag | Jflag);
-    } while(L < *N);
-    // Swap lists
-    xptr=X; X=X2; X2=xptr;
-    yptr=Y; Y=Y2; Y2=yptr;
-#ifdef OLD
-    for(i = 0; i < *N; i++)
-    { Xtem = X[i]; Ytem = Y[i];
-      X[i] = X2[i]; Y[i] = Y2[i];
-      X2[i] = Xtem; Y2[i] = Ytem;
-    };
-#endif
-    K *= 2;
-  } while (K < *N);
+		L=0;
+		do
+		{
+			I = L;
+			J = (I+K)<(*N-1)?(I+K):(*N-1);		// changed both from *N to (*N-1)
+			Iend = J;
+			Jend = (J+K)<(*N)?(J+K):(*N);
+			do
+			{
+				Iflag = (I < Iend);
+				Jflag = (J < Jend);
+				Xflag = ((X[I] > X[J]) | ((X[I] == X[J]) & (Y[I] > Y[J])));	//Error? is it possible to get X[*N]? but X has only length *N
+				if((Iflag & !Jflag) | (Iflag & Jflag & !Xflag))
+				{
+					X2[L] = X[I];
+					Y2[L] = Y[I];
+					I++;
+					L++;
+				};
+				if((!Iflag && Jflag) | (Iflag && Jflag && Xflag))
+				{
+					X2[L] = X[J];
+					Y2[L] = Y[J];
+					J++;
+					L++;
+				};
+			} 
+			while((Iflag | Jflag)  & I < *N & J < *N); // added additional constraints
+		} 
+		while(L < *N);
+		
+		// Swap lists
+		xptr=X; X=X2; X2=xptr;
+		yptr=Y; Y=Y2; Y2=yptr;
+		#ifdef OLD
+		for(i = 0; i < *N; i++)
+		{ 
+			Xtem = X[i]; Ytem = Y[i];
+			X[i] = X2[i]; Y[i] = Y2[i];
+			X2[i] = Xtem; Y2[i] = Ytem;
+		};
+		#endif
+		K *= 2;
+	} 
+	while (K < *N);
 
-  /* 1.2 Count pairs of tied X, T */
-  j = 1;
-  m = 1;
-  for(i = 1; i < *N; i++)
+	/* 1.2 Count pairs of tied X, T */
+	j = 1;
+	m = 1;
+	for(i = 1; i < *N; i++)
     if(X[i] == X[i-1])
     {
-      j++;
-      if(Y[i] == Y[i-1])
-	m++;
+		j++;
+		if(Y[i] == Y[i-1])
+		m++;
     }
     else if(j > 1)
     {
       *T += j * (j - 1) / 2;
       if(m > 1)
-	*V += m * (m - 1) / 2;
+		*V += m * (m - 1) / 2;
       j = 1;
       m = 1;
     };
-  *T += j * (j - 1) / 2;
-  *V += m * (m - 1) / 2;
+	*T += j * (j - 1) / 2;
+	*V += m * (m - 1) / 2;
 
-  /* 2.1 Sort Y again and count exchanges, S */
-  /* Keep original relative order if tied */
+	/* 2.1 Sort Y again and count exchanges, S */
+	/* Keep original relative order if tied */
 
-  K=1;
-  do
-  {
-    L=0;
-    do
-    {
-      I = L;
-      J = (I+K)<(*N)?(I+K):(*N);
-      Iend = J;
-      Jend = (J+K)<(*N)?(J+K):(*N);
-      do
-      {
-	Iflag = (I < Iend);
-	Jflag = (J < Jend);
-	Xflag = (Y[I] > Y[J]);
-	if((Iflag & !Jflag) | (Iflag & Jflag & !Xflag))
+	K=1;
+	do
 	{
-	  X2[L] = X[I];
-	  Y2[L] = Y[I];
-	  I++;
-	  L++;
-	};
-	if((!Iflag && Jflag) | (Iflag && Jflag && Xflag))
-	{
-	  X2[L] = X[J];
-	  Y2[L] = Y[J];
-	  *S += Iend - I;
-	  J++;
-	  L++;
-	};
-      } while(Iflag | Jflag);
-    } while(L < *N);
+		L=0;
+		do
+		{
+			I = L;
+			J = (I+K)<(*N-1)?(I+K):(*N-1); // changed both from *N to (*N-1)
+			Iend = J;
+			Jend = (J+K)<(*N)?(J+K):(*N);
+			do
+			{
+				Iflag = (I < Iend);
+				Jflag = (J < Jend);
+				Xflag = (Y[I] > Y[J]);
+				if((Iflag & !Jflag) | (Iflag & Jflag & !Xflag))
+				{
+					X2[L] = X[I];
+					Y2[L] = Y[I];
+					I++;
+					L++;
+				};
+				if((!Iflag && Jflag) | (Iflag && Jflag && Xflag))
+				{
+					X2[L] = X[J];
+					Y2[L] = Y[J];
+					*S += Iend - I;
+					J++;
+					L++;
+				};
+			} 
+			while((Iflag | Jflag) & I < *N & J < *N); // added additional constraints
+		} 
+		while(L < *N);
     
-    // Swap lists
-    xptr=X; X=X2; X2=xptr;
-    yptr=Y; Y=Y2; Y2=yptr;
-#ifdef OLD
-    for(i = 0; i < *N; i++)
-    { Xtem = X[i]; Ytem = Y[i];
-      X[i] = X2[i]; Y[i] = Y2[i];
-      X2[i] = Xtem; Y2[i] = Ytem;
-    };
-#endif
-    K *= 2;
-  } while (K < *N);
+		// Swap lists
+		xptr=X; X=X2; X2=xptr;
+		yptr=Y; Y=Y2; Y2=yptr;
+		#ifdef OLD
+		for(i = 0; i < *N; i++)
+		{ 
+			Xtem = X[i]; Ytem = Y[i];
+			X[i] = X2[i]; Y[i] = Y2[i];
+			X2[i] = Xtem; Y2[i] = Ytem;
+		};
+		#endif
+		K *= 2;
+	} 
+	while (K < *N);
 
-  /* 2.2 Count pairs of tied Y, U */
-  j=1;
-  for(i = 1; i < *N; i++)
-    if(Y[i] == Y[i-1])
-      j++;
-    else if(j > 1)
-    {
-      *U += j * (j - 1) / 2;
-      j = 1;
-    };
-  *U += j * (j - 1) / 2;
+	/* 2.2 Count pairs of tied Y, U */
+	j=1;
+	for(i = 1; i < *N; i++)
+		if(Y[i] == Y[i-1])
+			j++;
+		else if(j > 1)
+		{
+			*U += j * (j - 1) / 2;
+			j = 1;
+		};
+	*U += j * (j - 1) / 2;
 
 
-  /* 3. Calc. Kendall's Score and Denominator */
-  *D = 0.5 * *N * (*N - 1);
-  *S = *D - (2. * *S + *T + *U - *V);
-  //if(*T > 0 | *U > 0) // adjust for ties
+	/* 3. Calc. Kendall's Score and Denominator */
+	*D = 0.5 * (*N) * (*N - 1);
+	*S = *D - (2. * (*S) + *T + *U - *V);
+	//if(*T > 0 | *U > 0) // adjust for ties
     *D = sqrt((*D - *T) * (*D - *U));
-  *tau = *S / *D;
+	*tau = (*S) / (*D);
 
 
   Free(Y2);
@@ -284,42 +294,3 @@
 }
 
 
-/////////////////////////////////////////////////////////////////////
-// Code form Daniel Berg, R-package copulaGOF
-//     AD: Anderson-Darling  GOF test
-//     (Cumulative distribution function test)
-//     INPUT:
-//          cdf         CDF for which to compute the test
-//          n             Length of cdf
-/////////////////////////////////////////////////////////////////////
-void ADtest(double* cdf, int* n, double* out)
-{
-  int j;
-  double sum=0.0;
-  for(j=0;j<*n;j++) sum += (2.0*((double)j+1.0)-1.0)*(log(cdf[j])+log(1.0-cdf[*n-1-j]));
-  *out = -(double)*n-(1.0/(double)*n)*sum;
-}
-
-
-///////////////////////////////////////////////////////////////////////////////
-// Code form Daniel Berg, R-package copulaGOF
-// Function to compute cumulative distribution function of a uniform vector x ($\hat F(x)$)
-///////////////////////////////////////////////////////////////////////////////
-void CumDist(double* x, int* i_n, int* i_m, double* out)
-{
-  int i,j,n,m;
-  double *y;
-  n=*i_n; m=*i_m;
-  y = malloc(m*sizeof(double));
-  for(i=0;i<m;i++)
-  {
-    y[i]=0.0;
-    for(j=0;j<n;j++)
-    {
-      if(x[j]<=((double)i+1.0)/((double)m+1.0)) y[i] += 1.0/((double)n+1.0);
-    }
-    if(y[i]==0.0) y[i] = 1.0/((double)n+1.0);
-    out[i] = y[i];
-  }
-  free(y);
-}


From noreply at r-forge.r-project.org  Thu Apr 18 18:10:29 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Thu, 18 Apr 2013 18:10:29 +0200 (CEST)
Subject: [Vinecopula-commits] r8 - pkg/src
Message-ID: <20130418161030.09A04184CEF@r-forge.r-project.org>

Author: ben_graeler
Date: 2013-04-18 18:10:29 +0200 (Thu, 18 Apr 2013)
New Revision: 8

Modified:
   pkg/src/tools.c
Log:
- fix of the former bug-fix -- now producing the correct values


Modified: pkg/src/tools.c
===================================================================
--- pkg/src/tools.c	2013-04-18 15:10:56 UTC (rev 7)
+++ pkg/src/tools.c	2013-04-18 16:10:29 UTC (rev 8)
@@ -105,14 +105,21 @@
 		do
 		{
 			I = L;
-			J = (I+K)<(*N-1)?(I+K):(*N-1);		// changed both from *N to (*N-1)
+			J = (I+K)<(*N)?(I+K):(*N);
 			Iend = J;
 			Jend = (J+K)<(*N)?(J+K):(*N);
 			do
 			{
 				Iflag = (I < Iend);
 				Jflag = (J < Jend);
-				Xflag = ((X[I] > X[J]) | ((X[I] == X[J]) & (Y[I] > Y[J])));	//Error? is it possible to get X[*N]? but X has only length *N
+				if (Iflag & Jflag) 
+				{
+				 	Xflag = ((X[I] > X[J]) | ((X[I] == X[J]) & (Y[I] > Y[J])));
+				} 
+				else
+				{
+					Xflag = FALSE;
+				}
 				if((Iflag & !Jflag) | (Iflag & Jflag & !Xflag))
 				{
 					X2[L] = X[I];
@@ -128,7 +135,7 @@
 					L++;
 				};
 			} 
-			while((Iflag | Jflag)  & I < *N & J < *N); // added additional constraints
+			while(Iflag | Jflag);
 		} 
 		while(L < *N);
 		
@@ -178,14 +185,21 @@
 		do
 		{
 			I = L;
-			J = (I+K)<(*N-1)?(I+K):(*N-1); // changed both from *N to (*N-1)
+			J = (I+K)<(*N)?(I+K):(*N);
 			Iend = J;
 			Jend = (J+K)<(*N)?(J+K):(*N);
 			do
 			{
 				Iflag = (I < Iend);
 				Jflag = (J < Jend);
-				Xflag = (Y[I] > Y[J]);
+				if (Iflag & Jflag) 
+				{
+				 	Xflag = (Y[I] > Y[J]);
+				} 
+				else
+				{
+					Xflag = FALSE;
+				}
 				if((Iflag & !Jflag) | (Iflag & Jflag & !Xflag))
 				{
 					X2[L] = X[I];
@@ -202,7 +216,7 @@
 					L++;
 				};
 			} 
-			while((Iflag | Jflag) & I < *N & J < *N); // added additional constraints
+			while((Iflag | Jflag));
 		} 
 		while(L < *N);
     


From noreply at r-forge.r-project.org  Mon Apr 22 09:30:42 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Mon, 22 Apr 2013 09:30:42 +0200 (CEST)
Subject: [Vinecopula-commits] r9 - in pkg: inst man
Message-ID: <20130422073042.3FDEF18429A@r-forge.r-project.org>

Author: ulf
Date: 2013-04-22 09:30:41 +0200 (Mon, 22 Apr 2013)
New Revision: 9

Modified:
   pkg/inst/ChangeLog
   pkg/man/RVineClarkeTest.Rd
   pkg/man/RVineVuongTest.Rd
Log:
Bsp angepasst und den ChangeLog

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2013-04-18 16:10:29 UTC (rev 8)
+++ pkg/inst/ChangeLog	2013-04-22 07:30:41 UTC (rev 9)
@@ -3,14 +3,20 @@
 Ulf Schepsmeier, Jakob Stoeber and Eike Christian Brechmann <VineCopula at ma.tum.de>
 
 
-Version 1.1-2 (March, 13, 2013)
+Version 1.1-2 (April, 22, 2013)
 
 - Additional validy check of the R-vine matrix  in RVineMatrix (Code provided by Harry Joe)
 
 - New bivariate copula: Reflection asymmetric Archimedean copula
-  In our functions it is "family=41", 51, 61, and 71 for the rotated versions.
+  In our functions it is "family=41", and 51, 61, and 71 for the rotated versions.
   So far only implemented in some bivariate functions (not documented so far; experimental)
+
+- New author: Benedikt Gräler  
   
+- Bug fix:
+  * New (correct) examples for the Clarke and Vuong test
+  * Fixed memory problem in the C-function ktau (TauMatrix)
+  
 
 Version 1.1-1 (February 7, 2013)
 

Modified: pkg/man/RVineClarkeTest.Rd
===================================================================
--- pkg/man/RVineClarkeTest.Rd	2013-04-18 16:10:29 UTC (rev 8)
+++ pkg/man/RVineClarkeTest.Rd	2013-04-22 07:30:41 UTC (rev 9)
@@ -63,45 +63,22 @@
 
 
 \examples{
-# define first 5-dimensional RVineMatrix object
-Matrix1 = c(5,2,3,1,4,0,2,3,4,1,0,0,3,4,1,0,0,0,4,1,0,0,0,0,1)
-Matrix1 = matrix(Matrix1,5,5)
+\dontrun{
+# load data set
+data(daxreturns)
 
-family1 = c(0,1,3,4,4,0,0,3,4,1,0,0,0,4,1,0,0,0,0,3,0,0,0,0,0)
-family1 = matrix(family1,5,5)
+# select the R-vine structure, families and parameters
+RVM = RVineStructureSelect(daxreturns[,1:5],c(1:6))
 
-par1 = c(0,0.2,0.9,1.5,3.9,0,0,1.1,1.6,0.9,0,0,0,1.9,0.5,
-         0,0,0,0,4.8,0,0,0,0,0)
-par1 = matrix(par1,5,5)
+# select the C-vine structure, families and parameters
+CVM = RVineStructureSelect(daxreturns[,1:5],c(1:6),type="CVine")
 
-RVM1 = RVineMatrix(Matrix=Matrix1,family=family1,par=par1,
-                   par2=matrix(0,5,5),names=c("V1","V2","V3","V4","V5"))
-                  
-# define second 5-dimensional RVineMatrix object
-Matrix2 = c(5,4,3,2,1,0,4,3,2,1,0,0,3,2,1,0,0,0,2,1,0,0,0,0,1)
-Matrix2 = matrix(Matrix2,5,5)
-
-family2 = c(0,3,1,3,2,0,0,1,5,3,0,0,0,2,3,0,0,0,0,1,0,0,0,0,0)
-family2 = matrix(family2,5,5)
-
-par2 = c(0,0.8,0.3,1.5,0.8,0,0,-0.4,1.6,1.2,0,0,0,-0.4,1.5,
-         0,0,0,0,0.6,0,0,0,0,0)
-par2 = matrix(par2,5,5)
-
-nu2 = c(0,0,0,0,5,0,0,0,0,0,0,0,0,8,0,0,0,0,0,0,0,0,0,0,0)
-nu2 = matrix(nu2,5,5)
-
-RVM2 = RVineMatrix(Matrix=Matrix2,family=family2,par=par2,par2=nu2,
-                   names=c("V1","V2","V3","V4","V5"))                  
-
-# simulate a sample of size 300 from the first R-vine copula model
-simdata = RVineSim(300,RVM1)
-
-# compare the two models based on this sample
-clarke = RVineClarkeTest(simdata,RVM1,RVM2)
+# compare the two models based on the data
+clarke = RVineClarkeTest(daxreturns[,1:5],RVM,CVM)
 clarke$statistic
 clarke$statistic.Schwarz
 clarke$p.value
 clarke$p.value.Schwarz
 }
+}
 

Modified: pkg/man/RVineVuongTest.Rd
===================================================================
--- pkg/man/RVineVuongTest.Rd	2013-04-18 16:10:29 UTC (rev 8)
+++ pkg/man/RVineVuongTest.Rd	2013-04-22 07:30:41 UTC (rev 9)
@@ -68,45 +68,22 @@
 
 
 \examples{
-# define first 5-dimensional RVineMatrix object
-Matrix1 = c(5,2,3,1,4,0,2,3,4,1,0,0,3,4,1,0,0,0,4,1,0,0,0,0,1)
-Matrix1 = matrix(Matrix1,5,5)
+\dontrun{
+# load data set
+data(daxreturns)
 
-family1 = c(0,1,3,4,4,0,0,3,4,1,0,0,0,4,1,0,0,0,0,3,0,0,0,0,0)
-family1 = matrix(family1,5,5)
+# select the R-vine structure, families and parameters
+RVM = RVineStructureSelect(daxreturns[,1:5],c(1:6))
 
-par1 = c(0,0.2,0.9,1.5,3.9,0,0,1.1,1.6,0.9,0,0,0,1.9,0.5,
-         0,0,0,0,4.8,0,0,0,0,0)
-par1 = matrix(par1,5,5)
+# select the C-vine structure, families and parameters
+CVM = RVineStructureSelect(daxreturns[,1:5],c(1:6),type="CVine")
 
-RVM1 = RVineMatrix(Matrix=Matrix1,family=family1,par=par1,
-                   par2=matrix(0,5,5),names=c("V1","V2","V3","V4","V5"))
-                  
-# define second 5-dimensional RVineMatrix object
-Matrix2 = c(5,4,3,2,1,0,4,3,2,1,0,0,3,2,1,0,0,0,2,1,0,0,0,0,1)
-Matrix2 = matrix(Matrix2,5,5)
-
-family2 = c(0,3,1,3,2,0,0,1,5,3,0,0,0,2,3,0,0,0,0,1,0,0,0,0,0)
-family2 = matrix(family2,5,5)
-
-par2 = c(0,0.8,0.3,1.5,0.8,0,0,-0.4,1.6,1.2,0,0,0,-0.4,1.5,
-         0,0,0,0,0.6,0,0,0,0,0)
-par2 = matrix(par2,5,5)
-
-nu2 = c(0,0,0,0,5,0,0,0,0,0,0,0,0,8,0,0,0,0,0,0,0,0,0,0,0)
-nu2 = matrix(nu2,5,5)
-
-RVM2 = RVineMatrix(Matrix=Matrix2,family=family2,par=par2,par2=nu2,
-                   names=c("V1","V2","V3","V4","V5"))                  
-
-# simulate a sample of size 300 from the first R-vine copula model
-simdata = RVineSim(300,RVM1)
-
-# compare the two models based on this sample
-vuong = RVineVuongTest(simdata,RVM1,RVM2)
+# compare the two models based on the data
+vuong = RVineVuongTest(daxreturns[,1:5],RVM,CVM)
 vuong$statistic
 vuong$statistic.Schwarz
 vuong$p.value
 vuong$p.value.Schwarz
 }
+}
 


From noreply at r-forge.r-project.org  Tue Apr 23 15:08:58 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue, 23 Apr 2013 15:08:58 +0200 (CEST)
Subject: [Vinecopula-commits] r10 - pkg/R
Message-ID: <20130423130858.DBD391852AF@r-forge.r-project.org>

Author: ben_graeler
Date: 2013-04-23 15:08:58 +0200 (Tue, 23 Apr 2013)
New Revision: 10

Modified:
   pkg/R/BiCopSelect.r
   pkg/R/RVineStructureSelect.r
Log:
- Error in the default familyset of BiCopSelect

Modified: pkg/R/BiCopSelect.r
===================================================================
--- pkg/R/BiCopSelect.r	2013-04-22 07:30:41 UTC (rev 9)
+++ pkg/R/BiCopSelect.r	2013-04-23 13:08:58 UTC (rev 10)
@@ -1,13 +1,23 @@
 BiCopSelect <- function(u1,u2,familyset=NA,selectioncrit="AIC",indeptest=FALSE,level=0.05,weights=NA)
 {
-  if(is.null(u1)==TRUE || is.null(u2)==TRUE) stop("u1 and/or u2 are not set or have length zero.")
-  if(length(u1)!=length(u2)) stop("Lengths of 'u1' and 'u2' do not match.")
-  if(length(u1)<2) stop("Number of observations has to be at least 2.")
-  if(any(u1>1) || any(u1<0)) stop("Data has be in the interval [0,1].")
-  if(any(u2>1) || any(u2<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,2,3,4,5,6,7,8,9,10,13,14,16,17,18,19,20,23,24,26,27,28,29,30,33,34,36,37,38,39,40,41,51,61,71))) 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(u1)==TRUE || is.null(u2)==TRUE) 
+    stop("u1 and/or u2 are not set or have length zero.")
+  if(length(u1)!=length(u2)) 
+    stop("Lengths of 'u1' and 'u2' do not match.")
+  if(length(u1)<2) 
+    stop("Number of observations has to be at least 2.")
+  if(any(u1>1) || any(u1<0)) 
+    stop("Data has to be in the interval [0,1].")
+  if(any(u2>1) || any(u2<0)) 
+    stop("Data has to be in the interval [0,1].")	
+  if(any(is.na(familyset)))
+    familyset <- c(1:10,13,14,16:20,23,24,26:30,33,34,36:40,41,51,61,71)
+  if(any(!(familyset %in% c(0,1:10,13,14,16:20,23,24,26:30,33,34,36:40,41,51,61,71))))
+    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.")
   
   out=list()
 

Modified: pkg/R/RVineStructureSelect.r
===================================================================
--- pkg/R/RVineStructureSelect.r	2013-04-22 07:30:41 UTC (rev 9)
+++ pkg/R/RVineStructureSelect.r	2013-04-23 13:08:58 UTC (rev 10)
@@ -7,21 +7,32 @@
 	n = dim(data)[2]
 	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(!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(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 to be in the interval [0,1].")
+  if(any(is.na(familyset))) {
+    familyset <- c(1:10,13,14,16:20,23,24,26:30,33,34,36:40)
+  }
+  if(any(!(familyset %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.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)