Compare `7c6f7b8 ... +3 ... a218b07`

#' @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)

Click to load this diff.

Loading diff...

Click to load this diff.

Loading diff...

Click to load this diff.

Loading diff...

Click to load this diff.

Loading diff...

Click to load this diff.

Loading diff...

Click to load this diff.

Loading diff...

Learn more Showing 1 files with coverage changes found.

Changes in R/0_wrappers.R

-1

→

Loading file...

94.82% 98.51% +0.22%

Merge pull request #2 from BenGraeler/master

tnagler

a218b07

CI Passed

Hiding 3 contexual commits

+19

94.59% ø ø

add trailing slash in README

tnagler

7c6f7b8

CI Passed

Files		•	•	•	Coverage
R	+19	+19	ø	ø	^0.23% 94.74%
src/Tawn2.c	ø	ø	ø	ø	100.00%
Project Totals (12 files)	463	439	0	24	94.82%

116	116		param.names = c("param1", "param2"),
117	117		param.lowbnd = c(-Inf, 0),
118	118		param.upbnd = c(-1, 1),
119		-	family = 134,
120		-	fullname = "270 deg rotated Tawn type 2 copula family. Number 134 in VineCopula."
	119	+	family = 234,
	120	+	fullname = "270 deg rotated Tawn type 2 copula family. Number 234 in VineCopula."
121	121		)
122	122		}
	123	+
	124	+	# fitCopula
	125	+	setMethod(fitCopula, "tawnT2Copula", BCfitCopula)
	126	+	setMethod(fitCopula, "surTawnT2Copula", BCfitCopula)
	127	+	setMethod(fitCopula, "r90TawnT2Copula", BCfitCopula)
	128	+	setMethod(fitCopula, "r270TawnT2Copula", BCfitCopula)

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

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)

Compare 7c6f7b8 ... +3 ... a218b07

No flags found

Show failed CI and contexual commits c 5 Commits

Compare `7c6f7b8 ... +3 ... a218b07`

Show failed CI and contexual commits `c`

5 Commits