Commit ⋅ tnagler/VC2copula

#' @export
copulaFromFamilyIndex <- function(family, par, par2 = 0) {
  constr <- switch(paste("fam", family, sep = ""),
    fam0 = function(par) copula::indepCopula(),
    fam1 = function(par) copula::normalCopula(par[1]),
    fam2 = function(par) copula::tCopula(par[1], df = par[2]),
    fam3 = function(par) copula::claytonCopula(par[1]),
    fam4 = function(par) copula::gumbelCopula(par[1]),
    fam5 = function(par) copula::frankCopula(par[1]),
    fam6 = function(par) joeBiCopula(par[1]),
    fam7 = BB1Copula,
    fam8 = BB6Copula,
    fam9 = BB7Copula,
    fam10 = BB8Copula,
    fam13 = function(par) surClaytonCopula(par[1]),
    fam14 = function(par) surGumbelCopula(par[1]),
    fam16 = function(par) surJoeBiCopula(par[1]),
    fam17 = surBB1Copula,
    fam18 = surBB6Copula,
    fam19 = surBB7Copula,
    fam20 = surBB8Copula,
    fam23 = function(par) r90ClaytonCopula(par[1]),
    fam24 = function(par) r90GumbelCopula(par[1]),
    fam26 = function(par) r90JoeBiCopula(par[1]),
    fam27 = r90BB1Copula,
    fam28 = r90BB6Copula,
    fam29 = r90BB7Copula,
    fam30 = r90BB8Copula,
    fam33 = function(par) r270ClaytonCopula(par[1]),
    fam34 = function(par) r270GumbelCopula(par[1]),
    fam36 = function(par) r270JoeBiCopula(par[1]),
    fam37 = r270BB1Copula,
    fam38 = r270BB6Copula,
    fam39 = r270BB7Copula,
    fam40 = r270BB8Copula,
    fam104 = tawnT1Copula,
    fam114 = surTawnT1Copula,
    fam124 = r90TawnT1Copula,
    fam134 = r270TawnT1Copula,
    fam204 = tawnT2Copula,
    fam214 = surTawnT2Copula,
    fam224 = r90TawnT2Copula,
    fam234 = r270TawnT2Copula
                   fam0 = function(par) copula::indepCopula(),
                   fam1 = function(par) copula::normalCopula(par[1]),
                   fam2 = function(par) copula::tCopula(par[1], df = par[2]),
                   fam3 = function(par) copula::claytonCopula(par[1]),
                   fam4 = function(par) copula::gumbelCopula(par[1]),
                   fam5 = function(par) copula::frankCopula(par[1]),
                   fam6 = function(par) joeBiCopula(par[1]),
                   fam7 = BB1Copula,
                   fam8 = BB6Copula,
                   fam9 = BB7Copula,
                   fam10 = BB8Copula,
                   fam13 = function(par) surClaytonCopula(par[1]),
                   fam14 = function(par) surGumbelCopula(par[1]),
                   fam16 = function(par) surJoeBiCopula(par[1]),
                   fam17 = surBB1Copula,
                   fam18 = surBB6Copula,
                   fam19 = surBB7Copula,
                   fam20 = surBB8Copula,
                   fam23 = function(par) r90ClaytonCopula(par[1]),
                   fam24 = function(par) r90GumbelCopula(par[1]),
                   fam26 = function(par) r90JoeBiCopula(par[1]),
                   fam27 = r90BB1Copula,
                   fam28 = r90BB6Copula,
                   fam29 = r90BB7Copula,
                   fam30 = r90BB8Copula,
                   fam33 = function(par) r270ClaytonCopula(par[1]),
                   fam34 = function(par) r270GumbelCopula(par[1]),
                   fam36 = function(par) r270JoeBiCopula(par[1]),
                   fam37 = r270BB1Copula,
                   fam38 = r270BB6Copula,
                   fam39 = r270BB7Copula,
                   fam40 = r270BB8Copula,
                   fam104 = tawnT1Copula,
                   fam114 = surTawnT1Copula,
                   fam124 = r90TawnT1Copula,
                   fam134 = r270TawnT1Copula,
                   fam204 = tawnT2Copula,
                   fam214 = surTawnT2Copula,
                   fam224 = r90TawnT2Copula,
                   fam234 = r270TawnT2Copula
  )
  constr(c(par, par2))
}

