\name{predDensx}
\alias{predDensx}
\title{Conditional predictive posterior density of peaks-over-threshold models}
\usage{
predDensx(
  x,
  postsamp,
  scedasis,
  threshold,
  type = c("continuous", "discrete"),
  extrapolation = FALSE,
  p,
  k,
  n
)
}
\arguments{
\item{x}{vector of length \code{r} containing the points at which to evaluate the density}

\item{postsamp}{a \code{m} by \code{2} matrix with columns containing the posterior samples of scale and shape parameters of the generalized Pareto distribution, respectively}

\item{scedasis}{an \code{m} by \code{p} matrix, obtained by evaluating the scedasis function for every of the \code{p} covariate values and every \code{m} posterior draw}

\item{threshold}{threshold for the generalized Pareto model, corresponding to the \eqn{n-k}th order statistic of the sample}

\item{type}{data type, either \code{"continuous"} or \code{"discrete"} for count data.}

\item{extrapolation}{logical; if \code{TRUE}, extrapolate using the threshold stability property}

\item{p}{scalar tail probability for the extrapolation. Must be smaller than \eqn{k/n} (only used if \code{extrapolation=TRUE})}

\item{k}{integer, number of exceedances for the generalized Pareto (only used if \code{extrapolation=TRUE})}

\item{n}{integer, number of observations in the full sample. Must be greater than \code{k}  (only used if \code{extrapolation=TRUE})}
}
\value{
a list with components
\itemize{
\item \code{x} the vector at which the posterior density is evaluated
\item \code{preddens} an \code{r} by \code{p} matrix of predictive density corresponding to each combination of \code{x} and scedasis value
}
}
\description{
Given posterior samples for the parameters of the continuous or discrete generalized Pareto distribution and scedasis function for a set of covariates, evaluated at every draw of the latter,
return the predictive posterior density of a peak above an intermediate or extreme threshold using the threshold stability property.
}
\examples{
\dontrun{
# generate data
set.seed(1234)
n <- 500
samp <- evd::rfrechet(n,0,1:n,4)
# set effective sample size and threshold
k <- 50
threshold <- sort(samp,decreasing = TRUE)[k+1]
# preliminary mle estimates of scale and shape parameters
mlest <- evd::fpot(samp, threshold, control=list(maxit = 500))
# empirical bayes procedure
proc <- estPOT(
  samp,
  k = k,
  pn = c(0.01, 0.005),
  type = "continuous",
  method = "bayesian",
  prior = "empirical",
  start = as.list(mlest$estimate),
  sig0 = 0.1)
# conditional predictive density estimation
yg <- seq(0, 50, by = 2)
nyg <- length(yg)
# estimation of scedasis function
# setting
M <- 1e3
C <- 5
alpha <- 0.05
bw <- .5
nsim <- 5000
burn <- 1000
# create covariate
# in sample obs
n_in = n
# number of years ahead
nY = 1
n_out = 365 * nY
# total obs
n_tot = n_in + n_out
# total covariate (in+out sample period)
x <- seq(0, 1, length = n_tot)
# in sample grid dimension for covariate
ng_in <- 150
xg <- seq(0, x[n_in], length = ng_in)
# in+out of sample grid
xg <- c(xg, seq(x[n_in + 1], x[(n_tot)], length = ng_in))
# in+out sample grid dimension
nxg <- length(xg)
xg <- array(xg, c(nxg, 1))
# in sample observations
samp_in <- samp[1:n_in]
ssamp_in <- sort(samp_in, decreasing = TRUE, index = TRUE)
x_in <- x[1:n_in] # in sample covariate
xs <- x_in[ssamp_in$ix[1:k]] # in sample concomitant covariate
# estimate scedasis function over the in and out of sample period
res_stat <- apply(
  xg,
  1,
  cpost_stat,
  N = nsim - burn,
  x = x_in,
  xs = xs,
  bw = bw,
  k = k,
  C = C
)
# conditional predictive posterior density
yg <- seq(500, 5000, by = 100)
nyg = length(yg)
# intermediate threshold
predDens_intx <- predDensx(
  x = yg,
  postsamp = proc$post_sample,
  scedasis = res_stat,
  threshold = proc$t,
  "continuous",
  extrapolation = FALSE)
# extreme threshold
predDens_extx <- predDensx(
  x = yg,
  postsamp = proc$post_sample,
  scedasis = res_stat,
  threshold = proc$t,
  "continuous",
  extrapolation = TRUE,
  p = 0.001,
  k = k,
  n = n)
# plot intermediate and extreme density conditional on a specific value of scedasis function
# disclaimer: to speed up the procedure, we specify a coarse grid
plot(
 x = predDens_intx$x,
 y = predDens_intx$preddens[,20],
 type = "l",
 lwd = 2,
 col="dodgerblue",
 ylab = "",
 xlab = "yg",
 main = "Conditional predictive posterior density")
lines(
  x = predDens_extx$x,
  y = predDens_extx$preddens[,20],
  lwd = 2,
  col = "violet")
legend("topright",
  legend = c("Intermediate threshold","Extreme threshold"),
  lwd = 2,
  col = c("dodgerblue", "violet"))
}
}
