[Vinecopula-commits] r59 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mo Feb 17 21:35:25 CET 2014
Author: ulf
Date: 2014-02-17 21:35:24 +0100 (Mon, 17 Feb 2014)
New Revision: 59
Modified:
pkg/R/RVineAIC.r
pkg/R/RVineClarkeTest.R
pkg/R/RVineGofTest3.r
pkg/R/RVineMLE.R
pkg/R/RVinePIT.r
pkg/R/RVinePar2Beta.r
pkg/R/RVineTreePlot.r
pkg/R/RVineVuongTest.R
Log:
Die Einf?\195?\188hrung einer VineCopula-Klasse hat dazu gef?\195?\188hrt, dass is(RVM) zwei Elemente zur?\195?\188ckgeliefert hat. Das hat bei einigen Funktionen zu Warningsgef?\195?\188hrt, die diese Abfrage drin hatten.
Modified: pkg/R/RVineAIC.r
===================================================================
--- pkg/R/RVineAIC.r 2014-02-17 15:52:12 UTC (rev 58)
+++ pkg/R/RVineAIC.r 2014-02-17 20:35:24 UTC (rev 59)
@@ -89,7 +89,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)[1] != "RVineMatrix") stop("'RVM' has to be an RVineMatrix object.")
par[is.na(par)]=0
par[upper.tri(par,diag=T)]=0
Modified: pkg/R/RVineClarkeTest.R
===================================================================
--- pkg/R/RVineClarkeTest.R 2014-02-17 15:52:12 UTC (rev 58)
+++ pkg/R/RVineClarkeTest.R 2014-02-17 20:35:24 UTC (rev 59)
@@ -5,8 +5,8 @@
if(dim(data)[2]<2) stop("Dimension has to be at least 2.")
if(N<2) stop("Number of observations has to be at least 2.")
if(any(data>1) || any(data<0)) stop("Data has be in the interval [0,1].")
- if(is(RVM1) != "RVineMatrix") stop("'RVM1' has to be an RVineMatrix object.")
- if(is(RVM2) != "RVineMatrix") stop("'RVM2' has to be an RVineMatrix object.")
+ if(is(RVM1)[1] != "RVineMatrix") stop("'RVM1' has to be an RVineMatrix object.")
+ if(is(RVM2)[1] != "RVineMatrix") stop("'RVM2' has to be an RVineMatrix object.")
Model1.ll = RVineLogLik(data,RVM1,separate=TRUE)$loglik
Model2.ll = RVineLogLik(data,RVM2,separate=TRUE)$loglik
Modified: pkg/R/RVineGofTest3.r
===================================================================
--- pkg/R/RVineGofTest3.r 2014-02-17 15:52:12 UTC (rev 58)
+++ pkg/R/RVineGofTest3.r 2014-02-17 20:35:24 UTC (rev 59)
@@ -13,7 +13,7 @@
d=dim(data)[2]
if(d != 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)[1] != "RVineMatrix") stop("'RVM' has to be an RVineMatrix object.")
if(statistic=="Cramer-von Mises") statistic="CvM"
else if(statistic=="Kolmogorov-Smirnov") statistic="KS"
Modified: pkg/R/RVineMLE.R
===================================================================
--- pkg/R/RVineMLE.R 2014-02-17 15:52:12 UTC (rev 58)
+++ pkg/R/RVineMLE.R 2014-02-17 20:35:24 UTC (rev 59)
@@ -1,6 +1,6 @@
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(is(RVM)[1] != "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.")
Modified: pkg/R/RVinePIT.r
===================================================================
--- pkg/R/RVinePIT.r 2014-02-17 15:52:12 UTC (rev 58)
+++ pkg/R/RVinePIT.r 2014-02-17 20:35:24 UTC (rev 59)
@@ -13,7 +13,7 @@
d=dim(data)[2]
if(d != 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)[1] != "RVineMatrix") stop("'RVM' has to be an RVineMatrix object.")
#if(type=="CVine") type=1
#else if(type=="DVine") type=2
Modified: pkg/R/RVinePar2Beta.r
===================================================================
--- pkg/R/RVinePar2Beta.r 2014-02-17 15:52:12 UTC (rev 58)
+++ pkg/R/RVinePar2Beta.r 2014-02-17 20:35:24 UTC (rev 59)
@@ -1,17 +1,17 @@
-RVinePar2Beta = function(RVM){
-
- if(is(RVM) != "RVineMatrix") stop("'RVM' has to be an RVineMatrix object.")
-
- taus = RVM$par
- n = dim(RVM)
-
- for(i in 2:n)
- {
- for(j in 1:(i-1))
- {
- taus[i,j] = BiCopPar2Beta(RVM$family[i,j],RVM$par[i,j],RVM$par2[i,j])
- }
- }
-
- return(taus)
-}
+RVinePar2Beta = function(RVM){
+
+ if(is(RVM)[1] != "RVineMatrix") stop("'RVM' has to be an RVineMatrix object.")
+
+ taus = RVM$par
+ n = dim(RVM)
+
+ for(i in 2:n)
+ {
+ for(j in 1:(i-1))
+ {
+ taus[i,j] = BiCopPar2Beta(RVM$family[i,j],RVM$par[i,j],RVM$par2[i,j])
+ }
+ }
+
+ return(taus)
+}
Modified: pkg/R/RVineTreePlot.r
===================================================================
--- pkg/R/RVineTreePlot.r 2014-02-17 15:52:12 UTC (rev 58)
+++ pkg/R/RVineTreePlot.r 2014-02-17 20:35:24 UTC (rev 59)
@@ -1,6 +1,6 @@
RVineTreePlot = function(data=NULL, RVM, method="mle", max.df=30, max.BB=list(BB1=c(5,6),BB6=c(6,6),BB7=c(5,6),BB8=c(6,1)), tree="ALL", edge.labels=c("family"), P=NULL){
- if(is(RVM) != "RVineMatrix") stop("'RVM' has to be an RVineMatrix object.")
+ if(is(RVM)[1] != "RVineMatrix") stop("'RVM' has to be an RVineMatrix object.")
if(edge.labels[1] != FALSE & !all(edge.labels %in% c("family","par","par2","theotau","emptau","pair"))) stop("Edge label not implemented.")
if(is.null(data) & any(edge.labels == "emptau")) stop("Empirical Kendall's tau values cannot be obtained if no data is provided.")
Modified: pkg/R/RVineVuongTest.R
===================================================================
--- pkg/R/RVineVuongTest.R 2014-02-17 15:52:12 UTC (rev 58)
+++ pkg/R/RVineVuongTest.R 2014-02-17 20:35:24 UTC (rev 59)
@@ -5,8 +5,8 @@
if(dim(data)[2]<2) stop("Dimension has to be at least 2.")
if(N<2) stop("Number of observations has to be at least 2.")
if(any(data>1) || any(data<0)) stop("Data has be in the interval [0,1].")
- if(is(RVM1) != "RVineMatrix") stop("'RVM1' has to be an RVineMatrix object.")
- if(is(RVM2) != "RVineMatrix") stop("'RVM2' has to be an RVineMatrix object.")
+ if(is(RVM1)[1] != "RVineMatrix") stop("'RVM1' has to be an RVineMatrix object.")
+ if(is(RVM2)[1] != "RVineMatrix") stop("'RVM2' has to be an RVineMatrix object.")
Model1.ll = RVineLogLik(data,RVM1,separate=TRUE)$loglik
Model2.ll = RVineLogLik(data,RVM2,separate=TRUE)$loglik
Mehr Informationen über die Mailingliste Vinecopula-commits