@@ -136,7 +136,49 @@

  unlist(VineCopula::BiCopPar2TailDep(bc$family, bc$par, bc$par2))
}

# metods in copula

# methods in copula
# iTau
BCiTau <- function(copula, tau) VineCopula::BiCopTau2Par(copula@family, tau)

#' A dedicated method to use the estimation routines from the VineCopula package
#'
#' Bivariate copulas are estimated based on \code{\link[VineCopula]{BiCopEst}} and vine copulas through \code{\link[VineCopula]{RVineStructureSelect}} or \code{\link[VineCopula]{RVineCopSelect}} depending on the \code{method} argument.
#'
#' @param copula an object of the desired copula class
#' @param data a matrix holding the U(0,1) distributed data columns
#' @param method for BIVARIATE copulas either "ml" or "itau" for maximum likelihood estimation or inverse tau estimation (for one parameter families) respectively. See \code{\link[VineCopula]{BiCopEst}} for details. In case of a VINE copulas a list with names entries \code{StructureSelect} (default: FALSE), \code{indeptest} (default: FALSE), \code{familyset} (default: 'NA') and \code{indeptest} (default: FALSE). See \code{\link[VineCopula]{RVineStructureSelect}} or \code{\link[VineCopula]{RVineCopSelect}} for details.
#'
#' @return an object of class \code{\link[copula]{fitCopula}} as in the copula package.
#'
#' @examples
#'
#' u <- rCopula(1000, tawnT1Copula(c(3, 0.5)))
#'
#' fitCopula(tawnT1Copula(), u)
#'
#' @aliases fitCopula
#' @name fitCopula
BCfitCopula <- function(copula, data, method="ml") {
  stopifnot(method %in% c("ml", "itau"))
  if (method == "itau") {
    stopifnot(copula@family %in% c(1,2,3,4,5,6,13,14,16,23,24,26,33,34,36))
  }
  if (method == "ml")
    method <- "mle"

  BCestimate <- VineCopula::BiCopEst(data[,1], data[,2], copula@family,
                                     method = method)

  new("fitCopula",
      copula = BiCop2copula(BCestimate),
      estimate = c(BCestimate$par, ifelse(!is.na(BCestimate$par2),
                                          BCestimate$par2, NULL)),
      var.est = matrix(NA),
      loglik = BCestimate$logLik,
      nsample = BCestimate$nobs,
      method = method,
      call = match.call(),
      fitting.stats = list(AIC = BCestimate$AIC,
                           BIC = BCestimate$BIC,
                           convergence = NA))
}

@@ -143,3 +143,10 @@

143	143		)[[6]]
144	144		-log(1 - u + 1 - v - 1 + (u * v)^surA)
145	145		})
	146	+
	147	+	# fitCopula
	148	+	setMethod(fitCopula, "tawnT1Copula", BCfitCopula)
	149	+	setMethod(fitCopula, "surTawnT1Copula", BCfitCopula)
	150	+	setMethod(fitCopula, "r90TawnT1Copula", BCfitCopula)
	151	+	setMethod(fitCopula, "r270TawnT1Copula", BCfitCopula)
	152	+

@@ -73,8 +73,8 @@

    param.names = c("param1", "param2"),
    param.lowbnd = c(1, 0),
    param.upbnd = c(Inf, 1),
    family = 104,
    fullname = "Tawn type 2 copula family. Number 104 in VineCopula."
    family = 204,
    fullname = "Tawn type 2 copula family. Number 204 in VineCopula."
  )
}


@@ -87,8 +87,8 @@

    param.names = c("param1", "param2"),
    param.lowbnd = c(1, 0),
    param.upbnd = c(Inf, 1),
    family = 114,
    fullname = "Survival Tawn type 2 copula family. Number 114 in VineCopula."
    family = 214,
    fullname = "Survival Tawn type 2 copula family. Number 214 in VineCopula."
  )
}


