R/ddst.evd.test.R

Defines functions `ddst.extr.Nk` `ddst.evd.test`

#' Data Driven Smooth Test for Extreme Value Distribution
#'
#' Performs data driven smooth test for composite hypothesis of extreme value distribution.
#' Null density is given by
#' \eqn{
#'   f(z;\gamma)=1/\gamma_2 \exp((z-\gamma_1)/\gamma_2- \exp((z-\gamma_1)/\gamma_2))}, \eqn{z \in R}.
#'
#'   We model alternatives similarly as in Kallenberg and Ledwina (1997) and Janic-Wroblewska (2004) using Legendre's polynomials or cosines.
#'   For more details see: \url{http://www.biecek.pl/R/ddst/description.pdf}.
#'
#' @aliases ddst.extr.Nk
#'
#' @param x a (non-empty) numeric vector of data values
#' @param base a function which returns an orthonormal system, possible choice: \code{ddst.base.legendre} for the Legendre polynomials and \code{ddst.base.cos} for the cosine system
#' @param d.n an integer specifying the maximum dimension considered, only for advanced users
#' @param c a calibrating parameter in the penalty in the model selection rule
#' @param nr an integer specifying the number of runs for a p-value and a critical value computation if any
#' @param compute.p a logical value indicating whether to compute a p-value or not
#' @param alpha a significance level
#' @param compute.cv a logical value indicating whether to compute a critical value corresponding to the significance level alpha or not
#' @param ... further arguments
#'
#' @return
#'   An object of class \code{htest}
#'   \item{statistic }{the value of the test statistic.}
#'   \item{parameter }{the number of choosen coordinates (k).}
#'   \item{method }{a character string indicating the parameters of performed test. }
#'   \item{data.name }{a character string giving the name(s) of the data. }
#'   \item{p.value }{the p-value for the test, computed only if \code{compute.p=TRUE}.}
#'
#' @importFrom evd pgumbel
#' @importFrom orthopolynom slegendre.polynomials
#' @importFrom polynom polynomial
#' @references
#' Hosking, J.R.M., Wallis, J.R., Wood, E.F. (1985). Estimation of the generalized extreme-value distribution by the method of probability-weighted moments. \eqn{ Technometrics} 27, 251--261.
#'
#' Janic-Wroblewska, A. (2004). Data-driven smooth test for extreme  value distribution. \eqn{ Statistics} 38, 413--426.
#'
#' Janic, A. and Ledwina, T. (2008). Data-driven tests for a location-scale family revisited. \eqn{ J. Statist. Theory. Pract. Special issue on Modern Goodness of Fit Methods. accepted.}.
#'
#' Kallenberg, W.C.M., Ledwina, T. (1997). Data driven smooth tests for composite hypotheses: Comparison of powers. \eqn{ J. Statist. Comput. Simul.} \bold{ 59}, 101--121.
#'
#' @export
#'
#' @examples
#' library(evd)
#' set.seed(7)
#'
#' # for given vector of 19 numbers
#' z <- c(13.41, 6.04, 1.26, 3.67, -4.54, 2.92, 0.44, 12.93, 6.77, 10.09,
#'       4.10, 4.04, -1.97, 2.17, -5.38, -7.30, 4.75, 5.63, 8.84)
#' \dontrun{
#' t <- ddst.evd.test(z, compute.p = TRUE, d.n = 10)
#' t
#' plot(t)
#'
#' # H0 is true
#' x <- -qgumbel(runif(100),-1,1)
#' t <- ddst.evd.test (x, compute.p = TRUE, d.n = 10)
#' t
#' plot(t)
#'
#' # H0 is false
#' x <- rexp(80,4)
#' t <- ddst.evd.test (x, compute.p = TRUE, d.n = 10)
#' t
#' plot(t)
#' }
#' @keywords htest
`ddst.evd.test` <-
  function(x,
           base = ddst.base.legendre,
           d.n = 10,
           c = 100,
           nr = 100000,
           compute.p = TRUE,
           alpha = 0.05,
           compute.cv = TRUE,
           ...) {
    # method.name = as.character(substitute(base))
    base = ddst.base.legendre
    method.name = "ddst.base.legendre"

    n   = length(x)
    if (n < 5)
      stop("length(x) should be at least 5")
    sx  = sort(x)
    er2 = sum(sx * (1:n - n:1)) / (n * (n - 1) * log(2))
    er1 = mean(x) + 0.5772156649 * er2
    maxN = max(min(d.n, length(x) - 2, 20), 1)

    u = NULL
    for (j in 1:maxN)
      u[j] = ddst.phi(1 - pgumbel(-x, -er1, er2), j, base)
    coord = NULL
    gg1 = mean(1 - exp((x - er1) / er2))
    gg2 = mean((1 - exp((x - er1) / er2)) * (x - er1) / er2 + 1)
    for (k in 1:d.n) {
      korekta = u[1:k] + t(MMextr12[[k]]) %*% sM22 %*% c(gg1, gg2)
      coord[k] = t(korekta) %*% MMextr[[k]] %*% korekta * n
    }

    l = ddst.IIC(coord, n, c)
    attr(l, "names") = "T*"
    t = coord[l]
    attr(t, "names") = "W*T*"
    result = list(statistic = t,
                  parameter = l,
                  coordinates = coord - c(0, coord[-d.n]),
                  method = "Data Driven Smooth Test for Extreme Values")
    result$data.name = paste(paste(as.character(substitute(x)), collapse = ""),
                             ", base: ",
                             method.name,
                             ", c: ",
                             c,
                             ", d.n: ",
                             d.n,
                             sep = "")
    class(result) = c("htest", "ddst.test")
    if (compute.p | compute.cv) {
      tmp = numeric(nr)
      for (i in 1:nr) {
        y = rnorm(n)
        tmpC = ddst.extr.Nk(y, base, Dmax = d.n, n = length(y))
        l = ddst.IIC(tmpC, n, c)
        tmp[i] = tmpC[l]
      }
      p.val = mean(tmp > t)
      if (compute.p) {
        result$p.value = mean(tmp > t)
      }
      if (compute.cv) {
        result$cv = quantile(tmp, alpha)
      }
    }
    result
  }


`MMextr12` <-
  list(
    structure(c(0.866025403784439,-0.234141092407759), .Dim = c(2L,
                                                                1L)),
    structure(
      c(
        0.866025403784439,
        -0.234141092407759,
        0.372677996249965,
        1.10810510880576
      ),
      .Dim = c(2L, 2L)
    ),
    structure(
      c(
        0.866025403784439,-0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248
      ),
      .Dim = 2:3
    ),
    structure(
      c(
        0.866025403784439,-0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248,
        0.15,
        0.489380181546808
      ),
      .Dim = c(2L, 4L)
    ),
    structure(
      c(
        0.866025403784439,
        -0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248,
        0.15,
        0.489380181546808,
        0.110554159678513,
        0.142331828329152
      ),
      .Dim = c(2L,
               5L)
    ),
    structure(
      c(
        0.866025403784439,
        -0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248,
        0.15,
        0.489380181546808,
        0.110554159678513,
        0.142331828329152,
        0.0858464589396188,
        0.294178041927853
      ),
      .Dim = c(2L, 6L)
    ),
    structure(
      c(
        0.866025403784439,
        -0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248,
        0.15,
        0.489380181546808,
        0.110554159678513,
        0.142331828329152,
        0.0858464589396188,
        0.294178041927853,
        0.069160416896561,
        0.100333337378287
      ),
      .Dim = c(2L, 7L)
    ),
    structure(
      c(
        0.866025403784439,-0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248,
        0.15,
        0.489380181546808,
        0.110554159678513,
        0.142331828329152,
        0.0858464589396188,
        0.294178041927853,
        0.069160416896561,
        0.100333337378287,
        0.0572653559113564,
        0.202528656207688
      ),
      .Dim = c(2L, 8L)
    ),
    structure(
      c(
        0.866025403784439,
        -0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248,
        0.15,
        0.489380181546808,
        0.110554159678513,
        0.142331828329152,
        0.0858464589396188,
        0.294178041927853,
        0.069160416896561,
        0.100333337378287,
        0.0572653559113564,
        0.202528656207688,
        0.0484322104837853,
        0.0754369796383129
      ),
      .Dim = c(2L, 9L)
    ),
    structure(
      c(
        0.866025403784439,
        -0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248,
        0.15,
        0.489380181546808,
        0.110554159678513,
        0.142331828329152,
        0.0858464589396188,
        0.294178041927853,
        0.069160416896561,
        0.100333337378287,
        0.0572653559113564,
        0.202528656207688,
        0.0484322104837853,
        0.0754369796383129,
        0.0416597790450531,
        0.150701656278937
      ),
      .Dim = c(2L, 10L)
    ),
    structure(
      c(
        0.866025403784439,-0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248,
        0.15,
        0.489380181546808,
        0.110554159678513,
        0.142331828329152,
        0.0858464589396188,
        0.294178041927853,
        0.069160416896561,
        0.100333337378287,
        0.0572653559113564,
        0.202528656207688,
        0.0484322104837853,
        0.0754369796383129,
        0.0416597790450531,
        0.150701656278937,
        0.0363320569947933,
        0.0594232320521485
      ),
      .Dim = c(2L, 11L)
    ),
    structure(
      c(
        0.866025403784439,
        -0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248,
        0.15,
        0.489380181546808,
        0.110554159678513,
        0.142331828329152,
        0.0858464589396188,
        0.294178041927853,
        0.069160416896561,
        0.100333337378287,
        0.0572653559113564,
        0.202528656207688,
        0.0484322104837853,
        0.0754369796383129,
        0.0416597790450531,
        0.150701656278937,
        0.0363320569947933,
        0.0594232320521485,
        0.0320512820512820,
        0.117963013416300
      ),
      .Dim = c(2L, 12L)
    ),
    structure(
      c(
        0.866025403784439,
        -0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248,
        0.15,
        0.489380181546808,
        0.110554159678513,
        0.142331828329152,
        0.0858464589396188,
        0.294178041927853,
        0.069160416896561,
        0.100333337378287,
        0.0572653559113564,
        0.202528656207688,
        0.0484322104837853,
        0.0754369796383129,
        0.0416597790450531,
        0.150701656278937,
        0.0363320569947933,
        0.0594232320521485,
        0.0320512820512820,
        0.117963013416300,
        0.0285502880368496,
        0.0484291463698838
      ),
      .Dim = c(2L, 13L)
    ),
    structure(
      c(
        0.866025403784439,-0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248,
        0.15,
        0.489380181546808,
        0.110554159678513,
        0.142331828329152,
        0.0858464589396188,
        0.294178041927853,
        0.069160416896561,
        0.100333337378287,
        0.0572653559113564,
        0.202528656207688,
        0.0484322104837853,
        0.0754369796383129,
        0.0416597790450531,
        0.150701656278937,
        0.0363320569947933,
        0.0594232320521485,
        0.0320512820512820,
        0.117963013416300,
        0.0285502880368496,
        0.0484291463698838,
        0.0256436419387357,
        0.0956922480067001
      ),
      .Dim = c(2L, 14L)
    ),
    structure(
      c(
        0.866025403784439,
        -0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248,
        0.15,
        0.489380181546808,
        0.110554159678513,
        0.142331828329152,
        0.0858464589396188,
        0.294178041927853,
        0.069160416896561,
        0.100333337378287,
        0.0572653559113564,
        0.202528656207688,
        0.0484322104837853,
        0.0754369796383129,
        0.0416597790450531,
        0.150701656278937,
        0.0363320569947933,
        0.0594232320521485,
        0.0320512820512820,
        0.117963013416300,
        0.0285502880368496,
        0.0484291463698838,
        0.0256436419387357,
        0.0956922480067001,
        0.0231990181784584,
        0.0404954537147379
      ),
      .Dim = c(2L, 15L)
    ),
    structure(
      c(
        0.866025403784439,
        -0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248,
        0.15,
        0.489380181546808,
        0.110554159678513,
        0.142331828329152,
        0.0858464589396188,
        0.294178041927853,
        0.069160416896561,
        0.100333337378287,
        0.0572653559113564,
        0.202528656207688,
        0.0484322104837853,
        0.0754369796383129,
        0.0416597790450531,
        0.150701656278937,
        0.0363320569947933,
        0.0594232320521485,
        0.0320512820512820,
        0.117963013416300,
        0.0285502880368496,
        0.0484291463698838,
        0.0256436419387357,
        0.0956922480067001,
        0.0231990181784584,
        0.0404954537147379,
        0.0211197156122722,
        0.0797299850375612
      ),
      .Dim = c(2L, 16L)
    ),
    structure(
      c(
        0.866025403784439,-0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248,
        0.15,
        0.489380181546808,
        0.110554159678513,
        0.142331828329152,
        0.0858464589396188,
        0.294178041927853,
        0.069160416896561,
        0.100333337378287,
        0.0572653559113564,
        0.202528656207688,
        0.0484322104837853,
        0.0754369796383129,
        0.0416597790450531,
        0.150701656278937,
        0.0363320569947933,
        0.0594232320521485,
        0.0320512820512820,
        0.117963013416300,
        0.0285502880368496,
        0.0484291463698838,
        0.0256436419387357,
        0.0956922480067001,
        0.0231990181784584,
        0.0404954537147379,
        0.0211197156122722,
        0.0797299850375612,
        0.0193335940624170,
        0.0345719293822885
      ),
      .Dim = c(2L, 17L)
    ),
    structure(
      c(
        0.866025403784439,
        -0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248,
        0.15,
        0.489380181546808,
        0.110554159678513,
        0.142331828329152,
        0.0858464589396188,
        0.294178041927853,
        0.069160416896561,
        0.100333337378287,
        0.0572653559113564,
        0.202528656207688,
        0.0484322104837853,
        0.0754369796383129,
        0.0416597790450531,
        0.150701656278937,
        0.0363320569947933,
        0.0594232320521485,
        0.0320512820512820,
        0.117963013416300,
        0.0285502880368496,
        0.0484291463698838,
        0.0256436419387357,
        0.0956922480067001,
        0.0231990181784584,
        0.0404954537147379,
        0.0211197156122722,
        0.0797299850375612,
        0.0193335940624170,
        0.0345719293822885,
        0.0177858553517492,
        0.0680306326567245
      ),
      .Dim = c(2L, 18L)
    ),
    structure(
      c(
        0.866025403784439,
        -0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248,
        0.15,
        0.489380181546808,
        0.110554159678513,
        0.142331828329152,
        0.0858464589396188,
        0.294178041927853,
        0.069160416896561,
        0.100333337378287,
        0.0572653559113564,
        0.202528656207688,
        0.0484322104837853,
        0.0754369796383129,
        0.0416597790450531,
        0.150701656278937,
        0.0363320569947933,
        0.0594232320521485,
        0.0320512820512820,
        0.117963013416300,
        0.0285502880368496,
        0.0484291463698838,
        0.0256436419387357,
        0.0956922480067001,
        0.0231990181784584,
        0.0404954537147379,
        0.0211197156122722,
        0.0797299850375612,
        0.0193335940624170,
        0.0345719293822885,
        0.0177858553517492,
        0.0680306326567245,
        0.0164342052589432,
        0.0305267178695429
      ),
      .Dim = c(2L, 19L)
    ),
    structure(
      c(
        0.866025403784439,-0.234141092407759,
        0.372677996249965,
        1.10810510880576,
        0.220479275922049,
        0.215016389907248,
        0.15,
        0.489380181546808,
        0.110554159678513,
        0.142331828329152,
        0.0858464589396188,
        0.294178041927853,
        0.069160416896561,
        0.100333337378287,
        0.0572653559113564,
        0.202528656207688,
        0.0484322104837853,
        0.0754369796383129,
        0.0416597790450531,
        0.150701656278937,
        0.0363320569947933,
        0.0594232320521485,
        0.0320512820512820,
        0.117963013416300,
        0.0285502880368496,
        0.0484291463698838,
        0.0256436419387357,
        0.0956922480067001,
        0.0231990181784584,
        0.0404954537147379,
        0.0211197156122722,
        0.0797299850375612,
        0.0193335940624170,
        0.0345719293822885,
        0.0177858553517492,
        0.0680306326567245,
        0.0164342052589432,
        0.0305267178695429,
        0.0152455338986496,
        0.0615566914608176
      ),
      .Dim = c(2L, 20L)
    )
  )
