paulnorthrop / lax

Compare f692e78 ... +29 ... 62e77cd

Showing 9 of 82 files from the diff.
Newly tracked file
R/eva_gevr.R created.
Newly tracked file
R/eva_gpd.R created.
Newly tracked file
R/eva.R created.
Other files ignored by Codecov
man/evir.Rd has changed.
man/fExtremes.Rd has changed.
docs/index.html has changed.
man/anova.lax.Rd has changed.
man/texmex.Rd has changed.
docs/pkgdown.yml has changed.
man/extRemes.Rd has changed.
.gitignore has changed.
man/evd.Rd has changed.
man/ismev.Rd has changed.
man/mev.Rd has changed.
R/lax.R has changed.
docs/404.html has changed.
docs/authors.html has changed.
man/POT.Rd has changed.
NAMESPACE has changed.
appveyor.yml has changed.
man/lax.Rd has changed.
man/ow.Rd has changed.
README.Rmd has changed.
README.md has changed.
DESCRIPTION has changed.
vignettes/lax.bib has changed.
man/eva.Rd is new.
NEWS.md has changed.
man/alogLik.Rd has changed.
cran-comments.md has changed.

@@ -33,18 +33,18 @@
Loading
33 33
#'   # An example from the fExtremes::gevFit documentation
34 34
# '  # Simulate GEV Data
35 35
#'   set.seed(4082019)
36 -
#'   x <- gevSim(model = list(xi=0.25, mu=0, beta=1), n = 1000)
36 +
#'   x <- fExtremes::gevSim(model = list(xi=0.25, mu=0, beta=1), n = 1000)
37 37
#'   # Fit GEV distribution by maximum likelihood estimation
38 -
#'   fit <- gevFit(x)
38 +
#'   fit <- fExtremes::gevFit(x)
39 39
#'   adj_fit <- alogLik(fit)
40 40
#'   summary(adj_fit)
41 41
#'
42 42
#'   # GP
43 43
#'   # An example from the fExtremes::gpdFit documentation
44 44
#'   # Simulate GP data
45 -
#'   x <- gpdSim(model = list(xi = 0.25, mu = 0, beta = 1), n = 1000)
45 +
#'   x <- fExtremes::gpdSim(model = list(xi = 0.25, mu = 0, beta = 1), n = 1000)
46 46
#'   # Fit GP distribution by maximum likelihood estimation
47 -
#'   fit <- gpdFit(x, u = min(x))
47 +
#'   fit <- fExtremes::gpdFit(x, u = min(x))
48 48
#'   adj_fit <- alogLik(fit)
49 49
#'   summary(adj_fit)
50 50
#' }

@@ -0,0 +1,84 @@
Loading
1 +
# =============================== eva::gevrFit ============================== #
2 +
3 +
# Methods for class laxeva_gevr
4 +
5 +
#' @export
6 +
logLikVec.laxeva_rlarg <- function(object, pars = NULL, ...) {
7 +
  if (!missing(...)) {
8 +
    warning("extra arguments discarded")
9 +
  }
10 +
  # If the parameter estimates have not been provided in pars then extract
11 +
  # them from the fitted object
12 +
  if (is.null(pars)) {
13 +
    pars <- coef(object)
14 +
  }
15 +
  n_pars <- length(pars)
16 +
  #
17 +
  # Response data r-column matrix of r-largest order statistics
18 +
  response_data <- object$data
19 +
  # Design matrices for the location, scale and shape parameters
20 +
  mumat <- object$covars[[1]]
21 +
  sigmamat <- object$covars[[2]]
22 +
  ximat <- object$covars[[3]]
23 +
  # Link functions
24 +
  mulink <- object$links[[1]]
25 +
  sigmalink <- object$links[[2]]
26 +
  xilink <- object$links[[3]]
27 +
  # Numbers of parameter estimates for mu, sigma and xi
28 +
  npmu <- object$parnum[1]
29 +
  npsc <- object$parnum[2]
30 +
  npsh <- object$parnum[3]
31 +
  # object$mumat, object$sigmat, object$shmat contain design matrices
32 +
  # Values of mu, sigma, xi for each observation
33 +
  mu <- mulink(mumat %*% (pars[1:npmu]))
34 +
  sigma <- sigmalink(sigmamat %*% (pars[seq(npmu + 1, length = npsc)]))
35 +
  xi <- xilink(ximat %*% (pars[seq(npmu + npsc + 1, length = npsh)]))
36 +
  # Calculate the loglikelihood contributions
37 +
  if (any(sigma <= 0)) {
38 +
    val <- -Inf
39 +
  } else {
40 +
    rlarg_loglik_vec <- function(x, mu, sigma, xi) {
41 +
      logg <- apply(x, 2, revdbayes::dgev, loc = mu, scale = sigma,
42 +
                    shape = xi, log = TRUE)
43 +
      logG <- apply(x, 2, revdbayes::pgev, loc = mu, scale = sigma,
44 +
                    shape = xi, log.p = TRUE)
45 +
      logGmin <- revdbayes::pgev(min_response, loc = mu, scale = sigma,
46 +
                                 shape = xi, log.p = TRUE)
47 +
      loglik <- logGmin + rowSums(logg - logG, na.rm = TRUE)
48 +
      return(loglik)
49 +
    }
50 +
    min_response <- apply(response_data, 1, min, na.rm = TRUE)
51 +
    val <- rlarg_loglik_vec(x = response_data, mu = mu, sigma = sigma, xi = xi)
52 +
  }
53 +
  # Return the usual attributes for a "logLik" object
54 +
  attr(val, "nobs") <- nobs(object)
55 +
  attr(val, "df") <- n_pars
56 +
  class(val) <- "logLikVec"
57 +
  return(val)
58 +
}
59 +
60 +
#' @export
61 +
nobs.laxeva_rlarg <- function(object, ...) {
62 +
  return(object$n)
63 +
}
64 +
65 +
#' @export
66 +
coef.laxeva_rlarg <- function(object, ...) {
67 +
  return(object$par.ests)
68 +
}
69 +
70 +
#' @export
71 +
vcov.laxeva_rlarg <- function(object, ...) {
72 +
  vc <- object$varcov
73 +
  dimnames(vc) <- list(names(coef(object)), names(coef(object)))
74 +
  return(vc)
75 +
}
76 +
77 +
#' @export
78 +
logLik.laxeva_rlarg <- function(object, ...) {
79 +
  val <- -object$nllh.final
80 +
  attr(val, "nobs") <- nobs(object)
81 +
  attr(val, "df") <- length(coef(object))
82 +
  class(val) <- "logLik"
83 +
  return(val)
84 +
}