@@ -102,8 +102,8 @@

    param.names = c("param1", "param2"),
    param.lowbnd = c(-Inf, 0),
    param.upbnd = c(-1, 1),
    family = 124,
    fullname = "90 deg rotated Tawn type 2 copula family. Number 124 in VineCopula."
    family = 224,
    fullname = "90 deg rotated Tawn type 2 copula family. Number 224 in VineCopula."
  )
}


@@ -116,7 +116,13 @@

    param.names = c("param1", "param2"),
    param.lowbnd = c(-Inf, 0),
    param.upbnd = c(-1, 1),
    family = 134,
    fullname = "270 deg rotated Tawn type 2 copula family. Number 134 in VineCopula."
    family = 234,
    fullname = "270 deg rotated Tawn type 2 copula family. Number 234 in VineCopula."
  )
}

# fitCopula
setMethod(fitCopula, "tawnT2Copula", BCfitCopula)
setMethod(fitCopula, "surTawnT2Copula", BCfitCopula)
setMethod(fitCopula, "r90TawnT2Copula", BCfitCopula)
setMethod(fitCopula, "r270TawnT2Copula", BCfitCopula)

@@ -131,7 +131,14 @@

  )
}

# inverse tau
setMethod("iTau", signature = c("joeBiCopula", "ANY"), BCiTau)
setMethod("iTau", signature = c("r90JoeBiCopula", "ANY"), BCiTau)
setMethod("iTau", signature = c("surJoeBiCopula", "ANY"), BCiTau)
setMethod("iTau", signature = c("r270JoeBiCopula", "ANY"), BCiTau)

# fitCopula
setMethod(fitCopula, "joeBiCopula", BCfitCopula)
setMethod(fitCopula, "surJoeBiCopula", BCfitCopula)
setMethod(fitCopula, "r90JoeBiCopula", BCfitCopula)
setMethod(fitCopula, "r270JoeBiCopula", BCfitCopula)

@@ -102,3 +102,8 @@

102	102		setMethod("iTau", signature = c("r90ClaytonCopula", "ANY"), BCiTau)
103	103		setMethod("iTau", signature = c("surClaytonCopula", "ANY"), BCiTau)
104	104		setMethod("iTau", signature = c("r270ClaytonCopula", "ANY"), BCiTau)
	105	+
	106	+	# fitCopula
	107	+	setMethod(fitCopula, "surClaytonCopula", BCfitCopula)
	108	+	setMethod(fitCopula, "r90ClaytonCopula", BCfitCopula)
	109	+	setMethod(fitCopula, "r270ClaytonCopula", BCfitCopula)

@@ -120,3 +120,9 @@

120	120		fullname = "270 deg rotated BB8 copula family. Number 40 in VineCopula."
121	121		)
122	122		}
	123	+
	124	+	# fitCopula
	125	+	setMethod(fitCopula, "BB8Copula", BCfitCopula)
	126	+	setMethod(fitCopula, "surBB8Copula", BCfitCopula)
	127	+	setMethod(fitCopula, "r90BB8Copula", BCfitCopula)
	128	+	setMethod(fitCopula, "r270BB8Copula", BCfitCopula)

@@ -120,3 +120,9 @@

120	120		fullname = "270 deg rotated BB1 copula family. Number 37 in VineCopula."
121	121		)
122	122		}
	123	+
	124	+	# fitCopula
	125	+	setMethod(fitCopula, "BB1Copula", BCfitCopula)
	126	+	setMethod(fitCopula, "surBB1Copula", BCfitCopula)
	127	+	setMethod(fitCopula, "r90BB1Copula", BCfitCopula)
	128	+	setMethod(fitCopula, "r270BB1Copula", BCfitCopula)

@@ -120,3 +120,9 @@

120	120		fullname = "270 deg rotated BB7 copula family. Number 39 in VineCopula."
121	121		)
122	122		}
	123	+
	124	+	# fitCopula
	125	+	setMethod(fitCopula, "BB7Copula", BCfitCopula)
	126	+	setMethod(fitCopula, "surBB7Copula", BCfitCopula)
	127	+	setMethod(fitCopula, "r90BB7Copula", BCfitCopula)
	128	+	setMethod(fitCopula, "r270BB7Copula", BCfitCopula)