`MMextr` <-
  list(
    structure(32.3209404708014, .Dim = c(1L, 1L)),
    structure(
      c(
        34.3970537843995,-2.66186048577395,
        -2.66186048577395,
        3.41286826654214
      ),
      .Dim = c(2L,
               2L)
    ),
    structure(
      c(
        122.44648288656,
        -0.177860727429421,
        19.0055823736559,-0.177860727429428,
        3.48294543640426,
        0.536174538605836,
        19.0055823736559,
        0.536174538605838,
        4.10237936855581
      ),
      .Dim = c(3L, 3L)
    ),
    structure(
      c(
        130.209043428429,-4.51451571759888,
        19.2377674248368,
        -3.97418625924684,
        -4.51451571759888,
        5.90567391656528,
        0.406461352419979,
        2.22023062880676,
        19.2377674248368,
        0.406461352419978,
        4.10932422878602,
        -0.118871425868910,
        -3.97418625924684,
        2.22023062880676,
        -0.118871425868908,
        2.03465806649702
      ),
      .Dim = c(4L,
               4L)
    ),
    structure(
      c(
        281.015537230139,
        3.08029658576524,
        44.6135396937781,-2.97344456375853,
        19.0177199641021,
        3.08029658576527,
        6.28815859921544,
        1.68441843886300,
        2.27062928969849,
        0.957757255169728,
        44.6135396937781,
        1.684418438863,
        8.37923198946806,
        0.0495204830241909,
        3.20005669993291,-2.97344456375852,
        2.27062928969849,
        0.0495204830241905,
        2.04129892071915,
        0.126200303723139,
        19.0177199641021,
        0.957757255169724,
        3.20005669993290,
        0.126200303723138,
        2.39826325455559
      ),
      .Dim = c(5L, 5L)
    ),
    structure(
      c(
        296.630711253731,-3.76147597987010,
        45.5081153807952,
        -6.21381817139198,
        19.0790606375848,-5.08407622736899,
        -3.76147597987012,
        9.28587426790755,
        1.29246101436860,
        3.69039567959708,
        0.930880901671609,
        2.22758281153032,
        45.5081153807952,
        1.29246101436860,
        8.43048122041436,
        -0.136116861898231,
        3.20357083785028,-0.291260986081566,
        -6.21381817139199,
        3.69039567959708,
        -0.136116861898234,
        2.71372313457567,
        0.113471230122805,
        1.05501907320863,
        19.0790606375848,
        0.930880901671611,
        3.20357083785028,
        0.113471230122806,
        2.39850421749443,-0.0199716416450984,
        -5.08407622736899,
        2.22758281153032,
        -0.291260986081566,
        1.05501907320863,
        -0.0199716416450986,
        1.65530214691452
      ),
      .Dim = c(6L,
               6L)
    ),
    structure(
      c(
        512.313849849907,
        9.8270826615388,
        82.4198846430386,-3.58734355413421,
        35.325426722725,
        -4.50507317114052,
        20.1350606258432,
        9.8270826615388,
        10.1419862808949,
        3.61799162581456,
        3.85586992384758,
        1.95444120265120,
        2.26406140245924,
        1.26855744887350,
        82.4198846430386,
        3.61799162581456,
        14.7475198120127,
        0.31337504403547,
        5.9839556198402,-0.192171055581001,
        3.44589158308727,
        -3.58734355413420,
        3.85586992384758,
        0.313375044035469,
        2.74570694638404,
        0.311310840687776,
        1.06206986466315,
        0.245194065678628,
        35.325426722725,
        1.95444120265120,
        5.9839556198402,
        0.311310840687776,
        3.62226427908448,
        0.0236418539537150,
        1.51667658493421,-4.50507317114052,
        2.26406140245924,
        -0.192171055581001,
        1.06206986466315,
        0.0236418539537147,
        1.65685648510389,
        0.0540527262148954,
        20.1350606258432,
        1.26855744887349,
        3.44589158308726,
        0.245194065678627,
        1.51667658493421,
        0.0540527262148952,
        1.87970496463079
      ),
      .Dim = c(7L, 7L)
    ),
    structure(
      c(
        537.174461265744,
        0.512782902530479,
        84.20268600263,
        -8.05436983232551,
        35.6479469866289,-7.29503636643204,
        20.1498606421399,
        -6.06457494052765,
        0.512782902530449,
        13.6316904780056,
        2.95004561289220,
        5.52949013738349,
        1.83360546107918,
        3.30935160400959,
        1.26301246102393,
        2.27215927887482,
        84.20268600263,
        2.9500456128922,
        14.8753678618693,
        -0.00696384018943662,
        6.00708415659915,-0.392244581311429,
        3.44695292018524,
        -0.434902113567518,
        -8.05436983232552,
        5.52949013738349,
        -0.00696384018943565,
        3.54835509675595,
        0.253359470545891,
        1.56337848897983,
        0.242534756114088,
        1.08970029627342,
        35.6479469866288,
        1.83360546107917,
        6.00708415659915,
        0.25335947054589,
        3.62644838054873,-0.0125527372001168,
        1.51686858766016,
        -0.0786765971912042,
        -7.29503636643205,
        3.30935160400959,
        -0.392244581311428,
        1.56337848897983,
        -0.0125527372001164,
        1.96995798131718,
        0.0523918056498745,
        0.680592307088952,
        20.1498606421399,
        1.26301246102393,
        3.44695292018524,
        0.242534756114088,
        1.51686858766016,
        0.0523918056498743,
        1.87971377537474,
        -0.0036103620484587,
        -6.06457494052766,
        2.27215927887482,
        -0.434902113567518,
        1.08970029627342,
        -0.078676597191204,
        0.680592307088952,
        -0.00361036204845865,
        1.47941129017510
      ),
      .Dim = c(8L,
               8L)
    ),
    structure(
      c(
        819.143661337148,
        20.6552663424948,
        132.998745280787,-3.57835751069945,
        57.2260677899828,
        -5.91381020282217,
        32.703279767742,-5.66993879870671,
        21.4830243288986,
        20.6552663424948,
        15.0705697564038,
        6.43579446665671,
        5.84923429398857,
        3.37503956394234,
        3.40801956178766,
        2.15976656320369,
        2.30035013074599,
        1.53464088161272,
        132.998745280787,
        6.43579446665671,
        23.3197490229125,
        0.767630557072814,
        9.74127662004923,-0.153217078523954,
        5.61937949600029,
        -0.366608524889314,
        3.71773558375014,-3.57835751069946,
        5.84923429398857,
        0.767630557072808,
        3.61940784400026,
        0.595893103896238,
        1.58530423592562,
        0.441809211162737,
        1.09596479691003,
        0.34102406070451,
        57.2260677899828,
        3.37503956394235,
        9.74127662004923,
        0.59589310389624,
        5.27774681061211,
        0.093147690391196,
        2.47753803070139,-0.0484764677464773,
        1.64402102808739,
        -5.91381020282216,
        3.40801956178767,-0.153217078523954,
        1.58530423592562,
        0.0931476903911958,
        1.97672391786116,
        0.113884730886574,
        0.682525432281534,
        0.105234597498713,
        32.703279767742,
        2.15976656320369,
        5.61937949600029,
        0.441809211162737,
        2.47753803070139,
        0.113884730886574,
        2.43859868799330,
        0.0139590493948294,
        0.956435697295593,-5.66993879870671,
        2.30035013074599,
        -0.366608524889314,
        1.09596479691003,-0.0484764677464775,
        0.682525432281534,
        0.0139590493948297,
        1.47996361179176,
        0.0300670351004980,
        21.4830243288986,
        1.53464088161272,
        3.71773558375014,
        0.341024060704510,
        1.64402102808739,
        0.105234597498713,
        0.956435697295593,
        0.0300670351004979,
        1.63677569819399
      ),
      .Dim = c(9L, 9L)
    ),
    structure(
      c(
        854.250474615544,
        8.91493970168793,
        135.837282178762,
        -9.26710489293656,
        57.8827925389345,-9.48270773821005,
        32.8632945092877,
        -8.19037659798335,
        21.4801537258390,-6.95559236414534,
        8.91493970168783,
        18.9967384046347,
        5.48653854587784,
        7.75164998506586,
        3.15541942910870,
        4.60152073436018,
        2.10625486112516,
        3.14322820135604,
        1.53560086101374,
        2.32607060310064,
        135.837282178762,
        5.48653854587783,
        23.549256943705,
        0.307670855812477,
        9.7943756415108,-0.441777799172487,
        5.63231737630568,
        -0.570396764954333,
        3.71750348314227,-0.562389568552582,
        -9.26710489293657,
        7.75164998506586,
        0.307670855812478,
        4.5412188475311,
        0.489476689315478,
        2.16361239368755,
        0.41588024304865,
        1.50437936359351,
        0.341489216442637,
        1.12709198467218,
        57.8827925389345,
        3.15541942910871,
        9.7943756415108,
        0.489476689315479,
        5.29003181615983,
        0.0263861954251879,
        2.48053134257331,
        -0.0956249761528032,
        1.64396732922109,-0.130114619430786,
        -9.48270773821007,
        4.60152073436018,
        -0.441777799172486,
        2.16361239368755,
        0.0263861954251878,
        2.33953182973571,
        0.0976179107626083,
        0.938748752199806,
        0.105526418009594,
        0.707093413712111,
        32.8632945092876,
        2.10625486112515,
        5.63231737630568,
        0.415880243048649,
        2.48053134257331,
        0.0976179107626074,
        2.43932802555265,
        0.00247104563233753,
        0.956422613259673,-0.0317031712794379,
        -8.19037659798336,
        3.14322820135604,
        -0.570396764954334,
        1.50437936359351,
        -0.095624976152804,
        0.938748752199806,
        0.00247104563233791,
        1.66091443320781,
        0.0302731254796505,
        0.499365686425022,
        21.4801537258390,
        1.53560086101374,
        3.71750348314227,
        0.341489216442637,
        1.64396732922109,
        0.105526418009594,
        0.956422613259674,
        0.030273125479651,
        1.63677593291659,
        0.000568742727152438,
        -6.95559236414535,
        2.32607060310064,
        -0.562389568552583,
        1.12709198467218,
        -0.130114619430787,
        0.707093413712111,
        -0.0317031712794377,
        0.499365686425022,
        0.00056874272715208,
        1.37808763081201
      ),
      .Dim = c(10L,
               10L)
    ),
    structure(
      c(
        1203.57808384091,
        36.0200044219273,
        196.778640962872,-2.77896868179259,
        84.922037294422,
        -7.20682480616153,
        48.627329204544,-7.31357854683658,
        31.9920469792315,
        -6.6607108350063,
        22.870799165159,
        36.0200044219273,
        21.099877446858,
        10.215106887915,
        8.25507813466665,
        5.25345136168079,
        4.77811128300207,
        3.32941950480884,
        3.21126080827084,
        2.35124079167159,
        2.34895108182903,
        1.77459346242315,
        196.778640962872,
        10.2151068879150,
        34.1806788879622,
        1.43954771364311,
        14.5114614726293,-0.0447424814655483,
        8.38240545660101,
        -0.417436440018575,
        5.55133808807313,-0.510946508824441,
        3.98988668743918,
        -2.77896868179257,
        8.25507813466666,
        1.43954771364311,
        4.66172438554944,
        0.991682350668981,
        2.20588285291777,
        0.708669022517945,
        1.52066432085218,
        0.536728852428624,
        1.13256888222244,
        0.424784232114743,
        84.9220372944221,
        5.25345136168079,
        14.5114614726293,
        0.991682350668983,
        7.38296904081382,
        0.202547924442134,
        3.70072574233528,-0.0277575746649424,
        2.457626619285,
        -0.107289701990266,
        1.77028416892570,-7.20682480616153,
        4.77811128300208,
        -0.0447424814655465,
        2.20588285291777,
        0.202547924442135,
        2.35435929536855,
        0.200321208628792,
        0.94446112553292,
        0.174011810538296,
        0.709014578319263,
        0.149004144212143,
        48.627329204544,
        3.32941950480884,
        8.38240545660101,
        0.708669022517945,
        3.70072574233528,
        0.200321208628791,
        3.15070835539346,
        0.0420381297504842,
        1.43079064367894,-0.0183961135674913,
        1.03208581865971,
        -7.31357854683657,
        3.21126080827085,-0.417436440018575,
        1.52066432085218,
        -0.0277575746649426,
        0.94446112553292,
        0.042038129750484,
        1.66311516055427,
        0.0566575487975668,
        0.500105827035844,
        0.0574047730743405,
        31.9920469792315,
        2.35124079167159,
        5.55133808807313,
        0.536728852428625,
        2.457626619285,
        0.174011810538296,
        1.43079064367894,
        0.0566575487975672,
        1.95309762307945,
        0.00944225594181252,
        0.68822329840189,-6.6607108350063,
        2.34895108182903,
        -0.510946508824439,
        1.13256888222244,-0.107289701990266,
        0.709014578319263,
        -0.0183961135674909,
        0.500105827035844,
        0.00944225594181244,
        1.37833655220823,
        0.0193061643349974,
        22.870799165159,
        1.77459346242315,
        3.98988668743918,
        0.424784232114743,
        1.77028416892570,
        0.149004144212142,
        1.03208581865971,
        0.0574047730743405,
        0.68822329840189,
        0.0193061643349973,
        1.49737221061044
      ),
      .Dim = c(11L, 11L)
    ),
    structure(
      c(
        1249.70436071525,
        21.9003426666617,
        200.804788373757,
        -9.68090876399071,
        85.9709240121947,-11.5531126741251,
        48.9661431851002,
        -10.3896546121603,
        32.0839031494598,-8.99306559675041,
        22.8600930841128,
        -7.7799950077724,
        21.9003426666617,
        25.4220309262249,
        8.98266751775889,
        10.3678231038963,
        4.93237785048112,
        6.1085484816021,
        3.22570554548602,
        4.15287492757390,
        2.32312280466547,
        3.06290552516656,
        1.77787068862289,
        2.38152535628331,
        200.804788373757,
        8.9826675177589,
        34.5321025031461,
        0.837109579132873,
        14.6030138984746,-0.42410966287207,
        8.41197894752667,
        -0.685932761970815,
        5.55935578442738,-0.714526869555919,
        3.98895220359587,
        -0.679079450583789,
        -9.68090876399072,
        10.3678231038963,
        0.837109579132868,
        5.69447144701172,
        0.834735946803918,
        2.85622405705055,
        0.657971807149744,
        1.98094193547416,
        0.522984283690966,
        1.48156242574682,
        0.426386198171642,
        1.16413166251499,
        85.9709240121947,
        4.93237785048112,
        14.6030138984746,
        0.834735946803916,
        7.40682016041985,
        0.103715676854459,
        3.70843018995334,
        -0.0977058893008538,
        2.45971537917246,-0.16032619434367,
        1.77004071840306,
        -0.176912900433233,
        -11.5531126741251,
        6.1085484816021,
        -0.424109662872071,
        2.85622405705055,
        0.103715676854459,
        2.76389198500314,
        0.168396171686993,
        1.23430702226661,
        0.165356584378207,
        0.928782699478418,
        0.150012933850292,
        0.73307668007026,
        48.9661431851002,
        3.22570554548603,
        8.41197894752667,
        0.657971807149744,
        3.70843018995334,
        0.168396171686993,
        3.15319706510936,
        0.0194432522355649,
        1.43146536006143,-0.0355280924405143,
        1.03200717867002,
        -0.0571468424493999,
        -10.3896546121603,
        4.15287492757391,
        -0.685932761970816,
        1.98094193547416,
        -0.0977058893008535,
        1.23430702226661,
        0.0194432522355648,
        1.86825298222198,
        0.0505318307503938,
        0.655646250946056,
        0.0581187418116032,
        0.518833473096149,
        32.0839031494598,
        2.32312280466547,
        5.55935578442738,
        0.522984283690965,
        2.45971537917246,
        0.165356584378207,
        1.43146536006143,
        0.0505318307503936,
        1.95328054605911,
        0.00479758937537752,
        0.688201978241848,
        -0.0154931330741029,-8.99306559675042,
        3.06290552516656,
        -0.71452686955592,
        1.48156242574682,-0.160326194343670,
        0.928782699478418,
        -0.0355280924405141,
        0.655646250946056,
        0.00479758937537755,
        1.49627103778231,
        0.0198475125815083,
        0.393392001962976,
        22.8600930841128,
        1.77787068862289,
        3.98895220359587,
        0.426386198171643,
        1.77004071840306,
        0.150012933850292,
        1.03200717867002,
        0.0581187418116036,
        0.688201978241848,
        0.0198475125815084,
        1.49737469553178,
        0.00180576588276177,-7.77999500777241,
        2.38152535628331,
        -0.67907945058379,
        1.16413166251499,-0.176912900433233,
        0.733076680070259,
        -0.0571468424494,
        0.518833473096149,-0.0154931330741029,
        0.393392001962976,
        0.00180576588276152,
        1.3122308242166
      ),
      .Dim = c(12L, 12L)
    ),
    structure(
      c(
        1667.25617406901,
        56.288946492654,
        274.10014017619,
        -1.05331789738936,
        118.574463240461,-8.31030248037923,
        68.0048525590383,
        -8.98275406451293,
        44.7945139161181,-8.37398691744668,
        32.0545937572277,
        -7.54643154813351,
        24.2414993669381,
        56.2889464926538,
        28.2541969838992,
        15.0191035594941,
        11.0783715790693,
        7.6175301070134,
        6.3756188462112,
        4.79368971674345,
        4.26874401018427,
        3.36993937703337,
        3.11389141663877,
        2.53510854728756,
        2.40076110385970,
        1.99647394938093,
        274.10014017619,
        15.0191035594941,
        47.3980712860211,
        2.35156188792749,
        20.3261069406201,
        0.145120086293785,
        11.7539567735092,-0.438971145967781,
        7.79052484649704,
        -0.6058563090607,
        5.60291756054354,-0.638080668169405,
        4.25525447979026,
        -1.05331789738939,
        11.0783715790693,
        2.35156188792748,
        5.87273752509093,
        1.50840083884532,
        2.92322805203970,
        1.05135578933663,
        2.01001177046684,
        0.785615041963906,
        1.4943540300183,
        0.61636595036856,
        1.16895762639947,
        0.500885714879348,
        118.574463240461,
        7.6175301070134,
        20.3261069406201,
        1.50840083884532,
        9.95258989776372,
        0.356922790272102,
        5.19502248359723,
        0.0121485903793083,
        3.45219315915723,-0.111986909587747,
        2.4879714129735,
        -0.158675653760872,
        1.89283976331893,-8.31030248037926,
        6.3756188462112,
        0.145120086293781,
        2.92322805203970,
        0.356922790272102,
        2.78907644742515,
        0.316255476470469,
        1.24523335833218,
        0.264070317248363,
        0.933590616933853,
        0.221419689983612,
        0.734890591406715,
        0.188265452920355,
        68.0048525590383,
        4.79368971674346,
        11.7539567735092,
        1.05135578933663,
        5.19502248359723,
        0.316255476470471,
        4.02128682794359,
        0.0835923465229277,
        2.01101888279185,
        -0.00730055593385933,
        1.45124000332931,-0.0464972734947861,
        1.10531638583641,
        -8.98275406451294,
        4.26874401018426,-0.438971145967785,
        2.01001177046684,
        0.0121485903793072,
        1.24523335833218,
        0.083592346522926,
        1.87299339787260,
        0.0933590073465376,
        0.657732176824213,
        0.0890987246991117,
        0.519620442638047,
        0.0816793931780217,
        44.7945139161181,
        3.36993937703337,
        7.79052484649704,
        0.785615041963907,
        3.45219315915723,
        0.264070317248363,
        2.01101888279185,
        0.0933590073465384,
        2.34020169187774,
        0.0236428389346184,
        0.96808992391034,
        -0.00838327477666626,
        0.737930606452137,-8.37398691744668,
        3.11389141663877,
        -0.605856309060702,
        1.4943540300183,-0.111986909587747,
        0.933590616933854,
        -0.00730055593386019,
        0.657732176824214,
        0.0236428389346183,
        1.49718890808945,
        0.0334796395452239,
        0.39373829229989,
        0.0359413968098299,
        32.0545937572277,
        2.53510854728756,
        5.60291756054354,
        0.61636595036856,
        2.4879714129735,
        0.221419689983613,
        1.45124000332931,
        0.0890987246991124,
        0.96808992391034,
        0.0334796395452240,
        1.69983781489628,
        0.00694883871392815,
        0.533798381705934,
        -7.54643154813352,
        2.40076110385969,
        -0.638080668169408,
        1.16895762639947,
        -0.158675653760873,
        0.734890591406715,
        -0.0464972734947870,
        0.519620442638048,
        -0.00838327477666646,
        0.39373829229989,
        0.00694883871392789,
        1.31236147121161,
        0.0135598224648768,
        24.2414993669381,
        1.99647394938094,
        4.25525447979026,
        0.500885714879348,
        1.89283976331893,
        0.188265452920356,
        1.10531638583641,
        0.0816793931780223,
        0.737930606452138,
        0.0359413968098300,
        0.533798381705934,
        0.0135598224648771,
        1.40737094837924
      ),
      .Dim = c(13L, 13L)
    ),
    structure(
      c(
        1725.02315628199,
        39.8345950081936,
        279.421467469139,
        -9.15847199029239,
        120.063091425293,-13.4308674399428,
        68.5501500778068,
        -12.6135507804251,
        44.9995305604056,-11.1303350892035,
        32.1115643512323,
        -9.73606687615795,
        24.2270262199865,-8.55173420601856,
        39.8345950081937,
        32.9410556772693,
        13.5033762999478,
        13.387044270138,
        7.19350914478752,
        7.83416094787686,
        4.63836713118251,
        5.30294041518375,
        3.31154242091752,
        3.89900983366959,
        2.51888103907972,
        3.02445699258248,
        2.00059648162909,
        2.43587660350581,
        279.421467469140,
        13.5033762999478,
        47.8882565626956,
        1.60493853950565,
        20.4632350626988,-0.326571544994106,
        11.8041880034999,
        -0.773429636256977,
        7.80941038669615,-0.859763129069919,
        5.60816552685864,
        -0.839783540402773,
        4.25392125536112,-0.787761016573657,
        -9.1584719902924,
        13.3870442701380,
        1.60493853950564,
        7.00995329010345,
        1.29953479871553,
        3.64168289337145,
        0.974846332779237,
        2.51944061260396,
        0.756849622170666,
        1.88109098268518,
        0.608372535696881,
        1.47618038689426,
        0.50291640926165,
        1.19987440655769,
        120.063091425293,
        7.1935091447875,
        20.4632350626988,
        1.29953479871553,
        9.99095115168064,
        0.224968219874974,
        5.20907454628889,
        -0.0814153473172009,
        3.45747634244567,-0.183016716208951,
        2.48943951860577,
        -0.215101534755947,
        1.89246679707339,-0.220374201326746,
        -13.4308674399428,
        7.83416094787685,
        -0.326571544994108,
        3.64168289337145,
        0.224968219874975,
        3.24297215913941,
        0.267919363691790,
        1.56707344286830,
        0.245897288216201,
        1.17791807396867,
        0.216369718248842,
        0.92898364431331,
        0.189548377634478,
        0.758040472972113,
        68.5501500778068,
        4.63836713118251,
        11.8041880034999,
        0.974846332779236,
        5.20907454628889,
        0.267919363691792,
        4.02643422136089,
        0.0493190581411366,
        2.01295415901985,-0.0333193950931084,
        1.45177778325768,
        -0.0671665670191128,
        1.10517976503995,-0.0807249966165048,
        -12.6135507804251,
        5.30294041518374,
        -0.773429636256978,
        2.51944061260396,
        -0.0814153473171991,
        1.56707344286830,
        0.0493190581411363,
        2.10119788921493,
        0.0804732077034859,
        0.8309754293978,
        0.08551798293822,
        0.657244401056624,
        0.0825890660120881,
        0.537497499109961,
        44.9995305604056,
        3.31154242091752,
        7.80941038669615,
        0.756849622170667,
        3.45747634244567,
        0.245897288216202,
        2.01295415901985,
        0.0804732077034861,
        2.34092930171345,
        0.0138604817643320,
        0.968292114150518,
        -0.0161543521285393,
        0.737879240846649,-0.0303503451725615,
        -11.1303350892035,
        3.89900983366959,
        -0.85976312906992,
        1.88109098268518,
        -0.183016716208951,
        1.17791807396867,
        -0.0333193950931089,
        0.8309754293978,
        0.0138604817643317,
        1.62870789961206,
        0.0307612909902312,
        0.498216613687174,
        0.0366319821687078,
        0.408045496599316,
        32.1115643512323,
        2.51888103907971,
        5.60816552685864,
        0.608372535696881,
        2.48943951860577,
        0.216369718248842,
        1.45177778325767,
        0.0855179829382201,
        0.968292114150518,
        0.0307612909902313,
        1.69989400008129,
        0.00478939017586292,
        0.533784108088963,-0.00843383813401006,
        -9.73606687615795,
        3.02445699258248,
        -0.839783540402774,
        1.47618038689426,
        -0.215101534755946,
        0.92898364431331,
        -0.0671665670191128,
        0.657244401056624,
        -0.0161543521285395,
        0.498216613687174,
        0.00478939017586278,
        1.39535875938674,
        0.0141084215549004,
        0.324150208580381,
        24.2270262199865,
        2.00059648162909,
        4.25392125536112,
        0.50291640926165,
        1.89246679707339,
        0.189548377634477,
        1.10517976503995,
        0.0825890660120875,
        0.737879240846648,
        0.0366319821687076,
        0.533784108088963,
        0.0141084215549001,
        1.40737457453342,
        0.00214258216586551,
        -8.55173420601856,
        2.43587660350580,
        -0.787761016573658,
        1.19987440655769,
        -0.220374201326746,
        0.758040472972113,
        -0.0807249966165052,
        0.53749749910996,
        -0.0303503451725618,
        0.408045496599316,
        -0.0084338381340102,
        0.324150208580381,
        0.00214258216586556,
        1.26598543196973
      ),
      .Dim = c(14L,
               14L)
    ),
    structure(
      c(
        2211.56077139487,
        81.7722258195251,
        365.250563442343,
        1.71319662944353,
        158.319279643632,
        -9.16197931259021,
        90.9182253384846,-10.637414283462,
        59.9468919589412,
        -10.1587634693626,
        42.9321089483646,-9.26829291291937,
        32.4898818504405,
        -8.3592255398479,
        25.5776896387275,
        81.7722258195251,
        36.5559146798142,
        20.9015071494186,
        14.3241393902590,
        10.4910422602431,
        8.20212233194836,
        6.56640733425034,
        5.47327561696091,
        4.59994624513139,
        3.98275548998477,
        3.45156946931917,
        3.06477727032482,
        2.71282217212768,
        2.45247009416114,
        2.20469635184724,
        365.250563442343,
        20.9015071494186,
        63.0291901447132,
        3.5227871505235,
        27.2119302265845,
        0.426494194221987,
        15.7500939697614,
        -0.424823477584857,
        10.4462435444437,-0.688370185926527,
        7.51699545462101,
        -0.757264501509441,
        5.71155455418515,-0.753800960308323,
        4.51210741078228,
        1.71319662944351,
        14.3241393902590,
        3.5227871505235,
        7.25288040386817,
        2.15436819297947,
        3.73707107231941,
        1.47466031291514,
        2.56359732418187,
        1.09084797053394,
        1.90280072179507,
        0.850157284688595,
        1.48663278226782,
        0.687549673939804,
        1.20417600700958,
        0.571532718485098,
        158.319279643632,
        10.4910422602431,
        27.2119302265844,
        2.15436819297947,
        12.9990144371009,
        0.560628572970479,
        6.96786414584724,
        0.0739671913081214,
        4.63277924455991,
        -0.106622567839548,
        3.34025305876089,-0.178320722285484,
        2.54217064401290,
        -0.205237349544017,
        2.01115983351545,-9.16197931259023,
        8.20212233194837,
        0.426494194221989,
        3.73707107231941,
        0.560628572970477,
        3.2804274457972,
        0.464177182092702,
        1.58441209329918,
        0.377045655017508,
        1.18644265752394,
        0.311309334277236,
        0.933087899885595,
        0.262046793385313,
        0.759729546815329,
        0.224419021741117,
        90.9182253384846,
        6.56640733425035,
        15.7500939697614,
        1.47466031291514,
        6.96786414584725,
        0.464177182092704,
        5.0547838809268,
        0.140169936914790,
        2.70014399661015,
        0.0113476284600390,
        1.94924138810973,
        -0.0456611316946967,
        1.48505620391966,-0.0718746051986926,
        1.17590843762528,
        -10.637414283462,
        5.47327561696092,-0.424823477584859,
        2.56359732418188,
        0.0739671913081197,
        1.58441209329918,
        0.140169936914788,
        2.10922422743284,
        0.141183881401531,
        0.834921595280443,
        0.129467047576210,
        0.65914432651433,
        0.116149740610060,
        0.538279398369924,
        0.103887149591440,
        59.9468919589412,
        4.59994624513139,
        10.4462435444437,
        1.09084797053394,
        4.63277924455991,
        0.377045655017508,
        2.70014399661015,
        0.141183881401532,
        2.80014068812721,
        0.0437090107890668,
        1.30071983525237,-0.00178344582208682,
        0.991729889708947,
        -0.0244361126112514,
        0.785795299056045,
        -10.1587634693626,
        3.98275548998478,
        -0.688370185926527,
        1.90280072179507,
        -0.106622567839549,
        1.18644265752394,
        0.0113476284600379,
        0.834921595280442,
        0.0437090107890663,
        1.63064804027777,
        0.0523689400501235,
        0.499150715991016,
        0.0531321576536573,
        0.408429918997122,
        0.0510763332210758,
        42.9321089483646,
        3.45156946931917,
        7.51699545462101,
        0.850157284688596,
        3.34025305876089,
        0.311309334277236,
        1.94924138810973,
        0.129467047576211,
        1.30071983525237,
        0.0523689400501238,
        1.94054175627042,
        0.0151926331592977,
        0.717549134824356,
        -0.00415246595860141,
        0.56884508582805,
        -9.26829291291937,
        3.06477727032483,
        -0.757264501509442,
        1.48663278226782,
        -0.178320722285485,
        0.933087899885594,
        -0.0456611316946977,
        0.65914432651433,
        -0.00178344582208704,
        0.499150715991016,
        0.0151926331592976,
        1.39580849333102,
        0.0220526145748556,
        0.324335293019764,
        0.0245912687552914,
        32.4898818504405,
        2.71282217212768,
        5.71155455418515,
        0.687549673939804,
        2.54217064401290,
        0.262046793385313,
        1.48505620391966,
        0.116149740610060,
        0.991729889708947,
        0.0531321576536573,
        0.717549134824356,
        0.0220526145748556,
        1.54770243624229,
        0.00541195182356463,
        0.434385236167882,
        -8.3592255398479,
        2.45247009416114,
        -0.753800960308323,
        1.20417600700958,
        -0.205237349544018,
        0.759729546815328,
        -0.0718746051986931,
        0.538279398369924,
        -0.0244361126112516,
        0.408429918997122,
        -0.00415246595860139,
        0.324335293019764,
        0.00541195182356462,
        1.26606160200345,
        0.0101203417025442,
        25.5776896387275,
        2.20469635184724,
        4.51210741078228,
        0.571532718485098,
        2.01115983351545,
        0.224419021741116,
        1.17590843762528,
        0.103887149591440,
        0.785795299056045,
        0.0510763332210758,
        0.56884508582805,
        0.0245912687552914,
        0.434385236167882,
        0.0101203417025442,
        1.34464055179653
      ),
      .Dim = c(15L,
               15L)
    ),
    structure(
      c(
        2281.70463581081,
        62.9938098561674,
        371.984936235228,-7.6018810694523,
        160.298007976291,
        -15.0642327617156,
        91.6986494030292,-14.8294691911718,
        60.2838167981489,
        -13.3447132374785,
        43.0701024886997,-11.8012259179920,
        32.5281076796795,
        -10.4389280844588,
        25.5624332450559,-9.29580294261557,
        62.9938098561675,
        41.5831385008492,
        19.0986288134375,
        16.8179056692723,
        9.96131119938987,
        9.78223160182238,
        6.35747776023804,
        6.59554270979061,
        4.50974712605186,
        4.8356752782226,
        3.41462682120104,
        3.74287606018268,
        2.70258862528722,
        3.00923325210523,
        2.20878068493592,
        2.4886061784968,
        371.984936235228,
        19.0986288134374,
        63.6757438709884,
        2.62846508341811,
        27.4019039949087,
        -0.140169410293797,
        15.8250209306710,-0.827294324492114,
        10.4785910275668,
        -0.994246881152836,
        7.53024393973575,-1.0004463572232,
        5.71522453995708,
        -0.95346906172208,
        4.51064267479532,-0.892471536123538,
        -7.60188106945226,
        16.8179056692723,
        2.62846508341812,
        8.48991907088004,
        1.89159384603821,
        4.5208880167491,
        1.37102030305931,
        3.12030057268942,
        1.04610448395684,
        2.32589360214598,
        0.83183179662329,
        1.82300529246151,
        0.682473298800441,
        1.48035968971498,
        0.573558761583967,
        1.23447898693345,
        160.298007976292,
        9.96131119938988,
        27.4019039949087,
        1.89159384603821,
        13.0548335147499,
        0.394128534462044,
        6.98987957400819,-0.0442888797974801,
        4.64228374977717,
        -0.196496844444138,
        3.34414579735243,-0.249773676063034,
        2.54324897826171,
        -0.263904866408272,
        2.01072945719284,-0.262230614332889,
        -15.0642327617155,
        9.78223160182239,
        -0.140169410293786,
        4.5208880167491,
        0.394128534462045,
        3.77707239211818,
        0.398508421679561,
        1.93715243265599,
        0.348695124135014,
        1.45452430891456,
        0.299697871803554,
        1.14622147457573,
        0.258830282085708,
        0.934726057476059,
        0.225702770546554,
        0.782195070618233,
        91.6986494030293,
        6.35747776023806,
        15.8250209306711,
        1.37102030305932,
        6.9898795740082,
        0.398508421679561,
        5.06346691722051,
        0.0935289290783922,
        2.70389263884191,
        -0.0240994044086715,
        1.95077671098532,-0.073842668134343,
        1.48548150636438,
        -0.095013477378571,
        1.17573869424338,-0.103425557975155,
        -14.8294691911718,
        6.59554270979062,
        -0.827294324492104,
        3.12030057268942,
        -0.0442888797974785,
        1.93715243265599,
        0.093528929078392,
        2.35975682205858,
        0.121048015812824,
        1.0253256523183,
        0.121220046889439,
        0.8105217038972,
        0.113865224688235,
        0.662570059160878,
        0.104798927698991,
        0.555551318294857,
        60.2838167981489,
        4.50974712605186,
        10.4785910275668,
        1.04610448395684,
        4.64228374977716,
        0.348695124135013,
        2.70389263884191,
        0.121048015812822,
        2.8017590527299,
        0.0284058103979765,
        1.30138266516301,-0.0139499845860510,
        0.991913501368663,
        -0.034425631313817,
        0.785722017407933,-0.0446509033666429,
        -13.3447132374785,
        4.83567527822261,
        -0.994246881152834,
        2.32589360214598,
        -0.196496844444138,
        1.45452430891456,
        -0.0240994044086724,
        1.02532565231830,
        0.0284058103979770,
        1.77535458032153,
        0.0461012430604366,
        0.614197090856955,
        0.0513959320717841,
        0.502890466543306,
        0.0517692819811206,
        0.422217416676222,
        43.0701024886997,
        3.41462682120104,
        7.53024393973575,
        0.831831796623288,
        3.34414579735243,
        0.299697871803553,
        1.95077671098531,
        0.121220046889438,
        1.30138266516301,
        0.0461012430604363,
        1.94081323000982,
        0.0102096115404868,
        0.717624336234322,
        -0.00824385042069897,
        0.568815072030027,
        -0.0182875689702926,
        -11.8012259179920,
        3.74287606018269,-1.00044635722320,
        1.82300529246151,
        -0.249773676063032,
        1.14622147457573,-0.0738426681343433,
        0.8105217038972,
        -0.0139499845860504,
        0.614197090856955,
        0.0102096115404873,
        1.48727407854777,
        0.0206722591390660,
        0.399434480380296,
        0.0251421854090041,
        0.335676488285697,
        32.5281076796795,
        2.70258862528722,
        5.71522453995709,
        0.682473298800441,
        2.54324897826171,
        0.258830282085707,
        1.48548150636438,
        0.113865224688235,
        0.991913501368663,
        0.0513959320717841,
        0.717624336234322,
        0.0206722591390657,
        1.54772326791488,
        0.00427859033846914,
        0.434376921993761,
        -0.00506587110527014,
        -10.4389280844588,
        3.00923325210523,-0.953469061722077,
        1.48035968971498,
        -0.263904866408271,
        0.934726057476059,-0.0950134773785713,
        0.662570059160878,
        -0.0344256313138164,
        0.502890466543307,
        -0.00824385042069861,
        0.399434480380296,
        0.00427859033846937,
        1.32772291351036,
        0.0105726800645549,
        0.275612203503122,
        25.5624332450559,
        2.20878068493592,
        4.51064267479532,
        0.573558761583967,
        2.01072945719284,
        0.225702770546553,
        1.17573869424338,
        0.104798927698990,
        0.785722017407933,
        0.0517692819811205,
        0.568815072030027,
        0.0251421854090037,
        0.434376921993761,
        0.0105726800645547,
        1.34464387008456,
        0.00202185081104250,
        -9.29580294261556,
        2.4886061784968,
        -0.892471536123537,
        1.23447898693345,
        -0.26223061433289,
        0.782195070618233,
        -0.103425557975156,
        0.555551318294856,
        -0.0446509033666429,
        0.422217416676222,
        -0.0182875689702925,
        0.335676488285697,
        -0.00506587110527012,
        0.275612203503121,
        0.00202185081104253,
        1.23192460334437
      ),
      .Dim = c(16L,
               16L)
    ),
    structure(
      c(
        2836.65208921483,
        112.643335587721,
        470.29445005428,
        5.59415596509935,
        204.191833405888,
        -9.71852462020793,
        117.39053655333,-12.2481105528553,
        77.4657976017784,
        -11.9933259901707,
        55.5160548474411,-11.0775343811381,
        42.0370780681148,
        -10.0652489059055,
        33.1101684197937,-9.1318971795888,
        26.8385043262545,
        112.643335587721,
        46.0251363697426,
        27.8940935120780,
        17.9985165114031,
        13.8883633946119,
        10.2604964759059,
        8.65605576854612,
        6.82648931806745,
        6.04696870044804,
        4.95657994315436,
        4.52812978098336,
        3.80762262557437,
        3.55332839728775,
        3.04266523539871,
        2.88405447793103,
        2.50327034777815,
        2.40116249379926,
        470.29445005428,
        27.8940935120781,
        81.0913756538808,
        4.96615665628225,
        35.1777404478428,
        0.80682830126714,
        20.376365241465,
        -0.370003978948770,
        13.5223966507693,-0.754847236287038,
        9.73505723854037,
        -0.872243654955303,
        7.39974845311801,-0.887271409777643,
        5.84773174676412,
        -0.863435461128566,
        4.75446872629174,
        5.59415596509935,
        17.9985165114031,
        4.96615665628225,
        8.80370624541194,
        2.93534049701243,
        4.64800304751206,
        1.98194498114064,
        3.18168242782141,
        1.45467299548145,
        2.35802809714029,
        1.12778278666532,
        1.84021387728041,
        0.90858610396165,
        1.48924536753726,
        0.753035561201462,
        1.23837648480613,
        0.638189967120269,
        204.191833405888,
        13.8883633946119,
        35.1777404478428,
        2.93534049701243,
        16.5266359332056,
        0.816949791720957,
        9.02199126785387,
        0.159884875296709,
        6.00130046623035,
        -0.0896082452492687,
        4.32856415406114,-0.192532959327241,
        3.29536538799557,
        -0.234348538994766,
        2.60772106084215,-0.249266412217761,
        2.12280390956308,
        -9.71852462020798,
        10.2604964759059,
        0.80682830126713,
        4.64800304751206,
        0.816949791720951,
        3.82856662884081,
        0.645993709642627,
        1.96201819211550,
        0.514206028105817,
        1.46754197710272,
        0.419587472962793,
        1.15319266386001,
        0.350428468744669,
        0.938325641211166,
        0.298408734194191,
        0.783773945098121,
        0.258530443202864,
        117.39053655333,
        8.65605576854612,
        20.376365241465,
        1.98194498114064,
        9.02199126785387,
        0.645993709642629,
        6.25290036951392,
        0.213035693950066,
        3.49935085586358,
        0.0384645166278548,
        2.52697541505614,
        -0.0403385927801189,
        1.92570948225053,-0.0777135992965582,
        1.52516918385145,
        -0.0958373650009562,
        1.24251732340325,-12.2481105528553,
        6.82648931806745,
        -0.370003978948772,
        3.18168242782141,
        0.159884875296708,
        1.96201819211550,
        0.213035693950066,
        2.37176410739478,
        0.200970636051521,
        1.03161168016320,
        0.179112855363914,
        0.813887981891058,
        0.158096552723208,
        0.664308241703399,
        0.139907497480736,
        0.556313732023703,
        0.124840297143776,
        77.4657976017784,
        6.04696870044804,
        13.5223966507693,
        1.45467299548145,
        6.00130046623035,
        0.514206028105819,
        3.49935085586358,
        0.200970636051521,
        3.3337381843133,
        0.0702467263244978,
        1.68672746348411,
        0.00845655862394869,
        1.28632506353404,
        -0.0228559801094753,
        1.01941088306133,-0.0395761424020555,
        0.830959153525712,
        -11.9933259901707,
        4.95657994315436,-0.754847236287042,
        2.35802809714029,
        -0.0896082452492717,
        1.46754197710272,
        0.038464516627854,
        1.03161168016320,
        0.0702467263244969,
        1.77864542791618,
        0.0764091599542554,
        0.615959397374257,
        0.0745518205061524,
        0.503800436078959,
        0.0701492439011771,
        0.422616553849587,
        0.0653561202252395,
        55.5160548474411,
        4.52812978098336,
        9.73505723854037,
        1.12778278666532,
        4.32856415406114,
        0.419587472962794,
        2.52697541505614,
        0.179112855363913,
        1.68672746348411,
        0.0764091599542553,
        2.21994187393079,
        0.0264400317989493,
        0.93088451376862,
        0.000136750706854249,
        0.738090112081059,
        -0.0146116113540486,
        0.601914188767834,
        -11.0775343811381,
        3.80762262557437,
        -0.872243654955305,
        1.84021387728041,
        -0.192532959327242,
        1.15319266386001,
        -0.0403385927801197,
        0.813887981891058,
        0.00845655862394857,
        0.615959397374257,
        0.0264400317989496,
        1.48821782454986,
        0.033072642908909,
        0.399921785002314,
        0.034984976892898,
        0.335890233231852,
        0.0349993469176749,
        42.0370780681148,
        3.55332839728775,
        7.39974845311801,
        0.908586103961651,
        3.29536538799557,
        0.35042846874467,
        1.92570948225053,
        0.158096552723208,
        1.28632506353404,
        0.074551820506153,
        0.93088451376862,
        0.0330726429089092,
        1.71065854636963,
        0.0106815465496282,
        0.563706626700202,
        -0.00225736187154656,
        0.459875149156622,
        -10.0652489059055,
        3.04266523539871,
        -0.887271409777645,
        1.48924536753726,
        -0.234348538994766,
        0.938325641211167,
        -0.077713599296558,
        0.664308241703399,
        -0.0228559801094752,
        0.503800436078959,
        0.000136750706854587,
        0.399921785002314,
        0.0106815465496281,
        1.32797453396133,
        0.0156550197757023,
        0.275722571017225,
        0.0180719637305300,
        33.1101684197937,
        2.88405447793103,
        5.84773174676412,
        0.753035561201464,
        2.60772106084215,
        0.298408734194193,
        1.52516918385145,
        0.139907497480737,
        1.01941088306133,
        0.0701492439011778,
        0.738090112081059,
        0.0349849768928984,
        0.563706626700202,
        0.0156550197757024,
        1.44729918622041,
        0.00425110204077948,
        0.365025412582910,
        -9.1318971795888,
        2.50327034777815,
        -0.863435461128566,
        1.23837648480613,
        -0.249266412217763,
        0.783773945098121,
        -0.0958373650009565,
        0.556313732023703,
        -0.0395761424020557,
        0.422616553849587,
        -0.0146116113540486,
        0.335890233231852,
        -0.00225736187154671,
        0.275722571017225,
        0.00425110204077922,
        1.23197301351184,
        0.0079268505569946,
        26.8385043262545,
        2.40116249379926,
        4.75446872629173,
        0.638189967120268,
        2.12280390956308,
        0.258530443202864,
        1.24251732340325,
        0.124840297143776,
        0.830959153525712,
        0.0653561202252397,
        0.601914188767834,
        0.0349993469176749,
        0.459875149156622,
        0.0180719637305299,
        0.365025412582910,
        0.00792685055699466,
        1.29797030340870
      ),
      .Dim = c(17L,
               17L)
    ),
    structure(
      c(
        2924.03948019569,
        91.0026805723211,
        479.082824789297,-5.24191390578497,
        206.906889760163,
        -16.6112007506642,
        118.535529409201,-17.1543652651036,
        78.0140088568987,
        -15.7274675244308,
        55.7884483272507,-14.0494010485901,
        42.166172520358,
        -12.5072959384568,
        33.1590218846548,-11.1881847766414,
        26.8388418158651,
        -10.2777316330393,
        91.0026805723212,
        51.3842384580592,
        25.7177362178357,
        20.6819660018569,
        13.2160055492707,
        11.9674020671875,
        8.37250919379839,
        8.04147656570315,
        5.91120940480739,
        5.88130452658579,
        4.46067413024592,
        4.54357709887413,
        3.52135938580996,
        3.64741492262317,
        2.87195638268638,
        3.01249038514241,
        2.40107891771271,
        2.54518234399728,
        479.082824789297,
        25.7177362178356,
        81.9752048838911,
        3.87639483125218,
        35.4507882228172,
        0.113645679821434,
        20.4915148777389,-0.863416180327189,
        13.5775291577582,
        -1.13038236496234,
        9.76245130476782,-1.17111832832480,
        7.4127312233989,
        -1.13286318453668,
        5.85264484179426,-1.07023218274926,
        4.75450266694556,
        -1.03361086768973,
        -5.24191390578492,
        20.6819660018569,
        3.87639483125220,
        10.1473830496878,
        2.59867247170659,
        5.50269752126798,
        1.83996542953124,
        3.79005988674019,
        1.38669459038511,
        2.82106307414313,
        1.09400589109267,
        2.20872647954623,
        0.892578342559246,
        1.79206013263994,
        0.74697771289309,
        1.49335693251457,
        0.63814811828002,
        1.27444264945094,
        206.906889760163,
        13.2160055492707,
        35.4507882228172,
        2.59867247170659,
        16.6109905629090,
        0.602799856406373,
        9.05756528023798,
        0.00745146490876647,
        6.01833295152393,
        -0.205625036533583,
        4.33702720164661,-0.284866480089447,
        3.29937624939041,
        -0.31022098739626,
        2.60923889892753,-0.313153623449324,
        2.12281439509553,
        -0.319320902757987,
        -16.6112007506642,
        11.9674020671875,
        0.113645679821440,
        5.50269752126799,
        0.602799856406375,
        4.37222611685482,
        0.555682454911708,
        2.34899878926571,
        0.470965892542152,
        1.76207220545872,
        0.398102450750045,
        1.38759849989419,
        0.340246150225564,
        1.13094197981385,
        0.294555419575999,
        0.945963527353856,
        0.258503823726811,
        0.810655572931173,
        118.535529409201,
        8.37250919379839,
        20.4915148777389,
        1.83996542953124,
        9.05756528023798,
        0.55568245491171,
        6.2679026327158,
        0.148751515975289,
        3.50653379110851,
        -0.0104620542597434,
        2.53054444927127,-0.0792774610151742,
        1.92740094166938,
        -0.109710508399435,
        1.52580928613202,-0.122779863018094,
        1.24252174535929,
        -0.134663927623972,
        -17.1543652651036,
        8.04147656570314,
        -0.863416180327185,
        3.79005988674019,
        0.00745146490876721,
        2.34899878926571,
        0.148751515975288,
        2.64721958250804,
        0.170192007424219,
        1.24126034106371,
        0.163819667423694,
        0.980739683008915,
        0.150848707725052,
        0.801413888485434,
        0.137164681389349,
        0.671761402443555,
        0.124821349215947,
        0.577030263634357,
        78.0140088568987,
        5.91120940480739,
        13.5775291577582,
        1.38669459038512,
        6.01833295152393,
        0.470965892542152,
        3.50653379110851,
        0.170192007424219,
        3.33717730266757,
        0.0468211680798582,
        1.6884362817677,-0.0101869863715971,
        1.28713491757485,
        -0.0381757837302924,
        1.01971735770252,-0.0524759439844438,
        0.830961270714553,
        -0.0644757566855298,-15.7274675244308,
        5.88130452658578,
        -1.13038236496233,
        2.82106307414313,-0.205625036533584,
        1.76207220545872,
        -0.0104620542597442,
        1.24126034106371,
        0.0468211680798575,
        1.93820864225891,
        0.0647695424398446,
        0.742949923498118,
        0.0690354988659515,
        0.608151294372603,
        0.0680616915647413,
        0.510483565741995,
        0.0653416989918433,
        0.439176683710025,
        55.7884483272507,
        4.46067413024592,
        9.76245130476783,
        1.09400589109267,
        4.33702720164660,
        0.398102450750046,
        2.53054444927127,
        0.163819667423695,
        1.6884362817677,
        0.064769542439845,
        2.22079094617128,
        0.0171764859489573,
        0.931286911490793,
        -0.00747530500938581,
        0.738242392234413,
        -0.021021224088259,
        0.601915240749969,
        -0.03203651067496,-14.0494010485901,
        4.54357709887413,
        -1.1711183283248,
        2.20872647954623,-0.284866480089447,
        1.38759849989419,
        -0.0792774610151746,
        0.980739683008915,-0.0101869863715972,
        0.742949923498117,
        0.0171764859489572,
        1.58928493949639,
        0.0286824042800148,
        0.482970816389476,
        0.0333235703424761,
        0.405820374180135,
        0.0349878695854828,
        0.349524659273122,
        42.166172520358,
        3.52135938580996,
        7.41273122339891,
        0.892578342559246,
        3.29937624939041,
        0.340246150225564,
        1.92740094166938,
        0.150848707725053,
        1.28713491757485,
        0.0690354988659515,
        0.931286911490793,
        0.0286824042800148,
        1.71084925326016,
        0.00707399263972138,
        0.563778796280048,
        -0.00529504634762847,
        0.459875647718712,
        -0.0151829471109189,-12.5072959384568,
        3.64741492262317,
        -1.13286318453667,
        1.79206013263994,-0.310220987396259,
        1.13094197981385,
        -0.109710508399435,
        0.801413888485435,-0.0381757837302922,
        0.608151294372603,
        -0.00747530500938585,
        0.482970816389477,
        0.00707399263972142,
        1.39621771689966,
        0.0142898061270691,
        0.333185678315728,
        0.0180625325587579,
        0.287211962208656,
        33.1590218846548,
        2.87195638268638,
        5.85264484179426,
        0.74697771289309,
        2.60923889892753,
        0.294555419575998,
        1.52580928613202,
        0.137164681389349,
        1.01971735770252,
        0.0680616915647413,
        0.738242392234413,
        0.0333235703424760,
        0.563778796280048,
        0.0142898061270690,
        1.44732649749502,
        0.00310154519130248,
        0.365025601254752,-0.00574571223046452,
        -11.1881847766414,
        3.01249038514241,
        -1.07023218274925,
        1.49335693251457,
        -0.313153623449323,
        0.945963527353857,
        -0.122779863018094,
        0.671761402443556,
        -0.0524759439844437,
        0.510483565741995,
        -0.0210212240882589,
        0.405820374180135,
        -0.00529504634762835,
        0.333185678315728,
        0.0031015451913026,
        1.28035892633456,
        0.00791890918597106,
        0.241842351004092,
        26.8388418158651,
        2.40107891771271,
        4.75450266694556,
        0.63814811828002,
        2.12281439509553,
        0.258503823726811,
        1.24252174535929,
        0.124821349215947,
        0.830961270714553,
        0.0653416989918431,
        0.601915240749969,
        0.0349878695854828,
        0.459875647718711,
        0.0180625325587578,
        0.365025601254752,
        0.00791890918597096,
        1.29797030471212,-3.96925411621815e-05,
        -10.2777316330393,
        2.54518234399728,
        -1.03361086768972,
        1.27444264945094,
        -0.319320902757986,
        0.810655572931173,
        -0.134663927623972,
        0.577030263634358,
        -0.0644757566855298,
        0.439176683710025,
        -0.0320365106749598,
        0.349524659273122,
        -0.0151829471109188,
        0.287211962208656,
        -0.00574571223046431,
        0.241842351004092,
        -3.96925411620290e-05,
        1.20877584667009
      ),
      .Dim = c(18L,
               18L)
    ),
    structure(
      c(
        3514.22547602292,
        146.764258793439,
        584.307181588571,
        10.0893653817167,
        254.009531730345,
        -10.1490637329552,
        146.150218816549,-13.8753902906288,
        96.5037555201956,
        -13.8937698076466,
        69.194222872542,-12.9697624988619,
        52.4164054437707,
        -11.8586561612077,
        41.3005194355219,-10.8047094966945,
        33.4887198232198,
        -10.1001392503231,
        27.1798743224057,
        146.764258793439,
        56.652668457575,
        35.6594770316032,
        22.1304861891612,
        17.6663274362891,
        12.5779535904978,
        10.9815827304916,
        8.35127859560063,
        7.65814589964746,
        6.05455478903075,
        5.72727000206797,
        4.64558282226794,
        4.48981537931831,
        3.70869929387591,
        3.64117618073227,
        3.04872165286113,
        3.02936846590553,
        2.56196151464915,
        2.56799161414358,
        584.307181588571,
        35.6594770316032,
        100.735672502751,
        6.60981109890912,
        43.8487258897588,
        1.26578113549954,
        25.4149423254321,
        -0.278807200972408,
        16.8740690854804,-0.803452101999248,
        12.1525690200267,
        -0.97862939640491,
        9.24024691173218,-1.01721709357885,
        7.30419375896587,
        -1.00186231296899,
        5.9401104940794,-1.00194789300737,
        4.84590419576402,
        10.0893653817168,
        22.1304861891612,
        6.60981109890913,
        10.5456441508548,
        3.82225921271678,
        5.67056464809431,
        2.55731304322424,
        3.87523791784541,
        1.86700329315745,
        2.86869709464457,
        1.44224809790931,
        2.23677228248376,
        1.15884895016750,
        1.80890986755795,
        0.95846963857986,
        1.50331848134545,
        0.810892198416451,
        1.27905597209502,
        0.706052409210554,
        254.009531730345,
        17.6663274362891,
        43.8487258897588,
        3.82225921271678,
        20.3702442494717,
        1.11854189105223,
        11.2614888525839,
        0.269145888944365,
        7.49399642601885,
        -0.0592779397778019,
        5.40693974312394,-0.198700714678863,
        4.11744556129565,
        -0.258453159268509,
        3.25901040647085,-0.282548527863411,
        2.65354000556480,
        -0.305147285493504,
        2.16922105582738,-10.1490637329552,
        12.5779535904978,
        1.26578113549954,
        5.67056464809432,
        1.11854189105223,
        4.44298214144864,
        0.858044605002461,
        2.38490134492194,
        0.673416098419182,
        1.78214995379351,
        0.544886604479026,
        1.39941981095085,
        0.452479259928021,
        1.13804414615694,
        0.383699304851197,
        0.950162322004103,
        0.331315485030886,
        0.812600089267607,
        0.297601219340015,
        146.150218816549,
        10.9815827304915,
        25.4149423254320,
        2.55731304322423,
        11.2614888525839,
        0.858044605002455,
        7.55998864705002,
        0.302174125347234,
        4.37166548677307,
        0.075336309771224,
        3.1577980658439,
        -0.0287613806036763,
        2.40700737173430,-0.0793607777846261,
        1.90674839307026,
        -0.104837128310724,
        1.55366826030237,-0.126354414140946,
        1.27174110001032,
        -13.8753902906288,
        8.35127859560064,-0.278807200972402,
        3.87523791784541,
        0.269145888944369,
        2.38490134492194,
        0.302174125347237,
        2.66543702067036,
        0.272917956569043,
        1.25144805979409,
        0.238299915274804,
        0.986737974752663,
        0.207797292537375,
        0.805017622921855,
        0.182397484120676,
        0.673891927151312,
        0.161766962503275,
        0.578016937297755,
        0.151006849269068,
        96.5037555201956,
        7.65814589964746,
        16.8740690854804,
        1.86700329315745,
        7.49399642601885,
        0.67341609841918,
        4.37166548677308,
        0.272917956569042,
        3.91643661090263,
        0.104268492279559,
        2.10842146765861,
        0.0236366614505229,
        1.60826115800359,
        -0.0178547574066054,
        1.27477970794414,-0.0404621706519884,
        1.03929315348904,
        -0.0589120222205127,
        0.851509514144203,-13.8937698076466,
        6.05455478903075,
        -0.803452101999244,
        2.86869709464457,-0.0592779397777991,
        1.78214995379351,
        0.0753363097712267,
        1.25144805979409,
        0.104268492279559,
        1.94390590945997,
        0.106421052894566,
        0.746304341863841,
        0.100882795889369,
        0.610166606980783,
        0.0933571841311256,
        0.511675016827344,
        0.0860027553455959,
        0.439728460182207,
        0.0844474010564475,
        69.194222872542,
        5.72727000206798,
        12.1525690200267,
        1.44224809790931,
        5.40693974312394,
        0.544886604479026,
        3.15779806584390,
        0.238299915274804,
        2.10842146765861,
        0.106421052894566,
        2.5252962926719,
        0.0416999261701675,
        1.16411573592840,
        0.0072582174333552,
        0.923172365835342,
        -0.0123107782576066,
        0.752963835515993,-0.0280025900796093,
        0.617377013198748,
        -12.9697624988619,
        4.64558282226793,-0.978629396404913,
        2.23677228248375,
        -0.198700714678863,
        1.39941981095085,-0.0287613806036758,
        0.986737974752661,
        0.0236366614505227,
        0.74630434186384,
        0.0416999261701665,
        1.59125994298056,
        0.0474333517542944,
        0.484157385561501,
        0.0482169677978249,
        0.406521872856873,
        0.0471526188314703,
        0.349849532421378,
        0.0497206648459026,
        52.4164054437707,
        4.48981537931831,
        9.24024691173218,
        1.15884895016749,
        4.11744556129565,
        0.452479259928019,
        2.40700737173430,
        0.207797292537374,
        1.60826115800359,
        0.100882795889369,
        1.16411573592840,
        0.0474333517542947,
        1.88887325878904,
        0.0183394392060648,
        0.705178705515125,
        0.00136507599959678,
        0.575369405567246,
        -0.0120985579503223,
        0.472054648201643,
        -11.8586561612077,
        3.70869929387592,
        -1.01721709357884,
        1.80890986755795,
        -0.258453159268508,
        1.13804414615694,
        -0.0793607777846247,
        0.805017622921855,
        -0.0178547574066047,
        0.610166606980784,
        0.00725821743335516,
        0.484157385561502,
        0.0183394392060652,
        1.39693059989521,
        0.0232376618796755,
        0.333607134131228,
        0.0253710343190887,
        0.287407143870679,
        0.0298718501469379,
        41.3005194355219,
        3.64117618073227,
        7.30419375896588,
        0.958469638579858,
        3.25901040647085,
        0.383699304851195,
        1.90674839307026,
        0.182397484120675,
        1.27477970794414,
        0.0933571841311252,
        0.923172365835342,
        0.0482169677978249,
        0.705178705515125,
        0.0232376618796751,
        1.55963682481458,
        0.00839150983733102,
        0.456759335862533,
        -0.00329586089688537,
        0.374940919969803,
        -10.8047094966945,
        3.04872165286113,
        -1.00186231296899,
        1.50331848134545,
        -0.282548527863410,
        0.950162322004103,
        -0.104837128310723,
        0.673891927151311,
        -0.040462170651988,
        0.511675016827344,
        -0.0123107782576067,
        0.406521872856873,
        0.00136507599959707,
        0.333607134131228,
        0.00839150983733125,
        1.28060809065118,
        0.0122396891579020,
        0.241957742235266,
        0.0176602121846702,
        33.4887198232198,
        3.02936846590552,
        5.9401104940794,
        0.810892198416449,
        2.65354000556480,
        0.331315485030885,
        1.55366826030237,
        0.161766962503274,
        1.03929315348904,
        0.0860027553455953,
        0.752963835515992,
        0.04715261883147,
        0.575369405567246,
        0.0253710343190882,
        0.456759335862533,
        0.0122396891579016,
        1.37289732403374,
        0.00196131678208227,
        0.306247267432879,
        -10.1001392503231,
        2.56196151464915,
        -1.00194789300736,
        1.27905597209502,
        -0.305147285493503,
        0.812600089267606,
        -0.126354414140945,
        0.578016937297755,
        -0.0589120222205123,
        0.439728460182207,
        -0.0280025900796093,
        0.349849532421379,
        -0.0120985579503221,
        0.287407143870679,
        -0.0032958608968851,
        0.241957742235266,
        0.00196131678208257,
        1.20882928584795,
        0.00817867363337702,
        27.1798743224057,
        2.56799161414358,
        4.84590419576402,
        0.706052409210551,
        2.16922105582737,
        0.297601219340013,
        1.27174110001032,
        0.151006849269067,
        0.851509514144202,
        0.0844474010564469,
        0.617377013198748,
        0.0497206648459024,
        0.472054648201643,
        0.0298718501469374,
        0.374940919969803,
        0.0176602121846698,
        0.306247267432879,
        0.00817867363337678,
        1.25171653242394
      ),
      .Dim = c(19L,
               19L)
    ),
    structure(
      c(
        3701.44840696554,
        113.695992688020,
        606.156294024484,-7.29785265102723,
        261.720580984518,
        -21.4254674486465,
        149.912479484322,-21.9889858614517,
        98.6519823783009,
        -20.1125989387415,
        70.5394160688073,-17.9441058508523,
        53.3105294573092,
        -15.9618877429192,
        41.9195599395492,-14.2704851855762,
        33.9271731796379,
        -13.1021524738154,
        27.4454665555356,-15.1974404066730,
        113.695992688020,
        62.4933537716879,
        31.8003756888372,
        25.2015050533901,
        16.3043627057686,
        14.5696493561071,
        10.3170731199796,
        9.78434310355065,
        7.278715148079,
        7.15295601336899,
        5.48967513933847,
        5.52417663999883,
        4.33189064936172,
        4.43343292107262,
        3.53183809904523,
        3.66086457875606,
        2.95192660452802,
        3.09219235564068,
        2.52108136337265,
        2.68424920473150,
        606.156294024484,
        31.8003756888373,
        103.285486843514,
        4.58070451547859,
        44.7486134265318,
        -0.0501870069509115,
        25.8540020919339,-1.22567231516415,
        17.1247694132892,
        -1.52919598508461,
        12.3095544771248,-1.55914048361626,
        9.34459212203909,
        -1.49606852341153,
        7.37643643515306,-1.40632197142389,
        5.99127846070652,
        -1.35228598526935,
        4.87689908797388,-1.77355723741429,
        -7.29785265102731,
        25.2015050533901,
        4.58070451547857,
        12.1603787851043,
        3.10614129933777,
        6.71779368699019,
        2.20791542298021,
        4.62873993017568,
        1.66749947929491,
        3.44623392448962,
        1.31732126719582,
        2.69873488501042,
        1.07581249147425,
        2.18997313684324,
        0.900979927461777,
        1.82518181962280,
        0.770173446355448,
        1.55785012509391,
        0.681387107572845,
        1.41137203952830,
        261.720580984518,
        16.3043627057686,
        44.7486134265318,
        3.10614129933777,
        20.6878350504541,
        0.654106770718798,
        11.4164430409956,-0.0650243687263964,
        7.58247427981921,
        -0.315409480351710,
        5.46234348528618,-0.403576294829211,
        4.15427136181613,
        -0.427450731673319,
        3.28450649176802,-0.425291550346271,
        2.67159834601481,
        -0.428789574990051,
        2.18015985900117,-0.625928730647604,
        -21.4254674486465,
        14.5696493561071,
        -0.0501870069509175,
        6.71779368699019,
        0.654106770718802,
        5.12215792466736,
        0.631444316459798,
        2.87358175806334,
        0.54402877816485,
        2.15670892244208,
        0.463865858354223,
        1.69902362323590,
        0.398626330173345,
        1.38518105199141,
        0.346414605778272,
        1.15890537318457,
        0.304907517627792,
        0.993410809928549,
        0.281604646540819,
        0.91533912330227,
        149.912479484322,
        10.3170731199796,
        25.8540020919339,
        2.20791542298022,
        11.4164430409956,
        0.631444316459799,
        7.63559159408775,
        0.139130734579959,
        4.41483428758734,
        -0.049631588774555,
        3.18482983715205,-0.128721231926044,
        2.42497486957939,
        -0.161815564241015,
        1.91918806447347,-0.174482184564970,
        1.56247901766638,
        -0.186680124341070,
        1.27707819844879,-0.305393853225509,
        -21.9889858614517,
        9.78434310355065,
        -1.22567231516415,
        4.62873993017568,
        -0.0650243687263969,
        2.87358175806333,
        0.139130734579957,
        3.01705224619605,
        0.179821219789791,
        1.52095064817783,
        0.180003885487548,
        1.20230884518672,
        0.169049044128582,
        0.982837516136127,
        0.155570405480643,
        0.824086682340951,
        0.142765907489780,
        0.708113828052953,
        0.139496998656737,
        0.658604608691971,
        98.6519823783009,
        7.278715148079,
        17.1247694132892,
        1.66749947929491,
        7.58247427981921,
        0.544028778164849,
        4.41483428758734,
        0.179821219789791,
        3.94108572098048,
        0.0329126188398375,
        2.12385643675679,-0.0334397764428412,
        1.61852048473616,
        -0.0649359148506206,
        1.28188268101651,-0.080229053808465,
        1.04432403977817,
        -0.0933576181879014,
        0.854556963330302,-0.174377943404751,
        -20.1125989387415,
        7.15295601336899,
        -1.52919598508462,
        3.44623392448962,
        -0.31540948035171,
        2.15670892244208,
        -0.0496315887745566,
        1.52095064817783,
        0.0329126188398369,
        2.15047160932960,
        0.0617388839222937,
        0.911532987680456,
        0.0711834186058779,
        0.74646025415069,
        0.0727950280940695,
        0.626794819232806,
        0.071439013117131,
        0.539443848634975,
        0.0756254436816025,
        0.504800798937453,
        70.5394160688073,
        5.48967513933848,
        12.3095544771248,
        1.31732126719582,
        5.46234348528618,
        0.463865858354224,
        3.18482983715205,
        0.180003885487550,
        2.12385643675680,
        0.061738883922295,
        2.53496148019021,
        0.00595936384012936,
        1.17053999995195,
        -0.0222234234031309,
        0.927620160077449,-0.0372123106339053,
        0.756114114538811,
        -0.0495719979667634,
        0.619285288340012,
        -0.109193320138243,
        -17.9441058508523,
        5.52417663999884,-1.55914048361626,
        2.69873488501042,
        -0.403576294829209,
        1.69902362323590,-0.128721231926044,
        1.20230884518672,
        -0.0334397764428402,
        0.911532987680457,
        0.00595936384012932,
        1.72342373113910,
        0.0236772882198089,
        0.593176524602997,
        0.0317696234457986,
        0.498604387379542,
        0.0355033110908794,
        0.429610299148511,
        0.0426641202626646,
        0.403782198439627,
        53.3105294573092,
        4.33189064936172,
        9.34459212203908,
        1.07581249147426,
        4.15427136181613,
        0.398626330173344,
        2.42497486957939,
        0.169049044128582,
        1.61852048473616,
        0.0711834186058784,
        1.17053999995195,
        0.0236772882198084,
        1.89314334337519,
        -0.00125643973800671,
        0.708135068697895,
        -0.0151864930488915,
        0.577463335369652,
        -0.0264353280166915,
        0.47332304194091,
        -0.0725786971898078,
        -15.9618877429192,
        4.43343292107262,-1.49606852341153,
        2.18997313684324,
        -0.427450731673319,
        1.38518105199141,-0.161815564241016,
        0.982837516136128,
        -0.0649359148506205,
        0.746460254150691,-0.0222234234031314,
        0.593176524602996,
        -0.00125643973800679,
        1.48685820293191,
        0.0096705922174014,
        0.409564070550109,
        0.0157617645031750,
        0.353200128764924,
        0.0240510544071112,
        0.333071473264385,
        41.9195599395492,
        3.53183809904524,
        7.37643643515306,
        0.900979927461779,
        3.28450649176802,
        0.346414605778272,
        1.91918806447347,
        0.155570405480644,
        1.28188268101651,
        0.0727950280940698,
        0.927620160077448,
        0.0317696234457983,
        0.708135068697896,
        0.0096705922174015,
        1.56168364217665,
        -0.00306785317168121,
        0.458209053508693,-0.0132218233289650,
        0.375819083499442,
        -0.0502493531206952,-14.2704851855762,
        3.66086457875606,
        -1.40632197142389,
        1.82518181962280,-0.425291550346271,
        1.15890537318457,
        -0.174482184564971,
        0.824086682340952,-0.0802290538084651,
        0.626794819232806,
        -0.0372123106339058,
        0.498604387379541,
        -0.0151864930488915,
        0.409564070550109,
        -0.00306785317168127,
        1.34476476774828,
        0.00412326359120034,
        0.297529484410813,
        0.0127437038269759,
        0.281327288434012,
        33.9271731796379,
        2.95192660452802,
        5.99127846070652,
        0.770173446355448,
        2.67159834601481,
        0.304907517627791,
        1.56247901766638,
        0.142765907489780,
        1.04432403977817,
        0.0714390131171311,
        0.75611411453881,
        0.0355033110908791,
        0.577463335369652,
        0.0157617645031748,
        0.458209053508693,
        0.00412326359120027,
        1.37392412852179,
        -0.00506903343847453,
        0.306869252173055,
        -0.0355905589218347,
        -13.1021524738154,
        3.09219235564068,-1.35228598526935,
        1.55785012509391,
        -0.42878957499005,
        0.993410809928549,-0.186680124341070,
        0.708113828052954,
        -0.0933576181879012,
        0.539443848634976,-0.0495719979667637,
        0.429610299148511,
        -0.0264353280166914,
        0.353200128764924,
        -0.0132218233289650,
        0.297529484410813,
        -0.00506903343847442,
        1.25696486063390,
        0.00392005321816716,
        0.24368231409708,
        27.4454665555356,
        2.52108136337265,
        4.87689908797388,
        0.681387107572845,
        2.18015985900117,
        0.281604646540819,
        1.27707819844879,
        0.139496998656737,
        0.854556963330302,
        0.0756254436816024,
        0.619285288340011,
        0.0426641202626641,
        0.47332304194091,
        0.0240510544071110,
        0.375819083499442,
        0.0127437038269757,
        0.306869252173055,
        0.00392005321816693,
        1.25209329842128,
        -0.0215589090241893,
        -15.1974404066730,
        2.68424920473151,
        -1.77355723741429,
        1.41137203952830,
        -0.625928730647603,
        0.91533912330227,
        -0.305393853225509,
        0.658604608691971,
        -0.174377943404751,
        0.504800798937453,
        -0.109193320138244,
        0.403782198439627,
        -0.0725786971898077,
        0.333071473264385,
        -0.0502493531206951,
        0.281327288434012,
        -0.0355905589218345,
        0.24368231409708,
        -0.0215589090241892,
        1.23362129709203
      ),
      .Dim = c(20L,
               20L)
    )
  )
`sM22` <-
  structure(
    c(
      1.10866489886031,
      -0.257022055546625,
      -0.257022055546625,
      0.607927101854027
    ),
    .Dim = c(2L, 2L)
  )






`ddst.extr.Nk` <-
  function(x,
           base = ddst.base.legendre,
           Dmax = 5,
           n = length(x)) {
    sx  = sort(x)
    er2 = sum(sx * (1:n - n:1)) / (n * (n - 1) * log(2))
    er1 = mean(x) + 0.5772156649 * er2
    maxN = max(min(Dmax, length(x) - 2, 20), 1)

    u = NULL
    for (j in 1:maxN)
      u[j] = ddst.phi(1 - pgumbel(-x, -er1, er2), j, base)
    coord = NULL
    gg1 = mean(1 - exp((x - er1) / er2))
    gg2 = mean((1 - exp((x - er1) / er2)) * (x - er1) / er2 + 1)
    for (k in 1:Dmax) {
      korekta = u[1:k] + t(MMextr12[[k]]) %*% sM22 %*% c(gg1, gg2)
      coord[k] = t(korekta) %*% MMextr[[k]] %*% korekta * n
    }
    coord
  }
pbiecek/ddst documentation built on Aug. 22, 2023, 7:44 p.m.