Last updated on 2020-02-19 14:48:33 CET.
| Flavor | Version | Tinstall | Tcheck | Ttotal | Status | Flags |
|---|---|---|---|---|---|---|
| r-devel-linux-x86_64-debian-clang | 2.4.2 | 40.54 | 104.86 | 145.40 | ERROR | |
| r-devel-linux-x86_64-debian-gcc | 2.4.2 | 25.00 | 74.51 | 99.51 | ERROR | |
| r-devel-linux-x86_64-fedora-clang | 2.4.2 | 170.30 | ERROR | |||
| r-devel-linux-x86_64-fedora-gcc | 2.4.2 | 160.10 | ERROR | |||
| r-devel-windows-ix86+x86_64 | 2.4.2 | 62.00 | 174.00 | 236.00 | NOTE | |
| r-devel-windows-ix86+x86_64-gcc8 | 2.4.2 | 91.00 | 178.00 | 269.00 | NOTE | |
| r-patched-linux-x86_64 | 2.4.2 | 29.24 | 102.88 | 132.12 | WARN | |
| r-patched-solaris-x86 | 2.4.2 | 202.20 | WARN | |||
| r-release-linux-x86_64 | 2.4.2 | 27.29 | 102.46 | 129.75 | OK | |
| r-release-windows-ix86+x86_64 | 2.4.2 | 59.00 | 166.00 | 225.00 | NOTE | |
| r-release-osx-x86_64 | 2.4.2 | OK | ||||
| r-oldrel-windows-ix86+x86_64 | 2.4.2 | 56.00 | 177.00 | 233.00 | NOTE | |
| r-oldrel-osx-x86_64 | 2.4.2 | OK |
Version: 2.4.2
Check: Rd \usage sections
Result: WARN
Documented arguments not in \usage in documentation object 'mexDependence':
'...'
Documented arguments not in \usage in documentation object 'mexRangeFit':
'...'
Functions with \usage entries need to have the appropriate \alias
entries, and all their arguments documented.
The \usage entries must correspond to syntactically valid R code.
See chapter 'Writing R documentation files' in the 'Writing R
Extensions' manual.
Flavors: r-devel-linux-x86_64-debian-clang, r-devel-linux-x86_64-debian-gcc, r-devel-linux-x86_64-fedora-clang, r-devel-linux-x86_64-fedora-gcc, r-patched-linux-x86_64, r-patched-solaris-x86
Version: 2.4.2
Check: examples
Result: ERROR
Running examples in 'texmex-Ex.R' failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: ggplot.mex
> ### Title: Conditional multivariate extreme values modelling
> ### Aliases: ggplot.mex mex plot.mex print.mex predict.mex
> ### summary.predict.mex plot.predict.mex mexAll print.mexList
> ### print.summary.mex summary.mex ggplot.predict.mex
> ### Keywords: models multivariate
>
> ### ** Examples
>
>
> w <- mex(winter, mqu=.7)
which not given. Conditioning onO3
Warning in mexDependence(x = res1, which = which, dqu = dqu, margins = margins, :
Assuming same quantile for dependence thesholding as was used
to fit corresponding marginal model...
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
texmex
--- call from context ---
mexDependence(x = res1, which = which, dqu = dqu, margins = margins,
constrain = constrain, v = v)
--- call from argument ---
if (class(z) %in% c("Error", "try-error")) {
z <- matrix(nrow = 0, ncol = dim(x$data)[[2]] - 1)
} else if (!is.array(z)) {
z <- matrix(nrow = 0, ncol = dim(x$data)[[2]] - 1)
}
--- R stacktrace ---
where 1: mexDependence(x = res1, which = which, dqu = dqu, margins = margins,
constrain = constrain, v = v)
where 2: mex(winter, mqu = 0.7)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (x, which, dqu, margins = "laplace", constrain = TRUE,
v = 10, maxit = 1e+06, start = c(0.01, 0.01), marTransform = "mixture",
referenceMargin = NULL, nOptim = 1, PlotLikDo = FALSE, PlotLikRange = list(a = c(-1,
1), b = c(-3, 1)), PlotLikTitle = NULL)
{
theCall <- match.call()
if (class(x) != "migpd")
stop("you need to use an object created by migpd")
margins <- list(casefold(margins), p2q = switch(casefold(margins),
gumbel = function(p) -log(-log(p)), laplace = function(p) ifelse(p <
0.5, log(2 * p), -log(2 * (1 - p)))), q2p = switch(casefold(margins),
gumbel = function(q) exp(-exp(-q)), laplace = function(q) ifelse(q <
0, exp(q)/2, 1 - 0.5 * exp(-q))))
x <- mexTransform(x, margins = margins, method = marTransform,
r = referenceMargin)
x$referenceMargin <- referenceMargin
if (margins[[1]] == "gumbel" & constrain) {
warning("With Gumbel margins, you can't constrain, setting constrain=FALSE")
constrain <- FALSE
}
if (missing(which)) {
message("Missing 'which'. Conditioning on", dimnames(x$transformed)[[2]][1],
"\n")
which <- 1
}
else if (length(which) > 1)
stop("which must be of length 1")
else if (is.character(which))
which <- match(which, dimnames(x$transformed)[[2]])
if (missing(dqu)) {
warning("Assuming same quantile for dependence thesholding as was used\n to fit corresponding marginal model...\n")
dqu <- x$mqu[which]
}
dth <- quantile(x$transformed[, which], dqu)
dependent <- (1:(dim(x$data)[[2]]))[-which]
if (length(dqu) < length(dependent))
dqu <- rep(dqu, length = length(dependent))
aLow <- ifelse(margins[[1]] == "gumbel", 10^(-10), -1 + 10^(-10))
if (missing(start)) {
start <- c(0.01, 0.01)
}
else if (class(start) == "mex") {
start <- start$dependence$coefficients[1:2, ]
}
if (length(start) == 2) {
start <- matrix(rep(start, length(dependent)), nrow = 2)
}
if (length(start) != 2 * length(dependent)) {
stop("start should be of type 'mex' or be a vector of length 2, or be a matrix with 2 rows and ncol equal to the number of dependence models to be estimated")
}
if (!missing(PlotLikRange)) {
PlotLikDo <- TRUE
}
qfun <- function(X, yex, wh, aLow, margins, constrain, v,
maxit, start) {
Qpos <- function(param, yex, ydep, constrain, v, aLow) {
a <- param[1]
b <- param[2]
res <- PosGumb.Laplace.negProfileLogLik(yex, ydep,
a, b, constrain, v, aLow)
res$profLik
}
o <- try(optim(par = start, fn = Qpos, control = list(maxit = maxit),
yex = yex[wh], ydep = X[wh], constrain = constrain,
v = v, aLow = aLow), silent = TRUE)
if (class(o) == "try-error") {
warning("Error in optim call from mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
o$value <- NA
}
else if (o$convergence != 0) {
warning("Non-convergence in mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
}
else if (nOptim > 1) {
for (i in 2:nOptim) {
o <- try(optim(par = o$par, fn = Qpos, control = list(maxit = maxit),
yex = yex[wh], ydep = X[wh], constrain = constrain,
v = v, aLow = aLow), silent = TRUE)
if (class(o) == "try-error") {
warning("Error in optim call from mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
o$value <- NA
(break)()
}
else if (o$convergence != 0) {
warning("Non-convergence in mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
(break)()
}
}
}
if (PlotLikDo) {
nGridPlotLik <- 50
a.grid <- seq(PlotLikRange$a[1], PlotLikRange$a[2],
length = nGridPlotLik)
b.grid <- seq(PlotLikRange$b[1], PlotLikRange$b[2],
length = nGridPlotLik)
NegProfLik <- matrix(0, nrow = nGridPlotLik, ncol = nGridPlotLik)
for (i in 1:nGridPlotLik) {
for (j in 1:nGridPlotLik) {
NegProfLik[i, j] <- PosGumb.Laplace.negProfileLogLik(yex = yex[wh],
ydep = X[wh], a = a.grid[i], b = b.grid[j],
constrain = constrain, v = v, aLow = aLow)$profLik
}
}
NegProfLik[NegProfLik > 10^10] <- NA
if (sum(!is.na(NegProfLik))) {
filled.contour(a.grid, b.grid, -NegProfLik, main = paste("Profile likelihood",
PlotLikTitle), color.palette = terrain.colors,
xlab = "a", ylab = "b", plot.axes = {
axis(1)
axis(2)
points(o$par[1], o$par[2])
})
}
}
if (!is.na(o$par[1])) {
if (margins == "gumbel" & o$par[1] <= 10^(-5) & o$par[2] <
0) {
lo <- c(10^(-10), -Inf, -Inf, 10^(-10), -Inf,
10^(-10))
Qneg <- function(yex, ydep, param) {
param <- param[-1]
b <- param[1]
cee <- param[2]
d <- param[3]
m <- param[4]
s <- param[5]
obj <- function(yex, ydep, b, cee, d, m, s) {
mu <- cee - d * log(yex) + m * yex^b
sig <- s * yex^b
log(sig) + 0.5 * ((ydep - mu)/sig)^2
}
res <- sum(obj(yex, ydep, b, cee, d, m, s))
res
}
o <- try(optim(c(0, 0, 0, 0, 0, 1), Qneg, method = "L-BFGS-B",
lower = lo, upper = c(1, 1 - 10^(-10), Inf,
1 - 10^(-10), Inf, Inf), yex = yex[wh], ydep = X[wh]),
silent = TRUE)
if (class(o) == "try-error" || o$convergence !=
0) {
warning("Non-convergence in mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
}
}
else {
Z <- (X[wh] - yex[wh] * o$par[1])/(yex[wh]^o$par[2])
o$par <- c(o$par[1:2], 0, 0, mean(Z), sd(Z))
}
}
c(o$par[1:6], o$value)
}
yex <- c(x$transformed[, which])
wh <- yex > unique(dth)
res <- sapply(1:length(dependent), function(X, dat, yex,
wh, aLow, margins, constrain, v, maxit, start) qfun(dat[,
X], yex, wh, aLow, margins, constrain, v, maxit, start[,
X]), dat = as.matrix(x$transformed[, dependent]), yex = yex,
wh = wh, aLow = aLow, margins = margins[[1]], constrain = constrain,
v = v, maxit = maxit, start = start)
loglik <- -res[7, ]
res <- matrix(res[1:6, ], nrow = 6)
dimnames(res)[[1]] <- c(letters[1:4], "m", "s")
dimnames(res)[[2]] <- dimnames(x$transformed)[[2]][dependent]
gdata <- as.matrix(x$transformed[wh, -which])
tfun <- function(i, data, yex, a, b, cee, d) {
data <- data[, i]
a <- a[i]
b <- b[i]
cee <- cee[i]
d <- d[i]
if (is.na(a))
rep(NA, length(data))
else {
if (a < 10^(-5) & b < 0)
a <- cee - d * log(yex)
else a <- a * yex
(data - a)/(yex^b)
}
}
z <- try(sapply(1:(dim(gdata)[[2]]), tfun, data = gdata,
yex = yex[wh], a = res[1, ], b = res[2, ], cee = res[3,
], d = res[4, ]))
if (class(z) %in% c("Error", "try-error")) {
z <- matrix(nrow = 0, ncol = dim(x$data)[[2]] - 1)
}
else if (!is.array(z)) {
z <- matrix(nrow = 0, ncol = dim(x$data)[[2]] - 1)
}
dimnames(z) <- list(NULL, dimnames(x$transformed)[[2]][dependent])
res2 <- list(coefficients = res, Z = z, dth = unique(dth),
dqu = unique(dqu), which = which, conditioningVariable = colnames(x$data)[which],
loglik = loglik, margins = margins, constrain = constrain,
v = v)
oldClass(res2) <- "mexDependence"
output <- list(margins = x, dependence = res2, call = theCall)
oldClass(output) <- "mex"
output
}
<bytecode: 0x4cbfd28>
<environment: namespace:texmex>
--- function search by body ---
Function mexDependence in namespace texmex has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(z) %in% c("Error", "try-error")) { :
the condition has length > 1
Calls: mex -> mexDependence
Execution halted
Flavor: r-devel-linux-x86_64-debian-clang
Version: 2.4.2
Check: examples
Result: ERROR
Running examples in ‘texmex-Ex.R’ failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: ggplot.mex
> ### Title: Conditional multivariate extreme values modelling
> ### Aliases: ggplot.mex mex plot.mex print.mex predict.mex
> ### summary.predict.mex plot.predict.mex mexAll print.mexList
> ### print.summary.mex summary.mex ggplot.predict.mex
> ### Keywords: models multivariate
>
> ### ** Examples
>
>
> w <- mex(winter, mqu=.7)
which not given. Conditioning onO3
Warning in mexDependence(x = res1, which = which, dqu = dqu, margins = margins, :
Assuming same quantile for dependence thesholding as was used
to fit corresponding marginal model...
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
texmex
--- call from context ---
mexDependence(x = res1, which = which, dqu = dqu, margins = margins,
constrain = constrain, v = v)
--- call from argument ---
if (class(z) %in% c("Error", "try-error")) {
z <- matrix(nrow = 0, ncol = dim(x$data)[[2]] - 1)
} else if (!is.array(z)) {
z <- matrix(nrow = 0, ncol = dim(x$data)[[2]] - 1)
}
--- R stacktrace ---
where 1: mexDependence(x = res1, which = which, dqu = dqu, margins = margins,
constrain = constrain, v = v)
where 2: mex(winter, mqu = 0.7)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (x, which, dqu, margins = "laplace", constrain = TRUE,
v = 10, maxit = 1e+06, start = c(0.01, 0.01), marTransform = "mixture",
referenceMargin = NULL, nOptim = 1, PlotLikDo = FALSE, PlotLikRange = list(a = c(-1,
1), b = c(-3, 1)), PlotLikTitle = NULL)
{
theCall <- match.call()
if (class(x) != "migpd")
stop("you need to use an object created by migpd")
margins <- list(casefold(margins), p2q = switch(casefold(margins),
gumbel = function(p) -log(-log(p)), laplace = function(p) ifelse(p <
0.5, log(2 * p), -log(2 * (1 - p)))), q2p = switch(casefold(margins),
gumbel = function(q) exp(-exp(-q)), laplace = function(q) ifelse(q <
0, exp(q)/2, 1 - 0.5 * exp(-q))))
x <- mexTransform(x, margins = margins, method = marTransform,
r = referenceMargin)
x$referenceMargin <- referenceMargin
if (margins[[1]] == "gumbel" & constrain) {
warning("With Gumbel margins, you can't constrain, setting constrain=FALSE")
constrain <- FALSE
}
if (missing(which)) {
message("Missing 'which'. Conditioning on", dimnames(x$transformed)[[2]][1],
"\n")
which <- 1
}
else if (length(which) > 1)
stop("which must be of length 1")
else if (is.character(which))
which <- match(which, dimnames(x$transformed)[[2]])
if (missing(dqu)) {
warning("Assuming same quantile for dependence thesholding as was used\n to fit corresponding marginal model...\n")
dqu <- x$mqu[which]
}
dth <- quantile(x$transformed[, which], dqu)
dependent <- (1:(dim(x$data)[[2]]))[-which]
if (length(dqu) < length(dependent))
dqu <- rep(dqu, length = length(dependent))
aLow <- ifelse(margins[[1]] == "gumbel", 10^(-10), -1 + 10^(-10))
if (missing(start)) {
start <- c(0.01, 0.01)
}
else if (class(start) == "mex") {
start <- start$dependence$coefficients[1:2, ]
}
if (length(start) == 2) {
start <- matrix(rep(start, length(dependent)), nrow = 2)
}
if (length(start) != 2 * length(dependent)) {
stop("start should be of type 'mex' or be a vector of length 2, or be a matrix with 2 rows and ncol equal to the number of dependence models to be estimated")
}
if (!missing(PlotLikRange)) {
PlotLikDo <- TRUE
}
qfun <- function(X, yex, wh, aLow, margins, constrain, v,
maxit, start) {
Qpos <- function(param, yex, ydep, constrain, v, aLow) {
a <- param[1]
b <- param[2]
res <- PosGumb.Laplace.negProfileLogLik(yex, ydep,
a, b, constrain, v, aLow)
res$profLik
}
o <- try(optim(par = start, fn = Qpos, control = list(maxit = maxit),
yex = yex[wh], ydep = X[wh], constrain = constrain,
v = v, aLow = aLow), silent = TRUE)
if (class(o) == "try-error") {
warning("Error in optim call from mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
o$value <- NA
}
else if (o$convergence != 0) {
warning("Non-convergence in mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
}
else if (nOptim > 1) {
for (i in 2:nOptim) {
o <- try(optim(par = o$par, fn = Qpos, control = list(maxit = maxit),
yex = yex[wh], ydep = X[wh], constrain = constrain,
v = v, aLow = aLow), silent = TRUE)
if (class(o) == "try-error") {
warning("Error in optim call from mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
o$value <- NA
(break)()
}
else if (o$convergence != 0) {
warning("Non-convergence in mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
(break)()
}
}
}
if (PlotLikDo) {
nGridPlotLik <- 50
a.grid <- seq(PlotLikRange$a[1], PlotLikRange$a[2],
length = nGridPlotLik)
b.grid <- seq(PlotLikRange$b[1], PlotLikRange$b[2],
length = nGridPlotLik)
NegProfLik <- matrix(0, nrow = nGridPlotLik, ncol = nGridPlotLik)
for (i in 1:nGridPlotLik) {
for (j in 1:nGridPlotLik) {
NegProfLik[i, j] <- PosGumb.Laplace.negProfileLogLik(yex = yex[wh],
ydep = X[wh], a = a.grid[i], b = b.grid[j],
constrain = constrain, v = v, aLow = aLow)$profLik
}
}
NegProfLik[NegProfLik > 10^10] <- NA
if (sum(!is.na(NegProfLik))) {
filled.contour(a.grid, b.grid, -NegProfLik, main = paste("Profile likelihood",
PlotLikTitle), color.palette = terrain.colors,
xlab = "a", ylab = "b", plot.axes = {
axis(1)
axis(2)
points(o$par[1], o$par[2])
})
}
}
if (!is.na(o$par[1])) {
if (margins == "gumbel" & o$par[1] <= 10^(-5) & o$par[2] <
0) {
lo <- c(10^(-10), -Inf, -Inf, 10^(-10), -Inf,
10^(-10))
Qneg <- function(yex, ydep, param) {
param <- param[-1]
b <- param[1]
cee <- param[2]
d <- param[3]
m <- param[4]
s <- param[5]
obj <- function(yex, ydep, b, cee, d, m, s) {
mu <- cee - d * log(yex) + m * yex^b
sig <- s * yex^b
log(sig) + 0.5 * ((ydep - mu)/sig)^2
}
res <- sum(obj(yex, ydep, b, cee, d, m, s))
res
}
o <- try(optim(c(0, 0, 0, 0, 0, 1), Qneg, method = "L-BFGS-B",
lower = lo, upper = c(1, 1 - 10^(-10), Inf,
1 - 10^(-10), Inf, Inf), yex = yex[wh], ydep = X[wh]),
silent = TRUE)
if (class(o) == "try-error" || o$convergence !=
0) {
warning("Non-convergence in mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
}
}
else {
Z <- (X[wh] - yex[wh] * o$par[1])/(yex[wh]^o$par[2])
o$par <- c(o$par[1:2], 0, 0, mean(Z), sd(Z))
}
}
c(o$par[1:6], o$value)
}
yex <- c(x$transformed[, which])
wh <- yex > unique(dth)
res <- sapply(1:length(dependent), function(X, dat, yex,
wh, aLow, margins, constrain, v, maxit, start) qfun(dat[,
X], yex, wh, aLow, margins, constrain, v, maxit, start[,
X]), dat = as.matrix(x$transformed[, dependent]), yex = yex,
wh = wh, aLow = aLow, margins = margins[[1]], constrain = constrain,
v = v, maxit = maxit, start = start)
loglik <- -res[7, ]
res <- matrix(res[1:6, ], nrow = 6)
dimnames(res)[[1]] <- c(letters[1:4], "m", "s")
dimnames(res)[[2]] <- dimnames(x$transformed)[[2]][dependent]
gdata <- as.matrix(x$transformed[wh, -which])
tfun <- function(i, data, yex, a, b, cee, d) {
data <- data[, i]
a <- a[i]
b <- b[i]
cee <- cee[i]
d <- d[i]
if (is.na(a))
rep(NA, length(data))
else {
if (a < 10^(-5) & b < 0)
a <- cee - d * log(yex)
else a <- a * yex
(data - a)/(yex^b)
}
}
z <- try(sapply(1:(dim(gdata)[[2]]), tfun, data = gdata,
yex = yex[wh], a = res[1, ], b = res[2, ], cee = res[3,
], d = res[4, ]))
if (class(z) %in% c("Error", "try-error")) {
z <- matrix(nrow = 0, ncol = dim(x$data)[[2]] - 1)
}
else if (!is.array(z)) {
z <- matrix(nrow = 0, ncol = dim(x$data)[[2]] - 1)
}
dimnames(z) <- list(NULL, dimnames(x$transformed)[[2]][dependent])
res2 <- list(coefficients = res, Z = z, dth = unique(dth),
dqu = unique(dqu), which = which, conditioningVariable = colnames(x$data)[which],
loglik = loglik, margins = margins, constrain = constrain,
v = v)
oldClass(res2) <- "mexDependence"
output <- list(margins = x, dependence = res2, call = theCall)
oldClass(output) <- "mex"
output
}
<bytecode: 0x55caaaf93920>
<environment: namespace:texmex>
--- function search by body ---
Function mexDependence in namespace texmex has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(z) %in% c("Error", "try-error")) { :
the condition has length > 1
Calls: mex -> mexDependence
Execution halted
Flavor: r-devel-linux-x86_64-debian-gcc
Version: 2.4.2
Check: examples
Result: ERROR
Running examples in ‘texmex-Ex.R’ failed
The error most likely occurred in:
> ### Name: ggplot.mex
> ### Title: Conditional multivariate extreme values modelling
> ### Aliases: ggplot.mex mex plot.mex print.mex predict.mex
> ### summary.predict.mex plot.predict.mex mexAll print.mexList
> ### print.summary.mex summary.mex ggplot.predict.mex
> ### Keywords: models multivariate
>
> ### ** Examples
>
>
> w <- mex(winter, mqu=.7)
which not given. Conditioning onO3
Warning in mexDependence(x = res1, which = which, dqu = dqu, margins = margins, :
Assuming same quantile for dependence thesholding as was used
to fit corresponding marginal model...
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
texmex
--- call from context ---
mexDependence(x = res1, which = which, dqu = dqu, margins = margins,
constrain = constrain, v = v)
--- call from argument ---
if (class(z) %in% c("Error", "try-error")) {
z <- matrix(nrow = 0, ncol = dim(x$data)[[2]] - 1)
} else if (!is.array(z)) {
z <- matrix(nrow = 0, ncol = dim(x$data)[[2]] - 1)
}
--- R stacktrace ---
where 1: mexDependence(x = res1, which = which, dqu = dqu, margins = margins,
constrain = constrain, v = v)
where 2: mex(winter, mqu = 0.7)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (x, which, dqu, margins = "laplace", constrain = TRUE,
v = 10, maxit = 1e+06, start = c(0.01, 0.01), marTransform = "mixture",
referenceMargin = NULL, nOptim = 1, PlotLikDo = FALSE, PlotLikRange = list(a = c(-1,
1), b = c(-3, 1)), PlotLikTitle = NULL)
{
theCall <- match.call()
if (class(x) != "migpd")
stop("you need to use an object created by migpd")
margins <- list(casefold(margins), p2q = switch(casefold(margins),
gumbel = function(p) -log(-log(p)), laplace = function(p) ifelse(p <
0.5, log(2 * p), -log(2 * (1 - p)))), q2p = switch(casefold(margins),
gumbel = function(q) exp(-exp(-q)), laplace = function(q) ifelse(q <
0, exp(q)/2, 1 - 0.5 * exp(-q))))
x <- mexTransform(x, margins = margins, method = marTransform,
r = referenceMargin)
x$referenceMargin <- referenceMargin
if (margins[[1]] == "gumbel" & constrain) {
warning("With Gumbel margins, you can't constrain, setting constrain=FALSE")
constrain <- FALSE
}
if (missing(which)) {
message("Missing 'which'. Conditioning on", dimnames(x$transformed)[[2]][1],
"\n")
which <- 1
}
else if (length(which) > 1)
stop("which must be of length 1")
else if (is.character(which))
which <- match(which, dimnames(x$transformed)[[2]])
if (missing(dqu)) {
warning("Assuming same quantile for dependence thesholding as was used\n to fit corresponding marginal model...\n")
dqu <- x$mqu[which]
}
dth <- quantile(x$transformed[, which], dqu)
dependent <- (1:(dim(x$data)[[2]]))[-which]
if (length(dqu) < length(dependent))
dqu <- rep(dqu, length = length(dependent))
aLow <- ifelse(margins[[1]] == "gumbel", 10^(-10), -1 + 10^(-10))
if (missing(start)) {
start <- c(0.01, 0.01)
}
else if (class(start) == "mex") {
start <- start$dependence$coefficients[1:2, ]
}
if (length(start) == 2) {
start <- matrix(rep(start, length(dependent)), nrow = 2)
}
if (length(start) != 2 * length(dependent)) {
stop("start should be of type 'mex' or be a vector of length 2, or be a matrix with 2 rows and ncol equal to the number of dependence models to be estimated")
}
if (!missing(PlotLikRange)) {
PlotLikDo <- TRUE
}
qfun <- function(X, yex, wh, aLow, margins, constrain, v,
maxit, start) {
Qpos <- function(param, yex, ydep, constrain, v, aLow) {
a <- param[1]
b <- param[2]
res <- PosGumb.Laplace.negProfileLogLik(yex, ydep,
a, b, constrain, v, aLow)
res$profLik
}
o <- try(optim(par = start, fn = Qpos, control = list(maxit = maxit),
yex = yex[wh], ydep = X[wh], constrain = constrain,
v = v, aLow = aLow), silent = TRUE)
if (class(o) == "try-error") {
warning("Error in optim call from mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
o$value <- NA
}
else if (o$convergence != 0) {
warning("Non-convergence in mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
}
else if (nOptim > 1) {
for (i in 2:nOptim) {
o <- try(optim(par = o$par, fn = Qpos, control = list(maxit = maxit),
yex = yex[wh], ydep = X[wh], constrain = constrain,
v = v, aLow = aLow), silent = TRUE)
if (class(o) == "try-error") {
warning("Error in optim call from mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
o$value <- NA
(break)()
}
else if (o$convergence != 0) {
warning("Non-convergence in mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
(break)()
}
}
}
if (PlotLikDo) {
nGridPlotLik <- 50
a.grid <- seq(PlotLikRange$a[1], PlotLikRange$a[2],
length = nGridPlotLik)
b.grid <- seq(PlotLikRange$b[1], PlotLikRange$b[2],
length = nGridPlotLik)
NegProfLik <- matrix(0, nrow = nGridPlotLik, ncol = nGridPlotLik)
for (i in 1:nGridPlotLik) {
for (j in 1:nGridPlotLik) {
NegProfLik[i, j] <- PosGumb.Laplace.negProfileLogLik(yex = yex[wh],
ydep = X[wh], a = a.grid[i], b = b.grid[j],
constrain = constrain, v = v, aLow = aLow)$profLik
}
}
NegProfLik[NegProfLik > 10^10] <- NA
if (sum(!is.na(NegProfLik))) {
filled.contour(a.grid, b.grid, -NegProfLik, main = paste("Profile likelihood",
PlotLikTitle), color.palette = terrain.colors,
xlab = "a", ylab = "b", plot.axes = {
axis(1)
axis(2)
points(o$par[1], o$par[2])
})
}
}
if (!is.na(o$par[1])) {
if (margins == "gumbel" & o$par[1] <= 10^(-5) & o$par[2] <
0) {
lo <- c(10^(-10), -Inf, -Inf, 10^(-10), -Inf,
10^(-10))
Qneg <- function(yex, ydep, param) {
param <- param[-1]
b <- param[1]
cee <- param[2]
d <- param[3]
m <- param[4]
s <- param[5]
obj <- function(yex, ydep, b, cee, d, m, s) {
mu <- cee - d * log(yex) + m * yex^b
sig <- s * yex^b
log(sig) + 0.5 * ((ydep - mu)/sig)^2
}
res <- sum(obj(yex, ydep, b, cee, d, m, s))
res
}
o <- try(optim(c(0, 0, 0, 0, 0, 1), Qneg, method = "L-BFGS-B",
lower = lo, upper = c(1, 1 - 10^(-10), Inf,
1 - 10^(-10), Inf, Inf), yex = yex[wh], ydep = X[wh]),
silent = TRUE)
if (class(o) == "try-error" || o$convergence !=
0) {
warning("Non-convergence in mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
}
}
else {
Z <- (X[wh] - yex[wh] * o$par[1])/(yex[wh]^o$par[2])
o$par <- c(o$par[1:2], 0, 0, mean(Z), sd(Z))
}
}
c(o$par[1:6], o$value)
}
yex <- c(x$transformed[, which])
wh <- yex > unique(dth)
res <- sapply(1:length(dependent), function(X, dat, yex,
wh, aLow, margins, constrain, v, maxit, start) qfun(dat[,
X], yex, wh, aLow, margins, constrain, v, maxit, start[,
X]), dat = as.matrix(x$transformed[, dependent]), yex = yex,
wh = wh, aLow = aLow, margins = margins[[1]], constrain = constrain,
v = v, maxit = maxit, start = start)
loglik <- -res[7, ]
res <- matrix(res[1:6, ], nrow = 6)
dimnames(res)[[1]] <- c(letters[1:4], "m", "s")
dimnames(res)[[2]] <- dimnames(x$transformed)[[2]][dependent]
gdata <- as.matrix(x$transformed[wh, -which])
tfun <- function(i, data, yex, a, b, cee, d) {
data <- data[, i]
a <- a[i]
b <- b[i]
cee <- cee[i]
d <- d[i]
if (is.na(a))
rep(NA, length(data))
else {
if (a < 10^(-5) & b < 0)
a <- cee - d * log(yex)
else a <- a * yex
(data - a)/(yex^b)
}
}
z <- try(sapply(1:(dim(gdata)[[2]]), tfun, data = gdata,
yex = yex[wh], a = res[1, ], b = res[2, ], cee = res[3,
], d = res[4, ]))
if (class(z) %in% c("Error", "try-error")) {
z <- matrix(nrow = 0, ncol = dim(x$data)[[2]] - 1)
}
else if (!is.array(z)) {
z <- matrix(nrow = 0, ncol = dim(x$data)[[2]] - 1)
}
dimnames(z) <- list(NULL, dimnames(x$transformed)[[2]][dependent])
res2 <- list(coefficients = res, Z = z, dth = unique(dth),
dqu = unique(dqu), which = which, conditioningVariable = colnames(x$data)[which],
loglik = loglik, margins = margins, constrain = constrain,
v = v)
oldClass(res2) <- "mexDependence"
output <- list(margins = x, dependence = res2, call = theCall)
oldClass(output) <- "mex"
output
}
<bytecode: 0x58d1fc8>
<environment: namespace:texmex>
--- function search by body ---
Function mexDependence in namespace texmex has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(z) %in% c("Error", "try-error")) { :
the condition has length > 1
Calls: mex -> mexDependence
Execution halted
Flavor: r-devel-linux-x86_64-fedora-clang
Version: 2.4.2
Check: examples
Result: ERROR
Running examples in ‘texmex-Ex.R’ failed
The error most likely occurred in:
> ### Name: ggplot.mex
> ### Title: Conditional multivariate extreme values modelling
> ### Aliases: ggplot.mex mex plot.mex print.mex predict.mex
> ### summary.predict.mex plot.predict.mex mexAll print.mexList
> ### print.summary.mex summary.mex ggplot.predict.mex
> ### Keywords: models multivariate
>
> ### ** Examples
>
>
> w <- mex(winter, mqu=.7)
which not given. Conditioning onO3
Warning in mexDependence(x = res1, which = which, dqu = dqu, margins = margins, :
Assuming same quantile for dependence thesholding as was used
to fit corresponding marginal model...
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
texmex
--- call from context ---
mexDependence(x = res1, which = which, dqu = dqu, margins = margins,
constrain = constrain, v = v)
--- call from argument ---
if (class(z) %in% c("Error", "try-error")) {
z <- matrix(nrow = 0, ncol = dim(x$data)[[2]] - 1)
} else if (!is.array(z)) {
z <- matrix(nrow = 0, ncol = dim(x$data)[[2]] - 1)
}
--- R stacktrace ---
where 1: mexDependence(x = res1, which = which, dqu = dqu, margins = margins,
constrain = constrain, v = v)
where 2: mex(winter, mqu = 0.7)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (x, which, dqu, margins = "laplace", constrain = TRUE,
v = 10, maxit = 1e+06, start = c(0.01, 0.01), marTransform = "mixture",
referenceMargin = NULL, nOptim = 1, PlotLikDo = FALSE, PlotLikRange = list(a = c(-1,
1), b = c(-3, 1)), PlotLikTitle = NULL)
{
theCall <- match.call()
if (class(x) != "migpd")
stop("you need to use an object created by migpd")
margins <- list(casefold(margins), p2q = switch(casefold(margins),
gumbel = function(p) -log(-log(p)), laplace = function(p) ifelse(p <
0.5, log(2 * p), -log(2 * (1 - p)))), q2p = switch(casefold(margins),
gumbel = function(q) exp(-exp(-q)), laplace = function(q) ifelse(q <
0, exp(q)/2, 1 - 0.5 * exp(-q))))
x <- mexTransform(x, margins = margins, method = marTransform,
r = referenceMargin)
x$referenceMargin <- referenceMargin
if (margins[[1]] == "gumbel" & constrain) {
warning("With Gumbel margins, you can't constrain, setting constrain=FALSE")
constrain <- FALSE
}
if (missing(which)) {
message("Missing 'which'. Conditioning on", dimnames(x$transformed)[[2]][1],
"\n")
which <- 1
}
else if (length(which) > 1)
stop("which must be of length 1")
else if (is.character(which))
which <- match(which, dimnames(x$transformed)[[2]])
if (missing(dqu)) {
warning("Assuming same quantile for dependence thesholding as was used\n to fit corresponding marginal model...\n")
dqu <- x$mqu[which]
}
dth <- quantile(x$transformed[, which], dqu)
dependent <- (1:(dim(x$data)[[2]]))[-which]
if (length(dqu) < length(dependent))
dqu <- rep(dqu, length = length(dependent))
aLow <- ifelse(margins[[1]] == "gumbel", 10^(-10), -1 + 10^(-10))
if (missing(start)) {
start <- c(0.01, 0.01)
}
else if (class(start) == "mex") {
start <- start$dependence$coefficients[1:2, ]
}
if (length(start) == 2) {
start <- matrix(rep(start, length(dependent)), nrow = 2)
}
if (length(start) != 2 * length(dependent)) {
stop("start should be of type 'mex' or be a vector of length 2, or be a matrix with 2 rows and ncol equal to the number of dependence models to be estimated")
}
if (!missing(PlotLikRange)) {
PlotLikDo <- TRUE
}
qfun <- function(X, yex, wh, aLow, margins, constrain, v,
maxit, start) {
Qpos <- function(param, yex, ydep, constrain, v, aLow) {
a <- param[1]
b <- param[2]
res <- PosGumb.Laplace.negProfileLogLik(yex, ydep,
a, b, constrain, v, aLow)
res$profLik
}
o <- try(optim(par = start, fn = Qpos, control = list(maxit = maxit),
yex = yex[wh], ydep = X[wh], constrain = constrain,
v = v, aLow = aLow), silent = TRUE)
if (class(o) == "try-error") {
warning("Error in optim call from mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
o$value <- NA
}
else if (o$convergence != 0) {
warning("Non-convergence in mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
}
else if (nOptim > 1) {
for (i in 2:nOptim) {
o <- try(optim(par = o$par, fn = Qpos, control = list(maxit = maxit),
yex = yex[wh], ydep = X[wh], constrain = constrain,
v = v, aLow = aLow), silent = TRUE)
if (class(o) == "try-error") {
warning("Error in optim call from mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
o$value <- NA
(break)()
}
else if (o$convergence != 0) {
warning("Non-convergence in mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
(break)()
}
}
}
if (PlotLikDo) {
nGridPlotLik <- 50
a.grid <- seq(PlotLikRange$a[1], PlotLikRange$a[2],
length = nGridPlotLik)
b.grid <- seq(PlotLikRange$b[1], PlotLikRange$b[2],
length = nGridPlotLik)
NegProfLik <- matrix(0, nrow = nGridPlotLik, ncol = nGridPlotLik)
for (i in 1:nGridPlotLik) {
for (j in 1:nGridPlotLik) {
NegProfLik[i, j] <- PosGumb.Laplace.negProfileLogLik(yex = yex[wh],
ydep = X[wh], a = a.grid[i], b = b.grid[j],
constrain = constrain, v = v, aLow = aLow)$profLik
}
}
NegProfLik[NegProfLik > 10^10] <- NA
if (sum(!is.na(NegProfLik))) {
filled.contour(a.grid, b.grid, -NegProfLik, main = paste("Profile likelihood",
PlotLikTitle), color.palette = terrain.colors,
xlab = "a", ylab = "b", plot.axes = {
axis(1)
axis(2)
points(o$par[1], o$par[2])
})
}
}
if (!is.na(o$par[1])) {
if (margins == "gumbel" & o$par[1] <= 10^(-5) & o$par[2] <
0) {
lo <- c(10^(-10), -Inf, -Inf, 10^(-10), -Inf,
10^(-10))
Qneg <- function(yex, ydep, param) {
param <- param[-1]
b <- param[1]
cee <- param[2]
d <- param[3]
m <- param[4]
s <- param[5]
obj <- function(yex, ydep, b, cee, d, m, s) {
mu <- cee - d * log(yex) + m * yex^b
sig <- s * yex^b
log(sig) + 0.5 * ((ydep - mu)/sig)^2
}
res <- sum(obj(yex, ydep, b, cee, d, m, s))
res
}
o <- try(optim(c(0, 0, 0, 0, 0, 1), Qneg, method = "L-BFGS-B",
lower = lo, upper = c(1, 1 - 10^(-10), Inf,
1 - 10^(-10), Inf, Inf), yex = yex[wh], ydep = X[wh]),
silent = TRUE)
if (class(o) == "try-error" || o$convergence !=
0) {
warning("Non-convergence in mexDependence")
o <- as.list(o)
o$par <- rep(NA, 6)
}
}
else {
Z <- (X[wh] - yex[wh] * o$par[1])/(yex[wh]^o$par[2])
o$par <- c(o$par[1:2], 0, 0, mean(Z), sd(Z))
}
}
c(o$par[1:6], o$value)
}
yex <- c(x$transformed[, which])
wh <- yex > unique(dth)
res <- sapply(1:length(dependent), function(X, dat, yex,
wh, aLow, margins, constrain, v, maxit, start) qfun(dat[,
X], yex, wh, aLow, margins, constrain, v, maxit, start[,
X]), dat = as.matrix(x$transformed[, dependent]), yex = yex,
wh = wh, aLow = aLow, margins = margins[[1]], constrain = constrain,
v = v, maxit = maxit, start = start)
loglik <- -res[7, ]
res <- matrix(res[1:6, ], nrow = 6)
dimnames(res)[[1]] <- c(letters[1:4], "m", "s")
dimnames(res)[[2]] <- dimnames(x$transformed)[[2]][dependent]
gdata <- as.matrix(x$transformed[wh, -which])
tfun <- function(i, data, yex, a, b, cee, d) {
data <- data[, i]
a <- a[i]
b <- b[i]
cee <- cee[i]
d <- d[i]
if (is.na(a))
rep(NA, length(data))
else {
if (a < 10^(-5) & b < 0)
a <- cee - d * log(yex)
else a <- a * yex
(data - a)/(yex^b)
}
}
z <- try(sapply(1:(dim(gdata)[[2]]), tfun, data = gdata,
yex = yex[wh], a = res[1, ], b = res[2, ], cee = res[3,
], d = res[4, ]))
if (class(z) %in% c("Error", "try-error")) {
z <- matrix(nrow = 0, ncol = dim(x$data)[[2]] - 1)
}
else if (!is.array(z)) {
z <- matrix(nrow = 0, ncol = dim(x$data)[[2]] - 1)
}
dimnames(z) <- list(NULL, dimnames(x$transformed)[[2]][dependent])
res2 <- list(coefficients = res, Z = z, dth = unique(dth),
dqu = unique(dqu), which = which, conditioningVariable = colnames(x$data)[which],
loglik = loglik, margins = margins, constrain = constrain,
v = v)
oldClass(res2) <- "mexDependence"
output <- list(margins = x, dependence = res2, call = theCall)
oldClass(output) <- "mex"
output
}
<bytecode: 0x6912788>
<environment: namespace:texmex>
--- function search by body ---
Function mexDependence in namespace texmex has this body.
----------- END OF FAILURE REPORT --------------
Error in if (class(z) %in% c("Error", "try-error")) { :
the condition has length > 1
Calls: mex -> mexDependence
Execution halted
Flavor: r-devel-linux-x86_64-fedora-gcc
Version: 2.4.2
Check: installed package size
Result: NOTE
installed size is 5.5Mb
sub-directories of 1Mb or more:
doc 3.2Mb
libs 1.5Mb
Flavors: r-devel-windows-ix86+x86_64, r-devel-windows-ix86+x86_64-gcc8, r-release-windows-ix86+x86_64, r-oldrel-windows-ix86+x86_64