@@ -183,6 +183,7 @@

          signature("numeric", "vineCopula"),
          function(n, copula) VineCopula::RVineSim(n, copula@RVM))

# fitCopula
fitVineCop <- function(copula, data,
                       method = list(StructureSelect = FALSE,
                                     indeptest = FALSE,

@@ -116,3 +116,9 @@

116	116		fullname = "270 deg rotated BB6 copula family. Number 38 in VineCopula."
117	117		)
118	118		}
	119	+
	120	+	# fitCopula
	121	+	setMethod(fitCopula, "BB6Copula", BCfitCopula)
	122	+	setMethod(fitCopula, "surBB6Copula", BCfitCopula)
	123	+	setMethod(fitCopula, "r90BB6Copula", BCfitCopula)
	124	+	setMethod(fitCopula, "r270BB6Copula", BCfitCopula)

@@ -104,3 +104,9 @@

104	104		setMethod("iTau", signature = c("surGumbelCopula", "ANY"), BCiTau)
105	105		setMethod("iTau", signature = c("r270GumbelCopula", "ANY"), BCiTau)
106	106
	107	+	# fitCopula
	108	+	setMethod(fitCopula, "surGumbelCopula", BCfitCopula)
	109	+	setMethod(fitCopula, "r90GumbelCopula", BCfitCopula)
	110	+	setMethod(fitCopula, "r270GumbelCopula", BCfitCopula)
	111	+
	112	+

Files		•	•	Coverage
R	456	432	24	94.74%
src/Tawn2.c	7	7	0	100.00%
Project Totals (12 files)	463	439	24	94.82%

Download

No yaml found.

Create your codecov.yml to customize your Codecov experience

Read the docs

Interact now

The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.

SVG

The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.

SVG

Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.

SVG

Learn more about the coverage sunburst graph

183	183		signature("numeric", "vineCopula"),
184	184		function(n, copula) VineCopula::RVineSim(n, copula@RVM))
185	185
	186	+	# fitCopula