@@ -13,8 +13,7 @@
Loading
13 13
#' Loglikelihood adjustment for model fits
14 14
#'
15 15
#' This function is generic.  It performs adjustment of the loglikelihood
16 -
#' associated with fitted model objects, following
17 -
#' \href{http://doi.org/10.1093/biomet/asm015}{Chandler and Bate (2007)}.
16 +
#' associated with fitted model objects, following Chandler and Bate (2007).
18 17
#' Certain classes of extreme value model objects are supported automatically.
19 18
#' For details see the \code{alogLik} help pages for the packages:
20 19
#' \code{\link[lax]{evd}},
@@ -119,10 +118,10 @@
Loading
119 118
#'   `nobs`, `plot`, `print`, `summary` and `vcov` methods.
120 119
#' @references Chandler, R. E. and Bate, S. (2007). Inference for clustered
121 120
#'   data using the independence loglikelihood. \emph{Biometrika},
122 -
#'   \strong{94}(1), 167-183. \url{http://doi.org/10.1093/biomet/asm015}
121 +
#'   \strong{94}(1), 167-183. \doi{10.1093/biomet/asm015}
123 122
#' @references Zeleis (2006) Object-Oriented Computation and Sandwich
124 123
#'   Estimators.  \emph{Journal of Statistical Software}, \strong{16}, 1-16.
125 -
#'   \url{http://doi.org/10.18637/jss.v016.i09}
124 +
#'   \doi{10.18637/jss.v016.i09}
126 125
#' @seealso \code{\link[chandwich]{summary.chandwich}},
127 126
#'   \code{\link[chandwich]{plot.chandwich}},
128 127
#'   \code{\link[chandwich]{confint.chandwich}},

@@ -65,7 +65,7 @@
Loading
65 65
#'   \item{call }{The call to \code{return_level}.}
66 66
#' @references Coles, S. G. (2001) \emph{An Introduction to Statistical
67 67
#'   Modeling of Extreme Values}, Springer-Verlag, London.
68 -
#'   \url{https://doi.org/10.1007/978-1-4471-3675-0_3}
68 +
#'   \doi{10.1007/978-1-4471-3675-0_3}
69 69
#' @seealso \code{\link{plot.retlev}} for plotting the profile loglikelihood
70 70
#'   for a return level.
71 71
#' @examples

@@ -41,9 +41,6 @@
Loading
41 41
#'   set.seed(1112019)
42 42
#'   x <- revdbayes::rgp(365 * 10, loc = 0, scale = 1, shape = 0.1)
43 43
#'   pfit <- fit.pp(x, threshold = 1, npp = 365)
44 -
#'   # (To do: delete the next two lines after new mev hits CRAN)
45 -
#'   pfit$xdat <- x
46 -
#'   pfit$npp <- 365
47 44
#'   adj_pfit <- alogLik(pfit)
48 45
#'   summary(adj_pfit)
49 46
#'

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 4 files with coverage changes found.

New file R/eva_gpd.R
New
Loading file...
New file R/eva_gevr.R
New
Loading file...
New file R/eva.R
New
Loading file...
Changes in R/lax-internal.R
-1
+1
Loading file...

31 Commits

Hiding 29 contexual commits
+3 Files
+121
+113
+8
Files Coverage
R 0.33% 87.64%
Project Totals (45 files) 87.64%
Loading