186	187		fitVineCop <- function(copula, data,
187	188		method = list(StructureSelect = FALSE,
188	189		indeptest = FALSE,

Navigation	Overlay
`t` Navigate files	`h` Toggle hits
`y` Change url to tip of branch	`m` Toggle misses
`b / v` Jump to prev/next hit line	`p` Toggle partial
`z / x` Jump to prev/next missed or partial line	`1..9` Toggle flags
`shift + o` Open current page in GitHub	`a` Toggle all on
`/ or ?` Show keyboard shortcuts dialog	`c` Toggle context lines or commits

41	41		#' @export
42	42		copulaFromFamilyIndex <- function(family, par, par2 = 0) {
43	43		constr <- switch(paste("fam", family, sep = ""),
44		-	fam0 = function(par) copula::indepCopula(),
45		-	fam1 = function(par) copula::normalCopula(par[1]),
46		-	fam2 = function(par) copula::tCopula(par[1], df = par[2]),
47		-	fam3 = function(par) copula::claytonCopula(par[1]),
48		-	fam4 = function(par) copula::gumbelCopula(par[1]),
49		-	fam5 = function(par) copula::frankCopula(par[1]),
50		-	fam6 = function(par) joeBiCopula(par[1]),
51		-	fam7 = BB1Copula,
52		-	fam8 = BB6Copula,
53		-	fam9 = BB7Copula,
54		-	fam10 = BB8Copula,
55		-	fam13 = function(par) surClaytonCopula(par[1]),
56		-	fam14 = function(par) surGumbelCopula(par[1]),
57		-	fam16 = function(par) surJoeBiCopula(par[1]),
58		-	fam17 = surBB1Copula,
59		-	fam18 = surBB6Copula,
60		-	fam19 = surBB7Copula,
61		-	fam20 = surBB8Copula,
62		-	fam23 = function(par) r90ClaytonCopula(par[1]),
63		-	fam24 = function(par) r90GumbelCopula(par[1]),
64		-	fam26 = function(par) r90JoeBiCopula(par[1]),
65		-	fam27 = r90BB1Copula,
66		-	fam28 = r90BB6Copula,
67		-	fam29 = r90BB7Copula,
68		-	fam30 = r90BB8Copula,
69		-	fam33 = function(par) r270ClaytonCopula(par[1]),
70		-	fam34 = function(par) r270GumbelCopula(par[1]),
71		-	fam36 = function(par) r270JoeBiCopula(par[1]),
72		-	fam37 = r270BB1Copula,
73		-	fam38 = r270BB6Copula,
74		-	fam39 = r270BB7Copula,
75		-	fam40 = r270BB8Copula,
76		-	fam104 = tawnT1Copula,
77		-	fam114 = surTawnT1Copula,
78		-	fam124 = r90TawnT1Copula,
79		-	fam134 = r270TawnT1Copula,
80		-	fam204 = tawnT2Copula,
81		-	fam214 = surTawnT2Copula,
82		-	fam224 = r90TawnT2Copula,
83		-	fam234 = r270TawnT2Copula
	44	+	fam0 = function(par) copula::indepCopula(),
	45	+	fam1 = function(par) copula::normalCopula(par[1]),
	46	+	fam2 = function(par) copula::tCopula(par[1], df = par[2]),
	47	+	fam3 = function(par) copula::claytonCopula(par[1]),
	48	+	fam4 = function(par) copula::gumbelCopula(par[1]),
	49	+	fam5 = function(par) copula::frankCopula(par[1]),
	50	+	fam6 = function(par) joeBiCopula(par[1]),
	51	+	fam7 = BB1Copula,
	52	+	fam8 = BB6Copula,
	53	+	fam9 = BB7Copula,
	54	+	fam10 = BB8Copula,
	55	+	fam13 = function(par) surClaytonCopula(par[1]),
	56	+	fam14 = function(par) surGumbelCopula(par[1]),
	57	+	fam16 = function(par) surJoeBiCopula(par[1]),
	58	+	fam17 = surBB1Copula,
	59	+	fam18 = surBB6Copula,
	60	+	fam19 = surBB7Copula,
	61	+	fam20 = surBB8Copula,
	62	+	fam23 = function(par) r90ClaytonCopula(par[1]),
	63	+	fam24 = function(par) r90GumbelCopula(par[1]),
	64	+	fam26 = function(par) r90JoeBiCopula(par[1]),
	65	+	fam27 = r90BB1Copula,
	66	+	fam28 = r90BB6Copula,
	67	+	fam29 = r90BB7Copula,
	68	+	fam30 = r90BB8Copula,
	69	+	fam33 = function(par) r270ClaytonCopula(par[1]),
	70	+	fam34 = function(par) r270GumbelCopula(par[1]),
	71	+	fam36 = function(par) r270JoeBiCopula(par[1]),
	72	+	fam37 = r270BB1Copula,
	73	+	fam38 = r270BB6Copula,
	74	+	fam39 = r270BB7Copula,
	75	+	fam40 = r270BB8Copula,
	76	+	fam104 = tawnT1Copula,
	77	+	fam114 = surTawnT1Copula,
	78	+	fam124 = r90TawnT1Copula,
	79	+	fam134 = r270TawnT1Copula,
	80	+	fam204 = tawnT2Copula,
	81	+	fam214 = surTawnT2Copula,
	82	+	fam224 = r90TawnT2Copula,
	83	+	fam234 = r270TawnT2Copula
84	84		)
85	85		constr(c(par, par2))
86	86		}

136	136		unlist(VineCopula::BiCopPar2TailDep(bc$family, bc$par, bc$par2))
137	137		}
138	138
139		-	# metods in copula
140		-
	139	+	# methods in copula
141	140		# iTau
142	141		BCiTau <- function(copula, tau) VineCopula::BiCopTau2Par(copula@family, tau)
	142	+
	143	+	#' A dedicated method to use the estimation routines from the VineCopula package
	144	+	#'
	145	+	#' Bivariate copulas are estimated based on \code{\link[VineCopula]{BiCopEst}} and vine copulas through \code{\link[VineCopula]{RVineStructureSelect}} or \code{\link[VineCopula]{RVineCopSelect}} depending on the \code{method} argument.
	146	+	#'
	147	+	#' @param copula an object of the desired copula class
	148	+	#' @param data a matrix holding the U(0,1) distributed data columns
	149	+	#' @param method for BIVARIATE copulas either "ml" or "itau" for maximum likelihood estimation or inverse tau estimation (for one parameter families) respectively. See \code{\link[VineCopula]{BiCopEst}} for details. In case of a VINE copulas a list with names entries \code{StructureSelect} (default: FALSE), \code{indeptest} (default: FALSE), \code{familyset} (default: 'NA') and \code{indeptest} (default: FALSE). See \code{\link[VineCopula]{RVineStructureSelect}} or \code{\link[VineCopula]{RVineCopSelect}} for details.
	150	+	#'
	151	+	#' @return an object of class \code{\link[copula]{fitCopula}} as in the copula package.
	152	+	#'
	153	+	#' @examples
	154	+	#'
	155	+	#' u <- rCopula(1000, tawnT1Copula(c(3, 0.5)))
	156	+	#'
	157	+	#' fitCopula(tawnT1Copula(), u)
	158	+	#'
	159	+	#' @aliases fitCopula
	160	+	#' @name fitCopula
	161	+	BCfitCopula <- function(copula, data, method="ml") {
	162	+	stopifnot(method %in% c("ml", "itau"))
	163	+	if (method == "itau") {
	164	+	stopifnot(copula@family %in% c(1,2,3,4,5,6,13,14,16,23,24,26,33,34,36))
	165	+	}
	166	+	if (method == "ml")
	167	+	method <- "mle"
	168	+
	169	+	BCestimate <- VineCopula::BiCopEst(data[,1], data[,2], copula@family,
	170	+	method = method)
	171	+
	172	+	new("fitCopula",
	173	+	copula = BiCop2copula(BCestimate),
	174	+	estimate = c(BCestimate$par, ifelse(!is.na(BCestimate$par2),
	175	+	BCestimate$par2, NULL)),
	176	+	var.est = matrix(NA),
	177	+	loglik = BCestimate$logLik,
	178	+	nsample = BCestimate$nobs,
	179	+	method = method,
	180	+	call = match.call(),
	181	+	fitting.stats = list(AIC = BCestimate$AIC,
	182	+	BIC = BCestimate$BIC,
	183	+	convergence = NA))
	184	+	}

73	73		param.names = c("param1", "param2"),
74	74		param.lowbnd = c(1, 0),
75	75		param.upbnd = c(Inf, 1),
76		-	family = 104,
77		-	fullname = "Tawn type 2 copula family. Number 104 in VineCopula."
	76	+	family = 204,
	77	+	fullname = "Tawn type 2 copula family. Number 204 in VineCopula."
78	78		)
79	79		}
80	80

102	102		param.names = c("param1", "param2"),
103	103		param.lowbnd = c(-Inf, 0),
104	104		param.upbnd = c(-1, 1),
105		-	family = 124,
106		-	fullname = "90 deg rotated Tawn type 2 copula family. Number 124 in VineCopula."
	105	+	family = 224,
	106	+	fullname = "90 deg rotated Tawn type 2 copula family. Number 224 in VineCopula."
107	107		)
108	108		}
109	109

131	131		)
132	132		}
133	133
	134	+	# inverse tau
134	135		setMethod("iTau", signature = c("joeBiCopula", "ANY"), BCiTau)
135	136		setMethod("iTau", signature = c("r90JoeBiCopula", "ANY"), BCiTau)
136	137		setMethod("iTau", signature = c("surJoeBiCopula", "ANY"), BCiTau)
137	138		setMethod("iTau", signature = c("r270JoeBiCopula", "ANY"), BCiTau)
	139	+
	140	+	# fitCopula
	141	+	setMethod(fitCopula, "joeBiCopula", BCfitCopula)
	142	+	setMethod(fitCopula, "surJoeBiCopula", BCfitCopula)
	143	+	setMethod(fitCopula, "r90JoeBiCopula", BCfitCopula)
	144	+	setMethod(fitCopula, "r270JoeBiCopula", BCfitCopula)

Updating our web app

No yaml found.