actuar/0000755000176200001440000000000014522612723011535 5ustar liggesusersactuar/NAMESPACE0000644000176200001440000001132514515770645012770 0ustar liggesusers### C code useDynLib(actuar, .registration = TRUE, .fixes = "C_") ### Imports import(expint) # for C code import(stats, graphics) importFrom(utils, head, tail) ### Exports export( ## Credibility theory cm, ## Simulation of insurance data rcompound, rcomppois, rmixture, rcomphierarc, simul, severity, unroll, ## Risk theory aggregateDist, CTE, TVaR, discretize, discretise, VaR, adjCoef, ruin, ## One parameter distributions dinvexp, pinvexp, qinvexp, rinvexp, minvexp, levinvexp, mexp, levexp, mgfexp, dlogarithmic, plogarithmic, qlogarithmic, rlogarithmic, dztpois, pztpois, qztpois, rztpois, dztgeom, pztgeom, qztgeom, rztgeom, ## Two parameter distributions munif, levunif, mgfunif, mnorm, mgfnorm, mbeta, levbeta, mgamma, levgamma, mgfgamma, mchisq, levchisq, mgfchisq, dinvgamma, pinvgamma, qinvgamma, rinvgamma, minvgamma, levinvgamma, mgfinvgamma, dinvparalogis, pinvparalogis, qinvparalogis, rinvparalogis, minvparalogis, levinvparalogis, dinvpareto, pinvpareto, qinvpareto, rinvpareto, minvpareto, levinvpareto, dinvweibull, pinvweibull, qinvweibull, rinvweibull, minvweibull, levinvweibull, dlgompertz, plgompertz, qlgompertz, rlgompertz, mlgompertz, levlgompertz, # aliases dlgamma, plgamma, qlgamma, rlgamma, mlgamma, levlgamma, dllogis, pllogis, qllogis, rllogis, mllogis, levllogis, mlnorm, levlnorm, dparalogis, pparalogis, qparalogis, rparalogis, mparalogis, levparalogis, dpareto, ppareto, qpareto, rpareto, mpareto, levpareto, dpareto1, ppareto1, qpareto1, rpareto1, mpareto1, levpareto1, mweibull, levweibull, ## minvGauss, levinvGauss, mgfinvGauss, [defunct v3.0-0] dgumbel, pgumbel, qgumbel, rgumbel, mgumbel, mgfgumbel, dinvgauss, pinvgauss, qinvgauss, rinvgauss, minvgauss, levinvgauss, mgfinvgauss, dztnbinom, pztnbinom, qztnbinom, rztnbinom, dztbinom, pztbinom, qztbinom, rztbinom, dzmlogarithmic, pzmlogarithmic, qzmlogarithmic, rzmlogarithmic, dzmpois, pzmpois, qzmpois, rzmpois, dzmgeom, pzmgeom, qzmgeom, rzmgeom, dpoisinvgauss, ppoisinvgauss, qpoisinvgauss, rpoisinvgauss, dpig, ppig, qpig, rpig, # aliases ## Three parameter distributions dburr, pburr, qburr, rburr, mburr, levburr, dgenpareto, pgenpareto, qgenpareto, rgenpareto, mgenpareto, levgenpareto, dinvburr, pinvburr, qinvburr, rinvburr, minvburr, levinvburr, dinvtrgamma, pinvtrgamma, qinvtrgamma, rinvtrgamma, minvtrgamma, levinvtrgamma, dtrgamma, ptrgamma, qtrgamma, rtrgamma, mtrgamma, levtrgamma, dpareto2, ppareto2, qpareto2, rpareto2, mpareto2, levpareto2, dpareto3, ppareto3, qpareto3, rpareto3, mpareto3, levpareto3, dzmnbinom, pzmnbinom, qzmnbinom, rzmnbinom, dzmbinom, pzmbinom, qzmbinom, rzmbinom, ## Four parameter distributions dgenbeta, pgenbeta, qgenbeta, rgenbeta, mgenbeta, levgenbeta, dtrbeta, ptrbeta, qtrbeta, rtrbeta, mtrbeta, levtrbeta, dpearson6, ppearson6, qpearson6, rpearson6, mpearson6, levpearson6, #aliases dpareto4, ppareto4, qpareto4, rpareto4, mpareto4, levpareto4, ## Five parameter distributions dfpareto, pfpareto, qfpareto, rfpareto, mfpareto, levfpareto, ## Phase-type distributions dphtype, pphtype, rphtype, mphtype, mgfphtype, ## Loss distributions grouped.data, ogive, emm, mde, elev, coverage, var, sd ) ### Methods S3method("[", grouped.data) S3method("[<-", grouped.data) S3method(aggregate, portfolio) S3method(CTE, aggregateDist) S3method(diff, aggregateDist) S3method(elev, default) S3method(elev, grouped.data) S3method(emm, default) S3method(emm, grouped.data) S3method(frequency, portfolio) S3method(hist, grouped.data) S3method(knots, ogive) S3method(knots, elev) S3method(mean, aggregateDist) S3method(mean, grouped.data) S3method(sd, default) S3method(sd, grouped.data) S3method(var, default) S3method(var, grouped.data) S3method(ogive, default) S3method(ogive, grouped.data) S3method(plot, adjCoef) S3method(plot, aggregateDist) S3method(plot, elev) S3method(plot, ogive) S3method(plot, ruin) S3method(predict, bstraub) S3method(predict, cm) S3method(predict, hache) S3method(predict, hierarc) S3method(predict, bayes) S3method(print, aggregateDist) S3method(print, elev) S3method(print, cm) S3method(print, mde) S3method(print, ogive) S3method(print, summary.ogive) S3method(print, portfolio) S3method(print, summary.aggregateDist) S3method(print, summary.cm) S3method(quantile, aggregateDist) S3method(quantile, grouped.data) S3method(severity, default) S3method(severity, portfolio) S3method(summary, aggregateDist) S3method(summary, cm) S3method(summary, grouped.data) S3method(summary, elev) S3method(summary, ogive) S3method(VaR, aggregateDist) S3method(weights, portfolio) actuar/demo/0000755000176200001440000000000014515770645012473 5ustar liggesusersactuar/demo/simulation.R0000644000176200001440000000605314515770645015006 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Demo of the portfolio simulation facilities provided by actuar ### ### AUTHOR: Vincent Goulet require(actuar) ## A simple Compound Poisson model: S_t = C_1 + ... + C_{N_t}, with ## N_t ~ Poisson(10), C ~ Lognormal(log(1500) - 1, 1). The names of ## the components serve no purpose here but are required. pf <- rcomphierarc(list(y = 10), model.freq = expression(y = rpois(10)), model.sev = expression(y = rlnorm(log(1500) - 1, 1))) pf # print method aggregate(pf) # aggregate claim amounts frequency(pf) # frequencies severity(pf) # individual claim amounts severity(pf, splitcol = 10) # last period separate ## Simple (continuous) mixture of models: S_t|Theta ~ Poisson(Theta), ## Theta ~ Gamma(2, 1). Any names can be used in the model. pf <- rcomphierarc(list(Theta = 1, S = 10), model.freq = expression(Theta = rgamma(2, 1), S = rpois(Theta))) aggregate(pf) # actual data frequency(pf) # same, here ## Model with with mixtures for both frequency and severity. pf <- rcomphierarc(list(entity = 10, year = 5), model.freq = expression(entity = rgamma(2, 1), year = rpois(entity)), model.sev = expression(entity = rnorm(5, 1), year = rlnorm(entity, 1))) pf aggregate(pf) frequency(pf) ## Same model as above, but with weights incorporated into the model. ## The string "weights" should appear in the model specification ## wherever weights are to be used. wit <- runif(10, 2, 10) (wit <- runif(50, rep(0.5 * wit, each = 5), rep(1.5 * wit, each = 5))) (pf <- rcomphierarc(list(entity = 10, year = 5), model.freq = expression(entity = rgamma(2, 1), year = rpois(weights * entity)), model.sev = expression(entity = rnorm(5, 1), year = rlnorm(entity, 1)), weights = wit)) weights(pf) # extraction of weights ## Three level hierarchical model (sector, unit, contract). Claim ## severity varies only by sector and unit. The number of "nodes" at ## each level is different. nodes <- list(sector = 2, unit = c(3, 4), contract = c(10, 5, 8, 5, 7, 11, 4), year = 6) mf <- expression(sector = rexp(2), unit = rgamma(sector, 0.1), contract = rgamma(unit, 1), year = rpois(weights * contract)) ms <- expression(sector = rnorm(2, sqrt(0.1)), unit = rnorm(sector, 1), contract = NULL, year = rlnorm(unit, 1)) wijkt <- runif(50, 2, 10) wijkt <- runif(300, rep(0.5 * wijkt, each = 6), rep(1.5 * wijkt, each = 6)) pf <- rcomphierarc(nodes, model.freq = mf, model.sev = ms, weights = wijkt) frequency(pf) weights(pf) actuar/demo/risk.R0000644000176200001440000003024614264305077013565 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Demo of the risk theory facilities provided by actuar ### ### AUTHORS: Christophe Dutang, Vincent Goulet require(actuar) require(graphics) ### DISCRETIZATION OF CONTINUOUS DISTRIBUTIONS ## Upper and lower discretization of a Gamma(2, 1) distribution with a ## step (or span, or lag) of 0.5. The value of 'to' is chosen so as to ## cover most of the distribution. x <- seq(0, qgamma(1 - 1E-6, 2, 1), by = 0.5) xu <- tail(x, 1) fu <- discretize(pgamma(x, 2, 1), method = "upper", from = 0, to = xu, step = 0.5) fl <- discretize(pgamma(x, 2, 1), method = "lower", from = 0, to = xu, step = 0.5) curve(pgamma(x, 2, 1), xlim = range(x), lwd = 2) par(col = "blue") plot(stepfun(head(x, -1), diffinv(fu)), pch = 19, add = TRUE) par(col = "green") plot(stepfun(x, diffinv(fl)), pch = 19, add = TRUE) par(col = "black") ## Discretization with the rounding method, which has the true cdf ## pass through the midpoints of the intervals [x - step/2, x + ## step/2). fr <- discretize(pgamma(x, 2, 1), method = "rounding", from = 0, to = xu, step = 0.5) curve(pgamma(x, 2, 1), xlim = range(x), lwd = 2) par(col = "blue") plot(stepfun(head(x, -1), diffinv(fr)), pch = 19, add = TRUE) par(col = "black") ## Local matching of the first moment. This requires a function to ## compute the limited expected value of the true distribution in any ## point. fb <- discretize(pgamma(x, 2, 1), method = "unbiased", lev = levgamma(x, 2, 1), from = 0, to = xu, step = 0.5) curve(pgamma(x, 2, 1), xlim = range(x), lwd = 2) par(col = "blue") plot(stepfun(x, diffinv(fb)), pch = 19, add = TRUE) par(col = "black") all.equal(diff(pgamma(range(x), 2, 1)), sum(fb)) # same total probability all.equal(levgamma(xu, 2, 1) - xu * pgamma(xu, 2, 1, lower.tail = FALSE), drop(crossprod(x, fb))) # same expected value ## Comparison of all four methods fu <- discretize(plnorm(x), method = "upper", from = 0, to = 5) fl <- discretize(plnorm(x), method = "lower", from = 0, to = 5) fr <- discretize(plnorm(x), method = "rounding", from = 0, to = 5) fb <- discretize(plnorm(x), method = "unbiased", from = 0, to = 5, lev = levlnorm(x)) curve(plnorm(x), from = 0, to = 5, lwd = 2) par(col = "blue") plot(stepfun(0:4, diffinv(fu)), pch = 19, add = TRUE) par(col = "red") plot(stepfun(0:5, diffinv(fl)), pch = 19, add = TRUE) par(col = "green") plot(stepfun(0:4, diffinv(fr)), pch = 19, add = TRUE) par(col = "magenta") plot(stepfun(0:5, diffinv(fb)), pch = 19, add = TRUE) legend("bottomright", legend = c("upper", "lower", "rounding", "unbiased"), col = c("blue", "red", "green", "magenta"), lty = 1, pch = 19, text.col = "black") par(col = "black") ### CALCULATION OF THE AGGREGATE CLAIM AMOUNT DISTRIBUTION ## Calculation of the aggregate claim amount distribution using the ## recursive method (Panjer). Argument 'x.scale' is used to specify ## how much a value of 1 is really worth. fx.b <- discretize(pgamma(x, 2, 1), from = 0, to = 22, step = 0.5, method = "unbiased", lev = levgamma(x, 2, 1)) Fs.b <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx.b, lambda = 10, x.scale = 0.5) summary(Fs.b) # summary method knots(Fs.b) # support of Fs.b (knots) Fs.b(knots(Fs.b)) # evaluation at knots plot(Fs.b, do.points = FALSE, verticals = TRUE, xlim = c(0, 60)) # graphic mean(Fs.b) # empirical mean quantile(Fs.b) # quantiles ## Convolutions (exact calculation). Requires a vector of ## probabilities for the frequency model. This method can quickly ## become impractical for a large expected number of claims. pn <- dpois(0:qpois(1-1E-6, 10), 10) Fs <- aggregateDist("convolution", model.freq = pn, model.sev = fx.b, x.scale = 0.5) summary(Fs) # summary method knots(Fs) # support of Fs (knots) Fs(knots(Fs)) # evaluation at knots plot(Fs, do.points = FALSE, verticals = TRUE, xlim = c(0, 60)) # graphic mean(Fs) # empirical mean quantile(Fs) # quantiles ## Normal approximation. Not hugely useful, but simple to implement... Fs.n <- aggregateDist("normal", moments = c(20, 60)) summary(Fs.n) # summary method plot(Fs.n, xlim = c(0, 60)) # graphic mean(Fs.n) # true mean quantile(Fs.n) # normal quantiles ## Normal Power II approximation. The approximation is valid for ## values above the expected value only. Fs.np <- aggregateDist("npower", moments = c(20, 60, 0.516398)) summary(Fs.np) # summary method plot(Fs.np, xlim = c(0, 60)) # truncated graphic ## Simulation method. Function 'simul' is used to simulate the data ## (see the 'simulation' demo for examples). Fs.s <- aggregateDist("simulation", model.freq = expression(y = rpois(10)), model.sev = expression(y = rgamma(2, 1)), nb.simul = 10000) summary(Fs.s) # summary method plot(Fs.s, do.points = FALSE, verticals = TRUE, xlim = c(0, 60)) # graphic mean(Fs.s) # empirical mean quantile(Fs.s) # quantiles ## Graphic comparing the cdfs obtained by a few methods. fx.u <- discretize(pgamma(x, 2, 1), from = 0, to = 22, step = 0.5, method = "upper") Fs.u <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx.u, lambda = 10, x.scale = 0.5) fx.l <- discretize(pgamma(x, 2, 1), from = 0, to = 22, step = 0.5, method = "lower") Fs.l <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx.l, lambda = 10, x.scale = 0.5) par(col = "black") plot(Fs.b, do.points = FALSE, verticals = TRUE, xlim = c(0, 60), sub = "") par(col = "blue") plot(Fs.u, do.points = FALSE, verticals = TRUE, add = TRUE, sub = "") par(col = "red") plot(Fs.l, do.points = FALSE, verticals = TRUE, add = TRUE, sub = "") par(col = "green") plot(Fs.s, do.points = FALSE, verticals = TRUE, add = TRUE, sub = "") par(col = "magenta") plot(Fs.n, add = TRUE, sub = "") legend("bottomright", legend = c("recursive + unbiased", "recursive + upper", "recursive + lower", "simulation", "normal approximation"), col = c("black", "blue", "red", "green", "magenta"), lty = 1, text.col = "black", cex = 1.2) par(col = "black") ## Table of quantiles for the same methods as graphic above. x <- knots(Fs.l) m <- which.min(x[round(Fs.l(x), 6) > 0]) M <- which.max(x[round(Fs.u(x), 6) < 1]) x <- x[round(seq.int(from = m, to = M, length = 30))] round(cbind(x = x, Lower = Fs.l(x), Unbiased = Fs.b(x), Upper = Fs.u(x), Simulation = Fs.s(x), Normal = Fs.n(x)), 6) ### CALCULATION OF THE ADJUSTMENT COEFFICIENT ## No reinsurance, generalized Erlang claim amounts, inverse gamma ## interarrival times and independence. The adjustment coefficient is ## increasing with the safety loading. mgf <- function(x) 1/(1 - x) * 2/(2 - x) * 3/(3 - x) adjCoef(mgf, mgfinvgamma(x, 2, 6/11), 1.1, 1) adjCoef(mgf, mgfinvgamma(x, 2, 6/11), 1.2, 1) adjCoef(mgf, mgfinvgamma(x, 2, 6/11), 1.3, 1) ## More sophisticated example: comparison of the effect of dependence ## on the adjustment coefficient in the case of proportional ## reinsurance. Use a Clayton copula with exponential marginals. rclayton <- function(alpha, n) { val <- cbind(runif(n), runif(n)) val[, 2] <- (val[, 1]^(-alpha) * (val[, 2]^(-alpha/(alpha + 1)) - 1) + 1)^(-1/alpha) val } u <- rclayton(2, 1000) # variates with positive dependence x <- qexp(u[, 1]) # claim amounts w <- qexp(u[, 2]) # interarrival times ## Premium rate and Lundberg's functions of the retention rate. We ## assume a safety loading of 20% for the insurer and 30% for the ## reinsurer and premium calculated with the expected value principle. p <- function(a) mean(x)/mean(w) * (1.2 - 1.3 + 1.3 * a) h <- function(r, a) mean(exp(r * (a * x - p(a) * w))) R1 <- adjCoef(h = h, upper = 1, reinsurance = "prop", from = 1/3, to = 1) plot(R1) ## Repeat the above with independent claim amounts and interarrival ## times. u <- rclayton(1, 1000) # independent variates x <- qexp(u[,1]) # claim amounts w <- qexp(u[,2]) # interarrival times R2 <- adjCoef(h = h, upper = 1, reinsurance = "prop", from = 1/3, to = 1) plot(R2, add = TRUE, col = "green") legend("bottomright", legend = c("dependence", "independence"), col = c("black", "green"), lty = 1) ## Similar example with excess-of-loss reinsurance. ## positive dependence u <- rclayton(2, 1000) # variates with positive dependence x <- qexp(u[,1]) # claim amounts w <- qexp(u[,2]) # interarrival times p <- function(L) mean(x)/mean(w) * (1.2 - 1.3) + 1.3 * mean(pmin(L, x))/mean(w) h <- function(r, L) mean(exp(r * (pmin(L, x) - p(L) * w))) R3 <- adjCoef(h = h, upper = 1, reinsurance = "prop", from = 0, to = 10) plot(R3) u <- rclayton(1, 1000) # independent variates x <- qexp(u[,1]) # claim amounts w <- qexp(u[,2]) # interarrival times R4 <- adjCoef(h = h, upper = 1, reinsurance = "prop", from = 0, to = 10) plot(R4, add = TRUE, col = "green") legend("bottomright", legend = c("dependence", "independence"), col = c("black", "green"), lty = 1) ### CALCULATION OF RUIN PROBABILITIES ## Case with an explicit formula: exponential claims and interarrival ## times. Safety loading is always 20% and premiums are always ## calculated according to the expected value principle. psi <- ruin(claims = "exponential", par.claims = list(rate = 1), wait = "exponential", par.wait = list(rate = 1), premium = 1.2) psi(0:10) plot(psi, from = 0, to = 10) ## Exponential claims and hyper-exponential interarrival times. psi <- ruin(claims = "exponential", par.claims = list(rate = 2), wait = "exponential", par.wait = list(rate = c(2, 3, 1)/2, w = c(2, 3, 1)/6), premium = 1.2) psi(0:10) ## Hyper-exponential claims and interarrival times. psi <- ruin(claims = "exponential", par.claims = list(rate = c(2, 3, 1)/2, w = c(2, 3, 1)/6), wait = "exponential", par.wait = list(rate = c(2, 3, 1)/4, w = c(2, 3, 1)/6), premium = 0.6) psi(0:10) ## Exponential claims and Erlang interarrival times psi <- ruin(claims = "exponential", par.claims = list(rate = 2), wait = "Erlang", par.wait = list(shape = 2, rate = 1), premium = 1.2) psi(0:10) ## Erlang claims and interarrival times psi <- ruin(claims = "Erlang", par.claims = list(shape = 2, rate = 2), wait = "Erlang", par.wait = list(shape = 2, rate = 1), premium = 0.6) psi(0:10) ## Mixture of Erlang for claims and Erlang interarrival times psi <- ruin(claims = "Erlang", par.claims = list(shape = c(2, 4), rate = c(1, 3), w = c(1, 2)/3), wait = "Erlang", par.wait = list(shape = 2, rate = 1), premium = 1.2) psi(0:10) ## Generalized Erlang claims and mixture of two generalized Erlang ## interarrival times. These must be given as phase-type distributions ## to 'ruin'. prob.c <- c(1, 0, 2, 0)/3 rate.c <- cbind(c(-1, 0, 0, 0), c(1, -3, 0, 0), c(0, 0, -2, 0), c(0, 0, 2, -3)) mean.c <- mphtype(1, prob.c, rate.c) prob.w <- c(1, 0, 0) rate.w <- cbind(c(-1, 0, 0), c(1, -2, 0), c(0, 2, -3)) mean.w <- mphtype(1, prob.w, rate.w) psi <- ruin(claims = "phase-type", par.claims = list(prob = prob.c, rate = rate.c), wait = "phase-type", par.wait = list(prob = prob.w, rate = rate.w), premium = 1.2 * mean.c/mean.w) psi(0:10) par(op) actuar/demo/credibility.R0000644000176200001440000000612414264305077015116 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Demo of the credibility theory facilities provided by actuar ### ### AUTHOR: Vincent Goulet require(actuar) ## The package provides the famous data set of Hachemeister (1975) as ## a matrix of 5 lines (one for each state) and 25 columns (the state ## number, 12 periods of ratios, 12 periods of corresponding weights). data(hachemeister) hachemeister ## Fitting of a Buhlmann model to the Hachemeister data set using ## function 'cm'. The interface of the function is similar to 'lm'. fit <- cm(~state, hachemeister, ratios = ratio.1:ratio.12) fit # print method summary(fit) # more information fit$means # (weighted) averages fit$weights # total weights fit$unbiased # unbiased variance estimators predict(fit) # credibility premiums ## Fitting of a Buhlmann-Straub model require weights. Here, iterative ## estimators of the variance components are used. fit <- cm(~state, hachemeister, ratios = ratio.1:ratio.12, weights = weight.1:weight.12, method = "iterative") summary(fit) predict(fit) ## Simulation of a three level hierarchical portfolio. nodes <- list(sector = 2, unit = c(3, 4), contract = c(10, 5, 8, 5, 7, 11, 4), year = 6) mf <- expression(sector = rexp(2), unit = rgamma(sector, 0.1), contract = rgamma(unit, 1), year = rpois(weights * contract)) ms <- expression(sector = rnorm(2, sqrt(0.1)), unit = rnorm(sector, 1), contract = NULL, year = rlnorm(unit, 1)) wijkt <- runif(50, 2, 10) wijkt <- runif(300, rep(0.5 * wijkt, each = 6), rep(1.5 * wijkt, each = 6)) pf <- simul(nodes, model.freq = mf, model.sev = ms, weights = wijkt) ## Fitting of a hierarchical model to the portfolio simulated above. DB <- cbind(weights(pf, prefix = "weight."), aggregate(pf, classif = FALSE) / weights(pf, classif = FALSE)) fit <- cm(~sector + sector:unit + sector:unit:contract, data = DB, ratios = year.1:year.6, weights = weight.year.1:weight.year.6) fit predict(fit) # credibility premiums predict(fit, levels = "unit") # unit credibility premiums only summary(fit) # portfolio summary summary(fit, levels = "unit") # unit portfolio summary only ## Fitting of Hachemeister regression model with intercept at time origin. fit <- cm(~state, hachemeister, ratios = ratio.1:ratio.12, weights = weight.1:weight.12, regformula = ~time, regdata = data.frame(time = 1:12)) summary(fit, newdata = data.frame(time = 13)) # 'newdata' is the future value of regressor predict(fit, newdata = data.frame(time = 13)) ## Position the intercept at the barycenter of time. fit <- cm(~state, hachemeister, ratios = ratio.1:ratio.12, weights = weight.1:weight.12, regformula = ~time, regdata = data.frame(time = 1:12), adj.intercept = TRUE) summary(fit, newdata = data.frame(time = 13)) actuar/demo/lossdist.R0000644000176200001440000002447714264305077014472 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Demo of the loss distributions facilities provided by actuar ### ### AUTHOR: Vincent Goulet require(actuar) require(graphics) ### A utility function to create graphs for probability laws showgraphs <- function(fun, par, what = c("d", "p", "m", "lev"), xlim) { dist <- switch(fun, trbeta = "TRANSFORMED BETA DISTRIBUTION", genpareto = "GENERALIZED PARETO DISTRIBUTION", burr = "BURR DISTRIBUTION", invburr = "INVERSE BURR DISTRIBUTION", pareto = "PARETO DISTRIBUTION", invpareto = "INVERSE PARETO DISTRIBUTION", llogis = "LOGLOGISTIC DISTRIBUTION", paralogis = "PARALOGISTIC DISTRIBUTION", invparalogis = "INVERSE PARALOGISTIC DISTRIBUTION", trgamma = "TRANSFORMED GAMMA DISTRIBUTION", invtrgamma = "INVERSE TRANSFORMED GAMMA DISTRIBUTION", invgamma = "INVERSE GAMMA DISTRIBUTION", weibull = "WEIBULL DISTRIBUTION", invweibull = "INVERSE WEIBULL DISTRIBUTION", invexp = "INVERSE EXPONENTIAL DISTRIBUTION", pareto1 = "SINGLE PARAMETER PARETO DISTRIBUTION", lgamma = "LOGGAMMA DISTRIBUTION", genbeta = "GENERALIZED BETA DISTRIBUTION", phtype = "PHASE-TYPE DISTRIBUTION", gamma = "GAMMA DISTRIBUTION", exp = "EXPONENTIAL DISTRIBUTION", chisq = "CHI-SQUARE DISTRIBUTION", lnorm = "LOGNORMAL DISTRIBUTION", invgauss = "INVERSE GAUSSIAN DISTRIBUTION", norm = "NORMAL DISTRIBUTION", beta = "BETA DISTRIBUTION", unif = "UNIFORM DISTRIBUTION") if (missing(xlim)) { qf <- match.fun(paste("q", fun, sep = "")) formals(qf)[names(par)] <- par xlim <- c(0, qf(0.999)) } k <- seq.int(4) limit <- seq(0, xlim[2], len = 10) mfrow = c(ceiling(length(what) / 2), 2) op <- par(mfrow = mfrow, oma = c(0, 0, 2, 0)) for (t in what) { f <- match.fun(paste(t, fun, sep = "")) formals(f)[names(par)] <- par main <- switch(t, "d" = "Probability Density Function", "p" = "Cumulative Distribution Function", "m" = "Raw Moments", "lev" = "Limited Expected Value Function", "mgf" = "Moment Generating Function") if (t == "m") plot(k, f(k), type = "l", col = 4, lwd = 2, main = main) else if (t == "lev") plot(limit, f(limit), type = "l", col = 4, lwd = 2, main = main) else if (t == "mgf") curve(f(x), xlim = c(0, 2), col = 4, lwd = 2, main = main) else curve(f(x), xlim = xlim, col = 4, lwd = 2, main = main) title(main = dist, outer = TRUE) } par(op) } ### ### DATA SETS ### ## The package includes the individual dental claims and grouped ## dental claims data sets often referred to in Klugman, Panjer & ## Willmot (1998, 2004) data(dental); dental data(gdental); gdental ### ### PROBABILITY LAWS ### ## Illustration of the new probability laws functions provided by the ## package. ## TRANSFORMED BETA FAMILY ## Transformed beta distribution showgraphs("trbeta", list(shape1 = 3, shape2 = 4, shape3 = 5, scale = 10)) ## Generalized Pareto distribution showgraphs("genpareto", list(shape1 = 10, shape2 = 4, scale = 10)) ## Burr distribution showgraphs("burr", list(shape1 = 3, shape2 = 4, scale = 10)) ## Inverse Burr distribution showgraphs("invburr", list(shape1 = 3, shape2 = 6, scale = 10)) ## Pareto distribution showgraphs("pareto", list(shape = 10, scale = 10)) ## Inverse Pareto distribution showgraphs("invpareto", list(shape = 4, scale = 1), what = c("d", "p")) ## Loglogistic distribution showgraphs("llogis", list(shape = 6, scale = 10)) ## Paralogistic distribution showgraphs("paralogis", list(shape = 3, scale = 10)) ## Inverse paralogistic distribution showgraphs("invparalogis", list(shape = 6, scale = 10)) ## TRANSFORMED GAMMA FAMILY ## Transformed gamma distribution showgraphs("trgamma", list(shape1 = 3, shape2 = 1, scale = 10)) ## Inverse transformed gamma distribution showgraphs("invtrgamma", list(shape1 = 3, shape2 = 2, scale = 10)) ## Inverse gamma distribution showgraphs("invgamma", list(shape = 6, scale = 10)) ## Weibull distribution ('mweibull' and 'levweibull') showgraphs("weibull", list(shape = 1.5, scale = 10)) ## Inverse Weibull distribution showgraphs("invweibull", list(shape = 6, scale = 10)) ## Inverse exponential distribution showgraphs("invexp", list(rate = 1), what = c("d", "p")) ## OTHER DISTRIBUTIONS ## Single parameter Pareto distribution showgraphs("pareto1", list(shape = 5, min = 10), xlim = c(0, 50)) ## Loggamma distribution showgraphs("lgamma", list(shapelog = 2, ratelog = 5)) ## Generalized beta distribution showgraphs("genbeta", list(shape1 = 1, shape2 = 2, shape3 = 3, scale = 2)) ## Phase-type distribution showgraphs("phtype", list(prob = c(0.5614, 0.4386), rates = matrix(c(-8.64, 0.101, 1.997, -1.095), 2, 2)), what = c("d", "p", "m", "mgf"), xlim = c(0.001, 5)) ## DISTRIBUTIONS ALREADY IN R ## Gamma distribution showgraphs("gamma", list(shape = 3, rate = 5), what = c("m", "lev", "mgf")) ## Chi-square distribution showgraphs("chisq", list(df = 3), what = c("m", "lev", "mgf")) ## Exponential distribution showgraphs("exp", list(rate = 5), what = c("m", "lev", "mgf")) ## Lognormal distribution showgraphs("lnorm", list(meanlog = 1, sdlog = 1), what = c("m", "lev")) ## Inverse gaussian distribution (from package SuppDists) showgraphs("invgauss", list(nu = 1, lambda = 10), what = c("m", "lev", "mgf"), xlim = c(0, 10)) ## Normal distribution showgraphs("norm", list(mean = 0, sd = 1), what = c("m", "mgf")) ## Beta distribution showgraphs("beta", list(shape1 = 1, shape2 = 2), what = c("m", "lev")) ## Uniform distribution showgraphs("unif", list(min = 0, max = 1), what = c("m", "lev", "mgf")) ### ### GROUPED DATA MANIPULATION ### ## Creation of grouped data objects x <- grouped.data(groups = c(0, 25, 50, 100, 150, 250, 500), line1 = c(30, 31, 57, 42, 65, 84), line2 = c(26, 33, 31, 19, 16, 11)) x ## Extraction and replacement: only "[" and "[<-" are officially ## supported. x[, 1] # group boundaries x[1] # notice the difference x[, -1] # group frequencies x[1:3,] # first 3 groups x[1, 2] <- 22; x # frequency replacement x[1, 1] <- c(0, 20); x # boundary replacement ## Mean, variance and standard deviation for grouped data objects. mean(x) var(x) sd(x) ## In the sequel, only the first frequencies column is considered. x <- x[, -3] ## Function 'hist' handles individual data only. We provide a method ## for grouped data. hist(x) ## Function 'ogive' returns a function to compute the ogive of grouped ## data in any point, much like 'ecdf' does for individual data. ## Methods also exist to extract the group boundaries ('knots') and ## to plot the ogive. Fnt <- ogive(x) summary(Fnt) knots(Fnt) # group boundaries Fnt(knots(Fnt)) # ogive at group boundaries plot(Fnt) # plot of the ogive ## The method of 'quantile' for grouped data objects computes linearly ## smoothed quantiles, that is the inverse of the ogive in various ## points. quantile(x) Fnt(quantile(x)) ## The method of 'summary' for grouped data objects returns the ## quantiles and the mean in a single object. summary(x) ### ### EMPIRICAL MOMENTS CALCULATION ### ## Function 'emm' computes the k-th empirical moment of a sample, ## whether it is individual or grouped data. emm(dental) # == mean(dental) emm(gdental) # == mean(gdental) emm(dental, order = 1:3) # first three moments emm(gdental, order = 1:3) # idem ## Function 'elev' is similar to 'ecdf' and 'ogive' in that it returns ## a function to compute the empirical limited expected value (first ## limited moment) for any limit. There are methods for individual and ## grouped data. lev <- elev(dental) lev(knots(lev)) # ELEV at data points plot(lev, type = "o", pch = 19) # plot of the ELEV function lev <- elev(gdental) lev(knots(lev)) # ELEV at data points plot(lev, type = "o", pch = 19) # plot of the ELEV function ### ### MINIMUM DISTANCE ESTIMATION ### ## Maximum likelihood estimation (for individual data) is well covered ## by 'fitdistr' in package MASS. We provide function 'mde' to fit ## models using three distance minimization techniques: Cramer-von ## Mises (for individual and grouped data), chi-square and layer ## average severity (both grouped data only). Usage (and inner ## working) is very similar to 'fitdistr'. mde(dental, pexp, start = list(rate = 1/200), measure = "CvM") mde(gdental, pexp, start = list(rate = 1/200), measure = "CvM") mde(gdental, pexp, start = list(rate = 1/200), measure = "chi-square") mde(gdental, levexp, start = list(rate = 1/200), measure = "LAS") ### ### COVERAGE MODIFICATIONS ### ## Function 'coverage' is useful to obtain the probability density ## function (pdf) or cumulative distribution function (cdf) of a loss ## random variable under coverage modifications. f <- coverage(dgamma, pgamma, deductible = 1, limit = 7) curve(dgamma(x, 3), xlim = c(0, 10), ylim = c(0, 0.3)) # original curve(f(x, 3), xlim = c(0.01, 5.99), col = 4, add = TRUE) # modified x <- rgamma(1000, 3, 1) # sample of claim amounts x <- pmin(x, 7)[x > 1] - 1 # deductible and limit library(MASS) # for ML estimation m <- mean(x) # empirical mean v <- var(x) # empirical variance (p <- fitdistr(x, f, start = list(shape = m^2/v, rate = m/v))$estimate ) # MLE hist(x + 1, breaks = 0:10, prob = TRUE) # histogram of observed data curve(dgamma(x, p[1], p[2]), add = TRUE) # fit of underlying distribution par(op) actuar/demo/00Index0000644000176200001440000000023114264305077013613 0ustar liggesuserscredibility credibility theory lossdist loss distributions modeling risk risk and ruin theory simulation simulation of compound hierarchical models actuar/data/0000755000176200001440000000000014264305077012452 5ustar liggesusersactuar/data/hachemeister.rda0000644000176200001440000000111214264305077015576 0ustar liggesusers]=hSQOVӠk7D4mE2bjr*t(šITM8 (88888:(tppss7O9^)C0{apzDX9" gѬ{pI8]X.B/)O瘰|ě]@'VS~kɏ?!ou3O|_xy\q|ߘ:?7s̼[g_,S:ͲpݛgT$EP~-n7F8M|}M?+3wi|G%,kP2 sϓm%\Z;*~[|_ŹZ aSߞƷļ_Su_my|_.oJb]q57ثv^Juc P&tuF{݅8eܖ}LزߖeҖ!ڈ::h/w-k~wtO @GԮactuar/data/gdental.rda0000644000176200001440000000130114264305077014553 0ustar liggesusersVn@^ۉWH Xmjxġr쐐q"yȁYN8 @Xxyfw/?yttnCA8RoNv#9wYis5i8Xő.-σ`o3)Z#pC}kh[@kYu)V@(B2r=(!r27,l!pt(Rxz~'!kW{l?16#o*UdG3)įj28Dg[F:m?I`lCo T&Ue>I-@n\ ZXk&Z':YI"Rc>k%=*O{S3GEEXmB{ML)_[]Y+Z-8Y{?WH=*i fza624]w ga۵ vY _հ ;O/1-"O$Դ Ѕ ( a3(9އSe*_VG r.&/P`בȦ. ^< 5 Y=L5M(WrSj+qf^ actuar/data/dental.rda0000644000176200001440000000014514264305077014411 0ustar liggesusers r0b```b`bfb H020piԼ 0v.P.(p(ρQ t(?B@actuar/man/0000755000176200001440000000000014522560035012306 5ustar liggesusersactuar/man/emm.Rd0000644000176200001440000000361214264305077013363 0ustar liggesusers\name{emm} \alias{emm} \alias{emm.default} \alias{emm.grouped.data} \title{Empirical Moments} \description{ Raw empirical moments for individual and grouped data. } \usage{ emm(x, order = 1, \dots) \method{emm}{default}(x, order = 1, \dots) \method{emm}{grouped.data}(x, order = 1, \dots) } \arguments{ \item{x}{a vector or matrix of individual data, or an object of class \code{"grouped data"}.} \item{order}{order of the moment. Must be positive.} \item{\dots}{further arguments passed to or from other methods.} } \details{ Arguments \code{\dots} are passed to \code{\link{colMeans}}; \code{na.rm = TRUE} may be useful for individual data with missing values. For individual data, the \eqn{k}th empirical moment is \eqn{\sum_{j = 1}^n x_j^k}{sum(j; x[j]^k)}. For grouped data with group boundaries \eqn{c_0, c_1, \dots, c_r}{c[0], c[1], \dots, c[r]} and group frequencies \eqn{n_1, \dots, n_r}{n[1], \dots, n[r]}, the \eqn{k}th empirical moment is \deqn{\frac{1}{n} \sum_{j = 1}^r \frac{n_j (c_j^{k + 1} - c_{j - 1}^{k + 1})}{% (k + 1) (c_j - c_{j - 1})},}{% (1/n) * sum(j; (n[j] * {c[j]^(k+1) - c[j-1]^(k+1)})/% ((k+1) * {c[j] - c[j-1]})),} where \eqn{n = \sum_{j = 1}^r n_j}{n = sum(j; n[j])}. } \value{ A named vector or matrix of moments. } \seealso{ \code{\link{mean}} and \code{\link{mean.grouped.data}} for simpler access to the first moment. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (1998), \emph{Loss Models, From Data to Decisions}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ ## Individual data data(dental) emm(dental, order = 1:3) ## Grouped data data(gdental) emm(gdental) x <- grouped.data(cj = gdental[, 1], nj1 = sample(1:100, nrow(gdental)), nj2 = sample(1:100, nrow(gdental))) emm(x) # same as mean(x) } \keyword{univar} actuar/man/rcompound.Rd0000644000176200001440000000653714522530212014610 0ustar liggesusers\name{rcompound} \alias{rcompound} \alias{rcomppois} \title{Simulation from Compound Models} \description{ \code{rcompound} generates random variates from a compound model. \code{rcomppois} is a simplified version for a common case. } \usage{ rcompound(n, model.freq, model.sev, SIMPLIFY = TRUE) rcomppois(n, lambda, model.sev, SIMPLIFY = TRUE)} \arguments{ \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{model.freq, model.sev}{expressions specifying the frequency and severity simulation models with the number of variates omitted; see Details.} \item{lambda}{Poisson parameter.} \item{SIMPLIFY}{boolean; if \code{FALSE} the frequency and severity variates are returned along with the aggregate variates.} } \details{ \code{rcompound} generates variates from a random variable of the form \deqn{S = X_1 + ... X_N,} where \eqn{N} is the frequency random variable and \eqn{X_1, X_2, \dots} are the severity random variables. The latter are mutually independent, identically distributed and independent from \eqn{N}. \code{model.freq} and \code{model.sev} specify the simulation models for the frequency and the severity random variables, respectively. A model is a complete call to a random number generation function, with the number of variates omitted. This is similar to \code{\link{rcomphierarc}}, but the calls need not be wrapped into \code{\link{expression}}. Either argument may also be the name of an object containing an expression, in which case the object will be evaluated in the parent frame to retrieve the expression. The argument of the random number generation functions for the number of variates to simulate \strong{must} be named \code{n}. \code{rcomppois} generates variates from the common Compound Poisson model, that is when random variable \eqn{N} is Poisson distributed with mean \code{lambda}. } \value{ When \code{SIMPLIFY = TRUE}, a vector of aggregate amounts \eqn{S_1, \dots, S_n}. When \code{SIMPLIFY = FALSE}, a list of three elements: \item{\code{aggregate}}{vector of aggregate amounts \eqn{S_1, \dots, S_n};} \item{\code{frequency}}{vector of frequencies \eqn{N_1, \dots, N_n};} \item{\code{severity}}{vector of severities \eqn{X_1, X_2, \dots}.} } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \seealso{ \code{\link{rcomphierarc}} to simulate from compound hierarchical models. } \examples{ ## Compound Poisson model with gamma severity. rcompound(10, rpois(2), rgamma(2, 3)) rcomppois(10, 2, rgamma(2, 3)) # same ## Frequencies and individual claim amounts along with aggregate ## values. rcomppois(10, 2, rgamma(2, 3), SIMPLIFY = FALSE) ## Wrapping the simulation models into expression() is allowed, but ## not needed. rcompound(10, expression(rpois(2)), expression(rgamma(2, 3))) \dontrun{## Speed comparison between rcompound() and rcomphierarc(). ## [Also note the simpler syntax for rcompound().] system.time(rcompound(1e6, rpois(2), rgamma(2, 3))) system.time(rcomphierarc(1e6, expression(rpois(2)), expression(rgamma(2, 3))))} ## The severity can itself be a compound model. It makes sense ## in such a case to use a zero-truncated frequency distribution ## for the second level model. rcomppois(10, 2, rcompound(rztnbinom(1.5, 0.7), rlnorm(1.2, 1))) } \keyword{datagen} actuar/man/Loglogistic.Rd0000644000176200001440000000705714264305077015073 0ustar liggesusers\name{Loglogistic} \alias{Loglogistic} \alias{dllogis} \alias{pllogis} \alias{qllogis} \alias{rllogis} \alias{mllogis} \alias{levllogis} \title{The Loglogistic Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments and limited moments for the Loglogistic distribution with parameters \code{shape} and \code{scale}. } \usage{ dllogis(x, shape, rate = 1, scale = 1/rate, log = FALSE) pllogis(q, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) qllogis(p, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) rllogis(n, shape, rate = 1, scale = 1/rate) mllogis(order, shape, rate = 1, scale = 1/rate) levllogis(limit, shape, rate = 1, scale = 1/rate, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{shape, scale}{parameters. Must be strictly positive.} \item{rate}{an alternative way to specify the scale.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The loglogistic distribution with parameters \code{shape} \eqn{= \gamma}{= a} and \code{scale} \eqn{= \theta}{= s} has density: \deqn{f(x) = \frac{\gamma (x/\theta)^\gamma}{% x [1 + (x/\theta)^\gamma]^2}}{% f(x) = a (x/s)^a / (x [1 + (x/s)^a]^2)} for \eqn{x > 0}, \eqn{\gamma > 0}{a > 0} and \eqn{\theta > 0}{b > 0}. The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}, \eqn{-\gamma < k < \gamma}{-shape < k < shape}. The \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]}, \eqn{k > -\gamma}{k > -shape} and \eqn{1 - k/\gamma}{1 - k/shape} not a negative integer. } \value{ \code{dllogis} gives the density, \code{pllogis} gives the distribution function, \code{qllogis} gives the quantile function, \code{rllogis} generates random deviates, \code{mllogis} gives the \eqn{k}th raw moment, and \code{levllogis} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ \code{levllogis} computes the limited expected value using \code{\link{betaint}}. Also known as the Fisk distribution. See also Kleiber and Kotz (2003) for alternative names and parametrizations. The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Kleiber, C. and Kotz, S. (2003), \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ \code{\link{dpareto3}} for an equivalent distribution with a location parameter. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ exp(dllogis(2, 3, 4, log = TRUE)) p <- (1:10)/10 pllogis(qllogis(p, 2, 3), 2, 3) ## mean mllogis(1, 2, 3) ## case with 1 - order/shape > 0 levllogis(10, 2, 3, order = 1) ## case with 1 - order/shape < 0 levllogis(10, 2/3, 3, order = 1) } \keyword{distribution} actuar/man/severity.Rd0000644000176200001440000000244414264305077014461 0ustar liggesusers\name{severity} \alias{severity} \alias{severity.default} \title{Manipulation of Individual Claim Amounts} \description{ \code{severity} is a generic function created to manipulate individual claim amounts. The function invokes particular \emph{methods} which depend on the \code{\link[base]{class}} of the first argument. } \usage{ severity(x, ...) \method{severity}{default}(x, bycol = FALSE, drop = TRUE, \dots) } \arguments{ \item{x}{an \R object.} \item{bycol}{logical; whether to \dQuote{unroll} horizontally (\code{FALSE}) or vertically (\code{TRUE})} \item{\dots}{further arguments to be passed to or from other methods.} \item{drop}{logical; if \code{TRUE}, the result is coerced to the lowest possible dimension.} } \details{ Currently, the default method is equivalent to \code{\link{unroll}}. This is liable to change since the link between the name and the use of the function is rather weak. } \value{ A vector or matrix. } \seealso{ \code{\link{severity.portfolio}} for the original motivation of these functions. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Louis-Philippe Pouliot } \examples{ x <- list(c(1:3), c(1:8), c(1:4), c(1:3)) (mat <- matrix(x, 2, 2)) severity(mat) severity(mat, bycol = TRUE) } \keyword{datagen} \keyword{manip} actuar/man/elev.Rd0000644000176200001440000000473014264305077013542 0ustar liggesusers\name{elev} \alias{elev} \alias{elev.default} \alias{elev.grouped.data} \alias{print.elev} \alias{summary.elev} \alias{knots.elev} \alias{plot.elev} \title{Empirical Limited Expected Value} \description{ Compute the empirical limited expected value for individual or grouped data. } \usage{ elev(x, ...) \method{elev}{default}(x, \dots) \method{elev}{grouped.data}(x, \dots) \method{print}{elev}(x, digits = getOption("digits") - 2, \dots) \method{summary}{elev}(object, \dots) \method{knots}{elev}(Fn, \dots) \method{plot}{elev}(x, \dots, main = NULL, xlab = "x", ylab = "Empirical LEV") } \arguments{ \item{x}{a vector or an object of class \code{"grouped.data"} (in which case only the first column of frequencies is used); for the methods, an object of class \code{"elev"}, typically.} \item{digits}{number of significant digits to use, see \code{\link{print}}.} \item{Fn, object}{an \R object inheriting from \code{"ogive"}.} \item{main}{main title.} \item{xlab, ylab}{labels of x and y axis.} \item{\dots}{arguments to be passed to subsequent methods.} } \details{ The limited expected value (LEV) at \eqn{u} of a random variable \eqn{X} is \eqn{E[X \wedge u] = E[\min(X, u)]}{E[X ^ u] = E[min(X, u)]}. For individual data \eqn{x_1, \dots, x_n}{x[1], \dots, x[n]}, the empirical LEV \eqn{E_n[X \wedge u]}{En[X ^ u]} is thus \deqn{E_n[X \wedge u] = \frac{1}{n} \left( \sum_{x_j < u} x_j + \sum_{x_j \geq u} u \right).}{% En[X ^ u] = (sum(x[j] < u; 1) + sum(x[j] >= u; u))/n.} Methods of \code{elev} exist for individual data or for grouped data created with \code{\link{grouped.data}}. The formula in this case is too long to show here. See the reference for details. } \value{ For \code{elev}, a function of class \code{"elev"}, inheriting from the \code{"\link{function}"} class. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (1998), \emph{Loss Models, From Data to Decisions}, Wiley. } \seealso{ \code{\link{grouped.data}} to create grouped data objects; \code{\link{stepfun}} for related documentation (even though the empirical LEV is not a step function). } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ data(gdental) lev <- elev(gdental) lev summary(lev) knots(lev) # the group boundaries lev(knots(lev)) # empirical lev at boundaries lev(c(80, 200, 2000)) # and at other limits plot(lev, type = "o", pch = 16) } \keyword{dplot} \keyword{hplot} actuar/man/ogive.Rd0000644000176200001440000000635114264305077013721 0ustar liggesusers\name{ogive} \alias{ogive} \alias{ogive.default} \alias{ogive.grouped.data} \alias{print.ogive} \alias{summary.ogive} \alias{knots.ogive} \alias{plot.ogive} \title{Ogive for Grouped Data} \description{ Compute a smoothed empirical distribution function for grouped data. } \usage{ ogive(x, \dots) \method{ogive}{default}(x, y = NULL, breaks = "Sturges", nclass = NULL, \dots) \method{ogive}{grouped.data}(x, \dots) \method{print}{ogive}(x, digits = getOption("digits") - 2, \dots) \method{summary}{ogive}(object, \dots) \method{knots}{ogive}(Fn, \dots) \method{plot}{ogive}(x, main = NULL, xlab = "x", ylab = "F(x)", \dots) } \arguments{ \item{x}{for the generic and all but the default method, an object of class \code{"grouped.data"}; for the default method, a vector of individual data if \code{y} is \code{NULL}, a vector of group boundaries otherwise.} \item{y}{a vector of group frequencies.} \item{breaks, nclass}{arguments passed to \code{\link{grouped.data}}; used only for individual data (when \code{y} is \code{NULL}).} \item{digits}{number of significant digits to use, see \code{\link{print}}.} \item{Fn, object}{an \R object inheriting from \code{"ogive"}.} \item{main}{main title.} \item{xlab, ylab}{labels of x and y axis.} \item{\dots}{arguments to be passed to subsequent methods.} } \details{ The ogive is a linear interpolation of the empirical cumulative distribution function. The equation of the ogive is \deqn{G_n(x) = \frac{(c_j - x) F_n(c_{j - 1}) + (x - c_{j - 1}) F_n(c_j)}{c_j - c_{j - 1}}}{% Gn(x) = 1/(c[j] - c[j-1]) * [(c[j] - x) Fn(c[j-1]) + (x - c[j-1]) Fn(c[j])]} for \eqn{c_{j-1} < x \leq c_j}{c[j-1] < x <= c[j]} and where \eqn{c_0, \dots, c_r}{c[0], \dots, c[r]} are the \eqn{r + 1} group boundaries and \eqn{F_n}{Fn} is the empirical distribution function of the sample. } \value{ For \code{ogive}, a function of class \code{"ogive"}, inheriting from the \code{"\link{function}"} class. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (1998), \emph{Loss Models, From Data to Decisions}, Wiley. } \seealso{ \code{\link{grouped.data}} to create grouped data objects; \code{\link{quantile.grouped.data}} for the inverse function; \code{\link{approxfun}}, which is used to compute the ogive; \code{\link{stepfun}} for related documentation (even though the ogive is not a step function). } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ ## Most common usage: create ogive from grouped data object. Fn <- ogive(gdental) Fn summary(Fn) knots(Fn) # the group boundaries Fn(knots(Fn)) # true values of the empirical cdf Fn(c(80, 200, 2000)) # linear interpolations plot(Fn) # graphical representation ## Alternative 1: create ogive directly from individual data ## without first creating a grouped data object. ogive(dental) # automatic class boundaries ogive(dental, breaks = c(0, 50, 200, 500, 1500, 2000)) ## Alternative 2: create ogive from set of group boundaries and ## group frequencies. cj <- c(0, 25, 50, 100, 250, 500, 1000) nj <- c(30, 31, 57, 42, 45, 10) ogive(cj, nj) } \keyword{dplot} \keyword{hplot} actuar/man/BetaMoments.Rd0000644000176200001440000000265214264305077015026 0ustar liggesusers\name{BetaMoments} \alias{BetaMoments} \alias{mbeta} \alias{levbeta} \title{Raw and Limited Moments of the Beta Distribution} \description{ Raw moments and limited moments for the (central) Beta distribution with parameters \code{shape1} and \code{shape2}. } \usage{ mbeta(order, shape1, shape2) levbeta(limit, shape1, shape2, order = 1) } \arguments{ \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} \item{shape1, shape2}{positive parameters of the Beta distribution.} } \details{ The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]} and the \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]}, \eqn{k > -\alpha}{k > -shape1}. The noncentral beta distribution is not supported. } \value{ \code{mbeta} gives the \eqn{k}th raw moment and \code{levbeta} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \seealso{ \code{\link[stats]{Beta}} for details on the beta distribution and functions \code{[dpqr]beta}. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ mbeta(2, 3, 4) - mbeta(1, 3, 4)^2 levbeta(10, 3, 4, order = 2) } \keyword{distribution} actuar/man/ZeroModifiedBinomial.Rd0000644000176200001440000001074714264305077016647 0ustar liggesusers\name{ZeroModifiedBinomial} \alias{ZeroModifiedBinomial} \alias{ZMBinomial} \alias{dzmbinom} \alias{pzmbinom} \alias{qzmbinom} \alias{rzmbinom} \title{The Zero-Modified Binomial Distribution} \description{ Density function, distribution function, quantile function and random generation for the Zero-Modified Binomial distribution with parameters \code{size} and \code{prob}, and probability at zero \code{p0}. } \usage{ dzmbinom(x, size, prob, p0, log = FALSE) pzmbinom(q, size, prob, p0, lower.tail = TRUE, log.p = FALSE) qzmbinom(p, size, prob, p0, lower.tail = TRUE, log.p = FALSE) rzmbinom(n, size, prob, p0) } \arguments{ \item{x}{vector of (strictly positive integer) quantiles.} \item{q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{size}{number of trials (strictly positive integer).} \item{prob}{probability of success on each trial. \code{0 <= prob <= 1}.} \item{p0}{probability mass at zero. \code{0 <= p0 <= 1}.} \item{log, log.p}{logical; if \code{TRUE}, probabilities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}, otherwise, \eqn{P[X > x]}.} } \details{ The zero-modified binomial distribution with \code{size} \eqn{= n}, \code{prob} \eqn{= p} and \code{p0} \eqn{= p_0}{= p0} is a discrete mixture between a degenerate distribution at zero and a (standard) binomial. The probability mass function is \eqn{p(0) = p_0}{p(0) = p0} and \deqn{% p(x) = \frac{(1-p_0)}{(1 - (1-p)^n)} f(x)}{% p(x) = (1-p0)/[1 - (1-p)^n] f(x)} for \eqn{x = 1, \ldots, n}, \eqn{0 < p \le 1} and \eqn{0 \le p_0 \le 1}{0 \le p0 \le 1}, where \eqn{f(x)} is the probability mass function of the binomial. The cumulative distribution function is \deqn{P(x) = p_0 + (1 - p_0) \left(\frac{F(x) - F(0)}{1 - F(0)}\right)}{% P(x) = p0 + (1 - p0) [F(x) - F(0)]/[1 - F(0)].} The mean is \eqn{(1-p_0) \mu}{(1-p0)m} and the variance is \eqn{(1-p_0) \sigma^2 + p_0(1-p_0) \mu^2}{(1-p0)v + p0(1-p0)m^2}, where \eqn{\mu}{m} and \eqn{\sigma^2}{v} are the mean and variance of the zero-truncated binomial. In the terminology of Klugman et al. (2012), the zero-modified binomial is a member of the \eqn{(a, b, 1)} class of distributions with \eqn{a = -p/(1-p)} and \eqn{b = (n+1)p/(1-p)}. The special case \code{p0 == 0} is the zero-truncated binomial. If an element of \code{x} is not integer, the result of \code{dzmbinom} is zero, with a warning. The quantile is defined as the smallest value \eqn{x} such that \eqn{P(x) \ge p}, where \eqn{P} is the distribution function. } \value{ \code{dzmbinom} gives the probability mass function, \code{pzmbinom} gives the distribution function, \code{qzmbinom} gives the quantile function, and \code{rzmbinom} generates random deviates. Invalid \code{size}, \code{prob} or \code{p0} will result in return value \code{NaN}, with a warning. The length of the result is determined by \code{n} for \code{rzmbinom}, and is the maximum of the lengths of the numerical arguments for the other functions. } \note{ Functions \code{\{d,p,q\}zmbinom} use \code{\{d,p,q\}binom} for all but the trivial input values and \eqn{p(0)}. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ \code{\link{dbinom}} for the binomial distribution. \code{\link{dztbinom}} for the zero-truncated binomial distribution. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ dzmbinom(1:5, size = 5, prob = 0.4, p0 = 0.2) (1-0.2) * dbinom(1:5, 5, 0.4)/pbinom(0, 5, 0.4, lower = FALSE) # same ## simple relation between survival functions pzmbinom(0:5, 5, 0.4, p0 = 0.2, lower = FALSE) (1-0.2) * pbinom(0:5, 5, 0.4, lower = FALSE) / pbinom(0, 5, 0.4, lower = FALSE) # same qzmbinom(pzmbinom(1:10, 10, 0.6, p0 = 0.1), 10, 0.6, p0 = 0.1) n <- 8; p <- 0.3; p0 <- 0.025 x <- 0:n title <- paste("ZM Binomial(", n, ", ", p, ", p0 = ", p0, ") and Binomial(", n, ", ", p,") PDF", sep = "") plot(x, dzmbinom(x, n, p, p0), type = "h", lwd = 2, ylab = "p(x)", main = title) points(x, dbinom(x, n, p), pch = 19, col = "red") legend("topright", c("ZT binomial probabilities", "Binomial probabilities"), col = c("black", "red"), lty = c(1, 0), lwd = 2, pch = c(NA, 19)) } \keyword{distribution} actuar/man/InverseGamma.Rd0000644000176200001440000000750714264305077015172 0ustar liggesusers\name{InverseGamma} \alias{InverseGamma} \alias{dinvgamma} \alias{pinvgamma} \alias{qinvgamma} \alias{rinvgamma} \alias{minvgamma} \alias{levinvgamma} \alias{mgfinvgamma} \title{The Inverse Gamma Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments, and limited moments for the Inverse Gamma distribution with parameters \code{shape} and \code{scale}. } \usage{ dinvgamma(x, shape, rate = 1, scale = 1/rate, log = FALSE) pinvgamma(q, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) qinvgamma(p, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) rinvgamma(n, shape, rate = 1, scale = 1/rate) minvgamma(order, shape, rate = 1, scale = 1/rate) levinvgamma(limit, shape, rate = 1, scale = 1/rate, order = 1) mgfinvgamma(t, shape, rate =1, scale = 1/rate, log =FALSE) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{shape, scale}{parameters. Must be strictly positive.} \item{rate}{an alternative way to specify the scale.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} \item{t}{numeric vector.} } \details{ The inverse gamma distribution with parameters \code{shape} \eqn{= \alpha}{= a} and \code{scale} \eqn{= \theta}{= s} has density: \deqn{f(x) = \frac{u^\alpha e^{-u}}{x \Gamma(\alpha)}, % \quad u = \theta/x}{% f(x) = u^a exp(-u)/(x Gamma(a)), u = s/x} for \eqn{x > 0}, \eqn{\alpha > 0}{a > 0} and \eqn{\theta > 0}{s > 0}. (Here \eqn{\Gamma(\alpha)}{Gamma(a)} is the function implemented by \R's \code{\link{gamma}()} and defined in its help.) The special case \code{shape == 1} is an \link[=dinvexp]{Inverse Exponential} distribution. The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]}, \eqn{k < \alpha}{k < shape}, and the \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]}, all \eqn{k}. The moment generating function is given by \eqn{E[e^{tX}]}. } \value{ \code{dinvgamma} gives the density, \code{pinvgamma} gives the distribution function, \code{qinvgamma} gives the quantile function, \code{rinvgamma} generates random deviates, \code{minvgamma} gives the \eqn{k}th raw moment, \code{levinvgamma} gives the \eqn{k}th moment of the limited loss variable, and \code{mgfinvgamma} gives the moment generating function in \code{t}. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ \code{levinvgamma} computes the limited expected value using \code{gammainc} from package \pkg{expint}. Also known as the Vinci distribution. See also Kleiber and Kotz (2003) for alternative names and parametrizations. The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Kleiber, C. and Kotz, S. (2003), \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ exp(dinvgamma(2, 3, 4, log = TRUE)) p <- (1:10)/10 pinvgamma(qinvgamma(p, 2, 3), 2, 3) minvgamma(-1, 2, 2) ^ 2 levinvgamma(10, 2, 2, order = 1) mgfinvgamma(-1, 3, 2) } \keyword{distribution} actuar/man/Pareto3.Rd0000644000176200001440000001063114264305077014121 0ustar liggesusers\name{Pareto3} \alias{Pareto3} \alias{dpareto3} \alias{ppareto3} \alias{qpareto3} \alias{rpareto3} \alias{mpareto3} \alias{levpareto3} \title{The Pareto III Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments and limited moments for the Pareto III distribution with parameters \code{min}, \code{shape} and \code{scale}. } \usage{ dpareto3(x, min, shape, rate = 1, scale = 1/rate, log = FALSE) ppareto3(q, min, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) qpareto3(p, min, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) rpareto3(n, min, shape, rate = 1, scale = 1/rate) mpareto3(order, min, shape, rate = 1, scale = 1/rate) levpareto3(limit, min, shape, rate = 1, scale = 1/rate, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{min}{lower bound of the support of the distribution.} \item{shape, scale}{parameters. Must be strictly positive.} \item{rate}{an alternative way to specify the scale.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The Pareto III (or \dQuote{type III}) distribution with parameters \code{min} \eqn{= \mu}{= m}, \code{shape} \eqn{= \gamma}{= b} and \code{scale} \eqn{= \theta}{= s} has density: \deqn{f(x) = \frac{\gamma ((x - \mu)/\theta)^{\gamma - 1}}{% \theta [1 + ((x - \mu)/\theta)^\gamma]^2}}{% f(x) = (b ((x - m)/s)^(b - 1))/(s [1 + ((x - m)/s)^b]^2)} for \eqn{x > \mu}{x > m}, \eqn{-\infty < \mu < \infty}{-Inf < m < Inf}, \eqn{\gamma > 0}{b > 0} and \eqn{\theta > 0}{s > 0}. The Pareto III is the distribution of the random variable \deqn{\mu + \theta \left(\frac{X}{1 - X}\right)^{1/\gamma},}{% m + s (X/(1 - X))^(1/b),} where \eqn{X} has a uniform distribution on \eqn{(0, 1)}. It derives from the \link[=dfpareto]{Feller-Pareto} distribution with \eqn{\alpha = \tau = 1}{shape1 = shape3 = 1}. Setting \eqn{\mu = 0}{min = 0} yields the \link[=dllogis]{loglogistic} distribution. The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]} for nonnegative integer values of \eqn{k < \gamma}{k < shape}. The \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]} for nonnegative integer values of \eqn{k} and \eqn{1 - j/\gamma}{1 - j/shape}, \eqn{j = 1, \dots, k} not a negative integer. } \value{ \code{dpareto3} gives the density, \code{ppareto3} gives the distribution function, \code{qpareto3} gives the quantile function, \code{rpareto3} generates random deviates, \code{mpareto3} gives the \eqn{k}th raw moment, and \code{levpareto3} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ \code{levpareto3} computes the limited expected value using \code{\link{betaint}}. For Pareto distributions, we use the classification of Arnold (2015) with the parametrization of Klugman et al. (2012). The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Arnold, B.C. (2015), \emph{Pareto Distributions}, Second Edition, CRC Press. Kleiber, C. and Kotz, S. (2003), \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ \code{\link{dllogis}} for the loglogistic distribution. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ exp(dpareto3(1, min = 10, 3, 4, log = TRUE)) p <- (1:10)/10 ppareto3(qpareto3(p, min = 10, 2, 3), min = 10, 2, 3) ## mean mpareto3(1, min = 10, 2, 3) ## case with 1 - order/shape > 0 levpareto3(20, min = 10, 2, 3, order = 1) ## case with 1 - order/shape < 0 levpareto3(20, min = 10, 2/3, 3, order = 1) } \keyword{distribution} actuar/man/Burr.Rd0000644000176200001440000001047314264305077013522 0ustar liggesusers\name{Burr} \alias{Burr} \alias{dburr} \alias{pburr} \alias{qburr} \alias{rburr} \alias{mburr} \alias{levburr} \title{The Burr Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments and limited moments for the Burr distribution with parameters \code{shape1}, \code{shape2} and \code{scale}. } \usage{ dburr(x, shape1, shape2, rate = 1, scale = 1/rate, log = FALSE) pburr(q, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) qburr(p, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) rburr(n, shape1, shape2, rate = 1, scale = 1/rate) mburr(order, shape1, shape2, rate = 1, scale = 1/rate) levburr(limit, shape1, shape2, rate = 1, scale = 1/rate, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{shape1, shape2, scale}{parameters. Must be strictly positive.} \item{rate}{an alternative way to specify the scale.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The Burr distribution with parameters \code{shape1} \eqn{= \alpha}{= a}, \code{shape2} \eqn{= \gamma}{= b} and \code{scale} \eqn{= \theta}{= s} has density: \deqn{f(x) = \frac{\alpha \gamma (x/\theta)^\gamma}{% x [1 + (x/\theta)^\gamma]^{\alpha + 1}}}{% f(x) = (a b (x/s)^b)/(x [1 + (x/s)^b]^(a + 1))} for \eqn{x > 0}, \eqn{\alpha > 0}{a > 0}, \eqn{\gamma > 0}{b > 0} and \eqn{\theta > 0}{s > 0}. The Burr is the distribution of the random variable \deqn{\theta \left(\frac{X}{1 - X}\right)^{1/\gamma},}{% s (X/(1 - X))^(1/b),} where \eqn{X} has a beta distribution with parameters \eqn{1} and \eqn{\alpha}{a}. The Burr distribution has the following special cases: \itemize{ \item A \link[=dllogis]{Loglogistic} distribution when \code{shape1 == 1}; \item A \link[=dparalogis]{Paralogistic} distribution when \code{shape2 == shape1}; \item A \link[=dpareto]{Pareto} distribution when \code{shape2 == 1}. } The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]}, \eqn{-\gamma < k < \alpha\gamma}{-shape2 < k < shape1 * shape2}. The \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]}, \eqn{k > -\gamma}{k > -shape2} and \eqn{\alpha - k/\gamma}{shape1 - k/shape2} not a negative integer. } \value{ \code{dburr} gives the density, \code{pburr} gives the distribution function, \code{qburr} gives the quantile function, \code{rburr} generates random deviates, \code{mburr} gives the \eqn{k}th raw moment, and \code{levburr} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ \code{levburr} computes the limited expected value using \code{\link{betaint}}. Distribution also known as the Burr Type XII or Singh-Maddala distribution. See also Kleiber and Kotz (2003) for alternative names and parametrizations. The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Kleiber, C. and Kotz, S. (2003), \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ \code{\link{dpareto4}} for an equivalent distribution with a location parameter. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ exp(dburr(1, 2, 3, log = TRUE)) p <- (1:10)/10 pburr(qburr(p, 2, 3, 2), 2, 3, 2) ## variance mburr(2, 2, 3, 1) - mburr(1, 2, 3, 1) ^ 2 ## case with shape1 - order/shape2 > 0 levburr(10, 2, 3, 1, order = 2) ## case with shape1 - order/shape2 < 0 levburr(10, 1.5, 0.5, 1, order = 2) } \keyword{distribution} actuar/man/ZeroModifiedGeometric.Rd0000644000176200001440000000766014264305077017033 0ustar liggesusers\name{ZeroModifiedGeometric} \alias{ZeroModifiedGeometric} \alias{Zmgeometric} \alias{dzmgeom} \alias{pzmgeom} \alias{qzmgeom} \alias{rzmgeom} \title{The Zero-Modified Geometric Distribution} \description{ Density function, distribution function, quantile function and random generation for the Zero-Modified Geometric distribution with parameter \code{prob} and arbitrary probability at zero \code{p0}. } \usage{ dzmgeom(x, prob, p0, log = FALSE) pzmgeom(q, prob, p0, lower.tail = TRUE, log.p = FALSE) qzmgeom(p, prob, p0, lower.tail = TRUE, log.p = FALSE) rzmgeom(n, prob, p0) } \arguments{ \item{x}{vector of (strictly positive integer) quantiles.} \item{q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{prob}{parameter. \code{0 < prob <= 1}.} \item{p0}{probability mass at zero. \code{0 <= p0 <= 1}.} \item{log, log.p}{logical; if \code{TRUE}, probabilities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}, otherwise, \eqn{P[X > x]}.} } \details{ The zero-modified geometric distribution with \code{prob} \eqn{= p} and \code{p0} \eqn{= p_0}{= p0} is a discrete mixture between a degenerate distribution at zero and a (standard) geometric. The probability mass function is \eqn{p(0) = p_0}{p(0) = p0} and \deqn{% p(x) = \frac{(1-p_0)}{(1-p)} f(x)}{% p(x) = (1-p0)/(1-p) f(x)} for \eqn{x = 1, 2, \ldots}, \eqn{0 < p < 1} and \eqn{0 \le p_0 \le 1}{0 \le p0 \le 1}, where \eqn{f(x)} is the probability mass function of the geometric. The cumulative distribution function is \deqn{P(x) = p_0 + (1 - p_0) \left(\frac{F(x) - F(0)}{1 - F(0)}\right)}{% P(x) = p0 + (1 - p0) [F(x) - F(0)]/[1 - F(0)].} The mean is \eqn{(1-p_0) \mu}{(1-p0)m} and the variance is \eqn{(1-p_0) \sigma^2 + p_0(1-p_0) \mu^2}{(1-p0)v + p0(1-p0)m^2}, where \eqn{\mu}{m} and \eqn{\sigma^2}{v} are the mean and variance of the zero-truncated geometric. In the terminology of Klugman et al. (2012), the zero-modified geometric is a member of the \eqn{(a, b, 1)} class of distributions with \eqn{a = 1-p} and \eqn{b = 0}. The special case \code{p0 == 0} is the zero-truncated geometric. If an element of \code{x} is not integer, the result of \code{dzmgeom} is zero, with a warning. The quantile is defined as the smallest value \eqn{x} such that \eqn{P(x) \ge p}, where \eqn{P} is the distribution function. } \value{ \code{dzmgeom} gives the (log) probability mass function, \code{pzmgeom} gives the (log) distribution function, \code{qzmgeom} gives the quantile function, and \code{rzmgeom} generates random deviates. Invalid \code{prob} or \code{p0} will result in return value \code{NaN}, with a warning. The length of the result is determined by \code{n} for \code{rzmgeom}, and is the maximum of the lengths of the numerical arguments for the other functions. } \note{ Functions \code{\{d,p,q\}zmgeom} use \code{\{d,p,q\}geom} for all but the trivial input values and \eqn{p(0)}. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ \code{\link{dgeom}} for the geometric distribution. \code{\link{dztgeom}} for the zero-truncated geometric distribution. \code{\link{dzmnbinom}} for the zero-modified negative binomial, of which the zero-modified geometric is a special case. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ p <- 1/(1 + 0.5) dzmgeom(1:5, prob = p, p0 = 0.6) (1-0.6) * dgeom(1:5, p)/pgeom(0, p, lower = FALSE) # same ## simple relation between survival functions pzmgeom(0:5, p, p0 = 0.2, lower = FALSE) (1-0.2) * pgeom(0:5, p, lower = FALSE)/pgeom(0, p, lower = FALSE) # same qzmgeom(pzmgeom(0:10, 0.3, p0 = 0.6), 0.3, p0 = 0.6) } \keyword{distribution} actuar/man/PoissonInverseGaussian.Rd0000644000176200001440000001317414264305077017272 0ustar liggesusers\name{PoissonInverseGaussian} \alias{PoissonInverseGaussian} \alias{PIG} \alias{dpoisinvgauss} \alias{ppoisinvgauss} \alias{qpoisinvgauss} \alias{rpoisinvgauss} \alias{dpig} \alias{ppig} \alias{qpig} \alias{rpig} \title{The Poisson-Inverse Gaussian Distribution} \description{ Density function, distribution function, quantile function and random generation for the Poisson-inverse Gaussian discrete distribution with parameters \code{mean} and \code{shape}. } \usage{ dpoisinvgauss(x, mean, shape = 1, dispersion = 1/shape, log = FALSE) ppoisinvgauss(q, mean, shape = 1, dispersion = 1/shape, lower.tail = TRUE, log.p = FALSE) qpoisinvgauss(p, mean, shape = 1, dispersion = 1/shape, lower.tail = TRUE, log.p = FALSE) rpoisinvgauss(n, mean, shape = 1, dispersion = 1/shape) } \arguments{ \item{x}{vector of (positive integer) quantiles.} \item{q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{mean, shape}{parameters. Must be strictly positive. Infinite values are supported.} \item{dispersion}{an alternative way to specify the shape.} \item{log, log.p}{logical; if \code{TRUE}, probabilities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}, otherwise, \eqn{P[X > x]}.} } \details{ The Poisson-inverse Gaussian distribution is the result of the continuous mixture between a Poisson distribution and an inverse Gaussian, that is, the distribution with probability mass function \deqn{% p(x) = \int_0^\infty \frac{\lambda^x e^{-\lambda}}{x!}\, g(\lambda; \mu, \phi)\, d\lambda,}{% p(x) = int_0^Inf (y^x exp(-y))/x! g(y; \mu, \phi) dy,} where \eqn{g(\lambda; \mu, \phi)}{g(y; \mu, \phi)} is the density function of the inverse Gaussian distribution with parameters \code{mean} \eqn{= \mu} and \code{dispersion} \eqn{= \phi} (see \code{\link{dinvgauss}}). The resulting probability mass function is \deqn{% p(x) = \sqrt{\frac{2}{\pi \phi}} \frac{e^{(\phi\mu)^{-1}}}{x!} \left( \sqrt{2\phi\left(1 + \frac{1}{2\phi\mu^2}\right)} \right)^{-(x - \frac{1}{2})} K_{x - \frac{1}{2}} \left( \sqrt{\frac{2}{\phi}\left(1 + \frac{1}{2\phi\mu^2}\right)} \right),}{% p(x) = sqrt(2/(\pi \phi)) exp(1/(\phi \mu))/x! * [\sqrt(2 \phi (1 + 1/(2 \phi \mu^2)))]^(-(x-1/2)) * K(\sqrt((2/\phi) (1 + 1/(2 \phi \mu^2))); x-1/2),} for \eqn{x = 0, 1, \dots}, \eqn{\mu > 0}, \eqn{\phi > 0} and where \eqn{K_\nu(x)}{K(x; \nu)} is the modified Bessel function of the third kind implemented by \R's \code{\link{besselK}()} and defined in its help. The limiting case \eqn{\mu = \infty}{\mu = Inf} has well defined probability mass and distribution functions, but has no finite strictly positive, integer moments. The pmf in this case reduces to \deqn{% p(x) = \sqrt{\frac{2}{\pi \phi}} \frac{1}{x!} (\sqrt{2\phi})^{-(x - \frac{1}{2})} K_{x - \frac{1}{2}}(\sqrt{2/\phi}).}{% p(x) = sqrt(2/(\pi \phi)) 1/x! [\sqrt(2 \phi)]^(-(x-1/2)) * K(\sqrt(2/\phi); x-1/2).} The limiting case \eqn{\phi = 0} is a degenerate distribution in \eqn{x = 0}. If an element of \code{x} is not integer, the result of \code{dpoisinvgauss} is zero, with a warning. The quantile is defined as the smallest value \eqn{x} such that \eqn{F(x) \ge p}, where \eqn{F} is the distribution function. } \value{ \code{dpoisinvgauss} gives the probability mass function, \code{ppoisinvgauss} gives the distribution function, \code{qpoisinvgauss} gives the quantile function, and \code{rpoisinvgauss} generates random deviates. Invalid arguments will result in return value \code{NaN}, with a warning. The length of the result is determined by \code{n} for \code{rpoisinvgauss}, and is the maximum of the lengths of the numerical arguments for the other functions. } \note{ \code{[dpqr]pig} are aliases for \code{[dpqr]poisinvgauss}. \code{qpoisinvgauss} is based on \code{qbinom} et al.; it uses the Cornish--Fisher Expansion to include a skewness correction to a normal approximation, followed by a search. } \references{ Holla, M. S. (1966), \dQuote{On a Poisson-Inverse Gaussian Distribution}, \emph{Metrika}, vol. 15, p. 377-384. Johnson, N. L., Kemp, A. W. and Kotz, S. (2005), \emph{Univariate Discrete Distributions, Third Edition}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. Shaban, S. A., (1981) \dQuote{Computation of the poisson-inverse gaussian distribution}, \emph{Communications in Statistics - Theory and Methods}, vol. 10, no. 14, p. 1389-1399. } \seealso{ \code{\link{dpois}} for the Poisson distribution, \code{\link{dinvgauss}} for the inverse Gaussian distribution. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ ## Tables I and II of Shaban (1981) x <- 0:2 sapply(c(0.4, 0.8, 1), dpoisinvgauss, x = x, mean = 0.1) sapply(c(40, 80, 100, 130), dpoisinvgauss, x = x, mean = 1) qpoisinvgauss(ppoisinvgauss(0:10, 1, dis = 2.5), 1, dis = 2.5) x <- rpoisinvgauss(1000, 1, dis = 2.5) y <- sort(unique(x)) plot(y, table(x)/length(x), type = "h", lwd = 2, pch = 19, col = "black", xlab = "x", ylab = "p(x)", main = "Empirical vs theoretical probabilities") points(y, dpoisinvgauss(y, 1, dis = 2.5), pch = 19, col = "red") legend("topright", c("empirical", "theoretical"), lty = c(1, NA), pch = c(NA, 19), col = c("black", "red")) } \keyword{distribution} actuar/man/ZeroTruncatedBinomial.Rd0000644000176200001440000000770214264305077017055 0ustar liggesusers\name{ZeroTruncatedBinomial} \alias{ZeroTruncatedBinomial} \alias{ZTBinomial} \alias{dztbinom} \alias{pztbinom} \alias{qztbinom} \alias{rztbinom} \title{The Zero-Truncated Binomial Distribution} \description{ Density function, distribution function, quantile function and random generation for the Zero-Truncated Binomial distribution with parameters \code{size} and \code{prob}. } \usage{ dztbinom(x, size, prob, log = FALSE) pztbinom(q, size, prob, lower.tail = TRUE, log.p = FALSE) qztbinom(p, size, prob, lower.tail = TRUE, log.p = FALSE) rztbinom(n, size, prob) } \arguments{ \item{x}{vector of (strictly positive integer) quantiles.} \item{q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{size}{number of trials (strictly positive integer).} \item{prob}{probability of success on each trial. \code{0 <= prob <= 1}.} \item{log, log.p}{logical; if \code{TRUE}, probabilities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}, otherwise, \eqn{P[X > x]}.} } \details{ The zero-truncated binomial distribution with \code{size} \eqn{= n} and \code{prob} \eqn{= p} has probability mass function \deqn{% p(x) = {n \choose x} \frac{p^x (1 - p)^{n-x}}{1 - (1 - p)^n}}{% p(x) = choose(n, x) [p^x (1-p)^(n-x)]/[1 - (1-p)^n]} for \eqn{x = 1, \ldots, n} and \eqn{0 < p \le 1}, and \eqn{p(1) = 1} when \eqn{p = 0}. The cumulative distribution function is \deqn{P(x) = \frac{F(x) - F(0)}{1 - F(0)},}{% P(x) = [F(x) - F(0)]/[1 - F(0)],} where \eqn{F(x)} is the distribution function of the standard binomial. The mean is \eqn{np/(1 - (1-p)^n)} and the variance is \eqn{np[(1-p) - (1-p+np)(1-p)^n]/[1 - (1-p)^n]^2}. In the terminology of Klugman et al. (2012), the zero-truncated binomial is a member of the \eqn{(a, b, 1)} class of distributions with \eqn{a = -p/(1-p)} and \eqn{b = (n+1)p/(1-p)}. If an element of \code{x} is not integer, the result of \code{dztbinom} is zero, with a warning. The quantile is defined as the smallest value \eqn{x} such that \eqn{P(x) \ge p}, where \eqn{P} is the distribution function. } \value{ \code{dztbinom} gives the probability mass function, \code{pztbinom} gives the distribution function, \code{qztbinom} gives the quantile function, and \code{rztbinom} generates random deviates. Invalid \code{size} or \code{prob} will result in return value \code{NaN}, with a warning. The length of the result is determined by \code{n} for \code{rztbinom}, and is the maximum of the lengths of the numerical arguments for the other functions. } \note{ Functions \code{\{d,p,q\}ztbinom} use \code{\{d,p,q\}binom} for all but the trivial input values and \eqn{p(0)}. \code{rztbinom} uses the simple inversion algorithm suggested by Peter Dalgaard on the r-help mailing list on 1 May 2005 % (\url{https://stat.ethz.ch/pipermail/r-help/2005-May/070680.html}). } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ \code{\link{dbinom}} for the binomial distribution. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ dztbinom(1:5, size = 5, prob = 0.4) dbinom(1:5, 5, 0.4)/pbinom(0, 5, 0.4, lower = FALSE) # same pztbinom(1, 2, prob = 0) # point mass at 1 qztbinom(pztbinom(1:10, 10, 0.6), 10, 0.6) n <- 8; p <- 0.3 x <- 0:n title <- paste("ZT Binomial(", n, ", ", p, ") and Binomial(", n, ", ", p,") PDF", sep = "") plot(x, dztbinom(x, n, p), type = "h", lwd = 2, ylab = "p(x)", main = title) points(x, dbinom(x, n, p), pch = 19, col = "red") legend("topright", c("ZT binomial probabilities", "Binomial probabilities"), col = c("black", "red"), lty = c(1, 0), lwd = 2, pch = c(NA, 19)) } \keyword{distribution} actuar/man/UniformSupp.Rd0000644000176200001440000000305314264305077015073 0ustar liggesusers\name{UniformSupp} \alias{UniformSupp} \alias{munif} \alias{levunif} \alias{mgfunif} \title{Moments and Moment Generating Function of the Uniform Distribution} \description{ Raw moments, limited moments and moment generating function for the Uniform distribution from \code{min} to \code{max}. } \usage{ munif(order, min = 0, max = 1) levunif(limit, min = 0, max =1, order = 1) mgfunif(t, min = 0, max = 1, log = FALSE) } \arguments{ \item{order}{order of the moment.} \item{min, max}{lower and upper limits of the distribution. Must be finite.} \item{limit}{limit of the random variable.} \item{t}{numeric vector.} \item{log}{logical; if \code{TRUE}, the cumulant generating function is returned.} } \details{ The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]}, the \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]} and the moment generating function is \eqn{E[e^{tX}]}. } \value{ \code{munif} gives the \eqn{k}th raw moment, \code{levunif} gives the \eqn{k}th moment of the limited random variable, and \code{mgfunif} gives the moment generating function in \code{t}. Invalid arguments will result in return value \code{NaN}, with a warning. } \seealso{ \code{\link{Uniform}}. } \references{ \url{https://en.wikipedia.org/wiki/Uniform_distribution_\%28continuous\%29} } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca}, Christophe Dutang } \examples{ munif(-1) munif(1:5) levunif(3, order=1:5) levunif(3, 2, 4) mgfunif(1, 1, 2) } \keyword{distribution} actuar/man/dental.Rd0000644000176200001440000000055014264305077014052 0ustar liggesusers\name{dental} \docType{data} \alias{dental} \title{Individual Dental Claims Data Set} \description{ Basic dental claims on a policy with a deductible of 50. } \usage{dental} \format{A vector containing 10 observations} \source{Klugman, S. A., Panjer, H. H. and Willmot, G. E. (1998), \emph{Loss Models, From Data to Decisions}, Wiley. } \keyword{datasets} actuar/man/rmixture.Rd0000644000176200001440000000730114370340204014450 0ustar liggesusers\name{rmixture} \alias{rmixture} \title{Simulation from Discrete Mixtures} \description{ Generate random variates from a discrete mixture of distributions. } \usage{ rmixture(n, probs, models, shuffle = TRUE) } \arguments{ \item{n}{number of random variates to generate. If \code{length(n) > 1}, the length is taken to be the number required.} \item{probs}{numeric non-negative vector specifying the probability for each model; is internally normalized to sum 1. Infinite and missing values are not allowed. Values are recycled as necessary to match the length of \code{models}.} \item{models}{vector of expressions specifying the simulation models with the number of variates omitted; see Details. Models are recycled as necessary to match the length of \code{probs}.} \item{shuffle}{logical; should the random variates from the distributions be shuffled?} } \details{ \code{rmixture} generates variates from a discrete mixture, that is the random variable with a probability density function of the form \deqn{f(x) = p_1 f_1(x) + ... + p_n f_n(x),} where \eqn{f_1, \dots, f_n} are densities and \eqn{\sum_{i = 1}^n p_i = 1}{p_1 + \dots + p_n = 1}. The values in \code{probs} will be internally normalized to be used as probabilities \eqn{p_1 + \dots + p_n}. The specification of simulation models uses the syntax of \code{\link{rcomphierarc}}. Models \eqn{f_1, \dots, f_n} are expressed in a semi-symbolic fashion using an object of mode \code{\link[base]{expression}} where each element is a complete call to a random number generation function, with the number of variates omitted. The argument of the random number generation functions for the number of variates to simulate \strong{must} be named \code{n}. If \code{shuffle} is \code{FALSE}, the output vector contains all the random variates from the first model, then all the random variates from the second model, and so on. If the order of the variates is irrelevant, this cuts the time to generate the variates roughly in half. } \note{ Building the expressions in \code{models} from the arguments of another function is delicate. The expressions must be such that evaluation is possible in the frame of \code{rmixture} or its parent. See the examples. } \value{ A vector of random variates from the mixture with density \eqn{f(x)}. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \seealso{ \code{\link{rcompound}} to simulate from compound models. \code{\link{rcomphierarc}} to simulate from compound hierarchical models. } \examples{ ## Mixture of two exponentials (with means 1/3 and 1/7) with equal ## probabilities. rmixture(10, 0.5, expression(rexp(3), rexp(7))) rmixture(10, 42, expression(rexp(3), rexp(7))) # same ## Mixture of two lognormals with different probabilities. rmixture(10, probs = c(0.55, 0.45), models = expression(rlnorm(3.6, 0.6), rlnorm(4.6, 0.3))) ## Building the model expressions in the following example ## works as 'rate' is defined in the parent frame of ## 'rmixture'. probs <- c(2, 5) g <- function(n, p, rate) rmixture(n, p, expression(rexp(rate[1]), rexp(rate[2]))) g(10, probs, c(3, 7)) ## The following example does not work: 'rate' does not exist ## in the evaluation frame of 'rmixture'. f <- function(n, p, model) rmixture(n, p, model) h <- function(n, p, rate) f(n, p, expression(rexp(rate[1]), rexp(rate[2]))) \dontrun{h(10, probs, c(3, 7))} ## Fix: substitute the values in the model expressions. h <- function(n, p, rate) { models <- eval(substitute(expression(rexp(a[1]), rexp(a[2])), list(a = rate))) f(n, p, models) } h(10, probs, c(3, 7)) } \keyword{datagen} actuar/man/InverseTransformedGamma.Rd0000644000176200001440000001116514264305077017372 0ustar liggesusers\name{InverseTransformedGamma} \alias{InverseTransformedGamma} \alias{dinvtrgamma} \alias{pinvtrgamma} \alias{qinvtrgamma} \alias{rinvtrgamma} \alias{minvtrgamma} \alias{levinvtrgamma} \title{The Inverse Transformed Gamma Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments, and limited moments for the Inverse Transformed Gamma distribution with parameters \code{shape1}, \code{shape2} and \code{scale}. } \usage{ dinvtrgamma(x, shape1, shape2, rate = 1, scale = 1/rate, log = FALSE) pinvtrgamma(q, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) qinvtrgamma(p, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) rinvtrgamma(n, shape1, shape2, rate = 1, scale = 1/rate) minvtrgamma(order, shape1, shape2, rate = 1, scale = 1/rate) levinvtrgamma(limit, shape1, shape2, rate = 1, scale = 1/rate, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{shape1, shape2, scale}{parameters. Must be strictly positive.} \item{rate}{an alternative way to specify the scale.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The inverse transformed gamma distribution with parameters \code{shape1} \eqn{= \alpha}{= a}, \code{shape2} \eqn{= \tau}{= b} and \code{scale} \eqn{= \theta}{= s}, has density: \deqn{f(x) = \frac{\tau u^\alpha e^{-u}}{x \Gamma(\alpha)}, % \quad u = (\theta/x)^\tau}{% f(x) = b u^a exp(-u) / (x Gamma(a)), u = (s/x)^b} for \eqn{x > 0}, \eqn{\alpha > 0}{a > 0}, \eqn{\tau > 0}{b > 0} and \eqn{\theta > 0}{s > 0}. (Here \eqn{\Gamma(\alpha)}{Gamma(a)} is the function implemented by \R's \code{\link{gamma}()} and defined in its help.) The inverse transformed gamma is the distribution of the random variable \eqn{\theta X^{-1/\tau},}{s X^(-1/b),} where \eqn{X} has a gamma distribution with shape parameter \eqn{\alpha}{a} and scale parameter \eqn{1} or, equivalently, of the random variable \eqn{Y^{-1/\tau}}{Y^(-1/b)} with \eqn{Y} a gamma distribution with shape parameter \eqn{\alpha}{a} and scale parameter \eqn{\theta^{-\tau}}{s^(-b)}. The inverse transformed gamma distribution defines a family of distributions with the following special cases: \itemize{ \item An \link[=dinvgamma]{Inverse Gamma} distribution when \code{shape2 == 1}; \item An \link[=dinvweibull]{Inverse Weibull} distribution when \code{shape1 == 1}; \item An \link[=dinvexp]{Inverse Exponential} distribution when \code{shape1 == shape2 == 1}; } The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]}, \eqn{k < \alpha\tau}{k < shape1 * shape2}, and the \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]} for all \eqn{k}. } \value{ \code{dinvtrgamma} gives the density, \code{pinvtrgamma} gives the distribution function, \code{qinvtrgamma} gives the quantile function, \code{rinvtrgamma} generates random deviates, \code{minvtrgamma} gives the \eqn{k}th raw moment, and \code{levinvtrgamma} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ \code{levinvtrgamma} computes the limited expected value using \code{gammainc} from package \pkg{expint}. Distribution also known as the Inverse Generalized Gamma. See also Kleiber and Kotz (2003) for alternative names and parametrizations. The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Kleiber, C. and Kotz, S. (2003), \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ exp(dinvtrgamma(2, 3, 4, 5, log = TRUE)) p <- (1:10)/10 pinvtrgamma(qinvtrgamma(p, 2, 3, 4), 2, 3, 4) minvtrgamma(2, 3, 4, 5) levinvtrgamma(200, 3, 4, 5, order = 2) } \keyword{distribution} actuar/man/betaint.Rd0000644000176200001440000000635514264305077014242 0ustar liggesusers\name{betaint} \alias{betaint} \title{The \dQuote{Beta Integral}} \description{ The \dQuote{beta integral} which is just a multiple of the non regularized incomplete beta function. This function merely provides an R interface to the C level routine. It is not exported by the package. } \usage{ betaint(x, a, b) } \arguments{ \item{x}{vector of quantiles.} \item{a, b}{parameters. See Details for admissible values.} } \details{ Function \code{betaint} computes the \dQuote{beta integral} \deqn{ B(a, b; x) = \Gamma(a + b) \int_0^x t^{a-1} (1-t)^{b-1} dt}{% B(a, b; x) = Gamma(a + b) int_0^x t^(a-1) (1-t)^(b-1) dt} for \eqn{a > 0}, \eqn{b \neq -1, -2, \ldots}{b != -1, -2, \ldots} and \eqn{0 < x < 1}. (Here \eqn{\Gamma(\alpha)}{Gamma(a)} is the function implemented by \R's \code{\link{gamma}()} and defined in its help.) When \eqn{b > 0}, \deqn{ B(a, b; x) = \Gamma(a) \Gamma(b) I_x(a, b),} where \eqn{I_x(a, b)} is \code{pbeta(x, a, b)}. When \eqn{b < 0}, \eqn{b \neq -1, -2, \ldots}{b != -1, -2, \ldots}, and \eqn{a > 1 + [-b]}{a > 1 + floor(-b)}, \deqn{% \begin{array}{rcl} B(a, b; x) &=& \displaystyle -\Gamma(a + b) \left[ \frac{x^{a-1} (1-x)^b}{b} + \frac{(a-1) x^{a-2} (1-x)^{b+1}}{b (b+1)} \right. \\ & & \displaystyle\left. + \cdots + \frac{(a-1) \cdots (a-r) x^{a-r-1} (1-x)^{b+r}}{b (b+1) \cdots (b+r)} \right] \\ & & \displaystyle + \frac{(a-1) \cdots (a-r-1)}{b (b+1) \cdots (b+r)} \Gamma(a-r-1) \\ & & \times \Gamma(b+r+1) I_x(a-r-1, b+r+1), \end{array}}{% B(a, b; x) = -Gamma(a+b) \{(x^(a-1) (1-x)^b)/b + [(a-1) x^(a-2) (1-x)^(b+1)]/[b(b+1)] + \dots + [(a-1)\dots(a-r) x^(a-r-1) (1-x)^(b+r)]/[b(b+1)\dots(b+r)]\} + [(a-1)\dots(a-r-1)]/[b(b+1)\dots(b+r)] Gamma(a-r-1) * Gamma(b+r+1) I_x(a-r-1, b+r+1),} where \eqn{r = [-b]}{r = floor(-b)}. This function is used (at the C level) to compute the limited expected value for distributions of the transformed beta family; see, for example, \code{\link{levtrbeta}}. } \value{ The value of the integral. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ The need for this function in the package is well explained in the introduction of Appendix A of Klugman et al. (2012). See also chapter 6 and 15 of Abramowitz and Stegun (1972) for definitions and relations to the hypergeometric series. } \references{ Abramowitz, M. and Stegun, I. A. (1972), \emph{Handbook of Mathematical Functions}, Dover. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ x <- 0.3 a <- 7 ## case with b > 0 b <- 2 actuar:::betaint(x, a, b) gamma(a) * gamma(b) * pbeta(x, a, b) # same ## case with b < 0 b <- -2.2 r <- floor(-b) # r = 2 actuar:::betaint(x, a, b) ## "manual" calculation s <- (x^(a-1) * (1-x)^b)/b + ((a-1) * x^(a-2) * (1-x)^(b+1))/(b * (b+1)) + ((a-1) * (a-2) * x^(a-3) * (1-x)^(b+2))/(b * (b+1) * (b+2)) -gamma(a+b) * s + (a-1)*(a-2)*(a-3) * gamma(a-r-1)/(b*(b+1)*(b+2)) * gamma(b+r+1)*pbeta(x, a-r-1, b+r+1) } \keyword{math} \keyword{distribution} actuar/man/quantile.grouped.data.Rd0000644000176200001440000000410414264305077017000 0ustar liggesusers\name{quantile.grouped.data} \alias{quantile.grouped.data} \alias{summary.grouped.data} \title{Quantiles of Grouped Data} \description{ Sample quantiles corresponding to the given probabilities for objects of class \code{"grouped.data"}. } \usage{ \method{quantile}{grouped.data}(x, probs = seq(0, 1, 0.25), names = TRUE, \dots) \method{summary}{grouped.data}(object, \dots) } \arguments{ \item{x, object}{an object of class \code{"grouped.data"}.} \item{probs}{numeric vector of probabilities with values in \eqn{[0, 1]}.} \item{names}{logical; if true, the result has a \code{names} attribute. Set to \code{FALSE} for speedup with many \code{probs}.} \item{\dots}{further arguments passed to or from other methods.} } \details{ The quantile function is the inverse of the ogive, that is a linear interpolation of the empirical quantile function. The equation of the quantile function is \deqn{x = \frac{c_j (F_n(c_{j - 1}) - q) + c_{j - 1} (q - F_n(c_j)}{F_n(c_j) - F_n(c_{j - 1})}}{% x = (c[j] (Fn(c[j-1]) - q) + c[j-1] (q - Fn(c[j])))/(Fn(c[j]) - Fn(c[j-1]))} for \eqn{0 \leq q \leq c_j}{0 <= q <= 1} and where \eqn{c_0, \dots, c_r}{c[0], \dots, c[r]} are the \eqn{r + 1} group boundaries and \eqn{F_n}{Fn} is the empirical distribution function of the sample. } \value{ For \code{quantile}, a numeric vector, named if \code{names} is \code{TRUE}. For the \code{summary} method, an object of class \code{c("summaryDefault", "\link{table}")} which has specialized \code{\link{format}} and \code{\link{print}} methods. } \seealso{ \code{\link{ogive}} for the smoothed empirical distribution of which \code{quantile.grouped.data} is an inverse; \code{\link{mean.grouped.data}} and \code{\link{var.grouped.data}} to compute the mean and variance of grouped data. \code{\link{grouped.data}} to create grouped data objects. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ data(gdental) quantile(gdental) summary(gdental) Fn <- ogive(gdental) Fn(quantile(gdental)) # inverse function } \keyword{univar} actuar/man/WeibullMoments.Rd0000644000176200001440000000263214264305077015554 0ustar liggesusers\name{WeibullMoments} \alias{WeibullMoments} \alias{mweibull} \alias{levweibull} \title{Raw and Limited Moments of the Weibull Distribution} \description{ Raw moments and limited moments for the Weibull distribution with parameters \code{shape} and \code{scale}. } \usage{ mweibull(order, shape, scale = 1) levweibull(limit, shape, scale = 1, order = 1) } \arguments{ \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} \item{shape, scale}{shape and scale parameters, the latter defaulting to 1.} } \details{ The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]} and the \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]}, \eqn{k > -\tau}{k > -shape}. } \value{ \code{mweibull} gives the \eqn{k}th raw moment and \code{levweibull} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \seealso{ \code{\link{Weibull}} for details on the Weibull distribution and functions \code{[dpqr]weibull}. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ mweibull(2, 3, 4) - mweibull(1, 3, 4)^2 levweibull(10, 3, 4, order = 2) } \keyword{distribution} actuar/man/Pareto.Rd0000644000176200001440000000732314264305077014042 0ustar liggesusers\name{Pareto} \alias{Pareto} \alias{dpareto} \alias{ppareto} \alias{qpareto} \alias{rpareto} \alias{mpareto} \alias{levpareto} \title{The Pareto Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments and limited moments for the Pareto distribution with parameters \code{shape} and \code{scale}. } \usage{ dpareto(x, shape, scale, log = FALSE) ppareto(q, shape, scale, lower.tail = TRUE, log.p = FALSE) qpareto(p, shape, scale, lower.tail = TRUE, log.p = FALSE) rpareto(n, shape, scale) mpareto(order, shape, scale) levpareto(limit, shape, scale, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{shape, scale}{parameters. Must be strictly positive.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The Pareto distribution with parameters \code{shape} \eqn{= \alpha}{= a} and \code{scale} \eqn{= \theta}{= s} has density: \deqn{f(x) = \frac{\alpha \theta^\alpha}{(x + \theta)^{\alpha + 1}}}{% f(x) = a s^a / (x + s)^(a + 1)} for \eqn{x > 0}, \eqn{\alpha > 0}{a > 0} and \eqn{\theta}{s > 0}. There are many different definitions of the Pareto distribution in the literature; see Arnold (2015) or Kleiber and Kotz (2003). In the nomenclature of \pkg{actuar}, The \dQuote{Pareto distribution} does not have a location parameter. The version with a location parameter is the \link[=dpareto2]{Pareto II}. The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}, \eqn{-1 < k < \alpha}{-1 < k < shape}. The \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]}, \eqn{k > -1} and \eqn{\alpha - k}{shape - k} not a negative integer. } \value{ \code{dpareto} gives the density, \code{ppareto} gives the distribution function, \code{qpareto} gives the quantile function, \code{rpareto} generates random deviates, \code{mpareto} gives the \eqn{k}th raw moment, and \code{levpareto} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ \code{levpareto} computes the limited expected value using \code{\link{betaint}}. The version of the Pareto defined for \eqn{x > \theta}{x > s} is named Single Parameter Pareto, or Pareto I, in \pkg{actuar}. } \seealso{ \code{\link{dpareto2}} for an equivalent distribution with location parameter. \code{\link{dpareto1}} for the Single Parameter Pareto distribution. \code{"distributions"} package vignette for details on the interrelations between the continuous size distributions in \pkg{actuar} and complete formulas underlying the above functions. } \references{ Kleiber, C. and Kotz, S. (2003), \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ exp(dpareto(2, 3, 4, log = TRUE)) p <- (1:10)/10 ppareto(qpareto(p, 2, 3), 2, 3) ## variance mpareto(2, 4, 1) - mpareto(1, 4, 1)^2 ## case with shape - order > 0 levpareto(10, 3, scale = 1, order = 2) ## case with shape - order < 0 levpareto(10, 1.5, scale = 1, order = 2) } \keyword{distribution} actuar/man/ZeroTruncatedGeometric.Rd0000644000176200001440000000662214264305077017241 0ustar liggesusers\name{ZeroTruncatedGeometric} \alias{ZeroTruncatedGeometric} \alias{ZTGeometric} \alias{dztgeom} \alias{pztgeom} \alias{qztgeom} \alias{rztgeom} \title{The Zero-Truncated Geometric Distribution} \description{ Density function, distribution function, quantile function and random generation for the Zero-Truncated Geometric distribution with parameter \code{prob}. } \usage{ dztgeom(x, prob, log = FALSE) pztgeom(q, prob, lower.tail = TRUE, log.p = FALSE) qztgeom(p, prob, lower.tail = TRUE, log.p = FALSE) rztgeom(n, prob) } \arguments{ \item{x}{vector of (strictly positive integer) quantiles.} \item{q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{prob}{parameter. \code{0 < prob <= 1}.} \item{log, log.p}{logical; if \code{TRUE}, probabilities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}, otherwise, \eqn{P[X > x]}.} } \details{ The zero-truncated geometric distribution with \code{prob} \eqn{= p} has probability mass function \deqn{% p(x) = p (1-p)^{x - 1}}{% p(x) = p (1-p)^(x-1)} for \eqn{x = 1, 2, \ldots} and \eqn{0 < p < 1}, and \eqn{p(1) = 1} when \eqn{p = 1}. The cumulative distribution function is \deqn{P(x) = \frac{F(x) - F(0)}{1 - F(0)},}{% P(x) = [F(x) - F(0)]/[1 - F(0)],} where \eqn{F(x)} is the distribution function of the standard geometric. The mean is \eqn{1/p} and the variance is \eqn{(1-p)/p^2}. In the terminology of Klugman et al. (2012), the zero-truncated geometric is a member of the \eqn{(a, b, 1)} class of distributions with \eqn{a = 1-p} and \eqn{b = 0}. If an element of \code{x} is not integer, the result of \code{dztgeom} is zero, with a warning. The quantile is defined as the smallest value \eqn{x} such that \eqn{P(x) \ge p}, where \eqn{P} is the distribution function. } \value{ \code{dztgeom} gives the (log) probability mass function, \code{pztgeom} gives the (log) distribution function, \code{qztgeom} gives the quantile function, and \code{rztgeom} generates random deviates. Invalid \code{prob} will result in return value \code{NaN}, with a warning. The length of the result is determined by \code{n} for \code{rztgeom}, and is the maximum of the lengths of the numerical arguments for the other functions. } \note{ Functions \code{\{d,p,q\}ztgeom} use \code{\{d,p,q\}geom} for all but the trivial input values and \eqn{p(0)}. \code{rztgeom} uses the simple inversion algorithm suggested by Peter Dalgaard on the r-help mailing list on 1 May 2005 % (\url{https://stat.ethz.ch/pipermail/r-help/2005-May/070680.html}). } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ \code{\link{dgeom}} for the geometric distribution. \code{\link{dztnbinom}} for the zero-truncated negative binomial, of which the zero-truncated geometric is a special case. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ p <- 1/(1 + 0.5) dztgeom(c(1, 2, 3), prob = p) dgeom(c(1, 2, 3), p)/pgeom(0, p, lower = FALSE) # same dgeom(c(1, 2, 3) - 1, p) # same pztgeom(1, prob = 1) # point mass at 1 qztgeom(pztgeom(1:10, 0.3), 0.3) } \keyword{distribution} actuar/man/coverage.Rd0000644000176200001440000000747714264305077014415 0ustar liggesusers\name{coverage} \alias{coverage} \alias{Coverage} \title{Density and Cumulative Distribution Function for Modified Data} \description{ Compute probability density function or cumulative distribution function of the payment per payment or payment per loss random variable under any combination of the following coverage modifications: deductible, limit, coinsurance, inflation. } \usage{ coverage(pdf, cdf, deductible = 0, franchise = FALSE, limit = Inf, coinsurance = 1, inflation = 0, per.loss = FALSE) } \arguments{ \item{pdf, cdf}{function object or character string naming a function to compute, respectively, the probability density function and cumulative distribution function of a probability law.} \item{deductible}{a unique positive numeric value.} \item{franchise}{logical; \code{TRUE} for a franchise deductible, \code{FALSE} (default) for an ordinary deductible.} \item{limit}{a unique positive numeric value larger than \code{deductible}.} \item{coinsurance}{a unique value between 0 and 1; the proportion of coinsurance.} \item{inflation}{a unique value between 0 and 1; the rate of inflation.} \item{per.loss}{logical; \code{TRUE} for the per loss distribution, \code{FALSE} (default) for the per payment distribution.} } \details{ \code{coverage} returns a function to compute the probability density function (pdf) or the cumulative distribution function (cdf) of the distribution of losses under coverage modifications. The pdf and cdf of unmodified losses are \code{pdf} and \code{cdf}, respectively. If \code{pdf} is specified, the pdf is returned; if \code{pdf} is missing or \code{NULL}, the cdf is returned. Note that \code{cdf} is needed if there is a deductible or a limit. } \value{ An object of mode \code{"function"} with the same arguments as \code{pdf} or \code{cdf}, except \code{"lower.tail"}, \code{"log.p"} and \code{"log"}, which are not supported. } \note{ Setting arguments of the function returned by \code{coverage} using \code{\link{formals}} may very well not work as expected. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \seealso{ \code{vignette("coverage")} for the exact definitions of the per payment and per loss random variables under an ordinary or franchise deductible. } \examples{ ## Default case: pdf of the per payment random variable with ## an ordinary deductible coverage(dgamma, pgamma, deductible = 1) ## Add a limit f <- coverage(dgamma, pgamma, deductible = 1, limit = 7) f <- coverage("dgamma", "pgamma", deductible = 1, limit = 7) # same f(0, shape = 3, rate = 1) f(2, shape = 3, rate = 1) f(6, shape = 3, rate = 1) f(8, shape = 3, rate = 1) curve(dgamma(x, 3, 1), xlim = c(0, 10), ylim = c(0, 0.3)) # original curve(f(x, 3, 1), xlim = c(0.01, 5.99), col = 4, add = TRUE) # modified points(6, f(6, 3, 1), pch = 21, bg = 4) ## Cumulative distribution function F <- coverage(cdf = pgamma, deductible = 1, limit = 7) F(0, shape = 3, rate = 1) F(2, shape = 3, rate = 1) F(6, shape = 3, rate = 1) F(8, shape = 3, rate = 1) curve(pgamma(x, 3, 1), xlim = c(0, 10), ylim = c(0, 1)) # original curve(F(x, 3, 1), xlim = c(0, 5.99), col = 4, add = TRUE) # modified curve(F(x, 3, 1), xlim = c(6, 10), col = 4, add = TRUE) # modified ## With no deductible, all distributions below are identical coverage(dweibull, pweibull, limit = 5) coverage(dweibull, pweibull, per.loss = TRUE, limit = 5) coverage(dweibull, pweibull, franchise = TRUE, limit = 5) coverage(dweibull, pweibull, per.loss = TRUE, franchise = TRUE, limit = 5) ## Coinsurance alone; only case that does not require the cdf coverage(dgamma, coinsurance = 0.8) } \keyword{models} actuar/man/mean.grouped.data.Rd0000644000176200001440000000217614264305077016105 0ustar liggesusers\name{mean.grouped.data} \alias{mean.grouped.data} \title{Arithmetic Mean} \description{ Mean of grouped data objects. } \usage{ \method{mean}{grouped.data}(x, \dots) } \arguments{ \item{x}{an object of class \code{"grouped.data"}.} \item{\dots}{further arguments passed to or from other methods.} } \details{ The mean of grouped data with group boundaries \eqn{c_0, c_1, \dots, c_r}{c[0], c[1], \dots, c[r]} and group frequencies \eqn{n_1, \dots, n_r}{n[1], \dots, n[r]} is \deqn{\frac{1}{n} \sum_{j = 1}^r a_j n_j,}{% (1/n) * sum(j; a[j] * n[j]),} where \eqn{a_j = (c_{j - 1} + c_j)/2}{a[j] = (c[j - 1] + c[j])/2} is the midpoint of the \eqn{j}th interval, and \eqn{n = \sum_{j = 1}^r n_j}{n = sum(j; n[j])}. } \value{ A named vector of means. } \seealso{ \code{\link{grouped.data}} to create grouped data objects; \code{\link{emm}} to compute higher moments. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (1998), \emph{Loss Models, From Data to Decisions}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ data(gdental) mean(gdental) } \keyword{univar} actuar/man/ZeroTruncatedPoisson.Rd0000644000176200001440000000736114264305077016756 0ustar liggesusers\name{ZeroTruncatedPoisson} \alias{ZeroTruncatedPoisson} \alias{ZTPoisson} \alias{dztpois} \alias{pztpois} \alias{qztpois} \alias{rztpois} \title{The Zero-Truncated Poisson Distribution} \description{ Density function, distribution function, quantile function, random generation for the Zero-Truncated Poisson distribution with parameter \code{lambda}. } \usage{ dztpois(x, lambda, log = FALSE) pztpois(q, lambda, lower.tail = TRUE, log.p = FALSE) qztpois(p, lambda, lower.tail = TRUE, log.p = FALSE) rztpois(n, lambda) } \arguments{ \item{x}{vector of (strictly positive integer) quantiles.} \item{q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of values to return.} \item{lambda}{vector of (non negative) means.} \item{log, log.p}{logical; if \code{TRUE}, probabilities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} } \details{ The zero-truncated Poisson distribution has probability mass function \deqn{% p(x) = \frac{e^{-/lambda} \lambda^x}{x! (1 - e^{-\lambda})} = \frac{\lambda^x}{x! (e^{\lambda} - 1)}}{% p(x) = lambda^x exp(-lambda)/[x! (1 - exp(-lambda))] = lambda^x/[x! (e^lambda - 1)]} for \eqn{x = 1, 2, ...}, and \eqn{p(1) = 1} when \eqn{\lambda = 0}. The cumulative distribution function is \deqn{P(x) = \frac{F(x) - F(0)}{1 - F(0)},}{% P(x) = [F(x) - F(0)]/[1 - F(0)],} where \eqn{F(x)} is the distribution function of the standard Poisson. The mean is \eqn{\lambda/(1 - e^{-\lambda})^2}{\lambda/(1 - exp(-\lambda))} and the variance is \eqn{\lambda[1 - (\lambda+1)e^{-\lambda}]/(1 - e^{-\lambda})^2}{% \lambda[1 - (\lambda+1)exp(-\lambda)]/(1 - exp(-\lambda))^2}. In the terminology of Klugman et al. (2012), the zero-truncated Poisson is a member of the \eqn{(a, b, 1)} class of distributions with \eqn{a = 0} and \eqn{b = \lambda}. If an element of \code{x} is not integer, the result of \code{dztpois} is zero, with a warning. The quantile is defined as the smallest value \eqn{x} such that \eqn{P(x) \ge p}, where \eqn{P} is the distribution function. } \value{ \code{dztpois} gives the (log) probability mass function, \code{pztpois} gives the (log) distribution function, \code{qztpois} gives the quantile function, and \code{rztpois} generates random deviates. Invalid \code{lambda} will result in return value \code{NaN}, with a warning. The length of the result is determined by \code{n} for \code{rztpois}, and is the maximum of the lengths of the numerical arguments for the other functions. } \note{ Functions \code{\{d,p,q\}ztpois} use \code{\{d,p,q\}pois} for all but the trivial input values and \eqn{p(0)}. \code{rztpois} uses the simple inversion algorithm suggested by Peter Dalgaard on the r-help mailing list on 1 May 2005 % (\url{https://stat.ethz.ch/pipermail/r-help/2005-May/070680.html}). } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ \code{\link{dpois}} for the standard Poisson distribution. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ dztpois(1:5, lambda = 1) dpois(1:5, lambda = 1)/ppois(0, 1, lower = FALSE) # same pztpois(1, lambda = 0) # point mass at 1 qztpois(pztpois(1:10, 1), 1) x <- seq(0, 8) plot(x, dztpois(x, 2), type = "h", lwd = 2, ylab = "p(x)", main = "Zero-Truncated Poisson(2) and Poisson(2) PDF") points(x, dpois(x, 2), pch = 19, col = "red") legend("topright", c("ZT Poisson probabilities", "Poisson probabilities"), col = c("black", "red"), lty = c(1, 0), lwd = 2, pch = c(NA, 19)) } \keyword{distribution} actuar/man/ZeroTruncatedNegativeBinomial.Rd0000644000176200001440000001155214264305077020536 0ustar liggesusers\name{ZeroTruncatedNegativeBinomial} \alias{ZeroTruncatedNegativeBinomial} \alias{ZTNegativeBinomial} \alias{ZTNegBinomial} \alias{dztnbinom} \alias{pztnbinom} \alias{qztnbinom} \alias{rztnbinom} \title{The Zero-Truncated Negative Binomial Distribution} \description{ Density function, distribution function, quantile function and random generation for the Zero-Truncated Negative Binomial distribution with parameters \code{size} and \code{prob}. } \usage{ dztnbinom(x, size, prob, log = FALSE) pztnbinom(q, size, prob, lower.tail = TRUE, log.p = FALSE) qztnbinom(p, size, prob, lower.tail = TRUE, log.p = FALSE) rztnbinom(n, size, prob) } \arguments{ \item{x}{vector of (strictly positive integer) quantiles.} \item{q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{size}{target for number of successful trials, or dispersion parameter. Must be positive, need not be integer.} \item{prob}{parameter. \code{0 < prob <= 1}.} \item{log, log.p}{logical; if \code{TRUE}, probabilities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}, otherwise, \eqn{P[X > x]}.} } \details{ The zero-truncated negative binomial distribution with \code{size} \eqn{= r} and \code{prob} \eqn{= p} has probability mass function \deqn{% p(x) = \frac{\Gamma(x + r) p^r (1 - p)^x}{\Gamma(r) x! (1 - p^r)}}{% p(x) = [\Gamma(x+r) p^r (1-p)^x]/[\Gamma(n) x! (1-p^r)]} for \eqn{x = 1, 2, \ldots}, \eqn{r \ge 0} and \eqn{0 < p < 1}, and \eqn{p(1) = 1} when \eqn{p = 1}. The cumulative distribution function is \deqn{P(x) = \frac{F(x) - F(0)}{1 - F(0)},}{% P(x) = [F(x) - F(0)]/[1 - F(0)],} where \eqn{F(x)} is the distribution function of the standard negative binomial. The mean is \eqn{r(1-p)/(p(1-p^r))} and the variance is \eqn{[r(1-p)(1 - (1 + r(1-p))p^r)]/[p(1-p^r)]^2}. In the terminology of Klugman et al. (2012), the zero-truncated negative binomial is a member of the \eqn{(a, b, 1)} class of distributions with \eqn{a = 1-p} and \eqn{b = (r-1)(1-p)}. The limiting case \code{size == 0} is the \link[=Logarithmic]{logarithmic} distribution with parameter \code{1 - prob}. Unlike the standard negative binomial functions, parametrization through the mean \code{mu} is not supported to avoid ambiguity as to whether \code{mu} is the mean of the underlying negative binomial or the mean of the zero-truncated distribution. If an element of \code{x} is not integer, the result of \code{dztnbinom} is zero, with a warning. The quantile is defined as the smallest value \eqn{x} such that \eqn{P(x) \ge p}, where \eqn{P} is the distribution function. } \value{ \code{dztnbinom} gives the (log) probability mass function, \code{pztnbinom} gives the (log) distribution function, \code{qztnbinom} gives the quantile function, and \code{rztnbinom} generates random deviates. Invalid \code{size} or \code{prob} will result in return value \code{NaN}, with a warning. The length of the result is determined by \code{n} for \code{rztnbinom}, and is the maximum of the lengths of the numerical arguments for the other functions. } \note{ Functions \code{\{d,p,q\}ztnbinom} use \code{\{d,p,q\}nbinom} for all but the trivial input values and \eqn{p(0)}. \code{rztnbinom} uses the simple inversion algorithm suggested by Peter Dalgaard on the r-help mailing list on 1 May 2005 % (\url{https://stat.ethz.ch/pipermail/r-help/2005-May/070680.html}). } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ \code{\link{dnbinom}} for the negative binomial distribution. \code{\link{dztgeom}} for the zero-truncated geometric and \code{\link{dlogarithmic}} for the logarithmic, which are special cases of the zero-truncated negative binomial. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ ## Example 6.3 of Klugman et al. (2012) p <- 1/(1 + 0.5) dztnbinom(c(1, 2, 3), size = 2.5, prob = p) dnbinom(c(1, 2, 3), 2.5, p)/pnbinom(0, 2.5, p, lower = FALSE) # same pztnbinom(1, 2, prob = 1) # point mass at 1 dztnbinom(2, size = 1, 0.25) # == dztgeom(2, 0.25) dztnbinom(2, size = 0, 0.25) # == dlogarithmic(2, 0.75) qztnbinom(pztnbinom(1:10, 2.5, 0.3), 2.5, 0.3) x <- rztnbinom(1000, size = 2.5, prob = 0.4) y <- sort(unique(x)) plot(y, table(x)/length(x), type = "h", lwd = 2, pch = 19, col = "black", xlab = "x", ylab = "p(x)", main = "Empirical vs theoretical probabilities") points(y, dztnbinom(y, size = 2.5, prob = 0.4), pch = 19, col = "red") legend("topright", c("empirical", "theoretical"), lty = c(1, NA), lwd = 2, pch = c(NA, 19), col = c("black", "red")) } \keyword{distribution} actuar/man/cm.Rd0000644000176200001440000004237614264305077013216 0ustar liggesusers\name{cm} \alias{cm} \alias{print.cm} \alias{predict.cm} \alias{summary.cm} \alias{print.summary.cm} \title{Credibility Models} \description{ Fit the following credibility models: \enc{Bühlmann}{Buhlmann}, \enc{Bühlmann}{Buhlmann}-Straub, hierarchical, regression (Hachemeister) or linear Bayes. } \usage{ cm(formula, data, ratios, weights, subset, regformula = NULL, regdata, adj.intercept = FALSE, method = c("Buhlmann-Gisler", "Ohlsson", "iterative"), likelihood, ..., tol = sqrt(.Machine$double.eps), maxit = 100, echo = FALSE) \method{print}{cm}(x, \dots) \method{predict}{cm}(object, levels = NULL, newdata, \dots) \method{summary}{cm}(object, levels = NULL, newdata, \dots) \method{print}{summary.cm}(x, \dots) } \arguments{ \item{formula}{character string \code{"bayes"} or an object of class \code{"\link[stats]{formula}"}: a symbolic description of the model to be fit. The details of model specification are given below.} \item{data}{a matrix or a data frame containing the portfolio structure, the ratios or claim amounts and their associated weights, if any.} \item{ratios}{expression indicating the columns of \code{data} containing the ratios or claim amounts.} \item{weights}{expression indicating the columns of \code{data} containing the weights associated with \code{ratios}.} \item{subset}{an optional logical expression indicating a subset of observations to be used in the modeling process. All observations are included by default.} \item{regformula}{an object of class \code{"\link[stats]{formula}"}: symbolic description of the regression component (see \code{\link[stats]{lm}} for details). No left hand side is needed in the formula; if present it is ignored. If \code{NULL}, no regression is done on the data.} \item{regdata}{an optional data frame, list or environment (or object coercible by \code{\link[base]{as.data.frame}} to a data frame) containing the variables in the regression model.} \item{adj.intercept}{if \code{TRUE}, the intercept of the regression model is located at the barycenter of the regressor instead of the origin.} \item{method}{estimation method for the variance components of the model; see Details.} \item{likelihood}{a character string giving the name of the likelihood function in one of the supported linear Bayes cases; see Details.} \item{tol}{tolerance level for the stopping criteria for iterative estimation method.} \item{maxit}{maximum number of iterations in iterative estimation method.} \item{echo}{logical; whether to echo the iterative procedure or not.} \item{x, object}{an object of class \code{"cm"}.} \item{levels}{character vector indicating the levels to predict or to include in the summary; if \code{NULL} all levels are included.} \item{newdata}{data frame containing the variables used to predict credibility regression models.} \item{\dots}{parameters of the prior distribution for \code{cm}; additional attributes to attach to the result for the \code{predict} and \code{summary} methods; further arguments to \code{\link[base]{format}} for the \code{print.summary} method; unused for the \code{print} method.} } \details{ \code{cm} is the unified front end for credibility models fitting. The function supports hierarchical models with any number of levels (with \enc{Bühlmann}{Buhlmann} and \enc{Bühlmann}{Buhlmann}-Straub models as special cases) and the regression model of Hachemeister. Usage of \code{cm} is similar to \code{\link[stats]{lm}} for these cases. \code{cm} can also fit linear Bayes models, in which case usage is much simplified; see the section on linear Bayes below. When not \code{"bayes"}, the \code{formula} argument symbolically describes the structure of the portfolio in the form \eqn{~ terms}. Each term is an interaction between risk factors contributing to the total variance of the portfolio data. Terms are separated by \code{+} operators and interactions within each term by \code{:}. For a portfolio divided first into sectors, then units and finally contracts, \code{formula} would be \code{~ sector + sector:unit + sector:unit:contract}, where \code{sector}, \code{unit} and \code{contract} are column names in \code{data}. In general, the formula should be of the form \code{~ a + a:b + a:b:c + a:b:c:d + ...}. If argument \code{regformula} is not \code{NULL}, the regression model of Hachemeister is fit to the data. The response is usually time. By default, the intercept of the model is located at time origin. If argument \code{adj.intercept} is \code{TRUE}, the intercept is moved to the (collective) barycenter of time, by orthogonalization of the design matrix. Note that the regression coefficients may be difficult to interpret in this case. Arguments \code{ratios}, \code{weights} and \code{subset} are used like arguments \code{select}, \code{select} and \code{subset}, respectively, of function \code{\link[base]{subset}}. Data does not have to be sorted by level. Nodes with no data (complete lines of \code{NA} except for the portfolio structure) are allowed, with the restriction mentioned above. } \section{Hierarchical models}{ The credibility premium at one level is a convex combination between the linearly sufficient statistic of a node and the credibility premium of the level above. (For the first level, the complement of credibility is given to the collective premium.) The linearly sufficient statistic of a node is the credibility weighted average of the data of the node, except at the last level, where natural weights are used. The credibility factor of node \eqn{i} is equal to \deqn{\frac{w_i}{w_i + a/b},}{w[i]/(w[i] + a/b),} where \eqn{w_i}{w[i]} is the weight of the node used in the linearly sufficient statistic, \eqn{a} is the average within node variance and \eqn{b} is the average between node variance. } \section{Regression models}{ The credibility premium of node \eqn{i} is equal to \deqn{y^\prime b_i^a,}{y' ba[i],} where \eqn{y} is a matrix created from \code{newdata} and \eqn{b_i^a}{ba[i]} is the vector of credibility adjusted regression coefficients of node \eqn{i}. The latter is given by \deqn{b_i^a = Z_i b_i + (I - Z_I) m,}{ ba[i] = Z[i] b[i] + (I - Z[i]) m,} where \eqn{b_i}{b[i]} is the vector of regression coefficients based on data of node \eqn{i} only, \eqn{m} is the vector of collective regression coefficients, \eqn{Z_i}{Z[i]} is the credibility matrix and \eqn{I} is the identity matrix. The credibility matrix of node \eqn{i} is equal to \deqn{A^{-1} (A + s^2 S_i),}{A^(-1) (A + s2 S[i]),} where \eqn{S_i}{S[i]} is the unscaled regression covariance matrix of the node, \eqn{s^2}{s2} is the average within node variance and \eqn{A} is the within node covariance matrix. If the intercept is positioned at the barycenter of time, matrices \eqn{S_i}{S[i]} and \eqn{A} (and hence \eqn{Z_i}{Z[i]}) are diagonal. This amounts to use \enc{Bühlmann}{Buhlmann}-Straub models for each regression coefficient. Argument \code{newdata} provides the \dQuote{future} value of the regressors for prediction purposes. It should be given as specified in \code{\link[stats]{predict.lm}}. } \section{Variance components estimation}{ For hierarchical models, two sets of estimators of the variance components (other than the within node variance) are available: unbiased estimators and iterative estimators. Unbiased estimators are based on sums of squares of the form \deqn{B_i = \sum_j w_{ij} (X_{ij} - \bar{X}_i)^2 - (J - 1) a}{% B[i] = sum(j; w[ij] (X[ij] - Xb[i])^2 - (J - 1) a)}% and constants of the form \deqn{c_i = w_i - \sum_j \frac{w_{ij}^2}{w_i},}{% c[i] = w[i] - sum(j; w[ij]^2)/w[i],}% where \eqn{X_{ij}}{X[ij]} is the linearly sufficient statistic of level \eqn{(ij)}; \eqn{\bar{X_{i}}}{Xb[i]} is the weighted average of the latter using weights \eqn{w_{ij}}{w[ij]}; \eqn{w_i = \sum_j w_{ij}}{w[i] = sum(j; w[ij])}; \eqn{J} is the effective number of nodes at level \eqn{(ij)}; \eqn{a} is the within variance of this level. Weights \eqn{w_{ij}}{w[ij]} are the natural weights at the lowest level, the sum of the natural weights the next level and the sum of the credibility factors for all upper levels. The \enc{Bühlmann}{Buhlmann}-Gisler estimators (\code{method = "Buhlmann-Gisler"}) are given by% \deqn{b = \frac{1}{I} \sum_i \max \left( \frac{B_i}{c_i}, 0 \right),}{% b = mean(max(B[i]/c[i], 0)),}% that is the average of the per node variance estimators truncated at 0. The Ohlsson estimators (\code{method = "Ohlsson"}) are given by \deqn{b = \frac{\sum_i B_i}{\sum_i c_i},}{% b = sum(i; B[i]) / sum(i; c[i]),}% that is the weighted average of the per node variance estimators without any truncation. Note that negative estimates will be truncated to zero for credibility factor calculations. In the \enc{Bühlmann}{Buhlmann}-Straub model, these estimators are equivalent. Iterative estimators \code{method = "iterative"} are pseudo-estimators of the form \deqn{b = \frac{1}{d} \sum_i w_i (X_i - \bar{X})^2,}{% b = sum(i; w[i] * (X[i] - Xb)^2)/d,} where \eqn{X_i}{X[i]} is the linearly sufficient statistic of one level, \eqn{\bar{X}}{Xb} is the linearly sufficient statistic of the level above and \eqn{d} is the effective number of nodes at one level minus the effective number of nodes of the level above. The Ohlsson estimators are used as starting values. For regression models, with the intercept at time origin, only iterative estimators are available. If \code{method} is different from \code{"iterative"}, a warning is issued. With the intercept at the barycenter of time, the choice of estimators is the same as in the \enc{Bühlmann}{Buhlmann}-Straub model. } \section{Linear Bayes}{ When \code{formula} is \code{"bayes"}, the function computes pure Bayesian premiums for the following combinations of distributions where they are linear credibility premiums: \itemize{ \item{\eqn{X|\Theta = \theta \sim \mathrm{Poisson}(\theta)}{X|\Theta ~ Poisson(\Theta)} and \eqn{\Theta \sim \mathrm{Gamma}(\alpha, \lambda)}{\Theta ~ Gamma(\alpha, \lambda)};} \item{\eqn{X|\Theta = \theta \sim \mathrm{Exponential}(\theta)}{X|\Theta ~ Exponential(\Theta)} and \eqn{\Theta \sim \mathrm{Gamma}(\alpha, \lambda)}{\Theta ~ Gamma(\alpha, \lambda)};} \item{\eqn{X|\Theta = \theta \sim \mathrm{Gamma}(\tau, \theta)}{X|\Theta ~ Gamma(\tau, \Theta)} and \eqn{\Theta \sim \mathrm{Gamma}(\alpha, \lambda)}{\Theta ~ Gamma(\alpha, \lambda)};} \item{\eqn{X|\Theta = \theta \sim \mathrm{Normal}(\theta, \sigma_2^2)}{X|\Theta ~ Normal(\Theta, \sigma_2^2)} and \eqn{\Theta \sim \mathrm{Normal}(\mu, \sigma_1^2)}{\Theta ~ Normal(\mu, \sigma_1^2)};} \item{\eqn{X|\Theta = \theta \sim \mathrm{Bernoulli}(\theta)}{X|\Theta ~ Bernoulli(\Theta)} and \eqn{\Theta \sim \mathrm{Beta}(a, b)}{\Theta ~ Beta(a, b)};} \item{\eqn{X|\Theta = \theta \sim \mathrm{Binomial}(\nu, \theta)}{X|\Theta ~ Binomial(\nu, \Theta)} and \eqn{\Theta \sim \mathrm{Beta}(a, b)}{\Theta ~ Beta(a, b)};} \item{\eqn{X|\Theta = \theta \sim \mathrm{Geometric}(\theta)}{X|\Theta = \theta ~ Geometric(\theta)} and \eqn{\Theta \sim \mathrm{Beta}(a, b)}{\Theta ~ Beta(a, b)}.} \item{\eqn{X|\Theta = \theta \sim \mathrm{Negative~Binomial}(r, \theta)}{X|\Theta ~ Negative Binomial(r, \Theta)} and \eqn{\Theta \sim \mathrm{Beta}(a, b)}{\Theta ~ Beta(a, b)}.}} The following combination is also supported: \eqn{X|\Theta = \theta \sim \mathrm{Single~Parameter~Pareto}(\theta)}{X|\Theta ~ Single Parameter Pareto(\Theta)} and \eqn{\Theta \sim \mathrm{Gamma}(\alpha, \lambda)}{\Theta ~ Gamma(\alpha, \lambda)}. In this case, the Bayesian estimator not of the risk premium, but rather of parameter \eqn{\theta} is linear with a \dQuote{credibility} factor that is not restricted to \eqn{(0, 1)}. Argument \code{likelihood} identifies the distribution of \eqn{X|\Theta = \theta} as one of \code{"poisson"}, \code{"exponential"}, \code{"gamma"}, \code{"normal"}, \code{"bernoulli"}, \code{"binomial"}, \code{"geometric"}, \code{"negative binomial"} or \code{"pareto"}. The parameters of the distributions of \eqn{X|\Theta = \theta} (when needed) and \eqn{\Theta} are set in \code{\dots} using the argument names (and default values) of \code{\link[stats]{dgamma}}, \code{\link[stats]{dnorm}}, \code{\link[stats]{dbeta}}, \code{\link[stats]{dbinom}}, \code{\link[stats]{dnbinom}} or \code{dpareto1}, as appropriate. For the Gamma/Gamma case, use \code{shape.lik} for the shape parameter \eqn{\tau} of the Gamma likelihood. For the Normal/Normal case, use \code{sd.lik} for the standard error \eqn{\sigma_2} of the Normal likelihood. Data for the linear Bayes case may be a matrix or data frame as usual; an atomic vector to fit the model to a single contract; missing or \code{NULL} to fit the prior model. Arguments \code{ratios}, \code{weights} and \code{subset} are ignored. } \value{ Function \code{cm} computes the structure parameters estimators of the model specified in \code{formula}. The value returned is an object of class \code{cm}. An object of class \code{"cm"} is a list with at least the following components: \item{means}{a list containing, for each level, the vector of linearly sufficient statistics.} \item{weights}{a list containing, for each level, the vector of total weights.} \item{unbiased}{a vector containing the unbiased variance components estimators, or \code{NULL}.} \item{iterative}{a vector containing the iterative variance components estimators, or \code{NULL}.} \item{cred}{for multi-level hierarchical models: a list containing, the vector of credibility factors for each level. For one-level models: an array or vector of credibility factors.} \item{nodes}{a list containing, for each level, the vector of the number of nodes in the level.} \item{classification}{the columns of \code{data} containing the portfolio classification structure.} \item{ordering}{a list containing, for each level, the affiliation of a node to the node of the level above.} Regression fits have in addition the following components: \item{adj.models}{a list containing, for each node, the credibility adjusted regression model as obtained with \code{\link[stats]{lm.fit}} or \code{\link[stats]{lm.wfit}}.} \item{transition}{if \code{adj.intercept} is \code{TRUE}, a transition matrix from the basis of the orthogonal design matrix to the basis of the original design matrix.} \item{terms}{the \code{\link[stats]{terms}} object used.} The method of \code{predict} for objects of class \code{"cm"} computes the credibility premiums for the nodes of every level included in argument \code{levels} (all by default). Result is a list the same length as \code{levels} or the number of levels in \code{formula}, or an atomic vector for one-level models. } \references{ \enc{Bühlmann}{Buhlmann}, H. and Gisler, A. (2005), \emph{A Course in Credibility Theory and its Applications}, Springer. Belhadj, H., Goulet, V. and Ouellet, T. (2009), On parameter estimation in hierarchical credibility, \emph{Astin Bulletin} \bold{39}. Goulet, V. (1998), Principles and application of credibility theory, \emph{Journal of Actuarial Practice} \bold{6}, ISSN 1064-6647. Goovaerts, M. J. and Hoogstad, W. J. (1987), \emph{Credibility Theory}, Surveys of Actuarial Studies, No. 4, Nationale-Nederlanden N.V. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca}, Xavier Milhaud, Tommy Ouellet, Louis-Philippe Pouliot } \seealso{ \code{\link[base]{subset}}, \code{\link[stats]{formula}}, \code{\link[stats]{lm}}, \code{\link[stats]{predict.lm}}. } \examples{ data(hachemeister) ## Buhlmann-Straub model fit <- cm(~state, hachemeister, ratios = ratio.1:ratio.12, weights = weight.1:weight.12) fit # print method predict(fit) # credibility premiums summary(fit) # more details ## Two-level hierarchical model. Notice that data does not have ## to be sorted by level X <- data.frame(unit = c("A", "B", "A", "B", "B"), hachemeister) fit <- cm(~unit + unit:state, X, ratio.1:ratio.12, weight.1:weight.12) predict(fit) predict(fit, levels = "unit") # unit credibility premiums only summary(fit) summary(fit, levels = "unit") # unit summaries only ## Regression model with intercept at time origin fit <- cm(~state, hachemeister, regformula = ~time, regdata = data.frame(time = 12:1), ratios = ratio.1:ratio.12, weights = weight.1:weight.12) fit predict(fit, newdata = data.frame(time = 0)) summary(fit, newdata = data.frame(time = 0)) ## Same regression model, with intercept at barycenter of time fit <- cm(~state, hachemeister, adj.intercept = TRUE, regformula = ~time, regdata = data.frame(time = 12:1), ratios = ratio.1:ratio.12, weights = weight.1:weight.12) fit predict(fit, newdata = data.frame(time = 0)) summary(fit, newdata = data.frame(time = 0)) ## Poisson/Gamma pure Bayesian model fit <- cm("bayes", data = c(5, 3, 0, 1, 1), likelihood = "poisson", shape = 3, rate = 3) fit predict(fit) summary(fit) ## Normal/Normal pure Bayesian model cm("bayes", data = c(5, 3, 0, 1, 1), likelihood = "normal", sd.lik = 2, mean = 2, sd = 1) } \keyword{models} actuar/man/VaR.Rd0000644000176200001440000000105314264305077013272 0ustar liggesusers\name{VaR} \alias{VaR} \title{Value at Risk} \description{ Value at Risk. } \usage{ VaR(x, \dots) } \arguments{ \item{x}{an \R object.} \item{\dots}{further arguments passed to or from other methods.} } \details{ This is a generic function with, currently, only a method for objects of class \code{"aggregateDist"}. } \value{ An object of class \code{numeric}. } \seealso{ \code{\link{VaR.aggregateDist}}, \code{\link{aggregateDist}} } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Tommy Ouellet } \keyword{univar} actuar/man/mde.Rd0000644000176200001440000000713214264305077013353 0ustar liggesusers\name{mde} \alias{Mde} \alias{mde} \title{Minimum Distance Estimation} \description{ Minimum distance fitting of univariate distributions, allowing parameters to be held fixed if desired. } \usage{ mde(x, fun, start, measure = c("CvM", "chi-square", "LAS"), weights = NULL, ...) } \arguments{ \item{x}{a vector or an object of class \code{"grouped data"} (in which case only the first column of frequencies is used).} \item{fun}{function returning a cumulative distribution (for \code{measure = "CvM"} and \code{measure = "chi-square"}) or a limited expected value (for \code{measure = "LAS"}) evaluated at its first argument.} \item{start}{a named list giving the parameters to be optimized with initial values} \item{measure}{either \code{"CvM"} for the Cramer-von Mises method, \code{"chi-square"} for the modified chi-square method, or \code{"LAS"} for the layer average severity method.} \item{weights}{weights; see Details.} \item{\dots}{Additional parameters, either for \code{fun} or for \code{optim}. In particular, it can be used to specify bounds via \code{lower} or \code{upper} or both. If arguments of \code{fun} are included they will be held fixed.} } \details{ The Cramer-von Mises method (\code{"CvM"}) minimizes the squared difference between the theoretical cdf and the empirical cdf at the data points (for individual data) or the ogive at the knots (for grouped data). The modified chi-square method (\code{"chi-square"}) minimizes the modified chi-square statistic for grouped data, that is the squared difference between the expected and observed frequency within each group. The layer average severity method (\code{"LAS"}) minimizes the squared difference between the theoretical and empirical limited expected value within each group for grouped data. All sum of squares can be weighted. If arguments \code{weights} is missing, weights default to 1 for \code{measure = "CvM"} and \code{measure = "LAS"}; for \code{measure = "chi-square"}, weights default to \eqn{1/n_j}{1/n[j]}, where \eqn{n_j}{n[j]} is the frequency in group \eqn{j = 1, \dots, r}. Optimization is performed using \code{\link{optim}}. For one-dimensional problems the Nelder-Mead method is used and for multi-dimensional problems the BFGS method, unless arguments named \code{lower} or \code{upper} are supplied when \code{L-BFGS-B} is used or \code{method} is supplied explicitly. } \value{ An object of class \code{"mde"}, a list with two components: \item{estimate}{the parameter estimates, and} \item{distance}{the distance.} } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (1998), \emph{Loss Models, From Data to Decisions}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ ## Individual data example data(dental) mde(dental, pexp, start = list(rate = 1/200), measure = "CvM") ## Example 2.21 of Klugman et al. (1998) data(gdental) mde(gdental, pexp, start = list(rate = 1/200), measure = "CvM") mde(gdental, pexp, start = list(rate = 1/200), measure = "chi-square") mde(gdental, levexp, start = list(rate = 1/200), measure = "LAS") ## Two-parameter distribution example try(mde(gdental, ppareto, start = list(shape = 3, scale = 600), measure = "CvM")) # no convergence ## Working in log scale often solves the problem pparetolog <- function(x, shape, scale) ppareto(x, exp(shape), exp(scale)) ( p <- mde(gdental, pparetolog, start = list(shape = log(3), scale = log(600)), measure = "CvM") ) exp(p$estimate) } \keyword{distribution} \keyword{htest} actuar/man/GeneralizedPareto.Rd0000644000176200001440000001210114264305077016202 0ustar liggesusers\name{GeneralizedPareto} \alias{GeneralizedPareto} \alias{dgenpareto} \alias{pgenpareto} \alias{qgenpareto} \alias{rgenpareto} \alias{mgenpareto} \alias{levgenpareto} \title{The Generalized Pareto Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments and limited moments for the Generalized Pareto distribution with parameters \code{shape1}, \code{shape2} and \code{scale}. } \usage{ dgenpareto(x, shape1, shape2, rate = 1, scale = 1/rate, log = FALSE) pgenpareto(q, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) qgenpareto(p, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) rgenpareto(n, shape1, shape2, rate = 1, scale = 1/rate) mgenpareto(order, shape1, shape2, rate = 1, scale = 1/rate) levgenpareto(limit, shape1, shape2, rate = 1, scale = 1/rate, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{shape1, shape2, scale}{parameters. Must be strictly positive.} \item{rate}{an alternative way to specify the scale.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The Generalized Pareto distribution with parameters \code{shape1} \eqn{= \alpha}{= a}, \code{shape2} \eqn{= \tau}{= b} and \code{scale} \eqn{= \theta}{= s} has density: \deqn{f(x) = \frac{\Gamma(\alpha + \tau)}{\Gamma(\alpha)\Gamma(\tau)} \frac{\theta^\alpha x^{\tau - 1}}{% (x + \theta)^{\alpha + \tau}}}{% f(x) = Gamma(a + b)/(Gamma(a) * Gamma(b)) * (s^a x^(b - 1))/(x + s)^(a + b)} for \eqn{x > 0}, \eqn{\alpha > 0}{a > 0}, \eqn{\tau > 0}{b > 0} and \eqn{\theta > 0}{s > 0}. (Here \eqn{\Gamma(\alpha)} is the function implemented by \R's \code{\link{gamma}()} and defined in its help.) The Generalized Pareto is the distribution of the random variable \deqn{\theta \left(\frac{X}{1 - X}\right),}{\theta (X/(1 - X)),} where \eqn{X} has a beta distribution with parameters \eqn{\alpha} and \eqn{\tau}. The Generalized Pareto distribution has the following special cases: \itemize{ \item A \link[=dpareto]{Pareto} distribution when \code{shape2 == 1}; \item An \link[=dinvpareto]{Inverse Pareto} distribution when \code{shape1 == 1}. } The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}, \eqn{-\tau < k < \alpha}{-shape2 < k < shape1}. The \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]}, \eqn{k > -\tau}{k > -shape2} and \eqn{\alpha - k}{shape1 - k} not a negative integer. } \value{ \code{dgenpareto} gives the density, \code{pgenpareto} gives the distribution function, \code{qgenpareto} gives the quantile function, \code{rgenpareto} generates random deviates, \code{mgenpareto} gives the \eqn{k}th raw moment, and \code{levgenpareto} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ \code{levgenpareto} computes the limited expected value using \code{\link{betaint}}. Distribution also known as the Beta of the Second Kind. See also Kleiber and Kotz (2003) for alternative names and parametrizations. The Generalized Pareto distribution defined here is different from the one in Embrechts et al. (1997) and in \href{https://en.wikipedia.org/wiki/Generalized_Pareto_distribution}{Wikipedia}; see also Kleiber and Kotz (2003, section 3.12). One may most likely compute quantities for the latter using functions for the \link[=dpareto]{Pareto} distribution with the appropriate change of parametrization. The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Embrechts, P., Klüppelberg, C. and Mikisch, T. (1997), \emph{Modelling Extremal Events for Insurance and Finance}, Springer. Kleiber, C. and Kotz, S. (2003), \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ exp(dgenpareto(3, 3, 4, 4, log = TRUE)) p <- (1:10)/10 pgenpareto(qgenpareto(p, 3, 3, 1), 3, 3, 1) qgenpareto(.3, 3, 4, 4, lower.tail = FALSE) ## variance mgenpareto(2, 3, 2, 1) - mgenpareto(1, 3, 2, 1)^2 ## case with shape1 - order > 0 levgenpareto(10, 3, 3, scale = 1, order = 2) ## case with shape1 - order < 0 levgenpareto(10, 1.5, 3, scale = 1, order = 2) } \keyword{distribution} actuar/man/gdental.Rd0000644000176200001440000000123214264305077014217 0ustar liggesusers\name{gdental} \docType{data} \alias{gdental} \title{Grouped Dental Claims Data Set} \description{ Grouped dental claims, that is presented in a number of claims per claim amount group form. } \usage{gdental} \format{ An object of class \code{"grouped.data"} (inheriting from class \code{"data.frame"}) consisting of 10 rows and 2 columns. The environment of the object contains the plain vector of \code{cj} of group boundaries } \source{Klugman, S. A., Panjer, H. H. and Willmot, G. E. (1998), \emph{Loss Models, From Data to Decisions}, Wiley. } \seealso{ \code{\link{grouped.data}} for a description of grouped data objects. } \keyword{datasets} actuar/man/Pareto4.Rd0000644000176200001440000001162514264305077014126 0ustar liggesusers\name{Pareto4} \alias{Pareto4} \alias{dpareto4} \alias{ppareto4} \alias{qpareto4} \alias{rpareto4} \alias{mpareto4} \alias{levpareto4} \title{The Pareto IV Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments and limited moments for the Pareto IV distribution with parameters \code{min}, \code{shape1}, \code{shape2} and \code{scale}. } \usage{ dpareto4(x, min, shape1, shape2, rate = 1, scale = 1/rate, log = FALSE) ppareto4(q, min, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) qpareto4(p, min, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) rpareto4(n, min, shape1, shape2, rate = 1, scale = 1/rate) mpareto4(order, min, shape1, shape2, rate = 1, scale = 1/rate) levpareto4(limit, min, shape1, shape2, rate = 1, scale = 1/rate, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{min}{lower bound of the support of the distribution.} \item{shape1, shape2, scale}{parameters. Must be strictly positive.} \item{rate}{an alternative way to specify the scale.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The Pareto IV (or \dQuote{type IV}) distribution with parameters \code{min} \eqn{= \mu}{= m}, \code{shape1} \eqn{= \alpha}{= a}, \code{shape2} \eqn{= \gamma}{= b} and \code{scale} \eqn{= \theta}{= s} has density: \deqn{f(x) = \frac{\alpha \gamma ((x - \mu)/\theta)^{\gamma - 1}}{% \theta [1 + ((x - \mu)/\theta)^\gamma]^{\alpha + 1}}}{% f(x) = (a b ((x - m)/s)^(b - 1))/(s [1 + ((x - m)/s)^b]^(a + 1))} for \eqn{x > \mu}{x > m}, \eqn{-\infty < \mu < \infty}{-Inf < m < Inf}, \eqn{\alpha > 0}{a > 0}, \eqn{\gamma > 0}{b > 0} and \eqn{\theta > 0}{s > 0}. The Pareto IV is the distribution of the random variable \deqn{\mu + \theta \left(\frac{X}{1 - X}\right)^{1/\gamma},}{% m + s (X/(1 - X))^(1/b),} where \eqn{X} has a beta distribution with parameters \eqn{1} and \eqn{\alpha}{a}. It derives from the \link[=dfpareto]{Feller-Pareto} distribution with \eqn{\tau = 1}{shape3 = 1}. Setting \eqn{\mu = 0}{min = 0} yields the \link[=dburr]{Burr} distribution. The Pareto IV distribution also has the following direct special cases: \itemize{ \item A \link[=dpareto3]{Pareto III} distribution when \code{shape1 == 1}; \item A \link[=dpareto2]{Pareto II} distribution when \code{shape1 == 1}. } The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]} for nonnegative integer values of \eqn{k < \alpha\gamma}{k < shape1 * shape2}. The \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]} for nonnegative integer values of \eqn{k} and \eqn{\alpha - j/\gamma}{shape1 - j/shape2}, \eqn{j = 1, \dots, k} not a negative integer. } \value{ \code{dpareto4} gives the density, \code{ppareto4} gives the distribution function, \code{qpareto4} gives the quantile function, \code{rpareto4} generates random deviates, \code{mpareto4} gives the \eqn{k}th raw moment, and \code{levpareto4} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ \code{levpareto4} computes the limited expected value using \code{\link{betaint}}. For Pareto distributions, we use the classification of Arnold (2015) with the parametrization of Klugman et al. (2012). The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Arnold, B.C. (2015), \emph{Pareto Distributions}, Second Edition, CRC Press. Kleiber, C. and Kotz, S. (2003), \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ \code{\link{dburr}} for the Burr distribution. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ exp(dpareto4(1, min = 10, 2, 3, log = TRUE)) p <- (1:10)/10 ppareto4(qpareto4(p, min = 10, 2, 3, 2), min = 10, 2, 3, 2) ## variance mpareto4(2, min = 10, 2, 3, 1) - mpareto4(1, min = 10, 2, 3, 1) ^ 2 ## case with shape1 - order/shape2 > 0 levpareto4(10, min = 10, 2, 3, 1, order = 2) ## case with shape1 - order/shape2 < 0 levpareto4(10, min = 10, 1.5, 0.5, 1, order = 2) } \keyword{distribution} actuar/man/discretize.Rd0000644000176200001440000001076014264305077014754 0ustar liggesusers\name{discretize} \alias{discretize} \alias{discretise} \title{Discretization of a Continuous Distribution} \description{ Compute a discrete probability mass function from a continuous cumulative distribution function (cdf) with various methods. \code{discretise} is an alias for \code{discretize}. } \usage{ discretize(cdf, from, to, step = 1, method = c("upper", "lower", "rounding", "unbiased"), lev, by = step, xlim = NULL) discretise(cdf, from, to, step = 1, method = c("upper", "lower", "rounding", "unbiased"), lev, by = step, xlim = NULL) } \arguments{ \item{cdf}{an expression written as a function of \code{x}, or alternatively the name of a function, giving the cdf to discretize.} \item{from, to}{the range over which the function will be discretized.} \item{step}{numeric; the discretization step (or span, or lag).} \item{method}{discretization method to use.} \item{lev}{an expression written as a function of \code{x}, or alternatively the name of a function, to compute the limited expected value of the distribution corresponding to \code{cdf}. Used only with the \code{"unbiased"} method.} \item{by}{an alias for \code{step}.} \item{xlim}{numeric of length 2; if specified, it serves as default for \code{c(from, to)}.} } \details{ Usage is similar to \code{\link{curve}}. \code{discretize} returns the probability mass function (pmf) of the random variable obtained by discretization of the cdf specified in \code{cdf}. Let \eqn{F(x)} denote the cdf, \eqn{E[\min(X, x)]}{E[min(X, x)]]} the limited expected value at \eqn{x}, \eqn{h} the step, \eqn{p_x}{p[x]} the probability mass at \eqn{x} in the discretized distribution and set \eqn{a =} \code{from} and \eqn{b =} \code{to}. Method \code{"upper"} is the forward difference of the cdf \eqn{F}: \deqn{p_x = F(x + h) - F(x)}{p[x] = F(x + h) - F(x)} for \eqn{x = a, a + h, \dots, b - step}. Method \code{"lower"} is the backward difference of the cdf \eqn{F}: \deqn{p_x = F(x) - F(x - h)}{p[x] = F(x) - F(x - h)} for \eqn{x = a + h, \dots, b} and \eqn{p_a = F(a)}{p[a] = F(a)}. Method \code{"rounding"} has the true cdf pass through the midpoints of the intervals \eqn{[x - h/2, x + h/2)}: \deqn{p_x = F(x + h/2) - F(x - h/2)}{p[x] = F(x + h/2) - F(x - h/2)} for \eqn{x = a + h, \dots, b - step} and \eqn{p_a = F(a + h/2)}{p[a] = F(a + h/2)}. The function assumes the cdf is continuous. Any adjusment necessary for discrete distributions can be done via \code{cdf}. Method \code{"unbiased"} matches the first moment of the discretized and the true distributions. The probabilities are as follows: \deqn{p_a = \frac{E[\min(X, a)] - E[\min(X, a + h)]}{h} + 1 - F(a)}{% p[a] = (E[min(X, a)] - E[min(X, a + h)])/h + 1 - F(a)} \deqn{p_x = \frac{2 E[\min(X, x)] - E[\min(X, x - h)] - E[\min(X, x + h)]}{h}, \quad a < x < b}{% p[x] = (2 E[min(X, x)] - E[min(X, x - h)] - E[min(X, x + h)])/h, a < x < b} \deqn{p_b = \frac{E[\min(X, b)] - E[\min(X, b - h)]}{h} - 1 + F(b),}{% p[b] = (E[min(X, b)] - E[min(X, b - h)])/h - 1 + F(b).} } \value{ A numeric vector of probabilities suitable for use in \code{\link{aggregateDist}}. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \seealso{ \code{\link{aggregateDist}} } \examples{ x <- seq(0, 5, 0.5) op <- par(mfrow = c(1, 1), col = "black") ## Upper and lower discretization fu <- discretize(pgamma(x, 1), method = "upper", from = 0, to = 5, step = 0.5) fl <- discretize(pgamma(x, 1), method = "lower", from = 0, to = 5, step = 0.5) curve(pgamma(x, 1), xlim = c(0, 5)) par(col = "blue") plot(stepfun(head(x, -1), diffinv(fu)), pch = 19, add = TRUE) par(col = "green") plot(stepfun(x, diffinv(fl)), pch = 19, add = TRUE) par(col = "black") ## Rounding (or midpoint) discretization fr <- discretize(pgamma(x, 1), method = "rounding", from = 0, to = 5, step = 0.5) curve(pgamma(x, 1), xlim = c(0, 5)) par(col = "blue") plot(stepfun(head(x, -1), diffinv(fr)), pch = 19, add = TRUE) par(col = "black") ## First moment matching fb <- discretize(pgamma(x, 1), method = "unbiased", lev = levgamma(x, 1), from = 0, to = 5, step = 0.5) curve(pgamma(x, 1), xlim = c(0, 5)) par(col = "blue") plot(stepfun(x, diffinv(fb)), pch = 19, add = TRUE) par(op) } \keyword{distribution} \keyword{models} actuar/man/InverseParalogistic.Rd0000644000176200001440000000725114264305077016565 0ustar liggesusers\name{InverseParalogistic} \alias{InverseParalogistic} \alias{dinvparalogis} \alias{pinvparalogis} \alias{qinvparalogis} \alias{rinvparalogis} \alias{minvparalogis} \alias{levinvparalogis} \title{The Inverse Paralogistic Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments and limited moments for the Inverse Paralogistic distribution with parameters \code{shape} and \code{scale}. } \usage{ dinvparalogis(x, shape, rate = 1, scale = 1/rate, log = FALSE) pinvparalogis(q, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) qinvparalogis(p, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) rinvparalogis(n, shape, rate = 1, scale = 1/rate) minvparalogis(order, shape, rate = 1, scale = 1/rate) levinvparalogis(limit, shape, rate = 1, scale = 1/rate, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{shape, scale}{parameters. Must be strictly positive.} \item{rate}{an alternative way to specify the scale.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The inverse paralogistic distribution with parameters \code{shape} \eqn{= \tau}{= a} and \code{scale} \eqn{= \theta}{= s} has density: \deqn{f(x) = \frac{\tau^2 (x/\theta)^{\tau^2}}{% x [1 + (x/\theta)^\tau]^{\tau + 1}}}{% f(x) = a^2 (x/s)^(a^2)/(x [1 + (x/s)^a]^(a + 1))} for \eqn{x > 0}, \eqn{\tau > 0}{a > 0} and \eqn{\theta > 0}{b > 0}. The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]}, \eqn{-\tau^2 < k < \tau}{-shape^2 < k < shape}. The \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]}, \eqn{k > -\tau^2}{k > -shape^2} and \eqn{1 - k/\tau}{1 - k/shape} not a negative integer. } \value{ \code{dinvparalogis} gives the density, \code{pinvparalogis} gives the distribution function, \code{qinvparalogis} gives the quantile function, \code{rinvparalogis} generates random deviates, \code{minvparalogis} gives the \eqn{k}th raw moment, and \code{levinvparalogis} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ \code{levinvparalogis} computes computes the limited expected value using \code{\link{betaint}}. See Kleiber and Kotz (2003) for alternative names and parametrizations. The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Kleiber, C. and Kotz, S. (2003), \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ exp(dinvparalogis(2, 3, 4, log = TRUE)) p <- (1:10)/10 pinvparalogis(qinvparalogis(p, 2, 3), 2, 3) ## first negative moment minvparalogis(-1, 2, 2) ## case with 1 - order/shape > 0 levinvparalogis(10, 2, 2, order = 1) ## case with 1 - order/shape < 0 levinvparalogis(10, 2/3, 2, order = 1) } \keyword{distribution} actuar/man/TransformedGamma.Rd0000644000176200001440000001053514264305077016036 0ustar liggesusers\name{TransformedGamma} \alias{TransformedGamma} \alias{dtrgamma} \alias{ptrgamma} \alias{qtrgamma} \alias{rtrgamma} \alias{mtrgamma} \alias{levtrgamma} \title{The Transformed Gamma Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments and limited moments for the Transformed Gamma distribution with parameters \code{shape1}, \code{shape2} and \code{scale}. } \usage{ dtrgamma(x, shape1, shape2, rate = 1, scale = 1/rate, log = FALSE) ptrgamma(q, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) qtrgamma(p, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) rtrgamma(n, shape1, shape2, rate = 1, scale = 1/rate) mtrgamma(order, shape1, shape2, rate = 1, scale = 1/rate) levtrgamma(limit, shape1, shape2, rate = 1, scale = 1/rate, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{shape1, shape2, scale}{parameters. Must be strictly positive.} \item{rate}{an alternative way to specify the scale.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The transformed gamma distribution with parameters \code{shape1} \eqn{= \alpha}{= a}, \code{shape2} \eqn{= \tau}{= b} and \code{scale} \eqn{= \theta}{= s} has density: \deqn{f(x) = \frac{\tau u^\alpha e^{-u}}{x \Gamma(\alpha)}, % \quad u = (x/\theta)^\tau}{% f(x) = b u^a exp(-u) / (x Gamma(a)), u = (x/s)^b} for \eqn{x > 0}, \eqn{\alpha > 0}{a > 0}, \eqn{\tau > 0}{b > 0} and \eqn{\theta > 0}{s > 0}. (Here \eqn{\Gamma(\alpha)}{Gamma(a)} is the function implemented by \R's \code{\link{gamma}()} and defined in its help.) The transformed gamma is the distribution of the random variable \eqn{\theta X^{1/\tau},}{s X^(1/b),} where \eqn{X} has a gamma distribution with shape parameter \eqn{\alpha}{a} and scale parameter \eqn{1} or, equivalently, of the random variable \eqn{Y^{1/\tau}}{Y^(1/b)} with \eqn{Y} a gamma distribution with shape parameter \eqn{\alpha}{a} and scale parameter \eqn{\theta^\tau}{s^b}. The transformed gamma probability distribution defines a family of distributions with the following special cases: \itemize{ \item A \link[=dgamma]{Gamma} distribution when \code{shape2 == 1}; \item A \link[=dweibull]{Weibull} distribution when \code{shape1 == 1}; \item An \link[=dexp]{Exponential} distribution when \code{shape2 == shape1 == 1}. } The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]} and the \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]}, \eqn{k > -\alpha\tau}{k > -shape1 * shape2}. } \value{ \code{dtrgamma} gives the density, \code{ptrgamma} gives the distribution function, \code{qtrgamma} gives the quantile function, \code{rtrgamma} generates random deviates, \code{mtrgamma} gives the \eqn{k}th raw moment, and \code{levtrgamma} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ Distribution also known as the Generalized Gamma. See also Kleiber and Kotz (2003) for alternative names and parametrizations. The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Kleiber, C. and Kotz, S. (2003), \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ exp(dtrgamma(2, 3, 4, 5, log = TRUE)) p <- (1:10)/10 ptrgamma(qtrgamma(p, 2, 3, 4), 2, 3, 4) mtrgamma(2, 3, 4, 5) - mtrgamma(1, 3, 4, 5) ^ 2 levtrgamma(10, 3, 4, 5, order = 2) } \keyword{distribution} actuar/man/InversePareto.Rd0000644000176200001440000000555514264305077015403 0ustar liggesusers\name{InversePareto} \alias{InversePareto} \alias{dinvpareto} \alias{pinvpareto} \alias{qinvpareto} \alias{rinvpareto} \alias{minvpareto} \alias{levinvpareto} \title{The Inverse Pareto Distribution} \description{ Density function, distribution function, quantile function, random generation raw moments and limited moments for the Inverse Pareto distribution with parameters \code{shape} and \code{scale}. } \usage{ dinvpareto(x, shape, scale, log = FALSE) pinvpareto(q, shape, scale, lower.tail = TRUE, log.p = FALSE) qinvpareto(p, shape, scale, lower.tail = TRUE, log.p = FALSE) rinvpareto(n, shape, scale) minvpareto(order, shape, scale) levinvpareto(limit, shape, scale, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{shape, scale}{parameters. Must be strictly positive.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The inverse Pareto distribution with parameters \code{shape} \eqn{= \tau}{= a} and \code{scale} \eqn{= \theta}{= s} has density: \deqn{f(x) = \frac{\tau \theta x^{\tau - 1}}{% (x + \theta)^{\tau + 1}}}{% f(x) = a s x^(a - 1)/(x + s)^(a + 1)} for \eqn{x > 0}, \eqn{\tau > 0}{a > 0} and \eqn{\theta > 0}{s > 0}. The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}, \eqn{-\tau < k < 1}{-shape < k < 1}. The \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]}, \eqn{k > -\tau}{k > -shape}. } \value{ \code{dinvpareto} gives the density, \code{pinvpareto} gives the distribution function, \code{qinvpareto} gives the quantile function, \code{rinvpareto} generates random deviates, \code{minvpareto} gives the \eqn{k}th raw moment, and \code{levinvpareto} calculates the \eqn{k}th limited moment. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ Evaluation of \code{levinvpareto} is done using numerical integration. The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ exp(dinvpareto(2, 3, 4, log = TRUE)) p <- (1:10)/10 pinvpareto(qinvpareto(p, 2, 3), 2, 3) minvpareto(0.5, 1, 2) } \keyword{distribution} actuar/man/hachemeister.Rd0000644000176200001440000000154614264305077015252 0ustar liggesusers\name{hachemeister} \docType{data} \alias{hachemeister} \title{Hachemeister Data Set} \description{ Hachemeister (1975) data set giving average claim amounts in private passenger bodily injury insurance in five U.S. states over 12 quarters between July 1970 and June 1973 and the corresponding number of claims. } \usage{hachemeister} \format{ A matrix with 5 rows and the following 25 columns: \describe{ \item{\code{state}}{the state number;} \item{\code{ratio.1}, \dots, \code{ratio.12}}{the average claim amounts;} \item{\code{weight.1}, \dots, \code{weight.12}}{the corresponding number of claims.} } } \source{ Hachemeister, C. A. (1975), \emph{Credibility for regression models with application to trend}, Proceedings of the Berkeley Actuarial Research Conference on Credibility, Academic Press. } \keyword{datasets} actuar/man/ZeroModifiedPoisson.Rd0000644000176200001440000000730714264305077016545 0ustar liggesusers\name{ZeroModifiedPoisson} \alias{ZeroModifiedPoisson} \alias{ZMpoisson} \alias{dzmpois} \alias{pzmpois} \alias{qzmpois} \alias{rzmpois} \title{The Zero-Modified Poisson Distribution} \description{ Density function, distribution function, quantile function, random generation for the Zero-Modified Poisson distribution with parameter \code{lambda} and arbitrary probability at zero \code{p0}. } \usage{ dzmpois(x, lambda, p0, log = FALSE) pzmpois(q, lambda, p0, lower.tail = TRUE, log.p = FALSE) qzmpois(p, lambda, p0, lower.tail = TRUE, log.p = FALSE) rzmpois(n, lambda, p0) } \arguments{ \item{x}{vector of (strictly positive integer) quantiles.} \item{q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of values to return.} \item{lambda}{vector of (non negative) means.} \item{p0}{probability mass at zero. \code{0 <= p0 <= 1}.} \item{log, log.p}{logical; if \code{TRUE}, probabilities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} } \details{ The zero-modified Poisson distribution is a discrete mixture between a degenerate distribution at zero and a (standard) Poisson. The probability mass function is \eqn{p(0) = p_0}{p(0) = p0} and \deqn{% p(x) = \frac{(1-p_0)}{(1-e^{-\lambda})} f(x)}{% p(x) = (1-p0)/(1-exp(-lambda)) f(x)} for \eqn{x = 1, 2, ...}, \eqn{\lambda > 0} and \eqn{0 \le p_0 \le 1}{0 \le p0 \le 1}, where \eqn{f(x)} is the probability mass function of the Poisson. The cumulative distribution function is \deqn{P(x) = p_0 + (1 - p_0) \left(\frac{F(x) - F(0)}{1 - F(0)}\right).}{% P(x) = p0 + (1 - p0) [F(x) - F(0)]/[1 - F(0)].} The mean is \eqn{(1-p_0) \mu}{(1-p0)m} and the variance is \eqn{(1-p_0) \sigma^2 + p_0(1-p_0) \mu^2}{(1-p0)v + p0(1-p0)m^2}, where \eqn{\mu}{m} and \eqn{\sigma^2}{v} are the mean and variance of the zero-truncated Poisson. In the terminology of Klugman et al. (2012), the zero-modified Poisson is a member of the \eqn{(a, b, 1)} class of distributions with \eqn{a = 0} and \eqn{b = \lambda}. The special case \code{p0 == 0} is the zero-truncated Poisson. If an element of \code{x} is not integer, the result of \code{dzmpois} is zero, with a warning. The quantile is defined as the smallest value \eqn{x} such that \eqn{P(x) \ge p}, where \eqn{P} is the distribution function. } \value{ \code{dzmpois} gives the (log) probability mass function, \code{pzmpois} gives the (log) distribution function, \code{qzmpois} gives the quantile function, and \code{rzmpois} generates random deviates. Invalid \code{lambda} or \code{p0} will result in return value \code{NaN}, with a warning. The length of the result is determined by \code{n} for \code{rzmpois}, and is the maximum of the lengths of the numerical arguments for the other functions. } \note{ Functions \code{\{d,p,q\}zmpois} use \code{\{d,p,q\}pois} for all but the trivial input values and \eqn{p(0)}. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ \code{\link{dpois}} for the standard Poisson distribution. \code{\link{dztpois}} for the zero-truncated Poisson distribution. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ dzmpois(0:5, lambda = 1, p0 = 0.2) (1-0.2) * dpois(0:5, lambda = 1)/ppois(0, 1, lower = FALSE) # same ## simple relation between survival functions pzmpois(0:5, 1, p0 = 0.2, lower = FALSE) (1-0.2) * ppois(0:5, 1, lower = FALSE) / ppois(0, 1, lower = FALSE) # same qzmpois(pzmpois(0:10, 1, p0 = 0.7), 1, p0 = 0.7) } \keyword{distribution} actuar/man/GeneralizedBeta.Rd0000644000176200001440000001002114264305077015622 0ustar liggesusers\name{GeneralizedBeta} \alias{GeneralizedBeta} \alias{dgenbeta} \alias{pgenbeta} \alias{qgenbeta} \alias{rgenbeta} \alias{mgenbeta} \alias{levgenbeta} \title{The Generalized Beta Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments and limited moments for the Generalized Beta distribution with parameters \code{shape1}, \code{shape2}, \code{shape3} and \code{scale}. } \usage{ dgenbeta(x, shape1, shape2, shape3, rate = 1, scale = 1/rate, log = FALSE) pgenbeta(q, shape1, shape2, shape3, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) qgenbeta(p, shape1, shape2, shape3, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) rgenbeta(n, shape1, shape2, shape3, rate = 1, scale = 1/rate) mgenbeta(order, shape1, shape2, shape3, rate = 1, scale = 1/rate) levgenbeta(limit, shape1, shape2, shape3, rate = 1, scale = 1/rate, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{shape1, shape2, shape3, scale}{parameters. Must be strictly positive.} \item{rate}{an alternative way to specify the scale.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The generalized beta distribution with parameters \code{shape1} \eqn{= \alpha}{= a}, \code{shape2} \eqn{= \beta}{= b}, \code{shape3} \eqn{= \tau}{= c} and \code{scale} \eqn{= \theta}{= s}, has density: \deqn{f(x) = \frac{\Gamma(\alpha + \beta)}{\Gamma(\alpha)\Gamma(\beta)} (x/\theta)^{\alpha \tau} (1 - (x/\theta)^\tau)^{\beta - 1} \frac{\tau}{x}}{% f(x) = Gamma(a + b)/(Gamma(a) * Gamma(b)) (c (x/s)^(ac) [1 - (x/s)^c]^(b - 1))/x} for \eqn{0 < x < \theta}{0 < x < s}, \eqn{\alpha > 0}{a > 0}, \eqn{\beta > 0}{b > 0}, \eqn{\tau > 0}{c > 0} and \eqn{\theta > 0}{s > 0}. (Here \eqn{\Gamma(\alpha)}{Gamma(a)} is the function implemented by \R's \code{\link{gamma}()} and defined in its help.) The generalized beta is the distribution of the random variable \deqn{\theta X^{1/\tau},}{s X^(1/c),} where \eqn{X} has a beta distribution with parameters \eqn{\alpha}{a} and \eqn{\beta}{b}. The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]} and the \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)]}{E[min(X, d)]}, \eqn{k > -\alpha\tau}{k > -shape1 * shape3}. } \value{ \code{dgenbeta} gives the density, \code{pgenbeta} gives the distribution function, \code{qgenbeta} gives the quantile function, \code{rgenbeta} generates random deviates, \code{mgenbeta} gives the \eqn{k}th raw moment, and \code{levgenbeta} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ This is \emph{not} the generalized three-parameter beta distribution defined on page 251 of Johnson et al, 1995. The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Johnson, N. L., Kotz, S. and Balakrishnan, N. (1995) \emph{Continuous Univariate Distributions, Volume 2}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ exp(dgenbeta(2, 2, 3, 4, 0.2, log = TRUE)) p <- (1:10)/10 pgenbeta(qgenbeta(p, 2, 3, 4, 0.2), 2, 3, 4, 0.2) mgenbeta(2, 1, 2, 3, 0.25) - mgenbeta(1, 1, 2, 3, 0.25) ^ 2 levgenbeta(10, 1, 2, 3, 0.25, order = 2) } \keyword{distribution} actuar/man/actuar-package.Rd0000644000176200001440000000764714264331401015457 0ustar liggesusers\name{actuar-package} \alias{actuar-package} \alias{actuar} \docType{package} \title{\packageTitle{actuar}} \description{\packageDescription{actuar}} \details{ \pkg{actuar} provides additional actuarial science functionality and support for heavy tailed distributions to the \R statistical system. The current feature set of the package can be split into five main categories. \enumerate{ \item{Additional probability distributions: 23 continuous heavy tailed distributions from the Feller-Pareto and Transformed Gamma families, the loggamma, the Gumbel, the inverse Gaussian and the generalized beta; phase-type distributions; the Poisson-inverse Gaussian discrete distribution; zero-truncated and zero-modified extensions of the standard discrete distributions; computation of raw moments, limited moments and the moment generating function (when it exists) of continuous distributions. See the \dQuote{distributions} package vignette for details.} \item{Loss distributions modeling: extensive support of grouped data; functions to compute empirical raw and limited moments; support for minimum distance estimation using three different measures; treatment of coverage modifications (deductibles, limits, inflation, coinsurance). See the \dQuote{modeling} and \dQuote{coverage} package vignettes for details.} \item{Risk and ruin theory: discretization of the claim amount distribution; calculation of the aggregate claim amount distribution; calculation of the adjustment coefficient; calculation of the probability of ruin, including using phase-type distributions. See the \dQuote{risk} package vignette for details.} \item{Simulation of discrete mixtures, compound models (including the compound Poisson), and compound hierarchical models. See the \dQuote{simulation} package vignette for details.} \item{Credibility theory: function \code{cm} fits hierarchical (including Bühlmann, Bühlmann-Straub), regression and linear Bayes credibility models. See the \dQuote{credibility} package vignette for details.} } } \author{ Christophe Dutang, Vincent Goulet, Mathieu Pigeon and many other contributors; use \code{packageDescription("actuar")} for the complete list. Maintainer: Vincent Goulet. } \references{ Dutang, C., Goulet, V. and Pigeon, M. (2008). actuar: An R Package for Actuarial Science. \emph{Journal of Statistical Software}, \bold{25}(7), 1--37. \doi{10.18637/jss.v025.i07}. Dutang, C., Goulet, V., Langevin, N. (2022). Feller-Pareto and Related Distributions: Numerical Implementation and Actuarial Applications. \emph{Journal of Statistical Software}, \bold{103}(6), 1--22. \doi{10.18637/jss.v103.i06}. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ For probability distributions support functions, use as starting points: \code{\link{FellerPareto}}, \code{\link{TransformedGamma}}, \code{\link{Loggamma}}, \code{\link{Gumbel}}, \code{\link{InverseGaussian}}, \code{\link{PhaseType}}, \code{\link{PoissonInverseGaussian}} and, e.g., \code{\link{ZeroTruncatedPoisson}}, \code{\link{ZeroModifiedPoisson}}. For loss modeling support functions: \code{\link{grouped.data}}, \code{\link{ogive}}, \code{\link{emm}}, \code{\link{elev}}, \code{\link{mde}}, \code{\link{coverage}}. For risk and ruin theory functions: \code{\link{discretize}}, \code{\link{aggregateDist}}, \code{\link{adjCoef}}, \code{\link{ruin}}. For credibility theory functions and datasets: \code{\link{cm}}, \code{\link{hachemeister}}. } \examples{ ## The package comes with extensive demonstration scripts; ## use the following command to obtain the list. \dontrun{demo(package = "actuar")} } \keyword{package} \keyword{distribution} \keyword{models} \keyword{univar} actuar/man/rcomphierarc.Rd0000644000176200001440000001451314515770645015273 0ustar liggesusers\name{rcomphierarc} \alias{rcomphierarc} \alias{simul} \alias{print.portfolio} \title{Simulation from Compound Hierarchical Models} \description{ Simulate data for insurance applications allowing hierarchical structures and separate models for the frequency and severity of claims distributions. \code{rcomphierarc} is an alias for \code{simul}. } \usage{ rcomphierarc(nodes, model.freq = NULL, model.sev = NULL, weights = NULL) \method{print}{portfolio}(x, \dots) } \arguments{ \item{nodes}{a vector or a named list giving the number of "nodes" at each level in the hierarchy of the portfolio. The nodes are listed from top (portfolio) to bottom (usually the years of experience).} \item{model.freq}{a named vector of expressions specifying the frequency of claims model (see Details); if \code{NULL}, only claim amounts are simulated.} \item{model.sev}{a named vector of expressions specifying the severity of claims model (see Details); if \code{NULL}, only claim numbers are simulated.} \item{weights}{a vector of weights.} \item{x}{a \code{portfolio} object.} \item{\dots}{potential further arguments required by generic.} } \details{ The order and the names of the elements in \code{nodes}, \code{model.freq} and \code{model.sev} must match. At least one of \code{model.freq} and \code{model.sev} must be non \code{NULL}. \code{nodes} may be a basic vector, named or not, for non hierarchical models. The rule above still applies, so \code{model.freq} and \code{model.sev} should not be named if \code{nodes} is not. However, for non hierarchical models, \code{\link{rcompound}} is faster and has a simpler interface. \code{nodes} specifies the hierarchical layout of the portfolio. Each element of the list is a vector of the number of nodes at a given level. Vectors are recycled as necessary. \code{model.freq} and \code{model.sev} specify the simulation models for claim numbers and claim amounts, respectively. A model is expressed in a semi-symbolic fashion using an object of mode \code{\link[base]{expression}}. Each element of the object must be named and should be a complete call to a random number generation function, with the number of variates omitted. Hierarchical (or mixtures of) models are achieved by replacing one or more parameters of a distribution at a given level by any combination of the names of the levels above. If no mixing is to take place at a level, the model for this level can be \code{NULL}. The argument of the random number generation functions for the number of variates to simulate \strong{must} be named \code{n}. Weights will be used wherever the name \code{"weights"} appears in a model. It is the user's responsibility to ensure that the length of \code{weights} will match the number of nodes when weights are to be used. Normally, there should be one weight per node at the lowest level of the model. Data is generated in lexicographic order, that is by row in the output matrix. } \value{ An object of \code{\link[base]{class}} \code{"portfolio"}. A \code{print} method for this class displays the models used in the simulation as well as the frequency of claims for each year and entity in the portfolio. An object of class \code{"portfolio"} is a list containing the following components: \item{data}{a two dimension list where each element is a vector of claim amounts;} \item{weights}{the vector of weights given in argument reshaped as a matrix matching element \code{data}, or \code{NULL};} \item{classification}{a matrix of integers where each row is a unique set of subscripts identifying an entity in the portfolio (e.g. integers \eqn{i}, \eqn{j} and \eqn{k} for data \eqn{X_{ijkt}}{X[ijkt]});} \item{nodes}{the \code{nodes} argument, appropriately recycled;} \item{model.freq}{the frequency model as given in argument;} \item{model.sev}{the severity model as given in argument.} It is recommended to manipulate objects of class \code{"portfolio"} by means of the corresponding methods of functions \code{aggregate}, \code{frequency} and \code{severity}. } \references{ Goulet, V. and Pouliot, L.-P. (2008), Simulation of compound hierarchical models in R, \emph{North American Actuarial Journal} \bold{12}, 401--412. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca}, Sébastien Auclair and Louis-Philippe Pouliot } \seealso{ \code{\link{rcomphierarc.summaries}} for the functions to create the matrices of aggregate claim amounts, frequencies and individual claim amounts. \code{\link{rcompound}} for a simpler and much faster way to generate variates from standard, non hierarchical, compound models. } \examples{ ## Two level (contracts and years) portfolio with frequency model ## Nit|Theta_i ~ Poisson(Theta_i), Theta_i ~ Gamma(2, 3) and severity ## model X ~ Lognormal(5, 1) rcomphierarc(nodes = list(contract = 10, year = 5), model.freq = expression(contract = rgamma(2, 3), year = rpois(contract)), model.sev = expression(contract = NULL, year = rlnorm(5, 1))) ## Model with weights and mixtures for both frequency and severity ## models nodes <- list(entity = 8, year = c(5, 4, 4, 5, 3, 5, 4, 5)) mf <- expression(entity = rgamma(2, 3), year = rpois(weights * entity)) ms <- expression(entity = rnorm(5, 1), year = rlnorm(entity, 1)) wit <- sample(2:10, 35, replace = TRUE) pf <- rcomphierarc(nodes, mf, ms, wit) pf # print method weights(pf) # extraction of weights aggregate(pf)[, -1]/weights(pf)[, -1] # ratios ## Four level hierarchical model for frequency only nodes <- list(sector = 3, unit = c(3, 4), employer = c(3, 4, 3, 4, 2, 3, 4), year = 5) mf <- expression(sector = rexp(1), unit = rexp(sector), employer = rgamma(unit, 1), year = rpois(employer)) pf <- rcomphierarc(nodes, mf, NULL) pf # print method aggregate(pf) # aggregate claim amounts frequency(pf) # frequencies severity(pf) # individual claim amounts ## Standard, non hierarchical, compound model with simplified ## syntax (function rcompound() is much faster for such cases) rcomphierarc(10, model.freq = expression(rpois(2)), model.sev = expression(rgamma(2, 3))) } \keyword{datagen} actuar/man/TransformedBeta.Rd0000644000176200001440000001313714264305077015670 0ustar liggesusers\name{TransformedBeta} \alias{TransformedBeta} \alias{dtrbeta} \alias{ptrbeta} \alias{qtrbeta} \alias{rtrbeta} \alias{mtrbeta} \alias{levtrbeta} \alias{Pearson6} \alias{dpearson6} \alias{ppearson6} \alias{qpearson6} \alias{rpearson6} \alias{mpearson6} \alias{levpearson6} \title{The Transformed Beta Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments and limited moments for the Transformed Beta distribution with parameters \code{shape1}, \code{shape2}, \code{shape3} and \code{scale}. } \usage{ dtrbeta(x, shape1, shape2, shape3, rate = 1, scale = 1/rate, log = FALSE) ptrbeta(q, shape1, shape2, shape3, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) qtrbeta(p, shape1, shape2, shape3, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) rtrbeta(n, shape1, shape2, shape3, rate = 1, scale = 1/rate) mtrbeta(order, shape1, shape2, shape3, rate = 1, scale = 1/rate) levtrbeta(limit, shape1, shape2, shape3, rate = 1, scale = 1/rate, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{shape1, shape2, shape3, scale}{parameters. Must be strictly positive.} \item{rate}{an alternative way to specify the scale.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The transformed beta distribution with parameters \code{shape1} \eqn{= \alpha}{= a}, \code{shape2} \eqn{= \gamma}{= b}, \code{shape3} \eqn{= \tau}{= c} and \code{scale} \eqn{= \theta}{= s}, has density: \deqn{f(x) = \frac{\Gamma(\alpha + \tau)}{\Gamma(\alpha)\Gamma(\tau)} \frac{\gamma (x/\theta)^{\gamma \tau}}{% x [1 + (x/\theta)^\gamma]^{\alpha + \tau}}}{% f(x) = Gamma(a + c)/(Gamma(a) * Gamma(c)) (b (x/s)^(bc))/% (x [1 + (x/s)^b]^(a + c))} for \eqn{x > 0}, \eqn{\alpha > 0}{a > 0}, \eqn{\gamma > 0}{b > 0}, \eqn{\tau > 0}{c > 0} and \eqn{\theta > 0}{s > 0}. (Here \eqn{\Gamma(\alpha)}{Gamma(a)} is the function implemented by \R's \code{\link{gamma}()} and defined in its help.) The transformed beta is the distribution of the random variable \deqn{\theta \left(\frac{X}{1 - X}\right)^{1/\gamma},}{% s (X/(1 - X))^(1/b),} where \eqn{X} has a beta distribution with parameters \eqn{\tau}{c} and \eqn{\alpha}{a}. The transformed beta distribution defines a family of distributions with the following special cases: \itemize{ \item A \link[=dburr]{Burr} distribution when \code{shape3 == 1}; \item A \link[=dllogis]{loglogistic} distribution when \code{shape1 == shape3 == 1}; \item A \link[=dparalogis]{paralogistic} distribution when \code{shape3 == 1} and \code{shape2 == shape1}; \item A \link[=dgenpareto]{generalized Pareto} distribution when \code{shape2 == 1}; \item A \link[=dpareto]{Pareto} distribution when \code{shape2 == shape3 == 1}; \item An \link[=dinvburr]{inverse Burr} distribution when \code{shape1 == 1}; \item An \link[=dinvpareto]{inverse Pareto} distribution when \code{shape2 == shape1 == 1}; \item An \link[=dinvparalogis]{inverse paralogistic} distribution when \code{shape1 == 1} and \code{shape3 == shape2}. } The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}, \eqn{-\tau\gamma < k < \alpha\gamma}{-shape3 * shape2 < k < shape1 * shape2}. The \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]}, \eqn{k > -\tau\gamma}{k > -shape3 * shape2} and \eqn{\alpha - k/\gamma}{shape1 - k/shape2} not a negative integer. } \value{ \code{dtrbeta} gives the density, \code{ptrbeta} gives the distribution function, \code{qtrbeta} gives the quantile function, \code{rtrbeta} generates random deviates, \code{mtrbeta} gives the \eqn{k}th raw moment, and \code{levtrbeta} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ \code{levtrbeta} computes the limited expected value using \code{\link{betaint}}. Distribution also known as the Generalized Beta of the Second Kind and Pearson Type VI. See also Kleiber and Kotz (2003) for alternative names and parametrizations. The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Kleiber, C. and Kotz, S. (2003), \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ \code{\link{dfpareto}} for an equivalent distribution with a location parameter. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ exp(dtrbeta(2, 2, 3, 4, 5, log = TRUE)) p <- (1:10)/10 ptrbeta(qtrbeta(p, 2, 3, 4, 5), 2, 3, 4, 5) qpearson6(0.3, 2, 3, 4, 5, lower.tail = FALSE) ## variance mtrbeta(2, 2, 3, 4, 5) - mtrbeta(1, 2, 3, 4, 5)^2 ## case with shape1 - order/shape2 > 0 levtrbeta(10, 2, 3, 4, scale = 1, order = 2) ## case with shape1 - order/shape2 < 0 levtrbeta(10, 1/3, 0.75, 4, scale = 0.5, order = 2) } \keyword{distribution} actuar/man/GammaSupp.Rd0000644000176200001440000000357414264305077014506 0ustar liggesusers\name{GammaSupp} \alias{GammaSupp} \alias{mgamma} \alias{levgamma} \alias{mgfgamma} \title{Moments and Moment Generating Function of the Gamma Distribution} \description{ Raw moments, limited moments and moment generating function for the Gamma distribution with parameters \code{shape} and \code{scale}. } \usage{ mgamma(order, shape, rate = 1, scale = 1/rate) levgamma(limit, shape, rate = 1, scale = 1/rate, order = 1) mgfgamma(t, shape, rate = 1, scale = 1/rate, log = FALSE) } \arguments{ \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} \item{rate}{an alternative way to specify the scale.} \item{shape, scale}{shape and scale parameters. Must be strictly positive.} \item{t}{numeric vector.} \item{log}{logical; if \code{TRUE}, the cumulant generating function is returned.} } \details{ The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]}, the \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]} and the moment generating function is \eqn{E[e^{tX}]}, \eqn{k > -\alpha}{k > -shape}. } \value{ \code{mgamma} gives the \eqn{k}th raw moment, \code{levgamma} gives the \eqn{k}th moment of the limited loss variable, and \code{mgfgamma} gives the moment generating function in \code{t}. Invalid arguments will result in return value \code{NaN}, with a warning. } \seealso{ \code{\link[stats]{GammaDist}} } \references{ Johnson, N. L. and Kotz, S. (1970), \emph{Continuous Univariate Distributions, Volume 1}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca}, Christophe Dutang and Mathieu Pigeon } \examples{ mgamma(2, 3, 4) - mgamma(1, 3, 4)^2 levgamma(10, 3, 4, order = 2) mgfgamma(1,3,2) } \keyword{distribution} actuar/man/rcomphierarc.summaries.Rd0000644000176200001440000001223614515770645017277 0ustar liggesusers\name{rcomphierarc.summaries} \alias{rcomphierarc.summaries} \alias{aggregate.portfolio} \alias{frequency.portfolio} \alias{severity.portfolio} \alias{weights.portfolio} \title{Summary Statistics of a Portfolio} \description{ Methods for \link[base]{class} \code{"portfolio"} objects. \code{aggregate} splits portfolio data into subsets and computes summary statistics for each. \code{frequency} computes the frequency of claims for subsets of portfolio data. \code{severity} extracts the individual claim amounts. \code{weights} extracts the matrix of weights. } \usage{ \method{aggregate}{portfolio}(x, by = names(x$nodes), FUN = sum, classification = TRUE, prefix = NULL, \dots) \method{frequency}{portfolio}(x, by = names(x$nodes), classification = TRUE, prefix = NULL, \dots) \method{severity}{portfolio}(x, by = head(names(x$node), -1), splitcol = NULL, classification = TRUE, prefix = NULL, \dots) \method{weights}{portfolio}(object, classification = TRUE, prefix = NULL, \dots) } \arguments{ \item{x, object}{an object of class \code{"portfolio"}, typically created with \code{\link{simul}}.} \item{by}{character vector of grouping elements using the level names of the portfolio in \code{x}. The names can be abbreviated.} \item{FUN}{the function to be applied to data subsets.} \item{classification}{boolean; if \code{TRUE}, the node identifier columns are included in the output.} \item{prefix}{characters to prefix column names with; if \code{NULL}, sensible defaults are used when appropriate.} \item{splitcol}{columns of the data matrix to extract separately; usual matrix indexing methods are supported.} \item{\dots}{optional arguments to \code{FUN}, or passed to or from other methods.} } \details{ By default, \code{aggregate.portfolio} computes the aggregate claim amounts for the grouping specified in \code{by}. Any other statistic based on the individual claim amounts can be used through argument \code{FUN}. \code{frequency.portfolio} is equivalent to using \code{aggregate.portfolio} with argument \code{FUN} equal to \code{if (identical(x, NA)) NA else length(x)}. \code{severity.portfolio} extracts individual claim amounts of a portfolio by groupings using the default method of \code{\link{severity}}. Argument \code{splitcol} allows to get the individual claim amounts of specific columns separately. \code{weights.portfolio} extracts the weight matrix of a portfolio. } \value{ A matrix or vector depending on the groupings specified in \code{by}. For the \code{aggregate} and \code{frequency} methods: if at least one level other than the last one is used for grouping, the result is a matrix obtained by binding the appropriate node identifiers extracted from \code{x$classification} if \code{classification = TRUE}, and the summaries per grouping. If the last level is used for grouping, the column names of \code{x$data} are retained; if the last level is not used for grouping, the column name is replaced by the deparsed name of \code{FUN}. If only the last level is used (column summaries), a named vector is returned. For the \code{severity} method: a list of two elements: \item{main}{\code{NULL} or a matrix of claim amounts for the columns not specified in \code{splitcol}, with the appropriate node identifiers extracted from \code{x$classification} if \code{classification = TRUE};} \item{split}{same as above, but for the columns specified in \code{splitcol}.} For the \code{weights} method: the weight matrix of the portfolio with node identifiers if \code{classification = TRUE}. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca}, Louis-Philippe Pouliot. } \seealso{ \code{\link{rcomphierarc}} } \examples{ nodes <- list(sector = 3, unit = c(3, 4), employer = c(3, 4, 3, 4, 2, 3, 4), year = 5) model.freq <- expression(sector = rexp(1), unit = rexp(sector), employer = rgamma(unit, 1), year = rpois(employer)) model.sev <- expression(sector = rnorm(6, 0.1), unit = rnorm(sector, 1), employer = rnorm(unit, 1), year = rlnorm(employer, 1)) pf <- rcomphierarc(nodes, model.freq, model.sev) aggregate(pf) # aggregate claim amount by employer and year aggregate(pf, classification = FALSE) # same, without node identifiers aggregate(pf, by = "sector") # by sector aggregate(pf, by = "y") # by year aggregate(pf, by = c("s", "u"), mean) # average claim amount frequency(pf) # number of claims frequency(pf, prefix = "freq.") # more explicit column names severity(pf) # claim amounts by row severity(pf, by = "year") # by column severity(pf, by = c("s", "u")) # by unit severity(pf, splitcol = "year.5") # last year separate severity(pf, splitcol = 5) # same severity(pf, splitcol = c(FALSE, FALSE, FALSE, FALSE, TRUE)) # same weights(pf) ## For portfolios with weights, the following computes loss ratios. \dontrun{aggregate(pf, classif = FALSE) / weights(pf, classif = FALSE)} } \keyword{models} \keyword{methods} actuar/man/aggregateDist.Rd0000644000176200001440000003061414264305077015361 0ustar liggesusers\name{aggregateDist} \alias{aggregateDist} \alias{print.aggregateDist} \alias{plot.aggregateDist} \alias{summary.aggregateDist} \alias{mean.aggregateDist} \alias{diff.aggregateDist} \title{Aggregate Claim Amount Distribution} \description{ Compute the aggregate claim amount cumulative distribution function of a portfolio over a period using one of five methods. } \usage{ aggregateDist(method = c("recursive", "convolution", "normal", "npower", "simulation"), model.freq = NULL, model.sev = NULL, p0 = NULL, x.scale = 1, convolve = 0, moments, nb.simul, \dots, tol = 1e-06, maxit = 500, echo = FALSE) \method{print}{aggregateDist}(x, \dots) \method{plot}{aggregateDist}(x, xlim, ylab = expression(F[S](x)), main = "Aggregate Claim Amount Distribution", sub = comment(x), \dots) \method{summary}{aggregateDist}(object, \dots) \method{mean}{aggregateDist}(x, \dots) \method{diff}{aggregateDist}(x, \dots) } \arguments{ \item{method}{method to be used} \item{model.freq}{for \code{"recursive"} method: a character string giving the name of a distribution in the \eqn{(a, b, 0)} or \eqn{(a, b, 1)} families of distributions. For \code{"convolution"} method: a vector of claim number probabilities. For \code{"simulation"} method: a frequency simulation model (see \code{\link{rcomphierarc}} for details) or \code{NULL}. Ignored with \code{normal} and \code{npower} methods.} \item{model.sev}{for \code{"recursive"} and \code{"convolution"} methods: a vector of claim amount probabilities. For \code{"simulation"} method: a severity simulation model (see \code{\link{rcomphierarc}} for details) or \code{NULL}. Ignored with \code{normal} and \code{npower} methods.} \item{p0}{arbitrary probability at zero for the frequency distribution. Creates a zero-modified or zero-truncated distribution if not \code{NULL}. Used only with \code{"recursive"} method.} \item{x.scale}{value of an amount of 1 in the severity model (monetary unit). Used only with \code{"recursive"} and \code{"convolution"} methods.} \item{convolve}{number of times to convolve the resulting distribution with itself. Used only with \code{"recursive"} method.} \item{moments}{vector of the true moments of the aggregate claim amount distribution; required only by the \code{"normal"} or \code{"npower"} methods.} \item{nb.simul}{number of simulations for the \code{"simulation"} method.} \item{\dots}{parameters of the frequency distribution for the \code{"recursive"} method; further arguments to be passed to or from other methods otherwise.} \item{tol}{the resulting cumulative distribution in the \code{"recursive"} method will get less than \code{tol} away from 1.} \item{maxit}{maximum number of recursions in the \code{"recursive"} method.} \item{echo}{logical; echo the recursions to screen in the \code{"recursive"} method.} \item{x, object}{an object of class \code{"aggregateDist"}.} \item{xlim}{numeric of length 2; the \eqn{x} limits of the plot.} \item{ylab}{label of the y axis.} \item{main}{main title.} \item{sub}{subtitle, defaulting to the calculation method.} } \details{ \code{aggregateDist} returns a function to compute the cumulative distribution function (cdf) of the aggregate claim amount distribution in any point. The \code{"recursive"} method computes the cdf using the Panjer algorithm; the \code{"convolution"} method using convolutions; the \code{"normal"} method using a normal approximation; the \code{"npower"} method using the Normal Power 2 approximation; the \code{"simulation"} method using simulations. More details follow. } \section{Recursive method}{ The frequency distribution must be a member of the \eqn{(a, b, 0)} or \eqn{(a, b, 1)} families of discrete distributions. To use a distribution from the \eqn{(a, b, 0)} family, \code{model.freq} must be one of \code{"binomial"}, \code{"geometric"}, \code{"negative binomial"} or \code{"poisson"}, and \code{p0} must be \code{NULL}. To use a zero-truncated distribution from the \eqn{(a, b, 1)} family, \code{model.freq} may be one of the strings above together with \code{p0 = 0}. As a shortcut, \code{model.freq} may also be one of \code{"zero-truncated binomial"}, \code{"zero-truncated geometric"}, \code{"zero-truncated negative binomial"}, \code{"zero-truncated poisson"} or \code{"logarithmic"}, and \code{p0} is then ignored (with a warning if non \code{NULL}). (Note: since the logarithmic distribution is always zero-truncated. \code{model.freq = "logarithmic"} may be used with either \code{p0 = NULL} or \code{p0 = 0}.) To use a zero-modified distribution from the \eqn{(a, b, 1)} family, \code{model.freq} may be one of standard frequency distributions mentioned above with \code{p0} set to some probability that the distribution takes the value \eqn{0}. It is equivalent, but more explicit, to set \code{model.freq} to one of \code{"zero-modified binomial"}, \code{"zero-modified geometric"}, \code{"zero-modified negative binomial"}, \code{"zero-modified poisson"} or \code{"zero-modified logarithmic"}. The parameters of the frequency distribution must be specified using names identical to the arguments of the appropriate function \code{\link{dbinom}}, \code{\link{dgeom}}, \code{\link{dnbinom}}, \code{\link{dpois}} or \code{\link{dlogarithmic}}. In the latter case, do take note that the parametrization of \code{dlogarithmic} is different from Appendix B of Klugman et al. (2012). If the length of \code{p0} is greater than one, only the first element is used, with a warning. \code{model.sev} is a vector of the (discretized) claim amount distribution \eqn{X}; the first element \strong{must} be \eqn{f_X(0) = \Pr[X = 0]}{fx(0) = Pr[X = 0]}. The recursion will fail to start if the expected number of claims is too large. One may divide the appropriate parameter of the frequency distribution by \eqn{2^n} and convolve the resulting distribution \eqn{n =} \code{convolve} times. Failure to obtain a cumulative distribution function less than \code{tol} away from 1 within \code{maxit} iterations is often due to too coarse a discretization of the severity distribution. } \section{Convolution method}{ The cumulative distribution function (cdf) \eqn{F_S(x)}{Fs(x)} of the aggregate claim amount of a portfolio in the collective risk model is \deqn{F_S(x) = \sum_{n = 0}^{\infty} F_X^{*n}(x) p_n,}{% Fs(x) = sum(n; Fx^\{*n\}(x) * pn)} for \eqn{x = 0, 1, \dots}; \eqn{p_n = \Pr[N = n]}{pn = Pr[N = n]} is the frequency probability mass function and \eqn{F_X^{*n}(x)}{Fx^\{*n\}(x)} is the cdf of the \eqn{n}th convolution of the (discrete) claim amount random variable. \code{model.freq} is vector \eqn{p_n}{pn} of the number of claims probabilities; the first element \strong{must} be \eqn{\Pr[N = 0]}{Pr[N = 0]}. \code{model.sev} is vector \eqn{f_X(x)}{fx(x)} of the (discretized) claim amount distribution; the first element \strong{must} be \eqn{f_X(0)}{fx(0)}. } \section{Normal and Normal Power 2 methods}{ The Normal approximation of a cumulative distribution function (cdf) \eqn{F(x)} with mean \eqn{\mu}{m} and standard deviation \eqn{\sigma}{s} is \deqn{F(x) \approx \Phi\left( \frac{x - \mu}{\sigma} \right).}{% F(x) ~= pnorm((x - m)/s).} The Normal Power 2 approximation of a cumulative distribution function (cdf) \eqn{F(x)} with mean \eqn{\mu}{m}, standard deviation \eqn{\sigma}{s} and skewness \eqn{\gamma}{g} is \deqn{F(x) \approx \Phi \left(% -\frac{3}{\gamma} + \sqrt{\frac{9}{\gamma^2} + 1 % + \frac{6}{\gamma} \frac{x - \mu}{\sigma}} \right).}{% F(x) ~= pnorm(-3/g + sqrt(9/g^2 + 1 + (6/g) * (x - m)/s)).} This formula is valid only for the right-hand tail of the distribution and skewness should not exceed unity. } \section{Simulation method}{ This methods returns the empirical distribution function of a sample of size \code{nb.simul} of the aggregate claim amount distribution specified by \code{model.freq} and \code{model.sev}. \code{\link{rcomphierarc}} is used for the simulation of claim amounts, hence both the frequency and severity models can be mixtures of distributions. } \value{ A function of class \code{"aggregateDist"}, inheriting from the \code{"function"} class when using normal and Normal Power approximations and additionally inheriting from the \code{"ecdf"} and \code{"stepfun"} classes when other methods are used. There are methods available to summarize (\code{summary}), represent (\code{print}), plot (\code{plot}), compute quantiles (\code{quantile}) and compute the mean (\code{mean}) of \code{"aggregateDist"} objects. For the \code{diff} method: a numeric vector of probabilities corresponding to the probability mass function evaluated at the knots of the distribution. } \seealso{ \code{\link{discretize}} to discretize a severity distribution; \code{\link{mean.aggregateDist}} to compute the mean of the distribution; \code{\link{quantile.aggregateDist}} to compute the quantiles or the Value-at-Risk; \code{\link{CTE.aggregateDist}} to compute the Conditional Tail Expectation (or Tail Value-at-Risk); \code{\link{rcomphierarc}}. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. Daykin, C.D., \enc{Pentikäinen}{Pentikainen}, T. and Pesonen, M. (1994), \emph{Practical Risk Theory for Actuaries}, Chapman & Hall. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Louis-Philippe Pouliot } \examples{ ## Convolution method (example 9.5 of Klugman et al. (2012)) fx <- c(0, 0.15, 0.2, 0.25, 0.125, 0.075, 0.05, 0.05, 0.05, 0.025, 0.025) pn <- c(0.05, 0.1, 0.15, 0.2, 0.25, 0.15, 0.06, 0.03, 0.01) Fs <- aggregateDist("convolution", model.freq = pn, model.sev = fx, x.scale = 25) summary(Fs) c(Fs(0), diff(Fs(25 * 0:21))) # probability mass function plot(Fs) ## Recursive method (example 9.10 of Klugman et al. (2012)) fx <- c(0, crossprod(c(2, 1)/3, matrix(c(0.6, 0.7, 0.4, 0, 0, 0.3), 2, 3))) Fs <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx, lambda = 3) plot(Fs) Fs(knots(Fs)) # cdf evaluated at its knots diff(Fs) # probability mass function ## Recursive method (high frequency) fx <- c(0, 0.15, 0.2, 0.25, 0.125, 0.075, 0.05, 0.05, 0.05, 0.025, 0.025) \dontrun{Fs <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx, lambda = 1000)} Fs <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx, lambda = 250, convolve = 2, maxit = 1500) plot(Fs) ## Recursive method (zero-modified distribution; example 9.11 of ## Klugman et al. (2012)) Fn <- aggregateDist("recursive", model.freq = "binomial", model.sev = c(0.3, 0.5, 0.2), x.scale = 50, p0 = 0.4, size = 3, prob = 0.3) diff(Fn) ## Equivalent but more explicit call aggregateDist("recursive", model.freq = "zero-modified binomial", model.sev = c(0.3, 0.5, 0.2), x.scale = 50, p0 = 0.4, size = 3, prob = 0.3) ## Recursive method (zero-truncated distribution). Using 'fx' above ## would mean that both Pr[N = 0] = 0 and Pr[X = 0] = 0, therefore ## Pr[S = 0] = 0 and recursions would not start. fx <- discretize(pexp(x, 1), from = 0, to = 100, method = "upper") fx[1L] # non zero aggregateDist("recursive", model.freq = "zero-truncated poisson", model.sev = fx, lambda = 3, x.scale = 25, echo=TRUE) ## Normal Power approximation Fs <- aggregateDist("npower", moments = c(200, 200, 0.5)) Fs(210) ## Simulation method model.freq <- expression(data = rpois(3)) model.sev <- expression(data = rgamma(100, 2)) Fs <- aggregateDist("simulation", nb.simul = 1000, model.freq, model.sev) mean(Fs) plot(Fs) ## Evaluation of ruin probabilities using Beekman's formula with ## Exponential(1) claim severity, Poisson(1) frequency and premium rate ## c = 1.2. fx <- discretize(pexp(x, 1), from = 0, to = 100, method = "lower") phi0 <- 0.2/1.2 Fs <- aggregateDist(method = "recursive", model.freq = "geometric", model.sev = fx, prob = phi0) 1 - Fs(400) # approximate ruin probability u <- 0:100 plot(u, 1 - Fs(u), type = "l", main = "Ruin probability") } \keyword{distribution} \keyword{models} actuar/man/ruin.Rd0000644000176200001440000001232514264305077013563 0ustar liggesusers\name{ruin} \alias{ruin} \alias{plot.ruin} \title{Probability of Ruin} \description{ Calulation of infinite time probability of ruin in the models of \enc{Cramér}{Cramer}-Lundberg and Sparre Andersen, that is with exponential or phase-type (including mixtures of exponentials, Erlang and mixture of Erlang) claims interarrival time. } \usage{ ruin(claims = c("exponential", "Erlang", "phase-type"), par.claims, wait = c("exponential", "Erlang", "phase-type"), par.wait, premium.rate = 1, tol = sqrt(.Machine$double.eps), maxit = 200L, echo = FALSE) \method{plot}{ruin}(x, from = NULL, to = NULL, add = FALSE, xlab = "u", ylab = expression(psi(u)), main = "Probability of Ruin", xlim = NULL, \dots) } \arguments{ \item{claims}{character; the type of claim severity distribution.} \item{wait}{character; the type of claim interarrival (wait) time distribution.} \item{par.claims, par.wait}{named list containing the parameters of the distribution; see Details.} \item{premium.rate}{numeric vector of length 1; the premium rate.} \item{tol, maxit, echo}{respectively the tolerance level of the stopping criteria, the maximum number of iterations and whether or not to echo the procedure when the transition rates matrix is determined iteratively. Ignored if \code{wait = "exponential"}.} \item{x}{an object of class \code{"ruin"}.} \item{from, to}{the range over which the function will be plotted.} \item{add}{logical; if \code{TRUE} add to already existing plot.} \item{xlim}{numeric of length 2; if specified, it serves as default for \code{c(from, to)}.} \item{xlab, ylab}{label of the x and y axes, respectively.} \item{main}{main title.} \item{\dots}{further graphical parameters accepted by \code{\link[graphics]{curve}}.} } \details{ The names of the parameters in \code{par.claims} and \code{par.wait} must the same as in \code{\link[stats]{dexp}}, \code{\link[stats]{dgamma}} or \code{\link{dphtype}}, as appropriate. A model will be a mixture of exponential or Erlang distributions (but not phase-type) when the parameters are vectors of length \eqn{> 1} and the parameter list contains a vector \code{weights} of the coefficients of the mixture. Parameters are recycled when needed. Their names can be abbreviated. Combinations of exponentials as defined in Dufresne and Gerber (1988) are \emph{not} supported. Ruin probabilities are evaluated using \code{\link{pphtype}} except when both distributions are exponential, in which case an explicit formula is used. When \code{wait != "exponential"} (Sparre Andersen model), the transition rate matrix \eqn{\boldsymbol{Q}}{Q} of the distribution of the probability of ruin is determined iteratively using a fixed point-like algorithm. The stopping criteria used is% \deqn{\max \left\{ \sum_{j = 1}^n |\boldsymbol{Q}_{ij} - \boldsymbol{Q}_{ij}^\prime| \right\} < \code{tol},}{% max(rowSum(|Q - Q'|)) < tol,}% where \eqn{\boldsymbol{Q}}{Q} and \eqn{\boldsymbol{Q}^\prime}{Q'} are two successive values of the matrix. } \value{ A function of class \code{"ruin"} inheriting from the \code{"function"} class to compute the probability of ruin given initial surplus levels. The function has arguments: \item{u}{numeric vector of initial surplus levels;} \item{survival}{logical; if \code{FALSE} (default), probabilities are \eqn{\psi(u)}{psi(u)}, otherwise, \eqn{\phi(u) = 1 - \psi(u)}{phi(u) = 1 - psi(u)};} \item{lower.tail}{an alias for \code{!survival}.} } \references{ Asmussen, S. and Rolski, T. (1991), Computational methods in risk theory: A matrix algorithmic approach, \emph{Insurance: Mathematics and Economics} \bold{10}, 259--274. Dufresne, F. and Gerber, H. U. (1988), Three methods to calculate the probability of ruin, \emph{Astin Bulletin} \bold{19}, 71--90. Gerber, H. U. (1979), \emph{An Introduction to Mathematical Risk Theory}, Huebner Foundation. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca}, and Christophe Dutang } \examples{ ## Case with an explicit formula: exponential claims and exponential ## interarrival times. psi <- ruin(claims = "e", par.claims = list(rate = 5), wait = "e", par.wait = list(rate = 3)) psi psi(0:10) plot(psi, from = 0, to = 10) ## Mixture of two exponentials for claims, exponential interarrival ## times (Gerber 1979) psi <- ruin(claims = "e", par.claims = list(rate = c(3, 7), w = 0.5), wait = "e", par.wait = list(rate = 3), pre = 1) u <- 0:10 psi(u) (24 * exp(-u) + exp(-6 * u))/35 # same ## Phase-type claims, exponential interarrival times (Asmussen and ## Rolski 1991) p <- c(0.5614, 0.4386) r <- matrix(c(-8.64, 0.101, 1.997, -1.095), 2, 2) lambda <- 1/(1.1 * mphtype(1, p, r)) psi <- ruin(claims = "p", par.claims = list(prob = p, rates = r), wait = "e", par.wait = list(rate = lambda)) psi plot(psi, xlim = c(0, 50)) ## Phase-type claims, mixture of two exponentials for interarrival times ## (Asmussen and Rolski 1991) a <- (0.4/5 + 0.6) * lambda ruin(claims = "p", par.claims = list(prob = p, rates = r), wait = "e", par.wait = list(rate = c(5 * a, a), weights = c(0.4, 0.6)), maxit = 225L) } \keyword{models} actuar/man/CTE.Rd0000644000176200001440000000522614515770645013231 0ustar liggesusers\name{CTE} \alias{CTE} \alias{TVaR} \alias{CTE.aggregateDist} \title{Conditional Tail Expectation} \description{ Conditional Tail Expectation, also called Tail Value-at-Risk. \code{TVaR} is an alias for \code{CTE}. } \usage{ CTE(x, \dots) \method{CTE}{aggregateDist}(x, conf.level = c(0.9, 0.95, 0.99), names = TRUE, \dots) TVaR(x, \dots) } \arguments{ \item{x}{an \R object.} \item{conf.level}{numeric vector of probabilities with values in \eqn{[0, 1)}.} \item{names}{logical; if true, the result has a \code{names} attribute. Set to \code{FALSE} for speedup with many \code{probs}.} \item{\dots}{further arguments passed to or from other methods.} } \details{ The Conditional Tail Expectation (or Tail Value-at-Risk) measures the average of losses above the Value at Risk for some given confidence level, that is \eqn{E[X|X > \mathrm{VaR}(X)]} where \eqn{X} is the loss random variable. \code{CTE} is a generic function with, currently, only a method for objects of class \code{"aggregateDist"}. For the recursive, convolution and simulation methods of \code{\link{aggregateDist}}, the CTE is computed from the definition using the empirical cdf. For the normal approximation method, an explicit formula exists: \deqn{\mu + \frac{\sigma}{(1 - \alpha) \sqrt{2 \pi}} e^{-\mathrm{VaR}(X)^2/2},}{% m + s exp(-VaR(X)^2/2)/((1 - a) * sqrt(2 pi)),} where \eqn{\mu}{m} is the mean, \eqn{\sigma}{s} the standard deviation and \eqn{\alpha}{a} the confidence level. For the Normal Power approximation, the explicit formula given in Castañer et al. (2013) is \deqn{\mu + \frac{\sigma}{(1 - \alpha) \sqrt{2 \pi}} e^{-\mathrm{VaR}(X)^2/2} \left( 1 + \frac{\gamma}{6} \mathrm{VaR}(X) \right),}{% m + s exp(-VaR(X)^2/2)/((1 - a) * sqrt(2 pi)) (1 + g * VaR(X)/6),} where, as above, \eqn{\mu}{m} is the mean, \eqn{\sigma}{s} the standard deviation, \eqn{\alpha}{a} the confidence level and \eqn{\gamma}{g} is the skewness. } \value{ A numeric vector, named if \code{names} is \code{TRUE}. } \seealso{ \code{\link{aggregateDist}}; \code{\link{VaR}} } \references{ Castañer, A. and Claramunt, M.M. and Mármol, M. (2013), Tail value at risk. An analysis with the Normal-Power approximation. In \emph{Statistical and Soft Computing Approaches in Insurance Problems}, pp. 87-112. Nova Science Publishers, 2013. ISBN 978-1-62618-506-7. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Tommy Ouellet } \examples{ model.freq <- expression(data = rpois(7)) model.sev <- expression(data = rnorm(9, 2)) Fs <- aggregateDist("simulation", model.freq, model.sev, nb.simul = 1000) CTE(Fs) } \keyword{univar} actuar/man/Gumbel.Rd0000644000176200001440000000641214264305077014021 0ustar liggesusers\name{Gumbel} \alias{Gumbel} \alias{dgumbel} \alias{pgumbel} \alias{qgumbel} \alias{rgumbel} \alias{mgumbel} \alias{mgfgumbel} \title{The Gumbel Distribution} \description{ Density function, distribution function, quantile function, random generation and raw moments for the Gumbel extreme value distribution with parameters \code{alpha} and \code{scale}. } \usage{ dgumbel(x, alpha, scale, log = FALSE) pgumbel(q, alpha, scale, lower.tail = TRUE, log.p = FALSE) qgumbel(p, alpha, scale, lower.tail = TRUE, log.p = FALSE) rgumbel(n, alpha, scale) mgumbel(order, alpha, scale) mgfgumbel(t, alpha, scale, log = FALSE) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{alpha}{location parameter.} \item{scale}{parameter. Must be strictly positive.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment. Only values \eqn{1} and \eqn{2} are supported.} \item{t}{numeric vector.} } \details{ The Gumbel distribution with parameters \code{alpha} \eqn{= \alpha}{= a} and \code{scale} \eqn{= \theta}{= s} has distribution function: \deqn{F(x) = \exp[-\exp(-(x - \alpha)/\theta)]}{% F(x) = exp[-exp(-(x - a)/s)],} for \eqn{-\infty < x < \infty}{-Inf < x < Inf}, \eqn{-\infty < a < \infty}{-Inf < a < Inf} and \eqn{\theta > 0}{s > 0}. The mode of the distribution is in \eqn{\alpha}{a}, the mean is \eqn{\alpha + \gamma\theta}{a + g * s}, where \eqn{\gamma}{g} \eqn{= 0.57721566} is the Euler-Mascheroni constant, and the variance is \eqn{\pi^2 \theta^2/6}{(pi * s)^2/6}. } \value{ \code{dgumbel} gives the density, \code{pgumbel} gives the distribution function, \code{qgumbel} gives the quantile function, \code{rgumbel} generates random deviates, \code{mgumbel} gives the \eqn{k}th raw moment, \eqn{k = 1, 2}, and \code{mgfgamma} gives the moment generating function in \code{t}. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ Distribution also knonw as the generalized extreme value distribution Type-I. The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ dgumbel(c(-5, 0, 10, 20), 0.5, 2) p <- (1:10)/10 pgumbel(qgumbel(p, 2, 3), 2, 3) curve(pgumbel(x, 0.5, 2), from = -5, to = 20, col = "red") curve(pgumbel(x, 1.0, 2), add = TRUE, col = "green") curve(pgumbel(x, 1.5, 3), add = TRUE, col = "blue") curve(pgumbel(x, 3.0, 4), add = TRUE, col = "cyan") a <- 3; s <- 4 mgumbel(1, a, s) # mean a - s * digamma(1) # same mgumbel(2, a, s) - mgumbel(1, a, s)^2 # variance (pi * s)^2/6 # same } \keyword{distribution} actuar/man/SingleParameterPareto.Rd0000644000176200001440000000643014264305077017043 0ustar liggesusers\name{SingleParameterPareto} \alias{SingleParameterPareto} \alias{dpareto1} \alias{ppareto1} \alias{qpareto1} \alias{rpareto1} \alias{mpareto1} \alias{levpareto1} \title{The Single-parameter Pareto Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments, and limited moments for the Single-parameter Pareto distribution with parameter \code{shape}. } \usage{ dpareto1(x, shape, min, log = FALSE) ppareto1(q, shape, min, lower.tail = TRUE, log.p = FALSE) qpareto1(p, shape, min, lower.tail = TRUE, log.p = FALSE) rpareto1(n, shape, min) mpareto1(order, shape, min) levpareto1(limit, shape, min, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{shape}{parameter. Must be strictly positive.} \item{min}{lower bound of the support of the distribution.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The single-parameter Pareto, or Pareto I, distribution with parameter \code{shape} \eqn{= \alpha}{= a} has density: \deqn{f(x) = \frac{\alpha \theta^\alpha}{x^{\alpha + 1}}}{% f(x) = a b^a/x^(a + 1)} for \eqn{x > \theta}{x > b}, \eqn{\alpha > 0}{a > 0} and \eqn{\theta > 0}{b > 0}. Although there appears to be two parameters, only \code{shape} is a true parameter. The value of \code{min} \eqn{= \theta}{= b} must be set in advance. The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]}, \eqn{k < \alpha}{k < shape} and the \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]}, \eqn{x \ge \theta}{x \ge min}. } \value{ \code{dpareto1} gives the density, \code{ppareto1} gives the distribution function, \code{qpareto1} gives the quantile function, \code{rpareto1} generates random deviates, \code{mpareto1} gives the \eqn{k}th raw moment, and \code{levpareto1} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ For Pareto distributions, we use the classification of Arnold (2015) with the parametrization of Klugman et al. (2012). The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Arnold, B.C. (2015), \emph{Pareto Distributions}, Second Edition, CRC Press. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ \code{\link{dpareto}} for the two-parameter Pareto distribution. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ exp(dpareto1(5, 3, 4, log = TRUE)) p <- (1:10)/10 ppareto1(qpareto1(p, 2, 3), 2, 3) mpareto1(2, 3, 4) - mpareto(1, 3, 4) ^ 2 levpareto(10, 3, 4, order = 2) } \keyword{distribution} actuar/man/Loggamma.Rd0000644000176200001440000000614314264305077014333 0ustar liggesusers\name{Loggamma} \alias{Loggamma} \alias{dlgamma} \alias{plgamma} \alias{qlgamma} \alias{rlgamma} \alias{mlgamma} \alias{levlgamma} \title{The Loggamma Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments and limited moments for the Loggamma distribution with parameters \code{shapelog} and \code{ratelog}. } \usage{ dlgamma(x, shapelog, ratelog, log = FALSE) plgamma(q, shapelog, ratelog, lower.tail = TRUE, log.p = FALSE) qlgamma(p, shapelog, ratelog, lower.tail = TRUE, log.p = FALSE) rlgamma(n, shapelog, ratelog) mlgamma(order, shapelog, ratelog) levlgamma(limit, shapelog, ratelog, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{shapelog, ratelog}{parameters. Must be strictly positive.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The loggamma distribution with parameters \code{shapelog} \eqn{= \alpha}{= a} and \code{ratelog} \eqn{= \lambda}{= b} has density: \deqn{f(x) = \frac{\lambda^\alpha}{\Gamma(\alpha)}% \frac{(\log x)^{\alpha - 1}}{x^{\lambda + 1}}}{% f(x) = (b^a (log(x))^(a - 1))/(Gamma(a) * x^(b + 1))} for \eqn{x > 1}, \eqn{\alpha > 0}{a > 0} and \eqn{\lambda > 0}{b > 0}. (Here \eqn{\Gamma(\alpha)}{Gamma(a)} is the function implemented by \R's \code{\link{gamma}()} and defined in its help.) The loggamma is the distribution of the random variable \eqn{e^X}{exp(X)}, where \eqn{X} has a gamma distribution with shape parameter \eqn{alpha}{a} and scale parameter \eqn{1/\lambda}{1/b}. The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]} and the \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]}, \eqn{k < \lambda}{k < ratelog}. } \value{ \code{dlgamma} gives the density, \code{plgamma} gives the distribution function, \code{qlgamma} gives the quantile function, \code{rlgamma} generates random deviates, \code{mlgamma} gives the \eqn{k}th raw moment, and \code{levlgamma} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Hogg, R. V. and Klugman, S. A. (1984), \emph{Loss Distributions}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ exp(dlgamma(2, 3, 4, log = TRUE)) p <- (1:10)/10 plgamma(qlgamma(p, 2, 3), 2, 3) mlgamma(2, 3, 4) - mlgamma(1, 3, 4)^2 levlgamma(10, 3, 4, order = 2) } \keyword{distribution} actuar/man/PhaseType.Rd0000644000176200001440000000746414264333515014516 0ustar liggesusers\name{PhaseType} \alias{PhaseType} \alias{dphtype} \alias{pphtype} \alias{rphtype} \alias{mphtype} \alias{mgfphtype} \title{The Phase-type Distribution} \description{ Density, distribution function, random generation, raw moments and moment generating function for the (continuous) Phase-type distribution with parameters \code{prob} and \code{rates}. } \usage{ dphtype(x, prob, rates, log = FALSE) pphtype(q, prob, rates, lower.tail = TRUE, log.p = FALSE) rphtype(n, prob, rates) mphtype(order, prob, rates) mgfphtype(t, prob, rates, log = FALSE) } \arguments{ \item{x, q}{vector of quantiles.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{prob}{vector of initial probabilities for each of the transient states of the underlying Markov chain. The initial probability of the absorbing state is \code{1 - sum(prob)}.} \item{rates}{square matrix of the rates of transition among the states of the underlying Markov chain.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{t}{numeric vector.} } \details{ The phase-type distribution with parameters \code{prob} \eqn{= \pi}{= pi} and \code{rates} \eqn{= \boldsymbol{T}}{= T} has density:% \deqn{f(x) = \pi e^{\boldsymbol{T} x} \boldsymbol{t}}{% f(x) = pi \%*\% exp(T * x) \%*\% t}% for \eqn{x \ge 0} and \eqn{f(0) = 1 - \pi \boldsymbol{e}}{f(0) = 1 - pi \%*\% e}, where % \eqn{\boldsymbol{e}}{e} % is a column vector with all components equal to one, % \eqn{\boldsymbol{t} = -\boldsymbol{T} \boldsymbol{e}}{% t = -T \%*\% e} % is the exit rates vector and % \eqn{e^{\boldsymbol{T}x}}{exp(T * x)} % denotes the matrix exponential of \eqn{\boldsymbol{T}x}{T * x}. The matrix exponential of a matrix \eqn{\boldsymbol{M}}{M} is defined as the Taylor series% \deqn{e^{\boldsymbol{M}} = \sum_{n = 0}^{\infty} \frac{\boldsymbol{M}^n}{n!}.}{% exp(M) = sum(n = 0:Inf; (M^n)/(n!)).} The parameters of the distribution must satisfy \eqn{\pi \boldsymbol{e} \leq 1}{pi \%*\% e <= 1}, \eqn{\boldsymbol{T}_{ii} < 0}{T[i, i] < 0}, \eqn{\boldsymbol{T}_{ij} \geq 0}{T[i, j] >= 0} and \eqn{\boldsymbol{T} \boldsymbol{e} \leq 0}{T \%*\% e <= 0}. The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]} and the moment generating function is \eqn{E[e^{tX}]}. } \value{ \code{dphasetype} gives the density, \code{pphasetype} gives the distribution function, \code{rphasetype} generates random deviates, \code{mphasetype} gives the \eqn{k}th raw moment, and \code{mgfphasetype} gives the moment generating function in \code{x}. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ \url{https://en.wikipedia.org/wiki/Phase-type_distribution} Neuts, M. F. (1981), \emph{Generating random variates from a distribution of phase type}, WSC '81: Proceedings of the 13th conference on Winter simulation, IEEE Press. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Christophe Dutang } \examples{ ## Erlang(3, 2) distribution T <- cbind(c(-2, 0, 0), c(2, -2, 0), c(0, 2, -2)) pi <- c(1,0,0) x <- 0:10 dphtype(x, pi, T) # density dgamma(x, 3, 2) # same pphtype(x, pi, T) # cdf pgamma(x, 3, 2) # same rphtype(10, pi, T) # random values mphtype(1, pi, T) # expected value curve(mgfphtype(x, pi, T), from = -10, to = 1) } \keyword{distribution} actuar/man/grouped.data.Rd0000644000176200001440000001131614264305077015162 0ustar liggesusers\name{grouped.data} \alias{grouped.data} \title{Grouped data} \description{ Creation of grouped data objects, from either a provided set of group boundaries and group frequencies, or from individual data using automatic or specified breakpoints. } \usage{ grouped.data(\dots, breaks = "Sturges", include.lowest = TRUE, right = TRUE, nclass = NULL, group = FALSE, row.names = NULL, check.rows = FALSE, check.names = TRUE) } \arguments{ \item{\dots}{arguments of the form \code{value} or \code{tag = value}; see Details.} \item{breaks}{same as for \code{\link{hist}}, namely one of: \itemize{ \item{a vector giving the breakpoints between groups;} \item{a function to compute the vector of breakpoints;} \item{a single number giving the number of groups;} \item{a character string naming an algorithm to compute the number of groups (see \code{\link{hist}});} \item{a function to compute the number of groups.} } In the last three cases the number is a suggestion only; the breakpoints will be set to \code{\link{pretty}} values. If \code{breaks} is a function, the first element in \code{\dots} is supplied to it as the only argument. } \item{include.lowest}{logical; if \code{TRUE}, a data point equal to the \code{breaks} value will be included in the first (or last, for \code{right = FALSE}) group. Used only for individual data; see Details.} \item{right}{logical; indicating if the intervals should be closed on the right (and open on the left) or vice versa.} \item{nclass}{numeric (integer); equivalent to \code{breaks} for a scalar or character argument.} \item{group}{logical; an alternative way to force grouping of individual data.} \item{row.names, check.rows, check.names}{arguments identical to those of \code{\link{data.frame}}.} } \details{ A grouped data object is a special form of data frame consisting of one column of contiguous group boundaries and one or more columns of frequencies within each group. The function can create a grouped data object from two types of arguments. \enumerate{ \item{Group boundaries and frequencies. This is the default mode of operation if the call has at least two elements in \code{\dots}. The first argument will then be taken as the vector of group boundaries. This vector must be exactly one element longer than the other arguments, which will be taken as vectors of group frequencies. All arguments are coerced to data frames.} \item{Individual data. This mode of operation is active if there is a single argument in \code{\dots}, or if either \code{breaks} or \code{nclass} is specified or \code{group} is \code{TRUE}. Arguments of \code{\dots} are first grouped using \code{\link{hist}}. If needed, breakpoints are set using the first argument.} } Missing (\code{NA}) frequencies are replaced by zeros, with a warning. Extraction and replacement methods exist for \code{grouped.data} objects, but working on non adjacent groups will most likely yield useless results. } \value{ An object of \code{class} \code{c("grouped.data", "data.frame")} with an environment containing the vector \code{cj} of group boundaries. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (1998), \emph{Loss Models, From Data to Decisions}, Wiley. } \seealso{ \code{\link{[.grouped.data}} for extraction and replacement methods. \code{\link{data.frame}} for usual data frame creation and manipulation. \code{\link{hist}} for details on the calculation of breakpoints. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca}, Mathieu Pigeon and Louis-Philippe Pouliot } \examples{ ## Most common usage using a predetermined set of group ## boundaries and group frequencies. cj <- c(0, 25, 50, 100, 250, 500, 1000) nj <- c(30, 31, 57, 42, 45, 10) (x <- grouped.data(Group = cj, Frequency = nj)) class(x) x[, 1] # group boundaries x[, 2] # group frequencies ## Multiple frequency columns are supported x <- sample(1:100, 9) y <- sample(1:100, 9) grouped.data(cj = 1:10, nj.1 = x, nj.2 = y) ## Alternative usage with grouping of individual data. grouped.data(x) # automatic breakpoints grouped.data(x, breaks = 7) # forced number of groups grouped.data(x, breaks = c(0,25,75,100)) # specified groups grouped.data(x, y, breaks = c(0,25,75,100)) # multiple data sets \dontrun{## Providing two or more data sets and automatic breakpoints is ## very error-prone since the range of the first data set has to ## include the ranges of all the other data sets. range(x) range(y) grouped.data(x, y, group = TRUE)} } \keyword{classes} \keyword{methods} actuar/man/FellerPareto.Rd0000644000176200001440000001405114264331401015156 0ustar liggesusers\name{FellerPareto} \alias{FellerPareto} \alias{dfpareto} \alias{pfpareto} \alias{qfpareto} \alias{rfpareto} \alias{mfpareto} \alias{levfpareto} \title{The Feller Pareto Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments and limited moments for the Feller Pareto distribution with parameters \code{min}, \code{shape1}, \code{shape2}, \code{shape3} and \code{scale}. } \usage{ dfpareto(x, min, shape1, shape2, shape3, rate = 1, scale = 1/rate, log = FALSE) pfpareto(q, min, shape1, shape2, shape3, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) qfpareto(p, min, shape1, shape2, shape3, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) rfpareto(n, min, shape1, shape2, shape3, rate = 1, scale = 1/rate) mfpareto(order, min, shape1, shape2, shape3, rate = 1, scale = 1/rate) levfpareto(limit, min, shape1, shape2, shape3, rate = 1, scale = 1/rate, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{min}{lower bound of the support of the distribution.} \item{shape1, shape2, shape3, scale}{parameters. Must be strictly positive.} \item{rate}{an alternative way to specify the scale.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The Feller-Pareto distribution with parameters \code{min} \eqn{= \mu}{= m}, \code{shape1} \eqn{= \alpha}{= a}, \code{shape2} \eqn{= \gamma}{= b}, \code{shape3} \eqn{= \tau}{= c} and \code{scale} \eqn{= \theta}{= s}, has density: \deqn{f(x) = \frac{\Gamma(\alpha + \tau)}{\Gamma(\alpha)\Gamma(\tau)} \frac{\gamma ((x - \mu)/\theta)^{\gamma \tau - 1}}{% \theta [1 + ((x - \mu)/\theta)^\gamma]^{\alpha + \tau}}}{% f(x) = Gamma(a + c)/(Gamma(a) * Gamma(c)) (b ((x - m)/s)^(bc - 1))/% (s [1 + ((x - m)/s)^b]^(a + c))} for \eqn{x > \mu}{x > m}, \eqn{-\infty < \mu < \infty}{-Inf < m < Inf}, \eqn{\alpha > 0}{a > 0}, \eqn{\gamma > 0}{b > 0}, \eqn{\tau > 0}{c > 0} and \eqn{\theta > 0}{s > 0}. (Here \eqn{\Gamma(\alpha)}{Gamma(a)} is the function implemented by \R's \code{\link{gamma}()} and defined in its help.) The Feller-Pareto is the distribution of the random variable \deqn{\mu + \theta \left(\frac{1 - X}{X}\right)^{1/\gamma},}{% m + s ((1 - X)/X)^(1/b),} where \eqn{X} has a beta distribution with parameters \eqn{\alpha}{a} and \eqn{\tau}{c}. The Feller-Pareto defines a large family of distributions encompassing the transformed beta family and many variants of the Pareto distribution. Setting \eqn{\mu = 0}{min = 0} yields the \link[=dtrbeta]{transformed beta} distribution. The Feller-Pareto distribution also has the following direct special cases: \itemize{ \item A \link[=dpareto4]{Pareto IV} distribution when \code{shape3 == 1}; \item A \link[=dpareto3]{Pareto III} distribution when \code{shape1 shape3 == 1}; \item A \link[=dpareto2]{Pareto II} distribution when \code{shape1 shape2 == 1}; \item A \link[=dpareto1]{Pareto I} distribution when \code{shape1 shape2 == 1} and \code{min = scale}. } The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]} for nonnegative integer values of \eqn{k < \alpha\gamma}{k < shape1 * shape2}. The \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]} for nonnegative integer values of \eqn{k} and \eqn{\alpha - j/\gamma}{shape1 - j/shape2}, \eqn{j = 1, \dots, k} not a negative integer. Note that the range of admissible values for \eqn{k} in raw and limited moments is larger when \eqn{\mu = 0}{min == 0}. } \value{ \code{dfpareto} gives the density, \code{pfpareto} gives the distribution function, \code{qfpareto} gives the quantile function, \code{rfpareto} generates random deviates, \code{mfpareto} gives the \eqn{k}th raw moment, and \code{levfpareto} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ \code{levfpareto} computes the limited expected value using \code{\link{betaint}}. For the Feller-Pareto and other Pareto distributions, we use the classification of Arnold (2015) with the parametrization of Klugman et al. (2012). The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Dutang, C., Goulet, V., Langevin, N. (2022). Feller-Pareto and Related Distributions: Numerical Implementation and Actuarial Applications. \emph{Journal of Statistical Software}, \bold{103}(6), 1--22. \doi{10.18637/jss.v103.i06}. Abramowitz, M. and Stegun, I. A. (1972), \emph{Handbook of Mathematical Functions}, Dover. Arnold, B. C. (2015), \emph{Pareto Distributions}, Second Edition, CRC Press. Kleiber, C. and Kotz, S. (2003), \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ \code{\link{dtrbeta}} for the transformed beta distribution. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Nicholas Langevin } \examples{ exp(dfpareto(2, 1, 2, 3, 4, 5, log = TRUE)) p <- (1:10)/10 pfpareto(qfpareto(p, 1, 2, 3, 4, 5), 1, 2, 3, 4, 5) ## variance mfpareto(2, 1, 2, 3, 4, 5) - mfpareto(1, 1, 2, 3, 4, 5)^2 ## case with shape1 - order/shape2 > 0 levfpareto(10, 1, 2, 3, 4, scale = 1, order = 2) ## case with shape1 - order/shape2 < 0 levfpareto(20, 10, 0.1, 14, 2, scale = 1.5, order = 2) } \keyword{distribution} actuar/man/ZeroModifiedNegativeBinomial.Rd0000644000176200001440000001156114264305077020325 0ustar liggesusers\name{ZeroModifiedNegativeBinomial} \alias{ZeroModifiedNegativeBinomial} \alias{ZMNegativeBinomial} \alias{ZMNegBinomial} \alias{dzmnbinom} \alias{pzmnbinom} \alias{qzmnbinom} \alias{rzmnbinom} \title{The Zero-Modified Negative Binomial Distribution} \description{ Density function, distribution function, quantile function and random generation for the Zero-Modified Negative Binomial distribution with parameters \code{size} and \code{prob}, and arbitrary probability at zero \code{p0}. } \usage{ dzmnbinom(x, size, prob, p0, log = FALSE) pzmnbinom(q, size, prob, p0, lower.tail = TRUE, log.p = FALSE) qzmnbinom(p, size, prob, p0, lower.tail = TRUE, log.p = FALSE) rzmnbinom(n, size, prob, p0) } \arguments{ \item{x}{vector of (strictly positive integer) quantiles.} \item{q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{size}{target for number of successful trials, or dispersion parameter. Must be positive, need not be integer.} \item{prob}{parameter. \code{0 < prob <= 1}.} \item{p0}{probability mass at zero. \code{0 <= p0 <= 1}.} \item{log, log.p}{logical; if \code{TRUE}, probabilities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}, otherwise, \eqn{P[X > x]}.} } \details{ The zero-modified negative binomial distribution with \code{size} \eqn{= r}, \code{prob} \eqn{= p} and \code{p0} \eqn{= p_0}{= p0} is a discrete mixture between a degenerate distribution at zero and a (standard) negative binomial. The probability mass function is \eqn{p(0) = p_0}{p(0) = p0} and \deqn{% p(x) = \frac{(1-p_0)}{(1-p^r)} f(x)}{% p(x) = (1-p0)/(1-p^r) f(x)} for \eqn{x = 1, 2, \ldots}, \eqn{r \ge 0}, \eqn{0 < p < 1} and \eqn{0 \le p_0 \le 1}{0 \le p0 \le 1}, where \eqn{f(x)} is the probability mass function of the negative binomial. The cumulative distribution function is \deqn{P(x) = p_0 + (1 - p_0) \left(\frac{F(x) - F(0)}{1 - F(0)}\right)}{% P(x) = p0 + (1 - p0) [F(x) - F(0)]/[1 - F(0)].} The mean is \eqn{(1-p_0) \mu}{(1-p0)m} and the variance is \eqn{(1-p_0) \sigma^2 + p_0(1-p_0) \mu^2}{(1-p0)v + p0(1-p0)m^2}, where \eqn{\mu}{m} and \eqn{\sigma^2}{v} are the mean and variance of the zero-truncated negative binomial. In the terminology of Klugman et al. (2012), the zero-modified negative binomial is a member of the \eqn{(a, b, 1)} class of distributions with \eqn{a = 1-p} and \eqn{b = (r-1)(1-p)}. The special case \code{p0 == 0} is the zero-truncated negative binomial. The limiting case \code{size == 0} is the zero-modified logarithmic distribution with parameters \code{1 - prob} and \code{p0}. Unlike the standard negative binomial functions, parametrization through the mean \code{mu} is not supported to avoid ambiguity as to whether \code{mu} is the mean of the underlying negative binomial or the mean of the zero-modified distribution. If an element of \code{x} is not integer, the result of \code{dzmnbinom} is zero, with a warning. The quantile is defined as the smallest value \eqn{x} such that \eqn{P(x) \ge p}, where \eqn{P} is the distribution function. } \value{ \code{dzmnbinom} gives the (log) probability mass function, \code{pzmnbinom} gives the (log) distribution function, \code{qzmnbinom} gives the quantile function, and \code{rzmnbinom} generates random deviates. Invalid \code{size}, \code{prob} or \code{p0} will result in return value \code{NaN}, with a warning. The length of the result is determined by \code{n} for \code{rzmnbinom}, and is the maximum of the lengths of the numerical arguments for the other functions. } \note{ Functions \code{\{d,p,q\}zmnbinom} use \code{\{d,p,q\}nbinom} for all but the trivial input values and \eqn{p(0)}. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ \code{\link{dnbinom}} for the negative binomial distribution. \code{\link{dztnbinom}} for the zero-truncated negative binomial distribution. \code{\link{dzmgeom}} for the zero-modified geometric and \code{\link{dzmlogarithmic}} for the zero-modified logarithmic, which are special cases of the zero-modified negative binomial. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ ## Example 6.3 of Klugman et al. (2012) p <- 1/(1 + 0.5) dzmnbinom(1:5, size = 2.5, prob = p, p0 = 0.6) (1-0.6) * dnbinom(1:5, 2.5, p)/pnbinom(0, 2.5, p, lower = FALSE) # same ## simple relation between survival functions pzmnbinom(0:5, 2.5, p, p0 = 0.2, lower = FALSE) (1-0.2) * pnbinom(0:5, 2.5, p, lower = FALSE) / pnbinom(0, 2.5, p, lower = FALSE) # same qzmnbinom(pzmnbinom(0:10, 2.5, 0.3, p0 = 0.1), 2.5, 0.3, p0 = 0.1) } \keyword{distribution} actuar/man/Extract.grouped.data.Rd0000644000176200001440000000511014264305077016566 0ustar liggesusers\name{Extract.grouped.data} \alias{Extract.grouped.data} \alias{[.grouped.data} \alias{[<-.grouped.data} \title{Extract or Replace Parts of a Grouped Data Object} \description{ Extract or replace subsets of grouped data objects. } \usage{ \method{[}{grouped.data}(x, i, j) \method{[}{grouped.data}(x, i, j) <- value } \arguments{ \item{x}{an object of class \code{grouped.data}.} \item{i, j}{elements to extract or replace. \code{i, j} are \code{numeric} or \code{character} or, for \code{[} only, empty. Numeric values are coerced to integer as if by \code{\link[base]{as.integer}}. For replacement by \code{[}, a logical matrix is allowed, but not replacement in the group boundaries and group frequencies simultaneously.} \item{value}{a suitable replacement value.} } \details{ Objects of class \code{"grouped.data"} can mostly be indexed like data frames, with the following restrictions: \enumerate{ \item For \code{[}, the extracted object must keep a group boundaries column and at least one group frequencies column to remain of class \code{"grouped.data"}; \item For \code{[<-}, it is not possible to replace group boundaries and group frequencies simultaneously; \item When replacing group boundaries, \code{length(value) == length(i) + 1}. } \code{x[, 1]} will return the plain vector of group boundaries. Replacement of non adjacent group boundaries is not possible for obvious reasons. Otherwise, extraction and replacement should work just like for data frames. } \value{ For \code{[} an object of class \code{"grouped.data"}, a data frame or a vector. For \code{[<-} an object of class \code{"grouped.data"}. } \note{ Currently \code{[[}, \code{[[<-}, \code{$} and \code{$<-} are not specifically supported, but should work as usual on group frequency columns. } \seealso{ \code{\link[base]{[.data.frame}} for extraction and replacement methods of data frames, \code{\link{grouped.data}} to create grouped data objects. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ data(gdental) (x <- gdental[1]) # select column 1 class(x) # no longer a grouped.data object class(gdental[2]) # same gdental[, 1] # group boundaries gdental[, 2] # group frequencies gdental[1:4,] # a subset gdental[c(1, 3, 5),] # avoid this gdental[1:2, 1] <- c(0, 30, 60) # modified boundaries gdental[, 2] <- 10 # modified frequencies \dontrun{gdental[1, ] <- 2} # not allowed } \keyword{manip} \keyword{array} actuar/man/Logarithmic.Rd0000644000176200001440000001044414264305077015050 0ustar liggesusers\name{Logarithmic} \alias{Logarithmic} \alias{dlogarithmic} \alias{plogarithmic} \alias{qlogarithmic} \alias{rlogarithmic} \alias{log-series} \title{The Logarithmic Distribution} \description{ Density function, distribution function, quantile function and random generation for the Logarithmic (or log-series) distribution with parameter \code{prob}. } \usage{ dlogarithmic(x, prob, log = FALSE) plogarithmic(q, prob, lower.tail = TRUE, log.p = FALSE) qlogarithmic(p, prob, lower.tail = TRUE, log.p = FALSE) rlogarithmic(n, prob) } \arguments{ \item{x}{vector of (strictly positive integer) quantiles.} \item{q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{prob}{parameter. \code{0 <= prob < 1}.} \item{log, log.p}{logical; if \code{TRUE}, probabilities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}, otherwise, \eqn{P[X > x]}.} } \details{ The logarithmic (or log-series) distribution with parameter \code{prob} \eqn{= \theta}{= p} has probability mass function \deqn{% p(x) = \frac{a \theta^x}{x},}{% p(x) = a p^x / x,} with \eqn{a = -1/\log(1 - \theta)}{a = -1/log(1-p)} and for \eqn{x = 1, 2, \ldots}, \eqn{0 \le \theta < 1}{0 \le p < 1}. The logarithmic distribution is the limiting case of the zero-truncated negative binomial distribution with \code{size} parameter equal to \eqn{0}. Note that in this context, parameter \code{prob} generally corresponds to the probability of \emph{failure} of the zero-truncated negative binomial. If an element of \code{x} is not integer, the result of \code{dlogarithmic} is zero, with a warning. The quantile is defined as the smallest value \eqn{x} such that \eqn{F(x) \ge p}, where \eqn{F} is the distribution function. } \value{ \code{dlogarithmic} gives the probability mass function, \code{plogarithmic} gives the distribution function, \code{qlogarithmic} gives the quantile function, and \code{rlogarithmic} generates random deviates. Invalid \code{prob} will result in return value \code{NaN}, with a warning. The length of the result is determined by \code{n} for \code{rlogarithmic}, and is the maximum of the lengths of the numerical arguments for the other functions. } \note{ \code{qlogarithmic} is based on \code{qbinom} et al.; it uses the Cornish--Fisher Expansion to include a skewness correction to a normal approximation, followed by a search. \code{rlogarithmic} is an implementation of the LS and LK algorithms of Kemp (1981) with automatic selection. As suggested by Devroye (1986), the LS algorithm is used when \code{prob < 0.95}, and the LK algorithm otherwise. } \references{ Johnson, N. L., Kemp, A. W. and Kotz, S. (2005), \emph{Univariate Discrete Distributions, Third Edition}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. Kemp, A. W. (1981), \dQuote{Efficient Generation of Logarithmically Distributed Pseudo-Random Variables}, \emph{Journal of the Royal Statistical Society, Series C}, vol. 30, p. 249-253. Devroye, L. (1986), \emph{Non-Uniform Random Variate Generation}, Springer-Verlag. \url{http://luc.devroye.org/rnbookindex.html} } \seealso{ \code{\link{dztnbinom}} for the zero-truncated negative binomial distribution. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ ## Table 1 of Kemp (1981) [also found in Johnson et al. (2005), chapter 7] p <- c(0.1, 0.3, 0.5, 0.7, 0.8, 0.85, 0.9, 0.95, 0.99, 0.995, 0.999, 0.9999) round(rbind(dlogarithmic(1, p), dlogarithmic(2, p), plogarithmic(9, p, lower.tail = FALSE), -p/((1 - p) * log(1 - p))), 2) qlogarithmic(plogarithmic(1:10, 0.9), 0.9) x <- rlogarithmic(1000, 0.8) y <- sort(unique(x)) plot(y, table(x)/length(x), type = "h", lwd = 2, pch = 19, col = "black", xlab = "x", ylab = "p(x)", main = "Empirical vs theoretical probabilities") points(y, dlogarithmic(y, prob = 0.8), pch = 19, col = "red") legend("topright", c("empirical", "theoretical"), lty = c(1, NA), pch = c(NA, 19), col = c("black", "red")) } \keyword{distribution} actuar/man/ExponentialSupp.Rd0000644000176200001440000000326514264305077015747 0ustar liggesusers\name{ExponentialSupp} \alias{ExponentialSupp} \alias{mexp} \alias{levexp} \alias{mgfexp} \title{Moments and Moment Generating Function of the Exponential Distribution} \description{ Raw moments, limited moments and moment generating function for the exponential distribution with rate \code{rate} (i.e., mean \code{1/rate}). } \usage{ mexp(order, rate = 1) levexp(limit, rate = 1, order = 1) mgfexp(t, rate = 1, log = FALSE) } \arguments{ \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} \item{rate}{vector of rates.} \item{t}{numeric vector.} \item{log}{logical; if \code{TRUE}, the cumulant generating function is returned.} } \details{ The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]}, the \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]} and the moment generating function is \eqn{E[e^{tX}]}, \eqn{k > -1}. } \value{ \code{mexp} gives the \eqn{k}th raw moment, \code{levexp} gives the \eqn{k}th moment of the limited loss variable, and \code{mgfexp} gives the moment generating function in \code{t}. Invalid arguments will result in return value \code{NaN}, with a warning. } \seealso{ \code{\link[stats]{Exponential}} } \references{ Johnson, N. L. and Kotz, S. (1970), \emph{Continuous Univariate Distributions, Volume 1}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca}, Christophe Dutang and Mathieu Pigeon. } \examples{ mexp(2, 3) - mexp(1, 3)^2 levexp(10, 3, order = 2) mgfexp(1,2) } \keyword{distribution} actuar/man/InverseBurr.Rd0000644000176200001440000001052014264305077015047 0ustar liggesusers\name{InverseBurr} \alias{InverseBurr} \alias{dinvburr} \alias{pinvburr} \alias{qinvburr} \alias{rinvburr} \alias{minvburr} \alias{levinvburr} \title{The Inverse Burr Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments and limited moments for the Inverse Burr distribution with parameters \code{shape1}, \code{shape2} and \code{scale}. } \usage{ dinvburr(x, shape1, shape2, rate = 1, scale = 1/rate, log = FALSE) pinvburr(q, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) qinvburr(p, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) rinvburr(n, shape1, shape2, rate = 1, scale = 1/rate) minvburr(order, shape1, shape2, rate = 1, scale = 1/rate) levinvburr(limit, shape1, shape2, rate = 1, scale = 1/rate, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{shape1, shape2, scale}{parameters. Must be strictly positive.} \item{rate}{an alternative way to specify the scale.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The inverse Burr distribution with parameters \code{shape1} \eqn{= \tau}{= a}, \code{shape2} \eqn{= \gamma}{= b} and \code{scale} \eqn{= \theta}{= s}, has density: \deqn{f(x) = \frac{\tau \gamma (x/\theta)^{\gamma \tau}}{% x [1 + (x/\theta)^\gamma]^{\tau + 1}}}{% f(x) = a b (x/s)^(ba)/(x [1 + (x/s)^b]^(a + 1))} for \eqn{x > 0}, \eqn{\tau > 0}{a > 0}, \eqn{\gamma > 0}{b > 0} and \eqn{\theta > 0}{s > 0}. The inverse Burr is the distribution of the random variable \deqn{\theta \left(\frac{X}{1 - X}\right)^{1/\gamma},}{% s (X/(1 - X))^(1/b),} where \eqn{X} has a beta distribution with parameters \eqn{\tau}{a} and \eqn{1}. The inverse Burr distribution has the following special cases: \itemize{ \item A \link[=dllogis]{Loglogistic} distribution when \code{shape1 == 1}; \item An \link[=dinvpareto]{Inverse Pareto} distribution when \code{shape2 == 1}; \item An \link[=dinvparalogis]{Inverse Paralogistic} distribution when \code{shape1 == shape2}. } The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]}, \eqn{-\tau\gamma < k < \gamma}{-shape1 * shape2 < k < shape2}. The \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]}, \eqn{k > -\tau\gamma}{k > -shape1 * shape2} and \eqn{1 - k/\gamma}{1 - k/shape2} not a negative integer. } \value{ \code{dinvburr} gives the density, \code{invburr} gives the distribution function, \code{qinvburr} gives the quantile function, \code{rinvburr} generates random deviates, \code{minvburr} gives the \eqn{k}th raw moment, and \code{levinvburr} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ \code{levinvburr} computes the limited expected value using \code{\link{betaint}}. Also known as the Dagum distribution. See also Kleiber and Kotz (2003) for alternative names and parametrizations. The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Kleiber, C. and Kotz, S. (2003), \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ exp(dinvburr(2, 2, 3, 1, log = TRUE)) p <- (1:10)/10 pinvburr(qinvburr(p, 2, 3, 1), 2, 3, 1) ## variance minvburr(2, 2, 3, 1) - minvburr(1, 2, 3, 1) ^ 2 ## case with 1 - order/shape2 > 0 levinvburr(10, 2, 3, 1, order = 2) ## case with 1 - order/shape2 < 0 levinvburr(10, 2, 1.5, 1, order = 2) } \keyword{distribution} actuar/man/adjCoef.Rd0000644000176200001440000001411314264305077014136 0ustar liggesusers\name{adjCoef} \alias{adjCoef} \alias{plot.adjCoef} \title{Adjustment Coefficient} \description{ Compute the adjustment coefficient in ruin theory, or return a function to compute the adjustment coefficient for various reinsurance retentions. } \usage{ adjCoef(mgf.claim, mgf.wait = mgfexp, premium.rate, upper.bound, h, reinsurance = c("none", "proportional", "excess-of-loss"), from, to, n = 101) \method{plot}{adjCoef}(x, xlab = "x", ylab = "R(x)", main = "Adjustment Coefficient", sub = comment(x), type = "l", add = FALSE, \dots) } \arguments{ \item{mgf.claim}{an expression written as a function of \code{x} or of \code{x} and \code{y}, or alternatively the name of a function, giving the moment generating function (mgf) of the claim severity distribution.} \item{mgf.wait}{an expression written as a function of \code{x}, or alternatively the name of a function, giving the mgf of the claims interarrival time distribution. Defaults to an exponential distribution with mean 1.} \item{premium.rate}{if \code{reinsurance = "none"}, a numeric value of the premium rate; otherwise, an expression written as a function of \code{y}, or alternatively the name of a function, giving the premium rate function.} \item{upper.bound}{numeric; an upper bound for the coefficient, usually the upper bound of the support of the claim severity mgf.} \item{h}{an expression written as a function of \code{x} or of \code{x} and \code{y}, or alternatively the name of a function, giving function \eqn{h} in the Lundberg equation (see below); ignored if \code{mgf.claim} is provided.} \item{reinsurance}{the type of reinsurance for the portfolio; can be abbreviated.} \item{from, to}{the range over which the adjustment coefficient will be calculated.} \item{n}{integer; the number of values at which to evaluate the adjustment coefficient.} \item{x}{an object of class \code{"adjCoef"}.} \item{xlab, ylab}{label of the x and y axes, respectively.} \item{main}{main title.} \item{sub}{subtitle, defaulting to the type of reinsurance.} \item{type}{1-character string giving the type of plot desired; see \code{\link[graphics]{plot}} for details.} \item{add}{logical; if \code{TRUE} add to already existing plot.} \item{\dots}{further graphical parameters accepted by \code{\link[graphics]{plot}} or \code{\link[graphics]{lines}}.} } \details{ In the typical case \code{reinsurance = "none"}, the coefficient of determination is the smallest (strictly) positive root of the Lundberg equation% \deqn{h(x) = E[e^{x B - x c W}] = 1}{h(x) = E[exp(x B - x c W)] = 1}% on \eqn{[0, m)}, where \eqn{m =} \code{upper.bound}, \eqn{B} is the claim severity random variable, \eqn{W} is the claim interarrival (or wait) time random variable and \eqn{c =} \code{premium.rate}. The premium rate must satisfy the positive safety loading constraint \eqn{E[B - c W] < 0}. With \code{reinsurance = "proportional"}, the equation becomes \deqn{h(x, y) = E[e^{x y B - x c(y) W}] = 1,}{% h(x, y) = E[exp(x y B - x c(y) W)] = 1,} where \eqn{y} is the retention rate and \eqn{c(y)} is the premium rate function. With \code{reinsurance = "excess-of-loss"}, the equation becomes \deqn{h(x, y) = E[e^{x \min(B, y) - x c(y) W}] = 1,}{% h(x, y) = E[exp(x min(B, y) - x c(y) W)] = 1,} where \eqn{y} is the retention limit and \eqn{c(y)} is the premium rate function. One can use argument \code{h} as an alternative way to provide function \eqn{h(x)} or \eqn{h(x, y)}. This is necessary in cases where random variables \eqn{B} and \eqn{W} are not independent. The root of \eqn{h(x) = 1} is found by minimizing \eqn{(h(x) - 1)^2}. } \value{ If \code{reinsurance = "none"}, a numeric vector of length one. Otherwise, a function of class \code{"adjCoef"} inheriting from the \code{"function"} class. } \references{ Bowers, N. J. J., Gerber, H. U., Hickman, J., Jones, D. and Nesbitt, C. (1986), \emph{Actuarial Mathematics}, Society of Actuaries. Centeno, M. d. L. (2002), Measuring the effects of reinsurance by the adjustment coefficient in the Sparre-Anderson model, \emph{Insurance: Mathematics and Economics} \bold{30}, 37--49. Gerber, H. U. (1979), \emph{An Introduction to Mathematical Risk Theory}, Huebner Foundation. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2008), \emph{Loss Models, From Data to Decisions, Third Edition}, Wiley. } \author{ Christophe Dutang, Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ ## Basic example: no reinsurance, exponential claim severity and wait ## times, premium rate computed with expected value principle and ## safety loading of 20\%. adjCoef(mgfexp, premium = 1.2, upper = 1) ## Same thing, giving function h. h <- function(x) 1/((1 - x) * (1 + 1.2 * x)) adjCoef(h = h, upper = 1) ## Example 11.4 of Klugman et al. (2008) mgfx <- function(x) 0.6 * exp(x) + 0.4 * exp(2 * x) adjCoef(mgfx(x), mgfexp(x, 4), prem = 7, upper = 0.3182) ## Proportional reinsurance, same assumptions as above, reinsurer's ## safety loading of 30\%. mgfx <- function(x, y) mgfexp(x * y) p <- function(x) 1.3 * x - 0.1 h <- function(x, a) 1/((1 - a * x) * (1 + x * p(a))) R1 <- adjCoef(mgfx, premium = p, upper = 1, reins = "proportional", from = 0, to = 1, n = 11) R2 <- adjCoef(h = h, upper = 1, reins = "p", from = 0, to = 1, n = 101) R1(seq(0, 1, length = 10)) # evaluation for various retention rates R2(seq(0, 1, length = 10)) # same plot(R1) # graphical representation plot(R2, col = "green", add = TRUE) # smoother function ## Excess-of-loss reinsurance p <- function(x) 1.3 * levgamma(x, 2, 2) - 0.1 mgfx <- function(x, l) mgfgamma(x, 2, 2) * pgamma(l, 2, 2 - x) + exp(x * l) * pgamma(l, 2, 2, lower = FALSE) h <- function(x, l) mgfx(x, l) * mgfexp(-x * p(l)) R1 <- adjCoef(mgfx, upper = 1, premium = p, reins = "excess-of-loss", from = 0, to = 10, n = 11) R2 <- adjCoef(h = h, upper = 1, reins = "e", from = 0, to = 10, n = 101) plot(R1) plot(R2, col = "green", add = TRUE) } \keyword{optimize} \keyword{univar} actuar/man/unroll.Rd0000644000176200001440000000242514264305077014121 0ustar liggesusers\name{unroll} \alias{unroll} \title{Display a Two-Dimension Version of a Matrix of Vectors} \description{ Displays all values of a matrix of vectors by \dQuote{unrolling} the object vertically or horizontally. } \usage{ unroll(x, bycol = FALSE, drop = TRUE) } \arguments{ \item{x}{a list of vectors with a \code{\link[base]{dim}} attribute of length 0, 1 or 2.} \item{bycol}{logical; whether to unroll horizontally (\code{FALSE}) or vertically (\code{TRUE}).} \item{drop}{logical; if \code{TRUE}, the result is coerced to the lowest possible dimension.} } \details{ \code{unroll} returns a matrix where elements of \code{x} are concatenated (\dQuote{unrolled}) by row (\code{bycol = FALSE}) or by column (\code{bycol = TRUE}). \code{NA} is used to make rows/columns of equal length. Vectors and one dimensional arrays are coerced to \strong{row} matrices. } \value{ A vector or matrix. } \seealso{ This function was originally written for use in \code{\link{severity.portfolio}}. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Louis-Philippe Pouliot } \examples{ x <- list(c(1:3), c(1:8), c(1:4), c(1:3)) (mat <- matrix(x, 2, 2)) unroll(mat) unroll(mat, bycol = TRUE) unroll(mat[1, ]) unroll(mat[1, ], drop = FALSE) } \keyword{manip} actuar/man/hist.grouped.data.Rd0000644000176200001440000000740514264305077016134 0ustar liggesusers\name{hist.grouped.data} \alias{hist.grouped.data} \title{Histogram for Grouped Data} \description{ This method for the generic function \code{\link{hist}} is mainly useful to plot the histogram of grouped data. If \code{plot = FALSE}, the resulting object of class \code{"histogram"} is returned for compatibility with \code{\link{hist.default}}, but does not contain much information not already in \code{x}. } \usage{ \method{hist}{grouped.data}(x, freq = NULL, probability = !freq, density = NULL, angle = 45, col = NULL, border = NULL, main = paste("Histogram of" , xname), xlim = range(x), ylim = NULL, xlab = xname, ylab, axes = TRUE, plot = TRUE, labels = FALSE, \dots) } \arguments{ \item{x}{an object of class \code{"grouped.data"}; only the first column of frequencies is used.} \item{freq}{logical; if \code{TRUE}, the histogram graphic is a representation of frequencies, the \code{counts} component of the result; if \code{FALSE}, probability densities, component \code{density}, are plotted (so that the histogram has a total area of one). Defaults to \code{TRUE} \emph{iff} group boundaries are equidistant (and \code{probability} is not specified).} \item{probability}{an \emph{alias} for \code{!freq}, for S compatibility.} \item{density}{the density of shading lines, in lines per inch. The default value of \code{NULL} means that no shading lines are drawn. Non-positive values of \code{density} also inhibit the drawing of shading lines.} \item{angle}{the slope of shading lines, given as an angle in degrees (counter-clockwise).} \item{col}{a colour to be used to fill the bars. The default of \code{NULL} yields unfilled bars.} \item{border}{the color of the border around the bars. The default is to use the standard foreground color.} \item{main, xlab, ylab}{these arguments to \code{title} have useful defaults here.} \item{xlim, ylim}{the range of x and y values with sensible defaults. Note that \code{xlim} is \emph{not} used to define the histogram (breaks), but only for plotting (when \code{plot = TRUE}).} \item{axes}{logical. If \code{TRUE} (default), axes are draw if the plot is drawn.} \item{plot}{logical. If \code{TRUE} (default), a histogram is plotted, otherwise a list of breaks and counts is returned.} \item{labels}{logical or character. Additionally draw labels on top of bars, if not \code{FALSE}; see \code{\link{plot.histogram}}.} \item{\dots}{further graphical parameters passed to \code{\link{plot.histogram}} and their to \code{\link{title}} and \code{\link{axis}} (if \code{plot=TRUE}).} } \value{ An object of class \code{"histogram"} which is a list with components: \item{breaks}{the \eqn{r + 1} group boundaries.} \item{counts}{\eqn{r} integers; the frequency within each group.} \item{density}{the relative frequencies within each group \eqn{n_j/n}{n[j]/n}, where \eqn{n_j}{n[j]} = \code{counts[j]}.} \item{intensities}{same as \code{density}. Deprecated, but retained for compatibility.} \item{mids}{the \eqn{r} group midpoints.} \item{xname}{a character string with the actual \code{x} argument name.} \item{equidist}{logical, indicating if the distances between \code{breaks} are all the same.} } \note{ The resulting value does \emph{not} depend on the values of the arguments \code{freq} (or \code{probability}) or \code{plot}. This is intentionally different from S. } \seealso{ \code{\link{hist}} and \code{\link{hist.default}} for histograms of individual data and fancy examples. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (1998), \emph{Loss Models, From Data to Decisions}, Wiley. } \examples{ data(gdental) hist(gdental) } \keyword{dplot} \keyword{hplot} \keyword{distribution} actuar/man/ZeroModifiedLogarithmic.Rd0000644000176200001440000000752214264305077017354 0ustar liggesusers\name{ZeroModifiedLogarithmic} \alias{ZeroModifiedLogarithmic} \alias{ZMLogarithmic} \alias{dzmlogarithmic} \alias{pzmlogarithmic} \alias{qzmlogarithmic} \alias{rzmlogarithmic} \title{The Zero-Modified Logarithmic Distribution} \description{ Density function, distribution function, quantile function and random generation for the Zero-Modified Logarithmic (or log-series) distribution with parameter \code{prob} and arbitrary probability at zero \code{p0}. } \usage{ dzmlogarithmic(x, prob, p0, log = FALSE) pzmlogarithmic(q, prob, p0, lower.tail = TRUE, log.p = FALSE) qzmlogarithmic(p, prob, p0, lower.tail = TRUE, log.p = FALSE) rzmlogarithmic(n, prob, p0) } \arguments{ \item{x}{vector of (strictly positive integer) quantiles.} \item{q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{prob}{parameter. \code{0 <= prob < 1}.} \item{p0}{probability mass at zero. \code{0 <= p0 <= 1}.} \item{log, log.p}{logical; if \code{TRUE}, probabilities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}, otherwise, \eqn{P[X > x]}.} } \details{ The zero-modified logarithmic distribution with \code{prob} \eqn{= p} and \code{p0} \eqn{= p_0}{= p0} is a discrete mixture between a degenerate distribution at zero and a (standard) logarithmic. The probability mass function is \eqn{p(0) = p_0}{p(0) = p0} and \deqn{% p(x) = (1-p_0) f(x)}{p(x) = (1-p0) f(x)} for \eqn{x = 1, 2, \ldots}, \eqn{0 < p < 1} and \eqn{0 \le p_0 \le 1}{0 \le p0 \le 1}, where \eqn{f(x)} is the probability mass function of the logarithmic. The cumulative distribution function is \deqn{P(x) = p_0 + (1 - p_0) F(x)}{P(x) = p0 + (1 - p0) F(x).} The special case \code{p0 == 0} is the standard logarithmic. The zero-modified logarithmic distribution is the limiting case of the zero-modified negative binomial distribution with \code{size} parameter equal to \eqn{0}. Note that in this context, parameter \code{prob} generally corresponds to the probability of \emph{failure} of the zero-truncated negative binomial. If an element of \code{x} is not integer, the result of \code{dzmlogarithmic} is zero, with a warning. The quantile is defined as the smallest value \eqn{x} such that \eqn{F(x) \ge p}, where \eqn{F} is the distribution function. } \value{ \code{dzmlogarithmic} gives the probability mass function, \code{pzmlogarithmic} gives the distribution function, \code{qzmlogarithmic} gives the quantile function, and \code{rzmlogarithmic} generates random deviates. Invalid \code{prob} or \code{p0} will result in return value \code{NaN}, with a warning. The length of the result is determined by \code{n} for \code{rzmlogarithmic}, and is the maximum of the lengths of the numerical arguments for the other functions. } \note{ Functions \code{\{d,p,q\}zmlogarithmic} use \code{\{d,p,q\}logarithmic} for all but the trivial input values and \eqn{p(0)}. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ \code{\link{dlogarithmic}} for the logarithmic distribution. \code{\link{dztnbinom}} for the zero modified negative binomial distribution. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ p <- 1/(1 + 0.5) dzmlogarithmic(1:5, prob = p, p0 = 0.6) (1-0.6) * dlogarithmic(1:5, p)/plogarithmic(0, p, lower = FALSE) # same ## simple relation between survival functions pzmlogarithmic(0:5, p, p0 = 0.2, lower = FALSE) (1-0.2) * plogarithmic(0:5, p, lower = FALSE)/plogarithmic(0, p, lower = FALSE) # same qzmlogarithmic(pzmlogarithmic(0:10, 0.3, p0 = 0.6), 0.3, p0 = 0.6) } \keyword{distribution} actuar/man/Pareto2.Rd0000644000176200001440000001107514264305077014123 0ustar liggesusers\name{Pareto2} \alias{Pareto2} \alias{dpareto2} \alias{ppareto2} \alias{qpareto2} \alias{rpareto2} \alias{mpareto2} \alias{levpareto2} \title{The Pareto II Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments and limited moments for the Pareto II distribution with parameters \code{min}, \code{shape} and \code{scale}. } \usage{ dpareto2(x, min, shape, rate = 1, scale = 1/rate, log = FALSE) ppareto2(q, min, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) qpareto2(p, min, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) rpareto2(n, min, shape, rate = 1, scale = 1/rate) mpareto2(order, min, shape, rate = 1, scale = 1/rate) levpareto2(limit, min, shape, rate = 1, scale = 1/rate, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{min}{lower bound of the support of the distribution.} \item{shape, scale}{parameters. Must be strictly positive.} \item{rate}{an alternative way to specify the scale.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The Pareto II (or \dQuote{type II}) distribution with parameters \code{min} \eqn{= \mu}{= m}, \code{shape} \eqn{= \alpha}{= a} and \code{scale} \eqn{= \theta}{= s} has density: \deqn{f(x) = \frac{\alpha}{% \theta [1 + (x - \mu)/\theta]^{\alpha + 1}}}{% f(x) = a/(s [1 + (x - m)/s]^(a + 1))} for \eqn{x > \mu}{x > m}, \eqn{-\infty < \mu < \infty}{-Inf < m < Inf}, \eqn{\alpha > 0}{a > 0} and \eqn{\theta > 0}{s > 0}. The Pareto II is the distribution of the random variable \deqn{\mu + \theta \left(\frac{X}{1 - X}\right),}{% m + s X/(1 - X),} where \eqn{X} has a beta distribution with parameters \eqn{1} and \eqn{\alpha}{a}. It derives from the \link[=dfpareto]{Feller-Pareto} distribution with \eqn{\tau = \gamma = 1}{shape2 = shape3 = 1}. Setting \eqn{\mu = 0}{min = 0} yields the familiar \link[=dpareto]{Pareto} distribution. The \link[=dpareto1]{Pareto I} (or Single parameter Pareto) distribution is a special case of the Pareto II with \code{min == scale}. The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]} for nonnegative integer values of \eqn{k < \alpha}{k < shape}. The \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]} for nonnegative integer values of \eqn{k} and \eqn{\alpha - j}{shape1 - j}, \eqn{j = 1, \dots, k} not a negative integer. } \value{ \code{dpareto2} gives the density, \code{ppareto2} gives the distribution function, \code{qpareto2} gives the quantile function, \code{rpareto2} generates random deviates, \code{mpareto2} gives the \eqn{k}th raw moment, and \code{levpareto2} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ \code{levpareto2} computes the limited expected value using \code{\link{betaint}}. For Pareto distributions, we use the classification of Arnold (2015) with the parametrization of Klugman et al. (2012). The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Arnold, B.C. (2015), \emph{Pareto Distributions}, Second Edition, CRC Press. Kleiber, C. and Kotz, S. (2003), \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \seealso{ \code{\link{dpareto}} for the Pareto distribution without a location parameter. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ exp(dpareto2(1, min = 10, 3, 4, log = TRUE)) p <- (1:10)/10 ppareto2(qpareto2(p, min = 10, 2, 3), min = 10, 2, 3) ## variance mpareto2(2, min = 10, 4, 1) - mpareto2(1, min = 10, 4, 1)^2 ## case with shape - order > 0 levpareto2(10, min = 10, 3, scale = 1, order = 2) ## case with shape - order < 0 levpareto2(10, min = 10, 1.5, scale = 1, order = 2) } \keyword{distribution} actuar/man/LognormalMoments.Rd0000644000176200001440000000247014264305077016103 0ustar liggesusers\name{LognormalMoments} \alias{LognormalMoments} \alias{mlnorm} \alias{levlnorm} \title{Raw and Limited Moments of the Lognormal Distribution} \description{ Raw moments and limited moments for the Lognormal distribution whose logarithm has mean equal to \code{meanlog} and standard deviation equal to \code{sdlog}. } \usage{ mlnorm(order, meanlog = 0, sdlog = 1) levlnorm(limit, meanlog = 0, sdlog = 1, order = 1) } \arguments{ \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} \item{meanlog, sdlog}{mean and standard deviation of the distribution on the log scale with default values of \code{0} and \code{1} respectively.} } \value{ \code{mlnorm} gives the \eqn{k}th raw moment and \code{levlnorm} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \seealso{ \code{\link{Lognormal}} for details on the lognormal distribution and functions \code{[dpqr]lnorm}. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ mlnorm(2, 3, 4) - mlnorm(1, 3, 4)^2 levlnorm(10, 3, 4, order = 2) } \keyword{distribution} actuar/man/NormalSupp.Rd0000644000176200001440000000250614264305077014706 0ustar liggesusers\name{NormalSupp} \alias{NormalSupp} \alias{mnorm} \alias{mgfnorm} \title{Moments and Moment generating function of the Normal Distribution} \description{ Raw moments and moment generating function for the normal distribution with mean equal to \code{mean} and standard deviation equal to \code{sd}. } \usage{ mnorm(order, mean = 0, sd = 1) mgfnorm(t, mean = 0, sd = 1, log = FALSE) } \arguments{ \item{order}{vector of integers; order of the moment.} \item{mean}{vector of means.} \item{sd}{vector of standard deviations.} \item{t}{numeric vector.} \item{log}{logical; if \code{TRUE}, the cumulant generating function is returned.} } \details{ The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]} and the moment generating function is \eqn{E[e^{tX}]}. Only integer moments are supported. } \value{ \code{mnorm} gives the \eqn{k}th raw moment and \code{mgfnorm} gives the moment generating function in \code{t}. Invalid arguments will result in return value \code{NaN}, with a warning. } \seealso{ \code{\link{Normal}} } \references{ Johnson, N. L. and Kotz, S. (1970), \emph{Continuous Univariate Distributions, Volume 1}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca}, Christophe Dutang } \examples{ mgfnorm(0:4,1,2) mnorm(3) } \keyword{distribution} actuar/man/InverseGaussian.Rd0000644000176200001440000001340414264305077015713 0ustar liggesusers\name{InverseGaussian} \alias{InverseGaussian} \alias{dinvgauss} \alias{pinvgauss} \alias{qinvgauss} \alias{rinvgauss} \alias{minvgauss} \alias{levinvgauss} \alias{mgfinvgauss} \title{The Inverse Gaussian Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments, limited moments and moment generating function for the Inverse Gaussian distribution with parameters \code{mean} and \code{shape}. } \usage{ dinvgauss(x, mean, shape = 1, dispersion = 1/shape, log = FALSE) pinvgauss(q, mean, shape = 1, dispersion = 1/shape, lower.tail = TRUE, log.p = FALSE) qinvgauss(p, mean, shape = 1, dispersion = 1/shape, lower.tail = TRUE, log.p = FALSE, tol = 1e-14, maxit = 100, echo = FALSE, trace = echo) rinvgauss(n, mean, shape = 1, dispersion = 1/shape) minvgauss(order, mean, shape = 1, dispersion = 1/shape) levinvgauss(limit, mean, shape = 1, dispersion = 1/shape, order = 1) mgfinvgauss(t, mean, shape = 1, dispersion = 1/shape, log = FALSE) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{mean, shape}{parameters. Must be strictly positive. Infinite values are supported.} \item{dispersion}{an alternative way to specify the shape.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment. Only \code{order = 1} is supported by \code{levinvgauss}.} \item{limit}{limit of the loss variable.} \item{tol}{small positive value. Tolerance to assess convergence in the Newton computation of quantiles.} \item{maxit}{positive integer; maximum number of recursions in the Newton computation of quantiles.} \item{echo, trace}{logical; echo the recursions to screen in the Newton computation of quantiles.} \item{t}{numeric vector.} } \details{ The inverse Gaussian distribution with parameters \code{mean} \eqn{= \mu} and \code{dispersion} \eqn{= \phi} has density: \deqn{f(x) = \left( \frac{1}{2 \pi \phi x^3} \right)^{1/2} \exp\left( -\frac{(x - \mu)^2}{2 \mu^2 \phi x} \right),}{% f(x) = sqrt(1/(2 \pi \phi x^3)) * exp(-((x - \mu)^2)/(2 \mu^2 \phi x)),} for \eqn{x \ge 0}, \eqn{\mu > 0} and \eqn{\phi > 0}. The limiting case \eqn{\mu = \infty}{\mu = Inf} is an inverse chi-squared distribution (or inverse gamma with \code{shape} \eqn{= 1/2} and \code{rate} \eqn{= 2}\code{phi}). This distribution has no finite strictly positive, integer moments. The limiting case \eqn{\phi = 0} is an infinite spike in \eqn{x = 0}. If the random variable \eqn{X} is IG\eqn{(\mu, \phi)}, then \eqn{X/\mu} is IG\eqn{(1, \phi \mu)}{(1, \phi * \mu)}. The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]}, \eqn{k = 1, 2, \dots}, the limited expected value at some limit \eqn{d} is \eqn{E[\min(X, d)]}{E[min(X, d)]} and the moment generating function is \eqn{E[e^{tX}]}. The moment generating function of the inverse guassian is defined for \code{t <= 1/(2 * mean^2 * phi)}. } \value{ \code{dinvgauss} gives the density, \code{pinvgauss} gives the distribution function, \code{qinvgauss} gives the quantile function, \code{rinvgauss} generates random deviates, \code{minvgauss} gives the \eqn{k}th raw moment, \code{levinvgauss} gives the limited expected value, and \code{mgfinvgauss} gives the moment generating function in \code{t}. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ Functions \code{dinvgauss}, \code{pinvgauss} and \code{qinvgauss} are C implementations of functions of the same name in package \pkg{statmod}; see Giner and Smyth (2016). Devroye (1986, chapter 4) provides a nice presentation of the algorithm to generate random variates from an inverse Gaussian distribution. The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Giner, G. and Smyth, G. K. (2016), \dQuote{\pkg{statmod}: Probability Calculations for the Inverse Gaussian Distribution}, \emph{R Journal}, vol. 8, no 1, p. 339-351. \url{https://journal.r-project.org/archive/2016-1/giner-smyth.pdf} Chhikara, R. S. and Folk, T. L. (1989), \emph{The Inverse Gaussian Distribution: Theory, Methodology and Applications}, Decker. Devroye, L. (1986), \emph{Non-Uniform Random Variate Generation}, Springer-Verlag. \url{http://luc.devroye.org/rnbookindex.html} } \seealso{ \code{\link{dinvgamma}} for the inverse gamma distribution. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ dinvgauss(c(-1, 0, 1, 2, Inf), mean = 1.5, dis = 0.7) dinvgauss(c(-1, 0, 1, 2, Inf), mean = Inf, dis = 0.7) dinvgauss(c(-1, 0, 1, 2, Inf), mean = 1.5, dis = Inf) # spike at zero ## Typical graphical representations of the inverse Gaussian ## distribution. First fixed mean and varying shape; second ## varying mean and fixed shape. col = c("red", "blue", "green", "cyan", "yellow", "black") par = c(0.125, 0.5, 1, 2, 8, 32) curve(dinvgauss(x, 1, par[1]), from = 0, to = 2, col = col[1]) for (i in 2:6) curve(dinvgauss(x, 1, par[i]), add = TRUE, col = col[i]) curve(dinvgauss(x, par[1], 1), from = 0, to = 2, col = col[1]) for (i in 2:6) curve(dinvgauss(x, par[i], 1), add = TRUE, col = col[i]) pinvgauss(qinvgauss((1:10)/10, 1.5, shape = 2), 1.5, 2) minvgauss(1:4, 1.5, 2) levinvgauss(c(0, 0.5, 1, 1.2, 10, Inf), 1.5, 2) } \keyword{distribution} actuar/man/Paralogistic.Rd0000644000176200001440000000711614264305077015231 0ustar liggesusers\name{Paralogistic} \alias{Paralogistic} \alias{dparalogis} \alias{pparalogis} \alias{qparalogis} \alias{rparalogis} \alias{mparalogis} \alias{levparalogis} \title{The Paralogistic Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments and limited moments for the Paralogistic distribution with parameters \code{shape} and \code{scale}. } \usage{ dparalogis(x, shape, rate = 1, scale = 1/rate, log = FALSE) pparalogis(q, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) qparalogis(p, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) rparalogis(n, shape, rate = 1, scale = 1/rate) mparalogis(order, shape, rate = 1, scale = 1/rate) levparalogis(limit, shape, rate = 1, scale = 1/rate, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{shape, scale}{parameters. Must be strictly positive.} \item{rate}{an alternative way to specify the scale.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The paralogistic distribution with parameters \code{shape} \eqn{= \alpha}{= a} and \code{scale} \eqn{= \theta}{= s} has density: \deqn{f(x) = \frac{\alpha^2 (x/\theta)^\alpha}{% x [1 + (x/\theta)^\alpha)^{\alpha + 1}}}{% f(x) = a^2 (x/s)^a / (x [1 + (x/s)^a]^(a + 1))} for \eqn{x > 0}, \eqn{\alpha > 0}{a > 0} and \eqn{\theta > 0}{b > 0}. The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]}, \eqn{-\alpha < k < \alpha^2}{-shape < k < shape^2}. The \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]}, \eqn{k > -\alpha}{k > -shape} and \eqn{\alpha - k/\alpha}{shape - k/shape} not a negative integer. } \value{ \code{dparalogis} gives the density, \code{pparalogis} gives the distribution function, \code{qparalogis} gives the quantile function, \code{rparalogis} generates random deviates, \code{mparalogis} gives the \eqn{k}th raw moment, and \code{levparalogis} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ \code{levparalogis} computes the limited expected value using \code{\link{betaint}}. See Kleiber and Kotz (2003) for alternative names and parametrizations. The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Kleiber, C. and Kotz, S. (2003), \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ exp(dparalogis(2, 3, 4, log = TRUE)) p <- (1:10)/10 pparalogis(qparalogis(p, 2, 3), 2, 3) ## variance mparalogis(2, 2, 3) - mparalogis(1, 2, 3)^2 ## case with shape - order/shape > 0 levparalogis(10, 2, 3, order = 2) ## case with shape - order/shape < 0 levparalogis(10, 1.25, 3, order = 2) } \keyword{distribution} actuar/man/InverseExponential.Rd0000644000176200001440000000545314264305077016434 0ustar liggesusers\name{InverseExponential} \alias{InverseExponential} \alias{dinvexp} \alias{pinvexp} \alias{qinvexp} \alias{rinvexp} \alias{minvexp} \alias{levinvexp} \title{The Inverse Exponential Distribution} \description{ Density function, distribution function, quantile function, random generation raw moments and limited moments for the Inverse Exponential distribution with parameter \code{scale}. } \usage{ dinvexp(x, rate = 1, scale = 1/rate, log = FALSE) pinvexp(q, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) qinvexp(p, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) rinvexp(n, rate = 1, scale = 1/rate) minvexp(order, rate = 1, scale = 1/rate) levinvexp(limit, rate = 1, scale = 1/rate, order) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{scale}{parameter. Must be strictly positive.} \item{rate}{an alternative way to specify the scale.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The inverse exponential distribution with parameter \code{scale} \eqn{= \theta}{= s} has density: \deqn{f(x) = \frac{\theta e^{-\theta/x}}{x^2}}{f(x) = s exp(-s/x)/x^2} for \eqn{x > 0} and \eqn{\theta > 0}{s > 0}. The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]}, \eqn{k < 1}, and the \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]}, all \eqn{k}. } \value{ \code{dinvexp} gives the density, \code{pinvexp} gives the distribution function, \code{qinvexp} gives the quantile function, \code{rinvexp} generates random deviates, \code{minvexp} gives the \eqn{k}th raw moment, and \code{levinvexp} calculates the \eqn{k}th limited moment. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ \code{levinvexp} computes the limited expected value using \code{gammainc} from package \pkg{expint}. The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ exp(dinvexp(2, 2, log = TRUE)) p <- (1:10)/10 pinvexp(qinvexp(p, 2), 2) minvexp(0.5, 2) } \keyword{distribution} actuar/man/ChisqSupp.Rd0000644000176200001440000000401514264305077014522 0ustar liggesusers\name{ChisqSupp} \alias{ChisqSupp} \alias{mchisq} \alias{levchisq} \alias{mgfchisq} \title{Moments and Moment Generating Function of the (non-central) Chi-Squared Distribution} \description{ Raw moments, limited moments and moment generating function for the chi-squared (\eqn{\chi^2}{chi^2}) distribution with \code{df} degrees of freedom and optional non-centrality parameter \code{ncp}. } \usage{ mchisq(order, df, ncp = 0) levchisq(limit, df, ncp = 0, order = 1) mgfchisq(t, df, ncp = 0, log= FALSE) } \arguments{ \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} \item{df}{degrees of freedom (non-negative, but can be non-integer).} \item{ncp}{non-centrality parameter (non-negative).} \item{t}{numeric vector.} \item{log}{logical; if \code{TRUE}, the cumulant generating function is returned.} } \details{ The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]}, the \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)]}{E[min(X, d)]} and the moment generating function is \eqn{E[e^{tX}]}. Only integer moments are supported for the non central Chi-square distribution (\code{ncp > 0}). The limited expected value is supported for the centered Chi-square distribution (\code{ncp = 0}). } \value{ \code{mchisq} gives the \eqn{k}th raw moment, \code{levchisq} gives the \eqn{k}th moment of the limited loss variable, and \code{mgfchisq} gives the moment generating function in \code{t}. Invalid arguments will result in return value \code{NaN}, with a warning. } \seealso{ \code{\link[stats]{Chisquare}} } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. Johnson, N. L. and Kotz, S. (1970), \emph{Continuous Univariate Distributions, Volume 1}, Wiley. } \author{ Christophe Dutang, Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ mchisq(2, 3, 4) levchisq(10, 3, order = 2) mgfchisq(0.25, 3, 2) } \keyword{distribution} actuar/man/InverseWeibull.Rd0000644000176200001440000000713314264305077015546 0ustar liggesusers\name{InverseWeibull} \alias{InverseWeibull} \alias{dinvweibull} \alias{pinvweibull} \alias{qinvweibull} \alias{rinvweibull} \alias{minvweibull} \alias{levinvweibull} \alias{dlgompertz} \alias{plgompertz} \alias{qlgompertz} \alias{rlgompertz} \alias{mlgompertz} \alias{levlgompertz} \title{The Inverse Weibull Distribution} \description{ Density function, distribution function, quantile function, random generation, raw moments and limited moments for the Inverse Weibull distribution with parameters \code{shape} and \code{scale}. } \usage{ dinvweibull(x, shape, rate = 1, scale = 1/rate, log = FALSE) pinvweibull(q, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) qinvweibull(p, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) rinvweibull(n, shape, rate = 1, scale = 1/rate) minvweibull(order, shape, rate = 1, scale = 1/rate) levinvweibull(limit, shape, rate = 1, scale = 1/rate, order = 1) } \arguments{ \item{x, q}{vector of quantiles.} \item{p}{vector of probabilities.} \item{n}{number of observations. If \code{length(n) > 1}, the length is taken to be the number required.} \item{shape, scale}{parameters. Must be strictly positive.} \item{rate}{an alternative way to specify the scale.} \item{log, log.p}{logical; if \code{TRUE}, probabilities/densities \eqn{p} are returned as \eqn{\log(p)}{log(p)}.} \item{lower.tail}{logical; if \code{TRUE} (default), probabilities are \eqn{P[X \le x]}{P[X <= x]}, otherwise, \eqn{P[X > x]}.} \item{order}{order of the moment.} \item{limit}{limit of the loss variable.} } \details{ The inverse Weibull distribution with parameters \code{shape} \eqn{= \tau}{= a} and \code{scale} \eqn{= \theta}{= s} has density: \deqn{f(x) = \frac{\tau (\theta/x)^\tau e^{-(\theta/x)^\tau}}{x}}{% f(x) = a (s/x)^a exp(-(s/x)^a)/x} for \eqn{x > 0}, \eqn{\tau > 0}{a > 0} and \eqn{\theta > 0}{s > 0}. The special case \code{shape == 1} is an \link[=dinvexp]{Inverse Exponential} distribution. The \eqn{k}th raw moment of the random variable \eqn{X} is \eqn{E[X^k]}{E[X^k]}, \eqn{k < \tau}{k < shape}, and the \eqn{k}th limited moment at some limit \eqn{d} is \eqn{E[\min(X, d)^k]}{E[min(X, d)^k]}, all \eqn{k}. } \value{ \code{dinvweibull} gives the density, \code{pinvweibull} gives the distribution function, \code{qinvweibull} gives the quantile function, \code{rinvweibull} generates random deviates, \code{minvweibull} gives the \eqn{k}th raw moment, and \code{levinvweibull} gives the \eqn{k}th moment of the limited loss variable. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ \code{levinvweibull} computes the limited expected value using \code{gammainc} from package \pkg{expint}. Distribution also knonw as the log-Gompertz. See also Kleiber and Kotz (2003) for alternative names and parametrizations. The \code{"distributions"} package vignette provides the interrelations between the continuous size distributions in \pkg{actuar} and the complete formulas underlying the above functions. } \references{ Kleiber, C. and Kotz, S. (2003), \emph{Statistical Size Distributions in Economics and Actuarial Sciences}, Wiley. Klugman, S. A., Panjer, H. H. and Willmot, G. E. (2012), \emph{Loss Models, From Data to Decisions, Fourth Edition}, Wiley. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Mathieu Pigeon } \examples{ exp(dinvweibull(2, 3, 4, log = TRUE)) p <- (1:10)/10 pinvweibull(qinvweibull(p, 2, 3), 2, 3) mlgompertz(-1, 3, 3) levinvweibull(10, 2, 3, order = 1) } \keyword{distribution} actuar/man/quantile.aggregateDist.Rd0000644000176200001440000000313614264305077017201 0ustar liggesusers\name{quantile.aggregateDist} \alias{quantile.aggregateDist} \alias{VaR.aggregateDist} \title{Quantiles of Aggregate Claim Amount Distribution} \description{ Quantile and Value-at-Risk methods for objects of class \code{"aggregateDist"}. } \usage{ \method{quantile}{aggregateDist}(x, probs = c(0.25, 0.5, 0.75, 0.9, 0.95, 0.975, 0.99, 0.995), smooth = FALSE, names = TRUE, \dots) \method{VaR}{aggregateDist}(x, conf.level = c(0.9, 0.95, 0.99), smooth = FALSE, names = TRUE, \dots) } \arguments{ \item{x}{an object of class \code{"aggregateDist"}.} \item{probs, conf.level}{numeric vector of probabilities with values in \eqn{[0, 1)}.} \item{smooth}{logical; when \code{TRUE} and \code{x} is a step function, quantiles are linearly interpolated between knots.} \item{names}{logical; if true, the result has a \code{names} attribute. Set to \code{FALSE} for speedup with many \code{probs}.} \item{\dots}{further arguments passed to or from other methods.} } \details{ The quantiles are taken directly from the cumulative distribution function defined in \code{x}. Linear interpolation is available for step functions. } \value{ A numeric vector, named if \code{names} is \code{TRUE}. } \seealso{ \code{\link{aggregateDist}} } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} and Louis-Philippe Pouliot } \examples{ model.freq <- expression(data = rpois(3)) model.sev <- expression(data = rlnorm(10, 1.5)) Fs <- aggregateDist("simulation", model.freq, model.sev, nb.simul = 1000) quantile(Fs, probs = c(0.25, 0.5, 0.75)) VaR(Fs) } \keyword{univar} actuar/man/var-methods.Rd0000644000176200001440000000611414264305077015036 0ustar liggesusers\name{var} \alias{var} \alias{var.default} \alias{var.grouped.data} \alias{sd} \alias{sd.default} \alias{sd.grouped.data} \title{Variance and Standard Deviation} \description{ Generic functions for the variance and standard deviation, and methods for individual and grouped data. The default methods for individual data are the functions from the \pkg{stats} package. } \usage{ var(x, \dots) \method{var}{default}(x, y = NULL, na.rm = FALSE, use, \dots) \method{var}{grouped.data}(x, \dots) sd(x, \dots) \method{sd}{default}(x, na.rm = FALSE, \dots) \method{sd}{grouped.data}(x, \dots) } \arguments{ \item{x}{a vector or matrix of individual data, or an object of class \code{"grouped data"}.} \item{y}{see \code{\link[stats:var]{stats::var}}.} \item{na.rm}{see \code{\link[stats:var]{stats::var}}.} \item{use}{see \code{\link[stats:var]{stats::var}}.} \item{\dots}{further arguments passed to or from other methods.} } \details{ This page documents variance and standard deviation computations for grouped data. For individual data, see \code{\link[stats]{var}} and \code{\link[stats]{sd}} from the \pkg{stats} package. For grouped data with group boundaries \eqn{c_0, c_1, \dots, c_r}{c[0], c[1], \dots, c[r]} and group frequencies \eqn{n_1, \dots, n_r}{n[1], \dots, n[r]}, \code{var} computes the sample variance \deqn{\frac{1}{n - 1} \sum_{j = 1}^r n_j (a_j - m_1)^2,}{% (1/(n - 1)) * sum(j; n[j] * (a[j] - m)^2,} where \eqn{a_j = (c_{j - 1} + c_j)/2}{a[j] = (c[j - 1] + c[j])/2} is the midpoint of the \eqn{j}th interval, \eqn{m_1}{m} is the sample mean (or sample first moment) of the data, and \eqn{n = \sum_{j = 1}^r n_j}{n = sum(j; n[j])}. The sample sample standard deviation is the square root of the sample variance. The sample variance for grouped data differs from the variance computed from the empirical raw moments with \code{\link{emm}} in two aspects. First, it takes into account the degrees of freedom. Second, it applies Sheppard's correction factor to compensate for the overestimation of the true variation in the data. For groups of equal width \eqn{k}, Sheppard's correction factor is equal to \eqn{-k^2/12}. } \value{ A named vector of variances or standard deviations. } \seealso{ \code{\link{grouped.data}} to create grouped data objects; \code{\link{mean.grouped.data}} for the mean and \code{\link{emm}} for higher moments. } \references{ Klugman, S. A., Panjer, H. H. and Willmot, G. E. (1998), \emph{Loss Models, From Data to Decisions}, Wiley. Heumann, C., Schomaker, M., Shalabh (2016), \emph{Introduction to Statistics and Data Analysis}, Springer. } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca}. Variance and standard deviation methods for grouped data contributed by Walter Garcia-Fontes \email{walter.garcia@upf.edu}. } \examples{ data(gdental) var(gdental) sd(gdental) ## Illustration of Sheppard's correction factor cj <- c(0, 2, 4, 6, 8) nj <- c(1, 5, 3, 2) gd <- grouped.data(Group = cj, Frequency = nj) (sum(nj) - 1)/sum(nj) * var(gd) (emm(gd, 2) - emm(gd)^2) - 4/12 } \keyword{univar} actuar/DESCRIPTION0000644000176200001440000000610114522612722013240 0ustar liggesusersPackage: actuar Type: Package Title: Actuarial Functions and Heavy Tailed Distributions Version: 3.3-4 Date: 2023-11-07 Authors@R: c(person("Vincent", "Goulet", role = c("cre", "aut"), email = "vincent.goulet@act.ulaval.ca"), person("Sébastien", "Auclair", role = "ctb"), person("Christophe", "Dutang", role = "aut", email = "dutang@ceremade.dauphine.fr"), person("Walter", "Garcia-Fontes", role = "ctb", email = "walter.garcia@upf.edu"), person("Nicholas", "Langevin", role = "ctb"), person("Xavier", "Milhaud", role = "ctb"), person("Tommy", "Ouellet", role = "ctb"), person("Alexandre", "Parent", role = "ctb"), person("Mathieu", "Pigeon", role = "aut", email = "pigeon.mathieu.2@uqam.ca"), person("Louis-Philippe", "Pouliot", role = "ctb"), person("Jeffrey A.", "Ryan", role = "aut", email = "jeff.a.ryan@gmail.com", comment = "Package API"), person("Robert", "Gentleman", role = "aut", comment = "Parts of the R to C interface"), person("Ross", "Ihaka", role = "aut", comment = "Parts of the R to C interface"), person(family = "R Core Team", role = "aut", comment = "Parts of the R to C interface"), person(family = "R Foundation", role = "aut", comment = "Parts of the R to C interface")) Description: Functions and data sets for actuarial science: modeling of loss distributions; risk theory and ruin theory; simulation of compound models, discrete mixtures and compound hierarchical models; credibility theory. Support for many additional probability distributions to model insurance loss size and frequency: 23 continuous heavy tailed distributions; the Poisson-inverse Gaussian discrete distribution; zero-truncated and zero-modified extensions of the standard discrete distributions. Support for phase-type distributions commonly used to compute ruin probabilities. Main reference: . Implementation of the Feller-Pareto family of distributions: . Depends: R (>= 4.1.0) Imports: stats, graphics, expint LinkingTo: expint Suggests: MASS License: GPL (>= 2) URL: https://gitlab.com/vigou3/actuar BugReports: https://gitlab.com/vigou3/actuar/-/issues Encoding: UTF-8 LazyData: yes Classification/MSC-2010: 62P05, 91B30, 62G32 NeedsCompilation: yes Packaged: 2023-11-08 01:10:54 UTC; vincent Author: Vincent Goulet [cre, aut], Sébastien Auclair [ctb], Christophe Dutang [aut], Walter Garcia-Fontes [ctb], Nicholas Langevin [ctb], Xavier Milhaud [ctb], Tommy Ouellet [ctb], Alexandre Parent [ctb], Mathieu Pigeon [aut], Louis-Philippe Pouliot [ctb], Jeffrey A. Ryan [aut] (Package API), Robert Gentleman [aut] (Parts of the R to C interface), Ross Ihaka [aut] (Parts of the R to C interface), R Core Team [aut] (Parts of the R to C interface), R Foundation [aut] (Parts of the R to C interface) Maintainer: Vincent Goulet Repository: CRAN Date/Publication: 2023-11-08 05:00:02 UTC actuar/build/0000755000176200001440000000000014522560035012632 5ustar liggesusersactuar/build/vignette.rds0000644000176200001440000000063314522560035015173 0ustar liggesusersRKO1.<#0^@L zZ]l\Z҇dom/,۲-Ƌ:|ә& BM$`[ltX3vA*ߙ" `GbyM'k.k,%e9)PIEc^w(ImZƱW\0IUVjFy:cʤ*\R^V'9$ ÅVc"(``.qqݗ,q˧Xf m)"~,ƢrXS1YK!H0D{t*mx2m[W'M0 ǭ-Ȓi80\z޺gOם˩wϊTǍJǾNfg=#J53}}D actuar/build/partial.rdb0000644000176200001440000001567514522557737015014 0ustar liggesusers]VȖ6p IHȅӁn@Hs!\:CW#,(,$Y=<9?fy!f'Sd+ʷekU$~KRNmTL2vU6*r\TSv3Y-I̛ji;GRK/;UJ*4Wcz1+ף󆢕> we]|Y!/zm} h>Xc|I3{nn)o{uj |ȶ9L()iee f{? o 2_xcZ )L+梞]1ݫj%%?[78L>>L= ϲwϦ\3mrƫ?}9ބ?QTWέmO{RV㪭#c[_?톘1!f7vl#z/CTEZ&[!zۀ\ݴ:4 8 a <\ Bҁ0@h}HH}C $(!O,&=9VND GĨol}QW_Mժl끩Lq>pF| d---L{mkvIXͭzvke52.3oWCr4|`.YM.Ir֌%eEzҮKEZ,ǂ$orތGz,Po5|V9d㾖(99Lt'+G8đ鮨V*HOpxK\xvd[ܙ“"۲d% Sk-kl~. ω(~6p$醢\C2 Rɰ,Idj[W q̬je|:x,IWK2YLn bTo$ľo'^SITS6Zŵ}Yb_Q=هiiZP͙X`E#p$ULcOuluNVՔYkpgi²$L*kK]FFՒv2_{a1:KҶYQlJJOeirA/K1e#cibUrMc L}oeak%6T]O#,&|ۭ˖:eDXפҡTP_UeNQ{:\y7qM- p7-L.޿ycY3s$l+%UWvm 6mjNmˌIT`.Jd jzv.O`/6wvCNK})|hwgy9*hNǗ∘58$hG[JZk>bw$lՙ-hRūCP[Kg"!#{6 ˶0t*S.sC~~lUu(8 8b1$Q2f9вU]xCHOpm,T{#~,UbVer`Aʳd}}Ra͗("D}rodg}r4..WEv;9~Dr~łiSVwMl1UWAx&SYewIQ,ҟߞV=5 QWP v]WȢZVM⳧r? &|al6]Zx譔hՊxfG&=#] _uAC+, FcoxAaxҖ'5;qb\hPMsMDx% f *[t)%*TP˲="T)/WTʢWba;arCh{$veyb:|f g{VE#ȏZ1"cȏcǰ+4LXC?s;I.0TR,Zc!ȑOEYB W GVCfIȸ7=q#-}кy_ $n#h.'Z[Bms喼 %Y%Y79 9|X <,IswّrhEَ-D0eGAyS'ohLN;%Nr9h-.l~( ʗУFQw> ɭl9CY{;}<ъqw=ᗐbz HkoB.DnBca!vRO`%]nB٩Ix )ypy#vHqI h]6#ܻ9qh/'л.`޽ǟ=6< tt0BMށ|'^=]vzA Lb-+g#Dq ܽ(4۪D4 \gf;}}~IlTvlSMoY@w DYM|ZA{$|JjJ5"4|hm+q4a_AtL ǀ!GZ1XQd3 L5 PGJd_GL3iO= rUw;:hu(H}'8Gfo7.\_!G@`>&ldM =VV%iu,ۨnjiMQ-%,JZQ`<:mud !%\欌LOJMBĄ["N&du}] MxIe[aɞE&a!awJfBIVw`3Pa2<:j. ᪚]ERjfHwJv 2#q͹r'GZj#dmTaIA 20zǴzZKJYJۘpP_uKӎ$`'!7<ӽS131ַFդG=ظcw)zo 9ҺSȨqh ? ߰6w/=9s c()!jޅ|7v8&&٩ ,>V57Ov+ۡ>{Zd7/ 磻-ބ,|hإ3H 21 Vh9#vwK̍L%v% jh [|$0RI,eIz@K}kss0+4:++mQRhr/Մc&3¹Ts2DNM,yے,)Y]jQY3-|r[.QI4GT n>֝svnBG0ˀZO>n䳞3[تyYͳY5gwҺaOzː#UX&D:\V3~D/PY>F$\@gskJxJX=lEgqytoLG 4 5Hb$1 %I 89ҞP1I=DKRIJΧ $ȑ_#S*HOF%'0 9rM$w? GCP@Gː{Ic(5C#5ĸ$!57AͦR3m4fM9 ^@N2&xIx r/G 8 y8-xmS9ڻMcRȼ4۩$LPv~ FCqE`'p xry8;g7Cx?^G$<c#U1>= oC|>= ElӒNy9s'鋦r/iz[,MG!G,%&InPƾK ?}\ɀ;=[ VSzt $ gћpyļv~8ĻFa2h^p]FKHA ݄k{6`auvj߃7]FQ;q~2^ik1b~2^Ra1 /CTxr݌ʼnM%f K/@|ZfAEAȃͧeT$9"$!'Zv+𑰅7, aA|9A4ጷa2_fbf_9݄k}7F6h+ L~MzÐߠI] I|!ׁ7 5ʟȟsгLLCNr+??#BQ#$FПAJ›#x+ԳY햕76. 9{B H89,W '%LM8 96E, Ll]Wp k'20u $=*zL>&׵RNW,5SWgOU ת]iyߦI]/$עB4BԃkHE% -¬| &n*+,IW-&$l5$aą8qMTNn)1| 8 yy 64NC @oN}/>wAKp[MhE9g5eF@/{row1R6ȑRxQ r#hZVD8/CNnc)"CO`JKp#Мq߃%h>AnIPw"xA!8đTPe@hhvA#%T{6u N"Tn˦o\+az|tV.5U6ʥ#5m=r]^˾,Μ-*g%kdS=_Y, Yx=]Y_6- 3@kxWodOst7}=TqzϦNT{GeN z> em#ZX*ew.dxw m)Zjyݡ{ŃzwRV.; t2f>p*޺03+j^y45~j%zPj33YWD e?O/'*%WV(+uh cqF| >YgԲR5t'Hv%ٲCUfjPz w?aJ̽8gfq3D\;/L;pD~ȩg"]+c/5l?iLVFFV7q;7n:ȭy39~EjX}1~xa{)ܶ=?{mz߽rg>> mϔ̆Zt%UݎXfJƝTfC dԹLxaJ˹22 WJE/1y}n&ksQϮ:f,~=ϸ 0Mfd60nI0! yWsjtGo#g@oyD|j?>Bs{MNB>(dg9&V,ypW+9$<,|ط튵йS߰lq0th2*܂,j2Խc'3g5hB;]L"@g>݀mXδW?,rIc\uJXvCf7w7_~L]DȘ8cu@1>adIT#*p' ޏcBCC( ߳e>8va<WL𜐻$7jQMfݼ?f3l>R8&%GQT+lBQp&R7n.4Oiactuar/tests/0000755000176200001440000000000014522560035012675 5ustar liggesusersactuar/tests/dpqr-tests.R0000644000176200001440000026660514264305077015153 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Tests of functions for continuous and discrete probability ### distributions. ### ### Despite the name of the file, the tests are for [dpqrm,lev] ### functions (for continuous distributions): ### ### d: density or probability mass ### p: cumulative distribution ### q: quantile ### r: random number generation ### m: moment ### lev: limited moment ### ### Distributions are classified and sorted as in appendix A and ### appendix B of the 'distributions' package vignette. ### ### Inspired by (and some parts taken from) `tests/d-p-q-r-tests.R` in ### R sources. ### ### AUTHOR: Vincent Goulet with ### indirect help from the R Core Team ## Load the package library(actuar) library(expint) # for gammainc ## Define a "local" version of the otherwise non-exported function ## 'betaint'. betaint <- actuar:::betaint ## No warnings, unless explicitly asserted via tools::assertWarning. options(warn = 2) assertWarning <- tools::assertWarning ## Special values and utilities. Taken from `tests/d-p-q-r-tests.R`. Meps <- .Machine$double.eps xMax <- .Machine$double.xmax xMin <- .Machine$double.xmin All.eq <- function(x, y) { all.equal.numeric(x, y, tolerance = 64 * .Machine$double.eps, scale = max(0, mean(abs(x), na.rm = TRUE))) } if(!interactive()) set.seed(123) ### ### CONTINUOUS DISTRIBUTIONS ### ## ## FELLER-PARETO AND PARETO II, III, IV DISTRIBUTIONS ## ## When reasonable, we also test consistency with the special cases ## min = 0: ## ## Feller-Pareto -> Transformated beta ## Pareto IV -> Burr ## Pareto III -> Loglogistic ## Pareto II -> Pareto ## Density: first check that functions return 0 when scale = Inf, and ## when x = scale = Inf. stopifnot(exprs = { dfpareto(c(42, Inf), min = 1, shape1 = 2, shape2 = 3, shape3 = 4, scale = Inf) == c(0, 0) dpareto4(c(42, Inf), min = 1, shape1 = 2, shape2 = 3, scale = Inf) == c(0, 0) dpareto3(c(42, Inf), min = 1, shape = 3, scale = Inf) == c(0, 0) dpareto2(c(42, Inf), min = 1, shape = 2, scale = Inf) == c(0, 0) }) ## Next test density functions for an array of standard values. nshpar <- 3 # (maximum) number of shape parameters min <- round(rnorm(30, 2), 2) shpar <- replicate(30, rlnorm(nshpar, 2), simplify = FALSE) scpar <- rlnorm(30, 2) # scale parameters for (i in seq_along(min)) { m <- min[i] a <- shpar[[c(i, 1)]]; g <- shpar[[c(i, 2)]]; t <- shpar[[c(i, 3)]] Be <- beta(a, t) for (s in scpar) { x <- rfpareto(100, min = m, shape1 = a, shape2 = g, shape3 = t, scale = s) y <- (x - m)/s u <- 1/(1 + y^(-g)) stopifnot(exprs = { all.equal(d1 <- dfpareto(x, min = m, shape1 = a, shape2 = g, shape3 = t, scale = s), d2 <- dfpareto(y, min = 0, shape1 = a, shape2 = g, shape3 = t, scale = 1)/s, tolerance = 1e-10) all.equal(d2, dtrbeta(y, shape1 = a, shape2 = g, shape3 = t, scale = 1)/s, tolerance = 1e-10) all.equal(d1, g * y^(g*t - 1)/(s * Be * (1 + y^g)^(a + t)), tolerance = 1e-10) all.equal(d1, g * u^t * (1 - u)^a/((x - m) * Be), tolerance = 1e-10) }) x <- rpareto4(100, min = m, shape1 = a, shape2 = g, scale = s) y <- (x - m)/s u <- 1/(1 + y^g) stopifnot(exprs = { all.equal(d1 <- dpareto4(x, min = m, shape1 = a, shape2 = g, scale = s), d2 <- dpareto4(y, min = 0, shape1 = a, shape2 = g, scale = 1)/s, tolerance = 1e-10) all.equal(d2, dburr(y, shape1 = a, shape2 = g, scale = 1)/s, tolerance = 1e-10) all.equal(d1, a * g * y^(g - 1)/(s * (1 + y^g)^(a + 1)), tolerance = 1e-10) all.equal(d1, a * g * u^a * (1 - u)/(x - m), tolerance = 1e-10) }) x <- rpareto3(100, min = m, shape = g, scale = s) y <- (x - m)/s u <- 1/(1 + y^(-g)) stopifnot(exprs = { all.equal(d1 <- dpareto3(x, min = m, shape = g, scale = s), d2 <- dpareto3(y, min = 0, shape = g, scale = 1)/s, tolerance = 1e-10) all.equal(d2, dllogis(y, shape = g, scale = 1)/s, tolerance = 1e-10) all.equal(d1, g * y^(g - 1)/(s * (1 + y^g)^2), tolerance = 1e-10) all.equal(d1, g * u * (1 - u)/(x - m), tolerance = 1e-10) }) x <- rpareto2(100, min = m, shape = a, scale = s) y <- (x - m)/s u <- 1/(1 + y) stopifnot(exprs = { all.equal(d1 <- dpareto2(x, min = m, shape = a, scale = s), d2 <- dpareto2(y, min = 0, shape = a, scale = 1)/s, tolerance = 1e-10) all.equal(d2, dpareto(y, shape = a, scale = 1)/s, tolerance = 1e-10) all.equal(d1, a/(s * (1 + y)^(a + 1)), tolerance = 1e-10) all.equal(d1, a * u^a * (1 - u)/(x - m), tolerance = 1e-10) }) } } ## Tests on the cumulative distribution function. ## ## Note: when shape1 = shape3 = 1, the underlying beta distribution is ## a uniform. Therefore, pfpareto(x, min, 1, shape2, 1, scale) should ## return the value of u = v/(1 + v), v = ((x - min)/scale)^shape2. ## ## x = 2/Meps = 2^53 (with min = 0, shape2 = scale = 1) is the value ## where the cdf would jump to 1 if we weren't using the trick to ## compute the cdf with pbeta(1 - u, ..., lower = FALSE). scLrg <- 1e300 * c(0.5, 1, 2) m <- rnorm(1) stopifnot(exprs = { pfpareto(Inf, min = 10, 1, 2, 3, scale = xMax) == 1 pfpareto(2^53, min = 0, 1, 1, 1, scale = 1) != 1 pfpareto(2^53 + xMax, min = xMax, 1, 1, 1, scale = 1) != 1 all.equal(pfpareto(xMin + m, min = m, 1, 1, 1, scale = 1), xMin) all.equal(y <- pfpareto(1e300 + m, min = m, shape1 = 3, shape2 = rep(c(1, 2), each = length(scLrg)), shape3 = 1, scale = scLrg, log = TRUE), ptrbeta(1e300, shape1 = 3, shape2 = rep(c(1, 2), each = length(scLrg)), shape3 = 1, scale = scLrg, log = TRUE)) all.equal(y, c(pbeta(c(2/3, 1/2), 1, 3, lower.tail = TRUE, log = TRUE), pbeta(2/3, 3, 1, lower.tail = FALSE, log = TRUE), pbeta(c(4/5, 1/2), 1, 3, lower.tail = TRUE, log = TRUE), pbeta(4/5, 3, 1, lower.tail = FALSE, log = TRUE))) }) stopifnot(exprs = { ppareto4(Inf, min = 10, 1, 3, scale = xMax) == 1 ppareto4(2^53, min = 0, 1, 1, scale = 1) != 1 ppareto4(2^53 + xMax, min = xMax, 1, 1, scale = 1) != 1 all.equal(ppareto4(xMin + m, min = m, 1, 1, scale = 1), xMin) all.equal(y <- ppareto4(1e300 + m, min = m, shape1 = 3, shape2 = rep(c(1, 2), each = length(scLrg)), scale = scLrg, log = TRUE), pburr(1e300, shape1 = 3, shape2 = rep(c(1, 2), each = length(scLrg)), scale = scLrg, log = TRUE)) all.equal(y, c(log(1 - c(1/3, 1/2, 2/3)^3), log(1 - c(1/5, 1/2, 4/5)^3))) }) stopifnot(exprs = { ppareto3(Inf, min = 10, 3, scale = xMax) == 1 ppareto3(2^53, min = 0, 1, scale = 1) != 1 ppareto3(2^53 + xMax, min = xMax, 1, scale = 1) != 1 all.equal(ppareto3(xMin + m, min = m, 1, scale = 1), xMin) all.equal(y <- ppareto3(1e300 + m, min = m, shape = rep(c(1, 2), each = length(scLrg)), scale = scLrg, log = TRUE), pllogis (1e300, shape = rep(c(1, 2), each = length(scLrg)), scale = scLrg, log = TRUE)) all.equal(y, c(log(c(2/3, 1/2, 1/3)), log(c(4/5, 1/2, 1/5)))) }) stopifnot(exprs = { ppareto2(Inf, min = 10, 3, scale = xMax) == 1 ppareto2(2^53, min = 0, 1, scale = 1) != 1 ppareto2(2^53 + xMax, min = xMax, 1, scale = 1) != 1 all.equal(ppareto2(xMin + m, min = m, 1, scale = 1), xMin) all.equal(y <- ppareto2(1e300 + m, min = m, shape = 3, scale = scLrg, log = TRUE), ppareto (1e300, shape = 3, scale = scLrg, log = TRUE)) all.equal(y, c(log(1 - c(1/3, 1/2, 2/3)^3))) }) ## Also check that distribution functions return 0 when scale = Inf. stopifnot(exprs = { pfpareto(x, min = m, shape1 = a, shape2 = g, shape3 = t, scale = Inf) == 0 ppareto4(x, min = m, shape1 = a, shape2 = g, scale = Inf) == 0 ppareto3(x, min = m, shape = g, scale = Inf) == 0 ppareto2(x, min = m, shape = a, scale = Inf) == 0 }) ## Tests for first three (positive) moments ## ## Simulation of new parameters ensuring that the first three moments ## exist. set.seed(123) # reset the seed nshpar <- 3 # (maximum) number of shape parameters min <- round(rnorm(30, 2), 2) shpar <- replicate(30, c(3, 3, 0) + rlnorm(nshpar, 2), simplify = FALSE) scpar <- rlnorm(30, 2) # scale parameters for (i in seq_along(min)) { m <- min[i] a <- shpar[[c(i, 1)]]; g <- shpar[[c(i, 2)]]; t <- shpar[[c(i, 3)]] Be <- beta(a, t) Ga <- gamma(a) for (s in scpar) { stopifnot(exprs = { All.eq(mfpareto(1, min = m, shape1 = a, shape2 = g, shape3 = t, scale = s), m * (Be + (s/m) * beta(t + 1/g, a - 1/g))/Be) All.eq(mfpareto(2, min = m, shape1 = a, shape2 = g, shape3 = t, scale = s), m^2 * (Be + 2 * (s/m) * beta(t + 1/g, a - 1/g) + (s/m)^2 * beta(t + 2/g, a - 2/g))/Be) All.eq(mfpareto(3, min = m, shape1 = a, shape2 = g, shape3 = t, scale = s), m^3 * (Be + 3 * (s/m) * beta(t + 1/g, a - 1/g) + 3 * (s/m)^2 * beta(t + 2/g, a - 2/g) + (s/m)^3 * beta(t + 3/g, a - 3/g))/Be) }) stopifnot(exprs = { All.eq(mpareto4(1, min = m, shape1 = a, shape2 = g, scale = s), m * (Ga + (s/m) * gamma(1 + 1/g) * gamma(a - 1/g))/Ga) All.eq(mpareto4(2, min = m, shape1 = a, shape2 = g, scale = s), m^2 * (Ga + 2 * (s/m) * gamma(1 + 1/g) * gamma(a - 1/g) + (s/m)^2 * gamma(1 + 2/g) * gamma(a - 2/g))/Ga) All.eq(mpareto4(3, min = m, shape1 = a, shape2 = g, scale = s), m^3 * (Ga + 3 * (s/m) * gamma(1 + 1/g) * gamma(a - 1/g) + 3 * (s/m)^2 * gamma(1 + 2/g) * gamma(a - 2/g) + (s/m)^3 * gamma(1 + 3/g) * gamma(a - 3/g))/Ga) }) stopifnot(exprs = { All.eq(mpareto3(1, min = m, shape = g, scale = s), m * (1 + (s/m) * gamma(1 + 1/g) * gamma(1 - 1/g))) All.eq(mpareto3(2, min = m, shape = g, scale = s), m^2 * (1 + 2 * (s/m) * gamma(1 + 1/g) * gamma(1 - 1/g) + (s/m)^2 * gamma(1 + 2/g) * gamma(1 - 2/g))) All.eq(mpareto3(3, min = m, shape = g, scale = s), m^3 * (1 + 3 * (s/m) * gamma(1 + 1/g) * gamma(1 - 1/g) + 3 * (s/m)^2 * gamma(1 + 2/g) * gamma(1 - 2/g) + (s/m)^3 * gamma(1 + 3/g) * gamma(1 - 3/g))) }) stopifnot(exprs = { All.eq(mpareto2(1, min = m, shape = a, scale = s), m * (Ga + (s/m) * gamma(1 + 1) * gamma(a - 1))/Ga) All.eq(mpareto2(2, min = m, shape = a, scale = s), m^2 * (Ga + 2 * (s/m) * gamma(1 + 1) * gamma(a - 1) + (s/m)^2 * gamma(1 + 2) * gamma(a - 2))/Ga) All.eq(mpareto2(3, min = m, shape = a, scale = s), m^3 * (Ga + 3 * (s/m) * gamma(1 + 1) * gamma(a - 1) + 3 * (s/m)^2 * gamma(1 + 2) * gamma(a - 2) + (s/m)^3 * gamma(1 + 3) * gamma(a - 3))/Ga) }) } } ## Tests for first three limited moments ## ## Limits are taken from quantiles of each distribution. q <- c(0.25, 0.50, 0.75, 0.9, 0.95) for (i in seq_along(min)) { m <- min[i] a <- shpar[[c(i, 1)]]; g <- shpar[[c(i, 2)]]; t <- shpar[[c(i, 3)]] Ga <- gamma(a) Gt <- gamma(t) for (s in scpar) { limit <- qfpareto(q, min = m, shape1 = a, shape2 = g, shape3 = t, scale = s) y <- (limit - m)/s u <- 1/(1 + y^(-g)) stopifnot(exprs = { All.eq(levfpareto(limit, order = 1, min = m, shape1 = a, shape2 = g, shape3 = t, scale = s), m * (betaint(u, t, a) + (s/m) * betaint(u, t + 1/g, a - 1/g))/(Ga * Gt) + limit * pbeta(u, t, a, lower = FALSE)) All.eq(levfpareto(limit, order = 2, min = m, shape1 = a, shape2 = g, shape3 = t, scale = s), m^2 * (betaint(u, t, a) + 2 * (s/m) * betaint(u, t + 1/g, a - 1/g) + (s/m)^2 * betaint(u, t + 2/g, a - 2/g))/(Ga * Gt) + limit^2 * pbeta(u, t, a, lower = FALSE)) All.eq(levfpareto(limit, order = 3, min = m, shape1 = a, shape2 = g, shape3 = t, scale = s), m^3 * (betaint(u, t, a) + 3 * (s/m) * betaint(u, t + 1/g, a - 1/g) + 3 * (s/m)^2 * betaint(u, t + 2/g, a - 2/g) + (s/m)^3 * betaint(u, t + 3/g, a - 3/g))/(Ga * Gt) + limit^3 * pbeta(u, t, a, lower = FALSE)) }) limit <- qpareto4(q, min = m, shape1 = a, shape2 = g, scale = s) y <- (limit - m)/s u <- 1/(1 + y^g) u1m <- 1/(1 + y^(-g)) stopifnot(exprs = { All.eq(levpareto4(limit, order = 1, min = m, shape1 = a, shape2 = g, scale = s), m * (betaint(u1m, 1, a) + (s/m) * betaint(u1m, 1 + 1/g, a - 1/g))/Ga + limit * u^a) All.eq(levpareto4(limit, order = 2, min = m, shape1 = a, shape2 = g, scale = s), m^2 * (betaint(u1m, 1, a) + 2 * (s/m) * betaint(u1m, 1 + 1/g, a - 1/g) + (s/m)^2 * betaint(u1m, 1 + 2/g, a - 2/g))/Ga + limit^2 * u^a) All.eq(levpareto4(limit, order = 3, min = m, shape1 = a, shape2 = g, scale = s), m^3 * (betaint(u1m, 1, a) + 3 * (s/m) * betaint(u1m, 1 + 1/g, a - 1/g) + 3 * (s/m)^2 * betaint(u1m, 1 + 2/g, a - 2/g) + (s/m)^3 * betaint(u1m, 1 + 3/g, a - 3/g))/Ga + limit^3 * u^a) }) limit <- qpareto3(q, min = m, shape = g, scale = s) y <- (limit - m)/s u <- 1/(1 + y^(-g)) u1m <- 1/(1 + y^g) stopifnot(exprs = { All.eq(levpareto3(limit, order = 1, min = m, shape = g, scale = s), m * (u + (s/m) * betaint(u, 1 + 1/g, 1 - 1/g)) + limit * u1m) All.eq(levpareto3(limit, order = 2, min = m, shape = g, scale = s), m^2 * (u + 2 * (s/m) * betaint(u, 1 + 1/g, 1 - 1/g) + (s/m)^2 * betaint(u, 1 + 2/g, 1 - 2/g)) + limit^2 * u1m) All.eq(levpareto3(limit, order = 3, min = m, shape = g, scale = s), m^3 * (u + 3 * (s/m) * betaint(u, 1 + 1/g, 1 - 1/g) + 3 * (s/m)^2 * betaint(u, 1 + 2/g, 1 - 2/g) + (s/m)^3 * betaint(u, 1 + 3/g, 1 - 3/g)) + limit^3 * u1m) }) limit <- qpareto2(q, min = m, shape = a, scale = s) y <- (limit - m)/s u <- 1/(1 + y) u1m <- 1/(1 + y^(-1)) stopifnot(exprs = { All.eq(levpareto2(limit, order = 1, min = m, shape = a, scale = s), m * (betaint(u1m, 1, a) + (s/m) * betaint(u1m, 1 + 1, a - 1))/Ga + limit * u^a) All.eq(levpareto2(limit, order = 2, min = m, shape = a, scale = s), m^2 * (betaint(u1m, 1, a) + 2 * (s/m) * betaint(u1m, 1 + 1, a - 1) + (s/m)^2 * betaint(u1m, 1 + 2, a - 2))/Ga + limit^2 * u^a) All.eq(levpareto2(limit, order = 3, min = m, shape = a, scale = s), m^3 * (betaint(u1m, 1, a) + 3 * (s/m) * betaint(u1m, 1 + 1, a - 1) + 3 * (s/m)^2 * betaint(u1m, 1 + 2, a - 2) + (s/m)^3 * betaint(u1m, 1 + 3, a - 3))/Ga + limit^3 * u^a) }) } } ## ## TRANSFORMED BETA FAMILY ## ## Density: first check that functions return 0 when scale = Inf, and ## when x = scale = Inf. stopifnot(exprs = { dtrbeta (c(42, Inf), shape1 = 2, shape2 = 3, shape3 = 4, scale = Inf) == c(0, 0) dburr (c(42, Inf), shape1 = 2, shape2 = 3, scale = Inf) == c(0, 0) dllogis (c(42, Inf), shape = 3, scale = Inf) == c(0, 0) dparalogis (c(42, Inf), shape = 2, scale = Inf) == c(0, 0) dgenpareto (c(42, Inf), shape1 = 2, shape2 = 4, scale = Inf) == c(0, 0) dpareto (c(42, Inf), shape = 2, scale = Inf) == c(0, 0) dinvburr (c(42, Inf), shape1 = 4, shape2 = 3, scale = Inf) == c(0, 0) dinvpareto (c(42, Inf), shape = 4, scale = Inf) == c(0, 0) dinvparalogis(c(42, Inf), shape = 4, scale = Inf) == c(0, 0) }) ## Next test density functions for an array of standard values. set.seed(123) # reset the seed nshpar <- 3 # (maximum) number of shape parameters shpar <- replicate(30, rlnorm(nshpar, 2), simplify = FALSE) scpar <- rlnorm(30, 2) # scale parameters for (i in seq_along(shpar)) { a <- shpar[[c(i, 1)]]; g <- shpar[[c(i, 2)]]; t <- shpar[[c(i, 3)]] Be <- beta(a, t) for (s in scpar) { x <- rtrbeta(100, shape1 = a, shape2 = g, shape3 = t, scale = s) y <- x/s u <- 1/(1 + y^(-g)) stopifnot(exprs = { all.equal(d1 <- dtrbeta(x, shape1 = a, shape2 = g, shape3 = t, scale = s), d2 <- dtrbeta(y, shape1 = a, shape2 = g, shape3 = t, scale = 1)/s, tolerance = 1e-10) all.equal(d1, g * y^(g*t - 1)/(s * Be * (1 + y^g)^(a + t)), tolerance = 1e-10) all.equal(d1, g * u^t * (1 - u)^a/(x * Be), tolerance = 1e-10) }) x <- rburr(100, shape1 = a, shape2 = g, scale = s) y <- x/s u <- 1/(1 + y^g) stopifnot(exprs = { all.equal(d1 <- dburr(x, shape1 = a, shape2 = g, scale = s), d2 <- dburr(y, shape1 = a, shape2 = g, scale = 1)/s, tolerance = 1e-10) all.equal(d1, a * g * y^(g - 1)/(s * (1 + y^g)^(a + 1)), tolerance = 1e-10) all.equal(d1, a * g * u^a * (1 - u)/x, tolerance = 1e-10) }) x <- rllogis(100, shape = g, scale = s) y <- x/s u <- 1/(1 + y^(-g)) stopifnot(exprs = { all.equal(d1 <- dllogis(x, shape = g, scale = s), d2 <- dllogis(y, shape = g, scale = 1)/s, tolerance = 1e-10) all.equal(d1, g * y^(g - 1)/(s * (1 + y^g)^2), tolerance = 1e-10) all.equal(d1, g * u * (1 - u)/x, tolerance = 1e-10) }) x <- rparalogis(100, shape = a, scale = s) y <- x/s u <- 1/(1 + y^a) stopifnot(exprs = { all.equal(d1 <- dparalogis(x, shape = a, scale = s), d2 <- dparalogis(y, shape = a, scale = 1)/s, tolerance = 1e-10) all.equal(d1, a^2 * y^(a - 1)/(s * (1 + y^a)^(a + 1)), tolerance = 1e-10) all.equal(d1, a^2 * u^a * (1 - u)/x, tolerance = 1e-10) }) x <- rgenpareto(100, shape1 = a, shape2 = t, scale = s) y <- x/s u <- 1/(1 + y^(-1)) stopifnot(exprs = { all.equal(d1 <- dgenpareto(x, shape1 = a, shape2 = t, scale = s), d2 <- dgenpareto(y, shape1 = a, shape2 = t, scale = 1)/s, tolerance = 1e-10) all.equal(d1, y^(t - 1)/(s * Be * (1 + y)^(a + t)), tolerance = 1e-10) all.equal(d1, u^t * (1 - u)^a/(x * Be), tolerance = 1e-10) }) x <- rpareto(100, shape = a, scale = s) y <- x/s u <- 1/(1 + y) stopifnot(exprs = { all.equal(d1 <- dpareto(x, shape = a, scale = s), d2 <- dpareto(y, shape = a, scale = 1)/s, tolerance = 1e-10) all.equal(d1, a/(s * (1 + y)^(a + 1)), tolerance = 1e-10) all.equal(d1, a * u^a * (1 - u)/x, tolerance = 1e-10) }) x <- rpareto1(100, min = s, shape = a) stopifnot(exprs = { all.equal(d1 <- dpareto1(x, min = s, shape = a), a * s^a/(x^(a + 1)), tolerance = 1e-10) }) x <- rinvburr(100, shape1 = t, shape2 = g, scale = s) y <- x/s u <- 1/(1 + y^(-g)) stopifnot(exprs = { all.equal(d1 <- dinvburr(x, shape1 = t, shape2 = g, scale = s), d2 <- dinvburr(y, shape1 = t, shape2 = g, scale = 1)/s, tolerance = 1e-10) all.equal(d1, t * g * y^(g*t - 1)/(s * (1 + y^g)^(t + 1)), tolerance = 1e-10) all.equal(d1, t * g * u^t * (1 - u)/x, tolerance = 1e-10) }) x <- rinvpareto(100, shape = t, scale = s) y <- x/s u <- 1/(1 + y^(-1)) stopifnot(exprs = { all.equal(d1 <- dinvpareto(x, shape = t, scale = s), d2 <- dinvpareto(y, shape = t, scale = 1)/s, tolerance = 1e-10) all.equal(d1, t * y^(t - 1)/(s * (1 + y)^(t + 1)), tolerance = 1e-10) all.equal(d1, t * u^t * (1 - u)/x, tolerance = 1e-10) }) x <- rinvparalogis(100, shape = t, scale = s) y <- x/s u <- 1/(1 + y^(-t)) stopifnot(exprs = { all.equal(d1 <- dinvparalogis(x, shape = t, scale = s), d2 <- dinvparalogis(y, shape = t, scale = 1)/s, tolerance = 1e-10) all.equal(d1, t^2 * y^(t^2 - 1)/(s * (1 + y^t)^(t + 1)), tolerance = 1e-10) all.equal(d1, t^2 * u^t * (1 - u)/x, tolerance = 1e-10) }) } } ## Tests on the cumulative distribution function. ## ## Note: when shape1 = shape3 = 1, the underlying beta distribution is ## a uniform. Therefore, ptrbeta(x, 1, shape2, 1, scale) should return ## the value of u = v/(1 + v), v = (x/scale)^shape2. ## ## x = 2/Meps = 2^53 (with, shape2 = scale = 1) is the value where the ## cdf would jump to 1 if we weren't using the trick to compute the ## cdf with pbeta(1 - u, ..., lower = FALSE). scLrg <- 1e300 * c(0.5, 1, 2) stopifnot(exprs = { ptrbeta(Inf, 1, 2, 3, scale = xMax) == 1 ptrbeta(2^53, 1, 1, 1, scale = 1) != 1 all.equal(ptrbeta(xMin, 1, 1, 1, scale = 1), xMin) all.equal(ptrbeta(1e300, shape1 = 3, shape2 = rep(c(1, 2), each = length(scLrg)), shape3 = 1, scale = scLrg, log = TRUE), c(pbeta(c(2/3, 1/2), 1, 3, lower.tail = TRUE, log = TRUE), pbeta(2/3, 3, 1, lower.tail = FALSE, log = TRUE), pbeta(c(4/5, 1/2), 1, 3, lower.tail = TRUE, log = TRUE), pbeta(4/5, 3, 1, lower.tail = FALSE, log = TRUE))) }) stopifnot(exprs = { pburr(Inf, 1, 3, scale = xMax) == 1 pburr(2^53, 1, 1, scale = 1) != 1 all.equal(pburr(xMin, 1, 1, scale = 1), xMin) all.equal(pburr(1e300, shape1 = 3, shape2 = rep(c(1, 2), each = length(scLrg)), scale = scLrg, log = TRUE), c(log(1 - c(1/3, 1/2, 2/3)^3), log(1 - c(1/5, 1/2, 4/5)^3))) }) stopifnot(exprs = { pllogis(Inf, 3, scale = xMax) == 1 pllogis(2^53, 1, scale = 1) != 1 all.equal(pllogis(xMin, 1, scale = 1), xMin) all.equal(pllogis(1e300, shape = rep(c(1, 2), each = length(scLrg)), scale = scLrg, log = TRUE), c(log(c(2/3, 1/2, 1/3)), log(c(4/5, 1/2, 1/5)))) }) stopifnot(exprs = { pparalogis(Inf, 3, scale = xMax) == 1 pparalogis(2^53, 1, scale = 1) != 1 all.equal(pparalogis(xMin, 1, scale = 1), xMin) all.equal(pparalogis(1e300, shape = rep(c(2, 3), each = length(scLrg)), scale = scLrg, log = TRUE), c(log(1 - c(1/5, 1/2, 4/5)^2), log(1 - c(1/9, 1/2, 8/9)^3))) }) stopifnot(exprs = { pgenpareto(Inf, 1, 3, scale = xMax) == 1 pgenpareto(2^53, 1, 1, scale = 1) != 1 all.equal(pgenpareto(xMin, 1, 1, scale = 1), xMin) all.equal(pgenpareto(1e300, shape1 = 3, shape2 = 1, scale = scLrg, log = TRUE), c(pbeta(c(2/3, 1/2), 1, 3, lower.tail = TRUE, log = TRUE), pbeta(2/3, 3, 1, lower.tail = FALSE, log = TRUE))) }) stopifnot(exprs = { ppareto(Inf, 3, scale = xMax) == 1 ppareto(2^53, 1, scale = 1) != 1 all.equal(ppareto(xMin, 1, scale = 1), xMin) all.equal(ppareto(1e300, shape = 3, scale = scLrg, log = TRUE), c(log(1 - c(1/3, 1/2, 2/3)^3))) }) stopifnot(exprs = { ppareto1(Inf, 3, min = xMax) == 1 ppareto1(2^53, 1, min = 1) != 1 all.equal(ppareto1(xMin, 1, min = 1), xMin) all.equal(ppareto1(1e300, shape = 3, min = 1e300 * c(0.001, 0.1, 0.5), log = TRUE), c(log(1 - c(0.001, 0.1, 0.5)^3))) }) stopifnot(exprs = { pinvburr(Inf, 1, 3, scale = xMax) == 1 pinvburr(2^53, 1, 1, scale = 1) != 1 all.equal(pinvburr(xMin, 1, 1, scale = 1), xMin) all.equal(pinvburr(1e300, shape1 = 3, shape2 = rep(c(1, 2), each = length(scLrg)), scale = scLrg, log = TRUE), c(log(c(2/3, 1/2, 1/3)^3), log(c(4/5, 1/2, 1/5)^3))) }) stopifnot(exprs = { pinvpareto(Inf, 3, scale = xMax) == 1 pinvpareto(2^53, 1, scale = 1) != 1 all.equal(pinvpareto(xMin, 1, scale = 1), xMin) all.equal(pinvpareto(1e300, shape = 3, scale = scLrg, log = TRUE), c(log(c(2/3, 1/2, 1/3)^3))) }) stopifnot(exprs = { pinvparalogis(Inf, 3, scale = xMax) == 1 pinvparalogis(2^53, 1, scale = 1) != 1 all.equal(pinvparalogis(xMin, 1, scale = 1), xMin) all.equal(pinvparalogis(1e300, shape = rep(c(2, 3), each = length(scLrg)), scale = scLrg, log = TRUE), c(log(c(4/5, 1/2, 1/5)^2), log(c(8/9, 1/2, 1/9)^3))) }) ## Also check that distribution functions return 0 when scale = Inf. stopifnot(exprs = { ptrbeta (x, shape1 = a, shape2 = g, shape3 = t, scale = Inf) == 0 pburr (x, shape1 = a, shape2 = g, scale = Inf) == 0 pllogis (x, shape = g, scale = Inf) == 0 pparalogis (x, shape = a, scale = Inf) == 0 pgenpareto (x, shape1 = a, shape2 = t, scale = Inf) == 0 ppareto (x, shape = a, scale = Inf) == 0 pinvburr (x, shape1 = t, shape2 = g, scale = Inf) == 0 pinvpareto (x, shape = t, scale = Inf) == 0 pinvparalogis(x, shape = t, scale = Inf) == 0 }) ## Tests for first three positive moments and first two negative ## moments. ## ## Simulation of new parameters ensuring that said moments exist. set.seed(123) # reset the seed nshpar <- 3 # (maximum) number of shape parameters shpar <- replicate(30, c(3, 3, 3) + rlnorm(nshpar, 2), simplify = FALSE) scpar <- rlnorm(30, 2) # scale parameters k <- c(-2, -1, 1, 2, 3) # orders for (i in seq_along(shpar)) { a <- shpar[[c(i, 1)]]; g <- shpar[[c(i, 2)]]; t <- shpar[[c(i, 3)]] Be <- beta(a, t) Ga <- gamma(a) for (s in scpar) { stopifnot(exprs = { All.eq(mtrbeta(k, shape1 = a, shape2 = g, shape3 = t, scale = s), s^k * beta(t + k/g, a - k/g)/Be) All.eq(mburr(k, shape1 = a, shape2 = g, scale = s), s^k * gamma(1 + k/g) * gamma(a - k/g)/Ga) All.eq(mllogis(k, shape = g, scale = s), s^k * gamma(1 + k/g) * gamma(1 - k/g)) All.eq(mparalogis(k, shape = a, scale = s), s^k * gamma(1 + k/a) * gamma(a - k/a)/Ga) All.eq(mgenpareto(k, shape1 = a, shape2 = t, scale = s), s^k * beta(t + k, a - k)/Be) All.eq(mpareto(k[k > -1], shape = a, scale = s), s^k[k > -1] * gamma(1 + k[k > -1]) * gamma(a - k[k > -1])/Ga) All.eq(mpareto1(k, shape = a, min = s), s^k * a/(a - k)) All.eq(minvburr(k, shape1 = a, shape2 = g, scale = s), s^k * gamma(a + k/g) * gamma(1 - k/g)/Ga) All.eq(minvpareto(k[k < 1], shape = a, scale = s), s^k[k < 1] * gamma(a + k[k < 1]) * gamma(1 - k[k < 1])/Ga) All.eq(minvparalogis(k, shape = a, scale = s), s^k * gamma(a + k/a) * gamma(1 - k/a)/Ga) }) } } ## Tests for first three positive limited moments and first two ## negative limited moments. ## ## Limits are taken from quantiles of each distribution. order <- c(-2, -1, 1, 2, 3) # orders q <- c(0.25, 0.50, 0.75, 0.9, 0.95) # quantiles for (i in seq_along(shpar)) { a <- shpar[[c(i, 1)]]; g <- shpar[[c(i, 2)]]; t <- shpar[[c(i, 3)]] Ga <- gamma(a) Gt <- gamma(t) for (s in scpar) { limit <- qtrbeta(q, shape1 = a, shape2 = g, shape3 = t, scale = s) y <- limit/s u <- 1/(1 + y^(-g)) for (k in order) stopifnot(exprs = { All.eq(levtrbeta(limit, order = k, shape1 = a, shape2 = g, shape3 = t, scale = s), s^k * betaint(u, t + k/g, a - k/g)/(Ga * Gt) + limit^k * pbeta(u, t, a, lower = FALSE)) }) limit <- qburr(q, shape1 = a, shape2 = g, scale = s) y <- limit/s u <- 1/(1 + y^g) for (k in order) stopifnot(exprs = { All.eq(levburr(limit, order = k, shape1 = a, shape2 = g, scale = s), s^k * betaint(1 - u, 1 + k/g, a - k/g)/Ga + limit^k * u^a) }) limit <- qllogis(q, shape = g, scale = s) y <- limit/s u <- 1/(1 + y^(-g)) for (k in order) stopifnot(exprs = { All.eq(levllogis(limit, order = k, shape = g, scale = s), s^k * betaint(u, 1 + k/g, 1 - k/g) + limit^k * (1 - u)) }) limit <- qparalogis(q, shape = a, scale = s) y <- limit/s u <- 1/(1 + y^a) for (k in order) stopifnot(exprs = { All.eq(levparalogis(limit, order = k, shape = a, scale = s), s^k * betaint(1 - u, 1 + k/a, a - k/a)/Ga + limit^k * u^a) }) limit <- qgenpareto(q, shape1 = a, shape2 = t, scale = s) y <- limit/s u <- 1/(1 + y^(-1)) for (k in order) stopifnot(exprs = { All.eq(levgenpareto(limit, order = k, shape1 = a, shape2 = t, scale = s), s^k * betaint(u, t + k, a - k)/(Ga * Gt) + limit^k * pbeta(u, t, a, lower = FALSE)) }) limit <- qpareto(q, shape = a, scale = s) y <- limit/s u <- 1/(1 + y) for (k in order[order > -1]) stopifnot(exprs = { All.eq(levpareto(limit, order = k, shape = a, scale = s), s^k * betaint(1 - u, 1 + k, a - k)/Ga + limit^k * u^a) }) limit <- qpareto1(q, shape = a, min = s) for (k in order) stopifnot(exprs = { All.eq(levpareto1(limit, order = k, shape = a, min = s), s^k * a/(a - k) - k * s^a/((a - k) * limit^(a - k))) }) limit <- qinvburr(q, shape1 = a, shape2 = g, scale = s) y <- limit/s u <- 1/(1 + y^(-g)) for (k in order) stopifnot(exprs = { All.eq(levinvburr(limit, order = k, shape1 = a, shape2 = g, scale = s), s^k * betaint(u, a + k/g, 1 - k/g)/Ga + limit^k * (1 - u^a)) }) limit <- qinvpareto(q, shape = a, scale = s) y <- limit/s u <- 1/(1 + y^(-1)) for (k in order[order < 1]) stopifnot(exprs = { All.eq(levinvpareto(limit, order = k, shape = a, scale = s), s^k * a * sapply(u, function(upper) integrate(function(x) x^(a+k-1) * (1-x)^(-k), lower = 0, upper = upper)$value) + limit^k * (1 - u^a)) }) limit <- qinvparalogis(q, shape = a, scale = s) y <- limit/s u <- 1/(1 + y^(-a)) for (k in order) stopifnot(exprs = { All.eq(levinvparalogis(limit, order = k, shape = a, scale = s), s^k * betaint(u, a + k/a, 1 - k/a)/Ga + limit^k * (1 - u^a)) }) } } ## ## TRANSFORMED GAMMA AND INVERSE TRANSFORMED GAMMA FAMILIES ## ## Density: first check that functions return 0 when scale = Inf, and ## when x = scale = Inf (transformed gamma), or when scale = 0 and ## when x = scale = 0 (inverse distributions). stopifnot(exprs = { dtrgamma (c(42, Inf), shape1 = 2, shape2 = 3, scale = Inf) == c(0, 0) dinvtrgamma(c(42, 0), shape1 = 2, shape2 = 3, scale = 0) == c(0, 0) dinvgamma (c(42, 0), shape = 2, scale = 0) == c(0, 0) dinvweibull(c(42, 0), shape = 3, scale = 0) == c(0, 0) dinvexp (c(42, 0), scale = 0) == c(0, 0) }) ## Tests on the density set.seed(123) # reset the seed nshpar <- 2 # (maximum) number of shape parameters shpar <- replicate(30, rgamma(nshpar, 5), simplify = FALSE) scpar <- rlnorm(30, 2) # scale parameters for (i in seq_along(shpar)) { a <- shpar[[c(i, 1)]]; t <- shpar[[c(i, 2)]] Ga <- gamma(a) for (s in scpar) { x <- rtrgamma(100, shape1 = a, shape2 = t, scale = s) y <- x/s u <- y^t stopifnot(exprs = { all.equal(d1 <- dtrgamma(x, shape1 = a, shape2 = t, scale = s), d2 <- dtrgamma(y, shape1 = a, shape2 = t, scale = 1)/s, tolerance = 1e-10) all.equal(d2, t/(Ga * s^(a * t)) * x^(a * t - 1) * exp(-u), tolerance = 1e-10) all.equal(d1, t/(Ga * x) * u^a * exp(-u), tolerance = 1e-10) }) x <- rinvtrgamma(100, shape1 = a, shape2 = t, scale = s) y <- x/s u <- y^(-t) stopifnot(exprs = { all.equal(d1 <- dinvtrgamma(x, shape1 = a, shape2 = t, scale = s), d2 <- dinvtrgamma(y, shape1 = a, shape2 = t, scale = 1)/s, tolerance = 1e-10) all.equal(d2, t * s^(a * t)/(Ga * x^(a * t + 1)) * exp(-u), tolerance = 1e-10) all.equal(d1, t/(Ga * x) * u^a * exp(-u), tolerance = 1e-10) }) x <- rinvgamma(100, shape = a, scale = s) y <- x/s u <- y^(-1) stopifnot(exprs = { all.equal(d1 <- dinvgamma(x, shape = a, scale = s), d2 <- dinvgamma(y, shape = a, scale = 1)/s, tolerance = 1e-10) all.equal(d2, s^a/(Ga * x^(a + 1)) * exp(-u), tolerance = 1e-10) all.equal(d1, 1/(Ga * x) * u^a * exp(-u), tolerance = 1e-10) }) x <- rinvweibull(100, shape = t, scale = s) y <- x/s u <- y^(-t) stopifnot(exprs = { all.equal(d1 <- dinvweibull(x, shape = t, scale = s), d2 <- dinvweibull(y, shape = t, scale = 1)/s, tolerance = 1e-10) all.equal(d2, t * s^t/x^(t + 1) * exp(-u), tolerance = 1e-10) all.equal(d1, t/x * u * exp(-u), tolerance = 1e-10) }) x <- rinvexp(100, scale = s) y <- x/s u <- y^(-1) stopifnot(exprs = { all.equal(d1 <- dinvexp(x, scale = s), d2 <- dinvexp(y, scale = 1)/s, tolerance = 1e-10) all.equal(d2, s/x^2 * exp(-u), tolerance = 1e-10) all.equal(d1, 1/x * u * exp(-u), tolerance = 1e-10) }) } } ## Tests on the cumulative distribution function. scLrg <- c(2, 100, 1e300 * c(0.1, 1, 10, 100), 1e307, xMax, Inf) stopifnot(exprs = { ptrgamma(Inf, 2, 3, scale = xMax) == 1 ptrgamma(xMax, 2, 3, scale = xMax) == pgamma(1, 2, 1) ptrgamma(xMin, 2, 1, scale = 1) == pgamma(xMin, 2, 1) all.equal(ptrgamma(1e300, shape1 = 2, shape2 = 1, scale = scLrg, log = TRUE), pgamma(c(5e299, 1e+298, 10, 1, 0.1, 0.01, 1e-7, 1e+300/xMax, 0), 2, 1, log = TRUE)) }) scLrg <- c(2, 100, 1e300 * c(0.1, 1, 10, 100), 1e307, xMax, 0) stopifnot(exprs = { pinvtrgamma(Inf, 2, 3, scale = xMax) == 1 pinvtrgamma(xMax, 2, 3, scale = xMax) == pgamma(1, 2, 1, lower = FALSE) pinvtrgamma(xMin, 2, 1, scale = 1) == pgamma(1/xMin, 2, 1, lower = FALSE) all.equal(pinvtrgamma(1e300, shape1 = 2, shape2 = 1, scale = scLrg, log = TRUE), pgamma(c(2e-300, 1e-298, 0.1, 1, 10, 100, 1e+7, xMax/1e+300, 0), 2, 1, lower = FALSE, log = TRUE)) }) stopifnot(exprs = { pinvgamma(Inf, 2, scale = xMax) == 1 pinvgamma(xMax, 2, scale = xMax) == pgamma(1, 2, 1, lower = FALSE) pinvgamma(xMin, 2, scale = 1) == pgamma(1/xMin, 2, 1, lower = FALSE) all.equal(pinvgamma(1e300, shape = 2, scale = scLrg, log = TRUE), pgamma(c(2e-300, 1e-298, 0.1, 1, 10, 100, 1e+7, xMax/1e+300, 0), 2, 1, lower = FALSE, log = TRUE)) }) stopifnot(exprs = { pinvweibull(Inf, 3, scale = xMax) == 1 pinvweibull(xMax, 3, scale = xMax) == exp(-1) pinvweibull(xMin, 1, scale = 1) == exp(-1/xMin) all.equal(pinvweibull(1e300, shape = 1, scale = scLrg, log = TRUE), -c(2e-300, 1e-298, 0.1, 1, 10, 100, 1e+7, xMax/1e+300, 0)) }) stopifnot(exprs = { pinvexp(Inf, 3, scale = xMax) == 1 pinvexp(xMax, 3, scale = xMax) == exp(-1) pinvexp(xMin, 1, scale = 1) == exp(-1/xMin) all.equal(pinvexp(1e300, scale = scLrg, log = TRUE), -c(2e-300, 1e-298, 0.1, 1, 10, 100, 1e+7, xMax/1e+300, 0)) }) ## Tests for first three positive moments and first two negative ## moments. (Including for the Gamma, Weibull and Exponential ## distributions of base R.) ## ## Simulation of new parameters ensuring that said moments exist. set.seed(123) # reset the seed nshpar <- 2 # (maximum) number of shape parameters shpar <- replicate(30, c(3, 3) + rlnorm(nshpar, 2), simplify = FALSE) scpar <- rlnorm(30, 2) # scale parameters k <- c(-2, -1, 1, 2, 3) # orders for (i in seq_along(shpar)) { a <- shpar[[c(i, 1)]]; t <- shpar[[c(i, 2)]] Ga <- gamma(a) for (s in scpar) { stopifnot(exprs = { All.eq(mtrgamma(k, shape1 = a, shape2 = t, scale = s), s^k * gamma(a + k/t)/Ga) All.eq(mgamma(k, shape = a, scale = s), s^k * gamma(a + k)/Ga) All.eq(mweibull(k, shape = t, scale = s), s^k * gamma(1 + k/t)) All.eq(mexp(k[k > -1], rate = 1/s), s^k[k > -1] * gamma(1 + k[k > -1])) All.eq(minvtrgamma(k, shape1 = a, shape2 = t, scale = s), s^k * gamma(a - k/t)/Ga) All.eq(minvgamma(k, shape = a, scale = s), s^k * gamma(a - k)/Ga) All.eq(minvweibull(k, shape = t, scale = s), s^k * gamma(1 - k/t)) All.eq(minvexp(k[k < 1], scale = s), s^k[k < 1] * gamma(1 - k[k < 1])) }) } } ## Tests for first three positive limited moments and first two ## negative limited moments. (Including for the Gamma, Weibull and ## Exponential distributions of base R.) ## ## Limits are taken from quantiles of each distribution. order <- c(-2, -1, 1, 2, 3) # orders q <- c(0.25, 0.50, 0.75, 0.9, 0.95) # quantiles for (i in seq_along(shpar)) { a <- shpar[[c(i, 1)]]; t <- shpar[[c(i, 2)]] Ga <- gamma(a) for (s in scpar) { limit <- qtrgamma(q, shape1 = a, shape2 = t, scale = s) y <- limit/s u <- y^t for (k in order) stopifnot(exprs = { All.eq(levtrgamma(limit, order = k, shape1 = a, shape2 = t, scale = s), s^k * gamma(a + k/t)/Ga * pgamma(u, a + k/t, scale = 1) + limit^k * pgamma(u, a, scale = 1, lower = FALSE)) }) limit <- qgamma(q, shape = a, scale = s) y <- limit/s for (k in order) stopifnot(exprs = { All.eq(levgamma(limit, order = k, shape = a, scale = s), s^k * gamma(a + k)/Ga * pgamma(y, a + k, scale = 1) + limit^k * pgamma(y, a, scale = 1, lower = FALSE)) }) limit <- qweibull(q, shape = t, scale = s) y <- limit/s u <- y^t for (k in order) stopifnot(exprs = { All.eq(levweibull(limit, order = k, shape = t, scale = s), s^k * gamma(1 + k/t) * pgamma(u, 1 + k/t, scale = 1) + limit^k * pgamma(u, 1, scale = 1, lower = FALSE)) }) limit <- qexp(q, rate = 1/s) y <- limit/s for (k in order[order > -1]) stopifnot(exprs = { All.eq(levexp(limit, order = k, rate = 1/s), s^k * gamma(1 + k) * pgamma(y, 1 + k, scale = 1) + limit^k * pgamma(y, 1, scale = 1, lower = FALSE)) }) limit <- qinvtrgamma(q, shape1 = a, shape2 = t, scale = s) y <- limit/s u <- y^(-t) for (k in order) stopifnot(exprs = { All.eq(levinvtrgamma(limit, order = k, shape1 = a, shape2 = t, scale = s), s^k * (gammainc(a - k/t, u)/Ga) + limit^k * pgamma(u, a, scale = 1)) }) limit <- qinvgamma(q, shape = a, scale = s) y <- limit/s u <- y^(-1) for (k in order) stopifnot(exprs = { All.eq(levinvgamma(limit, order = k, shape = a, scale = s), s^k * (gammainc(a - k, u)/Ga) + limit^k * pgamma(u, a, scale = 1)) }) limit <- qinvweibull(q, shape = t, scale = s) y <- limit/s u <- y^(-t) for (k in order) stopifnot(exprs = { All.eq(levinvweibull(limit, order = k, shape = t, scale = s), s^k * gammainc(1 - k/t, u) + limit^k * (-expm1(-u))) }) limit <- qinvexp(q, scale = s) y <- limit/s u <- y^(-1) for (k in order) stopifnot(exprs = { All.eq(levinvexp(limit, order = k, scale = s), s^k * gammainc(1 - k, u) + limit^k * (-expm1(-u))) }) } } ## ## OTHER DISTRIBUTIONS ## ## Distributions in this category are quite different, so let's treat ## them separately. ## LOGGAMMA ## Tests on the density. stopifnot(exprs = { dlgamma(c(42, Inf), shapelog = 2, ratelog = 0) == c(0, 0) }) assertWarning(stopifnot(exprs = { is.nan(dlgamma(c(0, 42, Inf), shapelog = 2, ratelog = Inf)) })) x <- rlgamma(100, shapelog = 2, ratelog = 1) for(a in round(rlnorm(30), 2)) { Ga <- gamma(a) for(r in round(rlnorm(30), 2)) stopifnot(exprs = { All.eq(dlgamma(x, shapelog = a, ratelog = r), r^a * (log(x))^(a - 1)/(Ga * x^(r + 1))) }) } ## Tests on the cumulative distribution function. assertWarning(stopifnot(exprs = { is.nan(plgamma(Inf, 1, ratelog = Inf)) is.nan(plgamma(Inf, Inf, ratelog = Inf)) })) scLrg <- log(c(2, 100, 1e300 * c(0.1, 1, 10, 100), 1e307, xMax, Inf)) stopifnot(exprs = { plgamma(Inf, 2, ratelog = xMax) == 1 plgamma(xMax, 2, ratelog = 0) == 0 all.equal(plgamma(1e300, 2, ratelog = 1/scLrg, log = TRUE), pgamma(log(1e300), 2, scale = scLrg, log = TRUE)) }) ## Tests for first three positive moments and first two negative ## moments. k <- c(-2, -1, 1, 2, 3) # orders for(a in round(rlnorm(30), 2)) { Ga <- gamma(a) for(r in 3 + round(rlnorm(30), 2)) stopifnot(exprs = { All.eq(mlgamma(k, shapelog = a, ratelog = r), (1 - k/r)^(-a)) }) } ## Tests for first three positive limited moments and first two ## negative limited moments. order <- c(-2, -1, 1, 2, 3) # orders q <- c(0.25, 0.50, 0.75, 0.9, 0.95) # quantiles for(a in round(rlnorm(30), 2)) { Ga <- gamma(a) for(r in 3 + round(rlnorm(30), 2)) { limit <- qlgamma(q, shapelog = a, ratelog = r) for (k in order) { u <- log(limit) stopifnot(exprs = { All.eq(levlgamma(limit, order = k, shapelog = a, ratelog = r), (1 - k/r)^(-a) * pgamma((r - k) * u, a, scale = 1) + limit^k * pgamma(r * u, a, scale = 1,lower = FALSE)) }) } } } ## GUMBEL ## Tests on the density. stopifnot(exprs = { dgumbel(c(1, 3, Inf), alpha = 2, scale = Inf) == c(0, 0, 0) dgumbel(c(1, 2, 3), alpha = 2, scale = 0) == c(0, Inf, 0) dgumbel(c(-Inf, Inf), alpha = 1, scale = 1) == c(0, 0) dgumbel(1, alpha = Inf, scale = 1) == 0 }) assertWarning(stopifnot(exprs = { is.nan(dgumbel(Inf, alpha = Inf, scale = 1)) is.nan(dgumbel(-Inf, alpha = -Inf, scale = 1)) is.nan(dgumbel(Inf, alpha = 1, scale = -1)) is.nan(dgumbel(1, alpha = 1, scale = -1)) is.nan(dgumbel(1, alpha = Inf, scale = -1)) })) x <- rgumbel(100, alpha = 2, scale = 5) for(a in round(rlnorm(30), 2)) { Ga <- gamma(a) for(s in round(rlnorm(30), 2)) { u <- (x - a)/s stopifnot(exprs = { All.eq(dgumbel(x, alpha = a, scale = s), exp(-(u + exp(-u)))/s) }) } } ## Tests on the cumulative distribution function. assertWarning(stopifnot(exprs = { is.nan(pgumbel(Inf, alpha = Inf, scale = 1)) is.nan(pgumbel(-Inf, alpha = -Inf, scale = 1)) is.nan(pgumbel(Inf, alpha = 1, scale = -1)) is.nan(pgumbel(1, alpha = 1, scale = -1)) is.nan(pgumbel(1, alpha = Inf, scale = -1)) })) scLrg <- c(2, 100, 1e300 * c(0.1, 1, 10, 100), 1e307, xMax, Inf) stopifnot(exprs = { pgumbel(c(-Inf, Inf), 2, scale = xMax) == c(0, 1) pgumbel(c(xMin, xMax), 2, scale = 0) == c(0, 1) all.equal(pgumbel(1e300, 0, scale = scLrg, log = TRUE), -exp(-c(5e299, 1e+298, 10, 1, 0.1, 0.01, 1e-7, 1e+300/xMax, 0))) }) ## Test the first two moments, the only ones implemented. assertWarning(stopifnot(exprs = { is.nan(mgumbel(c(-2, -1, 3, 4), alpha = 2, scale = 5)) })) stopifnot(exprs = { All.eq(mgumbel(1, alpha = 2, scale = 5), 2 + 5 * 0.577215664901532860606512090082) All.eq(mgumbel(2, alpha = 2, scale = 5), pi^2 * 25/6 + (2 + 5 * 0.577215664901532860606512090082)^2) }) ## INVERSE GAUSSIAN ## Tests on the density. stopifnot(exprs = { dinvgauss(c(1, 3, Inf), mean = 2, dispersion = Inf) == c(0, 0, 0) dinvgauss(c(0, 42, Inf), mean = 2, dispersion = 0) == c(Inf, 0, 0) dinvgauss(c(0, Inf), mean = 1, dispersion = 1) == c(0, 0) dinvgauss(1, mean = Inf, dispersion = 2) == dinvgamma(1, 0.5, scale = 0.25) }) assertWarning(stopifnot(exprs = { is.nan(dinvgauss(-Inf, mean = -1, dispersion = 1)) is.nan(dinvgauss(Inf, mean = 1, dispersion = -1)) is.nan(dinvgauss(1, mean = 1, dispersion = -1)) is.nan(dinvgauss(1, mean = Inf, dispersion = -1)) })) x <- rinvgauss(100, mean = 2, dispersion = 5) for(mu in round(rlnorm(30), 2)) { for(phi in round(rlnorm(30), 2)) stopifnot(exprs = { All.eq(dinvgauss(x, mean = mu, dispersion = phi), 1/sqrt(2*pi*phi*x^3) * exp(-((x/mu - 1)^2)/(2*phi*x))) }) } ## Tests on the cumulative distribution function. assertWarning(stopifnot(exprs = { is.nan(pinvgauss(-Inf, mean = -Inf, dispersion = 1)) is.nan(pinvgauss(Inf, mean = 1, dispersion = -1)) is.nan(pinvgauss(1, mean = Inf, dispersion = -1)) })) x <- c(1:50, 10^c(3:10, 20, 50, 150, 250)) sqx <- sqrt(x) stopifnot(exprs = { pinvgauss(c(0, Inf), mean = 2, dispersion = xMax) == c(0, 1) pinvgauss(c(0, xMax), mean = xMax, dispersion = 0) == c(0, 1) all.equal(pinvgauss(x, 1, dispersion = 1, log = TRUE), log(pnorm(sqx - 1/sqx) + exp(2) * pnorm(-sqx - 1/sqx))) }) ## Tests for small value of 'shape'. Added for the patch in 4294e9c. q <- runif(100) stopifnot(exprs = { all.equal(q, pinvgauss(qinvgauss(q, 0.1, 1e-2), 0.1, 1e-2)) all.equal(q, pinvgauss(qinvgauss(q, 0.1, 1e-6), 0.1, 1e-6)) }) ## Tests for first three positive, integer moments. k <- 1:3 for(mu in round(rlnorm(30), 2)) { for(phi in round(rlnorm(30), 2)) stopifnot(exprs = { All.eq(minvgauss(k, mean = mu, dispersion = phi), c(mu, mu^2 * (1 + phi * mu), mu^3 * (1 + 3 * phi * mu + 3 * (phi * mu)^2))) }) } ## Tests for limited expected value. q <- c(0.25, 0.50, 0.75, 0.9, 0.95) # quantiles for(mu in round(rlnorm(30), 2)) { for(phi in round(rlnorm(30), 2)) { limit <- qinvgauss(q, mean = mu, dispersion = phi) stopifnot(exprs = { All.eq(levinvgauss(limit, mean = mu, dispersion = phi), mu * (pnorm((limit/mu - 1)/sqrt(phi * limit)) - exp(2/phi/mu) * pnorm(-(limit/mu + 1)/sqrt(phi * limit))) + limit * pinvgauss(limit, mean = mu, dispersion = phi, lower = FALSE)) }) } } ## GENERALIZED BETA stopifnot(exprs = { dgenbeta(c(0, 2.5, 5), shape1 = 0, shape2 = 0, shape3 = 3, scale = 5) == c(Inf, 0, Inf) dgenbeta(c(0, 2.5, 5), shape1 = 0, shape2 = 0, shape3 = 0, scale = 5) == c(Inf, 0, Inf) dgenbeta(c(0, 2.5, 5), shape1 = 0, shape2 = 2, shape3 = 0, scale = 5) == c(Inf, 0, 0) dgenbeta(c(0, 2.5, 5), shape1 = 0, shape2 = Inf, shape3 = 3, scale = 5) == c(Inf, 0, 0) dgenbeta(c(0, 2.5, 5), shape1 = 1, shape2 = Inf, shape3 = 3, scale = 5) == c(Inf, 0, 0) dgenbeta(c(0, 2.5, 5), shape1 = Inf, shape2 = Inf, shape3 = 3, scale = 5) == c(0, Inf, 0) dgenbeta(c(0, 2.5, 5), shape1 = Inf, shape2 = Inf, shape3 = Inf, scale = 5) == c(0, 0, Inf) }) nshpar <- 3 # number of shape parameters shpar <- replicate(30, rlnorm(nshpar, 2), simplify = FALSE) scpar <- rlnorm(30, 2) # scale parameters for (i in seq_along(shpar)) { a <- shpar[[c(i, 1)]]; b <- shpar[[c(i, 2)]]; t <- shpar[[c(i, 3)]] Be <- beta(a, b) for (s in scpar) { u <- rbeta(100, a, b) y <- u^(1/t) x <- s * y stopifnot(exprs = { all.equal(d1 <- dgenbeta(x, shape1 = a, shape2 = b, shape3 = t, scale = s), d2 <- dgenbeta(y, shape1 = a, shape2 = b, shape3 = t, scale = 1)/s, tolerance = 1e-10) all.equal(d1, t * y^(a*t - 1) * (1 - y^t)^(b - 1)/(s * Be), tolerance = 1e-10) all.equal(d1, t * u^a * (1 - u)^(b - 1)/(x * Be), tolerance = 1e-10) }) } } ## Tests on the cumulative distribution function. scLrg <- 1e300 * c(0.5, 1, 2, 4) stopifnot(exprs = { all.equal(pgenbeta(1e300, shape1 = 3, shape2 = 1, shape3 = rep(c(1, 2), each = length(scLrg)), scale = scLrg, log = TRUE), c(0, pbeta(c(1, 1/2, 1/4), 3, 1, log = TRUE), 0, pbeta(c(1, 1/4, 1/16), 3, 1, log = TRUE))) }) ## Tests for first three positive moments and first two negative ## moments. ## ## Simulation of new parameters ensuring that said moments exist. set.seed(123) # reset the seed nshpar <- 3 # number of shape parameters shpar <- replicate(30, sqrt(c(3, 0, 3)) + rlnorm(nshpar, 2), simplify = FALSE) scpar <- rlnorm(30, 2) # scale parameters k <- c(-2, -1, 1, 2, 3) # orders for (i in seq_along(shpar)) { a <- shpar[[c(i, 1)]]; b <- shpar[[c(i, 2)]]; t <- shpar[[c(i, 3)]] Be <- beta(a, b) for (s in scpar) stopifnot(exprs = { All.eq(mgenbeta(k, shape1 = a, shape2 = b, shape3 = t, scale = s), s^k * beta(a + k/t, b)/Be) }) } ## Tests for first three positive limited moments and first two ## negative limited moments. ## ## Simulation of new parameters ensuring that said moments exist. order <- c(-2, -1, 1, 2, 3) # orders q <- c(0.25, 0.50, 0.75, 0.9, 0.95) # quantiles for (i in seq_along(shpar)) { a <- shpar[[c(i, 1)]]; g <- shpar[[c(i, 2)]]; t <- shpar[[c(i, 3)]] Be <- beta(a, b) for (s in scpar) { limit <- qgenbeta(q, shape1 = a, shape2 = b, shape3 = t, scale = s) u <- (limit/s)^t for (k in order) stopifnot(exprs = { All.eq(levgenbeta(limit, order = k, shape1 = a, shape2 = b, shape3 = t, scale = s), s^k * beta(a + k/t, b)/Be * pbeta(u, a + k/t, b) + limit^k * pbeta(u, a, b, lower = FALSE)) }) } } ## ## RANDOM NUMBERS (all continuous distributions) ## set.seed(123) n <- 20 m <- rnorm(1) ## Generate variates Rfpareto <- rfpareto(n, min = m, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2) Rpareto4 <- rpareto4(n, min = m, shape1 = 0.8, shape2 = 1.5, scale = 2) Rpareto3 <- rpareto3(n, min = m, shape = 1.5, scale = 2) Rpareto2 <- rpareto2(n, min = m, shape = 0.8, scale = 2) Rtrbeta <- rtrbeta (n, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2) Rburr <- rburr (n, shape1 = 0.8, shape2 = 1.5, scale = 2) Rllogis <- rllogis (n, shape = 1.5, scale = 2) Rparalogis <- rparalogis (n, shape = 0.8, scale = 2) Rgenpareto <- rgenpareto (n, shape1 = 0.8, shape2 = 2, scale = 2) Rpareto <- rpareto (n, shape = 0.8, scale = 2) Rpareto1 <- rpareto1 (n, shape = 0.8, min = 2) Rinvburr <- rinvburr (n, shape1 = 1.5, shape2 = 2, scale = 2) Rinvpareto <- rinvpareto (n, shape = 2, scale = 2) Rinvparalogis <- rinvparalogis(n, shape = 2, scale = 2) Rtrgamma <- rtrgamma (n, shape1 = 2, shape2 = 3, scale = 5) Rinvtrgamma <- rinvtrgamma (n, shape1 = 2, shape2 = 3, scale = 5) Rinvgamma <- rinvgamma (n, shape = 2, scale = 5) Rinvweibull <- rinvweibull (n, shape = 3, scale = 5) Rinvexp <- rinvexp (n, scale = 5) Rlgamma <- rlgamma(n, shapelog = 1.5, ratelog = 5) Rgumbel <- rgumbel(n, alpha = 2, scale = 5) Rinvgauss <- rinvgauss(n, mean = 2, dispersion = 5) Rgenbeta <- rgenbeta(n, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2) ## Compute quantiles Pfpareto <- pfpareto(Rfpareto, min = m, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2) Ppareto4 <- ppareto4(Rpareto4, min = m, shape1 = 0.8, shape2 = 1.5, scale = 2) Ppareto3 <- ppareto3(Rpareto3, min = m, shape = 1.5, scale = 2) Ppareto2 <- ppareto2(Rpareto2, min = m, shape = 0.8, scale = 2) Ptrbeta <- ptrbeta (Rtrbeta, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2) Pburr <- pburr (Rburr, shape1 = 0.8, shape2 = 1.5, scale = 2) Pllogis <- pllogis (Rllogis, shape = 1.5, scale = 2) Pparalogis <- pparalogis (Rparalogis, shape = 0.8, scale = 2) Pgenpareto <- pgenpareto (Rgenpareto, shape1 = 0.8, shape2 = 2, scale = 2) Ppareto <- ppareto (Rpareto, shape = 0.8, scale = 2) Ppareto1 <- ppareto1 (Rpareto1, shape = 0.8, min = 2) Pinvburr <- pinvburr (Rinvburr, shape1 = 1.5, shape2 = 2, scale = 2) Pinvpareto <- pinvpareto (Rinvpareto, shape = 2, scale = 2) Pinvparalogis <- pinvparalogis(Rinvparalogis, shape = 2, scale = 2) Ptrgamma <- ptrgamma (Rtrgamma, shape1 = 2, shape2 = 3, scale = 5) Pinvtrgamma <- pinvtrgamma (Rinvtrgamma, shape1 = 2, shape2 = 3, scale = 5) Pinvgamma <- pinvgamma (Rinvgamma, shape = 2, scale = 5) Pinvweibull <- pinvweibull (Rinvweibull, shape = 3, scale = 5) Pinvexp <- pinvexp (Rinvexp, scale = 5) Plgamma <- plgamma(Rlgamma, shapelog = 1.5, ratelog = 5) Pgumbel <- pgumbel(Rgumbel, alpha = 2, scale = 5) Pinvgauss <- pinvgauss(Rinvgauss, mean = 2, dispersion = 5) Pgenbeta <- pgenbeta(Rgenbeta, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2) ## Just compute pdf Dfpareto <- dfpareto(Rfpareto, min = m, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2) Dpareto4 <- dpareto4(Rpareto4, min = m, shape1 = 0.8, shape2 = 1.5, scale = 2) Dpareto3 <- dpareto3(Rpareto3, min = m, shape = 1.5, scale = 2) Dpareto2 <- dpareto2(Rpareto2, min = m, shape = 0.8, scale = 2) Dtrbeta <- dtrbeta (Rtrbeta, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2) Dburr <- dburr (Rburr, shape1 = 0.8, shape2 = 1.5, scale = 2) Dllogis <- dllogis (Rllogis, shape = 1.5, scale = 2) Dparalogis <- dparalogis (Rparalogis, shape = 0.8, scale = 2) Dgenpareto <- dgenpareto (Rgenpareto, shape1 = 0.8, shape2 = 2, scale = 2) Dpareto <- dpareto (Rpareto, shape = 0.8, scale = 2) Dpareto1 <- dpareto1 (Rpareto1, shape = 0.8, min = 2) Dinvburr <- dinvburr (Rinvburr, shape1 = 1.5, shape2 = 2, scale = 2) Dinvpareto <- dinvpareto (Rinvpareto, shape = 2, scale = 2) Dinvparalogis <- dinvparalogis(Rinvparalogis, shape = 2, scale = 2) Dtrgamma <- dtrgamma (Rtrgamma, shape1 = 2, shape2 = 3, scale = 5) Dinvtrgamma <- dinvtrgamma (Rinvtrgamma, shape1 = 2, shape2 = 3, scale = 5) Dinvgamma <- dinvgamma (Rinvtrgamma, shape = 2, scale = 5) Dinvweibull <- dinvweibull (Rinvweibull, shape = 3, scale = 5) Dinvexp <- dinvexp (Rinvexp, scale = 5) Dlgamma <- dlgamma(Rlgamma, shapelog = 1.5, ratelog = 5) Dgumbel <- dgumbel(Rgumbel, alpha = 2, scale = 5) Dinvgauss <- dinvgauss(Rinvgauss, mean = 2, dispersion = 5) Dgenbeta <- dgenbeta(Rgenbeta, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2) ## Check q(p(.)) identity stopifnot(exprs = { All.eq(Rfpareto, qfpareto(Pfpareto, min = m, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2)) All.eq(Rpareto4, qpareto4(Ppareto4, min = m, shape1 = 0.8, shape2 = 1.5, scale = 2)) All.eq(Rpareto3, qpareto3(Ppareto3, min = m, shape = 1.5, scale = 2)) All.eq(Rpareto2, qpareto2(Ppareto2, min = m, shape = 0.8, scale = 2)) All.eq(Rtrbeta, qtrbeta (Ptrbeta, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2)) All.eq(Rburr, qburr (Pburr, shape1 = 0.8, shape2 = 1.5, scale = 2)) All.eq(Rllogis, qllogis (Pllogis, shape = 1.5, scale = 2)) All.eq(Rparalogis, qparalogis (Pparalogis, shape = 0.8, scale = 2)) All.eq(Rgenpareto, qgenpareto (Pgenpareto, shape1 = 0.8, shape2 = 2, scale = 2)) All.eq(Rpareto, qpareto (Ppareto, shape = 0.8, scale = 2)) All.eq(Rpareto1, qpareto1 (Ppareto1, shape = 0.8, min = 2)) All.eq(Rinvburr, qinvburr (Pinvburr, shape1 = 1.5, shape2 = 2, scale = 2)) All.eq(Rinvpareto, qinvpareto (Pinvpareto, shape = 2, scale = 2)) All.eq(Rinvparalogis, qinvparalogis(Pinvparalogis, shape = 2, scale = 2)) All.eq(Rtrgamma, qtrgamma (Ptrgamma, shape1 = 2, shape2 = 3, scale = 5)) All.eq(Rinvtrgamma, qinvtrgamma (Pinvtrgamma, shape1 = 2, shape2 = 3, scale = 5)) All.eq(Rinvgamma, qinvgamma (Pinvgamma, shape = 2, scale = 5)) All.eq(Rinvweibull, qinvweibull (Pinvweibull, shape = 3, scale = 5)) All.eq(Rinvexp, qinvexp (Pinvexp, scale = 5)) All.eq(Rlgamma, qlgamma(Plgamma, shapelog = 1.5, ratelog = 5)) All.eq(Rgumbel, qgumbel(Pgumbel, alpha = 2, scale = 5)) All.eq(Rinvgauss, qinvgauss(Pinvgauss, mean = 2, dispersion = 5)) All.eq(Rgenbeta, qgenbeta(Pgenbeta, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2)) }) ## Check q(p(.)) identity for special cases stopifnot(exprs = { All.eq(Rfpareto - m, qtrbeta(Pfpareto, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2)) All.eq(Rpareto4 - m, qburr (Ppareto4, shape1 = 0.8, shape2 = 1.5, scale = 2)) All.eq(Rpareto3 - m, qllogis(Ppareto3, shape = 1.5, scale = 2)) All.eq(Rpareto2 - m, qpareto(Ppareto2, shape = 0.8, scale = 2)) }) ## Check q(p(.)) identity with upper tail stopifnot(exprs = { All.eq(Rfpareto, qfpareto(1 - Pfpareto, min = m, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2, lower = FALSE)) All.eq(Rpareto4, qpareto4(1 - Ppareto4, min = m, shape1 = 0.8, shape2 = 1.5, scale = 2, lower = FALSE)) All.eq(Rpareto3, qpareto3(1 - Ppareto3, min = m, shape = 1.5, scale = 2, lower = FALSE)) All.eq(Rpareto2, qpareto2(1 - Ppareto2, min = m, shape = 0.8, scale = 2, lower = FALSE)) All.eq(Rtrbeta, qtrbeta (1 - Ptrbeta, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2, lower = FALSE)) All.eq(Rburr, qburr (1 - Pburr, shape1 = 0.8, shape2 = 1.5, scale = 2, lower = FALSE)) All.eq(Rllogis, qllogis (1 - Pllogis, shape = 1.5, scale = 2, lower = FALSE)) All.eq(Rparalogis, qparalogis (1 - Pparalogis, shape = 0.8, scale = 2, lower = FALSE)) All.eq(Rgenpareto, qgenpareto (1 - Pgenpareto, shape1 = 0.8, shape2 = 2, scale = 2, lower = FALSE)) All.eq(Rpareto, qpareto (1 - Ppareto, shape = 0.8, scale = 2, lower = FALSE)) All.eq(Rpareto1, qpareto1 (1 - Ppareto1, shape = 0.8, min = 2, lower = FALSE)) All.eq(Rinvburr, qinvburr (1 - Pinvburr, shape1 = 1.5, shape2 = 2, scale = 2, lower = FALSE)) All.eq(Rinvpareto, qinvpareto (1 - Pinvpareto, shape = 2, scale = 2, lower = FALSE)) All.eq(Rinvparalogis, qinvparalogis(1 - Pinvparalogis, shape = 2, scale = 2, lower = FALSE)) All.eq(Rtrgamma, qtrgamma (1 - Ptrgamma, shape1 = 2, shape2 = 3, scale = 5, lower = FALSE)) All.eq(Rinvtrgamma, qinvtrgamma (1 - Pinvtrgamma, shape1 = 2, shape2 = 3, scale = 5, lower = FALSE)) All.eq(Rinvgamma, qinvgamma (1 - Pinvgamma, shape = 2, scale = 5, lower = FALSE)) All.eq(Rinvweibull, qinvweibull (1 - Pinvweibull, shape = 3, scale = 5, lower = FALSE)) All.eq(Rinvexp, qinvexp (1 - Pinvexp, scale = 5, lower = FALSE)) All.eq(Rlgamma, qlgamma(1 - Plgamma, shapelog = 1.5, ratelog = 5, lower = FALSE)) All.eq(Rgumbel, qgumbel(1 - Pgumbel, alpha = 2, scale = 5, lower = FALSE)) All.eq(Rinvgauss, qinvgauss(1 - Pinvgauss, mean = 2, dispersion = 5, lower = FALSE)) All.eq(Rgenbeta, qgenbeta(1 - Pgenbeta, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2, lower = FALSE)) }) ## Check q(p(., log), log) identity stopifnot(exprs = { All.eq(Rfpareto, qfpareto(log(Pfpareto), min = m, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2, log = TRUE)) All.eq(Rpareto4, qpareto4(log(Ppareto4), min = m, shape1 = 0.8, shape2 = 1.5, scale = 2, log = TRUE)) All.eq(Rpareto3, qpareto3(log(Ppareto3), min = m, shape = 1.5, scale = 2, log = TRUE)) All.eq(Rpareto2, qpareto2(log(Ppareto2), min = m, shape = 0.8, scale = 2, log = TRUE)) All.eq(Rtrbeta, qtrbeta (log(Ptrbeta), shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2, log = TRUE)) All.eq(Rburr, qburr (log(Pburr), shape1 = 0.8, shape2 = 1.5, scale = 2, log = TRUE)) All.eq(Rllogis, qllogis (log(Pllogis), shape = 1.5, scale = 2, log = TRUE)) All.eq(Rparalogis, qparalogis (log(Pparalogis), shape = 0.8, scale = 2, log = TRUE)) All.eq(Rgenpareto, qgenpareto (log(Pgenpareto), shape1 = 0.8, shape2 = 2, scale = 2, log = TRUE)) All.eq(Rpareto, qpareto (log(Ppareto), shape = 0.8, scale = 2, log = TRUE)) All.eq(Rpareto1, qpareto1 (log(Ppareto1), shape = 0.8, min = 2, log = TRUE)) All.eq(Rinvburr, qinvburr (log(Pinvburr), shape1 = 1.5, shape2 = 2, scale = 2, log = TRUE)) All.eq(Rinvpareto, qinvpareto (log(Pinvpareto), shape = 2, scale = 2, log = TRUE)) All.eq(Rinvparalogis, qinvparalogis(log(Pinvparalogis), shape = 2, scale = 2, log = TRUE)) All.eq(Rtrgamma, qtrgamma (log(Ptrgamma), shape1 = 2, shape2 = 3, scale = 5, log = TRUE)) All.eq(Rinvtrgamma, qinvtrgamma (log(Pinvtrgamma), shape1 = 2, shape2 = 3, scale = 5, log = TRUE)) All.eq(Rinvgamma, qinvgamma (log(Pinvgamma), shape = 2, scale = 5, log = TRUE)) All.eq(Rinvweibull, qinvweibull (log(Pinvweibull), shape = 3, scale = 5, log = TRUE)) All.eq(Rinvexp, qinvexp (log(Pinvexp), scale = 5, log = TRUE)) All.eq(Rlgamma, qlgamma(log(Plgamma), shapelog = 1.5, ratelog = 5, log = TRUE)) All.eq(Rgumbel, qgumbel(log(Pgumbel), alpha = 2, scale = 5, log = TRUE)) All.eq(Rinvgauss, qinvgauss(log(Pinvgauss), mean = 2, dispersion = 5, log = TRUE)) All.eq(Rgenbeta, qgenbeta(log(Pgenbeta), shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2, log = TRUE)) }) ## Check q(p(., log), log) identity with upper tail stopifnot(exprs = { All.eq(Rfpareto, qfpareto(log1p(-Pfpareto), min = m, shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2, lower = FALSE, log = TRUE)) All.eq(Rpareto4, qpareto4(log1p(-Ppareto4), min = m, shape1 = 0.8, shape2 = 1.5, scale = 2, lower = FALSE, log = TRUE)) All.eq(Rpareto3, qpareto3(log1p(-Ppareto3), min = m, shape = 1.5, scale = 2, lower = FALSE, log = TRUE)) All.eq(Rpareto2, qpareto2(log1p(-Ppareto2), min = m, shape = 0.8, scale = 2, lower = FALSE, log = TRUE)) All.eq(Rtrbeta, qtrbeta (log1p(-Ptrbeta), shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2, lower = FALSE, log = TRUE)) All.eq(Rburr, qburr (log1p(-Pburr), shape1 = 0.8, shape2 = 1.5, scale = 2, lower = FALSE, log = TRUE)) All.eq(Rllogis, qllogis (log1p(-Pllogis), shape = 1.5, scale = 2, lower = FALSE, log = TRUE)) All.eq(Rparalogis, qparalogis (log1p(-Pparalogis), shape = 0.8, scale = 2, lower = FALSE, log = TRUE)) All.eq(Rgenpareto, qgenpareto (log1p(-Pgenpareto), shape1 = 0.8, shape2 = 2, scale = 2, lower = FALSE, log = TRUE)) All.eq(Rpareto, qpareto (log1p(-Ppareto), shape = 0.8, scale = 2, lower = FALSE, log = TRUE)) All.eq(Rpareto1, qpareto1 (log1p(-Ppareto1), shape = 0.8, min = 2, lower = FALSE, log = TRUE)) All.eq(Rinvburr, qinvburr (log1p(-Pinvburr), shape1 = 1.5, shape2 = 2, scale = 2, lower = FALSE, log = TRUE)) All.eq(Rinvpareto, qinvpareto (log1p(-Pinvpareto), shape = 2, scale = 2, lower = FALSE, log = TRUE)) All.eq(Rinvparalogis, qinvparalogis(log1p(-Pinvparalogis), shape = 2, scale = 2, lower = FALSE, log = TRUE)) All.eq(Rtrgamma, qtrgamma (log1p(-Ptrgamma), shape1 = 2, shape2 = 3, scale = 5, lower = FALSE, log = TRUE)) All.eq(Rinvtrgamma, qinvtrgamma (log1p(-Pinvtrgamma), shape1 = 2, shape2 = 3, scale = 5, lower = FALSE, log = TRUE)) All.eq(Rinvgamma, qinvgamma (log1p(-Pinvgamma), shape = 2, scale = 5, lower = FALSE, log = TRUE)) All.eq(Rinvweibull, qinvweibull (log1p(-Pinvweibull), shape = 3, scale = 5, lower = FALSE, log = TRUE)) All.eq(Rinvexp, qinvexp (log1p(-Pinvexp), scale = 5, lower = FALSE, log = TRUE)) All.eq(Rlgamma, qlgamma(log1p(-Plgamma), shapelog = 1.5, ratelog = 5, lower = FALSE, log = TRUE)) All.eq(Rgumbel, qgumbel(log1p(-Pgumbel), alpha = 2, scale = 5, lower = FALSE, log = TRUE)) All.eq(Rinvgauss, qinvgauss(log1p(-Pinvgauss), mean = 2, dispersion = 5, lower = FALSE, log = TRUE)) All.eq(Rgenbeta, qgenbeta(log1p(-Pgenbeta), shape1 = 0.8, shape2 = 1.5, shape3 = 2, scale = 2, lower = FALSE, log = TRUE)) }) ### ### DISCRETE DISTRIBUTIONS ### ## Reset seed set.seed(123) ## Define a small function to compute probabilities for the (a, b, 1) ## family of discrete distributions using the recursive relation ## ## p[k] = (a + b/k)p[k - 1], k = 2, 3, ... ## ## for a, b and p[1] given. dab1 <- function(x, a, b, p1) { x <- floor(x) if (x < 1) stop("recursive computations possible for x >= 2 only") for (k in seq(2, length.out = x - 1)) { p2 <- (a + b/k) * p1 p1 <- p2 } p1 } ## ZERO-TRUNCATED (a, b, 1) CLASS ## Tests on the probability mass function: ## ## 1. probability is 0 at x = 0; ## 2. pmf satisfies the recursive relation lambda <- rlnorm(30, 2) # Poisson parameters r <- lambda # size for negative binomial prob <- runif(30) # probs size <- round(lambda) # size for binomial stopifnot(exprs = { dztpois(0, lambda) == 0 dztnbinom(0, r, prob) == 0 dztgeom(0, prob) == 0 dztbinom(0, size, prob) == 0 dlogarithmic(0, prob) == 0 }) x <- sapply(size, sample, size = 1) stopifnot(exprs = { All.eq(dztpois(x, lambda), mapply(dab1, x, a = 0, b = lambda, p1 = lambda/(exp(lambda) - 1))) All.eq(dztnbinom(x, r, prob), mapply(dab1, x, a = 1 - prob, b = (r - 1) * (1 - prob), p1 = r * prob^r * (1 - prob)/(1 - prob^r))) All.eq(dztgeom(x, prob), mapply(dab1, x, a = 1 - prob, b = 0, p1 = prob)) All.eq(dztbinom(x, size, prob), mapply(dab1, x, a = -prob/(1 - prob), b = (size + 1) * prob/(1 - prob), p1 = size * prob * (1 - prob)^(size - 1)/(1 - (1 - prob)^size))) All.eq(dlogarithmic(x, prob), mapply(dab1, x, a = prob, b = -prob, p1 = -prob/log1p(-prob))) }) ## Tests on cumulative distribution function. for (l in lambda) stopifnot(exprs = { all.equal(cumsum(dztpois(0:20, l)), pztpois(0:20, l), tolerance = 1e-8) }) for (i in seq_along(r)) stopifnot(exprs = { all.equal(cumsum(dztnbinom(0:20, r[i], prob[i])), pztnbinom(0:20, r[i], prob[i]), tolerance = 1e-8) }) for (i in seq_along(r)) stopifnot(exprs = { all.equal(cumsum(dztgeom(0:20, prob[i])), pztgeom(0:20, prob[i]), tolerance = 1e-8) }) for (i in seq_along(size)) stopifnot(exprs = { all.equal(cumsum(dztbinom(0:20, size[i], prob[i])), pztbinom(0:20, size[i], prob[i]), tolerance = 1e-8) }) for (p in prob) stopifnot(exprs = { all.equal(cumsum(dlogarithmic(0:20, p)), plogarithmic(0:20, p), tolerance = 1e-8) }) ## ZERO-MODIFIED (a, b, 1) CLASS ## Tests on the probability mass function: ## ## 1. probability is p0 at x = 0 (trivial, but...); ## 2. pmf satisfies the recursive relation lambda <- rlnorm(30, 2) # Poisson parameters r <- lambda # size for negative binomial prob <- runif(30) # probs size <- round(lambda) # size for binomial p0 <- runif(30) # probs at 0 stopifnot(exprs = { dzmpois(0, lambda, p0) == p0 dzmnbinom(0, r, prob, p0) == p0 dzmgeom(0, prob, p0) == p0 dzmbinom(0, size, prob, p0) == p0 dzmlogarithmic(0, prob, p0) == p0 }) x <- sapply(size, sample, size = 1) stopifnot(exprs = { All.eq(dzmpois(x, lambda, p0), mapply(dab1, x, a = 0, b = lambda, p1 = (1 - p0) *lambda/(exp(lambda) - 1))) All.eq(dzmnbinom(x, r, prob, p0), mapply(dab1, x, a = 1 - prob, b = (r - 1) * (1 - prob), p1 = (1 - p0) * r * prob^r * (1 - prob)/(1 - prob^r))) All.eq(dzmgeom(x, prob, p0), mapply(dab1, x, a = 1 - prob, b = 0, p1 = (1 - p0) * prob)) All.eq(dzmbinom(x, size, prob, p0), mapply(dab1, x, a = -prob/(1 - prob), b = (size + 1) * prob/(1 - prob), p1 = (1 - p0) * size * prob * (1 - prob)^(size - 1)/(1 - (1 - prob)^size))) All.eq(dzmlogarithmic(x, prob, p0), mapply(dab1, x, a = prob, b = -prob, p1 = -(1 - p0) * prob/log1p(-prob))) }) ## Tests on cumulative distribution function. for (i in seq_along(lambda)) stopifnot(exprs = { all.equal(cumsum(dzmpois(0:20, lambda[i], p0 = p0[i])), pzmpois(0:20, lambda[i], p0 = p0[i]), tolerance = 1e-8) }) for (i in seq_along(r)) stopifnot(exprs = { all.equal(cumsum(dzmnbinom(0:20, r[i], prob[i], p0[i])), pzmnbinom(0:20, r[i], prob[i], p0[i]), tolerance = 1e-8) }) for (i in seq_along(r)) stopifnot(exprs = { all.equal(cumsum(dzmgeom(0:20, prob[i], p0[i])), pzmgeom(0:20, prob[i], p0[i]), tolerance = 1e-8) }) for (i in seq_along(size)) stopifnot(exprs = { all.equal(cumsum(dzmbinom(0:20, size[i], prob[i], p0[i])), pzmbinom(0:20, size[i], prob[i], p0[i]), tolerance = 1e-8) }) for (i in seq_along(prob)) stopifnot(exprs = { all.equal(cumsum(dzmlogarithmic(0:20, prob[i], p0[i])), pzmlogarithmic(0:20, prob[i], p0[i]), tolerance = 1e-8) }) ## POISSON-INVERSE GAUSSIAN ## Reset seed set.seed(123) ## Define a small function to compute probabilities for the PIG ## directly using the Bessel function. dpigBK <- function(x, mu, phi) { M_LN2 <- 0.693147180559945309417232121458 M_SQRT_2dPI <- 0.225791352644727432363097614947 phimu <- phi * mu lphi <- log(phi) y <- x - 0.5 logA = -lphi/2 - M_SQRT_2dPI logB = (M_LN2 + lphi + log1p(1/(2 * phimu * mu)))/2; exp(logA + 1/phimu - lfactorial(x) - y * logB) * besselK(exp(logB - lphi), y) } ## Tests on the probability mass function. mu <- rlnorm(30, 2) phi <- rlnorm(30, 2) x <- 0:100 for (i in seq_along(phi)) { stopifnot(exprs = { all.equal(dpoisinvgauss(x, mean = mu[i], dispersion = phi[i]), dpigBK(x, mu[i], phi[i])) all.equal(dpoisinvgauss(x, mean = Inf, dispersion = phi[i]), dpigBK(x, Inf, phi[i])) }) } ## Tests on cumulative distribution function. for (i in seq_along(phi)) stopifnot(exprs = { all.equal(cumsum(dpoisinvgauss(0:20, mu[i], phi[i])), ppoisinvgauss(0:20, mu[i], phi[i]), tolerance = 1e-8) all.equal(cumsum(dpoisinvgauss(0:20, Inf, phi[i])), ppoisinvgauss(0:20, Inf, phi[i]), tolerance = 1e-8) }) ## ## RANDOM NUMBERS (all discrete distributions) ## set.seed(123) n <- 20 ## Generate variates. ## ## For zero-modified distributions, we simulate two sets of values: ## one with p0m < p0 (suffix 'p0lt') and one with p0m > p0 (suffix ## 'p0gt'). Rztpois <- rztpois (n, lambda = 12) Rztnbinom <- rztnbinom (n, size = 7, prob = 0.01) Rztgeom <- rztgeom (n, prob = pi/16) Rztbinom <- rztbinom (n, size = 55, prob = pi/16) Rlogarithmic <- rlogarithmic(n, prob = 0.99) Rzmpoisp0lt <- rzmpois (n, lambda = 6, p0 = 0.001) Rzmpoisp0gt <- rzmpois (n, lambda = 6, p0 = 0.010) Rzmnbinomp0lt <- rzmnbinom (n, size = 7, prob = 0.8, p0 = 0.01) Rzmnbinomp0gt <- rzmnbinom (n, size = 7, prob = 0.8, p0 = 0.40) Rzmgeomp0lt <- rzmgeom (n, prob = pi/16, p0 = 0.01) Rzmgeomp0gt <- rzmgeom (n, prob = pi/16, p0 = 0.40) Rzmbinomp0lt <- rzmbinom (n, size = 12, prob = pi/16, p0 = 0.01) Rzmbinomp0gt <- rzmbinom (n, size = 12, prob = pi/16, p0 = 0.12) Rzmlogarithmicp0lt <- rzmlogarithmic(n, prob = 0.99, p0 = 0.05) Rzmlogarithmicp0gt <- rzmlogarithmic(n, prob = 0.99, p0 = 0.55) Rpoisinvgauss <- rpoisinvgauss(n, mean = 12, dispersion = 0.1) RpoisinvgaussInf <- rpoisinvgauss(n, mean = Inf, dispersion = 1.1) ## Compute quantiles Pztpois <- pztpois (Rztpois, lambda = 12) Pztnbinom <- pztnbinom (Rztnbinom, size = 7, prob = 0.01) Pztgeom <- pztgeom (Rztgeom, prob = pi/16) Pztbinom <- pztbinom (Rztbinom, size = 55, prob = pi/16) Plogarithmic <- plogarithmic(Rlogarithmic, prob = 0.99) Pzmpoisp0lt <- pzmpois (Rzmpoisp0lt, lambda = 6, p0 = 0.001) Pzmpoisp0gt <- pzmpois (Rzmpoisp0gt, lambda = 6, p0 = 0.010) Pzmnbinomp0lt <- pzmnbinom (Rzmnbinomp0lt, size = 7, prob = 0.8, p0 = 0.01) Pzmnbinomp0gt <- pzmnbinom (Rzmnbinomp0gt, size = 7, prob = 0.8, p0 = 0.40) Pzmgeomp0lt <- pzmgeom (Rzmgeomp0lt, prob = pi/16, p0 = 0.01) Pzmgeomp0gt <- pzmgeom (Rzmgeomp0gt, prob = pi/16, p0 = 0.40) Pzmbinomp0lt <- pzmbinom (Rzmbinomp0lt, size = 12, prob = pi/16, p0 = 0.01) Pzmbinomp0gt <- pzmbinom (Rzmbinomp0gt, size = 12, prob = pi/16, p0 = 0.12) Pzmlogarithmicp0lt <- pzmlogarithmic(Rzmlogarithmicp0lt, prob = 0.99, p0 = 0.05) Pzmlogarithmicp0gt <- pzmlogarithmic(Rzmlogarithmicp0gt, prob = 0.99, p0 = 0.55) Ppoisinvgauss <- ppoisinvgauss(Rpoisinvgauss, mean = 12, dispersion = 0.1) PpoisinvgaussInf <- ppoisinvgauss(RpoisinvgaussInf, mean = Inf, dispersion = 1.1) ## Just compute pmf Dztpois <- dztpois (Rztpois, lambda = 12) Dztnbinom <- dztnbinom (Rztnbinom, size = 7, prob = 0.01) Dztgeom <- dztgeom (Rztgeom, prob = pi/16) Dztbinom <- dztbinom (Rztbinom, size = 55, prob = pi/16) Dlogarithmic <- dlogarithmic(Rlogarithmic, prob = pi/16) Dzmpoisp0lt <- dzmpois (Rzmpoisp0lt, lambda = 6, p0 = 0.001) Dzmpoisp0gt <- dzmpois (Rzmpoisp0gt, lambda = 6, p0 = 0.010) Dzmnbinomp0lt <- dzmnbinom (Rzmnbinomp0lt, size = 7, prob = 0.8, p0 = 0.01) Dzmnbinomp0gt <- dzmnbinom (Rzmnbinomp0gt, size = 7, prob = 0.8, p0 = 0.40) Dzmgeomp0lt <- dzmgeom (Rzmgeomp0lt, prob = pi/16, p0 = 0.01) Dzmgeomp0gt <- dzmgeom (Rzmgeomp0gt, prob = pi/16, p0 = 0.40) Dzmbinomp0lt <- dzmbinom (Rzmbinomp0lt, size = 12, prob = pi/16, p0 = 0.01) Dzmbinomp0gt <- dzmbinom (Rzmbinomp0gt, size = 12, prob = pi/16, p0 = 0.12) Dzmlogarithmicp0lt <- dzmlogarithmic(Rzmlogarithmicp0lt, prob = 0.99, p0 = 0.05) Dzmlogarithmicp0gt <- dzmlogarithmic(Rzmlogarithmicp0gt, prob = 0.99, p0 = 0.55) Dpoisinvgauss <- dpoisinvgauss(Rpoisinvgauss, mean = 12, dispersion = 0.1) DpoisinvgaussInf <- dpoisinvgauss(RpoisinvgaussInf, mean = Inf, dispersion = 1.1) ## Check q(p(.)) identity stopifnot(exprs = { Rztpois == qztpois (Pztpois, lambda = 12) Rztnbinom == qztnbinom (Pztnbinom, size = 7, prob = 0.01) Rztgeom == qztgeom (Pztgeom, prob = pi/16) Rztbinom == qztbinom (Pztbinom, size = 55, prob = pi/16) Rlogarithmic == qlogarithmic(Plogarithmic, prob = 0.99) Rzmpoisp0lt == qzmpois (Pzmpoisp0lt, lambda = 6, p0 = 0.001) Rzmpoisp0gt == qzmpois (Pzmpoisp0gt, lambda = 6, p0 = 0.010) Rzmnbinomp0lt == qzmnbinom (Pzmnbinomp0lt, size = 7, prob = 0.8, p0 = 0.01) Rzmnbinomp0gt == qzmnbinom (Pzmnbinomp0gt, size = 7, prob = 0.8, p0 = 0.40) Rzmgeomp0lt == qzmgeom (Pzmgeomp0lt, prob = pi/16, p0 = 0.01) Rzmgeomp0gt == qzmgeom (Pzmgeomp0gt, prob = pi/16, p0 = 0.40) Rzmbinomp0lt == qzmbinom (Pzmbinomp0lt, size = 12, prob = pi/16, p0 = 0.01) Rzmbinomp0gt == qzmbinom (Pzmbinomp0gt, size = 12, prob = pi/16, p0 = 0.12) Rzmlogarithmicp0lt == qzmlogarithmic(Pzmlogarithmicp0lt, prob = 0.99, p0 = 0.05) Rzmlogarithmicp0gt == qzmlogarithmic(Pzmlogarithmicp0gt, prob = 0.99, p0 = 0.55) Rpoisinvgauss == qpoisinvgauss(Ppoisinvgauss, mean = 12, dispersion = 0.1) RpoisinvgaussInf == qpoisinvgauss(PpoisinvgaussInf, mean = Inf, dispersion = 1.1) }) ## Check q(p(.)) identity with upper tail stopifnot(exprs = { Rztpois == qztpois (1 - Pztpois, lambda = 12, lower = FALSE) Rztnbinom == qztnbinom (1 - Pztnbinom, size = 7, prob = 0.01, lower = FALSE) Rztgeom == qztgeom (1 - Pztgeom, prob = pi/16, lower = FALSE) Rztbinom == qztbinom (1 - Pztbinom, size = 55, prob = pi/16, lower = FALSE) Rlogarithmic == qlogarithmic(1 - Plogarithmic, prob = 0.99, lower = FALSE) Rzmpoisp0lt == qzmpois (1 - Pzmpoisp0lt, lambda = 6, p0 = 0.001, lower = FALSE) Rzmpoisp0gt == qzmpois (1 - Pzmpoisp0gt, lambda = 6, p0 = 0.010, lower = FALSE) Rzmnbinomp0lt == qzmnbinom (1 - Pzmnbinomp0lt, size = 7, prob = 0.8, p0 = 0.01, lower = FALSE) Rzmnbinomp0gt == qzmnbinom (1 - Pzmnbinomp0gt, size = 7, prob = 0.8, p0 = 0.40, lower = FALSE) Rzmgeomp0lt == qzmgeom (1 - Pzmgeomp0lt, prob = pi/16, p0 = 0.01, lower = FALSE) Rzmgeomp0gt == qzmgeom (1 - Pzmgeomp0gt, prob = pi/16, p0 = 0.40, lower = FALSE) Rzmbinomp0lt == qzmbinom (1 - Pzmbinomp0lt, size = 12, prob = pi/16, p0 = 0.01, lower = FALSE) Rzmbinomp0gt == qzmbinom (1 - Pzmbinomp0gt, size = 12, prob = pi/16, p0 = 0.12, lower = FALSE) Rzmlogarithmicp0lt == qzmlogarithmic(1 - Pzmlogarithmicp0lt, prob = 0.99, p0 = 0.05, lower = FALSE) Rzmlogarithmicp0gt == qzmlogarithmic(1 - Pzmlogarithmicp0gt, prob = 0.99, p0 = 0.55, lower = FALSE) Rpoisinvgauss == qpoisinvgauss(1 - Ppoisinvgauss, mean = 12, dispersion = 0.1, lower = FALSE) RpoisinvgaussInf == qpoisinvgauss(1 - PpoisinvgaussInf, mean = Inf, dispersion = 1.1, lower = FALSE) }) ## Check q(p(., log), log) identity stopifnot(exprs = { Rztpois == qztpois (log(Pztpois), lambda = 12, log = TRUE) Rztnbinom == qztnbinom (log(Pztnbinom), size = 7, prob = 0.01, log = TRUE) Rztgeom == qztgeom (log(Pztgeom), prob = pi/16, log = TRUE) Rztbinom == qztbinom (log(Pztbinom), size = 55, prob = pi/16, log = TRUE) Rlogarithmic == qlogarithmic(log(Plogarithmic), prob = 0.99, log = TRUE) Rzmpoisp0lt == qzmpois (log(Pzmpoisp0lt), lambda = 6, p0 = 0.001, log = TRUE) Rzmpoisp0gt == qzmpois (log(Pzmpoisp0gt), lambda = 6, p0 = 0.010, log = TRUE) Rzmnbinomp0lt == qzmnbinom (log(Pzmnbinomp0lt), size = 7, prob = 0.8, p0 = 0.01, log = TRUE) Rzmnbinomp0gt == qzmnbinom (log(Pzmnbinomp0gt), size = 7, prob = 0.8, p0 = 0.40, log = TRUE) Rzmgeomp0lt == qzmgeom (log(Pzmgeomp0lt), prob = pi/16, p0 = 0.01, log = TRUE) Rzmgeomp0gt == qzmgeom (log(Pzmgeomp0gt), prob = pi/16, p0 = 0.40, log = TRUE) Rzmbinomp0lt == qzmbinom (log(Pzmbinomp0lt), size = 12, prob = pi/16, p0 = 0.01, log = TRUE) Rzmbinomp0gt == qzmbinom (log(Pzmbinomp0gt), size = 12, prob = pi/16, p0 = 0.12, log = TRUE) Rzmlogarithmicp0lt == qzmlogarithmic(log(Pzmlogarithmicp0lt), prob = 0.99, p0 = 0.05, log = TRUE) Rzmlogarithmicp0gt == qzmlogarithmic(log(Pzmlogarithmicp0gt), prob = 0.99, p0 = 0.55, log = TRUE) Rpoisinvgauss == qpoisinvgauss(log(Ppoisinvgauss), mean = 12, dispersion = 0.1, log = TRUE) RpoisinvgaussInf == qpoisinvgauss(log(PpoisinvgaussInf), mean = Inf, dispersion = 1.1, log = TRUE) }) ## Check q(p(., log), log) identity with upper tail stopifnot(exprs = { Rztpois == qztpois (log1p(-Pztpois), lambda = 12, lower = FALSE, log = TRUE) Rztnbinom == qztnbinom (log1p(-Pztnbinom), size = 7, prob = 0.01, lower = FALSE, log = TRUE) Rztgeom == qztgeom (log1p(-Pztgeom), prob = pi/16, lower = FALSE, log = TRUE) Rztbinom == qztbinom (log1p(-Pztbinom), size = 55, prob = pi/16, lower = FALSE, log = TRUE) Rlogarithmic == qlogarithmic(log1p(-Plogarithmic), prob = 0.99, lower = FALSE, log = TRUE) Rzmpoisp0lt == qzmpois (log1p(-Pzmpoisp0lt), lambda = 6, p0 = 0.001, lower = FALSE, log = TRUE) Rzmpoisp0gt == qzmpois (log1p(-Pzmpoisp0gt), lambda = 6, p0 = 0.010, lower = FALSE, log = TRUE) Rzmnbinomp0lt == qzmnbinom (log1p(-Pzmnbinomp0lt), size = 7, prob = 0.8, p0 = 0.01, lower = FALSE, log = TRUE) Rzmnbinomp0gt == qzmnbinom (log1p(-Pzmnbinomp0gt), size = 7, prob = 0.8, p0 = 0.40, lower = FALSE, log = TRUE) Rzmgeomp0lt == qzmgeom (log1p(-Pzmgeomp0lt), prob = pi/16, p0 = 0.01, lower = FALSE, log = TRUE) Rzmgeomp0gt == qzmgeom (log1p(-Pzmgeomp0gt), prob = pi/16, p0 = 0.40, lower = FALSE, log = TRUE) Rzmbinomp0lt == qzmbinom (log1p(-Pzmbinomp0lt), size = 12, prob = pi/16, p0 = 0.01, lower = FALSE, log = TRUE) Rzmbinomp0gt == qzmbinom (log1p(-Pzmbinomp0gt), size = 12, prob = pi/16, p0 = 0.12, lower = FALSE, log = TRUE) Rzmlogarithmicp0lt == qzmlogarithmic(log1p(-Pzmlogarithmicp0lt), prob = 0.99, p0 = 0.05, lower = FALSE, log = TRUE) Rzmlogarithmicp0gt == qzmlogarithmic(log1p(-Pzmlogarithmicp0gt), prob = 0.99, p0 = 0.55, lower = FALSE, log = TRUE) Rpoisinvgauss == qpoisinvgauss(log1p(-Ppoisinvgauss), mean = 12, dispersion = 0.1, lower = FALSE, log = TRUE) RpoisinvgaussInf == qpoisinvgauss(log1p(-PpoisinvgaussInf), mean = Inf, dispersion = 1.1, lower = FALSE, log = TRUE) }) actuar/tests/rmixture-tests.R0000644000176200001440000000742514522557714016061 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Tests for the simulation of discrete mixtures with 'rmixture'. ### ### AUTHOR: Vincent Goulet ## Load the package library(actuar) ## Copy of tools::assertError. assertError <- tools::assertError ## Set common values for the tests n <- 20 bmodels <- expression(rexp(1/20), rlnorm(3.6, 0.6), rpareto(shape = 4, scale = 240)) ## Function to inject the number of variates in an expression and ## evaluate it. f <- function(n, expr) { expr$n <- n eval(expr) } ## Test a "normal" case (with data that is not reshuffled). set.seed(123) probs <- c(2, 3, 5)/10 nj <- rmultinom(1, n, prob = probs) x <- c(f(nj[1], bmodels[[1]]), f(nj[2], bmodels[[2]]), f(nj[3], bmodels[[3]])) set.seed(123) stopifnot(exprs = { identical(x, rmixture(n, probs, bmodels, shuffle = FALSE)) }) ## Test recycling of the probability vector. set.seed(123) probs <- 1 nj <- rmultinom(1, n, prob = rep_len(probs, 3)) x <- c(f(nj[1], bmodels[[1]]), f(nj[2], bmodels[[2]]), f(nj[3], bmodels[[3]])) set.seed(123) stopifnot(exprs = { identical(x, rmixture(n, probs, bmodels, shuffle = FALSE)) }) ## Test recycling of the models vector. set.seed(123) probs <- c(2, 3, 5) nj <- rmultinom(1, n, prob = probs) x <- f(n, bmodels[[1]]) set.seed(123) stopifnot(exprs = { identical(x, rmixture(n, probs, bmodels[1], shuffle = FALSE)) }) ## Test special cases. stopifnot(exprs = { identical(numeric(0), rmixture(0, probs, bmodels)) identical(2L, length(rmixture(c(n, n), probs, bmodels))) }) ## Test the calling environment, that is that arguments are correctly ## identified when 'rmixture' is called inside another function. set.seed(123) probs <- c(2, 3, 5)/10 x <- rmixture(n, probs, bmodels) f <- function(n, p, model) rmixture(n, p, model) g <- function(n, p, m, q) rmixture(n, p, expression(rexp(m[1]), rlnorm(m[2], q[2]), rpareto(m[3], q[3]))) h <- function(n, p, model) f(n, c(p[1], p[2], p[3]), c(model[1], model[2], model[3])) k <- function(n, p, m, q) { ## Pathological case where the models expression does not evaluate ## in the frame of 'rmixture' as 'm' and 'q' will not be bound. ## The fix is to substitute variables by their values. models <- substitute(expression(rexp(m[1]), rlnorm(m[2], q[2]), rpareto(m[3], q[3])), list(m = m, q = q)) f(n, p, eval(models)) } stopifnot(exprs = { identical(x, { set.seed(123) f(n, probs, bmodels) }) identical(x, { set.seed(123) f(n, c(probs[1], probs[2], probs[3]), c(bmodels[1], bmodels[2], bmodels[3])) }) identical(x, { set.seed(123) g(n, p = probs, m = c(eval(bmodels[[c(1, 2)]]), eval(bmodels[[c(2, 2)]]), eval(bmodels[[c(3, 2)]])), q = c(NA, eval(bmodels[[c(2, 3)]]), eval(bmodels[[c(3, 3)]]))) }) identical(x, { set.seed(123) h(n, probs, expression(rexp(eval(bmodels[[c(1, 2)]])), rlnorm(eval(bmodels[[c(2, 2)]]), eval(bmodels[[c(2, 3)]])), rpareto(shape = eval(bmodels[[c(3, 2)]]), scale = eval(bmodels[[c(3, 3)]])))) }) identical(x, { set.seed(123) k(n, p = probs, m = c(eval(bmodels[[c(1, 2)]]), eval(bmodels[[c(2, 2)]]), eval(bmodels[[c(3, 2)]])), q = c(NA, eval(bmodels[[c(2, 3)]]), eval(bmodels[[c(3, 3)]]))) }) }) ## Finally, test invalid arguments. assertError(rmixture(-1, probs, bmodels)) assertError(rmixture(c(3, -1), probs, bmodels)) assertError(rmixture(n, numeric(0), bmodels)) assertError(rmixture(n, 0, bmodels)) assertError(rmixture(n, c(0, 0), bmodels)) assertError(rmixture(n, probs, c(rexp(2), rexp(7)))) actuar/tests/rcompound-tests.R0000644000176200001440000001113414522557714016200 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Tests for the simulation of compound models with 'rcompound' and ### 'rcomppois'. ### ### AUTHOR: Vincent Goulet ## Load the package library(actuar) ## Copy of tools::assertError. assertError <- tools::assertError ### ### Tests for rcompound ### ## Test the function itself with various types of arguments. n <- 20 fmodel <- expression(rnbinom(2, 0.8)) smodel <- expression(rgamma(2, 1)) set.seed(123) x <- numeric(n) N <- rnbinom(n, 2, 0.8) y <- rgamma(sum(N), 2, 1) x[which(N != 0)] <- tapply(y, rep(seq_len(n), N), sum) stopifnot(exprs = { identical(x, { set.seed(123) rcompound(n, rnbinom(2, 0.8), rgamma(2, 1)) }) identical(x, { set.seed(123) rcompound(n, rnbinom(2, 0.8), expression(rgamma(2, 1))) }) identical(x, { set.seed(123) rcompound(n, expression(rnbinom(2, 0.8)), rgamma(2, 1)) }) identical(x, { set.seed(123) rcompound(n, fmodel, smodel) }) }) ## Test the calling environment, that is that arguments are correctly ## identified when 'rcompound' is called inside another function. n <- 20 lambda <- 2 smodel <- expression(rgamma(2, 1)) set.seed(123) x <- rcompound(n, rpois(2), rgamma(2, 1)) f <- function(n, p, model.sev) { ## safe way to pass down the arguments model.freq <- substitute(rpois(p), list(p = p)) model.sev <- substitute(model.sev) if (is.name(model.sev)) model.sev <- eval.parent(model.sev) rcompound(n, model.freq, model.sev) } g1 <- function(n, p, s, r) rcompound(n, rpois(p), rgamma(s, r)) g2 <- function(n, p, s, r) rcompound(n, expression(rpois(p)), expression(rgamma(s, r))) h <- function(n, p, model.sev) { ## safe way to pass down the arguments model.sev <- substitute(model.sev) if (is.name(model.sev)) model.sev <- eval.parent(model.sev) f(n, p, model.sev) } stopifnot(exprs = { identical(x, { set.seed(123) f(n, 2, rgamma(2, 1)) }) identical(x, { set.seed(123) f(n, lambda, expression(rgamma(2, 1))) }) identical(x, { set.seed(123) f(n, lambda, smodel) }) identical(x, { set.seed(123) g1(n, lambda, 2, 1) }) identical(x, { set.seed(123) g2(n, lambda, 2, 1) }) identical(x, { set.seed(123) h(n, 2, rgamma(2, 1)) }) identical(x, { set.seed(123) h(n, lambda, smodel) }) }) ## Test invalid arguments. assertError(rcompound(-1, rpois(2), rgamma(2, 1))) ### ### Tests for rcomppois ### ## Test the function itself with various types of arguments. n <- 20 lambda <- 2 smodel <- expression(rgamma(2, 1)) set.seed(123) x <- numeric(n) N <- rpois(n, 2) y <- rgamma(sum(N), 2, 1) x[which(N != 0)] <- tapply(y, rep(seq_len(n), N), sum) stopifnot(exprs = { identical(x, { set.seed(123) rcomppois(n, 2, rgamma(2, 1)) }) identical(x, { set.seed(123) rcomppois(n, lambda, expression(rgamma(2, 1))) }) identical(x, { set.seed(123) rcomppois(n, lambda, smodel) }) }) ## Test the calling environment, that is that arguments are correctly ## identified when 'rcomppois' is called inside another function. n <- 20 lambda <- 2 smodel <- expression(rgamma(2, 1)) set.seed(123) x <- rcomppois(n, lambda, smodel) f <- function(n, p, model) { ## safe way to pass down all sorts of 'model' objects model <- substitute(model) if (is.name(model)) model <- eval.parent(model) rcomppois(n, p, model) } g1 <- function(n, p, s, r) rcomppois(n, p, rgamma(s, r)) g2 <- function(n, p, s, r) rcomppois(n, p, expression(rgamma(s, r))) h <- function(n, p, model) { ## safe way to pass down all sorts of 'model' objects model <- substitute(model) if (is.name(model)) model <- eval.parent(model) f(n, p, model) } stopifnot(exprs = { identical(x, { set.seed(123) f(n, 2, rgamma(2, 1)) }) identical(x, { set.seed(123) f(n, lambda, expression(rgamma(2, 1))) }) identical(x, { set.seed(123) f(n, lambda, smodel) }) identical(x, { set.seed(123) g1(n, 2, 2, 1) }) identical(x, { set.seed(123) g2(n, 2, 2, 1) }) identical(x, { set.seed(123) h(n, 2, rgamma(2, 1)) }) identical(x, { set.seed(123) h(n, lambda, smodel) }) }) ## Test invalid arguments. assertError(rcomppois(-1, lambda, smodel)) assertError(rcomppois(n, -1, smodel)) assertError(rcomppois(n, c(3, -1), smodel)) actuar/tests/betaint-tests.R0000644000176200001440000000346314264305077015622 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Tests for the "beta integral" ### ### B(a, b; x) = Gamma(a + b) int_0^x t^(a-1) (1 - t)^(b-1) dt ### ### Inspired by (and some parts taken from) `tests/d-p-q-r-tests.R` in ### R sources. ### ### AUTHOR: Vincent Goulet with ### indirect help from the R Core Team ## Load the package library(actuar) ## Define a "local" version of the otherwise non-exported function ## 'betaint'. betaint <- actuar:::betaint ## Special values and utilities. Taken from `tests/d-p-q-r-tests.R`. xMax <- 1 - .Machine$double.eps xMin <- .Machine$double.xmin All.eq <- function(x, y) { all.equal.numeric(x, y, tolerance = 64 * .Machine$double.eps, scale = max(0, mean(abs(x), na.rm = TRUE))) } if(!interactive()) set.seed(123) ## Limiting cases stopifnot(exprs = { !is.finite(betaint(0.3, Inf, 2)) !is.finite(betaint(0.3, Inf, -2.2)) is.nan (betaint(0.3, 0, 2)) !is.finite(betaint(0.3, 2, Inf)) is.nan (betaint(0.3, 2, -2.2)) # a <= 1 + floor(-b) is.nan (betaint(0.3, 2, 0)) }) ## Tests for cases with b > 0 x <- c(xMin, runif(10), xMax) b <- 2 for (a in rlnorm(5, 2)) stopifnot(exprs = { All.eq(betaint(x, a, b), gamma(a) * gamma(b) * pbeta(x, a, b)) }) ## Tests for cases with b < 0 b <- -2.2 r <- floor(-b) # r = 2 for (a in 1 + r + rlnorm(5, 2)) { s <- (x^(a-1) * (1-x)^b)/b + ((a-1) * x^(a-2) * (1-x)^(b+1))/(b * (b+1)) + ((a-1) * (a-2) * x^(a-3) * (1-x)^(b+2))/(b * (b+1) * (b+2)) stopifnot(exprs = { all.equal(betaint(x, a, b), -gamma(a+b) * s + (a-1)*(a-2)*(a-3) * gamma(a-r-1)/(b*(b+1)*(b+2)) * gamma(b+r+1)*pbeta(x, a-r-1, b+r+1)) }) } actuar/src/0000755000176200001440000000000014522560035012322 5ustar liggesusersactuar/src/exp.c0000644000176200001440000000307014264305077013270 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to calculate raw and limited moments for the Exponential * distribution. See ../R/ExponentialSupp.R for details. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" double mexp(double order, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(scale)) return order + scale; #endif if (!R_FINITE(scale) || !R_FINITE(order) || scale <= 0.0) return R_NaN; if (order <= -1.0) return R_PosInf; return R_pow(scale, order) * gammafn(1.0 + order); } double levexp(double limit, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(scale) || ISNAN(order)) return limit + scale + order; #endif if (!R_FINITE(scale) || !R_FINITE(order) || scale <= 0.0) return R_NaN; if (order <= -1.0) return R_PosInf; if (limit <= 0.0) return 0.0; double u, tmp; tmp = 1.0 + order; u = exp(log(limit) - log(scale)); return R_pow(scale, order) * gammafn(tmp) * pgamma(u, tmp, 1.0, 1, 0) + ACT_DLIM__0(limit, order) * exp(-u); } double mgfexp(double t, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(t) || ISNAN(scale)) return t + scale; #endif if (!R_FINITE(scale) || scale <= 0.0 || scale * t > 1.0) return R_NaN; if (t == 0.0) return ACT_D__1; return ACT_D_exp(-log1p(-scale * t)); } actuar/src/ztgeom.c0000644000176200001440000000502214264305077014000 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute probability function, cumulative distribution * and quantile functions, and to simulate random variates for the * zero-truncated geometric distribution. See * ../R/ZeroTruncatedGeometric.R for details. * * Zero-truncated distributions have density * * Pr[Z = x] = Pr[X = x]/(1 - Pr[X = 0]), * * and distribution function * * Pr[Z <= x] = (Pr[X <= x] - Pr[X = 0])/(1 - Pr[X = 0]) * * or, alternatively, survival function * * Pr[Z > x] = Pr[X > x]/(1 - Pr[X = 0]). * * AUTHOR: Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" /* The geometric distribution has * * F(0) = Pr[X = 0] = prob. * * Limiting case: prob == 1 is point mass at x = 1. */ double dztgeom(double x, double prob, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(prob)) return x + prob; #endif if (prob <= 0 || prob > 1) return R_NaN; if (x < 1 || !R_FINITE(x)) return ACT_D__0; /* limiting case as prob approaches one is point mass at one */ if (prob == 1) return (x == 1) ? ACT_D__1 : ACT_D__0; return ACT_D_val(dgeom(x - 1, prob, /*give_log*/0)); } double pztgeom(double x, double prob, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(prob)) return x + prob; #endif if (prob <= 0 || prob > 1) return R_NaN; if (x < 1) return ACT_DT_0; if (!R_FINITE(x)) return ACT_DT_1; /* limiting case as prob approaches one is point mass at one */ if (prob == 1) return (x >= 1) ? ACT_DT_1 : ACT_DT_0; return ACT_DT_Cval(pgeom(x - 1, prob, /*l._t.*/0, /*log_p*/0)); } double qztgeom(double x, double prob, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(prob)) return x + prob; #endif if (prob <= 0 || prob > 1) return R_NaN; /* limiting case as prob approaches one is point mass at one */ if (prob == 1) { /* simplified ACT_Q_P01_boundaries macro */ if (log_p) { if (x > 0) return R_NaN; return 1.0; } else /* !log_p */ { if (x < 0 || x > 1) return R_NaN; return 1.0; } } ACT_Q_P01_boundaries(x, 1, R_PosInf); x = ACT_DT_qIv(x); return 1 + qgeom(x, prob, /*l._t.*/1, /*log_p*/0); } double rztgeom(double prob) { if (!R_FINITE(prob) || prob <= 0 || prob > 1) return R_NaN; /* limiting case as p approaches one is point mass at one */ if (prob == 1) return 1.0; return 1 + rpois(exp_rand() * ((1 - prob) / prob)); } actuar/src/poisinvgauss.c0000644000176200001440000001226314264305077015232 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, and to simulate random variates for the Poisson-inverse * gaussian distribution. See ../R/PoissonInverseGaussian.R for * details. * * We work with the density expressed as * * p(x) = sqrt(1/phi) sqrt(1/(pi/2)) exp(1/(phi mu))/x! * * [sqrt(2 phi (1 + (2 phi mu^2)^(-1)))]^(-(x - 0.5)) * * bessel_k(sqrt(2/phi (1 + (2 phi mu^2)^(-1))), x - 0.5) * * or, is essence, * * p(x) = A exp(1/(phi mu))/x! B^(-y) bessel_k(B/phi, y) * * The limiting case mu = Inf is handled "automatically" with terms * going to zero when mu is Inf. Specific code not worth it since the * function should rarely be evaluated with mu = Inf in practice. * * AUTHOR: Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dpoisinvgauss_raw(double x, double mu, double phi, int give_log) { /* Here assume that x is integer, 0 < x < Inf, mu > 0, 0 < phi < Inf */ int i; double p, pi1m, pi2m; double twophi = phi + phi; /* limiting case mu = Inf with simpler recursive formulas */ if (!R_FINITE(mu)) { p = -sqrt(2/phi); /* log p[0] */ if (x == 0.0) return ACT_D_exp(p); pi2m = exp(p); /* p[i - 2] = p[0]*/ p = p - (M_LN2 + log(phi))/2; /* log p[1] */ if (x == 1.0) return ACT_D_exp(p); pi1m = exp(p); /* p[i - 1] = p[1] */ for (i = 2; i <= x; i++) { p = (1 - 1.5/i) * pi1m + pi2m/twophi/(i * (i - 1)); pi2m = pi1m; pi1m = p; } return ACT_D_val(p); } /* else: "standard" case with mu < Inf */ double A, B; double mu2 = mu * mu; double twophimu2 = twophi * mu2; p = (1.0 - sqrt(1.0 + twophimu2))/phi/mu; /* log p[0] */ if (x == 0.0) return ACT_D_exp(p); pi2m = exp(p); /* p[i - 2] = p[0]*/ p = log(mu) + p - log1p(twophimu2)/2.0; /* log p[1] */ if (x == 1.0) return ACT_D_exp(p); pi1m = exp(p); /* p[i - 1] = p[1] */ A = 1.0/(1.0 + 1.0/twophimu2); /* constant in first term */ B = mu2/(1.0 + twophimu2); /* constant in second term */ for (i = 2; i <= x; i++) { p = A * (1 - 1.5/i) * pi1m + (B * pi2m)/(i * (i - 1)); pi2m = pi1m; pi1m = p; } return ACT_D_val(p); } double dpoisinvgauss(double x, double mu, double phi, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(mu) || ISNAN(phi)) return x + mu + phi; #endif if (mu <= 0.0 || phi <= 0.0) return R_NaN; ACT_D_nonint_check(x); if (!R_FINITE(x) || x < 0.0) return ACT_D__0; /* limiting case phi = Inf */ if (!R_FINITE(phi)) return (x == 0) ? ACT_D__1 : ACT_D__0; return dpoisinvgauss_raw(x, mu, phi, give_log); } /* For ppoisinvgauss(), there does not seem to be algorithms much * more elaborate than successive computations of the probabilities. */ double ppoisinvgauss(double q, double mu, double phi, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(mu) || ISNAN(phi)) return q + mu + phi; #endif if (mu <= 0.0 || phi <= 0.0) return R_NaN; if (q < 0) return ACT_DT_0; /* limiting case phi = Inf */ if (!R_FINITE(phi)) return ACT_DT_1; if (!R_FINITE(q)) return ACT_DT_1; int x; double s = 0; for (x = 0; x <= q; x++) s += dpoisinvgauss_raw(x, mu, phi, /*give_log*/ 0); return ACT_DT_val(s); } /* For qpoisinvgauss() we mostly reuse the code from qnbinom() et al. * of R sources. From src/nmath/qnbinom.c: * * METHOD * * Uses the Cornish-Fisher Expansion to include a skewness * correction to a normal approximation. This gives an * initial value which never seems to be off by more than * 1 or 2. A search is then conducted of values close to * this initial start point. * * For the limiting case mu = Inf (that has no finite moments), we * use instead the quantile of an inverse chi-square distribution as * starting point. */ #define _thisDIST_ poisinvgauss #define _dist_PARS_DECL_ double mu, double phi #define _dist_PARS_ mu, phi #include "qDiscrete_search.h" /* do_search() et al. */ double qpoisinvgauss(double p, double mu, double phi, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(mu) || ISNAN(phi)) return p + mu + phi; #endif if (mu <= 0.0 || phi <= 0.0) return R_NaN; /* limiting case phi = Inf */ if (!R_FINITE(phi)) return 0.0; ACT_Q_P01_boundaries(p, 0, R_PosInf); double phim2 = phi * mu * mu, sigma2 = phim2 * mu + mu, sigma = sqrt(sigma2), gamma = (3 * phim2 * sigma2 + mu)/sigma2/sigma; /* q_DISCRETE_01_CHECKS(); */ /* limiting case mu = Inf -> inverse chi-square as starting point*/ /* other cases -> Cornish-Fisher as usual */ double z, y; if (!R_FINITE(mu)) y = ACT_forceint(1/phi/qchisq(p, 1, lower_tail, log_p)); else { z = qnorm(p, 0., 1., lower_tail, log_p); y = ACT_forceint(mu + sigma * (z + gamma * (z*z - 1) / 6)); } q_DISCRETE_BODY(); } double rpoisinvgauss(double mu, double phi) { if (mu <= 0.0 || phi <= 0.0) return R_NaN; return rpois(rinvgauss(mu, phi)); } actuar/src/actuar.h0000644000176200001440000003103714326564170013764 0ustar liggesusers#include /*Error messages */ #define R_MSG_NA _("NaNs produced") /* Interfaces to routines from package expint */ extern double(*actuar_gamma_inc)(double,double); /* Functions accessed from .External() */ SEXP actuar_do_dpq(SEXP); SEXP actuar_do_dpq0(int, SEXP); SEXP actuar_do_dpq1(int, SEXP); SEXP actuar_do_dpq2(int, SEXP); SEXP actuar_do_dpq3(int, SEXP); SEXP actuar_do_dpq4(int, SEXP); SEXP actuar_do_dpq5(int, SEXP); SEXP actuar_do_dpq6(int, SEXP); SEXP actuar_do_random(SEXP); SEXP actuar_do_random1(int, SEXP, SEXPTYPE); SEXP actuar_do_random2(int, SEXP, SEXPTYPE); SEXP actuar_do_random3(int, SEXP, SEXPTYPE); SEXP actuar_do_random4(int, SEXP, SEXPTYPE); SEXP actuar_do_random5(int, SEXP, SEXPTYPE); SEXP actuar_do_dpqphtype(SEXP); SEXP actuar_do_dpqphtype2(int, SEXP); SEXP actuar_do_randomphtype(SEXP); SEXP actuar_do_randomphtype2(int, SEXP, SEXPTYPE); SEXP actuar_do_betaint(SEXP); SEXP actuar_do_hierarc(SEXP); SEXP actuar_do_panjer(SEXP); /* Utility functions */ /* Matrix algebra */ void actuar_expm(double *, int, double *); double actuar_expmprod(double *, double *, double *, int); void actuar_matpow(double *, int, int, double *); void actuar_solve(double *, double *, int, int, double *); /* Special integrals */ double betaint(double, double, double); double betaint_raw(double, double, double, double); /* Sampling */ int SampleSingleValue(int, double *); /* One parameter distributions */ double mexp(double, double, int); double levexp(double, double, double, int); double mgfexp(double, double, int); double dinvexp(double, double, int); double pinvexp(double, double, int, int); double qinvexp(double, double, int, int); double rinvexp(double); double minvexp(double, double, int); double levinvexp(double, double, double, int); double dlogarithmic(double, double, int); double plogarithmic(double, double, int, int); double qlogarithmic(double, double, int, int); double rlogarithmic(double); double dztpois(double, double, int); double pztpois(double, double, int, int); double qztpois(double, double, int, int); double rztpois(double); double dztgeom(double, double, int); double pztgeom(double, double, int, int); double qztgeom(double, double, int, int); double rztgeom(double); /* Two parameter distributions */ double munif(double, double, double, int); double levunif(double, double, double, double, int); double mgfunif(double, double, double, int); double mnorm(double, double, double, int); double mgfnorm(double, double, double, int); double mbeta(double, double, double, int); double levbeta(double, double, double, double, int); double mgamma(double, double, double, int); double levgamma(double, double, double, double, int); double mgfgamma(double, double, double, int); double mchisq(double, double, double, int); double levchisq(double, double, double, double, int); double mgfchisq(double, double, double, int); double dinvgamma(double, double, double, int); double pinvgamma(double, double, double, int, int); double qinvgamma(double, double, double, int, int); double rinvgamma(double, double); double minvgamma(double, double, double, int); double levinvgamma(double, double, double, double, int); double mgfinvgamma(double, double, double, int); double dinvparalogis(double, double, double, int); double pinvparalogis(double, double, double, int, int); double qinvparalogis(double, double, double, int, int); double rinvparalogis(double, double); double minvparalogis(double, double, double, int); double levinvparalogis(double, double, double, double, int); double dinvpareto(double, double, double, int); double pinvpareto(double, double, double, int, int); double qinvpareto(double, double, double, int, int); double rinvpareto(double, double); double minvpareto(double, double, double, int); double levinvpareto(double, double, double, double, int); double dinvweibull(double, double, double, int); double pinvweibull(double, double, double, int, int); double qinvweibull(double, double, double, int, int); double rinvweibull(double, double); double minvweibull(double, double, double, int); double levinvweibull(double, double, double, double, int); double dlgamma(double, double, double, int); double plgamma(double, double, double, int, int); double qlgamma(double, double, double, int, int); double rlgamma(double, double); double mlgamma(double, double, double, int); double levlgamma(double, double, double, double, int); double dllogis(double, double, double, int); double pllogis(double, double, double, int, int); double qllogis(double, double, double, int, int); double rllogis(double, double); double mllogis(double, double, double, int); double levllogis(double, double, double, double, int); double mlnorm(double, double, double, int); double levlnorm(double, double, double, double, int); double dparalogis(double, double, double, int); double pparalogis(double, double, double, int, int); double qparalogis(double, double, double, int, int); double rparalogis(double, double); double mparalogis(double, double, double, int); double levparalogis(double, double, double, double, int); double dpareto(double, double, double, int); double ppareto(double, double, double, int, int); double qpareto(double, double, double, int, int); double rpareto(double, double); double mpareto(double, double, double, int); double levpareto(double, double, double, double, int); double dpareto1(double, double, double, int); double ppareto1(double, double, double, int, int); double qpareto1(double, double, double, int, int); double rpareto1(double, double); double mpareto1(double, double, double, int); double levpareto1(double, double, double, double, int); double mweibull(double, double, double, int); double levweibull(double, double, double, double, int); double dgumbel(double, double, double, int); double pgumbel(double, double, double, int, int); double qgumbel(double, double, double, int, int); double rgumbel(double, double); double mgumbel(double, double, double, int); double mgfgumbel(double, double, double, int); double dinvgauss(double, double, double, int); double pinvgauss(double, double, double, int, int); double qinvgauss(double, double, double, int, int, double, int, int); double rinvgauss(double, double); double minvgauss(double, double, double, int); double levinvgauss(double, double, double, double, int); double mgfinvgauss(double, double, double, int); double dztnbinom(double, double, double, int); double pztnbinom(double, double, double, int, int); double qztnbinom(double, double, double, int, int); double rztnbinom(double, double); double dztbinom(double, double, double, int); double pztbinom(double, double, double, int, int); double qztbinom(double, double, double, int, int); double rztbinom(double, double); double dzmlogarithmic(double, double, double, int); double pzmlogarithmic(double, double, double, int, int); double qzmlogarithmic(double, double, double, int, int); double rzmlogarithmic(double, double); double dzmpois(double, double, double, int); double pzmpois(double, double, double, int, int); double qzmpois(double, double, double, int, int); double rzmpois(double, double); double dzmgeom(double, double, double, int); double pzmgeom(double, double, double, int, int); double qzmgeom(double, double, double, int, int); double rzmgeom(double, double); double dpoisinvgauss(double, double, double, int); double ppoisinvgauss(double, double, double, int, int); double qpoisinvgauss(double, double, double, int, int); double rpoisinvgauss(double, double); /* Three parameter distributions */ double dburr(double, double, double, double, int); double pburr(double, double, double, double, int, int); double qburr(double, double, double, double, int, int); double rburr(double, double, double); double mburr(double, double, double, double, int); double levburr(double, double, double, double, double, int); double dgenpareto(double, double, double, double, int); double pgenpareto(double, double, double, double, int, int); double qgenpareto(double, double, double, double, int, int); double rgenpareto(double, double, double); double mgenpareto(double, double, double, double, int); double levgenpareto(double, double, double, double, double, int); double dinvburr(double, double, double, double, int); double pinvburr(double, double, double, double, int, int); double qinvburr(double, double, double, double, int, int); double rinvburr(double, double, double); double minvburr(double, double, double, double, int); double levinvburr(double, double, double, double, double, int); double dinvtrgamma(double, double, double, double, int); double pinvtrgamma(double, double, double, double, int, int); double qinvtrgamma(double, double, double, double, int, int); double rinvtrgamma(double, double, double); double minvtrgamma(double, double, double, double, int); double levinvtrgamma(double, double, double, double, double, int); double dtrgamma(double, double, double, double, int); double ptrgamma(double, double, double, double, int, int); double qtrgamma(double, double, double, double, int, int); double rtrgamma(double, double, double); double mtrgamma(double, double, double, double, int); double levtrgamma(double, double, double, double, double, int); double dpareto2(double, double, double, double, int); double ppareto2(double, double, double, double, int, int); double qpareto2(double, double, double, double, int, int); double rpareto2(double, double, double); double mpareto2(double, double, double, double, int); double levpareto2(double, double, double, double, double, int); double dpareto3(double, double, double, double, int); double ppareto3(double, double, double, double, int, int); double qpareto3(double, double, double, double, int, int); double rpareto3(double, double, double); double mpareto3(double, double, double, double, int); double levpareto3(double, double, double, double, double, int); double dzmnbinom(double, double, double, double, int); double pzmnbinom(double, double, double, double, int, int); double qzmnbinom(double, double, double, double, int, int); double rzmnbinom(double, double, double); double dzmbinom(double, double, double, double, int); double pzmbinom(double, double, double, double, int, int); double qzmbinom(double, double, double, double, int, int); double rzmbinom(double, double, double); /* Four parameter distributions */ double dgenbeta(double, double, double, double, double, int); double pgenbeta(double, double, double, double, double, int, int); double qgenbeta(double, double, double, double, double, int, int); double rgenbeta(double, double, double, double); double mgenbeta(double, double, double, double, double, int); double levgenbeta(double, double, double, double, double, double, int); double dtrbeta(double, double, double, double, double, int); double ptrbeta(double, double, double, double, double, int, int); double qtrbeta(double, double, double, double, double, int, int); double rtrbeta(double, double, double, double); double mtrbeta(double, double, double, double, double, int); double levtrbeta(double, double, double, double, double, double, int); double dpareto4(double, double, double, double, double, int); double ppareto4(double, double, double, double, double, int, int); double qpareto4(double, double, double, double, double, int, int); double rpareto4(double, double, double, double); double mpareto4(double, double, double, double, double, int); double levpareto4(double, double, double, double, double, double, int); /* Five parameter distributions */ double dfpareto(double, double, double, double, double, double, int); double pfpareto(double, double, double, double, double, double, int, int); double qfpareto(double, double, double, double, double, double, int, int); double rfpareto(double, double, double, double, double); double mfpareto(double, double, double, double, double, double, int); double levfpareto(double, double, double, double, double, double, double, int); /* Phase-type distributions */ double dphtype(double, double *, double *, int, int); double pphtype(double, double *, double *, int, int, int); double rphtype(double *, double **, double *, int); double mphtype(double, double *, double *, int, int); double mgfphtype(double, double *, double *, int, int); /* Definitions for the tables linking the first group of functions to * the second one. Tables found in names.c. One table for * {d,p,q,m,lev} functions and one for the {r} functions since we * need one more argument: the type of the result. */ typedef struct { char *name; SEXP (*cfun)(int, SEXP); int code; } dpq_tab_struct; extern dpq_tab_struct dpq_tab[]; typedef struct { char *name; SEXP (*cfun)(int, SEXP, SEXPTYPE); int code; SEXPTYPE type; } random_tab_struct; extern random_tab_struct random_tab[]; actuar/src/gamma.c0000644000176200001440000000362514264305077013564 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to calculate raw and limited moments for the Gamma * distribution. See ../R/GammaSupp.R for details. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" double mgamma(double order, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape) || ISNAN(scale)) return order + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -shape) return R_PosInf; return R_pow(scale, order) * gammafn(order + shape) / gammafn(shape); } double levgamma(double limit, double shape, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape) || ISNAN(scale) || ISNAN(order)) return limit + shape + scale + order; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -shape) return R_PosInf; if (limit <= 0.0) return 0.0; double u, tmp; tmp = order + shape; u = exp(log(limit) - log(scale)); return R_pow(scale, order) * gammafn(tmp) * pgamma(u, tmp, 1.0, 1, 0) / gammafn(shape) + ACT_DLIM__0(limit, order) * pgamma(u, shape, 1.0, 0, 0); } double mgfgamma(double t, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(t) || ISNAN(shape) || ISNAN(scale)) return t + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0 || scale * t > 1.) return R_NaN; if (t == 0.0) return ACT_D__1; return ACT_D_exp(-shape * log1p(-scale * t)); } actuar/src/pareto1.c0000644000176200001440000000567014264305077014057 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the single-parameter Pareto distribution. See * ../R/SingleParameterPareto.R for details. * * The density function is * * shape * min^shape / x^(shape + 1). * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" double dpareto1(double x, double shape, double min, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(shape) || ISNAN(min)) return x + shape + min; #endif if (!R_FINITE(shape) || !R_FINITE(min) || shape <= 0.0 || min <= 0.0) return R_NaN; if (!R_FINITE(x) || x < min) return ACT_D__0; return ACT_D_exp(log(shape) + shape * log(min) - (shape + 1.0) * log(x)); } double ppareto1(double q, double shape, double min, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(shape) || ISNAN(min)) return q + shape + min; #endif if (!R_FINITE(shape) || !R_FINITE(min) || shape <= 0.0 || min <= 0.0) return R_NaN; if (q <= min) return ACT_DT_0; return ACT_DT_Cval(R_pow(min / q, shape)); } double qpareto1(double p, double shape, double min, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(shape) || ISNAN(min)) return p + shape + min; #endif if (!R_FINITE(shape) || !R_FINITE(min) || shape <= 0.0 || min <= 0.0) return R_NaN; ACT_Q_P01_boundaries(p, min, R_PosInf); p = ACT_D_qIv(p); return min / R_pow(ACT_D_Cval(p), 1.0/shape); } double rpareto1(double shape, double min) { if (!R_FINITE(shape) || !R_FINITE(min) || shape <= 0.0 || min <= 0.0) return R_NaN; return min / R_pow(unif_rand(), 1.0/shape); } double mpareto1(double order, double shape, double min, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape) || ISNAN(min)) return order + shape + min; #endif if (!R_FINITE(shape) || !R_FINITE(min) || !R_FINITE(order) || shape <= 0.0 || min <= 0.0) return R_NaN; if (order >= shape) return R_PosInf; return shape * R_pow(min, order) / (shape - order); } double levpareto1(double limit, double shape, double min, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape) || ISNAN(min) || ISNAN(order)) return limit + shape + min + order; #endif if (!R_FINITE(shape) || !R_FINITE(min) || !R_FINITE(order) || shape <= 0.0 || min <= 0.0) return R_NaN; if (limit <= min) return 0.0; double tmp = shape - order; return shape * R_pow(min, order) / tmp - order * R_pow(min, shape) / (tmp * R_pow(limit, tmp)); } actuar/src/util.c0000644000176200001440000003013614264305077013454 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Various utility functions for matrix algebra and sampling from * discrete distributions. * * The functions therein use LAPACK and BLAS routines. Nicely * formatted man pages for these can be found at * * * * AUTHORS: Vincent Goulet , Christophe * Dutang */ #define USE_FC_LEN_T #include #include #include #include #ifndef FCONE # define FCONE #endif #include "locale.h" /* For matrix exponential calculations. Pade constants * * n_{pqj} = [(p + q - j)! p!]/[(p + q)! j! (p - j)!] * * and * * d_{pqj} = [(p + q - j)! q!]/[(p + q)! j! (q - j)!] * * for p = q = 8 and j = 1, ..., 8. */ const static double padec88 [] = { 5.0000000000000000e-1, 1.1666666666666667e-1, 1.6666666666666667e-2, 1.6025641025641026e-3, 1.0683760683760684e-4, 4.8562548562548563e-6, 1.3875013875013875e-7, 1.9270852604185938e-9, }; /* Matrix exponential exp(x), where x is an (n x n) matrix. Result z * is an (n x n) matrix. Mostly lifted from the core of function * expm() of package Matrix, which is itself based on the function of * the same name in Octave. */ void actuar_expm(double *x, int n, double *z) { if (n == 1) z[0] = exp(x[0]); /* scalar exponential */ else { /* Constants */ int i, j; int nsqr = n * n, np1 = n + 1, is_uppertri = TRUE; int iloperm, ihiperm, iloscal, ihiscal, info, sqrpowscal; double infnorm, trshift, one = 1.0, zero = 0.0, m1pj = -1; /* Arrays */ int *pivot = (int *) R_alloc(n, sizeof(int)); /* pivot vector */ int *invperm = (int *) R_alloc(n, sizeof(int)); /* inverse permutation vector */ double *perm = (double *) R_alloc(n, sizeof(double)); /* permutation array */ double *scale = (double *) R_alloc(n, sizeof(double)); /* scale array */ double *work = (double *) R_alloc(nsqr, sizeof(double)); /* workspace array */ double *npp = (double *) R_alloc(nsqr, sizeof(double)); /* num. power Pade */ double *dpp = (double *) R_alloc(nsqr, sizeof(double)); /* denom. power Pade */ R_CheckStack(); Memcpy(z, x, nsqr); /* Check if matrix x is upper triangular; stop checking as * soon as a non-zero value is found below the diagonal. */ for (i = 0; i < n - 1 && is_uppertri; i++) for (j = i + 1; j < n; j++) if (!(is_uppertri = x[i * n + j] == 0.0)) break; /* Step 1 of preconditioning: shift diagonal by average * diagonal if positive. */ trshift = 0.0; for (i = 0; i < n; i++) trshift += x[i * np1]; trshift /= n; /* average diagonal element */ if (trshift > 0.0) for (i = 0; i < n; i++) z[i * np1] -= trshift; /* Step 2 of preconditioning: balancing with dgebal. */ if (is_uppertri) { /* no need to permute if x is upper triangular */ iloperm = 1; ihiperm = n; } else { F77_CALL(dgebal)("P", &n, z, &n, &iloperm, &ihiperm, perm, &info FCONE); if (info) error(_("LAPACK routine dgebal returned info code %d when permuting"), info); } F77_CALL(dgebal)("S", &n, z, &n, &iloscal, &ihiscal, scale, &info FCONE); if (info) error(_("LAPACK routine dgebal returned info code %d when scaling"), info); /* Step 3 of preconditioning: Scaling according to infinity * norm (a priori always needed). */ infnorm = F77_CALL(dlange)("I", &n, &n, z, &n, work FCONE); sqrpowscal = (infnorm > 0) ? imax2((int) 1 + log(infnorm)/M_LN2, 0) : 0; if (sqrpowscal > 0) { double scalefactor = R_pow_di(2, sqrpowscal); for (i = 0; i < nsqr; i++) z[i] /= scalefactor; } /* Pade approximation (p = q = 8): compute x^8, x^7, x^6, * ..., x^1 */ for (i = 0; i < nsqr; i++) { npp[i] = 0.0; dpp[i] = 0.0; } for (j = 7; j >= 0; j--) { /* npp = z * npp + padec88[j] * z */ F77_CALL(dgemm) ("N", "N", &n, &n, &n, &one, z, &n, npp, &n, &zero, work, &n FCONE FCONE); /* npp <- work + padec88[j] * z */ for (i = 0; i < nsqr; i++) npp[i] = work[i] + padec88[j] * z[i]; /* dpp = z * dpp + (-1)^j * padec88[j] * z */ F77_CALL(dgemm) ("N", "N", &n, &n, &n, &one, z, &n, dpp, &n, &zero, work, &n FCONE FCONE); for (i = 0; i < nsqr; i++) dpp[i] = work[i] + m1pj * padec88[j] * z[i]; m1pj *= -1; /* (-1)^j */ } /* power 0 */ for (i = 0; i < nsqr; i++) dpp[i] *= -1.0; for (j = 0; j < n; j++) { npp[j * np1] += 1.0; dpp[j * np1] += 1.0; } /* Pade approximation is (dpp)^-1 * npp. */ F77_CALL(dgetrf) (&n, &n, dpp, &n, pivot, &info); if (info) error(_("LAPACK routine dgetrf returned info code %d"), info); F77_CALL(dgetrs) ("N", &n, &n, dpp, &n, pivot, npp, &n, &info FCONE); if (info) error(_("LAPACK routine dgetrs returned info code %d"), info); Memcpy(z, npp, nsqr); /* Now undo all of the preconditioning */ /* Preconditioning 3: square the result for every power of 2 */ while (sqrpowscal--) { F77_CALL(dgemm)("N", "N", &n, &n, &n, &one, z, &n, z, &n, &zero, work, &n FCONE FCONE); Memcpy(z, work, nsqr); } /* Preconditioning 2: apply inverse scaling */ for (j = 0; j < n; j++) for (i = 0; i < n; i++) z[i + j * n] *= scale[i]/scale[j]; /* Inverse permuation if x is not upper triangular and 'perm' * is not the identity permutation */ if ((iloperm != 1 || ihiperm != n) && !is_uppertri) { /* balancing permutation vector */ for (i = 0; i < n; i++) invperm[i] = i; /* identity permutation */ /* leading permutations applied in forward order */ for (i = 0; i < (iloperm - 1); i++) { int permutedindex = (int) (perm[i]) - 1; int tmp = invperm[i]; invperm[i] = invperm[permutedindex]; invperm[permutedindex] = tmp; } /* trailing permutations applied in reverse order */ for (i = n - 1; i >= ihiperm; i--) { int permutedindex = (int) (perm[i]) - 1; int tmp = invperm[i]; invperm[i] = invperm[permutedindex]; invperm[permutedindex] = tmp; } /* construct inverse balancing permutation vector */ Memcpy(pivot, invperm, n); for (i = 0; i < n; i++) invperm[pivot[i]] = i; /* apply inverse permutation */ Memcpy(work, z, nsqr); for (j = 0; j < n; j++) for (i = 0; i < n; i++) z[i + j * n] = work[invperm[i] + invperm[j] * n]; } /* Preconditioning 1: Trace normalization */ if (trshift > 0) { double mult = exp(trshift); for (i = 0; i < nsqr; i++) z[i] *= mult; } } } /* Product x * exp(M) * y, where x is an (1 x n) vector, M is an (n x * n) matrix and y is an (n x 1) vector. Result z is a scalar. */ double actuar_expmprod(double *x, double *M, double *y, int n) { char *transa = "N"; int p = 1; double one = 1.0, zero = 0.0, *tmp, *expM; tmp = (double *) R_alloc(n, sizeof(double)); /* intermediate vector */ expM = (double *) R_alloc(n * n, sizeof(double)); /* matrix exponential */ /* Compute exp(M) */ actuar_expm(M, n, expM); /* Product tmp := x * exp(M) * (Dimensions: 1 x n 1 x n n x n) */ F77_CALL(dgemm)(transa, transa, &p, &n, &n, &one, x, &p, expM, &n, &zero, tmp, &p FCONE FCONE); /* Product z := tmp * y * (Dimensions: 1 x 1 1 x n n x 1) */ return F77_CALL(ddot)(&n, tmp, &p, y, &p); } /* Solution of a real system of linear equations AX = B, where A is an * (n x n) matrix and B is an (n x p) matrix. Essentially a simple * interface to the LAPACK routine DGESV based on modLa_dgesv() in * modules/lapack/laphack.c of R sources. Very little error checking * (e.g. no check that A is square) since it is currently used in a * very narrow and already controlled context. */ void actuar_solve(double *A, double *B, int n, int p, double *z) { int info, *ipiv; double *Avals; if (n == 0) error(_("'A' is 0-diml")); if (p == 0) error(_("no right-hand side in 'B'")); ipiv = (int *) R_alloc(n, sizeof(int)); /* Work on copies of A and B since they are overwritten by dgesv. */ Avals = (double *) R_alloc(n * n, sizeof(double)); Memcpy(Avals, A, (size_t) (n * n)); Memcpy(z, B, (size_t) (n * p)); F77_CALL(dgesv)(&n, &p, Avals, &n, ipiv, z, &n, &info); if (info < 0) error(_("argument %d of Lapack routine dgesv had invalid value"), -info); if (info > 0) error(_("Lapack routine dgesv: system is exactly singular")); } /* Power of a matrix x^k := x x ... x, where x in an (n x n) matrix * and k is an *integer* (including -1). This function is fairly naive * with little error checking since it is currently used in a very * narrow and already controlled context. */ void actuar_matpow(double *x, int n, int k, double *z) { if (k == 0) { /* Return identity matrix */ int i, j; for (i = 0; i < n; i++) for (j = 0; j < n; j++) z[i * n + j] = (i == j) ? 1.0 : 0.0; } else { char *transa = "N"; double one = 1.0, zero = 0.0, *tmp, *xtmp; xtmp = (double *) R_alloc(n * n, sizeof(double)); /* If k is negative, invert matrix first. */ if (k < 0) { k = -k; /* Create identity matrix for use in actuar_solve() */ int i, j; double *y = (double *) R_alloc(n * n, sizeof(double)); for (i = 0; i < n; i++) for (j = 0; j < n; j++) y[i * n + j] = (i == j) ? 1.0 : 0.0; /* Inverse */ actuar_solve(x, y, n, n, xtmp); } else Memcpy(xtmp, x, (size_t) (n * n)); /* Take powers in multiples of 2 until there is only one * product left to make. That is, if k = 5, compute (x * x), * then ((x * x) * (x * x)) and finally ((x * x) * (x * x)) * * x. Idea taken from Octave in file .../src/xpow.cc. */ Memcpy(z, xtmp, (size_t) (n * n)); k--; tmp = (double *) R_alloc(n * n, sizeof(double)); while (k > 0) { if (k & 1) /* z = z * xtmp */ { F77_CALL(dgemm)(transa, transa, &n, &n, &n, &one, z, &n, xtmp, &n, &zero, tmp, &n FCONE FCONE); Memcpy(z, tmp, (size_t) (n * n)); } k >>= 1; /* efficient division by 2 */ if (k > 0) /* xtmp = xtmp * xtmp */ { F77_CALL(dgemm)(transa, transa, &n, &n, &n, &one, xtmp, &n, xtmp, &n, &zero, tmp, &n FCONE FCONE); Memcpy(xtmp, tmp, (size_t) (n * n)); } } } } /* Simple function to sample one value from a discrete distribution on * 0, 1, ..., n - 1, n using probabilities p[0], ..., p[n - 1], 1 - * (p[0] + ... + p[n - 1]). */ int SampleSingleValue(int n, double *p) { int i; double pcum = p[0], u = unif_rand(); for (i = 0; u > pcum && i < n; i++) if (i < n - 1) pcum += p[i + 1]; return i; } actuar/src/beta.c0000644000176200001440000000267314264305077013417 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to calculate raw and limited moments for the Beta * distribution. See ../R/BetaMoments.R for details. * * AUTHOR: Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" double mbeta(double order, double shape1, double shape2, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape1) || ISNAN(shape2)) return order + shape1 + shape2; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0) return R_NaN; if (order <= -shape1) return R_PosInf; return beta(shape1 + order, shape2) / beta(shape1, shape2); } double levbeta(double limit, double shape1, double shape2, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(order)) return limit + shape1 + shape2 + order; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0) return R_NaN; if (order <= -shape1) return R_PosInf; if (limit <= 0.0) return 0.0; double tmp = order + shape1; return beta(tmp, shape2) / beta(shape1, shape2) * pbeta(limit, tmp, shape2, 1, 0) + ACT_DLIM__0(limit, order) * pbeta(limit, shape1, shape2, 0, 0); } actuar/src/trgamma.c0000644000176200001440000001045214264305077014126 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the transformed gamma distribution. See ../R/TransformedGamma.R * for details. * * We work with the density expressed as * * shape2 * u^shape1 * e^(-u) / (x * gamma(shape1)) * * with u = (x/scale)^shape2. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" double dtrgamma(double x, double shape1, double shape2, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return x + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (!R_FINITE(x) || x < 0.0) return ACT_D__0; /* handle x == 0 separately */ if (x == 0.0) { if (shape1 * shape2 < 1) return R_PosInf; if (shape1 * shape2 > 1) return ACT_D__0; /* else */ return give_log ? log(shape2) - log(scale) - lgammafn(shape1) : shape2 / (scale * gammafn(shape1)); } double logu = shape2 * (log(x) - log(scale)); return ACT_D_exp(log(shape2) + shape1 * logu - exp(logu) - log(x) - lgammafn(shape1)); } double ptrgamma(double q, double shape1, double shape2, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return q + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (q <= 0) return ACT_DT_0; double u = exp(shape2 * (log(q) - log(scale))); return pgamma(u, shape1, 1.0, lower_tail, log_p); } double qtrgamma(double p, double shape1, double shape2, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return p + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; ACT_Q_P01_boundaries(p, 0, R_PosInf); p = ACT_D_qIv(p); return scale * R_pow(qgamma(p, shape1, 1.0, lower_tail, 0), 1.0/shape2); } double rtrgamma(double shape1, double shape2, double scale) { if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; return scale * R_pow(rgamma(shape1, 1.0), 1.0/shape2); } double mtrgamma(double order, double shape1, double shape2, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return order + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -shape1 * shape2) return R_PosInf; return R_pow(scale, order) * gammafn(shape1 + order/shape2) / gammafn(shape1); } double levtrgamma(double limit, double shape1, double shape2, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale) || ISNAN(order)) return limit + shape1 + shape2 + scale + order; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -shape1 * shape2) return R_PosInf; if (limit <= 0.0) return 0.0; double u, tmp; tmp = shape1 + order / shape2; u = exp(shape2 * (log(limit) - log(scale))); return R_pow(scale, order) * gammafn(tmp) * pgamma(u, tmp, 1.0, 1, 0) / gammafn(shape1) + ACT_DLIM__0(limit, order) * pgamma(u, shape1, 1.0, 0, 0); } actuar/src/ztbinom.c0000644000176200001440000000663614264305077014171 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute probability function, cumulative distribution * and quantile functions, and to simulate random variates for the * zero-truncated binomial distribution. See * ../R/ZeroTruncatedBinomial.R for details. * * Zero-truncated distributions have density * * Pr[Z = x] = Pr[X = x]/(1 - Pr[X = 0]), * * and distribution function * * Pr[Z <= x] = (Pr[X <= x] - Pr[X = 0])/(1 - Pr[X = 0]) * * or, alternatively, survival function * * Pr[Z > x] = Pr[X > x]/(1 - Pr[X = 0]). * * AUTHOR: Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" /* The binomial distribution has * * F(0) = Pr[X = 0] = (1 - prob)^size. * * Support is x = 1, ..., size. * * Limiting cases: * * 1. size == 1 is point mass at x = 1; * 2. prob == 0 is point mass at x = 1. */ double dztbinom(double x, double size, double prob, int give_log) { /* We compute Pr[X = 0] with dbinom_raw() [as would eventually * dbinom()] to take advantage of all the optimizations for * small/large values of 'prob' and 'size' (and also to skip some * validity tests). */ #ifdef IEEE_754 if (ISNAN(x) || ISNAN(size) || ISNAN(prob)) return x + size + prob; #endif if (prob < 0 || prob > 1 || size < 1) return R_NaN; if (x < 1 || !R_FINITE(x)) return ACT_D__0; /* limiting cases as size -> 1 or prob -> 0 are point mass at one */ if (size == 1 || prob == 0) return (x == 1) ? ACT_D__1 : ACT_D__0; double lp0 = dbinom_raw(0, size, prob, 1 - prob, /*give_log*/1); return ACT_D_val(dbinom(x, size, prob, /*give_log*/0)/(-expm1(lp0))); } double pztbinom(double x, double size, double prob, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(size) || ISNAN(prob)) return x + size + prob; #endif if (prob < 0 || prob > 1 || size < 1) return R_NaN; if (x < 1) return ACT_DT_0; if (!R_FINITE(x)) return ACT_DT_1; /* limiting cases as size -> 1 or prob -> 0 are point mass at one */ if (size == 1 || prob == 0) return (x >= 1) ? ACT_DT_1 : ACT_DT_0; double lp0 = dbinom_raw(0, size, prob, 1 - prob, /*give_log*/1); return ACT_DT_Cval(pbinom(x, size, prob, /*l._t.*/0, /*log_p*/0)/(-expm1(lp0))); } double qztbinom(double x, double size, double prob, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(size) || ISNAN(prob)) return x + size + prob; #endif if (prob < 0 || prob > 1 || size < 1) return R_NaN; /* limiting cases as size -> 1 or prob -> 0 are point mass at one */ if (size == 1 || prob == 0) { /* simplified ACT_Q_P01_boundaries macro */ if (log_p) { if (x > 0) return R_NaN; return 1.0; } else /* !log_p */ { if (x < 0 || x > 1) return R_NaN; return 1.0; } } ACT_Q_P01_boundaries(x, 1, size); x = ACT_DT_qIv(x); double p0 = dbinom_raw(0, size, prob, 1 - prob, /*give_log*/0); return qbinom(p0 + (1 - p0) * x, size, prob, /*l._t.*/1, /*log_p*/0); } double rztbinom(double size, double prob) { if (!R_FINITE(prob) || prob < 0 || prob > 1 || size < 0) return R_NaN; /* limiting cases as size -> 1 or prob -> 0 are point mass at one */ if (size == 1 || prob == 0) return 1.0; double p0 = dbinom_raw(0, size, prob, 1 - prob, /*give_log*/0); return qbinom(runif(p0, 1), size, prob, /*l._t.*/1, /*log_p*/0); } actuar/src/fpareto.c0000644000176200001440000001664614264305077014151 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the Feller-Pareto distribution. See ../R/FellerPareto.R for * details. * * We work with the density expressed as * * shape2 * u^shape3 * (1 - u)^shape1 / ((x - min) * beta(shape1, shape3)) * * with u = v/(1 + v) = 1/(1 + 1/v), v = ((x - min)/scale)^shape2. * * AUTHORS: Nicholas Langevin and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dfpareto(double x, double min, double shape1, double shape2, double shape3, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(min) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(shape3) || ISNAN(scale)) return x + min + shape1 + shape2 + shape3 + scale; #endif if (!R_FINITE(min) || !R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(shape3) || shape1 <= 0.0 || shape2 <= 0.0 || shape3 <= 0.0 || scale <= 0.0) return R_NaN; if (!R_FINITE(x) || x < min) return ACT_D__0; /* handle (x - min) == 0 separately */ if (x == min) { if (shape2 * shape3 < 1) return R_PosInf; if (shape2 * shape3 > 1) return ACT_D__0; /* else */ return give_log ? log(shape2) - log(scale) - lbeta(shape3, shape1) : shape2 / (scale * beta(shape3, shape1)); } double logv, logu, log1mu; logv = shape2 * (log(x - min) - log(scale)); logu = - log1pexp(-logv); log1mu = - log1pexp(logv); return ACT_D_exp(log(shape2) + shape3 * logu + shape1 * log1mu - log(x - min) - lbeta(shape3, shape1)); } double pfpareto(double q, double min, double shape1, double shape2, double shape3, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(min) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(shape3) || ISNAN(scale)) return q + min + shape1 + shape2 + shape3 + scale; #endif if (!R_FINITE(min) || !R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(shape3) || shape1 <= 0.0 || shape2 <= 0.0 || shape3 <= 0.0 || scale <= 0.0) return R_NaN; if (q <= min) return ACT_DT_0; double logvm, u; logvm = shape2 * (log(scale) - log(q - min)); /* -log v */ u = exp(-log1pexp(logvm)); if (u > 0.5) { /* Compute (1 - u) accurately */ double u1m = exp(-log1pexp(-logvm)); return pbeta(u1m, shape1, shape3, 1 - lower_tail, log_p); } /* else u <= 0.5 */ return pbeta(u, shape3, shape1, lower_tail, log_p); } double qfpareto(double p, double min, double shape1, double shape2, double shape3, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(min) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(shape3) || ISNAN(scale)) return p + min + shape1 + shape2 + shape3 + scale; #endif if (!R_FINITE(min) || !R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(shape3) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || shape3 <= 0.0 || scale <= 0.0) return R_NaN; ACT_Q_P01_boundaries(p, min, R_PosInf); p = ACT_D_qIv(p); return min + scale * R_pow(1.0 / qbeta(p, shape3, shape1, lower_tail, 0) - 1.0, -1.0/shape2); } double rfpareto(double min, double shape1, double shape2, double shape3, double scale) { if (!R_FINITE(min) || !R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(shape3) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || shape3 <= 0.0 || scale <= 0.0) return R_NaN; return min + scale * R_pow(1.0/rbeta(shape1, shape3) - 1.0, 1.0/shape2); } double mfpareto(double order, double min, double shape1, double shape2, double shape3, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(min) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(shape3) || ISNAN(scale)) return order + min + shape1 + shape2 + shape3 + scale; #endif if (!R_FINITE(min) || !R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(shape3) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || shape3 <= 0.0 || scale <= 0.0) return R_NaN; /* The case min = 0 is a Transformed Beta with a larger range of * admissible values for order: - shape3 * shape2 < order < * shape1 * shape2. */ if (min == 0.0) return mtrbeta(order, shape1, shape2, shape3, scale, give_log); /* From now on min != 0 and order must be a stricly non negative * integer < shape1 * shape2. */ if (order < 0.0) return R_NaN; if (order >= shape1 * shape2) return R_PosInf; int i; double order0 = order; double tmp, sum, r = scale/min; double Be = beta(shape1, shape3); if (ACT_nonint(order)) { order = ACT_forceint(order); warning(_("'order' (%.2f) must be integer, rounded to %.0f"), order0, order); } sum = Be; /* first term in the sum */ for (i = 1; i <= order; i++) { tmp = i/shape2; sum += choose(order, i) * R_pow(r, i) * beta(shape3 + tmp, shape1 - tmp); } return R_pow(min, order) * sum / Be; } double levfpareto(double limit, double min, double shape1, double shape2, double shape3, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(min) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(shape3) || ISNAN(scale) || ISNAN(order)) return limit + min + shape1 + shape2 + shape3 + scale + order; #endif if (!R_FINITE(min) || !R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(shape3) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || shape3 <= 0.0 || scale <= 0.0) return R_NaN; if (limit <= min) return 0.0; /* The case min = 0 is a Transformed Beta with a larger range of * admissible values for order: order > - shape3 * shape2. */ if (min == 0.0) return levtrbeta(limit, shape1, shape2, shape3, scale, order, give_log); /* From now on min != 0 and order must be a stricly non negative * integer. */ if (order < 0.0) return R_NaN; int i; double order0 = order; double logv, u, u1m, Ix; double tmp, sum, r = scale / min; logv = shape2 * (log(limit - min) - log(scale)); u = exp(-log1pexp(-logv)); u1m = exp(-log1pexp(logv)); if (ACT_nonint(order)) { order = ACT_forceint(order); warning(_("'order' (%.2f) must be integer, rounded to %.0f"), order0, order); } sum = betaint_raw(u, shape3, shape1, u1m); /* first term in the sum */ for (i = 1; i <= order; i++) { tmp = i / shape2; sum += choose(order, i) * R_pow(r, i) * betaint_raw(u, shape3 + tmp, shape1 - tmp, u1m); } Ix = (u > 0.5) ? pbeta(u1m, shape1, shape3, /*l._t.*/1, /*give_log*/0) : pbeta(u, shape3, shape1, /*l._t.*/0, /*give_log*/0); return R_pow(min, order) * sum / (gammafn(shape1) * gammafn(shape3)) + ACT_DLIM__0(limit, order) * Ix; } actuar/src/locale.h0000644000176200001440000000023714264305077013742 0ustar liggesusers/* Localization */ #include #ifdef ENABLE_NLS #include #define _(String) dgettext ("actuar", String) #else #define _(String) (String) #endif actuar/src/pareto3.c0000644000176200001440000001243014264305077014051 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the Pareto (type) III distribution. See ../R/Pareto3.R for * details. * * We work with the density expressed as * * shape * u * (1 - u) / (x - min) * * with u = v/(1 + v), v = ((x - min)/scale)^shape. * * AUTHOR: Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dpareto3(double x, double min, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(min) || ISNAN(shape) || ISNAN(scale)) return x + min + shape + scale; #endif if (!R_FINITE(min) || !R_FINITE(shape) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (!R_FINITE(x) || x < min) return ACT_D__0; /* handle x == min separately */ if (x == min) { if (shape < 1) return R_PosInf; if (shape > 1) return ACT_D__0; /* else */ return ACT_D_val(1.0/scale); } double logv, logu, log1mu; logv = shape * (log(x - min) - log(scale)); logu = - log1pexp(-logv); log1mu = - log1pexp(logv); return ACT_D_exp(log(shape) + logu + log1mu - log(x - min)); } double ppareto3(double q, double min, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(min) || ISNAN(shape) || ISNAN(scale)) return q + min + shape + scale; #endif if (!R_FINITE(min) || !R_FINITE(shape) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (q <= min) return ACT_DT_0; double u = exp(-log1pexp(shape * (log(scale) - log(q - min)))); return ACT_DT_val(u); } double qpareto3(double p, double min, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(min) || ISNAN(shape) || ISNAN(scale)) return p + min + shape + scale; #endif if (!R_FINITE(min) || !R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN; ACT_Q_P01_boundaries(p, 0, R_PosInf); p = ACT_D_qIv(p); return min + scale * R_pow(1.0/ACT_D_Cval(p) - 1.0, 1.0/shape); } double rpareto3(double min, double shape, double scale) { if (!R_FINITE(min) || !R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN; return min + scale * R_pow(1.0/unif_rand() - 1.0, 1.0/shape); } double mpareto3(double order, double min, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(min) || ISNAN(shape) || ISNAN(scale)) return order + shape + scale; #endif if (!R_FINITE(min) || !R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; /* The case min = 0 is a loglogistic with a larger range of * admissible values for order: -shape < order < shape. */ if (min == 0.0) return mllogis(order, shape, scale, give_log); /* From now on min != 0 and order must be a stricly non negative * integer < shape. */ if (order < 0.0) return R_NaN; if (order >= shape) return R_PosInf; int i; double order0 = order; double tmp, sum, r = scale/min; if (ACT_nonint(order)) { order = ACT_forceint(order); warning(_("'order' (%.2f) must be integer, rounded to %.0f"), order0, order); } sum = 1.0; /* first term in the sum */ for (i = 1; i <= order; i++) { tmp = i / shape; sum += choose(order, i) * R_pow(r, i) * gammafn(1.0 + tmp) * gammafn(1.0 - tmp); } return R_pow(min, order) * sum; } double levpareto3(double limit, double min, double shape, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(min) || ISNAN(shape) || ISNAN(scale) || ISNAN(order)) return limit + min + shape + scale + order; #endif if (!R_FINITE(min) || !R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (limit <= min) return 0.0; /* The case min = 0 is a loglogistic with a larger range of * admissible values for order: order > -shape. */ if (min == 0.0) return levllogis(limit, shape, scale, order, give_log); /* From now on min != 0 and order must be a stricly non negative * integer. */ if (order < 0.0) return R_NaN; int i; double order0 = order; double logv, u, u1m; double tmp, sum, r = scale / min; logv = shape * (log(limit - min) - log(scale)); u = exp(-log1pexp(-logv)); u1m = exp(-log1pexp(logv)); if (ACT_nonint(order)) { order = ACT_forceint(order); warning(_("'order' (%.2f) must be integer, rounded to %.0f"), order0, order); } sum = betaint_raw(u, 1.0, 1.0, u1m); /* first term in the sum */ for (i = 1; i <= order; i++) { tmp = i / shape; sum += choose(order, i) * R_pow(r, i) * betaint_raw(u, 1.0 + tmp, 1.0 - tmp, u1m); } return R_pow(min, order) * sum + ACT_DLIM__0(limit, order) * (0.5 - u + 0.5); } actuar/src/pareto.c0000644000176200001440000000672214264305077013775 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the Pareto distribution. See ../R/Pareto.R for details. * * We work with the density expressed as * * shape * u^shape * (1 - u) / x * * with u = 1/(1 + v), v = x/scale. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dpareto(double x, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(shape) || ISNAN(scale)) return x + shape + scale; #endif if (!R_FINITE(shape) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (!R_FINITE(x) || x < 0.0) return ACT_D__0; /* handle x == 0 separately */ if (x == 0.0) return ACT_D_val(shape / scale); double logv, logu, log1mu; logv = log(x) - log(scale); logu = - log1pexp(logv); log1mu = - log1pexp(-logv); return ACT_D_exp(log(shape) + shape * logu + log1mu - log(x)); } double ppareto(double q, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(shape) || ISNAN(scale)) return q + shape + scale; #endif if (!R_FINITE(shape) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (q <= 0) return ACT_DT_0; double u = exp(-log1pexp(log(q) - log(scale))); return ACT_DT_Cval(R_pow(u, shape)); } double qpareto(double p, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(shape) || ISNAN(scale)) return p + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN; ACT_Q_P01_boundaries(p, 0, R_PosInf); p = ACT_D_qIv(p); return scale * (R_pow(ACT_D_Cval(p), -1.0/shape) - 1.0); } double rpareto(double shape, double scale) { if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN; return scale * (R_pow(unif_rand(), -1.0/shape) - 1.0); } double mpareto(double order, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape) || ISNAN(scale)) return order + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -1.0 || order >= shape) return R_PosInf; return R_pow(scale, order) * gammafn(1.0 + order) * gammafn(shape - order) / gammafn(shape); } double levpareto(double limit, double shape, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape) || ISNAN(scale) || ISNAN(order)) return limit + shape + scale + order; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -1.0) return R_PosInf; if (limit <= 0.0) return 0.0; double logv, u, u1m; logv = log(limit) - log(scale); u = exp(-log1pexp(logv)); u1m = exp(-log1pexp(-logv)); return R_pow(scale, order) * betaint_raw(u1m, 1.0 + order, shape - order, u) / gammafn(shape) + ACT_DLIM__0(limit, order) * R_pow(u, shape); } actuar/src/phtype.c0000644000176200001440000001305514264305077014011 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and moment * generating functions, raw moments and to simulate random variates * for Phase-type distributions. See ../R/PhaseType.R for details. * * The density function is * * pi * exp(x * T) * t * (1 x m) (m x m) (m x 1) * * for x > 0, with t = -T * e and e a 1-vector, and 1 - pi * e * for x = 0. * * AUTHOR: Vincent Goulet */ #include #include #include #include #include "actuar.h" #include "locale.h" #include "dpq.h" double dphtype(double x, double *pi, double *T, int m, int give_log) { if (!R_FINITE(x) || x < 0.0) return ACT_D__0; if (x == 0.0) { int i; double z = 0.0; for (i = 0; i < m; i++) z += pi[i]; return ACT_D_Clog(z); } int i, j, ij; double *t, *tmp; /* Build vector t (equal to minus the row sums of matrix T) and * matrix tmp = x * T. */ t = (double *) S_alloc(m, sizeof(double)); /* initialized to 0 */ tmp = (double *) R_alloc(m * m, sizeof(double)); for (i = 0; i < m; i++) for (j = 0; j < m; j++) { ij = i + j * m; t[i] -= T[ij]; tmp[ij] = x * T[ij]; } return ACT_D_val(actuar_expmprod(pi, tmp, t, m)); } double pphtype(double q, double *pi, double *T, int m, int lower_tail, int log_p) { /* Cumulative distribution function is * * 1 - pi * exp(q * T) * e * (1 x m) (m x m) (m x 1) * * for x > 0, where e a 1-vector, and 1 - pi * e for x = 0. */ if (q < 0.0) return ACT_DT_0; if (q == 0.0) { int i; double z = 0.0; for (i = 0; i < m; i++) z += pi[i]; return ACT_DT_Cval(z); } int i; double *e, *tmp; /* Create the 1-vector and multiply each element of T by q. */ e = (double *) R_alloc(m, sizeof(double)); for (i = 0; i < m; i++) e[i] = 1; tmp = (double *) R_alloc(m * m, sizeof(double)); for (i = 0; i < m * m; i++) tmp[i] = q * T[i]; return ACT_DT_Cval(actuar_expmprod(pi, tmp, e, m)); } double rphtype(double *pi, double **Q, double *rates, int m) { /* Algorithm based on Neuts, M. F. (1981), "Generating random * variates from a distribution of phase type", WSC '81: * Proceedings of the 13th conference on Winter simulation, IEEE * Press, */ int i, j, state, *nvisits; double z = 0.0; nvisits = (int *) S_alloc(m, sizeof(int)); /* Simulate initial state according to vector pi (transient states * are numbered 0, ..., m - 1 and absorbing state is numbered * m). See the definition of SampleSingleValue() to see why this * works fine here and below. */ state = SampleSingleValue(m, pi); /* Simulate the underlying Markov chain using transition matrix Q * while counting the number of visits in each transient state. */ while (state != m) { nvisits[state]++; state = SampleSingleValue(m, Q[state]); } /* Variate is the sum of as many exponential variates as there are * visits in each state, with the rate parameter varying per * state. */ for (i = 0; i < m; i++) for (j = 0; j < nvisits[i]; j++) z += exp_rand() / rates[i]; return z; } double mphtype(double order, double *pi, double *T, int m, int give_log) { /* Raw moment is * * order! * pi * (-T)^(-order) * e * (1 x 1) (1 x m) (m x m) (m x 1) * * where e is a 1-vector. Below, the moment is computed as * (-1)^order * order! * sum(pi * T^(-order)) */ if (order < 0.0 || ACT_nonint(order)) return R_NaN; int i, j; double tmp = 0.0, *Tpow; /* Compute the power of T */ Tpow = (double *) R_alloc(m * m, sizeof(double)); actuar_matpow(T, m, (int) -order, Tpow); /* Compute vector tmp = sum(pi * Tpow) */ for (i = 0; i < m; i++) for (j = 0; j < m; j++) tmp += pi[j] * Tpow[i * m + j]; /* Multiply by -1 if order is odd */ return ACT_D_val((int) order % 2 ? -gammafn(order + 1.0) * tmp : gammafn(order + 1.0) * tmp); } double mgfphtype(double x, double *pi, double *T, int m, int give_log) { /* Moment generating function is * * pi * (-x * I - T)^(-1) * t + (1 - pi * e) * (1 x m) (m x m) (m x 1) (1 x m) (m x 1) * * with t = -T * e, e a 1-vector and I the identity matrix. * Below, the mgf is computed as 1 - pi * (e + (x * I + T)^(-1) * t. */ if (x == 0.0) return ACT_D_exp(0.0); int i, j, ij; double z = 0.0, *t, *tmp1, *tmp2; /* Build vector t (equal to minux the row sums of matrix T) and * matrix tmp1 = x * I + T. */ t = (double *) S_alloc(m, sizeof(double)); /* initialized to 0 */ tmp1 = (double *) R_alloc(m * m, sizeof(double)); for (i = 0; i < m; i++) for (j = 0; j < m; j++) { ij = i + j * m; t[i] -= T[ij]; tmp1[ij] = (i == j) ? x + T[ij] : T[ij]; } /* Compute tmp2 = tmp1^(-1) * t */ tmp2 = (double *) R_alloc(m, sizeof(double)); actuar_solve(tmp1, t, m, 1, tmp2); /* Compute z = pi * (e + tmp2) */ for (i = 0; i < m; i++) z += pi[i] * (1 + tmp2[i]); return ACT_D_Clog(z); } actuar/src/invweibull.c0000644000176200001440000000643114264305077014660 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the inverse Weibull distribution. See ../R/InverseWeibull.R for * details. * * We work with the density expressed as * * shape * u * e^(-u) / x * * with u = (scale/x)^shape. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dinvweibull(double x, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(shape) || ISNAN(scale)) return x + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale < 0.0) return R_NaN;; /* handle also x == 0 here */ if (!R_FINITE(x) || x <= 0.0) return ACT_D__0; double logu = shape * (log(scale) - log(x)); return ACT_D_exp(log(shape) + logu - exp(logu) - log(x)); } double pinvweibull(double q, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(shape) || ISNAN(scale)) return q + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale < 0.0) return R_NaN;; if (q <= 0) return ACT_DT_0; double u = exp(shape * (log(scale) - log(q))); return ACT_DT_Eval(-u); } double qinvweibull(double p, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(shape) || ISNAN(scale)) return p + shape + scale; #endif if (!R_FINITE(scale) || !R_FINITE(shape) || scale <= 0.0 || shape <= 0.0) return R_NaN;; ACT_Q_P01_boundaries(p, 0, R_PosInf); p = ACT_D_qIv(p); return scale * R_pow(-log(ACT_D_Lval(p)), -1.0/shape); } double rinvweibull(double shape, double scale) { if (!R_FINITE(scale) || !R_FINITE(shape) || scale <= 0.0 || shape <= 0.0) return R_NaN;; return scale * R_pow(rexp(1.0), -1.0/shape); } double minvweibull(double order, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape) || ISNAN(scale)) return order + shape + scale; #endif if (!R_FINITE(scale) || !R_FINITE(shape) || !R_FINITE(order) || scale <= 0.0 || shape <= 0.0) return R_NaN; if (order >= shape) return R_PosInf; return R_pow(scale, order) * gammafn(1.0 - order / shape); } double levinvweibull(double limit, double shape, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape) || ISNAN(scale) || ISNAN(order)) return limit + shape + scale + order; #endif if (!R_FINITE(scale) || !R_FINITE(shape) || !R_FINITE(order) || scale <= 0.0 || shape <= 0.0) return R_NaN; if (order >= shape) return R_PosInf; if (limit <= 0.0) return 0.0; double u = exp(shape * (log(scale) - log(limit))); return R_pow(scale, order) * actuar_gamma_inc(1.0 - order/shape, u) + ACT_DLIM__0(limit, order) * (0.5 - exp(-u) + 0.5); } actuar/src/llogis.c0000644000176200001440000000713014264305077013766 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the loglogistic distribution. See ../R/Loglogistic.R for details. * * We work with the density expressed as * * shape * u * (1 - u) / x * * with u = v/(1 + v) = 1/(1 + 1/v), v = (x/scale)^shape. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dllogis(double x, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(shape) || ISNAN(scale)) return x + shape + scale; #endif if (!R_FINITE(shape) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (!R_FINITE(x) || x < 0.0) return ACT_D__0; /* handle x == 0 separately */ if (x == 0.0) { if (shape < 1) return R_PosInf; if (shape > 1) return ACT_D__0; /* else */ return ACT_D_val(1.0/scale); } double logv, logu, log1mu; logv = shape * (log(x) - log(scale)); logu = - log1pexp(-logv); log1mu = - log1pexp(logv); return ACT_D_exp(log(shape) + logu + log1mu - log(x)); } double pllogis(double q, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(shape) || ISNAN(scale)) return q + shape + scale; #endif if (!R_FINITE(shape) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (q <= 0) return ACT_DT_0; double u = exp(-log1pexp(shape * (log(scale) - log(q)))); return ACT_DT_val(u); } double qllogis(double p, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(shape) || ISNAN(scale)) return p + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN; ACT_Q_P01_boundaries(p, 0, R_PosInf); p = ACT_D_qIv(p); return scale * R_pow(1.0/ACT_D_Cval(p) - 1.0, 1.0/shape); } double rllogis(double shape, double scale) { if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN; return scale * R_pow(1.0/unif_rand() - 1.0, 1.0/shape); } double mllogis(double order, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape) || ISNAN(scale)) return order + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -shape || order >= shape) return R_PosInf; double tmp = order / shape; return R_pow(scale, order) * gammafn(1.0 + tmp) * gammafn(1.0 - tmp); } double levllogis(double limit, double shape, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape) || ISNAN(scale) || ISNAN(order)) return limit + shape + scale + order; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN;; if (order <= -shape) return R_PosInf; if (limit <= 0.0) return 0; double logv, u, u1m; double tmp = order / shape; logv = shape * (log(limit) - log(scale)); u = exp(-log1pexp(-logv)); u1m = exp(-log1pexp(logv)); return R_pow(scale, order) * betaint_raw(u, 1.0 + tmp, 1.0 - tmp, u1m) + ACT_DLIM__0(limit, order) * (0.5 - u + 0.5); } actuar/src/lgamma.c0000644000176200001440000000633114264305077013735 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, and to simulate random variates for the loggamma * distribution. See ../R/Loggamma.R for details. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" double dlgamma(double x, double shapelog, double ratelog, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(shapelog) || ISNAN(ratelog)) return x + shapelog + ratelog; #endif if (!R_FINITE(shapelog) || !R_FINITE(ratelog) || shapelog <= 0.0 || ratelog < 0.0) return R_NaN;; if (!R_FINITE(x) || x < 1.0) return ACT_D__0; return ACT_D_exp(dgamma(log(x), shapelog, 1.0/ratelog, 1) - log(x)); } double plgamma(double q, double shapelog, double ratelog, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(shapelog) || ISNAN(ratelog)) return q + shapelog + ratelog; #endif if (!R_FINITE(shapelog) || !R_FINITE(ratelog) || shapelog <= 0.0 || ratelog < 0.0) return R_NaN;; if (q <= 1.0) return ACT_DT_0; return pgamma(log(q), shapelog, 1.0/ratelog, lower_tail, log_p); } double qlgamma(double p, double shapelog, double ratelog, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(shapelog) || ISNAN(ratelog)) return p + shapelog + ratelog; #endif if (!R_FINITE(shapelog) || !R_FINITE(ratelog) || shapelog <= 0.0 || ratelog <= 0.0) return R_NaN;; ACT_Q_P01_boundaries(p, 1, R_PosInf); p = ACT_D_qIv(p); return exp(qgamma(p, shapelog, 1.0/ratelog, lower_tail, 0)); } double rlgamma(double shapelog, double ratelog) { if (!R_FINITE(shapelog) || !R_FINITE(ratelog) || shapelog <= 0.0 || ratelog <= 0.0) return R_NaN;; return exp(rgamma(shapelog, 1.0/ratelog)); } double mlgamma(double order, double shapelog, double ratelog, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shapelog) || ISNAN(ratelog)) return order + shapelog + ratelog; #endif if (!R_FINITE(shapelog) || !R_FINITE(ratelog) || !R_FINITE(order) || shapelog <= 0.0 || ratelog <= 0.0) return R_NaN; if (order >= ratelog) return R_PosInf; return R_pow(1.0 - order / ratelog, -shapelog); } double levlgamma(double limit, double shapelog, double ratelog, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shapelog) || ISNAN(ratelog) || ISNAN(order)) return limit + shapelog + ratelog + order; #endif if (!R_FINITE(shapelog) || !R_FINITE(ratelog) || !R_FINITE(limit) || !R_FINITE(order) || shapelog <= 0.0 || ratelog <= 0.0 || limit <= 0.0) return R_NaN; if (order >= ratelog) return R_PosInf; if (limit <= 1.0) return 0.0; double u = log(limit); return R_pow(1.0 - order / ratelog, -shapelog) * pgamma(u * (ratelog - order), shapelog, 1.0, 1, 0) + ACT_DLIM__0(limit, order) * pgamma(u * ratelog, shapelog, 1.0, 0, 0); } actuar/src/pareto2.c0000644000176200001440000001225014264305077014050 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the Pareto (type) II distribution. See ../R/Pareto2.R for * details. * * We work with the density expressed as * * shape * u^shape * (1 - u) / (x - min) * * with u = 1/(1 + v), v = (x - min)/scale. * * AUTHOR: Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dpareto2(double x, double min, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(min) || ISNAN(shape) || ISNAN(scale)) return x + min + shape + scale; #endif if (!R_FINITE(min) || !R_FINITE(shape) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (!R_FINITE(x) || x < min) return ACT_D__0; /* handle x == min separately */ if (x == min) return ACT_D_val(shape / scale); double logv, logu, log1mu; logv = log(x - min) - log(scale); logu = - log1pexp(logv); log1mu = - log1pexp(-logv); return ACT_D_exp(log(shape) + shape * logu + log1mu - log(x - min)); } double ppareto2(double q, double min, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(min) || ISNAN(shape) || ISNAN(scale)) return q + min + shape + scale; #endif if (!R_FINITE(min) || !R_FINITE(shape) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (q <= min) return ACT_DT_0; double u = exp(-log1pexp(log(q - min) - log(scale))); return ACT_DT_Cval(R_pow(u, shape)); } double qpareto2(double p, double min, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(min) || ISNAN(shape) || ISNAN(scale)) return p + min + shape + scale; #endif if (!R_FINITE(min) || !R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN; ACT_Q_P01_boundaries(p, 0, R_PosInf); p = ACT_D_qIv(p); return min + scale * (R_pow(ACT_D_Cval(p), -1.0/shape) - 1.0); } double rpareto2(double min, double shape, double scale) { if (!R_FINITE(min) || !R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN; return min + scale * (R_pow(unif_rand(), -1.0/shape) - 1.0); } double mpareto2(double order, double min, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(min) || ISNAN(shape) || ISNAN(scale)) return order + shape + scale; #endif if (!R_FINITE(min) || !R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; /* The case min = 0 is a Pareto with a larger range of admissible * values for order: -1 < order < shape. */ if (min == 0.0) return mpareto(order, shape, scale, give_log); /* From now on min != 0 and order must be a stricly non negative * integer < shape. */ if (order < 0.0) return R_NaN; if (order >= shape) return R_PosInf; int i; double order0 = order; double sum, r = scale/min; double Ga = gammafn(shape); if (ACT_nonint(order)) { order = ACT_forceint(order); warning(_("'order' (%.2f) must be integer, rounded to %.0f"), order0, order); } sum = Ga; /* first term in the sum */ for (i = 1; i <= order; i++) { sum += choose(order, i) * R_pow(r, i) * gammafn(1.0 + i) * gammafn(shape - i); } return R_pow(min, order) * sum / Ga; } double levpareto2(double limit, double min, double shape, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(min) || ISNAN(shape) || ISNAN(scale) || ISNAN(order)) return limit + min + shape + scale + order; #endif if (!R_FINITE(min) || !R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (limit <= min) return 0.0; /* The case min = 0 is a Pareto with a larger range of admissible * values for order: order > -1. */ if (min == 0.0) return levpareto(limit, shape, scale, order, give_log); /* From now on min != 0 and order must be a stricly non negative * integer. */ if (order < 0.0) return R_NaN; int i; double order0 = order; double logv, u, u1m; double sum, r = scale / min; logv = log(limit - min) - log(scale); u = exp(-log1pexp(logv)); u1m = exp(-log1pexp(-logv)); if (ACT_nonint(order)) { order = ACT_forceint(order); warning(_("'order' (%.2f) must be integer, rounded to %.0f"), order0, order); } sum = betaint_raw(u1m, 1.0, shape, u); /* first term in the sum */ for (i = 1; i <= order; i++) { sum += choose(order, i) * R_pow(r, i) * betaint_raw(u1m, 1.0 + i, shape - i, u); } return R_pow(min, order) * sum / gammafn(shape) + ACT_DLIM__0(limit, order) * R_pow(u, shape); } actuar/src/zmbinom.c0000644000176200001440000001257214264305077014156 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute probability function, cumulative distribution * and quantile functions, and to simulate random variates for the * zero-modified binomial distribution. See * ../R/ZeroModifiedBinomial.R for details. * * Zero-modified distributions are discrete mixtures between a * degenerate distribution at zero and the corresponding, * non-modified, distribution. As a mixture, they have density * * Pr[Z = x] = [1 - (1 - p0m)/(1 - p0)] 1(x) * + [(1 - p0m)/(1 - p0)] Pr[X = 0], * * where p0 = Pr[X = 0]. The density can also be expressed as * Pr[Z = 0] = p0m and * * Pr[Z = x] = (1 - p0m) * Pr[X = x]/(1 - Pr[X = 0]), * * for x = 1, 2, ... The distribution function is, for all x, * * Pr[Z <= x] = 1 - (1 - p0m) * (1 - Pr[X <= x])/(1 - p0). * * AUTHOR: Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" /* The binomial distribution has p0 = (1 - prob)^size. * * Limiting cases: * * 1. size == 0 is mass (1-p0m) at x = 1; * 2. prob == 0 is mass (1-p0m) at x = 1. */ double dzmbinom(double x, double size, double prob, double p0m, int give_log) { /* We compute Pr[X = 0] with dbinom_raw() [as would eventually * dbinom()] to take advantage of all the optimizations for * small/large values of 'prob' and 'size' (and also to skip some * validity tests). */ #ifdef IEEE_754 if (ISNAN(x) || ISNAN(size) || ISNAN(prob) || ISNAN(p0m)) return x + size + prob + p0m; #endif if (prob < 0 || prob > 1 || size < 0 || p0m < 0 || p0m > 1) return R_NaN; if (x < 0 || !R_FINITE(x)) return ACT_D__0; if (x == 0) return ACT_D_val(p0m); /* NOTE: from now on x > 0 */ /* limiting cases as size -> 1 or prob -> 0 are mass (1-p0m) at one */ if (size == 1 || prob == 0) return (x == 1) ? ACT_D_Clog(p0m) : ACT_D__0; double lp0 = dbinom_raw(0, size, prob, 1 - prob, /*give_log*/1); return ACT_D_val((1 - p0m) * dbinom(x, size, prob, /*give_log*/0)/(-expm1(lp0))); } double pzmbinom(double x, double size, double prob, double p0m, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(size) || ISNAN(prob) || ISNAN(p0m)) return x + size + prob + p0m; #endif if (prob < 0 || prob > 1 || size < 0 || p0m < 0 || p0m > 1) return R_NaN; if (x < 0) return ACT_DT_0; if (!R_FINITE(x)) return ACT_DT_1; if (x < 1) return ACT_DT_val(p0m); /* NOTE: from now on x >= 1 */ /* limiting cases as size -> 1 or prob -> 0 are mass (1-p0m) at one */ if (size == 1 || prob == 0) return ACT_DT_1; double lp0 = dbinom_raw(0, size, prob, 1 - prob, /*give_log*/1); /* working in log scale improves accuracy */ return ACT_DT_CEval(log1p(-p0m) + pbinom(x, size, prob, /*l._t.*/0, /*log_p*/1) - log1mexp(-lp0)); } double qzmbinom(double x, double size, double prob, double p0m, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(size) || ISNAN(prob) || ISNAN(p0m)) return x + size + prob + p0m; #endif if (prob < 0 || prob > 1 || size < 0 || p0m < 0 || p0m > 1) return R_NaN; /* limiting cases as size -> 1 or prob -> 0 are mass (1-p0m) at one */ if (size == 1 || prob == 0) { /* simplified ACT_Q_P01_boundaries macro */ if (log_p) { if (x > 0) return R_NaN; return (x <= log(p0m)) ? 0.0 : 1.0; } else /* !log_p */ { if (x < 0 || x > 1) return R_NaN; return (x <= p0m) ? 0.0 : 1.0; } } ACT_Q_P01_boundaries(x, 1, size); x = ACT_DT_qIv(x); /* working in log scale improves accuracy */ double lp0 = dbinom_raw(0, size, prob, 1 - prob, /*give_log*/1); return qbinom(-expm1(log1mexp(-lp0) - log1p(-p0m) + log1p(-x)), size, prob, /*l._t.*/1, /*log_p*/0); } /* ALGORITHM FOR GENERATION OF RANDOM VARIATES * * 1. p0m >= p0: just simulate variates from the discrete mixture. * * 2. p0m < p0: fastest method depends on the difference p0 - p0m. * * 2.1 p0 - p0m < ACT_DIFFMAX_REJECTION: rejection method with an * envelope that differs from the target distribution at zero * only. In other words: rejection only at zero. * 2.2 p0 - p0m >= ACT_DIFFMAX_REJECTION: simulate variates from * discrete mixture with the corresponding zero truncated * distribution. * * The threshold ACT_DIFFMAX_REJECTION is distribution specific. */ #define ACT_DIFFMAX_REJECTION 0.9 double rzmbinom(double size, double prob, double p0m) { if (!R_FINITE(prob) || prob < 0 || prob > 1 || size < 0 || p0m < 0 || p0m > 1) return R_NaN; /* limiting cases as size -> 1 or prob -> 0 are mass (1-p0m) at one */ if (size == 1 || prob == 0) return (unif_rand() <= p0m) ? 0.0 : 1.0; double x, p0 = dbinom_raw(0, size, prob, 1 - prob, /*give_log*/0); /* p0m >= p0: generate from mixture */ if (p0m >= p0) return (unif_rand() * (1 - p0) < (1 - p0m)) ? rbinom(size, prob) : 0.0; /* p0m < p0: choice of algorithm depends on difference p0 - p0m */ if (p0 - p0m < ACT_DIFFMAX_REJECTION) { /* rejection method */ for (;;) { x = rbinom(size, prob); if (x != 0 || /* x == 0 and */ runif(0, p0 * (1 - p0m)) <= (1 - p0) * p0m) return x; } } else { /* generate from zero truncated mixture */ return (unif_rand() <= p0m) ? 0.0 : qbinom(runif(p0, 1), size, prob, /*l._t.*/1, /*log_p*/0); } } actuar/src/ztnbinom.c0000644000176200001440000000776114264305077014347 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute probability function, cumulative distribution * and quantile functions, and to simulate random variates for the * zero-truncated negative binomial distribution. See * ../R/ZeroTruncatedNegativeBinomial.R for details. * * Zero-truncated distributions have density * * Pr[Z = x] = Pr[X = x]/(1 - Pr[X = 0]), * * and distribution function * * Pr[Z <= x] = (Pr[X <= x] - Pr[X = 0])/(1 - Pr[X = 0]) * * or, alternatively, survival function * * Pr[Z > x] = Pr[X > x]/(1 - Pr[X = 0]). * * AUTHOR: Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" /* The negative binomial distribution has * * F(0) = Pr[X = 0] = prob^size. * * Limiting cases: * * 1. size == 0 is Logarithmic(1 - prob) (according to the standard * parametrization of the logarithmic distribution used by * {d,p,q,r}logarithmic(); * 2. prob == 1 is point mass at x = 1. */ double dztnbinom(double x, double size, double prob, int give_log) { /* We compute Pr[X = 0] with dbinom_raw() [as would eventually * dnbinom()] to take advantage of all the optimizations for * small/large values of 'prob' and 'size' (and also to skip some * validity tests). */ #ifdef IEEE_754 if (ISNAN(x) || ISNAN(size) || ISNAN(prob)) return x + size + prob; #endif if (prob <= 0 || prob > 1 || size < 0) return R_NaN; if (x < 1 || !R_FINITE(x)) return ACT_D__0; /* limiting case as size approaches zero is logarithmic */ if (size == 0) return dlogarithmic(x, 1 - prob, give_log); /* limiting case as prob approaches one is point mass at one */ if (prob == 1) return (x == 1) ? ACT_D__1 : ACT_D__0; double lp0 = dbinom_raw(size, size, prob, 1 - prob, /*give_log*/1); return ACT_D_val(dnbinom(x, size, prob, /*give_log*/0)/(-expm1(lp0))); } double pztnbinom(double x, double size, double prob, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(size) || ISNAN(prob)) return x + size + prob; #endif if (prob <= 0 || prob > 1 || size < 0) return R_NaN; if (x < 1) return ACT_DT_0; if (!R_FINITE(x)) return ACT_DT_1; /* limiting case as size approaches zero is logarithmic */ if (size == 0) return plogarithmic(x, 1 - prob, lower_tail, log_p); /* limiting case as prob approaches one is point mass at one */ if (prob == 1) return (x >= 1) ? ACT_DT_1 : ACT_DT_0; double lp0 = dbinom_raw(size, size, prob, 1 - prob, /*give_log*/1); return ACT_DT_Cval(pnbinom(x, size, prob, /*l._t.*/0, /*log_p*/0)/(-expm1(lp0))); } double qztnbinom(double x, double size, double prob, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(size) || ISNAN(prob)) return x + size + prob; #endif if (prob <= 0 || prob > 1 || size < 0) return R_NaN; /* limiting case as size approaches zero is logarithmic */ if (size == 0) return qlogarithmic(x, 1 - prob, lower_tail, log_p); /* limiting case as prob approaches one is point mass at one */ if (prob == 1) { /* simplified ACT_Q_P01_boundaries macro */ if (log_p) { if (x > 0) return R_NaN; return 1.0; } else /* !log_p */ { if (x < 0 || x > 1) return R_NaN; return 1.0; } } ACT_Q_P01_boundaries(x, 1, R_PosInf); x = ACT_DT_qIv(x); double p0 = dbinom_raw(size, size, prob, 1 - prob, /*give_log*/0); return qnbinom(p0 + (1 - p0) * x, size, prob, /*l._t.*/1, /*log_p*/0); } double rztnbinom(double size, double prob) { if (!R_FINITE(prob) || prob <= 0 || prob > 1 || size < 0) return R_NaN; /* limiting case as size approaches zero is logarithmic */ if (size == 0) return rlogarithmic(1 - prob); /* limiting case as prob approaches one is point mass at one */ if (prob == 1) return 1.0; double p0 = dbinom_raw(size, size, prob, 1 - prob, /*give_log*/0); return qnbinom(runif(p0, 1), size, prob, /*l._t.*/1, /*log_p*/0); } actuar/src/hierarc.c0000644000176200001440000001776014264305077014124 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Function to compute the iterative part of function cm, used * to deal with credibility models. * * AUTHORS: Tommy Ouellet, Vincent Goulet */ #include #include #include #include "locale.h" #define CAD5R(e) CAR(CDR(CDR(CDR(CDR(CDR(e)))))) #define CAD6R(e) CAR(CDR(CDR(CDR(CDR(CDR(CDR(e))))))) #define CAD7R(e) CAR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(e)))))))) #define CAD8R(e) CAR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(e))))))))) #define CAD9R(e) CAR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(e)))))))))) #define abs(x) ((x) >= 0 ? (x) : -(x)) #define weights(i, j) (cred[i][j] != 0 ? cred[i][j] : tweights[i + 1][j]) SEXP toSEXP(double *x, int size) { SEXP ans = allocVector(REALSXP, size); memcpy(REAL(ans), x, size * sizeof(double)); return ans; } SEXP actuar_do_hierarc(SEXP args) { SEXP s_cred, s_tweights, s_wmeans, s_fnodes, denoms, b, tol, maxit, echo; double **cred, **tweights, **wmeans, diff, bw; int **fnodes, nlevels, i, j, k, count = 0; /* All values received from R are protected. */ PROTECT(s_cred = coerceVector(CADR(args), VECSXP)); PROTECT(s_tweights = coerceVector(CADDR(args), VECSXP)); PROTECT(s_wmeans = coerceVector(CADDDR(args), VECSXP)); PROTECT(s_fnodes = coerceVector(CAD4R(args), VECSXP)); PROTECT(denoms = coerceVector(CAD5R(args), REALSXP)); PROTECT(b = coerceVector(CAD6R(args), REALSXP)); PROTECT(tol = coerceVector(CAD7R(args), REALSXP)); PROTECT(maxit = coerceVector(CAD8R(args), INTSXP)); PROTECT(echo = coerceVector(CAD9R(args), LGLSXP)); /* Initialization of some variables */ double bt[length(b)]; /* previous values of 'b' */ nlevels = length(b) - 1; /* number of levels in the model */ bt[nlevels] = REAL(b)[nlevels]; /* within entity variance; never * changes. */ int size[nlevels + 1]; /* total number of nodes at each * level, including the portfolio level */ size[0] = 1; for (i = 1; i <= nlevels; i++) size[i] = length(VECTOR_ELT(s_fnodes, i - 1)); /* Allocation of arrays that will be needed below. */ cred = (double **) R_alloc(nlevels, sizeof(double *)); tweights = (double **) R_alloc(nlevels + 1, sizeof(double *)); wmeans = (double **) R_alloc(nlevels + 1, sizeof(double *)); fnodes = (int **) R_alloc(nlevels, sizeof(int *)); tweights[0] = (double *) R_alloc(size[0], sizeof(double)); wmeans[0] = (double *) R_alloc(size[0], sizeof(double)); for (i = 1; i <= nlevels; i++) { cred[i - 1] = (double *) R_alloc(size[i], sizeof(double)); tweights[i] = (double *) R_alloc(size[i], sizeof(double)); wmeans[i] = (double *) R_alloc(size[i], sizeof(double)); fnodes[i - 1] = (int *) R_alloc(size[i], sizeof(int)); } /* Get values of fnodes, tweights and wmeans from R lists. For * the latter two, only the entity level values are initialized * in R or meaningful. */ for (i = 0; i < nlevels; i++) memcpy(fnodes[i], INTEGER(VECTOR_ELT(s_fnodes, i)), size[i + 1] * sizeof(int)); memcpy(tweights[nlevels], REAL(VECTOR_ELT(s_tweights, nlevels)), size[nlevels] * sizeof(double)); memcpy(wmeans[nlevels], REAL(VECTOR_ELT(s_wmeans, nlevels)), size[nlevels] * sizeof(double)); /* If printing of iterations was asked for, start by printing a * header and the starting values. */ if (LOGICAL(echo)[0]) { Rprintf("Iteration\tVariance estimates\n %d\t\t", count); for (i = 0; i < nlevels; i++) Rprintf(" %.8g ", REAL(b)[i]); Rprintf("\n"); } /* Iterative part. */ do { /* Stop after 'maxit' iterations and issue warning. */ if (++count > INTEGER(maxit)[0]) { warning(_("maximum number of iterations reached before obtaining convergence")); break; } /* Copy the previous values of 'b'. */ for (i = 0; i < nlevels; i++) bt[i] = REAL(b)[i]; /* Run through all levels from lowest to highest. */ for (i = nlevels - 1; i >= 0; i--) { /* Reset the total weights and weighted averages. */ for (j = 0; j < size[i]; j++) { tweights[i][j] = 0; wmeans[i][j] = 0; } /* Find the first non-zero within variance estimator. */ for (j = 1; REAL(b)[i + j] == 0; j++); bw = REAL(b)[i + j]; /* Calculation of the new credibility factors, total * weights and (numerators of) weighted averages. */ for (j = 0; j < size[i + 1]; j++) { cred[i][j] = 1.0/(1.0 + bw / (REAL(b)[i] * tweights[i + 1][j])); k = fnodes[i][j] - 1; /* C version of tapply(). */ tweights[i][k] += weights(i, j); wmeans[i][k] += weights(i, j) * wmeans[i + 1][j]; } /* Final calculation of weighted averages with the * division by the total weight. */ for (j = 0; j < size[i]; j++) { if (tweights[i][j] > 0) wmeans[i][j] = wmeans[i][j] / tweights[i][j]; else wmeans[i][j] = 0; } /* Calculation of the new current level variance estimator * only if the previous one is strictly positive. */ if (bt[i] > 0) { REAL(b)[i] = 0; for (j = 0; j < size[i + 1]; j++) { k = fnodes[i][j]; REAL(b)[i] += weights(i, j) * R_pow_di(wmeans[i + 1][j] - wmeans[i][k - 1], 2); } REAL(b)[i] = REAL(b)[i] / REAL(denoms)[i]; /* Set the estimator to 0 if it is close enough to 0 * and henceforth stop iterations on this * parameter. */ if (REAL(b)[i] <= R_pow_di(REAL(tol)[0], 2)) REAL(b)[i] = 0; } /* Recompute the credibility factors, total weights and * weighted means with the latest between variance * estimator. */ for (j = 0; j < size[i]; j++) { tweights[i][j] = 0; wmeans[i][j] = 0; } for (j = 0; j < size[i + 1]; j++) { cred[i][j] = 1.0/(1.0 + bw / (REAL(b)[i] * tweights[i + 1][j])); k = fnodes[i][j] - 1; tweights[i][k] += weights(i, j); wmeans[i][k] += weights(i, j) * wmeans[i + 1][j]; } for (j = 0; j < size[i]; j++) { if (tweights[i][j] > 0) wmeans[i][j] = wmeans[i][j] / tweights[i][j]; else wmeans[i][j] = 0; } } /* Trace */ if (LOGICAL(echo)[0]) { Rprintf(" %d\t\t", count); for (i = 0; i < nlevels; i++) Rprintf(" %.8g ", REAL(b)[i]); Rprintf("\n"); } /* Computation of the largest difference between two * iterations. Estimators set to 0 are not taken into * account. */ diff = 0; for (i = 0; i < nlevels; i++) if (REAL(b)[i] > 0) diff = fmax2(abs(REAL(b)[i] - bt[i])/bt[i], diff); } while (diff >= REAL(tol)[0]); /* Copy the final values to R lists. */ SET_VECTOR_ELT(s_tweights, 0, toSEXP(tweights[0], size[0])); SET_VECTOR_ELT(s_wmeans, 0, toSEXP(wmeans[0], size[0])); for (i = 1; i <= nlevels; i++) { SET_VECTOR_ELT(s_cred, i - 1, toSEXP(cred[i - 1], size[i])); SET_VECTOR_ELT(s_tweights, i, toSEXP(tweights[i], size[i])); SET_VECTOR_ELT(s_wmeans, i, toSEXP(wmeans[i], size[i])); } UNPROTECT(9); return(R_NilValue); } actuar/src/zmlogarithmic.c0000644000176200001440000000645214264305077015354 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, and to simulate random variates for the zero modified * logarithmic discrete distribution. See * ../R/ZeroModifiedLogarithmic.R for details. * * The zero modified logarithmic is a discrete mixtures between a * degenerate distribution at zero and a logarithmic distribution. * The density is * * Pr[Z = x] = p0m 1(x) + (1 - p0m) Pr[X = x] * * or, alternatively, Pr[Z = 0] = p0m and * * Pr[Z = x] = (1 - p0m) Pr[X = x], * * for x = 1, 2, ... The distribution function is, for all x, * * Pr[Z <= x] = 1 - (1 - p0m) * (1 - Pr[X <= x]). * * AUTHOR: Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dzmlogarithmic(double x, double p, double p0m, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(p) || ISNAN(p0m)) return x + p + p0m; #endif if (p < 0 || p >= 1 || p0m < 0 || p0m > 1) return R_NaN; ACT_D_nonint_check(x); if (!R_FINITE(x) || x < 0) return ACT_D__0; if (x == 0) return ACT_D_val(p0m); /* NOTE: from now on x > 0 */ /* limiting case as p approaches zero is mass (1-p0m) at one */ if (p == 0) return (x == 1) ? ACT_D_Clog(p0m) : ACT_D__0; x = ACT_forceint(x); double a = -1.0/log1p(-p); return ACT_D_exp(log(a) + x * log(p) + log1p(-p0m) - log(x)); } double pzmlogarithmic(double x, double p, double p0m, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(p) || ISNAN(p0m)) return x + p + p0m; #endif if (p < 0 || p >= 1 || p0m < 0 || p0m > 1) return R_NaN; if (x < 0) return ACT_DT_0; if (!R_FINITE(x)) return ACT_DT_1; if (x < 1) return ACT_DT_val(p0m); /* NOTE: from now on x >= 1 */ /* simple case for all x >= 1 */ if (p0m == 1) return ACT_DT_1; /* limiting case as p approaches zero is mass (1-p0m) at one. */ if (p == 0) return ACT_DT_1; return ACT_DT_Cval((1 - p0m) * plogarithmic(x, p, /*l._t.*/0, /*log_p*/0)); } double qzmlogarithmic(double x, double p, double p0m, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(p) || ISNAN(p0m)) return x + p + p0m; #endif if (p < 0 || p >= 1 || p0m < 0 || p0m > 1) return R_NaN; /* limiting case as p approaches zero is mass (1-p0m) at one */ if (p == 0) { /* simplified ACT_Q_P01_boundaries macro */ if (log_p) { if (x > 0) return R_NaN; return (x <= log(p0m)) ? 0.0 : 1.0; } else /* !log_p */ { if (x < 0 || x > 1) return R_NaN; return (x <= p0m) ? 0.0 : 1.0; } } ACT_Q_P01_boundaries(x, 1.0, R_PosInf); x = ACT_DT_qIv(x); /* avoid rounding errors if x was given in log form */ if (log_p) p0m = exp(log(p0m)); /* avoid rounding errors if x was given as upper tail */ if (!lower_tail) p0m = 0.5 - (0.5 - p0m + 0.5) + 0.5; return (x <= p0m) ? 0.0 : qlogarithmic((x - p0m)/(1 - p0m), p, /*l._t.*/1, /*log_p*/0); } /* ALGORITHM FOR GENERATION OF RANDOM VARIATES * * Just simulate variates from the discrete mixture. * */ double rzmlogarithmic(double p, double p0m) { if (p < 0 || p >= 1 || p0m < 0 || p0m > 1) return R_NaN; return (unif_rand() < p0m) ? 0.0 : rlogarithmic(p); } actuar/src/init.c0000644000176200001440000003753614264305077013455 0ustar liggesusers/* * Native routines registration, as per "Writing R extensions" and * definition of native interface to one routine exported by package * expint. * */ #include #include #include #include /* optional; for expressiveness */ #include "actuar.h" static const R_ExternalMethodDef ExternalEntries[] = { {"actuar_do_random", (DL_FUNC) &actuar_do_random, -1}, {"actuar_do_randomphtype", (DL_FUNC) &actuar_do_randomphtype, -1}, {"actuar_do_dpq", (DL_FUNC) &actuar_do_dpq, -1}, {"actuar_do_dpqphtype", (DL_FUNC) &actuar_do_dpqphtype, -1}, {"actuar_do_betaint", (DL_FUNC) &actuar_do_betaint, -1}, {"actuar_do_hierarc", (DL_FUNC) &actuar_do_hierarc, -1}, {"actuar_do_panjer", (DL_FUNC) &actuar_do_panjer, -1}, {NULL, NULL, 0} }; void attribute_visible R_init_actuar(DllInfo *dll) { R_registerRoutines(dll, NULL, NULL, NULL, ExternalEntries); R_useDynamicSymbols(dll, FALSE); R_forceSymbols(dll, TRUE); /* Native interface to routine from package expint */ actuar_gamma_inc = (double(*)(double,double)) R_GetCCallable("expint", "gamma_inc"); /* Registration of actuar exported functions */ /* one parameter distributions */ R_RegisterCCallable("actuar", "mexp", (DL_FUNC) mexp); R_RegisterCCallable("actuar", "levexp", (DL_FUNC) levexp); R_RegisterCCallable("actuar", "mgfexp", (DL_FUNC) mgfexp); R_RegisterCCallable("actuar", "dinvexp", (DL_FUNC) dinvexp); R_RegisterCCallable("actuar", "pinvexp", (DL_FUNC) pinvexp); R_RegisterCCallable("actuar", "qinvexp", (DL_FUNC) qinvexp); R_RegisterCCallable("actuar", "rinvexp", (DL_FUNC) rinvexp); R_RegisterCCallable("actuar", "minvexp", (DL_FUNC) minvexp); R_RegisterCCallable("actuar", "levinvexp", (DL_FUNC) levinvexp); R_RegisterCCallable("actuar", "dlogarithmic", (DL_FUNC) dlogarithmic); R_RegisterCCallable("actuar", "plogarithmic", (DL_FUNC) plogarithmic); R_RegisterCCallable("actuar", "qlogarithmic", (DL_FUNC) qlogarithmic); R_RegisterCCallable("actuar", "rlogarithmic", (DL_FUNC) rlogarithmic); R_RegisterCCallable("actuar", "dztpois", (DL_FUNC) dztpois); R_RegisterCCallable("actuar", "pztpois", (DL_FUNC) pztpois); R_RegisterCCallable("actuar", "qztpois", (DL_FUNC) qztpois); R_RegisterCCallable("actuar", "rztpois", (DL_FUNC) rztpois); R_RegisterCCallable("actuar", "dztgeom", (DL_FUNC) dztgeom); R_RegisterCCallable("actuar", "pztgeom", (DL_FUNC) pztgeom); R_RegisterCCallable("actuar", "qztgeom", (DL_FUNC) qztgeom); R_RegisterCCallable("actuar", "rztgeom", (DL_FUNC) rztgeom); /* two parameter distributions */ R_RegisterCCallable("actuar", "munif", (DL_FUNC) munif); R_RegisterCCallable("actuar", "levunif", (DL_FUNC) levunif); R_RegisterCCallable("actuar", "mgfunif", (DL_FUNC) mgfunif); R_RegisterCCallable("actuar", "mnorm", (DL_FUNC) mnorm); R_RegisterCCallable("actuar", "mgfnorm", (DL_FUNC) mgfnorm); R_RegisterCCallable("actuar", "mbeta", (DL_FUNC) mbeta); R_RegisterCCallable("actuar", "levbeta", (DL_FUNC) levbeta); R_RegisterCCallable("actuar", "mgamma", (DL_FUNC) mgamma); R_RegisterCCallable("actuar", "levgamma", (DL_FUNC) levgamma); R_RegisterCCallable("actuar", "mgfgamma", (DL_FUNC) mgfgamma); R_RegisterCCallable("actuar", "mchisq", (DL_FUNC) mchisq); R_RegisterCCallable("actuar", "levchisq", (DL_FUNC) levchisq); R_RegisterCCallable("actuar", "mgfchisq", (DL_FUNC) mgfchisq); R_RegisterCCallable("actuar", "dinvgamma", (DL_FUNC) dinvgamma); R_RegisterCCallable("actuar", "pinvgamma", (DL_FUNC) pinvgamma); R_RegisterCCallable("actuar", "qinvgamma", (DL_FUNC) qinvgamma); R_RegisterCCallable("actuar", "rinvgamma", (DL_FUNC) rinvgamma); R_RegisterCCallable("actuar", "minvgamma", (DL_FUNC) minvgamma); R_RegisterCCallable("actuar", "levinvgamma", (DL_FUNC) levinvgamma); R_RegisterCCallable("actuar", "mgfinvgamma", (DL_FUNC) mgfinvgamma); R_RegisterCCallable("actuar", "dinvparalogis", (DL_FUNC) dinvparalogis); R_RegisterCCallable("actuar", "pinvparalogis", (DL_FUNC) pinvparalogis); R_RegisterCCallable("actuar", "qinvparalogis", (DL_FUNC) qinvparalogis); R_RegisterCCallable("actuar", "rinvparalogis", (DL_FUNC) rinvparalogis); R_RegisterCCallable("actuar", "minvparalogis", (DL_FUNC) minvparalogis); R_RegisterCCallable("actuar", "levinvparalogis", (DL_FUNC) levinvparalogis); R_RegisterCCallable("actuar", "dinvpareto", (DL_FUNC) dinvpareto); R_RegisterCCallable("actuar", "pinvpareto", (DL_FUNC) pinvpareto); R_RegisterCCallable("actuar", "qinvpareto", (DL_FUNC) qinvpareto); R_RegisterCCallable("actuar", "rinvpareto", (DL_FUNC) rinvpareto); R_RegisterCCallable("actuar", "minvpareto", (DL_FUNC) minvpareto); R_RegisterCCallable("actuar", "levinvpareto", (DL_FUNC) levinvpareto); R_RegisterCCallable("actuar", "dinvweibull", (DL_FUNC) dinvweibull); R_RegisterCCallable("actuar", "pinvweibull", (DL_FUNC) pinvweibull); R_RegisterCCallable("actuar", "qinvweibull", (DL_FUNC) qinvweibull); R_RegisterCCallable("actuar", "rinvweibull", (DL_FUNC) rinvweibull); R_RegisterCCallable("actuar", "minvweibull", (DL_FUNC) minvweibull); R_RegisterCCallable("actuar", "levinvweibull", (DL_FUNC) levinvweibull); R_RegisterCCallable("actuar", "dlgamma", (DL_FUNC) dlgamma); R_RegisterCCallable("actuar", "plgamma", (DL_FUNC) plgamma); R_RegisterCCallable("actuar", "qlgamma", (DL_FUNC) qlgamma); R_RegisterCCallable("actuar", "rlgamma", (DL_FUNC) rlgamma); R_RegisterCCallable("actuar", "mlgamma", (DL_FUNC) mlgamma); R_RegisterCCallable("actuar", "levlgamma", (DL_FUNC) levlgamma); R_RegisterCCallable("actuar", "dllogis", (DL_FUNC) dllogis); R_RegisterCCallable("actuar", "pllogis", (DL_FUNC) pllogis); R_RegisterCCallable("actuar", "qllogis", (DL_FUNC) qllogis); R_RegisterCCallable("actuar", "rllogis", (DL_FUNC) rllogis); R_RegisterCCallable("actuar", "mllogis", (DL_FUNC) mllogis); R_RegisterCCallable("actuar", "levllogis", (DL_FUNC) levllogis); R_RegisterCCallable("actuar", "mlnorm", (DL_FUNC) mlnorm); R_RegisterCCallable("actuar", "levlnorm", (DL_FUNC) levlnorm); R_RegisterCCallable("actuar", "dparalogis", (DL_FUNC) dparalogis); R_RegisterCCallable("actuar", "pparalogis", (DL_FUNC) pparalogis); R_RegisterCCallable("actuar", "qparalogis", (DL_FUNC) qparalogis); R_RegisterCCallable("actuar", "rparalogis", (DL_FUNC) rparalogis); R_RegisterCCallable("actuar", "mparalogis", (DL_FUNC) mparalogis); R_RegisterCCallable("actuar", "levparalogis", (DL_FUNC) levparalogis); R_RegisterCCallable("actuar", "dpareto", (DL_FUNC) dpareto); R_RegisterCCallable("actuar", "ppareto", (DL_FUNC) ppareto); R_RegisterCCallable("actuar", "qpareto", (DL_FUNC) qpareto); R_RegisterCCallable("actuar", "rpareto", (DL_FUNC) rpareto); R_RegisterCCallable("actuar", "mpareto", (DL_FUNC) mpareto); R_RegisterCCallable("actuar", "levpareto", (DL_FUNC) levpareto); R_RegisterCCallable("actuar", "dpareto1", (DL_FUNC) dpareto1); R_RegisterCCallable("actuar", "ppareto1", (DL_FUNC) ppareto1); R_RegisterCCallable("actuar", "qpareto1", (DL_FUNC) qpareto1); R_RegisterCCallable("actuar", "rpareto1", (DL_FUNC) rpareto1); R_RegisterCCallable("actuar", "mpareto1", (DL_FUNC) mpareto1); R_RegisterCCallable("actuar", "levpareto1", (DL_FUNC) levpareto1); R_RegisterCCallable("actuar", "mweibull", (DL_FUNC) mweibull); R_RegisterCCallable("actuar", "levweibull", (DL_FUNC) levweibull); /* R_RegisterCCallable("actuar", "minvGauss", (DL_FUNC) minvGauss); [defunct v3.0-0] */ /* R_RegisterCCallable("actuar", "levinvGauss", (DL_FUNC) levinvGauss); [idem] */ /* R_RegisterCCallable("actuar", "mgfinvGauss", (DL_FUNC) mgfinvGauss); [idem] */ R_RegisterCCallable("actuar", "dgumbel", (DL_FUNC) dgumbel); R_RegisterCCallable("actuar", "pgumbel", (DL_FUNC) pgumbel); R_RegisterCCallable("actuar", "qgumbel", (DL_FUNC) qgumbel); R_RegisterCCallable("actuar", "rgumbel", (DL_FUNC) rgumbel); R_RegisterCCallable("actuar", "mgumbel", (DL_FUNC) mgumbel); R_RegisterCCallable("actuar", "mgfgumbel", (DL_FUNC) mgfgumbel); R_RegisterCCallable("actuar", "dinvgauss", (DL_FUNC) dinvgauss); R_RegisterCCallable("actuar", "pinvgauss", (DL_FUNC) pinvgauss); R_RegisterCCallable("actuar", "qinvgauss", (DL_FUNC) qinvgauss); R_RegisterCCallable("actuar", "rinvgauss", (DL_FUNC) rinvgauss); R_RegisterCCallable("actuar", "minvgauss", (DL_FUNC) minvgauss); R_RegisterCCallable("actuar", "levinvgauss", (DL_FUNC) levinvgauss); R_RegisterCCallable("actuar", "mgfinvgauss", (DL_FUNC) mgfinvgauss); R_RegisterCCallable("actuar", "dztnbinom", (DL_FUNC) dztnbinom); R_RegisterCCallable("actuar", "pztnbinom", (DL_FUNC) pztnbinom); R_RegisterCCallable("actuar", "qztnbinom", (DL_FUNC) qztnbinom); R_RegisterCCallable("actuar", "rztnbinom", (DL_FUNC) rztnbinom); R_RegisterCCallable("actuar", "dztbinom", (DL_FUNC) dztbinom); R_RegisterCCallable("actuar", "pztbinom", (DL_FUNC) pztbinom); R_RegisterCCallable("actuar", "qztbinom", (DL_FUNC) qztbinom); R_RegisterCCallable("actuar", "rztbinom", (DL_FUNC) rztbinom); R_RegisterCCallable("actuar", "dzmlogarithmic", (DL_FUNC) dzmlogarithmic); R_RegisterCCallable("actuar", "pzmlogarithmic", (DL_FUNC) pzmlogarithmic); R_RegisterCCallable("actuar", "qzmlogarithmic", (DL_FUNC) qzmlogarithmic); R_RegisterCCallable("actuar", "rzmlogarithmic", (DL_FUNC) rzmlogarithmic); R_RegisterCCallable("actuar", "dzmpois", (DL_FUNC) dzmpois); R_RegisterCCallable("actuar", "pzmpois", (DL_FUNC) pzmpois); R_RegisterCCallable("actuar", "qzmpois", (DL_FUNC) qzmpois); R_RegisterCCallable("actuar", "rzmpois", (DL_FUNC) rzmpois); R_RegisterCCallable("actuar", "dzmgeom", (DL_FUNC) dzmgeom); R_RegisterCCallable("actuar", "pzmgeom", (DL_FUNC) pzmgeom); R_RegisterCCallable("actuar", "qzmgeom", (DL_FUNC) qzmgeom); R_RegisterCCallable("actuar", "rzmgeom", (DL_FUNC) rzmgeom); R_RegisterCCallable("actuar", "dpoisinvgauss", (DL_FUNC) dpoisinvgauss); R_RegisterCCallable("actuar", "ppoisinvgauss", (DL_FUNC) ppoisinvgauss); R_RegisterCCallable("actuar", "qpoisinvgauss", (DL_FUNC) qpoisinvgauss); R_RegisterCCallable("actuar", "rpoisinvgauss", (DL_FUNC) rpoisinvgauss); /* three parameter distributions */ R_RegisterCCallable("actuar", "dburr", (DL_FUNC) dburr); R_RegisterCCallable("actuar", "pburr", (DL_FUNC) pburr); R_RegisterCCallable("actuar", "qburr", (DL_FUNC) qburr); R_RegisterCCallable("actuar", "rburr", (DL_FUNC) rburr); R_RegisterCCallable("actuar", "mburr", (DL_FUNC) mburr); R_RegisterCCallable("actuar", "levburr", (DL_FUNC) levburr); R_RegisterCCallable("actuar", "dgenpareto", (DL_FUNC) dgenpareto); R_RegisterCCallable("actuar", "pgenpareto", (DL_FUNC) pgenpareto); R_RegisterCCallable("actuar", "qgenpareto", (DL_FUNC) qgenpareto); R_RegisterCCallable("actuar", "rgenpareto", (DL_FUNC) rgenpareto); R_RegisterCCallable("actuar", "mgenpareto", (DL_FUNC) mgenpareto); R_RegisterCCallable("actuar", "levgenpareto", (DL_FUNC) levgenpareto); R_RegisterCCallable("actuar", "dinvburr", (DL_FUNC) dinvburr); R_RegisterCCallable("actuar", "pinvburr", (DL_FUNC) pinvburr); R_RegisterCCallable("actuar", "qinvburr", (DL_FUNC) qinvburr); R_RegisterCCallable("actuar", "rinvburr", (DL_FUNC) rinvburr); R_RegisterCCallable("actuar", "minvburr", (DL_FUNC) minvburr); R_RegisterCCallable("actuar", "levinvburr", (DL_FUNC) levinvburr); R_RegisterCCallable("actuar", "dinvtrgamma", (DL_FUNC) dinvtrgamma); R_RegisterCCallable("actuar", "pinvtrgamma", (DL_FUNC) pinvtrgamma); R_RegisterCCallable("actuar", "qinvtrgamma", (DL_FUNC) qinvtrgamma); R_RegisterCCallable("actuar", "rinvtrgamma", (DL_FUNC) rinvtrgamma); R_RegisterCCallable("actuar", "minvtrgamma", (DL_FUNC) minvtrgamma); R_RegisterCCallable("actuar", "levinvtrgamma", (DL_FUNC) levinvtrgamma); R_RegisterCCallable("actuar", "dtrgamma", (DL_FUNC) dtrgamma); R_RegisterCCallable("actuar", "ptrgamma", (DL_FUNC) ptrgamma); R_RegisterCCallable("actuar", "qtrgamma", (DL_FUNC) qtrgamma); R_RegisterCCallable("actuar", "rtrgamma", (DL_FUNC) rtrgamma); R_RegisterCCallable("actuar", "mtrgamma", (DL_FUNC) mtrgamma); R_RegisterCCallable("actuar", "levtrgamma", (DL_FUNC) levtrgamma); R_RegisterCCallable("actuar", "dpareto2", (DL_FUNC) dpareto2); R_RegisterCCallable("actuar", "ppareto2", (DL_FUNC) ppareto2); R_RegisterCCallable("actuar", "qpareto2", (DL_FUNC) qpareto2); R_RegisterCCallable("actuar", "rpareto2", (DL_FUNC) rpareto2); R_RegisterCCallable("actuar", "mpareto2", (DL_FUNC) mpareto2); R_RegisterCCallable("actuar", "levpareto2", (DL_FUNC) levpareto2); R_RegisterCCallable("actuar", "dpareto3", (DL_FUNC) dpareto3); R_RegisterCCallable("actuar", "ppareto3", (DL_FUNC) ppareto3); R_RegisterCCallable("actuar", "qpareto3", (DL_FUNC) qpareto3); R_RegisterCCallable("actuar", "rpareto3", (DL_FUNC) rpareto3); R_RegisterCCallable("actuar", "mpareto3", (DL_FUNC) mpareto3); R_RegisterCCallable("actuar", "levpareto3", (DL_FUNC) levpareto3); R_RegisterCCallable("actuar", "dzmnbinom", (DL_FUNC) dzmnbinom); R_RegisterCCallable("actuar", "pzmnbinom", (DL_FUNC) pzmnbinom); R_RegisterCCallable("actuar", "qzmnbinom", (DL_FUNC) qzmnbinom); R_RegisterCCallable("actuar", "rzmnbinom", (DL_FUNC) rzmnbinom); R_RegisterCCallable("actuar", "dzmbinom", (DL_FUNC) dzmbinom); R_RegisterCCallable("actuar", "pzmbinom", (DL_FUNC) pzmbinom); R_RegisterCCallable("actuar", "qzmbinom", (DL_FUNC) qzmbinom); R_RegisterCCallable("actuar", "rzmbinom", (DL_FUNC) rzmbinom); /* four parameter distributions */ R_RegisterCCallable("actuar", "dtrbeta", (DL_FUNC) dtrbeta); R_RegisterCCallable("actuar", "ptrbeta", (DL_FUNC) ptrbeta); R_RegisterCCallable("actuar", "qtrbeta", (DL_FUNC) qtrbeta); R_RegisterCCallable("actuar", "rtrbeta", (DL_FUNC) rtrbeta); R_RegisterCCallable("actuar", "mtrbeta", (DL_FUNC) mtrbeta); R_RegisterCCallable("actuar", "levtrbeta", (DL_FUNC) levtrbeta); R_RegisterCCallable("actuar", "dgenbeta", (DL_FUNC) dgenbeta); R_RegisterCCallable("actuar", "pgenbeta", (DL_FUNC) pgenbeta); R_RegisterCCallable("actuar", "qgenbeta", (DL_FUNC) qgenbeta); R_RegisterCCallable("actuar", "rgenbeta", (DL_FUNC) rgenbeta); R_RegisterCCallable("actuar", "mgenbeta", (DL_FUNC) mgenbeta); R_RegisterCCallable("actuar", "levgenbeta", (DL_FUNC) levgenbeta); R_RegisterCCallable("actuar", "dpareto4", (DL_FUNC) dpareto4); R_RegisterCCallable("actuar", "ppareto4", (DL_FUNC) ppareto4); R_RegisterCCallable("actuar", "qpareto4", (DL_FUNC) qpareto4); R_RegisterCCallable("actuar", "rpareto4", (DL_FUNC) rpareto4); R_RegisterCCallable("actuar", "mpareto4", (DL_FUNC) mpareto4); R_RegisterCCallable("actuar", "levpareto4", (DL_FUNC) levpareto4); /* five parameter distributions */ R_RegisterCCallable("actuar", "dfpareto", (DL_FUNC) dfpareto); R_RegisterCCallable("actuar", "pfpareto", (DL_FUNC) pfpareto); R_RegisterCCallable("actuar", "qfpareto", (DL_FUNC) qfpareto); R_RegisterCCallable("actuar", "rfpareto", (DL_FUNC) rfpareto); R_RegisterCCallable("actuar", "mfpareto", (DL_FUNC) mfpareto); R_RegisterCCallable("actuar", "levfpareto", (DL_FUNC) levfpareto); /* phase-type distributions */ R_RegisterCCallable("actuar", "dphtype", (DL_FUNC) dphtype); R_RegisterCCallable("actuar", "pphtype", (DL_FUNC) pphtype); R_RegisterCCallable("actuar", "rphtype", (DL_FUNC) rphtype); R_RegisterCCallable("actuar", "mphtype", (DL_FUNC) mphtype); R_RegisterCCallable("actuar", "mgfphtype", (DL_FUNC) mgfphtype); /* special integrals */ R_RegisterCCallable("actuar", "betaint", (DL_FUNC) betaint); } /* Define imports from package expint */ double(*actuar_gamma_inc)(double,double); actuar/src/dpq.c0000644000176200001440000013213614326564170013266 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute probability density, cumulative probability * quantile functions and moment generating functions, raw moments * and limited moments for some probability laws not in base R (or * those quantities not provided in base R). Function .External() * calls actuar_do_dpq() with arguments: * * 1. the name of the distribution, with a "d", a "p" or "q" * prepended to it (e.g. "dpareto", "pburr"); * 2. the value(s) where the function is to be evaluated; * 3:x. the parameters of the distribution (including the order of * the limited moment for lev*); * x+1. whether to return the lower or upper tail probability or * quantile (p* and q* only); see note below for m* and lev* * functions; * x+2. whether to return probability in log scale or the cumulant * generating function (d*, p*, q* and mgf* only). * * Function actuar_do_dpq() will extract the name of the distribution, look * up in table dpq_tab defined in names.c which of actuar_do_dpq{1,2,3,4} * should take care of the calculation and dispatch to this function. * In turn, functions actuar_do_dpq{1,2,3,4} call function * {d,p,q,m,lev,mgf}dist() to get actual values from distribution * "dist". * * Note: the m* and lev* functions came later in the process. In * order to easily fit them into this system, I have decided to leave * an unused 'give_log' argument in the C definitions of these * functions. Otherwise, this would have required defining functions * dpq{1,2,3,4,5}_0() below. * * Functions therein are essentially identical to those found in * src/main/arithmetic.c of R sources with a different naming scheme. * * To add a new distribution: write a {d,p,q,m,lev,mgf}dist() * function, add an entry in names.c and in the definition of the * corresponding actuar_do_dpq{1,2,3,4,6} function, declare the * function in actuar.h. * * Adapted from src/main/arithmetic.c of R sources. * * AUTHOR: Vincent Goulet * with much indirect help from the R Core Team */ #include #include #include "actuar.h" #include "locale.h" /* Prototypes of auxiliary functions */ static SEXP dpq1_1(SEXP, SEXP, SEXP, double (*f)(double, double, int)); static SEXP dpq1_2(SEXP, SEXP, SEXP, SEXP, double (*f)(double, double, int, int)); static SEXP dpq2_1(SEXP, SEXP, SEXP, SEXP, double (*f)(double, double, double, int)); static SEXP dpq2_2(SEXP, SEXP, SEXP, SEXP, SEXP, double (*f)(double, double, double, int, int)); static SEXP dpq2_5(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, double (*f)(double, double, double, int, int, double, int, int)); static SEXP dpq3_1(SEXP, SEXP, SEXP, SEXP, SEXP, double (*f)(double, double, double, double, int)); static SEXP dpq3_2(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, double (*f)(double, double, double, double, int, int)); static SEXP dpq4_1(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, double (*f)(double, double, double, double, double, int)); static SEXP dpq4_2(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, double (*f)(double, double, double, double, double, int, int)); static SEXP dpq5_1(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, double (*f)(double, double, double, double, double, double, int)); static SEXP dpq5_2(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, double (*f)(double, double, double, double, double, double, int, int)); static SEXP dpq6_1(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, double (*f)(double, double, double, double, double, double, double, int)); /* Additional access macros */ #define CAD5R(e) CAR(CDR(CDR(CDR(CDR(CDR(e)))))) #define CAD6R(e) CAR(CDR(CDR(CDR(CDR(CDR(CDR(e))))))) #define CAD7R(e) CAR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(e)))))))) /* Functions for one parameter distributions */ #define if_NA_dpq1_set(y, x, a) \ if (ISNA (x) || ISNA (a)) y = NA_REAL; \ else if (ISNAN(x) || ISNAN(a)) y = R_NaN; #define mod_iterate1(n1, n2, i1, i2) \ for (i = i1 = i2 = 0; i < n; \ i1 = (++i1 == n1) ? 0 : i1, \ i2 = (++i2 == n2) ? 0 : i2, \ ++i) static SEXP dpq1_1(SEXP sx, SEXP sa, SEXP sI, double (*f)(double, double, int)) { SEXP sy; int i, ix, ia, n, nx, na, sxo = OBJECT(sx), sao = OBJECT(sa); double xi, ai, *x, *a, *y; int i_1; Rboolean naflag = FALSE; #define SETUP_DPQ1 \ if (!isNumeric(sx) || !isNumeric(sa)) \ error(_("invalid arguments")); \ \ nx = LENGTH(sx); \ na = LENGTH(sa); \ if ((nx == 0) || (na == 0)) \ return(allocVector(REALSXP, 0)); \ n = (nx < na) ? na : nx; \ PROTECT(sx = coerceVector(sx, REALSXP)); \ PROTECT(sa = coerceVector(sa, REALSXP)); \ PROTECT(sy = allocVector(REALSXP, n)); \ x = REAL(sx); \ a = REAL(sa); \ y = REAL(sy) SETUP_DPQ1; i_1 = asInteger(sI); mod_iterate1(nx, na, ix, ia) { xi = x[ix]; ai = a[ia]; if_NA_dpq1_set(y[i], xi, ai) else { y[i] = f(xi, ai, i_1); if (ISNAN(y[i])) naflag = TRUE; } } #define FINISH_DPQ1 \ if (naflag) \ warning(R_MSG_NA); \ \ if (n == nx) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sx))); \ SET_OBJECT(sy, sxo); \ } \ else if (n == na) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sa))); \ SET_OBJECT(sy, sao); \ } \ UNPROTECT(3) FINISH_DPQ1; return sy; } static SEXP dpq1_2(SEXP sx, SEXP sa, SEXP sI, SEXP sJ, double (*f)(double, double, int, int)) { SEXP sy; int i, ix, ia, n, nx, na, sxo = OBJECT(sx), sao = OBJECT(sa); double xi, ai, *x, *a, *y; int i_1, i_2; Rboolean naflag = FALSE; SETUP_DPQ1; i_1 = asInteger(sI); i_2 = asInteger(sJ); mod_iterate1(nx, na, ix, ia) { xi = x[ix]; ai = a[ia]; if_NA_dpq1_set(y[i], xi, ai) else { y[i] = f(xi, ai, i_1, i_2); if (ISNAN(y[i])) naflag = TRUE; } } FINISH_DPQ1; return sy; } #define DPQ1_1(A, FUN) dpq1_1(CAR(A), CADR(A), CADDR(A), FUN); #define DPQ1_2(A, FUN) dpq1_2(CAR(A), CADR(A), CADDR(A), CADDDR(A), FUN) SEXP actuar_do_dpq1(int code, SEXP args) { switch (code) { case 1: return DPQ1_1(args, mexp); case 2: return DPQ1_1(args, dinvexp); case 3: return DPQ1_2(args, pinvexp); case 4: return DPQ1_2(args, qinvexp); case 5: return DPQ1_1(args, minvexp); case 6: return DPQ1_1(args, mgfexp); case 101: return DPQ1_1(args, dlogarithmic); case 102: return DPQ1_2(args, plogarithmic); case 103: return DPQ1_2(args, qlogarithmic); case 104: return DPQ1_1(args, dztpois); case 105: return DPQ1_2(args, pztpois); case 106: return DPQ1_2(args, qztpois); case 107: return DPQ1_1(args, dztgeom); case 108: return DPQ1_2(args, pztgeom); case 109: return DPQ1_2(args, qztgeom); default: error(_("internal error in actuar_do_dpq1")); } return args; /* never used; to keep -Wall happy */ } /* Functions for two parameter distributions */ #define if_NA_dpq2_set(y, x, a, b) \ if (ISNA (x) || ISNA (a) || ISNA (b)) y = NA_REAL; \ else if (ISNAN(x) || ISNAN(a) || ISNAN(b)) y = R_NaN; #define mod_iterate2(n1, n2, n3, i1, i2, i3) \ for (i = i1 = i2 = i3 = 0; i < n; \ i1 = (++i1 == n1) ? 0 : i1, \ i2 = (++i2 == n2) ? 0 : i2, \ i3 = (++i3 == n3) ? 0 : i3, \ ++i) static SEXP dpq2_1(SEXP sx, SEXP sa, SEXP sb, SEXP sI, double (*f)(double, double, double, int)) { SEXP sy; int i, ix, ia, ib, n, nx, na, nb, sxo = OBJECT(sx), sao = OBJECT(sa), sbo = OBJECT(sb); double xi, ai, bi, *x, *a, *b, *y; int i_1; Rboolean naflag = FALSE; #define SETUP_DPQ2 \ if (!isNumeric(sx) || !isNumeric(sa) || !isNumeric(sb)) \ error(_("invalid arguments")); \ \ nx = LENGTH(sx); \ na = LENGTH(sa); \ nb = LENGTH(sb); \ if ((nx == 0) || (na == 0) || (nb == 0)) \ return(allocVector(REALSXP, 0)); \ n = nx; \ if (n < na) n = na; \ if (n < nb) n = nb; \ PROTECT(sx = coerceVector(sx, REALSXP)); \ PROTECT(sa = coerceVector(sa, REALSXP)); \ PROTECT(sb = coerceVector(sb, REALSXP)); \ PROTECT(sy = allocVector(REALSXP, n)); \ x = REAL(sx); \ a = REAL(sa); \ b = REAL(sb); \ y = REAL(sy) SETUP_DPQ2; i_1 = asInteger(sI); mod_iterate2(nx, na, nb, ix, ia, ib) { xi = x[ix]; ai = a[ia]; bi = b[ib]; if_NA_dpq2_set(y[i], xi, ai, bi) else { y[i] = f(xi, ai, bi, i_1); if (ISNAN(y[i])) naflag = TRUE; } } #define FINISH_DPQ2 \ if (naflag) \ warning(R_MSG_NA); \ \ if (n == nx) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sx))); \ SET_OBJECT(sy, sxo); \ } \ else if (n == na) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sa))); \ SET_OBJECT(sy, sao); \ } \ else if (n == nb) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sb))); \ SET_OBJECT(sy, sbo); \ } \ UNPROTECT(4) FINISH_DPQ2; return sy; } static SEXP dpq2_2(SEXP sx, SEXP sa, SEXP sb, SEXP sI, SEXP sJ, double (*f)(double, double, double, int, int)) { SEXP sy; int i, ix, ia, ib, n, nx, na, nb, sxo = OBJECT(sx), sao = OBJECT(sa), sbo = OBJECT(sb); double xi, ai, bi, *x, *a, *b, *y; int i_1, i_2; Rboolean naflag = FALSE; SETUP_DPQ2; i_1 = asInteger(sI); i_2 = asInteger(sJ); mod_iterate2(nx, na, nb, ix, ia, ib) { xi = x[ix]; ai = a[ia]; bi = b[ib]; if_NA_dpq2_set(y[i], xi, ai, bi) else { y[i] = f(xi, ai, bi, i_1, i_2); if (ISNAN(y[i])) naflag = TRUE; } } FINISH_DPQ2; return sy; } /* This is needed for qinvgauss that has three additional parameters * for the tolerance, the maximum number of iterations and echoing of * the iterations. */ static SEXP dpq2_5(SEXP sx, SEXP sa, SEXP sb, SEXP sI, SEXP sJ, SEXP sT, SEXP sM, SEXP sE, double (*f)(double, double, double, int, int, double, int, int)) { SEXP sy; int i, ix, ia, ib, n, nx, na, nb, sxo = OBJECT(sx), sao = OBJECT(sa), sbo = OBJECT(sb); double xi, ai, bi, *x, *a, *b, *y; int i_1, i_2, i_4, i_5; double d_3; Rboolean naflag = FALSE; SETUP_DPQ2; i_1 = asInteger(sI); i_2 = asInteger(sJ); d_3 = asReal(sT); i_4 = asInteger(sM); i_5 = asInteger(sE); mod_iterate2(nx, na, nb, ix, ia, ib) { xi = x[ix]; ai = a[ia]; bi = b[ib]; if_NA_dpq2_set(y[i], xi, ai, bi) else { y[i] = f(xi, ai, bi, i_1, i_2, d_3, i_4, i_5); if (ISNAN(y[i])) naflag = TRUE; } } FINISH_DPQ2; return sy; } #define DPQ2_1(A, FUN) dpq2_1(CAR(A), CADR(A), CADDR(A), CADDDR(A), FUN); #define DPQ2_2(A, FUN) dpq2_2(CAR(A), CADR(A), CADDR(A), CADDDR(A), CAD4R(A), FUN) #define DPQ2_5(A, FUN) dpq2_5(CAR(A), CADR(A), CADDR(A), CADDDR(A), CAD4R(A), CAD5R(A), CAD6R(A), CAD7R(A), FUN) SEXP actuar_do_dpq2(int code, SEXP args) { switch (code) { case 1: return DPQ2_1(args, mgamma); case 2: return DPQ2_1(args, dinvgamma); case 3: return DPQ2_2(args, pinvgamma); case 4: return DPQ2_2(args, qinvgamma); case 5: return DPQ2_1(args, minvgamma); case 6: return DPQ2_1(args, dinvparalogis); case 7: return DPQ2_2(args, pinvparalogis); case 8: return DPQ2_2(args, qinvparalogis); case 9: return DPQ2_1(args, minvparalogis); case 10: return DPQ2_1(args, dinvpareto); case 11: return DPQ2_2(args, pinvpareto); case 12: return DPQ2_2(args, qinvpareto); case 13: return DPQ2_1(args, minvpareto); case 14: return DPQ2_1(args, dinvweibull); case 15: return DPQ2_2(args, pinvweibull); case 16: return DPQ2_2(args, qinvweibull); case 17: return DPQ2_1(args, minvweibull); case 18: return DPQ2_1(args, dlgamma); case 19: return DPQ2_2(args, plgamma); case 20: return DPQ2_2(args, qlgamma); case 21: return DPQ2_1(args, mlgamma); case 22: return DPQ2_1(args, dllogis); case 23: return DPQ2_2(args, pllogis); case 24: return DPQ2_2(args, qllogis); case 25: return DPQ2_1(args, mllogis); case 26: return DPQ2_1(args, mlnorm); case 27: return DPQ2_1(args, dparalogis); case 28: return DPQ2_2(args, pparalogis); case 29: return DPQ2_2(args, qparalogis); case 30: return DPQ2_1(args, mparalogis); case 31: return DPQ2_1(args, dpareto); case 32: return DPQ2_2(args, ppareto); case 33: return DPQ2_2(args, qpareto); case 34: return DPQ2_1(args, mpareto); case 35: return DPQ2_1(args, dpareto1); case 36: return DPQ2_2(args, ppareto1); case 37: return DPQ2_2(args, qpareto1); case 38: return DPQ2_1(args, mpareto1); case 39: return DPQ2_1(args, mweibull); case 40: return DPQ2_1(args, levexp); case 41: return DPQ2_1(args, levinvexp); case 42: return DPQ2_1(args, mbeta); case 43: return DPQ2_1(args, mgfgamma); case 44: return DPQ2_1(args, mgfnorm); case 45: return DPQ2_1(args, mgfunif); case 46: return DPQ2_1(args, mgfinvgamma); case 47: return DPQ2_1(args, mnorm); case 48: return DPQ2_1(args, mchisq); case 49: return DPQ2_1(args, mgfchisq); /* case 50: return DPQ2_1(args, minvGauss); [defunct v3.0-0] */ /* case 51: return DPQ2_1(args, mgfinvGauss); [defunct v3.0-0] */ case 52: return DPQ2_1(args, munif); case 53: return DPQ2_1(args, dgumbel); case 54: return DPQ2_2(args, pgumbel); case 55: return DPQ2_2(args, qgumbel); case 56: return DPQ2_1(args, mgumbel); case 57: return DPQ2_1(args, mgfgumbel); case 58: return DPQ2_1(args, dinvgauss); case 59: return DPQ2_2(args, pinvgauss); case 60: return DPQ2_5(args, qinvgauss); case 61: return DPQ2_1(args, minvgauss); case 62: return DPQ2_1(args, mgfinvgauss); case 101: return DPQ2_1(args, dztnbinom); case 102: return DPQ2_2(args, pztnbinom); case 103: return DPQ2_2(args, qztnbinom); case 104: return DPQ2_1(args, dztbinom); case 105: return DPQ2_2(args, pztbinom); case 106: return DPQ2_2(args, qztbinom); case 107: return DPQ2_1(args, dzmlogarithmic); case 108: return DPQ2_2(args, pzmlogarithmic); case 109: return DPQ2_2(args, qzmlogarithmic); case 110: return DPQ2_1(args, dzmpois); case 111: return DPQ2_2(args, pzmpois); case 112: return DPQ2_2(args, qzmpois); case 113: return DPQ2_1(args, dzmgeom); case 114: return DPQ2_2(args, pzmgeom); case 115: return DPQ2_2(args, qzmgeom); case 116: return DPQ2_1(args, dpoisinvgauss); case 117: return DPQ2_2(args, ppoisinvgauss); case 118: return DPQ2_2(args, qpoisinvgauss); default: error(_("internal error in actuar_do_dpq2")); } return args; /* never used; to keep -Wall happy */ } /* Functions for three parameter distributions */ #define if_NA_dpq3_set(y, x, a, b, c) \ if (ISNA (x) || ISNA (a) || ISNA (b) || ISNA (c)) y = NA_REAL; \ else if (ISNAN(x) || ISNAN(a) || ISNAN(b) || ISNAN(c)) y = R_NaN; #define mod_iterate3(n1, n2, n3, n4, i1, i2, i3, i4) \ for (i = i1 = i2 = i3 = i4 = 0; i < n; \ i1 = (++i1 == n1) ? 0 : i1, \ i2 = (++i2 == n2) ? 0 : i2, \ i3 = (++i3 == n3) ? 0 : i3, \ i4 = (++i4 == n4) ? 0 : i4, \ ++i) static SEXP dpq3_1(SEXP sx, SEXP sa, SEXP sb, SEXP sc, SEXP sI, double (*f)(double, double, double, double, int)) { SEXP sy; int i, ix, ia, ib, ic, n, nx, na, nb, nc, sxo = OBJECT(sx), sao = OBJECT(sa), sbo = OBJECT(sb), sco = OBJECT(sc); double xi, ai, bi, ci, *x, *a, *b, *c, *y; int i_1; Rboolean naflag = FALSE; #define SETUP_DPQ3 \ if (!isNumeric(sx) || !isNumeric(sa) || \ !isNumeric(sb) || !isNumeric(sc)) \ error(_("invalid arguments")); \ \ nx = LENGTH(sx); \ na = LENGTH(sa); \ nb = LENGTH(sb); \ nc = LENGTH(sc); \ if ((nx == 0) || (na == 0) || (nb == 0) || (nc == 0)) \ return(allocVector(REALSXP, 0)); \ n = nx; \ if (n < na) n = na; \ if (n < nb) n = nb; \ if (n < nc) n = nc; \ PROTECT(sx = coerceVector(sx, REALSXP)); \ PROTECT(sa = coerceVector(sa, REALSXP)); \ PROTECT(sb = coerceVector(sb, REALSXP)); \ PROTECT(sc = coerceVector(sc, REALSXP)); \ PROTECT(sy = allocVector(REALSXP, n)); \ x = REAL(sx); \ a = REAL(sa); \ b = REAL(sb); \ c = REAL(sc); \ y = REAL(sy) SETUP_DPQ3; i_1 = asInteger(sI); mod_iterate3(nx, na, nb, nc, ix, ia, ib, ic) { xi = x[ix]; ai = a[ia]; bi = b[ib]; ci = c[ic]; if_NA_dpq3_set(y[i], xi, ai, bi, ci) else { y[i] = f(xi, ai, bi, ci, i_1); if (ISNAN(y[i])) naflag = TRUE; } } #define FINISH_DPQ3 \ if (naflag) \ warning(R_MSG_NA); \ \ if (n == nx) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sx))); \ SET_OBJECT(sy, sxo); \ } \ else if (n == na) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sa))); \ SET_OBJECT(sy, sao); \ } \ else if (n == nb) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sb))); \ SET_OBJECT(sy, sbo); \ } \ else if (n == nc) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sc))); \ SET_OBJECT(sy, sco); \ } \ UNPROTECT(5) FINISH_DPQ3; return sy; } static SEXP dpq3_2(SEXP sx, SEXP sa, SEXP sb, SEXP sc, SEXP sI, SEXP sJ, double (*f)(double, double, double, double, int, int)) { SEXP sy; int i, ix, ia, ib, ic, n, nx, na, nb, nc, sxo = OBJECT(sx), sao = OBJECT(sa), sbo = OBJECT(sb), sco = OBJECT(sc); double xi, ai, bi, ci, *x, *a, *b, *c, *y; int i_1, i_2; Rboolean naflag = FALSE; SETUP_DPQ3; i_1 = asInteger(sI); i_2 = asInteger(sJ); mod_iterate3(nx, na, nb, nc, ix, ia, ib, ic) { xi = x[ix]; ai = a[ia]; bi = b[ib]; ci = c[ic]; if_NA_dpq3_set(y[i], xi, ai, bi, ci) else { y[i] = f(xi, ai, bi, ci, i_1, i_2); if (ISNAN(y[i])) naflag = TRUE; } } FINISH_DPQ3; return sy; } #define DPQ3_1(A, FUN) dpq3_1(CAR(A), CADR(A), CADDR(A), CADDDR(A), CAD4R(A), FUN); #define DPQ3_2(A, FUN) dpq3_2(CAR(A), CADR(A), CADDR(A), CADDDR(A), CAD4R(A), CAD5R(A), FUN) SEXP actuar_do_dpq3(int code, SEXP args) { switch (code) { case 1: return DPQ3_1(args, dburr); case 2: return DPQ3_2(args, pburr); case 3: return DPQ3_2(args, qburr); case 4: return DPQ3_1(args, mburr); case 5: return DPQ3_1(args, dgenpareto); case 6: return DPQ3_2(args, pgenpareto); case 7: return DPQ3_2(args, qgenpareto); case 8: return DPQ3_1(args, mgenpareto); case 9: return DPQ3_1(args, dinvburr); case 10: return DPQ3_2(args, pinvburr); case 11: return DPQ3_2(args, qinvburr); case 12: return DPQ3_1(args, minvburr); case 13: return DPQ3_1(args, dinvtrgamma); case 14: return DPQ3_2(args, pinvtrgamma); case 15: return DPQ3_2(args, qinvtrgamma); case 16: return DPQ3_1(args, minvtrgamma); case 17: return DPQ3_1(args, dtrgamma); case 18: return DPQ3_2(args, ptrgamma); case 19: return DPQ3_2(args, qtrgamma); case 20: return DPQ3_1(args, mtrgamma); case 21: return DPQ3_1(args, levgamma); case 22: return DPQ3_1(args, levinvgamma); case 23: return DPQ3_1(args, levinvparalogis); case 24: return DPQ3_1(args, levinvpareto); case 25: return DPQ3_1(args, levinvweibull); case 26: return DPQ3_1(args, levlgamma); case 27: return DPQ3_1(args, levllogis); case 28: return DPQ3_1(args, levlnorm); case 29: return DPQ3_1(args, levparalogis); case 30: return DPQ3_1(args, levpareto); case 31: return DPQ3_1(args, levpareto1); case 32: return DPQ3_1(args, levweibull); case 33: return DPQ3_1(args, levbeta); case 34: return DPQ3_1(args, levchisq); /* case 35: return DPQ3_1(args, levinvGauss); [defunct v3.0-0] */ case 36: return DPQ3_1(args, levunif); case 37: return DPQ3_1(args, levinvgauss); case 38: return DPQ3_1(args, dpareto2); case 39: return DPQ3_2(args, ppareto2); case 40: return DPQ3_2(args, qpareto2); case 41: return DPQ3_1(args, mpareto2); case 42: return DPQ3_1(args, dpareto3); case 43: return DPQ3_2(args, ppareto3); case 44: return DPQ3_2(args, qpareto3); case 45: return DPQ3_1(args, mpareto3); case 101: return DPQ3_1(args, dzmnbinom); case 102: return DPQ3_2(args, pzmnbinom); case 103: return DPQ3_2(args, qzmnbinom); case 104: return DPQ3_1(args, dzmbinom); case 105: return DPQ3_2(args, pzmbinom); case 106: return DPQ3_2(args, qzmbinom); default: error(_("internal error in actuar_do_dpq3")); } return args; /* never used; to keep -Wall happy */ } /* Functions for four parameter distributions */ #define if_NA_dpq4_set(y, x, a, b, c, d) \ if (ISNA (x) || ISNA (a) || ISNA (b) || ISNA (c) || ISNA (d)) \ y = NA_REAL; \ else if (ISNAN(x) || ISNAN(a) || ISNAN(b) || ISNAN(c) || ISNAN(d)) \ y = R_NaN; #define mod_iterate4(n1, n2, n3, n4, n5, i1, i2, i3, i4, i5) \ for (i = i1 = i2 = i3 = i4 = i5 = 0; i < n; \ i1 = (++i1 == n1) ? 0 : i1, \ i2 = (++i2 == n2) ? 0 : i2, \ i3 = (++i3 == n3) ? 0 : i3, \ i4 = (++i4 == n4) ? 0 : i4, \ i5 = (++i5 == n5) ? 0 : i5, \ ++i) static SEXP dpq4_1(SEXP sx, SEXP sa, SEXP sb, SEXP sc, SEXP sd, SEXP sI, double (*f)(double, double, double, double, double, int)) { SEXP sy; int i, ix, ia, ib, ic, id, n, nx, na, nb, nc, nd, sxo = OBJECT(sx), sao = OBJECT(sa), sbo = OBJECT(sb), sco = OBJECT(sc), sdo = OBJECT(sd); double xi, ai, bi, ci, di, *x, *a, *b, *c, *d, *y; int i_1; Rboolean naflag = FALSE; #define SETUP_DPQ4 \ if (!isNumeric(sx) || !isNumeric(sa) || !isNumeric(sb) || \ !isNumeric(sc) || !isNumeric(sd)) \ error(_("invalid arguments")); \ \ nx = LENGTH(sx); \ na = LENGTH(sa); \ nb = LENGTH(sb); \ nc = LENGTH(sc); \ nd = LENGTH(sd); \ if ((nx == 0) || (na == 0) || (nb == 0) || \ (nc == 0) || (nd == 0)) \ return(allocVector(REALSXP, 0)); \ n = nx; \ if (n < na) n = na; \ if (n < nb) n = nb; \ if (n < nc) n = nc; \ if (n < nd) n = nd; \ PROTECT(sx = coerceVector(sx, REALSXP)); \ PROTECT(sa = coerceVector(sa, REALSXP)); \ PROTECT(sb = coerceVector(sb, REALSXP)); \ PROTECT(sc = coerceVector(sc, REALSXP)); \ PROTECT(sd = coerceVector(sd, REALSXP)); \ PROTECT(sy = allocVector(REALSXP, n)); \ x = REAL(sx); \ a = REAL(sa); \ b = REAL(sb); \ c = REAL(sc); \ d = REAL(sd); \ y = REAL(sy) SETUP_DPQ4; i_1 = asInteger(sI); mod_iterate4(nx, na, nb, nc, nd, ix, ia, ib, ic, id) { xi = x[ix]; ai = a[ia]; bi = b[ib]; ci = c[ic]; di = d[id]; if_NA_dpq4_set(y[i], xi, ai, bi, ci, di) else { y[i] = f(xi, ai, bi, ci, di, i_1); if (ISNAN(y[i])) naflag = TRUE; } } #define FINISH_DPQ4 \ if (naflag) \ warning(R_MSG_NA); \ \ if (n == nx) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sx))); \ SET_OBJECT(sy, sxo); \ } \ else if (n == na) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sa))); \ SET_OBJECT(sy, sao); \ } \ else if (n == nb) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sb))); \ SET_OBJECT(sy, sbo); \ } \ else if (n == nc) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sc))); \ SET_OBJECT(sy, sco); \ } \ else if (n == nd) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sd))); \ SET_OBJECT(sy, sdo); \ } \ UNPROTECT(6) FINISH_DPQ4; return sy; } static SEXP dpq4_2(SEXP sx, SEXP sa, SEXP sb, SEXP sc, SEXP sd, SEXP sI, SEXP sJ, double (*f)(double, double, double, double, double, int, int)) { SEXP sy; int i, ix, ia, ib, ic, id, n, nx, na, nb, nc, nd, sxo = OBJECT(sx), sao = OBJECT(sa), sbo = OBJECT(sb), sco = OBJECT(sc), sdo = OBJECT(sd); double xi, ai, bi, ci, di, *x, *a, *b, *c, *d, *y; int i_1, i_2; Rboolean naflag = FALSE; SETUP_DPQ4; i_1 = asInteger(sI); i_2 = asInteger(sJ); mod_iterate4(nx, na, nb, nc, nd, ix, ia, ib, ic, id) { xi = x[ix]; ai = a[ia]; bi = b[ib]; ci = c[ic]; di = d[id]; if_NA_dpq4_set(y[i], xi, ai, bi, ci, di) else { y[i] = f(xi, ai, bi, ci, di, i_1, i_2); if (ISNAN(y[i])) naflag = TRUE; } } FINISH_DPQ4; return sy; } #define DPQ4_1(A, FUN) dpq4_1(CAR(A), CADR(A), CADDR(A), CADDDR(A), CAD4R(A), CAD5R(A), FUN); #define DPQ4_2(A, FUN) dpq4_2(CAR(A), CADR(A), CADDR(A), CADDDR(A), CAD4R(A), CAD5R(A), CAD6R(A), FUN) SEXP actuar_do_dpq4(int code, SEXP args) { switch (code) { case 1: return DPQ4_1(args, dtrbeta); case 2: return DPQ4_2(args, ptrbeta); case 3: return DPQ4_2(args, qtrbeta); case 4: return DPQ4_1(args, mtrbeta); case 5: return DPQ4_1(args, levburr); case 6: return DPQ4_1(args, levgenpareto); case 7: return DPQ4_1(args, levinvburr); case 8: return DPQ4_1(args, levinvtrgamma); case 9: return DPQ4_1(args, levtrgamma); case 10: return DPQ4_1(args, dgenbeta); case 11: return DPQ4_2(args, pgenbeta); case 12: return DPQ4_2(args, qgenbeta); case 13: return DPQ4_1(args, mgenbeta); case 14: return DPQ4_1(args, levpareto2); case 15: return DPQ4_1(args, levpareto3); case 16: return DPQ4_1(args, dpareto4); case 17: return DPQ4_2(args, ppareto4); case 18: return DPQ4_2(args, qpareto4); case 19: return DPQ4_1(args, mpareto4); default: error(_("internal error in actuar_do_dpq4")); } return args; /* never used; to keep -Wall happy */ } /* Functions for five parameter distributions */ #define if_NA_dpq5_set(y, x, a, b, c, d, e) \ if (ISNA (x) || ISNA (a) || ISNA (b) || ISNA (c) || ISNA (d) || ISNA (e)) \ y = NA_REAL; \ else if (ISNAN(x) || ISNAN(a) || ISNAN(b) || ISNAN(c) || ISNAN(d) || ISNAN (e)) \ y = R_NaN; #define mod_iterate5(n1, n2, n3, n4, n5, n6, i1, i2, i3, i4, i5, i6) \ for (i = i1 = i2 = i3 = i4 = i5 = i6 = 0; i < n; \ i1 = (++i1 == n1) ? 0 : i1, \ i2 = (++i2 == n2) ? 0 : i2, \ i3 = (++i3 == n3) ? 0 : i3, \ i4 = (++i4 == n4) ? 0 : i4, \ i5 = (++i5 == n5) ? 0 : i5, \ i6 = (++i6 == n6) ? 0 : i6, \ ++i) static SEXP dpq5_1(SEXP sx, SEXP sa, SEXP sb, SEXP sc, SEXP sd, SEXP se, SEXP sI, double (*f)(double, double, double, double, double, double, int)) { SEXP sy; int i, ix, ia, ib, ic, id, ie, n, nx, na, nb, nc, nd, ne, sxo = OBJECT(sx), sao = OBJECT(sa), sbo = OBJECT(sb), sco = OBJECT(sc), sdo = OBJECT(sd), seo = OBJECT(se); double xi, ai, bi, ci, di, ei, *x, *a, *b, *c, *d, *e, *y; int i_1; Rboolean naflag = FALSE; #define SETUP_DPQ5 \ if (!isNumeric(sx) || !isNumeric(sa) || !isNumeric(sb) || \ !isNumeric(sc) || !isNumeric(sd) || !isNumeric(se)) \ error(_("invalid arguments")); \ \ nx = LENGTH(sx); \ na = LENGTH(sa); \ nb = LENGTH(sb); \ nc = LENGTH(sc); \ nd = LENGTH(sd); \ ne = LENGTH(se); \ if ((nx == 0) || (na == 0) || (nb == 0) || \ (nc == 0) || (nd == 0) || (ne == 0)) \ return(allocVector(REALSXP, 0)); \ n = nx; \ if (n < na) n = na; \ if (n < nb) n = nb; \ if (n < nc) n = nc; \ if (n < nd) n = nd; \ if (n < ne) n = ne; \ PROTECT(sx = coerceVector(sx, REALSXP)); \ PROTECT(sa = coerceVector(sa, REALSXP)); \ PROTECT(sb = coerceVector(sb, REALSXP)); \ PROTECT(sc = coerceVector(sc, REALSXP)); \ PROTECT(sd = coerceVector(sd, REALSXP)); \ PROTECT(se = coerceVector(se, REALSXP)); \ PROTECT(sy = allocVector(REALSXP, n)); \ x = REAL(sx); \ a = REAL(sa); \ b = REAL(sb); \ c = REAL(sc); \ d = REAL(sd); \ e = REAL(se); \ y = REAL(sy) SETUP_DPQ5; i_1 = asInteger(sI); mod_iterate5(nx, na, nb, nc, nd, ne, ix, ia, ib, ic, id, ie) { xi = x[ix]; ai = a[ia]; bi = b[ib]; ci = c[ic]; di = d[id]; ei = e[ie]; if_NA_dpq5_set(y[i], xi, ai, bi, ci, di, ei) else { y[i] = f(xi, ai, bi, ci, di, ei, i_1); if (ISNAN(y[i])) naflag = TRUE; } } #define FINISH_DPQ5 \ if (naflag) \ warning(R_MSG_NA); \ \ if (n == nx) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sx))); \ SET_OBJECT(sy, sxo); \ } \ else if (n == na) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sa))); \ SET_OBJECT(sy, sao); \ } \ else if (n == nb) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sb))); \ SET_OBJECT(sy, sbo); \ } \ else if (n == nc) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sc))); \ SET_OBJECT(sy, sco); \ } \ else if (n == nd) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sd))); \ SET_OBJECT(sy, sdo); \ } \ else if (n == ne) { \ SET_ATTRIB(sy, duplicate(ATTRIB(se))); \ SET_OBJECT(sy, seo); \ } \ UNPROTECT(7) FINISH_DPQ5; return sy; } static SEXP dpq5_2(SEXP sx, SEXP sa, SEXP sb, SEXP sc, SEXP sd, SEXP se, SEXP sI, SEXP sJ, double (*f)(double, double, double, double, double, double, int, int)) { SEXP sy; int i, ix, ia, ib, ic, id, ie, n, nx, na, nb, nc, nd, ne, sxo = OBJECT(sx), sao = OBJECT(sa), sbo = OBJECT(sb), sco = OBJECT(sc), sdo = OBJECT(sd), seo = OBJECT(sd); double xi, ai, bi, ci, di, ei, *x, *a, *b, *c, *d, *e, *y; int i_1, i_2; Rboolean naflag = FALSE; SETUP_DPQ5; i_1 = asInteger(sI); i_2 = asInteger(sJ); mod_iterate5(nx, na, nb, nc, nd, ne, ix, ia, ib, ic, id, ie) { xi = x[ix]; ai = a[ia]; bi = b[ib]; ci = c[ic]; di = d[id]; ei = e[ie]; if_NA_dpq5_set(y[i], xi, ai, bi, ci, di, ei) else { y[i] = f(xi, ai, bi, ci, di, ei, i_1, i_2); if (ISNAN(y[i])) naflag = TRUE; } } FINISH_DPQ5; return sy; } #define DPQ5_1(A, FUN) dpq5_1(CAR(A), CADR(A), CADDR(A), CADDDR(A), CAD4R(A), CAD5R(A), CAD6R(A), FUN); #define DPQ5_2(A, FUN) dpq5_2(CAR(A), CADR(A), CADDR(A), CADDDR(A), CAD4R(A), CAD5R(A), CAD6R(A), CAD7R(A), FUN) SEXP actuar_do_dpq5(int code, SEXP args) { switch (code) { case 1: return DPQ5_1(args, levtrbeta); case 2: return DPQ5_1(args, levgenbeta); case 3: return DPQ5_1(args, dfpareto); case 4: return DPQ5_2(args, pfpareto); case 5: return DPQ5_2(args, qfpareto); case 6: return DPQ5_1(args, mfpareto); case 7: return DPQ5_1(args, levpareto4); default: error(_("internal error in actuar_do_dpq5")); } return args; /* never used; to keep -Wall happy */ } /* Functions for six parameter distributions */ #define if_NA_dpq6_set(y, x, a, b, c, d, e, g) \ if (ISNA (x) || ISNA (a) || ISNA (b) || ISNA (c) || ISNA (d) || ISNA (e) || ISNA (g)) \ y = NA_REAL; \ else if (ISNAN(x) || ISNAN(a) || ISNAN(b) || ISNAN(c) || ISNAN(d) || ISNAN(e) || ISNAN(g)) \ y = R_NaN; #define mod_iterate6(n1, n2, n3, n4, n5, n6, n7, i1, i2, i3, i4, i5, i6, i7) \ for (i = i1 = i2 = i3 = i4 = i5 = i6 = i7 = 0; i < n; \ i1 = (++i1 == n1) ? 0 : i1, \ i2 = (++i2 == n2) ? 0 : i2, \ i3 = (++i3 == n3) ? 0 : i3, \ i4 = (++i4 == n4) ? 0 : i4, \ i5 = (++i5 == n5) ? 0 : i5, \ i6 = (++i6 == n6) ? 0 : i6, \ i7 = (++i7 == n7) ? 0 : i7, \ ++i) static SEXP dpq6_1(SEXP sx, SEXP sa, SEXP sb, SEXP sc, SEXP sd, SEXP se, SEXP sg, SEXP sI, double (*f)(double, double, double, double, double, double, double, int)) { SEXP sy; /* skip argument "sf" because "if" is a C keyword. */ int i, ix, ia, ib, ic, id, ie, ig, n, nx, na, nb, nc, nd, ne, ng, sxo = OBJECT(sx), sao = OBJECT(sa), sbo = OBJECT(sb), sco = OBJECT(sc), sdo = OBJECT(sd), seo = OBJECT(se), sgo = OBJECT(sg); double xi, ai, bi, ci, di, ei, gi, *x, *a, *b, *c, *d, *e, *g, *y; int i_1; Rboolean naflag = FALSE; #define SETUP_DPQ6 \ if (!isNumeric(sx) || !isNumeric(sa) || !isNumeric(sb) || \ !isNumeric(sc) || !isNumeric(sd) || !isNumeric(se) || \ !isNumeric(sg)) \ error(_("invalid arguments")); \ \ nx = LENGTH(sx); \ na = LENGTH(sa); \ nb = LENGTH(sb); \ nc = LENGTH(sc); \ nd = LENGTH(sd); \ ne = LENGTH(se); \ ng = LENGTH(sg); \ if ((nx == 0) || (na == 0) || (nb == 0) || \ (nc == 0) || (nd == 0) || (ne == 0) || \ (ng == 0)) \ return(allocVector(REALSXP, 0)); \ n = nx; \ if (n < na) n = na; \ if (n < nb) n = nb; \ if (n < nc) n = nc; \ if (n < nd) n = nd; \ if (n < ne) n = ne; \ if (n < ng) n = ng; \ PROTECT(sx = coerceVector(sx, REALSXP)); \ PROTECT(sa = coerceVector(sa, REALSXP)); \ PROTECT(sb = coerceVector(sb, REALSXP)); \ PROTECT(sc = coerceVector(sc, REALSXP)); \ PROTECT(sd = coerceVector(sd, REALSXP)); \ PROTECT(se = coerceVector(se, REALSXP)); \ PROTECT(sg = coerceVector(sg, REALSXP)); \ PROTECT(sy = allocVector(REALSXP, n)); \ x = REAL(sx); \ a = REAL(sa); \ b = REAL(sb); \ c = REAL(sc); \ d = REAL(sd); \ e = REAL(se); \ g = REAL(sg); \ y = REAL(sy) SETUP_DPQ6; i_1 = asInteger(sI); mod_iterate6(nx, na, nb, nc, nd, ne, ng, ix, ia, ib, ic, id, ie, ig) { xi = x[ix]; ai = a[ia]; bi = b[ib]; ci = c[ic]; di = d[id]; ei = e[ie]; gi = g[ig]; if_NA_dpq6_set(y[i], xi, ai, bi, ci, di, ei, gi) else { y[i] = f(xi, ai, bi, ci, di, ei, gi, i_1); if (ISNAN(y[i])) naflag = TRUE; } } #define FINISH_DPQ6 \ if (naflag) \ warning(R_MSG_NA); \ \ if (n == nx) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sx))); \ SET_OBJECT(sy, sxo); \ } \ else if (n == na) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sa))); \ SET_OBJECT(sy, sao); \ } \ else if (n == nb) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sb))); \ SET_OBJECT(sy, sbo); \ } \ else if (n == nc) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sc))); \ SET_OBJECT(sy, sco); \ } \ else if (n == nd) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sd))); \ SET_OBJECT(sy, sdo); \ } \ else if (n == ne) { \ SET_ATTRIB(sy, duplicate(ATTRIB(se))); \ SET_OBJECT(sy, seo); \ } \ else if (n == ng) { \ SET_ATTRIB(sy, duplicate(ATTRIB(sg))); \ SET_OBJECT(sy, sgo); \ } \ UNPROTECT(8) FINISH_DPQ6; return sy; } #define DPQ6_1(A, FUN) dpq6_1(CAR(A), CADR(A), CADDR(A), CADDDR(A), CAD4R(A), CAD5R(A), CAD6R(A), CAD7R(A), FUN); SEXP actuar_do_dpq6(int code, SEXP args) { switch (code) { case 1: return DPQ6_1(args, levfpareto); default: error(_("internal error in actuar_do_dpq6")); } return args; /* never used; to keep -Wall happy */ } /* Main function, the only one used by .External(). */ SEXP actuar_do_dpq(SEXP args) { int i; const char *name; /* Extract distribution name */ args = CDR(args); name = CHAR(STRING_ELT(CAR(args), 0)); /* Dispatch to actuar_do_dpq{1,2,3,4,5,6} */ for (i = 0; dpq_tab[i].name; i++) { if (!strcmp(dpq_tab[i].name, name)) { return dpq_tab[i].cfun(dpq_tab[i].code, CDR(args)); } } /* No dispatch is an error */ error("internal error in actuar_do_dpq"); return args; /* never used; to keep -Wall happy */ } actuar/src/ztpois.c0000644000176200001440000000520514264305077014026 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute probability function, cumulative distribution * and quantile functions, and to simulate random variates for the * zero-truncated Poisson distribution. See * ../R/ZeroTruncatedPoisson.R for details. * * Zero-truncated distributions have density * * Pr[Z = x] = Pr[X = x]/(1 - Pr[X = 0]), * * and distribution function * * Pr[Z <= x] = (Pr[X <= x] - Pr[X = 0])/(1 - Pr[X = 0]) * * or, alternatively, survival function * * Pr[Z > x] = Pr[X > x]/(1 - Pr[X = 0]). * * AUTHOR: Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" /* The Poisson distribution has * * F(0) = Pr[X = 0] = exp(-lambda). * * Limiting case: lambda == 0 is point mass at x = 1. */ double dztpois(double x, double lambda, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(lambda)) return x + lambda; #endif if (lambda < 0) return R_NaN; if (x < 1 || !R_FINITE(x)) return ACT_D__0; /* limiting case as lambda approaches zero is point mass at one */ if (lambda == 0) return (x == 1) ? ACT_D__1 : ACT_D__0; return ACT_D_exp(dpois(x, lambda, /*give_log*/1) - ACT_Log1_Exp(-lambda)); } double pztpois(double x, double lambda, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(lambda)) return x + lambda; #endif if (lambda < 0) return R_NaN; if (x < 1) return ACT_DT_0; if (!R_FINITE(x)) return ACT_DT_1; /* limiting case as lambda approaches zero is point mass at one */ if (lambda == 0) return (x >= 1) ? ACT_DT_1 : ACT_DT_0; return ACT_DT_Cval(ppois(x, lambda, /*l._t.*/0, /*log_p*/0)/(-expm1(-lambda))); } double qztpois(double x, double lambda, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(lambda)) return x + lambda; #endif if (lambda < 0 || !R_FINITE(lambda)) return R_NaN; /* limiting case as lambda approaches zero is point mass at one */ if (lambda == 0) { /* simplified ACT_Q_P01_boundaries macro */ if (log_p) { if (x > 0) return R_NaN; return 1.0; } else /* !log_p */ { if (x < 0 || x > 1) return R_NaN; return 1.0; } } ACT_Q_P01_boundaries(x, 1, R_PosInf); x = ACT_DT_qIv(x); double p0c = -expm1(-lambda); return qpois(p0c * x + (1 - p0c), lambda, /*l._t.*/1, /*log_p*/0); } double rztpois(double lambda) { if (lambda < 0 || !R_FINITE(lambda)) return R_NaN; /* limiting case as lambda approaches zero is point mass at one */ if (lambda == 0) return 1.0; return qpois(runif(exp(-lambda), 1), lambda, 1, 0); } actuar/src/genpareto.c0000644000176200001440000001147314264305077014466 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the Generalized Pareto distribution.. See ../R/GeneralizedPareto.R * for details. * * We work with the density expressed as * * u^shape2 * (1 - u)^shape1 / (x * beta(shape1, shape2)) * * with u = v/(1 + v) = 1/(1 + 1/v), v = x/scale. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dgenpareto(double x, double shape1, double shape2, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return x + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (!R_FINITE(x) || x < 0.0) return ACT_D__0; /* handle x == 0 separately */ if (x == 0.0) { if (shape2 < 1) return R_PosInf; if (shape2 > 1) return ACT_D__0; /* else */ return give_log ? - log(scale) - lbeta(shape2, shape1) : 1.0/(scale * beta(shape2, shape1)); } double logv, logu, log1mu; logv = log(x) - log(scale); logu = - log1pexp(-logv); log1mu = - log1pexp(logv); return ACT_D_exp(shape2 * logu + shape1 * log1mu - log(x) - lbeta(shape2, shape1)); } double pgenpareto(double q, double shape1, double shape2, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return q + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (q <= 0) return ACT_DT_0; double logvm, u; logvm = log(scale) - log(q); /* -log v */ u = exp(-log1pexp(logvm)); if (u > 0.5) { /* Compute (1 - u) accurately */ double u1m = exp(-log1pexp(-logvm)); return pbeta(u1m, shape1, shape2, 1 - lower_tail, log_p); } /* else u <= 0.5 */ return pbeta(u, shape2, shape1, lower_tail, log_p); } double qgenpareto(double p, double shape1, double shape2, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return p + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; ACT_Q_P01_boundaries(p, 0, R_PosInf); p = ACT_D_qIv(p); return scale / (1.0 / qbeta(p, shape2, shape1, lower_tail, 0) - 1.0); } double rgenpareto(double shape1, double shape2, double scale) { if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; return scale / (1.0 / rbeta(shape2, shape1) - 1.0); } double mgenpareto(double order, double shape1, double shape2, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return order + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -shape2 || order >= shape1) return R_PosInf; return R_pow(scale, order) * beta(shape1 - order, shape2 + order) / beta(shape1, shape2); } double levgenpareto(double limit, double shape1, double shape2, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale) || ISNAN(order)) return limit + shape1 + shape2 + scale + order; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -shape2) return R_PosInf; if (limit <= 0.0) return 0.0; double logv, u, u1m, Ix; logv = log(limit) - log(scale); u = exp(-log1pexp(-logv)); u1m = exp(-log1pexp(logv)); Ix = (u > 0.5) ? pbeta(u1m, shape1, shape2, /*l._t.*/1, /*give_log*/0) : pbeta(u, shape2, shape1, /*l._t.*/0, /*give_log*/0); return R_pow(scale, order) * betaint_raw(u, shape2 + order, shape1 - order, u1m) / (gammafn(shape1) * gammafn(shape2)) + ACT_DLIM__0(limit, order) * Ix; } actuar/src/lnorm.c0000644000176200001440000000256314264305077013631 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Fonctions to calculate raw and limited moments for the lognormal * distribution. See ../R/LognormalMoments.R for details. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" double mlnorm(double order, double logmean, double logsd, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(logmean) || ISNAN(logsd)) return order + logmean + logsd; #endif if (!R_FINITE(logmean) || !R_FINITE(logsd) || !R_FINITE(order) || logsd <= 0.0) return R_NaN; return exp(order * (logmean + 0.5 * order * R_pow_di(logsd, 2))); } double levlnorm(double limit, double logmean, double logsd, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(logmean) || ISNAN(logsd) || ISNAN(order)) return limit + logmean + logsd + order; #endif if (!R_FINITE(logmean) || !R_FINITE(logsd) || !R_FINITE(order) || logsd <= 0.0) return R_NaN; if (limit <= 0.0) return 0.0; double u = (log(limit) - logmean)/logsd; return exp(order * (logmean + 0.5 * order * R_pow(logsd, 2.0))) * pnorm(u - order * logsd, 0., 1.0, 1, 0) + ACT_DLIM__0(limit, order) * pnorm(u, 0., 1.0, 0, 0); } actuar/src/betaint.c0000644000176200001440000001246714264305077014134 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Function to compute the integral * * B(a, b; x) = gammafn(a + b) int_0^x t^(a-1) (1-t)^(b-1) dt * * for a > 0, b != -1, -2, ... and 0 < x < 1. When b > 0, * * B(a, b; x) = gammafn(a) gammafn(b) pbeta(x, a, b). * * When b < 0 and b != -1, -2, ... and a > 1 + floor(-b), * * B(a, b; x) * = -gammafn(a + b) {(x^(a-1) (1-x)^b)/b * + [(a-1) x^(a-2) (1-x)^(b+1)]/[b(b+1)] * + ... * + [(a-1)...(a-r) x^(a-r-1) (1-x)^(b+r)]/[b(b+1)...(b+r)]} * + [(a-1)...(a-r-1)]/[b(b+1)...(b+r)] gammafn(a-r-1) * * gammafn(b+r+1) pbeta(x, a-r-1, b+r+1) * * See Appendix A of Klugman, Panjer & Willmot, Loss Models, * Fourth Edition, Wiley, 2012 for the formula. * * AUTHOR: Vincent Goulet */ #include #include #include #include "actuar.h" #include "dpq.h" #include "locale.h" double betaint_raw(double x, double a, double b, double x1m) { /* Here, assume that (x, a, b) are not NA, 0 < x < 1 and 0 < a < Inf. */ if (b > 0) { /* I(x, a, b) = 1 - I(1 - x, b, a) */ double Ix = (x > 0.5) ? pbeta(x1m, b, a, /*l._t.*/0, /*give_log*/0) : pbeta(x, a, b, /*l._t.*/1, /*give_log*/0); return gammafn(a) * gammafn(b) * Ix; } double r = floor(-b); if (! (ACT_nonint(b) && a - r - 1 > 0)) return R_NaN; /* There are two quantities to accumulate in order to compute the * final result: the alternating sum (to be stored in 'sum') and * the ratio [(a - 1) ... (a - r)]/[b(b + 1) ... (b + r)] (to be * stored in 'ratio'). Some calculations are done in the log * scale. */ int i; double ap = a, bp = b; /* copies of a and b */ double lx = log(x); /* log(x) */ double lx1m = log(x1m); /* log(1 - x) */ double x1 = exp(lx1m - lx); /* (1 - x)/x */ double c, tmp, sum, ratio; /* Computation of the first term in the alternating sum. */ ap--; /* a - 1 */ c = exp(ap * lx + bp * lx1m)/bp; /* (x^(a - 1) (1 - x)^b) / b */ sum = c; /* first term */ ratio = 1/bp; /* 1 / b */ bp++; /* b + 1 */ /* Other terms in the alternating sum iff r > 0. * Relies on the fact that each new term in the sum is * * [previous term] * (a - i - 1)(1 - x)/[(b + i + 1) x] * * for i = 0, ..., r - 1. We need to compute this value as * * {[previous term] * [(1 - x)/x]} * [(a - i - 1)/(b + i + 1)] * * to preserve accuracy for very small values of x (near * DBL_MIN). */ for (i = 0; i < r; i++) { tmp = ap/bp; /* (a - i - 1)/(b + i + 1) */ c = tmp * (c * x1); /* new term in the sum */ sum += c; ratio *= tmp; ap--; bp++; } /* I(x, a, b) = 1 - I(1 - x, b, a) */ double lIx = (x > 0.5) ? pbeta(x1m, bp, ap, /*l._t.*/0, /*give_log*/1) : pbeta(x, ap, bp, /*l._t.*/1, /*give_log*/1); return(-gammafn(a + b) * sum + (ratio * ap) * exp(lgammafn(ap) + lgammafn(bp) + lIx)); } /* The frontend called by actuar_do_betaint() */ double betaint(double x, double a, double b) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(a) || ISNAN(b)) return x + a + b; #endif if (!R_FINITE(a)) return(R_PosInf); if (a <= 0 || x <= 0 || x >= 1) return R_NaN; return betaint_raw(x, a, b, 0.5 - x + 0.5); } /* * R TO C INTERFACE * * This is a streamlined version of the scheme in dpq.c * */ #define mod_iterate2(n1, n2, n3, i1, i2, i3) \ for (i = i1 = i2 = i3 = 0; i < n; \ i1 = (++i1 == n1) ? 0 : i1, \ i2 = (++i2 == n2) ? 0 : i2, \ i3 = (++i3 == n3) ? 0 : i3, \ ++i) /* Function called by .External() */ SEXP actuar_do_betaint(SEXP args) { SEXP sx, sa, sb, sy; int i, ix, ia, ib, n, nx, na, nb; double xi, ai, bi, *x, *a, *b, *y; Rboolean naflag = FALSE; args = CDR(args); /* drop function name from arguments */ if (!isNumeric(CAR(args))|| !isNumeric(CADR(args)) || !isNumeric(CADDR(args))) error(_("invalid arguments")); nx = LENGTH(CAR(args)); na = LENGTH(CADR(args)); nb = LENGTH(CADDR(args)); if ((nx == 0) || (na == 0) || (nb == 0)) return(allocVector(REALSXP, 0)); n = nx; if (n < na) n = na; if (n < nb) n = nb; PROTECT(sx = coerceVector(CAR(args), REALSXP)); PROTECT(sa = coerceVector(CADR(args), REALSXP)); PROTECT(sb = coerceVector(CADDR(args), REALSXP)); PROTECT(sy = allocVector(REALSXP, n)); x = REAL(sx); a = REAL(sa); b = REAL(sb); y = REAL(sy); mod_iterate2(nx, na, nb, ix, ia, ib) { xi = x[ix]; ai = a[ia]; bi = b[ib]; if (ISNA(xi) || ISNA(ai) || ISNA(bi)) y[i] = NA_REAL; else if (ISNAN(xi) || ISNAN(ai) || ISNAN(bi)) y[i] = R_NaN; else { y[i] = betaint(xi, ai, bi); if (ISNAN(y[i])) naflag = TRUE; } } if (naflag) warning(R_MSG_NA); if (n == nx) { SET_ATTRIB(sy, duplicate(ATTRIB(sx))); SET_OBJECT(sy, OBJECT(sx)); } else if (n == na) { SET_ATTRIB(sy, duplicate(ATTRIB(sa))); SET_OBJECT(sy, OBJECT(sa)); } else if (n == nb) { SET_ATTRIB(sy, duplicate(ATTRIB(sb))); SET_OBJECT(sy, OBJECT(sb)); } UNPROTECT(4); return sy; } actuar/src/names.c0000644000176200001440000003043114264305077013600 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Table of functions internal to the package. First element is an * argument to one of actuar_do_dpq or actuar_do_random, functions * callable from .External(); second element is the C function * actually called; third element is a code used in the latter. * * Idea taken from R sources (see src/main/names.c). * * AUTHOR: Vincent Goulet */ #include #include "actuar.h" /* DENSITY, CUMULATIVE PROBABILITY AND QUANTILE FUNCTIONS, * RAW AND LIMITED MOMENTS */ dpq_tab_struct dpq_tab[] = { /* One parameter distributions */ {"mexp", actuar_do_dpq1, 1}, {"dinvexp", actuar_do_dpq1, 2}, {"pinvexp", actuar_do_dpq1, 3}, {"qinvexp", actuar_do_dpq1, 4}, {"minvexp", actuar_do_dpq1, 5}, {"mgfexp", actuar_do_dpq1, 6}, {"dlogarithmic", actuar_do_dpq1, 101}, {"plogarithmic", actuar_do_dpq1, 102}, {"qlogarithmic", actuar_do_dpq1, 103}, {"dztpois", actuar_do_dpq1, 104}, {"pztpois", actuar_do_dpq1, 105}, {"qztpois", actuar_do_dpq1, 106}, {"dztgeom", actuar_do_dpq1, 107}, {"pztgeom", actuar_do_dpq1, 108}, {"qztgeom", actuar_do_dpq1, 109}, /* Two parameter distributions */ {"mgamma", actuar_do_dpq2, 1}, {"dinvgamma", actuar_do_dpq2, 2}, {"pinvgamma", actuar_do_dpq2, 3}, {"qinvgamma", actuar_do_dpq2, 4}, {"minvgamma", actuar_do_dpq2, 5}, {"dinvparalogis", actuar_do_dpq2, 6}, {"pinvparalogis", actuar_do_dpq2, 7}, {"qinvparalogis", actuar_do_dpq2, 8}, {"minvparalogis", actuar_do_dpq2, 9}, {"dinvpareto", actuar_do_dpq2, 10}, {"pinvpareto", actuar_do_dpq2, 11}, {"qinvpareto", actuar_do_dpq2, 12}, {"minvpareto", actuar_do_dpq2, 13}, {"dinvweibull", actuar_do_dpq2, 14}, {"pinvweibull", actuar_do_dpq2, 15}, {"qinvweibull", actuar_do_dpq2, 16}, {"minvweibull", actuar_do_dpq2, 17}, {"dlgamma", actuar_do_dpq2, 18}, {"plgamma", actuar_do_dpq2, 19}, {"qlgamma", actuar_do_dpq2, 20}, {"mlgamma", actuar_do_dpq2, 21}, {"dllogis", actuar_do_dpq2, 22}, {"pllogis", actuar_do_dpq2, 23}, {"qllogis", actuar_do_dpq2, 24}, {"mllogis", actuar_do_dpq2, 25}, {"mlnorm", actuar_do_dpq2, 26}, {"dparalogis", actuar_do_dpq2, 27}, {"pparalogis", actuar_do_dpq2, 28}, {"qparalogis", actuar_do_dpq2, 29}, {"mparalogis", actuar_do_dpq2, 30}, {"dpareto", actuar_do_dpq2, 31}, {"ppareto", actuar_do_dpq2, 32}, {"qpareto", actuar_do_dpq2, 33}, {"mpareto", actuar_do_dpq2, 34}, {"dpareto1", actuar_do_dpq2, 35}, {"ppareto1", actuar_do_dpq2, 36}, {"qpareto1", actuar_do_dpq2, 37}, {"mpareto1", actuar_do_dpq2, 38}, {"mweibull", actuar_do_dpq2, 39}, {"levexp", actuar_do_dpq2, 40}, {"levinvexp", actuar_do_dpq2, 41}, {"mbeta", actuar_do_dpq2, 42}, {"mgfgamma", actuar_do_dpq2, 43}, {"mgfnorm", actuar_do_dpq2, 44}, {"mgfunif", actuar_do_dpq2, 45}, {"mgfinvgamma", actuar_do_dpq2, 46}, {"mnorm", actuar_do_dpq2, 47}, {"mchisq", actuar_do_dpq2, 48}, {"mgfchisq", actuar_do_dpq2, 49}, /* {"minvGauss", actuar_do_dpq2, 50}, [defunct v3.0-0] */ /* {"mgfinvGauss", actuar_do_dpq2, 51}, [defunct v3.0-0] */ {"munif", actuar_do_dpq2, 52}, {"dgumbel", actuar_do_dpq2, 53}, {"pgumbel", actuar_do_dpq2, 54}, {"qgumbel", actuar_do_dpq2, 55}, {"mgumbel", actuar_do_dpq2, 56}, {"mgfgumbel", actuar_do_dpq2, 57}, {"dinvgauss", actuar_do_dpq2, 58}, {"pinvgauss", actuar_do_dpq2, 59}, {"qinvgauss", actuar_do_dpq2, 60}, {"minvgauss", actuar_do_dpq2, 61}, {"mgfinvgauss", actuar_do_dpq2, 62}, {"dztnbinom", actuar_do_dpq2, 101}, {"pztnbinom", actuar_do_dpq2, 102}, {"qztnbinom", actuar_do_dpq2, 103}, {"dztbinom", actuar_do_dpq2, 104}, {"pztbinom", actuar_do_dpq2, 105}, {"qztbinom", actuar_do_dpq2, 106}, {"dzmlogarithmic", actuar_do_dpq2, 107}, {"pzmlogarithmic", actuar_do_dpq2, 108}, {"qzmlogarithmic", actuar_do_dpq2, 109}, {"dzmpois", actuar_do_dpq2, 110}, {"pzmpois", actuar_do_dpq2, 111}, {"qzmpois", actuar_do_dpq2, 112}, {"dzmgeom", actuar_do_dpq2, 113}, {"pzmgeom", actuar_do_dpq2, 114}, {"qzmgeom", actuar_do_dpq2, 115}, {"dpoisinvgauss", actuar_do_dpq2, 116}, {"ppoisinvgauss", actuar_do_dpq2, 117}, {"qpoisinvgauss", actuar_do_dpq2, 118}, /* Three parameter distributions */ {"dburr", actuar_do_dpq3, 1}, {"pburr", actuar_do_dpq3, 2}, {"qburr", actuar_do_dpq3, 3}, {"mburr", actuar_do_dpq3, 4}, {"dgenpareto", actuar_do_dpq3, 5}, {"pgenpareto", actuar_do_dpq3, 6}, {"qgenpareto", actuar_do_dpq3, 7}, {"mgenpareto", actuar_do_dpq3, 8}, {"dinvburr", actuar_do_dpq3, 9}, {"pinvburr", actuar_do_dpq3, 10}, {"qinvburr", actuar_do_dpq3, 11}, {"minvburr", actuar_do_dpq3, 12}, {"dinvtrgamma", actuar_do_dpq3, 13}, {"pinvtrgamma", actuar_do_dpq3, 14}, {"qinvtrgamma", actuar_do_dpq3, 15}, {"minvtrgamma", actuar_do_dpq3, 16}, {"dtrgamma", actuar_do_dpq3, 17}, {"ptrgamma", actuar_do_dpq3, 18}, {"qtrgamma", actuar_do_dpq3, 19}, {"mtrgamma", actuar_do_dpq3, 20}, {"levgamma", actuar_do_dpq3, 21}, {"levinvgamma", actuar_do_dpq3, 22}, {"levinvparalogis", actuar_do_dpq3, 23}, {"levinvpareto", actuar_do_dpq3, 24}, {"levinvweibull", actuar_do_dpq3, 25}, {"levlgamma", actuar_do_dpq3, 26}, {"levllogis", actuar_do_dpq3, 27}, {"levlnorm", actuar_do_dpq3, 28}, {"levparalogis", actuar_do_dpq3, 29}, {"levpareto", actuar_do_dpq3, 30}, {"levpareto1", actuar_do_dpq3, 31}, {"levweibull", actuar_do_dpq3, 32}, {"levbeta", actuar_do_dpq3, 33}, {"levchisq", actuar_do_dpq3, 34}, /* {"levinvGauss", actuar_do_dpq3, 35}, [defunct v3.0-0] */ {"levunif", actuar_do_dpq3, 36}, {"levinvgauss", actuar_do_dpq3, 37}, {"dpareto2", actuar_do_dpq3, 38}, {"ppareto2", actuar_do_dpq3, 39}, {"qpareto2", actuar_do_dpq3, 40}, {"mpareto2", actuar_do_dpq3, 41}, {"dpareto3", actuar_do_dpq3, 42}, {"ppareto3", actuar_do_dpq3, 43}, {"qpareto3", actuar_do_dpq3, 44}, {"mpareto3", actuar_do_dpq3, 45}, {"dzmnbinom", actuar_do_dpq3, 101}, {"pzmnbinom", actuar_do_dpq3, 102}, {"qzmnbinom", actuar_do_dpq3, 103}, {"dzmbinom", actuar_do_dpq3, 104}, {"pzmbinom", actuar_do_dpq3, 105}, {"qzmbinom", actuar_do_dpq3, 106}, /* Four parameter distributions */ {"dtrbeta", actuar_do_dpq4, 1}, {"ptrbeta", actuar_do_dpq4, 2}, {"qtrbeta", actuar_do_dpq4, 3}, {"mtrbeta", actuar_do_dpq4, 4}, {"levburr", actuar_do_dpq4, 5}, {"levgenpareto", actuar_do_dpq4, 6}, {"levinvburr", actuar_do_dpq4, 7}, {"levinvtrgamma", actuar_do_dpq4, 8}, {"levtrgamma", actuar_do_dpq4, 9}, {"dgenbeta", actuar_do_dpq4, 10}, {"pgenbeta", actuar_do_dpq4, 11}, {"qgenbeta", actuar_do_dpq4, 12}, {"mgenbeta", actuar_do_dpq4, 13}, {"levpareto2", actuar_do_dpq4, 14}, {"levpareto3", actuar_do_dpq4, 15}, {"dpareto4", actuar_do_dpq4, 16}, {"ppareto4", actuar_do_dpq4, 17}, {"qpareto4", actuar_do_dpq4, 18}, {"mpareto4", actuar_do_dpq4, 19}, /* Five parameter distributions */ {"levtrbeta", actuar_do_dpq5, 1}, {"levgenbeta", actuar_do_dpq5, 2}, {"dfpareto", actuar_do_dpq5, 3}, {"pfpareto", actuar_do_dpq5, 4}, {"qfpareto", actuar_do_dpq5, 5}, {"mfpareto", actuar_do_dpq5, 6}, {"levpareto4", actuar_do_dpq5, 7}, /* Six parameter distributions */ {"levfpareto", actuar_do_dpq6, 1}, /* Phase-type distributions */ {"dphtype", actuar_do_dpqphtype2, 1}, {"pphtype", actuar_do_dpqphtype2, 2}, {"mphtype", actuar_do_dpqphtype2, 3}, {"mgfphtype", actuar_do_dpqphtype2, 4}, {0, 0, 0} }; /* RANDOM NUMBERS FUNCTIONS */ random_tab_struct random_tab[] = { /* One parameter distributions */ {"rinvexp", actuar_do_random1, 1, REALSXP}, {"rlogarithmic", actuar_do_random1, 101, INTSXP}, {"rztpois", actuar_do_random1, 102, INTSXP}, {"rztgeom", actuar_do_random1, 103, INTSXP}, /* Two parameter distributions */ {"rinvgamma", actuar_do_random2, 1, REALSXP}, {"rinvparalogis", actuar_do_random2, 2, REALSXP}, {"rinvpareto", actuar_do_random2, 3, REALSXP}, {"rinvweibull", actuar_do_random2, 4, REALSXP}, {"rlgamma", actuar_do_random2, 5, REALSXP}, {"rllogis", actuar_do_random2, 6, REALSXP}, {"rparalogis", actuar_do_random2, 7, REALSXP}, {"rpareto", actuar_do_random2, 8, REALSXP}, {"rpareto1", actuar_do_random2, 9, REALSXP}, {"rgumbel", actuar_do_random2, 10, REALSXP}, {"rinvgauss", actuar_do_random2, 11, REALSXP}, {"rztnbinom", actuar_do_random2, 101, INTSXP}, {"rztbinom", actuar_do_random2, 102, INTSXP}, {"rzmlogarithmic", actuar_do_random2, 103, INTSXP}, {"rzmpois", actuar_do_random2, 104, INTSXP}, {"rzmgeom", actuar_do_random2, 105, INTSXP}, {"rpoisinvgauss", actuar_do_random2, 106, INTSXP}, /* Three parameter distributions */ {"rburr", actuar_do_random3, 1, REALSXP}, {"rgenpareto", actuar_do_random3, 2, REALSXP}, {"rinvburr", actuar_do_random3, 3, REALSXP}, {"rinvtrgamma", actuar_do_random3, 4, REALSXP}, {"rtrgamma", actuar_do_random3, 5, REALSXP}, {"rpareto2", actuar_do_random3, 6, REALSXP}, {"rpareto3", actuar_do_random3, 7, REALSXP}, {"rzmnbinom", actuar_do_random3, 101, INTSXP}, {"rzmbinom", actuar_do_random3, 102, INTSXP}, /* Four parameter distributions */ {"rtrbeta", actuar_do_random4, 1, REALSXP}, {"rgenbeta", actuar_do_random4, 2, REALSXP}, {"rpareto4", actuar_do_random4, 3, REALSXP}, /* Five parameter distributions */ {"rfpareto", actuar_do_random5, 1, REALSXP}, /* Phase-type distributions */ {"rphtype", actuar_do_randomphtype2, 1, REALSXP}, {0, 0, 0} }; actuar/src/logarithmic.c0000644000176200001440000001077414264305077015007 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, and to simulate random variates for the logarithmic * discrete distribution. See ../R/Logarithmic.R for details. * * We work with the probability mass function expressed as * * a * p^x / x, x = 1, 2, ... * * with a = -1/log(1 - p). * * AUTHOR: Vincent Goulet */ #include #include #include /* for R_CheckUserInterrupt() */ #include "locale.h" #include "dpq.h" double dlogarithmic(double x, double prob, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(prob)) return x + prob; #endif if (prob < 0 || prob >= 1) return R_NaN; ACT_D_nonint_check(x); if (!R_FINITE(x) || x < 1) return ACT_D__0; /* limiting case as prob approaches zero is point mass at one */ if (prob == 0) return (x == 1) ? ACT_D__1 : ACT_D__0; x = ACT_forceint(x); double a = -1.0/log1p(-prob); return ACT_D_exp(log(a) + x * log(prob) - log(x)); } /* For plogarithmic(), there does not seem to be algorithms much more * elaborate that successive computations of the probabilities using * the recurrence relationship * * P[X = x + 1] = p * x * Pr[X = x] / (x + 1), x = 2, 3, ... * * with Pr[X = 1] = -p/log(1 - p). This is what is done here. */ double plogarithmic(double q, double prob, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(prob)) return q + prob; #endif if (prob < 0 || prob >= 1) return R_NaN; if (q < 1) return ACT_DT_0; if (!R_FINITE(q)) return ACT_DT_1; /* limiting case as prob approaches zero is point mass at one. */ if (prob == 0) return (q >= 1) ? ACT_DT_1 : ACT_DT_0; int k; double s, pk; pk = -prob/log1p(-prob); /* Pr[X = 1] */ s = pk; if (q == 1) return ACT_DT_val(s); /* simple case */ for (k = 1; k < q; k++) { pk *= prob * k/(k + 1.0); s += pk; } return ACT_DT_val(s); } /* For qlogarithmic() we mostly reuse the code from qnbinom() et al. * of R sources. From src/nmath/qnbinom.c: * * METHOD * * Uses the Cornish-Fisher Expansion to include a skewness * correction to a normal approximation. This gives an * initial value which never seems to be off by more than * 1 or 2. A search is then conducted of values close to * this initial start point. */ #define _thisDIST_ logarithmic #define _dist_PARS_DECL_ double prob #define _dist_PARS_ prob #include "qDiscrete_search.h" /* do_search() et al. */ double qlogarithmic(double p, double prob, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(prob)) return p + prob; #endif if (prob < 0 || prob >= 1) return R_NaN; /* limiting case as prob approaches zero is point mass at one */ if (prob == 0) { /* simplified ACT_Q_P01_boundaries macro */ if (log_p) { if (p > 0) return R_NaN; return 1.0; } else /* !log_p */ { if (p < 0 || p > 1) return R_NaN; return 1.0; } } ACT_Q_P01_boundaries(p, 1.0, R_PosInf); double a = -1.0/log1p(-prob), P = a * prob, Q = 1.0/(0.5 - prob + 0.5), mu = P * Q, sigma = sqrt(mu * (Q - mu)), gamma = (P * (1 + prob - P*(3 + 2*P)) * R_pow_di(Q, 3))/R_pow_di(sigma, 3); /* q_DISCRETE_01_CHECKS(); */ q_DISCRETE_DECL; q_DISCRETE_BODY(); } /* rlogarithmic() is an implementation with automatic selection of * the LS and LK algorithms of: * * Kemp, A. W. (1981), Efficient Generation of Logarithmically * Distributed Pseudo-Random Variables, Journal of the Royal * Statistical Society, Series C. Vol. 30, p. 249-253. * URL http://www.jstor.org/stable/2346348 * * The algorithms are also discussed in chapter 10 of Devroye (1986). */ double rlogarithmic(double prob) { if (prob < 0 || prob > 1) return R_NaN; /* limiting case as prob approaches zero is point mass at one. */ if (prob == 0) return 1.0; /* Automatic selection between the LS and LK algorithms */ if (prob < 0.95) { double s = -prob/log1p(-prob); double x = 1.0; double u = unif_rand(); while (u > s) { u -= s; x += 1.0; s *= prob * (x - 1.0)/x; } return x; } /* else (prob >= 0.95) */ { double r = log1p(-prob); double v = unif_rand(); if (v >= prob) return 1.0; double u = unif_rand(); double q = -expm1(r * u); if (v <= (q * q)) return floor(1.0 + log(v)/log(q)); if (v <= q) return 2.0; /* case q^2 < v <= q */ return 1.0; /* case v > q */ } } actuar/src/burr.c0000644000176200001440000001053714264305077013454 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the Burr distribution. See ../R/Burr.R for details. * * We work with the density expressed as * * shape1 * shape2 * u^shape1 * (1 - u) / x * * with u = 1/(1 + v), v = (x/scale)^shape2. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dburr(double x, double shape1, double shape2, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return x + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (!R_FINITE(x) || x < 0.0) return ACT_D__0; /* handle x == 0 separately */ if (x == 0.0) { if (shape2 < 1) return R_PosInf; if (shape2 > 1) return ACT_D__0; /* else */ return ACT_D_val(shape1 / scale); } double logv, logu, log1mu; logv = shape2 * (log(x) - log(scale)); logu = - log1pexp(logv); log1mu = - log1pexp(-logv); return ACT_D_exp(log(shape1) + log(shape2) + shape1 * logu + log1mu - log(x)); } double pburr(double q, double shape1, double shape2, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return q + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (q <= 0) return ACT_DT_0; double u = exp(-log1pexp(shape2 * (log(q) - log(scale)))); return ACT_DT_Cval(R_pow(u, shape1)); } double qburr(double p, double shape1, double shape2, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return p + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; ACT_Q_P01_boundaries(p, 0, R_PosInf); p = ACT_D_qIv(p); return scale * R_pow(R_pow(ACT_D_Cval(p), -1.0/shape1) - 1.0, 1.0/shape2); } double rburr(double shape1, double shape2, double scale) { if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; return scale * R_pow(R_pow(unif_rand(), -1.0/shape1) - 1.0, 1.0/shape2); } double mburr(double order, double shape1, double shape2, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return order + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -shape2 || order >= shape1 * shape2) return R_PosInf; double tmp = order / shape2; return R_pow(scale, order) * gammafn(1.0 + tmp) * gammafn(shape1 - tmp) / gammafn(shape1); } double levburr(double limit, double shape1, double shape2, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale) || ISNAN(order)) return limit + shape1 + shape2 + scale + order; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -shape2) return R_PosInf; if (limit <= 0.0) return 0.0; double logv, u, u1m; double tmp = order / shape2; logv = shape2 * (log(limit) - log(scale)); u = exp(-log1pexp(logv)); u1m = exp(-log1pexp(-logv)); return R_pow(scale, order) * betaint_raw(u1m, 1.0 + tmp, shape1 - tmp, u) / gammafn(shape1) + ACT_DLIM__0(limit, order) * R_pow(u, shape1); } actuar/src/Makevars0000644000176200001440000000026214264305077014024 0ustar liggesusers## We use the BLAS and the LAPACK libraries PKG_LIBS = $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) ## Hide entry points (but for R_init_actuar in init.c) PKG_CFLAGS = $(C_VISIBILITY) actuar/src/zmpois.c0000644000176200001440000001134314264305077014017 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute probability function, cumulative distribution * and quantile functions, and to simulate random variates for the * zero-modified Poisson distribution. See ../R/ZeroModifiedPoisson.R * for details. * * Zero-modified distributions are discrete mixtures between a * degenerate distribution at zero and the corresponding, * non-modified, distribution. As a mixture, they have density * * Pr[Z = x] = [1 - (1 - p0m)/(1 - p0)] 1(x) * + [(1 - p0m)/(1 - p0)] Pr[X = 0], * * where p0 = Pr[X = 0]. The density can also be expressed as * Pr[Z = 0] = p0m and * * Pr[Z = x] = (1 - p0m) * Pr[X = x]/(1 - Pr[X = 0]), * * for x = 1, 2, ... The distribution function is, for all x, * * Pr[Z <= x] = 1 - (1 - p0m) * (1 - Pr[X <= x])/(1 - p0). * * AUTHOR: Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" /* The Poisson distribution has p0 = exp(-lambda). * * Limiting case: lambda == 0 has mass (1 - p0m) at x = 1. */ double dzmpois(double x, double lambda, double p0m, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(lambda) || ISNAN(p0m)) return x + lambda + p0m; #endif if (lambda < 0 || p0m < 0 || p0m > 1) return R_NaN; if (x < 0 || !R_FINITE(x)) return ACT_D__0; if (x == 0) return ACT_D_val(p0m); /* NOTE: from now on x > 0 */ /* simple case for all x > 0 */ if (p0m == 1) return ACT_D__0; /* for all x > 0 */ /* limiting case as lambda approaches zero is mass (1-p0m) at one */ if (lambda == 0) return (x == 1) ? ACT_D_Clog(p0m) : ACT_D__0; return ACT_D_exp(dpois(x, lambda, /*give_log*/1) + log1p(-p0m) - ACT_Log1_Exp(-lambda)); } double pzmpois(double x, double lambda, double p0m, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(lambda) || ISNAN(p0m)) return x + lambda + p0m; #endif if (lambda < 0 || p0m < 0 || p0m > 1) return R_NaN; if (x < 0) return ACT_DT_0; if (!R_FINITE(x)) return ACT_DT_1; if (x < 1) return ACT_DT_val(p0m); /* NOTE: from now on x >= 1 */ /* simple case for all x >= 1 */ if (p0m == 1) return ACT_DT_1; /* limiting case as lambda approaches zero is mass (1-p0m) at one */ if (lambda == 0) return ACT_DT_1; /* working in log scale improves accuracy */ return ACT_DT_CEval(log1p(-p0m) + ppois(x, lambda, /*l._t.*/0, /*log_p*/1) - log1mexp(lambda)); } double qzmpois(double x, double lambda, double p0m, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(lambda) || ISNAN(p0m)) return x + lambda + p0m; #endif if (lambda < 0 || !R_FINITE(lambda) || p0m < 0 || p0m > 1) return R_NaN; /* limiting case as lambda approaches zero is mass (1-p0m) at one */ if (lambda == 0) { /* simplified ACT_Q_P01_boundaries macro */ if (log_p) { if (x > 0) return R_NaN; return (x <= log(p0m)) ? 0.0 : 1.0; } else /* !log_p */ { if (x < 0 || x > 1) return R_NaN; return (x <= p0m) ? 0.0 : 1.0; } } ACT_Q_P01_boundaries(x, 0, R_PosInf); x = ACT_DT_qIv(x); /* working in log scale improves accuracy */ return qpois(-expm1(log1mexp(lambda) - log1p(-p0m) + log1p(-x)), lambda, /*l._t.*/1, /*log_p*/0); } /* ALGORITHM FOR GENERATION OF RANDOM VARIATES * * 1. p0m >= p0: just simulate variates from the discrete mixture. * * 2. p0m < p0: fastest method depends on the difference p0 - p0m. * * 2.1 p0 - p0m < ACT_DIFFMAX_REJECTION: rejection method with an * envelope that differs from the target distribution at zero * only. In other words: rejection only at zero. * 2.2 p0 - p0m >= ACT_DIFFMAX_REJECTION: inverse method on a * restricted range --- same method as the corresponding zero * truncated distribution. * * The threshold ACT_DIFFMAX_REJECTION is distribution specific. */ #define ACT_DIFFMAX_REJECTION 0.95 double rzmpois(double lambda, double p0m) { if (lambda < 0 || !R_FINITE(lambda) || p0m < 0 || p0m > 1) return R_NaN; /* limiting case as lambda approaches zero is mass (1-p0m) at one */ if (lambda == 0) return (unif_rand() <= p0m) ? 0.0 : 1.0; double x, p0 = exp(-lambda); /* p0m >= p0: generate from mixture */ if (p0m >= p0) return (unif_rand() * (1 - p0) < (1 - p0m)) ? rpois(lambda) : 0.0; /* p0m < p0: choice of algorithm depends on difference p0 - p0m */ if (p0 - p0m < ACT_DIFFMAX_REJECTION) { /* rejection method */ for (;;) { x = rpois(lambda); if (x != 0 || /* x == 0 and */ runif(0, p0 * (1 - p0m)) <= (1 - p0) * p0m) return x; } } else { /* inversion method */ return qpois(runif((p0 - p0m)/(1 - p0m), 1), lambda, 1, 0); } } actuar/src/chisq.c0000644000176200001440000000533614264305077013612 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to calculate raw and limited moments for the Chi-square * distribution. See ../R/ChisqSupp.R for details. * * AUTHORS: Christophe Dutang and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" double mchisq(double order, double df, double ncp, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(df) || ISNAN(ncp)) return order + df + ncp; #endif if (!R_FINITE(df) || !R_FINITE(ncp) || !R_FINITE(order) || df <= 0.0 || ncp < 0.0) return R_NaN; if (order <= -df/2.0) return R_PosInf; /* Trivial case */ if (order == 0.0) return 1.0; /* Centered chi-square distribution */ if (ncp == 0.0) return R_pow(2.0, order) * gammafn(order + df/2.0) / gammafn(df/2.0); /* Non centered chi-square distribution */ if (order >= 1.0 && (int) order == order) { int i, j = 0, n = order; double *res; /* Array with 1, E[X], E[X^2], ..., E[X^n] */ res = (double *) R_alloc(n + 1, sizeof(double)); res[0] = 1.0; res[1] = df + ncp; /* E[X] */ for (i = 2; i <= n; i++) { res[i] = R_pow_di(2.0, i - 1) * (df + i * ncp); for (j = 1; j < i; j++) res[i] += R_pow_di(2.0, j - 1) * (df + j * ncp) * res[i - j] / gammafn(i - j + 1); res[i] *= gammafn(i); } return res[n]; } else return R_NaN; } double levchisq(double limit, double df, double ncp, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(df) || ISNAN(ncp) || ISNAN(order)) return limit + df + ncp + order; #endif if (!R_FINITE(df) || !R_FINITE(ncp) || !R_FINITE(order) || df <= 0.0 || ncp < 0.0) return R_NaN; if (order <= -df/2.0) return R_PosInf; if (limit <= 0.0) return 0.0; if (ncp == 0.0) { double u, tmp; tmp = order + df/2.0; u = exp(log(limit) - M_LN2); return R_pow(2.0, order) * gammafn(tmp) * pgamma(u, tmp, 1.0, 1, 0) / gammafn(df/2.0) + ACT_DLIM__0(limit, order) * pgamma(u, df/2.0, 1.0, 0, 0); } else return R_NaN; } double mgfchisq(double t, double df, double ncp, int give_log) { #ifdef IEEE_754 if (ISNAN(t) || ISNAN(df) || ISNAN(ncp)) return t + df + ncp; #endif if (!R_FINITE(df) || !R_FINITE(ncp) || df <= 0.0 || ncp < 0.0 || 2.0 * t > 1.0) return R_NaN; if (t == 0.0) return ACT_D__1; return ACT_D_exp(ncp * t / (1.0 - 2.0 * t) - df/2.0 * log1p(-2.0 * t)); } actuar/src/actuar-win.def0000644000176200001440000000005214264305077015057 0ustar liggesusersLIBRARY actuar.dll EXPORTS R_init_actuar actuar/src/weibull.c0000644000176200001440000000273114264305077014142 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Fonctions to calculate raw and limited moments for the Weibull * distribution. See ../R/WeibullMoments.R for details. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" double mweibull(double order, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape) || ISNAN(scale)) return order + shape + scale; #endif if (!R_FINITE(scale) || !R_FINITE(shape) || !R_FINITE(order) || scale <= 0.0 || shape <= 0.0) return R_NaN; if (order <= -shape) return R_PosInf; return R_pow(scale, order) * gammafn(1.0 + order / shape); } double levweibull(double limit, double shape, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape) || ISNAN(scale) || ISNAN(order)) return limit + shape + scale + order; #endif if (!R_FINITE(scale) || !R_FINITE(shape) || !R_FINITE(order) || scale <= 0.0 || shape <= 0.0) return R_NaN; if (order <= -shape) return R_PosInf; if (limit <= 0.0) return 0.0; double u, tmp; tmp = 1.0 + order / shape; u = exp(shape * (log(limit) - log(scale))); return R_pow(scale, order) * gammafn(tmp) * pgamma(u, tmp, 1.0, 1, 0) + ACT_DLIM__0(limit, order) * exp(-u); } actuar/src/qDiscrete_search.h0000644000176200001440000001077514264305077015763 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Find quantiles for discrete distributions using the Cornish-Fisher * Expansion. * * This file is a copy of src/nmath/qDiscrete_search.h of R sources, * but with the following minor changes: * * 1. all debugging material is deleted; * 2. the macro function q_DISCRETE_01_CHECKS(), which does not serve * any purpose without the debugging material is deleted; * 3. the declaration of variables in q_DISCRETE_BODY() is moved into * a separate macro; see comments marked 'VG' below. * * AUTHOR: Vincent Goulet * based on code from the R Core Team */ /* This is #included from ./logarithmic.c and ./poisinvgauss.c */ #define PST_0(a, b) a ## b #define PASTE(a, b) PST_0(a, b) #define _pDIST_ PASTE(p, _thisDIST_) #define _qDIST_ PASTE(q, _thisDIST_) #ifdef MATHLIB_STANDALONE # define MAYBE_R_CheckUserInterrupt() #else # define MAYBE_R_CheckUserInterrupt() R_CheckUserInterrupt() #endif #define DO_SEARCH_FUN(...) \ do_search(double y, double *z, double p, __VA_ARGS__, \ double incr, int lower_tail, int log_p) #define DO_SEARCH_(Y_, incr_, ...) \ do_search(Y_, &z, p, __VA_ARGS__, incr_, lower_tail, log_p) #define P_DIST(Y_, ...) _pDIST_(Y_, __VA_ARGS__, lower_tail, log_p) static double DO_SEARCH_FUN(_dist_PARS_DECL_) { Rboolean left = (lower_tail ? (*z >= p) : (*z < p)); if(left) { // (lower_tail, *z >= p) or (upper tail, *z < p): search to the __left__ for(int iter = 0; ; iter++) { double newz = -1.; // -Wall if(y > 0) newz = P_DIST(y - incr, _dist_PARS_); else if(y < 0) y = 0; // note that newz may be NaN because of remaining border line bugs in _pDIST_() {bug from pbeta()} if(y == 0 || ISNAN(newz) || (lower_tail ? (newz < p) : (newz >= p))) { return y; // and previous *z } y = fmax2(0, y - incr); *z = newz; } } else { // (lower_tail, *z < p) or (upper tail, *z >= p): search to the __right__ for(int iter = 0; ; iter++) { y += incr; *z = P_DIST(y, _dist_PARS_); if(ISNAN(*z) || (lower_tail ? (*z >= p) : (*z < p))) { return y; } } } } // do_search() #define q_DISCR_CHECK_BOUNDARY(Y_) if(Y_ < 0) Y_ = 0. /* VG: the Poisson-inverse gaussian requires different declarations * for a limiting case. Therefore, the standard declaration is taken * out of the q_DISCRETE_BODY() macro found in R sources. */ #define q_DISCRETE_DECL \ double \ z = qnorm(p, 0., 1., lower_tail, log_p), \ y = ACT_forceint(mu + sigma * (z + gamma * (z*z - 1) / 6)) #define q_DISCRETE_BODY() do { \ q_DISCR_CHECK_BOUNDARY(y); \ \ z = P_DIST(y, _dist_PARS_); \ \ /* Algorithmic "tuning parameters", used to be hardwired; changed for speed &| precision */ \ const double \ _pf_n_ = 8, /* was hardwired to 64 */ \ _pf_L_ = 2, /* was hardwired to 64 */ \ _yLarge_ = 4096, /* was hardwired to 1e5 */ \ _incF_ = (1./64),/* was hardwired to 0.001 (= 1./1000 ) */ \ _iShrink_ = 8, /* was hardwired to 100 */ \ _relTol_ = 1e-15,/* was hardwired to 1e-15 */ \ _xf_ = 4; /* extra factor, *must* be >= 1 (new anyway) */ \ \ /* fuzz to ensure left continuity: do not loose too much (=> error in upper tail) */ \ if(log_p) { /* <==> p \in [-Inf, 0] different adjustment: "other sign" */ \ double e = _pf_L_ * DBL_EPSILON; \ if(lower_tail && p > - DBL_MAX) /* prevent underflow to -Inf */ \ p *= 1 + e; \ else /* if(p < - DBL_MIN) // not too close to -0 */ \ p *= 1 - e; \ \ } else { /* not log scale */ \ double e = _pf_n_ * DBL_EPSILON; \ if(lower_tail) \ p *= 1 - e; \ else if(1 - p > _xf_*e) /* otherwise get p > 1 */ \ p *= 1 + e; \ } \ \ /* If the C-F value y is not too large a simple search is OK */ \ if(y < _yLarge_) return DO_SEARCH_(y, 1, _dist_PARS_); \ /* Otherwise be a bit cleverer in the search: use larger increments, notably initially: */ \ { /* y >= _yLarge_ */ \ double oldincr, incr = floor(y * _incF_); \ int qIt = 0; \ \ do { \ oldincr = incr; \ y = DO_SEARCH_(y, incr, _dist_PARS_); /* also updating *z */ \ if(++qIt % 10000 == 0) MAYBE_R_CheckUserInterrupt(); \ incr = fmax2(1, floor(incr / _iShrink_)); \ } while(oldincr > 1 && incr > y * _relTol_); \ return y; \ } \ } while(0) actuar/src/gumbel.c0000644000176200001440000000626614264305077013761 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the Gumbel distribution. See ../R/Gumbel.R for * details. * * We work with the density expressed as * * e^(-u) * e^(-e^(-u)) / scale * * with u = (x - alpha)/scale. * * AUTHOR: Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" double dgumbel(double x, double alpha, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(alpha) || ISNAN(scale)) return x + alpha + scale; #endif if (!R_FINITE(scale)) return ACT_D__0; if (!R_FINITE(x) && alpha == x) return R_NaN; /* x - alpha is NaN */ if (scale <= 0) { if (scale < 0) return R_NaN; /* scale == 0 */ return (x == alpha) ? R_PosInf : ACT_D__0; } x = (x - alpha) / scale; if (!R_FINITE(x)) return ACT_D__0; return ACT_D_exp(-(x + exp(-x) + log(scale))); } double pgumbel(double q, double alpha, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(alpha) || ISNAN(scale)) return q + alpha + scale; #endif if (!R_FINITE(q) && alpha == q) return R_NaN; /* q - alpha is NaN */ if (scale <= 0) { if (scale < 0) return R_NaN; /* scale == 0 : */ return (q < alpha) ? ACT_DT_0 : ACT_DT_1; } double p = (q - alpha) / scale; if (!R_FINITE(p)) return (q < alpha) ? ACT_DT_0 : ACT_DT_1; q = p; return ACT_DT_val(exp(-exp(-q))); } double qgumbel(double p, double alpha, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(alpha) || ISNAN(scale)) return p + alpha + scale; #endif if (!R_FINITE(alpha) || !R_FINITE(scale) || scale <= 0.0) return R_NaN;; ACT_Q_P01_boundaries(p, R_NegInf, R_PosInf); p = ACT_DT_qIv(p); return alpha - scale * log(-log(p)); } double rgumbel(double alpha, double scale) { if (!R_FINITE(alpha) || !R_FINITE(scale) || scale <= 0.0) return R_NaN;; return alpha - scale * log(exp_rand()); } #define EULER_CNST 0.577215664901532860606512090082 double mgumbel(double order, double alpha, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(alpha) || ISNAN(scale)) return order + alpha + scale; #endif if (!R_FINITE(alpha) || !R_FINITE(scale) || !R_FINITE(order) || scale <= 0.0 || order <= 0.0 || order > 2.0) return R_NaN; if (order == 1.0) return alpha + EULER_CNST * scale; if (order == 2.0) return R_pow_di(M_PI * scale, 2)/6 + R_pow_di(alpha + EULER_CNST * scale, 2); return R_NaN; /* order != 1 or 2 */ } double mgfgumbel(double t, double alpha, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(t) || ISNAN(alpha) || ISNAN(scale)) return t + alpha + scale; #endif if (!R_FINITE(alpha) || !R_FINITE(scale) || scale <= 0.0 || scale * t < 1.0) return R_NaN; if (t == 0.0) return ACT_D__1; return ACT_D_exp(alpha * t + lgamma(1 - scale * t)); } actuar/src/invtrgamma.c0000644000176200001440000001012714264305077014642 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the inverse transformed gamma distribution. See * ../R/InverseTransformedGamma.R for details. * * We work with the density expressed as * * shape2 * u^shape1 * e^(-u) / (x * gamma(shape1)) * * with u = (scale/x)^shape2. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dinvtrgamma(double x, double shape1, double shape2, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return x + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || scale < 0.0) return R_NaN; /* handle also x == 0 here */ if (!R_FINITE(x) || x <= 0.0) return ACT_D__0; double logu = shape2 * (log(scale) - log(x)); return ACT_D_exp(log(shape2) + shape1 * logu - exp(logu) - log(x) - lgammafn(shape1)); } double pinvtrgamma(double q, double shape1, double shape2, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return q + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || scale < 0.0) return R_NaN;; if (q <= 0) return ACT_DT_0; double u = exp(shape2 * (log(scale) - log(q))); return pgamma(u, shape1, 1.0, !lower_tail, log_p); } double qinvtrgamma(double p, double shape1, double shape2, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return p + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN;; ACT_Q_P01_boundaries(p, 0, R_PosInf); p = ACT_D_qIv(p); return scale * R_pow(qgamma(p, shape1, 1.0, !lower_tail, 0), -1.0/shape2); } double rinvtrgamma(double shape1, double shape2, double scale) { if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN;; return scale * R_pow(rgamma(shape1, 1.0), -1.0/shape2); } double minvtrgamma(double order, double shape1, double shape2, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return order + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (order >= shape1 * shape2) return R_PosInf; return R_pow(scale, order) * gammafn(shape1 - order / shape2) / gammafn(shape1); } double levinvtrgamma(double limit, double shape1, double shape2, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale) || ISNAN(order)) return limit + shape1 + shape2 + scale + order; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (limit <= 0.0) return 0.0; double u = exp(shape2 * (log(scale) - log(limit))); return R_pow(scale, order) * actuar_gamma_inc(shape1 - order/shape2, u) / gammafn(shape1) + ACT_DLIM__0(limit, order) * pgamma(u, shape1, 1.0, 1, 0); } actuar/src/invpareto.c0000644000176200001440000001110114264305077014475 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Fonctions to compute density, cumulative distribution and quantile * fonctions, raw and limited moments and to simulate random variates * for the inverse Pareto distribution. See ../R/InversePareto.R for * details. * * We work with the density expressed as * * shape * u^shape * (1 - u) / x * * with u = v/(1 + v) = 1/(1 + 1/v), v = x/scale. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dinvpareto(double x, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(shape) || ISNAN(scale)) return x + shape + scale; #endif if (!R_FINITE(shape) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (!R_FINITE(x) || x < 0.0) return ACT_D__0; /* handle x == 0 separately */ if (x == 0.0) { if (shape < 1) return R_PosInf; if (shape > 1) return ACT_D__0; /* else */ return ACT_D_val(1.0/scale); } double tmp, logu, log1mu; tmp = log(x) - log(scale); logu = - log1pexp(-tmp); log1mu = - log1pexp(tmp); return ACT_D_exp(log(shape) + shape * logu + log1mu - log(x)); } double pinvpareto(double q, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(shape) || ISNAN(scale)) return q + shape + scale; #endif if (!R_FINITE(shape) || shape <= 0.0 || scale <= 0.0) return R_NaN;; if (q <= 0) return ACT_DT_0; double u = exp(-log1pexp(log(scale) - log(q))); return ACT_DT_val(R_pow(u, shape)); } double qinvpareto(double p, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(shape) || ISNAN(scale)) return p + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN;; ACT_Q_P01_boundaries(p, 0, R_PosInf); p = ACT_D_qIv(p); return scale / (R_pow(ACT_D_Lval(p), -1.0/shape) - 1.0); } double rinvpareto(double shape, double scale) { if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN;; return scale / (R_pow(unif_rand(), -1.0/shape) - 1.0); } double minvpareto(double order, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape) || ISNAN(scale)) return order + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -shape || order >= 1.0) return R_PosInf; return R_pow(scale, order) * gammafn(shape + order) * gammafn(1.0 - order) / gammafn(shape); } /* The function to integrate in the limited moment */ static void fn(double *x, int n, void *ex) { int i; double *pars = (double *) ex, shape, order; shape = pars[0]; order = pars[1]; for(i = 0; i < n; i++) x[i] = R_pow(x[i], shape + order - 1) * R_pow(1 - x[i], -order); } double levinvpareto(double limit, double shape, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape) || ISNAN(scale) || ISNAN(order)) return limit + shape + scale + order; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -shape) return R_PosInf; if (limit <= 0.0) return 0.0; double u; double ex[2], lower, upper, epsabs, epsrel, result, abserr, *work; int neval, ier, subdiv, lenw, last, *iwork; /* Parameters for the integral are pretty much fixed here */ ex[0] = shape; ex[1] = order; lower = 0.0; upper = limit / (limit + scale); subdiv = 100; epsabs = R_pow(DBL_EPSILON, 0.25); epsrel = epsabs; lenw = 4 * subdiv; /* as instructed in WRE */ iwork = (int *) R_alloc(subdiv, sizeof(int)); /* idem */ work = (double *) R_alloc(lenw, sizeof(double)); /* idem */ Rdqags(fn, (void *) &ex, &lower, &upper, &epsabs, &epsrel, &result, &abserr, &neval, &ier, &subdiv, &lenw, &last, iwork, work); if (ier == 0) { u = exp(-log1pexp(log(scale) - log(limit))); return R_pow(scale, order) * shape * result + ACT_DLIM__0(limit, order) * (0.5 - R_pow(u, shape) + 0.5); } else error(_("integration failed")); } actuar/src/invparalogis.c0000644000176200001440000000754214264305077015202 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the inverse paralogistic distribution. See ../R/InverseParalogistic.R * for details. * * We work with the density expressed as * * shape^2 * u^shape * (1 - u) / x * * with u = v/(1 + v) = 1/(1 + 1/v), v = (x/scale)^shape. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dinvparalogis(double x, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(shape) || ISNAN(scale)) return x + shape + scale; #endif if (!R_FINITE(shape) || shape <= 0.0 || scale <= 0.0) return R_NaN;; if (!R_FINITE(x) || x < 0.0) return ACT_D__0; /* handle x == 0 separately */ if (x == 0.0) { if (shape < 1.0) return R_PosInf; if (shape > 1.0) return ACT_D__0; /* else */ return ACT_D_val(1.0/scale); } double logv, logu, log1mu; logv = shape * (log(x) - log(scale)); logu = - log1pexp(-logv); log1mu = - log1pexp(logv); return ACT_D_exp(2.0 * log(shape) + shape * logu + log1mu - log(x)); } double pinvparalogis(double q, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(shape) || ISNAN(scale)) return q + shape + scale; #endif if (!R_FINITE(shape) || shape <= 0.0 || scale <= 0.0) return R_NaN;; if (q <= 0) return ACT_DT_0; double u = exp(-log1pexp(shape * (log(scale) - log(q)))); return ACT_DT_val(R_pow(u, shape)); } double qinvparalogis(double p, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(shape) || ISNAN(scale)) return p + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN;; ACT_Q_P01_boundaries(p, 0, R_PosInf); p = ACT_D_qIv(p); double tmp = -1.0/shape; return scale * R_pow(R_pow(ACT_D_Lval(p), tmp) - 1.0, tmp); } double rinvparalogis(double shape, double scale) { double tmp; if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN;; tmp = -1.0/shape; return scale * R_pow(R_pow(unif_rand(), tmp) - 1.0, tmp); } double minvparalogis(double order, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape) || ISNAN(scale)) return order + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (order <= - shape * shape || order >= shape) return R_PosInf; double tmp = order / shape; return R_pow(scale, order) * gammafn(shape + tmp) * gammafn(1.0 - tmp) / gammafn(shape); } double levinvparalogis(double limit, double shape, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape) || ISNAN(scale) || ISNAN(order)) return limit + shape + scale + order; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -shape * shape) return R_PosInf; double logv, u, u1m; double tmp = order / shape; logv = shape * (log(limit) - log(scale)); u = exp(-log1pexp(-logv)); u1m = exp(-log1pexp(logv)); return R_pow(scale, order) * betaint_raw(u, shape + tmp, 1.0 - tmp, u1m) / gammafn(shape) + ACT_DLIM__0(limit, order) * (0.5 - R_pow(u, shape) + 0.5); } actuar/src/random.c0000644000176200001440000003757214326564170013772 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to generate variates of some probability laws not in * base R. Function .External() calls actuar_do_random() with * arguments: * * 1. the name of the distribution from which to simulate, with * an "r" prepended to it (e.g. "rpareto"); * 2. the number of variates; * 3:x. the parameters of the distribution. * * Function actuar_do_random() will extract the name of the * distribution, look up in table random_tab defined in names.c which of * actuar_do_random{1,2,3,4} should take care of the simulation and * dispatch to this function. In turn, functions * actuar_do_random{1,2,3,4} call function rdist() to get actual * variates from distribution "dist". * * This scheme is essentially what is used in base R (see files * src/main/random.c, src/main/names.c) with add-ons taken from * src/library/stats/src/random.c to support return values that can * be either real or integer. * * To add a new distribution: write an rdist() function, add an entry * in names.c and in the definition of the corresponding * actuar_do_random{1,2,3,4} function, declare the function in * actuar.h. * * AUTHOR: Vincent Goulet * with much indirect help from the R Core Team */ #include #include #include "actuar.h" #include "locale.h" /* Prototypes of auxiliary functions */ static Rboolean random1(double (*f)(double), double *, int, SEXP, int, SEXPTYPE); static Rboolean random2(double (*f)(double, double), double *, int, double *, int, SEXP, int, SEXPTYPE); static Rboolean random3(double (*f)(double, double, double), double *, int, double *, int, double *, int, SEXP, int, SEXPTYPE); static Rboolean random4(double (*f)(double, double, double, double), double *, int, double *, int, double *, int, double *, int, SEXP, int, SEXPTYPE); static Rboolean random5(double (*f)(double, double, double, double, double), double *, int, double *, int, double *, int, double *, int, double *, int, SEXP, int, SEXPTYPE); /* Additional access macros */ #define CAD5R(e) CAR(CDR(CDR(CDR(CDR(CDR(e)))))) /* Utility function used in actuar_do_random{1,2,3,4}. */ static void fill_with_NAs(SEXP x, int n, SEXPTYPE type) { int i; if (type == INTSXP) { for (i = 0; i < n; i++) { INTEGER(x)[i] = NA_INTEGER; } } else { /* REALSXP */ for (i = 0; i < n; i++) { REAL(x)[i] = NA_REAL; } } warning(_("NAs produced")); } /* Functions for one parameter distributions */ static Rboolean random1(double (*f)(double), double *a, int na, SEXP x, int n, SEXPTYPE type) { int i; Rboolean naflag = FALSE; if (type == INTSXP) { double rx; int *ix = INTEGER(x); for (i = 0; i < n; i++) { rx = f(a[i % na]); if (ISNAN(rx) || rx > INT_MAX || rx <= INT_MIN) { naflag = TRUE; ix[i] = NA_INTEGER; } else ix[i] = (int) rx; } } else /* REALSXP */ { double *rx = REAL(x); for (i = 0; i < n; i++) { rx[i] = f(a[i % na]); if (ISNAN(rx[i])) naflag = TRUE; } } return(naflag); } #define RAND1(num, fun) \ case num: \ naflag = random1(fun, REAL(a), na, x, n, type); \ break SEXP actuar_do_random1(int code, SEXP args, SEXPTYPE type) { SEXP x, a; int n, na; /* Check validity of arguments */ if (!isVector(CAR(args)) || !isNumeric(CADR(args))) error(_("invalid arguments")); /* Number of variates to generate */ if (LENGTH(CAR(args)) == 1) { n = asInteger(CAR(args)); if (n == NA_INTEGER || n < 0) error(_("invalid arguments")); } else n = LENGTH(CAR(args)); /* If n == 0, return numeric(0) */ PROTECT(x = allocVector(type, n)); if (n == 0) { UNPROTECT(1); return(x); } /* If length of parameters < 1, return NaN */ na = LENGTH(CADR(args)); if (na < 1) fill_with_NAs(x, n, type); /* Otherwise, dispatch to appropriate r* function */ else { Rboolean naflag = FALSE; PROTECT(a = coerceVector(CADR(args), REALSXP)); GetRNGstate(); switch (code) { RAND1(1, rinvexp); RAND1(101, rlogarithmic); RAND1(102, rztpois); RAND1(103, rztgeom); default: error(_("internal error in actuar_do_random1")); } if (naflag) warning(R_MSG_NA); PutRNGstate(); UNPROTECT(1); } UNPROTECT(1); return x; } /* Functions for two parameter distributions */ static Rboolean random2(double (*f)(double, double), double *a, int na, double *b, int nb, SEXP x, int n, SEXPTYPE type) { int i; Rboolean naflag = FALSE; if (type == INTSXP) { double rx; int *ix = INTEGER(x); for (i = 0; i < n; i++) { rx = f(a[i % na], b[i % nb]); if (ISNAN(rx) || rx > INT_MAX || rx <= INT_MIN) { naflag = TRUE; ix[i] = NA_INTEGER; } else ix[i] = (int) rx; } } else /* REALSXP */ { double *rx = REAL(x); for (i = 0; i < n; i++) { rx[i] = f(a[i % na], b[i % nb]); if (ISNAN(rx[i])) naflag = TRUE; } } return(naflag); } #define RAND2(num, fun) \ case num: \ naflag = random2(fun, REAL(a), na, REAL(b), nb, x, n, type); \ break SEXP actuar_do_random2(int code, SEXP args, SEXPTYPE type) { SEXP x, a, b; int n, na, nb; /* Check validity of arguments */ if (!isVector(CAR(args)) || !isNumeric(CADR(args)) || !isNumeric(CADDR(args))) error(_("invalid arguments")); /* Number of variates to generate */ if (LENGTH(CAR(args)) == 1) { n = asInteger(CAR(args)); if (n == NA_INTEGER || n < 0) error(_("invalid arguments")); } else n = LENGTH(CAR(args)); /* If n == 0, return numeric(0) */ PROTECT(x = allocVector(type, n)); if (n == 0) { UNPROTECT(1); return(x); } /* If length of parameters < 1, return NA */ na = LENGTH(CADR(args)); nb = LENGTH(CADDR(args)); if (na < 1 || nb < 1) fill_with_NAs(x, n, type); /* Otherwise, dispatch to appropriate r* function */ else { Rboolean naflag = FALSE; PROTECT(a = coerceVector(CADR(args), REALSXP)); PROTECT(b = coerceVector(CADDR(args), REALSXP)); GetRNGstate(); switch (code) { RAND2( 1, rinvgamma); RAND2( 2, rinvparalogis); RAND2( 3, rinvpareto); RAND2( 4, rinvweibull); RAND2( 5, rlgamma); RAND2( 6, rllogis); RAND2( 7, rparalogis); RAND2( 8, rpareto); RAND2( 9, rpareto1); RAND2( 10, rgumbel); RAND2( 11, rinvgauss); RAND2(101, rztnbinom); RAND2(102, rztbinom); RAND2(103, rzmlogarithmic); RAND2(104, rzmpois); RAND2(105, rzmgeom); RAND2(106, rpoisinvgauss); default: error(_("internal error in actuar_do_random2")); } if (naflag) warning(R_MSG_NA); PutRNGstate(); UNPROTECT(2); } UNPROTECT(1); return x; } /* Functions for three parameter distributions */ static Rboolean random3(double (*f)(double, double, double), double *a, int na, double *b, int nb, double *c, int nc, SEXP x, int n, SEXPTYPE type) { int i; Rboolean naflag = FALSE; if (type == INTSXP) { double rx; int *ix = INTEGER(x); for (i = 0; i < n; i++) { rx = f(a[i % na], b[i % nb], c[i % nc]); if (ISNAN(rx) || rx > INT_MAX || rx <= INT_MIN) { naflag = TRUE; ix[i] = NA_INTEGER; } else ix[i] = (int) rx; } } else /* REALSXP */ { double *rx = REAL(x); for (i = 0; i < n; i++) { rx[i] = f(a[i % na], b[i % nb], c[i % nc]); if (ISNAN(rx[i])) naflag = TRUE; } } return(naflag); } #define RAND3(num, fun) \ case num: \ naflag = random3(fun, REAL(a), na, REAL(b), nb, REAL(c), nc, x, n, type); \ break SEXP actuar_do_random3(int code, SEXP args, SEXPTYPE type) { SEXP x, a, b, c; int n, na, nb, nc; /* Check validity of arguments */ if (!isVector(CAR(args)) || !isNumeric(CADR(args)) || !isNumeric(CADDR(args)) || !isNumeric(CADDDR(args))) error(_("invalid arguments")); /* Number of variates to generate */ if (LENGTH(CAR(args)) == 1) { n = asInteger(CAR(args)); if (n == NA_INTEGER || n < 0) error(_("invalid arguments")); } else n = LENGTH(CAR(args)); /* If n == 0, return numeric(0) */ PROTECT(x = allocVector(type, n)); if (n == 0) { UNPROTECT(1); return(x); } /* If length of parameters < 1, return NaN */ na = LENGTH(CADR(args)); nb = LENGTH(CADDR(args)); nc = LENGTH(CADDDR(args)); if (na < 1 || nb < 1 || nc < 1) fill_with_NAs(x, n, type); /* Otherwise, dispatch to appropriate r* function */ else { Rboolean naflag = FALSE; PROTECT(a = coerceVector(CADR(args), REALSXP)); PROTECT(b = coerceVector(CADDR(args), REALSXP)); PROTECT(c = coerceVector(CADDDR(args), REALSXP)); GetRNGstate(); switch (code) { RAND3( 1, rburr); RAND3( 2, rgenpareto); RAND3( 3, rinvburr); RAND3( 4, rinvtrgamma); RAND3( 5, rtrgamma); RAND3( 6, rpareto2); RAND3( 7, rpareto3); RAND3(101, rzmnbinom); RAND3(102, rzmbinom); default: error(_("internal error in actuar_do_random3")); } if (naflag) warning(R_MSG_NA); PutRNGstate(); UNPROTECT(3); } UNPROTECT(1); return x; } /* Functions for four parameter distributions */ static Rboolean random4(double (*f)(double, double, double, double), double *a, int na, double *b, int nb, double *c, int nc, double *d, int nd, SEXP x, int n, SEXPTYPE type) { int i; Rboolean naflag = FALSE; if (type == INTSXP) { double rx; int *ix = INTEGER(x); for (i = 0; i < n; i++) { rx = f(a[i % na], b[i % nb], c[i % nc], d[i % nd]); if (ISNAN(rx) || rx > INT_MAX || rx <= INT_MIN) { naflag = TRUE; ix[i] = NA_INTEGER; } else ix[i] = (int) rx; } } else /* REALSXP */ { double *rx = REAL(x); for (i = 0; i < n; i++) { rx[i] = f(a[i % na], b[i % nb], c[i % nc], d[i % nd]); if (ISNAN(rx[i])) naflag = TRUE; } } return(naflag); } #define RAND4(num, fun) \ case num: \ naflag = random4(fun, REAL(a), na, REAL(b), nb, REAL(c), nc, REAL(d), nd, x, n, type); \ break SEXP actuar_do_random4(int code, SEXP args, SEXPTYPE type) { SEXP x, a, b, c, d; int n, na, nb, nc, nd; /* Check validity of arguments */ if (!isVector(CAR(args)) || !isNumeric(CADR(args)) || !isNumeric(CADDR(args)) || !isNumeric(CADDDR(args)) || !isNumeric(CAD4R(args))) error(_("invalid arguments")); /* Number of variates to generate */ if (LENGTH(CAR(args)) == 1) { n = asInteger(CAR(args)); if (n == NA_INTEGER || n < 0) error(_("invalid arguments")); } else n = LENGTH(CAR(args)); /* If n == 0, return numeric(0) */ PROTECT(x = allocVector(type, n)); if (n == 0) { UNPROTECT(1); return(x); } /* If length of parameters < 1, return NaN */ na = LENGTH(CADR(args)); nb = LENGTH(CADDR(args)); nc = LENGTH(CADDDR(args)); nd = LENGTH(CAD4R(args)); if (na < 1 || nb < 1 || nc < 1 || nd < 1) fill_with_NAs(x, n, type); /* Otherwise, dispatch to appropriate r* function */ else { Rboolean naflag = FALSE; PROTECT(a = coerceVector(CADR(args), REALSXP)); PROTECT(b = coerceVector(CADDR(args), REALSXP)); PROTECT(c = coerceVector(CADDDR(args), REALSXP)); PROTECT(d = coerceVector(CAD4R(args), REALSXP)); GetRNGstate(); switch (code) { RAND4(1, rtrbeta); RAND4(2, rgenbeta); RAND4(3, rpareto4); default: error(_("internal error in actuar_do_random4")); } if (naflag) warning(R_MSG_NA); PutRNGstate(); UNPROTECT(4); } UNPROTECT(1); return x; } /* Functions for Five parameter distributions */ static Rboolean random5(double (*f)(double, double, double, double, double), double *a, int na, double *b, int nb, double *c, int nc, double *d, int nd, double *e, int ne, SEXP x, int n, SEXPTYPE type) { int i; Rboolean naflag = FALSE; if (type == INTSXP) { double rx; int *ix = INTEGER(x); for (i = 0; i < n; i++) { rx = f(a[i % na], b[i % nb], c[i % nc], d[i % nd], e[i % ne]); if (ISNAN(rx) || rx > INT_MAX || rx <= INT_MIN) { naflag = TRUE; ix[i] = NA_INTEGER; } else ix[i] = (int) rx; } } else /* REALSXP */ { double *rx = REAL(x); for (i = 0; i < n; i++) { rx[i] = f(a[i % na], b[i % nb], c[i % nc], d[i % nd], e[i % nd]); if (ISNAN(rx[i])) naflag = TRUE; } } return(naflag); } #define RAND5(num, fun) \ case num: \ naflag = random5(fun, REAL(a), na, REAL(b), nb, REAL(c), nc, REAL(d), nd, REAL(e), ne, x, n, type); \ break SEXP actuar_do_random5(int code, SEXP args, SEXPTYPE type) { SEXP x, a, b, c, d, e; int n, na, nb, nc, nd, ne; /* Check validity of arguments */ if (!isVector(CAR(args)) || !isNumeric(CADR(args)) || !isNumeric(CADDR(args)) || !isNumeric(CADDDR(args)) || !isNumeric(CAD4R(args)) || !isNumeric(CAD5R(args))) error(_("invalid arguments")); /* Number of variates to generate */ if (LENGTH(CAR(args)) == 1) { n = asInteger(CAR(args)); if (n == NA_INTEGER || n < 0) error(_("invalid arguments")); } else n = LENGTH(CAR(args)); /* If n == 0, return numeric(0) */ PROTECT(x = allocVector(type, n)); if (n == 0) { UNPROTECT(1); return(x); } /* If length of parameters < 1, return NaN */ na = LENGTH(CADR(args)); nb = LENGTH(CADDR(args)); nc = LENGTH(CADDDR(args)); nd = LENGTH(CAD4R(args)); ne = LENGTH(CAD5R(args)); if (na < 1 || nb < 1 || nc < 1 || nd < 1 || ne < 1) fill_with_NAs(x, n, type); /* Otherwise, dispatch to appropriate r* function */ else { Rboolean naflag = FALSE; PROTECT(a = coerceVector(CADR(args), REALSXP)); PROTECT(b = coerceVector(CADDR(args), REALSXP)); PROTECT(c = coerceVector(CADDDR(args), REALSXP)); PROTECT(d = coerceVector(CAD4R(args), REALSXP)); PROTECT(e = coerceVector(CAD5R(args), REALSXP)); GetRNGstate(); switch (code) { RAND5(1, rfpareto); default: error(_("internal error in actuar_do_random5")); } if (naflag) warning(R_MSG_NA); PutRNGstate(); UNPROTECT(5); } UNPROTECT(1); return x; } /* Main function, the only one used by .External(). */ SEXP actuar_do_random(SEXP args) { int i; const char *name; /* Extract distribution name */ args = CDR(args); name = CHAR(STRING_ELT(CAR(args), 0)); /* Dispatch to actuar_do_random{1,2,3,4} */ for (i = 0; random_tab[i].name; i++) { if (!strcmp(random_tab[i].name, name)) return random_tab[i].cfun(random_tab[i].code, CDR(args), random_tab[i].type); } /* No dispatch is an error */ error(_("internal error in actuar_do_random")); return args; /* never used; to keep -Wall happy */ } actuar/src/zmgeom.c0000644000176200001440000001023514264305077013773 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute probability function, cumulative distribution * and quantile functions, and to simulate random variates for the * zero-modified geometric distribution. See * ../R/ZeroModifiedGeometric.R for details. * * Zero-modified distributions are discrete mixtures between a * degenerate distribution at zero and the corresponding, * non-modified, distribution. As a mixture, they have density * * Pr[Z = x] = [1 - (1 - p0m)/(1 - p0)] 1(x) * + [(1 - p0m)/(1 - p0)] Pr[X = 0], * * where p0 = Pr[X = 0]. The density can also be expressed as * Pr[Z = 0] = p0m and * * Pr[Z = x] = (1 - p0m) * Pr[X = x]/(1 - Pr[X = 0]), * * for x = 1, 2, ... The distribution function is, for all x, * * Pr[Z <= x] = 1 - (1 - p0m) * (1 - Pr[X <= x])/(1 - p0). * * AUTHOR: Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" /* The geometric distribution has p0 = prob. * * Limiting case: prob == 1 is mass (1-p0m) at x = 1. */ double dzmgeom(double x, double prob, double p0m, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(prob) || ISNAN(p0m)) return x + prob + p0m; #endif if (prob <= 0 || prob > 1 || p0m < 0 || p0m > 1) return R_NaN; if (x < 0 || !R_FINITE(x)) return ACT_D__0; if (x == 0) return ACT_D_val(p0m); /* NOTE: from now on x > 0 */ /* limiting case as prob approaches one is point mass (1-p0m) at one */ if (prob == 1) return (x == 1) ? ACT_D_Clog(p0m) : ACT_D__0; return ACT_D_val((1 - p0m) * dgeom(x - 1, prob, /*give_log*/0)); } double pzmgeom(double x, double prob, double p0m, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(prob) || ISNAN(p0m)) return x + prob + p0m; #endif if (prob <= 0 || prob > 1 || p0m < 0 || p0m > 1) return R_NaN; if (x < 0) return ACT_DT_0; if (!R_FINITE(x)) return ACT_DT_1; if (x < 1) return ACT_DT_val(p0m); /* NOTE: from now on x >= 1 */ /* limiting case as prob approaches one is mass (1-p0m) at one */ if (prob == 1) return ACT_DT_1; /* working in log scale improves accuracy */ return ACT_DT_CEval(log1p(-p0m) + pgeom(x - 1, prob, /*l._t.*/0, /*log_p*/1)); } double qzmgeom(double x, double prob, double p0m, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(prob) || ISNAN(p0m)) return x + prob + p0m; #endif if (prob <= 0 || prob > 1 || p0m < 0 || p0m > 1) return R_NaN; /* limiting case as prob approaches one is mass (1-p0m) at one */ if (prob == 1) { /* simplified ACT_Q_P01_boundaries macro */ if (log_p) { if (x > 0) return R_NaN; return (x <= log(p0m)) ? 0.0 : 1.0; } else /* !log_p */ { if (x < 0 || x > 1) return R_NaN; return (x <= p0m) ? 0.0 : 1.0; } } ACT_Q_P01_boundaries(x, 1, R_PosInf); x = ACT_DT_qIv(x); /* working in log scale improves accuracy */ return qgeom(-expm1(log1p(-prob) - log1p(-p0m) + log1p(-x)), prob, /*l._t.*/1, /*log_p*/0); } /* ALGORITHM FOR GENERATION OF RANDOM VARIATES * * 1. p0m >= p0: just simulate variates from the discrete mixture. * * 2. p0m < p0: fastest method depends p0m. * * 2.1 p0m < ACT_INVERSION: inversion method on a restricted range. * * 2.2 p0m >= ACT_INVERSION: simulate variates from discrete mixture * with the corresponding zero truncated distribution. * * The threshold ACT_INVERSION is distribution specific. */ #define ACT_INVERSION 0.4 double rzmgeom(double prob, double p0m) { if (!R_FINITE(prob) || prob <= 0 || prob > 1 || p0m < 0 || p0m > 1) return R_NaN; /* limiting case as p approaches one is mass (1-p0m) at one */ if (prob == 1) return (unif_rand() <= p0m) ? 0.0 : 1.0; /* p0m >= prob: generate from mixture */ if (p0m >= prob) return (unif_rand() * (1 - prob) < (1 - p0m)) ? rgeom(prob) : 0.0; /* inversion method */ if (p0m < ACT_INVERSION) return qgeom(runif((prob - p0m)/(1 - p0m), 1), prob, 1, 0); /* generate from zero truncated mixture */ return (unif_rand() <= p0m) ? 0.0 : 1 + rpois(exp_rand() * ((1 - prob) / prob)); } actuar/src/randomphtype.c0000644000176200001440000001050414326564170015206 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to generate variates of phase-type distributions. This * file is based on random.c with the following modifications: * * 1. support for a matrix argument; * 2. no iteration over the parameters; * 3. support for two parameter distributions only; * 4. no support for integer random variates. * * For details, see random.c. * * AUTHOR: Vincent Goulet */ #include #include #include #include "actuar.h" #include "locale.h" /* Prototypes of auxiliary function */ static Rboolean randomphtype2(double (*f)(double *, double **, double *, int), double *, double *, int, double *, int); static Rboolean randomphtype2(double (*f)(double *, double **, double *, int), double *a, double *b, int na, double *x, int n) { int i, j; double *rates, **Q; Rboolean naflag = FALSE; /* The sub-intensity matrix and initial probability vector never * change, so compute the transition matrix of the underlying * Markov chain and the vector of rate parameters before * looping. */ rates = (double *) R_alloc(na, sizeof(double)); Q = (double **) R_alloc(na, sizeof(double)); for (i = 0; i < na; i++) { Q[i] = (double *) S_alloc(na, sizeof(double)); rates[i] = -b[i * (na + 1)]; for (j = 0; j < na; j++) if (i != j) Q[i][j] = b[i + j * na] / rates[i]; } for (i = 0; i < n; i++) { x[i] = f(a, Q, rates, na); if (!R_FINITE(x[i])) naflag = TRUE; } return(naflag); } #define RANDPHTYPE2(num, fun) \ case num: \ randomphtype2(fun, REAL(a), REAL(b), na, REAL(x), n); \ break /* The function below retains a 'type' argument that is not actually * used. This is to fit within the scheme of the other random * generation functions of random.c and names.c. */ SEXP actuar_do_randomphtype2(int code, SEXP args, SEXPTYPE type /* unused */) { SEXP x, a, b, bdims; int i, n, na, nrow, ncol; Rboolean naflag = FALSE; /* Check validity of arguments */ if (!isVector(CAR(args)) || !isNumeric(CADR(args)) || !isMatrix(CADDR(args))) error(_("invalid arguments")); /* Number of variates to generate */ if (LENGTH(CAR(args)) == 1) { n = asInteger(CAR(args)); if (n == NA_INTEGER || n < 0) error(_("invalid arguments")); } else n = LENGTH(CAR(args)); /* If n == 0, return numeric(0) */ PROTECT(x = allocVector(REALSXP, n)); if (n == 0) { UNPROTECT(1); return(x); } /* Sanity checks of arguments. */ PROTECT(a = coerceVector(CADR(args), REALSXP)); PROTECT(b = coerceVector(CADDR(args), REALSXP)); bdims = getAttrib(b, R_DimSymbol); nrow = INTEGER(bdims)[0]; ncol = INTEGER(bdims)[1]; if (nrow != ncol) error(_("non-square sub-intensity matrix")); na = LENGTH(a); if (na != nrow) error(_("non-conformable arguments")); /* If length of parameters < 1, or either of the two parameters * is NA return NA. */ if (na < 1 || (na == 1 && !(R_FINITE(REAL(a)[0]) && R_FINITE(REAL(b)[0])))) { for (i = 0; i < n; i++) REAL(x)[i] = NA_REAL; } /* Otherwise, dispatch to appropriate r* function */ else { naflag = FALSE; GetRNGstate(); switch (code) { RANDPHTYPE2(1, rphtype); default: error(_("internal error in actuar_do_randomphtype2")); } if (naflag) warning(R_MSG_NA); PutRNGstate(); } UNPROTECT(3); return x; } /* Main function, the only one used by .External(). */ SEXP actuar_do_randomphtype(SEXP args) { int i; const char *name; /* Extract distribution name */ args = CDR(args); name = CHAR(STRING_ELT(CAR(args), 0)); /* Dispatch to actuar_do_random{1,2,3,4} */ for (i = 0; random_tab[i].name; i++) if (!strcmp(random_tab[i].name, name)) return random_tab[i].cfun(random_tab[i].code, CDR(args), random_tab[i].type); /* No dispatch is an error */ error(_("internal error in actuar_do_randomphtype")); return args; /* never used; to keep -Wall happy */ } actuar/src/invgauss.c0000644000176200001440000002145714264305077014344 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the inverse gaussian distribution. See ../R/InverseGaussian.R * for details. * * We work with the density expressed as * * (2 pi phi x^3)^(-1/2) exp(- u^2/(2 phi x)) * * with u = (x - mu)/mu. * * The code for functions [dpqr]invgauss() is a C implementation of * functions of the same functions in package statmod; see: * * Giner, G. and Smyth, G. K. (2016), "statmod: Probability * Calculations for the Inverse Gaussian Distribution", R * Journal, vol. 8, no 1, p. 339-351. * https://journal.r-project.org/archive/2016-1/giner-smyth.pdf * * AUTHOR (original R implementation): Gordon Smyth * AUTHOR (C implementation): Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" double dinvgauss(double x, double mu, double phi, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(mu) || ISNAN(phi)) return x + mu + phi; #endif if (mu <= 0.0) return R_NaN; if (phi <= 0) { if (phi < 0) return R_NaN; /* phi == 0 */ return (x == 0.0) ? R_PosInf : ACT_D__0; } if (!R_FINITE(x) || x < 0.0) return ACT_D__0; /* limiting case phi = Inf: spike at zero */ if (x == 0) return R_FINITE(phi) ? ACT_D__0 : R_PosInf; /* limiting case mu = Inf: inverse chi-square distribution [a.k.a * inverse gamma with shape = 1/2, scale = 1/(2 * phi)] */ if (!R_FINITE(mu)) return ACT_D_exp(-(log(phi) + 3 * log(x) + 1/phi/x)/2 - M_LN_SQRT_2PI); /* standard cases */ x = x/mu; phi = phi * mu; return ACT_D_exp(-(log(phi) + 3 * log(x) + R_pow_di(x - 1, 2)/phi/x)/2 - M_LN_SQRT_2PI - log(mu)); } double pinvgauss(double q, double mu, double phi, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(mu) || ISNAN(phi)) return q + mu + phi; #endif if (mu <= 0.0) return R_NaN; if (phi <= 0) { if (phi < 0) return R_NaN; /* phi == 0 : */ return (q == 0) ? ACT_DT_0 : ACT_DT_1; } if (q < 0) return ACT_DT_0; /* limiting case phi = Inf */ if (q == 0) return R_FINITE(phi) ? ACT_DT_0 : ACT_DT_1; if (!R_FINITE(q)) return ACT_DT_1; /* limiting case mu = Inf */ if (!R_FINITE(mu)) return pchisq(1/q/phi, 1, !lower_tail, log_p); /* standard cases */ double qm = q/mu; double phim = phi * mu; /* approximation for (survival) probabilities in the far right tail */ if (!lower_tail && qm > 1e6) { double r = qm/2/phim; if (r > 5e5) return ACT_D_exp(1/phim - M_LN_SQRT_PI - log(2*phim) - 1.5 * log1p(r) - r); } /* all other probabilities */ double r = sqrt(q * phi); double a = pnorm((qm - 1)/r, 0, 1, lower_tail, /* log_p */1); double b = 2/phim + pnorm(-(qm + 1)/r, 0, 1, /* l._t. */1, /* log_p */1); return ACT_D_exp(a + (lower_tail ? log1p(exp(b - a)) : ACT_Log1_Exp(b - a))); } /* This is used in nrstep() to return either dx or -dx. */ #define ACT_S_val(x) (lower_tail ? x : -x) /* Needed by qinvgauss() for Newton-Raphson iterations. */ double nrstep(double x, double p, double logp, double phi, int lower_tail) { double logF = pinvgauss(x, 1, phi, lower_tail, /*log.p*/1); double dlogp = logp - logF; return ACT_S_val(((fabs(dlogp) < 1e-5) ? dlogp * exp(logp + log1p(-dlogp/2)) : p - exp(logF)) / dinvgauss(x, 1, phi, 0)); } double qinvgauss(double p, double mu, double phi, int lower_tail, int log_p, double tol, int maxit, int echo) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(mu) || ISNAN(phi)) return p + mu + phi; #endif if (mu <= 0.0 || phi <= 0.0) return R_NaN; /* limiting case phi = Inf */ if (!R_FINITE(phi)) return 1.0; /* limiting case mu = Inf */ if (!R_FINITE(mu)) return 1/phi/qchisq(p, 1, !lower_tail, log_p); ACT_Q_P01_boundaries(p, 0, R_PosInf); /* must be able to do at least one iteration */ if (maxit < 1) error(_("maximum number of iterations must be at least 1")); int i = 1; double logp, kappa, mode, x, dx, s; /* make sure we have both p and log(p) for the sequel */ if (log_p) { logp = p; p = exp(p); } else logp = log(p); /* convert to mean = 1 */ phi *= mu; /* mode */ kappa = 1.5 * phi; if (kappa <= 1e3) mode = sqrt(1 + kappa * kappa) - kappa; else /* Taylor series correction */ { double k = 1.0/2.0/kappa; mode = k * (1 - k * k); } /* starting value: inverse chi squared for small left tail prob; * qgamma for small right tail prob; mode otherwise */ if (logp < -11.51) x = lower_tail ? 1/phi/R_pow_di(qnorm(logp, 0, 1, lower_tail, 1), 2) : qgamma(logp, 1/phi, phi, lower_tail, 1); else if (logp > -1e-5) x = lower_tail ? qgamma(logp, 1/phi, phi, lower_tail, 1) : 1/phi/R_pow_di(qnorm(logp, 0, 1, lower_tail, 1), 2); else x = mode; /* if echoing iterations, start by printing the header and the * first value */ if (echo) Rprintf("iter\tadjustment\tquantile\n%d\t ---- \t%.8g\n", 0, x); /* first Newton-Raphson outside the loop to retain the sign of * the adjustment */ dx = nrstep(x, p, logp, phi, lower_tail); s = sign(dx); x += dx; if (echo) Rprintf("%d\t%-14.8g\t%.8g\n", i, dx, x); /* now do the iterations */ do { i++; if (i > maxit) { warning(_("maximum number of iterations reached before obtaining convergence")); break; } dx = nrstep(x, p, logp, phi, lower_tail); /* change of sign indicates that machine precision has been overstepped */ if (dx * s < 0) dx = 0; else x += dx; if (echo) Rprintf("%d\t%-14.8g\t%.8g\n", i, dx, x); } while (fabs(dx) > tol); return x * mu; } double rinvgauss(double mu, double phi) { if (mu <= 0.0 || phi <= 0.0) return R_NaN; /* limiting case phi = Inf */ if (!R_FINITE(phi)) return 0.0; /* limiting case mu = Inf */ if (!R_FINITE(mu)) return 1/phi/rchisq(1); /* convert to mean = 1 */ phi *= mu; double y = R_pow_di(rnorm(0, 1), 2); double x = 1 + phi/2 * (y - sqrt(4 * y/phi + R_pow_di(y, 2))); return mu * ((unif_rand() <= 1/(1 + x)) ? x : 1/x); } double minvgauss(double order, double mu, double phi, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(mu) || ISNAN(phi)) return order + mu + phi; #endif if (mu <= 0.0 || phi <= 0.0 || order < 0 || ACT_nonint(order)) return R_NaN; /* trivial case */ if (order == 0.0) return 0.0; /* limiting case phi = Inf */ if (!R_FINITE(phi)) return 0.0; /* limiting case mu = Inf */ /* [no finite strictly positive, integer moments] */ if (!R_FINITE(mu)) return R_PosInf; int i, k = order; double term, s, phir = phi * mu/2; s = term = 1.0; /* first term (i = 0) */ for (i = 1; i < k; i++) { term *= ((k + i - 1) * (k - i)/i) * phir; s += term; } return R_pow_di(mu, k) * s; } /* The lev function is very similar to the pdf. It can be written as * * levinvgauss(x; mu, phi) = mu [pnorm((xm - 1)/r) * - exp(2/phim) pnorm(-(xm + 1)/r)] * + x (1 - pinvgauss(x; mu, phi) * * where xm = x/mu, phim = phi * mu, r = sqrt(x * phi). */ double levinvgauss(double limit, double mu, double phi, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(mu) || ISNAN(phi) || ISNAN(order)) return limit + mu + phi + order; #endif if (mu <= 0.0 || phi < 0.0 || order != 1.0) return R_NaN; if (limit <= 0.0 || !R_FINITE(phi)) return 0.0; if (!R_FINITE(limit) || !R_FINITE(mu)) return mu; /* calculations very similar to those in pinvgauss(); we do * everything here and avoid calling the latter */ double xm = limit/mu, phim = phi * mu, r = sqrt(limit * phi); double x = (xm - 1)/r; double a = pnorm(x, 0, 1, /*l._t.*/1, /* log_p */1); double ap = pnorm(x, 0, 1, /*l._t.*/0, /* log_p */1); double b = 2/phim + pnorm(-(xm + 1)/r, 0, 1, /* l._t. */1, /* log_p */1); return mu * exp(a + ACT_Log1_Exp(b - a)) + limit * exp(ap + ACT_Log1_Exp(b - ap)); } double mgfinvgauss(double t, double mu, double phi, int give_log) { #ifdef IEEE_754 if (ISNAN(t) || ISNAN(mu) || ISNAN(phi)) return t + mu + phi; #endif if (mu <= 0.0 || phi < 0.0 || t > 1/phi/(2.0 * mu * mu)) return R_NaN; /* trivial case */ if (t == 0.0) return ACT_D__1; /* limiting case phi = Inf */ if (!R_FINITE(phi)) return ACT_D__0; /* limiting case mu = Inf */ if (!R_FINITE(mu)) return R_PosInf; /* convert to mean = 1 */ phi *= mu; t *= mu; return ACT_D_exp((1 - sqrt(1 - 2 * phi * t))/phi); } actuar/src/unif.c0000644000176200001440000000366714264305077013451 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to calculate raw and limited moments for the Uniform * distribution. See ../R/UniformSupp.R for details. * * AUTHORS: Christophe Dutang and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" double munif(double order, double min, double max, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(min) || ISNAN(max)) return order + min + max; #endif if (!R_FINITE(min) || !R_FINITE(max) || min >= max) return R_NaN; if (order == -1.0) return (log(fabs(max)) - log(fabs(min))) / (max - min); double tmp = order + 1; return (R_pow(max, tmp) - R_pow(min, tmp)) / ((max - min) * tmp); } double levunif(double limit, double min, double max, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(min) || ISNAN(max) || ISNAN(order)) return limit + min + max + order; #endif if (!R_FINITE(min) || !R_FINITE(max) || min >= max) return R_NaN; if (limit <= min) return R_pow(limit, order); if (limit >= max) return munif(order, min, max, give_log); if (order == -1.0) return (log(fabs(limit)) - log(fabs(min))) / (max - min) + (max - limit) / (limit * (max - min)); double tmp = order + 1; return (R_pow(limit, tmp) - R_pow(min, tmp)) / ((max - min) * tmp) + R_pow(limit, order) * (max - limit) / (max - min); } double mgfunif(double t, double min, double max, int give_log) { #ifdef IEEE_754 if (ISNAN(t) || ISNAN(min) || ISNAN(max)) return t + min + max; #endif if (!R_FINITE(min) || !R_FINITE(max) || min >= max) return R_NaN; if (t == 0.0) return ACT_D__1; double tmp1, tmp2; tmp1 = exp(t * max) - exp(t * min); tmp2 = t * (max - min); return ACT_D_exp(log(tmp1) - log(tmp2)); } actuar/src/invburr.c0000644000176200001440000001070314264305077014164 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the inverse Burr distribution. See ../R/InverseBurr.R for details. * * We work with the density expressed as * * shape1 * shape2 * u^shape1 * (1 - u) / x * * with u = v/(1 + v) = 1/(1 + 1/v), v = (x/scale)^shape2. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dinvburr(double x, double shape1, double shape2, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return x + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (!R_FINITE(x) || x < 0.0) return ACT_D__0; /* handle x == 0 separately */ if (x == 0.0) { if (shape1 * shape2 < 1) return R_PosInf; if (shape1 * shape2 > 1) return ACT_D__0; /* else */ return ACT_D_val(1.0/scale); } double logv, logu, log1mu; logv = shape2 * (log(x) - log(scale)); logu = - log1pexp(-logv); log1mu = - log1pexp(logv); return ACT_D_exp(log(shape1) + log(shape2) + shape1 * logu + log1mu - log(x)); } double pinvburr(double q, double shape1, double shape2, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return q + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (q <= 0) return ACT_DT_0; double u = exp(-log1pexp(shape2 * (log(scale) - log(q)))); return ACT_DT_val(R_pow(u, shape1)); } double qinvburr(double p, double shape1, double shape2, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return p + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; ACT_Q_P01_boundaries(p, 0, R_PosInf); p = ACT_D_qIv(p); return scale * R_pow(R_pow(ACT_D_Lval(p), -1.0/shape1) - 1.0, -1.0/shape2); } double rinvburr(double shape1, double shape2, double scale) { if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; return scale * R_pow(R_pow(unif_rand(), -1.0/shape1) - 1.0, -1.0/shape2); } double minvburr(double order, double shape1, double shape2, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return order + shape1 + shape2 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (order <= - shape1 * shape2 || order >= shape2) return R_PosInf; double tmp = order / shape2; return R_pow(scale, order) * gammafn(shape1 + tmp) * gammafn(1.0 - tmp) / gammafn(shape1); } double levinvburr(double limit, double shape1, double shape2, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale) || ISNAN(order)) return limit + shape1 + shape2 + scale + order; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -shape1 * shape2) return R_PosInf; if (limit <= 0.0) return 0.0; double logv, u, u1m; double tmp = order / shape2; logv = shape2 * (log(limit) - log(scale)); u = exp(-log1pexp(-logv)); u1m = exp(-log1pexp(logv)); return R_pow(scale, order) * betaint_raw(u, shape1 + tmp, 1.0 - tmp, u1m) / gammafn(shape1) + ACT_DLIM__0(limit, order) * (0.5 - R_pow(u, shape1) + 0.5); } actuar/src/genbeta.c0000644000176200001440000001364114264305077014106 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the generalized beta distribution. See ../R/GeneralizedBeta.R * for details. * * We work with the density expressed as * * shape3 * u^shape1 * (1 - u)^(shape2 - 1) / (x * beta(shape1, shape2)) * * with u = (x/scale)^shape3. * * Code for limiting cases derived from .../src/nmath/dbeta.c from R * sources. * * AUTHOR: Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" double dgenbeta(double x, double shape1, double shape2, double shape3, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(shape3) || ISNAN(scale)) return x + shape1 + shape2 + shape3 + scale; #endif if (shape1 < 0.0 || shape2 < 0.0 || shape3 < 0.0 || scale <= 0.0) return R_NaN; if (x < 0.0 || x > scale) return ACT_D__0; /* limiting cases for (shape1 * shape3, shape2), leading to point masses */ double psh = shape1 * shape3; if (psh == 0.0 || shape2 == 0.0 || !R_FINITE(psh) || !R_FINITE(shape2)) { /* shape1 or shape3 = 0, shape2 = 0: point mass 1/2 at endpoints */ if (psh == 0.0 && shape2 == 0.0) return (x == 0 || x == scale) ? R_PosInf : ACT_D__0; /* shape1 or shape3 = 0, shape2 != 0: point mass 1 at 0 */ if (psh == 0.0 || psh/shape2 == 0.0) return (x == 0.0) ? R_PosInf : ACT_D__0; /* shape2 = 0, shape1 and shape3 != 0: point mass 1 at scale */ if (shape2 == 0.0 || shape2/psh == 0.0) return (x == scale) ? R_PosInf : ACT_D__0; /* remaining cases: shape1 or shape3 = Inf, shape2 = Inf */ if (R_FINITE(shape3)) /* shape3 < Inf: point mass 1 at midpoint */ return (x == scale/2.0) ? R_PosInf : ACT_D__0; else /* shape3 = Inf: point mass at scale */ return (x == scale) ? R_PosInf : ACT_D__0; } if (x == 0.0) { if (psh > 1) return(ACT_D__0); if (psh < 1) return(R_PosInf); /* psh == 1 : */ return(ACT_D_val(shape3/beta(shape1, shape2))); } if (x == scale) { if (shape2 > 1) return(ACT_D__0); if (shape2 < 1) return(R_PosInf); /* shape2 == 1 : */ return(ACT_D_val(shape1 * shape3)); } double logu, log1mu; logu = shape3 * (log(x) - log(scale)); log1mu = log1p(-exp(logu)); return ACT_D_exp(log(shape3) + shape1 * logu + (shape2 - 1.0) * log1mu - log(x) - lbeta(shape1, shape2)); } double pgenbeta(double q, double shape1, double shape2, double shape3, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(shape3) || ISNAN(scale)) return q + shape1 + shape2 + shape3 + scale; #endif if (shape1 < 0.0 || shape2 < 0.0 || shape3 < 0.0 || scale <= 0.0) return R_NaN; if (q <= 0) return ACT_DT_0; if (q >= scale) return ACT_DT_1; double u = exp(shape3 * (log(q) - log(scale))); return pbeta(u, shape1, shape2, lower_tail, log_p); } double qgenbeta(double p, double shape1, double shape2, double shape3, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(shape3) || ISNAN(scale)) return p + shape1 + shape2 + shape3 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(shape3) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || shape3 <= 0.0 || scale <= 0.0) return R_NaN; ACT_Q_P01_boundaries(p, 0, scale); p = ACT_D_qIv(p); return scale * R_pow(qbeta(p, shape1, shape2, lower_tail, 0), 1.0/shape3); } double rgenbeta(double shape1, double shape2, double shape3, double scale) { if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(shape3) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || shape3 <= 0.0 || scale <= 0.0) return R_NaN; return scale * R_pow(rbeta(shape1, shape2), 1.0/shape3); } double mgenbeta(double order, double shape1, double shape2, double shape3, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(shape3) || ISNAN(scale)) return order + shape1 + shape2 + shape3 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(shape3) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || shape3 <= 0.0 || scale <= 0.0) return R_NaN; if (order <= - shape1 * shape3) return R_PosInf; double tmp = order / shape3; return R_pow(scale, order) * beta(shape1 + tmp, shape2) / beta(shape1, shape2); } double levgenbeta(double limit, double shape1, double shape2, double shape3, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(shape3) || ISNAN(scale) || ISNAN(order)) return limit + shape1 + shape2 + shape3 + scale + order; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(shape3) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || shape3 <= 0.0 || scale <= 0.0) return R_NaN; if (order <= - shape1 * shape3) return R_PosInf; if (limit <= 0.0) return 0.0; double u, tmp; tmp = order / shape3; u = exp(shape3 * (log(limit) - log(scale))); return R_pow(scale, order) * beta(shape1 + tmp, shape2) / beta(shape1, shape2) * pbeta(u, shape1 + tmp, shape2, 1, 0) + ACT_DLIM__0(limit, order) * pbeta(u, shape1, shape2, 0, 0); } actuar/src/zmnbinom.c0000644000176200001440000001421114264305077014324 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute probability function, cumulative distribution * and quantile functions, and to simulate random variates for the * zero-modified negative binomial distribution. See * ../R/ZeroModifiedNegativeBinomial.R for details. * * Zero-modified distributions are discrete mixtures between a * degenerate distribution at zero and the corresponding, * non-modified, distribution. As a mixture, they have density * * Pr[Z = x] = [1 - (1 - p0m)/(1 - p0)] 1(x) * + [(1 - p0m)/(1 - p0)] Pr[X = 0], * * where p0 = Pr[X = 0]. The density can also be expressed as * Pr[Z = 0] = p0m and * * Pr[Z = x] = (1 - p0m) * Pr[X = x]/(1 - Pr[X = 0]), * * for x = 1, 2, ... The distribution function is, for all x, * * Pr[Z <= x] = 1 - (1 - p0m) * (1 - Pr[X <= x])/(1 - p0). * * AUTHOR: Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" /* The negative binomial distribution has p0 = prob^size. * * Limiting cases: * * 1. size == 0 is Zero Modified Logarithmic(1 - prob) (according to * the standard parametrization of the logarithmic distribution * used by {d,p,q,r}logarithmic(); * 2. prob == 1 is mass (1-p0) at x = 1. */ double dzmnbinom(double x, double size, double prob, double p0m, int give_log) { /* We compute Pr[X = 0] with dbinom_raw() [as would eventually * dnbinom()] to take advantage of all the optimizations for * small/large values of 'prob' and 'size' (and also to skip some * validity tests). */ #ifdef IEEE_754 if (ISNAN(x) || ISNAN(size) || ISNAN(prob) || ISNAN(p0m)) return x + size + prob + p0m; #endif if (prob <= 0 || prob > 1 || size < 0 || p0m < 0 || p0m > 1) return R_NaN; if (x < 0 || !R_FINITE(x)) return ACT_D__0; if (x == 0) return ACT_D_val(p0m); /* NOTE: from now on x > 0 */ /* limiting case as size approaches zero is zero modified logarithmic */ if (size == 0) return dzmlogarithmic(x, 1 - prob, p0m, give_log); /* limiting case as prob approaches one is mass (1-p0m) at one */ if (prob == 1) return (x == 1) ? ACT_D_Clog(p0m) : ACT_D__0; double lp0 = dbinom_raw(size, size, prob, 1 - prob, /*give_log*/1); return ACT_D_val((1 - p0m) * dnbinom(x, size, prob, /*give_log*/0) / (-expm1(lp0))); } double pzmnbinom(double x, double size, double prob, double p0m, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(size) || ISNAN(prob) || ISNAN(p0m)) return x + size + prob + p0m; #endif if (prob <= 0 || prob > 1 || size < 0 || p0m < 0 || p0m > 1) return R_NaN; if (x < 0) return ACT_DT_0; if (!R_FINITE(x)) return ACT_DT_1; if (x < 1) return ACT_DT_val(p0m); /* NOTE: from now on x >= 1 */ /* simple case for all x >= 1 */ if (p0m == 1) return ACT_DT_1; /* limiting case as size approaches zero is zero modified logarithmic */ if (size == 0) return pzmlogarithmic(x, 1 - prob, p0m, lower_tail, log_p); /* limiting case as prob approaches one is mass (1-p0m) at one */ if (prob == 1) return ACT_DT_1; double lp0 = dbinom_raw(size, size, prob, 1 - prob, /*give_log*/1); /* working in log scale improves accuracy */ return ACT_DT_CEval(log1p(-p0m) + pnbinom(x, size, prob, /*l._t.*/0, /*log_p*/1) - log1mexp(-lp0)); } double qzmnbinom(double x, double size, double prob, double p0m, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(size) || ISNAN(prob) || ISNAN(p0m)) return x + size + prob + p0m; #endif if (prob <= 0 || prob > 1 || size < 0 || p0m < 0 || p0m > 1) return R_NaN; /* limiting case as size approaches zero is zero modified logarithmic */ if (size == 0) return qzmlogarithmic(x, 1 - prob, p0m, lower_tail, log_p); /* limiting case as prob approaches one is mass (1-p0m) at one */ if (prob == 1) { /* simplified ACT_Q_P01_boundaries macro */ if (log_p) { if (x > 0) return R_NaN; return (x <= log(p0m)) ? 0.0 : 1.0; } else /* !log_p */ { if (x < 0 || x > 1) return R_NaN; return (x <= p0m) ? 0.0 : 1.0; } } ACT_Q_P01_boundaries(x, 0, R_PosInf); x = ACT_DT_qIv(x); /* working in log scale improves accuracy */ double lp0 = dbinom_raw(size, size, prob, 1 - prob, /*give_log*/1); return qnbinom(-expm1(log1mexp(-lp0) - log1p(-p0m) + log1p(-x)), size, prob, /*l._t.*/1, /*log_p*/0); } /* ALGORITHM FOR GENERATION OF RANDOM VARIATES * * 1. p0m >= p0: just simulate variates from the discrete mixture. * * 2. p0m < p0: fastest method depends on the difference p0 - p0m. * * 2.1 p0 - p0m < ACT_DIFFMAX_REJECTION: rejection method with an * envelope that differs from the target distribution at zero * only. In other words: rejection only at zero. * 2.2 p0 - p0m >= ACT_DIFFMAX_REJECTION: simulate variates from * discrete mixture with the corresponding zero truncated * distribution. * * The threshold ACT_DIFFMAX_REJECTION is distribution specific. */ #define ACT_DIFFMAX_REJECTION 0.6 double rzmnbinom(double size, double prob, double p0m) { if (!R_FINITE(prob) || prob <= 0 || prob > 1 || size < 0 || p0m < 0 || p0m > 1) return R_NaN; /* limiting case as size approaches zero is zero modified logarithmic */ if (size == 0) return rzmlogarithmic(1 - prob, p0m); /* limiting case as prob approaches one is mass (1-p0m) at one */ if (prob == 1) return (unif_rand() <= p0m) ? 0.0 : 1.0; double x, p0 = dbinom_raw(size, size, prob, 1 - prob, /*give_log*/0); /* p0m >= p0: generate from mixture */ if (p0m >= p0) return (unif_rand() * (1 - p0) < (1 - p0m)) ? rnbinom(size, prob) : 0.0; /* p0m < p0: choice of algorithm depends on difference p0 - p0m */ if (p0 - p0m < ACT_DIFFMAX_REJECTION) { /* rejection method */ for (;;) { x = rnbinom(size, prob); if (x != 0 || /* x == 0 and */ runif(0, p0 * (1 - p0m)) <= (1 - p0) * p0m) return x; } } else { /* generate from zero truncated mixture */ return (unif_rand() <= p0m) ? 0.0 : qnbinom(runif(p0, 1), size, prob, /*l._t.*/1, /*log_p*/0); } } actuar/src/panjer.c0000644000176200001440000001472414264305077013763 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Function to compute the recursive part of the Panjer formula * to approximate the aggregate claim amount distribution of * a portfolio over a period. * * AUTHORS: Tommy Ouellet, Vincent Goulet */ #include #include #include #include "locale.h" #define CAD5R(e) CAR(CDR(CDR(CDR(CDR(CDR(e)))))) #define CAD6R(e) CAR(CDR(CDR(CDR(CDR(CDR(CDR(e))))))) #define CAD7R(e) CAR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(e)))))))) #define CAD8R(e) CAR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(e))))))))) #define CAD9R(e) CAR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(e)))))))))) #define CAD10R(e) CAR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(CDR(e))))))))))) #define INITSIZE 100 /* default size for prob. vector */ SEXP actuar_do_panjer(SEXP args) { SEXP p0, p1, fs0, sfx, a, b, conv, tol, maxit, echo, sfs; double *fs, *fx, cumul; int upper, m, k, n, x = 1; double norm; /* normalizing constant */ double term; /* constant in the (a, b, 1) case */ /* The length of vector fs is not known in advance. We opt for a * simple scheme: allocate memory for a vector of size 'size', * double the size when the vector is full. */ int size = INITSIZE; fs = (double *) S_alloc(size, sizeof(double)); /* All values received from R are then protected. */ PROTECT(p0 = coerceVector(CADR(args), REALSXP)); PROTECT(p1 = coerceVector(CADDR(args), REALSXP)); PROTECT(fs0 = coerceVector(CADDDR(args), REALSXP)); PROTECT(sfx = coerceVector(CAD4R(args), REALSXP)); PROTECT(a = coerceVector(CAD5R(args), REALSXP)); PROTECT(b = coerceVector(CAD6R(args), REALSXP)); PROTECT(conv = coerceVector(CAD7R(args), INTSXP)); PROTECT(tol = coerceVector(CAD8R(args), REALSXP)); PROTECT(maxit = coerceVector(CAD9R(args), INTSXP)); PROTECT(echo = coerceVector(CAD10R(args), LGLSXP)); /* Initialization of some variables */ fx = REAL(sfx); /* severity distribution */ upper = length(sfx) - 1; /* severity distribution support upper bound */ fs[0] = REAL(fs0)[0]; /* value of Pr[S = 0] (computed in R) */ cumul = REAL(fs0)[0]; /* cumulative probability computed */ norm = 1 - REAL(a)[0] * fx[0]; /* normalizing constant */ n = INTEGER(conv)[0]; /* number of convolutions to do */ /* If printing of recursions was asked for, start by printing a * header and the probability at 0. */ if (LOGICAL(echo)[0]) Rprintf("x\tPr[S = x]\tCumulative probability\n%d\t%.8g\t%.8g\n", 0, fs[0], fs[0]); /* (a, b, 0) case (if p0 is NULL) */ if (isNull(CADR(args))) do { /* Stop after 'maxit' recursions and issue warning. */ if (x > INTEGER(maxit)[0]) { warning(_("maximum number of recursions reached before the probability distribution was complete")); break; } /* If fs is too small, double its size */ if (x >= size) { fs = (double *) S_realloc((char *) fs, size << 1, size, sizeof(double)); size = size << 1; } m = x; if (x > upper) m = upper; /* upper bound of the sum */ /* Compute probability up to the scaling constant */ for (k = 1; k <= m; k++) fs[x] += (REAL(a)[0] + REAL(b)[0] * k / x) * fx[k] * fs[x - k]; fs[x] = fs[x]/norm; /* normalization */ cumul += fs[x]; /* cumulative sum */ if (LOGICAL(echo)[0]) Rprintf("%d\t%.8g\t%.8g\n", x, fs[x], cumul); x++; } while (cumul < REAL(tol)[0]); /* (a, b, 1) case (if p0 is non-NULL) */ else { /* In the (a, b, 1) case, the recursion formula has an * additional term involving f_X(x). The mathematical notation * assumes that f_X(x) = 0 for x > m (the maximal value of the * distribution). We need to treat this specifically in * programming, though. */ double fxm; /* Constant term in the (a, b, 1) case. */ term = (REAL(p1)[0] - (REAL(a)[0] + REAL(b)[0]) * REAL(p0)[0]); do { /* Stop after 'maxit' recursions and issue warning. */ if (x > INTEGER(maxit)[0]) { warning(_("maximum number of recursions reached before the probability distribution was complete")); break; } if (x >= size) { fs = (double *) S_realloc((char *) fs, size << 1, size, sizeof(double)); size = size << 1; } m = x; if (x > upper) { m = upper; /* upper bound of the sum */ fxm = 0.0; /* i.e. no additional term */ } else fxm = fx[m]; /* i.e. additional term */ for (k = 1; k <= m; k++) fs[x] += (REAL(a)[0] + REAL(b)[0] * k / x) * fx[k] * fs[x - k]; fs[x] = (fs[x] + fxm * term) / norm; cumul += fs[x]; if (LOGICAL(echo)[0]) Rprintf("%d\t%.8g\t%.8g\n", x, fs[x], cumul); x++; } while (cumul < REAL(tol)[0]); } /* If needed, convolve the distribution obtained above with itself * using a very simple direct technique. Since we want to * continue storing the distribution in array 'fs', we need to * copy the vector in an auxiliary array at each convolution. */ if (n) { int i, j, ox; double *ofs; /* auxiliary array */ /* Resize 'fs' to its final size after 'n' convolutions. Each * convolution increases the length from 'x' to '2 * x - 1'. */ fs = (double *) S_realloc((char *) fs, (1 << n) * (x - 1) + 1, size, sizeof(double)); /* Allocate enough memory in the auxiliary array for the 'n' * convolutions. This is just slightly over half the final * size of 'fs'. */ ofs = (double *) S_alloc((1 << (n - 1)) * (x - 1) + 1, sizeof(double)); for (k = 0; k < n; k++) { memcpy(ofs, fs, x * sizeof(double)); /* keep previous array */ ox = x; /* previous array length */ x = (x << 1) - 1; /* new array length */ for(i = 0; i < x; i++) fs[i] = 0.0; for(i = 0; i < ox; i++) for(j = 0; j < ox; j++) fs[i + j] += ofs[i] * ofs[j]; } } /* Copy the values of fs to a SEXP which will be returned to R. */ PROTECT(sfs = allocVector(REALSXP, x)); memcpy(REAL(sfs), fs, x * sizeof(double)); UNPROTECT(11); return(sfs); } actuar/src/pareto4.c0000644000176200001440000001433314264305077014056 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the Pareto (type) IV distribution. See ../R/Pareto4.R for * details. * * We work with the density expressed as * * shape1 * shape2 * u^shape1 * (1 - u) / (x - min) * * with u = 1/(1 + v), v = ((x - min)/scale)^shape2. * * AUTHORS: Nicholas Langevin and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dpareto4(double x, double min, double shape1, double shape2, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(min) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return x + min + shape1 + shape2 + scale; #endif if (!R_FINITE(min) || !R_FINITE(shape1) || !R_FINITE(shape2) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (!R_FINITE(x) || x < min) return ACT_D__0; /* handle (x - min) == 0 separately */ if (x == min) { if (shape2 < 1) return R_PosInf; if (shape2 > 1) return ACT_D__0; /* else */ return ACT_D_val(shape1 / scale); } double logv, logu, log1mu; logv = shape2 * (log(x - min) - log(scale)); logu = - log1pexp(logv); log1mu = - log1pexp(-logv); return ACT_D_exp(log(shape1) + log(shape2) + shape1 * logu + log1mu - log(x - min)); } double ppareto4(double q, double min, double shape1, double shape2, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(min) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return q + min + shape1 + shape2 + scale; #endif if (!R_FINITE(min) || !R_FINITE(shape1) || !R_FINITE(shape2) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (q <= min) return ACT_DT_0; double u = exp(-log1pexp(shape2 * (log(q - min) - log(scale)))); return ACT_DT_Cval(R_pow(u, shape1)); } double qpareto4(double p, double min, double shape1, double shape2, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(min) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return p + min + shape1 + shape2 + scale; #endif if (!R_FINITE(min) || !R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; ACT_Q_P01_boundaries(p, min, R_PosInf); p = ACT_D_qIv(p); return min + scale * R_pow(R_pow(ACT_D_Cval(p), -1.0/shape1) - 1.0, 1.0/shape2); } double rpareto4(double min, double shape1, double shape2, double scale) { if (!R_FINITE(min) || !R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; return min + scale * R_pow(R_pow(unif_rand(), -1.0/shape1) - 1.0, 1.0/shape2); } double mpareto4(double order, double min, double shape1, double shape2, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(min) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale)) return order + min + shape1 + shape2 + scale; #endif if (!R_FINITE(min) || !R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; /* The case min = 0 is a Burr with a larger range of admissible * values for order: - shape2 < order < shape1 * shape2. */ if (min == 0.0) return mburr(order, shape1, shape2, scale, give_log); /* From now on min != 0 and order must be a stricly non negative * integer < shape1 * shape2. */ if (order < 0.0) return R_NaN; if (order >= shape1 * shape2) return R_PosInf; int i; double order0 = order; double tmp, sum, r = scale/min; double Ga = gammafn(shape1); if (ACT_nonint(order)) { order = ACT_forceint(order); warning(_("'order' (%.2f) must be integer, rounded to %.0f"), order0, order); } sum = Ga; /* first term in the sum */ for (i = 1; i <= order; i++) { tmp = i/shape2; sum += choose(order, i) * R_pow(r, i) * gammafn(1.0 + tmp) * gammafn(shape1 - tmp); } /* The first term of the sum is always min^order. */ return R_pow(min, order) * sum / Ga; } double levpareto4(double limit, double min, double shape1, double shape2, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(min) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(scale) || ISNAN(order)) return limit + min + shape1 + shape2 + scale + order; #endif if (!R_FINITE(min) || !R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || scale <= 0.0) return R_NaN; if (limit <= min) return 0.0; /* The case min = 0 is a Burr with a larger range of admissible * values for order: order > - shape2. */ if (min == 0.0) return levburr(limit, shape1, shape2, scale, order, give_log); /* From now on min != 0 and order must be a stricly non negative * integer. */ if (order < 0.0) return R_NaN; int i; double order0 = order; double logv, u, u1m; double tmp, sum, r = scale / min; logv = shape2 * (log(limit - min) - log(scale)); u = exp(-log1pexp(logv)); u1m = exp(-log1pexp(-logv)); if (ACT_nonint(order)) { order = ACT_forceint(order); warning(_("'order' (%.2f) must be integer, rounded to %.0f"), order0, order); } sum = betaint_raw(u1m, 1.0, shape1, u); /* first term in the sum */ for (i = 1; i <= order; i++) { tmp = i / shape2; sum += choose(order, i) * R_pow(r, i) * betaint_raw(u1m, 1.0 + tmp, shape1 - tmp, u); } return R_pow(min, order) * sum / gammafn(shape1) + ACT_DLIM__0(limit, order) * R_pow(u, shape1); } actuar/src/paralogis.c0000644000176200001440000000746014264305077014464 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the paralogistic distribution. See ../R/Paralogistic.R for * details. * * We work with the density expressed as * * shape^2 * u^shape * (1 - u) / x * * with u = 1/(1 + v), v = (x/scale)^shape. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dparalogis(double x, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(shape) || ISNAN(scale)) return x + shape + scale; #endif if (!R_FINITE(shape) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (!R_FINITE(x) || x < 0.0) return ACT_D__0; /* handle x == 0 separately */ if (x == 0.0) { if (shape < 1) return R_PosInf; if (shape > 1) return ACT_D__0; /* else */ return ACT_D_val(1.0/scale); } double logv, logu, log1mu; logv = shape * (log(x) - log(scale)); logu = - log1pexp(logv); log1mu = - log1pexp(-logv); return ACT_D_exp(2.0 * log(shape) + shape * logu + log1mu - log(x)); } double pparalogis(double q, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(shape) || ISNAN(scale)) return q + shape + scale; #endif if (!R_FINITE(shape) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (q <= 0) return ACT_DT_0; double u = exp(-log1pexp(shape * (log(q) - log(scale)))); return ACT_DT_Cval(R_pow(u, shape)); } double qparalogis(double p, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(shape) || ISNAN(scale)) return p + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN; ACT_Q_P01_boundaries(p, 0, R_PosInf); p = ACT_D_qIv(p); double tmp = 1.0/shape; return scale * R_pow(R_pow(ACT_D_Cval(p), -tmp) - 1.0, tmp); } double rparalogis(double shape, double scale) { double tmp; if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN; tmp = 1.0/shape; return scale * R_pow(R_pow(unif_rand(), -tmp) - 1.0, tmp); } double mparalogis(double order, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape) || ISNAN(scale)) return order + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -shape || order >= shape * shape) return R_PosInf; double tmp = order / shape; return R_pow(scale, order) * gammafn(1.0 + tmp) * gammafn(shape - tmp) / gammafn(shape); } double levparalogis(double limit, double shape, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape) || ISNAN(scale) || ISNAN(order)) return limit + shape + scale + order; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (order <= -shape) return R_PosInf; if (limit <= 0.0) return 0.0; double logv, u, u1m; double tmp = order / shape; logv = shape * (log(limit) - log(scale)); u = exp(-log1pexp(logv)); u1m = exp(-log1pexp(-logv)); return R_pow(scale, order) * betaint_raw(u1m, 1.0 + tmp, shape - tmp, u) / gammafn(shape) + ACT_DLIM__0(limit, order) * R_pow(u, shape); } actuar/src/dpq.h0000644000176200001440000000643114264305077013271 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Utilities for `dpq' handling (density/probability/quantile) * * These (except ACT_DLIM__0) are copied from src/nmath/dpq.h of R * sources with the names changed from "R_" to "ACT_". * * AUTHOR: Vincent Goulet * with much indirect help from the R Core Team */ /* give_log in "d" & "mgf"; log_p in "p" & "q" : */ #define give_log log_p #define ACT_D__0 (log_p ? R_NegInf : 0.) #define ACT_D__1 (log_p ? 0. : 1.) #define ACT_DT_0 (lower_tail ? ACT_D__0 : ACT_D__1) #define ACT_DT_1 (lower_tail ? ACT_D__1 : ACT_D__0) /* Use 0.5 - p + 0.5 to perhaps gain 1 bit of accuracy */ #define ACT_D_Lval(p) (lower_tail ? (p) : (0.5 - (p) + 0.5)) /* p */ #define ACT_D_Cval(p) (lower_tail ? (0.5 - (p) + 0.5) : (p)) /* 1 - p */ #define ACT_D_val(x) (log_p ? log(x) : (x)) /* x in pF(x,..) */ #define ACT_D_qIv(p) (log_p ? exp(p) : (p)) /* p in qF(p,..) */ #define ACT_DT_qIv(p) (log_p ? (lower_tail ? exp(p) : - expm1(p)) \ : ACT_D_Lval(p)) /* 1 - p in qF(p,..) */ #define ACT_DT_1mqIv(p) (log_p ? (lower_tail ? - expm1(p) : exp(p)) \ : ACT_D_Cval(p)) /* 1 - p in qF(p,..) */ #define ACT_D_exp(x) (log_p ? (x) : exp(x)) /* exp(x) */ #define ACT_D_Cexp(x) (log_p ? log(-expm1(x)) : (-expm1(x))) /* [log](1-exp(x)) */ #define ACT_D_Clog(p) (log_p ? log1p(-(p)) : (0.5 - (p) + 0.5)) /* [log](1-p) */ #define ACT_DT_val(x) (lower_tail ? ACT_D_val(x) : ACT_D_Clog(x)) #define ACT_DT_Eval(x) (lower_tail ? ACT_D_exp(x) : ACT_D_Cexp(x)) #define ACT_DT_Cval(x) (lower_tail ? ACT_D_Clog(x) : ACT_D_val(x)) #define ACT_DT_CEval(x) (lower_tail ? ACT_D_Cexp(x) : ACT_D_exp(x)) // log(1 - exp(x)) in more stable form than log1p(- R_D_qIv(x)) : #define ACT_Log1_Exp(x) ((x) > -M_LN2 ? log(-expm1(x)) : log1p(-exp(x))) /*Boundaries*/ #define ACT_Q_P01_boundaries(p, _LEFT_, _RIGHT_) \ if (log_p) { \ if(p > 0) \ return R_NaN; \ if(p == 0) /* upper bound*/ \ return lower_tail ? _RIGHT_ : _LEFT_; \ if(p == R_NegInf) \ return lower_tail ? _LEFT_ : _RIGHT_; \ } \ else { /* !log_p */ \ if(p < 0 || p > 1) \ return R_NaN; \ if(p == 0) \ return lower_tail ? _LEFT_ : _RIGHT_; \ if(p == 1) \ return lower_tail ? _RIGHT_ : _LEFT_; \ } /* Infinite limit in "lev" */ #define ACT_DLIM__0(x, y) (R_FINITE(x) ? R_pow(x, y) : 0.) /* This is taken from src/nmath/nmath.h of R sources */ #ifdef HAVE_NEARYINT # define ACT_forceint(x) nearbyint() #else # define ACT_forceint(x) round(x) #endif # define ACT_nonint(x) (fabs((x) - ACT_forceint(x)) > 1e-7*fmax2(1., fabs(x))) // for discrete d(x, ...) : #define ACT_D_nonint_check(x) \ if (ACT_nonint(x)) { \ warning(_("non-integer x = %f"), x); \ return ACT_D__0; \ } actuar/src/invgamma.c0000644000176200001440000000750414264305077014301 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the Inverse Gamma distribution. See ../R/InverseGamma.R for * details. * * We work with the density expressed as * * u^shape * e^(-u) / (x * gamma(shape)) * * with u = scale/x. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dinvgamma(double x, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(shape) || ISNAN(scale)) return x + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale < 0.0) return R_NaN; /* handle also x == 0 here */ if (!R_FINITE(x) || x <= 0.0) return ACT_D__0; double logu = log(scale) - log(x); return ACT_D_exp(shape * logu - exp(logu) - log(x) - lgammafn(shape)); } double pinvgamma(double q, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(shape) || ISNAN(scale)) return q + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale < 0.0) return R_NaN;; if (q <= 0) return ACT_DT_0; double u = exp(log(scale) - log(q)); return pgamma(u, shape, 1.0, !lower_tail, log_p); } double qinvgamma(double p, double shape, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(shape) || ISNAN(scale)) return p + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN;; ACT_Q_P01_boundaries(p, 0, R_PosInf); p = ACT_D_qIv(p); return scale / qgamma(p, shape, 1.0, !lower_tail, 0); } double rinvgamma(double shape, double scale) { if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0) return R_NaN;; return scale / rgamma(shape, 1.0); } double minvgamma(double order, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape) || ISNAN(scale)) return order + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (order >= shape) return R_PosInf; return R_pow(scale, order) * gammafn(shape - order) / gammafn(shape); } double levinvgamma(double limit, double shape, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape) || ISNAN(scale) || ISNAN(order)) return limit + shape + scale + order; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || !R_FINITE(order) || shape <= 0.0 || scale <= 0.0) return R_NaN; if (order >= shape) return R_PosInf; if (limit <= 0.0) return 0.0; double u = exp(log(scale) - log(limit)); return R_pow(scale, order) * actuar_gamma_inc(shape - order, u) / gammafn(shape) + ACT_DLIM__0(limit, order) * pgamma(u, shape, 1.0, 1, 0); } double mgfinvgamma(double t, double shape, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(t) || ISNAN(shape) || ISNAN(scale)) return t + shape + scale; #endif if (!R_FINITE(shape) || !R_FINITE(scale) || shape <= 0.0 || scale <= 0.0 || t > 0.0 ) return R_NaN; if (t == 0.0) return ACT_D__1; /* rescale and change sign */ t = -scale * t; return ACT_D_exp(M_LN2 + 0.5 * shape * log(t) + log(bessel_k(sqrt(4 * t), shape, 1)) - lgammafn(shape)); } actuar/src/trbeta.c0000644000176200001440000001304214264305077013755 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the transformed beta distribution. See ../R/TransformedBeta.R for * details. * * We work with the density expressed as * * shape2 * u^shape3 * (1 - u)^shape1 / (x * beta(shape1, shape3)) * * with u = v/(1 + v) = 1/(1 + 1/v), v = (x/scale)^shape2. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dtrbeta(double x, double shape1, double shape2, double shape3, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(shape3) || ISNAN(scale)) return x + shape1 + shape2 + shape3 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(shape3) || shape1 <= 0.0 || shape2 <= 0.0 || shape3 <= 0.0 || scale <= 0.0) return R_NaN; if (!R_FINITE(x) || x < 0.0) return ACT_D__0; /* handle x == 0 separately */ if (x == 0.0) { if (shape2 * shape3 < 1) return R_PosInf; if (shape2 * shape3 > 1) return ACT_D__0; /* else */ return give_log ? log(shape2) - log(scale) - lbeta(shape3, shape1) : shape2 / (scale * beta(shape3, shape1)); } double logv, logu, log1mu; logv = shape2 * (log(x) - log(scale)); logu = - log1pexp(-logv); log1mu = - log1pexp(logv); return ACT_D_exp(log(shape2) + shape3 * logu + shape1 * log1mu - log(x) - lbeta(shape3, shape1)); } double ptrbeta(double q, double shape1, double shape2, double shape3, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(shape3) || ISNAN(scale)) return q + shape1 + shape2 + shape3 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(shape3) || shape1 <= 0.0 || shape2 <= 0.0 || shape3 <= 0.0 || scale <= 0.0) return R_NaN; if (q <= 0) return ACT_DT_0; double logvm, u; logvm = shape2 * (log(scale) - log(q)); /* -log v */ u = exp(-log1pexp(logvm)); if (u > 0.5) { /* Compute (1 - x) accurately */ double u1m = exp(-log1pexp(-logvm)); return pbeta(u1m, shape1, shape3, 1 - lower_tail, log_p); } /* else u <= 0.5 */ return pbeta(u, shape3, shape1, lower_tail, log_p); } double qtrbeta(double p, double shape1, double shape2, double shape3, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(shape3) || ISNAN(scale)) return p + shape1 + shape2 + shape3 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(shape3) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || shape3 <= 0.0 || scale <= 0.0) return R_NaN; ACT_Q_P01_boundaries(p, 0, R_PosInf); p = ACT_D_qIv(p); return scale * R_pow(1.0/qbeta(p, shape3, shape1, lower_tail, 0) - 1.0, -1.0/shape2); } double rtrbeta(double shape1, double shape2, double shape3, double scale) { if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(shape3) || !R_FINITE(scale) || shape1 <= 0.0 || shape2 <= 0.0 || shape3 <= 0.0 || scale <= 0.0) return R_NaN; return scale * R_pow(1.0/rbeta(shape3, shape1) - 1.0, -1.0/shape2); } double mtrbeta(double order, double shape1, double shape2, double shape3, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(shape3) || ISNAN(scale)) return order + shape1 + shape2 + shape3 + scale; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(shape3) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || shape3 <= 0.0 || scale <= 0.0) return R_NaN; if (order <= - shape3 * shape2 || order >= shape1 * shape2) return R_PosInf; double tmp = order / shape2; return R_pow(scale, order) * beta(shape3 + tmp, shape1 - tmp) / beta(shape1, shape3); } double levtrbeta(double limit, double shape1, double shape2, double shape3, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(shape1) || ISNAN(shape2) || ISNAN(shape3) || ISNAN(scale) || ISNAN(order)) return limit + shape1 + shape2 + shape3 + scale + order; #endif if (!R_FINITE(shape1) || !R_FINITE(shape2) || !R_FINITE(shape3) || !R_FINITE(scale) || !R_FINITE(order) || shape1 <= 0.0 || shape2 <= 0.0 || shape3 <= 0.0 || scale <= 0.0) return R_NaN; if (order <= - shape3 * shape2) return R_PosInf; if (limit <= 0.0) return 0.0; double logv, u, u1m, Ix; double tmp = order / shape2; logv = shape2 * (log(limit) - log(scale)); u = exp(-log1pexp(-logv)); u1m = exp(-log1pexp(logv)); Ix = (u > 0.5) ? pbeta(u1m, shape1, shape3, /*l._t.*/1, /*give_log*/0) : pbeta(u, shape3, shape1, /*l._t.*/0, /*give_log*/0); return R_pow(scale, order) * betaint_raw(u, shape3 + tmp, shape1 - tmp, u1m) / (gammafn(shape1) * gammafn(shape3)) + ACT_DLIM__0(limit, order) * Ix; } actuar/src/invexp.c0000644000176200001440000000501014264305077014001 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute density, cumulative distribution and quantile * functions, raw and limited moments and to simulate random variates * for the inverse exponential distribution. See ../R/InverseExponential.R * for details. * * We work with the density expressed as * * u * e^(-u) / x * * with u = scale/x. * * AUTHORS: Mathieu Pigeon and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" #include "actuar.h" double dinvexp(double x, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(scale)) return x + scale; #endif if (!R_FINITE(scale) || scale < 0.0) return R_NaN; /* handle also x == 0 here */ if (!R_FINITE(x) || x <= 0.0) return ACT_D__0; double logu = log(scale) - log(x); return ACT_D_exp(logu - exp(logu) - log(x)); } double pinvexp(double q, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(q) || ISNAN(scale)) return q + scale; #endif if (!R_FINITE(scale) || scale < 0.0) return R_NaN; if (q <= 0) return ACT_DT_0; double u = exp(log(scale) - log(q)); return ACT_DT_Eval(-u); } double qinvexp(double p, double scale, int lower_tail, int log_p) { #ifdef IEEE_754 if (ISNAN(p) || ISNAN(scale)) return p + scale; #endif if (!R_FINITE(scale) || scale <= 0.0) return R_NaN; ACT_Q_P01_boundaries(p, 0, R_PosInf); p = ACT_D_qIv(p); return -scale / log(ACT_D_Lval(p)); } double rinvexp(double scale) { if (!R_FINITE(scale) || scale <= 0.0) return R_NaN; return scale / rexp(1.0); } double minvexp(double order, double scale, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(scale)) return order + scale; #endif if (!R_FINITE(scale) || !R_FINITE(order) || scale <= 0.0) return R_NaN; if (order >= 1.0) return R_PosInf; return R_pow(scale, order) * gammafn(1.0 - order); } double levinvexp(double limit, double scale, double order, int give_log) { #ifdef IEEE_754 if (ISNAN(limit) || ISNAN(scale) || ISNAN(order)) return limit + scale + order; #endif if (!R_FINITE(scale) || !R_FINITE(order) || scale <= 0.0) return R_NaN; if (limit <= 0.0) return 0.0; double u = exp(log(scale) - log(limit)); return R_pow(scale, order) * actuar_gamma_inc(1.0 - order, u) + ACT_DLIM__0(limit, order) * (0.5 - exp(-u) + 0.5); } actuar/src/dpqphtype.c0000644000176200001440000001703314326564170014516 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to compute probability density, cumulative probability * and moment generating functions, and raw moments for phase-type * distributions. This file is based on dpq.c with the following * modifications: * * 1. support for a matrix argument; * 2. no iteration over the parameters; * 3. support for two parameter distributions only; * 4. many sanity checks on the arguments that are done in the * {d,p,r,m,mgf} functions for other probability laws are done * here because of item 2 above. * * Note that the "q" in the functions and file names was retained for * symmetry reasons only, since the quantile function is not * otherwise supported. * * For details, see dpq.c. * * AUTHOR: Vincent Goulet */ #include #include #include "actuar.h" #include "locale.h" /* Prototypes of auxiliary functions */ static SEXP dpqphtype2_1(SEXP, SEXP, SEXP, SEXP, double (*f)(double, double *, double *, int, int)); static SEXP dpqphtype2_2(SEXP, SEXP, SEXP, SEXP, SEXP, double (*f)(double, double *, double *, int, int, int)); #define if_NA_dpqphtype2_set(y, x) \ if (ISNA (x) || naargs) y = NA_REAL; \ else if (ISNAN(x) || nanargs) y = R_NaN; \ else if (naflag) y = R_NaN; static SEXP dpqphtype2_1(SEXP sx, SEXP sa, SEXP sb, SEXP sI, double (*f)(double, double *, double *, int, int)) { SEXP sy, bdims; int i, j, ij, n, m, sxo = OBJECT(sx); double tmp1, tmp2, *x, *a, *b, *y; int i_1; /* Flags used in sanity check of arguments. Listed from highest to * lowest priority. */ Rboolean naargs = FALSE, nanargs = FALSE, naflag = FALSE; #define SETUP_DPQPHTYPE2 \ if (!isNumeric(sx) || !isNumeric(sa) || !isMatrix(sb)) \ error(_("invalid arguments")); \ \ n = LENGTH(sx); \ if (n == 0) \ return(allocVector(REALSXP, 0)); \ \ m = LENGTH(sa); \ bdims = getAttrib(sb, R_DimSymbol); \ if (INTEGER(bdims)[0] != INTEGER(bdims)[1] || \ INTEGER(bdims)[0] != m) \ naflag = TRUE; \ \ PROTECT(sx = coerceVector(sx, REALSXP)); \ PROTECT(sa = coerceVector(sa, REALSXP)); \ PROTECT(sb = coerceVector(sb, REALSXP)); \ PROTECT(sy = allocVector(REALSXP, n)); \ x = REAL(sx); \ a = REAL(sa); \ b = REAL(sb); \ y = REAL(sy); \ \ tmp1 = 0.0; \ for (i = 0; i < m && !naargs && !nanargs && !naflag; i++) \ { \ if ((naargs = ISNA(a[i]))) \ break; \ if ((nanargs = ISNAN(a[i]))) \ break; \ tmp1 += a[i]; \ tmp2 = 0.0; \ for (j = 0; j < m; j++) \ { \ ij = i + j * m; \ if ((naargs = ISNA(b[ij]))) \ break; \ if ((nanargs = ISNAN(b[ij]))) \ break; \ if (i == j && (naflag = b[ij] >= 0)) \ break; \ if (i != j && (naflag = b[ij] < 0)) \ break; \ tmp2 += b[ij]; \ } \ if (!(naargs || nanargs)) \ naflag = tmp2 > 0; \ } \ if (!(naargs || nanargs)) \ naflag = tmp1 > 1 SETUP_DPQPHTYPE2; i_1 = asInteger(sI); for (i = 0; i < n; i++) { if_NA_dpqphtype2_set(y[i], x[i]) else { y[i] = f(x[i], a, b, m, i_1); if (ISNAN(y[i])) naflag = TRUE; } } #define FINISH_DPQPHTYPE2 \ if (naflag) \ warning(R_MSG_NA); \ \ SET_ATTRIB(sy, duplicate(ATTRIB(sx))); \ SET_OBJECT(sy, sxo); \ \ UNPROTECT(4) FINISH_DPQPHTYPE2; return sy; } static SEXP dpqphtype2_2(SEXP sx, SEXP sa, SEXP sb, SEXP sI, SEXP sJ, double (*f)(double, double *, double *, int, int, int)) { SEXP sy, bdims; int i, j, ij, n, m, sxo = OBJECT(sx); double tmp1, tmp2, *x, *a, *b, *y; int i_1, i_2; /* Flags used in sanity check of arguments. Listed from highest to * lowest priority. */ Rboolean naargs = FALSE, nanargs = FALSE, naflag = FALSE; SETUP_DPQPHTYPE2; i_1 = asInteger(sI); i_2 = asInteger(sJ); for (i = 0; i < n; i++) { if_NA_dpqphtype2_set(y[i], x[i]) else { y[i] = f(x[i], a, b, m, i_1, i_2); if (ISNAN(y[i])) naflag = TRUE; } } FINISH_DPQPHTYPE2; return sy; } #define DPQPHTYPE2_1(A, FUN) dpqphtype2_1(CAR(A), CADR(A), CADDR(A), CADDDR(A), FUN); #define DPQPHTYPE2_2(A, FUN) dpqphtype2_2(CAR(A), CADR(A), CADDR(A), CADDDR(A), CAD4R(A), FUN) SEXP actuar_do_dpqphtype2(int code, SEXP args) { switch (code) { case 1: return DPQPHTYPE2_1(args, dphtype); case 2: return DPQPHTYPE2_2(args, pphtype); case 3: return DPQPHTYPE2_1(args, mphtype); case 4: return DPQPHTYPE2_1(args, mgfphtype); default: error(_("internal error in actuar_do_dpqphtype2")); } return args; /* never used; to keep -Wall happy */ } /* Main function, the only one used by .External(). */ SEXP actuar_do_dpqphtype(SEXP args) { int i; const char *name; /* Extract distribution name */ args = CDR(args); name = CHAR(STRING_ELT(CAR(args), 0)); /* Dispatch to actuar_do_dpqphtype{1,2,3,4,5} */ for (i = 0; dpq_tab[i].name; i++) if (!strcmp(dpq_tab[i].name, name)) return dpq_tab[i].cfun(dpq_tab[i].code, CDR(args)); /* No dispatch is an error */ error("internal error in actuar_do_dpqphtype"); return args; /* never used; to keep -Wall happy */ } actuar/src/norm.c0000644000176200001440000000272614264305077013456 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Functions to calculate raw moments and the moment generating * function for the normal distribution. See ../R/NormalSupp.R for * details. * * AUTHORS: Christophe Dutang and Vincent Goulet */ #include #include #include "locale.h" #include "dpq.h" double mnorm(double order, double mean, double sd, int give_log) { #ifdef IEEE_754 if (ISNAN(order) || ISNAN(mean) || ISNAN(sd)) return order + mean + sd; #endif if (!R_FINITE(mean) || !R_FINITE(sd) || !R_FINITE(order) || sd <= 0.0 || ACT_nonint(order)) return R_NaN; /* Trivial case */ if (order == 0.0) return 1.0; /* Odd moments about 0 are equal to 0 */ if ((int) order % 2 == 1 && mean == 0.0) return 0.0; int i, n = order; double res = 0.0; for (i = 0; i <= n/2; i++) res += R_pow_di(sd, 2 * i) * R_pow_di(mean, n - 2 * i) / (R_pow_di(2.0, i) * gammafn(i + 1) * gammafn(order - 2.0 * i + 1.0)); return gammafn(order + 1.0) * res; } double mgfnorm(double t, double mean, double sd, int give_log) { #ifdef IEEE_754 if (ISNAN(t) || ISNAN(mean) || ISNAN(sd)) return t + mean + sd; #endif if (!R_FINITE(mean) || !R_FINITE(sd) || sd <= 0.0) return R_NaN; if (t == 0.0) return ACT_D__1; return ACT_D_exp(t * mean + 0.5 * t * t * sd * sd) ; } actuar/vignettes/0000755000176200001440000000000014522560035013543 5ustar liggesusersactuar/vignettes/coverage.Rnw0000644000176200001440000002332214370340204016023 0ustar liggesusers\input{share/preamble} %\VignetteIndexEntry{Complete formulas used by coverage} %\VignettePackage{actuar} %\SweaveUTF8 \title{Complete formulas used by \code{coverage}} \author{Vincent Goulet \\ Université Laval} \date{} <>= library(actuar) @ \begin{document} \maketitle Function \code{coverage} of \pkg{actuar} defines a new function to compute the probability density function (pdf) of cumulative distribution function (cdf) of any probability law under the following insurance coverage modifications: ordinary or franchise deductible, limit, coinsurance, inflation. In addition, the function can return the distribution of either the payment per loss or the payment per payment random variable. This terminology refers to whether or not the insurer knows that a loss occurred. For the exact definitions of the terms as used by \code{coverage}, see Chapter~5 of \cite{LossModels2e}. In the presence of a deductible, four random variables can be defined: \begin{enumerate} \item $Y^P$, the payment per payment with an ordinary deductible; \item $Y^L$, the payment per loss with an ordinary deductible; \item $\tilde{Y}^P$, the payment per payment with a franchise deductible; \item $\tilde{Y}^L$, the payment per loss with a franchise deductible. \end{enumerate} The most common case in insurance applications is the distribution of the amount paid per payment with an ordinary deductible, $Y^P$. Hence, it is the default in \code{coverage}. When there is no deductible, all four random variables are equivalent. This document presents the definitions of the above four random variables and their corresponding cdf and pdf for a deductible $d$, a limit $u$, a coinsurance level $\alpha$ and an inflation rate $r$. An illustrative plot of each cdf and pdf is also included. In these plots, a dot indicates a probability mass at the given point. In definitions below, $X$ is the nonnegative random variable of the losses with cdf $F_X(\cdot)$ and pdf $f_X(\cdot)$. \bibliography{actuar} <>= deductible <- 5 limit <- 13 @ \section{Payment per payment, ordinary deductible} <>= pgammaL <- coverage(cdf = pgamma, deductible = deductible, limit = limit, per.loss = TRUE) dgammaL <- coverage(dgamma, pgamma, deductible = deductible, limit = limit, per.loss = TRUE) pgammaP <- coverage(cdf = pgamma, deductible = deductible, limit = limit) dgammaP <- coverage(dgamma, pgamma, deductible = deductible, limit = limit) d <- deductible u <- limit - d e <- 0.001 ylim <- c(0, dgammaL(0, 5, 0.6)) @ \begin{align*} Y^P &= \begin{cases} \alpha ((1 + r) X - d), & \D\frac{d}{1 + r} \leq X < \frac{u}{1 + r} \\ \alpha (u - d), & \D X \geq \frac{u}{1 + r} \end{cases} & \\ F_{Y^P}(y) &= \begin{cases} 0, & y = 0 \\ \D\frac{F_X \left( \frac{y + \alpha d}{\alpha (1 + r)} \right) - F_X \left( \frac{d}{1 + r} \right)}{% 1 - F_X \left( \frac{d}{1 + r} \right)}, & 0 < y < \alpha (u - d) \\ 1, & y \geq \alpha(u - d) \end{cases} & \begin{minipage}{0.4\linewidth} <>= par(mar = c(2, 3, 1, 1)) curve(pgammaP(x, 5, 0.6), from = 0, to = u - e, xlim = c(0, limit), ylim = c(0, 1), xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(pgammaP(x, 5, 0.6), from = u, add = TRUE, lwd = 2) axis(1, at = c(0, u), labels = c("0", "u - d")) @ \end{minipage} \\ f_{Y^P}(y) &= \begin{cases} 0, & y = 0 \\ \left( \D\frac{1}{\alpha (1 + r)} \right) \D\frac{f_X \left( \frac{y + \alpha d}{\alpha(1 + r)} \right)}{% 1 - F_X \left( \frac{d}{1 + r} \right)}, & 0 < y < \alpha (u - d) \\ \D\frac{1 - F_X \Big( \frac{u}{1 + r} \Big)}{% 1 - F_X \left( \frac{d}{1 + r} \right)}, & y = \alpha(u - d) \end{cases} & \begin{minipage}{0.4\linewidth} <>= par(mar = c(2, 3, 1, 1)) curve(dgammaP(x, 5, 0.6), from = 0 + e, to = u - e, xlim = c(0, limit), ylim = ylim, xlab = "", ylab = "", xaxt = "n", lwd = 2) points(u, dgammaP(u, 5, 0.6), pch = 16) axis(1, at = c(0, u), labels = c("0", "u - d")) @ \end{minipage} \end{align*} \section{Payment per loss, ordinary deductible} \begin{align*} Y^L &= \begin{cases} 0, & X < \D \frac{d}{1 + r} \\ \alpha ((1 + r) X - d), & \D\frac{d}{1 + r} \leq X < \frac{u}{1 + r} \\ \alpha (u - d), & \D X \geq \frac{u}{1 + r} \end{cases} & \\ F_{Y^L}(y) &= \begin{cases} F_X \left( \D\frac{d}{1 + r} \right), & y = 0 \\ F_X \left( \D\frac{y + \alpha d}{\alpha(1 + r)} \right), & 0 < y < \alpha (u - d) \\ 1, & y \geq \alpha(u - d) \end{cases} & \begin{minipage}{0.4\linewidth} <>= par(mar = c(2, 3, 1, 1)) curve(pgammaL(x, 5, 0.6), from = 0, to = u - e, xlim = c(0, limit), ylim = c(0, 1), xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(pgammaL(x, 5, 0.6), from = u, add = TRUE, lwd = 2) axis(1, at = c(0, u), labels = c("0", "u - d")) @ \end{minipage} \\ f_{Y^L}(y) &= \begin{cases} F_X \left( \D\frac{d}{1 + r} \right), & y = 0 \\ \D\frac{1}{\alpha (1 + r)} f_X \left( \D\frac{y + \alpha d}{\alpha(1 + r)} \right), & 0 < y < \alpha (u - d) \\ 1 - F_X \left( \D\frac{u}{1 + r} \right), & y = \alpha(u - d) \end{cases} & \begin{minipage}{0.4\linewidth} <>= par(mar = c(2, 3, 1, 1)) curve(dgammaL(x, 5, 0.6), from = 0 + e, to = u - e, xlim = c(0, limit), ylim = ylim, xlab = "", ylab = "", xaxt = "n", lwd = 2) points(c(0, u), dgammaL(c(0, u), 5, 0.6), pch = 16) axis(1, at = c(0, u), labels = c("0", "u - d")) @ \end{minipage} \end{align*} \section{Payment per payment, franchise deductible} <>= pgammaL <- coverage(cdf = pgamma, deductible = deductible, limit = limit, per.loss = TRUE, franchise = TRUE) dgammaL <- coverage(dgamma, pgamma, deductible = deductible, limit = limit, per.loss = TRUE, franchise = TRUE) pgammaP <- coverage(cdf = pgamma, deductible = deductible, limit = limit, franchise = TRUE) dgammaP <- coverage(dgamma, pgamma, deductible = deductible, limit = limit, franchise = TRUE) d <- deductible u <- limit e <- 0.001 ylim <- c(0, dgammaL(0, 5, 0.6)) @ \begin{align*} \tilde{Y}^P &= \begin{cases} \alpha (1 + r) X, & \D\frac{d}{1 + r} \leq X < \frac{u}{1 + r} \\ \alpha u, & \D X \geq \frac{u}{1 + r} \end{cases} & \\ F_{\tilde{Y}^P}(y) &= \begin{cases} 0, & 0 \leq y \leq \alpha d \\ \D\frac{F_X \left( \frac{y}{\alpha (1 + r)} \right) - F_X \left( \frac{d}{1 + r} \right)}{% 1 - F_X \left( \frac{d}{1 + r} \right)}, & \alpha d < y < \alpha u \\ 1, & y \geq \alpha u \end{cases} & \begin{minipage}{0.4\linewidth} <>= par(mar = c(2, 3, 1, 1)) curve(pgammaP(x, 5, 0.6), from = 0, to = u - e, xlim = c(0, limit + d), ylim = c(0, 1), xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(pgammaP(x, 5, 0.6), from = u, add = TRUE, lwd = 2) axis(1, at = c(0, d, u), labels = c("0", "d", "u")) @ \end{minipage} \\ f_{\tilde{Y}^P}(y) &= \begin{cases} 0, & 0 \leq y \leq \alpha d \\ \left( \D\frac{1}{\alpha (1 + r)} \right) \D\frac{f_X \left( \frac{y}{\alpha(1 + r)} \right)}{% 1 - F_X \left( \frac{d}{1 + r} \right)}, & \alpha d < y < \alpha u \\ \D\frac{1 - F_X \Big( \frac{u}{1 + r} \Big)}{% 1 - F_X \left( \frac{d}{1 + r} \right)}, & y = \alpha u \end{cases} & \begin{minipage}{0.4\linewidth} <>= par(mar = c(2, 3, 1, 1)) curve(dgammaP(x, 5, 0.6), from = d + e, to = u - e, xlim = c(0, limit + d), ylim = ylim, xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(dgammaL(x, 5, 0.6), from = 0 + e, to = d, add = TRUE, lwd = 2) points(u, dgammaP(u, 5, 0.6), pch = 16) axis(1, at = c(0, d, u), labels = c("0", "d", "u")) @ \end{minipage} \end{align*} \section{Payment per loss, franchise deductible} \begin{align*} \tilde{Y}^L &= \begin{cases} 0, & X < \D \frac{d}{1 + r} \\ \alpha (1 + r) X, & \D\frac{d}{1 + r} \leq X < \frac{u}{1 + r} \\ \alpha u, & \D X \geq \frac{u}{1 + r} \end{cases} & \\ F_{\tilde{Y}^L}(y) &= \begin{cases} F_X \left( \D\frac{d}{1 + r} \right), & 0 \leq y \leq \alpha d \\ F_X \left( \D\frac{y}{\alpha(1 + r)} \right), & \alpha d < y < \alpha u \\ 1, & y \geq \alpha u \end{cases} & \begin{minipage}{0.4\linewidth} <>= par(mar = c(2, 3, 1, 1)) curve(pgammaL(x, 5, 0.6), from = 0, to = u - e, xlim = c(0, limit + d), ylim = c(0, 1), xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(pgammaL(x, 5, 0.6), from = u, add = TRUE, lwd = 2) axis(1, at = c(0, d, u), labels = c("0", "d", "u")) @ \end{minipage} \\ f_{\tilde{Y}^L}(y) &= \begin{cases} F_X \left( \D\frac{d}{1 + r} \right), & y = 0 \\ \D\frac{1}{\alpha (1 + r)} f_X \left( \D\frac{y}{\alpha(1 + r)} \right), & \alpha d < y < \alpha u \\ 1 - F_X \left( \D\frac{u}{1 + r} \right), & y = \alpha u \end{cases} & \begin{minipage}{0.4\linewidth} <>= par(mar = c(2, 3, 1, 1)) curve(dgammaL(x, 5, 0.6), from = d + e, to = u - e, xlim = c(0, limit + d), ylim = ylim, xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(dgammaL(x, 5, 0.6), from = 0 + e, to = d, add = TRUE, lwd = 2) points(c(0, u), dgammaL(c(0, u), 5, 0.6), pch = 16) axis(1, at = c(0, d, u), labels = c("0", "d", "u")) @ \end{minipage} \end{align*} \end{document} %%% Local Variables: %%% mode: noweb %%% TeX-master: t %%% coding: utf-8 %%% End: actuar/vignettes/simulation.Rnw0000644000176200001440000004761514515770645016450 0ustar liggesusers\input{share/preamble} %\VignetteIndexEntry{Simulation of insurance data} %\VignettePackage{actuar} %\SweaveUTF8 \title{Simulation of insurance data with \pkg{actuar}} \author{Christophe Dutang \\ Université Paris Dauphine \\[3ex] Vincent Goulet \\ Université Laval \\[3ex] Mathieu Pigeon \\ Université du Québec à Montréal \\[3ex] Louis-Philippe Pouliot \\ Université Laval} \date{} <>= library(actuar) options(width = 52, digits = 4) @ \begin{document} \maketitle \section{Introduction} \label{sec:introduction} Package \pkg{actuar} provides functions to facilitate the generation of random variates from various probability models commonly used in actuarial applications. From the simplest to the most sophisticated, these functions are: \begin{enumerate} \item \code{rmixture} to simulate from discrete mixtures; \item \code{rcompound} to simulate from compound models (and a simplified version, \code{rcompois} to simulate from the very common compound Poisson model); \item \code{rcomphierarc} to simulate from compound models where both the frequency and the severity components can have a hierarchical structure. \end{enumerate} \section{Simulation from discrete mixtures} \label{sec:rmixture} A random variable is said to be a discrete mixture of the random variables with probability density functions $f_1, \dots, f_n$ if its density can be written as \begin{equation} \label{eq:mixture} f(x) = p_1 f_1(x) + \dots + p_n f_n(x) = \sum_{i = 1}^n p_i f_i(x), \end{equation} where $p_1, \dots, p_n$ are probabilities (or weights) such that $p_i \geq 0$ and $\sum_{i = 1}^n p_i = 1$. Function \code{rmixture} makes it easy to generate random variates from such mixtures. The arguments of the function are: \begin{enumerate} \item \code{n} the number of variates to generate; \item \code{probs} a vector of values that will be normalized internally to create the probabilities $p_1, \dots, p_n$; \item \code{models} a vector of expressions specifying the simulation models corresponding to the densities $f_1, \dots, f_n$. \end{enumerate} The specification of simulation models follows the syntax of \code{rcomphierarc} (explained in greater detail in \autoref{sec:rcomphierarc}). In a nutshell, the models are expressed in a semi-symbolic fashion using an object of mode \code{"expression"} where each element is a complete call to a random number generation function, with the number of variates omitted. The following example should clarify this concept. \begin{example} Let $X$ be a mixture between two exponentials: one with mean $1/3$ and one with mean $1/7$. The first exponential has twice as much weight as the second one in the mixture. Therefore, the density of $X$ is \begin{equation*} f(x) = \frac{2}{3} (3 e^{-3x}) + \frac{1}{3} (7 e^{-7x}) \\ = 2 e^{-3x} + \frac{7}{3} e^{-7x}. \end{equation*} The following expression generates $10$ random variates from this density using \code{rmixture}. <>= rmixture(10, probs = c(2, 1), models = expression(rexp(3), rexp(7))) @ \qed \end{example} See also \autoref{ex:comppois} for a more involved application combining simulation from a mixture and simulation from a compound Poisson model. \section{Simulation from compound models} \label{sec:rcompound} Actuaries often need to simulate separately the frequency and the severity of claims for compound models of the form \begin{equation} \label{eq:definition-S} S = C_1 + \dots + C_N, \end{equation} where $C_1, C_2, \dots$ are the mutually independent and identically distributed random variables of the claim amounts, each independent of the frequency random variable $N$. Function \code{rcompound} generates variates from the random variable $S$ when the distribution of both random variables $N$ and $C$ is non hierarchical; for the more general hierarchical case, see \autoref{sec:rcomphierarc}. The function has three arguments: \begin{enumerate} \item \code{n} the number of variates to generate; \item \code{model.freq} the frequency model (random variable $N$); \item \code{model.sev} the severity model (random variable $C$). \end{enumerate} Arguments \code{model.freq} and \code{model.sev} are simple R expressions consisting of calls to a random number generation function with the number of variates omitted. This is of course similar to argument \code{models} of \code{rmixture}, only with a slightly simpler syntax since one does not need to wrap the calls in \code{expression}. Function \code{rcomppois} is a simplified interface for the common case where $N$ has a Poisson distribution and, therefore, $S$ is compound Poisson. In this function, argument \code{model.freq} is replaced by \code{lambda} that takes the value of the Poisson parameter. \begin{example} Let $S \sim \text{Compound Poisson}(1.5, F)$, where $1.5$ is the value of the Poisson parameter and $F$ is the cumulative distribution function of a gamma distribution with shape parameter $\alpha = 3$ and rate parameter $\lambda = 2$. We obtain variates from the random variable $S$ using \code{rcompound} or \code{rcompois} as follows: <>= rcompound(10, rpois(1.5), rgamma(3, 2)) rcomppois(10, 1.5, rgamma(3, 2)) @ Specifying argument \code{SIMPLIFY = FALSE} to either function will return not only the variates from $S$, but also the underlying variates from the random variables $N$ and $C_1, \dots, C_N$: <>= rcomppois(10, 1.5, rgamma(3, 2), SIMPLIFY = FALSE) @ \qed \end{example} \begin{example} \label{ex:comppois} Theorem~9.7 of \cite{LossModels4e} states that the sum of compound Poisson random variables is itself compound Poisson with Poisson parameter equal to the sum of the Poisson parameters and severity distribution equal to the mixture of the severity models. Let $S = S_1 + S_2 + S_3$, where $S_1$ is compound Poisson with mean frequency $\lambda = 2$ and severity Gamma$(3, 1)$; $S_2$ is compound Poisson with $\lambda = 1$ and severity Gamma$(5, 4)$; $S_3$ is compound Poisson with $\lambda = 1/2$ and severity Lognormal$(2, 1)$. By the aforementioned theorem, $S$ is compound Poisson with $\lambda = 2 + 1 + 1/2 = 7/2$ and severity density \begin{equation*} f(x) = \frac{4}{7} \left( \frac{1}{\Gamma(3)} x^2 e^{-x} \right) + \frac{2}{7} \left( \frac{4^5}{\Gamma(5)} x^4 e^{-4x} \right) + \frac{1}{7} \phi(\ln x - 2). \end{equation*} Combining \code{rcomppois} and \code{rmixture} we can generate variates of $S$ using the following elegant expression. <>= x <- rcomppois(1e5, 3.5, rmixture(probs = c(2, 1, 0.5), expression(rgamma(3), rgamma(5, 4), rlnorm(2, 1)))) @ One can verify that the theoretical mean of $S$ is $6 + 5/4 + (e^{5/2})/2 = 13.34$. Now, the empirical mean based on the above sample of size $10^5$ is: <>= mean(x) @ \qed \end{example} \section{Simulation from compound hierarchical models} \label{sec:rcomphierarc} Hierarchical probability models are widely used for data classified in a tree-like structure and in Bayesian inference. The main characteristic of such models is to have the probability law at some level in the classification structure be conditional on the outcome in previous levels. For example, adopting a bottom to top description of the model, a simple hierarchical model could be written as \begin{equation} \label{eq:basic_model} \begin{split} X_t|\Lambda, \Theta &\sim \text{Poisson}(\Lambda) \\ \Lambda|\Theta &\sim \text{Gamma}(3, \Theta) \\ \Theta &\sim \text{Gamma}(2, 2), \end{split} \end{equation} where $X_t$ represents actual data. The random variables $\Theta$ and $\Lambda$ are generally seen as uncertainty, or risk, parameters in the actuarial literature; in the sequel, we refer to them as mixing parameters. The example above is merely a multi-level mixture of models, something that is simple to simulate ``by hand''. The following R expression will yield $n$ variates of the random variable $X_t$: <>= rpois(n, rgamma(n, 3, rgamma(n, 2, 2))) @ However, for categorical data common in actuarial applications there will usually be many categories --- or \emph{nodes} --- at each level. Simulation is then complicated by the need to always use the correct parameters for each variate. Furthermore, one may need to simulate both the frequency and the severity of claims for compound models of the form \eqref{eq:definition-S}. This section briefly describes function \code{rcomphierarc} and its usage. \cite{Goulet:simpf:2008} discuss in more details the models supported by the function and give more thorough examples. \subsection{Description of hierarchical models} \label{sec:rcomphierarc:description} We consider simulation of data from hierarchical models. We want a method to describe these models in R that meets the following criteria: \begin{enumerate} \item simple and intuitive to go from the mathematical formulation of the model to the R formulation and back; \item allows for any number of levels and nodes; \item at any level, allows for any use of parameters higher in the hierarchical structure. \end{enumerate} A hierarchical model is completely specified by the number of nodes at each level and by the probability laws at each level. The number of nodes is passed to \code{rcomphierarc} by means of a named list where each element is a vector of the number of nodes at a given level. Vectors are recycled when the number of nodes is the same throughout a level. Probability models are expressed in a semi-symbolic fashion using an object of mode \code{"expression"}. Each element of the object must be named --- with names matching those of the number of nodes list --- and should be a complete call to an existing random number generation function, but with the number of variates omitted. Hierarchical models are achieved by replacing one or more parameters of a distribution at a given level by any combination of the names of the levels above. If no mixing is to take place at a level, the model for this level can be \code{NULL}. \begin{example} Consider the following expanded version of model \eqref{eq:basic_model}: \begin{align*} X_{ijt}|\Lambda_{ij}, \Theta_i &\sim \text{Poisson}(\Lambda_{ij}), & t &= 1, \dots, n_{ij} \\ \Lambda_{ij}|\Theta_i &\sim \text{Gamma}(3, \Theta_i), & j &= 1, \dots, J_i \\ \Theta_i &\sim \text{Gamma}(2, 2), & i &= 1, \dots, I, \end{align*} with $I = 3$, $J_1 = 4$, $J_2 = 5$, $J_3 = 6$ and $n_{ij} \equiv n = 10$. Then the number of nodes and the probability model are respectively specified by the following expressions. \begin{Schunk} \begin{Verbatim} list(Theta = 3, Lambda = c(4, 5, 6), Data = 10) \end{Verbatim} \end{Schunk} \begin{Schunk} \begin{Verbatim} expression(Theta = rgamma(2, 2), Lambda = rgamma(3, Theta), Data = rpois(Lambda)) \end{Verbatim} \end{Schunk} \qed \end{example} Storing the probability model requires an expression object in order to avoid evaluation of the incomplete calls to the random number generation functions. Function \code{rcomphierarc} builds and executes the calls to the random generation functions from the top of the hierarchical model to the bottom. At each level, the function \begin{enumerate} \item infers the number of variates to generate from the number of nodes list, and \item appropriately recycles the mixing parameters simulated previously. \end{enumerate} The actual names in the list and the expression object can be anything; they merely serve to identify the mixing parameters. Furthermore, any random generation function can be used. The only constraint is that the name of the number of variates argument is \code{n}. In addition, \code{rcomphierarc} supports usage of weights in models. These usually modify the frequency parameters to take into account the ``size'' of an entity. Weights are used in simulation wherever the name \code{weights} appears in a model. \subsection[Usage of rcomphierarc]{Usage of \code{rcomphierarc}} \label{sec:rcomphierarc:usage} Function \code{rcomphierarc} can simulate data for structures where both the frequency model and the severity model are hierarchical. It has four main arguments: \begin{enumerate} \item \code{nodes} for the number of nodes list; \item \code{model.freq} for the frequency model; \item \code{model.sev} for the severity model; \item \code{weights} for the vector of weights in lexicographic order, that is all weights of entity 1, then all weights of entity 2, and so on. \end{enumerate} The function returns the variates in a list of class \code{"portfolio"} with a \code{dim} attribute of length two. The list contains all the individual claim amounts for each entity. Since every element can be a vector, the object can be seen as a three-dimension array with a third dimension of potentially varying length. The function also returns a matrix of integers giving the classification indexes of each entity in the portfolio. The package also defines methods for four generic functions to easily access key quantities for each entity of the simulated portfolio: \begin{enumerate} \item a method of \code{aggregate} to compute the aggregate claim amounts $S$; \item a method of \code{frequency} to compute the number of claims $N$; \item a method of \code{severity} (a generic function introduced by the package) to return the individual claim amounts $C_j$; \item a method of \code{weights} to extract the weights matrix. \end{enumerate} In addition, all methods have a \code{classification} and a \code{prefix} argument. When the first is \code{FALSE}, the classification index columns are omitted from the result. The second argument overrides the default column name prefix; see the \code{rcomphierarc.summaries} help page for details. The following example illustrates these concepts in detail. \begin{example} Consider the following compound hierarchical model: \begin{equation*} S_{ijt} = C_{ijt1} + \dots + C_{ijt N_{ijt}}, \end{equation*} for $i = 1, \dots, I$, $j = 1, \dots, J_i$, $t = 1, \dots, n_{ij}$ and with \begin{align*} N_{ijt}|\Lambda_{ij}, \Phi_i &\sim \text{Poisson}(w_{ijt} \Lambda_{ij}) & C_{ijtu}|\Theta_{ij}, \Psi_i &\sim \text{Lognormal}(\Theta_{ij}, 1) \notag \\ \Lambda_{ij}|\Phi_i &\sim \text{Gamma}(\Phi_i, 1) & \Theta_{ij}|\Psi_i &\sim N(\Psi_i, 1) \\ \Phi_i &\sim \text{Exponential}(2) & \Psi_i &\sim N(2, 0.1). \notag \end{align*} (Note how weights modify the Poisson parameter.) Using as convention to number the data level 0, the above is a two-level compound hierarchical model. Assuming that $I = 2$, $J_1 = 4$, $J_2 = 3$, $n_{11} = \dots = n_{14} = 4$ and $n_{21} = n_{22} = n_{23} = 5$ and that weights are simply simulated from a uniform distribution on $(0.5, 2.5)$, then simulation of a data set with \code{rcomphierarc} is achieved with the following expressions. <>= set.seed(3) @ <>= nodes <- list(cohort = 2, contract = c(4, 3), year = c(4, 4, 4, 4, 5, 5, 5)) mf <- expression(cohort = rexp(2), contract = rgamma(cohort, 1), year = rpois(weights * contract)) ms <- expression(cohort = rnorm(2, sqrt(0.1)), contract = rnorm(cohort, 1), year = rlnorm(contract, 1)) wijt <- runif(31, 0.5, 2.5) pf <- rcomphierarc(nodes = nodes, model.freq = mf, model.sev = ms, weights = wijt) @ Object \code{pf} is a list of class \code{"portfolio"} containing, among other things, the aforementioned two-dimension list as element \code{data} and the classification matrix (subscripts $i$ and $j$) as element \code{classification}: <>= class(pf) pf$data pf$classification @ The output of \code{pf\$data} is not much readable. If we were to print the results of \code{rcomphierarc} this way, many users would wonder what \code{Numeric,\emph{n}} means. (It is actually R's way to specify that a given element in the list is a numeric vector of length $n$ --- the third dimension mentioned above.) To ease reading, the \code{print} method for objects of class \code{"portfolio"} only prints the simulation model and the number of claims in each node: <>= pf @ By default, the method of \code{aggregate} returns the values of $S_{ijt}$ in a regular matrix (subscripts $i$ and $j$ in the rows, subscript $t$ in the columns). The method has a \code{by} argument to get statistics for other groupings and a \code{FUN} argument to get statistics other than the sum: <>= aggregate(pf) aggregate(pf, by = c("cohort", "year"), FUN = mean) @ The method of \code{frequency} returns the values of $N_{ijt}$. It is mostly a wrapper for the \code{aggregate} method with the default \code{sum} statistic replaced by \code{length}. Hence, arguments \code{by} and \code{FUN} remain available: <>= frequency(pf) frequency(pf, by = "cohort") @ The method of \code{severity} returns the individual variates $C_{ijtu}$ in a matrix similar to those above, but with a number of columns equal to the maximum number of observations per entity, \begin{displaymath} \max_{i, j} \sum_{t = 1}^{n_{ij}} N_{ijt}. \end{displaymath} Thus, the original period of observation (subscript $t$) and the identifier of the severity within the period (subscript $u$) are lost and each variate now constitute a ``period'' of observation. For this reason, the method provides an argument \code{splitcol} in case one would like to extract separately the individual severities of one or more periods: <>= severity(pf) severity(pf, splitcol = 1) @ Finally, the weights matrix corresponding to the data in object \code{pf} is <>= weights(pf) @ Combined with the argument \code{classification = FALSE}, the above methods can be used to easily compute loss ratios: <>= aggregate(pf, classif = FALSE) / weights(pf, classif = FALSE) @ \qed \end{example} \begin{example} \cite{Scollnik:2001:MCMC} considers the following model for the simulation of claims frequency data in a Markov Chain Monte Carlo (MCMC) context: \begin{align*} S_{it}|\Lambda_i, \alpha, \beta &\sim \text{Poisson}(w_{ij} \Lambda_i) \\ \Lambda_i|\alpha, \beta &\sim \text{Gamma}(\alpha, \beta) \\ \alpha &\sim \text{Gamma}(5, 5) \\ \beta &\sim \text{Gamma}(25, 1) \end{align*} for $i = 1, 2, 3$, $j = 1, \dots, 5$ and with weights $w_{it}$ simulated from \begin{align*} w_{it}|a_i, b_i &\sim \text{Gamma}(a_i, b_i) \\ a_i &\sim U(0, 100) \\ b_i &\sim U(0, 100). \end{align*} Strictly speaking, this is not a hierarchical model since the random variables $\alpha$ and $\beta$ are parallel rather than nested. Nevertheless, with some minor manual intervention, function \code{rcomphierarc} can simulate data from this model. First, one simulates the weights (in lexicographic order) with <>= set.seed(123) @ <>= wit <- rgamma(15, rep(runif(3, 0, 100), each = 5), rep(runif(3, 0, 100), each = 5)) @ Second, one calls \code{rcomphierarc} to simulate the frequency data. The key here consists in manually inserting the simulation of the shape and rate parameters of the gamma distribution in the model for $\Lambda_i$. Finally, wrapping the call to \code{rcomphierarc} in \code{frequency} will immediately yield the matrix of observations: <>= frequency(rcomphierarc(list(entity = 3, year = 5), expression(entity = rgamma(rgamma(1, 5, 5), rgamma(1, 25, 1)), year = rpois(weights * entity)), weights = wit)) @ \qed \end{example} One will find more examples of \code{rcomphierarc} usage in the \code{simulation} demo file. The function was used to simulate the data in \cite{Goulet_cfs}. %% References \bibliography{actuar} \end{document} %%% Local Variables: %%% mode: noweb %%% coding: utf-8 %%% TeX-master: t %%% End: actuar/vignettes/credibility.Rnw0000644000176200001440000006413314370340204016540 0ustar liggesusers\input{share/preamble} %\VignetteIndexEntry{Credibility theory} %\VignettePackage{actuar} %\SweaveUTF8 \title{Credibility theory features of \pkg{actuar}} \author{Christophe Dutang \\ Université Paris Dauphine \\[3ex] Vincent Goulet \\ Université Laval \\[3ex] Xavier Milhaud \\ Université Claude Bernard Lyon 1 \\[3ex] Mathieu Pigeon \\ Université du Québec à Montréal} \date{} <>= library(actuar) options(width = 57, digits = 4) @ \begin{document} \maketitle \section{Introduction} \label{sec:introduction} Credibility models are actuarial tools to distribute premiums fairly among a heterogeneous group of policyholders (henceforth called \emph{entities}). More generally, they can be seen as prediction methods applicable in any setting where repeated measures are made for subjects with different risk levels. The credibility theory features of \pkg{actuar} consist of matrix \code{hachemeister} containing the famous data set of \cite{Hachemeister_75} and function \code{cm} to fit hierarchical (including Bühlmann, Bühlmann-Straub), regression and linear Bayes credibility models. Furthermore, function \code{rcomphierarc} can simulate portfolios of data satisfying the assumptions of the aforementioned credibility models; see the \code{"simulation"} vignette for details. \section{Hachemeister data set} \label{sec:hachemeister} The data set of \cite{Hachemeister_75} consists of private passenger bodily injury insurance average claim amounts, and the corresponding number of claims, for five U.S.\ states over 12 quarters between July 1970 and June 1973. The data set is included in the package in the form of a matrix with 5 rows and 25 columns. The first column contains a state index, columns 2--13 contain the claim averages and columns 14--25 contain the claim numbers: <>= data(hachemeister) hachemeister @ \section{Hierarchical credibility model} \label{sec:hierarchical} The linear model fitting function of R is \code{lm}. Since credibility models are very close in many respects to linear models, and since the credibility model fitting function of \pkg{actuar} borrows much of its interface from \code{lm}, we named the credibility function \code{cm}. Function \code{cm} acts as a unified interface for all credibility models supported by the package. Currently, these are: the unidimensional models of \cite{Buhlmann_69} and \cite{BS_70}; the hierarchical model of \cite{Jewell_75} (of which the first two are special cases); the regression model of \cite{Hachemeister_75}, optionally with the intercept at the barycenter of time \citep[Section~8.4]{Buhlmann_Gisler}; linear Bayes models. The modular design of \code{cm} makes it easy to add new models if desired. This section concentrates on usage of \code{cm} for hierarchical models. There are some variations in the formulas of the hierarchical model in the literature. We compute the credibility premiums as given in \cite{BJ_87} or \cite{Buhlmann_Gisler}, supporting three types of estimators of the between variance structure parameters: the unbiased estimators of \cite{Buhlmann_Gisler} (the default), the slightly different version of \cite{Ohlsson} and the iterative pseudo-estimators as found in \cite{LivreVert} or \cite{Goulet_JAP}. Consider an insurance portfolio where \emph{entities} are classified into \emph{cohorts}. In our terminology, this is a two-level hierarchical classification structure. The observations are claim amounts $S_{ijt}$, where index $i = 1, \dots, I$ identifies the cohort, index $j = 1, \dots, J_i$ identifies the entity within the cohort and index $t = 1, \dots, n_{ij}$ identifies the period (usually a year). To each data point corresponds a weight --- or volume --- $w_{ijt}$. Then, the best linear prediction for the next period outcome of a entity based on ratios $X_{ijt} = S_{ijt}/w_{ijt}$ is \begin{equation} \label{eq:hierarchical:premiums} \begin{split} \hat{\pi}_{ij} &= z_{ij} X_{ijw} + (1 - z_{ij}) \hat{\pi}_i \\ \hat{\pi}_i &= z_i X_{izw} + (1 - z_i) m, \end{split} \end{equation} with the credibility factors \begin{align*} z_{ij} &= \frac{w_{ij\pt}}{w_{ij\pt} + s^2/a}, & w_{ij\pt} &= \sum_{t = 1}^{n_{ij}} w_{ijt} \\ z_{i} &= \frac{z_{i\pt}}{z_{i\pt} + a/b}, & z_{i\pt} &= \sum_{j = 1}^{J_i} z_{ij} \end{align*} and the weighted averages \begin{align*} X_{ijw} &= \sum_{t = 1}^{n_{ij}} \frac{w_{ijt}}{w_{ij\pt}}\, X_{ijt} \\ X_{izw} &= \sum_{j = 1}^{J_i} \frac{z_{ij}}{z_{i\pt}}\, X_{ijw}. \end{align*} The estimator of $s^2$ is \begin{equation} \label{eq:s2} \hat{s}^2 = \frac{1}{\sum_{i = 1}^I \sum_{j = 1}^{J_i} (n_{ij} - 1)} \sum_{i = 1}^I \sum_{j = 1}^{J_i} \sum_{t = 1}^{n_{ij}} w_{ijt} (X_{ijt} - X_{ijw})^2. \end{equation} The three types of estimators for the variance components $a$ and $b$ are the following. First, let \begin{align*} A_i &= \sum_{j = 1}^{J_i} w_{ij\pt} (X_{ijw} - X_{iww})^2 - (J_i - 1) s^2 & c_i &= w_{i\pt\pt} - \sum_{j = 1}^{J_i} \frac{w_{ij\pt}^2}{w_{i\pt\pt}} \\ B &= \sum_{i = 1}^I z_{i\pt} (X_{izw} - \bar{X}_{zzw})^2 - (I - 1) a & d &= z_{\pt\pt} - \sum_{i = 1}^I \frac{z_{i\pt}^2}{z_{\pt\pt}}, \end{align*} with \begin{equation} \label{eq:Xbzzw} \bar{X}_{zzw} = \sum_{i = 1}^I \frac{z_{i\pt}}{z_{\pt\pt}}\, X_{izw}. \end{equation} (Hence, $\E{A_i} = c_i a$ and $\E{B} = d b$.) Then, the Bühlmann--Gisler estimators are \begin{align} \label{eq:ac-BG} \hat{a} &= \frac{1}{I} \sum_{i = 1}^I \max \left( \frac{A_i}{c_i}, 0 \right) \\ \label{eq:bc-BG} \hat{b} &= \max \left( \frac{B}{d}, 0 \right), \end{align} the Ohlsson estimators are \begin{align} \label{eq:ac-Ohl} \hat{a}^\prime &= \frac{\sum_{i = 1}^I A_i}{\sum_{i = 1}^I c_i} \\ \label{eq:bc-Ohl} \hat{b}^\prime &= \frac{B}{d} \end{align} and the iterative (pseudo-)estimators are \begin{align} \label{eq:at} \tilde{a} &= \frac{1}{\sum_{i = 1}^I (J_i - 1)} \sum_{i = 1}^I \sum_{j = 1}^{J_i} z_{ij} (X_{ijw} - X_{izw})^2 \\ \label{eq:bt} \tilde{b} &= \frac{1}{I - 1} \sum_{i = 1}^I z_i (X_{izw} - X_{zzw})^2, \end{align} where \begin{equation} \label{eq:Xzzw} X_{zzw} = \sum_{i = 1}^I \frac{z_i}{z_\pt}\, X_{izw}. \end{equation} Note the difference between the two weighted averages \eqref{eq:Xbzzw} and \eqref{eq:Xzzw}. See \cite{cm} for further discussion on this topic. Finally, the estimator of the collective mean $m$ is $\hat{m} = X_{zzw}$. The credibility modeling function \code{cm} assumes that data is available in the format most practical applications would use, namely a rectangular array (matrix or data frame) with entity observations in the rows and with one or more classification index columns (numeric or character). One will recognize the output format of \code{rcomphierarc} and its summary methods. Then, function \code{cm} works much the same as \code{lm}. It takes in argument: a formula of the form \code{\~{} terms} describing the hierarchical interactions in a data set; the data set containing the variables referenced in the formula; the names of the columns where the ratios and the weights are to be found in the data set. The latter should contain at least two nodes in each level and more than one period of experience for at least one entity. Missing values are represented by \code{NA}s. There can be entities with no experience (complete lines of \code{NA}s). In order to give an easily reproducible example, we group states 1 and 3 of the Hachemeister data set into one cohort and states 2, 4 and 5 into another. This shows that data does not have to be sorted by level. The fitted model below uses the iterative estimators of the variance components. <>= X <- cbind(cohort = c(1, 2, 1, 2, 2), hachemeister) fit <- cm(~cohort + cohort:state, data = X, ratios = ratio.1:ratio.12, weights = weight.1:weight.12, method = "iterative") fit @ The function returns a fitted model object of class \code{"cm"} containing the estimators of the structure parameters. To compute the credibility premiums, one calls a method of \code{predict} for this class. <>= predict(fit) @ One can also obtain a nicely formatted view of the most important results with a call to \code{summary}. <>= summary(fit) @ The methods of \code{predict} and \code{summary} can both report for a subset of the levels by means of an argument \code{levels}. <>= summary(fit, levels = "cohort") predict(fit, levels = "cohort") @ \section{Bühlmann and Bühlmann--Straub models} \label{sec:buhlmann} As mentioned above, the Bühlmann and Bühlmann--Straub models are simply one-level hierarchical models. In this case, the Bühlmann--Gisler and Ohlsson estimators of the between variance parameters are both identical to the usual \cite{BS_70} estimator \begin{equation} \label{eq:a-hat} \hat{a} = \frac{w_{\pt\pt}}{w_{\pt\pt}^2 - \sum_{i=1}^I w_{i\pt}^2} \left( \sum_{i=1}^I w_{i\pt} (X_{iw} - X_{ww})^2 - (I - 1) \hat{s}^2 \right), \end{equation} and the iterative estimator \begin{equation} \label{eq:a-tilde} \tilde{a} = \frac{1}{I - 1} \sum_{i = 1}^I z_i (X_{iw} - X_{zw})^2 \end{equation} is better known as the Bichsel--Straub estimator. To fit the Bühlmann model using \code{cm}, one simply does not specify any weights. <>= cm(~state, hachemeister, ratios = ratio.1:ratio.12) @ When weights are specified together with a one-level model, \code{cm} automatically fits the Bühlmann--Straub model to the data. In the example below, we use the Bichsel--Straub estimator for the between variance. <>= cm(~state, hachemeister, ratios = ratio.1:ratio.12, weights = weight.1:weight.12) @ \section{Regression model of Hachemeister} \label{sec:regression} The credibility regression model of \cite{Hachemeister_75} is a generalization of the Bühlmann--Straub model. If data shows a systematic trend, the latter model will typically under- or over-estimate the true premium of an entity. The idea of \citeauthor{Hachemeister_75} was to fit to the data a regression model where the parameters are a credibility weighted average of an entity's regression parameters and the group's parameters. In order to use \code{cm} to fit a credibility regression model to a data set, one simply has to supply as additional arguments \code{regformula} and \code{regdata}. The first one is a formula of the form \code{\~{} terms} describing the regression model, and the second is a data frame of regressors. That is, arguments \code{regformula} and \code{regdata} are in every respect equivalent to arguments \code{formula} and \code{data} of \code{lm}, with the minor difference that \code{regformula} does not need to have a left hand side (and is ignored if present). Below, we fit the model \begin{displaymath} X_{it} = \beta_0 + \beta_1 t + \varepsilon_t, \quad t = 1, \dots, 12 \end{displaymath} to the original data set of \cite{Hachemeister_75}. <>= fit <- cm(~state, hachemeister, regformula = ~ time, regdata = data.frame(time = 1:12), ratios = ratio.1:ratio.12, weights = weight.1:weight.12) fit @ To compute the credibility premiums, one has to provide the ``future'' values of the regressors as in \code{predict.lm}. <>= predict(fit, newdata = data.frame(time = 13)) @ It is well known that the basic regression model has a major drawback: there is no guarantee that the credibility regression line will lie between the collective and individual ones. This may lead to grossly inadequate premiums, as Figure~\ref{fig:state4} shows. \begin{figure}[t] \centering <>= plot(NA, xlim = c(1, 13), ylim = c(1000, 2000), xlab = "", ylab = "") x <- cbind(1, 1:12) lines(1:12, x %*% fit$means$portfolio, col = "blue", lwd = 2) lines(1:12, x %*% fit$means$state[, 4], col = "red", lwd = 2, lty = 2) lines(1:12, x %*% coefficients(fit$adj.models[[4]]), col = "darkgreen", lwd = 2, lty = 3) points(13, predict(fit, newdata = data.frame(time = 13))[4], pch = 8, col = "darkgreen") legend("bottomright", legend = c("collective", "individual", "credibility"), col = c("blue", "red", "darkgreen"), lty = 1:3) @ \caption{Collective, individual and credibility regression lines for State 4 of the Hachemeister data set. The point indicates the credibility premium.} \label{fig:state4} \end{figure} The solution proposed by \cite{Buhlmann:regression:1997} is simply to position the intercept not at time origin, but instead at the barycenter of time \citep[see also][Section~8.4]{Buhlmann_Gisler}. In mathematical terms, this essentially amounts to using an orthogonal design matrix. By setting the argument \code{adj.intercept} to \code{TRUE} in the call, \code{cm} will automatically fit the credibility regression model with the intercept at the barycenter of time. The resulting regression coefficients have little meaning, but the predictions are sensible. <>= fit2 <- cm(~state, hachemeister, regformula = ~ time, regdata = data.frame(time = 1:12), adj.intercept = TRUE, ratios = ratio.1:ratio.12, weights = weight.1:weight.12) summary(fit2, newdata = data.frame(time = 13)) @ % Figure~\ref{fig:state4:2} shows the beneficient effect of the intercept adjustment on the premium of State~4. \begin{figure}[t] \centering <>= plot(NA, xlim = c(1, 13), ylim = c(1000, 2000), xlab = "", ylab = "") x <- cbind(1, 1:12) R <- fit2$transition lines(1:12, x %*% solve(R, fit2$means$portfolio), col = "blue", lwd = 2) lines(1:12, x %*% solve(R, fit2$means$state[, 4]), col = "red", lwd = 2, lty = 2) lines(1:12, x %*% solve(R, coefficients(fit2$adj.models[[4]])), col = "darkgreen", lwd = 2, lty = 3) points(13, predict(fit2, newdata = data.frame(time = 13))[4], pch = 8, col = "darkgreen") legend("bottomright", legend = c("collective", "individual", "credibility"), col = c("blue", "red", "darkgreen"), lty = 1:3) @ \caption{Collective, individual and credibility regression lines for State 4 of the Hachemeister data set when the intercept is positioned at the barycenter of time. The point indicates the credibility premium.} \label{fig:state4:2} \end{figure} \section{Linear Bayes model} \label{sec:bayes} In the pure bayesian approach to the ratemaking problem, we assume that the observations $X_t$, $t = 1, \dots, n$, of an entity depend on its risk level $\theta$, and that this risk level is a realization of an unobservable random variable $\Theta$. The best (in the mean square sense) approximation to the unknown risk premium $\mu(\theta) = \E{X_t|\Theta = \theta}$ based on observations $X_1, \dots, X_n$ is the Bayesian premium \begin{equation*} B_{n + 1} = \E{\mu(\Theta)|X_1, \dots, X_n}. \end{equation*} It is then well known \citep{Buhlmann_Gisler,LossModels4e} that for some combinaisons of distributions, the Bayesian premium is linear and can written as a credibility premium \begin{equation*} B_{n + 1} = z \bar{X} + (1 - z) m, \end{equation*} where $m = \E{\mu(\Theta)}$ and $z = n/(n + K)$ for some constant $K$. The combinations of distributions yielding a linear Bayes premium involve members of the univariate exponential family for the distribution of $X|\Theta = \theta$ and their natural conjugate for the distribution of $\Theta$: \begin{itemize} \item $X|\Theta = \theta \sim \text{Poisson}(\theta)$, $\Theta \sim \text{Gamma}(\alpha, \lambda)$; \item $X|\Theta = \theta \sim \text{Exponential}(\theta)$, $\Theta \sim \text{Gamma}(\alpha, \lambda)$; \item $X|\Theta = \theta \sim \text{Normal}(\theta, \sigma^2_2)$, $\Theta \sim \text{Normal}(\mu, \sigma^2_1)$; \item $X|\Theta = \theta \sim \text{Bernoulli}(\theta)$, $\Theta \sim \text{Beta}(a, b)$; \item $X|\Theta = \theta \sim \text{Geometric}(\theta)$, $\Theta \sim \text{Beta}(a, b)$; \end{itemize} and the convolutions \begin{itemize} \item $X|\Theta = \theta \sim \text{Gamma}(\tau, \theta)$, $\Theta \sim \text{Gamma}(\alpha, \lambda)$; \item $X|\Theta = \theta \sim \text{Binomial}(\nu, \theta)$, $\Theta \sim \text{Beta}(a, b)$; \item $X|\Theta = \theta \sim \text{Negative Binomial}(r, \theta)$ and $\Theta \sim \text{Beta}(a, b)$. \end{itemize} \autoref{sec:formulas} provides the complete formulas for the above combinations of distributions. In addition, \citet[section~2.6]{Buhlmann_Gisler} show that if $X|\Theta = \theta \sim \text{Single Parameter Pareto}(\theta, x_0)$ and $\Theta \sim \text{Gamma}(\alpha, \lambda)$, then the Bayesian estimator of parameter $\theta$ --- not of the risk premium! --- is \begin{equation*} \hat{\Theta} = \eta \hat{\theta}^{\text{MLE}} + (1 - \eta) \frac{\alpha}{\lambda}, \end{equation*} where \begin{equation*} \hat{\theta}^{\text{MLE}} = \frac{n}{\sum_{i = 1}^n \ln (X_i/x_0)} \end{equation*} is the maximum likelihood estimator of $\theta$ and \begin{equation*} \eta = \frac{\sum_{i = 1}^n \ln (X_i/x_0)}{% \lambda + \sum_{i = 1}^n \ln (X_i/x_0)} \end{equation*} is a weight not restricted to $(0, 1)$. (See the \code{"distributions"} package vignette for details on the Single Parameter Pareto distribution.) When argument \code{formula} is \code{"bayes"}, function \code{cm} computes pure Bayesian premiums --- or estimator in the Pareto/Gamma case --- for the combinations of distributions above. We identify which by means of argument \code{likelihood} that must be one of % \code{"poisson"}, % \code{"exponential"}, % \code{"gamma"}, % \code{"normal"}, % \code{"bernoulli"}, % \code{"binomial"}, % \code{"geometric"}, % \code{"negative binomial"} or % \code{"pareto"}. % The parameters of the distribution of $X|\Theta = \theta$, if any, and those of the distribution of $\Theta$ are specified using the argument names (and default values) of \code{dgamma}, \code{dnorm}, \code{dbeta}, \code{dbinom}, \code{dnbinom} or \code{dpareto1}, as appropriate. Consider the case where \begin{align*} X|\Theta = \theta &\sim \text{Poisson}(\theta) \\ \Theta &\sim \text{Gamma}(\alpha, \lambda). \end{align*} The posterior distribution of $\Theta$ is \begin{equation*} \Theta|X_1, \dots, X_n \sim \text{Gamma} \left( \alpha + \sum_{t = 1}^n X_t, \lambda + n \right). \end{equation*} Therefore, the Bayesian premium is \begin{align*} B_{n + 1} &= \E{\mu(\Theta)|X_1, \dots, X_n} \\ &= \E{\Theta|X_1, \dots, X_n} \\ &= \frac{\alpha + \sum_{t = 1}^n X_t}{\lambda + n} \\ &= \frac{n}{n + \lambda}\, \bar{X} + \frac{\lambda}{n + \lambda} \frac{\alpha}{\lambda} \\ &= z \bar{X} + (1 - z) m, \end{align*} with $m = \E{\mu(\Theta)} = \E{\Theta} = \alpha/\lambda$ and \begin{equation*} z = \frac{n}{n + K}, \quad K = \lambda. \end{equation*} One may easily check that if $\alpha = \lambda = 3$ and $X_1 = 5, X_2 = 3, X_3 = 0, X_4 = 1, X_5 = 1$, then $B_6 = 1.625$. We obtain the same result using \code{cm}. <>= x <- c(5, 3, 0, 1, 1) fit <- cm("bayes", x, likelihood = "poisson", shape = 3, rate = 3) fit predict(fit) summary(fit) @ \appendix \section{Linear Bayes formulas} \label{sec:formulas} This appendix provides the main linear Bayes credibility results for combinations of a likelihood function member of the univariate exponential family with its natural conjugate. For each combination, we provide, other than the names of the distributions of $X|\Theta = \theta$ and $\Theta$: \begin{itemize} \item the posterior distribution $\Theta|X_1 = x_1, \dots, X_n = x_n$, always of the same type as the prior, only with updated parameters; \item the risk premium $\mu(\theta) = \E{X|\Theta = \theta}$; \item the collective premium $m = \E{\mu(\Theta)}$; \item the Bayesian premium $B_{n+1} = \E{\mu(\Theta)|X_1, \dots, X_n}$, always equal to the collective premium evaluated at the parameters of the posterior distribution; \item the credibility factor when the Bayesian premium is expressed as a credibility premium. \end{itemize} %% Compact Listes à puce compactes et sans puce, justement. \begingroup \setlist[itemize]{label={},leftmargin=0pt,align=left,nosep} \subsection{Bernoulli/beta case} \begin{itemize} \item $X|\Theta = \theta \sim \text{Bernoulli}(\theta)$ \item $\Theta \sim \text{Beta}(a, b)$ \item $\Theta|X_1 = x_1, \dots, X_n = x_n \sim \text{Beta}(\tilde{a}, \tilde{b})$ \begin{align*} \tilde{a} &= a + \sum_{t = 1}^n x_t \\ \tilde{b} &= b + n - \sum_{t = 1}^n x_t \end{align*} \item Risk premium \begin{equation*} \mu(\theta) = \theta \end{equation*} \item Collective premium \begin{equation*} m = \frac{a}{a + b} \end{equation*} \item Bayesian premium \begin{equation*} B_{n + 1} = \frac{a + \sum_{t = 1}^n X_t}{a + b + n} \end{equation*} \item Credibility factor \begin{equation*} z = \frac{n}{n + a + b} \end{equation*} \end{itemize} \subsection{Binomial/beta case} \begin{itemize} \item $X|\Theta = \theta \sim \text{Binomial}(\nu, \theta)$ \item $\Theta \sim \text{Beta}(a, b)$ \item $\Theta|X_1 = x_1, \dots, X_n = x_n \sim \text{Beta}(\tilde{a}, \tilde{b})$ \begin{align*} \tilde{a} &= a + \sum_{t = 1}^n x_t \\ \tilde{b} &= b + n \nu - \sum_{t = 1}^n x_t \end{align*} \item Risk premium \begin{equation*} \mu(\theta) = \nu \theta \end{equation*} \item Collective premium \begin{equation*} m = \frac{\nu a}{a + b} \end{equation*} \item Bayesian premium \begin{equation*} B_{n + 1} = \frac{\nu (a + \sum_{t = 1}^n X_t)}{a + b + n \nu} \end{equation*} \item Credibility factor \begin{equation*} z = \frac{n}{n + (a + b)/\nu} \end{equation*} \end{itemize} \subsection{Geometric/Beta case} \begin{itemize} \item $X|\Theta = \theta \sim \text{Geometric}(\theta)$ \item $\Theta \sim \text{Beta}(a, b)$ \item $\Theta|X_1 = x_1, \dots, X_n = x_n \sim \text{Beta}(\tilde{a}, \tilde{b})$ \begin{align*} \tilde{a} &= a + n \\ \tilde{b} &= b + \sum_{t = 1}^n x_t \end{align*} \item Risk premium \begin{equation*} \mu(\theta) = \frac{1 - \theta}{\theta} \end{equation*} \item Collective premium \begin{equation*} m = \frac{b}{a - 1} \end{equation*} \item Bayesian premium \begin{equation*} B_{n + 1} = \frac{b + \sum_{t = 1}^n X_t}{a + n - 1} \end{equation*} \item Credibility factor \begin{equation*} z = \frac{n}{n + a - 1} \end{equation*} \end{itemize} \subsection{Negative binomial/Beta case} \begin{itemize} \item $X|\Theta = \theta \sim \text{Negative binomial}(r, \theta)$ \item $\Theta \sim \text{Beta}(a, b)$ \item $\Theta|X_1 = x_1, \dots, X_n = x_n \sim \text{Beta}(\tilde{a}, \tilde{b})$ \begin{align*} \tilde{a} &= a + n r \\ \tilde{b} &= b + \sum_{t = 1}^n x_t \end{align*} \item Risk premium \begin{equation*} \mu(\theta) = \frac{r (1 - \theta)}{\theta} \end{equation*} \item Collective premium \begin{equation*} m = \frac{r b}{a - 1} \end{equation*} \item Bayesian premium \begin{equation*} B_{n + 1} = \frac{r (b + \sum_{t = 1}^n X_t)}{a + n r - 1} \end{equation*} \item Credibility factor \begin{equation*} z = \frac{n}{n + (a - 1)/r} \end{equation*} \end{itemize} \subsection{Poisson/Gamma case} \begin{itemize} \item $X|\Theta = \theta \sim \text{Poisson}(\theta)$ \item $\Theta \sim \text{Gamma}(\alpha, \lambda)$ \item $\Theta|X_1 = x_1, \dots, X_n = x_n \sim \text{Gamma}(\tilde{\alpha}, \tilde{\lambda})$ \begin{align*} \tilde{\alpha} &= \alpha + \sum_{t = 1}^n x_t \\ \tilde{\lambda} &= \lambda + n \end{align*} \item Risk premium \begin{equation*} \mu(\theta) = \theta \end{equation*} \item Collective premium \begin{equation*} m = \frac{\alpha}{\lambda} \end{equation*} \item Bayesian premium \begin{equation*} B_{n + 1} = \frac{\alpha + \sum_{t = 1}^n X_t}{\lambda + n} \end{equation*} \item Credibility factor \begin{equation*} z = \frac{n}{n + \lambda} \end{equation*} \end{itemize} \subsection{Exponential/Gamma case} \begin{itemize} \item $X|\Theta = \theta \sim \text{Exponential}(\theta)$ \item $\Theta \sim \text{Gamma}(\alpha, \lambda)$ \item $\Theta|X_1 = x_1, \dots, X_n = x_n \sim \text{Gamma}(\tilde{\alpha}, \tilde{\lambda})$ \begin{align*} \tilde{\alpha} &= \alpha + n \\ \tilde{\lambda} &= \lambda + \sum_{t = 1}^n x_t \end{align*} \item Risk premium \begin{equation*} \mu(\theta) = \frac{1}{\theta} \end{equation*} \item Collective premium \begin{equation*} m = \frac{\lambda}{\alpha - 1} \end{equation*} \item Bayesian premium \begin{equation*} B_{n + 1} = \frac{\lambda + \sum_{t = 1}^n X_t}{\alpha + n - 1} \end{equation*} \item Credibility factor \begin{equation*} z = \frac{n}{n + \alpha - 1} \end{equation*} \end{itemize} \subsection{Gamma/Gamma case} \begin{itemize} \item $X|\Theta = \theta \sim \text{Gamma}(\tau, \theta)$ \item $\Theta \sim \text{Gamma}(\alpha, \lambda)$ \item $\Theta|X_1 = x_1, \dots, X_n = x_n \sim \text{Gamma}(\tilde{\alpha}, \tilde{\lambda})$ \begin{align*} \tilde{\alpha} &= \alpha + n \tau \\ \tilde{\lambda} &= \lambda + \sum_{t = 1}^n x_t \end{align*} \item Risk premium \begin{equation*} \mu(\theta) = \frac{\tau}{\theta} \end{equation*} \item Collective premium \begin{equation*} m = \frac{\tau \lambda}{\alpha - 1} \end{equation*} \item Bayesian premium \begin{equation*} B_{n + 1} = \frac{\tau (\lambda + \sum_{t = 1}^n X_t)}{\alpha + n \tau - 1} \end{equation*} \item Credibility factor \begin{equation*} z = \frac{n}{n + (\alpha - 1)/\tau} \end{equation*} \end{itemize} \subsection{Normal/Normal case} \begin{itemize} \item $X|\Theta = \theta \sim \text{Normal}(\theta, \sigma_2^2)$ \item $\Theta \sim \text{Normal}(\mu, \sigma_1^2)$ \item $\Theta|X_1 = x_1, \dots, X_n = x_n \sim \text{Normal}(\tilde{\mu}, \tilde{\sigma}_1^2)$ \begin{align*} \tilde{\mu} &= \frac{\sigma_1^2 \sum_{t = 1}^n x_t + \sigma_2^2 \mu}{n \sigma_1^2 + \sigma_2^2} \\ \tilde{\sigma}_1^2 &= \frac{\sigma_1^2 \sigma_2^2}{n \sigma_1^2 + \sigma_2^2} \end{align*} \item Risk premium \begin{equation*} \mu(\theta) = \theta \end{equation*} \item Collective premium \begin{equation*} m = \mu \end{equation*} \item Bayesian premium \begin{equation*} B_{n + 1} = \frac{\sigma_1^2 \sum_{t = 1}^n X_t + \sigma_2^2 \mu}{n \sigma_1^2 + \sigma_2^2} \end{equation*} \item Credibility factor \begin{equation*} z = \frac{n}{n + \sigma_2^2/\sigma_1^2} \end{equation*} \end{itemize} \endgroup \bibliography{actuar} \end{document} %%% Local Variables: %%% mode: noweb %%% TeX-master: t %%% coding: utf-8 %%% End: actuar/vignettes/actuar.Rnw0000644000176200001440000000503414370340204015507 0ustar liggesusers\input{share/preamble} %\VignetteIndexEntry{Introduction to actuar} %\VignettePackage{actuar} %\SweaveUTF8 \title{Introduction to \pkg{actuar}} \author{Christophe Dutang \\ Université Paris Dauphine \\[3ex] Vincent Goulet \\ Université Laval \\[3ex] Mathieu Pigeon \\ Université du Québec à Montréal} \date{} \begin{document} \maketitle \section{Introduction} \label{sec:introduction} \pkg{actuar} \citep{actuar} provides additional actuarial science functionality and support for heavy tailed distributions to the R statistical system. The project was officially launched in 2005 and is under active development. The current feature set of the package can be split into five main categories: additional probability distributions; loss distributions modeling; risk and ruin theory; simulation of compound hierarchical models; credibility theory. Furthermore, starting with version 3.0-0, \pkg{actuar} gives easy access to many of its underlying C workhorses through an API. As much as possible, the developers have tried to keep the ``user interface'' of the various functions of the package consistent. Moreover, the package follows the general R philosophy of working with model objects. This means that instead of merely returning, say, a vector of probabilities, many functions will return an object containing, among other things, the said probabilities. The object can then be manipulated at one's will using various extraction, summary or plotting functions. \section{Documentation} In addition to the help pages, \pkg{actuar} ships with extensive vignettes and demonstration scripts; run the following commands at the R prompt to obtain the list of each. <>= vignette(package = "actuar") demo(package = "actuar") @ \section{Collaboration and citation} If you use R or \pkg{actuar} for actuarial analysis, please cite the software in publications. For information on how to cite the software, use: <>= citation() citation("actuar") @ \section*{Acknowledgments} The package would not be at this stage of development without the stimulating contribution of Sébastien Auclair, Christophe Dutang, Nicholas Langevin, Xavier Milhaud, Tommy Ouellet and Louis-Philippe Pouliot. This research benefited from financial support from the Natural Sciences and Engineering Research Council of Canada and from the \emph{Chaire d'actuariat} (Actuarial Science Foundation) of Université Laval. \bibliography{actuar} \end{document} %%% Local Variables: %%% mode: noweb %%% TeX-master: t %%% coding: utf-8 %%% End: actuar/vignettes/distributions.Rnw0000644000176200001440000017461714370340204017150 0ustar liggesusers\input{share/preamble} %\VignetteIndexEntry{Additional continuous and discrete distributions} %\VignettePackage{actuar} %\SweaveUTF8 \title{Inventory of continuous and discrete distributions in \pkg{actuar}} \author{Christophe Dutang \\ Université Paris Dauphine \\[3ex] Vincent Goulet \\ Université Laval \\[3ex] Nicholas Langevin \\ Université Laval \\[3ex] Mathieu Pigeon \\ Université du Québec à Montréal} \date{} %% Compact, sans label itemize environment for the appendices. \setlist[itemize]{label={},leftmargin=0pt,align=left,nosep,midpenalty=10000} \begin{document} \maketitle \section{Introduction} \label{sec:introduction} R includes functions to compute the probability density function (pdf) or the probability mass function (pmf), the cumulative distribution function (cdf) and the quantile function, as well as functions to generate variates from a fair number of continuous and discrete distributions. For some root \code{foo}, the support functions are named \code{dfoo}, \code{pfoo}, \code{qfoo} and \code{rfoo}, respectively. Package \pkg{actuar} provides \code{d}, \code{p}, \code{q} and \code{r} functions for a large number of continuous size distributions useful for loss severity modeling; for phase-type distributions used in computation of ruin probabilities; for zero-truncated and zero-modified extensions of the discrete distributions commonly used in loss frequency modeling; for the heavy tailed Poisson-inverse Gaussian discrete distribution. The package also introduces support functions to compute raw moments, limited moments and the moment generating function (when it exists) of continuous distributions. \section{Additional continuous size distributions} \label{sec:continuous} The package provides support functions for all the probability distributions found in Appendix~A of \citet{LossModels4e} and not already present in base R, excluding the log-$t$, but including the loggamma distribution \citep{HoggKlugman}, as well as for the Feller--Pareto distribution and related Pareto distributions with a location parameter \citep{Arnold:pareto:2ed}. These distributions mostly fall under the umbrella of extreme value or heavy tailed distributions. \autoref{tab:continuous} lists the distributions supported by \pkg{actuar} along with the root names of the R functions. \autoref{sec:app:continuous} details the formulas implemented and the name of the argument corresponding to each parameter. By default, all functions (except those for the Pareto distribution) use a rate parameter equal to the inverse of the scale parameter. This differs from \citet{LossModels4e} but is better in line with the functions for the gamma, exponential and Weibull distributions in base R. \begin{table} \centering \begin{tabular}{lll} \toprule Family & Distribution & Root \\ \midrule Feller--Pareto & Feller--Pareto & \code{fpareto} \\ & Pareto IV & \code{pareto4} \\ & Pareto III & \code{pareto3} \\ & Pareto II & \code{pareto2} \\ & Transformed beta & \code{trbeta} \\ & Burr & \code{burr} \\ & Loglogistic & \code{llogis} \\ & Paralogistic & \code{paralogis} \\ & Generalized Pareto & \code{genpareto} \\ & Pareto & \code{pareto} \\ & Single-parameter Pareto & \code{pareto1} \\ & Inverse Burr & \code{invburr} \\ & Inverse Pareto & \code{invpareto} \\ & Inverse paralogistic & \code{invparalogis} \\ \midrule Transformed gamma & Transformed gamma & \code{trgamma} \\ & Inverse transformed gamma & \code{invtrgamma} \\ & Inverse gamma & \code{invgamma} \\ & Inverse Weibull & \code{invweibull} \\ & Inverse exponential & \code{invexp} \\ \midrule Other & Loggamma & \code{lgamma} \\ & Gumbel & \code{gumbel} \\ & Inverse Gaussian & \code{invgauss} \\ & Generalized beta & \code{genbeta} \\ \bottomrule \end{tabular} \caption{Probability distributions supported by \pkg{actuar} classified by family and root names of the R functions.} \label{tab:continuous} \end{table} We mostly use the nomenclature of \citet{LossModels4e} to classify the continuous distributions supported by \pkg{actuar}. However, following \citet{Arnold:pareto:2ed}, we regroup distributions of the transformed beta family and variants of the Pareto distribution inside the larger Feller--Pareto family of distributions. \autoref{fig:diagram:fp-family} shows the relationships between the distributions of the Feller--Pareto and transformed beta families. \autoref{fig:diagram:trgamma-family} does the same for the distributions of the transformed gamma and inverse transformed gamma families. \begin{figure} \centering \setlength{\unitlength}{0.7cm} \begin{picture}(16.9,10.75)(-0.7,-0.4) \small % Flèches \put(8,6){\vector(2,-1){3.7}} % trbeta -> invburr \put(13,4.2){\vector(0,1){0.95}} % invburr -> invparalogis \put(11.7,3.1){\line(-1,-1){1}} \put(10.7,2.1){\line(-1,0){7.7}} \put(3,2.1){\vector(-1,-1){1.1}} % invburr -> llogis \put(13,3){\vector(0,-1){2}} % invburr -> invpareto \put(2.05,3.1){\vector(2,-1){4.2}} % burr -> pareto \put(1,3){\vector(0,-1){2}} % burr -> llogis \put(6,6){\vector(-2,-1){3.85}} % trbeta -> burr \put(1,4.2){\vector(0,1){0.95}} % burr -> paralogis \put(7,6){\vector(0,-1){1.8}} % trbeta -> genpareto \put(7,9){\vector(0,-1){1.8}} % fpareto -> trbeta \put(7,3){\vector(0,-1){2}} % genpareto -> pareto \put(8,3){\vector(2,-1){4}} % genpareto -> invpareto % \put(6,9){\vector(-2,-1){3.3}} % fpareto -> pareto3 % \put(8,9){\vector(2,-1){3.3}} % fpareto -> pareto1 \put(1,9){\vector(0,-1){1.1}} % pareto4 -> pareto3 \put(13,9){\vector(0,-1){1.1}} % pareto2 -> pareto1 \put(4.5,9.6){\vector(-1,0){1.75}} % fpareto -> pareto4 \put(9.5,9.6){\vector(1,0){1.75}} % fpareto -> pareto2 \put(14.7,9.6){\line(1,0){1.5}} % pareto2 -> pareto \put(16.2,9.6){\line(0,-1){10}} \put(16.2,-0.4){\line(-1,0){7.5}} \put(8.7,-0.4){\vector(-2,1){0.72}} \put(14.8,9.62){\makebox(0,0.5)[l]{$\mu = 0$}} \put(7,9.65){\makebox(0,0.5)[c]{Feller-Pareto}} \put(7,9.1){\makebox(0,0.5)[c]{$\mu, \alpha, \gamma, \tau, \theta$}} \put(7,9.6){\oval(5,1.2)} \put(3.2,9.65){\makebox(0,0.5)[l]{$\tau = 1$}} \put(1,9.65){\makebox(0,0.5)[c]{Pareto IV}} \put(1,9.1){\makebox(0,0.5)[c]{$\mu, \alpha, \gamma, \theta$}} \put(1,9.6){\oval(3.4,1.2)} \put(9.8,9.05){\makebox(0,0.5)[l]{$\gamma = 1$}} \put(9.8,9.65){\makebox(0,0.5)[l]{$\tau = 1$}} \put(13,9.65){\makebox(0,0.5)[c]{Pareto II}} \put(13,9.1){\makebox(0,0.5)[c]{$\mu,\alpha, \theta$}} \put(13,9.6){\oval(3.4,1.2)} \put(0.8,8.3){\makebox(0,0.5)[r]{$\alpha = 1$}} \put(1,7.35){\makebox(0,0.5)[c]{Pareto III}} \put(1,6.8){\makebox(0,0.5)[c]{$\mu, \gamma, \theta$}} \put(1,7.3){\oval(3.4,1.2)} \put(13.2,8.3){\makebox(0,0.5)[l]{$\mu = \theta$}} \put(13,7.35){\makebox(0,0.5)[c]{Pareto I}} \put(13,6.8){\makebox(0,0.5)[c]{$\alpha, \theta$}} \put(13,7.3){\oval(3.4,1.2)} \put(7.2,7.9){\makebox(0,0.5)[l]{$\mu = 0$}} \put(7,6.65){\makebox(0,0.5)[c]{Transformed beta}} \put(7,6.1){\makebox(0,0.5)[c]{$\alpha, \gamma, \tau, \theta$}} \put(7,6.6){\oval(5,1.2)} \put(9.2,5.4){\rotatebox{-26.6}{\makebox(0,0.5)[l]{$\alpha = 1$}}} \put(13.20,3.65){\makebox(0,0.5)[c]{Inverse Burr}} \put(13.20,3.1){\makebox(0,0.5)[c]{$\gamma, \tau, \theta$}} \put(13.20,3.6){\oval(3.4,1.2)} \put(13.2,4.3){\makebox(0,0.5)[l]{$\gamma = \tau$}} \put(13.20,5.80){\makebox(0,0.5)[c]{Inverse paralogistic}} \put(13.20,5.25){\makebox(0,0.5)[c]{$\tau, \theta$}} \put(13.20,5.75){\oval(5.4,1.2)} \put(13.2,1.9){\makebox(0,0.5)[l]{$\gamma = 1$}} \put(13.20,0.45){\makebox(0,0.5)[c]{Inverse Pareto}} \put(13.20,-0.1){\makebox(0,0.5)[c]{$\tau, \theta$}} \put(13.20,0.4){\oval(3.9,1.2)} \put(7.2,4.9){\makebox(0,0.5)[l]{$\gamma = 1$}} \put(7,3.65){\makebox(0,0.5)[c]{Generalized Pareto}} \put(7,3.1){\makebox(0,0.5)[c]{$\alpha, \tau, \theta$}} \put(7,3.6){\oval(4.9,1.2)} \put(7.2,1.25){\makebox(0,0.5)[l]{$\tau = 1$}} \put(7,0.45){\makebox(0,0.5)[c]{Pareto}} \put(7,-0.1){\makebox(0,0.5)[c]{$\alpha, \theta$}} \put(7,0.4){\oval(2.2,1.2)} \put(4.5,5.4){\rotatebox{26.6}{\makebox(0,0.5)[r]{$\tau = 1$}}} \put(1,3.65){\makebox(0,0.5)[c]{Burr}} \put(1,3.1){\makebox(0,0.5)[c]{$\alpha, \gamma, \theta$}} \put(1,3.6){\oval(2.5,1.2)} \put(0.8,4.3){\makebox(0,0.5)[r]{$\gamma = \alpha$}} \put(1,5.80){\makebox(0,0.5)[c]{Paralogistic}} \put(1,5.25){\makebox(0,0.5)[c]{$\alpha, \theta$}} \put(1,5.75){\oval(3.4,1.2)} \put(0.8,1.9){\makebox(0,0.5)[r]{$\alpha = 1$}} \put(1,0.45){\makebox(0,0.5)[c]{Loglogistic}} \put(1,-0.1){\makebox(0,0.5)[c]{$\gamma, \theta$}} \put(1,0.4){\oval(3.4,1.2)} \put(9.8,2.1){\rotatebox{-26.6}{\makebox(0,0.5)[r]{$\alpha = 1$}}} \put(4.0,2.1){\rotatebox{-26.6}{\makebox(0,0.5)[r]{$\gamma = 1$}}} \put(11.25,3.0){\rotatebox{45}{\makebox(0,0.5)[r]{$\tau = 1$}}} \end{picture} \caption{Interrelations between distributions of the Feller--Pareto family. This diagram is an extension of Figure~5.2 of \citet{LossModels4e}.} \label{fig:diagram:fp-family} \end{figure} \begin{figure} \setlength{\unitlength}{0.7cm} \begin{picture}(7.5,5.2)(-0.25,0) \small % Flèches \put(4,4){\vector(2,-1){1.55}} % trgamma -> weibull \put(5.55,2){\vector(-2,-1){1.55}} % weibull -> exp \put(1.55,2){\vector(2,-1){1.55}} % gamma -> exp \put(3,4){\vector(-2,-1){1.55}} % trgamma -> gamma \put(3.5,4.65){\makebox(0,0.5)[c]{Transformed gamma}} \put(3.5,4.1){\makebox(0,0.5)[c]{$\alpha, \tau, \lambda$}} \put(3.5,4.6){\oval(5.5,1.2)} \put(5.4,3.45){\makebox(0,0.5)[l]{$\alpha = 1$}} \put(6,2.65){\makebox(0,0.5)[c]{Weibull}} \put(6,2.1){\makebox(0,0.5)[c]{$\tau, \lambda$}} \put(6,2.6){\oval(2.5,1.2)} \put(5.4,1.35){\makebox(0,0.5)[l]{$\tau = 1$}} \put(3.5,0.65){\makebox(0,0.5)[c]{Exponential}} \put(3.5,0.1){\makebox(0,0.5)[c]{$\lambda$}} \put(3.5,0.6){\oval(3.5,1.2)} \put(1.6,1.35){\makebox(0,0.5)[r]{$\alpha = 1$}} \put(1,2.65){\makebox(0,0.5)[c]{Gamma}} \put(1,2.1){\makebox(0,0.5)[c]{$\alpha, \lambda$}} \put(1,2.6){\oval(2.5,1.2)} \put(1.6,3.45){\makebox(0,0.5)[r]{$\tau = 1$}} \end{picture} \hfill \begin{picture}(8.75,5.2)(-0.875,0) \small % Flèches \put(4,4){\vector(2,-1){1.55}} % trgamma -> weibull \put(5.55,2){\vector(-2,-1){1.55}} % weibull -> exp \put(1.55,2){\vector(2,-1){1.55}} % gamma -> exp \put(3,4){\vector(-2,-1){1.55}} % trgamma -> gamma \put(3.5,4.65){\makebox(0,0.5)[c]{Inverse transformed gamma}} \put(3.5,4.1){\makebox(0,0.5)[c]{$\alpha, \tau, \lambda$}} \put(3.5,4.6){\oval(7,1.2)} \put(5.4,3.45){\makebox(0,0.5)[l]{$\alpha = 1$}} \put(6,2.65){\makebox(0,0.5)[c]{Inverse Weibull}} \put(6,2.1){\makebox(0,0.5)[c]{$\tau, \lambda$}} \put(6,2.6){\oval(4,1.2)} \put(5.4,1.35){\makebox(0,0.5)[l]{$\tau = 1$}} \put(3.5,0.65){\makebox(0,0.5)[c]{Inverse exponential}} \put(3.5,0.1){\makebox(0,0.5)[c]{$\lambda$}} \put(3.5,0.6){\oval(5,1.2)} \put(1.6,1.35){\makebox(0,0.5)[r]{$\alpha = 1$}} \put(1,2.65){\makebox(0,0.5)[c]{Inverse gamma}} \put(1,2.1){\makebox(0,0.5)[c]{$\alpha, \lambda$}} \put(1,2.6){\oval(4,1.2)} \put(1.6,3.45){\makebox(0,0.5)[r]{$\tau = 1$}} \end{picture} \caption{Interrelations between distributions of the transformed gamma and inverse transformed gamma families. Diagrams derived from Figure~5.3 of \citet{LossModels4e}.} \label{fig:diagram:trgamma-family} \end{figure} In addition to the \code{d}, \code{p}, \code{q} and \code{r} functions, \pkg{actuar} introduces \code{m}, \code{lev} and \code{mgf} functions to compute, respectively, the theoretical raw moments \begin{equation*} m_k = \E{X^k}, \end{equation*} the theoretical limited moments \begin{equation*} \E{(X \wedge x)^k} = \E{\min(X, x)^k} \end{equation*} and the moment generating function \begin{equation*} M_X(t) = \E{e^{tX}}, \end{equation*} when it exists. Every distribution of \autoref{tab:continuous} is supported, along with the following distributions of base R: beta, exponential, chi-square, gamma, lognormal, normal (no \code{lev}), uniform and Weibull. The \code{m} and \code{lev} functions are especially useful for estimation methods based on the matching of raw or limited moments; see the \code{lossdist} vignette for their empirical counterparts. The \code{mgf} functions come in handy to compute the adjustment coefficient in ruin theory; see the \code{risk} vignette. \section{Phase-type distributions} \label{sec:phase-type} In addition to the 19 distributions of \autoref{tab:continuous}, the package provides support for a family of distributions deserving a separate presentation. Phase-type distributions \citep{Neuts_81} are defined as the distribution of the time until absorption of continuous time, finite state Markov processes with $m$ transient states and one absorbing state. Let \begin{equation} \label{eq:Markov-transition-matrix} \mat{Q} = \begin{bmatrix} \mat{T} & \mat{t} \\ \mat{0} & 0 \end{bmatrix} \end{equation} be the transition rates matrix (or intensity matrix) of such a process and let $(\mat{\pi}, \pi_{m + 1})$ be the initial probability vector. Here, $\mat{T}$ is an $m \times m$ non-singular matrix with $t_{ii} < 0$ for $i = 1, \dots, m$ and $t_{ij} \geq 0$ for $i \neq j$, $\mat{t} = - \mat{T} \mat{e}$ and $\mat{e}$ is a column vector with all components equal to 1. Then the cdf of the time until absorption random variable with parameters $\mat{\pi}$ and $\mat{T}$ is \begin{equation} \label{eq:cdf-phtype} F(x) = \begin{cases} \pi_{m + 1}, & x = 0, \\ 1 - \mat{\pi} e^{\mat{T} x} \mat{e}, & x > 0, \end{cases} \end{equation} where \begin{equation} \label{eq:matrix-exponential} e^{\mat{M}} = \sum_{n = 0}^\infty \frac{\mat{M}^n}{n!} \end{equation} is the matrix exponential of matrix $\mat{M}$. The exponential distribution, the Erlang (gamma with integer shape parameter) and discrete mixtures thereof are common special cases of phase-type distributions. The package provides \code{d}, \code{p}, \code{r}, \code{m} and \code{mgf} functions for phase-type distributions. The root is \code{phtype} and parameters $\mat{\pi}$ and $\mat{T}$ are named \code{prob} and \code{rates}, respectively; see also \autoref{sec:app:phase-type}. For the package, function \code{pphtype} is central to the evaluation of the ruin probabilities; see \code{?ruin} and the \code{risk} vignette. \section{Extensions to standard discrete distributions} \label{sec:discrete} The package introduces support functions for counting distributions commonly used in loss frequency modeling. A counting distribution is a discrete distribution defined on the non-negative integers $0, 1, 2, \dots$. Let $N$ be the counting random variable. We denote $p_k$ the probability that the random variable $N$ takes the value $k$, that is: \begin{equation*} p_k = \Pr[N = k]. \end{equation*} \citet{LossModels4e} classify counting distributions in two main classes. First, a discrete random variable is a member of the $(a, b, 0)$ class of distributions if there exists constants $a$ and $b$ such that \begin{equation*} \frac{p_k}{p_{k - 1}} = a + \frac{b}{k}, \quad k = 1, 2, \dots. \end{equation*} The probability at zero, $p_0$, is set such that $\sum_{k = 0}^\infty p_k = 1$. The members of this class are the Poisson, the binomial, the negative binomial and its special case, the geometric. These distributions are all well supported in base R with \code{d}, \code{p}, \code{q} and \code{r} functions. The second class of distributions is the $(a, b, 1)$ class. A discrete random variable is a member of the $(a, b, 1)$ class of distributions if there exists constants $a$ and $b$ such that \begin{equation*} \frac{p_k}{p_{k - 1}} = a + \frac{b}{k}, \quad k = 2, 3, \dots. \end{equation*} One will note that recursion starts at $k = 2$ for the $(a, b, 1)$ class. Therefore, the probability at zero can be any arbitrary number $0 \leq p_0 \leq 1$. Setting $p_0 = 0$ defines a subclass of so-called \emph{zero-truncated} distributions. The members of this subclass are the zero-truncated Poisson, the zero-truncated binomial, the zero-truncated negative binomial and the zero-truncated geometric. Let $p_k^T$ denote the probability mass in $k$ for a zero-truncated distribution. As above, $p_k$ denotes the probability mass for the corresponding member of the $(a, b, 0)$ class. We have \begin{equation*} p_k^T = \begin{cases} 0, & k = 0 \\ \displaystyle\frac{p_k}{1 - p_0}, & k = 1, 2, \dots. \end{cases} \end{equation*} Moreover, let $P(k)$ denotes the cumulative distribution function of a member of the $(a, b, 0)$ class. Then the cdf $P^T(k)$ of the corresponding zero-truncated distribution is \begin{equation*} P^T(k) = \frac{P(k) - P(0)}{1 - P(0)} = \frac{P(k) - p_0}{1 - p_0} \end{equation*} for all $k = 0, 1, 2, \dots$. Alternatively, the survival function $\bar{P}^T(k) = 1 - P^T(k)$ is \begin{equation*} \bar{P}^T(k) = \frac{\bar{P}(k)}{\bar{P}(0)} = \frac{\bar{P}(k)}{1 - p_0}. \end{equation*} Package \pkg{actuar} provides \code{d}, \code{p}, \code{q} and \code{r} functions for the all the zero-truncated distributions mentioned above. \autoref{tab:discrete} lists the root names of the functions; see \autoref{sec:app:discrete} for additional details. \begin{table} \centering \begin{tabular}{ll} \toprule Distribution & Root \\ \midrule Zero-truncated Poisson & \code{ztpois} \\ Zero-truncated binomial & \code{ztbinom} \\ Zero-truncated negative binomial & \code{ztnbinom} \\ Zero-truncated geometric & \code{ztgeom} \\ Logarithmic & \code{logarithmic} \\ \addlinespace[6pt] Zero-modified Poisson & \code{zmpois} \\ Zero-modified binomial & \code{zmbinom} \\ Zero-modified negative binomial & \code{zmnbinom} \\ Zero-modified geometric & \code{zmgeom} \\ Zero-modified logarithmic & \code{zmlogarithmic} \\ \bottomrule \end{tabular} \caption{Members of the $(a, b, 1)$ class of discrete distributions supported by \pkg{actuar} and root names of the R functions.} \label{tab:discrete} \end{table} An entry of \autoref*{tab:discrete} deserves a few additional words. The logarithmic (or log-series) distribution with parameter $\theta$ has pmf \begin{equation*} p_k = \frac{a \theta^x}{k}, \quad k = 1, 2, \dots, \end{equation*} with $a = -1/\log(1 - \theta)$ and for $0 \leq \theta < 1$. This is the standard parametrization in the literature \citep{Johnson:discrete:2005}. The logarithmic distribution is always defined on the strictly positive integers. As such, it is not qualified as ``zero-truncated'', but it nevertheless belongs to the $(a, b, 1)$ class of distributions, more specifically to the subclass with $p_0 = 0$. Actually, the logarithmic distribution is the limiting case of the zero-truncated negative binomial distribution with size parameter equal to zero and $\theta = 1 - p$, where $p$ is the probability of success for the zero-truncated negative binomial. Note that this differs from the presentation in \citet{LossModels4e}. Another subclass of the $(a, b, 1)$ class of distributions is obtained by setting $p_0$ to some arbitrary number $p_0^M$ subject to $0 < p_0^M \leq 1$. The members of this subclass are called \emph{zero-modified} distributions. Zero-modified distributions are discrete mixtures between a degenerate distribution at zero and the corresponding distribution from the $(a, b, 0)$ class. Let $p_k^M$ and $P^M(k)$ denote the pmf and cdf of a zero-modified distribution. Written as a mixture, the pmf is \begin{equation} \label{eq:mixture} p_k^M = \left(1 - \frac{1 - p_0^M}{1 - p_0} \right) \mathbb{1}_{\{k = 0\}} + \frac{1 - p_0^M}{1 - p_0}\, p_k. \end{equation} Alternatively, we have \begin{equation*} p_k^M = \begin{cases} p_0^M, & k = 0 \\ \displaystyle\frac{1 - p_0^M}{1 - p_0}\, p_k, & k = 1, 2, \dots \end{cases} \end{equation*} and \begin{align*} P^M(k) &= p_0^M + (1 - p_0^M) \frac{P(k) - P(0)}{1 - P(0)} \\ &= p_0^M + \frac{1 - p_0^M}{1 - p_0}\, (P(k) - p_0) \\ &= p_0^M + (1 - p_0^M)\, P^T(k) \end{align*} for all $k = 0, 1, 2, \dots$. The survival function is \begin{equation*} \bar{P}^M(k) = (1 - p_0^M)\, \frac{\bar{P}(k)}{\bar{P}(0)} = \frac{1 - p_0^M}{1 - p_0}\, \bar{P}(k) = (1 - p_0^M)\, \bar{P}^T(k). \end{equation*} Therefore, we can also write the pmf of a zero-modified distribution as a mixture of a degenerate distribution at zero and the corresponding zero-truncated distribution: \begin{equation} \label{eq:mixture:alt} p_k^M = p_0^M \mathbb{1}_{\{k = 0\}} + (1 - p_0^M)\, p_k^T. \end{equation} The members of the subclass are the zero-modified Poisson, zero-modified binomial, zero-modified negative binomial and zero-modified geometric, together with the zero-modified logarithmic as a limiting case of the zero-modified negative binomial. \autoref{tab:discrete} lists the root names of the support functions provided in \pkg{actuar}; see also \autoref{sec:app:discrete}. Quite obviously, zero-truncated distributions are zero-modified distributions with $p_0^M = 0$. However, using the dedicated functions in R will be more efficient. \section{Poisson-inverse Gaussian distribution} \label{sec:pig} The Poisson-inverse Gaussian (PIG) distribution results from the continuous mixture between a Poisson distribution and an inverse Gaussian. That is, the Poisson-inverse Gaussian is the (marginal) distribution of the random variable $X$ when the conditional random variable $X|\Lambda = \lambda$ is Poisson with parameter $\lambda$ and the random variable $\Lambda$ is inverse Gaussian with parameters $\mu$ and $\phi$. The literature proposes many different expressions for the pmf of the PIG \citep{Holla:PIG:1966,Shaban:PIG:1981,Johnson:discrete:2005,LossModels4e}. Using the parametrization for the inverse Gaussian found in \autoref{sec:app:continuous}, we have: \begin{equation} \label{eq:pig:px} \begin{split} p_x &= \sqrt{\frac{2}{\pi \phi}} \frac{e^{(\phi\mu)^{-1}}}{x!} \left( \sqrt{2\phi \left( 1 + \frac{1}{2\phi\mu^2} \right)} \right)^{-\left( x - \frac{1}{2} \right)} \\ &\phantom{=} \times K_{x - \frac{1}{2}} \left( \sqrt{\frac{2}{\phi}\left(1 + \frac{1}{2\phi\mu^2}\right)} \right), \end{split} \end{equation} for $x = 0, 1, \dots$, $\mu > 0$, $\phi > 0$ and where \begin{equation} \label{eq:bessel_k} K_\nu(ax) = \frac{a^{-\nu}}{2} \int_0^\infty t^{\nu - 1} e^{- z(t + at^{-1})/2} dt, \quad a^2 z > 0 \end{equation} is the modified Bessel function of the third kind \citep{Bateman:1953:2,Abramowitz:1972}. One may compute the probabilities $p_x$, $x = 0, 1, \dots$ recursively using the following equations: \begin{equation} \label{eq:pig:px:recursive} \begin{split} p_0 &= \exp\left\{ \frac{1}{\phi\mu} \left(1 - \sqrt{1 + 2\phi\mu^2}\right) \right\} \\ p_1 &= \frac{\mu}{\sqrt{1 + 2\phi\mu^2}}\, p_0 \\ p_x &= \frac{2\phi\mu^2}{1 + 2\phi\mu^2} \left( 1 - \frac{3}{2x} \right) p_{x - 1} + \frac{\mu^2}{1 + 2\phi\mu^2} \frac{1}{x(x - 1)}\, p_{x - 2}, \quad x = 2, 3, \dots. \end{split} \end{equation} The first moment of the distribution is $\mu$. The second and third central moment are, respectively, \begin{align*} \mu_2 &= \sigma^2 = \mu + \phi\mu^3 \\ \mu_3 &= \mu + 3 \phi \mu^2 \sigma^2. \end{align*} For the limiting case $\mu = \infty$, the underlying inverse Gaussian has an inverse chi-squared distribution. The latter has no finite strictly positive, integer moments and, consequently, neither does the Poisson-inverse Gaussian. See \autoref{sec:app:discrete:pig} for the formulas in this case. \section{Special integrals} \label{sec:special-integrals} Many of the cumulative distribution functions of \autoref{sec:app:continuous} are expressed in terms of the incomplete gamma function or the incomplete beta function. From a probability theory perspective, the incomplete gamma function is usually defined as \begin{equation} \label{eq:pgamma} \Gamma(\alpha; x) = \frac{1}{\Gamma(\alpha)} \int_0^x t^{\alpha - 1} e^{-t}\, dt, \quad \alpha > 0, x > 0, \end{equation} with \begin{equation*} \Gamma(\alpha) = \int_0^\infty t^{\alpha - 1} e^{-t}\, dt, \end{equation*} whereas the (regularized) incomplete beta function is defined as \begin{equation} \label{eq:pbeta} \beta(a, b; x) = \frac{1}{\beta(a, b)} \int\limits_0^x t^{a - 1} (1 - t)^{b - 1}\, dt, \quad a > 0, b > 0, 0 < x < 1, \end{equation} with \begin{equation*} \beta(a, b) = \int_0^1 t^{a - 1} (1 - t)^{b - 1}\, dt = \frac{\Gamma(a) \Gamma(b)}{\Gamma(a + b)}. \end{equation*} Now, there exist alternative definitions of the these functions that are valid for negative values of the parameters. \citet{LossModels4e} introduce them to extend the range of admissible values for limited expected value functions. First, following \citet[Section~6.5]{Abramowitz:1972}, we define the ``extended'' incomplete gamma function as \begin{equation} \label{eq:gammainc} G(\alpha; x) = \int_x^\infty t^{\alpha - 1} e^{-t}\, dt \end{equation} for $\alpha$ real and $x > 0$. When $\alpha > 0$, we clearly have \begin{equation} \label{eq:gammainc:apos} G(\alpha; x) = \Gamma(a) [1 - \Gamma(\alpha; x)]. \end{equation} The integral is also defined for $\alpha \le 0$. As outlined in \citet[Appendix~A]{LossModels4e}, integration by parts of \eqref{eq:gammainc} yields the relation \begin{equation*} G(\alpha; x) = -\frac{x^\alpha e^{-x}}{\alpha} + \frac{1}{\alpha} G(\alpha + 1; x). \end{equation*} This process can be repeated until $\alpha + k$ is a positive number, in which case the right hand side can be evaluated with \eqref{eq:gammainc:apos}. If $\alpha = 0, -1, -2, \dots$, this calculation requires the value of \begin{equation*} \label{eq:expint} G(0; x) = \int_x^\infty \frac{e^{-t}}{t}\, dt = E_1(x), \end{equation*} which is known in the literature as the \emph{exponential integral} \citep[Section~5.1]{Abramowitz:1972}. Second, as seen in \citet[Section~6.6]{Abramowitz:1972}, we have the following relation for the integral on the right hand side of \eqref{eq:pbeta}: \begin{equation*} \int\limits_0^x t^{a - 1} (1 - t)^{b - 1}\, dt = \frac{x^a}{a}\, F(a, 1 - b; a + 1; x), \end{equation*} where \begin{equation*} F(a, b; c; z) = \frac{\Gamma(c)}{\Gamma(a) \Gamma(b)} \sum_{k = 0}^\infty \frac{\Gamma(a + k) \Gamma(b + k)}{\Gamma(c + k)} \frac{z^k}{k!} \end{equation*} is the Gauss hypergeometric series. With the above definition, the incomplete beta function also admits negative, non integer values for parameters $a$ and $b$. Now, let \begin{equation} \label{eq:betaint} B(a, b; x) = \Gamma(a + b) \int_0^x t^{a-1} (1-t)^{b-1} dt \end{equation} for $a > 0$, $b \neq -1, -2, \dots$ and $0 < x < 1$. Again, it is clear that when $b > 0$, \begin{equation*} B(a, b; x) = \Gamma(a) \Gamma(b) \beta(a, b; x). \end{equation*} Of more interest here is the case where $b < 0$, $b \neq -1, -2, \dots$ and $a > 1 + \lfloor -b\rfloor$. Integration by parts of \eqref{eq:betaint} yields \begin{equation} \label{eq:betaint:2} \begin{split} B(a, b; x) &= \displaystyle -\Gamma(a + b) \left[ \frac{x^{a-1} (1-x)^b}{b} + \frac{(a-1) x^{a-2} (1-x)^{b+1}}{b (b+1)} \right. \\ &\phantom{=} \displaystyle\left. + \cdots + \frac{(a-1) \cdots (a-r) x^{a-r-1} (1-x)^{b+r}}{b (b+1) \cdots (b+r)} \right] \\ &\phantom{=} \displaystyle + \frac{(a-1) \cdots (a-r-1)}{b (b+1) \cdots (b+r)} \Gamma(a-r-1) \\ &\phantom{=} \times \Gamma(b+r+1) \beta(a-r-1, b+r+1; x), \end{split} \end{equation} where $r = \lfloor -b\rfloor$. For the needs of \pkg{actuar}, we dubbed \eqref{eq:betaint} the \emph{beta integral}. Package \pkg{actuar} includes a C implementation of \eqref{eq:betaint:2} and imports functionalities of package \pkg{expint} \citep{expint} to compute the incomplete gamma function \eqref{eq:gammainc} at the C level. The routines are used to evaluate the limited expected value for distributions of the Feller--Pareto and transformed gamma families. \section{Package API: accessing the C routines} \label{sec:api} The actual workhorses behind the R functions presented in this document are C routines that the package exposes to other packages through an API. The header file \file{include/actuarAPI.h} in the package installation directory contains declarations for % the continuous distributions of \autoref{sec:app:continuous}, % the phase-type distributions of \autoref{sec:app:phase-type}, % the discrete distributions of \autoref{sec:app:discrete}, % and the beta integral of \autoref{sec:special-integrals}. The prototypes of the C routines for probability distributions all follow the same pattern modeled after those of base R \citep[Chapter~6]{R-exts}. As an example, here are the prototypes for the Pareto distribution: \begin{Schunk} \begin{Sinput} double dpareto(double x, double shape, double scale, int give_log); double ppareto(double q, double shape, double scale, int lower_tail, int log_p); double qpareto(double p, double shape, double scale, int lower_tail, int log_p); double rpareto(double shape, double scale); double mpareto(double order, double shape, double scale, int give_log); double levpareto(double limit, double shape, double scale, double order, int give_log); \end{Sinput} \end{Schunk} For the beta integral \eqref{eq:betaint:2}, the frontend is a routine \code{betaint} that returns \code{NA} or \code{NaN} for out-of-range arguments, but actual computation is done by routine \code{betaint\_raw}. Both are exposed as follows in the API: \begin{Schunk} \begin{Sinput} double betaint(double x, double a, double b); double betaint_raw(double x, double a, double b, double x1m); \end{Sinput} \end{Schunk} The developer of some package \pkg{pkg} who wants to use a routine --- say \code{dpareto} --- in her code should proceed as follows. \begin{enumerate} \item Add \pkg{actuar} to the \code{Imports} and \code{LinkingTo} directives of the \file{DESCRIPTION} file of \pkg{pkg}; \item Add an entry \code{import(actuar)} in the \file{NAMESPACE} file of \pkg{pkg}; \item Define the routine with a call to \code{R\_GetCCallable} in the initialization routine \code{R\_init\_pkg} of \pkg{pkg} \citep[Section~5.4]{R-exts}. For the current example, the file \file{src/init.c} of \pkg{pkg} would contain the following code: \begin{Schunk} \begin{Sinput} void R_init_pkg(DllInfo *dll) { R_registerRoutines( /* native routine registration */ ); pkg_dpareto = (double(*)(double,int,int)) R_GetCCallable("actuar", "dpareto"); } \end{Sinput} \end{Schunk} \item Define a native routine interface that will call \code{dpareto}, say \code{pkg\_dpareto} to avoid any name clash, in \file{src/init.c} as follows: \begin{Schunk} \begin{Sinput} double(*pkg_dpareto)(double,double,double,int); \end{Sinput} \end{Schunk} \item Declare the routine in a header file of \pkg{pkg} with the keyword \code{extern} to expose the interface to all routines of the package. In our example, file \file{src/pkg.h} would contain: \begin{Schunk} \begin{Sinput} extern double(*pkg_dpareto)(double,double,double,int); \end{Sinput} \end{Schunk} \item Include the package header file \file{pkg.h} in any C file making use of routine \code{pkg\_dpareto}. \end{enumerate} The companion package \pkg{expint} \citep{expint} ships with a complete test package implementing the above. See the vignette of the latter package for more information. \section{Implementation details} \label{sec:implementation} The cdf of the continuous distributions of \autoref{tab:continuous} use \code{pbeta} and \code{pgamma} to compute the incomplete beta and incomplete gamma functions, respectively. Functions \code{dinvgauss}, \code{pinvgauss} and \code{qinvgauss} rely on C implementations of functions of the same name from package \pkg{statmod} \citep{statmod}. The matrix exponential C routine needed in \code{dphtype} and \code{pphtype} is based on \code{expm} from package \pkg{Matrix} \citep{Matrix}. The C code to compute the beta integral \eqref{eq:betaint:2} was written by the second author. For all but the trivial input values, the pmf, cdf and quantile functions for the zero-truncated and zero-modified distributions of \autoref{tab:discrete} use the internal R functions for the corresponding standard distribution. Generation of random variates from zero-truncated distributions uses the following simple inversion algorithm on a restricted range \citep{Dalgaard:r-help:2005,Thomopoulos:2013:simulation}. Let $u$ be a random number from a uniform distribution on $(p_0, 1)$. Then $x = P^{-1}(u)$ is distributed according to the zero-truncated version of the distribution with cdf $P(k)$. For zero-modified distributions, we generate variates from the discrete mixture \eqref{eq:mixture} when $p_0^M \geq p_0$. When $p_0^M < p_0$, we can use either of two methods: \begin{enumerate} \item the classical rejection method with an envelope that differs from the target distribution only at zero (meaning that only zeros are rejected); \item generation from the discrete mixture \eqref{eq:mixture:alt} with the corresponding zero-truncated distribution (hence using the inversion method on a restricted range explained above). \end{enumerate} Which approach is faster depends on the relative speeds of the standard random generation function and the standard quantile function, and also on the proportion of zeros that are rejected using the rejection algorithm. Based on the difference $p_0 - p_0^M$, we determined (empirically) distribution-specific cutoff points between the two methods. Finally, computation of the Poisson-inverse Gaussian pmf uses the recursive equations \eqref{eq:pig:px:recursive}. Versions of \pkg{actuar} prior to 3.0-0 used the direct expression \eqref{eq:pig:px} and the C level function \code{bessel\_k} part of the R API. However, the latter overflows for large values of $\nu$ and this caused \code{NaN} results for the value of \begin{equation*} \frac{B^{- \left(x - \frac{1}{2} \right)} K_{x - \frac{1}{2}}(B/\phi)}{x!} \end{equation*} and, therefore, for the Poisson-inverse Gaussian pmf. \appendix \section{Continuous distributions} \label{sec:app:continuous} This appendix gives the root name and the parameters of the R support functions for the distributions of \autoref{tab:continuous}, as well as the formulas for the pdf, the cdf, the raw moment of order $k$ and the limited moment of order $k$ using the parametrization of \citet{LossModels4e} and \citet{HoggKlugman}. In the following, $\Gamma(\alpha; x)$ is the incomplete gamma function \eqref{eq:pgamma}, $\beta(a, b; x)$ is the incomplete beta function \eqref{eq:pbeta}, $G(\alpha; x)$ is the ``extended'' incomplete gamma function \eqref{eq:gammainc}, $B(a, b; x)$ is the beta integral \eqref{eq:betaint} and $K_\nu(x)$ is the modified Bessel function of the third kind \eqref{eq:bessel_k}. Unless otherwise stated, all parameters are finite and strictly positive, and the functions are defined for $x > 0$. \subsection{Feller--Pareto family} \label{sec:app:continuous:feller-pareto} \subsubsection{Feller--Pareto} \begin{itemize} \item Root: \code{fpareto} \item Parameters: \code{min} ($-\infty < \mu < \infty$), \code{shape1} ($\alpha$), \code{shape2} ($\gamma$), \code{shape3} ($\tau$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\gamma u^\tau (1 - u)^\alpha}{% (x - \mu) \beta (\alpha, \tau )}, \quad u = \frac{v}{1 + v}, \quad v = \left(\frac{x - \mu}{\theta} \right)^\gamma, \quad x > \mu \\ F(x) &= \beta(\tau, \alpha; u) \\ \displaybreak[0] \E{X^k} &= \sum_{j = 0}^k \binom{k}{j} \mu^{k - j} \theta^j\, \frac{\Gamma(\tau+j/\gamma) \Gamma(\alpha-j/\gamma)}{% \Gamma(\alpha) \Gamma(\tau)}, \quad \text{integer } 0 \leq k < \alpha\gamma \\ \E{(X \wedge x)^k} &= \sum_{j = 0}^k \binom{k}{j} \mu^{k - j} \theta^j\, \frac{B(\tau+j/\gamma, \alpha-j/\gamma; u)}{% \Gamma(\alpha) \Gamma(\tau)} \\ &\phantom{=} + x^k [1 - \beta(\tau, \alpha; u)], \quad \text{integer } k \geq 0, \quad \alpha - j/\gamma \neq -1, -2, \dots \end{align*} \subsubsection{Pareto IV} \begin{itemize} \item Root: \code{pareto4} \item Parameters: \code{min} ($-\infty < \mu < \infty$), \code{shape1} ($\alpha$), \code{shape2} ($\gamma$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\alpha \gamma u^\alpha (1 - u)}{(x - \mu)}, \quad u = \frac{1}{1 + v}, \quad v = \left(\frac{x - \mu}{\theta} \right)^\gamma, \quad x > \mu \\ F(x) &= 1 - u^\alpha \\ \displaybreak[0] \E{X^k} &= \sum_{j = 0}^k \binom{k}{j} \mu^{k - j} \theta^j\, \frac{\Gamma(1+j/\gamma) \Gamma(\alpha-j/\gamma)}{% \Gamma(\alpha)}, \quad \text{integer } 0 \leq k < \alpha\gamma \\ \E{(X \wedge x)^k} &= \sum_{j = 0}^k \binom{k}{j} \mu^{k - j} \theta^j\, \frac{B(1+j/\gamma, \alpha-j/\gamma; 1-u)}{% \Gamma(\alpha)} \\ &\phantom{=} + x^k u^\alpha, \quad \text{integer } k \geq 0 \quad \alpha - j/\gamma \neq -1, -2, \dots \end{align*} \subsubsection{Pareto III} \begin{itemize} \item Root: \code{pareto3} \item Parameters: \code{min} ($-\infty < \mu < \infty$), \code{shape} ($\gamma$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\gamma u (1 - u)}{(x - \mu)}, \quad u = \frac{v}{1 + v}, \quad v = \left(\frac{x - \mu}{\theta} \right)^\gamma, \quad x > \mu \\ F(x) &= u \\ \displaybreak[0] \E{X^k} &= \sum_{j = 0}^k \binom{k}{j} \mu^{k - j} \theta^j\, \Gamma(1+j/\gamma) \Gamma(1-j/\gamma), \quad \text{integer } 0 \leq k < \gamma \\ \E{(X \wedge x)^k} &= \sum_{j = 0}^k \binom{k}{j} \mu^{k - j} \theta^j\, B(1+j/\gamma, 1-j/\gamma; u) \\ &\phantom{=} + x^k (1 - u), \quad \text{integer } k \geq 0 \quad 1 - j/\gamma \neq -1, -2, \dots \end{align*} \subsubsection{Pareto II} \begin{itemize} \item Root: \code{pareto4} \item Parameters: \code{min} ($-\infty < \mu < \infty$), \code{shape} ($\alpha$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\alpha u^\alpha (1 - u)}{(x - \mu)}, \quad u = \frac{1}{1 + v}, \quad v = \frac{x - \mu}{\theta}, \quad x > \mu \\ F(x) &= 1 - u^\alpha \\ \displaybreak[0] \E{X^k} &= \sum_{j = 0}^k \binom{k}{j} \mu^{k - j} \theta^j\, \frac{\Gamma(1+j) \Gamma(\alpha-j)}{% \Gamma(\alpha)}, \quad \text{integer } 0 \leq k < \alpha \\ \E{(X \wedge x)^k} &= \sum_{j = 0}^k \binom{k}{j} \mu^{k - j} \theta^j\, \frac{B(1+j, \alpha-j; 1-u)}{% \Gamma(\alpha)} \\ &\phantom{=} + x^k u^\alpha, \quad \text{integer } k \geq 0 \quad \alpha - j \neq -1, -2, \dots \end{align*} \subsubsection{Transformed beta} \begin{itemize} \item Root: \code{trbeta}, \code{pearson6} \item Parameters: \code{shape1} ($\alpha$), \code{shape2} ($\gamma$), \code{shape3} ($\tau$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\gamma u^\tau (1 - u)^\alpha}{% x \beta (\alpha, \tau )}, \qquad u = \frac{v}{1 + v}, \qquad v = \left(\frac{x}{\theta} \right)^\gamma \\ F(x) &= \beta(\tau, \alpha; u) \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \Gamma(\tau+k/\gamma) \Gamma(\alpha-k/\gamma)}{% \Gamma(\alpha) \Gamma(\tau)}, \quad -\tau\gamma < k < \alpha\gamma \\ \E{(X \wedge x)^k} &= \frac{% \theta^k B(\tau+k/\gamma, \alpha-k/\gamma; u)}{% \Gamma(\alpha) \Gamma(\tau)} \\ &\phantom{=} + x^k [1 - \beta(\tau, \alpha; u)], \quad k > -\tau\gamma \end{align*} \subsubsection{Burr} \begin{itemize} \item Root: \code{burr} \item Parameters: \code{shape1} ($\alpha$), \code{shape2} ($\gamma$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\alpha \gamma u^\alpha (1 - u)}{x}, \qquad u = \frac{1}{1 + v}, \qquad v = \left( \frac{x}{\theta} \right)^\gamma \\ F(x) &= 1 - u^\alpha \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \Gamma(1+k/\gamma) \Gamma(\alpha-k/\gamma)}{% \Gamma(\alpha)}, \quad -\gamma < k < \alpha\gamma \\ \E{(X \wedge x)^k} &= \frac{% \theta^k B(1+k/\gamma, \alpha-k/\gamma; 1-u)}{% \Gamma(\alpha)} \\ &\phantom{=} + x^k u^\alpha, \quad k > -\gamma \end{align*} \subsubsection{Loglogistic} \begin{itemize} \item Root: \code{llogis} \item Parameters: \code{shape} ($\gamma$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\gamma u (1 - u)}{x}, \qquad u = \frac{v}{1 + v}, \qquad v = \left( \frac{x}{\theta} \right)^\gamma \\ F(x) &= u \\ \displaybreak[0] \E{X^k} &= \theta^k \Gamma(1+k/\gamma) \Gamma(1-k/\gamma), \quad -\gamma < k < \gamma \\ \E{(X \wedge x)^k} &= \theta^k B(1+k/\gamma, 1-k/\gamma; u) \\ &\phantom{=} + x^k (1 - u), \quad k > -\gamma \end{align*} \subsubsection{Paralogistic} \begin{itemize} \item Root: \code{paralogis} \item Parameters: \code{shape} ($\alpha$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\alpha^2 u^\alpha (1 - u)}{x}, \qquad u = \frac{1}{1 + v}, \qquad v = \left( \frac{x}{\theta} \right)^\alpha \\ F(x) &= 1 - u^\alpha \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \Gamma(1+k/\alpha) \Gamma(\alpha-k/\alpha)}{% \Gamma(\alpha)}, \quad -\alpha < k < \alpha^2 \\ \E{(X \wedge x)^k} &= \frac{% \theta^k B(1+k/\alpha, \alpha-k/\alpha; 1-u)}{% \Gamma(\alpha)} \\ &\phantom{=} + x^k u^\alpha, \quad k > -\alpha \end{align*} \subsubsection{Generalized Pareto} \begin{itemize} \item Root: \code{genpareto} \item Parameters: \code{shape1} ($\alpha$), \code{shape2} ($\tau$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{u^\tau (1 - u)^\alpha}{x \beta (\alpha, \tau )}, \qquad u = \frac{v}{1 + v}, \qquad v = \frac{x}{\theta} \\ F(x) &= \beta(\tau, \alpha; u) \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \Gamma(\tau+k) \Gamma(\alpha-k)}{% \Gamma(\alpha) \Gamma(\tau)}, \quad -\tau < k < \alpha \\ \E{(X \wedge x)^k} &= \frac{% \theta^k B(\tau+k, \alpha-k; u)}{% \Gamma(\alpha) \Gamma(\tau)} \\ &\phantom{=} + x^k [1 - \beta(\tau, \alpha; u)], \quad k > -\tau \end{align*} \subsubsection{Pareto} \begin{itemize} \item Root: \code{pareto}, \code{pareto2} \item Parameters: \code{shape} ($\alpha$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\alpha u^\alpha (1 - u)}{x}, \qquad u = \frac{1}{1 + v}, \qquad v = \frac{x}{\theta} \\ F(x) &= 1 - u^\alpha \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \Gamma(1+k) \Gamma(\alpha-k)}{% \Gamma(\alpha)}, \quad -1 < k < \alpha \\ \E{(X \wedge x)^k} &= \frac{% \theta^k B(1+k, \alpha-k; 1-u)}{% \Gamma(\alpha)} \\ &\phantom{=} + x^k u^\alpha, \quad k > -1 \end{align*} \subsubsection{Single-parameter Pareto (Pareto I)} \begin{itemize} \item Root: \code{pareto1} \item Parameters: \code{shape} ($\alpha$), \code{min} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\alpha \theta^\alpha}{x^{\alpha+1}}, \quad x > \theta \\ F(x) &= 1 - \left( \frac{\theta}{x} \right)^\alpha, \quad x > \theta \\ \displaybreak[0] \E{X^k} &= \frac{\alpha \theta^k}{\alpha - k}, \quad k < \alpha \\ \E{(X \wedge x)^k} &= \frac{\alpha \theta^k}{\alpha - k} - \frac{k \theta^\alpha}{(\alpha - k) x^{\alpha-k}}, \quad x \geq \theta \end{align*} Although there appears to be two parameters, only $\alpha$ is a true parameter. The value of $\theta$ is the minimum of the distribution and is usually set in advance. \subsubsection{Inverse Burr} \begin{itemize} \item Root: \code{invburr} \item Parameters: \code{shape1} ($\tau$), \code{shape2} ($\gamma$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\tau \gamma u^\tau (1 - u)}{x}, \qquad u = \frac{v}{1 + v}, \qquad v = \left( \frac{x}{\theta} \right)^\gamma \\ F(x) &= u^\tau \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \Gamma(\tau+k/\gamma) \Gamma(1-k/\gamma)}{% \Gamma(\tau)}, \quad -\gamma < k < \alpha\gamma \\ \E{(X \wedge x)^k} &= \frac{% \theta^k B(\tau+k/\gamma, 1-k/\gamma; u)}{% \Gamma(\tau)} \\ &\phantom{=} + x^k (1-u^\tau), \quad k > -\tau\gamma \end{align*} \subsubsection{Inverse Pareto} \begin{itemize} \item Root: \code{invpareto} \item Parameters: \code{shape} ($\tau$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\tau u^\tau (1 - u)}{x}, \qquad u = \frac{v}{1 + v}, \qquad v = \frac{x}{\theta} \\ F(x) &= u^\tau \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \Gamma(\tau+k) \Gamma(1-k)}{% \Gamma(\tau)}, \quad -\tau < k < 1 \\ \E{(X \wedge x)^k} &= \theta^k \tau \int_0^u y^{\tau+k-1} (1 - y)^{-k}\, dy \\ &\phantom{=} + x^k (1-u^\tau), \quad k > -\tau \end{align*} \subsubsection{Inverse paralogistic} \begin{itemize} \item Root: \code{invparalogis} \item Parameters: \code{shape} ($\tau$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\tau^2 u^\tau (1 - u)}{x}, \qquad u = \frac{v}{1 + v}, \qquad v = \left(\frac{x}{\theta} \right)^\tau \\ F(x) &= u^\tau \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \Gamma(\tau+k/\tau) \Gamma(1-k/\tau)}{% \Gamma(\tau)}, \quad -\tau^2 < k < \tau \\ \E{(X \wedge x)^k} &= \frac{% \theta^k B(\tau+k/\tau, 1-k/\tau; u)}{% \Gamma(\tau)} \\ &\phantom{=} + x^k (1-u^\tau), \quad k > -\tau^2 \end{align*} \subsection{Transformed gamma family} \label{sec:app:continuous:transformed-gamma} \subsubsection{Transformed gamma} \begin{itemize} \item Root: \code{trgamma} \item Parameters: \code{shape1} ($\alpha$), \code{shape2} ($\tau$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\tau u^\alpha e^{-u}}{x \Gamma(\alpha)}, \qquad u = \left( \frac{x}{\theta} \right)^\tau \\ F(x) &= \Gamma (\alpha ; u) \\ \displaybreak[0] \E{X^k} &= \frac{\theta^k \Gamma(\alpha+k/\tau)}{\Gamma(\alpha)} \quad k > -\alpha\tau \\ \E{(X \wedge x)^k} &= \frac{\theta^k \Gamma(\alpha+k/\tau)}{\Gamma(\alpha)} \Gamma(\alpha+k/\tau; u) \\ &\phantom{=} + x^k [1 - \Gamma(\alpha; u)], \quad k > -\alpha\tau \end{align*} \subsubsection{Inverse transformed gamma} \begin{itemize} \item Root: \code{invtrgamma} \item Parameters: \code{shape1} ($\alpha$), \code{shape2} ($\tau$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\tau u^\alpha e^{-u}}{x\Gamma (\alpha)}, \qquad u = \left( \frac{\theta}{x} \right)^\tau \\ F(x) &= 1 - \Gamma (\alpha ; u) \\ \displaybreak[0] \E{X^k} &= \frac{\theta^k \Gamma(\alpha-k/\tau)}{\Gamma(\alpha)} \quad k < \alpha\tau \\ \E{(X \wedge x)^k} &= \frac{\theta^k G(\alpha-k/\tau; u)}{\Gamma(\alpha)} + x^k \Gamma(\alpha; u), \quad \text{all }k \end{align*} \subsubsection{Inverse gamma} \begin{itemize} \item Root: \code{invgamma} \item Parameters: \code{shape} ($\alpha$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{u^\alpha e^{-u}}{x\Gamma (\alpha)}, \qquad u = \frac{\theta}{x}\\ F(x) &= 1 - \Gamma (\alpha ; u) \\ \displaybreak[0] \E{X^k} &= \frac{\theta^k \Gamma(\alpha-k)}{\Gamma(\alpha)} \quad k < \alpha \\ \E{(X \wedge x)^k} &= \frac{\theta^k G(\alpha-k; u)}{\Gamma(\alpha)} + x^k \Gamma(\alpha; u), \quad \text{all }k \\ M(t) &= \frac{2}{\Gamma(\alpha)} (-\theta t)^{\alpha/2} K_\alpha(\sqrt{-4\theta t}) \end{align*} \subsubsection{Inverse Weibull} \begin{itemize} \item Root: \code{invweibull}, \code{lgompertz} \item Parameters: \code{shape} ($\tau$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\tau u e^{-u}}{x}, \qquad u = \left( \frac{\theta}{x} \right)^\tau \\ F(x) &= e^{-u} \\ \displaybreak[0] \E{X^k} &= \theta^k \Gamma(1-k/\tau) \quad k < \tau \\ \E{(X \wedge x)^k} &= \theta^k G(1-k/\tau; u) + x^k (1 - e^{-u}), \quad \text{all }k \end{align*} \subsubsection{Inverse exponential} \begin{itemize} \item Root: \code{invexp} \item Parameters: \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{u e^{-u}}{x}, \qquad u = \frac{\theta}{x} \\ F(x) &= e^{-u} \\ \displaybreak[0] \E{X^k} &= \theta^k \Gamma(1-k) \quad k < 1 \\ \E{(X \wedge x)^k} &= \theta^k G(1-k; u) + x^k (1 - e^{-u}), \quad \text{all }k \end{align*} \subsection{Other distributions} \label{sec:app:continuous:other} \subsubsection{Loggamma} \begin{itemize} \item Root: \code{lgamma} \item Parameters: \code{shapelog} ($\alpha$), \code{ratelog} ($\lambda$) \end{itemize} \begin{align*} f(x) &= \frac{\lambda^\alpha (\ln x)^{\alpha - 1}}{% x^{\lambda + 1} \Gamma(\alpha)}, \quad x > 1 \\ F(x) &= \Gamma( \alpha ; \lambda \ln x), \quad x > 1 \\ \displaybreak[0] \E{X^k} &= \left( \frac{\lambda}{\lambda - k} \right)^\alpha, \quad k < \lambda \\ \E{(X \wedge x)^k} &= \left( \frac{\lambda}{\lambda - k} \right)^\alpha \Gamma(\alpha; (\lambda - k) \ln x) \\ &\phantom{=} + x^k (1 - \Gamma(\alpha; \lambda \ln x)), \quad k < \lambda \end{align*} \subsubsection{Gumbel} \begin{itemize} \item Root: \code{gumbel} \item Parameters: \code{alpha} ($-\infty < \alpha < \infty$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{e^{-(u + e^{-u})}}{\theta}, \qquad u = \frac{x - \alpha}{\theta}, \qquad -\infty < x < \infty \\ F(x) &= \exp[-\exp(-u)] \\ \displaybreak[0] \E{X} &= \alpha + \gamma \theta, \quad \gamma \approx 0.57721566490153 \\ \VAR{X} &= \frac{\pi^2 \theta^2}{6} \\ M(t) &= e^{\alpha t} \Gamma(1 - \theta t) \end{align*} \subsubsection{Inverse Gaussian} \begin{itemize} \item Root: \code{invgauss} \item Parameters: \code{mean} ($\mu$), \code{shape} ($\lambda = 1/\phi$), \code{dispersion} ($\phi$) \end{itemize} \begin{align*} f(x) &= \left( \frac{1}{2 \pi \phi x^3} \right)^{1/2} \exp\left\{ -\frac{(x/\mu - 1)^2}{2 \phi x} \right\} \\ F(x) &= \Phi\left( \frac{x/\mu - 1}{\sqrt{\phi x}} \right) + e^{2/(\phi\mu)} \Phi\left( -\frac{x/\mu + 1}{\sqrt{\phi x}} \right) \\ \displaybreak[0] \E{X^k} &= \mu^k \sum_{i = 0}^{k - 1} \frac{(k + i - 1)!}{i! (k - i - 1)!} \left( \frac{\phi \mu}{2} \right)^{i}, \quad k = 1, 2, \dots \\ \E{X \wedge x} &= \mu \left[ \Phi\left( \frac{x/\mu - 1}{\sqrt{\phi x}} \right) - e^{2/(\phi\mu)} \Phi\left(- \frac{x/\mu + 1}{\sqrt{\phi x}} \right) \right] \\ &\phantom{=} + x (1 - F(x)) \\ M(t) &= \exp \left\{ \frac{1}{\phi \mu} \left(1 - \sqrt{1 - 2 \phi \mu^2 t}\right) \right\}, \quad t \leq \frac{1}{2 \phi \mu^2} \end{align*} \noindent% The limiting case $\mu = \infty$ is an inverse gamma distribution with $\alpha = 1/2$ and $\lambda = 2\phi$ (or inverse chi-squared). \subsubsection{Generalized beta} \begin{itemize} \item Root: \code{genbeta} \item Parameters: \code{shape1} ($a$), \code{shape2} ($b$), \code{shape3} ($\tau$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\tau u^a (1 - u)^{b - 1}}{x \beta (a, b)}, \qquad u = \left( \frac{x}{\theta} \right)^\tau, \qquad 0 < x < \theta \\ F(x) &= \beta (a, b ; u) \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \beta(a+k/\tau, b)}{\beta(a, b)}, \quad k > -a\tau \\ \E{(X \wedge x)^k} &= \frac{% \theta^k \beta(a+k/\tau, b)}{\beta(a, b)} \beta(a+k/\tau, b; u) \\ &\phantom{=} + x^k [1 - \beta(a, b; u)], \quad k > -\tau\gamma \end{align*} \section{Phase-type distributions} \label{sec:app:phase-type} Consider a continuous-time Markov process with $m$ transient states and one absorbing state. Let \begin{equation*} \mat{Q} = \begin{bmatrix} \mat{T} & \mat{t} \\ \mat{0} & 0 \end{bmatrix} \end{equation*} be the transition rates matrix (or intensity matrix) of such a process and let $(\mat{\pi}, \pi_{m + 1})$ be the initial probability vector. Here, $\mat{T}$ is an $m \times m$ non-singular matrix with $t_{ii} < 0$ for $i = 1, \dots, m$ and $t_{ij} \geq 0$ for $i \neq j$; $\mat{\pi}$ is an $1 \times m$ vector of probabilities such that $\mat{\pi} \mat{e} + \pi_{m + 1} = 1$; $\mat{t} = -\mat{T} \mat{e}$; $\mat{e} = [1]_{m \times 1}$ is a column vector of ones. % \bigskip \begin{itemize} \item Root: \code{phtype} \item Parameters: \code{prob} ($\mat{\pi}_{1 \times m}$), \code{rates} ($\mat{T}_{m \times m}$) \end{itemize} \begin{align*} f(x) &= \begin{cases} 1 - \mat{\pi} \mat{e} & x = 0, \\ \mat{\pi} e^{\mat{T} x} \mat{t}, & x > 0 \end{cases} \\ F(x) &= \begin{cases} 1 - \mat{\pi} \mat{e}, & x = 0, \\ 1 - \mat{\pi} e^{\mat{T} x} \mat{e}, & x > 0 \end{cases} \\ \E{X^k} &= k! \mat{\pi} (-\mat{T})^{-k} \mat{e} \\ M(t) &= \mat{\pi} (-t \mat{I} - \mat{T})^{-1} \mat{t} + (1 - \mat{\pi} \mat{e}) \end{align*} \section{Discrete distributions} \label{sec:app:discrete} This appendix gives the root name and the parameters of the R support functions for the members of the $(a, b, 0)$ and $(a, b, 1)$ discrete distributions as defined in \citet{LossModels4e}; the values of $a$, $b$ and $p_0$ in the representation; the pmf; the relationship with other distributions, when there is one. The appendix also provides the main characteristics of the Poisson-inverse Gaussian distribution. \subsection[The (a, b, 0) class]{The $(a, b, 0)$ class} \label{sec:app:discrete:a-b-0} The distributions in this section are all supported in base R. Their pmf can be computed recursively by fixing $p_0$ to the specified value and then using $p_k = (a + b/k) p_{k - 1}$, for $k = 1, 2, \dots$. All parameters are finite. \subsubsection{Poisson} \begin{itemize} \item Root: \code{pois} \item Parameter: \code{lambda} ($\lambda \geq 0$) \end{itemize} \begin{align*} a &= 0, \qquad b = \lambda, \qquad p_0 = e^{-\lambda} \\ p_k &= \frac{e^{-\lambda} \lambda^k}{k!} \end{align*} \subsubsection{Negative binomial} \begin{itemize} \item Root: \code{nbinom} \item Parameters: \code{size} ($r \geq 0$), \code{prob} ($0 < p \leq 1$), \code{mu} ($r(1 - p)/p$) \end{itemize} \begin{align*} a &= 1 - p, \qquad b = (r - 1)(1 - p), \qquad p_0 = p^r \\ p_k &= \binom{r+k-1}{k} p^r (1 - p)^k \end{align*} \begin{itemize} \item Special case: Geometric$(p)$ when $r = 1$. \end{itemize} \subsubsection{Geometric} \begin{itemize} \item Root: \code{geom} \item Parameter: \code{prob} ($0 < p \leq 1$) \end{itemize} \begin{align*} a &= 1 - p, \qquad b = 0, \qquad p_0 = p \\ p_k &= p (1 - p)^k \end{align*} \subsubsection{Binomial} \begin{itemize} \item Root: \code{binom} \item Parameters: \code{size} ($n = 0, 1, 2, \dots$), \code{prob} ($0 \leq p \leq 1$) \end{itemize} \begin{align*} a &= -\frac{p}{1 - p}, \qquad b = \frac{(n + 1)p}{1 - p}, \qquad p_0 = (1 - p)^n \\ p_k &= \binom{n}{k} p^k (1 - p)^{n - k}, \quad k = 1, 2, \dots, n \end{align*} \begin{itemize} \item Special case: Bernoulli$(p)$ when $n = 1$. \end{itemize} \subsection[The zero-truncated (a, b, 1) class]{The zero-truncated $(a, b, 1)$ class} \label{sec:app:discrete:zt} Package \pkg{actuar} provides support for the distributions in this section. Zero-truncated distributions have probability at zero $p_0^T = 0$. Their pmf can be computed recursively by fixing $p_1$ to the value specified below and then using $p_k = (a + b/k) p_{k - 1}$, for $k = 2, 3, \dots$. The distributions are all defined on $k = 1, 2, \dots$. The limiting case of zero-truncated distributions when $p_1$ is infinite is a point mass in $k = 1$. \subsubsection{Zero-truncated Poisson} \begin{itemize} \item Root: \code{ztpois} \item Parameter: \code{lambda} ($\lambda \geq 0$) \end{itemize} \begin{align*} a &= 0, \qquad b = \lambda, \qquad p_1 = \frac{\lambda}{e^\lambda - 1} \\ p_k &= \frac{\lambda^k}{k! (e^\lambda - 1)} \end{align*} \subsubsection{Zero-truncated negative binomial} \begin{itemize} \item Root: \code{ztnbinom} \item Parameters: \code{size} ($r \geq 0$), \code{prob} ($0 < p \leq 1$) \end{itemize} \begin{align*} a &= 1 - p, \qquad b = (r - 1)(1 - p), \qquad p_1 = \frac{r p^r (1 - p)}{1 - p^r} \\ p_k &= \binom{r+k-1}{k} \frac{p^r (1 - p)^k}{1 - p^r} \end{align*} \begin{itemize} \item Special cases: Logarithmic$(1 - p)$ when $r = 0$; Zero-truncated geometric$(p)$ when $r = 1$. \end{itemize} \subsubsection{Zero-truncated geometric} \begin{itemize} \item Root: \code{ztgeom} \item Parameter: \code{prob} ($0 < p \leq 1$) \end{itemize} \begin{align*} a &= 1 - p, \qquad b = 0, \qquad p_1 = p \\ p_k &= p (1 - p)^{k - 1} \end{align*} \subsubsection{Zero-truncated binomial} \begin{itemize} \item Root: \code{ztbinom} \item Parameters: \code{size} ($n = 0, 1, 2, \dots$), \code{prob} ($0 \leq p \leq 1$) \end{itemize} \begin{align*} a &= -\frac{p}{1 - p}, \qquad b = \frac{(n + 1)p}{1 - p}, \qquad p_1 = \frac{n p (1 - p)^{n - 1}}{1 - (1 - p)^n} \\ p_k &= \binom{n}{k} \frac{p^k (1 - p)^{n - k}}{1 - (1 - p)^n}, \quad k = 1, 2, \dots, n \end{align*} \subsubsection{Logarithmic} \begin{itemize} \item Root: \code{logarithmic} \item Parameter: \code{prob} ($0 \leq p < 1$) \end{itemize} \begin{align*} a &= p, \qquad b = -p, \qquad p_1 = - \frac{p}{\log (1 - p)} \\ p_k &= - \frac{p^k}{k \log (1 - p)} \end{align*} \subsection[The zero-modified (a, b, 1) class]{The zero-modified $(a, b, 1)$ class} \label{sec:app:discrete:zm} Package \pkg{actuar} provides support for the distributions in this section. Zero-modified distributions have an arbitrary probability at zero $p_0^M \neq p_0$, where $p_0$ is the probability at zero for the corresponding member of the $(a, b, 0)$ class. Their pmf can be computed recursively by fixing $p_1$ to the value specified below and then using $p_k = (a + b/k) p_{k - 1}$, for $k = 2, 3, \dots$. The distributions are all defined on $k = 0, 1, 2, \dots$. The limiting case of zero-modified distributions when $p_1$ is infinite is a discrete mixture between a point mass in $k = 0$ (with probability $p_0^M$) and a point mass in $k = 1$ (with probability $1 - p_0^M$). \subsubsection{Zero-modified Poisson} \begin{itemize} \item Root: \code{zmpois} \item Parameters: \code{lambda} ($\lambda > 0$), \code{p0} ($0 \leq p_0^M \leq 1$) \end{itemize} \begin{align*} a &= 0, \qquad b = \lambda, \qquad p_1 = \frac{(1 - p_0^M) \lambda}{e^\lambda - 1} \\ p_k &= \frac{(1 - p_0^M) \lambda^k}{k! (e^\lambda - 1)} \end{align*} \subsubsection{Zero-modified negative binomial} \begin{itemize} \item Root: \code{zmnbinom} \item Parameters: \code{size} ($r \geq 0$), \code{prob} ($0 < p \leq 1$), \code{p0} ($0 \leq p_0^M \leq 1$) \end{itemize} \begin{align*} a &= 1 - p, \qquad b = (r - 1)(1 - p), \qquad p_1 = \frac{(1 - p_0^M) r p^r (1 - p)}{1 - p^r} \\ p_k &= \binom{r+k-1}{k} \frac{(1 - p_0^M) p^r (1 - p)^k}{1 - p^r} \end{align*} \begin{itemize} \item Special cases: Zero-modified logarithmic$(1 - p)$ when $r = 0$; Zero-modified geometric$(p)$ when $r = 1$. \end{itemize} \subsubsection{Zero-modified geometric} \begin{itemize} \item Root: \code{zmgeom} \item Parameters: \code{prob} ($0 < p \leq 1$), \code{p0} ($0 \leq p_0^M \leq 1$) \end{itemize} \begin{align*} a &= 1 - p, \qquad b = 0, \qquad p_1 = (1 - p_0^M) p \\ p_k &= (1 - p_0^M) p (1 - p)^{k - 1} \end{align*} \subsubsection{Zero-modified binomial} \begin{itemize} \item Root: \code{zmbinom} \item Parameters: \code{size} ($n = 0, 1, 2, \dots$), \code{prob} ($0 \leq p \leq 1$), \code{p0} ($0 \leq p_0^M \leq 1$) \end{itemize} \begin{align*} a &= -\frac{p}{1 - p}, \qquad b = \frac{(n + 1)p}{1 - p}, \qquad p_1^M = \frac{n (1 - p_0^M) p (1 - p)^{n - 1}}{1 - (1 - p)^n} \\ p_k &= \binom{n}{k} \frac{(1 - p_0^M) p^k (1 - p)^{n - k}}{1 - (1 - p)^n}, \quad k = 1, 2, \dots, n \end{align*} \subsubsection{Zero-modified logarithmic} \begin{itemize} \item Root: \code{zmlogarithmic} \item Parameters: \code{prob} ($0 \leq p < 1$), \code{p0} ($0 \leq p_0^M \leq 1$) \end{itemize} \begin{align*} a &= p, \qquad b = -p, \qquad p_1 = - \frac{(1 - p_0^M) p}{\log (1 - p)} \\ p_k &= - \frac{(1 - p_0^M) p^k}{k \log (1 - p)} \end{align*} \subsection{Other distribution} \label{sec:app:discrete:pig} \subsubsection{Poisson-inverse Gaussian} \begin{itemize} \item Root: \code{poisinvgauss}, \code{pig} \item Parameters: \code{mean} ($\mu > 0$), \code{shape} ($\lambda = 1/\phi$), \code{dispersion} ($\phi > 0$) \end{itemize} \begin{align*} p_x &= \sqrt{\frac{2}{\pi \phi}} \frac{e^{(\phi\mu)^{-1}}}{x!} \left( \sqrt{2\phi \left( 1 + \frac{1}{2\phi\mu^2} \right)} \right)^{- \left( x - \frac{1}{2} \right)} \\ &\phantom{=} \times K_{x - 1/2} \left( \sqrt{\frac{2}{\phi}\left(1 + \frac{1}{2\phi\mu^2}\right)} \right), \quad x = 0, 1, \dots, \end{align*} \noindent% Recursively: \begin{align*} p_0 &= \exp\left\{ \frac{1}{\phi\mu} \left(1 - \sqrt{1 + 2\phi\mu^2}\right) \right\} \\ p_1 &= \frac{\mu}{\sqrt{1 + 2\phi\mu^2}}\, p_0 \\ p_x &= \frac{2\phi\mu^2}{1 + 2\phi\mu^2} \left( 1 - \frac{3}{2x} \right) p_{x - 1} + \frac{\mu^2}{1 + 2\phi\mu^2} \frac{1}{x(x - 1)}\, p_{x - 2}, \quad x = 2, 3, \dots. \end{align*} \noindent% In the limiting case $\mu = \infty$, the pmf reduces to \begin{equation*} p_x = \sqrt{\frac{2}{\pi \phi}} \frac{1}{x!} (\sqrt{2\phi})^{- \left( x - \frac{1}{2} \right)} K_{x - \frac{1}{2}} (\sqrt{2/\phi}), \quad x = 0, 1, \dots \end{equation*} and the recurrence relations become \begin{align*} p_0 &= \exp\left\{-\sqrt{2/\phi}\right\} \\ p_1 &= \frac{1}{\sqrt{2\phi}}\, p_0 \\ p_x &= \left( 1 - \frac{3}{2x} \right) p_{x - 1} + \frac{1}{2\phi} \frac{1}{x(x - 1)}\, p_{x - 2}, \quad x = 2, 3, \dots. \end{align*} %% References \bibliography{actuar} \end{document} %%% Local Variables: %%% mode: noweb %%% coding: utf-8 %%% TeX-master: t %%% End: actuar/vignettes/modeling.Rnw0000644000176200001440000005154114370340204016032 0ustar liggesusers\input{share/preamble} %\VignetteIndexEntry{Loss distributions modeling} %\VignettePackage{actuar} %\SweaveUTF8 \title{Loss modeling features of \pkg{actuar}} \author{Christophe Dutang \\ Université Paris Dauphine \\[3ex] Vincent Goulet \\ Université Laval \\[3ex] Mathieu Pigeon \\ Université du Québec à Montréal} \date{} <>= library(actuar) options(width = 52, digits = 4) @ \begin{document} \maketitle \section{Introduction} \label{sec:introduction} One important task of actuaries is the modeling of claim amount and claim count distributions for ratemaking, loss reserving or other risk evaluation purposes. Package \pkg{actuar} features many support functions for loss distributions modeling: \begin{enumerate} \item support for heavy tail continuous distributions useful in loss severity modeling; \item support for phase-type distributions for ruin theory; \item functions to compute raw moments, limited moments and the moment generating function (when it exists) of continuous distributions; \item support for zero-truncated and zero-modified extensions of the discrete distributions commonly used in loss frequency modeling; \item extensive support of grouped data; \item functions to compute empirical raw and limited moments; \item support for minimum distance estimation using three different measures; \item treatment of coverage modifications (deductibles, limits, inflation, coinsurance). \end{enumerate} Vignette \code{"distributions"} covers the points 1--4 above in great detail. This document concentrates on points 5--8. \section{Grouped data} \label{sec:grouped-data} Grouped data is data represented in an interval-frequency manner. Typically, a grouped data set will report that there were $n_j$ claims in the interval $(c_{j - 1}, c_j]$, $j = 1, \dots, r$ (with the possibility that $c_r = \infty$). This representation is much more compact than an individual data set --- where the value of each claim is known --- but it also carries far less information. Now that storage space in computers has essentially become a non issue, grouped data has somewhat fallen out of fashion. Still, grouped data remains useful as a means to represent data, if only graphically --- for example, a histogram is nothing but a density approximation for grouped data. Moreover, various parameter estimation techniques rely on grouped data. For these reasons, \pkg{actuar} provides facilities to store, manipulate and summarize grouped data. A standard storage method is needed since there are many ways to represent grouped data in the computer: using a list or a matrix, aligning $n_j$ with $c_{j - 1}$ or with $c_j$, omitting $c_0$ or not, etc. With appropriate extraction, replacement and summary methods, manipulation of grouped data becomes similar to that of individual data. Function \code{grouped.data} creates a grouped data object similar to --- and inheriting from --- a data frame. The function accepts two types of input: \begin{enumerate} \item a vector of group boundaries $c_0, c_1, \dots, c_r$ and one or more vectors of group frequencies $n_1, \dots, n_r$ (note that there should be one more group boundary than group frequencies); \item individual data $x_1, \dots, x_n$ and either a vector of breakpoints $c_1, \dots, c_r$, a number $r$ of breakpoints or an algorithm to determine the latter. \end{enumerate} In the second case, \code{grouped.data} will group the individual data using function \code{hist}. The function always assumes that the intervals are contiguous. \begin{example} \label{ex:grouped.data-1} Consider the following already grouped data set: \begin{center} \begin{tabular}{lcc} \toprule Group & Frequency (Line 1) & Frequency (Line 2) \\ \midrule $(0, 25]$ & 30 & 26 \\ $(25, 50]$ & 31 & 33 \\ $(50, 100]$ & 57 & 31 \\ $(100, 150]$ & 42 & 19 \\ $(150, 250]$ & 65 & 16 \\ $(250, 500]$ & 84 & 11 \\ \bottomrule \end{tabular} \end{center} We can conveniently and unambiguously store this data set in R as follows: <>= x <- grouped.data(Group = c(0, 25, 50, 100, 150, 250, 500), Line.1 = c(30, 31, 57, 42, 65, 84), Line.2 = c(26, 33, 31, 19, 16, 11)) @ Internally, object \code{x} is a list with class <>= class(x) @ The package provides a suitable \code{print} method to display grouped data objects in an intuitive manner: <>= x @ \qed \end{example} \begin{example} \label{ex:grouped.data-2} Consider Data Set~B of \citet[Table~11.2]{LossModels4e}: \begin{center} \begin{tabular}{*{10}{r}} 27 & 82 & 115 & 126 & 155 & 161 & 243 & 294 & 340 & 384 \\ 457 & 680 & 855 & 877 & 974 & \numprint{1193} & \numprint{1340} & \numprint{1884} & \numprint{2558} & \numprint{15743} \end{tabular} \end{center} We can represent this data set as grouped data using either an automatic or a suggested number of groups (see \code{?hist} for details): <>= y <- c( 27, 82, 115, 126, 155, 161, 243, 294, 340, 384, 457, 680, 855, 877, 974, 1193, 1340, 1884, 2558, 15743) grouped.data(y) grouped.data(y, breaks = 5) @ The above grouping methods use equi-spaced breaks. This is rarely appropriate for heavily skewed insurance data. For this reason, \code{grouped.data} also supports specified breakpoints (or group boundaries): <>= grouped.data(y, breaks = c(0, 100, 200, 350, 750, 1200, 2500, 5000, 16000)) @ \qed \end{example} The package supports the most common extraction and replacement methods for \code{"grouped.data"} objects using the usual \code{[} and \code{[<-} operators. In particular, the following extraction operations are supported. (In the following, object \code{x} is the grouped data object of \autoref{ex:grouped.data-1}.) <>= x <- grouped.data(Group = c(0, 25, 50, 100, 150, 250, 500), Line.1 = c(30, 31, 57, 42, 65, 84), Line.2 = c(26, 33, 31, 19, 16, 11)) @ \begin{enumerate}[i)] \item Extraction of the vector of group boundaries (the first column): <>= x[, 1] @ \item Extraction of the vector or matrix of group frequencies (the second and third columns): <>= x[, -1] @ \item Extraction of a subset of the whole object (first three lines): <>= x[1:3, ] @ \end{enumerate} Notice how extraction results in a simple vector or matrix if either of the group boundaries or the group frequencies are dropped. As for replacement operations, the package implements the following. \begin{enumerate}[i)] \item Replacement of one or more group frequencies: <>= x[1, 2] <- 22; x x[1, c(2, 3)] <- c(22, 19); x @ \item Replacement of the boundaries of one or more groups: <>= x[1, 1] <- c(0, 20); x x[c(3, 4), 1] <- c(55, 110, 160); x @ \end{enumerate} It is not possible to replace the boundaries and the frequencies simultaneously. The mean of grouped data is \begin{equation} \hat{\mu} = \frac{1}{n} \sum_{j = 1}^r a_j n_j, \end{equation} where $a_j = (c_{j - 1} + c_j)/2$ is the midpoint of the $j$th interval, and $n = \sum_{j = 1}^r n_j$, whereas the variance is \begin{equation} \frac{1}{n} \sum_{j = 1}^r n_j (a_j - \hat{\mu})^2. \end{equation} The standard deviation is the square root of the variance. The package defines methods to easily compute the above descriptive statistics: <>= mean(x) var(x) sd(x) @ Higher empirical moments can be computed with \code{emm}; see \autoref{sec:empirical-moments}. The R function \code{hist} splits individual data into groups and draws an histogram of the frequency distribution. The package introduces a method for already grouped data. Only the first frequencies column is considered (see \autoref{fig:histogram} for the resulting graph): <>= hist(x[, -3]) @ \begin{figure}[t] \centering <>= hist(x[, -3]) @ \caption{Histogram of a grouped data object} \label{fig:histogram} \end{figure} \begin{rem} One will note that for an individual data set like \code{y} of \autoref{ex:grouped.data-2}, the following two expressions yield the same result: <>= hist(y) hist(grouped.data(y)) @ \end{rem} R has a function \code{ecdf} to compute the empirical cdf $F_n(x)$ of an individual data set: \begin{equation} \label{eq:ecdf} F_n(x) = \frac{1}{n} \sum_{j = 1}^n I\{x_j \leq x\}, \end{equation} where $I\{\mathcal{A}\} = 1$ if $\mathcal{A}$ is true and $I\{\mathcal{A}\} = 0$ otherwise. The function returns a \code{"function"} object to compute the value of $F_n(x)$ in any $x$. The approximation of the empirical cdf for grouped data is called an ogive \citep{LossModels4e,HoggKlugman}. It is obtained by joining the known values of $F_n(x)$ at group boundaries with straight line segments: \begin{equation} \tilde{F}_n(x) = \begin{cases} 0, & x \leq c_0 \\ \dfrac{(c_j - x) F_n(c_{j-1}) + (x - c_{j-1}) F_n(c_j)}{% c_j - c_{j - 1}}, & c_{j-1} < x \leq c_j \\ 1, & x > c_r. \end{cases} \end{equation} The package includes a generic function \code{ogive} with methods for individual and for grouped data. The function behaves exactly like \code{ecdf}. \begin{example} \label{ex:ogive} Consider first the grouped data set of \autoref{ex:grouped.data-1}. Function \code{ogive} returns a function to compute the ogive $\tilde{F}_n(x)$ in any point: <>= (Fnt <- ogive(x)) @ Methods for functions \code{knots} and \code{plot} allow, respectively, to obtain the knots $c_0, c_1, \dots, c_r$ of the ogive and to draw a graph (see \autoref{fig:ogive}): <>= knots(Fnt) Fnt(knots(Fnt)) plot(Fnt) @ \begin{figure}[t] \centering <>= plot(Fnt) @ \caption{Ogive of a grouped data object} \label{fig:ogive} \end{figure} To add further symmetry between functions \code{hist} and \code{ogive}, the latter also accepts in argument a vector individual data. It will call \code{grouped.data} and then computes the ogive. (Below, \code{y} is the individual data set of \autoref{ex:grouped.data-2}.) <>= (Fnt <- ogive(y)) knots(Fnt) @ \qed \end{example} A method of function \code{quantile} for grouped data objects returns linearly smoothed quantiles, that is, the inverse of the ogive evaluated at various points: <>= Fnt <- ogive(x) @ <>= quantile(x) Fnt(quantile(x)) @ Finally, a \code{summary} method for grouped data objects returns the quantiles and the mean, as is usual for individual data: <>= summary(x) @ \section{Data sets} \label{sec:data-sets} This is certainly not the most spectacular feature of \pkg{actuar}, but it remains useful for illustrations and examples: the package includes the individual dental claims and grouped dental claims data of \cite{LossModels4e}: <>= data("dental"); dental data("gdental"); gdental @ \section{Calculation of empirical moments} \label{sec:empirical-moments} The package provides two functions useful for estimation based on moments. First, function \code{emm} computes the $k$th empirical moment of a sample, whether in individual or grouped data form. For example, the following expressions compute the first three moments for individual and grouped data sets: <>= emm(dental, order = 1:3) emm(gdental, order = 1:3) @ Second, in the same spirit as \code{ecdf} and \code{ogive}, function \code{elev} returns a function to compute the empirical limited expected value --- or first limited moment --- of a sample for any limit. Again, there are methods for individual and grouped data (see \autoref{fig:elev} for the graphs): <>= lev <- elev(dental) lev(knots(lev)) plot(lev, type = "o", pch = 19) lev <- elev(gdental) lev(knots(lev)) plot(lev, type = "o", pch = 19) @ \begin{figure}[t] \centering <>= par(mfrow = c(1, 2)) plot(elev(dental), type = "o", pch = 19) plot(elev(gdental), type = "o", pch = 19) @ \caption{Empirical limited expected value function of an individual data object (left) and a grouped data object (right)} \label{fig:elev} \end{figure} \section{Minimum distance estimation} \label{sec:minimum-distance} Two methods are widely used by actuaries to fit models to data: maximum likelihood and minimum distance. The first technique applied to individual data is well covered by function \code{fitdistr} of the package \pkg{MASS} \citep{MASS}. The second technique minimizes a chosen distance function between theoretical and empirical distributions. Package \pkg{actuar} provides function \code{mde}, very similar in usage and inner working to \code{fitdistr}, to fit models according to any of the following three distance minimization methods. \begin{enumerate} \item The Cramér-von~Mises method (\code{CvM}) minimizes the squared difference between the theoretical cdf and the empirical cdf or ogive at their knots: \begin{equation} d(\theta) = \sum_{j = 1}^n w_j [F(x_j; \theta) - F_n(x_j; \theta)]^2 \end{equation} for individual data and \begin{equation} d(\theta) = \sum_{j = 1}^r w_j [F(c_j; \theta) - \tilde{F}_n(c_j; \theta)]^2 \end{equation} for grouped data. Here, $F(x)$ is the theoretical cdf of a parametric family, $F_n(x)$ is the empirical cdf, $\tilde{F}_n(x)$ is the ogive and $w_1 \geq 0, w_2 \geq 0, \dots$ are arbitrary weights (defaulting to $1$). \item The modified chi-square method (\code{chi-square}) applies to grouped data only and minimizes the squared difference between the expected and observed frequency within each group: \begin{equation} d(\theta) = \sum_{j = 1}^r w_j [n (F(c_j; \theta) - F(c_{j - 1}; \theta)) - n_j]^2, \end{equation} where $n = \sum_{j = 1}^r n_j$. By default, $w_j = n_j^{-1}$. \item The layer average severity method (\code{LAS}) applies to grouped data only and minimizes the squared difference between the theoretical and empirical limited expected value within each group: \begin{equation} d(\theta) = \sum_{j = 1}^r w_j [\LAS(c_{j - 1}, c_j; \theta) - \tilde{\LAS}_n(c_{j - 1}, c_j; \theta)]^2, \end{equation} where $\LAS(x, y) = \E{X \wedge y} - \E{X \wedge x}$, % $\tilde{\LAS}_n(x, y) = \tilde{E}_n[X \wedge y] - \tilde{E}_n[X \wedge x]$ and $\tilde{E}_n[X \wedge x]$ is the empirical limited expected value for grouped data. \end{enumerate} The arguments of \code{mde} are a data set, a function to compute $F(x)$ or $\E{X \wedge x}$, starting values for the optimization procedure and the name of the method to use. The empirical functions are computed with \code{ecdf}, \code{ogive} or \code{elev}. \begin{example} \label{ex:mde} The expressions below fit an exponential distribution to the grouped dental data set, as per example~2.21 of \cite{LossModels}: <>= op <- options(warn = -1) # hide warnings from mde() @ <>= mde(gdental, pexp, start = list(rate = 1/200), measure = "CvM") mde(gdental, pexp, start = list(rate = 1/200), measure = "chi-square") mde(gdental, levexp, start = list(rate = 1/200), measure = "LAS") @ <>= options(op) # restore warnings @ \qed \end{example} It should be noted that optimization is not always as simple to achieve as in \autoref{ex:mde}. For example, consider the problem of fitting a Pareto distribution to the same data set using the Cramér--von~Mises method: <>= mde(gdental, ppareto, start = list(shape = 3, scale = 600), measure = "CvM") @ <>= out <- try(mde(gdental, ppareto, start = list(shape = 3, scale = 600), measure = "CvM"), silent = TRUE) cat(sub(", scale", ",\n scale", out)) @ Working in the log of the parameters often solves the problem since the optimization routine can then flawlessly work with negative parameter values: <>= pparetolog <- function(x, logshape, logscale) ppareto(x, exp(logshape), exp(logscale)) (p <- mde(gdental, pparetolog, start = list(logshape = log(3), logscale = log(600)), measure = "CvM")) @ The actual estimators of the parameters are obtained with <>= exp(p$estimate) @ %$ This procedure may introduce additional bias in the estimators, though. \section{Coverage modifications} \label{sec:coverage} Let $X$ be the random variable of the actual claim amount for an insurance policy, $Y^L$ be the random variable of the amount paid per loss and $Y^P$ be the random variable of the amount paid per payment. The terminology for the last two random variables refers to whether or not the insurer knows that a loss occurred. Now, the random variables $X$, $Y^L$ and $Y^P$ will differ if any of the following coverage modifications are present for the policy: an ordinary or a franchise deductible, a limit, coinsurance or inflation adjustment \cite[see][chapter~8 for precise definitions of these terms]{LossModels4e}. \autoref{tab:coverage} summarizes the definitions of $Y^L$ and $Y^P$. \begin{table} \centering \begin{tabular}{lll} \toprule Coverage modification & Per-loss variable ($Y^L$) & Per-payment variable ($Y^P$)\\ \midrule Ordinary deductible ($d$) & $\begin{cases} 0, & X \leq d \\ X - d, & X > d \end{cases}$ & $\begin{cases} X - d, & X > d \end{cases}$ \medskip \\ Franchise deductible ($d$) & $\begin{cases} 0, & X \leq d \\ X, & X > d \end{cases}$ & $\begin{cases} X, & X > d \end{cases} $ \medskip \\ Limit ($u$) & $\begin{cases} X, & X \leq u \\ u, & X > u \end{cases}$ & $\begin{cases} X, & X \leq u \\ u, & X > u \end{cases}$ \bigskip \\ Coinsurance ($\alpha$) & $\alpha X$ & $\alpha X$ \medskip \\ Inflation ($r$) & $(1 + r)X$ & $(1 + r)X$ \\ \bottomrule \end{tabular} \caption{Coverage modifications for per-loss variable ($Y^L$) and per-payment variable ($Y^P$) as defined in \cite{LossModels4e}.} \label{tab:coverage} \end{table} Often, one will want to use data $Y^P_1, \dots, Y^P_n$ (or $Y^L_1, \dots, Y^L_n$) from the random variable $Y^P$ ($Y^L$) to fit a model on the unobservable random variable $X$. This requires expressing the pdf or cdf of $Y^P$ ($Y^L$) in terms of the pdf or cdf of $X$. Function \code{coverage} of \pkg{actuar} does just that: given a pdf or cdf and any combination of the coverage modifications mentioned above, \code{coverage} returns a function object to compute the pdf or cdf of the modified random variable. The function can then be used in modeling like any other \code{dfoo} or \code{pfoo} function. \begin{example} \label{ex:coverage} Let $Y^P$ represent the amount paid by an insurer for a policy with an ordinary deductible $d$ and a limit $u - d$ (or maximum covered loss of $u$). Then the definition of $Y^P$ is \begin{equation} Y^P = \begin{cases} X - d, & d \leq X \leq u \\ u - d, & X \geq u \end{cases} \end{equation} and its pdf is \begin{equation} \label{eq:pdf-YP} f_{Y^P}(y) = \begin{cases} 0, & y = 0 \\ \dfrac{f_X(y + d)}{1 - F_X(d)}, & 0 < y < u - d \\ \dfrac{1 - F_X(u)}{1 - F_X(d)}, & y = u - d \\ 0, & y > u - d. \end{cases} \end{equation} Assume $X$ has a gamma distribution. Then an R function to compute the pdf \eqref{eq:pdf-YP} in any $y$ for a deductible $d = 1$ and a limit $u = 10$ is obtained with \code{coverage} as follows: <>= f <- coverage(pdf = dgamma, cdf = pgamma, deductible = 1, limit = 10) f f(0, shape = 5, rate = 1) f(5, shape = 5, rate = 1) f(9, shape = 5, rate = 1) f(12, shape = 5, rate = 1) @ \qed \end{example} Note how function \code{f} in the previous example is built specifically for the coverage modifications submitted and contains as little useless code as possible. The function returned by \code{coverage} may be used for various purposes, most notably parameter estimation, as the following example illustrates. \begin{example} Let object \code{y} contain a sample of claims amounts from policies with the deductible and limit of \autoref{ex:coverage}. One can fit a gamma distribution by maximum likelihood to the claim severity distribution as follows: <>= x <- rgamma(100, 2, 0.5) y <- pmin(x[x > 1], 9) op <- options(warn = -1) # hide warnings from fitdistr() @ <>= library(MASS) fitdistr(y, f, start = list(shape = 2, rate = 0.5)) @ <>= options(op) # restore warnings @ \qed \end{example} Vignette \code{"coverage"} contains more detailed formulas for the pdf and the cdf under various combinations of coverage modifications. \bibliography{actuar} \end{document} %%% Local Variables: %%% mode: noweb %%% TeX-master: t %%% coding: utf-8 %%% End: actuar/vignettes/framed.sty0000644000176200001440000005366114264305077015563 0ustar liggesusers% framed.sty v 0.96 2011/10/22 % Copyright (C) 1992-2011 by Donald Arseneau (asnd@triumf.ca) % These macros may be freely transmitted, reproduced, or modified % for any purpose provided that this notice is left intact. % %====================== Begin Instructions ======================= % % framed.sty % ~~~~~~~~~~ % Create framed, shaded, or differently highlighted regions that can % break across pages. The environments defined are % framed - ordinary frame box (\fbox) with edge at margin % oframed - framed with open top/bottom at page breaks % shaded - shaded background (\colorbox) bleeding into margin % shaded* - shaded background (\colorbox) with edge at margin % snugshade - shaded with tight fit around text (esp. in lists) % snugshade* - like snugshade with shading edge at margin % leftbar - thick vertical line in left margin % % to be used like % \begin{framed} % copious text % \end{framed} % % But the more general purpose of this package is to facilitate the % definition of new environments that take multi-line material, % wrap it with some non-breakable formatting (some kind of box or % decoration) and allow page breaks in the material. Such environments % are defined to declare (or use) \FrameCommand for applying the boxy % decoration, and \MakeFramed{settings} ... \endMakeFramed wrapped % around the main text argument (environment body). % % The "framed" environment uses "\fbox", by default, as its "\FrameCommand" % with the additional settings "\fboxrule=\FrameRule" and "\fboxsep=\FrameSep". % You can change these lengths (using "\setlength") and you can change % the definition of "\FrameCommand" to use much fancier boxes. % % In fact, the "shaded" environment just redefines \FrameCommand to be % "\colorbox{shadecolor}" (and you have to define the color `"shadecolor"': % "\definecolor{shadecolor}..."). % % Although the intention is for other packages to define the varieties % of decoration, a command "\OpenFbox" is defined for frames with open % tops or bottoms, and used for the "oframed" environment. This facility % is based on a more complex and capable command "\CustomFBox" which can % be used for a wider range of frame styles. One such style of a title-bar % frame with continuation marks is provided as an example. It is used by % the "titled-frame" environment. To make use of "titled-frame" in your % document, or the "\TitleBarFrame" command in your own environment % definitions, you must define the colors TFFrameColor (for the frame) % and a contrasting TFTitleColor (for the title text). % % A page break is allowed, and even encouraged, before the framed % environment. If you want to attach some text (a box title) to the % frame, then the text should be inserted by \FrameCommand so it cannot % be separated from the body. % % The contents of the framed regions are restricted: % Floats, footnotes, marginpars and head-line entries will be lost. % (Some of these may be handled in a later version.) % This package will not work with the page breaking of multicol.sty, % or other systems that perform column-balancing. % % The MakeFramed environment does the work. Its `settings' argument % should contain any adjustments to the text width (via a setting of % "\hsize"). Here, the parameter "\width" gives the measured extra width % added by the frame, so a common setting is "\advance\hsize-\width" % which reduces the width of the text just enough that the outer edge % of the frame aligns with the margins. The `settings' should also % include a `restore' command -- "\@parboxrestore" or "\FrameRestore" % or something similar; for instance, the snugshade environment uses % settings to eliminate list indents and vertical space, but uses % "\hspace" in "\FrameCommand" to reproduce the list margin ouside the % shading. % % There are actually four variants of "\FrameCommand" to allow different % formatting for each part of an environment broken over pages. Unbroken % text is adorned by "\FrameCommand", whereas split text first uses % "\FirstFrameCommand", possibly followed by "\MidFrameCommand", and % finishing with "\LastFrameCommand". The default definitions for % these three just invokes "\FrameCommand", so that all portions are % framed the same way. See the oframe environment for use of distinct % First/Mid/Last frames. % % Expert commands: % \MakeFramed, \endMakeFramed: the "MakeFramed" environment % \FrameCommand: command to draw the frame around its argument % \FirstFrameCommand: the frame for the first part of a split environment % \LastFrameCommand: for the last portion % \MidFrameCommand: for any intermediate segments % \FrameRestore: restore some text settings, but fewer than \@parboxrestore % \FrameRule: length register; \fboxrule for default "framed". % \FrameSep: length register; \fboxsep for default "framed". % \FrameHeightAdjust: macro; height of frame above baseline at top of page % \OuterFrameSep: vertical space before and after the framed env. Defaults to "\topsep" % % This is still a `pre-production' version because I can think of many % features/improvements that should be made. Also, a detailed manual needs % to be written. Nevertheless, starting with version 0.5 it should be bug-free. % % ToDo: % Test more varieties of list % Improve and correct documentation % Propagation of \marks % Handle footnotes (how??) floats (?) and marginpars. % Stretchability modification. % Make inner contents height/depth influence placement. %======================== End Instructions ======================== \ProvidesPackage{framed}[2011/10/22 v 0.96: framed or shaded text with page breaks] \newenvironment{framed}% using default \FrameCommand {\MakeFramed {\advance\hsize-\width \FrameRestore}}% {\endMakeFramed} \newenvironment{shaded}{% \def\FrameCommand{\fboxsep=\FrameSep \colorbox{shadecolor}}% \MakeFramed {\FrameRestore}}% {\endMakeFramed} \newenvironment{shaded*}{% \def\FrameCommand{\fboxsep=\FrameSep \colorbox{shadecolor}}% \MakeFramed {\advance\hsize-\width \FrameRestore}}% {\endMakeFramed} \newenvironment{leftbar}{% \def\FrameCommand{\vrule width 3pt \hspace{10pt}}% \MakeFramed {\advance\hsize-\width \FrameRestore}}% {\endMakeFramed} % snugshde: Shaded environment that % -- uses the default \fboxsep instead of \FrameSep % -- leaves the text indent unchanged (shading bleeds out) % -- eliminates possible internal \topsep glue (\@setminipage) % -- shrinks inside the margins for lists % An \item label will tend to hang outside the shading, thanks to % the small \fboxsep. \newenvironment{snugshade}{% \def\FrameCommand##1{\hskip\@totalleftmargin \hskip-\fboxsep \colorbox{shadecolor}{##1}\hskip-\fboxsep % There is no \@totalrightmargin, so: \hskip-\linewidth \hskip-\@totalleftmargin \hskip\columnwidth}% \MakeFramed {\advance\hsize-\width \@totalleftmargin\z@ \linewidth\hsize \@setminipage}% }{\par\unskip\@minipagefalse\endMakeFramed} \newenvironment{snugshade*}{% \def\FrameCommand##1{\hskip\@totalleftmargin \colorbox{shadecolor}{##1}% % There is no \@totalrightmargin, so: \hskip-\linewidth \hskip-\@totalleftmargin \hskip\columnwidth}% \MakeFramed {\advance\hsize-\width \@totalleftmargin\z@ \linewidth\hsize \advance\labelsep\fboxsep \@setminipage}% }{\par\unskip\@minipagefalse\endMakeFramed} \newenvironment{oframed}{% open (top or bottom) framed \def\FrameCommand{\OpenFBox\FrameRule\FrameRule}% \def\FirstFrameCommand{\OpenFBox\FrameRule\z@}% \def\MidFrameCommand{\OpenFBox\z@\z@}% \def\LastFrameCommand{\OpenFBox\z@\FrameRule}% \MakeFramed {\advance\hsize-\width \FrameRestore}% }{\endMakeFramed} % A simplified entry to \CustomFBox with two customized parameters: % the thicknesses of the top and bottom rules. Perhaps we want to % use less \fboxsep on the open edges? \def\OpenFBox#1#2{\fboxsep\FrameSep \CustomFBox{}{}{#1}{#2}\FrameRule\FrameRule} % \CustomFBox is like an amalgamation of \fbox and \@frameb@x, % so it can be used by an alternate to \fbox or \fcolorbox, but % it has more parameters for various customizations. % Parameter #1 is inserted (in vmode) right after the top rule % (useful for a title or assignments), and #2 is similar, but % inserted right above the bottom rule. % The thicknesses of the top, bottom, left, and right rules are % given as parameters #3,#4,#5,#6 respectively. They should be % \fboxrule or \z@ (or some other thickness). % The text argument is #7. % An instance of this can be used for the frame of \fcolorbox by % locally defining \fbox before \fcolorbox; e.g., % \def\fbox{\CustomFBox{}{}\z@\z@\fboxrule\fboxrule}\fcolorbox % % Do we need to use different \fboxsep on different sides too? % \long\def\CustomFBox#1#2#3#4#5#6#7{% \leavevmode\begingroup \setbox\@tempboxa\hbox{% \color@begingroup \kern\fboxsep{#7}\kern\fboxsep \color@endgroup}% \hbox{% % Here we calculate and shift for the depth. Done in % a group because one of the arguments might be \@tempdima % (we could use \dimexpr instead without grouping). \begingroup \@tempdima#4\relax \advance\@tempdima\fboxsep \advance\@tempdima\dp\@tempboxa \expandafter\endgroup\expandafter \lower\the\@tempdima\hbox{% \vbox{% \hrule\@height#3\relax #1% \hbox{% \vrule\@width#5\relax \vbox{% \vskip\fboxsep % maybe these should be parameters too \copy\@tempboxa \vskip\fboxsep}% \vrule\@width#6\relax}% #2% \hrule\@height#4\relax}% }% }% \endgroup } % A particular type of titled frame with continuation marks. % Parameter #1 is the title, repeated on each page. \newenvironment{titled-frame}[1]{% \def\FrameCommand{\fboxsep8pt\fboxrule2pt \TitleBarFrame{\textbf{#1}}}% \def\FirstFrameCommand{\fboxsep8pt\fboxrule2pt \TitleBarFrame[$\blacktriangleright$]{\textbf{#1}}}% \def\MidFrameCommand{\fboxsep8pt\fboxrule2pt \TitleBarFrame[$\blacktriangleright$]{\textbf{#1\ (cont)}}}% \def\LastFrameCommand{\fboxsep8pt\fboxrule2pt \TitleBarFrame{\textbf{#1\ (cont)}}}% \MakeFramed{\advance\hsize-20pt \FrameRestore}}% % note: 8 + 2 + 8 + 2 = 20. Don't use \width because the frame title % could interfere with the width measurement. {\endMakeFramed} % \TitleBarFrame[marker]{title}{contents} % Frame with a label at top, optional continuation marker at bottom right. % Frame color is TFFrameColor and title color is a contrasting TFTitleColor; % both need to be defined before use. The frame itself use \fboxrule and % \fboxsep. If the title is omitted entirely, the title bar is omitted % (use a blank space to force a blank title bar). % \newcommand\TitleBarFrame[3][]{\begingroup \ifx\delimiter#1\delimiter \let\TF@conlab\@empty \else \def\TF@conlab{% continuation label \nointerlineskip \smash{\rlap{\kern\wd\@tempboxa\kern\fboxrule\kern\fboxsep #1}}}% \fi \let\TF@savecolor\current@color \textcolor{TFFrameColor}{% \CustomFBox {\TF@Title{#2}}{\TF@conlab}% \fboxrule\fboxrule\fboxrule\fboxrule {\let\current@color\TF@savecolor\set@color #3}% }\endgroup } % The title bar for \TitleBarFrame \newcommand\TF@Title[1]{% \ifx\delimiter#1\delimiter\else \kern-0.04pt\relax \begingroup \setbox\@tempboxa\vbox{% \kern0.8ex \hbox{\kern\fboxsep\textcolor{TFTitleColor}{#1}\vphantom{Tj)}}% \kern0.8ex}% \hrule\@height\ht\@tempboxa \kern-\ht\@tempboxa \box\@tempboxa \endgroup \nointerlineskip \kern-0.04pt\relax \fi } \chardef\FrameRestore=\catcode`\| % for debug \catcode`\|=\catcode`\% % (debug: insert space after backslash) \newlength\OuterFrameSep \OuterFrameSep=\maxdimen \relax \def\MakeFramed#1{\par % apply default \OuterFrameSep = \topsep \ifdim\OuterFrameSep=\maxdimen \OuterFrameSep\topsep \fi % measure added width and height; call result \width and \height \fb@sizeofframe\FrameCommand \let\width\fb@frw \let\height\fb@frh % insert pre-penalties and skips \begingroup \skip@\lastskip \if@nobreak\else \penalty9999 % updates \page parameters \ifdim\pagefilstretch=\z@ \ifdim\pagefillstretch=\z@ % not infinitely stretchable, so encourage a page break here \edef\@tempa{\the\skip@}% \ifx\@tempa\zero@glue \penalty-30 \else \vskip-\skip@ \penalty-30 \vskip\skip@ \fi\fi\fi \penalty\z@ % Give a stretchy breakpoint that will always be taken in preference % to the \penalty 9999 used to update page parameters. The cube root % of 10000/100 indicates a multiplier of 0.21545, but the maximum % calculated badness is really 8192, not 10000, so the multiplier % is 0.2301. \advance\skip@ \z@ plus-.5\baselineskip \advance\skip@ \z@ plus-.231\height \advance\skip@ \z@ plus-.231\skip@ \advance\skip@ \z@ plus-.231\OuterFrameSep \vskip-\skip@ \penalty 1800 \vskip\skip@ \fi \addvspace{\OuterFrameSep}% \endgroup % clear out pending page break \penalty\@M \vskip 2\baselineskip \vskip\height \penalty9999 \vskip -2\baselineskip \vskip-\height \penalty9999 % updates \pagetotal |\message{After clearout, \pagetotal=\the\pagetotal, \pagegoal=\the\pagegoal. }% \fb@adjheight \setbox\@tempboxa\vbox\bgroup #1% Modifications to \hsize (can use \width and \height) \textwidth\hsize \columnwidth\hsize } \def\endMakeFramed{\par \kern\z@ \hrule\@width\hsize\@height\z@ % possibly bad \penalty-100 % (\hrule moves depth into height) \egroup %%% {\showoutput\showbox\@tempboxa}% \begingroup \fb@put@frame\FrameCommand\FirstFrameCommand \endgroup \@minipagefalse % In case it was set and not cleared } % \fb@put@frame takes the contents of \@tempboxa and puts all, or a piece, % of it on the page with a frame (\FrameCommand, \FirstFrameCommand, % \MidFrameCommand, or \LastFrameCommand). It recurses until all of % \@tempboxa has been used up. (\@tempboxa must have zero depth.) % #1 = attempted framing command, if no split % #2 = framing command if split % First iteration: Try to fit with \FrameCommand. If it does not fit, % split for \FirstFrameCommand. % Later iteration: Try to fit with \LastFrameCommand. If it does not % fit, split for \MidFrameCommand. \def\fb@put@frame#1#2{\relax \ifdim\pagegoal=\maxdimen \pagegoal\vsize \fi | \message{=============== Entering putframe ====================^^J | \pagegoal=\the\pagegoal, \pagetotal=\the\pagetotal. }% \ifinner \fb@putboxa#1% \fb@afterframe \else \dimen@\pagegoal \advance\dimen@-\pagetotal % natural space left on page \ifdim\dimen@<2\baselineskip % Too little room on page | \message{Page has only \the\dimen@\space room left; eject. }% \eject \fb@adjheight \fb@put@frame#1#2% \else % there's appreciable room left on the page \fb@sizeofframe#1% | \message{\string\pagetotal=\the\pagetotal, | \string\pagegoal=\the\pagegoal, | \string\pagestretch=\the\pagestretch, | \string\pageshrink=\the\pageshrink, | \string\fb@frh=\the\fb@frh. \space} | \message{^^JBox of size \the\ht\@tempboxa\space}% \begingroup % temporarily set \dimen@ to be... \advance\dimen@.8\pageshrink % maximum space available on page \advance\dimen@-\fb@frh\relax % max space available for frame's contents %%% LOOKS SUBTRACTED AND ADDED, SO DOUBLE ACCOUNTING! \expandafter\endgroup % expand \ifdim, then restore \dimen@ to real room left on page \ifdim\dimen@>\ht\@tempboxa % whole box does fit | \message{fits in \the\dimen@. }% % ToDo: Change this to use vsplit anyway to capture the marks % MERGE THIS WITH THE else CLAUSE!!! \fb@putboxa#1% \fb@afterframe \else % box must be split | \message{must be split to fit in \the\dimen@. }% % update frame measurement to use \FirstFrameCommand or \MidFrameCommand \fb@sizeofframe#2% \setbox\@tempboxa\vbox{% simulate frame and flexiblity of the page: \vskip \fb@frh \@plus\pagestretch \@minus.8\pageshrink \kern137sp\kern-137sp\penalty-30 \unvbox\@tempboxa}% \edef\fb@resto@set{\boxmaxdepth\the\boxmaxdepth \splittopskip\the\splittopskip}% \boxmaxdepth\z@ \splittopskip\z@ | \message{^^JPadded box of size \the\ht\@tempboxa\space split to \the\dimen@}% % Split box here \setbox\tw@\vsplit\@tempboxa to\dimen@ | \toks99\expandafter{\splitfirstmark}% | \toks98\expandafter{\splitbotmark}% | \message{Marks are: \the\toks99, \the\toks98. }% \setbox\tw@\vbox{\unvbox\tw@}% natural-sized | \message{Natural height of split box is \the\ht\tw@, leaving | \the\ht\@tempboxa\space remainder. }% % If the split-to size > (\vsize-\topskip), then set box to full size. \begingroup \advance\dimen@\topskip \expandafter\endgroup \ifdim\dimen@>\pagegoal | \message{Frame is big -- Use up the full column. }% \dimen@ii\pagegoal \advance\dimen@ii -\topskip \advance\dimen@ii \FrameHeightAdjust\relax \else % suspect this is implemented incorrectly: % If the split-to size > feasible room_on_page, rebox it smaller. \advance\dimen@.8\pageshrink \ifdim\ht\tw@>\dimen@ | \message{Box too tall; rebox it to \the\dimen@. }% \dimen@ii\dimen@ \else % use natural size \dimen@ii\ht\tw@ \fi \fi % Re-box contents to desired size \dimen@ii \advance\dimen@ii -\fb@frh \setbox\tw@\vbox to\dimen@ii \bgroup % remove simulated frame and page flexibility: \vskip -\fb@frh \@plus-\pagestretch \@minus-.8\pageshrink \unvbox\tw@ \unpenalty\unpenalty \ifdim\lastkern=-137sp % whole box went to next page | \message{box split at beginning! }% % need work here??? \egroup \fb@resto@set \eject % (\vskip for frame size was discarded) \fb@adjheight \fb@put@frame#1#2% INSERTED ??? \else % Got material split off at the head \egroup \fb@resto@set \ifvoid\@tempboxa % it all fit after all | \message{box split at end! }% \setbox\@tempboxa\box\tw@ \fb@putboxa#1% \fb@afterframe \else % it really did split | \message{box split as expected. Its reboxed height is \the\ht\tw@. }% \ifdim\wd\tw@>\z@ \wd\tw@\wd\@tempboxa \centerline{#2{\box\tw@}}% ??? \centerline bad idea \else | \message{Zero width means likely blank. Don't frame it (guess)}% \box\tw@ \fi \hrule \@height\z@ \@width\hsize \eject \fb@adjheight \fb@put@frame\LastFrameCommand\MidFrameCommand \fi\fi\fi\fi\fi } \def\fb@putboxa#1{% \ifvoid\@tempboxa \PackageWarning{framed}{Boxa is void -- discard it. }% \else | \message{Frame and place boxa. }% | %{\showoutput\showbox\@tempboxa}% \centerline{#1{\box\@tempboxa}}% \fi } \def\fb@afterframe{% \nointerlineskip \null %{\showoutput \showlists} \penalty-30 \vskip\OuterFrameSep \relax } % measure width and height added by frame (#1 = frame command) % call results \fb@frw and \fb@frh % todo: a mechanism to handle wide frame titles \newdimen\fb@frw \newdimen\fb@frh \def\fb@sizeofframe#1{\begingroup \setbox\z@\vbox{\vskip-5in \hbox{\hskip-5in #1{\hbox{\vrule \@height 4.7in \@depth.3in \@width 5in}}}% \vskip\z@skip}% | \message{Measuring frame addition for \string#1 in \@currenvir\space | gives ht \the\ht\z@\space and wd \the\wd\z@. }% | %{\showoutput\showbox\z@}% \global\fb@frw\wd\z@ \global\fb@frh\ht\z@ \endgroup } \def\fb@adjheight{% \vbox to\FrameHeightAdjust{}% get proper baseline skip from above. \penalty\@M \nointerlineskip \vskip-\FrameHeightAdjust \penalty\@M} % useful for tops of pages \edef\zero@glue{\the\z@skip} \catcode`\|=\FrameRestore % Provide configuration commands: \providecommand\FrameCommand{% \setlength\fboxrule{\FrameRule}\setlength\fboxsep{\FrameSep}% \fbox} \@ifundefined{FrameRule}{\newdimen\FrameRule \FrameRule=\fboxrule}{} \@ifundefined{FrameSep} {\newdimen\FrameSep \FrameSep =3\fboxsep}{} \providecommand\FirstFrameCommand{\FrameCommand} \providecommand\MidFrameCommand{\FrameCommand} \providecommand\LastFrameCommand{\FrameCommand} % Height of frame above first baseline when frame starts a page: \providecommand\FrameHeightAdjust{6pt} % \FrameRestore has parts of \@parboxrestore, performing a similar but % less complete restoration of the default layout. See how it is used in % the "settings" argument of \MakeFrame. Though not a parameter, \hsize % should be set to the desired total line width available inside the % frame before invoking \FrameRestore. \def\FrameRestore{% \let\if@nobreak\iffalse \let\if@noskipsec\iffalse \let\-\@dischyph \let\'\@acci\let\`\@accii\let\=\@acciii % \message{FrameRestore: % \@totalleftmargin=\the \@totalleftmargin, % \rightmargin=\the\rightmargin, % \@listdepth=\the\@listdepth. }% % Test if we are in a list (or list-like paragraph) \ifnum \ifdim\@totalleftmargin>\z@ 1\fi \ifdim\rightmargin>\z@ 1\fi \ifnum\@listdepth>\z@ 1\fi 0>\z@ % \message{In a list: \linewidth=\the\linewidth, \@totalleftmargin=\the\@totalleftmargin, % \parshape=\the\parshape, \columnwidth=\the\columnwidth, \hsize=\the\hsize, % \labelwidth=\the\labelwidth. }% \@setminipage % snug fit around the item. I would like this to be non-global. % Now try to propageate changes of width from \hsize to list parameters. % This is deficient, but a more advanced way to indicate modification to text % dimensions is not (yet) provided; in particular, no separate left/right % adjustment. \advance\linewidth-\columnwidth \advance\linewidth\hsize \parshape\@ne \@totalleftmargin \linewidth \else % Not in list \linewidth=\hsize %\message{No list, set \string\linewidth=\the\hsize. }% \fi \sloppy } %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% actuar/vignettes/Makefile0000644000176200001440000000110414522560036015200 0ustar liggesusers### -*-Makefile-*- to build actuar vignettes ## ## AUTHOR: Vincent Goulet ## List of vignette to build VIGNETTES = actuar.pdf coverage.pdf credibility.pdf \ distributions.pdf modeling.pdf risk.pdf \ simulation.pdf ## Toolset SWEAVE = "$(R_HOME)/bin/R" CMD Sweave --encoding="utf-8" TEXI2DVI = LATEX=xelatex TEXINDY=makeindex texi2dvi -b RM = rm -rf all: pdf %.pdf: %.tex ${TEXI2DVI} '$<' .PHONY: pdf pdf: ${VIGNETTES} .PHONY: clean clean: ${RM} *.tex *-[0-9][0-9][0-9].pdf \ *.aux *.bbl *.blg *.log *.out *~ Rplots* \ auto/ actuar/vignettes/share/0000755000176200001440000000000014522560035014645 5ustar liggesusersactuar/vignettes/share/preamble.tex0000644000176200001440000000605314370340204017155 0ustar liggesusers\documentclass[11pt,x11names,english]{article} \usepackage{amsmath,amsthm} \usepackage[round]{natbib} \usepackage{babel} \usepackage[autolanguage]{numprint} \usepackage[noae]{Sweave} \usepackage{framed} \usepackage{booktabs} \usepackage[shortlabels]{enumitem} %% Fonts \usepackage{fontenc} \usepackage{unicode-math} \setmainfont{STIXTwoText} [ Extension={.otf}, UprightFont={*-Regular}, BoldFont={*-Bold}, ItalicFont={*-Italic}, BoldItalicFont={*-BoldItalic}, Numbers=OldStyle ] \setmathfont{STIXTwoMath-Regular} [ Extension={.otf}, Scale=1 ] \setmonofont{FiraMono} [ Extension={.otf}, UprightFont={*-Regular}, ItalicFont={*-Oblique}, BoldFont={*-Medium}, BoldItalicFont={*-MediumOblique}, Scale=0.92 ] \usepackage{microtype} %% Colors \usepackage{xcolor} \definecolor{link}{rgb}{0,0.4,0.6} % internal links \definecolor{url}{rgb}{0.6,0,0} % external links \definecolor{citation}{rgb}{0,0.5,0} % citations \definecolor{codebg}{named}{LightYellow1} % R code background %% Hyperlinks \usepackage{hyperref} \hypersetup{% pdfauthor={Vincent Goulet}, colorlinks = {true}, linktocpage = {true}, urlcolor = {url}, linkcolor = {link}, citecolor = {citation}, pdfpagemode = {UseOutlines}, pdfstartview = {Fit}, bookmarksopen = {true}, bookmarksnumbered = {true}, bookmarksdepth = {subsubsection}} %% Help for \autoref \def\exampleautorefname{Example} %% Sweave Sinput and Soutput environments reinitialized to remove %% default configuration. Space between input and output blocks also %% reduced. \DefineVerbatimEnvironment{Sinput}{Verbatim}{} \DefineVerbatimEnvironment{Soutput}{Verbatim}{} \fvset{listparameters={\setlength{\topsep}{0pt}}} %% Environment Schunk redefined as an hybrid of environments %% snugshade* and leftbar of framed.sty. \makeatletter \renewenvironment{Schunk}{% \setlength{\topsep}{1pt} \def\FrameCommand##1{\hskip\@totalleftmargin \vrule width 2pt\colorbox{codebg}{\hspace{3pt}##1}% % There is no \@totalrightmargin, so: \hskip-\linewidth \hskip-\@totalleftmargin \hskip\columnwidth}% \MakeFramed {\advance\hsize-\width \@totalleftmargin\z@ \linewidth\hsize \advance\labelsep\fboxsep \@setminipage}% }{\par\unskip\@minipagefalse\endMakeFramed} \makeatother %% Flush left enumerate environment. \setlist[enumerate]{leftmargin=*,align=left} %% Example environment \theoremstyle{definition} \newtheorem{example}{Example} \theoremstyle{remark} \newtheorem{rem}{Remark} %% New math commands \newcommand{\E}[1]{E[ #1 ]} \newcommand{\VAR}[1]{\mathrm{Var} [ #1 ]} \newcommand{\LAS}{\mathrm{LAS}} \newcommand{\D}{\displaystyle} \newcommand{\pt}{{\scriptscriptstyle \Sigma}} \newcommand{\mat}[1]{\symbf{#1}} %% New styling commands \newcommand{\pkg}[1]{\textbf{#1}} \newcommand{\code}[1]{\texttt{#1}} \newcommand{\file}[1]{{`\normalfont\textsf{#1}'}} \bibliographystyle{plainnat} actuar/vignettes/risk.Rnw0000644000176200001440000007576714370340204015224 0ustar liggesusers\input{share/preamble} %\VignetteIndexEntry{Risk and ruin theory} %\VignettePackage{actuar} %\SweaveUTF8 \title{Risk and ruin theory features of \pkg{actuar}} \author{Christophe Dutang \\ Université Paris Dauphine \\[3ex] Vincent Goulet \\ Université Laval \\[3ex] Mathieu Pigeon \\ Université du Québec à Montréal} \date{} %% Additional math commands \newcommand{\VaR}{\mathrm{VaR}} \newcommand{\CTE}{\mathrm{CTE}} <>= library(actuar) options(width = 52, digits = 4) @ \begin{document} \maketitle \section{Introduction} \label{sec:introduction} Risk theory refers to a body of techniques to model and measure the risk associated with a portfolio of insurance contracts. A first approach consists in modeling the distribution of total claims over a fixed period of time using the classical collective model of risk theory. A second input of interest to the actuary is the evolution of the surplus of the insurance company over many periods of time. In \emph{ruin theory}, the main quantity of interest is the probability that the surplus becomes negative, in which case technical ruin of the insurance company occurs. The interested reader can read more on these subjects in \cite{LossModels4e,Gerber_MRT,DenuitCharpentier1,MART:2e}, among others. The current version of \pkg{actuar} \citep{actuar} contains four visible functions related to the above problems: two for the calculation of the aggregate claim amount distribution and two for ruin probability calculations. \section{The collective risk model} \label{sec:collective-risk-model} Let random variable $S$ represent the aggregate claim amount (or total amount of claims) of a portfolio of independent risks over a fixed period of time, random variable $N$ represent the number of claims (or frequency) in the portfolio over that period, and random variable $C_j$ represent the amount of claim $j$ (or severity). Then, we have the random sum \begin{equation} \label{eq:definition-S} S = C_1 + \dots + C_N, \end{equation} where we assume that $C_1, C_2, \dots$ are mutually independent and identically distributed random variables each independent of $N$. The task at hand consists in evaluating numerically the cdf of $S$, given by \begin{align} \label{eq:cdf-S} F_S(x) &= \Pr[S \leq x] \notag \\ &= \sum_{n = 0}^\infty \Pr[S \leq x|N = n] p_n \notag \\ &= \sum_{n = 0}^\infty F_C^{*n}(x) p_n, \end{align} where $F_C(x) = \Pr[C \leq x]$ is the common cdf of $C_1, \dots, C_n$, $p_n = \Pr[N = n]$ and $F_C^{*n}(x) = \Pr[C_1 + \dots + C_n \leq x]$ is the $n$-fold convolution of $F_C(\cdot)$. If $C$ is discrete on $0, 1, 2, \dots$, one has \begin{equation} \label{eq:convolution-formula} F_C^{*k}(x) = \begin{cases} I\{x \geq 0\}, & k = 0 \\ F_C(x), & k = 1 \\ \sum_{y = 0}^x F_C^{*(k - 1)}(x - y) f_C(y), & k = 2, 3, \dots, \end{cases} \end{equation} where $I\{\mathcal{A}\} = 1$ if $\mathcal{A}$ is true and $I\{\mathcal{A}\} = 0$ otherwise. \section{Discretization of claim amount distributions} \label{sec:discretization} Some numerical techniques to compute the aggregate claim amount distribution (see \autoref{sec:aggregate}) require a discrete arithmetic claim amount distribution; that is, a distribution defined on $0, h, 2h, \dots$ for some step (or span, or lag) $h$. The package provides function \code{discretize} to discretize a continuous distribution. (The function can also be used to modify the support of an already discrete distribution, but this requires additional care.) Let $F(x)$ denote the cdf of the distribution to discretize on some interval $(a, b)$ and $f_x$ denote the probability mass at $x$ in the discretized distribution. Currently, \code{discretize} supports the following four discretization methods. \begin{enumerate} \item Upper discretization, or forward difference of $F(x)$: \begin{equation} \label{eq:discretization:upper} f_x = F(x + h) - F(x) \end{equation} for $x = a, a + h, \dots, b - h$. The discretized cdf is always above the true cdf. \item Lower discretization, or backward difference of $F(x)$: \begin{equation} \label{eq:discretization:lower} f_x = \begin{cases} F(a), & x = a \\ F(x) - F(x - h), & x = a + h, \dots, b. \end{cases} \end{equation} The discretized cdf is always under the true cdf. \item Rounding of the random variable, or the midpoint method: \begin{equation} \label{eq:discretization:midpoint} f_x = \begin{cases} F(a + h/2), & x = a \\ F(x + h/2) - F(x - h/2), & x = a + h, \dots, b - h. \end{cases} \end{equation} The true cdf passes exactly midway through the steps of the discretized cdf. \item Unbiased, or local matching of the first moment method: \begin{equation} \label{eq:discretization:unbiased} f_x = \begin{cases} \dfrac{\E{X \wedge a} - \E{X \wedge a + h}}{h} + 1 - F(a), & x = a \\ \dfrac{2 \E{X \wedge x} - \E{X \wedge x - h} - \E{X \wedge x + h}}{h}, & a < x < b \\ \dfrac{\E{X \wedge b} - \E{X \wedge b - h}}{h} - 1 + F(b), & x = b. \end{cases} \end{equation} The discretized and the true distributions have the same total probability and expected value on $(a, b)$. \end{enumerate} \autoref{fig:discretization-methods} illustrates the four methods. It should be noted that although very close in this example, the rounding and unbiased methods are not identical. \begin{figure}[t] \centering <>= fu <- discretize(plnorm(x), method = "upper", from = 0, to = 5) fl <- discretize(plnorm(x), method = "lower", from = 0, to = 5) fr <- discretize(plnorm(x), method = "rounding", from = 0, to = 5) fb <- discretize(plnorm(x), method = "unbiased", from = 0, to = 5, lev = levlnorm(x)) par(mfrow = c(2, 2), mar = c(5, 2, 4, 2)) curve(plnorm(x), from = 0, to = 5, lwd = 2, main = "Upper", ylab = "F(x)") plot(stepfun(0:4, diffinv(fu)), pch = 20, add = TRUE) curve(plnorm(x), from = 0, to = 5, lwd = 2, main = "Lower", ylab = "F(x)") plot(stepfun(0:5, diffinv(fl)), pch = 20, add = TRUE) curve(plnorm(x), from = 0, to = 5, lwd = 2, main = "Rounding", ylab = "F(x)") plot(stepfun(0:4, diffinv(fr)), pch = 20, add = TRUE) curve(plnorm(x), from = 0, to = 5, lwd = 2, main = "Unbiased", ylab = "F(x)") plot(stepfun(0:5, diffinv(fb)), pch = 20, add = TRUE) ## curve(plnorm(x), from = 0, to = 5, lwd = 2, ylab = "F(x)") ## par(col = "blue") ## plot(stepfun(0:4, diffinv(fu)), pch = 19, add = TRUE) ## par(col = "red") ## plot(stepfun(0:5, diffinv(fl)), pch = 19, add = TRUE) ## par(col = "green") ## plot(stepfun(0:4, diffinv(fr)), pch = 19, add = TRUE) ## par(col = "magenta") ## plot(stepfun(0:5, diffinv(fb)), pch = 19, add = TRUE) ## legend(3, 0.3, legend = c("upper", "lower", "rounding", "unbiased"), ## col = c("blue", "red", "green", "magenta"), lty = 1, pch = 19, ## text.col = "black") @ \caption{Comparison of four discretization methods} \label{fig:discretization-methods} \end{figure} Usage of \code{discretize} is similar to R's plotting function \code{curve}. The cdf to discretize and, for the unbiased method only, the limited expected value function are passed to \code{discretize} as expressions in \code{x}. The other arguments are the upper and lower bounds of the discretization interval, the step $h$ and the discretization method. For example, upper and unbiased discretizations of a Gamma$(2, 1)$ distribution on $(0, 17)$ with a step of $0.5$ are achieved with, respectively, <>= fx <- discretize(pgamma(x, 2, 1), method = "upper", from = 0, to = 17, step = 0.5) fx <- discretize(pgamma(x, 2, 1), method = "unbiased", lev = levgamma(x, 2, 1), from = 0, to = 17, step = 0.5) @ Function \code{discretize} is written in a modular fashion making it simple to add other discretization methods if needed. \section{Calculation of the aggregate claim amount distribution} \label{sec:aggregate} Function \code{aggregateDist} serves as a unique front end for various methods to compute or approximate the cdf of the aggregate claim amount random variable $S$. Currently, five methods are supported. \begin{enumerate} \item Recursive calculation using the algorithm of \cite{Panjer_81}. This requires the severity distribution to be discrete arithmetic on $0, 1, 2, \dots, m$ for some monetary unit and the frequency distribution to be a member of either the $(a, b, 0)$ or $(a, b, 1)$ class of distributions \citep{LossModels4e}. (These classes contain the Poisson, binomial, negative binomial and logarithmic distributions and their zero-truncated and zero-modified extensions allowing for a zero or arbitrary mass at $x = 0$.) The general recursive formula is: \begin{displaymath} f_S(x) = \frac{(p_1 - (a + b)p_0)f_C(x) + \sum_{y=1}^{\min(x, m)}(a + by/x)f_C(y)f_S(x - y)}{1 - a f_C(0)}, \end{displaymath} with starting value $f_S(0) = P_N(f_C(0))$, where $P_N(\cdot)$ is the probability generating function of $N$. Probabilities are computed until their sum is arbitrarily close to 1. The recursions are done in C to dramatically increase speed. One difficulty the programmer is facing is the unknown length of the output. This was solved using a common, simple and fast technique: first allocate an arbitrary amount of memory and double this amount each time the allocated space gets full. \item Exact calculation by numerical convolutions using \eqref{eq:cdf-S} and \eqref{eq:convolution-formula}. This also requires a discrete severity distribution. However, there is no restriction on the shape of the frequency distribution. The package merely implements the sum \eqref{eq:cdf-S}, the convolutions being computed with R's function \code{convolve}, which in turn uses the Fast Fourier Transform. This approach is practical for small problems only, even on today's fast computers. \item Normal approximation of the cdf, that is \begin{equation} \label{eq:normal-approximation} F_S(x) \approx \Phi \left( \frac{x - \mu_S}{\sigma_S} \right), \end{equation} where $\mu_S = \E{S}$ and $\sigma_S^2 = \VAR{S}$. For most realistic models, this approximation is rather crude in the tails of the distribution. \item Normal Power II approximation of the cdf, that is \begin{equation} \label{eq:np2-approximation} F_S(x) \approx \Phi \left( -\frac{3}{\gamma_S} + \sqrt{\frac{9}{\gamma_S^2} + 1 + \frac{6}{\gamma_S} \frac{x - \mu_S}{\sigma_S}} \right), \end{equation} where $\gamma_S = \E{(S - \mu_S)^3}/\sigma_S^{3/2}$. The approximation is valid for $x > \mu_S$ only and performs reasonably well when $\gamma_S < 1$. See \cite{Daykin_et_al} for details. \item Simulation of a random sample from $S$ and approximation of $F_S(x)$ by the empirical cdf \begin{equation} F_n(x) = \frac{1}{n} \sum_{j = 1}^n I\{x_j \leq x\}. \end{equation} The simulation itself is done with function \code{simul} (see the \code{"simulation"} vignette). This function admits very general hierarchical models for both the frequency and the severity components. \end{enumerate} Here also, adding other methods to \code{aggregateDist} is simple due to its modular conception. The arguments of \code{aggregateDist} differ according to the chosen calculation method; see the help page for details. One interesting argument to note is \code{x.scale} to specify the monetary unit of the severity distribution. This way, one does not have to mentally do the conversion between the support of $0, 1, 2, \dots$ assumed by the recursive and convolution methods, and the true support of $S$. The recursive method fails when the expected number of claims is so large that $f_S(0)$ is numerically equal to zero. One solution proposed by \citet{LossModels4e} consists in dividing the appropriate parameter of the frequency distribution by $2^n$, with $n$ such that $f_S(0) > 0$ and the recursions can start. One then computes the aggregate claim amount distribution using the recursive method and then convolves the resulting distribution $n$ times with itself to obtain the final distribution. Function \code{aggregateDist} supports this procedure through its argument \code{convolve}. A common problem with the recursive method is failure to obtain a cumulative distribution function that reaching (close to) $1$. This is usually due to too coarse a discretization of the severity distribution. One should make sure to use a small enough discretization step and to discretize the severity distribution far in the right tail. The function \code{aggregateDist} returns an object of class \code{"aggregateDist"} inheriting from the \code{"function"} class. Thus, one can use the object as a function to compute the value of $F_S(x)$ in any $x$. For illustration purposes, consider the following model: the distribution of $S$ is a compound Poisson with parameter $\lambda = 10$ and severity distribution Gamma$(2, 1)$. To obtain an approximation of the cdf of $S$ we first discretize the gamma distribution on $(0, 22)$ with the unbiased method and a step of $0.5$, and then use the recursive method in \code{aggregateDist}: <>= fx <- discretize(pgamma(x, 2, 1), method = "unbiased", from = 0, to = 22, step = 0.5, lev = levgamma(x, 2, 1)) Fs <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx, lambda = 10, x.scale = 0.5) summary(Fs) @ Although useless here, the following is essentially equivalent, except in the far right tail for numerical reasons: <>= Fsc <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx, lambda = 5, convolve = 1, x.scale = 0.5) summary(Fsc) @ We return to object \code{Fs}. It contains an empirical cdf with support <>= knots(Fs) @ A nice graph of this function is obtained with a method of \code{plot} (see \autoref{fig:Fs}): <>= plot(Fs, do.points = FALSE, verticals = TRUE, xlim = c(0, 60)) @ \begin{figure}[t] \centering <>= plot(Fs, do.points = FALSE, verticals = TRUE, xlim = c(0, 60)) @ \caption{Graphic of the empirical cdf of $S$ obtained with the recursive method} \label{fig:Fs} \end{figure} The package defines a few summary methods to extract information from \code{"aggregateDist"} objects. First, there are methods of \code{mean} and \code{quantile} to easily compute the mean and obtain the quantiles of the approximate distribution: <>= mean(Fs) quantile(Fs) quantile(Fs, 0.999) @ Second, a method of \texttt{diff} gives easy access to the underlying probability mass function: <>= diff(Fs) @ Of course, this is defined (and makes sense) for the recursive, direct convolution and simulation methods only. Third, the package introduces the generic functions \code{VaR} and \code{CTE} (with alias \code{TVaR}) with methods for objects of class \code{"aggregateDist"}. The former computes the value-at-risk $\VaR_\alpha$ such that \begin{equation} \label{eq:VaR} \Pr[S \leq \VaR_\alpha] = \alpha, \end{equation} where $\alpha$ is the confidence level. Thus, the value-at-risk is nothing else than a quantile. As for the method of \code{CTE}, it computes the conditional tail expectation (also called Tail Value-at-Risk) \begin{equation} \label{eq:CTE} \CTE_\alpha = \E{S|S > \VaR_\alpha}. \end{equation} Here are examples using object \code{Fs} obtained above: <>= VaR(Fs) CTE(Fs) @ To conclude on the subject, \autoref{fig:Fs-comparison} shows the cdf of $S$ using five of the many combinations of discretization and calculation method supported by \pkg{actuar}. \begin{figure}[t] \centering <>= fx.u <- discretize(pgamma(x, 2, 1), from = 0, to = 22, step = 0.5, method = "upper") Fs.u <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx.u, lambda = 10, x.scale = 0.5) fx.l <- discretize(pgamma(x, 2, 1), from = 0, to = 22, step = 0.5, method = "lower") Fs.l <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx.l, lambda = 10, x.scale = 0.5) Fs.n <- aggregateDist("normal", moments = c(20, 60)) Fs.s <- aggregateDist("simulation", model.freq = expression(y = rpois(10)), model.sev = expression(y = rgamma(2, 1)), nb.simul = 10000) par(col = "black") plot(Fs, do.points = FALSE, verticals = TRUE, xlim = c(0, 60), sub = "") par(col = "blue") plot(Fs.u, do.points = FALSE, verticals = TRUE, add = TRUE, sub = "") par(col = "red") plot(Fs.l, do.points = FALSE, verticals = TRUE, add = TRUE, sub = "") par(col = "green") plot(Fs.s, do.points = FALSE, verticals = TRUE, add = TRUE, sub = "") par(col = "magenta") plot(Fs.n, add = TRUE, sub = "") legend(30, 0.4, c("recursive + unbiased", "recursive + upper", "recursive + lower", "simulation", "normal approximation"), col = c("black", "blue", "red", "green", "magenta"), lty = 1, text.col = "black") @ \caption{Comparison between the empirical or approximate cdf of $S$ obtained with five different methods} \label{fig:Fs-comparison} \end{figure} \section{The continuous time ruin model} \label{sec:ruin-model} We now turn to the multi-period ruin problem. Let $U(t)$ denote the surplus of an insurance company at time $t$, $c(t)$ denote premiums collected through time $t$, and $S(t)$ denote aggregate claims paid through time $t$. If $u$ is the initial surplus at time $t = 0$, then a mathematically convenient definition of $U(t)$ is \begin{equation} \label{eq:definition-surplus} U(t) = u + c(t) - S(t). \end{equation} As mentioned previously, technical ruin of the insurance company occurs when the surplus becomes negative. Therefore, the definition of the infinite time probability of ruin is \begin{equation} \label{eq:definition-ruin} \psi(u) = \Pr[U(t) < 0 \text{ for some } t \geq 0]. \end{equation} We define some other quantities needed in the sequel. Let $N(t)$ denote the number of claims up to time $t \geq 0$ and $C_j$ denote the amount of claim $j$. Then the definition of $S(t)$ is analogous to \eqref{eq:definition-S}: \begin{equation} \label{eq:definition-S(t)} S(t) = C_1 + \dots + C_{N(t)}, \end{equation} assuming $N(0) = 0$ and $S(t) = 0$ as long as $N(t) = 0$. Furthermore, let $T_j$ denote the time when claim $j$ occurs, such that $T_1 < T_2 < T_3 < \dots$ Then the random variable of the interarrival (or wait) time between claim $j - 1$ and claim $j$ is defined as $W_1 = T_1$ and \begin{equation} \label{eq:definition-wait} W_j = T_j - T_{j - 1}, \quad j \geq 2. \end{equation} For the rest of this discussion, we make the following assumptions: \begin{enumerate} \item premiums are collected at a constant rate $c$, hence $c(t) = ct$; \item the sequence $\{T_j\}_{j \geq 1}$ forms an ordinary renewal process, with the consequence that random variables $W_1, W_2, \dots$ are independent and identically distributed; \item claim amounts $C_1, C_2, \dots$ are independent and identically distributed. \end{enumerate} \section{Adjustment coefficient} \label{sec:adjustment-coefficient} The quantity known as the adjustment coefficient $\rho$ hardly has any physical interpretation, but it is useful as an approximation to the probability of ruin since we have the inequality \begin{displaymath} \psi(u) \leq e^{-\rho u}, \quad u \geq 0. \end{displaymath} The adjustment coefficient is defined as the smallest strictly positive solution (if it exists) of the Lundberg equation \begin{equation} \label{eq:definition-adjcoef} h(t) = \E{e^{t C - t c W}} = 1, \end{equation} where the premium rate $c$ satisfies the positive safety loading constraint $\E{C - cW} < 0$. If $C$ and $W$ are independent, as in the most common models, then the equation can be rewritten as \begin{equation} \label{eq:definition-adjcoef-ind} h(t) = M_C(t) M_W(-tc) = 1. \end{equation} Function \code{adjCoef} of \pkg{actuar} computes the adjustment coefficient $\rho$ from the following arguments: either the two moment generating functions $M_C(t)$ and $M_W(t)$ (thereby assuming independence) or else function $h(t)$; the premium rate $c$; the upper bound of the support of $M_C(t)$ or any other upper bound for $\rho$. For example, if $W$ and $C$ are independent and each follow an exponential distribution, $W$ with parameter $2$ and $C$ with parameter $1$, and the premium rate is $c = 2.4$ (for a safety loading of 20\% using the expected value premium principle), then the adjustment coefficient is <>= adjCoef(mgf.claim = mgfexp(x), mgf.wait = mgfexp(x, 2), premium.rate = 2.4, upper = 1) @ The function also supports models with proportional or excess-of-loss reinsurance \citep{Centeno_02}. Under the first type of treaty, an insurer pays a proportion $\alpha$ of every loss and the rest is paid by the reinsurer. Then, for fixed $\alpha$ the adjustment coefficient is the solution of \begin{equation} \label{eq:definition-adjcoef-prop} h(t) = \E{e^{t \alpha C - t c(\alpha) W}} = 1. \end{equation} Under an excess-of-loss treaty, the primary insurer pays each claim up to a limit $L$. Again, for fixed $L$, the adjustment coefficient is the solution of \begin{equation} \label{eq:definition-adjcoef-xl} h(t) = \E{e^{t \min(C, L) - t c(L) W}} = 1. \end{equation} For models with reinsurance, \code{adjCoef} returns an object of class \code{"adjCoef"} inheriting from the \code{"function"} class. One can then use the object to compute the adjustment coefficient for any retention rate $\alpha$ or retention limit $L$. The package also defines a method of \code{plot} for these objects. For example, using the same assumptions as above with proportional reinsurance and a 30\% safety loading for the reinsurer, the adjustment coefficient as a function of $\alpha \in [0, 1]$ is (see \autoref{fig:adjcoef} for the graph): <>= mgfx <- function(x, y) mgfexp(x * y) p <- function(x) 2.6 * x - 0.2 rho <- adjCoef(mgfx, mgfexp(x, 2), premium = p, upper = 1, reins = "prop", from = 0, to = 1) rho(c(0.75, 0.8, 0.9, 1)) plot(rho) @ \begin{figure}[t] \centering <>= plot(rho) @ \caption{Adjustment coefficient as a function of the retention rate} \label{fig:adjcoef} \end{figure} \section{Probability of ruin} \label{sec:ruin} In this subsection, we always assume that interarrival times and claim amounts are independent. The main difficulty with the calculation of the infinite time probability of ruin lies in the lack of explicit formulas except for the most simple models. If interarrival times are Exponential$(\lambda)$ distributed (Poisson claim number process) and claim amounts are Exponential$(\beta)$ distributed, then \begin{equation} \label{eq:ruin-cramer-lundberg} \psi(u) = \frac{\lambda}{c \beta}\, e^{-(\beta - \lambda/c) u}. \end{equation} If the frequency assumption of this model is defensible, the severity assumption can hardly be used beyond illustration purposes. Fortunately, phase-type distributions have come to the rescue since the early 1990s. \cite{AsmussenRolski_91} first show that in the classical Cramér--Lundberg model where interarrival times are Exponential$(\lambda)$ distributed, if claim amounts are Phase-type$(\mat{\pi}, \mat{T})$ distributed, then $\psi(u) = 1 - F(u)$, where $F$ is Phase-type$(\mat{\pi}_+, \mat{Q})$ with \begin{equation} \label{eq:prob-ruin:cramer-lundberg} \begin{split} \mat{\pi}_+ &= - \frac{\lambda}{c}\, \mat{\pi} \mat{T}^{-1} \\ \mat{Q} &= \mat{T} + \mat{t} \mat{\pi}_+, \end{split} \end{equation} and $\mat{t} = -\mat{T} \mat{e}$, $\mat{e}$ is a column vector with all components equal to 1; see the \code{"lossdist"} vignette for details. In the more general Sparre~Andersen model where interarrival times can have any Phase-type$(\mat{\nu}, \mat{S})$ distribution, \cite{AsmussenRolski_91} also show that using the same claim severity assumption as above, one still has $\psi(u) = 1 - F(u)$ where $F$ is Phase-type$(\mat{\pi}_+, \mat{Q})$, but with parameters \begin{equation} \label{eq:prob-ruin:sparre:pi+} \mat{\pi}_+ = \frac{\mat{e}^\prime (\mat{Q} - \mat{T})}{% c \mat{e}^\prime \mat{t}} \end{equation} and $\mat{Q}$ solution of \begin{equation} \label{eq:eq:prob-ruin:sparre:Q} \begin{split} \mat{Q} &= \Psi(\mat{Q}) \\ &= \mat{T} - \mat{t} \mat{\pi} \left[ (\mat{I}_n \otimes \mat{\nu}) (\mat{Q} \oplus \mat{S})^{-1} (\mat{I}_n \otimes \mat{s}) \right]. \end{split} \end{equation} In the above, $\mat{s} = -\mat{S} \mat{e}$, $\mat{I}_n$ is the $n \times n$ identity matrix, $\otimes$ denotes the usual Kronecker product between two matrices and $\oplus$ is the Kronecker sum defined as \begin{equation} \label{eq:kronecker-sum} \mat{A}_{m \times m} \oplus \mat{B}_{n \times n} = \mat{A} \otimes \mat{I}_n + \mat{B} \otimes \mat{I}_m. \end{equation} Function \code{ruin} of \pkg{actuar} returns a function object of class \code{"ruin"} to compute the probability of ruin for any initial surplus $u$. In all cases except the exponential/exponential model where \eqref{eq:ruin-cramer-lundberg} is used, the output object calls function \code{pphtype} to compute the ruin probabilities. Some thought went into the interface of \code{ruin}. Obviously, all models can be specified using phase-type distributions, but the authors wanted users to have easy access to the most common models involving exponential and Erlang distributions. Hence, one first states the claim amount and interarrival times models with any combination of \code{"exponential"}, \code{"Erlang"} and \code{"phase-type"}. Then, one passes the parameters of each model using lists with components named after the corresponding parameters of \code{dexp}, \code{dgamma} and \code{dphtype}. If a component \code{"weights"} is found in a list, the model is a mixture of exponential or Erlang (mixtures of phase-type are not supported). Every component of the parameter lists is recycled as needed. The following examples should make the matter clearer. (All examples use $c = 1$, the default value in \code{ruin}.) First, for the exponential/exponential model, one has <>= psi <- ruin(claims = "e", par.claims = list(rate = 5), wait = "e", par.wait = list(rate = 3)) psi psi(0:10) @ Second, for a mixture of two exponentials claim amount model and exponential interarrival times, the simplest call to \code{ruin} is <>= op <- options(width=50) @ <>= ruin(claims = "e", par.claims = list(rate = c(3, 7), weights = 0.5), wait = "e", par.wait = list(rate = 3)) @ Finally, one will obtain a function to compute ruin probabilities in a model with phase-type claim amounts and mixture of exponentials interarrival times with <>= prob <- c(0.5614, 0.4386) rates <- matrix(c(-8.64, 0.101, 1.997, -1.095), 2, 2) ruin(claims = "p", par.claims = list(prob = prob, rates = rates), wait = "e", par.wait = list(rate = c(5, 1), weights = c(0.4, 0.6))) @ To ease plotting of the probability of ruin function, the package provides a method of \code{plot} for objects returned by \code{ruin} that is a simple wrapper for \code{curve} (see \autoref{fig:prob-ruin}): <>= psi <- ruin(claims = "p", par.claims = list(prob = prob, rates = rates), wait = "e", par.wait = list(rate = c(5, 1), weights = c(0.4, 0.6))) plot(psi, from = 0, to = 50) @ <>= options(op) @ \begin{figure}[t] \centering <>= plot(psi, from = 0, to = 50) @ \caption{Graphic of the probability of ruin as a function of the initial surplus $u$} \label{fig:prob-ruin} \end{figure} \section{Approximation to the probability of ruin} \label{sec:beekman} When the model for the aggregate claim process \eqref{eq:definition-S(t)} does not fit nicely into the framework of the previous section, one can compute ruin probabilities using the so-called Beekman's convolution formula \citep{Beekman_68,BeekmanFormula_EAS}. Let the surplus process and the aggregate claim amount process be defined as in \eqref{eq:definition-surplus} and \eqref{eq:definition-S(t)}, respectively, and let $\{N(t)\}$ be a Poisson process with mean $\lambda$. As before, claim amounts $C_1, C_2, \dots$ are independent and identically distributed with cdf $P(\cdot)$ and mean $\mu = \E{C_1}$. Then the infinite time probability of ruin is given by \begin{equation} \label{eq:beekman:prob-ruin} \psi(u) = 1 - F(u), \end{equation} where $F(\cdot)$ is Compound~Geometric$(p, H)$ with \begin{equation} \label{eq:beekman:p} p = 1 - \frac{\lambda \mu}{c} \end{equation} and \begin{equation} \label{eq:beekman:H} H(x) = \int_0^x \frac{1 - P(y)}{\mu}\, dy. \end{equation} In other words, we have (compare with \eqref{eq:cdf-S}): \begin{equation} \label{eq:beekman:prob-ruin-long} \psi(u) = 1 - \sum_{n = 0}^\infty H^{*n}(u) p (1 - p)^n. \end{equation} In most practical situations, numerical evaluation of \eqref{eq:beekman:prob-ruin-long} is done using Panjer's recursive formula. This usually requires discretization of $H(\cdot)$. In such circumstances, Beekman's formula yields approximate ruin probabilities. For example, let claim amounts have a Pareto$(5, 4)$ distribution, that is \begin{displaymath} P(x) = 1 - \left( \frac{4}{4 + x} \right)^5 \end{displaymath} and $\mu = 1$. Then \begin{align*} H(x) &= \int_0^x \left( \frac{4}{4 + y} \right)^5 dy \\ &= 1 - \left( \frac{4}{4 + x} \right)^4, \end{align*} or else $H$ is Pareto$(4, 4)$. Furthermore, we determine the premium rate $c$ with the expected value premium principle and a safety loading of 20\%, that is $c = 1.2 \lambda \mu$. Thus, $p = 0.2/1.2 = 1/6$. One can get functions to compute lower bounds and upper bounds for $F(u)$ with functions \code{discretize} and \code{aggregateDist} as follows: <>= f.L <- discretize(ppareto(x, 4, 4), from = 0, to = 200, step = 1, method = "lower") f.U <- discretize(ppareto(x, 4, 4), from = 0, to = 200, step = 1, method = "upper") F.L <- aggregateDist(method = "recursive", model.freq = "geometric", model.sev = f.L, prob = 1/6) F.U <- aggregateDist(method = "recursive", model.freq = "geometric", model.sev = f.U, prob = 1/6) @ Corresponding functions for the probability of ruin $\psi(u)$ lower and upper bounds are (see \autoref{fig:beekman:prob-ruin} for the graphic): <>= psi.L <- function(u) 1 - F.U(u) psi.U <- function(u) 1 - F.L(u) u <- seq(0, 50, by = 5) cbind(lower = psi.L(u), upper = psi.U(u)) curve(psi.L, from = 0, to = 100, col = "blue") curve(psi.U, add = TRUE, col = "green") @ \begin{figure}[t] \centering <>= curve(psi.L, from = 0, to = 100, col = "blue") curve(psi.U, add = TRUE, col = "green") @ \caption{Lower and upper bounds for the probability of ruin as determined using Beekman's convolution formula.} \label{fig:beekman:prob-ruin} \end{figure} One can make the bounds as close as one wishes by reducing the discretization step. \bibliography{actuar} \end{document} %%% Local Variables: %%% mode: noweb %%% TeX-master: t %%% coding: utf-8 %%% End: actuar/vignettes/actuar.bib0000644000176200001440000003054314264305077015513 0ustar liggesusers@string{AB = {ASTIN Bulletin}} @string{IME = {Insurance: Mathematics and Economics}} @string{MVSVM = {Bulletin of the Swiss Association of Actuaries}} @string{NAAJ = {North American Actuarial Journal}} @Book{Abramowitz:1972, author = {Abramowitz, M. and Stegun, I. A.}, title = {Handbook of Mathematical Functions}, publisher = {Dover}, year = 1972, url = {http://people.math.sfu.ca/~cbm/aands/}, language = {english} } @Book{Arnold:pareto:2ed, author = {Arnold, B. C.}, title = {{P}areto Distributions}, publisher = {{CRC} {P}ress}, year = 2015, edition = 2, isbn = {978-1-46658485-3} } @Article{AsmussenRolski_91, author = {Asmussen, S. and Rolski, T.}, title = {Computational methods in risk theory: a matrix-algorithmic approach}, journal = IME, year = 1991, volume = 10, pages = {259-274}, language = {english} } @Article{BJ_87, author = {Bühlmann, H. and Jewell, W. S.}, title = {Hierarchical credibility revisited}, year = 1987, journal = MVSVM, volume = 87, pages = {35-54}, language = {english} } @Article{BS_70, author = {Bühlmann, H. and Straub, E.}, title = {Glaubgwürdigkeit für {S}chadensätze}, year = 1970, journal = MVSVM, volume = 70, pages = {111-133} } @Book{Bateman:1953:2, author = {Bateman, H.}, title = {Higher transcendental functions}, volume = 2, publisher = {McGraw-Hill}, year = 1953, } @InCollection{BeekmanFormula_EAS, author = {Kass, R.}, title = {Beekman's convolution formula}, booktitle = {Encyclopedia of actuarial science}, publisher = {Wiley}, year = 2004, editor = {J. L. Teugels and B. Sundt}, volume = 1, ISBN = {0-4708467-6-3}, language = {english} } @Article{Beekman_68, author = {Beekman, J. A.}, title = {Collective risk results}, journal = {Transactions of the Society of Actuaries}, year = 1968, volume = 20, pages = {182-199}, language = {english} } @Article{Buhlmann:regression:1997, author = {Bühlmann, H. and Gisler, A.}, title = {Credibility in the regression case revisited}, journal = AB, year = 1997, volume = 27, pages = {83-98}, language = {english} } @Article{Buhlmann_69, author = {Bühlmann, H.}, title = {Experience rating and credibility}, year = 1969, journal = AB, volume = 5, pages = {157-165}, language = {english} } @Book{Buhlmann_Gisler, author = {Bühlmann, H. and Gisler, A.}, title = {A course in credibility theory and its applications}, publisher = {Springer}, year = 2005, isbn = {3-5402575-3-5}, language = {english} } @Article{Centeno_02, author = {Centeno, M. {d.} L.}, title = {Measuring the effects of reinsurance by the adjustment coefficient in the Sparre-Anderson model}, journal = IME, year = 2002, volume = 30, pages = {37-49} } @Misc{Dalgaard:r-help:2005, author = {Dalgaard, P.}, title = {simulate zero-truncated {P}oisson distribution}, howpublished = {\texttt{r-help} mailing list}, month = {May 1}, year = 2005, url = {https://stat.ethz.ch/pipermail/r-help/2005-May/070680.html}, language = {english} } @Book{Daykin_et_al, author = {Daykin, C.D. and Pentikäinen, T. and Pesonen, M.}, title = {Practical Risk Theory for Actuaries}, publisher = {Chapman \& Hall}, year = 1994, address = {London}, isbn = {0-4124285-0-4}, language = {english} } @Book{DenuitCharpentier1, author = {Denuit, M. and Charpentier, A.}, title = {Math\'ematiques de l'assurance non-vie}, publisher = {Economica}, year = 2004, volume = {1, Principes fondamentaux de th\'eorie du risque}, address = {Paris}, isbn = {2-7178485-4-1}, language = {francais} } @Manual{GSL, title = {{GNU} Scientific Library Reference Manual}, author = {Galassi, M. and Davies, J. and Theiler, J. and Gough, B. and Jungman, G. and Alken P. and Booth, M. and Rossi, F. and Ulerich, R.}, edition = {Third}, isbn = {0-95461207-8}, url = {https://www.gnu.org/software/gsl/}, language = {english} } @Book{Gerber_MRT, author = {Gerber, H. U.}, title = {An Introduction to Mathematical Risk Theory}, publisher = {Huebner Foundation}, year = 1979, address = {Philadelphia}, language = {english} } @Article{Goulet:lossdist:2008, author = {Goulet, V. and Pigeon, M.}, title = {Statistical Modeling of Loss Distributions Using \pkg{actuar}}, journal = {R News}, year = 2008, volume = 8, number = 1, pages = {34-40}, month = {May}, url = {http://cran.r-project.org/doc/Rnews/Rnews_2008-1.pdf}, language = {english} } @Article{Goulet:simpf:2008, author = {Goulet, V. and Pouliot, L.-P.}, title = {Simulation of Compound Hierarchical Models in {R}}, journal = NAAJ, year = 2008, volume = 12, pages = {401-412}, language = {english} } @Article{Goulet_JAP, author = {Goulet, V.}, title = {Principles and application of credibility theory}, year = 1998, journal = {Journal of Actuarial Practice}, volume = 6, pages = {5-62}, language = {english} } @Article{Goulet_cfs, author = {Forgues, A. and Goulet, V. and Lu, J.}, title = {Credibility for severity revisited}, journal = NAAJ, year = 2006, volume = 10, number = 1, pages = {49-62}, language = {english} } @InProceedings{Hachemeister_75, author = {Hachemeister, C. A.}, title = {Credibility for Regression Models with Application to Trend}, year = 1975, booktitle = {Credibility, theory and applications}, series = {Proceedings of the berkeley Actuarial Research Conference on Credibility}, pages = {129-163}, publisher = {Academic Press}, address = {New York}, language = {english} } @Book{HoggKlugman, author = {Hogg, R. V. and Klugman, S. A.}, title = {Loss Distributions}, publisher = {Wiley}, year = 1984, address = {New York}, isbn = {0-4718792-9-0}, language = {english} } @Article{Holla:PIG:1966, author = {Holla, M. S.}, title = {On a {P}oisson-Inverse {G}aussian Distribution}, journal = {Metrika}, year = 1966, volume = 15, pages = {377-384}, language = {english} } @Article{Jewell_75, author = {Jewell, W. S.}, title = {The use of collateral data in credibility theory: a hierarchical model}, year = 1975, journal = {Giornale dell'Istituto Italiano degli Attuari}, volume = 38, pages = {1-16}, language = {english} } @Book{Johnson:discrete:2005, author = {Johnson, N. L. and Kemp, A. W. and Kotz, S.}, title = {Univariate Discrete Distributions}, publisher = {Wiley}, year = 2005, edition = 3, isbn = {978-047127246-5}, language = {english} } @Book{LivreVert, author = {Goovaerts, M. J. and Hoogstad, W. J.}, title = {Credibility theory}, series = {Surveys of actuarial studies}, number = 4, year = 1987, publisher = {Nationale-Nederlanden N.V.}, address = {Netherlands}, language = {english} } @Book{LossModels, author = {Klugman, S. A. and Panjer, H. H. and Willmot, G.}, title = {Loss Models: From Data to Decisions}, publisher = {Wiley}, year = 1998, address = {New York}, isbn = {0-4712388-4-8}, language = {english} } @Book{LossModels2e, author = {Klugman, S. A. and Panjer, H. H. and Willmot, G.}, title = {Loss Models: From Data to Decisions}, edition = 2, publisher = {Wiley}, year = 2004, address = {New York}, isbn = {0-4712157-7-5}, language = {english} } @Book{LossModels3e, author = {Klugman, S. A. and Panjer, H. H. and Willmot, G.}, title = {Loss Models: From Data to Decisions}, edition = 3, publisher = {Wiley}, year = 2008, address = {New York}, isbn = {978-0-4701878-1-4}, language = {english} } @Book{LossModels4e, author = {Klugman, S. A. and Panjer, H. H. and Willmot, G.}, title = {Loss Models: From Data to Decisions}, edition = 4, publisher = {Wiley}, year = 2012, address = {New York}, isbn = {978-1-118-31532-3}, language = {english} } @Book{MART, author = {Kaas, R. and Goovaerts, M. and Dhaene, J. and Denuit, M.}, title = {Modern actuarial risk theory}, publisher = {Kluwer {A}cademic {P}ublishers}, year = 2001, address = {Dordrecht}, isbn = {0-7923763-6-6}, language = {english} } @Book{MART:2e, author = {Kaas, R. and Goovaerts, M. and Dhaene, J. and Denuit, M.}, title = {Modern Actuarial Risk Theory. Using {R}}, edition = 2, publisher = {Springer}, year = 2008, isbn = {978-3-54070992-3}, language = {english} } @Book{MASS, author = {Venables, W. N. and Ripley, B. D.}, title = {Modern applied statistics with {S}}, publisher = {Springer}, year = 2002, edition = 4, address = {New York}, isbn = {0-3879545-7-0}, language = {english} } @Manual{Matrix, title = {Matrix: A Matrix package for R}, author = {Bates, D. and Maechler, M.}, year = 2016, url = {http://cran.r-project.org/package=Matrix}, } @Book{Neuts_81, author = {Neuts, M. F.}, title = {Matrix-geometric solutions in stochastic models: an algorithmic approach}, publisher = {Dover Publications}, year = 1981, isbn = {978-0-4866834-2-3}, language = {english} } @Unpublished{Ohlsson, author = {Ohlsson, E.}, title = {Simplified estimation of structure parameters in hierarchical credibility}, year = 2005, note = {Presented at the Zurich ASTIN Colloquium}, url = {http://www.actuaries.org/ASTIN/Colloquia/Zurich/Ohlsson.pdf}, language = {english} } @Article{Panjer_81, author = {Panjer, H. H.}, title = {Recursive evaluation of a family of compound distributions}, journal = AB, year = 1981, volume = 12, pages = {22-26}, language = {english} } @Manual{R-exts, title = {Writing {R} Extensions}, author = {{R Core Team}}, organization = {R Foundation for Statistical Computing}, address = {Vienna, Austria}, year = 2020, url = {https://cran.r-project.org/doc/manuals/R-exts.html}, language = {english} } @Article{Scollnik:2001:MCMC, author = {Scollnik, D. P. M.}, title = {Actuarial Modeling with {MCMC} and {BUGS}}, journal = {North American Actuarial Journal}, year = 2001, volume = 5, number = 2, pages = {96-124}, language = {english} } @Article{Shaban:PIG:1981, author = {Shaban, S. A.}, title = {Computation of the {P}oisson-inverse {G}aussian distribution}, journal = {Communications in Statistics -- Theory and Methods}, year = 1981, volume = 10, number = 14, pages = {1389-1399}, language = {english} } @Manual{SuppDists, title = {SuppDists: Supplementary distributions}, author = {Wheeler, B.}, year = 2016, url = {http://cran.r-project.org/package=SuppDists} } @Book{Thomopoulos:2013:simulation, author = {Thomopoulos, N. T.}, title = {Essentials of Monte Carlo simulation: Statistical methods for building simulation models}, publisher = {Springer}, year = 2013, isbn = {978-146146022-0}, language = {english} } @Article{actuar, author = {Dutang, C and Goulet, V. and Pigeon, M.}, title = {\pkg{actuar}: An {R} Package for Actuarial Science}, journal = {Journal of Statistical Software}, year = 2008, volume = 25, number = 7, doi = {10.18637/jss.v025.i07}, url = {https://doi.org/10.18637/jss.v025.i07}, language = {english} } @Article{cm, author = {Belhadj, H. and Goulet, V. and Ouellet, T.}, title = {On Parameter Estimation in Hierarchical Credibility}, journal = AB, year = 2009, volume = 39, number = 2, language = {english} } @Manual{expint, title = {expint: Exponential Integral and Incomplete Gamma Function}, author = {Goulet, V.}, year = {2019}, note = {R package version 0.1-6}, url = {https://cran.r-project.org/package=expint}, } @Article{statmod, author = {Giner, G. and Smyth, G. K.}, title = {\pkg{statmod}: {P}robability calculations for the inverse gaussian distribution}, journal = {{R Journal}}, year = 2016, volume = 8, number = 1, pages = {339-351}, doi = {10.32614/RJ-2016-024}, url = {https://doi.org/10.32614/RJ-2016-024}, language = {english} } actuar/R/0000755000176200001440000000000014522560035011734 5ustar liggesusersactuar/R/quantile.aggregateDist.R0000644000176200001440000000423214264305077016461 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Quantiles for objects of class 'aggregateDist' ### ### AUTHORS: Louis-Philippe Pouliot, ### Vincent Goulet quantile.aggregateDist <- function(x, probs = c(0.25, 0.5, 0.75, 0.9, 0.95, 0.975, 0.99, 0.995), smooth = FALSE, names = TRUE, ...) { chkDots(...) # method does not use '...' label <- comment(x) ## The Normal and Normal Power approximations are the only ## continuous distributions of class 'aggregateDist'. They are ## therefore treated differently, using the 'base' quantile ## function qnorm(). if (label == "Normal approximation") res <- qnorm(probs, get("mean", environment(x)), sqrt(get("variance", environment(x)))) else if (label == "Normal Power approximation") { m <- get("mean", envir = environment(x)) sd <- sqrt(get("variance", envir = environment(x))) sk <- get("skewness", envir = environment(x)) ## Calling qnorm() and inverting the Normal Power 'standardization' q <- qnorm(probs) res <- ifelse(probs <= 0.5, NA, m + sd * (q + sk * (q^2 - 1)/6)) } else { ## An empirical and discrete approach is used for ## 'aggregateDist' objects obtained from methods other than ## Normal and Normal Power. y <- get("y", environment(x)) x <- get("x", environment(x)) ## Create the inverse function of either the cdf or the ogive. fun <- if (smooth) # ogive approxfun(y, x, yleft = 0, yright = max(x), method = "linear", ties = "ordered") else # cdf approxfun(y, x, yleft = 0, yright = max(x), method = "constant", f = 1, ties = "ordered") ## Quantiles res <- fun(probs) } if (names) { dig <- max(2, getOption("digits")) names(res) <- formatC(paste(100 * probs, "%", sep = ""), format = "fg", width = 1, digits = dig) } res } actuar/R/TransformedBeta.R0000644000176200001440000000356214264305077015153 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}trbeta functions to compute ### characteristics of the Transformed Beta distribution. The version ### used in these functions has cumulative distribution function ### ### Pr[X <= x] = Pr[Y <= (x/scale)^shape2 / (1 + (x/scale)^shape2)], ### ### where Y has a Beta distribution with parameters shape3 and shape1. ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet dtrbeta <- function (x, shape1, shape2, shape3, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "dtrbeta", x, shape1, shape2, shape3, scale, log) ptrbeta <- function (q, shape1, shape2, shape3, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "ptrbeta", q, shape1, shape2, shape3, scale, lower.tail, log.p) qtrbeta <- function (p, shape1, shape2, shape3, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qtrbeta", p, shape1, shape2, shape3, scale, lower.tail, log.p) rtrbeta <- function (n, shape1, shape2, shape3, rate = 1, scale = 1/rate) .External(C_actuar_do_random, "rtrbeta", n, shape1, shape2, shape3, scale) mtrbeta <- function (order, shape1, shape2, shape3, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "mtrbeta", order, shape1, shape2, shape3, scale, FALSE) levtrbeta <- function (limit, shape1, shape2, shape3, rate = 1, scale = 1/rate, order = 1) .External(C_actuar_do_dpq, "levtrbeta", limit, shape1, shape2, shape3, scale, order, FALSE) ## Aliases dpearson6 <- dtrbeta ppearson6 <- ptrbeta qpearson6 <- qtrbeta rpearson6 <- rtrbeta mpearson6 <- mtrbeta levpearson6 <- levtrbeta actuar/R/CTE.R0000644000176200001440000000345414264305077012506 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Conditional Tail Expectation for objects of class 'aggregateDist'. ### ### AUTHORS: Tommy Ouellet, Vincent Goulet CTE <- function(x, ...) UseMethod("CTE") CTE.aggregateDist <- function(x, conf.level = c(0.9, 0.95, 0.99), names = TRUE, ...) { chkDots(...) # method does not use '...' label <- comment(x) ## Normal approximation; an exact formula is available if (label == "Normal approximation") { m <- get("mean", environment(x)) sd <- sqrt(get("variance", environment(x))) res <- m + sd * dnorm(qnorm(conf.level)) / (1 - conf.level) } ## Normal Power approximation; explicit formula in Castaner, ## Claramunt and Marmol (2013) else if (label == "Normal Power approximation") { m <- get("mean", envir = environment(x)) sd <- sqrt(get("variance", envir = environment(x))) sk <- get("skewness", envir = environment(x)) q <- qnorm(conf.level) res <- m + sd * dnorm(q) * (1 + sk * q/6) / (1 - conf.level) } ## Recursive method, simulation and convolutions; each yield a ## step function that can be used to make calculations. else { val <- get("x", envir = environment(x)) prob <- get("fs", envir = environment(x)) f2 <- function(a) { pos <- val > VaR(x, a) drop(crossprod(val[pos], prob[pos])) / sum(prob[pos]) } res <- sapply(conf.level, f2) } if (names) { dig <- max(2, getOption("digits")) names(res) <- formatC(paste(100 * conf.level, "%", sep = ""), format = "fg", width = 1, digits = dig) } res } TVaR <- CTE actuar/R/BetaMoments.R0000644000176200001440000000117114264305077014303 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {m,lev}beta functions to compute raw and limited ### moments for the Beta distribution (as defined in R). The ### noncentral beta distribution is _not_ supported. ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHOR: Vincent Goulet mbeta <- function(order, shape1, shape2) .External(C_actuar_do_dpq, "mbeta", order, shape1, shape2, FALSE) levbeta <- function(limit, shape1, shape2, order = 1) .External(C_actuar_do_dpq, "levbeta", limit, shape1, shape2, order, FALSE) actuar/R/ChisqSupp.R0000644000176200001440000000140514264305077014004 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {m,lev,mgf}chisq functions to compute raw and ### limited moments, and the moment generating function for ### the Chi-square distribution (as defined in R) ### ### See Chapter 17 of Johnson & Kotz, Continuous univariate ### distributions, volume 1, Wiley, 1970 ### ### AUTHORS: Christophe Dutang, Vincent Goulet mchisq <- function(order, df, ncp = 0) .External(C_actuar_do_dpq, "mchisq", order, df, ncp, FALSE) levchisq <- function(limit, df, ncp = 0, order = 1) .External(C_actuar_do_dpq, "levchisq", limit, df, ncp, order, FALSE) mgfchisq <- function(t, df, ncp = 0, log = FALSE) .External(C_actuar_do_dpq, "mgfchisq", t, df, ncp, log) actuar/R/ZeroModifiedPoisson.R0000644000176200001440000000147014264305077016022 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r}zmpois functions to compute ### characteristics of the Zero Modified Poisson distribution. ### ### See Appendix B of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHOR: Vincent Goulet dzmpois <- function (x, lambda, p0, log = FALSE) .External(C_actuar_do_dpq, "dzmpois", x, lambda, p0, log) pzmpois <- function(q, lambda, p0, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pzmpois", q, lambda, p0, lower.tail, log.p) qzmpois <- function(p, lambda, p0, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qzmpois", p, lambda, p0, lower.tail, log.p) rzmpois <- function(n, lambda, p0) .External(C_actuar_do_random, "rzmpois", n, lambda, p0) actuar/R/Burr.R0000644000176200001440000000300214264305077012772 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}burr functions to compute ### characteristics of the Burr distribution. The version used in ### these functions has cumulative distribution function ### ### Pr[X <= x] = 1 - (1/(1 + (x/scale)^shape2))^shape1, x > 0. ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet dburr <- function (x, shape1, shape2, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "dburr", x, shape1, shape2, scale, log) pburr <- function(q, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pburr", q, shape1, shape2, scale, lower.tail, log.p) qburr <- function(p, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qburr", p, shape1, shape2, scale, lower.tail, log.p) rburr <- function(n, shape1, shape2, rate = 1, scale = 1/rate) .External(C_actuar_do_random, "rburr", n, shape1, shape2, scale) mburr <- function(order, shape1, shape2, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "mburr", order, shape1, shape2, scale, FALSE) levburr <- function(limit, shape1, shape2, rate = 1, scale = 1/rate, order = 1) .External(C_actuar_do_dpq, "levburr", limit, shape1, shape2, scale, order, FALSE) actuar/R/Gumbel.R0000644000176200001440000000227114264305077013302 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}gumbel functions to compute ### characteristics of the Gumbel distribution. The version used in ### these functions has cumulative distribution function ### ### Pr[X <= x] = exp(-exp(-(x - alpha)/scale)), -Inf < x < Inf. ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHOR: Vincent Goulet dgumbel <- function (x, alpha, scale, log = FALSE) .External(C_actuar_do_dpq, "dgumbel", x, alpha, scale, log) pgumbel <- function(q, alpha, scale, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pgumbel", q, alpha, scale, lower.tail, log.p) qgumbel <- function(p, alpha, scale, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qgumbel", p, alpha, scale, lower.tail, log.p) rgumbel <- function(n, alpha, scale) .External(C_actuar_do_random, "rgumbel", n, alpha, scale) mgumbel <- function(order, alpha, scale) .External(C_actuar_do_dpq, "mgumbel", order, alpha, scale, FALSE) mgfgumbel <- function(t, alpha, scale, log = FALSE) .External(C_actuar_do_dpq, "mgfgumbel", t, alpha, scale, log) actuar/R/NormalSupp.R0000644000176200001440000000116214264305077014165 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {m,mgf}norm functions to compute raw and the ### moment generating function for the Normal distribution (as defined ### in R). ### ### See Chapter 13 of Johnson & Kotz, Continuous univariate ### distributions, volume 1, Wiley, 1970 ### ### AUTHORS: Christophe Dutang, Vincent Goulet mnorm <- function(order, mean = 0, sd = 1) .External(C_actuar_do_dpq, "mnorm", order, mean, sd, FALSE) mgfnorm <- function(t, mean = 0, sd = 1, log = FALSE) .External(C_actuar_do_dpq, "mgfnorm", t, mean, sd, log) actuar/R/Loggamma.R0000644000176200001440000000231314264305077013610 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r}lgamma functions to compute ### characteristics of the Loggamma distribution. The version used in ### these functions has cumulative distribution function ### ### Pr[X <= x] = pgamma(log(x), shape = shapelog, rate = ratelog). ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet dlgamma <- function(x, shapelog, ratelog, log = FALSE) .External(C_actuar_do_dpq, "dlgamma", x, shapelog, ratelog, log) plgamma <- function(q, shapelog, ratelog, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "plgamma", q, shapelog, ratelog, lower.tail, log.p) qlgamma <- function(p, shapelog, ratelog, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qlgamma", p, shapelog, ratelog, lower.tail, log.p) rlgamma <- function(n, shapelog, ratelog) .External(C_actuar_do_random, "rlgamma", n, shapelog, ratelog) mlgamma <- function(order, shapelog, ratelog) .External(C_actuar_do_dpq, "mlgamma", order, shapelog, ratelog, FALSE) levlgamma <- function(limit, shapelog, ratelog, order = 1) .External(C_actuar_do_dpq, "levlgamma", limit, shapelog, ratelog, order, FALSE) actuar/R/SingleParameterPareto.R0000644000176200001440000000226314264305077016325 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}single-parameter pareto ### functions. The single-parameter Pareto distribution used in these ### functions has cumulative distribution function ### ### Pr[X <= x] = 1 - (min/x)^shape, x > 0. ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet dpareto1 <- function (x, shape, min, log = FALSE) .External(C_actuar_do_dpq, "dpareto1", x, shape, min, log) ppareto1 <- function(q, shape, min, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "ppareto1", q, shape, min, lower.tail, log.p) qpareto1 <- function(p, shape, min, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qpareto1", p, shape, min, lower.tail, log.p) rpareto1 <- function(n, shape, min) .External(C_actuar_do_random, "rpareto1", n, shape, min) mpareto1 <- function(order, shape, min) .External(C_actuar_do_dpq, "mpareto1", order, shape, min, FALSE) levpareto1 <- function(limit, shape, min, order = 1) .External(C_actuar_do_dpq, "levpareto1", limit, shape, min, order, FALSE) actuar/R/Pareto2.R0000644000176200001440000000266314264305077013410 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}pareto2 functions to compute ### characteristics of the Pareto (type) II distribution. The version ### used in these functions has cumulative distribution function ### ### Pr[X <= x] = 1 - (1/(1 + v))^shape, x > min, ### ### where v = (x - min)/scale. ### ### See Arnold, B. C. (2015), Pareto Distributions, Second Edition, ### CRC Press. ### ### AUTHOR: Vincent Goulet dpareto2 <- function (x, min, shape, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "dpareto2", x, min, shape, scale, log) ppareto2 <- function (q, min, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "ppareto2", q, min, shape, scale, lower.tail, log.p) qpareto2 <- function (p, min, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qpareto2", p, min, shape, scale, lower.tail, log.p) rpareto2 <- function(n, min, shape, rate = 1, scale = 1/rate) .External(C_actuar_do_random, "rpareto2", n, min, shape, scale) mpareto2 <- function(order, min, shape, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "mpareto2", order, min, shape, scale, FALSE) levpareto2 <- function(limit, min, shape, rate = 1, scale = 1/rate, order = 1) .External(C_actuar_do_dpq, "levpareto2", limit, min, shape, scale, order, FALSE) actuar/R/Paralogistic.R0000644000176200001440000000267514264305077014520 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}paralogis functions to compute ### characteristics of the paralogistic distribution. The version used ### in these functions has cumulative distribution function ### ### Pr[X <= x] = 1 - (1/(1 + (x/scale)^shape))^shape, x > 0. ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet dparalogis <- function (x, shape, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "dparalogis", x, shape, scale, log) pparalogis <- function(q, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pparalogis", q, shape, scale, lower.tail, log.p) qparalogis <- function(p, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qparalogis", p, shape, scale, lower.tail, log.p) rparalogis <- function(n, shape, rate = 1, scale = 1/rate) .External(C_actuar_do_random, "rparalogis", n, shape, scale) mparalogis <- function(order, shape, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "mparalogis", order, shape, scale, FALSE) levparalogis <- function(limit, shape, rate = 1, scale = 1/rate, order = 1) .External(C_actuar_do_dpq, "levparalogis", limit, shape, scale, order, FALSE) actuar/R/hache.barycenter.R0000644000176200001440000001370114264305077015274 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Auxiliary function to fit regression credibility model by ### positioning the intercept at the barycenter of time. ### ### AUTHORS: Xavier Milhaud, Vincent Goulet hache.barycenter <- function(ratios, weights, xreg, method, tol, maxit, echo) { ## Frequently used values weights.s <- rowSums(weights, na.rm = TRUE) # contract total weights has.data <- which(weights.s > 0) # contracts with data ncontracts <- nrow(ratios) # number of contracts eff.ncontracts <- length(has.data) # effective number of contracts p <- ncol(xreg) # rank (>= 2) of design matrix n <- nrow(xreg) # number of observations ## Putting the intercept at the barycenter of time amounts to use ## a "weighted orthogonal" design matrix in the regression (that ## is, X'WX = I for some diagonal weight matrix W). In theory, ## there would be one orthogonal design matrix per contract. In ## practice, we orthogonalize with a "collective" barycenter. We ## use average weights per period across contracts since these ## will be closest to the their individual analogues. ## ## We orthogonalize the original design matrix using QR ## decomposition. We also keep matrix R as a transition matrix ## between the original base and the orthogonal base. w <- colSums(weights, na.rm = TRUE)/sum(weights.s) Xqr <- qr(xreg * sqrt(w)) # QR decomposition R <- qr.R(Xqr) # transition matrix x <- qr.Q(Xqr) / sqrt(w) # weighted orthogonal matrix ## Fit linear model to each contract. For contracts without data, ## fit some sort of empty model to ease use in predict.hache(). f <- function(i) { z <- if (i %in% has.data) # contract with data { y <- ratios[i, ] not.na <- !is.na(y) lm.wfit(x[not.na, , drop = FALSE], y[not.na], weights[i, not.na]) } else # contract without data lm.fit(x, rep.int(0, n)) z[c("coefficients", "residuals", "weights", "rank", "qr")] } fits <- lapply(seq_len(ncontracts), f) ## Individual regression coefficients ind <- sapply(fits, coef) ind[is.na(ind)] <- 0 ## Individual variance estimators. The contribution of contracts ## without data is 0. S <- function(z) # from stats::summary.lm { nQr <- NROW(z$qr$qr) rank <- z$rank r <- z$residuals w <- z$weights sum(w * r^2) / (nQr - rank) } sigma2 <- sapply(fits[has.data], S) sigma2[is.nan(sigma2)] <- 0 ## Initialization of a few containers: p x p x ncontracts arrays ## for the weight and credibility matrices; p x p matrices for the ## between variance-covariance matrix and total weight matrix; a ## vector of length p for the collective regression coefficients. cred <- W <- array(0, c(p, p, ncontracts)) A <- W.s <- matrix(0, p, p) coll <- numeric(p) ## Weight matrices: we need here only the diagonal elements of ## X'WX, where W = diag(w_{ij}) (and not w_{ij}/w_{i.} as in the ## orthogonalization to keep a w_{i.} lying around). The first ## element is w_{i.} and the off-diagonal elements are zero by ## construction. Note that array W is quite different from the one ## in hache.origin(). W[1, 1, ] <- weights.s for (i in 2:p) W[i, i, has.data] <- colSums(t(weights[has.data, ]) * x[, i]^2, na.rm = TRUE) ## === ESTIMATION OF THE WITHIN VARIANCE === s2 <- mean(sigma2) ## === ESTIMATION OF THE BETWEEN VARIANCE-COVARIANCE MATRIX === ## ## By construction, we only estimate the diagonal of the matrix. ## Variance components are estimated just like in the ## Buhlmann-Straub model (see bstraub.R for details). ## ## Should we compute the iterative estimators? do.iter <- method == "iterative" && diff(range(weights, na.rm = TRUE)) > .Machine$double.eps^0.5 ## Do the computations one regression parameter at a time. for (i in seq_len(p)) { ## Unbiased estimator a <- A[i, i] <- bvar.unbiased(ind[i, has.data], W[i, i, has.data], s2, eff.ncontracts) ## Iterative estimator if (do.iter) { a <- A[i, i] <- if (a > 0) bvar.iterative(ind[i, has.data], W[i, i, has.data], s2, eff.ncontracts, start = a, tol = tol, maxit = maxit, echo = echo) else 0 } ## Credibility factors and estimator of the collective ## regression coefficients. if (a > 0) { z <- cred[i, i, has.data] <- 1/(1 + s2/(W[i, i, has.data] * a)) z. <- W.s[i, i] <- sum(z) coll[i] <- drop(crossprod(z, ind[i, has.data])) / z. } else { ## (credibility factors were already initialized to 0) w <- W[i, i, has.data] w. <- W.s[i, i] <- sum(w) coll[i] <- drop(crossprod(w, ind[i, ])) / w. } } ## Credibility adjusted coefficients. The coefficients of the ## models are replaced with these values. That way, prediction ## will be trivial using predict.lm(). for (i in seq_len(ncontracts)) fits[[i]]$coefficients <- coll + drop(cred[, , i] %*% (ind[, i] - coll)) ## Add names to the collective coefficients vector. names(coll) <- rownames(ind) ## Results list(means = list(coll, ind), weights = list(W.s, W), unbiased = if (method == "unbiased") list(A, s2), iterative = if (method == "iterative") list(A, s2), cred = cred, nodes = list(ncontracts), adj.models = fits, transition = R) } actuar/R/bstraub.R0000644000176200001440000001173614370340204013524 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Buhlmann-Straub credibility model calculations. ### ### Computation of the between variance estimators has been moved to ### external functions bvar.unbiased() and bvar.iterative() to share ### with hache(). ### ### AUTHORS: Vincent Goulet , ### Sebastien Auclair, Louis-Philippe Pouliot bstraub <- function(ratios, weights, method = c("unbiased", "iterative"), tol = sqrt(.Machine$double.eps), maxit = 100, echo = FALSE) { ## If weights are not specified, use equal weights as in ## Buhlmann's model. if (missing(weights)) { if (any(is.na(ratios))) stop("missing ratios not allowed when weights are not supplied") weights <- array(1, dim(ratios)) } ## Check other bad arguments. if (ncol(ratios) < 2L) stop("there must be at least one node with more than one period of experience") if (nrow(ratios) < 2L) stop("there must be more than one node") if (!identical(which(is.na(ratios)), which(is.na(weights)))) stop(sprintf("missing values are not in the same positions in %s and in %s", sQuote("weights"), sQuote("ratios"))) if (all(!weights, na.rm = TRUE)) stop("no available data to fit model") ## Individual weighted averages. It could happen that a contract ## has no observations, for example when applying the model on ## claim amounts. In such a situation, we will put the total ## weight of the contract and the weighted average both equal to ## zero. That way, the premium will be equal to the credibility ## weighted average, as it should, but the contract will have no ## contribution in the calculations. weights.s <- rowSums(weights, na.rm = TRUE) ratios.w <- ifelse(weights.s > 0, rowSums(weights * ratios, na.rm = TRUE)/weights.s, 0) ## Size of the portfolio. ncontracts <- sum(weights.s > 0) ntotal <- sum(!is.na(weights)) ## Collective weighted average. weights.ss <- sum(weights.s) ## Estimation of s^2 s2 <- sum(weights * (ratios - ratios.w)^2, na.rm = TRUE)/(ntotal - ncontracts) ## First estimation of a. Always compute the unbiased estimator. a <- bvar.unbiased(ratios.w, weights.s, s2, ncontracts) ## Iterative estimation of a. Compute only if ## 1. asked to in argument; ## 2. weights are not all equal (Buhlmann model). ## 3. the unbiased estimator is > 0; method <- match.arg(method) if (method == "iterative" && diff(range(weights, na.rm = TRUE)) > .Machine$double.eps^0.5) { a <- if (a > 0) bvar.iterative(ratios.w, weights.s, s2, ncontracts, start = a, tol = tol, maxit = maxit, echo = echo) else 0 } ## Final credibility factors and estimator of the collective mean. if (a > 0) { cred <- 1/(1 + s2/(weights.s * a)) ratios.zw <- drop(crossprod(cred, ratios.w))/sum(cred) } else { cred <- numeric(length(weights.s)) ratios.zw <- drop(crossprod(weights.s, ratios.w))/sum(weights.s) } structure(list(means = list(ratios.zw, ratios.w), weights = list(if (a > 0) sum(cred) else weights.ss, weights.s), unbiased = if (method == "unbiased") c(a, s2), iterative = if (method == "iterative") c(a, s2), cred = cred, nodes = list(nrow(weights))), class = "bstraub", model = "Buhlmann-Straub") } predict.bstraub <- function(object, levels = NULL, newdata, ...) structure(object$means[[1L]] + object$cred * (object$means[[2L]] - object$means[[1L]]), ...) ## Alias for the linear Bayes case predict.bayes <- predict.bstraub bvar.unbiased <- function(x, w, within, n) { w.s <- sum(w) x.w <- drop(crossprod(w, x))/w.s w.s * (drop(crossprod(w, (x - x.w)^2)) - (n - 1) * within)/(w.s^2 - sum(w^2)) } ### codetools does not like the way 'a1' is defined in function ### 'bvar.iterative' below. Avoid false positive in R CMD check. if (getRversion() >= "2.15.1") utils::globalVariables(c("a1")) bvar.iterative <- function(x, w, within, n, start, tol = sqrt(.Machine$double.eps), maxit = 100, echo = FALSE) { if (echo) { cat("Iteration\tBetween variance estimator\n") expr <- expression(cat(" ", count, "\t\t ", a1 <- a, fill = TRUE)) } else expr <- expression(a1 <- a) a <- start count <- 0L repeat { eval(expr) if (maxit < (count <- count + 1L)) { warning("maximum number of iterations reached before obtaining convergence") break } cred <- 1/(1 + within/(w * a)) x.z <- drop(crossprod(cred, x))/sum(cred) a <- drop(crossprod(cred, (x - x.z)^2))/(n - 1) if (abs((a - a1)/a1) < tol) break } a } actuar/R/quantile.grouped.data.R0000644000176200001440000000240214264305077016261 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Quantiles (inverse of the ogive) for grouped data ### ### AUTHOR: Vincent Goulet ### Walter Garcia-Fontes quantile.grouped.data <- function(x, probs = seq(0, 1, 0.25), names = TRUE, ...) { ## We keep the first frequencies column only; group boundaries are ## in the environment of 'x' y <- x[, 2L] x <- eval(expression(cj), envir = environment(x)) ## Inverse of the ogive fun <- approxfun(c(0, cumsum(y))/sum(y), x, yleft = min(x), yright = max(x), method = "linear", ties = "ordered") ## Quantiles res <- fun(probs) if (names) { dig <- max(2, getOption("digits")) names(res) <- formatC(paste(100 * probs, "%", sep = ""), format = "fg", width = 1, digits = dig) } res } summary.grouped.data <- function(object, ...) { ## Keep only the first frequencies column object <- object[1L:2L] res <- quantile(object) res <- c(res[1L:3L], mean(object), res[4L:5L]) names(res) <- c("Min.", "1st Qu.", "Median", "Mean", "3rd Qu.", "Max.") class(res) <- c("summaryDefault", "table") res } actuar/R/InverseExponential.R0000644000176200001440000000242414264305077015711 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}invexp functions to compute ### characteristics of the Inverse Exponential distribution. The ### version used in these functions has cumulative distribution ### function ### ### Pr[X <= x] = exp(-scale/x), x > 0. ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet dinvexp <- function (x, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "dinvexp", x, scale, log) pinvexp <- function(q, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pinvexp", q, scale, lower.tail, log.p) qinvexp <- function(p, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qinvexp", p, scale, lower.tail, log.p) rinvexp <- function(n, rate = 1, scale = 1/rate) .External(C_actuar_do_random, "rinvexp", n, scale) minvexp <- function(order, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "minvexp", order, scale, FALSE) levinvexp <- function(limit, rate = 1, scale = 1/rate, order) .External(C_actuar_do_dpq, "levinvexp", limit, scale, order, FALSE) actuar/R/Pareto4.R0000644000176200001440000000324414264305077013406 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}pareto4 functions to compute ### characteristics of the Pareto (type) IV distribution. The version ### used in these functions has cumulative distribution function ### ### Pr[X <= x] = 1 - (1/(1 + v))^shape1, x > min, ### ### where v = ((x - min)/scale)^shape2. ### ### See Arnold, B. C. (2015), Pareto Distributions, Second Edition, ### CRC Press. ### ### AUTHOR: Vincent Goulet dpareto4 <- function(x, min, shape1, shape2, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "dpareto4", x, min, shape1, shape2, scale, log) ppareto4 <- function(q, min, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "ppareto4", q, min, shape1, shape2, scale, lower.tail, log.p) qpareto4 <- function(p, min, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qpareto4", p, min, shape1, shape2, scale, lower.tail, log.p) rpareto4 <- function(n, min, shape1, shape2, rate = 1, scale = 1/rate) .External(C_actuar_do_random, "rpareto4", n, min, shape1, shape2, scale) mpareto4 <- function(order, min, shape1, shape2, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "mpareto4", order, min, shape1, shape2, scale, FALSE) levpareto4 <- function(limit, min, shape1, shape2, rate = 1, scale = 1/rate, order = 1) .External(C_actuar_do_dpq, "levpareto4", limit, min, shape1, shape2, scale, order, FALSE) actuar/R/InverseTransformedGamma.R0000644000176200001440000000336614264305077016660 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}invtrgamma functions to compute ### characteristics of the Inverse Transformed Gamma distribution. The ### version used in these functions has cumulative distribution ### function ### ### Pr[X <= x] = 1 - pgamma((x/scale)^shape2, shape1, scale = 1) ### ### or, equivalently, ### ### Pr[X <= x] = 1 - pgamma(x^shape2, shape1, scale = scale^shape2). ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet dinvtrgamma <- function (x, shape1, shape2, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "dinvtrgamma", x, shape1, shape2, scale, log) pinvtrgamma <- function(q, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pinvtrgamma", q, shape1, shape2, scale, lower.tail, log.p) qinvtrgamma <- function(p, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qinvtrgamma", p, shape1, shape2, scale, lower.tail, log.p) rinvtrgamma <- function(n, shape1, shape2, rate = 1, scale = 1/rate) .External(C_actuar_do_random, "rinvtrgamma", n, shape1, shape2, scale) minvtrgamma <- function(order, shape1, shape2, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "minvtrgamma", order, shape1, shape2, scale, FALSE) levinvtrgamma <- function(limit, shape1, shape2, rate = 1, scale = 1/rate, order = 1) .External(C_actuar_do_dpq, "levinvtrgamma", limit, shape1, shape2, scale, order, FALSE) actuar/R/ZeroTruncatedGeometric.R0000644000176200001440000000141214264305077016513 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r}ztgeom functions to compute ### characteristics of the Zero Truncated Geometric distribution. ### ### See Appendix B of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHOR: Vincent Goulet dztgeom <- function(x, prob, log = FALSE) .External(C_actuar_do_dpq, "dztgeom", x, prob, log) pztgeom <- function(q, prob, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pztgeom", q, prob, lower.tail, log.p) qztgeom <- function(p, prob, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qztgeom", p, prob, lower.tail, log.p) rztgeom <- function(n, prob) .External(C_actuar_do_random, "rztgeom", n, prob) actuar/R/Extract.grouped.data.R0000644000176200001440000001033514264305077016055 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Extraction and replacement methods for grouped data ### objects ### ### AUTHORS: Vincent Goulet , ### Mathieu Pigeon, Louis-Philippe Pouliot "[.grouped.data" <- function(x, i, j) { ## Only columns to extract are specified. if (nargs() < 3L) { if (missing(i)) return(x) if (is.matrix(i)) return(as.matrix(x)[i]) res <- as.data.frame(NextMethod()) if (length(i) > 1 && 1 %in% seq(ncol(x))[i]) { environment(res) <- environment(x) class(res) <- c("grouped.data", class(res)) } return(res) } ## Convert row and column indexes to strictly positive integers. ii <- if (missing(i)) seq.int(nrow(x)) else seq.int(nrow(x))[i] ij <- if (missing(j)) integer(0) else seq.int(ncol(x))[j] ## Extraction of at least the group boundaries (the complicated case). if (!length(ij) || 1L %in% ij) { ## Extraction of group boundaries in increasing order only ## (untractable otherwise). if (is.unsorted(ii)) { warning("rows extracted in increasing order") ii <- sort(ii) } ## Fetch the appropriate group boundaries. cj <- eval(expression(cj), envir = environment(x)) cj <- cj[sort(unique(c(ii, ii + 1L)))] ## Extraction of the first column only: return the vector of group ## boundaries. if (identical(ij, 1L)) return(cj) ## Return a modified 'grouped.data' object. res <- NextMethod() environment(res) <- new.env() assign("cj", cj, environment(res)) return(res) } ## All other cases handled like a regular data frame. NextMethod() } "[<-.grouped.data" <- function(x, i, j, value) { nA <- nargs() if (nA == 4L) { ii <- if (missing(i)) NULL else i ij <- if (missing(j)) NULL else j } else if (nA == 3L) { ## No arguments inside [ ]: only replacing by NULL is supported. if (missing(i) && missing(j)) { if (is.null(value)) return(x[logical(0)]) stop("impossible to replace boundaries and frequencies simultaneously") } ## Indexing by a logical matrix is supported, but only two ## types of replacement are allowed: replacing in the ## first column only, or replacing in any column but the ## first. if (is.logical(i) && is.matrix(i) && all(dim(i) == dim(x))) { ij <- apply(i, 2, any) # columns with replacements if (match(TRUE, ij) == 1) # boundaries to replace { if (length(ij) > 1) # boundaries and frequencies stop("impossible to replace boundaries and frequencies simultaneously") ii <- i[, ij] # boundaries only } return(NextMethod()) # frequencies only } ## Indexing by a non logical matrix is not supported. if (is.matrix(i)) stop("only logical matrix subscripts are allowed in replacement") ## Indexing by a vector: the argument specifies columns to ## replace. ij <- i ii <- NULL } else stop("need 0, 1, or 2 subscripts") ## Convert row and column indexes to integers. ii <- if (is.null(ii)) seq.int(nrow(x)) else seq.int(nrow(x))[ii] ij <- if (is.null(ij)) integer(0) else seq.int(ncol(x))[ij] ## Replacement at least in the group boundaries column. if (!length(ij) || 1L %in% ij) { ## supported: replacement of group boundaries only if (identical(ij, 1L)) { cj <- eval(expression(cj), envir = environment(x)) cj[sort(unique(c(ii, ii + 1L)))] <- value res <- grouped.data(cj, x[, -1L]) names(res) <- names(x) return(res) } ## not supported (untractable): replacement in the column of ## boundaries and any other column stop("impossible to replace boundaries and frequencies simultaneously") } ## All other cases handled like a regular data frame. NextMethod() } actuar/R/unroll.R0000644000176200001440000000241114370340204013363 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Display all values of a matrix of vectors by 'unrolling' the ### object vertically or horizontally. ### ### AUTHORS: Louis-Philippe Pouliot, ### Vincent Goulet unroll <- function(x, bycol = FALSE, drop = TRUE) { dx <- dim(x) if (length(dx) > 2L) stop(sprintf("%s must be a vector or a matrix", sQuote("x"))) if (length(dx) < 2L) x <- rbind(x, deparse.level = 0L) fun <- function(x) if (identical(x, NA)) NA else length(x) frequencies <- array(sapply(x, fun), dim = dim(x)) if (bycol) { lengths <- colSums(frequencies, na.rm = TRUE) mat <- matrix(NA, max(lengths), ncol(x), dimnames = dimnames(x)) for (i in seq_len(ncol(x))) if (0L < (lengthi <- lengths[i])) mat[seq_len(lengthi), i] <- unlist(x[!is.na(x[, i]), i]) } else { lengths <- rowSums(frequencies, na.rm = TRUE) mat <- matrix(NA, nrow(x), max(lengths), dimnames = list(rownames(x), NULL)) for (i in seq_len(nrow(x))) if (0L < (lengthi <- lengths[i])) mat[i, seq_len(lengthi)] <- unlist(x[i, !is.na(x[i, ])]) } mat[, , drop = drop] } actuar/R/simS.R0000644000176200001440000000224114264305077012777 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Simulation of a aggregate claim amounts ### ### AUTHORS: Vincent Goulet ### and Louis-Philippe Pouliot simS <- function(n, model.freq, model.sev) { ## Prepare the call to simul() by building up 'nodes' level.names <- names(if (is.null(model.freq)) model.sev else model.freq) nlevels <- length(level.names) nodes <- as.list(c(rep(1, nlevels - 1), n)) names(nodes) <- level.names ## Get sample x <- aggregate(simul(nodes = nodes, model.freq = model.freq, model.sev = model.sev))[-1] ## Compute the empirical cdf of the sample. Done manually instead ## of calling stats::ecdf to keep a copy of the empirical pmf in ## the environment without computing it twice. x <- sort(x) vals <- unique(x) fs <- tabulate(match(x, vals))/length(x) FUN <- approxfun(vals, pmin(cumsum(fs), 1), method = "constant", yleft = 0, yright = 1, f = 0, ties = "ordered") class(FUN) <- c("ecdf", "stepfun", class(FUN)) assign("fs", fs, envir = environment(FUN)) FUN } actuar/R/GeneralizedPareto.R0000644000176200001440000000326214264305077015474 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}genpareto functions to compute ### characteristics of the Generalized Pareto distribution. The version ### used in these functions has cumulative distribution function ### ### Pr[X <= x] = Pr[Y <= x / (x + scale)], ### ### where Y has a Beta distribution with parameters shape2 and shape1. ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet dgenpareto <- function(x, shape1, shape2, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "dgenpareto", x, shape1, shape2, scale, log) pgenpareto <- function(q, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pgenpareto", q, shape1, shape2, scale, lower.tail, log.p) qgenpareto <- function(p, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qgenpareto", p, shape1, shape2, scale, lower.tail, log.p) rgenpareto <- function(n, shape1, shape2, rate = 1, scale = 1/rate) .External(C_actuar_do_random, "rgenpareto", n, shape1, shape2, scale) mgenpareto <- function(order, shape1, shape2, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "mgenpareto", order, shape1, shape2, scale, FALSE) levgenpareto <- function(limit, shape1, shape2, rate = 1, scale = 1/rate, order = 1) .External(C_actuar_do_dpq, "levgenpareto", limit, shape1, shape2, scale, order, FALSE) actuar/R/discretize.R0000644000176200001440000001033114370340204014215 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Function to discretize a continuous distribution using various ### methods. ### ### AUTHOR: Vincent Goulet discretize <- function (cdf, from, to, step = 1, method = c("upper", "lower", "rounding", "unbiased"), lev, by = step, xlim = NULL) { method <- match.arg(method) ## If 'cdf' is only the name of a function (say f), build a call ## 'f(x)'. Otherwise, check that the expression is a function call ## containing an 'x'. Taken from 'curve'. scdf <- substitute(cdf) if (is.name(scdf)) { fcall <- paste(scdf, "(x)") cdf <- parse(text = fcall) } else { if (!(is.call(scdf) && match("x", all.vars(scdf), nomatch = 0))) stop(sprintf("%s must be a function or an expression containing %s", sQuote("cdf"), sQuote("x"))) cdf <- scdf } ## If 'from' and/or 'to' are not specified, take their values in 'xlim'. if (missing(from)) from <- xlim[1] if (missing(to)) to <- xlim[2] if (method %in% c("upper", "lower")) { ## The "upper" discretization method assigns to point x = ## from, from + step, ..., to - step the probability mass F(x ## + step) - F(x). ## ## The "lower" discretization method assigns to point x = from ## the probability mass 0 and to x = from + step, ..., to the ## probability mass F(x) - F(x - step). ## ## Hence, the latter method simply has one more element than the ## former. x <- seq.int(from, to, by) Fx <- eval(cdf, envir = list(x = x), enclos = parent.frame()) return(c(if(method == "lower") 0, diff(Fx))) } if (method == "rounding") { ## Rounding method assigns to point x = from the probability ## mass F(from + step/2) - F(from) and to point x = from + ## step, ..., to - step the probability mass F(x - step/2) - ## F(x + step/2). ## ## It is possible to make adjustments for the limits of the ## intervals (closed or open) for discrete distributions via ## 'cdf'. x <- c(from, seq.int(from + by/2, to - by/2, by)) Fx <- eval(cdf, envir = list(x = x), enclos = parent.frame()) return(diff(Fx)) } if (method == "unbiased") { ## This is the matching of the first moment method. It ## requires a function to compute the first limited moment ## which should be provided in argument 'lev'. The latter is ## specified just like 'cdf'. if (missing(lev)) stop(sprintf("%s required with method %s", sQuote("lev"), dQuote("unbiased"))) slev <- substitute(lev) if (is.name(slev)) { fcall <- paste(slev, "(x)") lev <- parse(text = fcall) } else { if (!(is.call(slev) && match("x", all.vars(slev), nomatch = 0))) stop(sprintf("%s must be a function or an expression containing %s", sQuote("lev"), sQuote("x"))) lev <- slev } ## The first limited moment must be evaluated in x = from, ## from + step, ..., to and the cdf in x = from and x = to ## only (see below). x <- seq.int(from, to, by) Ex <- eval(lev, envir = list(x = x), enclos = parent.frame()) Fx <- eval(cdf, envir = list(x = c(from, to)), enclos = parent.frame()) ## The probability mass in x = from is ## ## (E[X ^ x] - E[X ^ x + step])/step + 1 - F(x). ## ## The probability mass in x = from + step, ..., to - step is ## ## (2 * E[X ^ x] - E[X ^ x - step] - E[X ^ x + step])/step. ## ## The probability mass in x = to is ## ## (E[X ^ x] - E[X ^ x - step])/step - 1 + F(x). ## ## See exercise 6.36 in Loss Models, 2nd edition. return(c(-diff(head(Ex, 2))/by + 1 - Fx[1], (2 * head(Ex[-1], -1) - head(Ex, -2) - tail(Ex, -2))/by, diff(tail(Ex, 2))/by - 1 + Fx[2])) } } discretise <- discretize actuar/R/mean.grouped.data.R0000644000176200001440000000130314264305077015356 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Mean of grouped data objects ### ### See Klugman, Panjer & Willmot, Loss Models, Wiley, 1998. ### ### AUTHOR: Vincent Goulet ## New method of base::mean generic for grouped data mean.grouped.data <- function(x, ...) { ## Get group boundaries cj <- eval(expression(cj), envir = environment(x)) ## Compute group midpoints midpoints <- cj[-length(cj)] + diff(cj)/2 ## Extract frequencies columns by dropping the boundaries column; ## convert to matrix for use in crossprod() x <- as.matrix(x[-1L]) ## Compute mean per column drop(crossprod(x, midpoints))/colSums(x) } actuar/R/VaR.R0000644000176200001440000000106314264305077012555 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of a generic function for the Value at Risk. Currently, ### there is no default method for this function. The only method is ### for objects of class 'aggregateDist'. ### ### AUTHORS: Tommy Ouellet, Vincent Goulet VaR <- function(x, ...) UseMethod("VaR") VaR.aggregateDist <- function(x, conf.level = c(0.9, 0.95, 0.99), smooth = FALSE, names = TRUE, ...) quantile.aggregateDist(x, conf.level, smooth, names, ...) actuar/R/ZeroTruncatedNegativeBinomial.R0000644000176200001440000000201314264305077020010 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r}ztnbinom functions to compute ### characteristics of the Zero Truncated Negative Binomial ### distribution. ### ### See Appendix B of Klugman, Panjer & Willmot, Loss Models, Second ### Edition, Wiley, 2004. ### ### AUTHOR: Vincent Goulet dztnbinom <- function (x, size, prob, log = FALSE) .External(C_actuar_do_dpq, "dztnbinom", x, size, prob, log) pztnbinom <- function(q, size, prob, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pztnbinom", q, size, prob, lower.tail, log.p) qztnbinom <- function(p, size, prob, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qztnbinom", p, size, prob, lower.tail, log.p) rztnbinom <- function(n, size, prob) .External(C_actuar_do_random, "rztnbinom", n, size, prob) ## not exported; for internal use in panjer() pgfztnbinom <- function(x, size, prob) expm1(-size * log1p(x * (prob - 1)))/expm1(-size * log(prob)) actuar/R/betaint.R0000644000176200001440000000123014264305077013507 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### The "beta integral" ### ### B(a, b; x) = Gamma(a + b) int_0^x t^(a-1) (1 - t)^(b-1) dt ### ### a > 0, b != -1, -2, ..., 0 < x < 1. This mathematical function is ### only used at the C level in the package. The R function therein ### provides an R interface just in case it could be useful. ### ### The function is *not* exported. ### ### See Appendix A of Klugman, Panjer and Willmot (2012), Loss Models, ### Fourth Edition, Wiley. ### ### AUTHOR: Vincent Goulet ## see src/betaint.c betaint <- function(x, a, b) .External(C_actuar_do_betaint, x, a, b) actuar/R/LognormalMoments.R0000644000176200001440000000102414264305077015357 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {m,lev}lnorm functions. ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet mlnorm <- function(order, meanlog = 0, sdlog = 1) .External(C_actuar_do_dpq, "mlnorm", order, meanlog, sdlog, FALSE) levlnorm <- function(limit, meanlog = 0, sdlog = 1, order = 1) .External(C_actuar_do_dpq, "levlnorm", limit, meanlog, sdlog, order, FALSE) actuar/R/InverseGamma.R0000644000176200001440000000341714264305077014450 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev,mgf}invgamma functions to compute ### characteristics of the Inverse Gamma distribution. The version ### used in these functions has cumulative distribution function ### ### Pr[X <= x] = 1 - pgamma(scale/x, shape, scale = 1) ### ### or, equivalently, ### ### Pr[X <= x] = 1 - pgamma(1/x, shape1, scale = 1/scale). ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Second ### Edition, Wiley, 2004 and ### ### ### AUTHORS: Mathieu Pigeon, Christophe Dutang and ### Vincent Goulet dinvgamma <- function (x, shape, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "dinvgamma", x, shape, scale, log) pinvgamma <- function(q, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pinvgamma", q, shape, scale, lower.tail, log.p) qinvgamma <- function(p, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qinvgamma", p, shape, scale, lower.tail, log.p) rinvgamma <- function(n, shape, rate = 1, scale = 1/rate) .External(C_actuar_do_random, "rinvgamma", n, shape, scale) minvgamma <- function(order, shape, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "minvgamma", order, shape, scale, FALSE) levinvgamma <- function(limit, shape, rate = 1, scale = 1/rate, order = 1) .External(C_actuar_do_dpq, "levinvgamma", limit, shape, scale, order, FALSE) mgfinvgamma <- function(t, shape, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "mgfinvgamma", t, shape, scale, log) actuar/R/InversePareto.R0000644000176200001440000000237014264305077014655 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m}invpareto functions to compute ### characteristics of the Inverse Pareto distribution. The version ### used in these functions has cumulative distribution function ### ### Pr[X <= x] = (x/(x + scale))^shape, x > 0. ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet dinvpareto <- function(x, shape, scale, log = FALSE) .External(C_actuar_do_dpq, "dinvpareto", x, shape, scale, log) pinvpareto <- function(q, shape, scale, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pinvpareto", q, shape, scale, lower.tail, log.p) qinvpareto <- function(p, shape, scale, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qinvpareto", p, shape, scale, lower.tail, log.p) rinvpareto <- function(n, shape, scale) .External(C_actuar_do_random, "rinvpareto", n, shape, scale) minvpareto <- function(order, shape, scale) .External(C_actuar_do_dpq, "minvpareto", order, shape, scale, FALSE) levinvpareto <- function(limit, shape, scale, order = 1) .External(C_actuar_do_dpq, "levinvpareto", limit, shape, scale, order, FALSE) actuar/R/rcomphierarc.R0000644000176200001440000003115014522557714014547 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Simulation of hierarchical portfolios of data. Claim number and ### claim amounts in any given node are simulated independently. Both ### frequency and severity models can be mixtures of distributions. ### ### In the code here, numbering of levels starts at 1 at the data ### level, whereas in common discussion of hierarchical models the ### data level is numbered 0. ### ### AUTHORS: Vincent Goulet , ### Sebastien Auclair and Louis-Philippe Pouliot rcomphierarc <- function(nodes, model.freq = NULL, model.sev = NULL, weights = NULL) { ## Get level names. Each could be NULL. level.names <- names(nodes) freq.names <- names(model.freq) sev.names <- names(model.sev) ## 'nodes' must be a named list. One exception is allowed: there ## is only one level. In this case, add a predetermined name if ## there isn't one already and make sure 'nodes' is a list. if (length(nodes) == 1L) { if (is.null(level.names)) names(nodes) <- "X" nodes <- as.list(nodes) } else { if (!is.list(nodes) || is.null(level.names)) stop(sprintf("%s must be a named list", sQuote("nodes"))) } ## Determine if frequency and severity models are present. Keep ## for future use. has.freq <- !all(sapply(model.freq, is.null)) has.sev <- !all(sapply(model.sev, is.null)) ## Check that at least one of 'model.freq' or 'model.sev' is ## present and that the level names match with those of 'nodes'. ## Perhaps is there a fancier way to do all these tests, but the ## version below is at least easy to follow. if (has.freq) { if (has.sev) { if (! (identical(level.names, freq.names) && identical(level.names, sev.names))) stop(sprintf("level names different in %s, %s and %s", sQuote("nodes"), sQuote("model.freq"), sQuote("model.sev"))) } else { if (!identical(level.names, freq.names)) stop(sprintf("level names different in %s, %s and %s", sQuote("nodes"), sQuote("model.freq"), sQuote("model.sev"))) } } else { if (has.sev) { if (!identical(level.names, sev.names)) stop(sprintf("level names different in %s, %s and %s", sQuote("nodes"), sQuote("model.freq"), sQuote("model.sev"))) } else stop(sprintf("one of %s or %s must be non-NULL", sQuote("model.freq"), sQuote("model.sev"))) } ## The function is written for models with at least two levels ## (entity and year). If there is only one, add a dummy level to ## avoid scattering the code with conditions. if (length(nodes) < 2L) { nodes <- c(node = 1, nodes) model.freq <- if (has.freq) c(expression(node = NULL), model.freq) else NULL model.sev <- if (has.sev) c(expression(node = NULL), model.sev) else NULL } ## Frequently used quantities level.names <- names(nodes) # need to reset! nlevels <- length(nodes) # number of levels ## Recycling of the number of nodes (if needed) must be done ## "manually". We do it here once and for all since in any case ## below we will need to know the total number of nodes in the ## portfolio. Furthermore, the recycled list 'nodes' will be ## returned by the function. for (i in 2L:nlevels) # first node doesn't need recycling nodes[[i]] <- rep(nodes[[i]], length = sum(nodes[[i - 1L]])) ## Simulation of the frequency mixing parameters for each level ## (e.g. class, contract) and, at the last level, the actual ## frequencies. If 'model.freq' is NULL, this is equivalent to ## having one claim per node. if (has.freq) { ## Normally, only the immediately above mixing parameter will ## be used in the model for a level, but the code here allows ## for more general schemes. For this to work, all mixing ## parameters have to be correctly recycled at each level ## where they *could* be used. Since the model at any level ## could be NULL, 'params' will keep track of the mixing ## parameters that were simulated in previous iteration of the ## forthcoming loop. params <- character(0) for (i in seq_len(nlevels)) { ## Number of nodes at the current level n.current <- nodes[[i]] ## Extract simulation model for the level. Call <- model.freq[[i]] ## Repeat the mixing parameters of all levels above the ## current one that were simulated in the past. for (j in seq_along(params)) eval(substitute(x <- rep.int(x, n.current), list(x = as.name(params[[j]])))) ## Simulate data only if there is a model at the current ## level. if (!is.null(Call)) { ## Add the number of variates to the call. Call$n <- sum(n.current) ## Simulation of the mixing parameters or the data. In ## the latter case, store the results in a fixed ## variable name. if (i < nlevels) { assign(level.names[[i]], eval(Call)) params[i] <- level.names[[i]] # remember the parameter } else frequencies <- eval(Call) } } } else frequencies <- rep.int(1, sum(nodes[[nlevels]])) ## Simulation of the claim amounts. If 'model.sev' is NULL, this ## is equivalent to simulating frequencies only. if (has.sev) { ## Repeat the same procedure as for the frequency model, with ## one difference: when reaching the last level (claim ## amounts), the number of variates to simulate is not given ## by the number of nodes but rather by the number of claims ## as found in 'frequencies'. params <- character(0) for (i in seq_len(nlevels)) { n.current <- nodes[[i]] Call <- model.sev[[i]] for (j in seq_along(params)) eval(substitute(x <- rep.int(x, n.current), list(x = as.name(params[[j]])))) if (!is.null(Call)) { ## The rest of the procedure differs depending if we ## are still simulating mixing parameters or claim ## amounts. if (i < nlevels) { ## Simulation of mixing parameters is identical to the ## simulation of frequencies. Call$n <- sum(n.current) assign(level.names[[i]], eval(Call)) params[i] <- level.names[[i]] } else { ## For the simulation of claim amounts, the number ## of variates is rather given by the ## 'frequencies' object. Furthermore, the mixing ## parameters must be recycled once more to match ## the vector of frequencies. for (p in intersect(all.vars(Call), params)) eval(substitute(x <- rep.int(x, frequencies), list(x = as.name(p)))) Call$n <- sum(frequencies) severities <-eval(Call) } } } } else severities <- rep.int(1, sum(frequencies)) ## We must now distribute the claim amounts in vector 'severities' ## to the appropriate nodes. This is complicated by the ## possibility to have different number of nodes (years of ## observation) for each entity. The result must be a matrix ## with the number of columns equal to the maximum number of last ## level nodes. ## ## The number of nodes (years of observation) per entity is ## given by 'n.current' since we reached the last level in (either ## one of) the above loops. ## ## Assign a unique ID to each node, leaving gaps for nodes without ## observations. ind <- unlist(mapply(seq, from = seq(by = max(n.current), along = n.current), length = n.current)) ## Repeating the vector of IDs according to the frequencies ## effectively assigns a node ID to each claim amount. The vector ## of claim amounts is then split by node, yielding a list where ## each element corresponds to a node with claims. f <- rep.int(ind, frequencies) severities <- split(severities, f) ## Identify nodes with frequency equal to 0, which is different ## from having no observation (NA). freq0 <- ind[which(frequencies == 0)] ## Rearrange the list of claim amounts in a matrix; ## ## number of rows: number of nodes at the penultimate level ## (number of entities) ## number of columns: maximum number of nodes at the last level ## (number of years of observation). ## ## Moreover, assign a value of 'numeric(0)' to nodes with a ## frequency of 0. nrow <- length(n.current) # number of entities ncol <- max(n.current) # number of years res <- as.list(rep.int(NA, nrow * ncol)) res[unique(f)] <- severities res[freq0] <- lapply(rep.int(0, length(freq0)), numeric) res <- matrix(res, nrow, ncol, byrow = TRUE, dimnames = list(NULL, paste(level.names[nlevels], seq_len(ncol), sep = "."))) ## Reshape weights as a matrix, if necessary. weights <- if (is.null(weights)) NULL else { ## Integrate NAs into the weights matrix as appropriate. w <- rep.int(NA, nrow * ncol) w[ind] <- weights matrix(w, nrow = nrow, byrow = TRUE, dimnames = dimnames(res)) } ## Finally, create a matrix where each row contains the series of ## identifiers for an entity in the portfolio, e.g. if the data ## is denoted X_{ijkt}, one line of the matrix will contain ## subscripts i, j and k. As we move from right to left in the ## columns of 'm', the subcripts are increasingly repeated. ncol <- nlevels - 1L m <- matrix(1, nrow, ncol, dimnames = list(NULL, head(level.names, ncol))) for (i in seq_len(ncol - 1L)) # all but the last column { ## Vector 'x' will originally contain all subscripts for one ## level. These subscripts are then repeated as needed to give ## the desired result. To avoid another explicit loop, I use a ## 'lapply' with a direct assignment in the current ## frame. Somewhat unusual, but this is the simplest procedure ## I managed to come up with. x <- unlist(lapply(nodes[[i]], seq)) lapply(nodes[(i + 1L):(nlevels - 1L)], function(v) assign("x", rep.int(x, v), envir = parent.frame(2))) m[, i] <- x } m[, ncol] <- unlist(lapply(nodes[[ncol]], seq)) # last column ## Return object of class 'portfolio' structure(list(data = res, weights = weights, classification = m, nodes = nodes, model.freq = model.freq, model.sev = model.sev), class = "portfolio") } ### Alias for backward compatibility with actuar < 2.0-0. simul <- rcomphierarc ### 'print' method for 'portfolio' objects print.portfolio <- function(x, ...) { cat("\nPortfolio of claim amounts \n\n") nn <- names(x$nodes) nc <- max(nchar(nn)) if (!is.null(x$model.freq)) { cat(" Frequency model\n") cat(paste(" ", format(nn, width = nc), " ~ ", x$model.freq, "\n", sep = ""), sep = "") } if (!is.null(x$model.sev)) { cat(" Severity model\n") cat(paste(" ", format(nn, width = nc), " ~ ", x$model.sev, "\n", sep = ""), sep = "") } cat("\n Number of claims per node: \n\n") print(frequency(x), ...) invisible(x) } actuar/R/var-methods.R0000644000176200001440000000240314264305077014315 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Variance and standard deviation ### ### See Klugman, Panjer & Willmot, Loss Models, Wiley, 1998. ### ### AUTHOR: Vincent Goulet ### Walter Garcia-Fontes ## New generics for functions of the stats package var <- function(x, ...) UseMethod("var") sd <- function(x, ...) UseMethod("sd") ## Default methods are stats::var and stats:sd var.default <- function(x, y = NULL, na.rm = FALSE, use, ...) stats::var(x, y = NULL, na.rm = FALSE, use) sd.default <- function(x, na.rm = FALSE, ...) stats::sd(x, na.rm = FALSE) ## Methods for grouped data var.grouped.data <- function(x, ...) { ## Get group boundaries cj <- eval(expression(cj), envir = environment(x)) ## Compute group midpoints midpoints <- cj[-length(cj)] + diff(cj)/2 ## Compute midpoints minus mean and square it midsquare <- (midpoints - mean(x))^2 ## Extract frequencies columns by dropping the boundaries column; ## convert to matrix for use in crossprod() x <- as.matrix(x[-1L]) ## Compute mean per column drop(crossprod(x, midsquare))/(colSums(x) - 1) } sd.grouped.data <- function(x, ...) { ## Square root of variance drop(sqrt(var.grouped.data(x))) } actuar/R/PhaseType.R0000644000176200001440000000230214264305077013764 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,r,m,mgf}ph functions to compute ### characteristics of Phase-type distributions with cumulative ### distribution function ### ### Pr[X <= x] = 1 - pi %*% exp(Tx) %*% e, ### ### where 'pi' is the initial probability vector, 'T' is the ### subintensity matrix and 'e' is 1-vector of R^m. ### ### See Bladt, M. (2005), "A review on phase-type distributions and ### their use in risk theory", Astin Bulletin 35, p. 145-161. ### ### AUTHORS: Christophe Dutang, Vincent Goulet dphtype <- function(x, prob, rates, log = FALSE) .External(C_actuar_do_dpqphtype, "dphtype", x, prob, rates, log) pphtype <- function(q, prob, rates, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpqphtype, "pphtype", q, prob, rates, lower.tail, log.p) rphtype <- function(n, prob, rates) .External(C_actuar_do_randomphtype, "rphtype", n, prob, rates) mphtype <- function(order, prob, rates) .External(C_actuar_do_dpqphtype, "mphtype", order, prob, rates, FALSE) mgfphtype <- function(t, prob, rates, log = FALSE) .External(C_actuar_do_dpqphtype, "mgfphtype", t, prob, rates, log) actuar/R/grouped.data.R0000644000176200001440000001252314370340204014432 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Creation of grouped data objects. ### ### The function can create a grouped data object from two types of ### arguments. ### ### 1. Individual data. The call has at least two elements in '...'. ### The first is then the vector of group boundaries and the others ### are vectors (or a matrix) of group frequencies. ### ### 2. Group boundaries and frequencies. The call has one or more ### elements in '...' and either 'breaks' or 'nclass' is provided ### or 'group' is TRUE. In this case, elements of '...' are grouped ### using graphics::hist automatically based on the first element ### of '...', or with group boundaries 'breaks' if the latter is a ### vector. ### ### For details on grouped data, see Klugman, Panjer & Willmot, Loss ### Models, Wiley, 1998. ### ### AUTHORS: Vincent Goulet , ### Mathieu Pigeon, Louis-Philippe Pouliot ### ### CREDITS: Manipulation and creation of names taken in part from R ### function data.frame(). Arguments, 'breaks', 'nclass' and their ### treatment taken from R function 'hist'. grouped.data <- function(..., breaks = "Sturges", include.lowest = TRUE, right = TRUE, nclass = NULL, group = FALSE, row.names = NULL, check.rows = FALSE, check.names = TRUE) { ## Utility function to format numbers. numform <- function(x, w) formatC(x, digits = 2, width = w, format = "fg") ## Keep the calls in '...' in object 'ox', and the evaluated ## elements in '...' in object 'x'. ox <- as.list(substitute(list(...)))[-1L] x <- list(...) xlen <- length(x) # number of arguments in '...' use.br <- !missing(breaks) # 'breaks' specified ## If any elements of '...' are unnamed, set names based on the ## variable name provided in the function call (e.g. f(x) -> "x") ## or from the deparsed expression (e.g. f(1:3) -> "1:3"). xnames <- names(x) if(length(xnames) != xlen) xnames <- character(xlen) no.xn <- !nzchar(xnames) if (any(no.xn)) { for (i in which(no.xn)) xnames[i] <- deparse(ox[[i]], nlines = 1L)[1L] names(x) <- xnames } ## Single argument implies individual data. if (xlen == 1L) group <- TRUE ## Avoid using calling 'hist' with 'nclass' specified. if (use.br) { if (!missing(nclass)) warning(sprintf("%s not used when %s is specified", sQuote("nclass"), sQuote("breaks"))) if (!(missing(group) || group)) warning(sprintf("%s ignored when %s is specified", sQuote("group"), sQuote("breaks"))) group <- TRUE } else if (!is.null(nclass) && length(nclass) == 1L) { breaks <- nclass if (!(missing(group) || group)) warning(sprintf("%s ignored when %s is specified", sQuote("group"), sQuote("nclass"))) group <- TRUE } if (group) # individual data in argument; group with 'hist' { ## Set group boudaries (and the first set of group ## frequencies) using the first argument in '...'. y <- hist(x[[1]], plot = FALSE, breaks = breaks, include.lowest = include.lowest, right = right) br <- y$breaks y <- y$counts ## If there are other vectors in '...', compute group ## frequencies using 'hist' with the group boundaries ## determined above. If 'breaks' were set automatically, there ## is a great risk of error, but we can't do much better. if (xlen > 1) { f <- function(x, br) hist(x, plot = FALSE, breaks = br, include.lowest = include.lowest, right = right)$counts y <- cbind(y, sapply(x[-1], f, br = br)) } y <- as.data.frame(y) x <- as.data.frame(br) names(y) <- xnames xnames <- "" nx <- nrow(x) } else # group boundaries and frequencies in argument { y <- as.data.frame(x[-1L]) # group frequencies x <- as.data.frame(x[[1L]]) # group boundaries nx <- nrow(x) ## There must be exactly one more group boundary than frequencies. if (nx - nrow(y) != 1L) stop("invalid number of group boundaries and frequencies") ## Replace missing frequencies by zeros. nax <- is.na(x) if (any(nax)) { x[nax] <- 0 warning("missing frequencies replaced by zeros") } } ## Return a data frame with formatted group boundaries in the ## first column. w <- max(nchar(x[-1L, ])) # longest upper boundary xfmt <- paste(if (right) "(" else "[", numform(x[-nx, ], -1), ", ", numform(x[-1L, ], w), if (right) "]" else ")", sep = "") res <- data.frame(xfmt, y, row.names = row.names, check.rows = check.rows, check.names = check.names) names(res) <- c(xnames[1L], names(y)) class(res) <- c("grouped.data", "data.frame") environment(res) <- new.env() assign("cj", unlist(x, use.names = FALSE), environment(res)) attr(res, "right") <- right res } actuar/R/Logarithmic.R0000644000176200001440000000260714264305077014334 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,r}logarithmic functions to compute ### characteristics of the logarithmic distribution. The version used ### in these functions has probability mass function ### ### Pr[X = x] = -p^x/(x log(1 - p)), x = 1, 2, ... ### ### This is the standard parametrization in the literature; see for ### example https://en.wikipedia.org/wiki/Logarithmic_distribution. ### ### NOTE: Klugman, Panjer & Willmot (Loss Models) introduce the ### logarithmic distribution as a limiting case of the zero truncated ### negative binomial. In this setting, parameter 'p' above would be ### the probability of *failure* (a.k.a. q) of the zero truncated ### negative binomial. ### ### AUTHOR: Vincent Goulet dlogarithmic <- function(x, prob, log = FALSE) .External(C_actuar_do_dpq, "dlogarithmic", x, prob, log) plogarithmic <- function(q, prob, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "plogarithmic", q, prob, lower.tail, log.p) qlogarithmic <- function(p, prob, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qlogarithmic", p, prob, lower.tail, log.p) rlogarithmic <- function(n, prob) .External(C_actuar_do_random, "rlogarithmic", n, prob) ## not exported; for internal use in panjer() pgflogarithmic <- function(x, prob) log1p(-prob * x)/log1p(-prob) actuar/R/emm.R0000644000176200001440000000223014370340204012625 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Empirical moments for individual and grouped data. ### ### See Klugman, Panjer & Willmot, Loss Models, Wiley, 1998. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet emm <- function(x, order = 1, ...) UseMethod("emm") emm.default <- function(x, order = 1, ...) { if (any(order < 0)) stop(sprintf("%s must be positive", sQuote("order"))) colMeans(outer(x, order, "^"), ...) } emm.grouped.data <- function(x, order = 1, ...) { ## Function does not work for negative moments if (any(order < 0)) stop(sprintf("%s must be positive", sQuote("order"))) ## Extract group boundaries cj <- eval(expression(cj), envir = environment(x)) ## Compute the factor ## ## f_j = (c_j^{k + 1} - c_{j-1}^{k+1})/((k+1) * (c_j - c_{j-1})) ## ## for all values of 'j' and 'k' == 'order'. y <- diff(outer(cj, order + 1, "^")) / outer(diff(cj), order + 1) ## Drop the group boundaries column x <- as.matrix(x[-1L]) ## Compute sum(n_j * f_j)/sum(nj) for all values of 'order'. drop(crossprod(x, y)) / colSums(x, ...) } actuar/R/FellerPareto.R0000644000176200001440000000357714264305077014465 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}fpareto functions to compute ### characteristics of the Feller-Pareto distribution. The version ### used in these functions has cumulative distribution function ### ### Pr[X <= x] = Pr[Y <= v/(1 + v)], x > min, ### ### where v = ((x - min)/scale)^shape2 and Y has a Beta distribution ### with parameters shape3 and shape1. ### ### See Arnold, B. C. (2015), Pareto Distributions, Second Edition, ### CRC Press. ### ### AUTHORS: Nicholas Langevin, Vincent Goulet dfpareto <- function (x, min, shape1, shape2, shape3, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "dfpareto", x, min, shape1, shape2, shape3, scale, log) pfpareto <- function (q, min, shape1, shape2, shape3, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pfpareto", q, min, shape1, shape2, shape3, scale, lower.tail, log.p) qfpareto <- function (p, min, shape1, shape2, shape3, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qfpareto", p, min, shape1, shape2, shape3, scale, lower.tail, log.p) rfpareto <- function (n, min, shape1, shape2, shape3, rate = 1, scale = 1/rate) .External(C_actuar_do_random, "rfpareto", n, min, shape1, shape2, shape3, scale) mfpareto <- function (order, min, shape1, shape2, shape3, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "mfpareto", order, min, shape1, shape2, shape3, scale, FALSE) levfpareto <- function (limit, min, shape1, shape2, shape3, rate = 1, scale = 1/rate, order = 1) .External(C_actuar_do_dpq, "levfpareto", limit, min, shape1, shape2, shape3, scale, order, FALSE) actuar/R/InverseWeibull.R0000644000176200001440000000315614264305077015031 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}invweibull functions to compute ### characteristics of the Inverse Weibull distribution. The version ### used in these functions has cumulative distribution function ### ### Pr[X <= x] = exp(-(x/scale)^shape), x > 0. ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet dinvweibull <- function (x, shape, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "dinvweibull", x, shape, scale, log) pinvweibull <- function(q, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pinvweibull", q, shape, scale, lower.tail, log.p) qinvweibull <- function(p, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qinvweibull", p, shape, scale, lower.tail, log.p) rinvweibull <- function(n, shape, rate = 1, scale = 1/rate) .External(C_actuar_do_random, "rinvweibull", n, shape, scale) minvweibull <- function(order, shape, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "minvweibull", order, shape, scale, FALSE) levinvweibull <- function(limit, shape, rate = 1, scale = 1/rate, order = 1) .External(C_actuar_do_dpq, "levinvweibull", limit, shape, scale, order, FALSE) ## Aliases dlgompertz <- dinvweibull plgompertz <- pinvweibull qlgompertz <- qinvweibull rlgompertz <- rinvweibull mlgompertz <- minvweibull levlgompertz <- levinvweibull actuar/R/InverseParalogistic.R0000644000176200001440000000277614264305077016056 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}invparalogis functions to compute ### characteristics of the Inverse Paralogistic distribution. The ### version used in these functions has cumulative distribution ### function ### ### Pr[X <= x] = (u/(1 + u))^shape, u = (x/scale)^shape, x > 0. ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet dinvparalogis <- function (x, shape, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "dinvparalogis", x, shape, scale, log) pinvparalogis <- function(q, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pinvparalogis", q, shape, scale, lower.tail, log.p) qinvparalogis <- function(p, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qinvparalogis", p, shape, scale, lower.tail, log.p) rinvparalogis <- function(n, shape, rate = 1, scale = 1/rate) .External(C_actuar_do_random, "rinvparalogis", n, shape, scale) minvparalogis <- function(order, shape, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "minvparalogis", order, shape, scale, FALSE) levinvparalogis <- function(limit, shape, rate = 1, scale = 1/rate, order = 1) .External(C_actuar_do_dpq, "levinvparalogis", limit, shape, scale, order, FALSE) actuar/R/InverseGaussian.R0000644000176200001440000000374714264305077015206 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev,mgf}invgauss functions to compute ### characteristics of the Inverse Gaussian distribution. ### ### Functions [dpq]invgauss rely on C implementations of functions of ### the same name in package statmod. See: ### ### Giner, G. and Smyth, G. K. (2016), "statmod: Probability ### Calculations for the Inverse Gaussian Distribution", R Journal, ### vol. 8, no 1, p. 339-351. ### https://journal.r-project.org/archive/2016-1/giner-smyth.pdf ### ### Chhikara, R. S. and Folk, T. L. (1989), The Inverse Gaussian ### Distribution: Theory, Methodology and Applications}, Decker. ### ### AUTHOR: Vincent Goulet dinvgauss <- function(x, mean, shape = 1, dispersion = 1/shape, log = FALSE) .External(C_actuar_do_dpq, "dinvgauss", x, mean, dispersion, log) pinvgauss <- function(q, mean, shape = 1, dispersion = 1/shape, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pinvgauss", q, mean, dispersion, lower.tail, log.p) qinvgauss <- function(p, mean, shape = 1, dispersion = 1/shape, lower.tail = TRUE, log.p = FALSE, tol = 1e-14, maxit = 100, echo = FALSE, trace = echo) .External(C_actuar_do_dpq, "qinvgauss", p, mean, dispersion, lower.tail, log.p, tol, maxit, trace) rinvgauss <- function(n, mean, shape = 1, dispersion = 1/shape) .External(C_actuar_do_random, "rinvgauss", n, mean, dispersion) minvgauss <- function(order, mean, shape = 1, dispersion = 1/shape) .External(C_actuar_do_dpq, "minvgauss", order, mean, dispersion, FALSE) levinvgauss <- function(limit, mean, shape = 1, dispersion = 1/shape, order = 1) .External(C_actuar_do_dpq, "levinvgauss", limit, mean, dispersion, order, FALSE) mgfinvgauss <- function(t, mean, shape = 1, dispersion = 1/shape, log = FALSE) .External(C_actuar_do_dpq, "mgfinvgauss", t, mean, dispersion, log) actuar/R/PoissonInverseGaussian.R0000644000176200001440000000215414264305077016550 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r}poisinvgauss functions to compute ### characteristics of the Poisson-Inverse Gaussian discrete ### distribution. ### ### AUTHOR: Vincent Goulet dpoisinvgauss <- function(x, mean, shape = 1, dispersion = 1/shape, log = FALSE) .External(C_actuar_do_dpq, "dpoisinvgauss", x, mean, dispersion, log) ppoisinvgauss <- function(q, mean, shape = 1, dispersion = 1/shape, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "ppoisinvgauss", q, mean, dispersion, lower.tail, log.p) qpoisinvgauss <- function(p, mean, shape = 1, dispersion = 1/shape, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qpoisinvgauss", p, mean, dispersion, lower.tail, log.p) rpoisinvgauss <- function(n, mean, shape = 1, dispersion = 1/shape) .External(C_actuar_do_random, "rpoisinvgauss", n, mean, dispersion) ## Aliases dpig <- dpoisinvgauss ppig <- ppoisinvgauss qpig <- qpoisinvgauss rpig <- rpoisinvgauss actuar/R/TransformedGamma.R0000644000176200001440000000325714264305077015323 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}trgamma functions to compute ### characteristics of the Transformed Gamma distribution. The version ### used in these functions has cumulative distribution function ### ### Pr[X <= x] = pgamma((x/scale)^shape2, shape1, scale = 1), x > 0 ### ### or, equivalently, ### ### Pr[X <= x] = pgamma(x^shape2, shape1, scale = scale^shape2), x > 0. ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet dtrgamma <- function (x, shape1, shape2, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "dtrgamma", x, shape1, shape2, scale, log) ptrgamma <- function(q, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "ptrgamma", q, shape1, shape2, scale, lower.tail, log.p) qtrgamma <- function(p, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qtrgamma", p, shape1, shape2, scale, lower.tail, log.p) rtrgamma <- function(n, shape1, shape2, rate = 1, scale = 1/rate) .External(C_actuar_do_random, "rtrgamma", n, shape1, shape2, scale) mtrgamma <- function(order, shape1, shape2, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "mtrgamma", order, shape1, shape2, scale, FALSE) levtrgamma <- function(limit, shape1, shape2, rate = 1, scale = 1/rate, order = 1) .External(C_actuar_do_dpq, "levtrgamma", limit, shape1, shape2, scale, order, FALSE) actuar/R/ogive.R0000644000176200001440000001077014515770645013211 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Ogive for grouped data. ### ### A default method exists for either a vector of individual data, or ### two vectors of group boundaries and group frequencies. It first ### creates a grouped data object using 'grouped.data' and then calls ### a utility function to create the ogive. ### ### For the definition of the ogive, see Klugman, Panjer & Willmot, ### Loss Models, Wiley, 1998. ### ### More details on the admissible arguments for the default method ### are to be found in ./grouped.data.R. ### ### AUTHORS: Vincent Goulet , ### Mathieu Pigeon ### ### CREDITS: Arguments, 'breaks', 'nclass' and their treatment taken ### from R function hist(). ogive <- function(x, ...) UseMethod("ogive") ogive.default <- function(x, y = NULL, breaks = "Sturges", nclass = NULL, ...) { chkDots(...) # method does not use '...' Call <- match.call() if (exists(".Generic", inherits = FALSE)) Call[[1]] <- as.name(.Generic) ## Avoid using calling 'hist' with 'nclass' specified. if (!missing(breaks)) { if (!missing(nclass)) warning(sprintf("%s not used when %s is specified", sQuote("nclass"), sQuote("breaks"))) } else if (!is.null(nclass) && length(nclass) == 1L) breaks <- nclass ## Create the "grouped.data" object. x <- if (is.null(y)) # one argument: individual data grouped.data(x, breaks = breaks) else # two arguments: boundaries and frequencies grouped.data(x, y) ## Group frequencies in the second column of the data frame; group ## boundaries in the environment of 'x'. y <- x[, 2L] x <- eval(expression(cj), envir = environment(x)) ## Create an object of class 'ogive'. res <- .ogiveFUN(x, y) attr(res, "call") <- Call res } ogive.grouped.data <- function(x, ...) { chkDots(...) # method does not use '...' Call <- match.call() if (exists(".Generic", inherits = FALSE)) Call[[1]] <- as.name(.Generic) ## We keep the first frequencies column only; group boundaries are ## in the environment of 'x' y <- x[, 2L] x <- eval(expression(cj), envir = environment(x)) ## Create an object of class 'ogive'. res <- .ogiveFUN(x, y) attr(res, "call") <- Call res } .ogiveFUN <- function(x, y) { FUN <- approxfun(x, cumsum(c(0, y)) / sum(y), yleft = 0, yright = 1, method = "linear", ties = "ordered") class(FUN) <- c("ogive", class(FUN)) FUN } ### Essentially identical to stats:::print.ecdf. print.ogive <- function(x, digits = getOption("digits") - 2, ...) { ## Utility function numform <- function(x) paste(formatC(x, digits = digits), collapse = ", ") ## The rest is adapted from stats::ecdf cat("Ogive for grouped data \nCall: ") print(attr(x, "call"), ...) nc <- length(xxc <- get("x", envir = environment(x))) nn <- length(xxn <- get("y", envir = environment(x))) i1 <- 1L:min(3L, nc) i2 <- if (nc >= 4L) max(4L, nc - 1L):nc else integer(0) i3 <- 1L:min(3L, nn) i4 <- if (nn >= 4L) max(4L, nn - 1L):nn else integer(0) cat(" x = ", numform(xxc[i1]), if (nc > 3L) ", ", if (nc > 5L) " ..., ", numform(xxc[i2]), "\n", sep = "") cat(" F(x) = ", numform(xxn[i3]), if (nn > 3L) ", ", if (nn > 5L) " ..., ", numform(xxn[i4]), "\n", sep = "") invisible(x) } ### Essentially identical to stats:::summary.ecdf. summary.ogive <- function (object, ...) { n <- length(eval(expression(x), envir = environment(object))) header <- paste("Ogive: ", n, "unique values with summary\n") structure(summary(knots(object), ...), header = header, class = "summary.ogive") } ### Identical to stats:::print.summary.ecdf. print.summary.ogive <- function(x, ...) { cat(attr(x, "header")) y <- x; attr(y, "header") <- NULL; class(y) <- "summaryDefault" print(y, ...) invisible(x) } ### Identical to stats:::knots.stepfun. knots.ogive <- function(Fn, ...) eval(expression(x), envir = environment(Fn)) plot.ogive <- function(x, main = NULL, xlab = "x", ylab = "F(x)", ...) { if (missing(main)) main <- { cl <- attr(x, "call") deparse(if (!is.null(cl)) cl else sys.call()) } kn <- knots(x) Fn <- x(kn) plot(kn, Fn, ..., type = "o", pch = 16, main = main, xlab = xlab, ylab = ylab) } actuar/R/ZeroModifiedLogarithmic.R0000644000176200001440000000167114264305077016635 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,r}zmlogarithmic functions to compute ### characteristics of the zero modified logarithmic distribution. See ### ./Logarithmic.R for details on the parametrization. ### ### See p. 93 of Klugman, Panjer & Willmot, Loss Models, Fourth ### Edition, Wiley, 2012. ### ### AUTHOR: Vincent Goulet dzmlogarithmic <- function(x, prob, p0, log = FALSE) .External(C_actuar_do_dpq, "dzmlogarithmic", x, prob, p0, log) pzmlogarithmic <- function(q, prob, p0, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pzmlogarithmic", q, prob, p0, lower.tail, log.p) qzmlogarithmic <- function(p, prob, p0, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qzmlogarithmic", p, prob, p0, lower.tail, log.p) rzmlogarithmic <- function(n, prob, p0) .External(C_actuar_do_random, "rzmlogarithmic", n, prob, p0) actuar/R/ruin.R0000644000176200001440000002641014370340204013032 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Calulation of infinite time ruin probabilities in the models of ### Cramer-Lundberg and Sparre Andersen. In general, one has ### ### psi(u) = pphtype(u, pi, Q, lower.tail = FALSE) ### ### for definitions of pi and Q that depend on the severity and waiting ### times models. An explicit solution exists when both severity and ### waiting times are exponential (no mixture). ### ### _Combinations_ of exponentials as defined in Dufresne & Gerber ### (1988) are NOT supported. ### ### References: ### ### Dufresne, F. and Gerber, H. U. (1988), "Three methods to calculate ### the probability of ruin", Astin Bulletin 19, p. 71-90. ### ### Asmussen, S. and Rolski, T. (1991), "Computational methods in risk ### theory: A matrix-algorithmic approach", Insurance: Mathematics and ### Economics 10, p. 259-274. ### ### AUTHORS: Christophe Dutang, Vincent Goulet ruin <- function(claims = c("exponential", "Erlang", "phase-type"), par.claims, wait = c("exponential", "Erlang", "phase-type"), par.wait, premium.rate = 1, tol = sqrt(.Machine$double.eps), maxit = 200L, echo = FALSE) { ## Sanity checks if (missing(par.claims) || !is.list(par.claims)) stop(sprintf("%s must be a named list", sQuote("par.claims"))) if (missing(par.wait) || !is.list(par.wait)) stop(sprintf("%s must be a named list", sQuote("par.wait"))) claims <- match.arg(claims) wait <- match.arg(wait) ## ============================================== ## Extraction of the claims severity parameters choices <- switch(claims, exponential = c("rate", "weights"), Erlang = c("shape", "rate", "scale", "weights"), "phase-type" = c("prob", "rates")) i <- pmatch(names(par.claims), choices, nomatch = 0L, duplicates.ok = TRUE) if (all(i == 0L)) stop(sprintf("parameters %s missing in %s", paste(dQuote(choices), collapse = ", "), sQuote("par.claims"))) par.claims <- par.claims[i > 0L] # keep relevant components p <- choices[i[i > 0L]] # keep relevant names names(par.claims) <- p # use full names if (claims == "exponential") { if ("rate" %in% p) rate <- par.claims$rate else stop(sprintf("parameter %s missing in %s", dQuote("rate"), sQuote("par.claims"))) n <- length(rate) if ("weights" %in% p && n > 1L) prob <- rep(par.claims$weights, length.out = n) else if (n == 1L) prob <- 1 else stop(sprintf("parameter %s missing in %s", dQuote("weights"), sQuote("par.claims"))) rates <- diag(-rate, n) } else if (claims == "Erlang") { if ("shape" %in% p) shape <- par.claims$shape else stop(sprintf("parameter %s missing in %s", dQuote("shape"), sQuote("par.claims"))) if ("rate" %in% p) rate <- par.claims$rate else if ("scale" %in% p) rate <- 1 / par.claims$scale else stop(sprintf("parameter %s or %s missing in %s", dQuote("rate"), dQuote("scale"), sQuote("par.claims"))) if (length(shape) < length(rate)) shape <- rep(shape, length.out = length(rate)) else rate <- rep(rate, length.out = length(shape)) n <- sum(shape) if ("weights" %in% p && length(shape) > 1L) { prob <- numeric(n) prob[cumsum(c(1, head(shape, -1)))] <- par.claims$weights } else if (length(shape) == 1L) prob <- c(1, rep(0, n - 1)) else stop(sprintf("parameter %s missing in %s", dQuote("weights"), sQuote("par.claims"))) rates <- diag(rep(-rate, shape), n) if (n > 1 && shape > 1) { tmp <- -head(diag(rates), -1L) tmp[cumsum(head(shape, -1L))] <- 0 # insert 0s in "ll corners" rates[cbind(seq_len(n - 1), seq(2, len = n - 1))] <- tmp } } else # claims == "phase-type" { if ("prob" %in% p) prob <- par.claims$prob else stop(sprintf("parameter %s missing in %s", dQuote("prob"), sQuote("par.claims"))) if ("rates" %in% p) rates <- par.claims$rates else stop(sprintf("parameter %s missing in %s", dQuote("rates"), sQuote("par.claims"))) n <- length(prob) if (!(is.matrix(rates) && nrow(rates) == n)) stop(sprintf("invalid parameters in %s", sQuote("par.claims"))) } ## ============================================== ## ================================================= ## Extraction of the interarrival times parameters choices <- switch(wait, exponential = c("rate", "weights"), Erlang = c("shape", "rate", "scale", "weights"), "phase-type" = c("prob", "rates")) i <- pmatch(names(par.wait), choices, nomatch = 0L, duplicates.ok = TRUE) if (all(i == 0L)) stop(sprintf("parameters %s missing in %s", paste(dQuote(choices), collapse = ", "), sQuote("par.wait"))) par.wait <- par.wait[i > 0L] # keep relevant components p <- choices[i[i > 0L]] # keep relevant names names(par.wait) <- p # use full names if (wait == "exponential") { if ("rate" %in% p) rate <- par.wait$rate else stop(sprintf("parameter %s missing in %s", dQuote("rate"), sQuote("par.wait"))) m <- length(rate) if ("weights" %in% p && m > 1L) prob.w <- rep(par.wait$weights, length.out = m) else if (m == 1L) prob.w <- 1 else stop(sprintf("parameter %s missing in %s", dQuote("weights"), sQuote("par.wait"))) rates.w <- diag(-rate, m) } else if (wait == "Erlang") { if ("shape" %in% p) shape <- par.wait$shape else stop(sprintf("parameter %s missing in %s", dQuote("shape"), sQuote("par.wait"))) if ("rate" %in% p) rate <- par.wait$rate else if ("scale" %in% p) rate <- 1 / par.wait$scale else stop(sprintf("parameter %s or %s missing in %s", dQuote("rate"), dQuote("scale"), sQuote("par.wait"))) if (length(shape) < length(rate)) shape <- rep(shape, length.out = length(rate)) else rate <- rep(rate, length.out = length(shape)) m <- sum(shape) if ("weights" %in% p && length(shape) > 1L) { prob.w <- numeric(sum(shape)) prob.w[cumsum(c(1, head(shape, -1L)))] <- par.wait$weights } else if (length(shape) == 1L) prob.w <- c(1, rep(0, m - 1)) else stop(sprintf("parameter %s missing in %s", dQuote("weights"), sQuote("par.wait"))) rates.w <- diag(rep(-rate, shape), m) if (m > 1 && shape > 1) { tmp <- -head(diag(rates.w), -1L) tmp[cumsum(head(shape, -1L))] <- 0 # insert 0s in "ll corners" rates.w[cbind(seq_len(m - 1), seq(2, len = m - 1))] <- tmp } } else # wait == "phase-type" { if ("prob" %in% p) prob.w <- par.wait$prob else stop(sprintf("parameter %s missing in %s", dQuote("prob"), sQuote("par.wait"))) if ("rates" %in% p) rates.w <- par.wait$rates else stop(sprintf("parameter %s missing in %s", dQuote("rates"), sQuote("par.wait"))) m <- length(prob.w) if (!(is.matrix(rates.w) && nrow(rates.w) == m)) stop(sprintf("invalid parameters in %s", sQuote("par.wait"))) } ## ================================================= ## Empty definition of the output function. The body is set later. FUN <- function(u, survival = FALSE, lower.tail = !survival) {} ## Cramer-Lundberg model if (wait == "exponential" && m == 1L) { ## Special case with an explicit solution if (claims == "exponential" && n == 1L) { lambda <- -drop(rates.w) / premium.rate body(FUN) <- substitute({res <- a * exp(-(b) * u); if (lower.tail) res else 0.5 - res + 0.5}, list(a = -lambda/drop(rates), b = -drop(rates) - lambda)) environment(FUN) <- new.env() # new, empty environment class(FUN) <- c("ruin", class(FUN)) return(FUN) } ## Use phase-type representation for all other claim severity models. pi <- drop(rates.w) * prob %*% solve(rates) / premium.rate Q <- rates - rowSums(rates) %*% pi } ## Sparre Andersen model (interarrival times other than single exponential) else { ## Matrix Q is a "fixed point" of some function (Asmussen & ## Rolski, 1992, p. 265-266). Many elements of this function ## never change, hence they are computed once and for all ## here. In <- diag(n) # n x n identity matrix Im <- diag(m) # m x m identity matrix t0pi <- -rowSums(rates) %o% prob # "multiple" of A(Q) A <- In %x% rbind(prob.w) # first term of A(Q) B <- In %x% rates.w # rhs of the Kronecker sum C <- In %x% -rowSums(rates.w) # third term of A(Q) if (echo) { cat("Iteration\tMatrix Q (column major order)\n") exp <- expression(cat(" ", count, "\t\t ", Q1 <- Q, fill = TRUE)) } else exp <- expression(Q1 <- Q) Q <- rates count <- 0L repeat { eval(exp) if (maxit < (count <- count + 1L)) { warning("maximum number of iterations reached before obtaining convergence") break } Q1 <- Q Q <- rates - t0pi %*% A %*% solve(Q %x% Im + B, C) if (max(rowSums(abs(Q - Q1))) < tol) break } pi <- colSums(Q - rates) / (-sum(rates) * premium.rate) } ## Compute the probability of ruin using the cdf of a phase-type ## distribution with parameters pi and Q. body(FUN) <- substitute(pphtype(u, a, b, lower.tail = !lower.tail), list(a = pi, b = Q)) environment(FUN) <- new.env() # new, empty environment class(FUN) <- c("ruin", class(FUN)) FUN } plot.ruin <- function(x, from = NULL, to = NULL, add = FALSE, xlab = "u", ylab = expression(psi(u)), main = "Probability of Ruin", xlim = NULL, ...) curve(x, from = from, to = to, add = add, xlab = xlab, ylab = ylab, main = main, xlim = xlim, ...) actuar/R/normal.R0000644000176200001440000000301214264305077013351 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Normal and Normal Power Approximation of the total amount of ### claims distribution ### ### See Dayken, Pentikanen and Pesonen, Practical Risk Theory for ### Actuaries, Chapman & Hall, 1994. ### ### AUTHORS: Vincent Goulet ### and Louis-Philippe Pouliot normal <- function(mean, variance) { ## Approximate the total amount of claims distribution using the first ## two moments. FUN <- function(x) pnorm(x, mean = mean, sd = sqrt(variance)) environment(FUN) <- new.env() assign("mean", mean, envir = environment(FUN)) assign("variance", variance, envir = environment(FUN)) attr(FUN, "source") <- "function(x) pnorm(x, mean = mean, sd = sqrt(variance))" FUN } npower <- function(mean, variance, skewness) { ## Approximate the total amount of claims distribution using the first ## three moments. FUN <- function(x) ifelse(x <= mean, NA, pnorm(sqrt(1 + 9/skewness^2 + 6 * (x - mean)/(sqrt(variance) * skewness)) - 3/skewness)) environment(FUN) <- new.env() assign("mean", mean, envir = environment(FUN)) assign("variance", variance, envir = environment(FUN)) assign("skewness", skewness, envir = environment(FUN)) attr(FUN, "source") <- "function(x) ifelse(x <= mean, NA, pnorm(sqrt(1 + 9/skewness^2 + 6 * (x - mean)/(sqrt(variance) * skewness)) - 3/skewness))" FUN } actuar/R/ZeroTruncatedPoisson.R0000644000176200001440000000161514264305077016234 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r}ztpois functions to compute ### characteristics of the Zero Truncated Poisson distribution. ### ### See Appendix B of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHOR: Vincent Goulet dztpois <- function (x, lambda, log = FALSE) .External(C_actuar_do_dpq, "dztpois", x, lambda, log) pztpois <- function(q, lambda, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pztpois", q, lambda, lower.tail, log.p) qztpois <- function(p, lambda, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qztpois", p, lambda, lower.tail, log.p) rztpois <- function(n, lambda) .External(C_actuar_do_random, "rztpois", n, lambda) ## not exported; for internal use in panjer() pgfztpois <- function(x, lambda) expm1(lambda * x)/expm1(lambda) actuar/R/ZeroTruncatedBinomial.R0000644000176200001440000000200614264305077016327 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r}ztbinom functions to compute ### characteristics of the Zero Truncated Binomial distribution. ### ### See Appendix B of Klugman, Panjer & Willmot, Loss Models, Second ### Edition, Wiley, 2004. ### ### AUTHOR: Vincent Goulet dztbinom <- function (x, size, prob, log = FALSE) .External(C_actuar_do_dpq, "dztbinom", x, size, prob, log) pztbinom <- function(q, size, prob, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pztbinom", q, size, prob, lower.tail, log.p) qztbinom <- function(p, size, prob, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qztbinom", p, size, prob, lower.tail, log.p) rztbinom <- function(n, size, prob) .External(C_actuar_do_random, "rztbinom", n, size, prob) ## not exported; for internal use in panjer() pgfztbinom <- function(x, size, prob) { qn <- (1 - prob)^size (exp(size * log1p(prob * (x - 1))) - qn)/(1 - qn) } actuar/R/hierarc.R0000644000176200001440000003213514264305077013506 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Hierarchical credibility model calculations ### ### AUTHORS: Vincent Goulet , ### Louis-Philippe Pouliot, Tommy Ouellet. hierarc <- function(ratios, weights, classification, method = c("Buhlmann-Gisler", "Ohlsson", "iterative"), tol = sqrt(.Machine$double.eps), maxit = 100, echo = FALSE) { ## === HANDS ON THE DATA === ## ## Arguments 'ratios' and 'weights' must be matrices of real ## numbers, whereas 'classification' must be a matrix of integers ## giving the affiliation of each entity in the portfolio. nlevels <- ncol(classification) # number of levels nlevels1p <- nlevels + 1L # frequently used ## To symmetrize further calculations, bind a column of ones ## representing the affiliation to the global portfolio. classification <- cbind(pf = 1L, classification) ## If weights are not specified, use equal weights. if (missing(weights)) { if (any(is.na(ratios))) stop("missing ratios not allowed when weights are not supplied") array(1, dim(ratios)) # matrix of ones } ## Sanity check if weights and ratios correspond. if (!identical(which(is.na(ratios)), which(is.na(weights)))) stop("missing values are not in the same positions in 'weights' and in 'ratios'") ## === NUMBER OF NODES AND SPLITTING FACTORS === ## ## Future computation of per level summaries will require a set of ## factors based on the number of nodes in each level. An example ## will best explain what is achieved here: suppose there are two ## sectors; sector 1 has 3 units; sector 2 has 2 units. To make ## per sector summaries, the following factors can be used to ## split the unit data: 1 1 1 2 2. ## ## Generating such factors first requires to know the number of ## nodes at each level in a format identical to the 'nodes' ## argument of simul(). [In the previous example, the number of ## nodes would be 'list(2, c(3, 2))'.] Then, the factors are ## obtained by repeating a sequence the same length as the number ## of nodes at one level [2] according to the number of nodes at ## the level below [c(3, 2)]. ## ## 0. Initialization fnodes <- nnodes <- vector("list", nlevels) ## 1. Calculation of the number of nodes: the main idea is to ## create a unique factor for each node using interaction() ## recursively on the columns of 'classification'. We can do ## something simpler for the lowest level (the entities), since we ## know the combinations of indexes to all be different at this ## level. fx <- vector("list", nlevels1p) fx[[nlevels1p]] <- factor(classification[, nlevels1p]) # entity level for (i in nlevels:1L) { ## Function 'interaction' expects its arguments separately or ## as a list, hence the lapply() below. fx[[i]] <- as.integer(interaction(lapply(seq.int(i), function(j) classification[, j]), drop = TRUE)) ## 'as.vector' below is used to get rid of names nnodes[[i]] <- as.vector(sapply(split(fx[[i + 1]], fx[[i]]), function(x) length(unique(x)))) } ## 2. Generation of the factors. Following the rule described ## above, this could simply be ## ## fnodes <- lapply(nnodes, function(x) rep(seq_along(x), x)) ## ## However, this will not work if rows of data are not sorted per ## level. (In the example above, if the data of unit 3 of sector 1 ## is at the bottom of the matrix of data, then the factors need ## to be 1 1 2 2 1.) ## ## The solution is actually simple: converting the entity level ## factors ('fx[[nlevels]]') to integers will assure that any ## summary made using these factors will be sorted. This done, it ## is possible to use the command above for the upper levels. fnodes[[nlevels]] <- as.integer(fx[[nlevels]]) fnodes[-nlevels] <- lapply(nnodes[-nlevels], function(x) rep(seq_along(x), x)) ## === PER ENTITY SUMMARIES === ## ## Individual weighted averages. It could happen that an entity ## has no observations, for example when applying the model on ## claim amounts. In such a situation, put the total weight of the ## entity and the weighted average both equal to zero. That way, ## the premium will be equal to the credibility weighted average, ## as it should, but the entity will otherwise have no ## contribution in the calculations. weights.s <- rowSums(weights, na.rm = TRUE) ratios.w <- ifelse(weights.s > 0, rowSums(weights * ratios, na.rm = TRUE) / weights.s, 0) ## === EFFECTIVE NUMBER OF NODES === ## ## Given the possibility to have whole levels with no data, as ## explained above, it is necessary to count the *effective* ## number of nodes in each level, that is the number of nodes with ## data. This comes this late since it relies on 'weights.s'. ## ## Object 'eff.nnodes' is in every respect equivalent to 'nnodes' ## except that each element of the list is a vector of the number of ## non "empty" nodes for each classification of the level ## above. eff.nnodes <- vector("list", nlevels) w <- weights.s for (i in nlevels:1L) { eff.nnodes[[i]] <- tapply(w, fnodes[[i]], function(x) sum(x > 0)) w <- tapply(w, fnodes[[i]], sum) # running totals } ## === DENOMINATORS OF VARIANCE ESTIMATORS === ## ## The denominators for all the variance estimators never ## change. The denominator at one level is equal to the total ## number of nodes at that level minus the total number of nodes ## at the level above. At the lowest level (the denominator of ## s^2), this is ## ## number of (non NA) ratios - (effective) number of entities. ## ## The number of (non missing) ratios is not included in ## 'eff.nnodes'. For the portfolio level, the denominator is ## ## (effective) number of "sectors" - 1 ## ## The 1 neither is included in 'eff.nnodes'. denoms <- diff(c(1L, sapply(eff.nnodes, sum), sum(!is.na(ratios)))) ## Final sanity checks if (any(!denoms)) stop("there must be at least two nodes at every level") if (ncol(ratios) < 2L) stop("there must be at least one node with more than one period of experience") ## === ESTIMATION OF s^2 === s2 <- sum(weights * (ratios - ratios.w)^2, na.rm = TRUE) / denoms[nlevels1p] ## === ESTIMATION OF THE OTHER VARIANCE COMPONENTS === ## ## Create vectors to hold values to be computed at each level ## (from portfolio to entity), namely: the total node weights, the ## node weighted averages, the between variances and the node ## credibility factors. ## ## Only credibility factors are not computed for the portfolio ## level, hence this list is one shorter than the others. tweights <- vector("list", nlevels1p) # total level weights wmeans <- vector("list", nlevels1p) # weighted averages b <- c(numeric(nlevels), s2) # variance estimators cred <- vector("list", nlevels) # credibility factors ## Values already computed at the entity level. tweights[[nlevels1p]] <- as.vector(weights.s); wmeans[[nlevels1p]] <- as.vector(ratios.w); ## The unbiased variance estimators are evaluated first as they will ## be used as starting values for the iterative part below. ## ## At the entity level: node weight is given by the natural ## weight, weighted averages use the natural weights. ## ## Level above the entity: node weight is the sum of the natural ## weights at the level below, weighted averages use the natural ## weights. ## ## All upper levels: node weight is the sum of the credibility ## factors at the level below, weighted averages use credibility ## factors from previous level. ## ## Buhlmann-Gisler estimators truncate the per node variance ## estimates to 0 before taking the mean, whereas the Ohlsson ## estimators do not make any truncation. method <- match.arg(method) if (method == "Buhlmann-Gisler") bexp <- expression(b[i] <- mean(pmax(ifelse(ci != 0, bi/ci, 0), 0), na.rm = TRUE)) else # Ohlsson bexp <- expression(b[i] <- sum(bi, na.rm = TRUE) / sum(ci, na.rm = TRUE)) for (i in nlevels:1L) { ## Total weight of the level as per the rule above. tweights[[i]] <- as.vector(tapply(tweights[[i + 1L]], fnodes[[i]], sum)) ## Calculation of the weighted averages of the level. Before ## the between variance is estimated, these use the total ## weights calculated above. wmeans[[i]] <- ifelse(tweights[[i]] > 0, as.vector(tapply(tweights[[i + 1L]] * wmeans[[i + 1L]], fnodes[[i]], sum) / tweights[[i]]), 0) ## Latest non-zero between variance estimate -- the one used ## in the estimator and in the credibility factors. between <- b[b != 0][1L] ## Calculation of the per node variance estimate. bi <- as.vector(tapply(tweights[[i + 1L]] * (wmeans[[i + 1L]] - wmeans[[i]][fnodes[[i]]])^2, fnodes[[i]], sum)) - (eff.nnodes[[i]] - 1) * between ci <- tweights[[i]] - as.vector(tapply(tweights[[i + 1L]]^2, fnodes[[i]], sum)) / tweights[[i]] ## The final estimate is the average of all the per node estimates. eval(bexp) ## Calculation of the credibility factors. If these are ## non-zero, the total weights for the current level are ## replaced by the sum of the credibility factors and the ## weighted averages are recomputed with these new weights. #if (max(bu[i], 0)) # don't compute negative factors! if (b[i]) { cred[[i]] <- 1/(1 + between/(b[i] * tweights[[i + 1L]])) tweights[[i]] <- as.vector(tapply(cred[[i]], fnodes[[i]], sum)) wmeans[[i]] <- ifelse(tweights[[i]] > 0, as.vector(tapply(cred[[i]] * wmeans[[i + 1L]], fnodes[[i]], sum) / tweights[[i]]), 0) } else cred[[i]] <- numeric(sum(nnodes[[i]])) } ## Iterative estimation of the structure parameters. ## ## At the entity level: total weight is the sum of the natural ## weights, weighted averages use the natural weights and between ## variance is s^2. ## ## All upper levels: total weight is the sum of the credibility ## factors of the level below, weighted averages use credibility ## factors, between variance estimated recursively and credibility ## factor use total weight of the level, between variance of the ## level below (hence the within variance) and between variance of ## the current level. if (method == "iterative") { b <- pmax(b, 0) # truncation for starting values if (any(head(b, -1L) > 0)) # at least one non-zero starting value .External(C_actuar_do_hierarc, cred, tweights, wmeans, fnodes, denoms, b, tol, maxit, echo) } ## Results structure(list(means = wmeans, weights = tweights, unbiased = if (method != "iterative") b, iterative = if (method == "iterative") b, cred = cred, nodes = nnodes, classification = classification[, -1L], ordering = fnodes), class = "hierarc", model = "hierarchical") } predict.hierarc <- function(object, levels = NULL, newdata, ...) { ## The credibility premium of a node at one level is equal to ## ## p + z * (m - p) ## ## where 'p' is the credibility premium of the level above (or the ## collective premium for the portfolio), 'z' is the credibility ## factor of the node, and 'm' is the weighted average of the ## node. fnodes <- object$ordering cred <- object$cred means <- object$means nlevels <- length(object$nodes) level.names <- names(object$nodes) if (is.null(levels)) levels <- seq_len(nlevels) if (any(is.na(levels)) || !is.numeric(levels)) stop("invalid level number") n <- max(levels) res <- vector("list", n) ## First level credibility premiums res[[1L]] <- means[[1L]] + cred[[1L]] * (means[[2L]] - means[[1L]]) for (i in seq(2, length.out = n - 1)) { p <- res[[i - 1]][fnodes[[i]]] res[[i]] <- p + cred[[i]] * (means[[i + 1]] - p) } structure(res[levels], names = level.names[levels], ...) } actuar/R/aggregateDist.R0000644000176200001440000002065214370340204014631 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Use one of five methods to compute the aggregate claim amount ### distribution of a portfolio over a period given a frequency and a ### severity model or the true moments of the distribution. ### ### AUTHORS: Vincent Goulet , ### Louis-Philippe Pouliot aggregateDist <- function(method = c("recursive", "convolution", "normal", "npower", "simulation"), model.freq = NULL, model.sev = NULL, p0 = NULL, x.scale = 1, convolve = 0, moments, nb.simul, ..., tol = 1e-06, maxit = 500, echo = FALSE) { Call <- match.call() ## The method used essentially tells which function should be ## called for the calculation of the aggregate claims ## distribution. method <- match.arg(method) if (method == "normal") { ## An error message is issued if the number of moments listed ## is not appropriate for the method. However it is the user's ## responsability to list the moments in the correct order ## since the vector is not required to be named. if (missing(moments) || length(moments) < 2) stop(sprintf("%s must supply the mean and variance of the distribution", sQuote("moments"))) FUN <- normal(moments[1], moments[2]) comment(FUN) <- "Normal approximation" } else if (method == "npower") { if (missing(moments) || length(moments) < 3) stop(sprintf("%s must supply the mean, variance and skewness of the distribution", sQuote("moments"))) FUN <- npower(moments[1], moments[2], moments[3]) comment(FUN) <- "Normal Power approximation" } else if (method == "simulation") { if (missing(nb.simul)) stop(sprintf("%s must supply the number of simulations", sQuote("nb.simul"))) if (is.null(names(model.freq)) && is.null(names(model.sev))) stop(sprintf("expressions in %s and %s must be named", sQuote("model.freq"), sQuote("model.sev"))) FUN <- simS(nb.simul, model.freq = model.freq, model.sev = model.sev) comment(FUN) <- "Approximation by simulation" } else { ## "recursive" and "convolution" cases. Both require a ## discrete distribution of claim amounts, that is a vector of ## probabilities in argument 'model.sev'. if (!is.numeric(model.sev)) stop(sprintf("%s must be a vector of probabilities", sQuote("model.sev"))) ## Recursive method uses a model for the frequency distribution. if (method == "recursive") { if (is.null(model.freq) || !is.character(model.freq)) stop("frequency distribution must be supplied as a character string") dist <- match.arg(tolower(model.freq), c("poisson", "geometric", "negative binomial", "binomial", "logarithmic", "zero-truncated poisson", "zero-truncated geometric", "zero-truncated negative binomial", "zero-truncated binomial", "zero-modified logarithmic", "zero-modified poisson", "zero-modified geometric", "zero-modified negative binomial", "zero-modified binomial")) FUN <- panjer(fx = model.sev, dist = dist, p0 = p0, x.scale = x.scale, ..., convolve = convolve, tol = tol, maxit = maxit, echo = echo) comment(FUN) <- "Recursive method approximation" } ## Convolution method requires a vector of probabilites in ## argument 'model.freq'. else if (method == "convolution") { if (!is.numeric(model.freq)) stop(sprintf("%s must be a vector of probabilities", sQuote("model.freq"))) FUN <- exact(fx = model.sev, pn = model.freq, x.scale = x.scale) comment(FUN) <- "Exact calculation (convolutions)" } else stop("internal error") } ## Return cumulative distribution function class(FUN) <- c("aggregateDist", class(FUN)) attr(FUN, "call") <- Call FUN } print.aggregateDist <- function(x, ...) { cat("\nAggregate Claim Amount Distribution\n") cat(" ", label <- comment(x), "\n\n", sep = "") cat("Call:\n") print(attr(x, "call"), ...) cat("\n") if (label %in% c("Exact calculation (convolutions)", "Recursive method approximation", "Approximation by simulation")) { n <- length(get("x", envir = environment(x))) cat("Data: (", n, "obs. )\n") numform <- function(x) paste(formatC(x, digits = 4, width = 5), collapse = ", ") i1 <- 1L:min(3L, n) i2 <- if (n >= 4L) max(4L, n - 1L):n else integer() xx <- eval(expression(x), envir = environment(x)) cat(" x[1:", n, "] = ", numform(xx[i1]), if (n > 3L) ", ", if (n > 5L) " ..., ", numform(xx[i2]), "\n", sep = "") cat("\n") } if (label %in% c("Normal approximation", "Normal Power approximation")) cat(attr(x, "source"), "\n") invisible(x) } plot.aggregateDist <- function(x, xlim, ylab = expression(F[S](x)), main = "Aggregate Claim Amount Distribution", sub = comment(x), ...) { ## Function plot() is used for the step cdfs and function curve() ## in the continuous cases. if ("stepfun" %in% class(x)) { ## Method for class 'ecdf' will most probably be used. NextMethod(main = main, ylab = ylab, ...) } else { ## Limits for the x-axis are supplied if none are given ## in argument. if (missing(xlim)) { mean <- get("mean", envir = environment(x)) sd <- sqrt(get("variance", envir = environment(x))) xlim <- c(mean - 3 * sd, mean + 3 * sd) } curve(x, main = main, ylab = ylab, xlim = xlim, ylim = c(0, 1), ...) } mtext(sub, line = 0.5) } summary.aggregateDist <- function(object, ...) structure(object, class = c("summary.aggregateDist", class(object)), ...) print.summary.aggregateDist <- function(x, ...) { cat(ifelse(comment(x) %in% c("Normal approximation", "Normal Power approximation"), "Aggregate Claim Amount CDF:\n", "Aggregate Claim Amount Empirical CDF:\n")) q <- quantile(x, p = c(0.25, 0.5, 0.75)) expectation <- mean(x) if (comment(x) %in% c("Normal approximation", "Normal Power approximation")) { min <- 0 max <- NA } else { max <- tail(eval(expression(x), environment(x)), 1) min <- head(eval(expression(x), environment(x)), 1) } res <- c(min, q[c(1, 2)], expectation, q[3], max) names(res) <- c("Min.", "1st Qu.", "Median", "Mean", "3rd Qu.", "Max.") print(res, ...) invisible(x) } mean.aggregateDist <- function(x, ...) { label <- comment(x) ## Simply return the value of the true mean given in argument in ## the case of the Normal and Normal Power approximations. if (label %in% c("Normal approximation", "Normal Power approximation")) return(get("mean", envir = environment(x))) ## For the recursive, exact and simulation methods, compute the ## mean from the stepwise cdf using the pmf saved in the ## environment of the object. drop(crossprod(get("x", envir = environment(x)), get("fs", envir = environment(x)))) } diff.aggregateDist <- function(x, ...) { label <- comment(x) ## The 'diff' method is defined for the recursive, exact and ## simulation methods only. if (label == "Normal approximation" || label == "Normal Power approximation") stop("function not defined for approximating distributions") ## The probability vector is already stored in the environment of ## the "aggregateDist" object. get("fs", environment(x)) } actuar/R/hache.origin.R0000644000176200001440000001334314264305077014427 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Auxiliary function to fit regression credibility model using the ### original Hachemeister model. ### ### AUTHORS: Tommy Ouellet, Vincent Goulet ### codetools does not like the way 'coll1' is defined in ### 'hache.origin' below. Avoid false positive in R CMD check. if (getRversion() >= "2.15.1") utils::globalVariables(c("coll1")) hache.origin <- function(ratios, weights, xreg, tol, maxit, echo) { ## Frequently used values weights.s <- rowSums(weights, na.rm = TRUE) # contract total weights has.data <- which(weights.s > 0) # contracts with data ncontracts <- nrow(ratios) # number of contracts eff.ncontracts <- length(has.data) # effective number of contracts p <- ncol(xreg) # rank (>= 2) of design matrix n <- nrow(xreg) # number of observations ## Fit linear model to each contract. For contracts without data, ## fit some sort of empty model to ease use in predict.hache(). f <- function(i) { z <- if (i %in% has.data) # contract with data { y <- ratios[i, ] not.na <- !is.na(y) lm.wfit(xreg[not.na, , drop = FALSE], y[not.na], weights[i, not.na]) } else # contract without data lm.fit(xreg, rep.int(0, n)) z[c("coefficients", "residuals", "weights", "rank", "qr")] } fits <- lapply(seq_len(ncontracts), f) ## Individual regression coefficients ind <- sapply(fits, coef) ind[is.na(ind)] <- 0 ## Individual variance estimators. The contribution of contracts ## without data is 0. S <- function(z) # from stats::summary.lm { nQr <- NROW(z$qr$qr) r1 <- z$rank r <- z$residuals w <- z$weights sum(w * r^2) / (nQr - r1) } sigma2 <- sapply(fits[has.data], S) sigma2[is.nan(sigma2)] <- 0 ## Initialization of a few containers: p x p x ncontracts arrays ## for the weight and credibility matrices; p x p matrices for the ## between variance-covariance matrix and total credibility ## matrix. cred <- W <- array(0, c(p, p, ncontracts)) A <- cred.s <- matrix(0, p, p) ## Weight matrices: we use directly (X'WX)^{-1}. This is quite ## different from hache.barycenter(). V <- function(z) # from stats::summary.lm { r1 <- z$rank if (r1 == 1L) diag(as.double(chol2inv(z$qr$qr[1L, 1L, drop = FALSE])), p) else chol2inv(z$qr$qr[1L:r1, 1L:r1, drop = FALSE]) } W[, , has.data] <- sapply(fits[has.data], V) ## Starting credibility matrices and collective regression ## coefficients. cred[, , has.data] <- diag(p) # identity matrices coll <- rowSums(ind) / eff.ncontracts # coherent with above ## === ESTIMATION OF WITHIN VARIANCE === s2 <- mean(sigma2) ## === ESTIMATION OF THE BETWEEN VARIANCE-COVARIANCE MATRIX === ## ## This is an iterative procedure similar to the Bischel-Straub ## estimator. Following Goovaerts & Hoogstad, stopping criterion ## is based in the collective regression coefficients estimates. ## ## If printing of iterations was asked for, start by printing a ## header and the starting values. if (echo) { cat("Iteration\tCollective regression coefficients\n") exp <- expression(cat(" ", count, "\t\t ", coll1 <- coll, fill = TRUE)) } else exp <- expression(coll1 <- coll) ## Iterative procedure count <- 0 repeat { eval(exp) ## Stop after 'maxit' iterations if (maxit < (count <- count + 1)) { warning("maximum number of iterations reached before obtaining convergence") break } ## Calculation of the between variance-covariance matrix. A[] <- rowSums(sapply(has.data, function(i) cred[, , i] %*% tcrossprod(ind[, i] - coll))) / (eff.ncontracts - 1) ## Symmetrize A A <- (A + t(A))/2 ## New credibility matrices cred[, , has.data] <- sapply(has.data, function(i) A %*% solve(A + s2 * W[, , i])) ## New collective regression coefficients cred.s <- apply(cred[, , has.data], c(1L, 2L), sum) coll <- solve(cred.s, rowSums(sapply(has.data, function(i) cred[, , i] %*% ind[, i]))) ## Test for convergence if (max(abs((coll - coll1)/coll1)) < tol) break } ## Final calculation of the between variance-covariance matrix and ## credibility matrices. A[] <- rowSums(sapply(has.data, function(i) cred[, , i] %*% tcrossprod(ind[, i] - coll))) / (eff.ncontracts - 1) A <- (A + t(A))/2 cred[, , has.data] <- sapply(has.data, function(i) A %*% solve(A + s2 * W[, , i])) ## Credibility adjusted coefficients. The coefficients of the ## models are replaced with these values. That way, prediction ## will be trivial using predict.lm(). for (i in seq_len(ncontracts)) fits[[i]]$coefficients <- coll + drop(cred[, , i] %*% (ind[, i] - coll)) ## Add names to the collective coefficients vector. names(coll) <- rownames(ind) ## Results list(means = list(coll, ind), weights = list(cred.s, W), unbiased = NULL, iterative = list(A, s2), cred = cred, nodes = list(ncontracts), adj.models = fits) } actuar/R/ExponentialSupp.R0000644000176200001440000000140114264305077015217 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {m,lev,mgf}exp functions to compute raw and ### limited moments, and the moment generating function for the ### Exponential distribution (as defined in R). ### ### See Chapter 18 of Johnson & Kotz, Continuous univariate ### distributions, volume 1, Wiley, 1970 ### ### AUTHORS: Mathieu Pigeon, Christophe Dutang, ### Vincent Goulet mexp <- function(order, rate = 1) .External(C_actuar_do_dpq, "mexp", order, 1/rate, FALSE) levexp <- function(limit, rate = 1, order = 1) .External(C_actuar_do_dpq, "levexp", limit, 1/rate, order, FALSE) mgfexp <- function(t, rate = 1, log = FALSE) .External(C_actuar_do_dpq, "mgfexp", t, 1/rate, log) actuar/R/panjer.R0000644000176200001440000001345014370340204013334 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Panjer recursion formula to compute the approximate aggregate ### claim amount distribution of a portfolio over a period. ### ### AUTHORS: Vincent Goulet , ### Sebastien Auclair, Louis-Philippe Pouliot and Tommy Ouellet panjer <- function(fx, dist, p0 = NULL, x.scale = 1, ..., convolve = 0, tol = sqrt(.Machine$double.eps), maxit = 500, echo = FALSE) { ## Express 'tol' as a value close to 1. If needed, modify the ## accuracy level so that the user specified level is attained ## *after* the additional convolutions (without getting too high). tol <- if (convolve > 0) min((0.5 - tol + 0.5)^(0.5 ^ convolve), 0.5 - sqrt(.Machine$double.eps) + 0.5) else 0.5 - tol + 0.5 ## Check if p0 is a valid probability. if (!is.null(p0)) { if (length(p0) > 1L) { p0 <- p0[1L] warning(sprintf("%s has many elements: only the first used", sQuote("p0"))) } if ((p0 < 0) || (p0 > 1)) stop(sprintf("%s must be a valid probability (between 0 and 1)", sQuote("p0"))) } ## Treat trivial case where 'p0 == 1' and hence F_S(0) = 1. if (identical(p0, 1)) { FUN <- approxfun(0, 1, method = "constant", yleft = 0, yright = 1, f = 0) class(FUN) <- c("ecdf", "stepfun", class(FUN)) assign("fs", 1, envir = environment(FUN)) assign("x.scale", x.scale, envir = environment(FUN)) return(FUN) } ## The call to .External below requires 'p1' to be initialized. p1 <- 0 ## Argument '...' should contain the values of the parameters of ## 'dist'. par <- list(...) ## Distributions are expressed as a member of the (a, b, 0) or (a, ## b, 1) families of distributions. Assign parameters 'a' and 'b' ## depending of the chosen distribution and compute f_S(0) in ## every case, and p1 if p0 is specified in argument. ## ## At this point, either p0 is NULL or 0 <= p0 < 1. if (startsWith(dist, "zero-truncated")) { if (!(is.null(p0) || identical(p0, 0))) warning(sprintf("value of %s ignored with a zero-truncated distribution", sQuote("p0"))) dist <- sub("zero-truncated ", "", dist) # drop "zero truncated" prefix p0 <- 0 } if (startsWith(dist, "zero-modified")) dist <- sub("zero-modified ", "", dist) # drop "zero modified" prefix if (dist == "geometric") { dist <- "negative binomial" par$size <- 1 } if (dist == "poisson") { if (!"lambda" %in% names(par)) stop(sprintf("value of %s missing", sQuote("lambda"))) lambda <- par$lambda a <- 0 b <- lambda if (is.null(p0)) # standard Poisson fs0 <- exp(lambda * (fx[1L] - 1)) else # 0 <= p0 < 1; zero-truncated/modified Poisson { fs0 <- p0 + (1 - p0) * pgfztpois(fx[1L], lambda) p1 <- (1 - p0) * dztpois(1, lambda) } } else if (dist == "negative binomial") { if (!all(c("prob", "size") %in% names(par))) stop(sprintf("value of %s or %s missing", sQuote("prob"), sQuote("size"))) r <- par$size p <- par$prob a <- 1 - p b <- (r - 1) * a if (is.null(p0)) # standard negative binomial fs0 <- exp(-r * log1p(-a/p * (fx[1L] - 1))) else # 0 <= p0 < 1; zero-truncated/modified neg. binomial { fs0 <- p0 + (1 - p0) * pgfztnbinom(fx[1L], r, p) p1 <- (1 - p0) * dztnbinom(1, r, p) } } else if (dist == "binomial") { if (!all(c("prob", "size") %in% names(par))) stop(sprintf("value of %s or %s missing", sQuote("prob"), sQuote("size"))) n <- par$size p <- par$prob a <- p/(p - 1) # equivalent to -p/(1 - p) b <- -(n + 1) * a if (is.null(p0)) # standard binomial fs0 <- exp(n * log1p(p * (fx[1L] - 1))) else # 0 <= p0 < 1; zero-truncated/modified binomial { fs0 <- p0 + (1 - p0) * pgfztbinom(fx[1L], n, p) p1 <- (1 - p0) * dztbinom(1, n, p) } } else if (dist == "logarithmic") { if (!"prob" %in% names(par)) stop(sprintf("value of %s missing", sQuote("prob"))) a <- par$prob b <- -a if (is.null(p0) || identical(p0, 0)) # standard logarithmic fs0 <- pgflogarithmic(fx[1L], a) else # 0 < p0 < 1; zero-modified logarithmic { fs0 <- p0 + (1 - p0) * pgflogarithmic(fx[1L], a) p1 <- (1 - p0) * dlogarithmic(1, a) } } else stop("frequency distribution not in the (a, b, 0) or (a, b, 1) families") ## If fs0 is equal to zero, the recursion will not start. There is ## no provision to automatically cope with this situation in the ## current version of this function. Just issue an error message ## and let the user do the work by hand. if (identical(fs0, 0)) stop("Pr[S = 0] is numerically equal to 0; impossible to start the recursion") ## Recursive calculations in C. fs <- .External(C_actuar_do_panjer, p0, p1, fs0, fx, a, b, convolve, tol, maxit, echo) FUN <- approxfun((0:(length(fs) - 1)) * x.scale, pmin(cumsum(fs), 1), method = "constant", yleft = 0, yright = 1, f = 0, ties = "ordered") class(FUN) <- c("ecdf", "stepfun", class(FUN)) assign("fs", fs, envir = environment(FUN)) assign("x.scale", x.scale, envir = environment(FUN)) FUN } actuar/R/Loglogistic.R0000644000176200001440000000260714264305077014351 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r}llogis functions to compute ### characteristics of the loglogistic distribution. The version used ### in these functions has cumulative distribution function ### ### Pr[X <= x] = v/(1 + v), v = (x/scale)^shape, x > 0. ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet dllogis <- function (x, shape, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "dllogis", x, shape, scale, log) pllogis <- function(q, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pllogis", q, shape, scale, lower.tail, log.p) qllogis <- function(p, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qllogis", p, shape, scale, lower.tail, log.p) rllogis <- function(n, shape, rate = 1, scale = 1/rate) .External(C_actuar_do_random, "rllogis", n, shape, scale) mllogis <- function(order, shape, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "mllogis", order, shape, scale, FALSE) levllogis <- function(limit, shape, rate = 1, scale = 1/rate, order = 1) .External(C_actuar_do_dpq, "levllogis", limit, shape, scale, order, FALSE) actuar/R/bayes.R0000644000176200001440000001533114370340204013160 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Pure bayesian credibility calculations. ### ### AUTHORS: Alexandre Parent , ### Vincent Goulet bayes <- function(x, likelihood = c("poisson", "bernoulli", "geometric", "exponential", "normal", "binomial", "negative binomial", "gamma", "pareto"), shape, rate = 1, scale = 1/rate, shape1, shape2, mean = 0, sd = 1, size, shape.lik, sd.lik, min) { likelihood <- match.arg(likelihood) ## We need to treat separately the (Single Parameter, or ## Translated) Pareto/Gamma case given the different form of the ## individual mean and the "credibility factor" (which isn't one, ## really). if (likelihood == "pareto") { if (missing(min)) stop("lower bound of the likelihood missing") if (missing(shape) || (missing(rate) && missing(scale))) stop(sprintf("one of the Gamma prior parameter %s, %s or %s missing", dQuote("shape"), dQuote("rate"), dQuote("scale"))) coll <- shape * scale vars <- c(NA, NA) # not pertinent here ## Computation of individual means and credibility factors ## differs depending on the type of data provided in argument. if (is.null(x)) # no data cred <- ind.means <- n <- 0 else if (is.vector(x, mode = "numeric")) # atomic vector { n <- length(x) sumlog <- sum(log(x)) - n * log(min) ind.means <- n/sumlog cred <- 1/(1 + 1/(scale * sumlog)) } else # matrix or data frame { n <- ncol(x) sumlog <- rowSums(log(x)) - n * log(min) ind.means <- n/sumlog cred <- 1/(1 + 1/(scale * sumlog)) } } ## Now the usual linear Bayes cases. else { if (likelihood == "poisson") { if (missing(shape) || (missing(rate) && missing(scale))) stop(sprintf("one of the Gamma prior parameter %s, %s or %s missing", dQuote("shape"), dQuote("rate"), dQuote("scale"))) coll <- shape * scale vars <- c(coll * scale, coll) K <- 1/scale } else if (likelihood == "bernoulli") { if (missing(shape1) || missing(shape2)) stop(sprintf("one of the Beta prior parameter %s or %s missing", dQuote("shape1"), dQuote("shape2"))) K <- shape1 + shape2 coll <- shape1/K vars <- (shape1 * shape2) * c(1, K)/(K^2 * (K + 1)) } else if (likelihood == "binomial") { if (missing(shape1) || missing(shape2)) stop(sprintf("one of the Beta prior parameter %s or %s missing", dQuote("shape1"), dQuote("shape2"))) if (missing(size)) stop(sprintf("parameter %s of the likelihood missing", dQuote("size"))) K <- (shape1 + shape2)/size coll <- shape1/K vars <- (shape1 * shape2) * c(1, K)/(K^2 * (shape1 + shape2 + 1)) } else if (likelihood == "geometric") { if (missing(shape1) || missing(shape2)) stop(sprintf("one of the Beta prior parameter %s or %s missing", dQuote("shape1"), dQuote("shape2"))) K <- shape1 - 1 coll <- shape2/K vars <- shape2 * (shape1 + shape2 - 1)/(K * (K - 1)) vars <- c(vars/K, vars) } else if (likelihood == "negative binomial") { if (missing(shape1) || missing(shape2)) stop(sprintf("one of the Beta prior parameter %s or %s missing", dQuote("shape1"), dQuote("shape2"))) if (missing(size)) stop(sprintf("parameter %s of the likelihood missing", dQuote("size"))) K <- (shape1 - 1)/size coll <- shape2/K vars <- shape2 * (shape1 + shape2 - 1)/(K * (shape1 - 2)) vars <- c(vars/K, vars) } else if (likelihood == "exponential") { if (missing(shape) || (missing(rate) && missing(scale))) stop(sprintf("one of the Gamma prior parameter %s, %s or %s missing", dQuote("shape"), dQuote("rate"), dQuote("scale"))) K <- shape - 1 coll <- 1/(K * scale) vars <- c(coll^2, coll/scale)/(shape - 2) } else if (likelihood == "gamma") { if (missing(shape) || (missing(rate) && missing(scale))) stop(sprintf("one of the Gamma prior parameter %s, %s or %s missing", dQuote("shape"), dQuote("rate"), dQuote("scale"))) if (missing(shape.lik)) stop(sprintf("parameter %s of the likelihood missing", dQuote("shape.lik"))) K <- (shape - 1)/shape.lik coll <- 1/(K * scale) vars <- c(coll^2, coll/scale)/(shape - 2) } else if (likelihood == "normal") { if (missing(sd.lik)) stop(sprintf("parameter %s of the likelihood missing", dQuote("sd.lik"))) coll <- mean vars <- c(sd, sd.lik)^2 K <- vars[2L]/vars[1L] } else stop("unsupported likelihood") ## Computation of individual means and credibility factors ## differs depending on the type of data provided in argument. if (is.null(x)) # no data cred <- ind.means <- n <- 0 else if (is.vector(x, mode = "numeric")) # atomic vector { n <- length(x) ind.means <- mean(x) cred <- n/(n + K) } else # matrix or data frame { n <- ncol(x) ind.means <- rowMeans(x) cred <- n/(n + K) } } structure(list(means = list(coll, ind.means), weights = list(NULL, n), unbiased = vars, iterative = NULL, cred = cred, nodes = 1L), class = "bayes", model = "Linear Bayes") } ## Premium calculation is identical to the Buhlmann-Straub case; no ## need for another method. See bstraub.R for the definition. # predict.bayes <- predict.bstraub actuar/R/Pareto3.R0000644000176200001440000000265714264305077013414 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}pareto3 functions to compute ### characteristics of the Pareto (type) II distribution. The version ### used in these functions has cumulative distribution function ### ### Pr[X <= x] = v/(1 + v), x > min, ### ### where v = ((x - min)/scale)^shape. ### ### See Arnold, B. C. (2015), Pareto Distributions, Second Edition, ### CRC Press. ### ### AUTHOR: Vincent Goulet dpareto3 <- function (x, min, shape, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "dpareto3", x, min, shape, scale, log) ppareto3 <- function (q, min, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "ppareto3", q, min, shape, scale, lower.tail, log.p) qpareto3 <- function (p, min, shape, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qpareto3", p, min, shape, scale, lower.tail, log.p) rpareto3 <- function(n, min, shape, rate = 1, scale = 1/rate) .External(C_actuar_do_random, "rpareto3", n, min, shape, scale) mpareto3 <- function(order, min, shape, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "mpareto3", order, min, shape, scale, FALSE) levpareto3 <- function(limit, min, shape, rate = 1, scale = 1/rate, order = 1) .External(C_actuar_do_dpq, "levpareto3", limit, min, shape, scale, order, FALSE) actuar/R/InverseBurr.R0000644000176200001440000000311314264305077014331 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}burr functions to compute ### characteristics of the Inverse Burr distribution. The version used ### in these functions has cumulative distribution function ### ### Pr[X <= x] = (u/(1 + u))^shape1, u = (x/scale)^shape2, x > 0. ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet dinvburr <- function (x, shape1, shape2, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "dinvburr", x, shape1, shape2, scale, log) pinvburr <- function(q, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pinvburr", q, shape1, shape2, scale, lower.tail, log.p) qinvburr <- function(p, shape1, shape2, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qinvburr", p, shape1, shape2, scale, lower.tail, log.p) rinvburr <- function(n, shape1, shape2, rate = 1, scale = 1/rate) .External(C_actuar_do_random, "rinvburr", n, shape1, shape2, scale) minvburr <- function(order, shape1, shape2, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "minvburr", order, shape1, shape2, scale, FALSE) levinvburr <- function(limit, shape1, shape2, rate = 1, scale = 1/rate, order = 1) .External(C_actuar_do_dpq, "levinvburr", limit, shape1, shape2, scale, order, FALSE) actuar/R/Pareto.R0000644000176200001440000000232414264305077013320 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}pareto functions to compute ### characteristics of the Pareto distribution. The version used in ### these functions has cumulative distribution function ### ### Pr[X <= x] = 1 - (scale/(x + scale))^shape, x > 0. ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet dpareto <- function (x, shape, scale, log = FALSE) .External(C_actuar_do_dpq, "dpareto", x, shape, scale, log) ppareto <- function (q, shape, scale, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "ppareto", q, shape, scale, lower.tail, log.p) qpareto <- function (p, shape, scale, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qpareto", p, shape, scale, lower.tail, log.p) rpareto <- function(n, shape, scale) .External(C_actuar_do_random, "rpareto", n, shape, scale) mpareto <- function(order, shape, scale) .External(C_actuar_do_dpq, "mpareto", order, shape, scale, FALSE) levpareto <- function(limit, shape, scale, order = 1) .External(C_actuar_do_dpq, "levpareto", limit, shape, scale, order, FALSE) actuar/R/WeibullMoments.R0000644000176200001440000000114414264305077015033 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {m,lev}weibull functions to compute raw and ### limited moments for the Weibull distribution (as defined in R). ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet mweibull <- function(order, shape, scale = 1) .External(C_actuar_do_dpq, "mweibull", order, shape, scale, FALSE) levweibull <- function(limit, shape, scale = 1, order = 1) .External(C_actuar_do_dpq, "levweibull", limit, shape, scale, order, FALSE) actuar/R/rmixture.R0000644000176200001440000000367214522557714013760 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Simulation of discrete mixtures ### ### f(x) = p_1 f_1(x) + ... + p_n f_n(x). ### ### Uses the syntax of rcomphierarc() for model specfification. ### ### AUTHOR: Vincent Goulet rmixture <- function(n, probs, models, shuffle = TRUE) { ## Validity checks (similar to other r functions and to ## rmultinom). if (any(is.na(n)) || any(n < 0)) stop(sprintf("invalid first argument %s", sQuote("n"))) if (all(probs <= 0)) stop("no positive probabilities") if ((!is.expression(models)) || (length(models) == 0L)) stop(sprintf("invalid third argument %s", sQuote("models"))) ## Number of models in the mixture. m <- max(length(probs), length(models)) ## Number of variates to generate: 'length(n)' if length of 'n' is ## > 1, like other 'r' functions. if (length(n) > 1L) n <- length(n) ## Number of variates from each model. By definition of the ## multinomial distribution, sum(nj) == n. ## ## Note that 'rmultinom' will normalize probabilities to sum 1. nj <- rmultinom(1, size = n, prob = rep_len(probs, m)) ## Auxiliary function to generate 'n' variates from the model ## given in 'expr'. The expressions end up being evaluated three ## frames below the current one. f <- function(n, expr) { expr$n <- n eval.parent(expr, n = 3) } ## Simulate from each model the appropriate number of times and ## return result as an atomic vector. Variates are ordered by ## model: all random variates from model 1, then all random ## variates from model 2, and so on. x <- unlist(mapply(f, n = nj, expr = rep_len(models, m), SIMPLIFY = FALSE)) ## Return variates reshuffled or in the order above as per ## argument 'shuffle'. if (shuffle) x[sample.int(n)] else x } actuar/R/severity.R0000644000176200001440000000120014264305077013730 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Display all values of a matrix of vectors by 'unrolling' the ### object vertically or horizontally. ### ### AUTHORS: Louis-Philippe Pouliot, ### Vincent Goulet ### New generic severity <- function(x, ...) UseMethod("severity") ### Default method. Currently identical to 'unroll' by lack of a ### better alternative. This default method is never called in the ### package. severity.default <- function(x, bycol = FALSE, drop = TRUE, ...) { chkDots(...) # method does not use '...' unroll(x, bycol, drop) } actuar/R/hist.grouped.data.R0000644000176200001440000000431214370340204015375 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Histogram for grouped data ### ### See Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHORS: Vincent Goulet , Mathieu Pigeon hist.grouped.data <- function(x, freq = NULL, probability = !freq, density = NULL, angle = 45, col = NULL, border = NULL, main = paste("Histogram of", xname), xlim = range(x), ylim = NULL, xlab = xname, ylab, axes = TRUE, plot = TRUE, labels = FALSE, ...) { ## We keep the first frequencies column only; group boundaries are ## in the environment of 'x' y <- x[, 2L] x <- eval(expression(cj), envir = environment(x)) ## If any frequency is non finite, omit the group keep <- which(is.finite(y)) y <- y[keep] x <- x[c(1L, keep + 1L)] ## Some useful values n <- sum(y) # total number of observations h <- diff(x) # group widths dens <- y/(n * h) # group "densities" ## Cannot plot histogram with infinite group if (any(is.infinite(x))) stop("infinite group boundaries") ## The rest is taken from hist.default() xname <- paste(deparse(substitute(x), 500), collapse = "\n") equidist <- diff(range(h)) < 1e-07 * mean(h) if (is.null(freq)) { freq <- if (!missing(probability)) !as.logical(probability) else equidist } else if (!missing(probability) && any(probability == freq)) stop(sprintf("%s is an alias for %s, however they differ.", sQuote("probability"), sQuote("!freq"))) mids <- 0.5 * (x[-1L] + x[-length(x)]) r <- structure(list(breaks = x, counts = y, intensities = dens, density = dens, mids = mids, xname = xname, equidist = equidist), class = "histogram") if (plot) { plot(r, freq = freq, col = col, border = border, angle = angle, density = density, main = main, xlim = xlim, ylim = ylim, xlab = xlab, ylab = ylab, axes = axes, labels = labels, ...) invisible(r) } else r } actuar/R/rcompound.R0000644000176200001440000001053114522557714014077 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Simulation of standard, non hierarchical, compound models. Uses a ### simplified version of the syntax of 'rcomphierarc' for model ### specfification. ### ### Where 'rcomphierarc' was developed for flexibility, the functions ### therein aim at execution speed. Various algorithms were tested. ### No argument validity checks. ### ### AUTHOR: Vincent Goulet rcompound <- function(n, model.freq, model.sev, SIMPLIFY = TRUE) { ## Validity checks. if (any(is.na(n)) || any(n < 0)) stop(sprintf("invalid first argument %s", sQuote("n"))) ## Convert model expressions into language objects. cl.freq <- substitute(model.freq) cl.sev <- substitute(model.sev) ## If a model expression was actually an object containing the ## model, we need to evaluate the object to retrieve the model. ## If the resulting object is an expression object, its first ## element is the language object we are after. if (is.name(cl.freq)) { cl.freq <- eval.parent(cl.freq) if (is.expression(cl.freq)) cl.freq <- cl.freq[[1L]] } if (is.name(cl.sev)) { cl.sev <- eval.parent(cl.sev) if (is.expression(cl.sev)) cl.sev <- cl.sev[[1L]] } ## If a model expression is wrapped into 'expression' (as in ## 'rcomphierarc'), get rid of the call. if (cl.freq[[1L]] == "expression") cl.freq <- cl.freq[[-1L]] if (cl.sev[[1L]] == "expression") cl.sev <- cl.sev[[-1L]] ## Initialize the output vector. We will use the fact that 'res' ## is filled with zeros later. res <- numeric(n) ## Add the number of variates to the 'model.freq' call. cl.freq$n <- n ## Generate frequencies. N <- eval.parent(cl.freq) ## Add the number of variates to the 'model.sev' call. cl.sev$n <- sum(N) ## Generate all severities. x <- eval.parent(cl.sev) ## Create a vector that will be used as a factor to regroup ## severities for the computation of aggregate values. Idea: ## assign one integer to each frequency and repeat that integer a ## number of times equal to the frequency. For example, if the ## frequencies are (2, 0, 1, 3), then the vector will be (1, 1, 3, ## 4, 4, 4). f <- rep.int(seq_len(n), N) ## Compute aggregate values and put them in the appropriate ## positions in the output vector. The positions corresponding to ## zero frequencies are already initialized with zeros. res[which(N != 0)] <- tapply(x, f, sum) if (SIMPLIFY) res else list(aggregate = res, frequency = N, severity = x) } rcomppois <- function(n, lambda, model.sev, SIMPLIFY = TRUE) { ## Validity checks. if (any(is.na(n)) || any(n < 0)) stop(sprintf("invalid first argument %s", sQuote("n"))) if (any(lambda < 0)) stop(sprintf("invalid values in %s", sQuote("lambda"))) ## Convert model expression into language object. cl.sev <- substitute(model.sev) ## If the model expression was actually an object containing the ## model, we need to evaluate the object to retrieve the model. ## If the resulting object is an expression object, its first ## element is the language object we are after. if (is.name(cl.sev)) { cl.sev <- eval.parent(cl.sev) if (is.expression(cl.sev)) cl.sev <- cl.sev[[1L]] } ## Get rid of the eventual 'expression' call in the language ## object. if (cl.sev[[1L]] == "expression") cl.sev <- cl.sev[[-1L]] ## Initialize the output vector. res <- numeric(n) ## Generate frequencies from Poisson distribution. N <- rpois(n, lambda) ## Add the number of variates to the 'model.sev' call. cl.sev$n <- sum(N) ## Generate all severities. x <- eval.parent(cl.sev) ## Create a vector that will be used as a factor to regroup ## severities for the computation of aggregate values. (See ## comments in 'rcompound' for details.) f <- rep.int(seq_len(n), N) ## Compute aggregate values and put them in the appropriate ## positions in the output vector. res[which(N != 0)] <- tapply(x, f, sum) if (SIMPLIFY) res else list(aggregate = res, frequency = N, severity = x) } actuar/R/cm.R0000644000176200001440000003277114370340204012463 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Main interface to credibility model fitting functions. ### ### AUTHORS: Louis-Philippe Pouliot, Tommy Ouellet, ### Vincent Goulet . cm <- function(formula, data, ratios, weights, subset, regformula = NULL, regdata, adj.intercept = FALSE, method = c("Buhlmann-Gisler", "Ohlsson", "iterative"), likelihood, ..., tol = sqrt(.Machine$double.eps), maxit = 100, echo = FALSE) { Call <- match.call(expand.dots = TRUE) ## Catch the pure bayesian special case. if (formula == "bayes") { if (missing(data) || length(data) == 0L) data <- NULL res <- bayes(data, likelihood, ...) class(res) <- c("cm", class(res)) attr(res, "call") <- Call return(res) } ## === MODEL ANALYSIS === ## ## Decompose the formula giving the portfolio structure. Attribute ## "order" gives the interaction level of each term in the ## formula. In hierarchical structures, each term should represent ## a different level, hence there should not be any duplicates in ## this attribute. The column names in 'data' containing the ## portfolio structure can be obtained from the rownames of the ## matrix in attribute "factors". ## ## Note that the very last level, the data, is not taken into ## account here. tf <- terms(formula) level.numbers <- attr(tf, "order") # level IDs level.names <- rownames(attr(tf, "factors")) # level names nlevels <- length(level.names) # number of levels ## Sanity checks ## ## 1. only hierarchical interactions are allowed in 'formula'; ## 2. hierarchical regression models are not supported. ## 3. if 'ratios' is missing, all columns of 'data' are taken to ## be ratios, so 'weights' should also be missing; ## if (any(duplicated(level.numbers))) stop(sprintf("unsupported interactions in %s", sQuote("formula"))) if (nlevels > 1 && !is.null(regformula)) stop("hierarchical regression models not supported") if (missing(ratios) & !missing(weights)) stop("ratios have to be supplied if weights are") ## === DATA EXTRACTION === ## ## 'data' is split into three matrices: one for the portfolio ## structure, one for the ratios and one for the weights. They are ## obtained via calls to subset() built from this function's ## call. That way, arguments 'ratios', 'weights' and 'subset' are ## not evaluated before being passed to subset(). Argument ## matching is as follows: ## ## Argument of cm() Argument of subset() ## ================ ==================== ## data x ## ratios select ## weights select ## subset subset ## ## Positions of the arguments that will be needed. m <- match(c("data", "ratios", "weights", "subset"), names(Call), 0) ## Extraction of the portfolio structure. Arguments 'data' and ## 'subset' are passed to subset(). cl <- Call[c(1, m[c(1, 4)])] # use data and subset only cl[[1]] <- as.name("subset") # change function name names(cl)[2] <- "x" # argument matching cl$select <- level.names # add argument 'select' levs <- eval(cl, parent.frame()) # extraction ## Object 'levs' is a data frame or matrix with as many colums as ## there are levels in the model (still notwithstanding the data ## level). Rows contain nodes identifiers which can be ## anything. For calculations, these identifiers are converted ## into simple subscripts (i, j, k, ...) as used in mathematical ## notation. ## ## Note that 'apply' will coerce to a matrix. ilevs <- apply(levs, 2, function(x) as.integer(factor(x))) ## Extraction of the ratios. If argument 'ratios' is missing, then ## use all columns of 'data' except those of the portfolio ## structure. cl$select <- if (missing(ratios)) setdiff(colnames(data), level.names) else Call[[m[2]]] ratios <- as.matrix(eval(cl, parent.frame())) # ratios as matrix ## Creation of a weight matrix. Extract from data if argument ## 'weights' is specified, otherwise create a matrix of ones. For ## extraction, the only change from ratio extraction is the ## content of element "select" of the call. weights <- if (missing(weights)) { if (any(is.na(ratios))) stop("missing ratios not allowed when weights are not supplied") array(1, dim(ratios)) # matrix of ones } else { cl$select <- Call[[m[3]]] as.matrix(eval(cl, parent.frame())) # weights as matrix } ## == DISPATCH TO APPROPRIATE CALCULATION FUNCTION == ## ## Buhlmann-Straub models are handled by bstraub(), regression ## models by hache() and hierarchical models by hierarc(). if (nlevels < 2) # one-dimensional model { ## One-dimensional models accept only "unbiased" and ## "iterative" for argument 'method'. method <- match.arg(method) if (method == "Buhlmann-Gisler" || method == "Ohlsson") method <- "unbiased" if (is.null(regformula)) # Buhlmann-Straub { res <- bstraub(ratios, weights, method = method, tol = tol, maxit = maxit, echo = echo) } else # Hachemeister { ## If regression model is actually empty or has only an ## intercept, call bstraub(). trf <- terms(regformula) res <- if (length(attr(trf, "factors")) == 0) { warning("empty regression model; fitting with Buhlmann-Straub's model") bstraub(ratios, weights, method = method, tol = tol, maxit = maxit, echo = echo) } else hache(ratios, weights, regformula, regdata, adj.intercept = adj.intercept, method = method, tol = tol, maxit = maxit, echo = echo) } ## Add missing quantities to results. res$classification <- levs res$ordering <- list(seq_along(levs)) } else # hierarchical model { ## Computations with auxiliary function. res <- hierarc(ratios, weights, classification = ilevs, method = method, tol = tol, maxit = maxit, echo = echo) ## Put back original level names into the object res$classification <- levs } ## Transfer level names to lists names(res$means) <- names(res$weights) <- c("portfolio", level.names) names(res$unbiased) <- if (!is.null(res$unbiased)) names(res$means) names(res$iterative) <- if (!is.null(res$iterative)) names(res$means) names(res$nodes) <- names(res$ordering) <- level.names if (is.list(res$cred)) names(res$cred) <- level.names ## Results class(res) <- c("cm", class(res)) attr(res, "call") <- Call res } predict.cm <- function(object, levels = NULL, newdata, ...) { ## Convert the character 'levels' argument into numeric and pass ## to next method. level.names <- names(object$nodes) levels <- if (is.null(levels)) seq_along(level.names) else pmatch(levels, level.names) if (any(is.na(levels))) stop("invalid level name") NextMethod() } print.cm <- function(x, ...) { chkDots(...) # method does not use '...' nlevels <- length(x$nodes) level.names <- names(x$nodes) b <- if (is.null(x$iterative)) x$unbiased else x$iterative cat("Call:\n", paste(deparse(attr(x, "call")), sep = "\n", collapse = "\n"), "\n\n", sep = "") cat("Structure Parameters Estimators\n\n") cat(" Collective premium:", x$means[[1]], "\n") for (i in seq.int(nlevels)) { if (i == 1L) { ## Treat the Hachemeister model separately since in this ## case the variance components vector is a list, with the ## first element a matrix. (Note that since a matrix with ## empty column names is printed to the screen, there will ## be a blank line in the display. Hence the inserted ## newline in the 'else' case.) if (attr(x, "model") == "regression") { m <- b[[1]] dimnames(m) <- list(c(paste(" Between", level.names[i], "variance: "), rep("", nrow(m) - 1)), rep("", ncol(m))) print(m) } else cat("\n Between", level.names[i], "variance:", b[i], "\n") } else cat(" Within ", level.names[i - 1], "/Between ", level.names[i], " variance: ", b[i], "\n", sep = "") } cat(" Within", level.names[nlevels], "variance:", b[[nlevels + 1]], "\n", fill = TRUE) invisible(x) } summary.cm <- function(object, levels = NULL, newdata, ...) { nlevels <- length(object$nodes) if (nlevels == 1L) { ## Single level cases (Buhlmann-Straub and Hachemeister): ## return the object with the following modifications: put ## credibility factors into a list and add a list of the ## credibility premiums. object$premiums <- list(predict(object, newdata = newdata)) object$cred <- list(object$cred) class(object) = c("summary.cm", class(object)) } else { ## Multi-level case (hierarchical): select result of the ## appropriate level(s). plevs <- if (is.null(levels)) seq_along(names(object$nodes)) else pmatch(levels, names(object$nodes)) if (any(is.na(plevs))) stop("invalid level name") object$premiums <- predict(object, levels) # new element object$means <- object$means[c(1, plevs + 1)] object$weights <- object$weights[c(1, plevs + 1)] object$unbiased <- object$unbiased[sort(unique(c(plevs, plevs + 1)))] object$iterative <- object$iterative[sort(unique(c(plevs, plevs + 1)))] object$cred <- object$cred[plevs] object$classification <- object$classification[, seq.int(max(plevs)), drop = FALSE] object$nodes <- object$nodes[plevs] class(object) <- c("summary.cm", class(object)) } structure(object, ...) # attach additional attributes in '...' } print.summary.cm <- function(x, ...) { nlevels <- length(x$nodes) level.names <- names(x$nodes) NextMethod() # print.cm() cat("Detailed premiums\n\n") for (i in seq.int(nlevels)) { ## Print a "section title" only if there is more than one ## level. (Provision introduced in v2.3.0; before the title ## was always printed.) if (nlevels > 1L) cat(" Level:", level.names[i], "\n") ## There are no level names in the linear Bayes case, so we ## skip this column in the results. if (is.null(level.names)) levs <- NULL else { level.id <- match(level.names[i], colnames(x$classification)) levs <- x$classification[, seq.int(level.id), drop = FALSE] m <- duplicated(levs) } if (attr(x, "model") == "regression") { ## Hachemeister model: results contain matrices y <- cbind(" ", as.vector(format(x$means[[i + 1L]], ...)), as.vector(apply(format(x$cred[[i]], ...), c(1L, 3L), paste, collapse = " ")), as.vector(format(sapply(x$adj.models, coef), ...)), " ") y[seq(1, nrow(y), dim(x$cred[[i]])[1]), c(1L, 5L)] <- c(levs[!m, , drop = FALSE], format(x$premiums[[i]], ...)) colnames(y) <- c(colnames(levs), "Indiv. coef.", "Cred. matrix", "Adj. coef.", "Cred. premium") } else if (is.null(levs)) { ## Linear Bayes model: simplified results with no level ## column y <- cbind(format(x$means[[i + 1L]], ...), format(x$weights[[i + 1L]], ...), format(x$cred[[i]], ...), format(x$premiums[[i]], ...)) colnames(y) <- c("Indiv. mean", "Weight", "Cred. factor", "Bayes premium") } else { ## All other models y <- cbind(as.matrix(levs[!m, , drop = FALSE]), format(x$means[[i + 1L]], ...), format(x$weights[[i + 1L]], ...), format(x$cred[[i]], ...), format(x$premiums[[i]], ...)) colnames(y) <- c(colnames(levs), "Indiv. mean", "Weight", "Cred. factor", "Cred. premium") } rownames(y) <- rep(" ", nrow(y)) print(y, quote = FALSE, right = FALSE, ...) cat("\n") } invisible(x) } actuar/R/hache.R0000644000176200001440000000605214264305077013140 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Credibility in the regression case using the Hachemeister (1975) ### model with possibly an adjustment to put the intercept at the ### barycenter of time (see Buhlmann & Gisler, 2005). ### ### AUTHORS: Xavier Milhaud, Tommy Ouellet, Vincent Goulet ### hache <- function(ratios, weights, formula, data, adj.intercept = FALSE, method = c("unbiased", "iterative"), tol = sqrt(.Machine$double.eps), maxit = 100, echo = FALSE) { Call <- match.call() ## If weights are not specified, use equal weights as in ## Buhlmann's model. if (missing(weights)) { if (any(is.na(ratios))) stop("missing ratios not allowed when weights are not supplied") weights <- array(1, dim(ratios)) } ## Check other bad arguments. if (NCOL(ratios) < 2) stop("there must be at least one node with more than one period of experience") if (NROW(ratios) < 2) stop("there must be more than one node") if (!identical(which(is.na(ratios)), which(is.na(weights)))) stop("missing values are not in the same positions in 'weights' and in 'ratios'") if (all(!weights, na.rm = TRUE)) stop("no available data to fit model") ## Build the design matrix mf <- model.frame(formula, data, drop.unused.levels = TRUE) mt <- attr(mf, "terms") xreg <- model.matrix(mt, mf) ## Do computations in auxiliary functions. res <- if (adj.intercept) hache.barycenter(ratios, weights, xreg, method = match.arg(method), tol = tol, maxit = maxit, echo = echo) else hache.origin(ratios, weights, xreg, tol = tol, maxit = maxit, echo = echo) ## Add the terms object to the result for use in predict.hache() ## [and thus predict.lm()]. res$terms <- mt ## Results attr(res, "class") <- "hache" attr(res, "model") <- "regression" res } predict.hache <- function(object, levels = NULL, newdata, ...) { ## If model was fitted at the barycenter of time (there is a ## transition matrix in the object), then also convert the ## regression coefficients in the base of the (original) design ## matrix. if (!is.null(R <- object$transition)) { for (i in seq_along(object$adj.models)) { b <- coefficients(object$adj.models[[i]]) object$adj.models[[i]]$coefficients <- solve(R, b) } } ## Prediction (credibility premiums) using predict.lm() on each of ## the adjusted individual models. This first requires to add a ## 'terms' component to each adjusted model. f <- function(z, ...) { z$terms <- object$terms class(z) <- "lm" # to keep predict.lm() quiet unname(predict.lm(z, ...)) } structure(sapply(object$adj.models, f, newdata = newdata), ...) } print.hache <- function(x, ...) print.default(x) actuar/R/GeneralizedBeta.R0000644000176200001440000000334214264305077015114 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r,m,lev}genbeta functions to compute ### characteristics of the Generalized Beta distribution. The version ### used in these functions has cumulative distribution function ### ### Pr[X <= x] = Pr[Y <= (x/scale)^shape3], 0 < x < scale, ### ### where Y has a Beta distribution with parameters shape1 and shape2. ### ### See Appendix A of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHOR: Vincent Goulet dgenbeta <- function (x, shape1, shape2, shape3, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "dgenbeta", x, shape1, shape2, shape3, scale, log) pgenbeta <- function (q, shape1, shape2, shape3, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pgenbeta", q, shape1, shape2, shape3, scale, lower.tail, log.p) qgenbeta <- function (p, shape1, shape2, shape3, rate = 1, scale = 1/rate, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qgenbeta", p, shape1, shape2, shape3, scale, lower.tail, log.p) rgenbeta <- function (n, shape1, shape2, shape3, rate = 1, scale = 1/rate) .External(C_actuar_do_random, "rgenbeta", n, shape1, shape2, shape3, scale) mgenbeta <- function (order, shape1, shape2, shape3, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "mgenbeta", order, shape1, shape2, shape3, scale, FALSE) levgenbeta <- function (limit, shape1, shape2, shape3, rate = 1, scale = 1/rate, order = 1) .External(C_actuar_do_dpq, "levgenbeta", limit, shape1, shape2, shape3, scale, order, FALSE) actuar/R/rcomphierarc.summaries.R0000644000176200001440000001527314515770645016565 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Computing summary statistics and accessing components of a ### portfolio. ### ### AUTHORS: Louis-Philippe Pouliot, Tommy Ouellet, ### Vincent Goulet aggregate.portfolio <- function(x, by = names(x$nodes), FUN = sum, classification = TRUE, prefix = NULL, ...) { level.names <- names(x$nodes) # level names nlevels <- length(level.names) # number of levels years <- level.names[nlevels] # name of last level ## Match level names in 'by' to those in the model by <- match.arg(by, level.names, several.ok = TRUE) ## Version of FUN able to work on lists fun <- function(x, ...) FUN(unlist(x), ...) ## The most common case should be to aggregate claim amounts by ## node. This case being very simple, it is treated separately. if (identical(by, level.names)) return(cbind(if (classification) x$classification, array(sapply(x$data, FUN, ...), dim(x$data), dimnames = list(NULL, paste(prefix, colnames(x$data), sep = ""))))) ## Summaries only by last level (years) are also simple to handle. if (identical(by, years)) { res <- apply(x$data, 2, fun, ...) names(res) <- paste(prefix, colnames(x$data), sep = "") return(res) } ## The other possibilities require to split the data in groups as ## specified in argument 'by'. If the last level (years) is in ## 'by', then the matrix structure must be retained to make the ## summaries. Otherwise, it can just be dropped since summaries ## will span the years of observation. ## ## Convert the sequence of subscripts into factors by pasting the ## digits together. It is important *not* to sort the levels in ## case the levels in 'by' are not in the same order as in ## 'level.names'. rows <- setdiff(by, years) # groups other than years s <- x$classification[, rows, drop = FALSE] # subscripts f <- apply(s, 1, paste, collapse = "") # grouping IDs f <- factor(f, levels = unique(f)) # factors s <- s[match(levels(f), f), , drop = FALSE] # unique subscripts xx <- split(x$data, f) # split data ## Make summaries if (years %in% by) { xx <- lapply(xx, matrix, ncol = ncol(x$data)) res <- t(sapply(xx, function(x, ...) apply(x, 2, fun, ...), ...)) cols <- colnames(x$data) } else { res <- sapply(xx, fun, ...) cols <- deparse(substitute(FUN)) } ## Return results as a matrix structure(cbind(if (classification) s, res), dimnames = list(NULL, c(if (classification) rows, paste(prefix, cols, sep = "")))) } frequency.portfolio <- function(x, by = names(x$nodes), classification = TRUE, prefix = NULL, ...) { chkDots(...) # method does not use '...' freq <- function(x) if (identical(x, NA)) NA else length(x[!is.na(x)]) aggregate(x, by, freq, classification, prefix) } severity.portfolio <- function(x, by = head(names(x$node), -1), splitcol = NULL, classification = TRUE, prefix = NULL, ...) { chkDots(...) # method does not use '...' level.names <- names(x$nodes) # level names ci <- seq_len(ncol(x$data)) # column indexes ## Match level names in 'by' to those in the model by <- match.arg(by, level.names, several.ok = TRUE) ## Sanity checks if (identical(by, level.names)) { warning("nothing to do") return(x) } ## Convert character 'splitcol' to numeric and then from numeric ## or NULL to boolean. if (is.character(splitcol)) splitcol <- pmatch(splitcol, colnames(x$data), duplicates.ok = TRUE) if (is.numeric(splitcol) || is.null(splitcol)) splitcol <- ci %in% splitcol ## Unroll claim amounts by column; simplest case if (tail(level.names, 1L) %in% by) { if (length(by) > 1L) stop(sprintf("invalid %s specification", sQuote("by"))) #x <- x$data res <- unroll(x$data, bycol = TRUE, drop = FALSE) colnames(res) <- paste(prefix, colnames(res), sep = "") return(list(main = res[, !splitcol], split = if (all(!splitcol)) NULL else res[, splitcol])) } ## Unrolling per row (or group of rows) is more work. It requires ## to split the columns of the matrix first, and then to apply the ## unrolling procedure twice (if 'splitcol' != NULL). ## ## Utility function fun <- function(x) unlist(x[!is.na(x)]) ## Split rows according to the 'by' argument. s <- x$classification[, by, drop = FALSE] # subscripts f <- apply(s, 1, paste, collapse = "") # grouping IDs f <- factor(f, levels = unique(f)) # factors s <- s[match(levels(f), f), , drop = FALSE] # unique subscripts ## Keep the 'splitcol' columns for later use. x.split <- x$data[, splitcol] ## If a prefix is not specified, use "claim." as a sensible ## choice. if (is.null(prefix)) prefix <- "claim." ## Unroll the "main" block of columns. if (all(splitcol)) res.main <- NULL else { x <- cbind(lapply(split(x$data[, !splitcol], f), fun)) res.main <- unroll(x, bycol = FALSE, drop = FALSE) res.main <- if (0L < (nc <- ncol(res.main))) { dimnames(res.main) <- list(NULL, paste(prefix, seq_len(nc), sep = "")) cbind(if (classification) s, res.main) } else NULL } ## Unroll the 'splitcol' block of columns. if (all(!splitcol)) res.split <- NULL else { x <- cbind(lapply(split(x.split, f), fun)) # split data res.split <- unroll(x, bycol = FALSE, drop = FALSE) res.split <- if (0L < (nc <- ncol(res.split))) { dimnames(res.split) <- list(NULL, paste(prefix, seq_len(nc), sep = "")) cbind(if (classification) s, res.split) } else NULL } ## Return the result as a list. list(main = res.main, split = res.split) } weights.portfolio <- function(object, classification = TRUE, prefix = NULL, ...) { chkDots(...) # method does not use '...' if (is.null(object$weights)) NULL else { w <- object$weights colnames(w) <- paste(prefix, colnames(w), sep = "") cbind(if (classification) object$classification, w) } } actuar/R/ZeroModifiedBinomial.R0000644000176200001440000000154214264305077016122 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r}zmbinom functions to compute ### characteristics of the Zero Modified Binomial distribution. ### ### See Appendix B of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHOR: Vincent Goulet dzmbinom <- function (x, size, prob, p0, log = FALSE) .External(C_actuar_do_dpq, "dzmbinom", x, size, prob, p0, log) pzmbinom <- function(q, size, prob, p0, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pzmbinom", q, size, prob, p0, lower.tail, log.p) qzmbinom <- function(p, size, prob, p0, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qzmbinom", p, size, prob, p0, lower.tail, log.p) rzmbinom <- function(n, size, prob, p0) .External(C_actuar_do_random, "rzmbinom", n, size, prob, p0) actuar/R/mde.R0000644000176200001440000001115214370340204012617 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Minimum distance estimation. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet mde <- function(x, fun, start, measure = c("CvM", "chi-square", "LAS"), weights = NULL, ...) { ## General form of the function to minimize. myfn <- function(parm, x, weights, ...) { y <- G(parm, x, ...) - Gn(x) drop(crossprod(weights * y, y)) } ## Extract call; used to build the call to optim(). Call <- match.call(expand.dots = TRUE) ## Argument checking if (missing(start) || !is.list(start)) stop(sprintf("%s must be a named list", sQuote("start"))) if (missing(fun) || !(is.function(fun))) stop(sprintf("%s must be supplied as a function", sQuote("fun"))) grouped <- inherits(x, "grouped.data") if (!(is.numeric(x) || grouped)) stop(sprintf("%s must be a numeric vector or an object of class %s", sQuote("x"), dQuote("grouped.data"))) ## Make sure that any argument of 'fun' specified in '...' is held ## fixed. dots <- names(list(...)) dots <- dots[!is.element(dots, c("upper", "lower"))] start <- start[!is.element(names(start), dots)] ## Adapt 'fun' to our needs; taken from MASS::fitdistr. nm <- names(start) f <- formals(fun) args <- names(f) m <- match(nm, args) if (any(is.na(m))) stop(sprintf("%s specifies names which are not arguments to %s", sQuote("start"), sQuote("fun"))) formals(fun) <- c(f[c(1, m)], f[-c(1, m)]) # reorder arguments fn <- function(parm, x, ...) fun(x, parm, ...) if ((l <- length(nm)) > 1) body(fn) <- parse(text = paste("fun(x,", paste("parm[", 1:l, "]", collapse = ", "), ")")) measure <- match.arg(measure) ## Cramer-von Mises. Use the true and empirical cdf for individual ## data, or the true cdf and the ogive for grouped data. if (measure == "CvM") { G <- fn Gn <- if (grouped) ogive(x) else ecdf(x) if (is.null(weights)) weights <- 1 Call$x <- knots(Gn) Call$par <- start } ## Modified Chi-square. if (measure == "chi-square") { if (!grouped) stop(sprintf("%s measure requires an object of class %s", dQuote("chi-square"), dQuote("grouped.data"))) if (any((nj <- x[, 2]) == 0)) stop("frequency must be larger than 0 in all groups") og <- ogive(x) x <- knots(og) n <- sum(nj) G <- function(...) n * diff(fn(...)) Gn <- function(...) n * diff(og(...)) if (is.null(weights)) weights <- 1/nj Call$x <- x Call$par <- start } ## Layer average severity. if (measure == "LAS") { if (!grouped) stop(sprintf("%s measure requires an object of class %s", dQuote("LAS"), dQuote("grouped.data"))) e <- elev(x) x <- knots(e) G <- function(...) diff(fn(...)) Gn <- function(...) diff(e(...)) if (is.null(weights)) weights <- 1 Call$x <- x Call$par <- start } ## optim() call Call[[1]] <- as.name("optim") Call$fun <- Call$start <- Call$measure <- NULL Call$fn <- myfn Call$weights <- weights Call$hessian <- FALSE if (is.null(Call$method)) { if (any(c("lower", "upper") %in% names(Call))) Call$method <- "L-BFGS-B" else if (length(start) > 1) Call$method <- "BFGS" else Call$method <- "Nelder-Mead" } res <- eval(Call) ## Return result if (res$convergence > 0) stop("optimization failed") structure(list(estimate = res$par, distance = res$value), class = c("mde","list")) } print.mde <- function(x, digits = getOption("digits"), ...) { ans1 <- format(x$estimate, digits = digits) ans1 <- sapply(ans1, function(x) paste("", x)) nm1 <- names(ans1) nm1 <- paste(substring(" ", 1L, (nchar(ans1) - nchar(nm1)) %/% 2), nm1) nm1 <- paste(nm1, substring(" ", 1L, (nchar(ans1) - nchar(nm1)) %/% 2 + 1)) names(ans1) <- nm1 ans2 <- format(x$distance, digits = digits) ans2 <- sapply(ans2, function(x) paste("", x)) nm2 <- "distance" nm2 <- paste(substring(" ", 1L, (nchar(ans2) - nchar(nm2)) %/% 2), nm2) nm2 <- paste(nm2, substring(" ", 1L, (nchar(ans2) - nchar(nm2)) %/% 2)) names(ans2) <- nm2 print(ans1, quote = FALSE) cat("\n") print(ans2, quote = FALSE) invisible(x) } actuar/R/coverage.R0000644000176200001440000003060614370340204013652 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Create modified density and modified cumulative distribution ### function for data with deductible, limit, coinsurance and ### inflation. ### ### See Chapter 8 of Klugman, Panjer & Willmot, Loss Models, Fourth ### Edition, Wiley, 2012. ### ### AUTHORS: Mathieu Pigeon, Vincent Goulet coverage <- function(pdf, cdf, deductible = 0, franchise = FALSE, limit = Inf, coinsurance = 1, inflation = 0, per.loss = FALSE) { Call <- match.call() ## First determine if the cdf is needed or not. It is needed when ## there is a deductible or a limit and, of course, if the output ## function should compute the cdf. is.cdf <- missing(pdf) || is.null(pdf) # return cdf? has.limit <- limit < Inf # used often needs.cdf <- any(deductible > 0, has.limit, is.cdf) # cdf needed? ## Sanity check of arguments if (any(deductible < 0, limit < 0, coinsurance < 0, inflation < 0)) stop("coverage modifications must be positive") if (limit <= deductible) stop("deductible must be smaller than the limit") if (coinsurance > 1) stop("coinsurance must be between 0 and 1") if (missing(cdf) & needs.cdf) stop(sprintf("%s must be supplied", sQuote("cdf"))) ## Quantites often used. Leave as expressions for the output ## function to preserve accuracy. r <- 1 + inflation d <- if (inflation) substitute(d/r, list(d = deductible, r = r)) else deductible u <- if (inflation) substitute(u/r, list(u = limit, r = r)) else limit ## The modified cdf or pdf are usually defined in branches. To ## avoid using nested ifelse(), we will rather rely on sets of ## expressions to make the required calculations for each branch ## separately. This is actually much faster. ## ## The output function will have varying number of said ## expressions depending on the case that is dealt with. We will ## build the body of the output function piece by piece as we go ## along. e <- expression(Call <- match.call()) ## One main discriminating factor is whether the cdf is needed for ## the output function of not. if (needs.cdf) { ## Get argument list of 'cdf' to transfert them to the output ## function. argv <- formals(cdf) # arguments as list argn <- names(argv) # arguments names as strings ## Remember if argument 'lower.tail' is available, so we can ## use it later. Then, drop unsupported arguments 'lower.tail' ## and 'log.p'. has.lower <- "lower.tail" %in% argn argn <- setdiff(argn, c("lower.tail", "log.p")) ## Calculations in the output function are done by evaluating ## function calls built upon the call to the output function ## itself. This is convenient as we do not need to fiddle with ## the values of the formal arguments. if (is.cdf) # output function computes F(y) { ## The output function will have the same formal arguments ## as the cdf. Object 'x' holds the symbol of the first ## argument. argsFUN <- argv[argn] # arguments of output function x <- as.name(argn[1]) # symbol ## Calls needed in this case: ## 1. one to compute F(y); ## 2. one to compute F(d) if there is a deductible; ## 3. one to compute 1 - F(d) for the per payment cases. ## Never need to compute F(u). ## ## If 'lower.tail' is available in 'cdf', then set it to ## FALSE to compute S(d) = 1 - F(d) more accurately. e <- c(e, quote(F <- Call), # 1. substitute(F[[1L]] <- as.name(fun), list(fun = as.character(Call$cdf)))) if (deductible) { e <- c(e, quote(Fd <- F), # 2. substitute(Fd[[2L]] <- a, list(a = d))) if (!per.loss & has.lower) e <- c(e, quote(Sd <- Fd), # 3. quote(Sd$lower.tail <- FALSE)) } } else # output function computes f(y) { ## When there is a limit, we will need to compute 1 - F(u) ## as is or using 'lower.tail = FALSE' to improve ## accuracy. For clarity in the output function, we will ## use Fu as object name in the first case and Su in the ## second. if (has.limit) { if (has.lower) { Fu.name <- as.name("Su") Su.quote <- quote(eval.parent(Su)) } else { Fu.name <- as.name("Fu") Su.quote <- quote((1 - eval.parent(Fu))) } } ## Calls needed in this case: ## 1. one to compute F(d) if there is a deductible for the ## per loss cases; ## 2. one to compute 1 - F(d) if there is a deductible for the ## per payment cases; ## 3. one to compute 1 - F(u) when there is a limit. ## No function to compute F(y) needed. ## ## If 'lower.tail' is available in 'cdf', then set it to ## FALSE to compute S(d) = 1 - F(d) and S(u) = 1 - F(u) ## more accurately. if (deductible) # f(y) with deductible { Fd.name <- as.name(if (!per.loss & has.lower) "Sd" else "Fd") e <- c(e, substitute(G <- Call, list(G = Fd.name)), # 1. or 2. if (!per.loss & has.lower) quote(Sd$lower.tail <- FALSE), substitute(G[[1L]] <- as.name(fun), list(G = Fd.name, fun = as.character(Call$cdf))), substitute(names(G)[2L] <- q, list(G = Fd.name, q = argn[1])), substitute(G[[2L]] <- a, list(G = Fd.name, a = d))) if (has.limit) e <- c(e, substitute(H <- G, list(H = Fu.name, G = Fd.name)), # 3. if (per.loss & has.lower) quote(Su$lower.tail <- FALSE), substitute(H[[2L]] <- a, list(H = Fu.name, a = u))) } else # f(y) with limit only { ## Since 'needs.cdf == TRUE', then this case ## necessarily has 'limit < Inf'. Only call needed is ## one to compute 1 - F(u). e <- c(e, substitute(G <- Call, list(G = Fu.name)), if (has.lower) quote(Su$lower.tail <- FALSE), substitute(G[[1L]] <- as.name(fun), list(G = Fu.name, fun = as.character(Call$cdf))), substitute(names(G)[2L] <- q, list(G = Fu.name, q = argn[1])), substitute(G[[2L]] <- a, list(G = Fu.name, a = u))) } } } ## Repeat same steps as above for case needing the pdf. The output ## function is a pdf and in this case the arguments of the output ## function are those of 'pdf'. if (!is.cdf) { argv <- formals(pdf) # arguments as list argn <- setdiff(names(argv), "log") # drop argument 'log' argsFUN <- argv[argn] # arguments of output function x <- as.name(argn[1]) # symbol e <- c(e, quote(f <- Call), substitute(f[[1L]] <- as.name(fun), list(fun = as.character(Call$pdf)))) } ## Build the value at which the underlying pdf/cdf will be called ## for non special case values of 'x'. We need to index 'x' to ## only compute for the correct values of a given branch. x.mod <- as.call(c(as.name("["), x, as.name("w"))) if (coinsurance < 1) x.mod <- substitute(x/alpha, list(x = x.mod, alpha = coinsurance)) if (deductible & !franchise) x.mod <- substitute(x + d, list(x = x.mod, d = deductible)) if (inflation) x.mod <- substitute((x)/r, list(x = x.mod, r = r)) ## Each pdf/cdf is defined in three branches. Define the ## boundaries and conditions for the first two branches. Those for ## the third branch are defined further down. if (franchise) { bound1 <- coinsurance * deductible bound2 <- coinsurance * limit cond1 <- if (is.cdf) substitute(0 <= x & x <= b1, list(x = x, b1 = bound1)) else quote(x == 0) cond2 <- substitute(b1 < x & x < b2, list(x = x, b1 = bound1, b2 = bound2)) } else { bound1 <- 0 bound2 <- coinsurance * (limit - deductible) cond1 <- substitute(x == 0, list(x = x)) cond2 <- substitute(0 < x & x < b, list(x = x, b = bound2)) } ## Initialization of the results vector in the output function ## with 0s. e <- c(e, substitute(res <- numeric(length(x)), list(x = x))) ## Definition of the output function for the first branch. There ## is a computation to make only if there is a deductible with the ## payment per loss random variable. For all other cases, the ## value in the first branch is 0 and we rely on the ## initialization with numeric() done at the previous step. if (per.loss & deductible) e <- c(e, substitute(res[which(cond1)] <- eval.parent(Fd), list(cond1 = cond1))) ## Definition of the output function for the second and third ## branches. The 'is.cdf = TRUE' and 'is.cdf = FALSE' cases must ## be treated separately. if (is.cdf) { cond3 <- substitute(x >= b, list(x = x, b = bound2)) f2 <- quote(eval.parent(F)) if (!per.loss & deductible) f2 <- if (has.lower) substitute((f - F)/S, list(f = f2, F = quote(eval.parent(Fd)), S = quote(eval.parent(Sd)))) else substitute((f - F)/S, list(f = f2, F = quote((p <- eval.parent(Fd))), S = quote((1 - p)))) e <- c(e, substitute(w <- which(cond), list(cond = cond2)), substitute(F[[2L]] <- x, list(x = x.mod)), substitute(res[w] <- f, list(f = f2)), if (has.limit) substitute(res[cond] <- 1, list(cond = cond3))) } else { cond3 <- substitute(x == b, list(x = x, b = bound2)) f2 <- quote(eval.parent(f)) if (has.limit) f3 <- Su.quote if (!per.loss & deductible) { if (has.limit) { f2 <- if (has.lower) substitute(f/(p <- S), list(f = f2, S = quote(eval.parent(Sd)))) else substitute(f/(p <- S), list(f = f2, S = quote(1 - eval.parent(Fd)))) f3 <- substitute(f/p, list(f = f3)) } else f2 <- if (has.lower) substitute(f/S, list(f = f2, S = quote(eval.parent(Sd)))) else substitute(f/S, list(f = f2, S = quote((1 - eval.parent(Fd))))) } if (inflation | coinsurance < 1) f2 <- substitute(f/k, list(f = f2, k = coinsurance * r)) e <- c(e, substitute(w <- which(cond), list(cond = cond2)), substitute(f[[2L]] <- x, list(x = x.mod)), substitute(res[w] <- f, list(f = f2)), if (has.limit) substitute(res[cond] <- f, list(cond = cond3, f = f3))) } ## Last expression of the output function. e <- c(e, quote(res)) ## Wrap up the output function. FUN <- function() {} body(FUN) <- as.call(c(as.name("{"), e)) # taken from help(body) formals(FUN) <- argsFUN # set arguments environment(FUN) <- new.env() # new, empty environment FUN } actuar/R/GammaSupp.R0000644000176200001440000000153714264305077013765 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {m,lev,mgf}gamma functions to compute raw and ### limited moments, and the moment generating function for ### the Gamma distribution (as defined in R) ### ### See Chapter 17 of Johnson & Kotz, Continuous univariate ### distributions, volume 1, Wiley, 1970 ### ### AUTHORS: Mathieu Pigeon, Christophe Dutang, ### Vincent Goulet mgamma <- function(order, shape, rate = 1, scale = 1/rate) .External(C_actuar_do_dpq, "mgamma", order, shape, scale, FALSE) levgamma <- function(limit, shape, rate = 1, scale = 1/rate, order = 1) .External(C_actuar_do_dpq, "levgamma", limit, shape, scale, order, FALSE) mgfgamma <- function(t, shape, rate = 1, scale = 1/rate, log = FALSE) .External(C_actuar_do_dpq, "mgfgamma", t, shape, scale, log) actuar/R/adjCoef.R0000644000176200001440000002060114370340204013404 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Compute the adjustment coefficient in ruin theory, that is the ### smallest (strictly) positive root of the Lundberg equation ### ### h(r) = E[e^(r X - r c W)] = 1, ### ### where X is the claim size random variable, W the inter-occurence ### time and c the premium rate. ### ### AUTHORS: Christophe Dutang, Vincent Goulet adjCoef <- function(mgf.claim, mgf.wait = mgfexp, premium.rate, upper.bound, h, reinsurance = c("none", "proportional", "excess-of-loss"), from, to, n = 101) { reinsurance <- match.arg(reinsurance) ## Sanity check if (missing(mgf.claim) && missing(h)) stop(sprintf("one of %s or %s is needed", sQuote("mgf.claim"), sQuote("h"))) ## === NO REINSURANCE CASE === ## ## Moment generating functions are unidimensional, premium rate ## and adjustment coefficient are both single numeric values. if (reinsurance == "none") { ## For each of 'mgf.claim', 'mgf.wait' and 'h' (if needed): if ## the expression is only the name of a function (say f), ## build a call 'f(x)'. Otherwise, check that the expression ## is a function call containing an 'x'. Taken from 'curve' ## and 'discretize'. ## ## NOTE: argument 'h' will be used iff 'mgf.claim' is missing, ## thereby giving priority to 'mgf.claim'. if (missing(mgf.claim)) { sh <- substitute(h) if (is.name(sh)) { fcall <- paste(sh, "(x)") h1 <- function(x) eval(parse(text = fcall), envir = list(x = x), enclos = parent.frame(2)) } else { if (!(is.call(sh) && match("x", all.vars(sh), nomatch = 0L))) stop(sprintf("%s must be a function or an expression containing %s", sQuote("h"), sQuote("x"))) h1 <- function(x) eval(sh, envir = list(x = x), enclos = parent.frame(2)) } } else { smgfx <- substitute(mgf.claim) if (is.name(smgfx)) { fcall <- paste(smgfx, "(x)") mgfx <- parse(text = fcall) } else { if (!(is.call(smgfx) && match("x", all.vars(smgfx), nomatch = 0L))) stop(sprintf("%s must be a function or an expression containing %s", sQuote("mgf.claim"), sQuote("x"))) mgfx <- smgfx } smgfw <- substitute(mgf.wait) if (is.name(smgfw)) { fcall <- paste(smgfw, "(x)") mgfw <- parse(text = fcall) } else { if (!(is.call(smgfw) && match("x", all.vars(smgfw), nomatch = 0L))) stop(sprintf("%s must be a function or an expression containing %s", sQuote("mgf.wait"), sQuote("x"))) mgfw <- smgfw } h1 <- function(x) eval(mgfx) * eval(mgfw, list(x = -x * premium.rate)) } f1 <- function(r) (h1(r) - 1)^2 return(optimize(f1, c(0, upper.bound - .Machine$double.eps), tol = sqrt(.Machine$double.eps))$minimum) } ## === WITH REINSURANCE CASES === ## ## Claim amount moment generating function is a function of 'x' ## and the retention level 'y', inter-occurence time moment ## generating function is a function of 'x', premium rate and ## adjustment coefficient are both functions of the retention ## level 'y'. ## ## Do same as in the no reinsurance case for each of 'mgf.claim', ## 'mgf.wait' and 'h' (if needed) and also 'premium'. The first ## must be functions of 'x' and 'y', whereas the last one is a ## function of 'y' only. if (missing(mgf.claim)) { sh <- substitute(h) if (is.name(sh)) { fcall <- paste(sh, "(x, y)") h2 <- function(x, y) eval(parse(text = fcall), envir = list(x = x, y = y), enclos = parent.frame(2)) } else { if (!(is.call(sh) && all(match(c("x", "y"), all.vars(sh), nomatch = 0L)))) stop(sprintf("%s must be a function or an expression containing %s and %s", sQuote("h"), sQuote("x"), sQuote("y"))) h2 <- function(x, y) eval(sh, envir = list(x = x, y = y), enclos = parent.frame(2)) } } else { if (!is.function(premium.rate)) stop(sprintf("%s must be a function when using reinsurance", sQuote("premium.rate"))) smgfx <- substitute(mgf.claim) if (is.name(smgfx)) { fcall <- paste(smgfx, "(x, y)") mgfx <- parse(text = fcall) } else { if (!(is.call(smgfx) && all(match(c("x", "y"), all.vars(smgfx), nomatch = 0L)))) stop(sprintf("%s must be a function or an expression containing %s and %s", sQuote("mgf.claim"), sQuote("x"), sQuote("y"))) mgfx <- smgfx } smgfw <- substitute(mgf.wait) if (is.name(smgfw)) { fcall <- paste(smgfw, "(x)") mgfw <- parse(text = fcall) } else { if (!(is.call(smgfw) && match("x", all.vars(smgfw), nomatch = 0L))) stop(sprintf("%s must be a function or an expression containing %s", sQuote("mgf.wait"), sQuote("x"))) mgfw <- smgfw } spremium <- substitute(premium.rate) if (is.name(spremium)) { fcall <- paste(spremium, "(y)") premium.rate <- parse(text = fcall) } else { if (!(is.call(spremium) && match("y", all.vars(spremium), nomatch = 0L))) stop(sprintf("%s must be a function or an expression containing %s", sQuote("premium.rate"), sQuote("y"))) premium.rate <- spremium } h2 <- function(x, y) eval(mgfx) * eval(mgfw, list(x = -x * eval(premium.rate))) } f2 <- function(x, y) (h2(x, y) - 1)^2 retention <- seq(from, to, length.out = n) ## Compute the adjustment coefficient for each retention level. ## The output of 'sapply' is a matrix with minima in the first ## line. ## ## The sapply() below passes the retention levels (argument 'y' of ## function 'f') to optimize(). Since the first two arguments ('f' ## and 'interval') of the latter function are specified, the ## retention levels end up in '...' and hence are considered as ## second argument of 'f'. *This requires R >= 2.6.0 to work since ## argument '...' comes much earlier in the definition of ## optimize(). coef <- sapply(retention, optimize, f = f2, interval = c(0, upper.bound-.Machine$double.eps), tol = sqrt(.Machine$double.eps))[1L, ] ## Make a function from the (retention, coefficient) pairs ## computed above, joining the points by straight line segments. FUN <- approxfun(retention, coef, rule = 2, method = "linear") comment(FUN) <- paste(toupper(substring(reinsurance, 1L, 1L)), substring(reinsurance, 2L), " reinsurance", sep = "", collapse = "") class(FUN) <- c("adjCoef", class(FUN)) attr(FUN, "call") <- sys.call() FUN } plot.adjCoef <- function(x, xlab = "x", ylab = "R(x)", main = "Adjustment Coefficient", sub = comment(x), type = "l", add = FALSE, ...) { xx <- eval(expression(x), envir = environment(x)) yy <- eval(expression(y), envir = environment(x)) if (add) lines(xx, yy, ..., main = main, xlab = xlab, ylab = ylab, type = type) else plot(xx, yy, ..., main = main, xlab = xlab, ylab = ylab, type = type) mtext(sub, line = 0.5) } actuar/R/ZeroModifiedGeometric.R0000644000176200001440000000145214264305077016306 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r}zmgeom functions to compute ### characteristics of the Zero Modified Geometric distribution. ### ### See Appendix B of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHOR: Vincent Goulet dzmgeom <- function (x, prob, p0, log = FALSE) .External(C_actuar_do_dpq, "dzmgeom", x, prob, p0, log) pzmgeom <- function(q, prob, p0, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pzmgeom", q, prob, p0, lower.tail, log.p) qzmgeom <- function(p, prob, p0, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qzmgeom", p, prob, p0, lower.tail, log.p) rzmgeom <- function(n, prob, p0) .External(C_actuar_do_random, "rzmgeom", n, prob, p0) actuar/R/UniformSupp.R0000644000176200001440000000136114264305077014355 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {m,lev,mgf}unif functions to compute raw and ### limited moments, and the moment generating function for the ### Uniform distribution (as defined in R). ### ### ### ### AUTHORS: Christophe Dutang, Vincent Goulet munif <- function(order, min = 0, max = 1) .External(C_actuar_do_dpq, "munif", order, min, max, FALSE) levunif <- function(limit, min = 0, max =1, order = 1) .External(C_actuar_do_dpq, "levunif", limit, min, max, order, FALSE) mgfunif <- function(t, min = 0, max = 1, log = FALSE) .External(C_actuar_do_dpq, "mgfunif", t, min, max, log) actuar/R/ZeroModifiedNegativeBinomial.R0000644000176200001440000000157014264305077017606 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Definition of the {d,p,q,r}zmnbinom functions to compute ### characteristics of the Zero Modified Negative Binomial ### distribution. ### ### See Appendix B of Klugman, Panjer & Willmot, Loss Models, Wiley. ### ### AUTHOR: Vincent Goulet dzmnbinom <- function (x, size, prob, p0, log = FALSE) .External(C_actuar_do_dpq, "dzmnbinom", x, size, prob, p0, log) pzmnbinom <- function(q, size, prob, p0, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "pzmnbinom", q, size, prob, p0, lower.tail, log.p) qzmnbinom <- function(p, size, prob, p0, lower.tail = TRUE, log.p = FALSE) .External(C_actuar_do_dpq, "qzmnbinom", p, size, prob, p0, lower.tail, log.p) rzmnbinom <- function(n, size, prob, p0) .External(C_actuar_do_random, "rzmnbinom", n, size, prob, p0) actuar/R/exact.R0000644000176200001440000000234014264305077013170 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Exact calculation of the aggregate claim amount distribution ### function by convolution. Requires a discrete distribution for ### claim amounts. ### ### AUTHORS: Vincent Goulet ### and Louis-Philippe Pouliot exact <- function(fx, pn, x.scale = 1) { ## Some useful lengths m <- length(fx) # 1 + maximum claim amount n <- length(pn) - 1 # maximum number of claims r <- n * m - n + 1 # maximum total amount of claims ## Initialization of the output vector fs <- rep(0, r) fs[1] <- pn[1] # Pr[N = 0] ## Convolutions fxc <- 1 for (i in 1:n) { pos <- seq_len(i * m - i + 1) fxc <- convolve(fx, rev(fxc), type = "open") fs[pos] <- fs[pos] + fxc * pn[i + 1] } FUN <- approxfun((0:(length(fs) - 1)) * x.scale, pmin(cumsum(fs), 1), method = "constant", yleft = 0, yright = 1, f = 0, ties = "ordered") class(FUN) <- c("ecdf", "stepfun", class(FUN)) assign("fs", fs, envir = environment(FUN)) assign("x.scale", x.scale, envir = environment(FUN)) FUN } actuar/R/elev.R0000644000176200001440000001060114515770645013024 0ustar liggesusers### actuar: Actuarial Functions and Heavy Tailed Distributions ### ### Sample empirical limited value functions for individual and ### grouped data. ### ### AUTHORS: Vincent Goulet and ### Mathieu Pigeon elev <- function(x, ...) UseMethod("elev") elev.default <- function(x, ...) { chkDots(...) # method does not use '...' Call <- match.call() if (exists(".Generic", inherits = FALSE)) Call[[1]] <- as.name(.Generic) FUN <- function(limit) sapply(limit, function(x, y) mean(pmin(x, y)), x = x) environment(FUN) <- new.env() assign("x", sort(x), envir = environment(FUN)) assign("n", length(unique(x)), envir = environment(FUN)) class(FUN) <- c("elev", class(FUN)) attr(FUN, "call") <- Call attr(FUN, "grouped") <- FALSE FUN } ### Function 'elev.grouped.data' below returns a function that uses ### data stored in its environment. Avoid false positive in R CMD ### check. if (getRversion() >= "2.15.1") utils::globalVariables(c("cj", "nj")) ### This function assumes right-closed intervals, but the numerical ### values are identical for left-closed intervals. elev.grouped.data <- function(x, ...) { chkDots(...) # method does not use '...' Call <- match.call() if (exists(".Generic", inherits = FALSE)) Call[[1]] <- as.name(.Generic) FUN <- function(limit) { ## Explicitely get the data from the function environment. ## cj <- eval(expression(cj)) ## nj <- eval(expression(nj)) ## Number of classes. r <- length(nj) ## This is to avoid numerical problems. limit <- pmin(limit, cj[r + 1L]) ## Class in which the limit is located. cl <- findInterval(limit, cj, all.inside = TRUE) ## Means for all classes below each limit. cjt <- head(cj, max(cl)) # upper bounds res1 <- sapply(cl - 1L, function(n, x) drop(crossprod(head(x, n), head(nj, n))), (head(cjt, -1) + tail(cjt, -1))/2) ## Means for classes with each limit. cjt <- cj[cl] # lower bounds njt <- nj[cl] # frequencies p <- (limit - cjt) / (cj[cl + 1L] - cjt) # prop. to take res2 <- njt * p * (cjt + limit)/2 + njt * (1 - p) * limit ## Means for classes above each limit. res3 <- limit * sapply(r - cl, function(n, x) sum(tail(x, n)), tail(nj, -min(cl))) ## Total (res1 + res2 + res3)/sum(nj) } environment(FUN) <- new.env() assign("cj", eval(expression(cj), envir = environment(x)), envir = environment(FUN)) assign("nj", x[, 2L], envir = environment(FUN)) assign("n", nrow(x), envir = environment(FUN)) class(FUN) <- c("elev", class(FUN)) attr(FUN, "call") <- Call attr(FUN, "grouped") <- TRUE FUN } ### Essentially identical to stats::print.ecdf(). print.elev <- function(x, digits = getOption("digits") - 2, ...) { ## Utility function numform <- function(x) paste(formatC(x, digits = digits), collapse = ", ") ## The rest is adapted from ecdf() varname <- if (attr(x, "grouped")) "cj" else "x" cat("Empirical LEV \nCall: ") print(attr(x, "call"), ...) n <- length(xx <- eval(parse(text = varname), envir = environment(x))) i1 <- 1L:min(3L, n) i2 <- if (n >= 4L) max(4L, n - 1L):n else integer(0) cat(" ", varname, "[1:", n, "] = ", numform(xx[i1]), if (n > 3L) ", ", if (n > 5L) " ..., ", numform(xx[i2]), "\n", sep = "") invisible(x) } ### Essentially identical to stats::summary.ecdf(). summary.elev <- function (object, ...) { cat("Empirical LEV:\t ", eval(expression(n), envir = environment(object)), "unique values with summary\n") summary(knots(object), ...) } ### Essentially identical to stats::knots.stepfun(). knots.elev <- function(Fn, ...) { if (attr(Fn, "grouped")) eval(expression(cj), envir = environment(Fn)) else eval(expression(x), envir = environment(Fn)) } plot.elev <- function(x, ..., main = NULL, xlab = "x", ylab = "Empirical LEV") { if (missing(main)) main <- { cl <- attr(x, "call") deparse(if (!is.null(cl)) cl else sys.call()) } kn <- knots(x) Fn <- x(kn) plot(kn, Fn, ..., main = main, xlab = xlab, ylab = ylab) } actuar/MD50000644000176200001440000003413314522612723012051 0ustar liggesusersdcfca8b4604d0fb1d05778ad0e7ed267 *DESCRIPTION ac28959174a2eb45950484feb0792d8b *NAMESPACE 897ed422ca2c1beb724be294ffa9e9ac *R/BetaMoments.R 4eb3807e52e187a67327d326e5cec116 *R/Burr.R 3965f43c4eb19c7a7dd3f0b0d9ce82ed *R/CTE.R d71c766092688d8ace86e9390d9494fc *R/ChisqSupp.R e1449bca14a1d2067b5ca96d81465394 *R/ExponentialSupp.R b478732d335382c1fd29ae2ffcb594b8 *R/Extract.grouped.data.R ddfc518f5632c092117bd3683ab71b6a *R/FellerPareto.R 6536049b3a817c22298cfbc7d708b9de *R/GammaSupp.R 1d798ad9fb619c57b6234ce538c7843f *R/GeneralizedBeta.R b60c8cf61518d3fcb6c46e1cc8d0b4fe *R/GeneralizedPareto.R bc8505634d74b7bd8201400bfb0411cf *R/Gumbel.R 1f7797c8d96468caec51272ca6112b0e *R/InverseBurr.R b67bfde359869dca1d51d5a6270f5d40 *R/InverseExponential.R b559da828d4e3e283fb93b0691049d03 *R/InverseGamma.R c9152b7948c9154da4df196d7d0615c0 *R/InverseGaussian.R 0210a7e85bb7071ba9be657c71e7de40 *R/InverseParalogistic.R 9e70aca6c90b9233fab986fef20b5786 *R/InversePareto.R 49bab767297187138d857c408e633f46 *R/InverseTransformedGamma.R 535173040b228938cee28e2bc565d66c *R/InverseWeibull.R d53ffa132009c951d906001622f90168 *R/Logarithmic.R 779255efbe27b5127d5a4c018de58eec *R/Loggamma.R 7b310e8e8c1c2f21ca4d5a6c2d45687d *R/Loglogistic.R 51fa5c8ec5ac728cc9a206c9b3a685df *R/LognormalMoments.R ba49f5d675f03254c59efaf17eb09ab4 *R/NormalSupp.R 7e118f3973ead42d8c27175834d14b3e *R/Paralogistic.R a6639ef45829476468f3569f6a72e0db *R/Pareto.R 366fa3267df223b0138ad727d7017cfc *R/Pareto2.R ea1af518ab2a801760f9096e25a7fcf9 *R/Pareto3.R 6b60deaa3fc14350121d6e0eb1053a86 *R/Pareto4.R 54701777966346cc4113acf73cc54d0f *R/PhaseType.R 4d5ae06ab8158d0460b1141454cfe292 *R/PoissonInverseGaussian.R 15162616a66854c75a163b54c55bf1a7 *R/SingleParameterPareto.R 5d890d751ef3f233e565bf337934928b *R/TransformedBeta.R 97f04c8a4d99357e1dc7dc157e99777c *R/TransformedGamma.R 42309c4a3f95e3c0f2a3d85de52c8ae8 *R/UniformSupp.R f7825e63fc68307bc8d8fb7e3e4dc993 *R/VaR.R 3a6a050a94d357f2722c5bd679188c41 *R/WeibullMoments.R 28cff186b532b3f2f11de659ec8117f0 *R/ZeroModifiedBinomial.R 23ddfd9674a66c845f109175b200273b *R/ZeroModifiedGeometric.R 30c2ee36ccd94a418a7fe8d831053e81 *R/ZeroModifiedLogarithmic.R 7ef383933d9f3e57ca467eb2f48126bb *R/ZeroModifiedNegativeBinomial.R 86951dbd48d9072ae2c39587b6ce479a *R/ZeroModifiedPoisson.R a7404543a59fdf1098ff194b4a5b07d7 *R/ZeroTruncatedBinomial.R cdef9997fe9a5aad4fd59a783b5b5641 *R/ZeroTruncatedGeometric.R 8a15f7c97fbc80d384a7b1ab65e58222 *R/ZeroTruncatedNegativeBinomial.R 9a8b00de6d10f69f370de9b34b70638c *R/ZeroTruncatedPoisson.R 46bcac0d79b89d79300dffd00679d84d *R/adjCoef.R 082d3a685d776e423bf227e86a53b255 *R/aggregateDist.R 9386b587af91970a246cffe22125c99c *R/bayes.R cad82d69924eea24d9331043aa8d932f *R/betaint.R deefe58e5493ecbe1b1a66349af978d4 *R/bstraub.R ac750ed3da4634c752efab8170ca33cb *R/cm.R 284bb3b15eca6671625e165948e88538 *R/coverage.R 97e6d19c54e56f2bbabc18421e9750c1 *R/discretize.R ebb17d2210a64597ec60bf7a1afb81d9 *R/elev.R 1f16152b56d6b585cb3b34019c9f4c9a *R/emm.R 6c108ca22200bb02cffe0c0a615f818f *R/exact.R 514f21d7247da2c1a2dc1e5d7b671c8c *R/grouped.data.R cee57eb2dbbbce79ba41398e6ed4ee99 *R/hache.R 4ee527efa52117e2afadb4e3f9dcbc54 *R/hache.barycenter.R dfbc96214f68bd8ba5753cad4a214fbe *R/hache.origin.R 08e0a5941190b2ac7c6760a1814cf3fc *R/hierarc.R 9dd9dde7e2fa6f0cb97d283a6d153a67 *R/hist.grouped.data.R abd5e8b6d8c097f12d49fae70402ab8a *R/mde.R b5ba4fcb93636b9109a612b59ead39a1 *R/mean.grouped.data.R 51ae31191cbe874bb0776ad9ac1f4329 *R/normal.R ab0cfeac34a96a29763454cae34e9d96 *R/ogive.R 1ff77003e9dc0520ab130042b488c469 *R/panjer.R 25e2fd00a7ec8be892f3046f9dbc2d45 *R/quantile.aggregateDist.R 189c7d99b3ac103a4bc89a054cce6b07 *R/quantile.grouped.data.R 2e057c192eec665f9f80aa94337aa0c6 *R/rcomphierarc.R 604be8757d8ed0337443af0f990906c7 *R/rcomphierarc.summaries.R 8c1266b5a2074e6c76ca7a18bbdc1942 *R/rcompound.R ba40593cd7cc3bf25c223697acc512c6 *R/rmixture.R 66078c7d02c0e63130d6d348d678d159 *R/ruin.R d8496850dc700280270491250a63ff56 *R/severity.R 8100464532661fe82f6fb460bc9713a2 *R/simS.R a9c79777e1bbc8f7aa5e38e99132fca8 *R/unroll.R 8b98adb2e60847215a378dac68626d07 *R/var-methods.R 56afa44a8ad4a560167532ca193edaa2 *build/partial.rdb 86980a7f2c392a01e05c27e7efd083d0 *build/vignette.rds da6fbdff847094e9912fa30c9face3a3 *data/dental.rda e886a1fe6ab8ec18a541f6b8ea5c6683 *data/gdental.rda 6380487493d31ef00477ec198b042f95 *data/hachemeister.rda 206fe0a149ac938f90adeec103672e39 *demo/00Index 70cdea149ce67c7ea8dfdb6d3d2d0204 *demo/credibility.R b255336d6294311b8e51c4e63c385b3b *demo/lossdist.R 3a93e5a0fe9eefddb6f977e9f7d02147 *demo/risk.R 4c5d46011a661ed3fc81c6ed29a3f556 *demo/simulation.R 265512e43f452a2c49a40dcdb3816a8d *inst/CITATION 2a7a3a4bfc457254fb8d8fd273674465 *inst/NEWS.0.Rd 93822768a8a7bc79173a88839d75679d *inst/NEWS.1.Rd 46233fd433b7a57d4ac93562a459f61c *inst/NEWS.2.Rd 7adb829ff51139867cf62c2d5e41197b *inst/NEWS.Rd 54c6102cdf7b26efb50d96f537b9f77a *inst/doc/actuar.R 25eda75d3a9dafb321cf02767f2e0699 *inst/doc/actuar.Rnw 212d0fdd1fb489581d3eb77e6a2f2e8e *inst/doc/actuar.pdf 2d03a5e39d6ff94432112d0936a0e1cc *inst/doc/coverage.R 5f5a49b3fb7528a82c4aae99eccd4d01 *inst/doc/coverage.Rnw 24cc992e39172628d53ed79448f0e781 *inst/doc/coverage.pdf f2a9264da940ee12a2dd00b30dc01e3a *inst/doc/credibility.R e12a851322bcdcddac53a8ce00125d1c *inst/doc/credibility.Rnw ca8e5d2bdfb878d1f134e37e1ddca77b *inst/doc/credibility.pdf c1ae0939cc016d1af67480e6cc9e17f1 *inst/doc/distributions.Rnw 96599a16018610ad5839c85fdf11b7a9 *inst/doc/distributions.pdf f19c665d32a053449a72780d03eb8752 *inst/doc/modeling.R 59d5dc35cb6c38c4772c84193b20358c *inst/doc/modeling.Rnw bdb087fdfe4af747a7ecb64733e4a13b *inst/doc/modeling.pdf 413292084d97e9652ac52adfc6212907 *inst/doc/risk.R 1a59e2be1fa4daa72d09192e1031878d *inst/doc/risk.Rnw bb69b9d5c565c51c43a44c94c7e43d18 *inst/doc/risk.pdf 385bc9e73b0b1ad656700896bd7c411e *inst/doc/simulation.R eeb6b668b3c0147ed912786a3f450dad *inst/doc/simulation.Rnw f81fecde0f752b7b98debbfe3e696e35 *inst/doc/simulation.pdf bebc84cdf387870641034e7de14570b2 *inst/include/actuarAPI.h fe020c2287ee8dc8c57a9920ed8efc2e *inst/po/en@quot/LC_MESSAGES/R-actuar.mo 357c632c0ac3304401e6fc77ac6fb5f4 *inst/po/en@quot/LC_MESSAGES/actuar.mo 308b748c6f30cd5690aba506cefdbb90 *inst/po/fr/LC_MESSAGES/R-actuar.mo f8cd3795d32963c6fc32b064f8ba9bfc *inst/po/fr/LC_MESSAGES/actuar.mo d63628bf63171d06a2d4caac032ca298 *inst/po/it/LC_MESSAGES/R-actuar.mo f0c66c364544558c97bc0be2db8632ef *inst/po/it/LC_MESSAGES/actuar.mo a755dd2fbf5c32b50ebc32b75b905812 *man/BetaMoments.Rd a5b36249c0e0e080efe0d433085e291a *man/Burr.Rd d879ce2614ecb9cada7c2299aa8ef717 *man/CTE.Rd f90e3267c218e2bbec36827befbd5681 *man/ChisqSupp.Rd a36da40ba94b948d645c0c7291884f6a *man/ExponentialSupp.Rd e64e51f65b83ef97abfebd0f0f0c38da *man/Extract.grouped.data.Rd 5b0c96bcc91218a4ad8d144b5416c392 *man/FellerPareto.Rd f99fdaf70013ee8d9b93862edaa1ce4d *man/GammaSupp.Rd c07b818c28d902ba89d2e4bd6f91996c *man/GeneralizedBeta.Rd 3dd31f6e5df7ab4a85b3d0e4c9cf017d *man/GeneralizedPareto.Rd 8fbf644555828cdb77b5ca846961e322 *man/Gumbel.Rd 8dcb5ce64fc21451b6b5bdb8d8120e83 *man/InverseBurr.Rd 8cbeea0bec948b962a48920ff3a1aeb7 *man/InverseExponential.Rd 1a388b76d074be8c7327ed4e70612236 *man/InverseGamma.Rd e8c30457b4ba503944779545e11ffd8f *man/InverseGaussian.Rd 4828f4076903a9b35ad0b7c37734e393 *man/InverseParalogistic.Rd bbf0d27f10ffb11afcd9f7369f1b3dbd *man/InversePareto.Rd 5f7b9c1c63fe38a8eca486eeb2ff199f *man/InverseTransformedGamma.Rd 23ffafbba3401b859954b533247a90b8 *man/InverseWeibull.Rd b7ead1a4c209a7eb1e25898113637b44 *man/Logarithmic.Rd cccb4d2ddcd349c5a207f33ab3077dd1 *man/Loggamma.Rd 0dbde815295726f32cf5f563ec102225 *man/Loglogistic.Rd d6c1fe8d8b341ded225bc193d3fa4588 *man/LognormalMoments.Rd ab9f79c93ad324f4799a1fbbed2141d1 *man/NormalSupp.Rd fc8d0fdedfef3ee1d53a79a1b702cf1b *man/Paralogistic.Rd ad5cfa789efa6493aefe1acb91a5a6bc *man/Pareto.Rd 8e4341f214ca4c0f37479f6a315f0d6a *man/Pareto2.Rd bc68a38c54a1da299fa938a8862cbe3d *man/Pareto3.Rd c6c2e08dd5218b3f0bf984b9c635b301 *man/Pareto4.Rd ca22543943f8235456aa588c1aebdb30 *man/PhaseType.Rd f66617fa4003eec4a7e466f5e15f9c46 *man/PoissonInverseGaussian.Rd de268358595d4c258b70eafe1d3ccc20 *man/SingleParameterPareto.Rd 879a15c9e184fd89663a3b2722fdb9d6 *man/TransformedBeta.Rd ae97789b1f01240d83101889836cdac4 *man/TransformedGamma.Rd ed2257d1b871c738b3568946e9060854 *man/UniformSupp.Rd 17e4ad925959dd184c1e311661937a4d *man/VaR.Rd 30ccb130026f702bd6880cdebd5e0cdc *man/WeibullMoments.Rd 84a695bd7218b7d86adf69558261bad8 *man/ZeroModifiedBinomial.Rd a32fd5e382630aeb2cea6a364b5a8480 *man/ZeroModifiedGeometric.Rd cef1debcf683144a1391aa04bcfb27cc *man/ZeroModifiedLogarithmic.Rd 4f715f784f55d6f1c35c5b0e76f3148c *man/ZeroModifiedNegativeBinomial.Rd fe31b64dd377996a320d7f0ec536b39a *man/ZeroModifiedPoisson.Rd f4667c1a70dfb2c9ceb8f6d1f3476324 *man/ZeroTruncatedBinomial.Rd 6b3e1b6c4afd2bdcb3edf322a4f72dfc *man/ZeroTruncatedGeometric.Rd 9c13ff5ed2532cce33a4b33ac53ceaa0 *man/ZeroTruncatedNegativeBinomial.Rd 1566726255c8498c2aaaaf56700b4061 *man/ZeroTruncatedPoisson.Rd d4abca98c7c87e4ac564a044fcf31679 *man/actuar-package.Rd 536b3b28791e306bcaf157ec480aa6a3 *man/adjCoef.Rd 2e390d1f0143bed5093fd67edd421621 *man/aggregateDist.Rd 890c44a3c34c9ed4627bda5772008676 *man/betaint.Rd 4a3e07182e0062b285763b84f7204871 *man/cm.Rd 6e32ade77f871805b5650f784f806abe *man/coverage.Rd 6044e3f1b95f253a80c0d578edbbd7a6 *man/dental.Rd d7e21ad16f1eb6c4fbd8122c13d16c30 *man/discretize.Rd db5fd4f06810d8020f1cd70d4d2e8453 *man/elev.Rd c15d6cd098d1bf0e524c205ef85e1a59 *man/emm.Rd 39643c4bc3d0cb51764f6e64aa2dd354 *man/gdental.Rd 35b3f616d3637b5b32966681f3cdcea6 *man/grouped.data.Rd daaaa29d395f33c225e96f69fa9d74a6 *man/hachemeister.Rd 2c4852e710c1ffcc693ae6be10213465 *man/hist.grouped.data.Rd 2090db683b954338399a99539b34e7ad *man/mde.Rd f48a9ca0f857ada94234a4b37f41e8c2 *man/mean.grouped.data.Rd 45e87a1fca0cc9f9d9aabeb1f8deb79d *man/ogive.Rd baa2b018d4db06e55bf4cb9e7c118a4b *man/quantile.aggregateDist.Rd c1d373c5dab78d5ba1e8ce5288ac4259 *man/quantile.grouped.data.Rd 407b19473359f63c87c3c2f3808c529d *man/rcomphierarc.Rd bb2b512a9587144411acab2fe2edf8ac *man/rcomphierarc.summaries.Rd b5c74e757b8ab483c2166d376c62dd69 *man/rcompound.Rd 04a50062890975798781d7f5d9c6982f *man/rmixture.Rd 13e8544e89fce8bc0cd928e8894a5fab *man/ruin.Rd 62fe79bec4453860df38c4add86c7091 *man/severity.Rd 52c4034e29078164436cbce1e4444952 *man/unroll.Rd 2f799ad801d4c4172aaf761e6b0937ef *man/var-methods.Rd 8a07fbcaf126feac5a4918f8ff47ae1a *po/R-actuar.pot 5811abc029854005f3fa88532484eaa2 *po/R-fr.po 498af72bedff605815abc310a87e1083 *po/R-it.po a2884ce3ae9ad6cb5b7d9dca665c5847 *po/actuar.pot b3a2b0896fcecbff1a21a09b1585c8a1 *po/fr.po e39b16aaa4db083d6c065e4022dacee6 *po/it.po 7fbcbeb771d645b3019868c753dc7dac *src/Makevars bece94f05eade2c2b72b692454215695 *src/actuar-win.def d866223f447064c1cc4e0b2703a5ef79 *src/actuar.h c8b2ead45feff5557b4426059f358fc8 *src/beta.c 61ab09b1f522a6e629645af18e3de86d *src/betaint.c 9c30d6493c7c88062061bc212a2f94ac *src/burr.c 48c24c75e7e5e6985c079645e33fd154 *src/chisq.c 8029bb10b2cd694bbba56ffa068eb07c *src/dpq.c e2bd462f6346394bd27213627fb129de *src/dpq.h b81663eae892b544cc8317366bfe27fe *src/dpqphtype.c 20fde04e013227cc195a5d7f4c6dd76d *src/exp.c 8523c8415c74846418f7668e804962e2 *src/fpareto.c 312fe85f8307c7e45d53f118789b92e9 *src/gamma.c b30606d5ef612b7e36ad521a6fa4f15c *src/genbeta.c 07617c7f9bd3850dbf5c125205ee4a50 *src/genpareto.c 5881f88789e12197629dabb82f37bfe2 *src/gumbel.c 66e3624e2411e885fa5de545c2588926 *src/hierarc.c 09d1cf8e8af5b90664cc144bbcf0c7f9 *src/init.c add45c5792404f0e50488101561cda98 *src/invburr.c d24f3ec76f1a390865236e761507eca9 *src/invexp.c 773bf6dfd624e013153dc6fad0b41ef0 *src/invgamma.c f9e244ea444ad4405110157180ad2dcb *src/invgauss.c bf661856dd4cd75b261ed8da58075631 *src/invparalogis.c f341f9a518224a9666a1f3503d136ffe *src/invpareto.c d468b0b2f832b71e1f2d718a3ce05d07 *src/invtrgamma.c 94698806446eb8b6a9399020fde2117a *src/invweibull.c 1dfe640aeab42b10962917c55488789e *src/lgamma.c 3c1665ee7820b06bf9b4cd19f0b5bab8 *src/llogis.c f75ec671f0aae41a9096ccfa759ebdba *src/lnorm.c bbb5f2e900fe0cc5bc568d702d3ec3ab *src/locale.h c956040194d6b1768478e219e629dd0c *src/logarithmic.c 9c713a0375e6f60f9da951502bea6317 *src/names.c 9093d8b368d18412c108c79c0f06ae8f *src/norm.c faee18c808ccb6d6bc99e5967d430831 *src/panjer.c 8d8c6e88112590c5ba1b37a45e32fe36 *src/paralogis.c 082700f0e53fa1245858c85fc3db73bc *src/pareto.c a46729c17991f37c65ae2228275fbf2a *src/pareto1.c 2c63b5b1f9e4ac3b92db32142146e1d9 *src/pareto2.c eed5c0fcf81b02a01d4f650fffe09e61 *src/pareto3.c 8b5ee13ac8d7ebcfe884bcb9ed43f409 *src/pareto4.c 08c56928909e1a32dafd3464db6517b5 *src/phtype.c 6de5b082750d2278e4bdba9563812c75 *src/poisinvgauss.c 6204e871d7308aa3332ef53ed5d4104d *src/qDiscrete_search.h b21f46cf8a20a95a1cded0a65b11c766 *src/random.c 8a34f804eead95891e41c14cefc60b68 *src/randomphtype.c 61079014ae71296852fcbf372276be60 *src/trbeta.c 57d10d46317c060649b4389db9074797 *src/trgamma.c 7a82ca42fbdae512854bdf4794c0a558 *src/unif.c 1ac736574129de7ec9da305997d4bc9c *src/util.c 42214b9442bcede3be64125ec8e46e6d *src/weibull.c 45f3029e575824db6fe0feede36a4ae6 *src/zmbinom.c 5f5fdb76d5d4407135142d766f8f50cc *src/zmgeom.c 40a80c5356a9c330aced6c19e78cfb2e *src/zmlogarithmic.c 6cf539c2d33a53554cc2625590b26467 *src/zmnbinom.c 391ea0f45aae3e34a36666ab18d3983f *src/zmpois.c 4bbe38f08cc7ad43aef6db373d44bdc4 *src/ztbinom.c 4a69d3aec3f73d49c25b7857ff94d676 *src/ztgeom.c 0529064ab267e2c86289b84a0f1f4845 *src/ztnbinom.c db270accfbd63b183828f9ba9715b238 *src/ztpois.c b2dc8c5900c8e9933c38165a381d8176 *tests/betaint-tests.R ded044b5296e59754ae2b6a07b5abfac *tests/dpqr-tests.R 19128e4a29a71c7db9e2301ee0debac5 *tests/rcompound-tests.R ab41d2f76222ec733cb701a556adc346 *tests/rmixture-tests.R 4ceb348e84a64d194abefd833cb95889 *vignettes/Makefile 25eda75d3a9dafb321cf02767f2e0699 *vignettes/actuar.Rnw a0c2d4077778b55dd70f98e6bc705e4f *vignettes/actuar.bib 5f5a49b3fb7528a82c4aae99eccd4d01 *vignettes/coverage.Rnw e12a851322bcdcddac53a8ce00125d1c *vignettes/credibility.Rnw c1ae0939cc016d1af67480e6cc9e17f1 *vignettes/distributions.Rnw 7ec15c16d0d66790f28e90343c5434a3 *vignettes/framed.sty 59d5dc35cb6c38c4772c84193b20358c *vignettes/modeling.Rnw 1a59e2be1fa4daa72d09192e1031878d *vignettes/risk.Rnw 82d60ae8b20b40e23e4cc1278317b449 *vignettes/share/preamble.tex eeb6b668b3c0147ed912786a3f450dad *vignettes/simulation.Rnw actuar/inst/0000755000176200001440000000000014522560035012510 5ustar liggesusersactuar/inst/NEWS.2.Rd0000644000176200001440000003063514264305077013730 0ustar liggesusers\name{NEWS} \title{\pkg{actuar} News} \encoding{UTF-8} \section{LATER NEWS}{ This file covers NEWS for the 2.x series. News for \pkg{actuar} 3.0-0 and later can be found in file \file{NEWS.Rd}. } \section{CHANGES IN \pkg{actuar} VERSION 2.3-3}{ \subsection{BUG FIXES}{ \itemize{ \item{Fixed declaration of the interface to a function imported from \pkg{expint} to comply with option \code{-fno-common} that will be the default in gcc starting with version 10.0.x. Thanks to Joshua Ulrich \email{josh.m.ulrich@gmail.com}, maintainer of \pkg{xts} and \pkg{TTR} for proposing the fix.} \item{Correction of the formula for the moment of order \eqn{k} for grouped data in \code{?emm}. Thanks to Walter Garcia-Fontes for the heads up.} } } } \section{CHANGES IN \pkg{actuar} VERSION 2.3-2}{ \subsection{BUG FIXES}{ \itemize{ \item{Fixed generation of random variates for the logarithmic distribution with \code{rlogarithmic} when \eqn{p > 0.95}. Thanks to Sam Thompson \email{samuel.thompson14@imperial.ac.uk} for the report and patch.} \item{Fixed generation of random variates for the zero modified geometric distribution with \code{rzmgeom} when \eqn{p_0^M > p}{p0m > p}. Thanks to Christophe Dutang \email{dutang@ceremade.dauphine.fr} for the report.} \item{Fixed the formula for the variance of the zero truncated negative binomial distribution in the man page. Thanks to Daan Gerard Uitenbroek \email{Daanuitenbroek@ggd.amsterdam.nl} for the report.} \item{Fixed a typo in vignette \dQuote{distributions} in the formula of the survival function for zero-modified discrete distributions.} } } \subsection{USER VISIBLE CHANGES}{ \itemize{ \item{Add circular references between Pareto and Single Parameter Pareto man pages. There was no reference to the Single Parameter Pareto distribution in the man page for the Pareto and this generated questions from time to time on how to compute the former. The new note and 'see also' should solve this.} } } } \section{CHANGES IN \pkg{actuar} VERSION 2.3-1}{ \subsection{NEW FEATURES}{ \itemize{ \item{Vignette \dQuote{credibility} now contains an appendix summarizing the formulas in the linear Bayes cases.} } } \subsection{BUG FIXES}{ \itemize{ \item{\code{cm} with \code{formula = "bayes"} stopped in the Gamma/Gamma case even though the parameter \code{shape.lik} was provided. Thanks to Vincent Masse \email{vincent.masse.4@ulaval.ca} for the report.} \item{Component \code{weights} of the return value of \code{cm} in the \code{formula = "bayes"} case was wrong. This had no impact on premium calculation and was visible in the output of \code{summary} only. Also, it caused an error when \code{data} was \code{NULL} or missing.} } } } \section{CHANGES IN \pkg{actuar} VERSION 2.3-0}{ \subsection{NEW FEATURES}{ \itemize{ \item{\code{cm} can now fit linear Bayes models for the following combinations of likelihood and prior distributions: Poisson/Gamma, Exponential/Gamma, Bernoulli/Beta, Geometric/Beta, Normal/Normal, Gamma/Gamma, Binomial/Beta, Negative Binomial/Beta and the less common case Single Parameter Pareto/Gamma (where the Bayes estimator is linear, but not a credibility premium). Thanks to Christophe Dutang \email{dutang@ceremade.dauphine.fr} for the idea.} \item{\code{rcomphierarc.summaries} is now an alias for the man page of \code{simul.summaries}.} } } \subsection{USER VISIBLE CHANGES}{ \itemize{ \item{In \code{summary} results for credibility models, a level \dQuote{section title} is no longer printed for one-level models.} \item{All instances of function \code{simul} in vignette \code{\dQuote{simulation}} replaced by \code{rcomphierarc}.} } } } \section{CHANGES IN \pkg{actuar} VERSION 2.2-0}{ \subsection{NEW FEATURES}{ \itemize{ \item{Functions \code{rcompound} and \code{rcomppois} gain an argument \code{SIMPLIFY} that is \code{TRUE} by default. When \code{FALSE}, the functions return not only variates from the aggregate claim amount random variable, but also the variates from the underlying frequency and severity distributions.} \item{Functions \code{rcompound} and \code{rcomppois} now admit an object name in argument for \code{model.sev} and \code{model.freq}.} } } \subsection{BUG FIX}{ \itemize{ \item{Display of verbatim blocks in vignettes.} } } \subsection{USER VISIBLE CHANGES}{ \itemize{ \item{In the man page for \code{dgenpareto}, additional note on the link between the Generalized Pareto distribution in the package and the version used in Embrechts et al. (1997) and Wikipedia. Thanks to Marcel Trevissen \email{kamath1602@gmail.com} for the pointer.} } } } \section{CHANGES IN \pkg{actuar} VERSION 2.1-1}{ \subsection{BUG FIX}{ \itemize{ \item{Usage of \code{R_useDynamicSymbols} to preclude compilation \code{NOTE}s, better registration of native routines and reduced symbol visibility.} \item{Vignettes no longer use LaTeX package framed as it was not found on OS X in CRAN builds.} } } } \section{CHANGES IN \pkg{actuar} VERSION 2.1-0}{ \subsection{BUG FIX}{ \itemize{ \item{\code{qinvgauss} was not computing quantiles as far in the right tail as \code{statmod:::qinvgauss}. This is now fixed. Thanks to Gordon Smyth \email{smyth@wehi.edu.au} for pointing it out.} } } \subsection{USER VISIBLE CHANGES}{ \itemize{ \item{Support for the incomplete gamma function and the exponential integral has been moved to package \pkg{expint}. Therefore, \pkg{actuar} now imports these functionalities through the \pkg{expint} API.} \item{Consequence of the above, the non exported functions \code{gammaint} and \code{expint} are deleted from the package.} \item{Section 6 on special integrals of the \code{\dQuote{distributions}} package vignette was revised to better introduce the incomplete gamma function, the incomplete beta function and the related integrals.} } } } \section{CHANGES IN \pkg{actuar} VERSION 2.0-0}{ \subsection{NEW FEATURES}{ \itemize{ \item{New support functions \code{[dpqrm,lev,mgf]invgauss} for the inverse Gaussian distribution. The first three functions are C (read: faster) implementations of functions of the same name in package \pkg{statmod}.} \item{New support functions \code{[dpqrm,mgf]gumbel} for the Gumbel extreme value distribution.} \item{Extended range of admissible values for many limited expected value functions thanks to new C-level functions \code{expint}, \code{betaint} and \code{gammaint}. These provide special integrals presented in the introduction of Appendix A of Klugman et al. (2012); see also \code{vignette("distributions")}. Affected functions are: \code{levtrbeta}, \code{levgenpareto}, \code{levburr}, \code{levinvburr}, \code{levpareto}, \code{levinvpareto}, \code{levllogis}, \code{levparalogis}, \code{levinvparalogis} in the Transformed Beta family, and \code{levinvtrgamma}, \code{levinvgamma}, \code{levinvweibull} in the Transformed Gamma family.} \item{New functions \code{expint}, \code{betaint} and \code{gammaint} to compute the special integrals mentioned above. These are merely convenience R interfaces to the C level functions. They are \emph{not} exported by the package.} \item{New support functions \code{[dpqr]poisinvgauss} for the Poisson-inverse Gaussian discrete distribution.} \item{New support functions \code{[dpqr]logarithmic} and \code{[dpqr]zmlogarithmic} for the logarithmic (or log-series) and zero-modified logarithmic distributions.} \item{New support functions \code{[dpqr]ztpois} and \code{[dpqr]zmpois} for the zero-truncated and zero-modified Poisson distributions.} \item{New support functions \code{[dpqr]ztnbinom} and \code{[dpqr]zmnbinom} for the zero-truncated and zero-modified negative binomial distributions.} \item{New support functions \code{[dpqr]ztgeom} and \code{[dpqr]zmgeom} for the zero-truncated and zero-modified geometric distributions.} \item{New support functions \code{[dpqr]ztbinom} and \code{[dpqr]zmbinom} for the zero-truncated and zero-modified binomial distributions.} \item{New vignette \code{"distributions"} that reviews in great detail the continuous and discrete distributions provided in the package, along with implementation details.} \item{\code{aggregateDist} now accepts \code{"zero-truncated binomial"}, \code{"zero-truncated geometric"}, \code{"zero-truncated negative binomial"}, \code{"zero-truncated poisson"}, \code{"zero-modified binomial"}, \code{"zero-modified geometric"}, \code{"zero-modified negative binomial"}, \code{"zero-modified poisson"} and \code{"zero-modified logarithmic"} for argument \code{model.freq} with the \code{"recursive"} method.} \item{New function \code{rmixture} to generate random variates from discrete mixtures, that is from random variables with densities of the form \eqn{f(x) = p_1 f_1(x) + ... + p_n f_n(x)}.} \item{New function \code{rcompound} to generate random variates from (non hierarchical) compound models of the form \eqn{S = X_1 + \dots + X_N}. Function \code{simul} could already do that, but \code{rcompound} is substantially faster for non hierarchical models.} \item{New function \code{rcomppois} that is a simplified version of \code{rcompound} for the very common compound Poisson case.} \item{\code{simul} now accepts an atomic (named or not) vector for argument \code{nodes} when simulating from a non hierarchical compound model. But really, one should use \code{rcompound} for such cases.} \item{New alias \code{rcomphierarc} for \code{simul} that better fits within the usual naming scheme of random generation functions.} \item{Functions \code{grouped.data} and \code{ogive} now accept individual data in argument. The former will group the data using \code{hist} (therefore, all the algorithms to compute the number of breakpoints available in \code{hist} are also available in \code{grouped.data}). \code{ogive} will first create a grouped data object and then compute the ogive. While there is no guarantee that the two functions are backward compatible (the number and position of the arguments have changed), standard calls should not be affected.} } } \subsection{USER VISIBLE CHANGES}{ \itemize{ \item{The material on probability laws in vignette \code{"lossdist"} has been moved to the new vignette \code{"distributions"} (see the previous section).} \item{The first argument of the \code{mgffoo} functions has changed from \code{x} to \code{t}. This is a more common notation for moment generating functions.} \item{In \code{aggregateDist} with the \code{"recursive"} method, if the length of \code{p0} is greater than one, only the first element is used, with a warning.} \item{\code{aggregateDist} with the \code{"recursive"} method and \code{model.freq = "logarithmic"} now uses the new \code{dlogarithmic} family of functions. Therefore, parametrization has changed from the one of Klugman et al. (2012) to the standard parametrization for the logarithmic distribution. Basically, any value of \code{prob} for the logarithmic parameter in previous versions of \pkg{actuar} should now be \code{1 - prob}.} \item{The aim of vignette \code{"simulation"} is changed from \dQuote{simulation of compound hierarchical models} to \dQuote{simulation of insurance data with \pkg{actuar}} as it also covers the new functions \code{rmixture} and \code{rcompound}.} \item{Vignette \code{"lossdist"} is renamed to \code{"modeling"} and it is revised to cover the new functionalities of \code{grouped.data} and \code{ogive}.} } } \subsection{BUG FIX}{ \itemize{ \item{An old and nasty out-of-bounds bug could crash R when using the \code{"recursive"} method of \code{aggregateDist} with a frequency distribution from the \eqn{(a, b, 1)} family. The bug went unnoticed before because there was no example for the \eqn{(a, b, 1)} case in the man page.} } } \subsection{DEPRECATED}{ \itemize{ \item{Functions \code{[m,lev,mgf]invGauss} that complemented functions \code{[dpqr]invGauss} of package \pkg{SuppDists} are deprecated in favor of the new complete set of functions \code{[dpqrm,lev,mgf]invgauss}.} } } } \section{OLDER NEWS}{ News for \pkg{actuar} 1.2-2 and earlier can be found in file \file{NEWS.1.Rd}. } actuar/inst/doc/0000755000176200001440000000000014522560035013255 5ustar liggesusersactuar/inst/doc/coverage.pdf0000644000176200001440000017624214522557761015573 0ustar liggesusers%PDF-1.5 % 17 0 obj <> stream xɎ+f& ` 6[9h$|"6V7Y}8hC@ׇgo~vF98a;}zZ; J }nlO|D,/`b}Mi;]@]:`;9S0(aXGzuoK߆>1D\psN Ԑ _BNGQy6}0?2!oOwa&Ġ3ŴҹFVQG`RHxeM!EoFHKbl\Jo k/!ⴲ >B/Lr\=)&Ƭ:8EO 2HaD!ՈbiZgY50H FϺ۩}ar'D}>u0Vp"8{h(K6#F8:_QVbǘev :Ll9۳LAl NRfy3rgLS9get8/V7%"/-y;٩ͲT[Y`vQ;ƾT˿v{g^6 ;Щ^fr{u/iEyZ"=.՗q xrvw-)m#lYaLJXU,T/'J#.@s;Q.S3ӵv4\pN#[Cs3cL FטZF{.MmAbdܩfӽ/&-gqPrt9.v#]v@zȀ|_ʶzP5LƜ)w2f xr|)RXaI-QGt[-R}N:a1&x.}n3ȻWfU.uM|pX}9c?Pӝ v %n3Ğ萣E$D_@"_~8ExWʙ\ D(5Hj<?ű4_6շGl8ݺ'L 5 /c Au~Rܸ{0h6 5_w^rmoa"ؾD[͏shlmopG endstream endobj 23 0 obj <> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 24 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 1430>> stream xڵWMo%5ϯki%D8P -S՞dhDC^^m]O .|<ޅ)9Œt%}_77G)޼XSǐ‡C[ ᛣJ95c!7f?jA~sFᘤDg-IHQ: +J*Q.) WZI; TggQcEJ[85IZ/֜"Ё/Ez{6˹&h6'yHj'Fa}&0|,^ul䟡[X?gnxm81MK%wƶwyŅ%"1Rl@Ǎ O_R?)~A5?ɿL&n2b}TًuޘHg$0'V]?Uzn|^!;KBbzG*/Zd((؉Ƌbݪc]0UCA `rE kE cz(%䏰d롘?; #:'aD!nPbȟD?+EMϲ>ݰS#I\ojSg#9L!eB0^hFچچyZv'L}oyy|>XVgOP3(*C ?wǗ_EC虮hZ|prnlf'KXM]7}VQ\k6r7vܬ=][ytPG\>~^X6/=Fs W 7Y6l}odlÐDx+]¾Jt w  701={>1WaI6_bu»viכ.zSNo $7ScכNzST<._uzS-;7M7]o m W777ܽ`h|sNoEފzzCsz+ > mF`#jz=tzvz]tztzt^o{:^+3|NoF?}v][u6N?~89k 7*eat$]sB‡wǟ2b" endstream endobj 28 0 obj <> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 29 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 1044>> stream xڥK5+EooR$ŒQ)D9ܓJ,9׮*G}xw B-1g,)ld? ??oH17/~<,>~5qChG Vs,%<!+W2 [lž GLrpQX rY)W9$W1sqd2]'"^ 蔸i*7-KAi2qs䅜U8h4BVrtDx!/g,RT39/6w.A煍V"lr8/άӓ2(9oQfam~՜%ٝ,%V96ޤ,'σ,dXŲQ>IwQ~>7Q3,%IgvufEΗY|!2`SmRcl/f-gIG'7婰şw-ȪBtğ| DZ%<(m7 A6?omE~\[ךC}"GZ"?Җt?H,z?訧jDTv=5.U~"QvjV-Q.8֝X(꫓QV?m t h5L'pMc] 5Zؓ'{g[_dF`hpvZ͓ ,W;ygj+%bd6=# N( yr ;XINJ?P|؏0^ /N+W塹w.,q= q%w|Tn*g_zp_[y_xr'촷פcÑQo%?|߃W\>T~ד/M_c {_,|;竂vۭw_0[?;^ڶsoVΤIaE'| qKya#HT5~ڒC]L Q)9 endstream endobj 30 0 obj <> stream xXMo6 WV$E ȡh@oV^{d=mXJI>ő #W=>/|L]_CDH~ >(p-G܏[w(<\O.pR".1=MPfM6U&(ؔ<;Eܩ5`mx?~QQ*>u|M;x|bYrW&'^mx։;,C|jMS_IVzix k Oft8}z>$,@6Dɞ60uӶwT?$q {vLp%">YrEPќ،v8LjEA.p"W..,׺p}g5|fмO^lGP#5^uP'hK=IzFpϺQ8 4~X7U ?;JShbe5uϸ?5u*3x'NS9%儳EQsnǒu:i̲u *&= oh4n[=20> lȳ",ZGh>$k٫#s  x9 CzGE;7fBWp\ o`f4ѻNȩڶ5qN6$2 hWi_|l<^# )h,1w},2H#c~|ZϿF}\ܤ:&&ȕ=9kn %/{PJ)-OUv0ދFP)[0y|N{18KgvemM )/!-]*ukX<}̳A?q!PD#]+U=~Us 1rK8@`hgՌLB]OҺ̈́)B3l=+puL߶c#_5E;8 M }~cYRչ]nW d%~;Px?-O++=n\ȴ1Q+TCעELzB^fVn̺x-+)o*'b_7g.C^‘i=3ŷ4yms2`헐>lak5tъeCh0h~_> endstream endobj 36 0 obj <> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 37 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 1437>> stream xڵXM\5_#bk"@Rؕ8 N v jq X ?wwk#m>PrtāϜbIAS>z|ׯÛ#ŔR?|{H)qcH!-=7Gsh%cZxpu\tA2ж-/-m'h=t?'=fWxcg Fru|%puӫ ^\w6\'6l

q;M8:No,M7]o > v -w797ڹ=|ڟ[)^oNoNoNoNoexV}zQV[^oNo{> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 42 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 1117>> stream xڥMo^5Wx mH@*JP 9ox;3 .| ĜBqⷤXS-8ՑbJ)\^Rא[=G8Zch%YJj,E[-c͔gX A;=Cτ) = EAX$k[MO9:hdHI9R4--f<,*%xKa*^ G/d.^Ȯx!XQSḍ9oG⼝@V_+}!Tq N.6ưP ^)nlsrPv[Tm Nx*ۧI7lVeݢ哢l [хۃ]OuzۭtOh-nx+׶,_<> stream xڵWMo6 WV$%Q9-hnE^{$OnPE>Spo ?/?>O%fv'k-wA@!q?D%Px%^[hP8u)IIpBR^V^^G,mp(DVe9+SGP#(#RY4IMY$@rL>ďM}3R-XwtЌ@^t/4&PAp}tP_Pi֎.20YOVFu{0TrNi܉iqZG_*^klmj. Z&s~K{/V\18M 'u1=^Gx3%_^Ȋ0r E qatz|e TJ,cSl5hp5}>ҴPb endstream endobj 49 0 obj <> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 50 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 1326>> stream xڵ͎\5)oR$´J@hA #sNv5DF"tk_-9Žqr1}g >'-8~W|w8ė>~oɥw<j'}8J]UGX4|7(eVZ|]QjE龮(-4dӊҐҐYoQŇڎ"d=!Yۊ22222[dEA+6DmE6Du?"U9EbP|G/C1e!f! K4Dξ6FGAKhi M1pI,EŋÍ U*vFй K(vI&,a88dh)1kd]#N{@>G׊pעhZhE cȹ#P_%$'i4*9ʓ5Yx. [HZ j(%id,%;=籖N|-ŕ]95m|QmX/v1rNP~GnNs$5. =b08v3f4/-,2փ∋/v8\IJɝ6sӰHel#l3t8I˦Vbي^N3A7IsGDly؉e e~%rP,kx׭5t e1c'1kۇ'mX6p~ o?78p` uz~+z7 .<nwT.p7Rݵq㕺qkcg$d5slΔ`q⹿q9d.>6z^ ^ wvm?/Nw^Pvǎ4/N _q=`"^Om"d㑅Ӟ⹎ ߦlm_שoSn endstream endobj 54 0 obj <> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 55 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 1443>> stream xڵ͎5^򿷉)HaQ)9eww5ն˧Unqoq{>| .vI?~u?߷~{}Bp_Ͽm&|}}JQypŗ|03]}[߳ru8)Xfo^ӎ'.>NxWnU9q#RcWMEpy_4>y}xAД\eMBƴ7/ 'u [QNӞ9?_OK3L23^ -qꃰsi('OA}H8T1闔!]':x7W^5JJXGS}8#j,F4ͯb`01&: 7|cvWzbeɕBQ?&L{~PhO!5p!U H {S3hƣ`{<ӴLcի6iO|LFоǣbcf@@OgC`1JK`8k]etBXœౌL=[ȝ[ӆ34 pZSvȢ;=|Xs[>|g9w; _ɘ|9͓QwB\xwzQq>Z%p6 G~n77Dyd//_^K}kQ&DUzy̞znQ+PdW p y 0sPa7rPe=B=P:LȖ5M Eヒ9>rz$jUKqz,+f2ʣC/C*](1#BdG3ʷlgu;F 2ʣJAxݭFyQY%> stream xXn#G +m߀Cl܌ V.1=S<Yg C*M[o?`ؓQGds;;kY||gΖ^g|wqXܬj ͢lIx>nwj+_+isξdVkǟm2lrg*ZC"]t`*ۥtH3epֽ2 0/$u!́XB^ɛBx^I9>OόIC8s;%QɑJ"ʏМ_c H"pƧgfܼqz^[KD|uNvRk5E 7/d:!q"aG0m5VPgSC ƕ4c0H"QH02sm}CPΡ `IP{Q̨hD7+0%zS=fq-(21vQό<*9ܵdK'ن՞zVϗV΄2o=ʴ[:  q&odu dbrAʌa y-y`} *r:@G7.~"Iv-r̘nKVT俩dȉsB|,o%\ȱߐRi{#zҖ—^?&-.7blf r$X,0v lڛ7Lm L VR9!<_`OAkF!ׄr\ Ⱦ̦=Ӊ+B^nq^MsX+Ї[F0)jzgמX5g0  S.ta\dnlHEPsc=0A2o-Ϸ@qmhsϢE҇06Ǵ[)Mwx:8X5$PPable wU0TWOU%r9T)nEۡj5\yUf12~(=>|7ؗ, endstream endobj 62 0 obj <> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 63 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 1314>> stream xڵ͎\5)oR$ŒJ@h4FDF"k_V9Žq܇r1}g >'-8~W|w8ė>~o[uOGIGɾˢS]J5E_Z_*yV龮UZq҄|Z4DViz[Qo JVQEz,Bi^5ݷ@k*QU^ VAk ;mۆًl농ZW}C+Ťv>dL?PMsWltD.5h t4 =A5b) (  m+!6Wй]8TzƜBq(. OD Í~FBr,|SB |NHҠEXYhiZ9&,rQD ]G. k3ߟ"1PPrgXYa2+5%'" #Xa$hʪ“|cCWQx"ə45XaE߇%Wx֬̒`B 1`[CR" gƴʜ_5:m$8azS]gUEi4F31ž3^c^`W蕣 lj lB_nv腾6z]^賌^ Jz^ˌ^ˌ^`Ke=R^^`>V/F/ѫo4zo4z^l endstream endobj 67 0 obj <> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 68 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 1496>> stream xڵˎ5^D 0#@&D( 9lw׏%b?uq]^9q܇r1}o >'-~?~|߻?Kp?{s{!"Cb%GQɏރ#X ;稜KS.ep*W_xڕc#uM#O;CVrv =ɧܓrĨ\'W/ \}PQF´9~ 5-Uyio6֧}^t=nup u}:Z1c0W$ʝr1yparSV)Y!Ory?<'CȮ,sCϲxO~D{,_ķjDߠ'Y(€}4څ2+OL_atk!Lһ<iu(Dt5y}sJ;rA.K 23,ƴ!wγb" } L yׄ$!-}QZ*%&c!g_ ]XWcg{<汋AkTmNFYҶcqcgntih]Wua KE2"?F, ^X}07X[r\p.}m<4 Aޖ谑g`jO B}_w7'MG#Y?dϗ=(ƚEߟ5xonFa(;44B$ϓNm*evRe ԙԆzhlZ 몙lL듒IRFjUKqy,f7FPFJ7dGY2ʣr[ʳ^^2ʳXGKxݭmXAFy閌h%Fyk4ry%7dG33vRʣ{ʣ1a(.igm5:f!<ڧQ3$KFy^ %<5j!> stream xڽXMoF WAPl@oAs+zHx/ {Iv$[J-25!G*!!#?go+̧/P>$6OgfHj%@rɳr=8G|MuocsI,\p'iK7k~^Jm%lßO;1lvwlmмTb˪lIS(J*6e8;`y /\b*` nG|\#I2JbFqjb(~dc&$8usS;7%9 >J11CG֞P}˓n+$oxNGѼv<2ǖyWp{ d?;3DA"E#Z!;?]`rN r{%*#SNfM尿>ۄozǀ%RKd lvFHK8 Bva޻ts`fIGێoȞ/p̢<5JQ#B{M8Vi!q)̴T=%q/} 6%֣N( "KL@,6x.)_' EaIm Qu~U(dxEj"8Q w)C 8T3(΢3͸I{U4jt\dcil:.7k%^Т_jIuHiKۇ4Df$>NrjR-kEP3M> stream x]n0y _vUU& EH-B%0Iݼm33sGc74p_m[ԋCcjKb+{:6QZMOTv>~ڂx([Sڑgi~=t̡#;5^]\{1ؚlc-y'tB:Qښ]Y-͑V$ֻaEzGP!Z&bڂ&%A[fZJ2 b#5ާ<KU\a>#DP񦺨fPöwy=W Ьx%B~|gRz|nSp b!ۀ<ͮޔ!O20 &11yǁgkԫg1ug7 endstream endobj 102 0 obj <> stream x]Mk09n)j ",aRw){hkb> stream x]]k0+r$V(cɩ+$|T 9=ysA񇖬Np [ mH/ T@_V,?`MV\5݉#GR'Az]K#4ufE$>8֓Q7(HƴkOܥPur3ҵp+J*w?5h endstream endobj 104 0 obj <> stream x]o0)rcI E؀{\j*跿dV{d2,ʮz'GrlFKU$yj;(izT,_?~?Ro{!io$t.<ݱ'CQShT#U۝ߡ×\v&1w3alPګVګVW Y; _;@=8T> stream x]ok0)c-NjaoxvBMBLgr"; `Ifh~Ir nv!#AXYs!mpb3#YG'AZByy`֡_xu2)lrOH RT!*9b4Ez5_k2'c4Fu; bc iSti[nߌl> stream xڝYwTTWaXpԹ{7XbT3 miCEt5AMQAK,1US5/3//[o7̺o{u^$Rt{N;,-ؼT*n)DRR"XXcYw̠߫%iQ5ry(IoB|+bGrOMohd;{[6K5!6nWj[Mh-?&frM 4/,-G@o_gpD*c@mDO${[{u_GmjCfzO0weflxoIzIIoII_I?I\2P(%Vk[^ZjT&%eIHJI-r@ BIKR+tt}Zdah8F!;dfCFPL"5ϕ̵O$H㥏-޷H6I]˦WTLkv{Bս齿>}U}oC KdbyaoH8u`6 Q pO18}q%RSnSf))ZlUe^n]l}9@bI33qߖtgߵS2GFg~畢Ou,@2a)F/`KQh,ɭ/U+ך|f d2y+U~/!Ku%t>^aZF,wMIWdxqʄ\+ ǭ2611*]jA &A_vCIĸħ;!sL#F9J`ÂaMzkFIo= ;+ Xj{,e\ufIhzTL zeH 5gKH(.]s:̱A㥬7Cx^qgqF%%Xw^8CJՎ˼ɰqtܗ/o'֥] jk%GE{ d=J 2ܱ FPo R݁4sr>}ѣؙ}ٙ.=̐&t>Q[bhATLA`ghoz?qTr߉,zy- 9ƋB5IGwsba"A;x2bʏ? _?w"oaꡆbc"}}G'ď8|(i͍Pfx"7ܯ0MIi4!$?({{ʞ &ҨFOd6٨}Ajӛn'ٙ=$&3UO{dVFYS!!G0M. 2W2?=6 z5-a9U~4Pö/yDvQEVNu݆TbϤZ?M5Rjzi#V&GQcX\ ; Jg ltSg)qi.UD =76~I j({2&_nV3dm)Jp:::b6 z ͏*} ~f8g?0d,O-EՐd\]+1 4C.}>4#À:QRAE%g7a^K$|mܱ ݫ!MzkdAHzkc $w\xwNQ3VӘ;dtQǍ՟ ?np Ml0\$$Ĩ*[;,8\5]<|"JTBfFDY˶*3^t1qzŰ6} "-U,W˘,,c -1;uqmmJO>db8%k+0$J f~CDذX[?+Nn?9v(b1&-n9׽4)_"^EK(IQps2"O+gċN'i#R1Q>cN3q)EDΗ,AyW)靖; {jR"l?*/0WeμH!KD8ƐQ>.]s']p*R4|uλ5]kVW|emB\%'kpt>4cУO).W]\Wu5UadqzKF kNw~R͢է0<]A 1ONx(}@߰?q}}X VK]q WXcg&D'p,'}\LcGnyr@vG~0W^^wr9c#x۩,I+;,l5wκ`{˙LCm9`/AFm 09C^Yg(@]*lܗM ֩(_p' L5#zP\Jm /\ax/OݭF?{&?cu ,ؤ,G<3iEMKZ|aÙ5KLGE *v WABߠlSAcDx/ .V,ֺjq[GmynwUv!nA$̼UG^KqAQ(iw+Xu 8ZF08+ЄDe 벌8"֕gjb>N<"|L7~cVTn;Żb T blبSo\4{?I>mjFwsJNu6VaDXnqz_|:NJC9 AK\C׮vE-KTo4GD +ђP멺F#{ L TsIUzE=0I, ,%2Qf2aK.jΨeB p/)W}|‚eA4HܱW=*;82=)[5J7ɯ;MlR7n\S?w浑ۚo`:呃THYA~]z%,8tD/gQ>a~vd /e|*!~!E{t30y PبTLd0,!a(8Xaн7 X ?DA.]bzȐC܅4,-=IݩW?:D<#]TTQ\̟h d=Z3h)5[Gӷ`o:6ifz!==Y a 9[9yoԠ5Iq+J*6">\t,6l*&[6R"ckZQgto'w]s׭b6r@u"( OkI8#:Ttűut`N+c5V6;c/*)8C=1nnp2?_?Zx !ﱫ"g@rq׹Z\LQh:z /'c,]Un9siPM 6?< seVܥb46Y`/ryd 4HjlR\lC/'tL*n~}\v̄4 2?=7?):В,x2&5/bKI<ߡFU둒zDzwx =c؜`q3lی>O\1̵(Ey瑗:[abdw)=+ccy710-{E;iCvޟ\+1o_^WOa=.UJp9o.- p/#`Qt ѼVdΖMFO lVֳEir>͘AEp*!COt /gDJE,xoYM/t{q0s8WE5֕E%ǥ`ӭs[թ$SsrUB%֠9Uug:7H <źd%X@1N%GP$TbD\ LJ^1G@1<5X^⊃8[Эc)$dXDwwX2Zr>pc|-VV(v,:Of0-( 1T/dP9Fv(SufBtTB ,eRِcň|U^jk07o>&h'Ė0Uf0fЗU6ٗ}Y$}R~XK .c'3Ƽ&j\¼}Nî$<=EK8<% r2[D4a Ū4k-p.1R_>H\)Y٭&5=oF,@3b2ԿswZ&oF~-z]qoQ8}- R"xߖiߧ9rv-['}P,2~iVBo h4A#ssCMCS&ޮŁ[3vjjSҟ7tۼKXs@չ1BNVW3hJW?'7#ad!ʦ®Z`T5wi5ٙ{!^QŸ_qS!C{&P6 3yxj|}|u3/R@.d`{DIENYWj^jz ^IFxpUy:5N*gÌĖhTD )z ;AV+ 48<=XH"˲ȭBi?FO endstream endobj 109 0 obj <> stream xڛm܀0K8ad> endstream endobj 111 0 obj <> stream x=TmLSgrWPnt{/fs`U&2? nҭ) e셩I 0`ꏉ`0v*8_DQcbL^v,9y<9'y2,LٲjaOIk$,J5Q3D`CBddo}1 lY%|՛˔1 [X]\ de!]o0یMTDfz͸ϠZVYZ{ mb.L#WI!&\.4}FI+ZJRbfm0v[FV̊H#z}AH2)Lla2rA>gea'$:O^ x<_u>;Ւ5\"'xOE0$aGxbx Zb9U 5M@o;lŽHme)ћO&}S_TRT.,?+:κgjFFi]Y56Զ?zp'FY>XQR&lh}9jDԏN9HIMy\d5^~B@ Wܚ]4͊)\H7/!Ht±;2H*k"{D_b$E4G} B=G.t#%.ߤ8`9Tqz!zL$Z87f.AޠȚ{;LK0 ıXi MH8`-3Ѷ>kET!%Q?ˉB\υNµ=\S!࣍-Mmvb7~O`+UWw։$ozuzu}ߤ0;n:N&Pi@(~8uP!w֕N3C9 "?x> stream xk`Q0 endstream endobj 114 0 obj <> stream x}Wy\3-g;QkERJq)(V %"A `p-uaQ$([@Y)ҧVmVj_7sgww3F"afThXpDAMMMp .?]&]dJ7}͹EAcٲG ؚFE-ntmcmĕa؂oGy xup:M˞;@Me*C2.Ce%ed*0ZIgnЩj.#I:4CmZ*S6)M|NQy/Цgg$|||L;T/3trFt陳&4Uu7}CYY_ν2gďw.E}x]Wz*K^k0A㓼V̊2Z0\im Kc;Z5sMzuI\j7i7$t]⣐=أ2 `xoO9<7W\a"*mZσ; DLU_E-hX=pSVPZ'oԔ늛*5S)Lŏ%>F*PJ(_~9EZ/JMi+ri{D'R̮+GIQ 2k8^18x9edBb3suaVP(JW?ڠ5zXqLd``Kq&Pko_Pȍs6V!p :NFִnh>l>]ڳ?y!agd |rVeƂDM޼OX{V{^n5 ?܅b[هs*7*9ӰA,*(9ر{ao>} `oB_vURtJ#if9׮"nf:._4 _0py$] yΈ_E|vvaAd,Y ?mtͥD};ydl+LTq0W!@+^8I3|p#,<(qcYhtTveYֹ{K@*9yw*Od^sV#${S*df9VC}")DdC~/]b+k xE`(OWɪ_܊D`O9d.yxQΆ5a/RZl;^ "ΐQwеj!27ZlBj͉6Dň+ TZz4p3 *$=[lzsCgZv/#zsiB0B82-GŕUB0Xr7TiE jzD،ڬueJD"۳B@~p|d7L{lQ"|ckf;yDȲ|j D]^^Qr>ZՎɞoi$t~ٚ%;C&„ vw@EBnuчT\V/B0jJEu#v0CH{hg뢛Ó13d^Ѭifyk@y ^!Uv06]>)1)mϞ%{Uf^Τ3BoNxw $[P3TƙɰuEe^d_ endstream endobj 116 0 obj <> stream xk``W40 qgo` endstream endobj 118 0 obj <> stream xMXw\TGfٝ"\.܋FφK,(\VAIJ i(";&`nj~箳7叽s9gg^@`FY{mb|W֨-jkΑsҋX,FYrhK$O1Qd8trۘ}H4ڭ1[΋ZXxvR63?P40(RչMvujy"Rq{EUo آ8+ʃFj3Jd6,  ЪCN 8/L$ J:d\6u$nOՊPw+gVGOPD(r 6ӜJ:bKSH8xJ46 Чh V iaL)1Jw3i]{=gh+[4H{<󃱽T%?4bI]t<8JzPTVQψM1v&{nj%kӴF#Wo ZVQM9r+:kGjX1~ o "uk^y4>1~K=vLa]ެ'YҺaqh5?y7˄ gU\ƝNO֑eSDw L&F^++ 0,c /a:+x2KMf փ;> ofjHA|n}pJp);)עPan]ׁRYev5nMbB1D]~$װJl J\ 0=l֟rϱX]nZrUhZBm| x#y!kePs`'3)z: ռ>3><)'4p ]FKdiT7<΍a-"<5ٛ<&ϩ&{LL%1a 0$]k-X׻!IS&'R)˰ yIY!k1̂HPv&[E3sH',UGs fV^z<p}aa/F<ڟUrZg%bFR%m2RZI\2h[UX(v[I6`Ç@ȗ4(CC 5 x[<[#jc&oU2P藼ʼniI^,#&8Je֢aYGr+`!(x:( )Y(@0ȉY} XEu:` ¾Q#'=!IG#K8t6J+ʳ<AR$k _bʯc7rȈDԠ9ņƢb\*p|* >*L*=܋Z^хol+ ̝yRRX ' JypA ; %syf)ض}"XKHv,yf u_\tk,ٶ#v͏!};l\'c R f&%P<,A&԰IY,"xi{zg):aWdixYt11 %m,,ȬѳsKSM_|+}~{׏t3U.U(rkzC>xq[%;}j-MQ>p:ڇl7@/GD*&z`UըruUڕUZukxVY4|kMv. b/DMAJto^ufJ.CCo]V:etz᪃[5f“c>#QV-9iG kp ڑ=T% 6Ȼ`tɡhe  UG3ް5>#'pZ;4 cx=_M/(ͪ&W]ړXZP͋Ռx1VEќWKV]IQ-V )ԗ-ٔO1 ب3A2m|RDű۽B?cOw?<ҊS6UڮjLE3A*&M d@۩!/~ vN@Yo]}F|Z 2̌É`  tíw_wghB#)z[&E"dIz7&+P06Ѭqq8OݦG,];A"~wt6,6 p雸;17.[h$(b^?7 f>U&Iʚ3[~b=q%Hrpa"_-<[\ N%Nj)=;/ !R1i@x&" `$dH`.^!i7C8 2r @(^kIfŽQX4.-ecs~6/PЛn:Ln%ƹhez NR{V(sqq1wFͶ%4* ܠ[6hWN"̄%dѨL)/՗~;0;ycب={X1x[2g:@3/t2st2/=)!.FjgPkHuCyvQv O$o'O=V̝M`ՂrKX 3Q&uлs*"$S+)V7'Sۖb_R)0 e0K E&Ddty:fz78I$]|mdRY- [ ,;_M<% ѯ1IB1)䬩?7>K3Jx y#aE2<jɥ w{:wtd;~{b4<@ %ɒ2K[. }dIsdk 4en>#P͉cv?pC D!9]~to~}f|L\zG434Jt7{ƬfYu,]sLQ OŸ{Sf-8p"d٩I;]wPt`#d6mː>`M@|FnN:=sJ95^1CL/."{lG4HkL+2\yܢ؎DL wi͚V+ ]SVboal}95VһYt>}ӷz-m⤴3/,6F] *դߐ&?նӿ&F<+wܗ${^]a+|gpB-PRM w>H*gw%m0ZA+:\$>~,NڽL?d$*}Ǧ3F|Vwd#?[.;|sO=t Jۄڽ{tɃH8n"m7HaMv !k=Ũ C7/0kz416*UF8@STOKZ`)|:3y > stream xk``"NY3B I3SB0dD% h1`qHV8gT endstream endobj 122 0 obj <> stream xeVyXSW#1 4OR]AOA*e.@aYJ l#ŀR@؂jU"*_Ww͌_zgn3Sy9s 2R@QʪUUj)6ٔ6O'{ ^!9W[(#F㻓N',Pycm$2@xjزC.nfl|\̱p_Y!EfF_`TjL&q^VIcN\9 SwM@Z0N Llm%DxJLM$T4%џDK*0J:qX(vE#mP 8OE^_DÉD|SAi`*4co<1Dٝ]!x?oZh^<.yyzSjhnup/>˶uS8F/b6%K&lB6ďkR3UgAUьok,~9lE YFCPz*DC|m ,90`~p*$~OI0G ,ncC[7VvVSޅJ}3.Hʥ-gXA>Ouٮ60j w$it/aI%+i?xsqx[1îW:WsuuX01Ggvk' !!!bvB&"8NÄCh ,~t1zr, F,^l?_]g aK4>:ZJi,+^&e=%>ZE hgR} KLbݲs;hfVG);O{XHQXEzM.,yx pLP:A X{SY<OKpԇk>z-ׁ= }jK\IWWWt((Oa"ٍOuHU_`rt4sa͵E ^gԶXSIL W`%ffeVw-k + 9lfo@4\E5*y8d1#x! `'kgdoi[nBIP8ЕnC5[xdw{ a[vjqV֩^aeu{NH_Լy 'O΂J(P)La5֬sVb&N6|G|ղ-m }<6>;uoy 47zE2G7f\O6<Rx+hݓcdkX=kBl,Ws0& ݭE2G m߰.jKΪ,ST=R~%^_f>Q"?nus4$IUj*j<8PEmeWսn\<%1]mުvyOQZ,NHWl$%=Zd*Q/5W؝}}Cwd@Si79x8#4(uqV {-ԛ9&WrmnP!O \ SBt8סxLǎ֠IiIcW&qc}{ RxGj6,cTIOVbzPBPH7l!pӿ)R AUw˒lC#0<{<<>>Erd;0a%k2>t#i!tfcՙlKџ7o]Ǖ~~ڼVۖRb$xMq yqs3)ݹ2@3GOeu{Pj~y{SRǂkTp^CV:@ڱҝٸ{եi1їգyUZ( |<ͭ\g0 Q^[B2{CcqXWYʠ;otU=Nk5 )9?~B/_%[vy߼_!#! JQ\QjjZ2fCvNc>orНF!4NV{a3zIױyV(P  _κ_º4?&6NRGϟ?lz endstream endobj 124 0 obj <> stream xkjf <`"  endstream endobj 11 0 obj <> stream xZrF}W[Me˥*I\L|[KYˋ&!c@I%[yKLw>`,8LH9&0Pa6Jv@Wp^gMqîq>N2[5Yڃ*gQVh%BwQT$dje]OYUh1d*h,0 )hͪhCAQhNG8LU:/tQEu1F)Wޤa U:E}gOYk,)I/ym/hvh~ڒ;2ܽ|?x@Hnv}bݠmдx8Ѳ[|b v;}'hFnf٭-q }:|@Y(+}7hfh[g;>ŋ_Ӽ*A1:rF5AVmzq: ]7N@4盝W7w_p'gKbihҾXfeDI>Ufe,F!+֋)u)٠ӵZnxc;;mw]-$m$}3M#hJX,mH8v'EH]z,"dG*/ż}'hײ,JcpeOj~ {ט*;CJzP`8G5־f5,:EE5g@>-{WOĺ4Iq]kb[9xlة%gѕKDXL"lLlH xOQ61H[iLejmc=%֔l% /rtB4tC>㌮&G̡JcXq2(-ң d2҆"V.FЕ4l0h &tZ'Nu#=L t󭄻nPw05`O4A,LVDz[%m(׵sX`bP F@8)@L0@)tspVx!Pԁ*d,* qԣT!NT;-aY@ŃNRQt`dI*8QtFC؂ # kM@ AS+[(o+^…ȖYmxht ~ B̚# 1dς&# WxMQ9"+f /ŧiwމ_ςMf׋I: _J gWEկ98^}0#5՗tL)ej}4h<7H=!e;bwhx=#:.ksVJsX/d/䥛Y~9t.#GN(rAuDC|tɠ'`v8btNmŒޥ mC:!.CvsٻpLJ_ ӜKL&ִ4CYvhbbWn d M&P&@pD yYq'ϗ=)& Q"tؗR6RMBpGJ- P^b0z0ٳ}  O7|4eZ}|̤ns&| gGC2[i!Ttt{.ZwHFv:yP,kdk*7i6i endstream endobj 125 0 obj <<8d5fda0883efeef5589b046e2527ca4a>]/Root 1 0 R/Info 2 0 R/Size 126/W[1 2 2]/Filter/FlateDecode/Length 345>> stream x%/Q2-cf;umhm]eE&v]vDS V,4,YR-HI#798 s!z9 L̊˳6ށ2x$ BhQ{YȕȪNw6y O7{Ĕ~A> (ɐNؤ HX)kCB N6/mRB6*"M5@ jvBtBt@?o_qeBٝGwKq9>$aiP-}yKCj))+KrG~f< endstream endobj startxref 64114 %%EOF actuar/inst/doc/distributions.pdf0000644000176200001440000037511714522560002016662 0ustar liggesusers%PDF-1.5 % 10 0 obj <> stream xڵY=#7 +xVF"@6@):U&EQx|u.3I$H=i&LSLӯ?w M)98pvq>1gzBw4U~3YNW ߑ;jAu `pJEmriNœF%RQ8ۻHe f\ƱbD1w9GYGfs1 L ֵ29wLnn^F ;W?~NKZGn8r~R|-˪Z΀Hl[#V٪U#ht5E*:G(թS^)Jޡ%&|¥!Q]a7[(c<~Ou[n(oKi =Cm/&5 J3D^^[[[ԋ"{YE[$͎5 ec-" Uh+ $A;M{R ѻ &P0\;^=Cůf/Rzfi|i?{a?5y K@4}?v3BmzHл1 CR|לhj 3vl$%A/=~{/2kXWLm6W~Tvj2=h2k^MK ,yAv2lR_mVlJ)ݗll$RvB+-YAlL3q2Y:+J ݔ.n%-su-v0Ei_yu.Rܚru³Y7 c<2|ͨ}j4èįp|@}zȌ;rqaL{LGbve-Ƽ%Չ4%i3Ye>q6K(˼1EvU9BTrf|*: ;v2+|3Eq晽)h+6"-`(Xvqi6nNAn!whzƮ۴ P?>ՉiPOWJ̨b2;xCd%i@~d= =֐[uY},MTMơ~E-J:\VVG40RR"hv4}fD4Lhx gmqr3, 5N//h(bHMK{rGa[ji= f,88\Ļ2AғѾ,$`,ciR7QMx *_]ɥg~X!Y `57eRÇM]}jy=hcw_׎jA_10&|ᨨ|nu4Lv}q{zmEZ`uɨgw5]t6KP6}6pufvz8 WC_Tz8 endstream endobj 35 0 obj <> stream xڽ[ˎ+ +HыKpwAmU/BIԳvEp*ECJ>NOno?8;-~IȪ0,@2aYWf{t1n VTY~M0fEKƳ ce4HWвQnB\<¢&ͦa4EA*4Q38ycZ?WȜMp+[^(^Y (ƗN1 l/iaUA!/]3͛stAZ''>)t!eޢݥAf8*̴BD)ǧz4yq3wAS`si3[?ɓ屰KWAtW_Ҕ\i wV.ۢ=lF*uT6 /SL/Y1)dhl2[NI^طrz1r;D`ό,1l٤(y&E%)q)kyNUs#Rc;Ö'}6 7 KE\20ktNX0Lt8(wϜ p-H8G%-_֙PF4Ja+ƑEB2)݄Œ7]&t02=/z^L.Uf3@a @Z$atMK+hCw~|$;K:4Q2&afSJ0 9핝GYdy:q 9D!5yzR-Lf'd '\`]9ۀtٰ - jU(]$҃H2U$}g̓YFht_<<*%-Q(oR)J(j6(2>9,FB$(їL#9_,' W[U¦rIm|?QՓ`y@0u_d˛<7tR2q/mRb„k {.?905`W+Sm*KU~ ~ ָq#f>k.47F*CWN\_2mI.޵ˌq$EJLgVΌAw84[.XT:[.Ԥxtc<85%:}^>I~Jحܭ<g ~?Lߟul"h= y$%RYkgFo<*k7lRMxUJ ;mUtVSB{|os|JyMc0Ri@xZ6.z [e{i^$UNwkywoTGz{#W3w;8D*pˆѠ~."u;ک}h:TY6u߆mzgUwĩ*Ⱦxcn}s-oRcwQlG"iú ;<vwnS9dk_=Y 5~cpCkg c@SH`NTHRrzk~7$ZL*~Rz\LŲ7&FTPJ# ">^(cGܲOaCZIw!%4 \kR)#԰_0S5>~)]_)TDwZr>3&lO\qӟKvΪp]2ariˉmSq$|夏޵u6mBM12B*Fb='VG dUG"MvɓSZVWiu1 DW'*;!2 ^Vk'd'QS$UabC'y diIO6bxn5~5A+;g٢~2 x.ކʹ3W.3R +=21K&;5d{ΖQHtX&ARs+&Ġ6t;r@$EX*]"]K kʖf݇ @cV#=('# i ATw`>qۃnoFOU0y%)fe/2Tm (J-7"(h,YM۴M?ːT*S^dř|":o>hb}(zA=KrNy>Q,A,[H[븲I/jv6"L`:z)pvk*tFHL7ȸ϶ L\m[6RU!4[)nF]zY>~-gF~0T&'Q5lD NTΣ Ϙ|iKו/F@1i?2634$rζ ͮd R4^z^@WPWR`7#,ֻ'H J?wܫ긽5NiЂ_Stjc3͚TVo 5:{J-}iZ+/JS}ҢR8?0#N endstream endobj 38 0 obj <> stream xڽXn0+f )!^CN7rX$l˛7CWN? 竐NJEFq/$fxW^=(@zJ;^K*$buMk] gPi sw(pSygLc$) sS}3 j3Jqdf~uL%75ɼ"V ~JHG؁&3=P05sa@tT=rî g^W}q>#w  k+M:6Zm,\2@c M[*Gu @c& ¨Ym[FlAEsKK]X>W%jSja{sM&~6CȬYH>ثi@ψ4#4xgN\"ifiwa ξԴ EY14etr<3 -?m[ALЧ].rY[&6CJ6ꢭVA3d82CLt;ey'|sڼM>#B/W7nkܻTCoy TZ6X Ձ){9(eT>˦P/d*A)\V$6WTM9F\'3]]BikLPϔ膒}5!D9 ǵ>-WU+Bu:qJ=vHt_1CFPƸ'x;ג8'ϩ|jzWK!^ʄz=PF"]>0-Y%Bӗh?$]A ּ -g>BR&jۑmXYxv.]b^ +;ma[i;b{rS<~ՃD endstream endobj 47 0 obj <> stream xڵ\M$ W9"Rbd/Aά7@K~U*IURUa%X'Tˍn-0շ?|xK*y_nl^($߿oyX⁘wb({C*XĤ?~)fLP0I+c&D&wDSB)^SEXar`Tll,#,nXia;ˈJÞT̟_0\s~s-D*rULxc|Mn2 虐_ v /%EqdŤݒUlm׼Do8υv;G.-34yu㮒}[LQUD*h;նD) ~ r4NM`Dsݩ) A_q}MGklG%+@ 'u&pz0/`FQ|Mt*3f%>t{: 'U$/WHiY6Zt7Eө 3pADE?R)vM7V{-_az졤Σ?/o^mX>E| SBsT (k_w [gWvt0Z˗,u&;N 3-w[XͱתiUϒn&$hJ~zﱤr^v/ܕ{= ոZTJLtGTn)_˳ϯ%w%)_PmX_j,BaR"3Z'hwV$gOhWG+Q_ǿ:rQ > @acM\[gZh+ ~B믗ݟRIJ^Q a1 I1e(! 4,˚jDzJ^Ӈb/l o+8ͫJ/uV}-9 "ȅ(>k_C'˱ &ǂ,]kJ-*ߋ9UCv/FT5bD~hz\F9[ ,S/t{-υ򼦵9_k7Vﵾ|ldx  VGeiE9Zf"|ae+%lg*_u5hHem g7c_qx IpIޞ=45:8B4c͔/7BVޖ)"#ə~D?!Njf?dD<_tQ+z?hdy| ;6-Yay[:2?#2ƃap&ъal䉣Sn3$6' lwR?D !SXQRم ř'2pltih3N qBi4Gm4ZNfH g 7<3Mҳ )ǛĺNk#a'J$o Mt@I __`ʐ .SWә/}|zoЈb6¶.4)iIRK{\)lZ"H)3܃z6\v@9P8`VO|l_8hs&:~Z^s' Jr7qOK,_3hPTj f)Q循Q$ݛ)hT?C.kmnhm.4v-?|,Vu§ŏ?S endstream endobj 54 0 obj <> stream xڭZˎ+ +@ËMrwAW6d%QRŝ* 6I`s7 ]ӏ @m.dp!ݧ;@J!%( JxHH~2ttPH\^V@Ntu+1HdȘN .$%=}^M^Ew:2t7/l\> ]o^wt:ȟD}MK?J0)h&aM(Ǥȧ >^G H)4N#)1}gs>%b=g8>2H2"$jEl!餐n:IIE H %x^yh|,zbr9-K$8+k@Y{t"@f`O3wNў*z['efKY[I[Ao6?.-ܣC 2ظ<,R`p(xjt!=Ni-+fB9"u}=,+&LIbۊ2OW>:O֧nZ\Usqdq2PHaٹ1w>*O EZ6}nQ6gtx1ЇüƈmZ`nJR,bŷp]%R 1с;.+ 8$,W*u)mrYH!AEߙ),\n4Kl=ziQ*ӗ̾Rw( PN _NH?\d6E_oZzէ": vP %Z]ߗJZx Y90C'c("l}RzAm_M򣚄JHFKfw6{Y,Q|D@|7e^yQoe`cuAR+OT oX"NX:C9b?T #/j/pWX#W]H=ۅ4R:;bd6\ chFp(~YT:%E"@~lW.Dlc ˦uP&`S)FHtg58F%ǖz ?Gvwdr!f"mQ#*V `EzcD ż̐=#3[Gc0v1qU,qOEq 9҇0R;Ӂ@k{G?[zv/={M.|Ј5Ȍ7&&ߤkp-Pĵ9|8k*მ 3Yx`~#(_gȭHVk9Ìk4fFEd AKuW[ȶ:7. tSе'vpE./o)R^6.k\Ǻ`:&,aaмiD" Ζ~~#ŘQH)UnST#&F-+cbM >R'ĉ\SAb5$OM3 J-U*%٭A aCT%9 u=->1q*2dr}M[N$~7k5T&鉡Fʹ1d$$@:me]| C;cywE}3)O\P=Q sY" + jQ^_R[wQbź 1'_}ʉS͗_g2K::zk2; ߡ꾯 #D DpuSy>6MNU$4bݢ)(ltq.YI]Q.n}+4/ Ƽ5]` l Ar&V߽-@pOb@vy!Pls Z-~lCҪ5LWZvo8)iblXCA2"42쏓;"F{形cqcWB)3Qշb/X8`shDZ 'JFR=7*4+'gy; endstream endobj 63 0 obj <> stream x[K# WXII ܂z{6PoJe{ qJ#%~?I>&~ŧVV_ǟZZ1yO~נk#V7?>r&/rGʷf| |p0fW'a7 agC|iK$~ju-z)mkUqҹgu-t*x}.&Ƈ.tI>ϺXg˜PUb30;%tȪ&i-TFfb [ޢ'Y!XYӧ.@{g3mΥQ$x'$b뷏6qI8Uet eI*gXui|5 k*U]^S['<4-4.>LmYK˅HA@U "ΕrkAY#\,D*CEyEpFH)+4>?Z[Vig cWi'~O|8VrEde;v/q͌(49orI5.qIb'Af uE4J{E]gf_,i⿳A&mdqࣕ`ņi`xowo+]-vEK5Wr,{2.ތҩj|Kf^P$7|d[V5?CnVlYRG|X~z 0ź..QߘMf<'-x% ׬y3WvYR9Tn%ep.YgfN0ՅC(R;Q藡Z3K3m~pFYq8&UPx_ΛPXN!6䑩=Of 5u_z8(3vmUo>1Db֍H~(j4I/`sꑴ/ QkQT\j!ZsѮQBYQsڸ9xVB6'C˘Bgw>ښ5vizNƤ@@nr+p0.;p-MUy/%F8fmJv*5Jt)s ~;x0V %}#rD,KNvDW5,k_}ڝj򱦗ƃ1 p/$s$2܈l% auSX iՁSƜ$x7 AƝ/ =34%y& dܡ*5O˖{UsʷNBslm7*+pABP\'VެZ90'yhbG3 J/~namգjJe8"zibL.60WA3hŠžH&\z?=})V-n}Ec`z7] W6flmbyfעTV6M3f,SQҠ&!(7QR۾Qy_èU;Kn]>;Vm%qD6o@G,Mi{F(j4KLТm/+;s&6[l62]Udϴ c BJNږ,av,x?{sFޔ'wnX@~ B+y7v*Cf ɳg\I şsijY:Q~xMb^F@FrpO_A&nYHW0<@1RMBZ$X DnJ8ɏ6Ll %'qmǫ/]9\s D͊FG4XQ1BA{=c96#ZIWCk}g2x}t;[߰p",2{+Ff)2 R%AjOgڔƍl{#^[W73.k9kY'(nXH cxskI: vDִ^w M+5pž[ǐ\Tꤏw&!Gs,8Ei "l2A\e|(Ss-RWP7W> stream xZˮ# +H=ËwAdM~?D(lO݅*$yHz}1f @r~_W ,]*\To z0ߗ_?[~bt2˷bsDQ&{Fm ЅtzOcrEo] h[{0nK+e_euNI]&b;HgrF+|}ҙ!}>쾾y#8@j79O?LF}wtQ:~s`e^$7RtVtub徼?ZC3OωXMPL{wkOK8yJJkIJ3PT$~1$M̏L^<))2 P:HLbMP4GŁ9Mo`yz.T@2(J@OC,F}-2SƉuۨ3մ>(gVZY5]R  &D Q_ښxȚݹ? 􉰩e,ǮS}n:l(5bTiL;4bn#S"s/ѩ<왯/ݘiȼed>qt TJO%&6ޔS[ny$|;)W>bwB-苠tiƥfzPw6ʉFnW\HJ ]_F^+wC%-gZ8AΦT>KM?(K|N%3E}]Ov͒u6nlo qD48-G!v'ŒHuƎ22}iV>'ZH #-s-ue΀t)+b&ѕ-y1RPPgJ59"r BT<nZt4 :*Os6?#5א;cem!r)xADJ$]2WEmHI0Pqdd7lR.ed/rAΆWQ͸nRjO`er(?\@]rhWV*qd-T`OzU:Q!x_[YDL#tĠ1/ !iNnUa'JZo9"/AvC5kGE,+\cSNF~X}zr̻W@8г(DDϔ bC/wM9ó{X+up4N~20gDh^@ txY%mNAeP#3x0AbdSCEm]d;P+ f߼(ʞK| 6/} 3)L~W l(ThåSWxԢj 'ok#n Gy}5Wt͚3DCZ?|lq9bǞ63ȤH1˜oO/z}XKFi=~@>)@ *wtJ3ۭsœ<*TH,8HvTҳeEk˩F^w~mzeo^]j@EBxOkW IYnRҪu*tKG ˜TA9VK7] y5ƿ0'y/d^>9bbBkǰAi쯈DƤ-{m+$*lE@mF32Oylh rsqfN|Zw\%Gv14e&h YnA Eȴʄ틱12E_[N{1 OP֚eg=%9qhq(T 8B +E޸Q/B\ݥt,B8i$`1ޅm7 ڼ90qDbx 5V kZ{a,Q-t-eUn=kKHNJE~dvAb!-bȕژ04 0ꍴ2.Vg7ķW|!4$z" E:40ҜœYy*W >$2̔.Y=~#FErSG,νɕh^RRKᄾQΛDޭC~!?՘ӱoNFLIޘz⼻ܜ\xp^1 9=;G/4.*X:Π i/j0NB-z~Q<;3Q|S7Ec (ʆv0RنgL1gYtD`L_c y;{ӓs#odom=EG\mT\'eq͙ Mul sBEiܦ,a.Ɣ]L/#H$"MPP&MFǏc,(GLǝt)Q  Uec- nmKekhG%2~u)2AY4@GH#fV释>_O{ endstream endobj 75 0 obj <> stream xZIo+WhU0|  I| rd)a撿*nMŲ~zRd_-xz9W??-3,UbI .oZ}j_'_ o߶Nëk"դ u@;Y?d,Ve/t}s#gdSi1 MӘ/[`"Jeל4ʡOG9"2˿VcyluA 6o/6GDe#$e?A5ˊ e"*.O׻bPp46/imvk2y >߮r129Qis=y SXQLs "u~a{&j!hw}\d᚛G܄v~f$=n4 8Awz,KA&Yfn_D69Ldn+n{',~FP@]s4ZiQ$xxϮ"(j;<Ǟx Zݧa|C@˞]p<qL+[};: /"q;kbvh=6}My„v\)lAKi^¬)4os>LOg (- ǸG9ӿ|-ox̘7 TоEqTG}=y^+LppQ3&|b}">_h'GGs\\P:  *]Ev2*f қz,knDZ5_k endstream endobj 94 0 obj <> stream xڽ[Ɏ$+&;Yofе9H_pK2YU=m TgcGۢjrO?u/ߖ?U-J(Z/v9 oR*'G(7x~7QU+;71MՁo?_Eej/y*y}W[ )- Ȫ{Ѿ-]k8[ӣeX0FRU0;=r2Il%ݱHocA:f썷d[n !D[kLM%Da!BZMCt*C$٠UOS{Q:EX'/;5>-lօg"~a)VWPC$}D(S;ʗ3k^/ S_b`DqYICA^5_rmTPQoC?M:%r!9426\D"L;|fa8i+2萐`I%eZ?<‚. '&m'sBɤF0[ R1k|Nb %`Z1sXjN$p~ '񯸈'(A=>fȏ ?/j~z#_T{nG}M~~(MQU懔% !bf U]"OZF~*8G֑r*#ڂ7ʰkv `_7;Jk-xNkzm*ij`P,8suWl\j{zLh;Tn_VU&wn"[D)j 5֐U|WGhgEEyPdA^/-'kHܩp{}:JUFDOձ?r&H~\sʄ 1bR}5y[ f)o[mMl7/"&lF:?tFf,J(jĨ]Fmr~tw0 =׭׮kv|~H5] endstream endobj 105 0 obj <> stream xڽZˎ,9enztaÆvP߼t8Z~]h%0 ~?*Dˏ%h[N>`yqۛ:{DNg~S<ߤL:ด3w0eQVHʛ{#{oq`z?ٕ;aVTr:dd@+'K)K森53f1n3򭟓?ȫdF9h3 YeK9]sfuBy\?NCSL$LשԖa6ֵPr*ٰ=X‡n((`ފmşM~#L@є|ՇS)O;}HϖQBLn48+A+rr@les2A<"~켬$\E:EΧhr]@l^m~7rx@04U}8;_|05ìnpʐ=gRN2H  {潿q:kut. tJ^afmӎSi`Nf7li?+ !x8"De1\$`=`vbTp`cٵ^택 B+אe:ϯ.(J~f"p6+l*/\ -X^Eǚ*kνXn$:a;[V#5pq~4*i;`ER(nUW~&\UTkBq&/zLPkḗ꺭dt]{*^r/?, _7`ٍ]`HPJp;HUa 2B4two238NV9pceZ16P֢)+B^v8 !XF)#ʑ:5.2(VVݞI̎o$XCr=7|UHfK^%Vn^jYs_uLzw˺,9(ΕjNS7Y_P> O7WlFLDH*뇠z >.J7ܩ_Ǽڴ ܑJ`r?Jn,mn d=8mmM^\C[kgZĆ *VA}н=/WyZM6vra*I!GD*&yt|lJ\Ĕo yIhvcn a׳ H\`IkjL4[LzR_G#:olc_ĥ$ d򮢦>;r\Ն3X7ܵCz6s܈c X`@Ő{* UL"L qY=*͜oO+u2۬"]B림_չ D}GJC6 Wx0tOY@/mGw{]׀ݰp. @6rsv`H~u쌵\zФ+yjם^iiYE:SV;'C*pJUM8jh9ԄOcC U7}҆Ֆc]wNT<ikUKUb'-5yt~Z53oWQd¨9ʹ}ۚkusj]6U~:RkwSF!@ΜP:!;UжdFno-;p;xyt{DЖ'n3 W(f碣.F3KnY}t%mG[_5> H,JEaڊXIQӾR+Zp?{a;1(T,LAkݤbbI3z6$(z;~Y)1s{}bݲ}ZZO8+ ax\}g endstream endobj 120 0 obj <> stream xڵZɮ+͐,@9y =x/M~?8Kbg-ڸoiǪO*ondb4*@31Rˤ;s@} I'h堀W$pi&JH":ǗP5\-)l԰{Y4 $|eA&TT(z 7HQ*JZҘc;," ڡJ( j$yVYBM3;!E ʸmQa,µPk9^:"' bXTJlJld  PZ^nr4!iS`)0'M^eFD?T?PHM$ ARn؄"Q 3[^A>UǢڽr5u¢EVb?\D3J( Ha6EK :j"^w&7z/FhвA;6:?*p|C0>cKl<HQm[~UUV-hKnO -snV/` V! &B3 b9 /g˼jAu_/J&HbJ\4)Qb&{S@Sܫ=dz>R/D֧/ú Ŵ~Y3>>l2ҝO5s>[뉛y?A-/qrSM~S}6ŘҏNC#)Ֆ?8?yȰ[K4:)'/[eJ'Q6)(NY|P )ʓ48 )d+h& @AB.+ͦ_pOsRf.Yzy$s)ŤMk E, l0ቓ楄q+zpm= ]asZ g&2=<ް,Ʀ K2p۸Vz@Dxec3MLjZžpu;4=tqo1]k[cυ7"x!KN[]Zz쏷4Ҷ]Yb1 Kn:{ߟ< Id|aԆ kr׮uk|Ԏn@R5P"Hf~7k[ mu*q[ulC[T2u 7!D8v| : ˓ҪȉEбj^jQ9uqaK:R]Zzw1WU%##=˥gq'IO6gGy $϶3WOX'Ԥ;`'mso-֙acѪ2yeזڶGFK1M6nM-/ێѕE3NxvKkּ9Ȳ^mSO~)5üVmڏ(ɩ˿s&xt-v|w0f?t> G(oz[b Xif'qpX+r_8) ð`MlG=&?I'CM{p@J{km 9:ЖK`z{znT _ڈe,o[k;$TunMSqw151GfnUW2j 5xbmiVWNl }ě)M}<ֶ"~Wߎ[~*kGt#*52q}X4{/*߮EJlLyzE}kQ tꛪ݆w_#ks7ħ_' endstream endobj 134 0 obj <> stream xˎ#힯"RoCd6[C%{\!%QU*="ASc[%Q$7|_`K@_Omoo`X˷ ).'U4^/h_/:m 4#?:^VΉ7W+S+ o$`N) PX3 0 v}Lr))䙺YElFyDD@B\^2 uDdNu)!` sy1地OXxh(-e ! : 7BT[Uqnj|}sw txCv<,k5s2uM ;ȋ1izxRFUG̨$*DC;ó}'Z{NtBVT,4+KJhʹ2rzApRi fީd8{̎p:Pn]{51kMG3LCخ˩hq)3ǘϪFi/c[QOX󓨴x.Og=R27aS&^Cό/ /:2ܮ8s0Pv-,ڌP;_EH2ĤdV uc\\H&={1|¹LfDf76Om֛|,ك=l+;mrz>[&[WHYNVpp\G^e',;=֕M^ˇtϞ[΢X|d4՜_1$ޓq(>!? c. V2U/P/e΀!|"P8~GC~K,gt޾D*ߏ2>()y_rHY EIsr_Jr6<0"ӠU0ㄠ|g_xLmRƵr7kDw-b eL0Θ7cYr1ypzp.Xi;v;N+6˓؅r_5chx2;=)[*:٬f1GO `MsgYͪ :BwU FnMPE۽IPkOg^l/f9Pw r,LŐM_lHFE? EA r̭ ٗ͐Pk"xP!Z>g[nWP0!#/jnŒDN ifLX8Э8}a#HXMғۚd9j-} o%xv/@dC͡䑟KweZw싑]/vT;nG7S`!yz,/ Q3=o3:GK i n4n,nRhi&y ơ񔊌*2ؘl*Y9?\9h-Y>gYC~tO]:[v6P0]GC'gΑ[=p9#1Fykw{EưEǭȤxG|lF5<(1AZ}6)bOWZti士|\(Swp(4@ {,Wk$#+ULi2DrMΦ5У9r?.䒝mf6H"K=ב lv6fslf#f6k@61x{0^Nve5}ZTM+nwP5^7,%"YL⓸;?G.!Rz \>}"ʟ| 8P2FCNu,rw/mPCu.1\$݈X ?_; endstream endobj 146 0 obj <> stream xZ#7"0P`^ٮ'3H#ɉ&}٭kfdXǫZ.jO-\osXv Z/ Y\Z~[>U._|jyub7h4. iiyܠ[8u\R[^]vzEJ()͑a4 }Q1{'Ћ2?QQov%?^%.wJ 4rJ`nzWSȌ.΋A!CaJXnk۫T[|n"{&&zNE4@U4̓^,uڮSJư&\~[ߜwnVZAh'XF<"4E;zRsK2< y$9l /ϯw]lp5]-Ƞ.D ;x 뫭#j)TR'B|;^.)7+MŽy*Ѵy|i#J긎Lbr> cϫ uY@ō]dT<~3N9'{a L3J+m $3h"*y*7A kz,69c ׺gT)Jhxm"82PqS.UENreG~r8FP| 0!%*+Pۏ^PHs7=}7CA$PB =H #WH R6\wc'r9DM!S6ēq:SسYeXS/l( ՒajBĊ~V do< Fm.kVVܼjؐQ}Sq@gk3 qȿ\?c_:묻[jNʕg' oN@ HIF@ڍ`COwl[Rq{yƝң1^* P"Ooj&(i+dL7) |Unp❏ ݼ% endstream endobj 168 0 obj <> stream x˲*q@V*EbWeRYƿֻ0p1AjbuE?Xr^ڼÏ\av_r^8o_8J)W N`NsG[tP+_:i# W\ V BOU ZK_ Agҝ@2Q*pXo?u9+:zGao^>)Kj ߺcYR:̫.q0k9uqo9'd`L.č !D[ia~LQIZ^ % =ASſ^GV I,;> 09[zZw`㽐(Jͪhr5JҋfѸgLwv]zR?+1W(k8^52($YN k[?8F$q輨@5Ѹ$*W@lGAf^+,bݕ@u@Zpv$ݎ<\iNTʃIGwRvU!{)`qbT@]ؖtyДJXS6b״)_v%Jf.e--PlS▌vFTevqa"K\l./)1[u 2#^zRo^Nڀ8'''2UV%L;'vW 382_-f*וLGBRະy#F:m\-FU*ޑܙ(DE@1J?qq^`0m.ɾ1"T# ɵ/IZ%ʩaaüIc)A*Oh\ | HY>O\ofC.F8jK5.3@Q($'*FHuco !6k|)fאjmQ+KGaͺ(EB[jΈÍ+ImMB bF;xr&6*7T+L%W&c ϑjxZP0^P< %1ތk c!P0Tx+*wpRyNd;nA#KSe9lBM#&aFݪ%vYe yXAOEBokC,]Uf<л\$dmsWq/ OwьQTO8PXA<<3~1.hWþ]Կ1dud* [Jrll+KѱX*0LȒ>~ӒpԭvuImDwd1?Fƙ7j9欞Y 2ގSJ#3A(ibXj":̅Α5|K身(Zԍz ~ z'5 t0RLOp4 1V 8+S'QR@5cuRz{XdzPc|?;y*6F!|0aHL>@ֱnm3tUi&|\,BMOȞ"߿Kۭ1l+ȒPreF?i3ǽf&(;'IÇ\~AKt1|ūxا\J|HVb kSca亄n/VP>ʳ;GQD8:M'OzSK 'Nz]9wWO Fd+VM%TGۦh-N`>W\gez%vk7Dᑷצ,m0mi;͢*ޱeVٕW w+'u*y&2_Cʗ1yBc<ArS[|m d#k4~ 6 @*K)vKd^]pa YL& OdE7 endstream endobj 171 0 obj <> stream xZˎ6+n>Ç-2 ?ƹd{(zؔ-yvscwn_w뤏|7 ?_~k~y*hFF5WFٜyGY*ޙ2^ngYxmM+&rZX)t&EpG.mޮ.3Xrϸ0PSȨt;{kr'?svX`]aԯP9\15Wq'"dǪT`2^FuK K ۆ~6( x&C=RPXQFddmލ@Uq낙] aP57W] Q/>L[:OuKyjV adcm "d a34K`\Of;}R"FM A^98=LՑD[3f[+x8Q>j~2yXЅ5 M16c=7_=phavN 1&CAy]7U(b傢~ƹeDyr l?㮝L;r(лc\IhJ6M\pB(Sc12X Kŵ^ )/v%tz=w-uN1f\AV$|%tʹrBeǡ  /"+&| %2T3H1 o ߜzGr9w̹1-`X.['\UZFt1JbCd4jI%!+@*Gs h)0u)6 5ӑWie2ou>2gK.Ds]|94G2| L 6`E/-:%GP8wF1{,O4@}Nm|cUy{3S6a|$h$aE7ni 9qqT8.VRЇa>|XW砛c>NR3 NKX)oEtбTzK(`Tn T9, {0j6'ͱU0*S*s%+[o ha^SwZliqOE-EYU֥|3'i}@^,`g*_ե+LH(=]p_b^sV+Y8Wm3רx#=&_*_5d[嫉wU!D?妅jPqpO q@UlQɇU,kMrFX)4BsNAs]6\w_zYJT0ԓ# MZ;l/ƲFGYeF &J5]ARB*+3fcZh[%IBE:f-S^k<='qJ&<\AngJsx0$!yDN|'>=wy>ȑ2ΆQ|)JӼJ_= JŽ1 ; ;+\5CEYGUbH2wC,0cë"5@$;ŝgs n*/C%UwfrUʎ_zcf]q@ػ;Am|qǷ)yZC/'v9npw;&ɛNz 1bV &z'dkPczF %J_~2qX endstream endobj 174 0 obj <> stream xZɎ6+fX܊}m9xi9)WŢl 0nKbmKG?ΟׯZ| wU҉+:=u6*Խ\xm3Q_?#/u֫=y'^O.sl0 ?^ʷ'};cCc5}(:Ew~>8XD[" 㰿M'$J!d9o.REI8&8̌83HD3Ó3wE(_< AT`M5FVQ XK`+o[ſz``Ϳ* Nq*(r(ad,6',U%pc>z.qC: Gܫ_G(ְ "QNHzj$ J @aq =MY. csU}PB6<T1A`|p邋Z;u0˧jbBt,>K2Lz7# H#ƎDxsK&ޤ]iϵ)- _pnPSli2V֦^YNFx߀8$eC,ث!]]{-A; :$&{A; z6mAuޕtedT]H ]jʙ 4Im2ۖojϭм}per 5Hfھ4Cq^Yi_"$ct6#@\1NYHȆX0 cX\ENYbnۗ, ~z:LA&G> stream xYnF+0| 9HK0~^5EJx !Ԣzyr56ǯ3?>|j>}6StjS DoZ{}wD>?4͝B9=X/Cz+~u !avsG?vd4G {:wc{# ?tCPz?Hxc'cv$FnRL*>&c 6y@9/S ~{͠c)XӢ F 3sC'fƷs7!SbWCe(kQavl~m br:#AS $WW|8!N~0C*oV2xR2{ŀtײ.Eӥpw}Z)w[}Y D7ý.quUfJ+ ۙ7ޞƄ3S; we[Zdy镏o q&uvj9#qY=$Kd8Etg<[c_2{HGȻv?t?]ۿom$"7F s`sdR׽cZ.IȿڷgM4Z&0$.E}ky[:[Si%x3kxKn/I!_M&l[rK np'wKn]Ȫ@^}{o]uӃpbʥqW˝kDiᛮ/:9KUz.@\+|!?X#P(SؽVn^w}{"ۿXֿ{pE ൴R;BBh{?Ԝ0H־mtZ凿 endstream endobj 180 0 obj <> stream xYɎ7+D,.@q܌-A(S~?MbknEqU+Nuv3?.>|>|tYmԉ31no/Zg#;0?eK$ڒ{<cn[f ԯv[׷ﯿt? LHT_6Qtur&> 4ƻçc=.43FTX -ɝ D*1c~B.L~XIq19Nq}TRjIL麠=pk#16,yrV:vS/!H?Y 7ԩ<.ՊTåV.ʹ M*`ٛz细Mh,d_h Fs HRT R^,&CDgHz'[Ց[KurN#sdSÑihg}„+R +"Bv3MĦf8}CKG#+F? FĊIXtuӼkOCF'V$jLd\Y_jyRq2$(qɍcq*;K38p2($lr3d^{sλw^MyC6PPIҞ4t @Y#@D~ ws6B?⓮5K壙K11b=.1=j3ZϢ*e׶ Wڎs3q6).{ߏkI߼Y}[\@56 dڋ*mmƒ "n뜹Aάp]eNAA\Y)XH)*8$1ȑqV>PrN_cϳΞLƞeb[7J.DRD5*x_MOk Hq[hxo*??&R&C1O!G楼7ΚٖюH"~Ƒک<ɼyӬ=ZЍP4j;`Yջq-P䖬<]U> stream xYɎ6+fXdq $roAK0~^qҦ=3@-Hb-@ _+? ?*Di TtaV6 /l-6&m5=ncjxdV~!-ϗ߲࠼,r8XLRpi b5e18x)cN>|ga2x ? _@)*vr U֛çH;S!/G}-cՐ@sdΆkO ۢ>XhܶdUHmh6#ڷq BZr4%5,PP.Umm31nu Ĺh.gcvFt"Kk+k"9{ofHOOq&! pY ao"FFp~FtU:YҪq[XU;mB:Y1X8bϥQH%e\lcHfOx:Uݬ:J:M9Ɔr\f[nsnvq3my81$R~6**_)4y4KŸ<#Y|Y׌rFm:\% 6Œ1IxypY< \-4lE "C}2Sa{7^6 !/oDȧ k>0Zt6jT`5"F#t޲ir2_[os،4 krTB}uJ&{aL#wC j젱u 38CcD@4fBM)/f̨ rJ{3)Ū)"eEI(;w\dO;O4;e_c86V,H7jnv~[lsg:l ƔT}]ǂg.i! h"PJ 8&q>!6qiʉJbrNP]K@K_E[*96Θl2ʑ3j>r^_PLb&v;͝;w3 ibN6 ktTd^Zg9*Knnu5׌@ x x+ glBI"`[^IЍYܺ1޻PbG=0C0 v 5ٹ'z!JBt%AO9v9v4ˈt6m|7_*\Z 4ZM-pa͂>LFZ'hVl-Y!(`Z{R}~DU-M.(Q=6b]xC{Cۼ|*`nPr{\(-^%p?n#>\ot}.Fq{'t[p(\=ЖY_z}zs1_{*/txu-kv,HyHʢTmXIHyoZD5vd(Mrɐ)et_WMkLJ V7 [yJр(TDTigoBo ½G %VfT( 5>5>Wh1MhȂFYGit4vKߋuA`2թRt@eaCt\%;Ѓ?:CLT(np2K~zSe\ѡQD&?[u.:x?k*uvO8C 9І?W6`;:=f HD;zf|'d<b >~}?Z endstream endobj 186 0 obj <> stream xYɎ6+fX4 } r%sS~?(Jmʖ=3t %.z% ,hvį_quum85fގ/ & េfj2qxc=>|6q56lx\$Fϭjޚ@ZTV ˻O667ubrE.3oRPS23J9ӊ%C{aZ:SݯZquq )IqhbO.! (6زGߏ8ZhtBįF@%H.nl@ o]o(E -t ˔ϒA5e2H-YŒciabijy|7Oᕗi΍' ȓI*z|k1@S+~BZƼe`Rz! "}7X%SGLc 6S,G`& . K|J ;Fq- 乯Bi%B|:: T@ĩo,CPJ~GX2T{l:d@L tx6Zυv1¼3ds@ gsBXFie6n,F`GK,8{C łֿi¾J$at)oI^tĭgĮuY*uձH{YueLa8&lj>$`z@lGIH į^Rۂ^+?I!v;#L.FMGՉ%]4= 먤ԓ7ۂtsOTA쭋<=$!Ǎ~.IV@fdy̾}Iv&D^4}$ ֺo$JҭgkN І:|n:tXH#eq)n-bשu07&7y{ 2\#Mhfu%ϒ}0her2i˲kE@U0uz:uym*uJ;F3%+_LGYtc5r,0LB.η\IJyCfڴE+YsBK]MZ?/h.8b\^ ~HEBC ̥kNfQ@jK`ߤX y>.qS== /(i);a "hx%|.ӗt˲~E;q֟彷Ma$c3맇iZK=fg$"F}?Z ԅ(C׊Gx?='_)\W&/_|4RЙn$fBֽ.-]wm0 Ćb7b|_UhVi /?4Qăq4*n,ހTb 8l/0Xj#|{qJ0Z&Au`@AַB5,>~nC| J TH$_ԎO'\3S_k:` +? w endstream endobj 189 0 obj <> stream xXɎ6+氊,.@Ç ҷ dsEYRNwg݂iKիouEƿ_g<udMs'ĜMH&z=Yk,6B d[OH&"<톝he1|P?ܖZrek*-OC*/~,ܺt9GCBV $3\wTH+іdqZZ V.X.8T[wF4G8B+ `]3('u0k{-4QC/B,!Noq[J1)Mdlm!Øl!y"dx/y@goÒ9h 75aLX%Fی!785Lao; !!cJ0GLdl̘IV4Y{dlN3Ңa)3 fG4o0L $3%3u%ƵPBJ1dc_ vҶu`Č#w a͠M0Xfˑ Sq= lAz/JՋ^DYz/JKY&CK=r9BN HǂF=^!\^-"zEBˉp< 8{W;$n5GsDdz /EȇAթ4]U 6wa]Ӱǹ۷͌aMLq|hf"&4ig0|swS4,CY %<.|֙*ڽ{&o&j0'5gKz&IB<^[F/$$ B2ae^LF^+\|oK8ϒRDy{uO  ZS7Sz`"#i Ya#s6TO}GUV0˽ GbiYIw7+|F a2 M"ڵX I-bhdm&xةoo8z~~$sEqZInsxo6 Sdh RIlWrMKal7aI_oZqCCWeD34o @-څi]\meG B}jק [g(!cKږ([A$U aiBTrҍBfPBYW~68Z`Ò%Z&VO9hrkvxovL/zYKh[7k\j*DoBar#V(Q&<_4,ÊnAA DkEV+vKW>׉ ؁eԁGu;?pHceBUVMQ#g:~Kpev;Kv}ׄ}aҫ*Җ-DWKdɚqY EOhlO 9Z&K9%ft/|T2 CT"︶%/prKpg${}WhLƤ ;yƬ]J_7/" g{h : ~Z=@[mmY.\3DKz2 endstream endobj 192 0 obj <> stream xYɎk+fY^dg,4zc/;jtҥ8\NN4Yv:`v_DdOo8s!1s7kc|;1Eg |7<1F Rnm>_1.?9L5fZSi2SU!:2n7|= ht57k\ 3}9_D[hbH8nW0nmOޤة7G(dͯ޽4-@#d&V+!e%’-ET[s;F-(48BoĆ뽉^"4D+bG5bt`Btu:,s:Cńoz2 S4_2gA6,G9=oPհaJCpؑs s)NM;Gz^~5ZeC[N %{a&6Q:QGtڳ a:˪GX9-܂PMN}xވdl.K=fC w ϩnϸ"É߆ўo$Q6&#\ߝA45 ZUdIsBB?Mf ֆOFT^/JXWb%'^. f]犺 $ Y_}C?~m8=Xb;~NmH9~ͪ?ft(wI@9m,v c3|L'FNx;/!@,4SQA\%=bF@y>xsbE "kv^ƛQ'3Bz,'S E*(m%!Ub6Nf>I~#&:l! bC6PӘsLl\c8]s.@bVVq =_7# @0검et*rO*ˡO f3iĥNC3|J⡆$ P,nnF%g|ԆbqHFNYZ7{Os*gyf;6u0KT!FW{#D-Kit8Xx;20X 9: 5`H7zemˍ+@ƣ!9! 8lfPyfxp6fq@%f!vjsu6kŒڀ— 9IZڋ4Ϸ\YٚhG[C~J6˄>@hA q?ѓ|&ma{oٔ%Ɋ/sC3YZ%-jwt,z^c!z랢}=V?m puUӧ#.Z9DEVo! R =R-)iPGij} |Dq-2e#xQ,/Z DtA-tH6, V.+]_aNڰi lF5iO/wmCu2dx9T/M}_4(=8Ú2ܑu@y!hI@X HC!cY_a?Y 'XXktNj]va]sTsKhq׵뫇{%£Q zK=R=rdQ,jr9'EU Xpk:Rvj P٨|˽5 Ӹ?pakoT~!W*`Uok Ƹ4%M@*ѺUh.]H[QyQ]6DQ՛BIN sX{}ߛ4Bѵ [24w/@*EvEo=,˲(ޓ! ‚*\Uf,Ѷrtހв4\hO*ho Du6hҍmo endstream endobj 195 0 obj <> stream xڽZ$E1  x:hz+Y̪S,qBzϿ}_BZ%hXq9Voz'i6g}}\Mt8?NG".>=.~-'Eƕue}o=IyG2R@.,a|kO,N(Ҵkq嗉fESdyW!mÈ9 J{ؘp6{P}\YYhmB tj7] {L}.ZbU2! }a;Q }('ClNyov HP^_jjY+֯6@{ZX?PjU־ukuVi[(Z{c$:c>:q F'-,)8ÕUC,Yy4d)gR}<Mۥ*0};ۭYOI8S7!jnxxfFF-Pg۝,b̞cR p 5fZI[.( XZ2|pj[ pBYCES ; IB(!p՘Y:Ck)oMfȊrjcL]634H%nyς{^5w2 T@znO@cy KYgI{9wW5\/]5awd*#p+[鸂~PJ ;Rop4 x[(t\;Йݷ~_]0zl6ζ [64=\V쥐j\#DZTߖ-뽉)v{M.sR6m=32qO>m4ʤƮcK/$:a`мvW ԦX3^3OkG;V@snjK6*!{@"mPs8+ӺƳt@-[Akhn=m۝kP[Ʉ809؂Afl!fX &S@]aOau*E^tCVJt8LX/h h=]Unh?iPn,ӾΠv .Uӵ r @}jfR G`y@7JJ]tKkm' E\fmn>P;S6\n'~@ e)Sn(fSGy6 0m[+s[[ +M5 LC@3Nlg`H?A8{O endstream endobj 200 0 obj <> stream xڭYɎ6 +(!@2@n-ȡkq.ZrzzO۲L>R#^.E>^q py]rA9'C?prp.rd9;?_] )ҼKszÊ,/Nyt9-k-wors"?)g)9Bdr@4,1~} $5M8Ũ}VDp\]#.p%aU \dTcWq{ݗjiޓ:wyƩatjEBO})P"O! i^Y!+ <#}B;ù@'&7![kzp:!A 7*2ΥbS_r 1%OɌ&Ov\is|oCtoM4ezϯ̂ Yk9+sX@p *EBȭyt+ ;8HAJ4Xƭ0QD%)KҔ);Ӽ//1N3,rYTwެ\$x/z#h1'ֆ}s-*yےiN6Z᮳ Ÿ8/̴YgrbmO, IZ{tZ#q)GlZ}Cuzz+"aΟ1rıgY9:2>'+x:GujJkIL"k$3v!6Iq!$Wmza5Z*1dL_W޾}ǖm˙ZF1%7K?1ͻ-xS{'!+lmGf֕TIz Lsn4g*F 1u\<)YMҵD:Uyvqшd7{70 x%ۧRZg!}m bfTH w54[ZZztM34#2yjSs<Jn6]+AI˚~EJ l',3:؅=]uD`+I% ;׾U#SPcl[לs(o] ;O+wHvӃclTCPQa*nэ04m9: J6cHǙKqs5o]G'Qz`:1!eG|Vo_^DhGAMD>54!887\:/u &בzn ݷXn1Oݹ9XVSVۂX%I `XSUqA(IۆrIGLDr8^?ey:3kxM*9~L`菁pKðT\Kꈰ2iY˝C3 - [=:Nd=S?w".wtӣ+^!הwOt }R>?{K endstream endobj 203 0 obj <> stream xYɎ6 +VD } rrZvɽTAd[Q5}`*_w?=M?&*m8+Gfzq8N&\#KA_Mxk㲛 =/&w!/HK>$pʢ$J;;F(mf'S̫lvtP2e0,T\31QfDT cxn'siV)`ei90 "&szgPs6 ScfOj64_$)"23^h]oiг\b" ;Fi}''`,g8#Wkʺ\=af΄v/d/P#.\qoSML (%Z1ƷH|NcؔKG<|Md{4N'YM'C$;|YPF!"qm_Ј;$$Jq\B^TJ:NIgУ o1wҤ $P@ߡ{u:m*[ͮ)gG{`ӧU'i D[pKUT%h<~F CK Sܸ*0rq0ٹBSU;cYحڄPuv yj /H,vcс^Rz:Iے4NК`FAdniIq͒եل^=+vH=d8:s9|3W)hzړbJ6N .M*m>U dE./n-M4V2Wx`@븮_QR+"ܞ4i=u?E&hTW.MEuܬP8&[kչv*%P$b,)w|Y^ѫ7{G@;` LG}!2AP=NX0[Vڱ2+b93>J (54,6]먯6%S,.h .!C8tFm^Vb 1Wo,Q51eAo=6`HH 6W,lR$ʩҢ2+ZiaV9zȨm@WcYƵN~b"\zJa j#h(Y,B2!/?8Oe ru"T@tsLfjّ€=5gl˙sI~T ?U.a]zN[NB;]tdIb{sd25p=/? ts endstream endobj 206 0 obj <> stream xYɎ6+bXU\ ҷ ݞK0~^Q$)/j iEU{wY.2lwq}}so#k=:Xr]8_Opzu/w w' QpdK^N9?hWlb@6*@YlQg.tƑyEc1d &'@tys3Q8 B6qryK+d <8ZnL`U2J[BTypzvط'XYԖIKo0 -^ڗ:1ӹ3WSLRFx4麐l2^%6wj|})tz\ĬI04fFƵw+:XD%]~-Q0LeN:sO*$8xgLj_e4/ʚW\\ٗj[PVǠGmQ:\P#u %i!aa? ,k2{(NP+6UxǮzv{[?^kZ(~ڏB{gp0S]Z1'u 2›S9mn.%ݦUmjL _3.7mjXA@F wd[7’@<2uQMk+E oBtV9qkY/[=p1~ΈMoj"fM4gK[aۢhMR l(:VEXXé)a"+F#3,vuLI P\dGC2{-indL~xVh*(ݞݧ˹,׸-4Ui xEb!,B!bМF3QX#$ pԻUu 4n&Lh㑚i/Z;3L4~0UǖH6!Kv, iMY u}w}ɼ57z/xe 4m}\*$ 78Ǻ5n0;fbk۳]PRK!uYp"k$T9wW%;?XaHHA׺7*8UteO[դg9d:PZHۗV'zuf9YvwZ> stream xZn++aU,0 wdaV6ŬS|6b[ d Z|OF77}˟ htuʇee?Or}?|?7}|DZUn=&۾|=Ӥ9愠ˊ C S[v2`8]AAy%"6u_~,/ UeRto *ОgkzZOv!. [< ^#f]B C`NP!EKL|`y|NsZ4, yr@Yd5xdDP!Wt HR$(+B֓#SlTu8*XܤѴQ>Z#p"IH&+A!+%LQ.\N@Fq=ĀcʴITĄݪuB׫H񚡿G@/)M/ޞWsJx4ml!e 0X$ A2`XJ+Y&m`:HWl-O[tZd(yԃrT݌{ HbngWiU',CPqVrO,Atp4x뿥u,/e-p-4uÕ)AR'ä~8 Aou i1 -85ڦi 9b=̘A.aNH}gvLI#-6m(L$q11XY3QKO<ۦr${?P*y݌:KsqLYY0E}:,xM2iYRg Y(ZK6 ':~π\S9DA )2jɶ"Mk!x yIp^,0쀺4d--i %sQ]X3ł,o\ \V.Уc(a,9Ig6adTVB+Yv9{B+4lr|M">I^rX;j6\f 43 5mмĥ((SM6bwuD Ҟ&>ATfVRH0Yk.%GҞd,mt3,(gz)ܷR_ZK(v~2%˸& PI!}{~P{Fw4a4 {ԍdF{.GĆ~M!G1sX N)'PoS>TmC1`Lߎէ|5 xL Ȋ !T+v OYBvU>Ia,}pO7f$HkEh4эP7$L5x|jV|.+%uQ9}M_6}L JI+)ȔOf.Դ,7g+sZq^~by^ LUkpMGڊ|\V#<'!)wuoU5-,6~ a96rQ\>ݥx~RbVX\_C+[;*vguXcBfNH%r >s.< hpÐNƳhZ&) /<;=h@Ɂ<}rۉC,H ܭ Sϯ#ƺNq7̂ex$@C GGuQqƶ:NwĊ ri*XՐVq7>޶2s #e/*sKj >V> stream xZɎ6+I3K@# fnb|ߟ%ʬβaVDqC=1`aw<}Wy dM]LF</矿XkuND_p{+Nb\b9[\t_7rh,;EWsh}\T(iCd|7quLa\dh!2q!9c Ӓ}Tfٝ Py&V["Qr="{oSw^TH5|E&m#?BHD;pH6q}oU ȒYN|g|vZi?7m#"nTs=(ҵ]^EH\"2E`Mv]^D/Kx<#gGJzc r1Ykvlc jrݙ 1znMBn[m' DJKp3OS*aֲL-[#5lONv\ T`sC59H).n5Uپ)ZһG}Jp;," N t/; S OSQ̓ƬR\4pT.E=o_LWA o0A.!Nwqצ:tMéBP8 'E;$yn$hkt. 0HN,0fJ7߱֐ZHqKen B'5MB:'F)SAM˴H*t\ &Mo'M2="$%ݧiQ|w۔\|Iܙ6!WߐW9+F"noCu7$Ɯ endstream endobj 221 0 obj <> stream xZˎ+fX|hx @v7]-,n6*$Y{zf.-Q|qN鷉&4Ez\z/Biu䭊9MTtfrǛ4i OٷW<&;_1{\NQওI[f5`=r62<03MUio1ܦk$D_,3/1jUS].em(NljNaYCkעmi0uY}"ːW'jOA8t!˭ MNʅ*zy-zbl-RPdtT)p(zQE63 }3ݳv3Gt5Ii 罴G|f=V'ԶZDUfcag^ei2VԖC0OFe'~N ja{J$WsRصyR*۱!YVdU6i}4kgL>N qe>"tR Jtal#p2q˸i}lZ)#Z}( ݨB+Z+a!x)#!&E'Ǣ; WNd@,X(H~1wr#un"V5Ǧ*X4.gO4_E u$V=^5+@ BB LLE @䴧Conˌ0VrZ|Ey͙[sySkA5 ^{MwI=BzߓM =z:疲?N y]d]n}N喚27w%FגQ<' =rN#oG꤫Ȳ )EHa߯wU F2ܥ"D/K=)td Y$nBx>M̠y J`FFe9;/ڰgGxaS16\-D4J7w& HB(Hq].ņ=e#!54"dXڌ՞CaJ-0NY[7 rޅԯHOk~hPfP^v=YEfsKt_WN^o ;/]+k5N}zy;+3v=T_ERQ8^RU4Ѱ<@u@xྨx5*&s+~+3}Z&DXn2a4:HrD1Y,Sic-:8I5aC3@}̥s)KzTL@ǵ0Ӈ('Hm(Ge=*S㷔֩R;3J%{,Ub Z'cF'!Q ѠdVB =? D0$|d4?dE#m]0o o8X*i_&l4ʏM_Z00T6(s\73.PrIk 5׋>{HKϛ }W(§._Ƀә=(y9|w@[s+b$^^B: 0A|_;xR`EJĵ9v%CD> Zݡ\찠oFpбem>oK+gWr9](㉶ւISly7H 3ڢnJSiǽCWYʠpaCX-kz$"ޣY:dGFvw)d^M9 CUA?Y`kDsߊ^\*MY:ڹs 6BKr)msyY'}"cT"ڊ#ԡ'RXbZQD|g[3y r8\caLjd2'́lڜLܠ%L PU@vLH}jJgۂ[Kl)\\LKy1 u1ř(zPr{~>!巡Hȱ\A*/QmaPu͕C2^#4Cل p U pSSw^X*Աx&n`nss5jgaz+Bf2@/Dl: Uw9ɹ "CH!Ж/ ms5Hr#Qo\ endstream endobj 227 0 obj <> stream xX+7 +"%j Kp =SHEQ̳}W (j!?;Y."nqO/XmmGĜvL{q1烍H=ol`?_~-JWZ}6C*zV};E$URʷ3yZ=˧<uj:ޢcwȪfK=u}7`k{X|w <7v{whygj#ګH&0~oUSul )66FW PgѼ+ʯN҉_P>j  rUX䋲"/zk?+T\ЗEc'@&OeƬKS1ajÅJ)ef+(8:E/EP!o<6fNGr3LҊy^ll;^e5ő;)T.<'v]̶, bp jSn!i(;}(5>uGPzmOݗc7eh6#37(>61a[AsRh}jg5. ,"! HAMx2)5SA|T5$QcK[Zr<&Q.V>1 :NӧgI<1VNf+g(KP-{8L飒&$ؚп>͐ 6= QUtᨉNG(Se{Б_\':آYvgZAyZPv/wtϽAnoqm\ryE@ ΧjyʇͼyJL Qd8){<^4m'(2G9?I&SYHub8wy!0rp,:i[ D&Rؔ_G:rcx4)cPshGe;SM1m+*}{Ԡga W5<(I 5)Hou#G2@nf+쎄|B\2\J9p+[')|b`y"=#m+qȣfuVBS>U${ZA\ƚޭkru>AiGI,|%BT ccj1,E=YI ر6Qt}b=rL@iεC}*mnL-wTw>R$du\rN)ռ7=as ue<Ď29 #(F/48 }]Ҧo$0F.Pr*VE]DʝJ\K,i-m߯Os;hwOՂ547b:-5E2"g|qyބOD٧d1P]^:'Ro[Sy7-{0I$B3.uWsY?Vִb~ubrxv& F)).m~ܷ endstream endobj 12 0 obj <> stream x\mo_!Y|r ^ln7@a,M,]$N3B6p=2Ӳ,O}5lv*Uc*]W%S_Y*+PT xR+khbem\T9ʺJ_,*bD= ϕ((`* ]%94вG=p0ФrTMCK5C6!VM&A"0+ c% x| 9CO@2 $ G#"0!Ae$ с4>FS&M FbˡJ D !*i UJJ+ K0 ftPЛWGhs#b=mn4Xe4t>0:a F "CXB{3:?pS$D!)24I2mYiqx ෑJH-®2= :#~yȞHA GPIbZN7SPh8(HZ82$_=kpax!r'=Hn"QLa-5)Ѳ[d>AD=+"$  kJDO\o3|/. 2N\)jr^/:-G)~;ÉQKdl}Y?&7`J7gownUe/|;?o775K?\}ryw{Ѧe ˟o]j|qr x8[\:"Q`¸<<>%; n1 '| *B,&UMA.(ӀPOν7* jsfyu~z;[vq)`b!+IǬ?\Ǡ` L]Z(ӉYa̼C7pҏN%PZӁoo7痿ȍQTⅠ8gz &o!o \8)HI`'Ƕ% =u-!;'Q+N=Cm?>ܜ1;R9N?҂XtF.?m ͌#٪`%ė NEU@[p4Ddmgiг ~PȳV>/ +bCj<>8h*445'ZogkoNKD'K% ! sr-}Dn~PfWG[%jVG ?xtE1?@/ q^h[%yvpzH<6jdi?ͽ A3bE o3`&94UY8}ll0kI;2O%?>zzS&<Ą#1Ls/Z^ -!Bo\eҊP ƭڃ:/?qyqZޜ_-NČyFq8*:wD N p  []r22ebCtbKl<<}4K yF,n: [~_fdL|$anabBFqrF$ 9#KWWӟ^qlExŵ#]qS " F ACY>< C:UWuL2ȅ |j%8$Yw@`Ņoi6}j;,\$:}gJ9ڶ9L&> nx+44n|9_/1Lrj{Gԝ3L$aq^uG@Fha[#xn~_id,q9+D<lIJqfKaR7 VWvQERl1-p]n gZͶIEH+3FaXOOZAAL 3r<|hC?zT9]+%}S=c@%@`$!s8B+ G' #ɋΰ-3΋K lͭZFrIZ`yҽN `LBRN3&_Ć|lRt)bj&gF0'mm+wA0ꬖҖ(f.aq04/mp21^Fʡ^e)a< f=3[[B9K9eŘ?'X{gV:'2LQO-7o6f9ZglzZW#OPE ,NOާ aNK zY=A=T٦@vPU/sTZeل%܏1&]aMsr?m#7܂V4%ΝLa3%6hL>e;sv֛%sxί>ww/W;+3 ʄ@x8N'Lvy\UѺanbҁ4ɺc8 pl?bAXt0% ]?7(qS~(;ryMYc'*F+3 VΨz1muCg/ 3*J,'3`T}fMS߳׳|5y; uto n~-v~w;)$#:#Ց_ O>;& ĵ0&b}/uv1]]/fundCb}}%X.mA@{^3xo_NxwJxePb.6o|yYa t7|8"<׶b#1vזcn|[=Ҝ6::`Y:$_Y0eZɕGu^>kf]gbQB>P/d ;G ;oF ;_vHx7RG,~XG C;. ٸ:#uHu#udHGȇ=7x(BBKuH+C}U|nѕGBۯ/veďĻ-֡grqb 1!.0wf-ުK0e_];s/T.V~=e׳B]* ky{}a xtP0;.3@ʶv%f/J5NmuTǎwkEmUۖsK$&^ybWw;H܊I~3s;L}6> stream x[KܸW\4*V, 8^$"CLO``a/<`HuSQ 4WEy4MxBʆ\U ń3XdžFaDmqE[ij FkDcC2n ; W2cmƏ2u Oz& &xMHl}-ֈ71AD&YKl䰐-MhǍ7QDCD'Yr6,`qФSbQ12#RzӕDW4EgUqlLLXS$QB*n!7&-4 qbae&ԚF"'|w?k‚JSNIWgVuNa8>LlikN;/]N!?joU8D++_iUf?%D#+W6unS6o-_o7@_~obe3f[h8@6 .J3Av?Anl f;%;;}|NlXhCl/P=X? `$ xMTx B>XC P=.mD ~v;AvQV nnLan'1 nF5ΞWR߻ \}耼cmᨠ.h컆ڣѭ` w'U 65켶qQPVUa+dMԨmI›5 =H ٪#'Wq=a{;!r+-%u4NLX̨OJ &3^@9ݎ}]Ÿt˄>>f*v p{~+ ulo)vHi'킒Kf|z~=fqA [2<ڼ;\9?Wn~xq*~}Beyr9|6U8sSzs_NՕ\s2vvvC>=UdžSL18Uwvnc5.nf,y5b fLSo䑧N.hZ/i#VHcC}UW}V6W}WO==_憼-o奆59V+Zi7eZ*{PS)QܿeaSX5x*AZ6PCNπ,}rI[UiUrd. \WsYgE߼R\Ýr]*y:] v 텱dO:wJ_HK҉3tݜ}uCF\'Yr]n瓘:5sS2%Q˙w 5픊ηtTr[kv_lJaۙ uԉOQsu)c'jYB^quzj.X?] )TєYI6i?sz/w~^ׅ W"Y8ت)ܶpSIJO'ۻfu&vA b>Ɯtn.;PͳyˆNdr^/iQQ)st[B^ :O ^{Tސ̖,TǬx z?JUϥ2V{[?; u/Et*SR_૽B*l;:;I[z)(sAt׭sFأ W{kԗW,:csx=^z!\N;s[ո..8tJWJ|-qK0NJҜ:qWJR|K\JcNpez{ȩ+KJ.`īC%ovaS={He{m{+x1SaES(mn "߫񯧇O_>ߞL9 ?0NS5G6ڼSL>2dT&/nT&oLޕ 4yer\\ך\ \q\lwK1J2Cb}wO.ꫦKY+Jsh?}{(0'V'7!gymy_sNo]֭˺uY7ss1'jSJu[c>vδytggyM_L\,_-FV+ܞP{:{Tql)ɭX!6d昘K&f1c̬f2y/ٚɯx/u V\\+.߈33߭+-W.-K4_琧pXPB (hf@\|!d]H|S6^O%PI1Tr $C%PI3T DCRMZE>ʩg .P@)GRHRR@2@+Y/S~UJ"G.T BڡPB|W|ϗ|ϗ Sf|+{SNxN sx> stream x}]k0$:ֶLGvB%l3縏b'yyOLTsW)3ض֕cs2% jɪoy(ZM8sVIzkٍ_`wfΗglI[`rtRmt0a3g6f7vT`jcuLvj=@w;QX6ۢS8S?.'r@WWEm{aZz50BJb>%_`!F|g5P&BԷ啡1Z5PB^[S?TXb _^˻iB~A($%)@fD(&8 -!e!A`IY#DHQQQ*${Ab^&?mP$6 ^v{/k ?6 F endstream endobj 478 0 obj <> stream x]j@}L)ը MjFT6o_ig̎cqgnzVV5;©R~"|ufY ̌vodGդ/͹XҽpX%8kCa>xwEP4Gx]ԉ-aJri3Ԡz G;AM]3ucÇgpb}EY24Foh?Vњ% ~$G`uk0NN\CĐm"'_rO9\jC($NmQEBѥHH}]5o6$dck""wH (ORE=FJ.Ssjǿ=nmI*6S)m{۴c?Q endstream endobj 479 0 obj <> stream x]j0}\vRѮ Bdt}G'^] (|''sr6QKwEFYjQnT7+bX6W&:#om&Og{K}VRCsNԦXXlA?j_v7zc$ȚQf"٨ԝZ04r^\dB$ -ɛ9v\t1۶3ȐŠ(ņJ@!A ځhBu.ypBŃ@u=8™oM7i6j:o}4ı71t+|)<L ISO%5 endstream endobj 480 0 obj <> stream x}m8SeDϲa zz4[&moc3 v﯇f$oӵZ3tOqH/ᐪtW\T:?> stream xU_HSQq3,[eJ(0+Svyfdz| _A= (t |ad4"qE=}.v 6&2QS5^@`gaɂ,JWTeAJ'B79"%Vi'-5v&I.I7 I B~2"%` Dz3,< `8pQ Bo`"0>x*FGB b>WtG>=!9t .tѐ>c'p+88籊]E3h ؆ ~w.+HN^m͠%ϨʂiyniBq``Ʀט3.-UE)ӡƏQ:e3jVY,z㊜L$e[TEhћQ2tUrk+f3}uT߀ #nu#|,:@{p@M01 Pւ1~f~螎iRs3~Y&]<[X/t/l3 =?!pBgY 2ryfbo} > stream xMJAgr02 ө+%Yw 2%` W?,DPBs^w]Sx%Ԙa;7a}\.[*|F9%. r+' KMa !,XGkO1\U S'JR"SoH)JT*# IJڬhdU *&CMx0 V[bY>ƈQ5W[jV&NiU%ψB/+q?Gd ]O`أ!Xv1 wo߰Go 0;XCsZhaB>)P`4s,ŞQ9Cq -++71 endstream endobj 485 0 obj <> stream x]ok0)cMڂN+b6PcH-[u[*.IbzYVNH`{8խf·*mcI|_[ٗ5,:r+3 L̜4@gah1f\"=MgSiՁ-vI:Ps(B;Nɾ$J qE,Y>eQTq<!m(Eim>ǚ eNB.9yH< C1[Pwq{侈0SpncSрTV7#6>Қh3Q #yԏH cic$ƌwÆ2]l:S>8 endstream endobj 486 0 obj <> stream x]Mk@໿b)%?!BӖPͬ*9W]r̬;vl'f^4+AJM+-~,;9{$R~+r܀UT#q<-D].EŘ=l+,k"ʆ.IW0ܨ#91NJcD_8T)"gbe[$qCٵZÜ8k%Zm dFG<(C ڸGBn噺dm2};B)2!A,6Z󢖧 ԡOk%4B>KC#t{KL#, s]y t[f*}HÿC endstream endobj 488 0 obj <> stream xڝzwXT 9ۂr9z5`K 3H齈3C.],1j!h5I4&=AswygfAX$nXegKH.nAގah 'p" &"a0\2DjbeCVPCE"w_hp!pqXHIQbqS9)g'.@PI v(_].. GsW .˕D2(peW.Gn_}̗(<..ȮI||C=-'Oh9Ң['k}<@ws@߀nANv(ojO; ޙ?XDh~"S# DEDEhؐ#Dl,Ĵ{{{M}Rq_q?qfAbx>F4JGp4BD-F6h)Z2tiP9@J",ODLj-1j3C_Sө" ӫ3D;{ӷuzbcr$D'=wDߒwti7@: P[Vk6ˁf |1zОA=,l?8mprcL.yJ`7![CW -m59g@H(j޺lМO>+4(ЫDwG|}T>@h٫0z{iD(g*9/ֲ>!gxVUtJL^Г)ԯc<NF-(ܓp E.Ҥ+}vx*`-vOljX_ᨙ6=]u׆5 WAT635u,5ģ{Rr"˜T) B _^>$@k]nM|=®*nB w*ay`422C-MхK%HO1!ce*.ѠVinx|7iAE `c% t/"X+(),n^6O潕T B. o#8`B֎(#COX _<$_f1^yAԴhkIhf20%d%0w%TP+E굼~!C\hx SyQ-<Ӂ{"8TpͿy/U"lE/Tê'.v1+R'j (S$.BE^߯ĺE먌NhPuFoX b<_6y,{؏: 4,9i!x4-2f!+hK[%ҵM~{LߋƨEE#"!ECO rGȘrQ̬:o, z@͖xzE*~[Iz82ͤbb'шdkv]S90*yK;p=i)i=i[X`jH?ㅠ6I4S ()('GLummw =/Hj{+xGo? 3u@J>p&dk":[LC s!0NyG&F¼Q (NjR=4~D0<%T\~Li,V Vf.p3݅{@3S)/l%2#Y_40 è4]* J< &1 $UTgf t xF[BMnN uV4X%~xFYTuY /ui̾9N|twdXN1?ڃ9%Uz /a)-}>v李|\Vaϰr&EiI/=cF\y_"Lu=W#=);Ǟdj/;11 [`}l,RCM|/Zk ,jQ'xt2Wӆ;σm2)ߕ;캡vPLe ٬S*dF*B5hQ"fB::>6`/7\YLI-^Wld& ̆SnZã. 0ˬ])rzr=m N}5>ZX^' fU iќ< ܏TڪZL~@cy_֎OWub\4SlԬQ.>ƄN*uo. !.8V}i! Kx#1V'b;ɖX!JZ o^"'_OJA fVfcuM>^6(jec3UʭYmA5ͻLGrHZtcUP3iI0RaT2Z/1cA3٣~Pb/w ٺ`Yxo%O9Oe>QQ^қ 59*gv}I٤Ң;}?0fif. //$1)"lAy%/a![]ty+2Õى嘐Dr¾Έ3#Xؤ57‹`w',:V)SW][Մ\ T|vbf<7+b7%:^U8}xú& nu'd"xX@0Zj C" lZG0B/*!'1;SVK0\)'vE)XW-+s2-' -O,9N=q%FFt"ث\ vz[&_㾰bnC(mII~1syti#wGKVDy-ʕ6!3fQ7<O=CfigCCE*toOMEw,}{+N5O4L]=:q&^a0ɫ'%!̩,IP%1d_ؼ,y^fZ3鰧UgG0Ge;Fɕk01bO<]d'V086-qCHe S̘-`EyL$U5JIib xa˺[ l#>06͇~d+6|8ɖy( }1K_P?b#PʠT$O8 ѧ$##}݈{|յܩvo[ ;k6gkGy\q;jů$PxSԕN;dV,vVߔ"OF~$2Z/ ϾkPf׈!0QU[)u.?_s~aֺ}ﶛOQ 2 8)nsL!4SS.ThSbȇ*EnJ7M) F+)}?y(1 ;#wU%?[uW2׿.#-u7!5pAjz 8a= B̍ _0俆f-l2Gk5T2ټqK5zF U/ҥ77ttIkҙcO@xf ?PȖfym e辥)usXD"L5+Kʗb^ڏ~K]kZ&]m;׃;M\cO^=mǤ<6F$ PY mpkGYyqoafxMmۋ~`lxhRj|Kͼx}+M[ZY`"o*qel'2XYB[Q!/Fx;`Qq!N;%d?nI MLyxQK/t= ¬䜔0&3%Ǣ-. 'YĘxtvjŧ@c dF@M' AK`[N>~oz#,GKax,q@@,v\O $ϒA;U 'YEuȡs,иX..W[y=20wO>T싣u݆KB̋+> stream xڛ ܀`qy `9, > ) endstream endobj 492 0 obj <> stream x}YXT׶aa&wTaӨAѡ>;Mf[|<|E.4ȗʛ, 3';btFyNk&z+B"C@ T4D4T4L$ E#D#EDEz 1#fHl$$6KC21GG48xdfh1*CU*TjP-C%"Zdm@?j_0h\0xzƔd3H :~?nA#S#Q"cCc7㇃NT-}?daܡä*ed1Xc'|_Oo ~^n.a=wۏVWerEwX Z+ZǚZN ?S '`&*~6yŠ ~\ZSM}ut 92HE4uWD6/Xx2`Jz,fEީq/т-k *zɖee*|rne r 1eI@YtCr/` F*ŭz k dXBQG!s_\ 5o!~VrsŋGaqW /ц',pE9-WˈMuV.Sbֳ'N36-> ﾺU2߸c]uҋ/aVa|'ucq[lZJtD@PX%O\GNgC et;Үwo`&F@,Og4)IZF4 8OѝŤ& +=[ %$| KS! [HNOx;0[YbB>R#xξew@3k+y"7vH0"?be.=>Za?7$;,mc+ ,G_W̧ KHA,> Vfd$,EK%h g.aF'{yfZIp4v)?|) 383/a(x{݁, ŕR>~ ̄$dqzpEC`@$\ }}8l!'A/t.ތ#KF] &AvTK74Smƾa:1v.a_F_ e0Iu~Q_y= fC-sϔ]gC^ Z{LїǏȠm38)LEukD# lL-RExn!TXBd x՟'"Wlx==  dH39߮r}NޮT^Z_[^|ٴņ7LLNO _vE@}*L4C# kպ{˵Gcڀ0嗛0dceﶻt)ŨX쨉LKK (Qb_mHK~Uk">(| ^fFlp?'#4[ l"*Yܸ 81 *9e[3k͑j},]*HbV`*'RN%CI$-O Jٝ›4U?3UOА ] ! IX ANcO t1 mz oAʚjRyf&̆>L$m<\wCg-UDDчBP$QduӧTr)q's06]U )WiV1ذw"SC`(2g(dӣ'RRt;zlq_ 〤[4/Wmj*qd0```YcNYڮ:ϋ8ୱ;b#:h#ÈkFT?̍mEzZY&w`4AѻBǺ6{PK5ᷗ09=l BKO&9fk7Qx(i׊⫮V\`_{d7Y~@aA]M Z =VK4'|+lW*MgwT6/n x>޷ͼ47ɚf/"7f"X5(ًnt75QE#Y+ f5: MP%rݍ}}+lBbSmdqkO䛂{@5gN-ܑɓT穀ix8ƴRS& 0Zැ$'BfGUi<\`axA Ed#K@K%qQ9eOC0 \\X͒v?8՛KD16rФC+ӊ:y؅t%Y/C[vGsF29J|`I&DmlUb^`#K1Dɭ.NƑ#h&S*L8)𤋮l\Ka}%r}\VL#T&31#)U@-ӡFl̷ jԞRH:y$96!yWr?2I*3($#L˟닥%{tz6]!(,P(Ҥ𝭾v[ e䗕H䐼V/(шGG¿k i)ʎybSbQ\{Uoq j%n|*oDdz2 *s8v뭀FM:#C ʎPRc3`+u tcZ7-:EMգ^xTZUmVT INq-LU0Mrxll 2,Ĕ%l%4%-vj-֖!:fXx.޼}8X@|E:*:~"kS0ͯ X|zkv͛,@JmFNx'MA;=«x؇k*uʮrWZ|MT[7#$6\ڛDqx/|Cy\rQQyI/qoUVה\8Z.c&‡!4h=QT8rG ]!%\BT\U>'Ir),.ki\eE?^bue35ˏ{d(J;4NeM+2Y$ eأ;J!yg6AYVyǪh2gլul’D;Wzj4h"S4̺rT]gOqID a\]Y\1(`Ke@7O^_>/酸DRITH %SG{:(`kݍBl8bN$7bˬˁ !ko` dc.tSzPUA\ &S\>u JPɟ9Hj e&}": ZUt0Cgq.`(2}ȸDV|tP|d{DEޮvWXftOp\O -4K^ofQVM"eiN&-;)J >zĀ]B2ϯ\hftM6^(􂲡9~roy&2>bs Jև2(lKDl).83_i7)i#FKNȨI6U\]4VU֣ln\mӖP?q4wN zNΡp<`x0nm)'^-?hDR0 6M2>Lgq~7m5`1,"b - Cٕ\~0?}o)CSoGWrkQzGׇ}GKEhrjg5L0CVFݿK[ܶw"nT*ׯ@^> stream xڛ ܀}x8D endstream endobj 496 0 obj <> stream x]X TTҾtGa F#&&*.(Ȱ 24OKDQPpa3 :.:ŠgLIpjxV) jGWG_ -8 ,+  a&܅%x >'f la0W'B0_!B&, b!RR4aZpN'+G`W+6llڤ>RRjWjK.*D\uZe!$|BV6ɶgd}= 35^?G{;^{_˽i}lۗW_XrVwx|eꓵ3YNoN*Uӛ2$J6^R5,(&r%8Cu;6~_l_| հk`'wgأte#Y3dh3233tj߅cYBXT].^b|{f7 "?R`"_`KNĨ pe2UǤB' #gb=1 X,x\*sE1YFg`qDM2De&M1LskQMY%i3WX䈄|7kI8 8[9 ʄZ5if+U3{Tg69,\iYٸaZ7QtciY&L~f{Ԍnë'3LVmL.҆\|l`,*c{0l+H)-+(,-1`WP[)~bѬo< , `LkotGp#KH]Ty@p &hf:B @q=DՈy er~4 ~Sҩ򓹗\Z2}8?{ $ӻW\ S$ht ]c۴Ϳs]{䧉wVL4CAq<C>Rnb!l!,uEX`6`:p3_ӯdިc/lOi3"69RαmxVh,t##[ϠmE p>rT~ -@` ̝E*p,36<]iicS((,ӕԳ*Z!a?ȝ؊N/.p=Ͳ)*%^m?Q+/aN7d؏ɺP_T~D\R@ukh{ь682$ͯ7g&4Ѫ[⽇XTA2`.0w-兣.N}0Zա|elNՂӂUOP`T+VFf-Xa8&g%Z]n kC ̖m`e8SU#=$il764W׷tԈaehc lR(.iXtf-:KnsOE'G6jc&Jq MR-JTޒlh2.-Ҷ?~Hj mw%b4{;4_S#;&JM8>b0Z./+4#"gLI|wEo2]Ϧj'<&Gl4XuWV^ sAI\!?MOpYSLvnaUɈsy*{wZ5'.MWޭbPVE4l*%rI\ #p M9&q5w ^r뮭{a0hF8ބgˈ&&OQ͋/CugL"K$.5ܨG.h=j8~A-NQh`Iu-oĦLr]\K0{ZXCmAwpWY#xj=O=,L4/Ǧe$Rdڟ C1Ntfk,׆dҫ:k5?e*7}o[;,]pm!\7&Un?d5nU߷0Mj@&p[kVzc#t9 N֞mTLT/"kaVJ|N t`E[܄ftJJtEiqZ6(@K EfAcpվ\UXq\@UrV}hWo{&`o3g20ͼhrjv g$L w5D;DL_̐٧n)V]~{ʫRJqS2owSJr}Vù6Ў44 Xd\B4g7_i&|pUaՑ}ǁ}ꫳۻg;LuRa?k=?;FYP^s;c-9e6x%GMզݍ(<|s+;ߣ{SP *?c3"n:AMt۞h.cb:~;JbNepVfP+5i3|{9s.JN'&{k:lk8pg]?xf3ygn&}SP0H\ iQK"L04X%pۦtyfnG8W a1A{{g )MҴ!I&j7H+ܖS7gC%E$|TeO@~O¥{ |{ &J?J꤈c ` T1Ip]tUO}^p=,/$37H9ZzUfq2|ݽ?X4o`BNiThW3͚*^i ѢQ|7 kf՗͜ <WYR" <YiHBSJK1|Y*{\i( Ksp6dU]q6'SWP;/1t(4[JµT-faИc+)ubRVݾ\~P[ŗTf+(>,`u\SMTnpmB:df&f35~)Z ҦRĤb!K2ΗQn7qUGAȣ!kYL:tHi܀?yG.Ǥ%-9PI}=7 /m5y_eӼl]d٪94/]rJrKyKkXov;[hhggi)! endstream endobj 497 0 obj <> stream x6,! 2 endstream endobj 499 0 obj <> stream xڍXI/8T*2mNc7f9 fbBEQA̐a@D$Is 9is뮺fݯ}{SS" MM Hoe7vRhs!"@[CC,hi[5wkkZihv!=juB>wkSSʴkhD:293m2oo'M6ǐg`ikiecbefg`U;Z{{:X[9`{`euXb=~.{o'N7yI?KO7Go0k.o{\^wNխvtr K#6o[i9H9BPsh1^ޚ> M_M?j̓u44#= @hah8FQh2\dh%ZL:d6ROQl,ёВ~3WMǴ[Ok_~R[w?iYkKGCGCGCh飣Cӑ:}jhc}isϙ>W}CF{oC}m{okߓ3tu.5]Zw: f[u-tw*uuuctcuusttuefOb;?G!"((A>%kk!$cp =Gݚ5]4 5"+TfjXADK%UȞ={~5GC>۾wZ h~CJ>wn[(b+YoY#=AG/W3.=^ac8kaIv![~O8hǠ+758`iC y8tЬaӇu;h%#{L1m{QF~tc֎oLŘc-c\cƿnBYzOʙmwSܞ8δ^M_=yg|ofOO:3kѬ5J)_Uvu3 1jI1V~_-*N1*E+AAa/%&K"#埧6anEwGwWzElB[b;'꺰T;9z/⤪3"UohON2gp4,BX+7T`+hKcRugTQ"dīH9hL  $UlWSRSѭ+CPvKB0LKz+PP!1-P*O05(p";X&La`|L:znW Y'XF+[~y2D^IX=n)$ǃ_/U 4VHfgߎaeʻ0\N `Xg h_݆)9]TMdC Ng  ȥY2  >%0 9q6&y(5%n*7k] 7BA* :V'j&F?]!9SacPPZ""J +NzWЁzO4)n 3d1SCU (00[\fct SĹ-jr[;7G ir $i3)K<U ^C` @04-Ҍ\GrY8j[7lROLD^@^Vl}&_ s̥췙j쟂DIg(kE!`79Í/4`.7z7l7gywa8Έ),X0+LiîqrlMcyl}8MB QWEX+ebZ$0t?uӎ%G;sEa#W[ 1_i8cX pDd (iϯSˇB$s`]E.78h6fծ+X9YoGK b|44u9?Uۦڑ5+`r0W~<_t 9h%T/`dr=S Dm̠4Lix)56)L2Y.Vጴ .k'֕]i[bzzuy&>p"($ZO΃e%> S v 0ȫX @vCEhN."[Pb0m}ԝ/U5,D}_?5 Ⱦ JLbUFβEa4G֚ 3y)~€G R`QX6ofF :QK1M,5v2֝yL7${08r2q-ȑ\PY"zmNM=$/(ádB|;fAH }àH$ d,H=M᮸dKT*ꐨo$3jDX]U䅈PeD_O}TXq${r8Ad20VuQ ]x-@URr<+(BV̅x-wɕ 9B&ӘTR9W_)j{'nSχ! B\3@2 LcS͗K٤e)j nW{p0BWr'̕ s_ z@'!iL`*f~s'm5{)LUmؑ+-@xd &\p(rL1JR:;` +'-4XBWȐs%d2 L)c }m}S?%45+<Or@# LB }Rq~$ 8&J\.!i 0BkI$R<0B`W Kd2p䝘Hq>/U\E/IrL"\ Fx1pl8Oo+JO5W;Qɐ+&d2 &wObaZ@)*l;sAgT*gC 9ZRB&@`w^~ :HȸUJ0rLЃlIDt5s /U]Or'L>`Bvw G@~ dMtG-%~ϗGe!2G'Ycޓ?tk Y;~HaI%pDFl!\V^VG+jewr~R {=~ }j%Fk>-_%赽K\,jn^_a[ZO߾Y1;/bm|)yQ_KQ0SMD0/wW[p68t5J(i@&7`JV婣` ; &{ <"N3wgIjqec&|/=q>תuHpd;N 0S^ŸKtVi`f-H[NV0㵧q3#<ըpNj}q\ve௎o7!b3O.şqZ¹ljΗJz5Ok/P&Z7`q _IcI~}O3Iё~8 T-#w#X\"YC;)2ABmaT$870p9Hrr,0 eI`KTcw.4D[}?e>xCt9 er쀒%vTⴹTկ2c}ÓbD };=/\~0eͦ-4ݹ9dԈ^Z{zS _fAÒE,e>G#V Ro݆>Kp$0d0L\ǧ%a=؞"N-"}}\%p2ŃX vPЇ@O2mbރ蚺?Hyj9^?HxwU-]e= œ `+ I%7He|ˬm|=r<TspCnU^p2M6dCĤd9e IhosX$7 /%]_pMi^%L YP b&lB~*Q\UCs9K$1ϸ C$ws:L 6UY)Ĭ>hIǫdxhl"M5Dx!$%F|Lql6Kqrx{"_; \ DV^xZ?kdiSa2r썢(Kx8k'(. WRi)&F~A* jR9UJЀ`Y)#`$DIJ u59h;}kc2dsH;54_fA; ?Rl\ǚiWjП`]0üg amCsoֽ$!^dJYؼu\$C]4#¥5z `ҏ0 ~chw[@C~k9lD*gÙй,MpI6/o4JRc6ĺ=Cbp9 I(.?%6=A3M5ĎCpXisHmʪQ8hjvcubЃzWR 9Q&XLt<87{#! YtL4Ճ>[2Ygۥ0)*>H 6 'AjPV9%դĦŧM@zWSG!8;@7]m })wMV/W 7|e?i+5Rypgt79xa"cjK7u!aKZF|Â<<-H=7~H5| G3αһUX! v4?YE%VɑOZ0Aiԕɰ"'. Zc&]ͥs p(ႲŒA.6Nk-xO"k=wUCu㼌gb*"_|L]G/˺?;Y7YBk)|TP0/)B,"PmG!O*p&A`)1>2$T{8j񍹑i|J@{ ~: …IɦpB^-nojBr㻄( ~euef LJe߅@a8#~!;5J"y2JY"SsX .|~e|5-d ROۗ~7ដ8%/=S.mN ˷(Œ攈oow˱!vE~y:.Um S{@j58b+7J,Ga)ٙy9Q.䳨?ȶ Ľ'lD҄n3G!k :R'1=#,ܱگG`_WQQwTwk> Q_kKҸl bplaL6e׳n Z}6CЅJQ smav au1쨑fH;d'ӊ{DpR5|+;l+3Ǫl}{Wd gow%,:@=n`|1NT'*ʏT)Cy<FݰQcnʄQ׋'0R 8D; ,&x+m#Bȏ3xhTGUfIjoD=IH&_\(k8VPŋL ܲ3H Mgc*AL4HcZu%(#=s'D7d,})][R{WlSD$.&~DO1kJb2.%lٞ]_l|lYƻHFO:;-tZ!yGkm!W %xCbnQ`/<Ƒ),"Uj*y9m,̈gUHKIO<ɔ5Kt00g^f17 +zCn_zwA}[D9Fyɷd:vq&~~.Ƙ_nc\K:9Μ~82۶W?JwF[۪4=J]];e¬nwrJx<ز^9ܴ4">yaʹ}ǿOޱqeZI],]Z`꧕7%tgg:fooRưj=V Z.ܾwJOR줕fA׶Us2Wp9[Y2u"f\ݒXgݸ6%kr:eܹ TU^žH~MԂ#jkae0 m;0PK<䜂DgNGpe`c lCq)pm $J87̉s\@rP`-/?I#4A*<2#ktP,0)S75g^=5?q$1?1)ֺ xgfD ?p&ϹZ-94rF^)=rc"۱jmb.0)X|Abm\:3CQߔvTk#&"yMXs4."弪/wXekƁ Fy5xR Hτ߰Vz~z0 ݣ7t#7{[.Z!;v+^YN6zMw]iWj)_KW}-N,^L[eXRͅdP{)w\tqFL&{Dq/ ~7=ngf*myvnFa)^t0`O0%;cۜZCccbcKK2b ٻI" *cI8>RdV`zQEKfV< rc(3zr(3h@aMАAk}q0XkVԾ(v HГ݁'`dd>RtJsXYE+&]ufΕo(q?~B*;)vyed@zղ]Ip񈨖$ +$&θb 7ށCa-JOUv/{f,i_ kjk0Q!um ´#ilH+!1:p,f5^}O`tfb N?qt,夋cjNߛDba^d[V+/\$fd-I*9ϖUK%p$ 1ߏ7E_a {jG:QF{Qt$: qE;r!j[l͋0h5&ah09 o #%XӕfU37-.v_PϷ O aB|\ \~! 50e|tD-E f.6њv#qjep!$@aҽH򧦑 fnMgOV߼E?/B3à76|^AH@LV#p2 c+}P (qo0 _p =aG9vX)C<{ _@\*9ԭ VjԜt9*,Es:=(ܥ*@' CEX٪1|¦$("aV(mTEJMFSTмj]!ao=.68Lwt/ ̑#EwQнgsJH؛* &ʮM xM/"pX^ cQȣS=_/~C_Ɂx*X:obWs,5"$(\g;~$O^\ϑudH x`{f<;h][{z9<%+.'d. QMWoN."XiEp炟Gvʪ{2-9X# Ro/mqȹuj!];O%lh~p;$E6zKՃyD7weF|,<6>6.63gQfͺF~#~JP{QQY_2( XrK^a?;?(^e@S{0Vx 4/2“ 7h_D_9΃EGRzbw'gƧ^DOZRyCPL#[{" '7UBŶLo>>GGc7˒|ciUmZgԛli{^=ZX%_Na't tEAS[SmĿ3cv?8CcF 1c̨9yhbRV((_ҝ.?%~)䤣14N;hb+*Ҫ}"=*9^F#)#R?ɴcJty[S Xg JJAwnvKb /w,9KӽR#9QicKp}κ-, @W&/H  !k>lȀHGwLa.Wmo=^upf3X|y3 &%ְ6מPokɔK?q?7]vna nJšY)7ĔDk X.cP+;~Np;Oth~'H63'^JTG8 {RY-d +A'?EcJuXK݁_;uR&} _BzMq5yu. T͓OzR[8nNHؚU"dSqVqs:>`R9]7invl#n#MM+{$|-/F8i q' gp,&KH*li[_hm:wlG{`œym]Gl[KEkfWۏ_tc X_>k7fޚg4W4gߟ>jі5Tȋi>@~OxpUU2.2^`%:S%CIZ9 [%3Btʹ\+.`GU7`B g6S{ $x9h1-*> 0 N-B5Q7lo3^<%$ Sn!$vXBK {JIM3D-R A\YPUw;=#;9&¡D^.O~mOk endstream endobj 501 0 obj <> stream xk`!h@b3228`WuYL@fb`̔F>fF"U;1 VQT7PQF eP!&̤&BZ`! PAe2> endstream endobj 503 0 obj <> stream xeXw|SGd|A/JzhB!ccwj%Wٖ.rŅ&1j( B# y~|}3;+gOP(?_kUb_z"wHV~y1.7"r.npncե"?j @җ]M>reI(t?Pl_"_0uZ7~c@+*w0_$0woZ V+W/ S0/oZ;kkWEXVma~~JHeO:ecǍ?v.sqB"gk =@WMު%~5>=ʟ?qܻϚD$bY[" \Ro7B>="aO!RBY["# ]pP*=rc KE!o`ti 7chT=G$JF5)ʼnq*%8qwwgFR++?.בM@:3@6KZ/AbBkV|qe1g4_}z8G8!cY?[`:@4_ Bx~paWNhWˊsYux6VV]Q0]Gc?vE?҆Ⲛjme&<8Ȯnb%ϚaB׋`[m1۳  ȡơ$s [^Jwҋt ySΝSQUL,yrC,+#]-oi\}{ѲBg0ϫ pp0ӫx: :F5AwC[ <w:0Emn4:\[ vRC eq.EY T.zC2֔((03uc ~`Vrwu&ޑg9ĥe(x$'܇j:= -S l5`DT*j {P_B.зD9<<@UԙI$YYihIeAdQb'TowarutKs ̤\v?!P- $wDNk&RFb}&N ŝl|;6~y0rvVUs7*͛.Z|Cѹܼ6&X*.mjn` $,bi#,'tEC g;:<q/XEX^MRa"s#2d{c;ܤ|r4AgR xN=,dprMAj,b@{gtoRu0.L)!ĕR5'r4^g2O:=7R۳w!-ۼʛ3GO>\p]EG ,gorNv^/3 d04/::gSsOFyQ^`%iDCk4Js3<>f6R+Y2g*tVcew/oaZ"K9ML3:ݸ"a"2RFT tF%<᎐o;9Fa6f07*}MD_ v3 LA p)o&Ga`wDk3B@f Rus(ʬ.n[P|=`zt-E6UlYa!&ᾔ~~PrIvr1a"<`Z܋oiMfVr]>?E|%Md+``>ېˊoO`$s*Y~c"[qJ?AC0X'-]A}Bw67tgi'|G:U(4+ɱ~50z3vI`%}*m-,4E^yϭUtQZjcA#W&/69.n}tU#"b^TbƘw5 vsR4Eo6ɺ+ϮIN3w- XNħ!HrHb=mr^T{!<)YOQe*_{0u֑5<Ր"i@cL14yC.g= q藒G]bI=]d%(cX/\3)Ul;~ܚy}+N4ɹ.ýϭr l!|#C:`E I5wHb ́aj_mcO%R+=]^r7d[֎ٌx3>PvZ󳓭ɲ.H)]O*G;Q%Y@RL..ot~ +ӵ0,=ZqM; z,n?rIiChE@0cL؝kK+_oȋk6sh^ x>v>pQ(݉ccꖯ^HqNBc!x#a ,?9;lOu)܂"V{rvQ~Ɯ+A;o#Vi&wtkXYN44.w,>h;cWu` DKo?m/Wj| a? F~eRD4yer^{MJON 3uD6kcX> c{awSq' , )6]{h(SxP0VeeAXH3M:<6'bXҶgv__}I E4_܇ E,\ 똅۪_ִTʄ_B%9_Iñ~|$J>7GNԶW`Q,Ig9poZ JP5RtS}OTUVʔ%6%KWmU&lFY4JAD,x'˙Vǿ8EXS!Uq;o`YF{zK;` 9#++8,σ[ke" vyQLz+2ЪҼ,O81]EVUh'erO*llÖx?e]Y]NWϣ߹r=^K&/J1W|GxiAn@Z嬖 Fd;;'5S`@)yuc:,zwP{*AK89(b4&FYo.UЕjLI^ 3>QgŽ%q%÷ t=(7K/6:Z] @Vieo݂ւ䂊4C>d{(zEF/ (5ڸΝ:Fi%QV8撿[ԻVsat <ފDيu7cy(Xc",ŵ&vx@kj.%Lكp0D:ð;/m ɅihC*pd9@B.A#MHŠԷ>E7Dtc@[V}\]1ҫ]mPtt WS!S>x~%n5DׯǢ)xtmzQ}Kv8rv|?ُp] =]lVV{;ݣ*=Y/6k+>[ rP#{88|곢z,Vc$b>+,qxjW 0Ѿk~gn<9=R'$}4|bd`ǯ<ŽH3@fK=to@0׫ ^xG ^s̩/Jm!7'IQNḒCtMa\ CMa+T!l 2oB+,Q|6~EtRt^^\))jxc/[{5U'^~f [FX4"(f5ͫxh%']㶆ղM "=+x,N*ѷ Fढ (D6oLc [t3AHW.N1 .d(XUE0 V{ љg@;SZWWaXvs~2L:TNF k@]3)lOCv%0HCDn$4j5jrk؎_$gqx|V6fʡOϓq;0lVޯ0s'Vu[NsT@Q|X=D 4,(LɴoYmïb1O0QLq=y\kԗm%\Ife"=)<US_e\f`D"_v/D%Yi J +kfJ2oJ2"#L{!2Z^Jew ZN3J:j{AUsFlڴ1n-x9M}=jAg/&&\W1F b'莑*6='ҿkg/qUhL0XuX׃Wogrtvgp> stream xڛ[߁7`o_{$0#q endstream endobj 507 0 obj <> stream x]V TWa23ÌŶkk%USw 6'@P E5?j]BՇZY~X}H08ظuz@(zmIxI|d'}* J4רS2yeAnc!x`{)kkIt-M&WmAV+Z: }YFFt~2(oj.~mޘ" Uեjo"R{O{^ f}I--%gٳG?eo_iI&y`|YSOHfɳQH9b}s=F8̹]zY=Ïx 0vV(xef:7 q r_J֖17]#C6JfE:OKF;VT] ){gg/q4$~ҤW S! >%P0B9RBL  UUU\%wfC( ; x({ ҳţWkrDx9 8NzoCGA2.n/ֆ Y-0Hf} 3GOf?x""_&rAd^?X^xJQ- ́X+A?#0Jy tXF ~7Hv1 *UL9 b}E4),UKfS%x=dJAVEg'o`.ڛ`'i^ 8 W$o9z2Vk,=" tKGW`1NLIJe2ա~1Yn˾Ehv*xS~teXaBX߈4B.Bȓ&]6}㠙գndI)cwe݂73#=-LtSG}t}OX<=!|{62w3|ek|MB[{ncGa_슢F6BcC=*_c}؇w JUb?g!bxAڝrvoܲ˭c+7T\]1VڣenK9ܵs欺=w^)\- ~ØZ[OwkGm2:es ~Y#^n(سm[~ $w`mʷW쫨(c`@rqQfkʀI}]UUR%4+4(ISYzp$9#?)Gfg 򔂦.j`$y%:J 5y8c93&$w*Q;rvђԊu]Ç/2h[]Ў :lr}VuQ(V+~(~l[mJ˄B,.-+T] endstream endobj 509 0 obj <> stream xk```0NLZ3k endstream endobj 466 0 obj <> stream xڽ[s)-vQ.rP@ A*#$9o_ϮlIHr'j{cTcB\𕶦҉'[޾2>+kK)Ч+ :vή >QWXEVU22T F*;E(hHiZWZ;G!kdHCemsaC/J @ 988c]\%%t$|:b 敪RBq1Hb^,̂Q F80d_{\U0&*8dȪBdת YL7UZ;-4? **&iS iUrpzwLדfDO{o\5 4YtG3QOr?e5DW&<<&qU!ޛCxzYmVopAC HY59Lvf1|E9>ƖVm'\C<EL ӃI3';ǃ7c9Ia=8<|JwT!0BEi?k{{9_5 ?|\`inp<:̚e5 FJj_|r2>ozo͋p~|4{iMkAUҴ}{8_6>xP۪Z֑"g;#JU'<.N)Q,K |._ Gbs}@M3j4VJ$pL}|m<" ՈjUY^D<F#¤H#>Ѝ-:[ZSdykYscu&:dS]H_6)92 ee3)iWjz]_ ʁa!-x$[!X(BH!GbIv n5e]Q֔|EuXYm8Њ@}΢FO7 &(O!r9r;%=B!d X!`.!|Hf!E!l 8IJH"H2w!Fr^쒱Vd\%ˆ''4^ bSd9 8"T'qg(*,O?`802):$%s@?-4u޲yjـ5ڶ ZK$P{ߡ3 CF$ڒ M d. ڢ/r?K e#&LlddFqH%K%.Ed%q~,H1UF2(/W'b*Cq$w$[3R?fԶrńmۦ+dS @*Y3s(轾sV*£C{:6ߏ_=zoϳr0 Lgͧчq9\ ɗn伙 G;G/Ⱥl>ə@=yR6ӳ܇IzޕKLx`z*~̽^|lunxNO rNؓM|ϖBbbwDy<<]\6=\L/ ߓ6)y>lBs vgP;F{s{6:B[jp{ooGCF7l.Ec٫/t|y--z(`˛yp1l6w Y{ lrfYƌ3o 5`9}{td< Q߄I~&w0In%2fJ{^9 *Z FɌ~)i [dmH /Ns f'FrRJ즜U^)=Z.!,pLmWr 1%l uZIuxuZ>tvq0sǃ_ţ_iۨ9 JZ,*?mO2<@7Ƚ<7p >]Ӊvʼn:,x1:WN~=}t|ptzp֏r]gٓnœ48POjvgoֈ}_]W%X2;D'cZQ_@{7?}xPr[dMVA}[?:>y=M~o'1IȤ{A&:o dd-db5Hn{VQ.;+sw۞xEe-в[Ǽe) endstream endobj 512 0 obj <]/Root 1 0 R/Info 2 0 R/Size 513/W[1 3 2]/Filter/FlateDecode/Length 1153>> stream x5iPUuaUEAEBQ5Qd5LsM WT\KAqAqJ,40K*sLjrif}9{8s>=J;9p#0MEE|DBETc"sE4~}0_0 H(V (tw՗TjwM?Kh|>c,Pyq\Eq8$™1O14YU1aʄfwp*u~M= 3p4fYhw5qx \TjZܚo]b\Kq.U*u*Y;Xkp5u7`5nMkp nmwN[nuͻ4UΕfMT:\FUWkhTn=4*&P2 Q)5hl*t95 4*Mʟ5iRk#7Q<6NpMx [T^<܏ 6!l#ho <86͐؂=esmؾ}j{ i*ڛЁxh2^Gx {fM6';sR^E/ӣxcTsu?:ŭ9HwG>YCT++]N]W t9ݓ+4Os(O>r.UD_;\[I'r&f;y endstream endobj startxref 128245 %%EOF actuar/inst/doc/coverage.Rnw0000644000176200001440000002332214370340204015535 0ustar liggesusers\input{share/preamble} %\VignetteIndexEntry{Complete formulas used by coverage} %\VignettePackage{actuar} %\SweaveUTF8 \title{Complete formulas used by \code{coverage}} \author{Vincent Goulet \\ Université Laval} \date{} <>= library(actuar) @ \begin{document} \maketitle Function \code{coverage} of \pkg{actuar} defines a new function to compute the probability density function (pdf) of cumulative distribution function (cdf) of any probability law under the following insurance coverage modifications: ordinary or franchise deductible, limit, coinsurance, inflation. In addition, the function can return the distribution of either the payment per loss or the payment per payment random variable. This terminology refers to whether or not the insurer knows that a loss occurred. For the exact definitions of the terms as used by \code{coverage}, see Chapter~5 of \cite{LossModels2e}. In the presence of a deductible, four random variables can be defined: \begin{enumerate} \item $Y^P$, the payment per payment with an ordinary deductible; \item $Y^L$, the payment per loss with an ordinary deductible; \item $\tilde{Y}^P$, the payment per payment with a franchise deductible; \item $\tilde{Y}^L$, the payment per loss with a franchise deductible. \end{enumerate} The most common case in insurance applications is the distribution of the amount paid per payment with an ordinary deductible, $Y^P$. Hence, it is the default in \code{coverage}. When there is no deductible, all four random variables are equivalent. This document presents the definitions of the above four random variables and their corresponding cdf and pdf for a deductible $d$, a limit $u$, a coinsurance level $\alpha$ and an inflation rate $r$. An illustrative plot of each cdf and pdf is also included. In these plots, a dot indicates a probability mass at the given point. In definitions below, $X$ is the nonnegative random variable of the losses with cdf $F_X(\cdot)$ and pdf $f_X(\cdot)$. \bibliography{actuar} <>= deductible <- 5 limit <- 13 @ \section{Payment per payment, ordinary deductible} <>= pgammaL <- coverage(cdf = pgamma, deductible = deductible, limit = limit, per.loss = TRUE) dgammaL <- coverage(dgamma, pgamma, deductible = deductible, limit = limit, per.loss = TRUE) pgammaP <- coverage(cdf = pgamma, deductible = deductible, limit = limit) dgammaP <- coverage(dgamma, pgamma, deductible = deductible, limit = limit) d <- deductible u <- limit - d e <- 0.001 ylim <- c(0, dgammaL(0, 5, 0.6)) @ \begin{align*} Y^P &= \begin{cases} \alpha ((1 + r) X - d), & \D\frac{d}{1 + r} \leq X < \frac{u}{1 + r} \\ \alpha (u - d), & \D X \geq \frac{u}{1 + r} \end{cases} & \\ F_{Y^P}(y) &= \begin{cases} 0, & y = 0 \\ \D\frac{F_X \left( \frac{y + \alpha d}{\alpha (1 + r)} \right) - F_X \left( \frac{d}{1 + r} \right)}{% 1 - F_X \left( \frac{d}{1 + r} \right)}, & 0 < y < \alpha (u - d) \\ 1, & y \geq \alpha(u - d) \end{cases} & \begin{minipage}{0.4\linewidth} <>= par(mar = c(2, 3, 1, 1)) curve(pgammaP(x, 5, 0.6), from = 0, to = u - e, xlim = c(0, limit), ylim = c(0, 1), xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(pgammaP(x, 5, 0.6), from = u, add = TRUE, lwd = 2) axis(1, at = c(0, u), labels = c("0", "u - d")) @ \end{minipage} \\ f_{Y^P}(y) &= \begin{cases} 0, & y = 0 \\ \left( \D\frac{1}{\alpha (1 + r)} \right) \D\frac{f_X \left( \frac{y + \alpha d}{\alpha(1 + r)} \right)}{% 1 - F_X \left( \frac{d}{1 + r} \right)}, & 0 < y < \alpha (u - d) \\ \D\frac{1 - F_X \Big( \frac{u}{1 + r} \Big)}{% 1 - F_X \left( \frac{d}{1 + r} \right)}, & y = \alpha(u - d) \end{cases} & \begin{minipage}{0.4\linewidth} <>= par(mar = c(2, 3, 1, 1)) curve(dgammaP(x, 5, 0.6), from = 0 + e, to = u - e, xlim = c(0, limit), ylim = ylim, xlab = "", ylab = "", xaxt = "n", lwd = 2) points(u, dgammaP(u, 5, 0.6), pch = 16) axis(1, at = c(0, u), labels = c("0", "u - d")) @ \end{minipage} \end{align*} \section{Payment per loss, ordinary deductible} \begin{align*} Y^L &= \begin{cases} 0, & X < \D \frac{d}{1 + r} \\ \alpha ((1 + r) X - d), & \D\frac{d}{1 + r} \leq X < \frac{u}{1 + r} \\ \alpha (u - d), & \D X \geq \frac{u}{1 + r} \end{cases} & \\ F_{Y^L}(y) &= \begin{cases} F_X \left( \D\frac{d}{1 + r} \right), & y = 0 \\ F_X \left( \D\frac{y + \alpha d}{\alpha(1 + r)} \right), & 0 < y < \alpha (u - d) \\ 1, & y \geq \alpha(u - d) \end{cases} & \begin{minipage}{0.4\linewidth} <>= par(mar = c(2, 3, 1, 1)) curve(pgammaL(x, 5, 0.6), from = 0, to = u - e, xlim = c(0, limit), ylim = c(0, 1), xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(pgammaL(x, 5, 0.6), from = u, add = TRUE, lwd = 2) axis(1, at = c(0, u), labels = c("0", "u - d")) @ \end{minipage} \\ f_{Y^L}(y) &= \begin{cases} F_X \left( \D\frac{d}{1 + r} \right), & y = 0 \\ \D\frac{1}{\alpha (1 + r)} f_X \left( \D\frac{y + \alpha d}{\alpha(1 + r)} \right), & 0 < y < \alpha (u - d) \\ 1 - F_X \left( \D\frac{u}{1 + r} \right), & y = \alpha(u - d) \end{cases} & \begin{minipage}{0.4\linewidth} <>= par(mar = c(2, 3, 1, 1)) curve(dgammaL(x, 5, 0.6), from = 0 + e, to = u - e, xlim = c(0, limit), ylim = ylim, xlab = "", ylab = "", xaxt = "n", lwd = 2) points(c(0, u), dgammaL(c(0, u), 5, 0.6), pch = 16) axis(1, at = c(0, u), labels = c("0", "u - d")) @ \end{minipage} \end{align*} \section{Payment per payment, franchise deductible} <>= pgammaL <- coverage(cdf = pgamma, deductible = deductible, limit = limit, per.loss = TRUE, franchise = TRUE) dgammaL <- coverage(dgamma, pgamma, deductible = deductible, limit = limit, per.loss = TRUE, franchise = TRUE) pgammaP <- coverage(cdf = pgamma, deductible = deductible, limit = limit, franchise = TRUE) dgammaP <- coverage(dgamma, pgamma, deductible = deductible, limit = limit, franchise = TRUE) d <- deductible u <- limit e <- 0.001 ylim <- c(0, dgammaL(0, 5, 0.6)) @ \begin{align*} \tilde{Y}^P &= \begin{cases} \alpha (1 + r) X, & \D\frac{d}{1 + r} \leq X < \frac{u}{1 + r} \\ \alpha u, & \D X \geq \frac{u}{1 + r} \end{cases} & \\ F_{\tilde{Y}^P}(y) &= \begin{cases} 0, & 0 \leq y \leq \alpha d \\ \D\frac{F_X \left( \frac{y}{\alpha (1 + r)} \right) - F_X \left( \frac{d}{1 + r} \right)}{% 1 - F_X \left( \frac{d}{1 + r} \right)}, & \alpha d < y < \alpha u \\ 1, & y \geq \alpha u \end{cases} & \begin{minipage}{0.4\linewidth} <>= par(mar = c(2, 3, 1, 1)) curve(pgammaP(x, 5, 0.6), from = 0, to = u - e, xlim = c(0, limit + d), ylim = c(0, 1), xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(pgammaP(x, 5, 0.6), from = u, add = TRUE, lwd = 2) axis(1, at = c(0, d, u), labels = c("0", "d", "u")) @ \end{minipage} \\ f_{\tilde{Y}^P}(y) &= \begin{cases} 0, & 0 \leq y \leq \alpha d \\ \left( \D\frac{1}{\alpha (1 + r)} \right) \D\frac{f_X \left( \frac{y}{\alpha(1 + r)} \right)}{% 1 - F_X \left( \frac{d}{1 + r} \right)}, & \alpha d < y < \alpha u \\ \D\frac{1 - F_X \Big( \frac{u}{1 + r} \Big)}{% 1 - F_X \left( \frac{d}{1 + r} \right)}, & y = \alpha u \end{cases} & \begin{minipage}{0.4\linewidth} <>= par(mar = c(2, 3, 1, 1)) curve(dgammaP(x, 5, 0.6), from = d + e, to = u - e, xlim = c(0, limit + d), ylim = ylim, xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(dgammaL(x, 5, 0.6), from = 0 + e, to = d, add = TRUE, lwd = 2) points(u, dgammaP(u, 5, 0.6), pch = 16) axis(1, at = c(0, d, u), labels = c("0", "d", "u")) @ \end{minipage} \end{align*} \section{Payment per loss, franchise deductible} \begin{align*} \tilde{Y}^L &= \begin{cases} 0, & X < \D \frac{d}{1 + r} \\ \alpha (1 + r) X, & \D\frac{d}{1 + r} \leq X < \frac{u}{1 + r} \\ \alpha u, & \D X \geq \frac{u}{1 + r} \end{cases} & \\ F_{\tilde{Y}^L}(y) &= \begin{cases} F_X \left( \D\frac{d}{1 + r} \right), & 0 \leq y \leq \alpha d \\ F_X \left( \D\frac{y}{\alpha(1 + r)} \right), & \alpha d < y < \alpha u \\ 1, & y \geq \alpha u \end{cases} & \begin{minipage}{0.4\linewidth} <>= par(mar = c(2, 3, 1, 1)) curve(pgammaL(x, 5, 0.6), from = 0, to = u - e, xlim = c(0, limit + d), ylim = c(0, 1), xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(pgammaL(x, 5, 0.6), from = u, add = TRUE, lwd = 2) axis(1, at = c(0, d, u), labels = c("0", "d", "u")) @ \end{minipage} \\ f_{\tilde{Y}^L}(y) &= \begin{cases} F_X \left( \D\frac{d}{1 + r} \right), & y = 0 \\ \D\frac{1}{\alpha (1 + r)} f_X \left( \D\frac{y}{\alpha(1 + r)} \right), & \alpha d < y < \alpha u \\ 1 - F_X \left( \D\frac{u}{1 + r} \right), & y = \alpha u \end{cases} & \begin{minipage}{0.4\linewidth} <>= par(mar = c(2, 3, 1, 1)) curve(dgammaL(x, 5, 0.6), from = d + e, to = u - e, xlim = c(0, limit + d), ylim = ylim, xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(dgammaL(x, 5, 0.6), from = 0 + e, to = d, add = TRUE, lwd = 2) points(c(0, u), dgammaL(c(0, u), 5, 0.6), pch = 16) axis(1, at = c(0, d, u), labels = c("0", "d", "u")) @ \end{minipage} \end{align*} \end{document} %%% Local Variables: %%% mode: noweb %%% TeX-master: t %%% coding: utf-8 %%% End: actuar/inst/doc/simulation.pdf0000644000176200001440000020452514522560035016144 0ustar liggesusers%PDF-1.5 % 12 0 obj <> stream xXˎ6 +QER(.&ɤ.R")˶2\\1|>D7^v8@v1 p@txqz;?v>"œ W~cZ^3 u($d@9U_:MK>WbqZE&('{ n Bv3Lq*ONZ߲E KmPa6ԵTLM"䪴 -!whЦ/Bs G /EHCx3ұ%</G JX{ߤc0l5]XU \=Ξ;)x$Т)'@@?*R~A8<5ߺ˓퇴ڰjIe@V-sW` nLe_6(82'T dIa}zU#Bygҡyd ]f}v{eWحzmir:UwZ?6H tcLab g[ٱB=oT&GG3ƶU$<b?.EͫAF6'Y߄w"$*ዸp)DZ]țƇR6oXrs5ŋsJS(vJ$)r8dPӭ<.?R^ƫxՉAw9W=?$y.m!nf;8_F8r'+'BYl ԧ"ݔbCwyޯ{7v*&d w\m/8’%,{5,i|9r{Hrb6FXzξKc%4GE3H|rS52,} ؎@'8]ka]cMкWٲԽ20"yʌ1rޚs9Hܰÿ>|2 endstream endobj 18 0 obj <> stream xڵɮ힯"R;PxMҷ Z2sCj-W03x.[)./X$=D/߿}[X@ ,ߞQBN$_ zp%pG|INXe5ϱB+P D_(@F^Мdӻ̡Q| Xv6\d;DϠˤPY!5*DGJh hwq_Ä/ %:ٚi_O hj>QnMPHUЧS Sbe_? yud^GGvI[R̷kA  l&ngib1ֽ9{ߤ1s!TʹQ$AbT[b졥dDw\OB*NJnX64l'[ڿ2'wֈ2Xgb$xdfΠ7#v|beߝd=,l ʦ*c*|VD gB11Ez욉>L,L$+iR,&b 2s6&\ž7gה4̷lעc]"5zSuµ=ު E4ώrt' N?E']tM_Oe oX7]{,n+Nu9=ow1tP*;erI#=!,O%'<ʙ%}91SRxn!yAAVgJ>⭍鄯I*[>@!T+23}Q{|BPwtu'EZ%Lv$`uv:7:?j_ R'Bi|Xf}Ao;;{&0b_nLp7t7_NK*WϖsP:4?6iJP7"v _j7 endstream endobj 22 0 obj <> stream xZɎ#7WfPm7{6CJe|Op'3Jj6TE0o ,`'?l|]~KmJ(q.{F p~ARqAVe(1IP`@^p Iw>1{+XZZ͗Y#S%opBTRhѡ[)w&/ṿ,>J։]%>3dMO#NY&&p \`j6=@q._v.y[B8K"(hid3u'gܡ3:e($d9-`.yԩzૡ`NScQ'(l)]cu 7K235S)ϧ_U~ijDw72v^7~%y}ɡBa73CxI)he9 >(IY(/Q%SC8dq1x> Cg:;lC۸ ۆi|O|\pdޭY4Wn1iuVY(kvrFOX;:D1e|!}džGZiɧF᥶` K @k9W,M v{aۃ3iex}XFREAkF@QdVaOX8Íʇ}5gXfYfJ;ݼUeˉL !^_t\wB:׺ہ U!>F4<~v !T2r\!l `qYHEFUpC X/OI RR}NZ]ii%vOc&Ss48tDL+QJg"z7qn39(f>-oð)0xW<"̋[ bIB[6 k|Fw؇"x)xu))нLT,zlRfWG;UHN~ kn``a\b9FѐȚz}H83L=%I^KbV?AImKӈN49+[+!i=3*<-.ͬ8& qLNZDN-laP4Gz qP%Yg PqEpչ&l I?Ik)YPZTWw2kRG3Xi&dEG 6IIb!%ѥE :{K.dGtX@rC3-~%Y"SVIFkƙ=]4]DD*rQ~ndlޡ5+cUO(콊 h:%3˲3BBp S嗲K(=Ƽ10iZUa|ZkL$lm,J|5)JiAԳrv@[ c3kLr7ghD)ֿkZ鷦e߭+Cgkhs nFRw> #eN4ͱQ,Ǎ GY'i*v'5W ͡V_^@5!"Dn#nH=Į{5Uْ$~R=M,MoJbk%uƇ@QҨy#ITC]^iVFh_ǺSa v׻~&%pWaBq2_Qx: m7;I9)T{( <3&f>bs6<.iyFvx{U°hvZ)j~f/KOhF,8!Q,kꮖ˝Eff~vsqlJy sZ l) bx1VC.iØ07wR6Pci k (.Yc$ì/O- G3mxsFs @Y[(\"-X@x?G8?vۿ-,.וU 2 <{X80L!N7 b5J8X Eߍ i#r_ [zt?2H^rqR}ԭN¼- .~Սl5]˽#]rOm30ⲙKy#./o{06Lz}{ɽۧ4fO4㿦eӷN3tl6sufڕ,omsVJՠQd#|?RX% Y(W!{rsFk|Cfb)>^oVyt}2'Qqq#`ЪOkRZmL:+t`1ܪV/dCVm%:{}|f؄NpM! SJ"=ˋqa\Ť@9JgmwK?NPԲ>2_f(Edj{dkۍYJcUtxwYF=*v_zyIu-1ڵ!y5mrD;oz)N5Û&֎]W~˿=0 endstream endobj 27 0 obj <> stream xڭZɎ$ +R#ZB xmu3|ȥr.Ce~ߤD)EeVZ>,%O?v4VnkqV@PA.Z~#D]ŸmsDƬy=.[]~/WQ[Vi})X.ohIq>v?o\ɠr6timh_O4Z }kZYzxDc'gG-@}ZO\XdJPgjWT|F$l"y\]Df& t3w!~zW̴?7jl<َt{J5?sZIN8:2ϛ[w5'?q:vͽNHcr|$\E"?Ы#q=yάMXPj,n$-awj>y;avI)*z@կ$h *tsre;-vCxsrg+:BK c"*<Vdy%WM~[峃\8>USi.09ƭr ;1!Y,]J,!|BPl\F=G6lދ>Y/qց/5.@@^tǙi]ۄ|(7$*P¶4 yg{*>aMk\ml|9pK/ CjCoz*t**u.Dy-3JAPw<<aA>>0OӠKܝZ-O)6zwۉ:f{?ͭZBy8wyvpp>EOG'c=f7{ZcmNVPk3LX5ˤ83_ѮRA/ .-qx(fy-_p6~/~.-ȇ[xNa4֚>x+❗}෿߫ endstream endobj 36 0 obj <> stream xڽZˮ +zZE-$d7I,nf3CDvݪFtumK!Dr~_-])Y=oULr z>Ckt^~Ar7L-dgbTwָ( oMZ% oZ/'㕃HօT~<@ fAl /$m]*rS4B-lZÔ6I㵥IJ`YGYF{bПgh_Y3 {]}߻A VWU:ƬY0y 3[7΃y*KlǍdu4|y#T~XD4xA5:WfbsA#MՅWI1RvL DgE#>*'b-]<"2[f5IĶ%gUG~e:C'IQV_EpMz'.X0JEIDO$\^Q܁Qg6Pݭ {S=[?K3%0󚗲ţ'QٓrH|Wa[꽜pMHfɎ[ҾuY$F4hHNȴ7-yIf2EtD!Ff(L:.Q\TB2y.C3Q2>N;Q$NQO&" wC`d{LxZ 8&U]i x̛Q4Z'R%FtulP)[VU0&';k) ZU 0.brrZA-k <1f}> bH78d 4Q|F;;D_H fOxrn9ueCS%Du{5.f$5΄E.,K7ֲMŪLJظExkb0= ]v=RKtb̦ЖQ nqϷ ʫ@؂ 06¥2a^C äj9ہ F0I'Ң崝}hCnח=PPNmCܱX>@D2_aѻYGGzir!ГgκyC;xtS>Hfy_P1 H(w3| ͈0T{.m/]9Qü|ٽr]UF?kq]:E͖bWکg"Wc!w 4Jilz<(Lѽ ȇ+A[ۀ$Ȼ,kk ֮!*-!j[kiIoi>)Z-D.UWB&DzTi~N57L5nuU&8:{.|io`I}:j h!l4'5ZO}U6O`DO iwv\~%+ZbZ@" wYiӽڰf"p0tXvS.7nlmʪkplËflk ɸET|סڶ3$~(꫊*'ZNcvsx͏,g\T&abĎAn^a 1 *Bsa!|8lC(CY9{gZn,)x`(w=뭼O<!I@Kzo븽tJAiѼH66ۛ Uެ$k>wgs LZs&`F1QÍ!S*ê:u "q }_V-[7ςUGԣ(Yq1d" 1=;^\k9E8m#c?q܇cy}yx%6 %,Ҽ>p!?mE}c+gN;aIy@gд"R)Sl%v#mBS(;C|^'ϊ'gmmbAU־.M{k/YkO6 lڨ}$Yev:ci8m`ncnBIY@35a}tg)oKjS˸Ntyв1ufy;/*ڱ=4z_x"G|̧ Ʒl)}hQR}#M{eC`-D ۜMX WT k}M)|  64:pal&{gkPC#0pd m?s諚cj,֒Yky/+q; endstream endobj 40 0 obj <> stream xˎ$h HTK+v,0{wH2g-Y3A rE?r|_߿/?%*W.o 4zy$BuJ:!@*eWlJsB_wNҌ>J7ׅCgs* bB(*W5Բ.+LZ֍kvHNȂ9o˛rb Y>-M"HQ^|RZr$hYgҦ!7UFg; dʁ,vx6 $sE^L'g 8R!Hi,%> Q~ЏDf0CYeX2:!:~ͫ/Lѭ.:ì$f uBZNHEFNxZEKi+ 1a<0ngB̪me  &bnBLtylH͍r\QfucJ`|He4r$=x*1:S#(6фM)M&u%AЌ3 RUM xRɳkf)v|ppn#Y`5JHk>ЏTmyl6L0qi}T͎:+n_DLElT :ʻ*]f$y?FdAe6̘e3в[Ɗ"uxd&Ӹf#+&YHY}ᓌNrk2s2o! d&ÛC {CscY+D0SMz}HRH8~*%Q)ۭeVyp?98"bSHر=q۩٥pBg>C *?VdR;DuC:f|P!ļ7{ͩ,SuMu0j11-Osmv#Mdi aGE75'{utKm ܞPҷ.鑧.a% p WPT3E%E6[?.%rOa4ngj*YfZ}3fAn8,2g`oݳ(PM$R[+{}&$Z(B|,_(1U[oڠΆae?b k)?7֑6Jz9#C/ R$1;BKLcctfFCSN(Təѣ:']oǐlɌ& 2h'%U _Z$tP˛k3xD(% "O fɶ+QcԬKi Ha 315 4v۳*Z4u&r0hVƒ{yʨ=pZj2d4+f2 B^h f&˱ReTߘJ_,x2wQ1g"6B=\>Ϯr噹HƆ62gCjF8<+p.>xؕ!Gҙ(+rrVd\i"qETϊ|#L0SFSEfgpt< ^Ђ(8ռ!3I`mVRw@!#cCT+dn= >-*7mh@Sa&ԕ:P=!vӦ;~ Vʷ[[%vحa)Z:_PYv{Zs 46;wϪqW/OL[]a MFn}QJGͫ4j*|ܼYi?-s?" u7O}3MjӜ+N L ۯ~)_Zɢӥ*u5TJٿ-WГ0X(Uу%ir&/U, 2gs#r3ޅ^ -}Sl> stream xڽZKo#9Ha@n=gO{J")JrF")8.LJrO ~)Ugw}j*)-Zz iΜ?uVJUyMo>?h 2ax$QVua6G2Z5e]^@k}L۷n~'vO6G5m͛(%oLEd׫heS9,ٗyza6§ݼM]jE,@f?YxŵӠm/rGyh0 lD(G?yR`р* UFH4.p'F靴rZM\!F3:Qqo+4+$#_=% R721HRSqPLd1{QUP=^#UZ*":1W'd|VC& c"C9:̽n#\׈KCB'T$;Bܬ 5p>c>#MCdZPz,bJqƒ‹b j]cPSDgYbүɜǺP,36kR=J($}~IBɯX~c}A:#)Tڛ. 죐5*#Q<.$Ƹ:z(}^/%_Y7Q.ܪ>vNЅQ`l7'V}ubNt jG}E_P{yv_0P a%o-^ PCTis92vZÂe:tZxoDXM4$B@}<).kfTiPo&7c+- `P~ݼ\hr74s#I;6Zs96W$Lܔ4: endstream endobj 48 0 obj <> stream xڵn,힯hE$r݂^2sxsڥjV= *}`G7?}ZEavۼVvrAy۷^`ƿ>^P4K{43i{] 5a8i}ɣly~'l͚%xG\cCZ[[Os~tp#8~.W MGAO >g %mr" eƟĺb1U8Ou &HM.J;A:ȻB(2׉^ܝVc[TD {_yLwS ^Z3RU0-l EyٵN?~V(X4.@ ”TBO<$&~L V2a!IӇzTgulq7FVi܋,o$ވ9_,&]̏l4/zzg)8mqV ּUg{xZq,O{X4-i).`wH*W8@`{0kQk0ɞlڬjYssd2bf^m;7TU?PnC'x8oH,)3Xex[<e!c a=*ark:Ki︇nh׃8諲{4I0Ot D/d$YO'1tL 3NP+#UtԊʸ/T>גMdKD~kWYX* г,ʮ #*&w,/>wd*jNEpDdr9X@ w',"Fhe5N{ЁCYPs$I=*DR*}'T:py%O}*[?k3#j¹?}c]Cʘ] R׀z['4r /9eRk9:)#)x4nӎ^8.Oi. Rkč}W]4fGcLvR/rDKw)l̔%[9K^@Lו XfZRYwu ,`׷ o✽3Dz\qpSYU~$/ή90!et' f7dz,|qkJz4돣|s\CۘH4DG$$$5&H4DE,π3{.VFPNH{;H^6Z=@i,|Nz# b|#Y{>G_.8rk3B|wU8Hp 8K}|Iww>&LTMm; odVȄvxͅXVZ2ݸBzk}f:>1?Qw%jя[BQ5TװBtەiC!7b̸eOKS׋&Nq~bHbOra@ޝy)?a@c>>_k(r;_JL76vf Ze;{YTүۿ7H T4rb|퐉Ǣٳ~n/w0=;$׮9Q`wAW%pv+_~譶k.)otqs( Y<. H pQ{osGC}HfwV+(4~%l7@fIok6XYv8nfY} |i!1:g>5wЪ HDZf2 #IdX׽WV#p蔅|?yU/ qh_͙dI9vg,4 (xEtJkDc-ۥ"/դjwYO*KDy7!Pβm9(h2]}FEg1Ǟ}-OiWC Ԣw[!$a-'VuS#HUv^ e#MP eԨx]q~&V-SA؛icvG mODX6%2q)7+6`4XG[^~5턆)ڡy0EXY]$]TР~jZ.s \szҜMK 5Zבqku hh% y& )# ͣ[0;ĖX2N=\[\sG] b!uq h-%NJmVR[+mrtI9E'<>.:ATљEQqPk%iڠٯhf0Zf:$ g'^&Gv// G- endstream endobj 53 0 obj <> stream xXɎ6+b!@2@n`d3~KLK݂%.W%oL29}ŧOx}ű<ol23}-Vqg~g*Z޳>_nchF6,V3,α'v0LPڳ&gJ ްJ̓ uK /q_mh{ŀ> !q>!a$x{ lр-o"f7:Rϓ2lwvM`Fs0aE8Eb!9gsT$%F WIWB!Rg \gPeoh;?I*CW>2(uWB;%A ;TH'a+.G2*Ւ{^!1]7yCئ9Cy\vquIzguMyv<;>;pʋH_z,-ɘoFkPˇ8>)~Kl![Luiȷ c5 n:IiǭV0 cQ?nޅ6i/XOkxjcKw,wSL²X û@xi?}7 AV\n+p8H+%Ut, +Yjr:#nL7&%;g^$?hͮ'6$R\vy vWhwDې&+(IߊP0WBtɶ"+ʘ@hˍ-dCɈyuFU` UgN߂"NZ=)0zpJ"/bވ] fʤMg;Ztg~槎ڦ(K՜Z)C%0Uw߇#w & ^0 pk 9C%sWeº(;.Hp$4h0 endstream endobj 56 0 obj <> stream xX͒& )xLTRlUn-tO^K^?vgz< O?@:}|iVdQP ϭ'X#I%zoQ$&)ƨeEnEӳT`q|QOH'ʻ0c_ Ÿ>jiIfN})-π0@LBLhiNj1 7w2: cO|8Wpl-we ~uWGC1+Z0i|^d.wɄh #B `KR\z^ۗ` X;:mh;6{B;h`@pha=Ў;wavm?@V-Z Om oZ mf]""Ee }k܏Yamp! \W.3mhho!w^.4H3SS:% _96_rdAv@䔜R1HDЕ~T/$r@߯ڪ*@?^d0IKuEBsFup3w:mSY,^N_=E0qTjESY+шp7Mt,~ؙȉH>LtqRi{QClՄ3 Ӕ#^sjo+]PwP[ QG:1 iBe?3\ endstream endobj 59 0 obj <> stream xXˎ[7 +VIQ̢@+v6"K=l˾ $ŌpeJ$BY~}+suտ8ЁX}gwQ"UOW_E0Α4xT_xCp˛7VHߎʡ jIG`D B *a#u>5Ҡ~{A~b(i ZmQ}|=B,]mIVn\ RwElAeMޮ&pgְ" 3Μ4B, `2,J3mbZ RMYÚhuESƕ.|^e,7 Sy r2 Nk@NnH},rQ퓇y8kP4퓥e[I> stream xYK7 W*RC6@oiVY۹4ҿ_J3&i3('>M0iG>\=YVň4=U>ҴAy6PyG_{VUo7?MD^CN9g& NOOӏZiË.FXQ鏽5X/?~VfH= h^ B1Da^+oh:[; :}à~N42sY7A6QHk۴3?fQGcUP&'~&8.6EFcy1:s:ݗѬ˻9P5֏` h+kR^93WAi "cg6 aG-V 0+8uur^ moYh~"+BR>+Igl>4KˍfPYf1 iihv'(ҮöOy4l> stream xXKo1 +&IT8^.}LjmLmqO)qYVHd $:~P(FUY?񉵲v|5=SkZ-adů8P\o?@yQXd\^tNˠruo0=Qg22mN̲ I'V\ ['ַ SNB&J",jخVQԒca!QJU}gҰ02>n]5saU),\2|SR*.%&4z (hA*,"R;t!Gj%{c"LžYj 0ݰ )i IT$q*/ѽ)na 0ڝ}=l㳡abNgxåԢEh%#$פ_ 9v(lͽZ 5`4Kk#ME Ps^_+fζMSz#5؍lRwVŸg%u'G姎 ҺiJmn(lU@~sEY+r[whPNuSsVתt8ݵy-ٛ-R PK,')U*☞6j΋ jGP{IO_u]/_escՋ[uS.X}kalAӱuA*kkm<ypNwp)mvḺ> stream xڽX6z!"@l RH{ g()RuJ<7 jOǯ/!h 8(e Y  *Q>,?_6 hzP 4f~.7gQ޽AI!5~ V\~9-{)IJR3=_9X)@y"v(=ϒv*e; a^AxNr-dە V]D.#SJYB}BQDZ#_ dљYg3ncT7<:o ]u&VgX:`BƱYMlk~6L~:3 u ykP]Ě7XJ$ކlfh#fM-LQ_7ێ:$3$zzJ:*g#7j?9\'6tuIx{XADItyT<-i3hhhʙTdyEY[f緸gBf*ɝDs)mݧ.C`ɘyͦwTQΘ_]vѦtsol m!swn6[E~Ң/1)OMqF1S~zƤH*nY8lj$ؓ= E&1|JTqfiDBXN 2 u" agB1 7T]R-|jP^6pT%X1IioRD?zBW[HY{ .TRG(풬_ƪJ;6 -QyfE^^_wvvUR'sU& Al~Z: ^H/+i:?яIW@̝U?3^1o٢&l5=~a(_$_:.AmVi-Vpo6PIWSP1^gGey=(%7ԍ3iϤ`nD+ShM5CMx r^FT1ޙM: #AER CyCӱlV0kqb4uQVdVC! MGKad4eOd;BbX!j>kV:/l4gg ӈ(Qm̜\GJ-%4d״40I 70a6̓ HBek<ٗn$KݜD;Ug?0<rCs%q& ECT|V9x޵'Z7vA璙[:a53*c !9Sp"値%:E!2 ZM/hIhϲrjtIpC嶫ɵ$! !n qZdvB5*-VsQ!tkEE4n};FP3y&WPU|{̭˹. (b|UD*P}!1VoX W [,Xz#V> stream xZɎ#7+Ds n|]$2?d̔ 3%b/Y4%Zg|ן?^1*l❊9-T먵FGMw}{:G|ri}{u~5VZWo4F}%iBHXk} Ss@_ufm KہPLvصúY#ee[W/(筲ѡ ;Dun㔇Mm5mޛ9+#o?ctcycåo0XڥGmeʩ AP\stp925UKun"1@#(, n\n8{YA4UFr2lwPr[yg)p:dzvDqRnG*(Jo~WNa$J6Ȅ]^ELE0n CGݬVc&E&j&=щ07A8<ڏ"tbK3N kWna|U./w^`-Nĵ,IT/]< =rB`,{*gc :χ_qgv>u䗯dɑM'9*n逖4 W -憠\4\^MRQx;U{z׬SGqӛ-2~ oZ^# I%iA0XsVAGF Rɢ_?҆ze4*Fdwh0gpH2|տy6{3k;:;hs%#[d \mַ];u ZJ=ݚcecfOUV7hcZ,񙌞"$+-pۨ3 'A 6x-(qU `"lQ,^e텱cUpT^ y a?$NXz70(%\$]J\X I{;ÁCJ؋Bcbio+hU[jNJ,sMؼr5`KzX2Ҍ 7-/:O`0ZJ)md955'%|Zw|{ѡ0yFM6>zL~1pn}ۨdu15J]5sJcW!TRsy<y9z 0I@RF)'u}ɥ\hxTEr1tљS4V^mjhp츗2 t  \F^Lˇ\>#ZDL c MI\tȦ1ZgՑJ/(>Ocڛc O? Ctxن9jT0y ^=E^0,&C[ gwꬊDx\UKO?rնbUU}gg>U%G5^Nq Wh7y=#! endstream endobj 176 0 obj <> stream x}_k0y$ZimeZث['QRo?s2xƎ$UMn zoTԞu lu,!YՔHx/EgS=G`vEx[O_> =k /09rdST[\Zك9&a tj6d;Tϸ:Am(Akɇz{.ɵۗ6j j~`h0rzGDP&|oB([q!>BW GIr c~,+ҹ,}~C'ņ<)HEDQHD>BO%HQJ.fD!rxDT%/"0Z>0|mZشsѵq\ endstream endobj 177 0 obj <> stream x]_k0yEcv a= 5 Ѳek@ᗜ{(ץFj*I aG̀` wltd߬oOznz ~Y?owU]~߲q>-:.i/E+Iz0ɹ{t'f[Tv:*uH/ˬtLrT@7b^L+#fZ_/jײF[u<`,%H ]XBiuM ugq4FF]RL@gX!*]$tD>0 1h=nVU?S/gGiKblF #%/&? endstream endobj 178 0 obj <> stream x]j@}L)ߘDH4Kӆ% Y@FBHXو~"|kN\}|?n_jy~fy9gnJH|~h`yZ<\VEņ2C7ؖ /c۔`Y%)0RܵA gX%wBi.pY9ÉY '@7u7x^HD; !"[Mw)ю(#JBiGwꯉ-܄a'~BY&I_QpM~| ,?!0L^Sex37>Χ\*/W+ endstream endobj 179 0 obj <> stream xڍۊ0l)K4:1OY؞;d 8 e߾׊sUCOҌd66-mvڗc,@./TteTtߊe럟_v>[?< ڿ,fŞ͡e;V/;W<}e9Ouod ]l+{Es5wφ{6 Twˡ|-z]*s͠""JP*HIRSjP\RR9)SBњ! PLPc̄ P%d%GΨ P!e|M2sFCts nzTt7 enUQI7ZF T9Cl%uʀHID$$%y!10D|dEʓēHINxwθD'Ϯ">k?$ 4֕LnfH(;ȁ"{x$ܓxgNd챐Tթ?ms?[fԬ[jfT>@󹷎蹷$s'INb@ 2 eZ S&eaoy{7qDaiwm7?At endstream endobj 180 0 obj <> stream x}Mk@=VS!դxUf1⺬MC]X};Lٯ9ִ0G-`Jn e'Oz:`ۼދoLuhŲ,<`54$/N ;s@ɦgQd1fOlL]n-$GK~TH+1D_à*{"g<1-yYiT{q|#D>ъ( JHcYx7_1q|YMU1|Nb2w;|#2R A#'%ԡ>㦗Lwڌbp}pӨZ Sv endstream endobj 181 0 obj <> stream x]K0໿b]⣵[<-]cLn`MBԃ~5#=l / .BռN# #[f<\2sa-}-/\ZVj% 9=w hEV]m Iꮷ#NB6}ZV'T1آ!]Rq\ hzH!ɧzĿ#e avn ؅SLڐt"H#)'eNqHI> mIncsn﫻|vzR뛌6sF endstream endobj 182 0 obj <> stream x]P0+H[AO BjdZ6NC~X<@{y6CCVrj;DhӆePZY±< w=Bou]i'kҼǽv}C,u}౯Mk!@rg&Xm+`RHtz<"|t=)+8.{o' $L,O( (V>6twcWD(WXAYTs( endstream endobj 184 0 obj <> stream xڝzwXTW 9[G8sػ{E{ a΀Ab^a(QK+XԔuƻMn~^]}A[7T*fk5k]Cƭvuq 0/% T0&n.4H"? -"MNMIKLxBuuv] oi5`:(Ibejr uXjXH%\  |\xns}W-bS8l?/,#jqV,|eh83#y6_ v?C ۡII +AcIIOD.-#+1p~L_b. %句IenRFJXCSj"%K{KHJMT!5KH%F{}fh(,"[d *E!=*GU$R+$+?1'F ZdCeEnSv{La .gOSǺo^cll ={X$o^;Ϙ>e}~rΈŵI񣙭v3`>|)s2T83rXy |QGdi k/l5snO<'>#3,|rCig PA 0BuӨv9U[rWRY~zOdnL鏸?j 8W1C"F\0ѱ\ *hZLDN*4S4Xg%P [lnVqWtf]Hϰ@D:0fh fiB?1|#X.P ,筍)Lg$hƝ6hfx 7=r X݂^fg| zGQpDxR00Ay]He,wUnÝsiEKm$ViԹJ] 4QFKo`:'Tdot;#r&ڶM'C`^z2s/h,w78*.r{g51J"^$x;/cCڞ6261FV H+Zuz4agַXн=/=Sggb2 twOivF[<$zE[~dPAA^}/b#+* zF+^^s,%T0cĪ\}Wᡪug.S0utbLnEDȣ^mQAQI=l9s zKti1!?-L"VLy@ndq\0 4 piܣIa6O/M,??(DJkSKڕMFͤC4WhRR*F))TTrj%HUD"P'J/Gn&s|R|`PշP[%l^)F’hęp O碑%PsEC]Joǰ@UaEVau 7&F`rγ^Ԗ(tSG$5d@"p?5t-&G1D` ּGcN2B+y' ;_~NPp^[ \R;#3N ݿmsdI92˺WkQw=Tri ,M%>X%ЛEL@iA1هnOlZD2 `҈a-$㜐&zӘˈQ1{(J,&1=Sr'悝~aq#xW N2eʚݥP.*Yž!o{Q?gp&08EX'~Rۼ{@Xa* VC%)OCٙS,*8I!T|Nu" i|:HwhbbJr3-V u(|2tda8AkB/AMxGS5YcxfF# 'ۊ3/3WBaQ;`&r21;2Y(d 5봄}' CV i!妵>ٷܩ.U^ ز?-(9LDddL(@ $uk" t9埧\e-lA\YO̕4`O _Op/~ݎCO9A4 K5g5!)] %g,t^DQ%_`E:yDȒ7Jִ/Z!2wU%šXNcn\L #6{,nzr@'>oÏ )82t0bImX{>8/;+iOehak˘s sAKd-+f SXSQZoO@9*<12LT#wa$0B $s /:,sq>I. r#cnc 7? ^pBr84qqO way'㦓5ЁNg-_+C\&jvԛ)w1|F":5%YaBhv/*kr8druI}m9;Sm+|>no$hU]ocX]r w:FLa1J%јsw|쟦ͩN;Juq7.>?\YDds]SAsXRޅF w'wNXKn->`EV~R}gOjҏIvʭHae ?+.bJKvD;thQ|,˨QrzJVYvVTՉ_#W.*-zx|hOomT(2gnCi2*'@sHذIpLڞ۾=`KL{[8\Bz$WamOz X;f_1j2=&a'`.zBL'.!5`PrAJVg;D6F+`4?Yv^|D̻Srr:К!hJjUK:lj'`-O_HK,iŰAGgߨ^VH`k<[ ;҆Á,6d+#%[] hTQhZqsW!5՜UOdZ}LZuN@0vl. 3ghkZKwA7nc waʎUhMvZ)C0w!}M9`pe>-&zѦVZ辑C0FNzJo5 #:,W$m Яexܟ|`qhժC:˶i]c_ :(C3C3/ciʪbky0̂vGb.@g=Nd97m\,~h}QBg,Z}@u"ȇP Y`7GWQ€/YN XzSS@'#m[^j*m,z4HU/;NW?$"6r m`4R=!K Z`sBZ1W gxVEE9UE.* N~@&}T h";ʘx2&8uiwƮ`^>k%۱=i}p4ᓂXE!3)Tqr7j&ǓxS6.<&p-Q-\jCl"c4Tl&Pe},2unSG>wuP:~:[gdwEWcOQQ޼ˎ똮L#a`prrpPw:KZeK3uKy>tӧvqK@@[Ԭ?ur %E,7B}c}g( D\XDh^ʍ_oȖ6WklPuEar&)+aPr !; qoL;!+CZK1\hvGbv[eǧwYROoynuY2Zr{QJZ#Gd:2'LwtJY,n!"}1 w7ȔUQ3HJ_#"|GvXH繰ev΁ k2b>=![OL+Lɫazޛ~ +/-?Ԯ̾ؔ-1Dߴ})׫L.س ,{y.` g겲smh+5;v M :BGSln27#IrK0 0~yNQJ " CȓD0몏l䃓F5Z:n Lq1 / I=,TCNqeda'˼S |"K:7q`]ll>?!WXMxxU_* <7- 9Iw2@_{6_"vu,-S?}I&%vlg}m7gCvAx:FbQ}͵ Ayys+ZYna?oQ7TP+.YdǢ pfZU*2#19'Ueoj?vޟDŽ!Lg܅\?}MyU(U~-[P7]. 7NsS!ڿEʫ.nAjOz%]*RMc(~i{V#?eb ÿ_<8*  2f`2Wb 6SR@L+W?%b@g`3DIq1Tj7/K XŴ.%HKRKW#9?6})tƼr*O!vli#(X?у5 g`𢇢B66)^o/2n֮CkK[Xm/ɉ/[@26[jk)5'D{ }r!0f3‘዇ 9Md`kMq at{+Wd'3|!m432цȀXT,xc >O3Uz>c7j=7gb0?sxq#)fT𧎅,s-&fT!}*k!.ulid2>`5 |xݛZU^W\saؤO] O+k/U|5垿r%xf/2$Ŀ9+FZ djw ":͙G# rlf 3J2Sæpl20b@}!M 32');9'iBz(d=4н>>5&^eғ! 2"D.av1wI0S{>VWt|{G5 , َ*] q V (c;eșHd:vWu^d gw[+ h|{;.I8qw~j?0mKf'$"ȥӕnFPUh.˔v=D_8|BykEtJ_np_D4t /.B[+{Hlp5[0 $[g

,J#7PCg= |?Z endstream endobj 186 0 obj <> stream xڛ܀`qi `9 >  endstream endobj 188 0 obj <> stream x}Wy\SN U5c\{&*u_pTЋE `@X"a'`wE@ D- AEVmjmֺk{bn&~/e~Lμ<3sĢ>}Dbx*_j@tt.S"*}}ErʥKz k:p8jr.squT+r2B7DҦM:́@HoHVG2D$ʐ OMVTZ'>h8:u!)Z{3[}|:Y!:^IJȆ'/'%EoTܦN6mp|E>Wym4hI*QҾӾY 2y 8$) CѽwJ[,0$^Ebf4WX%C0͞yW 2 l L(ꀢ"7&QOX8XSs ➽.)UpYؖSwg0v!{}Wyoq vJzwНN7gI`F;UE哶T&nL=k+(k hIu0bv%z-7/9 4=W?A6EsT]qе.>8 L¬œJ#WR }BnF]uW,r̉ u@:N YL`)5}FzЋ2KЃbB t  `QZy=8 >Mh~xB 4]6֧fEF0$`CU_Q8L9Lk#i y66X+;/u'!1QOP'眎.piyJ]o,?nFI!b&X_w?Q"5 DZ{߯=*žp=Vd(k)Ɉr\ydks#gz~ЂZ,SPTf)b ZPy[qM7:%G} FH|Mi̩k#7#bّJό.x821;n:F+u=.0aˬT?Hf\S<lCew tVIQBdeiUYg-ok^18.X?K1.gfz j$ 9W`( 'eMq05/sOXGs䌮 Ctv_6jEŮTТ|Qps3"᧦ջ#{T!$_Ŋts$I- 2֭wͭW|$PNQ}f_ ؖukߛ&ҋE6$(Xz%a 0U!.E& 2NqtGy@+"ՂlhqaU7 ܜ̡"}pw:v%[{4U|L`2oR!ֶ(j&Vg` ]~iҒB|JHwxxX()qϽՈNwVtS@f 8bC>, YUU,8F]a@0aCٟ8^lTPgnWW֏ܐ4.>[a L@]>| uc:{$UTGT [va9!LJH杍kʾ}C`7 why^&8w g6)O0u >kג{:>!w@&B>ozGy ^ ܑ|:g.fxżCwt2d+J~ goYl ILdJ]b3uf*"`{f2?{k(?lXgflɎ aL4+~qӞ]B=ACt$BN*kC.owҪZr7뺽=y;sƜMo&\ $ O7vHh ǭcN4?0#?pGޱI=Ď;õ\0*RKgM(0!]GYE?…[bIڔ4m:+ ܣ;V|6r5é\g漲={6f;1Z? K˙=~TY[s?_i@t34Bswie{qDzHO0r6a9YRe?bK |a>aIG:?pD{p! Ur|Cf>LX`0|$;/gE[k]E ׸ay֗~JFClxKw \V|Z4U_h.G8 rrc!@[mhd]I B\ejNuW'=_7շM] DxE~ۮtsEf ]7/+ зVPPL-d_~C?q endstream endobj 190 0 obj <> stream xke+:`A? endstream endobj 192 0 obj <> stream x]X TTG~u->ԉv7 **;:*!WA7Htb0.Ј`DpAE7p%E'VgyΫzuun=QDQIΈ4ΉO\aBо`ZDN z^2c]T+oy+eۏha_j;@PMO3ŧ-I^u԰#$^5/HNLZwGhܤx}hailHGƧ'ҒcAæ lGoُe ւR B7A-t{A=Ypz ߄>V zCa0Hp> Wa0Zp{(93;^oW0t1?lNg@_X ;0H8N~gGltxv ˆ(Y3'xV7 )Vz IQM/A؇&Bͷ%`}OШ^[<>+ŔNNYř%p.pf 1}>I1%hDFLhx:.1ۅ/=(hO8b4 =KYqA>Y'` DM "C%-= e]c7aVh#gc.E̽v< f9;86J5W"hűrDRb>dJn} l 2K7%2ifol1"W.+>p$4,>nV],Lt;kfQJlf`O04c&nݳd3ygDTG޲YdLoHfr͂=HHt6Zj+ގZzaB⚘%a& 0wb#ҹ/MN[(ҜYRܾ` l Ȗ+'GWp(O<Cg~\$H7z{fi_Q~Eoc~m 0zәpÃO5-+j\*9haማID#n L|cn(imevűPOXZ;w"}2=aٻ.<5$#'h3`Qf^3uOpcVt̔zj5GT~3,`>=]­h1^0m%c^π-fV~K,k*P2+xR6Ҫ&1{Gs]ƑJ'^ 0GNbv,|El OF\ׄ+8[9(Le< [Y=OumNM/6Z.Zjbbx^Ľ|.4ZYkI75`C} 'pR -×HZ ѝkѷZE\AoNe4u`'͏֣Ld`_= 6nXx_-9{I f)6lÒ?Im}YB,Ҁ'D$0~"c&6V˦rJK8Z7llh_tfzx +! YϡUL8zGEhmڬSQyivoP`u |<°o,$\~0*2K jM ~lgQ%7-;`-ɘ`~j:$qrӎ2'+z7-Mv3' Cݳgӕ wɸ,̦4O f"T2njbE6)u٦yz!}jѹQlx\kտXOmL[BNjvȝI*6m_Vg>.ˬZK\mY*K }Rՙ**na9dJ̤ MXbt kJ1FpUJLxoүI0^ Au3 4-.y< 橊+*j<82}[g ie":z}T.ZDǗ3W֕dcq24T!ȬyWgS;nmӔrcl*hw38^hq^\-NЙۨ꧈=hkP=Ng; e&h5g~8ܗQm=s 'ETqdpBP`Xlx~p f{%Jj6 ɛ&aaŃvԋ7r(~n.U^ ~cۋRZaM*]gteN`;ػEsRyl0bei xg UWHW~:Nȁi}T-0O3gw&6M/mT,8{ ۢc7n xFM՚S;>:Aю<[kny<;Ť+APĸ(Y?1iQu:dbP#n5@Pj<_Բg4m[7Ic9m`: plcF_I",,s[뽹ߢW';w™Gj8p*d-%U/ WcEQ"fWo!J )uo&/T".;[o9ڳZϜp]Ϗ IrIm} dRj륛:$ynk@sϕ⮧ К_*%p";$PR&Yow ڱpZ5&Pg0R;4 ԱY7yB.83q| l'~9Xw:ГmdCS MWRXH"ǥD0!lPQ xϺxnS`4 (EɥEҾ%ez T6\ 3J|3 A'mvہic- ʥ88,WɒsU+hA:#,5Fڶ׶6`۵ֶkm ҂ endstream endobj 193 0 obj <> stream x{h7|/ endstream endobj 195 0 obj <> stream xڍyyXSwbOBjCZk*Wm-cyLPT "@AAAjZkZk;ߎ}͓᜵״{:RX,m*7}B>~`p}0HlN$b^$|CP" KKԝ7^4hH$M{B.uCm?쇉bO;gO&@NpoGxPSܐ"3}4^E}43/ '-}Zs.黼ھz-SVU?.EE=U8D#ǿ$C%\^ɟ)R! zSAT>uj^>^M3{A>8I=ѫ~ uXyyo>>}* J?鷮_ӏ c82A;8^迸 ;%J!;-f.@2l_QEU_>/KGU ?a"kןdcu?tc e OZ:u]fGw+kxzn{\qB%Q&6tb9SժK4e{8y",ZU |D "VhX)H%3օ~*nOTd9ǔt) dt,v*k)9okP_q+4iv `(^`<oa-{p a.!xlk]d4p㱄%wB1Aǚ4hJ5TA f#/FK^v/ 08WJNE\_qQ yRݚZƪdePu̪tSV!S(̖7Z~l7wY{_O07<&0M)OkW{R޸3'-}'7u}o G7\|$0SxjBJ›5O?5/Pz^,ݫ7 шNRr܆:oNI`V3o,5zqk*܏/B8y#Atڈ$D x=.& `\!!Nlԉa W0MR< a_p#0mϧm|+`́ow9dcGac3ü?DW@YnRvWv?o&[= Br~z*aB-Vf&  :uld0Wn4hco}!Qx 82T탉Gm ~@k:%S]f>%Ο, Y^oΈa5a8W`9ǦwhֆʛKN|ɜt|Y矀A a¤E2|9ZeΗNAmnWLD w@uзAB\ 2)y:=q_G |\Xw_-0[a}0^-nJJmŸaoQ۰>ŵ0╾Z/O.i.2o/T6pu*i s&x>>9}i82|q0MxX2/<&sOAa8M2mn]t-ӎMP5.Ʀ`נX/ل οS\>#G ;wq/vحunܮ a(|x"8 cf%K~ʟc}DJa7lāP4B%+, 0&lVop Q DOax5q X#&.B&@؄onl x7B "X^ZgYYdqfB&@tntv /ɸ/kuɠ79E%EV7R؁0DPBߺEtdrb ARb"=k(3*!~{ͻL ZP8NSnc",O.D܄:78X0HǨ\_t!gMu*x-|z AVmQD8rN[+ ^SsV}mT', J 8`K& W4\h_ƗZw }PE!k )%MY|CBs 3CU{×ON&:X"(zA9Zy",pE~1u;{eCg$驋|S6gGEF4ݔ_`^D7~4[~^Ӳ7WUkqtQ gŒwHbG UkU8a.t7ؑR%;3G7LE'ۦqb܌J ?ٖo(7c 3K8vRF9jUOܯ<|f ^(Y| # 3g$R30$mBrd6#k' ?|44 ^( O|=d;99Tv!pĽ@7ș^n95|Q觼5/<6)xdz.>˒:k$^{w!ZNd*ѽTcy{<@4} ӅA gT~4ʻv9VEefJL-E=ׯ 5 MB; V|0_SԌ_a'RˌEiE挘8# oBKiQMOkKTTLh@%3 O_ Lmdy`V_i*#{v"q;7fwM @af]]hmQP=/l@_f*uPYTmmY 1x['|zͻ^?=-b2lyiyMSvdV]{Nþ6SP,-W$F&G>gD{_=`N['Kp Jݺ-*F2ta7'/j3kؓ&B|D*]d4 8-;P`Gj[xeGVR` nHR!G(I[RpARbg]`-GtNE&[ BҌ;CoE5RFwtNQU .6nXmK]l(HΰE}͵~o';҃G`670uulAmq$.eXm Sw`}\EN6|a΄+bd25xP*!4L?j*Kl+|EE굮gqĦ SY_W\5!W )>a 6wrCf*3ZvgE" d0X^=OqT!56^l׆CQ]r5]tx.br)u>{C I:]' NZL2p4x䁈d hQ]^6O;^;*uKײZ})l^epD+(9ȶ7uOc ?s/PUQAAE~Eb!k.J(Yfg=t՚ܺZF "d1 CPvfOv\ MF(a_.StQ*v5>ݘC~rYT4%%2YIJ8do}5 cRR84k4o8+1tB}PRS/^==+`qB| uX(KRٱynnNˢ| ?ajot]}7JY6$Gכx[~T\ʆlAsyU/#$36n>'_pgN{- bQZ{N15U%#1;*N BtL*iT8eN9|.D00== R<0Q;$L?Dy淅$; ^[')l]w-s)jY#L'%}L)&%]kUazq7DӦX(?0]2'w ngOlZ)inDpu}ZxιUK@V[[Vib>dr7CaUq?a3j^Xv))m(KFNv_E h%k1Gm ΃\1ZK=CFjk>ӔzqXc.8{)ba2|:}Kpb."-IIɧ/GbAzG"ژGS,J6ZX6k7ф{5 |pT<[,O7`*"Lu,OmJAmYp="rwwK%݋@t!u!70oSx1\ܤx'؞4DB;n}ۯ{K^`m>3:Ud.qDžlSI^ےDJ BCQ$oTV#W{KP貞F7BEaWQeYgnF7߆kFCoW<WP Z#cpq.[L9`SKQt\/)0{ BT4UivkvW4bu #mpH M?clh&o[!Q9]~?H4+}ĀY[`xcNyoc{ֽRs'}ٸ삝i9Cϳҋ2kʦئxЧx|_.W-GM>*'.*jM~~sD{^ k`Yj{'Xep~ͷ*Ȕ$eVHx5IDG}kŘ-稙)Jٔ zr̅վlTr^~Qv??)Į ŝa`/t1!@aw}=[Oڿ[JOY#% ZBnӞk[Z2dZ57(u = ǣ;SXuRiUYV5Q\=ivdeMp򓉝.?n62 י-T܅S5|dƼ&=Rm[3b=bck$/G&*LөaE^?r Rޖ\+%#sQAa5KgܓPVU5EsW"P.äx$Z}K7M& "i Jf*R`MC6@fRjrumFRvymiq%mb3KJsٶ a/l QoXถ6cbN1U*~ņjtA˞=+;JˍbnPeLׄ^?dFQ</ P`Dh=n#B45w$H;^.NU{Q mK{Hyq7hx"jEI(Uڑ_P&Y}w{Uͱw'dܺ endstream endobj 197 0 obj <> stream xk``d.uƬoS< lȁUL>NZ%P?.8)a@J pE7ҁa(` endstream endobj 199 0 obj <> stream xeViXdLܻիbU܊ZjBVPlEB K lA놴uQZoz ^8Ϝ/s} !AjiتLժhzRuxb\$^ƎaZ|\2"c㒣ҧrK"JJU=S|e*[XVJ:%}NlZ1=RMɈFm _8yr'p?x |bH(8=!A"b8C Ą/!!(9+By^T&&d{Mk=+32G*5۰ab){qЧ [}OR߫QPSPRq +D}h)JpIE@K0Eی/NywMN=Li2)ݚB<91O*uig]C[YoW1 8vr&p:&:]UvdE*4[Ԓ;mcY3upކ0կsZR a*&xHr=I ϔA"i([I%?_ចLӔX꒦fZ xhWya kbl&Fl| c`V/~%PQ^XYle>xzukzI#J 4hA~ V/-۞<#AR`rsp(i 12`n18D6[x,{ F72dХj[+$zhɔPZˊ;vptG~'} D`@4T/gy[P.>̥F鞉4c{AdBCBu: N![an^0 wD54X#M.XsF5:!U%Cy8!<<}f -_mrh82qT59 Ql5cLCV6-dĎB%$Hd>۝)i ^0,y6l ]LҙTڐ_f0 #)r#СQՇ9<O!گγpU-l Zɼα+n ,7IoyT(2:8& ;h1^JeT]3a͡Xx<} ňO{* 3GNfHʰ\5k5]zyfZcJ|mZRe-i0 dC$RE]EXe'yܣm1=u/;J?Lj~@q=˵ALr|a[[n`lh}FZzIl}fd üOWviy)8O|kxWBGۗ0bvTjcZؐs.Jþ| oSr{u52!=>Xr{ԟWhou:bQ!B_Wd6 9u?@ε лKu\JG $[wo'7 PAYzyoiW;U%fX^rE6JYjjJ&]"Ûie~N{JS)wkAqIًb/C䪋v5mיz%wKݼ>I!1T=4SN [k9ҁ!QyOD-ElHR^TcyiD%e=-NS:,㥦6BS9"kCYm{'t+ETjr:w@so !"G ix5p<~wf` d*:Y0Lm`ג9xx2K4F̺ed~0Q-?.@^:Y\F76sViKwlmV^j~|5|d`Ε uggK;Afӡ}O8Cw_4dj wCcj^zH7c;e'h6.N=x#GF\Gih֪n͗a<\[B|J!6T)uZЇ~"\$r팴 oѶ$,ўO.9?/n[7k~$'{n/SYPAətkrcye9&8k/^@gliU0p %U,Y^XEطj9,z  Pޒoڍ-RW]cS_P_q$!!B qXg2. >N,- cQUP .QI endstream endobj 201 0 obj <> stream xڛ0U0 yDG3 endstream endobj 203 0 obj <> stream x=TmLSgεj{5,jX`Y ?NiRм0tZD6a(P# 941~l%6r^y!٭89yޓyP4MI~Fc O@ (,XR`I1e<= 42 E=zA$aN*in \܋\n_ܒlg'vI.G!9y[9Ais$Ϝ!tɞ[=)Ϳ'O{>sIvwctH+ ]2ҿo!.ZB٨]Iq\KirWN+t~xSQx\<@ 8~n+fkvttΖ5ơx-PgZrȎ+*2uKhQ_Ÿy+$xi7]jo5 }E. .E]&H-Y<, L+}@_-@AT ʴ.2ɔ. p y*/MWKRڵ(*|zMSquYrdMX=rrS2Ѩ6fA`*Xmm0_7*yBđ O,!Eugk8Uo.P. x*(F8f0?D endstream endobj 204 0 obj <> stream xk`Q / endstream endobj 206 0 obj <> stream x=RmHSQ>w9O~lYAsB#郄#%Yif2]~_rt6 ?ca +,0QD`EE=}yx abjsH-,gk!lElMHN`dN%oQ˛4i*eV̮/~6!DʄDQMpEo4U^??(XNY+/|YN3W横+\rY Gd*\\NټΙjv23w,-'- f1WT*7)? /#ИLo||0"cHqIt{D@%#{B|LQbdcS"߶I/aP#rP}. |R$IYEHZlR:Ht%^5[L.PT#jGiN,˷_ `ЦXJ'Y:Xjt#ޤti AʤWZa-vSZ r ڇzh(uC].Q+/F*nڨZ/M~Û ~u ZeɃ';+)_HAtYOoIbz0 ( rE6*t1f=tl{CZ/ϯ=r' SxOxW^bFtq D9T endstream endobj 207 0 obj <> stream xk`  endstream endobj 14 0 obj <> stream x[ko_1*rޏ0 KNi,QJ&J I3KhQewq瞹X(ƙ,&xeZJ&3ìRLZL`3SL.Ћ (Ä)DŽh03M*He 4ʃА$hg9{LJ+Bkf=Z` gFZC; s`LqD(A~>:W5LFr9 (7.8*%̃u{4W0hx O5A=iJkOm$@ШJh8( JC 2@643'|k#h"=Y()&F8 `V9M@+p$ PcS ƐR5Ѕc!2p88$@("h#)vyGb`P#BI^ I@Pr2[@*8*s:IXhYi$h)bU̲ fxH!jj,@gZc7#FX C%Œh߰*=ʓ߂J,yM `'`L8/# 悤^u x;h@T@&~bzU o4H F:*,`rс@ΐz>488LCAJ8d IxK{۠ A0AA/@ր`A:EE |?qn7Ѣ\gB5>2ab (SJp_H+nRjWxYhCP!K"pY݀.òBJ[["`8+ Ec coot9^ŋbrvUN\fBqhl+6ɲډ )$}7QJ(ErՎ\.|\I%Q}>oۻoizJSP!/hq/ _m x k ʲJ8xt{hfX72K\YՄ%akUV#vж35mOA{LՃk\++XP%Wd2҂,7 Ac*Ia?$}@JVH ,VZ@Q3?/y:K(RZkWbwV=vmt!^kw~3x./wt,o {۲Q @Gբ|{f%7UZ^KkȤ6O*=;uZk0=o3)s7\N*y[I !{!sڢyTbh:,Nu)k|UJTu 2U/tz+m0uV"LVGOOףi@MUGgV+aG'WٱVuJ[6l+- Eٓ~%ObPώ  t"շƎƺl!Μk4hbՎvxfJVthPR6J) ;d1X=Z]UA$'}SuJX dxoxD hdb(9UVA>=U'źe0UdnYۉDHr):R. :ѐ-%::_ T(F %WnBGPdОmt ) qڎğ!OT#z$fiK˯ѩzA|l-=O&-\VZjֵIiVm- ; jSvhTn]yk"uU6:#ʺUu߳kD:u+e֦vo)P M| t^RWv i6Mjh\Ff[ݽ5 ضdFu*lY|FD7"=ފFwsX uayHbY-ȂYm\a|'LދjqRc_]-HC謖: bg[DղZXڟnRYrUgTwl(tc˨ Q26ҢTUUH"B-UY[\,1;rR>.9W`uܖ;?XYz7xTN_dm_tn%Ӿ;P]Lꍪ_U*/'jS[k3STojsU&k:\[\z5/?B?So{S&WUaNT_!KtE:ˌ>1?$[xﾪ!T*'PfGk.U߲ϵ'A:5`iϪ=^ʷ񕲰En!7m3Y}řlǻ$5HAIZpj/8x "eXO=7Yo, XZ:15 jb}1HdavaSkV!d-~_si7;04RKY9+T'I:hQ9,ƣ'+LB}t^ыћ{=yy/Ռkl5ӕlg֋*ryYHSW㻫GKɝ FT)!hݏ3%k+'qά)aĄ?-3x빓p\E B{:Z&Nă."^dz1ЕGE>nb9*ވO3IWj-WѽPYz(j7 {ط]9vO{0fNzMX!ʀK:LtWfAW9 F.i hb>5 x(O9J^6- {Mtҋi,8*دeF7Cm(fC2 %"BHM'm0}]'up_MjPM0Q;$ fkKv;6 <C4nxu/&Ç4Du>;$5@I9@HW­? vWzQ "H$eK/x<> M/ E 0E rb^DDINHS'N ^f5 % Ce;>$E kH=;:Yi/QE/z87a ̄"1p`Xy8$: GV[Hai x arwbqEBTh;k$҉jMr`4]H$wOSƿ„"5 rpz~FTOF2֞>y_/ޜ3mpbYޞOgq&/G'We]Ooί0zuw7)oi: rq9aV)?$j?͙٣$YJ: R; Yr|.9&=E=iı!@cv_Lo&%g 3{GOEwqJ6ƓŇi-Bwk菿?^ή~V@Y\QěO1ZXT4d;g.~}dž=Of k&|a]rMI˰1OM9g|3mN߽xt&]IIP&5MXBm:Xb2) LV[YD𗾰n A6  HC 6 'wO[_#TUWNq<9c&hK )u4 a%kg]v@34`LCIW5Ygӟ~;~q χ oFrYK޹t:#ǘ>Dt,dd>m0gMY#85 %$燓W/uޣӔ/.R~Tݾs̹:@[SDrդ>"ۥʏtݬ O1x;~_>AW\WU$ ~C'-Wp9b9dHnM?@1r& endstream endobj 208 0 obj <<4fe3c19331478f1edef094efa703decf>]/Root 1 0 R/Info 2 0 R/Size 209/W[1 3 2]/Filter/FlateDecode/Length 488>> stream x-Sߓ{9vJ-]v5dKdmYS,1o_ W1ff;g{}s$+F]R| 6s|/٤xOhc E|1;a{'V`^{c_Sr?/a)Xo)3ίڔK;|kXc2kMy|u kz_ LE~p&Jrq&H܆10 qQ p8^cq\q8c.x#LL\p".%$\1 ' \p N7`6NÍ 7[q-ALCxL44X$g^ƋXxoui*K ~XXX9< =S7&S[}ӇFg KcӗXhx?4}o~mW/._9k endstream endobj startxref 67222 %%EOF actuar/inst/doc/modeling.pdf0000644000176200001440000023264214522560013015553 0ustar liggesusers%PDF-1.5 % 8 0 obj <> stream xڝX6 QD- SH p ŌM&)Jg/3R`Crx;^k7 1 _̌O΄4 _k Z|j=^W^7b ȋTya&"*U5h3E"ECDЇ]D?&cSNN>f&jŝ_[_lDH#kgjps_o搊8d%3,373\E<&(E'kd`ݹ $Y;FOo?gF,vozރoQ2y%=`Z7YJ.rboFX19X5ڢR{Jr#_ܑX0RGoҌw34{.n֘e_JSR6KPZ`O0vŢhZU'mJWnxEʗ..O D;XA~uvgZo\/%Z*f'mDhbvE [GAUJJͱGrhsmPh3R!JB~=8ZAw/*30pjt})dJ="h rbmU0)igm݋ ۝UO8džc2ލbW3+V&{~0`P;`A,XjYJk6,6ӞvIJ_uN۟ X;W66o3̵SOdTNL'ܒ6 އ<;?)V^4~bj9reVYmiEn%wƗR޶ҐhUт[cK$ߌ^jHȝqD.^ ۄe/}-tOMR"msM\J|8]dq0Kuiϭou*;(ftLN>Έ*˵>\cpɩ"NW$#j̧@Gq|;n:_Ebw5e$˿H$ 78 jR=ʇv$UPOu?i>lU?#ᎣApkm\4X_L00fM7M>*w{=uUݓSDɌ0IփABT֘N>xӂN7C e4eVELg)+O[聂3hM|jI R(d۔j^eyK蒱".ܰB,a endstream endobj 16 0 obj <> stream xˎ,m e2)&a_db?^RGvguDW6UaAI,$"1Ec}UX^g ˹ 5S ǒP *F]ָ5\V.=HuV\.6-y$J3߸Nmߛ2wV䕑C4#&] f\G\; {uII!>w,t6c5J_R 3zu~t6ywK+EIH`b`'>džB"NZagyDY ah_L0``y& b16؇NaĎN Zf_deQ#,6pDs 'ȾEq[X0QW|hV b25,^Aa+>~C2qaËKyҮcA+-Ԙ +\=Txh ?%! @M2ڑ*;-$Tֹ!/f9UucR,֍mێQ]G=ySbv6[]HT]q;aOxyETol)s.gbLh+ #z0, Jɯ͎ՆQ6ӄ~sbGu.D3;XHnwPm[\BSxZ.V߲fob}V},aq-i>e4;sQ2nL,[vۘf鞢n-(G""w U`By~ nmzZ k}g5b?0>MXQ:yl~J Mn[) Esk˽Wn `,{I^N\ض]a*m?cP;czVPho\(4Hh_`/= 8?V"+2 -Yj X2zί,$; wUHXt?ђstXM7uȨمUG*u|NUvCkX6Et~VRJS [8Rv鰁KbC!%[\<ZM\S̷sq? 37 /:[*҈c;[_@T}mISx9[hhy$R\dE$-:HЇ֌.u^&G#vͷD!o8Lv?d\>7O: /|_,]⃡Zc7ٽ>~ ӼDi̎L-=R6CoVyixٗ~=,ڮ۬7V`)E#FWg%NnMY M,Zt)_O_οLdCteMj3 wVV*D c5ݚ}-5P{h0.#gk~#9I{FC*a57ܥ9xj:OiL5j bV;nl6'-n!9d\2Jb*fݲn0mUQ{ekgkkpKaX}>,dO -|Ɇj$kl7a];c-F?1FAVKJAie)#`NztN:!ӅWJ躰q%͉rg[}<1fHv[_S7]H}s۷]HB)g?e]^}Q.w旀fɻ%xo𚎚q53`h-0u8;)dG?%'=bO:]&5[;@PtcsTdH+%:PӚ[-Jg%B'JfڐoKyؚNz'«IiA4r/'sji[%}黢!n1oӗ~a6EWxIr&W?toZBgܤSq}ɽɸץs)BfqVw^`TF͍\\WOu 1\_1GrvX?2 endstream endobj 21 0 obj <> stream xڭYˮ$' +`ͦNtۋFRү*5Fc*?B)]v98B2ByNJプ."П|<"\0T$HI r?xs8nbV.ՍGQ@cLJ+Up1x+ ݓxA(UFn%ukv-v*F5Sf>3!h 8 0DD- tFA uO/o"3VqtU0^i1] YeJUdpc;ޣ2 =t!z+1ǷC@~ˑT3_s8QjÑI =G 9Su*l7E*)"[Z7CXWZ`zW(6< kۡK[1[1YVVhT)ӑĖ\”+?^EDݦ`.\ *c'$&9ftHܻZǭz,szk/*,x`_⷏lZjjME{ad+ i-3?b,9jlB;'^Pa)Zo"PhՋѴgydn|FS>!t5E ]|H yVW!d%z2ctEav&aAZ y$JzQf;͙I%!jX-PkX]mĴGZtII,77fvڤl iǙA%׆\?֘h@ t&<^x~rwa:*qi c>&!I4:EN ]ԑe#P>1!Ԩzٜ֛S<ߐ=o{ᇹܞׇmEq8*c[wBJWUp+^{BJvU*Nw=ljlzWHaf@L&Ϧ :[Px3אm%ZANJ4H/*rP]QCbӺS; Qn%K9Q%CELq-Sq&4ZRĔOJn:\T#UOEŲB\H%ԙ4ű)M0C*ConŭnMx0Žp,*[UzRnv15*r[jUY) K#5 i $OAkCˡkUY \WLSXڸ]zA ˾9a5}WA=b^imf޶׼lh94u3m-@ZU>5]CLɎ%TE=dx-kMY-lY՚  @jm2P']AQ>œuf*( 4ɻVvj GG R= :/a鋦.BsS|\7e%Wt[EpbQJ(`w]W)훒eWgUmv'ê91n(֍=j[:UN9ظe# endstream endobj 25 0 obj <> stream xX͎')E#)E9֗~ (hۊe >fy["ZryL}M"˿ .a\GP ]xaiwmA$Za-,ڐm$zo()$uY^:J)_N?}WbU@c$z:`ȅ33Ϲ HA@ؼEՐ 0*zCoad~G~K2 @ l{m+H`U3K&]lq ,&LIPknmc}l=Ƕ=>?zI~>,;-5 p{ӂv}W=0&#$-0/7V^qSzvjchWK,M5};X؏܎!ק  <I *m}u**>p:h4rSU*J9I_Hw#XuUu~Qɜ*ejHڢ@AFP_ Wx1RyRT:MuSV:&IrF t] ob9&ϰ~,6%-䦀l$R2N |3f©ZΩZA>s`mOߌz.4/|PTD ac4-Ybe煦͜?Z!ryCV!G7kK2_ N)%^ZfDK^ #qrov3j BL}RwPz=J m!Bio@ōi\Լu: QG)ab} "XFη:~Ռ1pٙ{J{f)ؠ?Nu3|6B,3R9'dĵJB3_ 7ܝ+}vX,pW1M|!gfDS ae7uw%#.?SYl2T |./ٌNJ7x+Euᒰ']w/LKKeui RצhrvZRm&LVBwsH/?V:[oP܊ LtZ ֔@]ˆަƧ]Ga-$< ]5Lo uUչu63%+×ttQg O/ 4:Pm"m K5o|3~N 0ӂ; F?mVeُo, endstream endobj 28 0 obj <> stream xڭXˮ#'+xJĻ( =bfOūmǣ{[SE}c )+~}ÿϿI&"HvgӊoN8PϿ_qch,X>$5M@K/s1-攆A9BU aR_(4PѵQ9@))"(r%$>*Hb*%s% pJ5a2q ; ڂ d1˘m=S{a7 ٴ;$Ĥ  7Ik(JV|3!k|/-z4sJr$Ł}>ƕM>]mc2ыW({ _:pEDW;/πRnC;V0WV1CQl[g4f55GPm yv)Bv{i68Qk6zܯ[4W[i2]T/] ۻ'jWLCJŅֳ"Vw!q fBXłNV4HU)GV\h=},(O?ăUcx-@ ]59`$[g oUK} ~ͪ`3}jw EuFT(S8Zh& Ɇ)~:i"Wޭ\^qeTu 4}+ȅ0_V}Q]ڥ@^.A1oxDDќ,[b8|*%;f~ueKӻ&zUצjٵI5C0t.-LcjHl IO;fvQ/ \ @U_3ܤTNd1L޾]e6!lrހtW嚾{RxMF U$5I)RqT}ܬHlN>ZmI'Y{eۅޱqؒx݁yMJ;L\ A/'bT*Km Z}mwM Lp\Z٩m־ r:e܃ٔݹ(Esk/ItGzZ@gK8uB܄!_屓4|)zɲ^)]aݣ=>NhŠSjLՎ+-.;w;~MeW|b)KmZD]$`{e@^[wXkea%?, endstream endobj 31 0 obj <> stream xXˎ6+by/߀E6@wigWt4d[)ۙ @Pstu0L3 Ls,LN tLJrV=XM__ ܺ_3I!Uy"vgvJNJRp9\M)~&<g !Ij?[)ůzӬYQPũ\y+!NCe`9Ad\MdƝ*zM7褭/5-&/C2l oi5kmqRVn*UCһrΦm\խM[mMgKvҮ} /Ugt7VG1 S(႟b a$]a9pD:")\g\HsS;IR d_pE+xQ,2d)95cq^ -"Q{;biQVQ'KǺgP~‘Y_^x\+r a|s v`Yc ):e %W7mօtiq@X2L6ZKF{MtF0WkݷU7~Ne`u\%lKCms ~c*R>SCOGOE7'MwLpmN֫Som2JJ&[kBK^=֌^-2x 8-nX U_f d$+ritN5LtS#w Dǎ03A}r&Z<ahHǃY#I%ٌK:,[[K5^YK1‘m/׏ă4ʝZzq_ΩFA%wg(D(ouA 'jd5!'gq(ײ =:<3-`ZGF BUMkf6 *E>.t>F6aݝ;yOX,q- [F33JّJ)c\X![ Pe&+UZPUX-H):-sCy٭%ipjqVQwAUy*&μY* U/f= s!4 &ċȠ˯g4VRh4"fe5;.~?1 endstream endobj 44 0 obj <> stream xZˎ+7WX7 fG;dWYvo)](:䡼l~뗛ORB9BrVawۯI*IW1noΑ肍{ *:}}ۮWUeGV_+n`D}Ekԯ5}W]Fk#}ҥOoy7z*C5O0U͂҈$(grP|=fIC3, v!$NZMlwFLEX#/#p<&MM w8PЁ.Ghx=//}ZFhRN<ҽȨ7.4eaQ߹;(3<h$65*^>dЀ1!">vѓa *M"6 ejSN,]Lw V gK" X`3W}h[ n[1L7Qb1(!ruor>AtAyf=[h,wx\| 2jx)N1^% 6(=gs P%cg\5EUJ/Q#\F~Q{*>pXww󘷡GO>Fs*w9Tadɨ(Z*0 N"*@27ZVa{EHr0VbJVe&PVU\.{Pq"|Yj%a *:z)كIۺ$q{ huqgcZVjPoY+]k({WAHs@sJ]PzJ{ct鼬Rhvٙ$WsIr2s3sNcC}vh3I#u<ow}#9mYxgk`݆޻(: &=h3#g  7kNy ݹwe;}*jʫT'kTQ`r mRJA=!)8o.( 0?ho'!]wDѬ#xLӑJvS2ddn=] qLp?҅xcG&ܹ]HeM)r)B3 .7vbrk["m= <Ԟqfr$ձ##DPƄD 24 .H'0j|?UO[3z{0n7n: ,9V Dp9s~s"V'" ȶD%]|T:E>-B(6C ӚbmpߠmvBwh2r-PeT@@5Tͬ;(Ed6bl,$ZY;~RrADdc>;>&v'@2.] N3$Y=ZhpZR˽[2)cܱ`TNŀ VY{ݴ@ YhCr; -gozXZw>K܇#*)%'nyΞwg"h29tz`b(D}ƀd,9!Z]@', XUHC*!8$MR-qnDEڭa gq%FWN2IWgNm!Qޗf L'layP/AM??,0,os;<ӨE*n:3?n0?S> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 52 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 517>> stream xڭTKk1 W@X_sMڴZHw&MJf=k2yȟI֋6\s֛3XƢޙ Qa+)"Hypax~t{X_`}?"0c7]?rx/`H@ #Oa|8.( ۉnxx])dL'=~7`!gchh"a$uhc,\`?FV" ] Yl80CaaB|F5bCBgEvA{h5dX'MWhy5){kYb-ѷEQF^!ɡWDʹszJ 3gK@YBqY^1NG!@idg{rPL tGjVi6K)M,q> stream xڥWˎ#7 +֊ rdnAK%^ng fn)RE,Z)RſQ_0!8kF@u$j)CՁ:~[}VL&z*z,4-{| bxC0蘟0{2 xE7@o^|Б07+NdV#79af[UT䩜Aw5"=똓:;BA;v:S\:BA8W7k zQi'4,ZTnw/xOxƶiuۤJܮwn^)︅6)\JMD&3{> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 63 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 944>> stream xڭWˎ5W2YP` E)̕XVM`>zEX̽qo-|']1%)` z#|^Kxu9ty{~yxCg|U5BK#}%lT$1bǜ1&WA$g 4̏Wcc|c^zR~&.T!C"o}%; #&08CC|[xKy} fپ  ZN;*fc{pg?tdVEUP-F͍Vj#}e AWa7w֐̭l\AS,s R嶸2ב, :YKOwm#~j#enAʶTȷ*0gk_Gtb;ʏ|I>Z8U̢5H䚙Z1+-nLֵ:¾PZNԸxEqG>hhm#CK {Gu-J=m_G3 O |;vhm#cZ1"a[7_}Bqwʹ; nn1cp3np%$(\n`p!Đ) \Bxy;k`p>Cqi\p}{훋e'/ZΨuȲ:QG1)u*u>6dn4/)0^fJY: (\!;G !eW5AXְв-_-E 5Z>E5_T *FtZU6弜iy̑kB*|R\ t kkn〿qG/ #Z'/S/z}Ŕwkxx3L]4'z8O^+'&G?cuu endstream endobj 65 0 obj <> stream xڭVɎ7+b6m݂Z| H{S+ Dt7Y뫍U"XE? >a}{|U:gLeWK)s3NTVs:Wg;ΔYk3$tHDo;uG@P8uC}8 N0ڭ`&g?L+_5+xBR {a2),8+"j) =n#s6^}Wf$MR/ӎ[}\bSR_>oߞ*v`4I> Z"wJ_' f Xǐ N 3$XjR-ho0= Op{l $c]Ư%xCiwE&ո$LO{" 8\"6ʑ&98 ,ѵɭ 7|-|N8VpsCZYۉKx\ {j[ɝ)V*3c8!3U nFƃF瀨3g[)WK)Zan2 }oKJ5eLAvAR"3Ux%[ T丰i#R7Hl#x,y'tUny:ۊٽF`m&0ʒ .wyjY4moYFD[) !utO̜hitv|o249SJ2λyҐFǴsѩDKF03 Sl=Fӈ|lϏk+\bv(6A$e(ŗ:p2HMȧUZͩ뮒r+'z ,.E[F89v yyz➞KAXgjur|w\QwP3H(QM]y<_/? endstream endobj 70 0 obj <> stream xڵX͎7 )~c%[уsIK_E͌w,DDRGjM` ;}u(L-.V[0-Uf>o_Ռ]yѶ3rg3}Q3jVI'XoKФ[ qqy}ZDsԠ_=+5G(oY/@<'-= ZEⲮCjAkI LJ-¤+j h8~K-w+6;Xh};Y%ͫ PЅYpaɲ~lQҎ&lU Ӭ,ye啫Ϣ? cs3F9wehͣUAŪP=e Ɲ,qD-uo]2dN}ߡOo T7Yގߟ)@drl9 D(jWDd6Q1._>_.T\t^y@L.7P+/qH&i%~:Цbq>j̮ 3W+=t1JA,_t.ta 9EHWao:d!߫u8hVۨ]Ͱհ\Sّ;9\R[oU/oƦ7ʦI7R CF-ﳾXf#^eUrm3Kh8۹ɍ~m35H D> tm 1uEm&D%'}C֐گV81|:(ȍP*Լt-1ft[h.$S a~flF^0d&M)FB HGuŸpk^d%@ f M㔅P}%kX=caVXHλҳΝIau&kX Z5;ȍ IR/.3pttj,á=7QѷR0{kѢ&;w&7vWF7:|)l|Rq '37cs,ыUs[sC6#y|/Op|3##'6-YI"J(qN\ە(wec;*+[Kn+<&q˧c39-ݨ*7rVC9 g}׿W!^vd@YՑҘn t,5Ї{<Bm\+xʁ6ʭKFF˄J\pDZpswuγ^q[oP^Qr%Aꄴ{O{\tEԒ}%^e%4BF .;_Rt3r~qih4tu€p*qճaFgTv=pbSԶ[0kw Q۠77ZoӸы\fLPӃThש/g{DT endstream endobj 76 0 obj <> stream xZK$5 +tmanCW?v/}yV 4MUʱDZ8|Y`˗g|o?ʈhɬw8f\;r{vpΏ4;bP9gz:[`'Zo & Nzy!}`R 4S` M"OQj~OYCz<)TIT 1' s'Wd+YJ* eZP$JLe,v̭ɶ dZJVEjZ>K#ϸ ~+l> bު[Eʴ*G2bmp3+?ϤkLf/ywZ=| 82,cWo'(ߙ*ل6yT~qLR4V{GD$Qoq8|#}[Q2olR=L"JM3sv+f}(<5ChwY6ZD[ؒz^\HޮSN Ns]cQц?-ʘB/.Za^(J2iFˇnEkԆJ!X|-|Lڇ4``&&8:ṳ5ơc.R&d3IGh"Z5*{yQy8aZ:RA^8צ@kU"ʕ@i7<=ZT Yzֻ6j)}j;6r 9Ol;%ҔʰadHiOBY\PMЙ2hdۤy YLY'~MH4a/*9/h[|3]?9*=GE%) O fv yu,, 6uZSKq!2xɸAnM`#tmfj@G.}qnݗ2qk uQ1LWEd51J#8΋\f rށ;etT>xKS{oU/ĭǺs3J&?o,Ol\\g~㍚qzwוV4_MAt$W;_=LKJx5{ Ĭ)/ 3~EM|ry%t <HNpUVQkǙQBS*tv 1U6 ? X֗yQg"8d a'OXy{!پdjŽ C"L#VA_qT5N@HҨ}owR1{j̱ŕLq7uo˧8.U!ߗ9Ҩu"$/E[jԎi 5ԴЇ `S.&_%I0՛ы̴ B0Q$> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 84 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 2169>> stream xڵYK^5}lRČ4,j#?N|}X|Ulˮ螻^/q?P\Ͼz=}^_ߏ_\!^/Ͽt}}9{uui݈~t_%lnk>Fwͧ4E.pb ~ 6?}q|-.nƩ x [Op~.mW2BuwŹ|>B8\] kw:E}=a{8P&͞&=29k|w9#o-m*6oU'G~=\|KAL{[gFD&1gO#.Y ǀj'2[w, 4`Fn<b5w ^XIzOep %l,z/oэRӴ@^FDVi)`oxPaaSX5<[2|nn >Y%J1d@kDg w]xy8 ŧ h4;*)=a0kR(Cr"g1FÔđ)WmLRnTwfUbpOq\b㍓:#4|@8]#*Oq d:ޓLیd[pOq\`#pLP:D1y\El[u$Q`n)Ӷ"fSq)w[R*Ǿpَ6QwRN~Ctv0b-qt&G9ضh1&.f[kok\=-sɱqӻo_G %@>'p)yS2"yҔc5ĶE[G"%qa[kok\=Ms{/>G߶;\&h6&W(\(rSP(\2y#yU L. nw$ܸWglT).`_ٸg:e/BQ߬ /%ܡl"W'BnSAyKEQ<\(\27P*HSaźJҼXASEdnY[t=.yGxO(QOQ+?L/=6~FJY0ua#UyoG?\g=(7S̸ '/_ޠ'?W}u͗;M^܃nOZ_XRIJBqDJ'>*%͂ke8I,SW7%Wyi&sY,/0!`hBc:p% 'i2f{­_݄ n)KZPlDi-yiE ^TtjhGէI<=Hy ؗ/S^ khpTMiY`خ0y^f5|TSTf_Fp]ʣS"-:1.ʇmANr׸m.U|Pu$I7:qfY;=X;jfm:' Ͷ ['mr˸k:ta}A@mM*h$F]'ʔs?ضh:R:HEZۂD[|\2Υv:IZ u+;%7)#^}35k5ĶE[G]& Ǵ͈ͷ-.ֹ% Hl; <(1pWd\Eaf$Nnl mrKe.O@@W~l endstream endobj 85 0 obj <> stream xYˎ6 +dQtw]$DْGN-#-Q$uHM4y9ï_q$t LVt EB,C$ eBzoj+p&"H=I1`2»QJ$IJ"Nt ҟʜxmm 5z![KMq݋t"^{$B~#q)!i"unlHDfkHs"x[F#2,H {XaTܘ%rsK\3&`47bﵰO={0Yi;+XP𷲯7Li3В,OJ&Y-سZΉa$WtI{\H`,.XPs%'% rf`U@jyi|&FBeE{B; upe 6vbcrF:Cu|8V^69xTd cf$ BU"fog vf.ws6ILl Ry'IGWȱ5?pBc8ІNșUԇD;8#sC.3*AM?"x쵹(ƞpڙ$K& vجzrRƼs̃` })O+p-@VX SM-%Fr28LqӕJ ,ݷV H'P8#9_cVbaV e[D0 9o mu,R-=u :20堵Bwp>i> a6:| HP t,f~a'LovMt `[EPmi +Bbˣqdp&0f;&aa`8\6$ "1֩Ln-gʼNOĆ>1ȿru_(,4<@1{[Ny6r{׾a'_㑳7!#Qߛv;GF͘mɹF'P!c|$Nښ 0 Up:5^Bzc! vJ#v4;x:n?pAhS(Gɦ(t%~^hj1R]vZtE.nrXd+` kً(#$%^^k$6n42zw1{es;gZH&amX ['a+>2!>!w&Qr\GuYƮ+z9$*XY O0Jh?(=MgbK{jG#8adA9pR;+qk;}&]\2u*.m q|``$V*Ge_sL1. mTԥӄ&'_5Rwꅾ8EWl=q.4''мb? ަnzL[ƶ(ޓRYaa\E=8 | )bh٠3e _`쎂O|xꑘk{5k)mp&E\NZ;t cв-E HmwhFm0baa'=,Zrw]( cYf;h0, +'OXiOo\^@7W#F) vӿ.H endstream endobj 91 0 obj <> stream xɎNч-ȡW_ſ*HjLOĘ'jc~˷?\\~A%H~Y}T @4GKC>tLtCwO`pg3=ی_ʆ+J|{pw廷oV1eMQyeW@" :?$Z@VPxˤLT.hBv\s % K  `b TvKSheK'iUQʢ_68Ic1*B C0@g|Pt3! h*0k 01f{!WX* 8LXS>e`;[њVk&b2x"}3%i3UngMS;e >m}v3E&-g3gCS^Q ŧӅE+1FYi*͗(HQ .GyO55v3@K*ˍLi' R[n>+6ݲzA8t1 IKzOȫf)$^qWq>jʀUZl;!|$Rzy&/(~ʢVC6i$Fk.3&ܵ(вӜ!>کq*%[]E<<2]ipaQ'V<˗KVt`,뵽R2OcIы,YN\(UI՘VN &(nu M ߢ}q'I*&n8(oJ.P@o"+DISFdrL-]nbb4UQ~Ƅ6\FB`0D\g8nd.Ű4=^7OZm1{ǣ]j0`?BE#sQwyоuiFYF.X߰WmFL]bdut{0MY.'1bZ=j jh 6uKbϴς> ĹB?|+w\䰉jO=̐I-k{kr6O*GGa.ScQIp 9 s3"5EPh><VN?M!gI ;]ӻjPs3VEaEBy-ART$`Z*hFvpl~r u\:8X~-uRQ]5k]"U#G?++;:'UgTe߸RN-.Β/SJAy\}aA6RKϻhkƳnS""K /aCTVȜl*s?ItgxmJ\d*XN ĩ/nq ϛDpe qJIE&+_ds0ϴde䩩ñf ˆa} ]/VzTq_iHBW#iTmQ&EΪ(&bRVXj:$RNPm^=!6qW8EkoKhэgR8AUѳ\Z]asQv{l RJ!P>kug[o#Jd R7lž[_t?j [{ e"-]֑aZIE<4Ln^h@Svso5oѤC76 >@}~t"< 1l81kRIdH 2fJӕΌQF>/p\=@4Č8R7`Q[v}t7b+NO}NE?Laß w7 endstream endobj 97 0 obj <> stream xڵZˮ6 +z ̢@wWt1lEư-S& &0yto#Qᣝv pMS;;=1}F]0}Ԟ|;}@c(AM?"/oϿ '&(VvfzRIO>/<=wC5^W|YV勾XBwfZXyIyI ФsQy9'F6bUxuVI]3.O#4ƶ~r( K59W¨ KW x?e;m4R@Tjq9t3<ڸh}~g CbHhLa,3K!ly[4:=oYe7%h?H#3I֦U(nSTA%*IK;$ NQp,}Z r%-I=l -mYib;SK)™>GS=3.zWk[G9RMǚ(,8ɜJƔYq-_?r-AΣ³3OHsTIRu^{#JLʩc5wZiq5HKX{ :9Z[t:hTV{\^!ìIʹ̡@jɕ+K"+$`""6D FhiTy!cE;nt$,d#]扟 Gc dT+] 2E{ŅEm(-vh0&czXI52ߕ_U%e]fJ:i IMZD̸vDF84˅RI,{Iv +{BmDB:7 4PcMuH~>~LdE v~p._Fы)@@3E(&)`HŗE5HuҦ C`!]BIexS{eA b4X/P }Dw5qgG2 f5k22AsS TTJ\a\/ZP=5[jvZcdPqafs-8?`KPĻV|3};u_Z.p2Lq«6f1 {5̈́Dg e~ηsDcBa/RQe{.ܚ KM%lvTvM=f3Z@׺k+:υ|dUƗ=[ - 6ji'Çi:!3AXbڕmʇ>T)BmAe p\L]lg(IOVwV?v3#xa@pn-Y\}fds﹒ǻg(TE7V\ڲss䴴Lbq߳Mu옹"cǰ8J?:g?WuZ˪%TBс %lM=)l:P#{)C=vJؒDJ^9/+^HS,̧_$ endstream endobj 102 0 obj <> stream xZˎ+Ͱo`Ћ.3.M~?U|S wE*-/HC/7~}ޡ[%\x|[4k/?R`y\L@@poRJ#A~Hs6ot@*θ$ҟ$57@4~>@1 rxގN: .#*t οLTFXĶHVg9a&9[Jqi#߄DڕN 2G}(Ƽ3P l8@(^5J64;boNNe7KLb "8hIK!>%68(y Zy|b|LPZ(XMDX?{bA^#=?ژ9yD&DU LG ")2I'?%˭8gpG_K1~0Q {kAFy%t Kg+߶x]t)k >/@W` "tMx4VPG>;X6w%6aY%T/C],&X RRMo#Cٰ.h` {c8e;z]ǒ}:>'8G"&S'So&Ez9%>ȸ5#9eTS%V)v:nD%k°c Gg(]-te_Cgcw(C5*:G'/5 v0iE^R9zrV +3ƪZ : @=3V{mT[[/IV\2; iAG&!y 鉼| YYW\ްc -?EEHJ;: f5*d'Pc_ _0;?ž|9XK&ުکg6MQgO8 XafBЦ~<<(+ؠ 5nD$iuëKv g^2mC l<]Mu)A@-%ĪX4:o>!8lEICq٢F Df;7U@ 'lBnôl'<`|H3ZJZAd\__A8WMwNϡY)y:ZEY5Q=0wh);PUeSRMIgNHkGh G&-ҭ"n;U2AqAYHQt+F{:P{YtT}USR 47̓}_@z¬2]γ%mZIvRScj g q_028zc<8dRaYmkI]5,m_u_H$(y;+FA:O<֟v%*, ip +J4{s_{ۄ4nk}.٦omV!ar5q{m4eI:vڜG"b,P]?QS dmM 6Q堵&c7!(:LM?qDseZFiێtphKvK$Ib+G|(k'I>!QtɽL6J@cQvu+t,v}_oCPdb?dF0HtmU #hخlanf%aE)?J& @RbGGPˁ$h!KcseH8"h?x(?GN֙Ay)qgֵFoO16 <Ʌ;}0]>|*%踟hB0hX endstream endobj 106 0 obj <> stream xXn#7 )V 0|(.۶=xb^C/IQ3[$mA"FɏQ*JA=?=1ʀ.PzU\PuV=]8c qӟO"y=hHy3<ɦ d&``S9қ S]ϛ$EM}G ɆLd Ф\e݀/@n64Ɲ֭ RV-uIl8|iEY; o\=~ҽ|:7QՖVy:~e9pGgQ r7Ұy)萗Ha v_iP`y:>UЗ0E,$%#!Ow->6gsƄ`n$C$V$"ahRM'qUr $P]K 9'RHHHCm 8ODIk7'e/&x$Ov S,rdTb|T/ Kb=DbrQ,sLW1+gh ..W5?`I!)fh6,X ɤ7/M;ϸfq7r^uNα^C|$JĹ"AyvA8o #QeM BDʎ&xƒ=ZyPaLcH@7Xs vE&1<Ϣz1aOarlҘD`(쨢X;~9y3=J0՜$r"qj״reGd"7eiίey |306~xG4V`5/oj-INc v\ M;'= }C~w_yyQkޜ&SorvoD7ɴŸZ.T3AeltjP֦%b3*>/??!V:N u+K_j2}FMD$j#" /ao]|^v%M,ew~ t햶)7$_}-M] 1 uǶ-#o#8{71A>weq{ip/Vۘ;UNb4;S0s_jI +n[Q"I]Sn^+[k?7i1ÉMpXv-K`[ }L^Kȥ&6 C'C 3vη_ endstream endobj 110 0 obj <> stream xYˎ6 +zZMήMl%)kϝ:\ؒ%"Cez`S4OOoL>Z%`zMު)*:3\zW GMvö_rLog-z7$?âxXgmSfGDR .ғ:Y_(AP .eOh8&F'5MK#fTge3 9H\fVgO6XB"@!v:kq=E€/T uyIєa޽MĊPy[64 usn'ėѐ*O74ʦ&.2MI2EE"i/3'ϻAcyA'8^(ZTPH8yk &8~g1ؽSG:gP?ܲ V_dT$ MLx|ա?>$SL$Ã}EMW[ߛsmR$&d6"$\qeX\+a„0& HDO[xzJd4;!S۲$%BC+_*L|bQ)pvwkzDAz+@d(;zBg:/|P¶y0B{+bu!4T #fNchJ0j"iAϓK}AtwSOJVg6t?,&k:5,a-̜6$[,);|)< f˅,+dz"nL-q * mkz(r#[wrw0%wwڡq8+0v[ڽ׮mV$Oo?N7X)͡qNzf endstream endobj 227 0 obj <> stream x}]k0$V[݇ mԲϼtmTxNNG;X_uS$б}J `;je ʺkq[7y͏MfI_M !,])+aOQr9upվaŘS/l؋.Aתb,Lp$9:--hJ8y:WX >[÷@%v3F-MpP Ix4;We+n7WRcr]p|E%ߑ$&DHr R:K"( "\!9oND>Dk H$7h`,O0m0E8kw ێm5Ū\i qE endstream endobj 228 0 obj <> stream x}k0+1&Na 5JlwY@{w#g:U7 dkN*C% .XQ&<:k 3|ڗff.jRgX̶iV@IurzcY6 ͐ՙEU*y`w0ԶGA2|qr7tm ϼhX/LԖ5>Ғ%Z-"5#-тFHptkF)r).&F9hs"=-->ʸ=NmqݏRBRF\qcƞKbI\YsOv(s6)8~8pyOJ ߏS5@%2mӎQq@ endstream endobj 229 0 obj <> stream x]M0,ERzh $D=߯fl6ᙏgܴ )~KH#dmW@n Ԃ 7vu@܏R}°jxgf}rCjh0zh t"+]!E!ĝD?Ykuv15![w@sXW5q0LtI?`ڭ?p > stream x}m0+qcy1*]vj5 [k9/M]dg&iZf$U[=Cփ>wdMQF'T"{)Iůmu[~w/S/+$>`k&^<Ӻ=tdYiy)bݏCk>v$ZrZCgE<֟iL8S Vr- YY)ñIb>@LX4!*&K!s )L F"2y)GŠR̓Ъ'֡[GEHm~h CށxBsH#EAGeRH9H r_@e> stream x]mk0)rcMځۘxvB!Z~-gI煉9 nTeNFáQj0e[jˎ~-[`9޼ц(&J$!-ђEJ񹂿" 8U84~\iMƹ%hbKܛAz \ GBE_G]<3'> Qp)) ? endstream endobj 233 0 obj <> stream xڝywXTW 9ۂr9l%jnXb f A HzHW^`1Ɗ1K1Y칟=藛}\ZzJuHk-ٴN-,x7_@"qQ KE+s8L*e.;eퟋ=3b>H}o^CG\h>t"3!.P[?Mn3f+{?upժ+9*8Mdnj:J%kGB-0h1axgĉm&Xw@?o*o57$/038?hWg˄~*Be;C II +A^BIKK@ /y'5eL*v2RV==RBIKRK@ Rl^}fe!h(F kdfh:!GȀ*QF52d2238fde%nӺ5t{83'>lEt={[_D/^?3/{<gqz=ovJ>-qܓQÖ2h9pc^ 1aAZ)+u<`p`h&΀X\EMvέ9?xW?gd\N+xj e!y`wF)m3~t*{_VS7J/]n) DN,+j˪*C!>ޅ X`u8Jca=/K~uݟ[~g mfrT{ãT J h8qa1!CtZ^@53RϥTuP  * zB'K X{Qrϋ/{\ ig`x452zP]"(hwzo'%8/R.P8Κ趃ƋX6i5*wSh0bYT̬X `8 (W\&6122нv($`҇FB#:Y/j7/|g 0D@ N\1ѳ\ *)hz\$N+4a5Xxb8YCBt%YmTQ7S| :QHkzXWxdww=`i*ak>HF\ XGSc %hGF;4+2FۇJ9ʿ\nZ/=ѣ(V@z~r`@Fи. B9hndtR4uR~Y(+b֝H= RءYΓavXd0s/fT4ujUKx'7 $4w}Λɽ2M}ya%6>چML}ESR0z/h&3I;DwN?dkm򐸤&Uo3I&zΨ.Ԯr87IqgǓ_GuVFi 얐JoL0`ٓEy 2]<ό U;md2a`c&Kh5- N*"(vYO1WgF8?焸QgG⨽cL b+8)p͏̻E;]^ | "4&%bC{98 y_< oP{)ȓ\n qzkC5hUQL$!#+jm.\22*|&19`QqaüfEq*`3![H/DZLmsds+FP,OG~{445Y0FIY)E< '`"UMcr*tX )ژYu MpzS%(0JNo\;ڋH[ CۭdY :O Wʿy ~4V(sa&xkxՉk"!m"-,WI%Hu`_6tձmMz>{\=hծbHD<L=ufd"dh)x/+ _I3"+Άz䅾57XĽ]NaCQ1xNy҈ĝ/[Ó"0 7sʊW<&*::.y rHt%QE/2/|a!Ο, 5;` ?/Ho~COK%Il44; )ݠ Oe*/yE`;{Ē ֝_l-lWps7l{mRn9E KC=&4GĂz.g4۹M QO,$0H_ by—_U$y8q6Zܟ/7x}v-1>i]a*i="I3 biC'oT/+#B uW2h@SòbDufta9BXn/-U8\;ǻN>6'|&oo $hZpocXC)%Xc  ݝI@!?6Sw7^z~2:C/RO`g|2!sZZ?ޅf+GOg^X[a >05>޳'m-I?/-bKNk[NjB&c-LX`1G]&2Z:+iSE$moHw6. WLW.CMz4? sW 2՞[ZÈ9&KLWbok5ALYqy>{ 3a䧔6c2F]k0I O]CTN0M_,i~^c}zWЂ+*Ь+Ez>Gc.PwNa9wm'ܴ,g~x9bc;@sH=R؜6̕Bj,j. E^|II^}MXs&ӻ_#.5rI_gzEi4؄خ2&3u^0| aƢƻwLmT0/Lj%׹=i}t4铂ձxE12鬶urw[&SxlP.>&pS+\FCl g4TlND(ftyۦm|ꄹ]NaJGsVNv]{7Kz/0&ƇwYvUi& DUHvpAwٍNxjz3qSp[ }"I ˍGrreAK(ILfxMjZB(LWΦ+ %72c zZ"< ẏ'F4r7PZQ~y wwTP3H e3;.[xQ|xq27@MMq:9ȸzkx5̨@ޱ{ 2I*lOOLPF9K {sKA]a trw{x DqӠo}JC[]IHJce~vFb31"11JJ"xcċĨ0fnCӚ\(f5Z^`rIܦLeY.g&4'P#g* *(Ns-#;c]l_l>?GBb!mЇT]/TtW+/Lg$obO@oګ A5Wo轷ꄓ-[\϶M{ꥯ:eP7us'3N8>,_R3u(_UMypS¶SvU+}PtZ/1)sh&W5])٩T99PP?ǫKg<@&Ua'Ҷ)hN qӣhL aGCMZi?7Y(- e!r0RrF h,Fyοzu^`CVF,aS{6Ă[|{x q1aCXr&* lF<]̒@.d0 n+LNu zI g1'!!vӆD$o5M>HAY+Y7` JPȱg8(z“Sݠ"m*BB"2 5d7*.ArqIsdn5s=\I@*`9'dz\2d"k\m5 c/{X#?hmuD;Zi N`S!b#2++˲"|1)D"FiQMx&= =-+g7igb0|wxWK8˜_O ]1eׄyXaSd 6 ܹ-Sl:lɹ5ɟ9ٺ49P_`;Vr_[5aRaS+Pz[O#n_ 2L =CcƁ (  i ^RD&N9woetRætl20R@8{!-(':/57-/uJz*d0",ȣ1>5&^ғ! E#e;N]#^Ë`N2`$.9NW~Gu ՞*] q ֐ (g*2B>Ja:y7/1EjֻϭqW̿M;?Vy^HA˜f(G<k&>*]+x.=^uqn_&vc1۲|їN"=$pG/Im@vp 5%C"@as1?qҳJ[n ,7țH" 3K"*mK&aW8y3JYH$3ɷ^z endstream endobj 235 0 obj <> stream xڛ܀`qy `9  H|?z endstream endobj 237 0 obj <> stream x}Xy\S׶NlT5Xو8:8 !<PgD bj:W8k۫Z;ݴ~9o}k{mĢDbxJoO:5q<&p0RUh HbJ$l%.VV\Կ`$S{33J$CGf+[qIXXa 6_>dXGv3Z#m-.xmЬA[*՟ּuT.b[O\N`h|BV|V}obOc%\N |۟B #mq V'6ܫ~#^ƶ'okQ?d w4" #q,j aIQX Y8GH%>q|v6WUo0V/eiFf*#Ae' 3^D#[DgMj2A˹o~"f1r "SdGAvr98^{zG50/_~^KagOťEdh=A,w4 /-)Z2Z"'H:YCYVtF0 8&a0L0 wS@׫7h.g6i([yVF ,mŅ%Jp3#dާ O]o梄kcFGUAPiY2Y !F\H*eE'52pha!E!)8At=F08×wqτ!:9,naX\z"miԑ9˔ւǩ'枽MF^ d;Ғc#Q%obgCrHod`)q/viz% ʿ‚Q$ B_Np䔟9\3K&Hs .*-]좜,WZ<7;тϱ`FYگb6db fiAcs65ɴd _utm[DAy+}`E:eﻇ*t@SMc'KHdbvwi0dmwr'z; ȐyrS~;4;]Gy"ȇ̊v}UAוWGҵ٠!Q/Rdm }:2A=fJJȦ҉ќn(N~w,X7\̓0Fr>W%)"#V |o}X$cƘjaՋ|Yzh uɰ.VtZ` :5 [~Ews0_ffzN29w C4GPb9ouIcgzJ>2EK&9y kc6)5z:ܮYYc$/fPikΞ"&s?;4dag`w0Y3n40+A`+qr&tqktHFa'h%" W Bm6zyyd.9/LȰcWǞXO.t^LQbdJvRꥣ (qdK(a#8 TŹ(M`U, ̺EdJ2X872pUʓe޳Ry?&^zC =O~n4ܗVɇV6*WW;bUf),Gؙٹn IH֗{@u!LXL\{k 5exq?ϯ%EEGT+*vV//'9z2z+JV S:㌩8qBU^e=~3A|BՊ%@K[ŷ^ٲ\$MHuW޺<40=:NE) ZeLS喝へd F%EMu<كV?RpGN8"?`957iS5'~GU 8c,|뉸kAèPaYQymMOAޛ= l ^|9EF \޾ R床O1,@[*6!ew]TLʼe +EkB|䀖yJ@rW!2- AE 7yo6C&G1{+ڔEXjy?4Gӥc h-,$mF,h4(ׇ:#ś曣^lTXPl+&snH+a ,)ϕWG[bC} x{#U* kqJj?|'!&U8nʾy \%䒺2r;SMyJ>:3$jWtԆhlVfxWTU, ې`l0){3٨"Sa&T뼔k9 P?GITC6(3]&c5^*՘WDhMQ;WTպ;e=O93ݲC0X8|VEt"Qgʑ7\@.(y N;8*T4Vtj\su]fɄ\(3)`=k=Q_ুUQ ud?G{i@VJ|fGz) 9zڎ_T3}VFX_$5_v'sxH2|JNپyA;꫗G[w9Ve\}mi^o^$iA%0#2[+]$#z~@Ad$Kno&` 6ɹpp0k+MJP^Y]GGI83y J:x9B&CG#ey`G pKhy#fR'{i(?l'^j:ؒCD w)Kv6VLmĖKxFT qO4v/+_U/?dzM{Î o'rJ) 붺Ϛj7F6emkiYUS?L0![g[7&%3gНfF["D&euɰe&mRi.L{ Mǎ6h4DS˝Eo k)^,f]GޝUʚ鴇ۈ|cǚgo J oFÆ'(م~> stream xڛÀ020 6g=} endstream endobj 241 0 obj <> stream xڭXyXTWms#b+%ƸNvNMPA#*8:4j0  :[Kx74f|߽VΩ_m gfI$+wmj.Y7/6~ebTisFJQɉ*#Jšf[,%xf·%p `W_rb9Ҵr'H, Qd}3.:KBbÔ &j+_jԚQ]Tm| ]X5{?yV3XYn|zr rVVGYϷδ.~Tr.omxXq饗- N*g>}["ؼ,NWm^ ~ 0c5 ]eB^ \ngVrl۲}|s$U.%NwgU*e."ٿ?wρt\\ْq2q!\WUr`ћfyVkhZO`O~ҿVdo=O:ΜX`̂ (.BQ$ğl /~12Tp?xyq鲪M+Hu ]S2;"iEp:ZMǂ?'D{#4Lj NTu-7]2ŭ=A:Әγ&AL6„j>hqxS.ɉ1e7EOk3ieƒRqIƺR r&G'32Uge$m9H0K⟅9t,ގ±86S|.*!'ć/%4E_>CO*N)XƶR$6\GW)w !eUեeUNj(#ߎԈ }ky_)Z8S?n!jz n.UUtu'UuW㪹v*N4F;MdHhxf K KO cUrH%X@*Zg2E.I?0!y9q `, "u|Eu&s03ͦ[8AvLǘ/9` fkLzX/'git8/U4dy^^޵evSE5g瞮)`?Y;E[NuO~yV,6Td |# KE"n\xκ d~^oz eؚ7(r<RwP-QgHP0_|#>+ݨDs7F 2SPoG/ J x@@Jop5@d[E_5#rЩt4]Mϟx3yjca,DlƉuO5imJ;HRj= o=`|iJ0p˽O7A5c,Z+ax 'B%}`Xt}R)U~4z~ve|-t>MG=\d|VW\>LP{+&ܮzIcK~owaǀNw}I'(9_V' Tl}r&Au^w\qieDh6>BIߙ'RwI?UW3(!ew ]r |>*{)A<.y&n8f8fU^oLنm7PA/Cͩ^ѷM74ɕ@̂,#jfxXщYUE>/9ĂK(OݶF4bZHnzP*4vIqe' T"MoH/^f⎮%7wn34̻Zzߚk h!t V Ie>.9L7廅C'Faܯmhk+ȅ+|I@7bYkV? ;î6đ-f JwRf׷&d)Ҥ`gxdI퐩/M61L947K3d>Gf_0_-}c(&\]!kUPԂf S S0mT S{ܑR1 ژHD4^4~Vcxq#@"A r=9@^ņvɹxT&Le=m5ڇԖȬ8cSбP>9HC6Re7閊սHH#=jd[WnK~i=PNhྫྷQ_^Du~l 2G}|TaE0nE *xESK` d%Dعش qJZ55-%;C0GVX^Y^w:CqAQ3KGdg\ڗALNJMKD{@O:O#AFE ͕%GDǰrzD GU]nsc41fM 5h6܁E[)Oo\ŶЩ 73ghڃdqND'#Dו+Oɍu>MqsCHu-1QūLx[2l5KfjӜA aW姱ZXJQySuj_pJ-t *gsumF+ͺfTiof ޟПl.kT[P[*rM]'gω tMZVD&d#KV$= .i_p,ɮVZkxHx'G0>n7 ƍ(m`#]MO3,7<2\Dؠg%əc `t`^:fRuB?Cų޺a沈nŪo]934%kyMUĠt EX0:DŠIƼ,">hJIy\NUd'ȱi(4Y.NFDA=5OTN[c 26 mtgiԏ_G寵,I9,au&wn>^DҦ}ņ̞Vo5 (~Sq3'.9ɖv,s 2fu:Ϙ ol.)Ł@2:O|7|6?)f ʞ2P{;ǖM0+d->ºl1/ffSmlmv9'rM髴,5[4[Z,7–H endstream endobj 242 0 obj <> stream x!e endstream endobj 244 0 obj <> stream xڍYyXS׶OLR9ԫ^^u*Z81 IHAE@Ȥ@eGEDʼn*8:kjmW{׉;D{Ir~{/BX, CW/pʗoVNZYi/kc+䜬EH\kQwGSj>![>_:#q֣,֣B;xo_:H5y)2N jp_<9J?'r_feI8\{F,~>jenA>*A~~JDy\ T;M2eiSM}?Tʃy/"Ձr)PVf#}a|^E72reP@0'bxxxxxxxx8Bq^"n@ 2"{| )jlFh#hceccck3f̆q8mpǐ!-CZrvlۿη]ivtr 9"? <Lq[XV-|6@8TfJE/N<b@VhM+MG*#-Kdd< {JVdYvwG.,:p[C'{pM|Vy6%z%1#sK>Sp"_ym8QA@2z":wa& ٬ZfC8kqsqׯa/UYXuζet1ҙ Šg}xO0GUx .0v0i<Ix#P+% ܁p ^뎂%{k:Ӌ@*Y=Kx﹔ BxL§T8ᦎӬ1K,HAiv]~,{3_ʔnA7\ovuƎfD<q 2T vqŹpWqnv${c[_}, >C+Z_N%a*܁ "{p4"^l#. sܳ?g_`Ŀ?|r&"T]^nL$1A8_|7- Lj/oP­fB|c^舖6\M~ $Sd:W, G˘`%sS=^=dd7Xmhu+li{+XIyΆTӣj,~%\GyѪݑc~ ~N>;[(l v8ƒsy<B2G$i3 "Vpid2%ϜHX!w1i'd2<1?q ;*[Nf»^3L|8iۄ %#0Z¶ %nYafNE*F"A(V{}ud<6IӹlƭG_UD,D %7wcQ|<+YPݍs9d`ĤdCðx^G>[eߩgIϬKu` ’^))o?׳Kd]y9΋7z᪋ + n k"Uh 75l^YZǩKE@-WwӼ/؛| ?a=Z,ܰ#R m0T@}30˷%ڎ[^Ns] I,ֱ k !(0xZ0+!:@B1*d%H% ޯ$0 b{7v-U/`=jhkG!c5"ULd! <؅4<ϛVd4dNa x0##C,O5Za!H^{Oq<7i=w{^-&^0jzT|ˉj,:)7`O1{{KӼW.W,(x"YiIfϒY/cƁ8+W,~!)HBdkYRoGyh\l!#iuƈLM),D>o>nKtBݰ%_ݘ#-9XH@&`N ãѴ(}4tX&~VTΣBƃ'..9 U_\6'j>n'J%Ⱥ(ք0ltu|'A)QɱzYpֈCc~ *4oڕ Y7#|E W =]q-Zs+ ϻ70 /0omj6G"sJYSamexc]A=Xϑ<ʕP|+K@Cؔ(/Ll|0/ă~I)xYhrC5b!tܜ*in8))$i1q)l!Քk4AQuuŅt^ 66taMvޭ긔hC!`wl]Q`s'}Y^VB#Պ :lKq],˺e)JTZݒ)c~YHcj W}(K-AtlR^_.k7x`x6t?aA];$kKRCx0 ka,FdDr>bJv&%GŒǮ5zӵXW{^u[*b4Fd& &)+Ә^i`k4 "ռNN/-ʨW(+mO~J_+y0vkG5nhϋ?A6p H`?4KmfF:ޞs"%/ue2>I@r:5 =6ZJI` k}VƓ4bgN}luنC Yx%M^lV-9{ WUv1/I|}g$kJ\rB'BwƞRU:7$cjsqWbf#jߨ491ZIZQvx-! 2kI~tCU&(t:TTjzF%9%[’<>*XB8 4ܪ ;~*< (\b(ޝ۝!9ߠMrWt 'huL\n=~ɟjOf"Q(5U[U*_Kr+/q;v!ֽИ礮kVw}[`ٚ盏aJPqߍ4< ^ud No=OcfaI݂;@v3$W<:n7_+321yHEk ?_et7&c #sq8iCZځ?o{Ȓ5 :;Ҹp+:.}'`Cᩓ΅S0zˉx&vO1La \dM>.ݔZB?V|>wu3r7}Zwwun^$2ΗJʚAB:v<>CRrr퉹(CoF6D Rh%Ѩ/W93qBካta/1ZXx " Nv:|bix.r׮< &*0lvߥˊ8GA,Uղ%}PǾ8}6"N"(OqyL6aAYٗ?0K`gsU;$ckV^^cSA1 0GƢ| ^+tۼxJa$nh NZBݷ-.6!z+{4>EIl1xY4Z/I'ǎhRT~~"Mj/ޫ 4`+0DǨo6XFˣn~:W@Q (2h-ҨEBSYTQHolQ-yּRBfqOD+}],=uV}vg.8 ȟypwNeVlTT?A?M0oo:2ZSЎ^r[%t|;{Jμ06"cާ(ڝ]NR&k9f+3/L¤Н&%Ky0]pv;9 rIΗ JC|KIEuSm$2䈜'l5V<; R0Q?aWS po&c= iqQ&7yKO{L_竰9} N|!|<|v"5E$S3#!^tɸ.,~,#FZlWG[LbU|-Y[=R˟AC8z@0\; ++ӐGx$ڪGUwmLC~┪ endstream endobj 246 0 obj <> stream xk``"N?0fPAI@ȀRaȂ Rxl'edR- Zp-6 J endstream endobj 248 0 obj <> stream xmWy\ 1kF3Ѫ=U+nԥZP\Ö !d!DV @l,Kj**ZjknszNw<1̛<7C\]APn-M-JA7VO+ = vS8u~ց Dd5Ms&U94yTYg?""UQ"XM~<ZR)#0yXJ\Q J5o&DEhRb#S'nUMeL2**E=KURzJlB#]0ox-5EWj\$j#TܺIUqpR& & $&B$D;Ax/bb2Ex1& >w` \D"qe'½{AMh)HhHmx$ǹXqsgA"wxȻb(  DG_>C=Kb%6}f3Zj1- U'9,~9kYZQ$55^mSxJb h#MQzZIwCSGUWc :D7{?)@9"y -'ݨ\mb%4P'INpgC54؊_q4X/ >%)PaUy300NP,fi+xH}|fVީaa-p-Geg77n0_r?Y u+=0Cǰ\$u~T-y}lZ7Z&o%w 5V6?:vnSy8<:!]ݭLqQiv[5MU ?">5O1=vIzcp|Һ dN؁$U6>x v6jSh-(/xmEzNAl~qk08PW^i᝻%gWN3$z7J]'K#}JOm#V3xIʩ Ъi<OƳZQȧLUI0ۏBDi}-_ҷlLך.x(f  Bxn928L+%9JbY&JY*guy2>J2meSU3dK]q f\g:;G9;eHrr?HF:0!Ls^c62N,MhQunrLCkΈ5{ȑz;R,p)8fiBjN:SR\ )D%W v1\ XڜSj.i2-g$Đ7Yex?ؚ*9o%NݑTm7Z>ֲ.vVItæ3C:~SMUY2DyjF[5(:9ibVC ӢG'SPKMn>b41x\{6763 c?#1 ] nr?0Mfʊ3~[E-WX$M޿+yκ G{W,q]yq ]y]ΎZj53\.%FQaIy;k'xAH|.v?̶r{}؋0Qq:]Wېbe5I![kOY?*;x*͛pÐLl KhODzx\ۖs!a<5\} 鸣dD)͕Ӳ r rA0Yւj[j*&pC#s}^4K-}g/ӭs /WvA EwBRvx Qm ԥ>u]’x= %t*uHf'=2͝&n8~+1=N0{OwHpysE1D6/G49-;h=m:81݊⵻%x`x)w7b2W ]qÄ mˁxQhJڔ_QYS2`HfΈd:(.Omt&ԥٖk )?t̩>i_?fA*봴\9vKk{1CV?]x<QN_-uԬ2_| +V5u9ZeمQ);.YmWp>Yii iz~_*a{/ܳW(e ۀC_g:֚e7K`+dQ#$wHml1w偗#LqS (ATT]VXI;̡T)ůhC>{{8SdI۝Ԥظzu/C]D6Q[YE& KT#J6"1"K{^/zoyB{PuXU/!kE=K endstream endobj 250 0 obj <> stream xkja?W1 yJ A endstream endobj 10 0 obj <> stream x\[sF~_v@/[)W2ި&Ol2CB w(CRuyThoާOt+𪐱J*BV ЦN1BBZQp5ڌ,\ >2 0c&7Y VlaA` e֢h t; %UZY8/\բE^ƒ``N$*V `@t`"CqA,G'$)w+F ":B(B@)9'Yn=۠Y7IaX3֕U>teP./g> hNP8%@ 9{ K5"t! `!ax `d|T$8 Gbd z!xӐ(:_c8$1 X$X $ + J ΒS# ^M=,&A^4C!8J#`HBT'@E`x!0(9` QZQx @z`QH{d(&:SpF6#mUhH %ECa|hi FFtSP8 .p8z0,  An Rtp1Rt#g< NWHUq,Q'K4|Ìɚi@P( Bd_HM[-#4aEHnD=HҢ IZI.,LG44%B\J4SdSz%WJJmzhs0BOb9cVPc` m%&:d)pM𥜼.qYjЧarZfwkxA<{Vnozu.ofxgmuszMk`כ}=K_-^lz;)՗es {[ݦzdW͢^L} , %??Q/+KݣΕV%׺Sg=r@ʏ)[ 'f7Wu);2u Ң !)Crn2p`kQpwr.QF GUjLh+u^-o]E˜PFCcaEl)d@JWƫ:"zF ڝ)`Jo&eZ޴)u |.>e?X\_iu{}3[^+dm~+_Y>A?zY,Ջٮ>~Xwcy[,׷;o7zU_RV~Uvz;f}]͗ժP헫E]ͺi[zK -wU a/jKz\fʟo׳jv6כuj>#ټrFY}3AJ//~9q8O_lV`Kv_n8n! 0\:֓iKr;AX ȈKJ?~39vm_% cN=w̫&q !4̘uǍ-Uӱ:ލ v Q GF"cw`u8$}k˸Q.g-K/ź۷'!cˊ S7(@&|vv@rjx@W{qA]m"OM=BL"k NLVlQo~UY=;CZ4s>w3%K2x ;K|bi$/ui'*ӎzC:~X6*ֲwM;B9U7 TfoQ•pį|Y>Ndvm&`/"ۖ3gsV "?#Hq|.O_-oɫlxro ؋iZoOdtѶ(.d?q=E[mZ%/A- ۲1gSjpqƟ2!n,% Ё']{v;Q ͜5=#PEЁ `CƞVZ*ظ~%l]T ƹ褫I`lOoJ+c*up6n&]z鐭ٔbxc+2tɂ?m8sje'PeU iy)Ct0-o`9[Yoލb{ԃiyma0O`p vC}p:c 1M۴?vT[x†@b5QԀ8Ρ*?DGtmtAVќ@\ў@10O׌ETsr  h=a'G_?ʐ2kRj:*cH+wÝ5f5JsԣZɣ/Ӂ;G+S ֜[E"#xc팴b2t:kEXmZ L :4UaC71dnFR؋Kó3ѴVi+iK6~34 )<ꇐfDx[e\nv M*(Y0\].)mGZ괃~s{ ã{x7UAy;v@8'ߍ\}B4nM|ϢφO赣Kl|r-Rvfm5FΌ6`]*1w~ňz֬kp+/JČՃ'T̹J^-?ryGgDC'fTeNsgbWp~ЍYЪ4/>-Z16-.c%e0zՠ-ZDQ8I`;N6djmK:5ܡŎТZNp:'=I\GGUУZ}E;]T}]ލv?WݑC]]nȾ'er`[sD!E3jGy7na9/ym\eѤ(O=4gw~3(p}\ ѻFUHc5;&瘓@JOJ_V&N'9}YeEN!9oXLas͹{`Ι@$ ;/ e?[_9*rR4sګ"ЍN t}u[E:3VSKC9U\VѤzX}1\LB7vO-倾a\$gU*scE@9ut.9TQE},X|LhB w4׉ ݢ,"{.I(ۂh)}A˞M+wǜV}s~-[E4&}"6˕2wAq&:iuX^l>"k<%xgWw?g.7&AI55} ]_W7>A4B^\dn'M@`{O~^?OI1{OLe~W{_-QJΦ |wn$ڗlNՄz 7?cKz~* l^{Uu$'Ku;ު1STY;1'y:y+7}a)U`NXʼ ԌU"Fh`rAĢțj"0 X#hЁh&{Hc B/OppKtd h`ӇBg⋃ZTIW)QewE5qA҇03qY0f-< l-_^1%X3٬a#^08A^BScI>G*-'3>L1F hy% ZZ`?=P#xbkd@3ﬣxN/5 f.(BM̺C@4;^2OZ@OM\+ L\4P-TZ |ye6柿|o]Oy]}}m9ݾ\_mjz<_l~/oyf~r"W 4ќ|U{,-} >[鞟2mGTw< WDJO[P߈Y/}rr BJ^p{)Tt rKxzUz]#܏g5a_5wH}^/W5o6;ȴƂKGOe{SMگ(k.Bm/~ݏ'`0o0 ?S endstream endobj 251 0 obj <> stream xڵmo@ Se*KNBH@ەiU}]s4ղHgc|q80å5.0Fp `Q`5P\*mVL7kK.8?" yNqk Lr)RayZ MiMo#=p@`TwQF29So"F~dEk>v_Y7Mw2ϹM #+Y)I>90Oճ}^]X08W"^$A/Iŷ-Z̒ݖ 4ms=_^0I8c|<&_ C$ d7Z#*Kw|iIUQYW"11BU0j'+15hQiE$Eߦ}NE<h@$;DԤo G\|G{\~𑐈HC'ꆊKMu8TƦ bvL] Equ;%"# ߡ15ASsw`mи1u()+xF#4M02vװJw@ ݠ)4;Nʚ endstream endobj 252 0 obj <<10fb10708b890c2b479d8eba6f8d6da5>]/Root 1 0 R/Info 2 0 R/Size 253/W[1 3 2]/Filter/FlateDecode/Length 584>> stream x-ITOaI!2g 2E!!S#C,Q)sdJ()HR)ɲh|#T*-/0F>= library(actuar) options(width = 52, digits = 4) @ \begin{document} \maketitle \section{Introduction} \label{sec:introduction} Package \pkg{actuar} provides functions to facilitate the generation of random variates from various probability models commonly used in actuarial applications. From the simplest to the most sophisticated, these functions are: \begin{enumerate} \item \code{rmixture} to simulate from discrete mixtures; \item \code{rcompound} to simulate from compound models (and a simplified version, \code{rcompois} to simulate from the very common compound Poisson model); \item \code{rcomphierarc} to simulate from compound models where both the frequency and the severity components can have a hierarchical structure. \end{enumerate} \section{Simulation from discrete mixtures} \label{sec:rmixture} A random variable is said to be a discrete mixture of the random variables with probability density functions $f_1, \dots, f_n$ if its density can be written as \begin{equation} \label{eq:mixture} f(x) = p_1 f_1(x) + \dots + p_n f_n(x) = \sum_{i = 1}^n p_i f_i(x), \end{equation} where $p_1, \dots, p_n$ are probabilities (or weights) such that $p_i \geq 0$ and $\sum_{i = 1}^n p_i = 1$. Function \code{rmixture} makes it easy to generate random variates from such mixtures. The arguments of the function are: \begin{enumerate} \item \code{n} the number of variates to generate; \item \code{probs} a vector of values that will be normalized internally to create the probabilities $p_1, \dots, p_n$; \item \code{models} a vector of expressions specifying the simulation models corresponding to the densities $f_1, \dots, f_n$. \end{enumerate} The specification of simulation models follows the syntax of \code{rcomphierarc} (explained in greater detail in \autoref{sec:rcomphierarc}). In a nutshell, the models are expressed in a semi-symbolic fashion using an object of mode \code{"expression"} where each element is a complete call to a random number generation function, with the number of variates omitted. The following example should clarify this concept. \begin{example} Let $X$ be a mixture between two exponentials: one with mean $1/3$ and one with mean $1/7$. The first exponential has twice as much weight as the second one in the mixture. Therefore, the density of $X$ is \begin{equation*} f(x) = \frac{2}{3} (3 e^{-3x}) + \frac{1}{3} (7 e^{-7x}) \\ = 2 e^{-3x} + \frac{7}{3} e^{-7x}. \end{equation*} The following expression generates $10$ random variates from this density using \code{rmixture}. <>= rmixture(10, probs = c(2, 1), models = expression(rexp(3), rexp(7))) @ \qed \end{example} See also \autoref{ex:comppois} for a more involved application combining simulation from a mixture and simulation from a compound Poisson model. \section{Simulation from compound models} \label{sec:rcompound} Actuaries often need to simulate separately the frequency and the severity of claims for compound models of the form \begin{equation} \label{eq:definition-S} S = C_1 + \dots + C_N, \end{equation} where $C_1, C_2, \dots$ are the mutually independent and identically distributed random variables of the claim amounts, each independent of the frequency random variable $N$. Function \code{rcompound} generates variates from the random variable $S$ when the distribution of both random variables $N$ and $C$ is non hierarchical; for the more general hierarchical case, see \autoref{sec:rcomphierarc}. The function has three arguments: \begin{enumerate} \item \code{n} the number of variates to generate; \item \code{model.freq} the frequency model (random variable $N$); \item \code{model.sev} the severity model (random variable $C$). \end{enumerate} Arguments \code{model.freq} and \code{model.sev} are simple R expressions consisting of calls to a random number generation function with the number of variates omitted. This is of course similar to argument \code{models} of \code{rmixture}, only with a slightly simpler syntax since one does not need to wrap the calls in \code{expression}. Function \code{rcomppois} is a simplified interface for the common case where $N$ has a Poisson distribution and, therefore, $S$ is compound Poisson. In this function, argument \code{model.freq} is replaced by \code{lambda} that takes the value of the Poisson parameter. \begin{example} Let $S \sim \text{Compound Poisson}(1.5, F)$, where $1.5$ is the value of the Poisson parameter and $F$ is the cumulative distribution function of a gamma distribution with shape parameter $\alpha = 3$ and rate parameter $\lambda = 2$. We obtain variates from the random variable $S$ using \code{rcompound} or \code{rcompois} as follows: <>= rcompound(10, rpois(1.5), rgamma(3, 2)) rcomppois(10, 1.5, rgamma(3, 2)) @ Specifying argument \code{SIMPLIFY = FALSE} to either function will return not only the variates from $S$, but also the underlying variates from the random variables $N$ and $C_1, \dots, C_N$: <>= rcomppois(10, 1.5, rgamma(3, 2), SIMPLIFY = FALSE) @ \qed \end{example} \begin{example} \label{ex:comppois} Theorem~9.7 of \cite{LossModels4e} states that the sum of compound Poisson random variables is itself compound Poisson with Poisson parameter equal to the sum of the Poisson parameters and severity distribution equal to the mixture of the severity models. Let $S = S_1 + S_2 + S_3$, where $S_1$ is compound Poisson with mean frequency $\lambda = 2$ and severity Gamma$(3, 1)$; $S_2$ is compound Poisson with $\lambda = 1$ and severity Gamma$(5, 4)$; $S_3$ is compound Poisson with $\lambda = 1/2$ and severity Lognormal$(2, 1)$. By the aforementioned theorem, $S$ is compound Poisson with $\lambda = 2 + 1 + 1/2 = 7/2$ and severity density \begin{equation*} f(x) = \frac{4}{7} \left( \frac{1}{\Gamma(3)} x^2 e^{-x} \right) + \frac{2}{7} \left( \frac{4^5}{\Gamma(5)} x^4 e^{-4x} \right) + \frac{1}{7} \phi(\ln x - 2). \end{equation*} Combining \code{rcomppois} and \code{rmixture} we can generate variates of $S$ using the following elegant expression. <>= x <- rcomppois(1e5, 3.5, rmixture(probs = c(2, 1, 0.5), expression(rgamma(3), rgamma(5, 4), rlnorm(2, 1)))) @ One can verify that the theoretical mean of $S$ is $6 + 5/4 + (e^{5/2})/2 = 13.34$. Now, the empirical mean based on the above sample of size $10^5$ is: <>= mean(x) @ \qed \end{example} \section{Simulation from compound hierarchical models} \label{sec:rcomphierarc} Hierarchical probability models are widely used for data classified in a tree-like structure and in Bayesian inference. The main characteristic of such models is to have the probability law at some level in the classification structure be conditional on the outcome in previous levels. For example, adopting a bottom to top description of the model, a simple hierarchical model could be written as \begin{equation} \label{eq:basic_model} \begin{split} X_t|\Lambda, \Theta &\sim \text{Poisson}(\Lambda) \\ \Lambda|\Theta &\sim \text{Gamma}(3, \Theta) \\ \Theta &\sim \text{Gamma}(2, 2), \end{split} \end{equation} where $X_t$ represents actual data. The random variables $\Theta$ and $\Lambda$ are generally seen as uncertainty, or risk, parameters in the actuarial literature; in the sequel, we refer to them as mixing parameters. The example above is merely a multi-level mixture of models, something that is simple to simulate ``by hand''. The following R expression will yield $n$ variates of the random variable $X_t$: <>= rpois(n, rgamma(n, 3, rgamma(n, 2, 2))) @ However, for categorical data common in actuarial applications there will usually be many categories --- or \emph{nodes} --- at each level. Simulation is then complicated by the need to always use the correct parameters for each variate. Furthermore, one may need to simulate both the frequency and the severity of claims for compound models of the form \eqref{eq:definition-S}. This section briefly describes function \code{rcomphierarc} and its usage. \cite{Goulet:simpf:2008} discuss in more details the models supported by the function and give more thorough examples. \subsection{Description of hierarchical models} \label{sec:rcomphierarc:description} We consider simulation of data from hierarchical models. We want a method to describe these models in R that meets the following criteria: \begin{enumerate} \item simple and intuitive to go from the mathematical formulation of the model to the R formulation and back; \item allows for any number of levels and nodes; \item at any level, allows for any use of parameters higher in the hierarchical structure. \end{enumerate} A hierarchical model is completely specified by the number of nodes at each level and by the probability laws at each level. The number of nodes is passed to \code{rcomphierarc} by means of a named list where each element is a vector of the number of nodes at a given level. Vectors are recycled when the number of nodes is the same throughout a level. Probability models are expressed in a semi-symbolic fashion using an object of mode \code{"expression"}. Each element of the object must be named --- with names matching those of the number of nodes list --- and should be a complete call to an existing random number generation function, but with the number of variates omitted. Hierarchical models are achieved by replacing one or more parameters of a distribution at a given level by any combination of the names of the levels above. If no mixing is to take place at a level, the model for this level can be \code{NULL}. \begin{example} Consider the following expanded version of model \eqref{eq:basic_model}: \begin{align*} X_{ijt}|\Lambda_{ij}, \Theta_i &\sim \text{Poisson}(\Lambda_{ij}), & t &= 1, \dots, n_{ij} \\ \Lambda_{ij}|\Theta_i &\sim \text{Gamma}(3, \Theta_i), & j &= 1, \dots, J_i \\ \Theta_i &\sim \text{Gamma}(2, 2), & i &= 1, \dots, I, \end{align*} with $I = 3$, $J_1 = 4$, $J_2 = 5$, $J_3 = 6$ and $n_{ij} \equiv n = 10$. Then the number of nodes and the probability model are respectively specified by the following expressions. \begin{Schunk} \begin{Verbatim} list(Theta = 3, Lambda = c(4, 5, 6), Data = 10) \end{Verbatim} \end{Schunk} \begin{Schunk} \begin{Verbatim} expression(Theta = rgamma(2, 2), Lambda = rgamma(3, Theta), Data = rpois(Lambda)) \end{Verbatim} \end{Schunk} \qed \end{example} Storing the probability model requires an expression object in order to avoid evaluation of the incomplete calls to the random number generation functions. Function \code{rcomphierarc} builds and executes the calls to the random generation functions from the top of the hierarchical model to the bottom. At each level, the function \begin{enumerate} \item infers the number of variates to generate from the number of nodes list, and \item appropriately recycles the mixing parameters simulated previously. \end{enumerate} The actual names in the list and the expression object can be anything; they merely serve to identify the mixing parameters. Furthermore, any random generation function can be used. The only constraint is that the name of the number of variates argument is \code{n}. In addition, \code{rcomphierarc} supports usage of weights in models. These usually modify the frequency parameters to take into account the ``size'' of an entity. Weights are used in simulation wherever the name \code{weights} appears in a model. \subsection[Usage of rcomphierarc]{Usage of \code{rcomphierarc}} \label{sec:rcomphierarc:usage} Function \code{rcomphierarc} can simulate data for structures where both the frequency model and the severity model are hierarchical. It has four main arguments: \begin{enumerate} \item \code{nodes} for the number of nodes list; \item \code{model.freq} for the frequency model; \item \code{model.sev} for the severity model; \item \code{weights} for the vector of weights in lexicographic order, that is all weights of entity 1, then all weights of entity 2, and so on. \end{enumerate} The function returns the variates in a list of class \code{"portfolio"} with a \code{dim} attribute of length two. The list contains all the individual claim amounts for each entity. Since every element can be a vector, the object can be seen as a three-dimension array with a third dimension of potentially varying length. The function also returns a matrix of integers giving the classification indexes of each entity in the portfolio. The package also defines methods for four generic functions to easily access key quantities for each entity of the simulated portfolio: \begin{enumerate} \item a method of \code{aggregate} to compute the aggregate claim amounts $S$; \item a method of \code{frequency} to compute the number of claims $N$; \item a method of \code{severity} (a generic function introduced by the package) to return the individual claim amounts $C_j$; \item a method of \code{weights} to extract the weights matrix. \end{enumerate} In addition, all methods have a \code{classification} and a \code{prefix} argument. When the first is \code{FALSE}, the classification index columns are omitted from the result. The second argument overrides the default column name prefix; see the \code{rcomphierarc.summaries} help page for details. The following example illustrates these concepts in detail. \begin{example} Consider the following compound hierarchical model: \begin{equation*} S_{ijt} = C_{ijt1} + \dots + C_{ijt N_{ijt}}, \end{equation*} for $i = 1, \dots, I$, $j = 1, \dots, J_i$, $t = 1, \dots, n_{ij}$ and with \begin{align*} N_{ijt}|\Lambda_{ij}, \Phi_i &\sim \text{Poisson}(w_{ijt} \Lambda_{ij}) & C_{ijtu}|\Theta_{ij}, \Psi_i &\sim \text{Lognormal}(\Theta_{ij}, 1) \notag \\ \Lambda_{ij}|\Phi_i &\sim \text{Gamma}(\Phi_i, 1) & \Theta_{ij}|\Psi_i &\sim N(\Psi_i, 1) \\ \Phi_i &\sim \text{Exponential}(2) & \Psi_i &\sim N(2, 0.1). \notag \end{align*} (Note how weights modify the Poisson parameter.) Using as convention to number the data level 0, the above is a two-level compound hierarchical model. Assuming that $I = 2$, $J_1 = 4$, $J_2 = 3$, $n_{11} = \dots = n_{14} = 4$ and $n_{21} = n_{22} = n_{23} = 5$ and that weights are simply simulated from a uniform distribution on $(0.5, 2.5)$, then simulation of a data set with \code{rcomphierarc} is achieved with the following expressions. <>= set.seed(3) @ <>= nodes <- list(cohort = 2, contract = c(4, 3), year = c(4, 4, 4, 4, 5, 5, 5)) mf <- expression(cohort = rexp(2), contract = rgamma(cohort, 1), year = rpois(weights * contract)) ms <- expression(cohort = rnorm(2, sqrt(0.1)), contract = rnorm(cohort, 1), year = rlnorm(contract, 1)) wijt <- runif(31, 0.5, 2.5) pf <- rcomphierarc(nodes = nodes, model.freq = mf, model.sev = ms, weights = wijt) @ Object \code{pf} is a list of class \code{"portfolio"} containing, among other things, the aforementioned two-dimension list as element \code{data} and the classification matrix (subscripts $i$ and $j$) as element \code{classification}: <>= class(pf) pf$data pf$classification @ The output of \code{pf\$data} is not much readable. If we were to print the results of \code{rcomphierarc} this way, many users would wonder what \code{Numeric,\emph{n}} means. (It is actually R's way to specify that a given element in the list is a numeric vector of length $n$ --- the third dimension mentioned above.) To ease reading, the \code{print} method for objects of class \code{"portfolio"} only prints the simulation model and the number of claims in each node: <>= pf @ By default, the method of \code{aggregate} returns the values of $S_{ijt}$ in a regular matrix (subscripts $i$ and $j$ in the rows, subscript $t$ in the columns). The method has a \code{by} argument to get statistics for other groupings and a \code{FUN} argument to get statistics other than the sum: <>= aggregate(pf) aggregate(pf, by = c("cohort", "year"), FUN = mean) @ The method of \code{frequency} returns the values of $N_{ijt}$. It is mostly a wrapper for the \code{aggregate} method with the default \code{sum} statistic replaced by \code{length}. Hence, arguments \code{by} and \code{FUN} remain available: <>= frequency(pf) frequency(pf, by = "cohort") @ The method of \code{severity} returns the individual variates $C_{ijtu}$ in a matrix similar to those above, but with a number of columns equal to the maximum number of observations per entity, \begin{displaymath} \max_{i, j} \sum_{t = 1}^{n_{ij}} N_{ijt}. \end{displaymath} Thus, the original period of observation (subscript $t$) and the identifier of the severity within the period (subscript $u$) are lost and each variate now constitute a ``period'' of observation. For this reason, the method provides an argument \code{splitcol} in case one would like to extract separately the individual severities of one or more periods: <>= severity(pf) severity(pf, splitcol = 1) @ Finally, the weights matrix corresponding to the data in object \code{pf} is <>= weights(pf) @ Combined with the argument \code{classification = FALSE}, the above methods can be used to easily compute loss ratios: <>= aggregate(pf, classif = FALSE) / weights(pf, classif = FALSE) @ \qed \end{example} \begin{example} \cite{Scollnik:2001:MCMC} considers the following model for the simulation of claims frequency data in a Markov Chain Monte Carlo (MCMC) context: \begin{align*} S_{it}|\Lambda_i, \alpha, \beta &\sim \text{Poisson}(w_{ij} \Lambda_i) \\ \Lambda_i|\alpha, \beta &\sim \text{Gamma}(\alpha, \beta) \\ \alpha &\sim \text{Gamma}(5, 5) \\ \beta &\sim \text{Gamma}(25, 1) \end{align*} for $i = 1, 2, 3$, $j = 1, \dots, 5$ and with weights $w_{it}$ simulated from \begin{align*} w_{it}|a_i, b_i &\sim \text{Gamma}(a_i, b_i) \\ a_i &\sim U(0, 100) \\ b_i &\sim U(0, 100). \end{align*} Strictly speaking, this is not a hierarchical model since the random variables $\alpha$ and $\beta$ are parallel rather than nested. Nevertheless, with some minor manual intervention, function \code{rcomphierarc} can simulate data from this model. First, one simulates the weights (in lexicographic order) with <>= set.seed(123) @ <>= wit <- rgamma(15, rep(runif(3, 0, 100), each = 5), rep(runif(3, 0, 100), each = 5)) @ Second, one calls \code{rcomphierarc} to simulate the frequency data. The key here consists in manually inserting the simulation of the shape and rate parameters of the gamma distribution in the model for $\Lambda_i$. Finally, wrapping the call to \code{rcomphierarc} in \code{frequency} will immediately yield the matrix of observations: <>= frequency(rcomphierarc(list(entity = 3, year = 5), expression(entity = rgamma(rgamma(1, 5, 5), rgamma(1, 25, 1)), year = rpois(weights * entity)), weights = wit)) @ \qed \end{example} One will find more examples of \code{rcomphierarc} usage in the \code{simulation} demo file. The function was used to simulate the data in \cite{Goulet_cfs}. %% References \bibliography{actuar} \end{document} %%% Local Variables: %%% mode: noweb %%% coding: utf-8 %%% TeX-master: t %%% End: actuar/inst/doc/credibility.Rnw0000644000176200001440000006413314370340204016252 0ustar liggesusers\input{share/preamble} %\VignetteIndexEntry{Credibility theory} %\VignettePackage{actuar} %\SweaveUTF8 \title{Credibility theory features of \pkg{actuar}} \author{Christophe Dutang \\ Université Paris Dauphine \\[3ex] Vincent Goulet \\ Université Laval \\[3ex] Xavier Milhaud \\ Université Claude Bernard Lyon 1 \\[3ex] Mathieu Pigeon \\ Université du Québec à Montréal} \date{} <>= library(actuar) options(width = 57, digits = 4) @ \begin{document} \maketitle \section{Introduction} \label{sec:introduction} Credibility models are actuarial tools to distribute premiums fairly among a heterogeneous group of policyholders (henceforth called \emph{entities}). More generally, they can be seen as prediction methods applicable in any setting where repeated measures are made for subjects with different risk levels. The credibility theory features of \pkg{actuar} consist of matrix \code{hachemeister} containing the famous data set of \cite{Hachemeister_75} and function \code{cm} to fit hierarchical (including Bühlmann, Bühlmann-Straub), regression and linear Bayes credibility models. Furthermore, function \code{rcomphierarc} can simulate portfolios of data satisfying the assumptions of the aforementioned credibility models; see the \code{"simulation"} vignette for details. \section{Hachemeister data set} \label{sec:hachemeister} The data set of \cite{Hachemeister_75} consists of private passenger bodily injury insurance average claim amounts, and the corresponding number of claims, for five U.S.\ states over 12 quarters between July 1970 and June 1973. The data set is included in the package in the form of a matrix with 5 rows and 25 columns. The first column contains a state index, columns 2--13 contain the claim averages and columns 14--25 contain the claim numbers: <>= data(hachemeister) hachemeister @ \section{Hierarchical credibility model} \label{sec:hierarchical} The linear model fitting function of R is \code{lm}. Since credibility models are very close in many respects to linear models, and since the credibility model fitting function of \pkg{actuar} borrows much of its interface from \code{lm}, we named the credibility function \code{cm}. Function \code{cm} acts as a unified interface for all credibility models supported by the package. Currently, these are: the unidimensional models of \cite{Buhlmann_69} and \cite{BS_70}; the hierarchical model of \cite{Jewell_75} (of which the first two are special cases); the regression model of \cite{Hachemeister_75}, optionally with the intercept at the barycenter of time \citep[Section~8.4]{Buhlmann_Gisler}; linear Bayes models. The modular design of \code{cm} makes it easy to add new models if desired. This section concentrates on usage of \code{cm} for hierarchical models. There are some variations in the formulas of the hierarchical model in the literature. We compute the credibility premiums as given in \cite{BJ_87} or \cite{Buhlmann_Gisler}, supporting three types of estimators of the between variance structure parameters: the unbiased estimators of \cite{Buhlmann_Gisler} (the default), the slightly different version of \cite{Ohlsson} and the iterative pseudo-estimators as found in \cite{LivreVert} or \cite{Goulet_JAP}. Consider an insurance portfolio where \emph{entities} are classified into \emph{cohorts}. In our terminology, this is a two-level hierarchical classification structure. The observations are claim amounts $S_{ijt}$, where index $i = 1, \dots, I$ identifies the cohort, index $j = 1, \dots, J_i$ identifies the entity within the cohort and index $t = 1, \dots, n_{ij}$ identifies the period (usually a year). To each data point corresponds a weight --- or volume --- $w_{ijt}$. Then, the best linear prediction for the next period outcome of a entity based on ratios $X_{ijt} = S_{ijt}/w_{ijt}$ is \begin{equation} \label{eq:hierarchical:premiums} \begin{split} \hat{\pi}_{ij} &= z_{ij} X_{ijw} + (1 - z_{ij}) \hat{\pi}_i \\ \hat{\pi}_i &= z_i X_{izw} + (1 - z_i) m, \end{split} \end{equation} with the credibility factors \begin{align*} z_{ij} &= \frac{w_{ij\pt}}{w_{ij\pt} + s^2/a}, & w_{ij\pt} &= \sum_{t = 1}^{n_{ij}} w_{ijt} \\ z_{i} &= \frac{z_{i\pt}}{z_{i\pt} + a/b}, & z_{i\pt} &= \sum_{j = 1}^{J_i} z_{ij} \end{align*} and the weighted averages \begin{align*} X_{ijw} &= \sum_{t = 1}^{n_{ij}} \frac{w_{ijt}}{w_{ij\pt}}\, X_{ijt} \\ X_{izw} &= \sum_{j = 1}^{J_i} \frac{z_{ij}}{z_{i\pt}}\, X_{ijw}. \end{align*} The estimator of $s^2$ is \begin{equation} \label{eq:s2} \hat{s}^2 = \frac{1}{\sum_{i = 1}^I \sum_{j = 1}^{J_i} (n_{ij} - 1)} \sum_{i = 1}^I \sum_{j = 1}^{J_i} \sum_{t = 1}^{n_{ij}} w_{ijt} (X_{ijt} - X_{ijw})^2. \end{equation} The three types of estimators for the variance components $a$ and $b$ are the following. First, let \begin{align*} A_i &= \sum_{j = 1}^{J_i} w_{ij\pt} (X_{ijw} - X_{iww})^2 - (J_i - 1) s^2 & c_i &= w_{i\pt\pt} - \sum_{j = 1}^{J_i} \frac{w_{ij\pt}^2}{w_{i\pt\pt}} \\ B &= \sum_{i = 1}^I z_{i\pt} (X_{izw} - \bar{X}_{zzw})^2 - (I - 1) a & d &= z_{\pt\pt} - \sum_{i = 1}^I \frac{z_{i\pt}^2}{z_{\pt\pt}}, \end{align*} with \begin{equation} \label{eq:Xbzzw} \bar{X}_{zzw} = \sum_{i = 1}^I \frac{z_{i\pt}}{z_{\pt\pt}}\, X_{izw}. \end{equation} (Hence, $\E{A_i} = c_i a$ and $\E{B} = d b$.) Then, the Bühlmann--Gisler estimators are \begin{align} \label{eq:ac-BG} \hat{a} &= \frac{1}{I} \sum_{i = 1}^I \max \left( \frac{A_i}{c_i}, 0 \right) \\ \label{eq:bc-BG} \hat{b} &= \max \left( \frac{B}{d}, 0 \right), \end{align} the Ohlsson estimators are \begin{align} \label{eq:ac-Ohl} \hat{a}^\prime &= \frac{\sum_{i = 1}^I A_i}{\sum_{i = 1}^I c_i} \\ \label{eq:bc-Ohl} \hat{b}^\prime &= \frac{B}{d} \end{align} and the iterative (pseudo-)estimators are \begin{align} \label{eq:at} \tilde{a} &= \frac{1}{\sum_{i = 1}^I (J_i - 1)} \sum_{i = 1}^I \sum_{j = 1}^{J_i} z_{ij} (X_{ijw} - X_{izw})^2 \\ \label{eq:bt} \tilde{b} &= \frac{1}{I - 1} \sum_{i = 1}^I z_i (X_{izw} - X_{zzw})^2, \end{align} where \begin{equation} \label{eq:Xzzw} X_{zzw} = \sum_{i = 1}^I \frac{z_i}{z_\pt}\, X_{izw}. \end{equation} Note the difference between the two weighted averages \eqref{eq:Xbzzw} and \eqref{eq:Xzzw}. See \cite{cm} for further discussion on this topic. Finally, the estimator of the collective mean $m$ is $\hat{m} = X_{zzw}$. The credibility modeling function \code{cm} assumes that data is available in the format most practical applications would use, namely a rectangular array (matrix or data frame) with entity observations in the rows and with one or more classification index columns (numeric or character). One will recognize the output format of \code{rcomphierarc} and its summary methods. Then, function \code{cm} works much the same as \code{lm}. It takes in argument: a formula of the form \code{\~{} terms} describing the hierarchical interactions in a data set; the data set containing the variables referenced in the formula; the names of the columns where the ratios and the weights are to be found in the data set. The latter should contain at least two nodes in each level and more than one period of experience for at least one entity. Missing values are represented by \code{NA}s. There can be entities with no experience (complete lines of \code{NA}s). In order to give an easily reproducible example, we group states 1 and 3 of the Hachemeister data set into one cohort and states 2, 4 and 5 into another. This shows that data does not have to be sorted by level. The fitted model below uses the iterative estimators of the variance components. <>= X <- cbind(cohort = c(1, 2, 1, 2, 2), hachemeister) fit <- cm(~cohort + cohort:state, data = X, ratios = ratio.1:ratio.12, weights = weight.1:weight.12, method = "iterative") fit @ The function returns a fitted model object of class \code{"cm"} containing the estimators of the structure parameters. To compute the credibility premiums, one calls a method of \code{predict} for this class. <>= predict(fit) @ One can also obtain a nicely formatted view of the most important results with a call to \code{summary}. <>= summary(fit) @ The methods of \code{predict} and \code{summary} can both report for a subset of the levels by means of an argument \code{levels}. <>= summary(fit, levels = "cohort") predict(fit, levels = "cohort") @ \section{Bühlmann and Bühlmann--Straub models} \label{sec:buhlmann} As mentioned above, the Bühlmann and Bühlmann--Straub models are simply one-level hierarchical models. In this case, the Bühlmann--Gisler and Ohlsson estimators of the between variance parameters are both identical to the usual \cite{BS_70} estimator \begin{equation} \label{eq:a-hat} \hat{a} = \frac{w_{\pt\pt}}{w_{\pt\pt}^2 - \sum_{i=1}^I w_{i\pt}^2} \left( \sum_{i=1}^I w_{i\pt} (X_{iw} - X_{ww})^2 - (I - 1) \hat{s}^2 \right), \end{equation} and the iterative estimator \begin{equation} \label{eq:a-tilde} \tilde{a} = \frac{1}{I - 1} \sum_{i = 1}^I z_i (X_{iw} - X_{zw})^2 \end{equation} is better known as the Bichsel--Straub estimator. To fit the Bühlmann model using \code{cm}, one simply does not specify any weights. <>= cm(~state, hachemeister, ratios = ratio.1:ratio.12) @ When weights are specified together with a one-level model, \code{cm} automatically fits the Bühlmann--Straub model to the data. In the example below, we use the Bichsel--Straub estimator for the between variance. <>= cm(~state, hachemeister, ratios = ratio.1:ratio.12, weights = weight.1:weight.12) @ \section{Regression model of Hachemeister} \label{sec:regression} The credibility regression model of \cite{Hachemeister_75} is a generalization of the Bühlmann--Straub model. If data shows a systematic trend, the latter model will typically under- or over-estimate the true premium of an entity. The idea of \citeauthor{Hachemeister_75} was to fit to the data a regression model where the parameters are a credibility weighted average of an entity's regression parameters and the group's parameters. In order to use \code{cm} to fit a credibility regression model to a data set, one simply has to supply as additional arguments \code{regformula} and \code{regdata}. The first one is a formula of the form \code{\~{} terms} describing the regression model, and the second is a data frame of regressors. That is, arguments \code{regformula} and \code{regdata} are in every respect equivalent to arguments \code{formula} and \code{data} of \code{lm}, with the minor difference that \code{regformula} does not need to have a left hand side (and is ignored if present). Below, we fit the model \begin{displaymath} X_{it} = \beta_0 + \beta_1 t + \varepsilon_t, \quad t = 1, \dots, 12 \end{displaymath} to the original data set of \cite{Hachemeister_75}. <>= fit <- cm(~state, hachemeister, regformula = ~ time, regdata = data.frame(time = 1:12), ratios = ratio.1:ratio.12, weights = weight.1:weight.12) fit @ To compute the credibility premiums, one has to provide the ``future'' values of the regressors as in \code{predict.lm}. <>= predict(fit, newdata = data.frame(time = 13)) @ It is well known that the basic regression model has a major drawback: there is no guarantee that the credibility regression line will lie between the collective and individual ones. This may lead to grossly inadequate premiums, as Figure~\ref{fig:state4} shows. \begin{figure}[t] \centering <>= plot(NA, xlim = c(1, 13), ylim = c(1000, 2000), xlab = "", ylab = "") x <- cbind(1, 1:12) lines(1:12, x %*% fit$means$portfolio, col = "blue", lwd = 2) lines(1:12, x %*% fit$means$state[, 4], col = "red", lwd = 2, lty = 2) lines(1:12, x %*% coefficients(fit$adj.models[[4]]), col = "darkgreen", lwd = 2, lty = 3) points(13, predict(fit, newdata = data.frame(time = 13))[4], pch = 8, col = "darkgreen") legend("bottomright", legend = c("collective", "individual", "credibility"), col = c("blue", "red", "darkgreen"), lty = 1:3) @ \caption{Collective, individual and credibility regression lines for State 4 of the Hachemeister data set. The point indicates the credibility premium.} \label{fig:state4} \end{figure} The solution proposed by \cite{Buhlmann:regression:1997} is simply to position the intercept not at time origin, but instead at the barycenter of time \citep[see also][Section~8.4]{Buhlmann_Gisler}. In mathematical terms, this essentially amounts to using an orthogonal design matrix. By setting the argument \code{adj.intercept} to \code{TRUE} in the call, \code{cm} will automatically fit the credibility regression model with the intercept at the barycenter of time. The resulting regression coefficients have little meaning, but the predictions are sensible. <>= fit2 <- cm(~state, hachemeister, regformula = ~ time, regdata = data.frame(time = 1:12), adj.intercept = TRUE, ratios = ratio.1:ratio.12, weights = weight.1:weight.12) summary(fit2, newdata = data.frame(time = 13)) @ % Figure~\ref{fig:state4:2} shows the beneficient effect of the intercept adjustment on the premium of State~4. \begin{figure}[t] \centering <>= plot(NA, xlim = c(1, 13), ylim = c(1000, 2000), xlab = "", ylab = "") x <- cbind(1, 1:12) R <- fit2$transition lines(1:12, x %*% solve(R, fit2$means$portfolio), col = "blue", lwd = 2) lines(1:12, x %*% solve(R, fit2$means$state[, 4]), col = "red", lwd = 2, lty = 2) lines(1:12, x %*% solve(R, coefficients(fit2$adj.models[[4]])), col = "darkgreen", lwd = 2, lty = 3) points(13, predict(fit2, newdata = data.frame(time = 13))[4], pch = 8, col = "darkgreen") legend("bottomright", legend = c("collective", "individual", "credibility"), col = c("blue", "red", "darkgreen"), lty = 1:3) @ \caption{Collective, individual and credibility regression lines for State 4 of the Hachemeister data set when the intercept is positioned at the barycenter of time. The point indicates the credibility premium.} \label{fig:state4:2} \end{figure} \section{Linear Bayes model} \label{sec:bayes} In the pure bayesian approach to the ratemaking problem, we assume that the observations $X_t$, $t = 1, \dots, n$, of an entity depend on its risk level $\theta$, and that this risk level is a realization of an unobservable random variable $\Theta$. The best (in the mean square sense) approximation to the unknown risk premium $\mu(\theta) = \E{X_t|\Theta = \theta}$ based on observations $X_1, \dots, X_n$ is the Bayesian premium \begin{equation*} B_{n + 1} = \E{\mu(\Theta)|X_1, \dots, X_n}. \end{equation*} It is then well known \citep{Buhlmann_Gisler,LossModels4e} that for some combinaisons of distributions, the Bayesian premium is linear and can written as a credibility premium \begin{equation*} B_{n + 1} = z \bar{X} + (1 - z) m, \end{equation*} where $m = \E{\mu(\Theta)}$ and $z = n/(n + K)$ for some constant $K$. The combinations of distributions yielding a linear Bayes premium involve members of the univariate exponential family for the distribution of $X|\Theta = \theta$ and their natural conjugate for the distribution of $\Theta$: \begin{itemize} \item $X|\Theta = \theta \sim \text{Poisson}(\theta)$, $\Theta \sim \text{Gamma}(\alpha, \lambda)$; \item $X|\Theta = \theta \sim \text{Exponential}(\theta)$, $\Theta \sim \text{Gamma}(\alpha, \lambda)$; \item $X|\Theta = \theta \sim \text{Normal}(\theta, \sigma^2_2)$, $\Theta \sim \text{Normal}(\mu, \sigma^2_1)$; \item $X|\Theta = \theta \sim \text{Bernoulli}(\theta)$, $\Theta \sim \text{Beta}(a, b)$; \item $X|\Theta = \theta \sim \text{Geometric}(\theta)$, $\Theta \sim \text{Beta}(a, b)$; \end{itemize} and the convolutions \begin{itemize} \item $X|\Theta = \theta \sim \text{Gamma}(\tau, \theta)$, $\Theta \sim \text{Gamma}(\alpha, \lambda)$; \item $X|\Theta = \theta \sim \text{Binomial}(\nu, \theta)$, $\Theta \sim \text{Beta}(a, b)$; \item $X|\Theta = \theta \sim \text{Negative Binomial}(r, \theta)$ and $\Theta \sim \text{Beta}(a, b)$. \end{itemize} \autoref{sec:formulas} provides the complete formulas for the above combinations of distributions. In addition, \citet[section~2.6]{Buhlmann_Gisler} show that if $X|\Theta = \theta \sim \text{Single Parameter Pareto}(\theta, x_0)$ and $\Theta \sim \text{Gamma}(\alpha, \lambda)$, then the Bayesian estimator of parameter $\theta$ --- not of the risk premium! --- is \begin{equation*} \hat{\Theta} = \eta \hat{\theta}^{\text{MLE}} + (1 - \eta) \frac{\alpha}{\lambda}, \end{equation*} where \begin{equation*} \hat{\theta}^{\text{MLE}} = \frac{n}{\sum_{i = 1}^n \ln (X_i/x_0)} \end{equation*} is the maximum likelihood estimator of $\theta$ and \begin{equation*} \eta = \frac{\sum_{i = 1}^n \ln (X_i/x_0)}{% \lambda + \sum_{i = 1}^n \ln (X_i/x_0)} \end{equation*} is a weight not restricted to $(0, 1)$. (See the \code{"distributions"} package vignette for details on the Single Parameter Pareto distribution.) When argument \code{formula} is \code{"bayes"}, function \code{cm} computes pure Bayesian premiums --- or estimator in the Pareto/Gamma case --- for the combinations of distributions above. We identify which by means of argument \code{likelihood} that must be one of % \code{"poisson"}, % \code{"exponential"}, % \code{"gamma"}, % \code{"normal"}, % \code{"bernoulli"}, % \code{"binomial"}, % \code{"geometric"}, % \code{"negative binomial"} or % \code{"pareto"}. % The parameters of the distribution of $X|\Theta = \theta$, if any, and those of the distribution of $\Theta$ are specified using the argument names (and default values) of \code{dgamma}, \code{dnorm}, \code{dbeta}, \code{dbinom}, \code{dnbinom} or \code{dpareto1}, as appropriate. Consider the case where \begin{align*} X|\Theta = \theta &\sim \text{Poisson}(\theta) \\ \Theta &\sim \text{Gamma}(\alpha, \lambda). \end{align*} The posterior distribution of $\Theta$ is \begin{equation*} \Theta|X_1, \dots, X_n \sim \text{Gamma} \left( \alpha + \sum_{t = 1}^n X_t, \lambda + n \right). \end{equation*} Therefore, the Bayesian premium is \begin{align*} B_{n + 1} &= \E{\mu(\Theta)|X_1, \dots, X_n} \\ &= \E{\Theta|X_1, \dots, X_n} \\ &= \frac{\alpha + \sum_{t = 1}^n X_t}{\lambda + n} \\ &= \frac{n}{n + \lambda}\, \bar{X} + \frac{\lambda}{n + \lambda} \frac{\alpha}{\lambda} \\ &= z \bar{X} + (1 - z) m, \end{align*} with $m = \E{\mu(\Theta)} = \E{\Theta} = \alpha/\lambda$ and \begin{equation*} z = \frac{n}{n + K}, \quad K = \lambda. \end{equation*} One may easily check that if $\alpha = \lambda = 3$ and $X_1 = 5, X_2 = 3, X_3 = 0, X_4 = 1, X_5 = 1$, then $B_6 = 1.625$. We obtain the same result using \code{cm}. <>= x <- c(5, 3, 0, 1, 1) fit <- cm("bayes", x, likelihood = "poisson", shape = 3, rate = 3) fit predict(fit) summary(fit) @ \appendix \section{Linear Bayes formulas} \label{sec:formulas} This appendix provides the main linear Bayes credibility results for combinations of a likelihood function member of the univariate exponential family with its natural conjugate. For each combination, we provide, other than the names of the distributions of $X|\Theta = \theta$ and $\Theta$: \begin{itemize} \item the posterior distribution $\Theta|X_1 = x_1, \dots, X_n = x_n$, always of the same type as the prior, only with updated parameters; \item the risk premium $\mu(\theta) = \E{X|\Theta = \theta}$; \item the collective premium $m = \E{\mu(\Theta)}$; \item the Bayesian premium $B_{n+1} = \E{\mu(\Theta)|X_1, \dots, X_n}$, always equal to the collective premium evaluated at the parameters of the posterior distribution; \item the credibility factor when the Bayesian premium is expressed as a credibility premium. \end{itemize} %% Compact Listes à puce compactes et sans puce, justement. \begingroup \setlist[itemize]{label={},leftmargin=0pt,align=left,nosep} \subsection{Bernoulli/beta case} \begin{itemize} \item $X|\Theta = \theta \sim \text{Bernoulli}(\theta)$ \item $\Theta \sim \text{Beta}(a, b)$ \item $\Theta|X_1 = x_1, \dots, X_n = x_n \sim \text{Beta}(\tilde{a}, \tilde{b})$ \begin{align*} \tilde{a} &= a + \sum_{t = 1}^n x_t \\ \tilde{b} &= b + n - \sum_{t = 1}^n x_t \end{align*} \item Risk premium \begin{equation*} \mu(\theta) = \theta \end{equation*} \item Collective premium \begin{equation*} m = \frac{a}{a + b} \end{equation*} \item Bayesian premium \begin{equation*} B_{n + 1} = \frac{a + \sum_{t = 1}^n X_t}{a + b + n} \end{equation*} \item Credibility factor \begin{equation*} z = \frac{n}{n + a + b} \end{equation*} \end{itemize} \subsection{Binomial/beta case} \begin{itemize} \item $X|\Theta = \theta \sim \text{Binomial}(\nu, \theta)$ \item $\Theta \sim \text{Beta}(a, b)$ \item $\Theta|X_1 = x_1, \dots, X_n = x_n \sim \text{Beta}(\tilde{a}, \tilde{b})$ \begin{align*} \tilde{a} &= a + \sum_{t = 1}^n x_t \\ \tilde{b} &= b + n \nu - \sum_{t = 1}^n x_t \end{align*} \item Risk premium \begin{equation*} \mu(\theta) = \nu \theta \end{equation*} \item Collective premium \begin{equation*} m = \frac{\nu a}{a + b} \end{equation*} \item Bayesian premium \begin{equation*} B_{n + 1} = \frac{\nu (a + \sum_{t = 1}^n X_t)}{a + b + n \nu} \end{equation*} \item Credibility factor \begin{equation*} z = \frac{n}{n + (a + b)/\nu} \end{equation*} \end{itemize} \subsection{Geometric/Beta case} \begin{itemize} \item $X|\Theta = \theta \sim \text{Geometric}(\theta)$ \item $\Theta \sim \text{Beta}(a, b)$ \item $\Theta|X_1 = x_1, \dots, X_n = x_n \sim \text{Beta}(\tilde{a}, \tilde{b})$ \begin{align*} \tilde{a} &= a + n \\ \tilde{b} &= b + \sum_{t = 1}^n x_t \end{align*} \item Risk premium \begin{equation*} \mu(\theta) = \frac{1 - \theta}{\theta} \end{equation*} \item Collective premium \begin{equation*} m = \frac{b}{a - 1} \end{equation*} \item Bayesian premium \begin{equation*} B_{n + 1} = \frac{b + \sum_{t = 1}^n X_t}{a + n - 1} \end{equation*} \item Credibility factor \begin{equation*} z = \frac{n}{n + a - 1} \end{equation*} \end{itemize} \subsection{Negative binomial/Beta case} \begin{itemize} \item $X|\Theta = \theta \sim \text{Negative binomial}(r, \theta)$ \item $\Theta \sim \text{Beta}(a, b)$ \item $\Theta|X_1 = x_1, \dots, X_n = x_n \sim \text{Beta}(\tilde{a}, \tilde{b})$ \begin{align*} \tilde{a} &= a + n r \\ \tilde{b} &= b + \sum_{t = 1}^n x_t \end{align*} \item Risk premium \begin{equation*} \mu(\theta) = \frac{r (1 - \theta)}{\theta} \end{equation*} \item Collective premium \begin{equation*} m = \frac{r b}{a - 1} \end{equation*} \item Bayesian premium \begin{equation*} B_{n + 1} = \frac{r (b + \sum_{t = 1}^n X_t)}{a + n r - 1} \end{equation*} \item Credibility factor \begin{equation*} z = \frac{n}{n + (a - 1)/r} \end{equation*} \end{itemize} \subsection{Poisson/Gamma case} \begin{itemize} \item $X|\Theta = \theta \sim \text{Poisson}(\theta)$ \item $\Theta \sim \text{Gamma}(\alpha, \lambda)$ \item $\Theta|X_1 = x_1, \dots, X_n = x_n \sim \text{Gamma}(\tilde{\alpha}, \tilde{\lambda})$ \begin{align*} \tilde{\alpha} &= \alpha + \sum_{t = 1}^n x_t \\ \tilde{\lambda} &= \lambda + n \end{align*} \item Risk premium \begin{equation*} \mu(\theta) = \theta \end{equation*} \item Collective premium \begin{equation*} m = \frac{\alpha}{\lambda} \end{equation*} \item Bayesian premium \begin{equation*} B_{n + 1} = \frac{\alpha + \sum_{t = 1}^n X_t}{\lambda + n} \end{equation*} \item Credibility factor \begin{equation*} z = \frac{n}{n + \lambda} \end{equation*} \end{itemize} \subsection{Exponential/Gamma case} \begin{itemize} \item $X|\Theta = \theta \sim \text{Exponential}(\theta)$ \item $\Theta \sim \text{Gamma}(\alpha, \lambda)$ \item $\Theta|X_1 = x_1, \dots, X_n = x_n \sim \text{Gamma}(\tilde{\alpha}, \tilde{\lambda})$ \begin{align*} \tilde{\alpha} &= \alpha + n \\ \tilde{\lambda} &= \lambda + \sum_{t = 1}^n x_t \end{align*} \item Risk premium \begin{equation*} \mu(\theta) = \frac{1}{\theta} \end{equation*} \item Collective premium \begin{equation*} m = \frac{\lambda}{\alpha - 1} \end{equation*} \item Bayesian premium \begin{equation*} B_{n + 1} = \frac{\lambda + \sum_{t = 1}^n X_t}{\alpha + n - 1} \end{equation*} \item Credibility factor \begin{equation*} z = \frac{n}{n + \alpha - 1} \end{equation*} \end{itemize} \subsection{Gamma/Gamma case} \begin{itemize} \item $X|\Theta = \theta \sim \text{Gamma}(\tau, \theta)$ \item $\Theta \sim \text{Gamma}(\alpha, \lambda)$ \item $\Theta|X_1 = x_1, \dots, X_n = x_n \sim \text{Gamma}(\tilde{\alpha}, \tilde{\lambda})$ \begin{align*} \tilde{\alpha} &= \alpha + n \tau \\ \tilde{\lambda} &= \lambda + \sum_{t = 1}^n x_t \end{align*} \item Risk premium \begin{equation*} \mu(\theta) = \frac{\tau}{\theta} \end{equation*} \item Collective premium \begin{equation*} m = \frac{\tau \lambda}{\alpha - 1} \end{equation*} \item Bayesian premium \begin{equation*} B_{n + 1} = \frac{\tau (\lambda + \sum_{t = 1}^n X_t)}{\alpha + n \tau - 1} \end{equation*} \item Credibility factor \begin{equation*} z = \frac{n}{n + (\alpha - 1)/\tau} \end{equation*} \end{itemize} \subsection{Normal/Normal case} \begin{itemize} \item $X|\Theta = \theta \sim \text{Normal}(\theta, \sigma_2^2)$ \item $\Theta \sim \text{Normal}(\mu, \sigma_1^2)$ \item $\Theta|X_1 = x_1, \dots, X_n = x_n \sim \text{Normal}(\tilde{\mu}, \tilde{\sigma}_1^2)$ \begin{align*} \tilde{\mu} &= \frac{\sigma_1^2 \sum_{t = 1}^n x_t + \sigma_2^2 \mu}{n \sigma_1^2 + \sigma_2^2} \\ \tilde{\sigma}_1^2 &= \frac{\sigma_1^2 \sigma_2^2}{n \sigma_1^2 + \sigma_2^2} \end{align*} \item Risk premium \begin{equation*} \mu(\theta) = \theta \end{equation*} \item Collective premium \begin{equation*} m = \mu \end{equation*} \item Bayesian premium \begin{equation*} B_{n + 1} = \frac{\sigma_1^2 \sum_{t = 1}^n X_t + \sigma_2^2 \mu}{n \sigma_1^2 + \sigma_2^2} \end{equation*} \item Credibility factor \begin{equation*} z = \frac{n}{n + \sigma_2^2/\sigma_1^2} \end{equation*} \end{itemize} \endgroup \bibliography{actuar} \end{document} %%% Local Variables: %%% mode: noweb %%% TeX-master: t %%% coding: utf-8 %%% End: actuar/inst/doc/actuar.Rnw0000644000176200001440000000503414370340204015221 0ustar liggesusers\input{share/preamble} %\VignetteIndexEntry{Introduction to actuar} %\VignettePackage{actuar} %\SweaveUTF8 \title{Introduction to \pkg{actuar}} \author{Christophe Dutang \\ Université Paris Dauphine \\[3ex] Vincent Goulet \\ Université Laval \\[3ex] Mathieu Pigeon \\ Université du Québec à Montréal} \date{} \begin{document} \maketitle \section{Introduction} \label{sec:introduction} \pkg{actuar} \citep{actuar} provides additional actuarial science functionality and support for heavy tailed distributions to the R statistical system. The project was officially launched in 2005 and is under active development. The current feature set of the package can be split into five main categories: additional probability distributions; loss distributions modeling; risk and ruin theory; simulation of compound hierarchical models; credibility theory. Furthermore, starting with version 3.0-0, \pkg{actuar} gives easy access to many of its underlying C workhorses through an API. As much as possible, the developers have tried to keep the ``user interface'' of the various functions of the package consistent. Moreover, the package follows the general R philosophy of working with model objects. This means that instead of merely returning, say, a vector of probabilities, many functions will return an object containing, among other things, the said probabilities. The object can then be manipulated at one's will using various extraction, summary or plotting functions. \section{Documentation} In addition to the help pages, \pkg{actuar} ships with extensive vignettes and demonstration scripts; run the following commands at the R prompt to obtain the list of each. <>= vignette(package = "actuar") demo(package = "actuar") @ \section{Collaboration and citation} If you use R or \pkg{actuar} for actuarial analysis, please cite the software in publications. For information on how to cite the software, use: <>= citation() citation("actuar") @ \section*{Acknowledgments} The package would not be at this stage of development without the stimulating contribution of Sébastien Auclair, Christophe Dutang, Nicholas Langevin, Xavier Milhaud, Tommy Ouellet and Louis-Philippe Pouliot. This research benefited from financial support from the Natural Sciences and Engineering Research Council of Canada and from the \emph{Chaire d'actuariat} (Actuarial Science Foundation) of Université Laval. \bibliography{actuar} \end{document} %%% Local Variables: %%% mode: noweb %%% TeX-master: t %%% coding: utf-8 %%% End: actuar/inst/doc/simulation.R0000644000176200001440000001107414522557740015600 0ustar liggesusers### R code from vignette source 'simulation.Rnw' ################################################### ### code chunk number 1: simulation.Rnw:14-16 ################################################### library(actuar) options(width = 52, digits = 4) ################################################### ### code chunk number 2: simulation.Rnw:84-86 ################################################### rmixture(10, probs = c(2, 1), models = expression(rexp(3), rexp(7))) ################################################### ### code chunk number 3: simulation.Rnw:139-141 ################################################### rcompound(10, rpois(1.5), rgamma(3, 2)) rcomppois(10, 1.5, rgamma(3, 2)) ################################################### ### code chunk number 4: simulation.Rnw:147-148 ################################################### rcomppois(10, 1.5, rgamma(3, 2), SIMPLIFY = FALSE) ################################################### ### code chunk number 5: simulation.Rnw:180-185 ################################################### x <- rcomppois(1e5, 3.5, rmixture(probs = c(2, 1, 0.5), expression(rgamma(3), rgamma(5, 4), rlnorm(2, 1)))) ################################################### ### code chunk number 6: simulation.Rnw:191-192 ################################################### mean(x) ################################################### ### code chunk number 7: simulation.Rnw:225-226 (eval = FALSE) ################################################### ## rpois(n, rgamma(n, 3, rgamma(n, 2, 2))) ################################################### ### code chunk number 8: simulation.Rnw:398-399 ################################################### set.seed(3) ################################################### ### code chunk number 9: simulation.Rnw:401-414 ################################################### nodes <- list(cohort = 2, contract = c(4, 3), year = c(4, 4, 4, 4, 5, 5, 5)) mf <- expression(cohort = rexp(2), contract = rgamma(cohort, 1), year = rpois(weights * contract)) ms <- expression(cohort = rnorm(2, sqrt(0.1)), contract = rnorm(cohort, 1), year = rlnorm(contract, 1)) wijt <- runif(31, 0.5, 2.5) pf <- rcomphierarc(nodes = nodes, model.freq = mf, model.sev = ms, weights = wijt) ################################################### ### code chunk number 10: simulation.Rnw:421-424 ################################################### class(pf) pf$data pf$classification ################################################### ### code chunk number 11: simulation.Rnw:436-437 ################################################### pf ################################################### ### code chunk number 12: simulation.Rnw:445-447 ################################################### aggregate(pf) aggregate(pf, by = c("cohort", "year"), FUN = mean) ################################################### ### code chunk number 13: simulation.Rnw:454-456 ################################################### frequency(pf) frequency(pf, by = "cohort") ################################################### ### code chunk number 14: simulation.Rnw:472-474 ################################################### severity(pf) severity(pf, splitcol = 1) ################################################### ### code chunk number 15: simulation.Rnw:479-480 ################################################### weights(pf) ################################################### ### code chunk number 16: simulation.Rnw:485-486 ################################################### aggregate(pf, classif = FALSE) / weights(pf, classif = FALSE) ################################################### ### code chunk number 17: simulation.Rnw:514-515 ################################################### set.seed(123) ################################################### ### code chunk number 18: simulation.Rnw:517-519 ################################################### wit <- rgamma(15, rep(runif(3, 0, 100), each = 5), rep(runif(3, 0, 100), each = 5)) ################################################### ### code chunk number 19: simulation.Rnw:527-532 ################################################### frequency(rcomphierarc(list(entity = 3, year = 5), expression(entity = rgamma(rgamma(1, 5, 5), rgamma(1, 25, 1)), year = rpois(weights * entity)), weights = wit)) actuar/inst/doc/distributions.Rnw0000644000176200001440000017461714370340204016662 0ustar liggesusers\input{share/preamble} %\VignetteIndexEntry{Additional continuous and discrete distributions} %\VignettePackage{actuar} %\SweaveUTF8 \title{Inventory of continuous and discrete distributions in \pkg{actuar}} \author{Christophe Dutang \\ Université Paris Dauphine \\[3ex] Vincent Goulet \\ Université Laval \\[3ex] Nicholas Langevin \\ Université Laval \\[3ex] Mathieu Pigeon \\ Université du Québec à Montréal} \date{} %% Compact, sans label itemize environment for the appendices. \setlist[itemize]{label={},leftmargin=0pt,align=left,nosep,midpenalty=10000} \begin{document} \maketitle \section{Introduction} \label{sec:introduction} R includes functions to compute the probability density function (pdf) or the probability mass function (pmf), the cumulative distribution function (cdf) and the quantile function, as well as functions to generate variates from a fair number of continuous and discrete distributions. For some root \code{foo}, the support functions are named \code{dfoo}, \code{pfoo}, \code{qfoo} and \code{rfoo}, respectively. Package \pkg{actuar} provides \code{d}, \code{p}, \code{q} and \code{r} functions for a large number of continuous size distributions useful for loss severity modeling; for phase-type distributions used in computation of ruin probabilities; for zero-truncated and zero-modified extensions of the discrete distributions commonly used in loss frequency modeling; for the heavy tailed Poisson-inverse Gaussian discrete distribution. The package also introduces support functions to compute raw moments, limited moments and the moment generating function (when it exists) of continuous distributions. \section{Additional continuous size distributions} \label{sec:continuous} The package provides support functions for all the probability distributions found in Appendix~A of \citet{LossModels4e} and not already present in base R, excluding the log-$t$, but including the loggamma distribution \citep{HoggKlugman}, as well as for the Feller--Pareto distribution and related Pareto distributions with a location parameter \citep{Arnold:pareto:2ed}. These distributions mostly fall under the umbrella of extreme value or heavy tailed distributions. \autoref{tab:continuous} lists the distributions supported by \pkg{actuar} along with the root names of the R functions. \autoref{sec:app:continuous} details the formulas implemented and the name of the argument corresponding to each parameter. By default, all functions (except those for the Pareto distribution) use a rate parameter equal to the inverse of the scale parameter. This differs from \citet{LossModels4e} but is better in line with the functions for the gamma, exponential and Weibull distributions in base R. \begin{table} \centering \begin{tabular}{lll} \toprule Family & Distribution & Root \\ \midrule Feller--Pareto & Feller--Pareto & \code{fpareto} \\ & Pareto IV & \code{pareto4} \\ & Pareto III & \code{pareto3} \\ & Pareto II & \code{pareto2} \\ & Transformed beta & \code{trbeta} \\ & Burr & \code{burr} \\ & Loglogistic & \code{llogis} \\ & Paralogistic & \code{paralogis} \\ & Generalized Pareto & \code{genpareto} \\ & Pareto & \code{pareto} \\ & Single-parameter Pareto & \code{pareto1} \\ & Inverse Burr & \code{invburr} \\ & Inverse Pareto & \code{invpareto} \\ & Inverse paralogistic & \code{invparalogis} \\ \midrule Transformed gamma & Transformed gamma & \code{trgamma} \\ & Inverse transformed gamma & \code{invtrgamma} \\ & Inverse gamma & \code{invgamma} \\ & Inverse Weibull & \code{invweibull} \\ & Inverse exponential & \code{invexp} \\ \midrule Other & Loggamma & \code{lgamma} \\ & Gumbel & \code{gumbel} \\ & Inverse Gaussian & \code{invgauss} \\ & Generalized beta & \code{genbeta} \\ \bottomrule \end{tabular} \caption{Probability distributions supported by \pkg{actuar} classified by family and root names of the R functions.} \label{tab:continuous} \end{table} We mostly use the nomenclature of \citet{LossModels4e} to classify the continuous distributions supported by \pkg{actuar}. However, following \citet{Arnold:pareto:2ed}, we regroup distributions of the transformed beta family and variants of the Pareto distribution inside the larger Feller--Pareto family of distributions. \autoref{fig:diagram:fp-family} shows the relationships between the distributions of the Feller--Pareto and transformed beta families. \autoref{fig:diagram:trgamma-family} does the same for the distributions of the transformed gamma and inverse transformed gamma families. \begin{figure} \centering \setlength{\unitlength}{0.7cm} \begin{picture}(16.9,10.75)(-0.7,-0.4) \small % Flèches \put(8,6){\vector(2,-1){3.7}} % trbeta -> invburr \put(13,4.2){\vector(0,1){0.95}} % invburr -> invparalogis \put(11.7,3.1){\line(-1,-1){1}} \put(10.7,2.1){\line(-1,0){7.7}} \put(3,2.1){\vector(-1,-1){1.1}} % invburr -> llogis \put(13,3){\vector(0,-1){2}} % invburr -> invpareto \put(2.05,3.1){\vector(2,-1){4.2}} % burr -> pareto \put(1,3){\vector(0,-1){2}} % burr -> llogis \put(6,6){\vector(-2,-1){3.85}} % trbeta -> burr \put(1,4.2){\vector(0,1){0.95}} % burr -> paralogis \put(7,6){\vector(0,-1){1.8}} % trbeta -> genpareto \put(7,9){\vector(0,-1){1.8}} % fpareto -> trbeta \put(7,3){\vector(0,-1){2}} % genpareto -> pareto \put(8,3){\vector(2,-1){4}} % genpareto -> invpareto % \put(6,9){\vector(-2,-1){3.3}} % fpareto -> pareto3 % \put(8,9){\vector(2,-1){3.3}} % fpareto -> pareto1 \put(1,9){\vector(0,-1){1.1}} % pareto4 -> pareto3 \put(13,9){\vector(0,-1){1.1}} % pareto2 -> pareto1 \put(4.5,9.6){\vector(-1,0){1.75}} % fpareto -> pareto4 \put(9.5,9.6){\vector(1,0){1.75}} % fpareto -> pareto2 \put(14.7,9.6){\line(1,0){1.5}} % pareto2 -> pareto \put(16.2,9.6){\line(0,-1){10}} \put(16.2,-0.4){\line(-1,0){7.5}} \put(8.7,-0.4){\vector(-2,1){0.72}} \put(14.8,9.62){\makebox(0,0.5)[l]{$\mu = 0$}} \put(7,9.65){\makebox(0,0.5)[c]{Feller-Pareto}} \put(7,9.1){\makebox(0,0.5)[c]{$\mu, \alpha, \gamma, \tau, \theta$}} \put(7,9.6){\oval(5,1.2)} \put(3.2,9.65){\makebox(0,0.5)[l]{$\tau = 1$}} \put(1,9.65){\makebox(0,0.5)[c]{Pareto IV}} \put(1,9.1){\makebox(0,0.5)[c]{$\mu, \alpha, \gamma, \theta$}} \put(1,9.6){\oval(3.4,1.2)} \put(9.8,9.05){\makebox(0,0.5)[l]{$\gamma = 1$}} \put(9.8,9.65){\makebox(0,0.5)[l]{$\tau = 1$}} \put(13,9.65){\makebox(0,0.5)[c]{Pareto II}} \put(13,9.1){\makebox(0,0.5)[c]{$\mu,\alpha, \theta$}} \put(13,9.6){\oval(3.4,1.2)} \put(0.8,8.3){\makebox(0,0.5)[r]{$\alpha = 1$}} \put(1,7.35){\makebox(0,0.5)[c]{Pareto III}} \put(1,6.8){\makebox(0,0.5)[c]{$\mu, \gamma, \theta$}} \put(1,7.3){\oval(3.4,1.2)} \put(13.2,8.3){\makebox(0,0.5)[l]{$\mu = \theta$}} \put(13,7.35){\makebox(0,0.5)[c]{Pareto I}} \put(13,6.8){\makebox(0,0.5)[c]{$\alpha, \theta$}} \put(13,7.3){\oval(3.4,1.2)} \put(7.2,7.9){\makebox(0,0.5)[l]{$\mu = 0$}} \put(7,6.65){\makebox(0,0.5)[c]{Transformed beta}} \put(7,6.1){\makebox(0,0.5)[c]{$\alpha, \gamma, \tau, \theta$}} \put(7,6.6){\oval(5,1.2)} \put(9.2,5.4){\rotatebox{-26.6}{\makebox(0,0.5)[l]{$\alpha = 1$}}} \put(13.20,3.65){\makebox(0,0.5)[c]{Inverse Burr}} \put(13.20,3.1){\makebox(0,0.5)[c]{$\gamma, \tau, \theta$}} \put(13.20,3.6){\oval(3.4,1.2)} \put(13.2,4.3){\makebox(0,0.5)[l]{$\gamma = \tau$}} \put(13.20,5.80){\makebox(0,0.5)[c]{Inverse paralogistic}} \put(13.20,5.25){\makebox(0,0.5)[c]{$\tau, \theta$}} \put(13.20,5.75){\oval(5.4,1.2)} \put(13.2,1.9){\makebox(0,0.5)[l]{$\gamma = 1$}} \put(13.20,0.45){\makebox(0,0.5)[c]{Inverse Pareto}} \put(13.20,-0.1){\makebox(0,0.5)[c]{$\tau, \theta$}} \put(13.20,0.4){\oval(3.9,1.2)} \put(7.2,4.9){\makebox(0,0.5)[l]{$\gamma = 1$}} \put(7,3.65){\makebox(0,0.5)[c]{Generalized Pareto}} \put(7,3.1){\makebox(0,0.5)[c]{$\alpha, \tau, \theta$}} \put(7,3.6){\oval(4.9,1.2)} \put(7.2,1.25){\makebox(0,0.5)[l]{$\tau = 1$}} \put(7,0.45){\makebox(0,0.5)[c]{Pareto}} \put(7,-0.1){\makebox(0,0.5)[c]{$\alpha, \theta$}} \put(7,0.4){\oval(2.2,1.2)} \put(4.5,5.4){\rotatebox{26.6}{\makebox(0,0.5)[r]{$\tau = 1$}}} \put(1,3.65){\makebox(0,0.5)[c]{Burr}} \put(1,3.1){\makebox(0,0.5)[c]{$\alpha, \gamma, \theta$}} \put(1,3.6){\oval(2.5,1.2)} \put(0.8,4.3){\makebox(0,0.5)[r]{$\gamma = \alpha$}} \put(1,5.80){\makebox(0,0.5)[c]{Paralogistic}} \put(1,5.25){\makebox(0,0.5)[c]{$\alpha, \theta$}} \put(1,5.75){\oval(3.4,1.2)} \put(0.8,1.9){\makebox(0,0.5)[r]{$\alpha = 1$}} \put(1,0.45){\makebox(0,0.5)[c]{Loglogistic}} \put(1,-0.1){\makebox(0,0.5)[c]{$\gamma, \theta$}} \put(1,0.4){\oval(3.4,1.2)} \put(9.8,2.1){\rotatebox{-26.6}{\makebox(0,0.5)[r]{$\alpha = 1$}}} \put(4.0,2.1){\rotatebox{-26.6}{\makebox(0,0.5)[r]{$\gamma = 1$}}} \put(11.25,3.0){\rotatebox{45}{\makebox(0,0.5)[r]{$\tau = 1$}}} \end{picture} \caption{Interrelations between distributions of the Feller--Pareto family. This diagram is an extension of Figure~5.2 of \citet{LossModels4e}.} \label{fig:diagram:fp-family} \end{figure} \begin{figure} \setlength{\unitlength}{0.7cm} \begin{picture}(7.5,5.2)(-0.25,0) \small % Flèches \put(4,4){\vector(2,-1){1.55}} % trgamma -> weibull \put(5.55,2){\vector(-2,-1){1.55}} % weibull -> exp \put(1.55,2){\vector(2,-1){1.55}} % gamma -> exp \put(3,4){\vector(-2,-1){1.55}} % trgamma -> gamma \put(3.5,4.65){\makebox(0,0.5)[c]{Transformed gamma}} \put(3.5,4.1){\makebox(0,0.5)[c]{$\alpha, \tau, \lambda$}} \put(3.5,4.6){\oval(5.5,1.2)} \put(5.4,3.45){\makebox(0,0.5)[l]{$\alpha = 1$}} \put(6,2.65){\makebox(0,0.5)[c]{Weibull}} \put(6,2.1){\makebox(0,0.5)[c]{$\tau, \lambda$}} \put(6,2.6){\oval(2.5,1.2)} \put(5.4,1.35){\makebox(0,0.5)[l]{$\tau = 1$}} \put(3.5,0.65){\makebox(0,0.5)[c]{Exponential}} \put(3.5,0.1){\makebox(0,0.5)[c]{$\lambda$}} \put(3.5,0.6){\oval(3.5,1.2)} \put(1.6,1.35){\makebox(0,0.5)[r]{$\alpha = 1$}} \put(1,2.65){\makebox(0,0.5)[c]{Gamma}} \put(1,2.1){\makebox(0,0.5)[c]{$\alpha, \lambda$}} \put(1,2.6){\oval(2.5,1.2)} \put(1.6,3.45){\makebox(0,0.5)[r]{$\tau = 1$}} \end{picture} \hfill \begin{picture}(8.75,5.2)(-0.875,0) \small % Flèches \put(4,4){\vector(2,-1){1.55}} % trgamma -> weibull \put(5.55,2){\vector(-2,-1){1.55}} % weibull -> exp \put(1.55,2){\vector(2,-1){1.55}} % gamma -> exp \put(3,4){\vector(-2,-1){1.55}} % trgamma -> gamma \put(3.5,4.65){\makebox(0,0.5)[c]{Inverse transformed gamma}} \put(3.5,4.1){\makebox(0,0.5)[c]{$\alpha, \tau, \lambda$}} \put(3.5,4.6){\oval(7,1.2)} \put(5.4,3.45){\makebox(0,0.5)[l]{$\alpha = 1$}} \put(6,2.65){\makebox(0,0.5)[c]{Inverse Weibull}} \put(6,2.1){\makebox(0,0.5)[c]{$\tau, \lambda$}} \put(6,2.6){\oval(4,1.2)} \put(5.4,1.35){\makebox(0,0.5)[l]{$\tau = 1$}} \put(3.5,0.65){\makebox(0,0.5)[c]{Inverse exponential}} \put(3.5,0.1){\makebox(0,0.5)[c]{$\lambda$}} \put(3.5,0.6){\oval(5,1.2)} \put(1.6,1.35){\makebox(0,0.5)[r]{$\alpha = 1$}} \put(1,2.65){\makebox(0,0.5)[c]{Inverse gamma}} \put(1,2.1){\makebox(0,0.5)[c]{$\alpha, \lambda$}} \put(1,2.6){\oval(4,1.2)} \put(1.6,3.45){\makebox(0,0.5)[r]{$\tau = 1$}} \end{picture} \caption{Interrelations between distributions of the transformed gamma and inverse transformed gamma families. Diagrams derived from Figure~5.3 of \citet{LossModels4e}.} \label{fig:diagram:trgamma-family} \end{figure} In addition to the \code{d}, \code{p}, \code{q} and \code{r} functions, \pkg{actuar} introduces \code{m}, \code{lev} and \code{mgf} functions to compute, respectively, the theoretical raw moments \begin{equation*} m_k = \E{X^k}, \end{equation*} the theoretical limited moments \begin{equation*} \E{(X \wedge x)^k} = \E{\min(X, x)^k} \end{equation*} and the moment generating function \begin{equation*} M_X(t) = \E{e^{tX}}, \end{equation*} when it exists. Every distribution of \autoref{tab:continuous} is supported, along with the following distributions of base R: beta, exponential, chi-square, gamma, lognormal, normal (no \code{lev}), uniform and Weibull. The \code{m} and \code{lev} functions are especially useful for estimation methods based on the matching of raw or limited moments; see the \code{lossdist} vignette for their empirical counterparts. The \code{mgf} functions come in handy to compute the adjustment coefficient in ruin theory; see the \code{risk} vignette. \section{Phase-type distributions} \label{sec:phase-type} In addition to the 19 distributions of \autoref{tab:continuous}, the package provides support for a family of distributions deserving a separate presentation. Phase-type distributions \citep{Neuts_81} are defined as the distribution of the time until absorption of continuous time, finite state Markov processes with $m$ transient states and one absorbing state. Let \begin{equation} \label{eq:Markov-transition-matrix} \mat{Q} = \begin{bmatrix} \mat{T} & \mat{t} \\ \mat{0} & 0 \end{bmatrix} \end{equation} be the transition rates matrix (or intensity matrix) of such a process and let $(\mat{\pi}, \pi_{m + 1})$ be the initial probability vector. Here, $\mat{T}$ is an $m \times m$ non-singular matrix with $t_{ii} < 0$ for $i = 1, \dots, m$ and $t_{ij} \geq 0$ for $i \neq j$, $\mat{t} = - \mat{T} \mat{e}$ and $\mat{e}$ is a column vector with all components equal to 1. Then the cdf of the time until absorption random variable with parameters $\mat{\pi}$ and $\mat{T}$ is \begin{equation} \label{eq:cdf-phtype} F(x) = \begin{cases} \pi_{m + 1}, & x = 0, \\ 1 - \mat{\pi} e^{\mat{T} x} \mat{e}, & x > 0, \end{cases} \end{equation} where \begin{equation} \label{eq:matrix-exponential} e^{\mat{M}} = \sum_{n = 0}^\infty \frac{\mat{M}^n}{n!} \end{equation} is the matrix exponential of matrix $\mat{M}$. The exponential distribution, the Erlang (gamma with integer shape parameter) and discrete mixtures thereof are common special cases of phase-type distributions. The package provides \code{d}, \code{p}, \code{r}, \code{m} and \code{mgf} functions for phase-type distributions. The root is \code{phtype} and parameters $\mat{\pi}$ and $\mat{T}$ are named \code{prob} and \code{rates}, respectively; see also \autoref{sec:app:phase-type}. For the package, function \code{pphtype} is central to the evaluation of the ruin probabilities; see \code{?ruin} and the \code{risk} vignette. \section{Extensions to standard discrete distributions} \label{sec:discrete} The package introduces support functions for counting distributions commonly used in loss frequency modeling. A counting distribution is a discrete distribution defined on the non-negative integers $0, 1, 2, \dots$. Let $N$ be the counting random variable. We denote $p_k$ the probability that the random variable $N$ takes the value $k$, that is: \begin{equation*} p_k = \Pr[N = k]. \end{equation*} \citet{LossModels4e} classify counting distributions in two main classes. First, a discrete random variable is a member of the $(a, b, 0)$ class of distributions if there exists constants $a$ and $b$ such that \begin{equation*} \frac{p_k}{p_{k - 1}} = a + \frac{b}{k}, \quad k = 1, 2, \dots. \end{equation*} The probability at zero, $p_0$, is set such that $\sum_{k = 0}^\infty p_k = 1$. The members of this class are the Poisson, the binomial, the negative binomial and its special case, the geometric. These distributions are all well supported in base R with \code{d}, \code{p}, \code{q} and \code{r} functions. The second class of distributions is the $(a, b, 1)$ class. A discrete random variable is a member of the $(a, b, 1)$ class of distributions if there exists constants $a$ and $b$ such that \begin{equation*} \frac{p_k}{p_{k - 1}} = a + \frac{b}{k}, \quad k = 2, 3, \dots. \end{equation*} One will note that recursion starts at $k = 2$ for the $(a, b, 1)$ class. Therefore, the probability at zero can be any arbitrary number $0 \leq p_0 \leq 1$. Setting $p_0 = 0$ defines a subclass of so-called \emph{zero-truncated} distributions. The members of this subclass are the zero-truncated Poisson, the zero-truncated binomial, the zero-truncated negative binomial and the zero-truncated geometric. Let $p_k^T$ denote the probability mass in $k$ for a zero-truncated distribution. As above, $p_k$ denotes the probability mass for the corresponding member of the $(a, b, 0)$ class. We have \begin{equation*} p_k^T = \begin{cases} 0, & k = 0 \\ \displaystyle\frac{p_k}{1 - p_0}, & k = 1, 2, \dots. \end{cases} \end{equation*} Moreover, let $P(k)$ denotes the cumulative distribution function of a member of the $(a, b, 0)$ class. Then the cdf $P^T(k)$ of the corresponding zero-truncated distribution is \begin{equation*} P^T(k) = \frac{P(k) - P(0)}{1 - P(0)} = \frac{P(k) - p_0}{1 - p_0} \end{equation*} for all $k = 0, 1, 2, \dots$. Alternatively, the survival function $\bar{P}^T(k) = 1 - P^T(k)$ is \begin{equation*} \bar{P}^T(k) = \frac{\bar{P}(k)}{\bar{P}(0)} = \frac{\bar{P}(k)}{1 - p_0}. \end{equation*} Package \pkg{actuar} provides \code{d}, \code{p}, \code{q} and \code{r} functions for the all the zero-truncated distributions mentioned above. \autoref{tab:discrete} lists the root names of the functions; see \autoref{sec:app:discrete} for additional details. \begin{table} \centering \begin{tabular}{ll} \toprule Distribution & Root \\ \midrule Zero-truncated Poisson & \code{ztpois} \\ Zero-truncated binomial & \code{ztbinom} \\ Zero-truncated negative binomial & \code{ztnbinom} \\ Zero-truncated geometric & \code{ztgeom} \\ Logarithmic & \code{logarithmic} \\ \addlinespace[6pt] Zero-modified Poisson & \code{zmpois} \\ Zero-modified binomial & \code{zmbinom} \\ Zero-modified negative binomial & \code{zmnbinom} \\ Zero-modified geometric & \code{zmgeom} \\ Zero-modified logarithmic & \code{zmlogarithmic} \\ \bottomrule \end{tabular} \caption{Members of the $(a, b, 1)$ class of discrete distributions supported by \pkg{actuar} and root names of the R functions.} \label{tab:discrete} \end{table} An entry of \autoref*{tab:discrete} deserves a few additional words. The logarithmic (or log-series) distribution with parameter $\theta$ has pmf \begin{equation*} p_k = \frac{a \theta^x}{k}, \quad k = 1, 2, \dots, \end{equation*} with $a = -1/\log(1 - \theta)$ and for $0 \leq \theta < 1$. This is the standard parametrization in the literature \citep{Johnson:discrete:2005}. The logarithmic distribution is always defined on the strictly positive integers. As such, it is not qualified as ``zero-truncated'', but it nevertheless belongs to the $(a, b, 1)$ class of distributions, more specifically to the subclass with $p_0 = 0$. Actually, the logarithmic distribution is the limiting case of the zero-truncated negative binomial distribution with size parameter equal to zero and $\theta = 1 - p$, where $p$ is the probability of success for the zero-truncated negative binomial. Note that this differs from the presentation in \citet{LossModels4e}. Another subclass of the $(a, b, 1)$ class of distributions is obtained by setting $p_0$ to some arbitrary number $p_0^M$ subject to $0 < p_0^M \leq 1$. The members of this subclass are called \emph{zero-modified} distributions. Zero-modified distributions are discrete mixtures between a degenerate distribution at zero and the corresponding distribution from the $(a, b, 0)$ class. Let $p_k^M$ and $P^M(k)$ denote the pmf and cdf of a zero-modified distribution. Written as a mixture, the pmf is \begin{equation} \label{eq:mixture} p_k^M = \left(1 - \frac{1 - p_0^M}{1 - p_0} \right) \mathbb{1}_{\{k = 0\}} + \frac{1 - p_0^M}{1 - p_0}\, p_k. \end{equation} Alternatively, we have \begin{equation*} p_k^M = \begin{cases} p_0^M, & k = 0 \\ \displaystyle\frac{1 - p_0^M}{1 - p_0}\, p_k, & k = 1, 2, \dots \end{cases} \end{equation*} and \begin{align*} P^M(k) &= p_0^M + (1 - p_0^M) \frac{P(k) - P(0)}{1 - P(0)} \\ &= p_0^M + \frac{1 - p_0^M}{1 - p_0}\, (P(k) - p_0) \\ &= p_0^M + (1 - p_0^M)\, P^T(k) \end{align*} for all $k = 0, 1, 2, \dots$. The survival function is \begin{equation*} \bar{P}^M(k) = (1 - p_0^M)\, \frac{\bar{P}(k)}{\bar{P}(0)} = \frac{1 - p_0^M}{1 - p_0}\, \bar{P}(k) = (1 - p_0^M)\, \bar{P}^T(k). \end{equation*} Therefore, we can also write the pmf of a zero-modified distribution as a mixture of a degenerate distribution at zero and the corresponding zero-truncated distribution: \begin{equation} \label{eq:mixture:alt} p_k^M = p_0^M \mathbb{1}_{\{k = 0\}} + (1 - p_0^M)\, p_k^T. \end{equation} The members of the subclass are the zero-modified Poisson, zero-modified binomial, zero-modified negative binomial and zero-modified geometric, together with the zero-modified logarithmic as a limiting case of the zero-modified negative binomial. \autoref{tab:discrete} lists the root names of the support functions provided in \pkg{actuar}; see also \autoref{sec:app:discrete}. Quite obviously, zero-truncated distributions are zero-modified distributions with $p_0^M = 0$. However, using the dedicated functions in R will be more efficient. \section{Poisson-inverse Gaussian distribution} \label{sec:pig} The Poisson-inverse Gaussian (PIG) distribution results from the continuous mixture between a Poisson distribution and an inverse Gaussian. That is, the Poisson-inverse Gaussian is the (marginal) distribution of the random variable $X$ when the conditional random variable $X|\Lambda = \lambda$ is Poisson with parameter $\lambda$ and the random variable $\Lambda$ is inverse Gaussian with parameters $\mu$ and $\phi$. The literature proposes many different expressions for the pmf of the PIG \citep{Holla:PIG:1966,Shaban:PIG:1981,Johnson:discrete:2005,LossModels4e}. Using the parametrization for the inverse Gaussian found in \autoref{sec:app:continuous}, we have: \begin{equation} \label{eq:pig:px} \begin{split} p_x &= \sqrt{\frac{2}{\pi \phi}} \frac{e^{(\phi\mu)^{-1}}}{x!} \left( \sqrt{2\phi \left( 1 + \frac{1}{2\phi\mu^2} \right)} \right)^{-\left( x - \frac{1}{2} \right)} \\ &\phantom{=} \times K_{x - \frac{1}{2}} \left( \sqrt{\frac{2}{\phi}\left(1 + \frac{1}{2\phi\mu^2}\right)} \right), \end{split} \end{equation} for $x = 0, 1, \dots$, $\mu > 0$, $\phi > 0$ and where \begin{equation} \label{eq:bessel_k} K_\nu(ax) = \frac{a^{-\nu}}{2} \int_0^\infty t^{\nu - 1} e^{- z(t + at^{-1})/2} dt, \quad a^2 z > 0 \end{equation} is the modified Bessel function of the third kind \citep{Bateman:1953:2,Abramowitz:1972}. One may compute the probabilities $p_x$, $x = 0, 1, \dots$ recursively using the following equations: \begin{equation} \label{eq:pig:px:recursive} \begin{split} p_0 &= \exp\left\{ \frac{1}{\phi\mu} \left(1 - \sqrt{1 + 2\phi\mu^2}\right) \right\} \\ p_1 &= \frac{\mu}{\sqrt{1 + 2\phi\mu^2}}\, p_0 \\ p_x &= \frac{2\phi\mu^2}{1 + 2\phi\mu^2} \left( 1 - \frac{3}{2x} \right) p_{x - 1} + \frac{\mu^2}{1 + 2\phi\mu^2} \frac{1}{x(x - 1)}\, p_{x - 2}, \quad x = 2, 3, \dots. \end{split} \end{equation} The first moment of the distribution is $\mu$. The second and third central moment are, respectively, \begin{align*} \mu_2 &= \sigma^2 = \mu + \phi\mu^3 \\ \mu_3 &= \mu + 3 \phi \mu^2 \sigma^2. \end{align*} For the limiting case $\mu = \infty$, the underlying inverse Gaussian has an inverse chi-squared distribution. The latter has no finite strictly positive, integer moments and, consequently, neither does the Poisson-inverse Gaussian. See \autoref{sec:app:discrete:pig} for the formulas in this case. \section{Special integrals} \label{sec:special-integrals} Many of the cumulative distribution functions of \autoref{sec:app:continuous} are expressed in terms of the incomplete gamma function or the incomplete beta function. From a probability theory perspective, the incomplete gamma function is usually defined as \begin{equation} \label{eq:pgamma} \Gamma(\alpha; x) = \frac{1}{\Gamma(\alpha)} \int_0^x t^{\alpha - 1} e^{-t}\, dt, \quad \alpha > 0, x > 0, \end{equation} with \begin{equation*} \Gamma(\alpha) = \int_0^\infty t^{\alpha - 1} e^{-t}\, dt, \end{equation*} whereas the (regularized) incomplete beta function is defined as \begin{equation} \label{eq:pbeta} \beta(a, b; x) = \frac{1}{\beta(a, b)} \int\limits_0^x t^{a - 1} (1 - t)^{b - 1}\, dt, \quad a > 0, b > 0, 0 < x < 1, \end{equation} with \begin{equation*} \beta(a, b) = \int_0^1 t^{a - 1} (1 - t)^{b - 1}\, dt = \frac{\Gamma(a) \Gamma(b)}{\Gamma(a + b)}. \end{equation*} Now, there exist alternative definitions of the these functions that are valid for negative values of the parameters. \citet{LossModels4e} introduce them to extend the range of admissible values for limited expected value functions. First, following \citet[Section~6.5]{Abramowitz:1972}, we define the ``extended'' incomplete gamma function as \begin{equation} \label{eq:gammainc} G(\alpha; x) = \int_x^\infty t^{\alpha - 1} e^{-t}\, dt \end{equation} for $\alpha$ real and $x > 0$. When $\alpha > 0$, we clearly have \begin{equation} \label{eq:gammainc:apos} G(\alpha; x) = \Gamma(a) [1 - \Gamma(\alpha; x)]. \end{equation} The integral is also defined for $\alpha \le 0$. As outlined in \citet[Appendix~A]{LossModels4e}, integration by parts of \eqref{eq:gammainc} yields the relation \begin{equation*} G(\alpha; x) = -\frac{x^\alpha e^{-x}}{\alpha} + \frac{1}{\alpha} G(\alpha + 1; x). \end{equation*} This process can be repeated until $\alpha + k$ is a positive number, in which case the right hand side can be evaluated with \eqref{eq:gammainc:apos}. If $\alpha = 0, -1, -2, \dots$, this calculation requires the value of \begin{equation*} \label{eq:expint} G(0; x) = \int_x^\infty \frac{e^{-t}}{t}\, dt = E_1(x), \end{equation*} which is known in the literature as the \emph{exponential integral} \citep[Section~5.1]{Abramowitz:1972}. Second, as seen in \citet[Section~6.6]{Abramowitz:1972}, we have the following relation for the integral on the right hand side of \eqref{eq:pbeta}: \begin{equation*} \int\limits_0^x t^{a - 1} (1 - t)^{b - 1}\, dt = \frac{x^a}{a}\, F(a, 1 - b; a + 1; x), \end{equation*} where \begin{equation*} F(a, b; c; z) = \frac{\Gamma(c)}{\Gamma(a) \Gamma(b)} \sum_{k = 0}^\infty \frac{\Gamma(a + k) \Gamma(b + k)}{\Gamma(c + k)} \frac{z^k}{k!} \end{equation*} is the Gauss hypergeometric series. With the above definition, the incomplete beta function also admits negative, non integer values for parameters $a$ and $b$. Now, let \begin{equation} \label{eq:betaint} B(a, b; x) = \Gamma(a + b) \int_0^x t^{a-1} (1-t)^{b-1} dt \end{equation} for $a > 0$, $b \neq -1, -2, \dots$ and $0 < x < 1$. Again, it is clear that when $b > 0$, \begin{equation*} B(a, b; x) = \Gamma(a) \Gamma(b) \beta(a, b; x). \end{equation*} Of more interest here is the case where $b < 0$, $b \neq -1, -2, \dots$ and $a > 1 + \lfloor -b\rfloor$. Integration by parts of \eqref{eq:betaint} yields \begin{equation} \label{eq:betaint:2} \begin{split} B(a, b; x) &= \displaystyle -\Gamma(a + b) \left[ \frac{x^{a-1} (1-x)^b}{b} + \frac{(a-1) x^{a-2} (1-x)^{b+1}}{b (b+1)} \right. \\ &\phantom{=} \displaystyle\left. + \cdots + \frac{(a-1) \cdots (a-r) x^{a-r-1} (1-x)^{b+r}}{b (b+1) \cdots (b+r)} \right] \\ &\phantom{=} \displaystyle + \frac{(a-1) \cdots (a-r-1)}{b (b+1) \cdots (b+r)} \Gamma(a-r-1) \\ &\phantom{=} \times \Gamma(b+r+1) \beta(a-r-1, b+r+1; x), \end{split} \end{equation} where $r = \lfloor -b\rfloor$. For the needs of \pkg{actuar}, we dubbed \eqref{eq:betaint} the \emph{beta integral}. Package \pkg{actuar} includes a C implementation of \eqref{eq:betaint:2} and imports functionalities of package \pkg{expint} \citep{expint} to compute the incomplete gamma function \eqref{eq:gammainc} at the C level. The routines are used to evaluate the limited expected value for distributions of the Feller--Pareto and transformed gamma families. \section{Package API: accessing the C routines} \label{sec:api} The actual workhorses behind the R functions presented in this document are C routines that the package exposes to other packages through an API. The header file \file{include/actuarAPI.h} in the package installation directory contains declarations for % the continuous distributions of \autoref{sec:app:continuous}, % the phase-type distributions of \autoref{sec:app:phase-type}, % the discrete distributions of \autoref{sec:app:discrete}, % and the beta integral of \autoref{sec:special-integrals}. The prototypes of the C routines for probability distributions all follow the same pattern modeled after those of base R \citep[Chapter~6]{R-exts}. As an example, here are the prototypes for the Pareto distribution: \begin{Schunk} \begin{Sinput} double dpareto(double x, double shape, double scale, int give_log); double ppareto(double q, double shape, double scale, int lower_tail, int log_p); double qpareto(double p, double shape, double scale, int lower_tail, int log_p); double rpareto(double shape, double scale); double mpareto(double order, double shape, double scale, int give_log); double levpareto(double limit, double shape, double scale, double order, int give_log); \end{Sinput} \end{Schunk} For the beta integral \eqref{eq:betaint:2}, the frontend is a routine \code{betaint} that returns \code{NA} or \code{NaN} for out-of-range arguments, but actual computation is done by routine \code{betaint\_raw}. Both are exposed as follows in the API: \begin{Schunk} \begin{Sinput} double betaint(double x, double a, double b); double betaint_raw(double x, double a, double b, double x1m); \end{Sinput} \end{Schunk} The developer of some package \pkg{pkg} who wants to use a routine --- say \code{dpareto} --- in her code should proceed as follows. \begin{enumerate} \item Add \pkg{actuar} to the \code{Imports} and \code{LinkingTo} directives of the \file{DESCRIPTION} file of \pkg{pkg}; \item Add an entry \code{import(actuar)} in the \file{NAMESPACE} file of \pkg{pkg}; \item Define the routine with a call to \code{R\_GetCCallable} in the initialization routine \code{R\_init\_pkg} of \pkg{pkg} \citep[Section~5.4]{R-exts}. For the current example, the file \file{src/init.c} of \pkg{pkg} would contain the following code: \begin{Schunk} \begin{Sinput} void R_init_pkg(DllInfo *dll) { R_registerRoutines( /* native routine registration */ ); pkg_dpareto = (double(*)(double,int,int)) R_GetCCallable("actuar", "dpareto"); } \end{Sinput} \end{Schunk} \item Define a native routine interface that will call \code{dpareto}, say \code{pkg\_dpareto} to avoid any name clash, in \file{src/init.c} as follows: \begin{Schunk} \begin{Sinput} double(*pkg_dpareto)(double,double,double,int); \end{Sinput} \end{Schunk} \item Declare the routine in a header file of \pkg{pkg} with the keyword \code{extern} to expose the interface to all routines of the package. In our example, file \file{src/pkg.h} would contain: \begin{Schunk} \begin{Sinput} extern double(*pkg_dpareto)(double,double,double,int); \end{Sinput} \end{Schunk} \item Include the package header file \file{pkg.h} in any C file making use of routine \code{pkg\_dpareto}. \end{enumerate} The companion package \pkg{expint} \citep{expint} ships with a complete test package implementing the above. See the vignette of the latter package for more information. \section{Implementation details} \label{sec:implementation} The cdf of the continuous distributions of \autoref{tab:continuous} use \code{pbeta} and \code{pgamma} to compute the incomplete beta and incomplete gamma functions, respectively. Functions \code{dinvgauss}, \code{pinvgauss} and \code{qinvgauss} rely on C implementations of functions of the same name from package \pkg{statmod} \citep{statmod}. The matrix exponential C routine needed in \code{dphtype} and \code{pphtype} is based on \code{expm} from package \pkg{Matrix} \citep{Matrix}. The C code to compute the beta integral \eqref{eq:betaint:2} was written by the second author. For all but the trivial input values, the pmf, cdf and quantile functions for the zero-truncated and zero-modified distributions of \autoref{tab:discrete} use the internal R functions for the corresponding standard distribution. Generation of random variates from zero-truncated distributions uses the following simple inversion algorithm on a restricted range \citep{Dalgaard:r-help:2005,Thomopoulos:2013:simulation}. Let $u$ be a random number from a uniform distribution on $(p_0, 1)$. Then $x = P^{-1}(u)$ is distributed according to the zero-truncated version of the distribution with cdf $P(k)$. For zero-modified distributions, we generate variates from the discrete mixture \eqref{eq:mixture} when $p_0^M \geq p_0$. When $p_0^M < p_0$, we can use either of two methods: \begin{enumerate} \item the classical rejection method with an envelope that differs from the target distribution only at zero (meaning that only zeros are rejected); \item generation from the discrete mixture \eqref{eq:mixture:alt} with the corresponding zero-truncated distribution (hence using the inversion method on a restricted range explained above). \end{enumerate} Which approach is faster depends on the relative speeds of the standard random generation function and the standard quantile function, and also on the proportion of zeros that are rejected using the rejection algorithm. Based on the difference $p_0 - p_0^M$, we determined (empirically) distribution-specific cutoff points between the two methods. Finally, computation of the Poisson-inverse Gaussian pmf uses the recursive equations \eqref{eq:pig:px:recursive}. Versions of \pkg{actuar} prior to 3.0-0 used the direct expression \eqref{eq:pig:px} and the C level function \code{bessel\_k} part of the R API. However, the latter overflows for large values of $\nu$ and this caused \code{NaN} results for the value of \begin{equation*} \frac{B^{- \left(x - \frac{1}{2} \right)} K_{x - \frac{1}{2}}(B/\phi)}{x!} \end{equation*} and, therefore, for the Poisson-inverse Gaussian pmf. \appendix \section{Continuous distributions} \label{sec:app:continuous} This appendix gives the root name and the parameters of the R support functions for the distributions of \autoref{tab:continuous}, as well as the formulas for the pdf, the cdf, the raw moment of order $k$ and the limited moment of order $k$ using the parametrization of \citet{LossModels4e} and \citet{HoggKlugman}. In the following, $\Gamma(\alpha; x)$ is the incomplete gamma function \eqref{eq:pgamma}, $\beta(a, b; x)$ is the incomplete beta function \eqref{eq:pbeta}, $G(\alpha; x)$ is the ``extended'' incomplete gamma function \eqref{eq:gammainc}, $B(a, b; x)$ is the beta integral \eqref{eq:betaint} and $K_\nu(x)$ is the modified Bessel function of the third kind \eqref{eq:bessel_k}. Unless otherwise stated, all parameters are finite and strictly positive, and the functions are defined for $x > 0$. \subsection{Feller--Pareto family} \label{sec:app:continuous:feller-pareto} \subsubsection{Feller--Pareto} \begin{itemize} \item Root: \code{fpareto} \item Parameters: \code{min} ($-\infty < \mu < \infty$), \code{shape1} ($\alpha$), \code{shape2} ($\gamma$), \code{shape3} ($\tau$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\gamma u^\tau (1 - u)^\alpha}{% (x - \mu) \beta (\alpha, \tau )}, \quad u = \frac{v}{1 + v}, \quad v = \left(\frac{x - \mu}{\theta} \right)^\gamma, \quad x > \mu \\ F(x) &= \beta(\tau, \alpha; u) \\ \displaybreak[0] \E{X^k} &= \sum_{j = 0}^k \binom{k}{j} \mu^{k - j} \theta^j\, \frac{\Gamma(\tau+j/\gamma) \Gamma(\alpha-j/\gamma)}{% \Gamma(\alpha) \Gamma(\tau)}, \quad \text{integer } 0 \leq k < \alpha\gamma \\ \E{(X \wedge x)^k} &= \sum_{j = 0}^k \binom{k}{j} \mu^{k - j} \theta^j\, \frac{B(\tau+j/\gamma, \alpha-j/\gamma; u)}{% \Gamma(\alpha) \Gamma(\tau)} \\ &\phantom{=} + x^k [1 - \beta(\tau, \alpha; u)], \quad \text{integer } k \geq 0, \quad \alpha - j/\gamma \neq -1, -2, \dots \end{align*} \subsubsection{Pareto IV} \begin{itemize} \item Root: \code{pareto4} \item Parameters: \code{min} ($-\infty < \mu < \infty$), \code{shape1} ($\alpha$), \code{shape2} ($\gamma$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\alpha \gamma u^\alpha (1 - u)}{(x - \mu)}, \quad u = \frac{1}{1 + v}, \quad v = \left(\frac{x - \mu}{\theta} \right)^\gamma, \quad x > \mu \\ F(x) &= 1 - u^\alpha \\ \displaybreak[0] \E{X^k} &= \sum_{j = 0}^k \binom{k}{j} \mu^{k - j} \theta^j\, \frac{\Gamma(1+j/\gamma) \Gamma(\alpha-j/\gamma)}{% \Gamma(\alpha)}, \quad \text{integer } 0 \leq k < \alpha\gamma \\ \E{(X \wedge x)^k} &= \sum_{j = 0}^k \binom{k}{j} \mu^{k - j} \theta^j\, \frac{B(1+j/\gamma, \alpha-j/\gamma; 1-u)}{% \Gamma(\alpha)} \\ &\phantom{=} + x^k u^\alpha, \quad \text{integer } k \geq 0 \quad \alpha - j/\gamma \neq -1, -2, \dots \end{align*} \subsubsection{Pareto III} \begin{itemize} \item Root: \code{pareto3} \item Parameters: \code{min} ($-\infty < \mu < \infty$), \code{shape} ($\gamma$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\gamma u (1 - u)}{(x - \mu)}, \quad u = \frac{v}{1 + v}, \quad v = \left(\frac{x - \mu}{\theta} \right)^\gamma, \quad x > \mu \\ F(x) &= u \\ \displaybreak[0] \E{X^k} &= \sum_{j = 0}^k \binom{k}{j} \mu^{k - j} \theta^j\, \Gamma(1+j/\gamma) \Gamma(1-j/\gamma), \quad \text{integer } 0 \leq k < \gamma \\ \E{(X \wedge x)^k} &= \sum_{j = 0}^k \binom{k}{j} \mu^{k - j} \theta^j\, B(1+j/\gamma, 1-j/\gamma; u) \\ &\phantom{=} + x^k (1 - u), \quad \text{integer } k \geq 0 \quad 1 - j/\gamma \neq -1, -2, \dots \end{align*} \subsubsection{Pareto II} \begin{itemize} \item Root: \code{pareto4} \item Parameters: \code{min} ($-\infty < \mu < \infty$), \code{shape} ($\alpha$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\alpha u^\alpha (1 - u)}{(x - \mu)}, \quad u = \frac{1}{1 + v}, \quad v = \frac{x - \mu}{\theta}, \quad x > \mu \\ F(x) &= 1 - u^\alpha \\ \displaybreak[0] \E{X^k} &= \sum_{j = 0}^k \binom{k}{j} \mu^{k - j} \theta^j\, \frac{\Gamma(1+j) \Gamma(\alpha-j)}{% \Gamma(\alpha)}, \quad \text{integer } 0 \leq k < \alpha \\ \E{(X \wedge x)^k} &= \sum_{j = 0}^k \binom{k}{j} \mu^{k - j} \theta^j\, \frac{B(1+j, \alpha-j; 1-u)}{% \Gamma(\alpha)} \\ &\phantom{=} + x^k u^\alpha, \quad \text{integer } k \geq 0 \quad \alpha - j \neq -1, -2, \dots \end{align*} \subsubsection{Transformed beta} \begin{itemize} \item Root: \code{trbeta}, \code{pearson6} \item Parameters: \code{shape1} ($\alpha$), \code{shape2} ($\gamma$), \code{shape3} ($\tau$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\gamma u^\tau (1 - u)^\alpha}{% x \beta (\alpha, \tau )}, \qquad u = \frac{v}{1 + v}, \qquad v = \left(\frac{x}{\theta} \right)^\gamma \\ F(x) &= \beta(\tau, \alpha; u) \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \Gamma(\tau+k/\gamma) \Gamma(\alpha-k/\gamma)}{% \Gamma(\alpha) \Gamma(\tau)}, \quad -\tau\gamma < k < \alpha\gamma \\ \E{(X \wedge x)^k} &= \frac{% \theta^k B(\tau+k/\gamma, \alpha-k/\gamma; u)}{% \Gamma(\alpha) \Gamma(\tau)} \\ &\phantom{=} + x^k [1 - \beta(\tau, \alpha; u)], \quad k > -\tau\gamma \end{align*} \subsubsection{Burr} \begin{itemize} \item Root: \code{burr} \item Parameters: \code{shape1} ($\alpha$), \code{shape2} ($\gamma$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\alpha \gamma u^\alpha (1 - u)}{x}, \qquad u = \frac{1}{1 + v}, \qquad v = \left( \frac{x}{\theta} \right)^\gamma \\ F(x) &= 1 - u^\alpha \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \Gamma(1+k/\gamma) \Gamma(\alpha-k/\gamma)}{% \Gamma(\alpha)}, \quad -\gamma < k < \alpha\gamma \\ \E{(X \wedge x)^k} &= \frac{% \theta^k B(1+k/\gamma, \alpha-k/\gamma; 1-u)}{% \Gamma(\alpha)} \\ &\phantom{=} + x^k u^\alpha, \quad k > -\gamma \end{align*} \subsubsection{Loglogistic} \begin{itemize} \item Root: \code{llogis} \item Parameters: \code{shape} ($\gamma$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\gamma u (1 - u)}{x}, \qquad u = \frac{v}{1 + v}, \qquad v = \left( \frac{x}{\theta} \right)^\gamma \\ F(x) &= u \\ \displaybreak[0] \E{X^k} &= \theta^k \Gamma(1+k/\gamma) \Gamma(1-k/\gamma), \quad -\gamma < k < \gamma \\ \E{(X \wedge x)^k} &= \theta^k B(1+k/\gamma, 1-k/\gamma; u) \\ &\phantom{=} + x^k (1 - u), \quad k > -\gamma \end{align*} \subsubsection{Paralogistic} \begin{itemize} \item Root: \code{paralogis} \item Parameters: \code{shape} ($\alpha$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\alpha^2 u^\alpha (1 - u)}{x}, \qquad u = \frac{1}{1 + v}, \qquad v = \left( \frac{x}{\theta} \right)^\alpha \\ F(x) &= 1 - u^\alpha \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \Gamma(1+k/\alpha) \Gamma(\alpha-k/\alpha)}{% \Gamma(\alpha)}, \quad -\alpha < k < \alpha^2 \\ \E{(X \wedge x)^k} &= \frac{% \theta^k B(1+k/\alpha, \alpha-k/\alpha; 1-u)}{% \Gamma(\alpha)} \\ &\phantom{=} + x^k u^\alpha, \quad k > -\alpha \end{align*} \subsubsection{Generalized Pareto} \begin{itemize} \item Root: \code{genpareto} \item Parameters: \code{shape1} ($\alpha$), \code{shape2} ($\tau$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{u^\tau (1 - u)^\alpha}{x \beta (\alpha, \tau )}, \qquad u = \frac{v}{1 + v}, \qquad v = \frac{x}{\theta} \\ F(x) &= \beta(\tau, \alpha; u) \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \Gamma(\tau+k) \Gamma(\alpha-k)}{% \Gamma(\alpha) \Gamma(\tau)}, \quad -\tau < k < \alpha \\ \E{(X \wedge x)^k} &= \frac{% \theta^k B(\tau+k, \alpha-k; u)}{% \Gamma(\alpha) \Gamma(\tau)} \\ &\phantom{=} + x^k [1 - \beta(\tau, \alpha; u)], \quad k > -\tau \end{align*} \subsubsection{Pareto} \begin{itemize} \item Root: \code{pareto}, \code{pareto2} \item Parameters: \code{shape} ($\alpha$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\alpha u^\alpha (1 - u)}{x}, \qquad u = \frac{1}{1 + v}, \qquad v = \frac{x}{\theta} \\ F(x) &= 1 - u^\alpha \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \Gamma(1+k) \Gamma(\alpha-k)}{% \Gamma(\alpha)}, \quad -1 < k < \alpha \\ \E{(X \wedge x)^k} &= \frac{% \theta^k B(1+k, \alpha-k; 1-u)}{% \Gamma(\alpha)} \\ &\phantom{=} + x^k u^\alpha, \quad k > -1 \end{align*} \subsubsection{Single-parameter Pareto (Pareto I)} \begin{itemize} \item Root: \code{pareto1} \item Parameters: \code{shape} ($\alpha$), \code{min} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\alpha \theta^\alpha}{x^{\alpha+1}}, \quad x > \theta \\ F(x) &= 1 - \left( \frac{\theta}{x} \right)^\alpha, \quad x > \theta \\ \displaybreak[0] \E{X^k} &= \frac{\alpha \theta^k}{\alpha - k}, \quad k < \alpha \\ \E{(X \wedge x)^k} &= \frac{\alpha \theta^k}{\alpha - k} - \frac{k \theta^\alpha}{(\alpha - k) x^{\alpha-k}}, \quad x \geq \theta \end{align*} Although there appears to be two parameters, only $\alpha$ is a true parameter. The value of $\theta$ is the minimum of the distribution and is usually set in advance. \subsubsection{Inverse Burr} \begin{itemize} \item Root: \code{invburr} \item Parameters: \code{shape1} ($\tau$), \code{shape2} ($\gamma$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\tau \gamma u^\tau (1 - u)}{x}, \qquad u = \frac{v}{1 + v}, \qquad v = \left( \frac{x}{\theta} \right)^\gamma \\ F(x) &= u^\tau \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \Gamma(\tau+k/\gamma) \Gamma(1-k/\gamma)}{% \Gamma(\tau)}, \quad -\gamma < k < \alpha\gamma \\ \E{(X \wedge x)^k} &= \frac{% \theta^k B(\tau+k/\gamma, 1-k/\gamma; u)}{% \Gamma(\tau)} \\ &\phantom{=} + x^k (1-u^\tau), \quad k > -\tau\gamma \end{align*} \subsubsection{Inverse Pareto} \begin{itemize} \item Root: \code{invpareto} \item Parameters: \code{shape} ($\tau$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\tau u^\tau (1 - u)}{x}, \qquad u = \frac{v}{1 + v}, \qquad v = \frac{x}{\theta} \\ F(x) &= u^\tau \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \Gamma(\tau+k) \Gamma(1-k)}{% \Gamma(\tau)}, \quad -\tau < k < 1 \\ \E{(X \wedge x)^k} &= \theta^k \tau \int_0^u y^{\tau+k-1} (1 - y)^{-k}\, dy \\ &\phantom{=} + x^k (1-u^\tau), \quad k > -\tau \end{align*} \subsubsection{Inverse paralogistic} \begin{itemize} \item Root: \code{invparalogis} \item Parameters: \code{shape} ($\tau$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\tau^2 u^\tau (1 - u)}{x}, \qquad u = \frac{v}{1 + v}, \qquad v = \left(\frac{x}{\theta} \right)^\tau \\ F(x) &= u^\tau \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \Gamma(\tau+k/\tau) \Gamma(1-k/\tau)}{% \Gamma(\tau)}, \quad -\tau^2 < k < \tau \\ \E{(X \wedge x)^k} &= \frac{% \theta^k B(\tau+k/\tau, 1-k/\tau; u)}{% \Gamma(\tau)} \\ &\phantom{=} + x^k (1-u^\tau), \quad k > -\tau^2 \end{align*} \subsection{Transformed gamma family} \label{sec:app:continuous:transformed-gamma} \subsubsection{Transformed gamma} \begin{itemize} \item Root: \code{trgamma} \item Parameters: \code{shape1} ($\alpha$), \code{shape2} ($\tau$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\tau u^\alpha e^{-u}}{x \Gamma(\alpha)}, \qquad u = \left( \frac{x}{\theta} \right)^\tau \\ F(x) &= \Gamma (\alpha ; u) \\ \displaybreak[0] \E{X^k} &= \frac{\theta^k \Gamma(\alpha+k/\tau)}{\Gamma(\alpha)} \quad k > -\alpha\tau \\ \E{(X \wedge x)^k} &= \frac{\theta^k \Gamma(\alpha+k/\tau)}{\Gamma(\alpha)} \Gamma(\alpha+k/\tau; u) \\ &\phantom{=} + x^k [1 - \Gamma(\alpha; u)], \quad k > -\alpha\tau \end{align*} \subsubsection{Inverse transformed gamma} \begin{itemize} \item Root: \code{invtrgamma} \item Parameters: \code{shape1} ($\alpha$), \code{shape2} ($\tau$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\tau u^\alpha e^{-u}}{x\Gamma (\alpha)}, \qquad u = \left( \frac{\theta}{x} \right)^\tau \\ F(x) &= 1 - \Gamma (\alpha ; u) \\ \displaybreak[0] \E{X^k} &= \frac{\theta^k \Gamma(\alpha-k/\tau)}{\Gamma(\alpha)} \quad k < \alpha\tau \\ \E{(X \wedge x)^k} &= \frac{\theta^k G(\alpha-k/\tau; u)}{\Gamma(\alpha)} + x^k \Gamma(\alpha; u), \quad \text{all }k \end{align*} \subsubsection{Inverse gamma} \begin{itemize} \item Root: \code{invgamma} \item Parameters: \code{shape} ($\alpha$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{u^\alpha e^{-u}}{x\Gamma (\alpha)}, \qquad u = \frac{\theta}{x}\\ F(x) &= 1 - \Gamma (\alpha ; u) \\ \displaybreak[0] \E{X^k} &= \frac{\theta^k \Gamma(\alpha-k)}{\Gamma(\alpha)} \quad k < \alpha \\ \E{(X \wedge x)^k} &= \frac{\theta^k G(\alpha-k; u)}{\Gamma(\alpha)} + x^k \Gamma(\alpha; u), \quad \text{all }k \\ M(t) &= \frac{2}{\Gamma(\alpha)} (-\theta t)^{\alpha/2} K_\alpha(\sqrt{-4\theta t}) \end{align*} \subsubsection{Inverse Weibull} \begin{itemize} \item Root: \code{invweibull}, \code{lgompertz} \item Parameters: \code{shape} ($\tau$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\tau u e^{-u}}{x}, \qquad u = \left( \frac{\theta}{x} \right)^\tau \\ F(x) &= e^{-u} \\ \displaybreak[0] \E{X^k} &= \theta^k \Gamma(1-k/\tau) \quad k < \tau \\ \E{(X \wedge x)^k} &= \theta^k G(1-k/\tau; u) + x^k (1 - e^{-u}), \quad \text{all }k \end{align*} \subsubsection{Inverse exponential} \begin{itemize} \item Root: \code{invexp} \item Parameters: \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{u e^{-u}}{x}, \qquad u = \frac{\theta}{x} \\ F(x) &= e^{-u} \\ \displaybreak[0] \E{X^k} &= \theta^k \Gamma(1-k) \quad k < 1 \\ \E{(X \wedge x)^k} &= \theta^k G(1-k; u) + x^k (1 - e^{-u}), \quad \text{all }k \end{align*} \subsection{Other distributions} \label{sec:app:continuous:other} \subsubsection{Loggamma} \begin{itemize} \item Root: \code{lgamma} \item Parameters: \code{shapelog} ($\alpha$), \code{ratelog} ($\lambda$) \end{itemize} \begin{align*} f(x) &= \frac{\lambda^\alpha (\ln x)^{\alpha - 1}}{% x^{\lambda + 1} \Gamma(\alpha)}, \quad x > 1 \\ F(x) &= \Gamma( \alpha ; \lambda \ln x), \quad x > 1 \\ \displaybreak[0] \E{X^k} &= \left( \frac{\lambda}{\lambda - k} \right)^\alpha, \quad k < \lambda \\ \E{(X \wedge x)^k} &= \left( \frac{\lambda}{\lambda - k} \right)^\alpha \Gamma(\alpha; (\lambda - k) \ln x) \\ &\phantom{=} + x^k (1 - \Gamma(\alpha; \lambda \ln x)), \quad k < \lambda \end{align*} \subsubsection{Gumbel} \begin{itemize} \item Root: \code{gumbel} \item Parameters: \code{alpha} ($-\infty < \alpha < \infty$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{e^{-(u + e^{-u})}}{\theta}, \qquad u = \frac{x - \alpha}{\theta}, \qquad -\infty < x < \infty \\ F(x) &= \exp[-\exp(-u)] \\ \displaybreak[0] \E{X} &= \alpha + \gamma \theta, \quad \gamma \approx 0.57721566490153 \\ \VAR{X} &= \frac{\pi^2 \theta^2}{6} \\ M(t) &= e^{\alpha t} \Gamma(1 - \theta t) \end{align*} \subsubsection{Inverse Gaussian} \begin{itemize} \item Root: \code{invgauss} \item Parameters: \code{mean} ($\mu$), \code{shape} ($\lambda = 1/\phi$), \code{dispersion} ($\phi$) \end{itemize} \begin{align*} f(x) &= \left( \frac{1}{2 \pi \phi x^3} \right)^{1/2} \exp\left\{ -\frac{(x/\mu - 1)^2}{2 \phi x} \right\} \\ F(x) &= \Phi\left( \frac{x/\mu - 1}{\sqrt{\phi x}} \right) + e^{2/(\phi\mu)} \Phi\left( -\frac{x/\mu + 1}{\sqrt{\phi x}} \right) \\ \displaybreak[0] \E{X^k} &= \mu^k \sum_{i = 0}^{k - 1} \frac{(k + i - 1)!}{i! (k - i - 1)!} \left( \frac{\phi \mu}{2} \right)^{i}, \quad k = 1, 2, \dots \\ \E{X \wedge x} &= \mu \left[ \Phi\left( \frac{x/\mu - 1}{\sqrt{\phi x}} \right) - e^{2/(\phi\mu)} \Phi\left(- \frac{x/\mu + 1}{\sqrt{\phi x}} \right) \right] \\ &\phantom{=} + x (1 - F(x)) \\ M(t) &= \exp \left\{ \frac{1}{\phi \mu} \left(1 - \sqrt{1 - 2 \phi \mu^2 t}\right) \right\}, \quad t \leq \frac{1}{2 \phi \mu^2} \end{align*} \noindent% The limiting case $\mu = \infty$ is an inverse gamma distribution with $\alpha = 1/2$ and $\lambda = 2\phi$ (or inverse chi-squared). \subsubsection{Generalized beta} \begin{itemize} \item Root: \code{genbeta} \item Parameters: \code{shape1} ($a$), \code{shape2} ($b$), \code{shape3} ($\tau$), \code{rate} ($\lambda = 1/\theta$), \code{scale} ($\theta$) \end{itemize} \begin{align*} f(x) &= \frac{\tau u^a (1 - u)^{b - 1}}{x \beta (a, b)}, \qquad u = \left( \frac{x}{\theta} \right)^\tau, \qquad 0 < x < \theta \\ F(x) &= \beta (a, b ; u) \\ \displaybreak[0] \E{X^k} &= \frac{% \theta^k \beta(a+k/\tau, b)}{\beta(a, b)}, \quad k > -a\tau \\ \E{(X \wedge x)^k} &= \frac{% \theta^k \beta(a+k/\tau, b)}{\beta(a, b)} \beta(a+k/\tau, b; u) \\ &\phantom{=} + x^k [1 - \beta(a, b; u)], \quad k > -\tau\gamma \end{align*} \section{Phase-type distributions} \label{sec:app:phase-type} Consider a continuous-time Markov process with $m$ transient states and one absorbing state. Let \begin{equation*} \mat{Q} = \begin{bmatrix} \mat{T} & \mat{t} \\ \mat{0} & 0 \end{bmatrix} \end{equation*} be the transition rates matrix (or intensity matrix) of such a process and let $(\mat{\pi}, \pi_{m + 1})$ be the initial probability vector. Here, $\mat{T}$ is an $m \times m$ non-singular matrix with $t_{ii} < 0$ for $i = 1, \dots, m$ and $t_{ij} \geq 0$ for $i \neq j$; $\mat{\pi}$ is an $1 \times m$ vector of probabilities such that $\mat{\pi} \mat{e} + \pi_{m + 1} = 1$; $\mat{t} = -\mat{T} \mat{e}$; $\mat{e} = [1]_{m \times 1}$ is a column vector of ones. % \bigskip \begin{itemize} \item Root: \code{phtype} \item Parameters: \code{prob} ($\mat{\pi}_{1 \times m}$), \code{rates} ($\mat{T}_{m \times m}$) \end{itemize} \begin{align*} f(x) &= \begin{cases} 1 - \mat{\pi} \mat{e} & x = 0, \\ \mat{\pi} e^{\mat{T} x} \mat{t}, & x > 0 \end{cases} \\ F(x) &= \begin{cases} 1 - \mat{\pi} \mat{e}, & x = 0, \\ 1 - \mat{\pi} e^{\mat{T} x} \mat{e}, & x > 0 \end{cases} \\ \E{X^k} &= k! \mat{\pi} (-\mat{T})^{-k} \mat{e} \\ M(t) &= \mat{\pi} (-t \mat{I} - \mat{T})^{-1} \mat{t} + (1 - \mat{\pi} \mat{e}) \end{align*} \section{Discrete distributions} \label{sec:app:discrete} This appendix gives the root name and the parameters of the R support functions for the members of the $(a, b, 0)$ and $(a, b, 1)$ discrete distributions as defined in \citet{LossModels4e}; the values of $a$, $b$ and $p_0$ in the representation; the pmf; the relationship with other distributions, when there is one. The appendix also provides the main characteristics of the Poisson-inverse Gaussian distribution. \subsection[The (a, b, 0) class]{The $(a, b, 0)$ class} \label{sec:app:discrete:a-b-0} The distributions in this section are all supported in base R. Their pmf can be computed recursively by fixing $p_0$ to the specified value and then using $p_k = (a + b/k) p_{k - 1}$, for $k = 1, 2, \dots$. All parameters are finite. \subsubsection{Poisson} \begin{itemize} \item Root: \code{pois} \item Parameter: \code{lambda} ($\lambda \geq 0$) \end{itemize} \begin{align*} a &= 0, \qquad b = \lambda, \qquad p_0 = e^{-\lambda} \\ p_k &= \frac{e^{-\lambda} \lambda^k}{k!} \end{align*} \subsubsection{Negative binomial} \begin{itemize} \item Root: \code{nbinom} \item Parameters: \code{size} ($r \geq 0$), \code{prob} ($0 < p \leq 1$), \code{mu} ($r(1 - p)/p$) \end{itemize} \begin{align*} a &= 1 - p, \qquad b = (r - 1)(1 - p), \qquad p_0 = p^r \\ p_k &= \binom{r+k-1}{k} p^r (1 - p)^k \end{align*} \begin{itemize} \item Special case: Geometric$(p)$ when $r = 1$. \end{itemize} \subsubsection{Geometric} \begin{itemize} \item Root: \code{geom} \item Parameter: \code{prob} ($0 < p \leq 1$) \end{itemize} \begin{align*} a &= 1 - p, \qquad b = 0, \qquad p_0 = p \\ p_k &= p (1 - p)^k \end{align*} \subsubsection{Binomial} \begin{itemize} \item Root: \code{binom} \item Parameters: \code{size} ($n = 0, 1, 2, \dots$), \code{prob} ($0 \leq p \leq 1$) \end{itemize} \begin{align*} a &= -\frac{p}{1 - p}, \qquad b = \frac{(n + 1)p}{1 - p}, \qquad p_0 = (1 - p)^n \\ p_k &= \binom{n}{k} p^k (1 - p)^{n - k}, \quad k = 1, 2, \dots, n \end{align*} \begin{itemize} \item Special case: Bernoulli$(p)$ when $n = 1$. \end{itemize} \subsection[The zero-truncated (a, b, 1) class]{The zero-truncated $(a, b, 1)$ class} \label{sec:app:discrete:zt} Package \pkg{actuar} provides support for the distributions in this section. Zero-truncated distributions have probability at zero $p_0^T = 0$. Their pmf can be computed recursively by fixing $p_1$ to the value specified below and then using $p_k = (a + b/k) p_{k - 1}$, for $k = 2, 3, \dots$. The distributions are all defined on $k = 1, 2, \dots$. The limiting case of zero-truncated distributions when $p_1$ is infinite is a point mass in $k = 1$. \subsubsection{Zero-truncated Poisson} \begin{itemize} \item Root: \code{ztpois} \item Parameter: \code{lambda} ($\lambda \geq 0$) \end{itemize} \begin{align*} a &= 0, \qquad b = \lambda, \qquad p_1 = \frac{\lambda}{e^\lambda - 1} \\ p_k &= \frac{\lambda^k}{k! (e^\lambda - 1)} \end{align*} \subsubsection{Zero-truncated negative binomial} \begin{itemize} \item Root: \code{ztnbinom} \item Parameters: \code{size} ($r \geq 0$), \code{prob} ($0 < p \leq 1$) \end{itemize} \begin{align*} a &= 1 - p, \qquad b = (r - 1)(1 - p), \qquad p_1 = \frac{r p^r (1 - p)}{1 - p^r} \\ p_k &= \binom{r+k-1}{k} \frac{p^r (1 - p)^k}{1 - p^r} \end{align*} \begin{itemize} \item Special cases: Logarithmic$(1 - p)$ when $r = 0$; Zero-truncated geometric$(p)$ when $r = 1$. \end{itemize} \subsubsection{Zero-truncated geometric} \begin{itemize} \item Root: \code{ztgeom} \item Parameter: \code{prob} ($0 < p \leq 1$) \end{itemize} \begin{align*} a &= 1 - p, \qquad b = 0, \qquad p_1 = p \\ p_k &= p (1 - p)^{k - 1} \end{align*} \subsubsection{Zero-truncated binomial} \begin{itemize} \item Root: \code{ztbinom} \item Parameters: \code{size} ($n = 0, 1, 2, \dots$), \code{prob} ($0 \leq p \leq 1$) \end{itemize} \begin{align*} a &= -\frac{p}{1 - p}, \qquad b = \frac{(n + 1)p}{1 - p}, \qquad p_1 = \frac{n p (1 - p)^{n - 1}}{1 - (1 - p)^n} \\ p_k &= \binom{n}{k} \frac{p^k (1 - p)^{n - k}}{1 - (1 - p)^n}, \quad k = 1, 2, \dots, n \end{align*} \subsubsection{Logarithmic} \begin{itemize} \item Root: \code{logarithmic} \item Parameter: \code{prob} ($0 \leq p < 1$) \end{itemize} \begin{align*} a &= p, \qquad b = -p, \qquad p_1 = - \frac{p}{\log (1 - p)} \\ p_k &= - \frac{p^k}{k \log (1 - p)} \end{align*} \subsection[The zero-modified (a, b, 1) class]{The zero-modified $(a, b, 1)$ class} \label{sec:app:discrete:zm} Package \pkg{actuar} provides support for the distributions in this section. Zero-modified distributions have an arbitrary probability at zero $p_0^M \neq p_0$, where $p_0$ is the probability at zero for the corresponding member of the $(a, b, 0)$ class. Their pmf can be computed recursively by fixing $p_1$ to the value specified below and then using $p_k = (a + b/k) p_{k - 1}$, for $k = 2, 3, \dots$. The distributions are all defined on $k = 0, 1, 2, \dots$. The limiting case of zero-modified distributions when $p_1$ is infinite is a discrete mixture between a point mass in $k = 0$ (with probability $p_0^M$) and a point mass in $k = 1$ (with probability $1 - p_0^M$). \subsubsection{Zero-modified Poisson} \begin{itemize} \item Root: \code{zmpois} \item Parameters: \code{lambda} ($\lambda > 0$), \code{p0} ($0 \leq p_0^M \leq 1$) \end{itemize} \begin{align*} a &= 0, \qquad b = \lambda, \qquad p_1 = \frac{(1 - p_0^M) \lambda}{e^\lambda - 1} \\ p_k &= \frac{(1 - p_0^M) \lambda^k}{k! (e^\lambda - 1)} \end{align*} \subsubsection{Zero-modified negative binomial} \begin{itemize} \item Root: \code{zmnbinom} \item Parameters: \code{size} ($r \geq 0$), \code{prob} ($0 < p \leq 1$), \code{p0} ($0 \leq p_0^M \leq 1$) \end{itemize} \begin{align*} a &= 1 - p, \qquad b = (r - 1)(1 - p), \qquad p_1 = \frac{(1 - p_0^M) r p^r (1 - p)}{1 - p^r} \\ p_k &= \binom{r+k-1}{k} \frac{(1 - p_0^M) p^r (1 - p)^k}{1 - p^r} \end{align*} \begin{itemize} \item Special cases: Zero-modified logarithmic$(1 - p)$ when $r = 0$; Zero-modified geometric$(p)$ when $r = 1$. \end{itemize} \subsubsection{Zero-modified geometric} \begin{itemize} \item Root: \code{zmgeom} \item Parameters: \code{prob} ($0 < p \leq 1$), \code{p0} ($0 \leq p_0^M \leq 1$) \end{itemize} \begin{align*} a &= 1 - p, \qquad b = 0, \qquad p_1 = (1 - p_0^M) p \\ p_k &= (1 - p_0^M) p (1 - p)^{k - 1} \end{align*} \subsubsection{Zero-modified binomial} \begin{itemize} \item Root: \code{zmbinom} \item Parameters: \code{size} ($n = 0, 1, 2, \dots$), \code{prob} ($0 \leq p \leq 1$), \code{p0} ($0 \leq p_0^M \leq 1$) \end{itemize} \begin{align*} a &= -\frac{p}{1 - p}, \qquad b = \frac{(n + 1)p}{1 - p}, \qquad p_1^M = \frac{n (1 - p_0^M) p (1 - p)^{n - 1}}{1 - (1 - p)^n} \\ p_k &= \binom{n}{k} \frac{(1 - p_0^M) p^k (1 - p)^{n - k}}{1 - (1 - p)^n}, \quad k = 1, 2, \dots, n \end{align*} \subsubsection{Zero-modified logarithmic} \begin{itemize} \item Root: \code{zmlogarithmic} \item Parameters: \code{prob} ($0 \leq p < 1$), \code{p0} ($0 \leq p_0^M \leq 1$) \end{itemize} \begin{align*} a &= p, \qquad b = -p, \qquad p_1 = - \frac{(1 - p_0^M) p}{\log (1 - p)} \\ p_k &= - \frac{(1 - p_0^M) p^k}{k \log (1 - p)} \end{align*} \subsection{Other distribution} \label{sec:app:discrete:pig} \subsubsection{Poisson-inverse Gaussian} \begin{itemize} \item Root: \code{poisinvgauss}, \code{pig} \item Parameters: \code{mean} ($\mu > 0$), \code{shape} ($\lambda = 1/\phi$), \code{dispersion} ($\phi > 0$) \end{itemize} \begin{align*} p_x &= \sqrt{\frac{2}{\pi \phi}} \frac{e^{(\phi\mu)^{-1}}}{x!} \left( \sqrt{2\phi \left( 1 + \frac{1}{2\phi\mu^2} \right)} \right)^{- \left( x - \frac{1}{2} \right)} \\ &\phantom{=} \times K_{x - 1/2} \left( \sqrt{\frac{2}{\phi}\left(1 + \frac{1}{2\phi\mu^2}\right)} \right), \quad x = 0, 1, \dots, \end{align*} \noindent% Recursively: \begin{align*} p_0 &= \exp\left\{ \frac{1}{\phi\mu} \left(1 - \sqrt{1 + 2\phi\mu^2}\right) \right\} \\ p_1 &= \frac{\mu}{\sqrt{1 + 2\phi\mu^2}}\, p_0 \\ p_x &= \frac{2\phi\mu^2}{1 + 2\phi\mu^2} \left( 1 - \frac{3}{2x} \right) p_{x - 1} + \frac{\mu^2}{1 + 2\phi\mu^2} \frac{1}{x(x - 1)}\, p_{x - 2}, \quad x = 2, 3, \dots. \end{align*} \noindent% In the limiting case $\mu = \infty$, the pmf reduces to \begin{equation*} p_x = \sqrt{\frac{2}{\pi \phi}} \frac{1}{x!} (\sqrt{2\phi})^{- \left( x - \frac{1}{2} \right)} K_{x - \frac{1}{2}} (\sqrt{2/\phi}), \quad x = 0, 1, \dots \end{equation*} and the recurrence relations become \begin{align*} p_0 &= \exp\left\{-\sqrt{2/\phi}\right\} \\ p_1 &= \frac{1}{\sqrt{2\phi}}\, p_0 \\ p_x &= \left( 1 - \frac{3}{2x} \right) p_{x - 1} + \frac{1}{2\phi} \frac{1}{x(x - 1)}\, p_{x - 2}, \quad x = 2, 3, \dots. \end{align*} %% References \bibliography{actuar} \end{document} %%% Local Variables: %%% mode: noweb %%% coding: utf-8 %%% TeX-master: t %%% End: actuar/inst/doc/modeling.R0000644000176200001440000002055614522557740015217 0ustar liggesusers### R code from vignette source 'modeling.Rnw' ################################################### ### code chunk number 1: modeling.Rnw:13-15 ################################################### library(actuar) options(width = 52, digits = 4) ################################################### ### code chunk number 2: modeling.Rnw:107-111 ################################################### x <- grouped.data(Group = c(0, 25, 50, 100, 150, 250, 500), Line.1 = c(30, 31, 57, 42, 65, 84), Line.2 = c(26, 33, 31, 19, 16, 11)) ################################################### ### code chunk number 3: modeling.Rnw:115-116 ################################################### class(x) ################################################### ### code chunk number 4: modeling.Rnw:121-122 ################################################### x ################################################### ### code chunk number 5: modeling.Rnw:142-147 ################################################### y <- c( 27, 82, 115, 126, 155, 161, 243, 294, 340, 384, 457, 680, 855, 877, 974, 1193, 1340, 1884, 2558, 15743) grouped.data(y) grouped.data(y, breaks = 5) ################################################### ### code chunk number 6: modeling.Rnw:154-156 ################################################### grouped.data(y, breaks = c(0, 100, 200, 350, 750, 1200, 2500, 5000, 16000)) ################################################### ### code chunk number 7: modeling.Rnw:166-169 ################################################### x <- grouped.data(Group = c(0, 25, 50, 100, 150, 250, 500), Line.1 = c(30, 31, 57, 42, 65, 84), Line.2 = c(26, 33, 31, 19, 16, 11)) ################################################### ### code chunk number 8: modeling.Rnw:173-174 ################################################### x[, 1] ################################################### ### code chunk number 9: modeling.Rnw:178-179 ################################################### x[, -1] ################################################### ### code chunk number 10: modeling.Rnw:182-183 ################################################### x[1:3, ] ################################################### ### code chunk number 11: modeling.Rnw:192-194 ################################################### x[1, 2] <- 22; x x[1, c(2, 3)] <- c(22, 19); x ################################################### ### code chunk number 12: modeling.Rnw:197-199 ################################################### x[1, 1] <- c(0, 20); x x[c(3, 4), 1] <- c(55, 110, 160); x ################################################### ### code chunk number 13: modeling.Rnw:216-219 ################################################### mean(x) var(x) sd(x) ################################################### ### code chunk number 14: modeling.Rnw:229-230 ################################################### hist(x[, -3]) ################################################### ### code chunk number 15: modeling.Rnw:234-235 ################################################### hist(x[, -3]) ################################################### ### code chunk number 16: modeling.Rnw:245-247 ################################################### hist(y) hist(grouped.data(y)) ################################################### ### code chunk number 17: modeling.Rnw:284-285 ################################################### (Fnt <- ogive(x)) ################################################### ### code chunk number 18: modeling.Rnw:290-293 ################################################### knots(Fnt) Fnt(knots(Fnt)) plot(Fnt) ################################################### ### code chunk number 19: modeling.Rnw:297-298 ################################################### plot(Fnt) ################################################### ### code chunk number 20: modeling.Rnw:309-311 ################################################### (Fnt <- ogive(y)) knots(Fnt) ################################################### ### code chunk number 21: modeling.Rnw:319-320 ################################################### Fnt <- ogive(x) ################################################### ### code chunk number 22: modeling.Rnw:322-324 ################################################### quantile(x) Fnt(quantile(x)) ################################################### ### code chunk number 23: modeling.Rnw:329-330 ################################################### summary(x) ################################################### ### code chunk number 24: modeling.Rnw:340-342 ################################################### data("dental"); dental data("gdental"); gdental ################################################### ### code chunk number 25: modeling.Rnw:353-355 ################################################### emm(dental, order = 1:3) emm(gdental, order = 1:3) ################################################### ### code chunk number 26: modeling.Rnw:363-370 ################################################### lev <- elev(dental) lev(knots(lev)) plot(lev, type = "o", pch = 19) lev <- elev(gdental) lev(knots(lev)) plot(lev, type = "o", pch = 19) ################################################### ### code chunk number 27: modeling.Rnw:374-377 ################################################### par(mfrow = c(1, 2)) plot(elev(dental), type = "o", pch = 19) plot(elev(gdental), type = "o", pch = 19) ################################################### ### code chunk number 28: modeling.Rnw:446-447 ################################################### op <- options(warn = -1) # hide warnings from mde() ################################################### ### code chunk number 29: modeling.Rnw:449-455 ################################################### mde(gdental, pexp, start = list(rate = 1/200), measure = "CvM") mde(gdental, pexp, start = list(rate = 1/200), measure = "chi-square") mde(gdental, levexp, start = list(rate = 1/200), measure = "LAS") ################################################### ### code chunk number 30: modeling.Rnw:457-458 ################################################### options(op) # restore warnings ################################################### ### code chunk number 31: modeling.Rnw:467-470 (eval = FALSE) ################################################### ## mde(gdental, ppareto, ## start = list(shape = 3, scale = 600), ## measure = "CvM") ################################################### ### code chunk number 32: modeling.Rnw:472-475 ################################################### out <- try(mde(gdental, ppareto, start = list(shape = 3, scale = 600), measure = "CvM"), silent = TRUE) cat(sub(", scale", ",\n scale", out)) ################################################### ### code chunk number 33: modeling.Rnw:481-487 ################################################### pparetolog <- function(x, logshape, logscale) ppareto(x, exp(logshape), exp(logscale)) (p <- mde(gdental, pparetolog, start = list(logshape = log(3), logscale = log(600)), measure = "CvM")) ################################################### ### code chunk number 34: modeling.Rnw:490-491 ################################################### exp(p$estimate) ################################################### ### code chunk number 35: modeling.Rnw:591-598 ################################################### f <- coverage(pdf = dgamma, cdf = pgamma, deductible = 1, limit = 10) f f(0, shape = 5, rate = 1) f(5, shape = 5, rate = 1) f(9, shape = 5, rate = 1) f(12, shape = 5, rate = 1) ################################################### ### code chunk number 36: modeling.Rnw:616-619 ################################################### x <- rgamma(100, 2, 0.5) y <- pmin(x[x > 1], 9) op <- options(warn = -1) # hide warnings from fitdistr() ################################################### ### code chunk number 37: modeling.Rnw:621-623 ################################################### library(MASS) fitdistr(y, f, start = list(shape = 2, rate = 0.5)) ################################################### ### code chunk number 38: modeling.Rnw:625-626 ################################################### options(op) # restore warnings actuar/inst/doc/risk.R0000644000176200001440000002233114522557740014362 0ustar liggesusers### R code from vignette source 'risk.Rnw' ################################################### ### code chunk number 1: risk.Rnw:17-19 ################################################### library(actuar) options(width = 52, digits = 4) ################################################### ### code chunk number 2: risk.Rnw:159-185 ################################################### fu <- discretize(plnorm(x), method = "upper", from = 0, to = 5) fl <- discretize(plnorm(x), method = "lower", from = 0, to = 5) fr <- discretize(plnorm(x), method = "rounding", from = 0, to = 5) fb <- discretize(plnorm(x), method = "unbiased", from = 0, to = 5, lev = levlnorm(x)) par(mfrow = c(2, 2), mar = c(5, 2, 4, 2)) curve(plnorm(x), from = 0, to = 5, lwd = 2, main = "Upper", ylab = "F(x)") plot(stepfun(0:4, diffinv(fu)), pch = 20, add = TRUE) curve(plnorm(x), from = 0, to = 5, lwd = 2, main = "Lower", ylab = "F(x)") plot(stepfun(0:5, diffinv(fl)), pch = 20, add = TRUE) curve(plnorm(x), from = 0, to = 5, lwd = 2, main = "Rounding", ylab = "F(x)") plot(stepfun(0:4, diffinv(fr)), pch = 20, add = TRUE) curve(plnorm(x), from = 0, to = 5, lwd = 2, main = "Unbiased", ylab = "F(x)") plot(stepfun(0:5, diffinv(fb)), pch = 20, add = TRUE) ## curve(plnorm(x), from = 0, to = 5, lwd = 2, ylab = "F(x)") ## par(col = "blue") ## plot(stepfun(0:4, diffinv(fu)), pch = 19, add = TRUE) ## par(col = "red") ## plot(stepfun(0:5, diffinv(fl)), pch = 19, add = TRUE) ## par(col = "green") ## plot(stepfun(0:4, diffinv(fr)), pch = 19, add = TRUE) ## par(col = "magenta") ## plot(stepfun(0:5, diffinv(fb)), pch = 19, add = TRUE) ## legend(3, 0.3, legend = c("upper", "lower", "rounding", "unbiased"), ## col = c("blue", "red", "green", "magenta"), lty = 1, pch = 19, ## text.col = "black") ################################################### ### code chunk number 3: risk.Rnw:199-204 (eval = FALSE) ################################################### ## fx <- discretize(pgamma(x, 2, 1), method = "upper", ## from = 0, to = 17, step = 0.5) ## fx <- discretize(pgamma(x, 2, 1), method = "unbiased", ## lev = levgamma(x, 2, 1), ## from = 0, to = 17, step = 0.5) ################################################### ### code chunk number 4: risk.Rnw:324-331 ################################################### fx <- discretize(pgamma(x, 2, 1), method = "unbiased", from = 0, to = 22, step = 0.5, lev = levgamma(x, 2, 1)) Fs <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx, lambda = 10, x.scale = 0.5) summary(Fs) ################################################### ### code chunk number 5: risk.Rnw:335-339 ################################################### Fsc <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx, lambda = 5, convolve = 1, x.scale = 0.5) summary(Fsc) ################################################### ### code chunk number 6: risk.Rnw:343-344 ################################################### knots(Fs) ################################################### ### code chunk number 7: risk.Rnw:348-350 (eval = FALSE) ################################################### ## plot(Fs, do.points = FALSE, verticals = TRUE, ## xlim = c(0, 60)) ################################################### ### code chunk number 8: risk.Rnw:354-355 ################################################### plot(Fs, do.points = FALSE, verticals = TRUE, xlim = c(0, 60)) ################################################### ### code chunk number 9: risk.Rnw:366-369 ################################################### mean(Fs) quantile(Fs) quantile(Fs, 0.999) ################################################### ### code chunk number 10: risk.Rnw:374-375 ################################################### diff(Fs) ################################################### ### code chunk number 11: risk.Rnw:397-399 ################################################### VaR(Fs) CTE(Fs) ################################################### ### code chunk number 12: risk.Rnw:407-433 ################################################### fx.u <- discretize(pgamma(x, 2, 1), from = 0, to = 22, step = 0.5, method = "upper") Fs.u <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx.u, lambda = 10, x.scale = 0.5) fx.l <- discretize(pgamma(x, 2, 1), from = 0, to = 22, step = 0.5, method = "lower") Fs.l <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx.l, lambda = 10, x.scale = 0.5) Fs.n <- aggregateDist("normal", moments = c(20, 60)) Fs.s <- aggregateDist("simulation", model.freq = expression(y = rpois(10)), model.sev = expression(y = rgamma(2, 1)), nb.simul = 10000) par(col = "black") plot(Fs, do.points = FALSE, verticals = TRUE, xlim = c(0, 60), sub = "") par(col = "blue") plot(Fs.u, do.points = FALSE, verticals = TRUE, add = TRUE, sub = "") par(col = "red") plot(Fs.l, do.points = FALSE, verticals = TRUE, add = TRUE, sub = "") par(col = "green") plot(Fs.s, do.points = FALSE, verticals = TRUE, add = TRUE, sub = "") par(col = "magenta") plot(Fs.n, add = TRUE, sub = "") legend(30, 0.4, c("recursive + unbiased", "recursive + upper", "recursive + lower", "simulation", "normal approximation"), col = c("black", "blue", "red", "green", "magenta"), lty = 1, text.col = "black") ################################################### ### code chunk number 13: risk.Rnw:525-527 ################################################### adjCoef(mgf.claim = mgfexp(x), mgf.wait = mgfexp(x, 2), premium.rate = 2.4, upper = 1) ################################################### ### code chunk number 14: risk.Rnw:557-564 ################################################### mgfx <- function(x, y) mgfexp(x * y) p <- function(x) 2.6 * x - 0.2 rho <- adjCoef(mgfx, mgfexp(x, 2), premium = p, upper = 1, reins = "prop", from = 0, to = 1) rho(c(0.75, 0.8, 0.9, 1)) plot(rho) ################################################### ### code chunk number 15: risk.Rnw:569-570 ################################################### plot(rho) ################################################### ### code chunk number 16: risk.Rnw:670-674 ################################################### psi <- ruin(claims = "e", par.claims = list(rate = 5), wait = "e", par.wait = list(rate = 3)) psi psi(0:10) ################################################### ### code chunk number 17: risk.Rnw:679-680 ################################################### op <- options(width=50) ################################################### ### code chunk number 18: risk.Rnw:682-686 ################################################### ruin(claims = "e", par.claims = list(rate = c(3, 7), weights = 0.5), wait = "e", par.wait = list(rate = 3)) ################################################### ### code chunk number 19: risk.Rnw:692-698 ################################################### prob <- c(0.5614, 0.4386) rates <- matrix(c(-8.64, 0.101, 1.997, -1.095), 2, 2) ruin(claims = "p", par.claims = list(prob = prob, rates = rates), wait = "e", par.wait = list(rate = c(5, 1), weights = c(0.4, 0.6))) ################################################### ### code chunk number 20: risk.Rnw:704-710 ################################################### psi <- ruin(claims = "p", par.claims = list(prob = prob, rates = rates), wait = "e", par.wait = list(rate = c(5, 1), weights = c(0.4, 0.6))) plot(psi, from = 0, to = 50) ################################################### ### code chunk number 21: risk.Rnw:712-713 ################################################### options(op) ################################################### ### code chunk number 22: risk.Rnw:718-719 ################################################### plot(psi, from = 0, to = 50) ################################################### ### code chunk number 23: risk.Rnw:788-798 ################################################### f.L <- discretize(ppareto(x, 4, 4), from = 0, to = 200, step = 1, method = "lower") f.U <- discretize(ppareto(x, 4, 4), from = 0, to = 200, step = 1, method = "upper") F.L <- aggregateDist(method = "recursive", model.freq = "geometric", model.sev = f.L, prob = 1/6) F.U <- aggregateDist(method = "recursive", model.freq = "geometric", model.sev = f.U, prob = 1/6) ################################################### ### code chunk number 24: risk.Rnw:804-810 ################################################### psi.L <- function(u) 1 - F.U(u) psi.U <- function(u) 1 - F.L(u) u <- seq(0, 50, by = 5) cbind(lower = psi.L(u), upper = psi.U(u)) curve(psi.L, from = 0, to = 100, col = "blue") curve(psi.U, add = TRUE, col = "green") ################################################### ### code chunk number 25: risk.Rnw:815-817 ################################################### curve(psi.L, from = 0, to = 100, col = "blue") curve(psi.U, add = TRUE, col = "green") actuar/inst/doc/modeling.Rnw0000644000176200001440000005154114370340204015544 0ustar liggesusers\input{share/preamble} %\VignetteIndexEntry{Loss distributions modeling} %\VignettePackage{actuar} %\SweaveUTF8 \title{Loss modeling features of \pkg{actuar}} \author{Christophe Dutang \\ Université Paris Dauphine \\[3ex] Vincent Goulet \\ Université Laval \\[3ex] Mathieu Pigeon \\ Université du Québec à Montréal} \date{} <>= library(actuar) options(width = 52, digits = 4) @ \begin{document} \maketitle \section{Introduction} \label{sec:introduction} One important task of actuaries is the modeling of claim amount and claim count distributions for ratemaking, loss reserving or other risk evaluation purposes. Package \pkg{actuar} features many support functions for loss distributions modeling: \begin{enumerate} \item support for heavy tail continuous distributions useful in loss severity modeling; \item support for phase-type distributions for ruin theory; \item functions to compute raw moments, limited moments and the moment generating function (when it exists) of continuous distributions; \item support for zero-truncated and zero-modified extensions of the discrete distributions commonly used in loss frequency modeling; \item extensive support of grouped data; \item functions to compute empirical raw and limited moments; \item support for minimum distance estimation using three different measures; \item treatment of coverage modifications (deductibles, limits, inflation, coinsurance). \end{enumerate} Vignette \code{"distributions"} covers the points 1--4 above in great detail. This document concentrates on points 5--8. \section{Grouped data} \label{sec:grouped-data} Grouped data is data represented in an interval-frequency manner. Typically, a grouped data set will report that there were $n_j$ claims in the interval $(c_{j - 1}, c_j]$, $j = 1, \dots, r$ (with the possibility that $c_r = \infty$). This representation is much more compact than an individual data set --- where the value of each claim is known --- but it also carries far less information. Now that storage space in computers has essentially become a non issue, grouped data has somewhat fallen out of fashion. Still, grouped data remains useful as a means to represent data, if only graphically --- for example, a histogram is nothing but a density approximation for grouped data. Moreover, various parameter estimation techniques rely on grouped data. For these reasons, \pkg{actuar} provides facilities to store, manipulate and summarize grouped data. A standard storage method is needed since there are many ways to represent grouped data in the computer: using a list or a matrix, aligning $n_j$ with $c_{j - 1}$ or with $c_j$, omitting $c_0$ or not, etc. With appropriate extraction, replacement and summary methods, manipulation of grouped data becomes similar to that of individual data. Function \code{grouped.data} creates a grouped data object similar to --- and inheriting from --- a data frame. The function accepts two types of input: \begin{enumerate} \item a vector of group boundaries $c_0, c_1, \dots, c_r$ and one or more vectors of group frequencies $n_1, \dots, n_r$ (note that there should be one more group boundary than group frequencies); \item individual data $x_1, \dots, x_n$ and either a vector of breakpoints $c_1, \dots, c_r$, a number $r$ of breakpoints or an algorithm to determine the latter. \end{enumerate} In the second case, \code{grouped.data} will group the individual data using function \code{hist}. The function always assumes that the intervals are contiguous. \begin{example} \label{ex:grouped.data-1} Consider the following already grouped data set: \begin{center} \begin{tabular}{lcc} \toprule Group & Frequency (Line 1) & Frequency (Line 2) \\ \midrule $(0, 25]$ & 30 & 26 \\ $(25, 50]$ & 31 & 33 \\ $(50, 100]$ & 57 & 31 \\ $(100, 150]$ & 42 & 19 \\ $(150, 250]$ & 65 & 16 \\ $(250, 500]$ & 84 & 11 \\ \bottomrule \end{tabular} \end{center} We can conveniently and unambiguously store this data set in R as follows: <>= x <- grouped.data(Group = c(0, 25, 50, 100, 150, 250, 500), Line.1 = c(30, 31, 57, 42, 65, 84), Line.2 = c(26, 33, 31, 19, 16, 11)) @ Internally, object \code{x} is a list with class <>= class(x) @ The package provides a suitable \code{print} method to display grouped data objects in an intuitive manner: <>= x @ \qed \end{example} \begin{example} \label{ex:grouped.data-2} Consider Data Set~B of \citet[Table~11.2]{LossModels4e}: \begin{center} \begin{tabular}{*{10}{r}} 27 & 82 & 115 & 126 & 155 & 161 & 243 & 294 & 340 & 384 \\ 457 & 680 & 855 & 877 & 974 & \numprint{1193} & \numprint{1340} & \numprint{1884} & \numprint{2558} & \numprint{15743} \end{tabular} \end{center} We can represent this data set as grouped data using either an automatic or a suggested number of groups (see \code{?hist} for details): <>= y <- c( 27, 82, 115, 126, 155, 161, 243, 294, 340, 384, 457, 680, 855, 877, 974, 1193, 1340, 1884, 2558, 15743) grouped.data(y) grouped.data(y, breaks = 5) @ The above grouping methods use equi-spaced breaks. This is rarely appropriate for heavily skewed insurance data. For this reason, \code{grouped.data} also supports specified breakpoints (or group boundaries): <>= grouped.data(y, breaks = c(0, 100, 200, 350, 750, 1200, 2500, 5000, 16000)) @ \qed \end{example} The package supports the most common extraction and replacement methods for \code{"grouped.data"} objects using the usual \code{[} and \code{[<-} operators. In particular, the following extraction operations are supported. (In the following, object \code{x} is the grouped data object of \autoref{ex:grouped.data-1}.) <>= x <- grouped.data(Group = c(0, 25, 50, 100, 150, 250, 500), Line.1 = c(30, 31, 57, 42, 65, 84), Line.2 = c(26, 33, 31, 19, 16, 11)) @ \begin{enumerate}[i)] \item Extraction of the vector of group boundaries (the first column): <>= x[, 1] @ \item Extraction of the vector or matrix of group frequencies (the second and third columns): <>= x[, -1] @ \item Extraction of a subset of the whole object (first three lines): <>= x[1:3, ] @ \end{enumerate} Notice how extraction results in a simple vector or matrix if either of the group boundaries or the group frequencies are dropped. As for replacement operations, the package implements the following. \begin{enumerate}[i)] \item Replacement of one or more group frequencies: <>= x[1, 2] <- 22; x x[1, c(2, 3)] <- c(22, 19); x @ \item Replacement of the boundaries of one or more groups: <>= x[1, 1] <- c(0, 20); x x[c(3, 4), 1] <- c(55, 110, 160); x @ \end{enumerate} It is not possible to replace the boundaries and the frequencies simultaneously. The mean of grouped data is \begin{equation} \hat{\mu} = \frac{1}{n} \sum_{j = 1}^r a_j n_j, \end{equation} where $a_j = (c_{j - 1} + c_j)/2$ is the midpoint of the $j$th interval, and $n = \sum_{j = 1}^r n_j$, whereas the variance is \begin{equation} \frac{1}{n} \sum_{j = 1}^r n_j (a_j - \hat{\mu})^2. \end{equation} The standard deviation is the square root of the variance. The package defines methods to easily compute the above descriptive statistics: <>= mean(x) var(x) sd(x) @ Higher empirical moments can be computed with \code{emm}; see \autoref{sec:empirical-moments}. The R function \code{hist} splits individual data into groups and draws an histogram of the frequency distribution. The package introduces a method for already grouped data. Only the first frequencies column is considered (see \autoref{fig:histogram} for the resulting graph): <>= hist(x[, -3]) @ \begin{figure}[t] \centering <>= hist(x[, -3]) @ \caption{Histogram of a grouped data object} \label{fig:histogram} \end{figure} \begin{rem} One will note that for an individual data set like \code{y} of \autoref{ex:grouped.data-2}, the following two expressions yield the same result: <>= hist(y) hist(grouped.data(y)) @ \end{rem} R has a function \code{ecdf} to compute the empirical cdf $F_n(x)$ of an individual data set: \begin{equation} \label{eq:ecdf} F_n(x) = \frac{1}{n} \sum_{j = 1}^n I\{x_j \leq x\}, \end{equation} where $I\{\mathcal{A}\} = 1$ if $\mathcal{A}$ is true and $I\{\mathcal{A}\} = 0$ otherwise. The function returns a \code{"function"} object to compute the value of $F_n(x)$ in any $x$. The approximation of the empirical cdf for grouped data is called an ogive \citep{LossModels4e,HoggKlugman}. It is obtained by joining the known values of $F_n(x)$ at group boundaries with straight line segments: \begin{equation} \tilde{F}_n(x) = \begin{cases} 0, & x \leq c_0 \\ \dfrac{(c_j - x) F_n(c_{j-1}) + (x - c_{j-1}) F_n(c_j)}{% c_j - c_{j - 1}}, & c_{j-1} < x \leq c_j \\ 1, & x > c_r. \end{cases} \end{equation} The package includes a generic function \code{ogive} with methods for individual and for grouped data. The function behaves exactly like \code{ecdf}. \begin{example} \label{ex:ogive} Consider first the grouped data set of \autoref{ex:grouped.data-1}. Function \code{ogive} returns a function to compute the ogive $\tilde{F}_n(x)$ in any point: <>= (Fnt <- ogive(x)) @ Methods for functions \code{knots} and \code{plot} allow, respectively, to obtain the knots $c_0, c_1, \dots, c_r$ of the ogive and to draw a graph (see \autoref{fig:ogive}): <>= knots(Fnt) Fnt(knots(Fnt)) plot(Fnt) @ \begin{figure}[t] \centering <>= plot(Fnt) @ \caption{Ogive of a grouped data object} \label{fig:ogive} \end{figure} To add further symmetry between functions \code{hist} and \code{ogive}, the latter also accepts in argument a vector individual data. It will call \code{grouped.data} and then computes the ogive. (Below, \code{y} is the individual data set of \autoref{ex:grouped.data-2}.) <>= (Fnt <- ogive(y)) knots(Fnt) @ \qed \end{example} A method of function \code{quantile} for grouped data objects returns linearly smoothed quantiles, that is, the inverse of the ogive evaluated at various points: <>= Fnt <- ogive(x) @ <>= quantile(x) Fnt(quantile(x)) @ Finally, a \code{summary} method for grouped data objects returns the quantiles and the mean, as is usual for individual data: <>= summary(x) @ \section{Data sets} \label{sec:data-sets} This is certainly not the most spectacular feature of \pkg{actuar}, but it remains useful for illustrations and examples: the package includes the individual dental claims and grouped dental claims data of \cite{LossModels4e}: <>= data("dental"); dental data("gdental"); gdental @ \section{Calculation of empirical moments} \label{sec:empirical-moments} The package provides two functions useful for estimation based on moments. First, function \code{emm} computes the $k$th empirical moment of a sample, whether in individual or grouped data form. For example, the following expressions compute the first three moments for individual and grouped data sets: <>= emm(dental, order = 1:3) emm(gdental, order = 1:3) @ Second, in the same spirit as \code{ecdf} and \code{ogive}, function \code{elev} returns a function to compute the empirical limited expected value --- or first limited moment --- of a sample for any limit. Again, there are methods for individual and grouped data (see \autoref{fig:elev} for the graphs): <>= lev <- elev(dental) lev(knots(lev)) plot(lev, type = "o", pch = 19) lev <- elev(gdental) lev(knots(lev)) plot(lev, type = "o", pch = 19) @ \begin{figure}[t] \centering <>= par(mfrow = c(1, 2)) plot(elev(dental), type = "o", pch = 19) plot(elev(gdental), type = "o", pch = 19) @ \caption{Empirical limited expected value function of an individual data object (left) and a grouped data object (right)} \label{fig:elev} \end{figure} \section{Minimum distance estimation} \label{sec:minimum-distance} Two methods are widely used by actuaries to fit models to data: maximum likelihood and minimum distance. The first technique applied to individual data is well covered by function \code{fitdistr} of the package \pkg{MASS} \citep{MASS}. The second technique minimizes a chosen distance function between theoretical and empirical distributions. Package \pkg{actuar} provides function \code{mde}, very similar in usage and inner working to \code{fitdistr}, to fit models according to any of the following three distance minimization methods. \begin{enumerate} \item The Cramér-von~Mises method (\code{CvM}) minimizes the squared difference between the theoretical cdf and the empirical cdf or ogive at their knots: \begin{equation} d(\theta) = \sum_{j = 1}^n w_j [F(x_j; \theta) - F_n(x_j; \theta)]^2 \end{equation} for individual data and \begin{equation} d(\theta) = \sum_{j = 1}^r w_j [F(c_j; \theta) - \tilde{F}_n(c_j; \theta)]^2 \end{equation} for grouped data. Here, $F(x)$ is the theoretical cdf of a parametric family, $F_n(x)$ is the empirical cdf, $\tilde{F}_n(x)$ is the ogive and $w_1 \geq 0, w_2 \geq 0, \dots$ are arbitrary weights (defaulting to $1$). \item The modified chi-square method (\code{chi-square}) applies to grouped data only and minimizes the squared difference between the expected and observed frequency within each group: \begin{equation} d(\theta) = \sum_{j = 1}^r w_j [n (F(c_j; \theta) - F(c_{j - 1}; \theta)) - n_j]^2, \end{equation} where $n = \sum_{j = 1}^r n_j$. By default, $w_j = n_j^{-1}$. \item The layer average severity method (\code{LAS}) applies to grouped data only and minimizes the squared difference between the theoretical and empirical limited expected value within each group: \begin{equation} d(\theta) = \sum_{j = 1}^r w_j [\LAS(c_{j - 1}, c_j; \theta) - \tilde{\LAS}_n(c_{j - 1}, c_j; \theta)]^2, \end{equation} where $\LAS(x, y) = \E{X \wedge y} - \E{X \wedge x}$, % $\tilde{\LAS}_n(x, y) = \tilde{E}_n[X \wedge y] - \tilde{E}_n[X \wedge x]$ and $\tilde{E}_n[X \wedge x]$ is the empirical limited expected value for grouped data. \end{enumerate} The arguments of \code{mde} are a data set, a function to compute $F(x)$ or $\E{X \wedge x}$, starting values for the optimization procedure and the name of the method to use. The empirical functions are computed with \code{ecdf}, \code{ogive} or \code{elev}. \begin{example} \label{ex:mde} The expressions below fit an exponential distribution to the grouped dental data set, as per example~2.21 of \cite{LossModels}: <>= op <- options(warn = -1) # hide warnings from mde() @ <>= mde(gdental, pexp, start = list(rate = 1/200), measure = "CvM") mde(gdental, pexp, start = list(rate = 1/200), measure = "chi-square") mde(gdental, levexp, start = list(rate = 1/200), measure = "LAS") @ <>= options(op) # restore warnings @ \qed \end{example} It should be noted that optimization is not always as simple to achieve as in \autoref{ex:mde}. For example, consider the problem of fitting a Pareto distribution to the same data set using the Cramér--von~Mises method: <>= mde(gdental, ppareto, start = list(shape = 3, scale = 600), measure = "CvM") @ <>= out <- try(mde(gdental, ppareto, start = list(shape = 3, scale = 600), measure = "CvM"), silent = TRUE) cat(sub(", scale", ",\n scale", out)) @ Working in the log of the parameters often solves the problem since the optimization routine can then flawlessly work with negative parameter values: <>= pparetolog <- function(x, logshape, logscale) ppareto(x, exp(logshape), exp(logscale)) (p <- mde(gdental, pparetolog, start = list(logshape = log(3), logscale = log(600)), measure = "CvM")) @ The actual estimators of the parameters are obtained with <>= exp(p$estimate) @ %$ This procedure may introduce additional bias in the estimators, though. \section{Coverage modifications} \label{sec:coverage} Let $X$ be the random variable of the actual claim amount for an insurance policy, $Y^L$ be the random variable of the amount paid per loss and $Y^P$ be the random variable of the amount paid per payment. The terminology for the last two random variables refers to whether or not the insurer knows that a loss occurred. Now, the random variables $X$, $Y^L$ and $Y^P$ will differ if any of the following coverage modifications are present for the policy: an ordinary or a franchise deductible, a limit, coinsurance or inflation adjustment \cite[see][chapter~8 for precise definitions of these terms]{LossModels4e}. \autoref{tab:coverage} summarizes the definitions of $Y^L$ and $Y^P$. \begin{table} \centering \begin{tabular}{lll} \toprule Coverage modification & Per-loss variable ($Y^L$) & Per-payment variable ($Y^P$)\\ \midrule Ordinary deductible ($d$) & $\begin{cases} 0, & X \leq d \\ X - d, & X > d \end{cases}$ & $\begin{cases} X - d, & X > d \end{cases}$ \medskip \\ Franchise deductible ($d$) & $\begin{cases} 0, & X \leq d \\ X, & X > d \end{cases}$ & $\begin{cases} X, & X > d \end{cases} $ \medskip \\ Limit ($u$) & $\begin{cases} X, & X \leq u \\ u, & X > u \end{cases}$ & $\begin{cases} X, & X \leq u \\ u, & X > u \end{cases}$ \bigskip \\ Coinsurance ($\alpha$) & $\alpha X$ & $\alpha X$ \medskip \\ Inflation ($r$) & $(1 + r)X$ & $(1 + r)X$ \\ \bottomrule \end{tabular} \caption{Coverage modifications for per-loss variable ($Y^L$) and per-payment variable ($Y^P$) as defined in \cite{LossModels4e}.} \label{tab:coverage} \end{table} Often, one will want to use data $Y^P_1, \dots, Y^P_n$ (or $Y^L_1, \dots, Y^L_n$) from the random variable $Y^P$ ($Y^L$) to fit a model on the unobservable random variable $X$. This requires expressing the pdf or cdf of $Y^P$ ($Y^L$) in terms of the pdf or cdf of $X$. Function \code{coverage} of \pkg{actuar} does just that: given a pdf or cdf and any combination of the coverage modifications mentioned above, \code{coverage} returns a function object to compute the pdf or cdf of the modified random variable. The function can then be used in modeling like any other \code{dfoo} or \code{pfoo} function. \begin{example} \label{ex:coverage} Let $Y^P$ represent the amount paid by an insurer for a policy with an ordinary deductible $d$ and a limit $u - d$ (or maximum covered loss of $u$). Then the definition of $Y^P$ is \begin{equation} Y^P = \begin{cases} X - d, & d \leq X \leq u \\ u - d, & X \geq u \end{cases} \end{equation} and its pdf is \begin{equation} \label{eq:pdf-YP} f_{Y^P}(y) = \begin{cases} 0, & y = 0 \\ \dfrac{f_X(y + d)}{1 - F_X(d)}, & 0 < y < u - d \\ \dfrac{1 - F_X(u)}{1 - F_X(d)}, & y = u - d \\ 0, & y > u - d. \end{cases} \end{equation} Assume $X$ has a gamma distribution. Then an R function to compute the pdf \eqref{eq:pdf-YP} in any $y$ for a deductible $d = 1$ and a limit $u = 10$ is obtained with \code{coverage} as follows: <>= f <- coverage(pdf = dgamma, cdf = pgamma, deductible = 1, limit = 10) f f(0, shape = 5, rate = 1) f(5, shape = 5, rate = 1) f(9, shape = 5, rate = 1) f(12, shape = 5, rate = 1) @ \qed \end{example} Note how function \code{f} in the previous example is built specifically for the coverage modifications submitted and contains as little useless code as possible. The function returned by \code{coverage} may be used for various purposes, most notably parameter estimation, as the following example illustrates. \begin{example} Let object \code{y} contain a sample of claims amounts from policies with the deductible and limit of \autoref{ex:coverage}. One can fit a gamma distribution by maximum likelihood to the claim severity distribution as follows: <>= x <- rgamma(100, 2, 0.5) y <- pmin(x[x > 1], 9) op <- options(warn = -1) # hide warnings from fitdistr() @ <>= library(MASS) fitdistr(y, f, start = list(shape = 2, rate = 0.5)) @ <>= options(op) # restore warnings @ \qed \end{example} Vignette \code{"coverage"} contains more detailed formulas for the pdf and the cdf under various combinations of coverage modifications. \bibliography{actuar} \end{document} %%% Local Variables: %%% mode: noweb %%% TeX-master: t %%% coding: utf-8 %%% End: actuar/inst/doc/credibility.pdf0000644000176200001440000025246114522557771016302 0ustar liggesusers%PDF-1.5 % 17 0 obj <> stream xڭY+7 OD5 r/.vA ?SHE57foɻwsv?E߾?z vvo8Tv{\B^woιyLszq>7qXe~wy7"jU?~!!,iVQkA$_a)1b}sXD>=9 h|VWK'Ž݊:%9^Xc~+= L~)!ȲJM?ƒSkxDP8cE{ȳ5.P[u ɺ$J%%3M[ٽ=|7V?"M%a?(!$kErݎί,+*US*:@N9Wj6>j7- ޯ< S7\Ct8 VTՠ$NS?,>$\jPmꗵrY)uLWo{#.(ƣ$jl$!6`*Ke`-҂) W•pӅcLmf0k`72 ;)cl(n(|ٻ)}`%Q}5 lMo9yȲS>ه1HsG )CJ  )Y7 ^t"bg_UP%z 6BɈgȆmݳ$ZaF]^0 uh jolp'y;DRxlcuaSyy\ NmsL; /e=+Q<1~gl,#YurY2&d4Cֵ/l4Sa%x>ԴطSv3e)TJ 3UmvO1yZbz&N eC5>-'eI.o4}[@Эɟ<-1TRGʫQ2VNuA( &ynn@a9@E0Q}s];sLA'L#HpgfSݠitflu)sW;dK~i$R9(3i@pR/v> stream xڥY͎6 )C6@oiV`K^?,ɒ%^Q'aߘd$ ~}~C2)^'CJv3[Pϋ)7eE(/h(!\|!LRG{EҤ^h x) R[a$C_d24! {eZED}+Ш0AQ/aeyvOƵ&5G1 oy$c:\ Oۃ4*zu}(< kF `Qr [Zpa%^pf))sO_o ͰFÍ J;{ ."4ͦ1[hʦR~3B(b{KHĨOhB%v9Q,!A O GŬiō,],Jn>ՀS <06eXecq)h!Y_1AHxўW/.Vѓp1crvw@lطڦ5x11~1†6VH1CM0ı[+yjJZ u'zlkM\̵ȫ~Mȴ%.y!|i[TT}.Z˕@10ah@oWA>!5Tm%(7)$pS0xr))M$Caq)P6WxŎ~UKb-Rۏu4(K/DN]%7]5=~k2c<i]ϵIYc9\R8fͶ4#ܯ>g;[׻..H.cpcA]Nsdc$ۑkC$sĜ V `Dx9bL37|j2]r XJ9q7 yEnGnq.ȝ#9{I%-Ik5܅ש+k*:#SIKbzzE;xc'q:殹jFܥ]Knܵ95Wqi^),'dg꿦SGnaj{l%' –!_Au|tCJ+tUÝi˚VixM÷&s[>T77S*O"١gSj\*pu:OCX-{Z|pcM焲PǠZP90*?(eQM L2~ endstream endobj 51 0 obj <> stream xڵ[ˮ# + $ v6d~.vm.WQ AF~׿6/rdX~<%qv9i ҕ?\ 8gz]8pC/ =3N@_NBbtHt#O-e %aw?1)r!7D˄U heەNҶa? >9Jo0w/Z%HCj{;3I`1h2aX,@/qi#,H2? x-IpPrɔ|Gq  ,N/JLlD+}_-0(x$>!Ddֽg&Ȉ#s b"xcqGojc+Q7<1jek HQl5#K8'+}-ߓ> g.3 +?$oPtY I%:uQ-Hh0-)@'f·Κ!܋\id`Tث^Dw@=lTTkF3ʹ} D;2+TUp ҧʓnV8je ץfAPw!N=cN:͌ޘOk|&uC7g9aD2*L e&QD_GNyl4Ye6ˋ\+߸'c3oIHZ2d. ]$m+i^GzBmNF»)@EF͍!P"IttH@p$J|eI FmޤIߖ% J/s2dFkbFd!ST4rA5ZTU5?H-±TqxL6;Dd !eޛ=i1m¸)] PnHd]}k: ow1 '.MKɨXԝ\ C C;O%?6VCH][uTd*$/\sp"ɦnwo $\o;y6:iV4 Ht?#tR=H0tWp]6D@^)-Z̼5s>.ڧ:` ,S[2*!w*ZehmFBg(Kx5|UTq-JSy38]q$HN5 Fğ%llؙ]2 DZX-D؏(JW`,ol8d)NdY7xdR<ŀdo ( 5+Юb S 7 o5z=&i|zdx}ucՃKK\% B"^QK65ZlHZH)ofCk jD(Gʠnz^fGW3B2L8w K /gET, jF: $HLlȠ"s.] f${@ fCʧpHHC/lAV%|Q7HM8$`vKq-󭨟_ֹ:N>,Jir-.Q[W;H\ymo"7| UV7%&'Wkt)`5)9z홐lIgm9.SrQ=ɥfW>E(;z6>p>S#kGbْyG)Ŧx wV-?[D 5 @tK f8,&H ɔXc!mXdncvKF7u8l"_fJq :ʵ&F>@Ѱ qħ@J1gp4 i)U7_ R,v FRi.bB?t=82*>4\.#APLmHV*D>wdFr`J@|6Yf# #G2thZSTGQm؜^ *7۶'E-E- KVb=9 {b_7jߞ& fwP@_VΡ-|6'TJ'h9i[qYrt/'db6mR$=M^tEy{6^GBLiΨugԩoA+ׇ"wpMO\l^R:(E4G@qpvhvB&d5g3h|jL} ϛ֙NtUZe:fϵ #¾郢a:H]ꓩ]WlZYɴ[o8 لYҙUU#Y&&~ac)& 5 Clډ~Oך."r({<['LZ # !Ey(J:6*ePg[K㡱hY'9E.~gPMI:e8Q(?EϯلmCh&]~12>І3$N7ξ s^d0}a+F,!Eez:KY`L-5#S!`+u Qgm^-38cҟ N.#GDyGP~O)ڀM6MrY#67UыTnI칛jtM1Eٻ۞ OPPIT3>{Y endstream endobj 54 0 obj <> stream xZˎ# +J)QE$@v]E?dwϡT/\nOn$JC~勉G]dOWuBYmg'Ĝ>$=w?>b%_zvb xi$\re/]X&$TQrZėv$s||&`ǃlX9"A6 vT߸!$:&R!2=or]OE;rKz/GXؤ!|6ƻ8Go8!/tlHX?NdԠ ZcʎzVǺK2j:o W{bP\z|{++rT;ZX/ jjekلN^P oSAo4.n^RHp)bZo$|EohpEt1-h7@+ I[b /ҝy¹`}ֹ>LJJl,Hs(3h1F ׻`H$2@l>#B%ԇɓ!V% c?訜ھ֣Xv6 |2BSMJ2Lϲ8ƬOuY@I홪5"ߢX㢆8ZT 3$_G ڻvX[a Аr&%p[ZG(92JK DF pyq6hH#hl'H9^6#|?#d擑IV<)*&(3!zGZ0XMjy  ;axԚۡGB 6:D׀l$ceud (rʗnF>hf3NW/$jޙ 4cU\ ߵzr;rdUזA<=,H[+! ~(/-XW Ik0*Ҿ/UjQYlri3h2e W ԖuT9\}vŊPEL~z Z m"֎ +GH!/%3Hyi܊7::k3J3,vΘI$Ȕkp?Nam ѯ`12 9.#{U'XC&`DxOhE9# `":lǯPê.sA7BVf.AY!C{4Y6st' {9!yXCPAƽ r$HXFEr\Zs铍4d@z$CWZ  !pqLK>'FwMbkZ$Kd5q"ִFC+$<5= #ү`"/b%KxT- J`o8nipi(<˅\Oo,ipX6ĭFܰMcknJbN0¸myÉ4_{R>Wm)A6憻**FU S,RC- uvtܺm욍j槬}C's^WםVri3Y7, ʧvU>-B9b8/+p*rZ R,كVͩ-rVҕѷTMZʢA24 (JO훡{n/|k#ʭJ!ܷ;-ze-*#NVnȀ\#USU5+=T`T2AhaGM}6B@^IEZbgAJDXjNU A *{X{(yʒ7E^RZ56̰/Ƌ{q^f"S%/>'! FLFW|%^q,^2b5P1+>c?=Bkx̆:=<͏lt[8k}?p )ꔱY y6[zSڨq γp<{3,G)^G;^y#17$8[GvыTp^4|B-UhkX:ԆE i;q {ʃ{?hdo Sr&C4$dujۤQL';*Z!AB8Nvz endstream endobj 62 0 obj <> stream xɮ힯"R\CJ[,,S$ŝt-X4% +Dׯ?}YX@#,_3*u9U˗?~<4]yB>4;OxWz lM}&ȴc,,ӠyW!6L*3;d9?Ϙ_霱?g*1UD yr}} C V+U\ ɟ,\TBkuApD ֕.[~bi;2 6j@ !P34e˧/7p&@,Vit\6T$8Sλi{'IjD!NcPpA\'U("I ,RRAq H蔎Fhۊ3.+yGAy2Q^pVϓUFumX{Sz5Xn1<.s#\cg{KpOɀ'@jަ`qH*cx2ňä%w6qF`3fhb49+y 900!tH3^:-a$."V ȅQ$"zjؖ^"!Ю+ƛgShB^{r|ד=RJ<mZ.|,Ew?D5/!PG⒃lYe#)j ;dI;ҭ:iT,Dr7Av \0 !D)t8CpPƕ^V'9wQGe'tȌ'^6]N1өKp4x#M5FD1=7wh.H^ X.%v(,bUuUqVRY4ì %Τ^ ^FJZMN٫jw!-C!eU##v^{y":* fvasFݙĈ*9ud%;鍰5CQt`EaNMÈM"g?t'A^FOBͨND!xڮ\KtEcAwWn=ʍun]F?j5j?3]hIItXk&?T/22m|DʱLN"Ѕukt M^5'0!1tW}I8g{} ,I0?մd$gH6Ff1;PcnGpmmLQIK-޼;J?z}/mVR)jM9X;]UVDZ_4"Цc~,U58pHf:2'%;]|1 U;rUC3ٲ<0Jըa&Ԍ7<搧,=aj*}V6NGJ1c@0`܏}=xUث01RDںn-V' x t0˹ipi)!fElJr~7nǎhIJ 퀅c ~!MqU|*t/&5)kqD?66ٙRFh~–6H"8Z0G\mL4랳It[.i&cK%ُd- Uwħ/! 0/G'z쒠b-/a(lh6) tުQyl껻ܦI)9ٶ0Qtݤ?t~2T!dZLkOm&UgK:Jc<.bf1$enBy][Hv2`6YϹT(=f'G(޷hs^Nt Zc^ 5]EL>Юۙe:#Q@8.=*`{HS)Rjz)8u)`UWKM}ye&'eI*pvQֳj8Wфmnɭ$]-bXBӇ,e ^*YwWӱ ϥHI{![Qs|otԽx/CD&`/OdWYhjXe@kylӦEVsMŒͤbT`:u7#NG:s:O8 .R3`[pv=?铹t,@_fXwt|Gc4f#O^朠g* =SBAx)=\ 칭L XMu6i`_r)^i'Uf*[a΅55OQW[t黕d}bjWJLU=),E\=m~n5 endstream endobj 65 0 obj <> stream xWK6 WXE=,`0mG.!(Y=]"?>QR_(CN_n$S^}W阼`:ƨ`u ^}VyV}޿};Uyҗ`S>PEmou}AqۓhH샚0;t`OƸHc 8Hlj&^CiqrݵH[uJl֍+Z,(y~.,gO:m(,ڤY\F/.gwUIbBL pEU- PH308'^md؊V,͕!4`ζͳpX9ղǿMRt eX5Ht`<8`+`H+3b*r[fK$,CxkU|;l&Zr**W14U5L'[Vb"@Dȕ 2(neHZ}HE|-٩4&l7~m4LёVVCήy69Ρ;"SP\OAs6ş?\δhv_*'yu9ep5*3nmwBx}QfSgyePH6xwoexԱ:0q@qtm6n\Xs%lV&psƊn䴁6NGgyE)vpmGf..Y ުiS23 LL򒥪ķ*1!9b/# 8RC;و_<rU+ W \zK"7j#7\k_^z~~b_Wi(Е2Zt"+]4=)r=H+BOvts)Qlz>)6ZCkSӧE)pFRUץf endstream endobj 68 0 obj <> stream xX$7 u:A=jkoMIQݪ8YU%QIO--i +>Pt$YA@>8N|n=HP!~I+i!_>DRbN:gNZElwW?B+,~D@Љ'|>^hhbR bY]I(jR'c|O "J!+a rY4*NJ4Jm E͡f 1L0a!BT1($sȐU8w *`0[os@CP&]8*Xu!vr~'0Y$3׭*.prxWg}E׏U,*VTTby%M56Z*Vɠy4-#jMH=%){g9x FVޓ%*({z8cK:e]V*jR6I( 4fB({qK!ۂRJ".{ZY Z9Lx<=ͭEG;}5Rq+99; O Zd`RgQ%` Q襦$DjL2Ū1Š 3EtZ50ԥ.LBԥф[Q7GԧQ bDɚYȥQI抳jO}Ȩޢ~o+=@fmqd.t]W5L.5˘C\i@JSX`0 0dwP]e3xwVkw͢9-;48cwUؔ5}otCvrCwԬxtcdʺf=?-o z/w`L/_|^Syj}и!U_}qH8𻄌O&X6pMpAF+<;?ZjR >H1^nݖ{yr|i1o\6i㗵S?~_ endstream endobj 73 0 obj <> stream xYKE+꧴ "q 8^ 9$>_kz<7lt8c P#D'euf]hq7O- B3wgKq_  gQ]f;6]5:[X((,7f#ZG)<7ײKdeڎ,:dN/'Ib 2rqX LQaG,?Y&cӂ>A'ETțy͎R,)3!dP uBT=+qiB5D k"=q$ͼ~5 n\sgo6*dY_8G^2S1kWJSىT P `SeCm{-sTZ] +3dNJ>!6\ւ[jAA&̧.cGf؀Mft;zޖ&ŝ6sZ't}^6h|6*ٞ^VD]4dU";T51vVRvu!nt+@[z2 1\"#n1g鬝 o>,ч˩;\IV6Y`ZN,r9NU.5 ry;"QG{Hd-;F,-Ⱥ~-+lIaN走>z ?7(  !@HfSMoUxgN)?&%߶nkqXm od|SʙG^1%s P3S͓CZ$~Mjl4ZKrqQLڐS"\6=5%uJ<_h^5?^FKxaArXKе'7IceD0w9;E;L˂QU3ڳ7 ۖguXMmS)!FzQwgՎB6JغV^3ɴW,.pv-Gޜi֓UKLQ(:rqk?_⠠c}'‚TlT2̩JSߜ_5bso=JU0$WJmVڕKh}1G~Y^ ꍢ녞gr~g2ث XFq6QHqvJu2:Klf jq-}ѺT%fz?[=N>dqŠX&xx-<3p]T7=_6u/\nx1_(zH/ۀscsE ݿӑБ$>;Fud)HwdN{Ym9!Ts '~}{r!Kv|5KC.^nL5ʲv^jz75 endstream endobj 81 0 obj <> stream xZK7ﯨ?в$ 4@l`orKR38U*ėHh3KO/ ^b_w*fe[kV-^~FH\eit,A+H~v[W ~]>}J.T2v9Ĭ@c?GݍWi {TN|=\py+_`9 [&R˳n"q^W؅F83_]f0y& @@=0rO_ߧVXS-j֒pJ>+d]_j%dQ xym9.u=,P Xy.o[?i[Wl)^728 d^f)59F4 XY,sܚ̱Ie93y4|P' <˗vu4ϚB%Hm4Ïv02* rq`F^<^WdboU'ɓO(O/z6C2el`M[h\Ì_DZV67˭gHx+:STOj='6KL$<(Di< "Eaišs \1e>1_\ 8 |8ʈu~ 1 L-d9keYA4a/.,36abrQŰ_1m[(!P {`$MpoR+^Yi }΃Mk!> *;L[߈IGpd*k*`SYfcE`eg= |C͌4:闲 RLi;#L#}b#0PhХȏ/CW»hKLIKBatWzĩLʅ8jy܈n]v[fq6L "`㶉P 8}d} {Bnu[,C=p>9=9*Lw|4FHP(ɠ?A FŐv؎JUSzm}]5`h oK}C^C\Xl#߹z Ɔ/l~|)vwŪ12^SUD]1ӢvXB}`;6Tݱa} Z޴OeL=;@|ISC CI|n.ӓA37-C>g:S5sAc͌IDQ /E .7޶6뱱<̓&{L~-?*9V_rh#߽軗Hc,or }'ecP}J@j86k endstream endobj 87 0 obj <> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 88 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 862>> stream xڭVO[1 "G8`b;?m&1*8l-ӊ Ӏ1佗Ъ_c;>;NМ4Wp*û`ZkOop~aY hNs5CND̵@1g+ -GqZo3 ːd`o$7TyNޠOz-F˻-o$.$h 4'Y\=7ݢD~Kҝ}}Ze2Wzoz/Kl|Ѿ{Ⱦw3ɁgSERuz*zE2ٸ`o=8T p 5ɠ ԩrЉM]Sgݑ~"V b)p??+ t;j}(Rq6B3h3s?|u>;Hqo/s{4t}zJe&Ix6c $$Ǟ(Yujڬ8F=$T t@l_)e',%+N O=ZSthΨTL8!9ʾE'(+7(I8;(UB;Ř!S8[=[K:&$afK̖|T؎<9.b6zHif+ٖZleZ6)Z7YfA[zd%ۤYtlI:14|c?8\S,;:L֞VI'[|ĵdFތzbEns#+Gu0OPFVDPc~msʐRbAMPon)`i$N] ϳ]PQ:(=[l.}/fr,N^xh9msy}Z?Wn^zA} \7c0 endstream endobj 92 0 obj <> stream xڥX͎7 )J~FC6@oiVO.Y~)HcfQfFOer?;/o>_&8sUI zo2v3T/O&gMMO)Iyq6az:ΖlQ 9O>s9m:Kf<1tGmNܨ%uBm簚s )wX 35P!fעK{bi"jiͲaBOgAm<,欓Tg22_eI, ס,ywn_Ȓ;&O!Q8,XXt+psk55Z,~ޣ'a3)%{y̰]ЪECJSPzo io/)wfr DhA+R~]tKqg^ZF7 y #{t=x[Edzx*In $Mj%e{K]&7a?stV'1"|.ܯ|_+by]WІIE8#ޱK} TZ޿ hpoIT"Xݦn~;O! endstream endobj 97 0 obj <> stream xڽY˲6 +V~xLzBrlEAhtnK4 ԽIN~<}Ssm<}$')(η0\QG!|~M頥:UFD'/TNý5}c o>_a7scP-kf83;-_pw$S4jQSRt3ã4eT^S9`dI Zu7z{WVV⎐fŌJ6_励s56OlJG@=afLԝ{1v. c7@v4lCi>  6qrwH]s9D4I2C/l&F5g1|%h;6;">J(zXn,bځiZZ+:g5_2,Li^JO5PC%?_"\;mo#xWmJv-EI5X*I%lКP*ײi޳1+ OJ I RaXAoYF94 }!Mʒ,eZU]רFJe3#YsD4Kc_LO8O:R> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 104 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 870>> stream xڭVMO1 ϯVBj%J= U-TJ_' X}7Asb\_é>82gkgǟmp~aМjb`>9&3׆A7Ɯ=YWP[F``g@!ɠHn6PyNQao'=q F˻-5[ I n-Cqv%'Y\=7ݢF~Kҝ}}d o ;z_&}}> stream xڕUn0 )HQ$aV`n ;IK!GJ +–O's1hh?X^>/vw+Efl (n&)yo74G5fh dcNl%(g 8KDς;rx/ h!eB,C0}ޑck"gהtϕ`k*ںS&7M}>[I ͹A(K]Rs3jJ9.þ-9#i#i4 읏1H6(:QqϨx5)l4ynX*&5b7s|։`,a;b>ՠ&qjbKqǸT,I- PQy{&t Y!3<ڗUsKvP<覦jޮn 3*.\Ot6g_r0&ma y5?qPɦd?Lח֘> stream xɮ$힯hEvȡW_}ڗR1TDN,/_οwi7_K, /E f]v2#i㞛~WB?CWG4j4' ۙ~~ _/&$`w`~ p|p|\#/tMΫ8\Lk1?wlc=N BOGD?TDf1,#&gS* Q@*OA,t-#5gqT&aszGL$aE&Jp`{.O^ ' Im .I I&/u$`U[dߥR6_"L[)C+aԯr,~гR#n'=;b֮ϜNb;Y7 C4F#GOVo&4ɺXP$&yp\iE\>VbCbF[D:x?iDY#t0rg+=qĂa↍uwmDDNiZڠ97ֆgK~ao  CLK'aUG&tqu0ݮڸIq7gwQeNMDi2{F3Xg IzrNh_-aU^T:5D˟g2@"E4C,V,4tb@19S>n ~/>`>vw2t؂r J&j$lI:5%oC55&s@BCX7c΃G:GM?~ t=*/cCޅԽDU-u E#-9 C>Kұ-J*:lE?S@6L"$Ro\kDa>{yT-4PG7sAԨ󔫮\Y ʇX|d:O>Li8\Qn%q;d8;d+ ÿ>zq Y'?]Gi D5̋p9E}"exIO~ufe??!0|`@v7'!|@j$ZVgdviYssJj* N2|B@EQ@{&K5m,IKR%p/(06QV\rn*u$EX_+ ǑT\N"F 7`q]J +&Es6Q DgdK-][ z(LK7Nu~T As2C`:̏&P4O2|-0pn?ggҌ]KR_?\ (^ޑ( Isݯ<ìÙr %\ Vg>Hu3\}p%2}\ȴt4Lod&KNjlҦ`BWfIĖ5je::߮t}Nɢի̗/33%7v)Fί-BeA|O) Η68S<yV(7/9%eo:3vq}Che'i$Ys\iΏgI T-51PNi9#-E"5sWT]n,v\ rC^i(R3/-l*0,'4ue&Uy*kޕX7(QZ ,wYq+@ߚk^QQt89h5߲ͺ6d }U4ۈxSYzB0C[tVCOY ,޸t.%%`~N۷BP ot)PJAzZ_Yf[`u6"lohӹ#-q4)wh㮖y)]PFCCY0w{߱x ^4=>`52݅pπ|- yEGh1t m6۾g~_HOϺ(B@u.J;-p^ mul92|c\&omx&Hyri++y>BC> stream xZɎ+$`6}3|u.ÜwʬB))EZ<\n~/ߖ?M-J(Z=vY]TI%ҸWg%O|`y+q=p]Q8s4ѐ*,NPd{zo/ DT~u!e}B gSVD$HLùGc Ux>E)k<%a8*qQS(a#$뾧(gȪ o>h6ΆZ(󰩑wuT8m*joS7mD_p#UxϤJڲuDCOh*UhTwi賋5 ; 0; b u'FJ^+)-l&m༗罤v:Z74½5_Xzj5,y+;gKzIxBrKo#U%$˜H,xwv&`wyfW1(s v;kHݡ0'_ejNe t,.U&V8MXB.*ޒuw ?Ed@JRx06z%F|qX/_oWN5Hꯄ!xTw(e.DTYLu[=olM猆-dSDUϔY-:ZGi;2±):U,|e$)Y$)z9+J,@E.|GI%`VsVDUNHm-GM/mx.]l@R&J>Y#T# ܋fct |ɼ%3* {Mra-I!a|.Mp$X=x>AUMmh |TmB~SϤV'i5a%@ɇB3Hxg>eb ZP:f㓺ūץ}# /a@W2R ?oo#L;yoېڂcmnI?F۩jRԺ-޶~l> {)YOsݖJǪęq]E,34hJ=K̜"#~zdfMJ+G'S(rnj;^~-3rg"qf-@p{gO _³BDc=Kk`qCq񄥇ZQ_<[!slDTY~9m%1Q#RaF|Zێ5\jN[{{&ɝuM<~[#QZXA|`mݺƸ 8$-:CڴIsճ֩KhABNX:Dfn8#56{{ܸTm\CyFnngV%몔1˳z: zh:ʦQ)Cټ a#SnW}_MӦGK=Zԣ-LK9B1]\rAX#bKU £Yx:wF -`? VSyV DUsg˵x uOe:|eN?kEtKQ0+Bz!{f1~vc%"u4FR;fdc_ sD0;/0%ahF X . ,/kT'?'=|:]"}Wt+?[?@U&r=2UWo|,jWAjDFQBGԇ?$!LV+@^{k٠hgС҇/_*Ho6k&CZp:-,H 2$?(L#\dP諀]DuY"F oH־+1;3ntGĉ/݆P=19@âZ4E15=kJ[B$Ǩ՜zA״VmSO#/˵L;X'n&S45o<Կdx=m{-%Q=xc5 RDq̖Njo%.'axҪO$4ϸ<'\Y' endstream endobj 122 0 obj <> stream xXɎ6+bX*.@9[Co%>ؗ~g2H1Mj}F}VV~F]?꽌Ϯ?ԏ?Nb>=Yu~02G2v9bڕ+s/t7,U 0)g' tG#v@Bo=Dž9:[/1`#ߴ]"7eو쬝A[&|]/]HLBGIHQ-VtF$SeQ38luRG86` 9G@ԀW c xG<,tInAm<PܕFxKp:P ͰFg&WgYjzy "U~۴r\ L8YN݊#ѡpDeci*}*w1jɴTiäN8o[|۠Üf͸u9u+ azwRB:F郿4H^};1CT`b6g%Vz1+FvډDQS+w߁NjDhM[_Xs\we6$mm's]/{VlU[r "FFZ 1$4D1\7X>+t+}-R eІqNΘ9s6A'lMq-p֡pS3"j'}  p:7#i-8˹#7;aN7MCKڄP-45Ėr8)Qnk_wV c5i&mkKra̍.[֊rdh[9UJԹ[Vx2mpJz0~sSK Đ|qLcZ7B}iZRj@[5snP/#gw<2 `ƒo%Aq_iw:G|I&|1]sCjt^Yd/ը!'`Z(*jNRݒ`΂C}By-N/7K oZ/K[eJۮi~+_/?LRJ3ˈM};ᇿ[ endstream endobj 125 0 obj <> stream xY#7 VD0\H;d zN+x=e"?ɹ??9_ۯ_Z(mqzNF t^8M+G):EtZ襤^% yHDK yo^>B3s?~#`) B7 .N٤VR Y^*y˻⯤0k1l*ʗztΗDyHR"+0LY:kCn`E1mj+UUH+|`*;5Gڠ1 섃tx񓚿y?.v5Iو%YYVQ_%t+E>iNWq-}VCU@au~NXvVI֤}ͣFeB\ yu8 Dӗ`2̮v_V1d [[' v'UV-6L,hIgP)Okud7&=n%t2c'X/&ThY1ȑ|2INF"t:Wr'5Z +}fQl5ЦHɀDl[io}N8)Xt64t'{21NU ͥͻ5 I/V@EnG&ىJ,SۖYHr쟑LܛNt$kuu7 A':0f{IS.$\tt)%)\p] ҷ>"M²/[Zfe-wiu#AseȒPVu+עkmR[!h)}Ⱦ} !i:HsH~ZϹ;)p:,jq.z4*Z0u[:s-@MޚUVH }ܣ^~.y+8jMb4jD@X+s[P2U\1utn٪w4"z+aU*ê*GnZ-LugS'~ҔK!ߧdUTzn۹ \-ӈh0fڨ'~2{kM=TM M^}_K@%Y)i?m1!#-c)XqpM LfZj[Э;),O!L%cMlq+, D0{> SҽPL"uѥ&qY=Pؤ! j;.z+)'1EA"uEiCWvo6&6,-؁ (vv|j̾2n I%A^'I/ OZxìLPt89ؓXÇfgyׅx[,V(#q645`!]N;!<@\f"Tw %i1Գ:yZq4""AlvZx|K-X<(dbݷ;73B(ePM_'4VxӗAjg!P[Os&]cUZ}|SBK# g=9BzUx#Є_K.o9/&۹bv4`yZ.ѶpkD}(9(t-s^]-m!IX16bqq^󞉫75\r1] ~Ayek `TcZ:\ڨeT߃L" c-}i/? P-N endstream endobj 128 0 obj <> stream xWˎ6 +֊Cl[Cd{(ɏgg&A,f eY"Kd}먳.2mw_?SL҉31Do;kC:-وX~urg';PEo?nYȚl3--XGղe x։1v2dgΆ-{}LW9bnX q {ST!4 XU~Y d$5og7acqfxǰ4x9/?걽vdz9#=юh ^Č=WkG)tɉkKӫ%ZzI4w0 pm{']z#\;}|{ y7E~1$E:M8N6zbc%vsߏ(Tauc |.A3Yz2TFWeex5MĽ F"(;mEy+ư'W9pNJ'&\OkFbyA\]ŕ^6EpFpLDCMjԵT>jnzBeq &h&.~h15O-kP&<, rd++Te3,.PL-O(&*5o$ Drc~T(&4atl 8SR+)XIiUr(βpsSIpff%V+< }P|JMI2'cN}Jg c׌bU)P-,8!u]Ph(אJɄɣ".6CS!l9HuY‚MvZ0cÅ/*O:k4 Nhtn  ҞzgAȂXڄ{V0чy[zqUK;,Tn[8Xa?!M Y,o cN|o=A^=ݕW 俷W۫+lFlzz\@q0 7 / TC&^/T+9 ӢX )Py`Cx9 mgB!nG6G-}T!o9Kh4{qZX?8s-N4iS"('{<poY.TE] endstream endobj 131 0 obj <> stream xXˎ6 +fD 4|X "s rg.ÞS,{gv {dKEbUW^ԏ?bMI'V/ U#+Nkm\zN;{6xC~1ie/bt%Ck[nosb"Ic}8UӑvjZ0tTaG|`'0e_bHPx^ *2hiÇcMaeIkV6lZ@Q*M @5Q}QǑos%D0ѥHqr1Q}:cSCH97gQEVF=; 5-0伱cbb2L)0_4akzFnKM 2i)9'3l_akteDw js@fx nv ̟J֨i”쁕ػGJH]V6b0N_6ݳH0'Etwo7>%aS+w3kqUz@R5>V|M6k+K}ldzd16 R}H xfq./#O)ca+ ~)k!K5"YR0ቪBrᦄղCͲq)6ե4 $Gx){W /IjS'( )|NXuk 0ȧ 44ds)"IRڬl &JƷנJK2Bw:_ęO9.fb[ 78 9qBPptrMǥ^7o^)6dl \2?pMh+( }L$iq2b5Qp 1)PD#Qlp鵳%*!L5T&G`P!A_o vig :[WDv|\τ;P7L\v,vX6X ,;4uXKkbWĹtcJr ]Bpu=ۦjtyQx_t"B5}I./--goC4 O~>L2AU;jKAe.c-— $[:XO\}2*mzzej3'|A>kq6\V endstream endobj 134 0 obj <> stream xXn#7+ͰnC$@nVKds瑽b۲<3؍\^l2?d"יg;|l~ 9]&|1^lt!٨l#u#b?at r Ӵ,>~g䳕I<~N9p0UĈQerP[0<:駧IlЪIQOR/UpkWm.VK!`s eXF %gDf_4p%H5b!n`(&M3r  ,Џx엕 Z,q0j''+kݰغd3O-:fƒ(%e,.O8pnHvQ:Wh<'H;J0'".}Rȿ@op :#8K"LpXv$X Jq4'X@IE0CR7M'Uo\iV'a2@EuRО:)ώ<4g=H9Y ɺ:ndt1\z"DctQ\d@W hq a #=XO)N?}TW[f/VNwɕxmNn25jsRn=[܀h|MRz&]QaװQ %еxqZIA"{5Q;Q x'EtGP:G+:z@i(ŽhҺ΍1M=z/r}/8 ЧAK^'"eK KO[uEۀ|ûw)_]dR~^F"_FQD$(P4=C%&i6qiNNfwM+;+_OrIJץOkE+!gt5r2JE&+JE6S798@{ @[ t.Vz]ĶpZwt()W M&ky/U8/ejw Yor}w&bB҈Q.P~B숡ٚ=a].;>Da5C~SB ;+>^dm[E^w#æ/~Ono݇xCUh~#݇/?`qETĊ+x,$§Vu endstream endobj 137 0 obj <> stream xYˎ6+bd71I[\=SMQlS`cK񡮮nr/uß_Oݏ䎬6SzěSׇd"za.qoeJ4M&8]4pv4L;qqcm-LN-'9[KO!h렭8ն]8ێDZ%#οӒGo84L kǣ%/_[{\P'ƺ"7=tüba'}0Z3=:2c6dзkH|& ^z7npvF@' CepQ86 d;0Ƈ%*4W)T06RԊtl#b'Z"-0A "zd:HFH23#>*0o ap‹ ;*>#`)vt!L0s` ߻O ;͍hم'K`1hừ_E -yϡ tܰ d,8zg6B$ELalEZZ.F I*b yXLM=o҈91]8[dTIiJ{UMC|\2OВUrZiB QÛ4DVbc]C;mh/05OQ9IL* N&k$GM႗隔ǐ5Zg:0@RƒwW GrqA(:-dŐ$@;Xܙ`E"S->u-=N%܅mmPs/;Ej00F'6> &0; _kztl zdhV1}R?n&ȅ:OZS7B+ Z18yWKZ5 R!c=ћ2%&_ "Xݝ@\  %?>RqsAJ )o`Fd و۾c;ى[zJ95:fC]t*P<;ַTìJ5K =To<Q{]GbSmkY-'lǑnZݤX3ͪNkw!] LJ2bkw'Pq(Y Sy$Y> stream xZK WW^pE tbvEU_I=lg$3bHHL~йCojAϿvw{7Y|yz0À8Xhߝ~\|;_ .`d%7O~%˙`'}"=iA#AG¼&-9guK˛G큰Q H]hu(]dYIuM-`bGmAz`tc@6+-.W2&-L#+村ʣgeei1Ů$}2,^عکiX_ i2x1j-s7[O~^^icm{X]^䁢Y׻[Ff-]c;Q"wlU =yev`Ĕ no5lDl(o}ߡEMx]Fk&Σgx$v*%8a"kB_1'=W䍰,=#B#)߽PH3YXB|Y s;qrRwv* ;=_l0+=f,0;1 0.:ܲ$-^Rx"UI 诰ۺ$p ҏgU$x;x S;vl.|4HI¤kZ݄gAO£'3<[@ꂴ"OZ[( x7<~Q&,a (}/7ON mw 5'&n}:QSw8=B`M8MI䖄c'FG.ƾɱLR*lf{NG 3`EKJQU@ *@'}BČfIc;O="֓?Cʼ[Syjp9A|Փ g5ŧi[jxN%kTOYF0칚%׸5 v9U=*(v36Pqσ38ypWkc~C#`d6˷.<40wNKC+[vnL)1K:kD p@ J1СM.o [EC^LW99* At'I[錖oBD84~mol)ĹW$%\c}jd7 +^y=/{탩$_l҃- -m+Uc}$}Ųkޏ'›rۤD<Cl >N)iAݽ]rW9TJOl>Sʱy.rpeZr "}Km=gү#*dC"%0 ɨ2+٣uWָN9DZ(ț=]]V,Xe.t2P:ab.dvK}L}e&${;Eˣʒ3k+Įu֣HUD{M ̓Ω"&BR]]\4iYn'.5BݿicYJ~4lr{7:KlZi@hk9\xmoV Zy=ǾB˭Y'h5ޓ}݂V9pٴ-/,ٍz-E"0xZ4@$YjZדd ouz/{9â+E%58A:$k5Ru{=.?MB|$k'}jb1^qgaAYIطl\o\J;6Q1j@ {[XGQUb|H \:SP_Pcx)c|'y9Ԛb__[[ao:.m][W`]3*-X ;\h\ЂTS(F? cV':laQ<_T/.d4.';/2"=mґqrY<\X̳"{ey\徺)/8ӄ%QiB׾;1Ni‡t[ endstream endobj 13 0 obj <> stream x\Yz}GOTwU!@b[ 9鑘!e.sNUo\z(ka]U]wVJ*) PX % 'B](Sl/+deCIz|^2&IrM -A$UժѠB? @VFg6VBta9 laTEW j,Xq0F=HJ:cK.$*_HtpHFԓd)j< 0!£=*ԇ5R :`~̃k[C5O$g@,C~IA4@>e,fdTvK ;o"|R;咐%T*]P\e`   &;@XЉ8+XL0%lT0 J<-ef$4KG exP*8#+ ,1䡛yHS<]VH#/2R6tRd*)K~HΎ$,$/RI1PJ1Uk D'gTBJ4NjU>7Ko!?TJa/tH0ލar3<R,IR\E of"Gwc፭b(Z\'MGS8EȦGEȥh]Q6: BxlԃKҫ':y2M}QZE&>`Q6Ő'kCc%jd1'VG?H{z<ާ7G"@/)NiA9һ<[2#H;QƧ7Tj:sQƤܟ|8f F[yQ#Wi 6fS0af#HŤ5)S Es./58j.B;IϠ|1Ƥ7s ( ]tWx#[N* {7ЪO! gXO|y7M0Vo3$ OMelS']=[o;o<)_͵ F$/0l 1(o<"f0,]2 /E9m ;B)].6|` D_7|Mn~Nj1ҟKQnXsSVTrb Zsss` 8[#el%|)lxToggPv܌UBbhhJ g`C[=($w̍/ `C&E9 ȅrSO1Ww@`t%8fZ>HH2pQ eǗ #ˏ.޿ѵ(zSDŽ(9ûwu9Fh5Rc F/XmUnl)v1K<Q1  cC|wIL\bA!I]$qˍx0_\h11Ac%fgarz9ciG8,Ou(˜vXӶwI"cJ%^pzɿ[nO_.1ޱY/fx_~3Y]?f+?֫z1Ɩwv]DW]ny}GyzV_M~tl5l~Swj(^]&iؔ730X֥orEf6Oj{7l7rQNHoq2QuX#'wWI}=̦NPן 3>"&#u`db~wйY#T1ZK x\]K6qmd;ݨusCw+J13Z,ރ1BKiL(& &X bc  .9؀z/.oԃio &{ZƋZhǞ}c=^~OR*K )ɧfވH""WEt%;N/m+OQA>pg ?a? ſ~/?l6*~MLd5bz_>}Ӌg|v6)]ͦf'_|YMzM*PrhiLP  :.Yp骡t?lro6j6Mvy|7X58Zξ*NΈv޿8=Of>Uk Mɮq.Go Ow!wg#W>w=!vqj?ώnY%JSevgJ7);}ڀ!h{yvU_^=սJQ( wŻ{@኷[*^]!UJ8>-ʨ~|VE]A8!y6 M2rPf%6w+{SiM9Q+@C _ț^ >PxjƎ/C1qTU5\4zOa kQ(x+U qWb+U6J,lɘ\6 !?x*}e_W鉥?J5qF])sX _R>RJr!S5ez_ۥbs>/k(9fXlsvR>Noxx{v<+1i=^x,oFxwo~Bfm;N^ Op "Fc :}rv'ú{w+@]sд';'lA}'4u=UaΩ ]u_rtu4ŒHe+V(o3™QZ1 X|pOr7Ba'?xWᎧCݍW^FbyOtC|``l3ooJ˪RQn*WW7CCSz~p?dU/6c&P8{հ +3+wi`[6ccݥ'p{I_qƨ`lMup|clA<$u]Vg\}%& 3Nզ6UAimc)r98xf m|MVS,`8xsB?}@ԏ>ƞ~͞V0>e~(v1w\w/O|;[7]{9Ywj,-@FF`Ґ̙lls^wz]մ^>N:j}5y_wLKuAy}7*u/:T=f_4~:,y PfKOT>>)<+ܨӈ"EV]5Td9o999 E"['EȂ1?~sxLl|8: _Ţ9ˇE>,i|| LSumuj_cVAWwu}16; w"1ԞHxCќ( 8{}Wq;W]d! endstream endobj 267 0 obj <> stream x}Mo0 7M$dP Q*q؇#CjJ%6VC_;oiU;0Ywu۴p莺m.XHUC?V{`kV7E] _ lJ߮%Xҗ9_\m:6;= Į[õ=tj)}=yNc;N뮁C_ՠ+g+fbT3ɏUMQi62fzUM}4 Dɐ|ʈQΘﻆ 'Lȫ]C;>vσ_6CVV al endstream endobj 268 0 obj <> stream x}_k0y$ tjjhnC*ܓx0ĺjj@NJRlKm Ru#[UYcSݧX *N/ 09rI.mUyŘkIx^LG6ه $9Ac}N9Md3/ooWP`Ws>>ҌHDs-Q$8іH"9IẺ@ F!VXiݹ9d]HKҖE߆mCHi|Xk͕T&\!f¹{nn^Gk8!d1}P0!-kěv xvr endstream endobj 269 0 obj <> stream x]]k0$ZmAήEX1-c'(ѲOqj@s<okG:e7S:V:7gXjKH ߪˎvYUv]=$i~)|wNӍX9^'*E͂b~ﻷU^~Ln%IMs tǸN>U6#XWȂMB t>C>3ً>s D>#ђ("Z! 4Ds"#rz!y寎?qu|B؂,bz!d\g:WuO*%GP`PWވq'b|I%֗]&HF]=@gmfc! endstream endobj 270 0 obj <> stream x]Mn0VUB !~Ti1l"/xH*X0xcUy%HܓQB65 OI#}i͎Lqx+aG%r.4bЕ#lcw.h%m^ؗiّKVH=i}H<'Ij`Ќa'敐Wl};eז0c9(M,EH!Rt@[HJRf)[Pe*A"H)yvmdu=>RTEm;?x(fnlu"F^F9!|2f0;Gv[^ <)k endstream endobj 271 0 obj <> stream xڍmk0W(ыedAFo6迟|FQIxKdZf$CWmHvM[؝ʒgonL[~6Weeul?OPۡiӣڀٜl;:[`9V]m}Y١lv"K>mlӞwK9\+7 W1@Z E "(WH @Ҏ81A;*&OR HH9Jp!$_ve g_s8*0J4,J0rAϣQCɮ, H2) hue *;腐ZFYxq)_Lɽh7 Uӛkj* aOM&h7 Gh2o$N|fL ${O&T0MNh.JHo85yS|Mmiψxy7# bt_=A[Mjh0Q c ; b&a8L&u(8h&&A.|:.Puw&it04h}OK endstream endobj 273 0 obj <> stream xڝzwXTW9ۂr9zk`K#*H:tP56" E 1jP#Xbrh:f{}>|DbxuK7S '<=tX& O7N$b\$%167}0joUpH85|0t|$h|Df>Z[,o!ww|+bgRO/e_Xd;)&;]aJO랯.k/wO/{H@u:_/P"e:p=G Pkg+$t"9ya**7~ISz|UH?j 1yg=Ho?4ygֻr("$"3%EH[GWOd./,DhH&Y"V4LZlC/Dl&ĴR@ Ėb+P\l#^&ׁ^{}FhƢI٣h>Z\bmDQ:tH UjT#M֮E>.N?dԌ6aiNP^A%JѻO>oa=4_hߪEvy* M OQJ-[޴:3$nECϓ ߲6B6ձ1lzf )q))U|(f<, %WO[dk:-4O0x@ceBĿ#hȁY>18ޅZǍqY3skQXǼRVϪ}#e4d,Ɩ`VW]d%U:_pUQX/w Q6ggi@̏[ }ϷBA&`G*D}=*8zu٧J' }i$ܮq1kYȑ~zjJz>ݠflP,`SPg&qہZb"J/7~-~E2Q|,8 M1A[' ݗC@LcfƑ_(t2KLH[Ι_5c>jS? 3j R9>Zv;,1!lNxU)ܪ(4cbBkG-o$BG['_6/ ੝ؓ:)P28 LcS2u 5/|2,f^ñx%^Kۉ5 ӷ:gD5KhO/*7O53* g#pLWL&SRщLюќDr"=L*XVsYt}R/ss>3#XQ 42C'n i<A;M+쩂oGR|'$QV4a4$G{vNBbN,qv}y2NI3wCjq/C?%'>65@Alrnr:JgO~ rs΀9<;a6t! v&GAƄ@wiRވ8}#2+#YTdϯW^fwDdId rNRxrnbb"υ\%nĭ 8w yXKh/դqj4-9 䰉x%W e \5dql.ʾ롪! Gbc|v:TGQ71fh[x :,9{x|4-.eLFeJm[fX{U -4-^jDE6QW{E׏MruʘJQ\mY'zm=5Nv?iq_@S! ,QDJbRLhx9"Is\;R>wky[NAށ4āZX=cꄵ=z 툹`,.+i. PS4s]Ph+{NOKڅ[>\}Hծ^*}șf sWc+lsHu>x3,rq3+gRH}#^,_ JF1u"KXuM܏ۊwRbcyloRhϟq8E%Sru*T+ ]!XOIAyy&%zmxP$(Bzh`oe|yiE)UIUn.p+؍{C+XZ#/9Mne+ЙG*da&#47? v0_Z}l=(<,=X{%h:Q#*^ mm*'`lT׳bOY8b.۰h&HnOF<*on*<"qɞ\vX ~ (d(HMSl!TgY*1NM߭N%(*1owa\yTt̒ne;G#wMU",XuB-`Z } ?9{}@3zap㐩ZR@ARXIq&DoH!uͻ4npVdL|l>F:ăq xźʏJ.~dw#Q{ͮw8,'ƟݡRKdg, 9 ) b4T30'ʞ|XsFI2Ih:. 46s@ڌߠlC]6*2UWeZ}˜}Tn*>=3mJyGMlpfG_McA#(`駙kXɰ0 uz'8P_wU蒫؟o^~v*:?CCxnu6?+ӝ|2*~/buJ]*?u`Ž2mQZ=~쵴HsغTaYIGZ&[wawMÙ+gNK$NîQ?tA`%%Z):˃+ nas{4ŗ3fQI9%%% ydmAۙ2kB\(G@"g-Iɻ IeNRwp  ";)PEҊJCxox",$,Nhyأ#*M{y!Te@sq:u-sWV1SVv1/7H׃)`j]?AmOi&~0w|K+q1ϻxl9D}TaUրɚWcL% ZR*^p;g܃%jV_o%K`hI^ !Gv`h9ma+nNVi]gp`ai0Gtj3{~tX%ӣ9Wy:z̿悕3[ Ѭr \oM7b4!4cмm^1 M^A Cַ$-:\t,EjB ˜y;16|X#J N6/Fw*JG flGbjcU -~~?!z&Qtf>'gksy‚[X)~ 5C9U"y "QcyUs\)fKKk"K=]71i4* SצGDcw'1'[[ꦜ? o=ZrcY\X3{`&bNw(Y%go}3{5܊"ʷDnue,R/пYtDzsW ,T3`dغU; PĤu,敂 l n2MjZ{LWΥiS1!7"<.N:#a"|Ȣ|//e|gOSg /T"$%<&9!-w+h*RԜ\y~nf>Jt,G~:"WhN` >Їje0#c>h+JN#qz54Tm[/XM& JK 0d<8MB-tt{am <[Bl sF k3H$ e+Vo]Lҡ-߅|y^*iיr7[?J*a'>-C_bWox`RFnytygIK <z'~.f 7`%m^A#m. a^uYzx|&$@ET+/lWZm|XcT=^\9,c )25qґM3a{3ٍL7t\%) (ɝvd4(B>5m2`C_|-L oadQo|Ŀ@̙ whYO:Ǭ@mZ.ya˾V?4`C#|EQ\Ce~o_Fq/P` Td'Qm {ҵ'\{u48/4ͬ>ͬiffYmYfL5µcͶ^[7Qw;1[Z5V,[${BuM ~$PA،sIk3vAƺ59"77 uVvgڶu: "ڜHm˻ 0[j(/ʍa!5yPbqV9"k,J~^Uyg*@Ґq ý 2!?1څ#5O0_QH# $TLI*w '$?: dI0 saZ02twLFDFWi4EVOvpwx_qhѴfK U5PRzN-6ܗUl/c],|TPqH<+X3[)/i+d3؁Jʑ0;b)3cW9v[Yد L3xQ6gz` 5x";nH:6$/0 WlPVlyvt Ѧn\~ ^O>$TJTP{;_\8-m튵s Թ:ݧ+𛼀ǖ#D!w!to$k4}Xk;yW.#}(8>a0dm,屃OW_| JS8h> stream xڛ܀ V eIHv`l m endstream endobj 277 0 obj <> stream xڍXTT֞aXp91s^DQB@}$ )*"63 n,јB%1h4ɋ)o_sx 5w=3{ooT2dD*wurs׸bf-ՄW yKDA*Jĉ&TvtV,LH׋f1S qLtdT:|;3z?/ 11fϝgeD`\m`>xKFc|Q@s SD4Q1Qaoo5[#eĨA1Κg5o3&JB͗i̓bb"m v#c5!4fnt?N$% 0p\2Z(%oHe!RFJtT:R*IR,#UJߑ>A,ՠZTQңF$HgIfO&LLe!2.}ցBcQ 2Ёa[oˈߚFeEF( Udk&O A!Ux(nG^F $L`,X>cl8۠DLOv^(? );0Rju<,Ʊca0 V-E>㾩r_t'ę'OX|=a/ L@iyKU%O,$dNexǽj 2l? @9Npjl3,1 l#pd8/f]efMAcq44sY N',F8ђ<Ar^t.0^q e *O`rdеnJY&,@a5x9q5Bd{^BNVb\dpD@\9I'! 9ۥn2QFi*Nkh'hAv|vdy нg|;y惞쏶L3Oi/dhyY.|kC&P|ct|烾5j29)2_){SG/Vƍ%£Cùk 9[T-=>g/3dǑІGĽREo+? e)E-Sp(=@ ʐ,PcOMMZL/hGɺ܋p#DH(a?$mGErgUq`Fs*Qԓ >ԏsd6J {SJy%/?? #D0{#Җ6R+0Z6Qsѱùae#]Sb=YaLMWhнI0Q&ڈ{',IZ{#ޘ:GWW=ou'ҍSs4#į &"J&t@4P.'fŬ 8XOu}_%#xb!QM^e oȈs/N֪.Ƣ= pĝI#w~x&EL"#p/*??Ze XI7[{AQ{$'sq #0Y~K7[\_yaCyӐqDPEgCx&"1srVѻU2C pCE@iQy| ,œʳuN~[DgCX/巀}9]^nR˶(Ϝ cQޑ\5?\Dv `=f<~ X-=/rUiֵp]5bg'.7W0nY+7osKq^MK9G__o!=7 2;Һ<)D;(ŀRQmmci3Uw+9ɫ8o DZz迁8k}(&WZ1ZiVƝ,oH#ZtK=X ɠ6C sy `i, Zs{+Q~IV}z~9m| ?@" m`{!^P<t`,+ I %_ ݃px!/aG7g:n$60DD{:]GM`kB7C}*DЉwkg34dxNRg>l/:\*+>p-RJb fҫ~SƋ 4qIA[: 3f|*SA [z#|'K.QvwvD{xDFlR%@s&'3`2XɀP5tlpwӄo 7 FSB K#{jqL@F[$=/ -f Ӣz7NOT[ULv4țMpaLpl1alP\bGL5>{RmՓI+6z}%-mcP"G&؟ʋqO4gM` ~ӈŧa.홿hXuy%4{j)9S}kk_e*IH^W?}f (r. gN->NܤќRnn;[1 Kd,VBxr` B6`(KJ ]ꔢO&nBw]Jʖ%@J1T-Wzr4.rs\7٩,lQVV][Z]})}ҩ3x|]cgKm߯"g:eD"1^(_%nUoVBpJQz- endstream endobj 279 0 obj <> stream xڛY`/_ۀKRah$>U; endstream endobj 281 0 obj <> stream xeXy\WN w3fj7{ꊭZZp) K ddĀ"HWWĪUmj׺m][;h߷}c~3'<99L;;P(?_2J/Z=M7/BBA zr;9.Q ؀w+[KP0`b˕\_R8v<*:[H9{G9#}B##U+ݔdFmRGnYQ <_9P9,4UXLD'8~℞=BD;ըTjuX́MP7LCMp G$ %8$GT 8 ^ y{ EB;!RBAO(JpIxxx3@8R0`aQ/^GEKDDٕ(L{ǿOW}vHp8Ͻ_Y)OL9.w8V8ivRj|t(G=%cY?`d?Cl0:2{. VL_oUW+WaeU,kX6F^UԹ怙 <<\LPK˪{5aAVu+f|̹D Z+NY6e,,CON@i4^Vʴbٙ\[\+D*ȗ*hET nEJ-!1&<_.V^'A~gq<6CLGB 툛'S3t) E} ާ]9zk0uh yFvb+k4-`I*;^T ^n?8o_dm0/(`2NBзO  QW2K\Q,`0 , A*g0'[S7d%8lڄh85NOȽ_↢Eeb6~lc?VcL{BM6a'e==W o9{t}GQm&S"fb4?66gC񓥌Jq8<+ n٤\;iN2_4r7as+QWQuQWϾ 2܌,0{2g3tX'/SR67 m_!a4{`e[w\.brѕ>tBazw:W=;{~6UTZaI$c[d?s[]̺JϖqT.Q|%Sx7޼87cs2㱹Z*as(Pw-)ߣ''1y:s% ɧackpP5ץqqh@w wd#XvYJ_S,}MkXL$%(酽w3J2t`-A-5|]yyW[mb:k;[IjIqxF]9_|ͦ18mm1.k@aO|(o$I\&)n4L1>?rzAA= *n\]Kl>x.&"խG㣍S{rj711JZVܡk`Ivt[): D$`4Lxx+984Vġpj+ّ1FoKQ>QD[$S*ۤ,ˏe *i=}W4^`4񱗸A5۰U%G_:ꊐ_j1zߪM~V5e Iޥؙl8yf% u` &d4>fSa+jh.4lI63IfDM>=2:cjYgabzsYlsX K:^T]m - Ngy[ e’YRg m#lR%`IvblLZA,\n.90K $#26L^ wH=+ ]elћGOuǢDBg9Ts[ R_ ܧ` B>tVѓGx,Vb>]txYWrVKd` Ld=G酙zC'O#\}[=Чn"_) f;E$t D0ٕSG%ȎܱmMNCGܘ 7GNqBӉ:2F dLI{UxY:ǡ0R\ե bS4:yfR2۞ښ]AAm`hI~ Ii &wYe`aY]O՛wuoI-Rn=ݥk^/!-}dPRyRœj[7t:GLYJy}lZ,䩦׷A[nSP38ۑ]vmaf6ۅ9+oS Ew+<|MK gmKNyvP>G78ފqGE /X<8GbBۃR; N! X;,6 h^3iB'^F/0ᯫx0ҁ&au2טW!KEq_<VU}sb(dԐ)#;/?\M#v&%f@Ȋ%mK+*V.e`臦&c3[HFg*e֎FQ,j7! wa|t&0\jº)2}('w? ۛ_3mvv>TFjh5]8ynsƃ!VyeiQRjNg˨0Fyɿd53U  h%LU5 ޏWDPx*+RRa+ϭPC_ߵ^iE֠dyY5f &4*'B <'ED. JѾA-7P<ĪiUH 5J>O$;a6ԂnazWM|řsDf59E{ F!d"p.R\3ff/uBag1-/')&i:RArR $QTyTi.׷):VmtxE\7}R L M㞑ZcbeI˱=WVRAcAf+?Bou)0 X (Dl)JcjL3"璉?S>>r+ }qƂ-\!,Wx)J~Ҁ n$Vk !8-''-9v_j |Πi k&2="i!8ѥIxxJHe_e4K²5j:enY@-^?MX`PId#K_[@y^ [DPJYyrRD 2, wЋ˗?E%`TA xWIY9e@ F.4%5:EEK X\8m9xI.SQ_H endstream endobj 283 0 obj <> stream xڛw{_aNG  endstream endobj 285 0 obj <> stream x]X XǶvqFљADQQI"d_$ʐ+*T@DAaU4 ,)p}_uUwusy̌y315O,6~CRd2 5QsD b##vXo1fEoJǽ6È.& ͇Td}1X?qpa0=1>q}cc1#ѺORkm'k{ǩl]=1))Rې̾N%k#ccbtɉёMњ֣sڿ:'̹!PN sFpg͍Fqqpc85ܻxn7ĽstΑs✹ 7qnΝ<9/Λr8_Ώ[-r2.[r+ . Vrq27Yy bOsx?~>h A]Mv\lYYD8%(**_,.XRRP&:[ :O7_in{8!g-޵EЍC++}SF w0\7޲+Vs&]xѶt]]:ћi̛d!]8Y^# kr:mThUx˩clS _s85{-t.=Sf.!mܿ?oyz>#CQ1;dr72"K]sƁhk 4Yizg~Se%/:ENmY2\y)Ugigg21$@(h_"}נ`c&*PV?{mN$jRߒ_^ $JaQe$]_s(3!g7 a"Z_x!FT ԅtv=xC;r'#HpN9:3ag0eem1#ZmƉJ,j1 ?yt2Nqb(WR/|c :˰gK XMb( O=  J2Ӏ8S 8mRmRΧ*N?*EnT'>UVev ]E#]gb:{WCSX&(,*=+(y,+#@A#ҥ8y^ (Եd4;f=…sߵ@7T|fn4~.z{Ů͸/Uj 2[0`E4w}~@tBe@Eq>(ɝ+kl b*ŀ0]7#![W׎ܫ#>sZ@bBܖ"9bЇ4\Ddll%QC2A~*p).AR=yF j%PjT`K^ĵX09} XxO=dS"~s N@Iֱtz!Ъ@H?WHtEp*N:N4"۶A쨉*'rOZ?'v2&zD0lpqgCU7|'ҦvUR+5?ޕ ,_."d57N/ol:+nުX5kM=- }(- |neM5;W^HD>F*سik/ò%n;QTyɣl])_$JY/:8LYhוGXΊ[39+q&:S$)89?GTJx(;tI:TMrQ8EC`8GMeRs>yF0m&{w`u4.ro͠c0A3p$s5?Asqi1^Kg5wH4P8A;X@01o #ODKz g#WTxh4O<-\`iGbR!'W@'xÔ]d67y)3FȾn >0o️3qϽRD'cj8=ܗ{WmKv,I8~ n|z()ep%N'5t~#"a=P; }aN_;H ]K,?xt:.꾭ěUy :i1&_[ZcK'~TVM6`^է*A_xP.\୾e.êYZӉ tːZbN 8AZ 3"**@sƓoMi<"9\B4i|cZaLwC#H+О_qR DJ_a%m6^U ,Vğn1 bV#jE-8yAT}ЯhN: eE)WEE/q֪6}fo.`ho=wqwޱit4:AggثbL1W?Q* V5SAF⅛0.-逎{i S4㨥7Z]n ESprkqxQ{ y_ j{/{W2"$ua0 Uv9ITx?6UC[Υ, ^K,OuEW5nrm]E/^Qf7/{9K-:V^s;sE676Ey2jcuhO5iYӂct˂)MeJ=B(<]WjƢ_ѲX)~ oEɑYi!c[p[VTegmqjbb~҂bMqjAZu2ӍcLon,Jo@d&TPM4{h)v"Os px0_&*Uu2CՓeo$_F}XƄ_/ϼqDD]gəI {$$9SouGݪ$H+ Q.fo4ktQطB&xg_MUU{O|1*o_=d-u/Q j+xkw4/GRdڵ`&Z>,`A^lT3)+9VqNV͙+ =UP _ބZV6iL:md?vSC Iltl@R8]gjcMʤ&iR뽤ZIbGLl&ícN-3FY͔7)[*mP^R I-dU?cZLZRnh"n&+\ڋ]@ eA`H3۽hI',a>a9e!hҲ#UPupĝT0U{KXՆ0`_>@$?8U,.*bhƎlu||MP *N'c~fs`Lk_| R!WcLl1WFV_tY1 .H>ڠf|_.bJL a5vʨ 9/&f*Xɗ\*e/WVT۽IA (Erx@ ź#S L֫JI)?}B `n*= "#[H>Scn.̈́g|X2_O2dhg0 'д@W` ῦ+'>+Q!40*IfhvdgSc~!)sքS.]-6ҽRء)p'a$ 9BZZP3p J&=(.9&hM\,5Lb>1Nޱh99Ky>9$?'ibbS.E"M6m9X i5ok10k endstream endobj 286 0 obj <> stream x2{\?47V endstream endobj 288 0 obj <> stream xڍzwXT7g C89x5V0'T@Ι4H9g$"fWUT̺iݻ}{{¯A#m^icQ1q{cF0p#"@G+  #, ĝzeX舜_ݡ&榫 F^Z(}TuS6miS`,)~.S1B-wpX'' W-a"ѧ__S?Og2?wO?W "#q< jέ@ʉy  ?#Cւ' dmZ2%ersv"8½+`(է7gaPkkIe-'f3(hE-}!pS 2*ޮ2-Df˴MNHqP]W a,.0pY=#A3fӱ\*g<"{2찅|'a:h%ñM]Pg[8o; v>=:sYU ͪ$ :xሟoF^Δ"ϻ+6ÕF?4+?}5cGx<<U0#US̡LϜih+,^QwO7Lo\TxM`#W0nr>QB ߷7ݔpqԷkw~U>Z/y#SCfǙGWRkqN $q&ָ.V{u8A[s}rĺ=0a*6:s;+BYQEpbaz{d}2<*80aX-ىI('>E9 wY}uTF7Dpo437p.,8wP g"Af!]a>Ux7V$1?KD]o]$5` B :^ L+ SNAd\25d5w x(\y)k z`&, ^ f@\!eL4$Ḵ|Q/{?r\m1Žp #F .!p>d0`@Teu E@OL6h^K/B>`G$>!p^d0`Ncog)#,#3 9R2 =dʕ2Y& 0N@ -XsA kpkfL` )WNd_Q7/`_|-@&L\-Y @.Ub7/j9hz4dO 0!pd0a#΀>J_nƙ LJeEI+5_ɯj|vGcT&ҋu_XxaRm|r(fխ;9]uK{z*2V<(r t6JӚLpv72T{ukB JFskyIl;5sK1NnjʣLcBL;^gt'0[I$ޮQd06^;o_}'J>a*W񻶣]m\H. f#e&Nd|l~Vo g9_kj͇EB vhGQ$PfQ^LpTlh\=(3" ? k݁(>]5O؄~eY$⿍) 7x ;Zwq_nV;_&n]~?Eʂs"8MSa]U5x$6 9Ϋ绎R#M^3CcϪIVc9/<g+w)2/8 Oi:H6%)VlX֣/o6r_rNvru+XQZSS^@L}@GJtG:xKՋͬTҵ­ u|[=@8S,RCaŅ$vQ o4 OiaYpzXq-M W(t ފujng˃3-3+1DĜԆ YW T~JHNk5FL<|#!;N/Rf|v;WczZh@>k"+by9 :~R? \1 /OV;rX 0ZZ xPt(4os!44Dܬ]!$Ɵhހ#S]"s$ g=!1M,Y?@BO@tuk+>җ3؊c-BD+ot[5?zx_I r& yVkˊ'<[dۼ;W \TBUk_N{P˵]My6mçI^ȗq|bz4']Ό j!!:{o̧0AݖjmlPXulFf~j}< :'J ct Lސ[`w Tg'x0Vbc۳Ϥ'Z1__WFs! PcV~l'&K S)▍Y-w7to,$t?&\g!& l6}ଐ ReU4ŪkJ2SԫIJU?AǴ+,yF@&U]U%;םɵjٺ$>G)wͰe'comlu>ٟIJ _?rv΂sǪʋ ȆF6#d>#v:(J_X)|ջ)X\tkQCCz(Vx8Ģj ?_ }dǦ|1$WG5ڬnSQIAaI=[28=6R?3YC,ea-pēY)0t8\l]+5%C3gAG8͘(O/-Qw(…K'i@85VOQZ ݁`6'vH}sƹlky)-gَ50;tMƆv{u\m<^E0қU\KRSd9 009c0!aC'g7JU)d:Xo .&Wk]7xbaQad<uCf$s{o}h }l `c+ɋ{;ŕO'=p8un8؝mwt;1[\9Lϟ`zOO,KOKOUė*jRy"⾜rvZy߽X)>?ap7ȻƑ: Q155'O|ܑʸ<6?˱>^='mg}1xHCQu67!' N?P|"YތI" o:~B5re[!"Y,,5kL9KR+U*w^c%QD%R򐏷DbA jU`T&QP AhuFmM*_ˆ (+jl@"ȹI,waNbio8K>o®zQ'8A,lB< gx ٧+> F] 50 股6 fw.:WcIiBzDᱸo0=*g0i*$s#L?,%}zOok fb$6%*T*H* ゴlj+Qy>VQ" ,Ty8ؖu v[s1?o¬:0=Ϯxׯ~?GHʞ;Ķ`bzp0"fŸk;QK[դF kcIZ~f.\=)yiQXpvnh(m!O>V6}5&`,S(rc5Ͻb}|<@Sxd?1C2P@ T7Uj {}N^! pc1i9 B %WZUxJ.ٺذجx2\AvmaQ ٗłphZ#4vɜipA<$Eཁ6WCQ;՛ld,~j/`o}O(~ e<,{661;HH qƻ#edJ$ "N9)K+Jc1넄U e!;%L_~RFRa5 '0hSm߂ÃKaj/"رe cN} F}> stream xk``j@RƬP< gxi#3*ah>&C=+n0㴢 EP L-PXet5 endstream endobj 256 0 obj <> stream xڵYn}W6 axۼ%'4=eAƲEcHrY3%YJ)`,n.*HHI/4ye"VhPj=GaHhqh:)u"FaɡAAP$ y'V[HpZ҂.BEkĖgIUX ђa9X^)C=hXMYl"rlP(XP@4?/Xja0ya"*8Vl7 A0VPV b 0]8 'BǹMs(^*.y}?z̪"T^]z18GQ6ڲK4;.▫ϫ4V:ΓڼeٱK{Z6[ƠVGb#;m6.Æ~I%i`@yGJuN>nlKՖ-M[ڶܪYz@-;:)0tUU/ABoڒ!'C_*eٴ:$. vSB.]%7[ohq޾=c;$tCG\+۞ -{VU_픿|d\V]`=ƴmz1ZYosnG6ٴ8kb9u+ͬ,U{g6n⶞nn$'*|5uoRJ<͸G_WÿwÛ/_şZj-6*`Q!|5H=I?Ja퇻jڿɩxQfê8>/&)\@g7QȮ}3X &eg) 8s A@-`ĬH\2Lsne@阝OȩUJ 21;$:y" F @pPRp&Yv0's90 ksϾ qUv6ڧu(9+C"E8| l5#Ip *wJ6fE3]G̼,ЂL l(;8f7(Bc<`f+⬹ۊ3- ^l7:'˰VH 5 1$v\A=64og-Mì䜔+FZ \F"PJ̢pc("eB #5+.:!X>i,bW q(|8steqn|ݟ&d0\.&t9LyJv;jmk%Kݷd>@^\AL1J;"s}1c&woo:gROhh'ZӑYE/?6ܞYVh+"H Z"R9y`q=A7J7i%e\p@#]@f0 ^ UȄ5Ddw؛y endstream endobj 291 0 obj <]/Root 1 0 R/Info 2 0 R/Size 292/W[1 3 2]/Filter/FlateDecode/Length 675>> stream x5OTAHY(`lX{ET;Eb1?1ޘx{~gy杙sffWDMT$;8)9a&`*Wz)BVtCw׌{3 }[1`vN atSy(|4c01;Ř N%aD|e$>'dQ{)iM%ߝUrZ'8^[%}x}FRPlF2jZT s|63ƚ*|`Cqf2M.C4#iUjZsMӌir&4y4T.6f MJӌoxr[,:\Kq".=w$!3W"^xom|wb#r|쁢ۺօlA**y_,2OQVarGN]U]HFUA;'Lq"\2P?ׄx endstream endobj startxref 86455 %%EOF actuar/inst/doc/credibility.R0000644000176200001440000001067314522557740015723 0ustar liggesusers### R code from vignette source 'credibility.Rnw' ################################################### ### code chunk number 1: credibility.Rnw:14-16 ################################################### library(actuar) options(width = 57, digits = 4) ################################################### ### code chunk number 2: credibility.Rnw:52-54 ################################################### data(hachemeister) hachemeister ################################################### ### code chunk number 3: credibility.Rnw:208-214 ################################################### X <- cbind(cohort = c(1, 2, 1, 2, 2), hachemeister) fit <- cm(~cohort + cohort:state, data = X, ratios = ratio.1:ratio.12, weights = weight.1:weight.12, method = "iterative") fit ################################################### ### code chunk number 4: credibility.Rnw:221-222 ################################################### predict(fit) ################################################### ### code chunk number 5: credibility.Rnw:227-228 ################################################### summary(fit) ################################################### ### code chunk number 6: credibility.Rnw:233-235 ################################################### summary(fit, levels = "cohort") predict(fit, levels = "cohort") ################################################### ### code chunk number 7: credibility.Rnw:263-264 ################################################### cm(~state, hachemeister, ratios = ratio.1:ratio.12) ################################################### ### code chunk number 8: credibility.Rnw:271-273 ################################################### cm(~state, hachemeister, ratios = ratio.1:ratio.12, weights = weight.1:weight.12) ################################################### ### code chunk number 9: credibility.Rnw:302-307 ################################################### fit <- cm(~state, hachemeister, regformula = ~ time, regdata = data.frame(time = 1:12), ratios = ratio.1:ratio.12, weights = weight.1:weight.12) fit ################################################### ### code chunk number 10: credibility.Rnw:312-313 ################################################### predict(fit, newdata = data.frame(time = 13)) ################################################### ### code chunk number 11: credibility.Rnw:323-336 ################################################### plot(NA, xlim = c(1, 13), ylim = c(1000, 2000), xlab = "", ylab = "") x <- cbind(1, 1:12) lines(1:12, x %*% fit$means$portfolio, col = "blue", lwd = 2) lines(1:12, x %*% fit$means$state[, 4], col = "red", lwd = 2, lty = 2) lines(1:12, x %*% coefficients(fit$adj.models[[4]]), col = "darkgreen", lwd = 2, lty = 3) points(13, predict(fit, newdata = data.frame(time = 13))[4], pch = 8, col = "darkgreen") legend("bottomright", legend = c("collective", "individual", "credibility"), col = c("blue", "red", "darkgreen"), lty = 1:3) ################################################### ### code chunk number 12: credibility.Rnw:353-359 ################################################### fit2 <- cm(~state, hachemeister, regformula = ~ time, regdata = data.frame(time = 1:12), adj.intercept = TRUE, ratios = ratio.1:ratio.12, weights = weight.1:weight.12) summary(fit2, newdata = data.frame(time = 13)) ################################################### ### code chunk number 13: credibility.Rnw:366-380 ################################################### plot(NA, xlim = c(1, 13), ylim = c(1000, 2000), xlab = "", ylab = "") x <- cbind(1, 1:12) R <- fit2$transition lines(1:12, x %*% solve(R, fit2$means$portfolio), col = "blue", lwd = 2) lines(1:12, x %*% solve(R, fit2$means$state[, 4]), col = "red", lwd = 2, lty = 2) lines(1:12, x %*% solve(R, coefficients(fit2$adj.models[[4]])), col = "darkgreen", lwd = 2, lty = 3) points(13, predict(fit2, newdata = data.frame(time = 13))[4], pch = 8, col = "darkgreen") legend("bottomright", legend = c("collective", "individual", "credibility"), col = c("blue", "red", "darkgreen"), lty = 1:3) ################################################### ### code chunk number 14: credibility.Rnw:509-515 ################################################### x <- c(5, 3, 0, 1, 1) fit <- cm("bayes", x, likelihood = "poisson", shape = 3, rate = 3) fit predict(fit) summary(fit) actuar/inst/doc/actuar.pdf0000644000176200001440000005502714522557750015252 0ustar liggesusers%PDF-1.5 % 11 0 obj <> stream xڥYˎ,5 ]yTU $@bb1V,$#NN3hnݞݒ}$ iR=n ʬUf݅)-p+Ykش@^qW;Ov;DK:lAִW7ۼ6ȏ&x9$ة6,8H VS޻e?uNvnt_SF Ix>X!22m0 s1Ͱx^[%~)$M*a_ ҅HȌ(rPgN$}l8;d;[pgy"mG @8? a]Fky<=qm>B WZOD+XztmYh=:^`(-)YHxCa!҃FTX_ZYD8ipvE[ws/#CWN\\됌Ȃ\T\@V!H5 뜙pO2RC(,D\X4{V$vJF)&uEG nn'f "~ `7۴u4N{`]`m등T:{U|FjA$^b]d+RO6$%iQپ+ ^'YU Eﲚ):ҟr^ՙרB 8z;tH:6 XbaBGJHH6{E,dcG XWI+ȡ2 z%QmYQg -2 ]CW5#C0`G`#umZX3]slv+fo C&~eu{`w&@ w~~}WMX/W|~=J%`o넣BgηIӮT:kUC}̩VB p" K? VxKe?#mi[ʔ^:25.p鵉,w(T}iYݳ AݼJt=T #{k5P`[ӎU]XcyX9{W>R7gϘ[q}Fs\_ufv=W?LK_L endstream endobj 19 0 obj <> stream xڽXK6 W#i 4zKy)fРŮ1$RIP<>4=8C㔆=45>|F{O˛߆ ېsކ;\Mʟ_H>d@PS^n>dp&c<4v'{|pCҺq\\2")ʚ; )H<0@C̞tZu ~ErB)HP:<9p7| 2l]48ه">:taRŲ$`QIOA9Yk;A A{ x ,f; Kh-߻f_W,8Ǒfm@GVL5 .[a[Xoǂ1@:ŸuQBc+WT84=hV GZ6f !  5l"|mb`.A\ډ}V~ Z0wgsZ7lTST㱜T &=ȷ. q=QBptnڔ%*[$Kdi}h'&V)$eؽ}IM԰֣[-yktzWsU{~ܷ]>2C;bQRظe ,DIiTCuuyAi Rb6Rm5qL͏SnTkr,nW\Oh\Xtc?mA1w}>څP+)P~|Ui\[ʹ,|9e|*A9),mj"nӵ6?^t4}[zr9"U/9Aݙ }ݘ6|헰sh]P> %pD5=D`{ ELl"'^/vi)[0y_Jr7Fb]%?rub endstream endobj 43 0 obj <> stream x}o@ +e1(xp?"TG91H|zvĉZfHeJEvp%$+579?֛1͒op9zVbJؓvmII^-|n1fwaչW6 zE+u`m%4NZƭ @9Au &/@֜wW ,Pܥݾ5z;7D>&3N@] ~OЍI ɻ}p :ü?{yTXBpSzF!h]1b!93>X$˓(eDDg΂% IrI2#"I(FrI.(-/IJ`ǽ'#%s&w g_6ĝdzRp[n( endstream endobj 44 0 obj <> stream x]_k0yEn 2iaMk'$Do?րp:dnȡguNVQlD?E[]l_6}?EY~JPx$$..?q/]mja^,llvXXƜ3INh )Ra%, +q@ɻOtwiQ j[iID 3_ -}ᲑBt^DJ%0tspq1Q'[*ȐcqJ/9{(E(P';4N6Xqv3'86QpC6)| endstream endobj 45 0 obj <> stream x]n0 > stream x][k0y^\AVpnL ۣ.PS~[F~\fŦ’(^%^ rH#߼uf0{eU|V?_;-l}|r$ ^]4hbS^z ]![E$ ${k.dn4`<>+uAB$Nlbڡߵ!,!=1-7(:Z2G.b3RA"mrO U;V]k(sa1whdhQblx#VV{,?3/ZH=;7 endstream endobj 48 0 obj <> stream xڝYwXT׶a r?(z^I3} D'd'փ[s~,4Nrjgd]S)+lh#]mr˘gV[MyIN%hwV+*]3'ċX*g] qזWU}4~E X aU0J+0➃qh -3mfrT#c>;T JhqgOWCXhG dˁjf fkʎ&LQH';Nf"OdȘ`1w5d@)n@嚴I^CM &}ԝFUpIeg ZB {QJtL,WBtsqT4#!S 6g˵;3Xe+ad5 #d SG@JHd1/Za9z"C';͉Г}V Ɵ'= r!:s bTb9]LcJYN/Rh;efG'fi:\0pM1xA/8n_i˓^>eg0`Bn$]Ubpd?(`k*!MOk'2\|UvYٱ0!֭ϕd_` ,xDaM%F3%YIxқ?>=(0aS ܢ^l{U7&z;d6k4ƒxpᐥsh/P+[PAUԨ,gfbf} ;~@>yQ躎2, yhѼXE\W#ՕΤ[Hg{/7jƽtcT>^48G\؁^6ܡt*xDL$.V23\ͭw!edL, gDs~t"*F s㛅o7 C6`q&i?&Xt;d| +az1AP,KKniPo m v(9"X `1D!>&1`T[梩urmhFS%((N\1_KD_uwqYQmV70l1nӍkG11kQGG8"#cy#.{456a)K๜jSvR[72׃%c#Ao6heDtwa:QwwwOL/:'#*E;srT)v0Fݜjo)jugp ''$FUNRrEl*v8wSio1aCh=34\'Yg. *e/| ֝v&..Zn ޼73 8Q^Vc؄e}M7DLċ:*/fhoF\,"K0gywr݇a{B`5LHמwBS>~$'r9ggMw]@q5} rыmqp%{;|yzxیwREi3ՉI0ZjoA ؏*&Gko~kҐev\\$ʹ9WNԛnXn1ÑW\I,ADF=Q 27ٶ'RP*`Ȇ$1H zC>, ;ï 0)@!>8tt-p3; o\?{r0xoXJw焙ZlO zpE(W/EVf@#-iw1\i3@u幑9|D^BYVkhq9dUC=&۹&ٺIgs0p9Nt?M։"ke%wH?ݲGBZR&2ݝIP 63o'U)ܸxXul1ރ^2鿝n2g٨%mqV.>nފZϧ vOa B<(->޵+}jڿ9(#F8Η|QVRSŔʗ{ڵ3{n\QtB@')Z+:=xMke|*հDs2&]cd:^ ZrH?!-hPvd9L9hL!$za߀}NJ3-hQry, ȨQzVF!/e OE| %J+*a>>aAS$[ns Ueӷ Z-Jݕ_/a35YȻ|DEon okʩ ortҊ $hS|N`Ёٓ7ab[Bﾸܢwqd>l< LaeP]giH-} J/ȭbߕ$Vto%Ca%X Fd`P^F|WrL^ljeNp ҅0 }uSM!l&kԠpv [^dz5| ۦ=ZZ aI?)[ym-&ƄF^\rI +g,=)VJ1dFmƫtity:/ "}7^uP}@O4rsÀHkIWϿg0hV:8:T=D.区 PS'ΓJD Qx3Ad}ZJ"0EkO)=odmV_+4. hDdc "PcyUs;][,-ͯ(pVد7Y5BX.U1>,M#ݵEf|auwGMw)/LOu"|={jIN)X]sJLUc+ܭ}ƺImxa C%Gyn՗ut -NDv*wvM>O]1Cܵ(Ep[ bdgwmOqqJm1004yOQCϐvdmzx~pɓ̶pxʞjt=.E rIwx-ev8:,s A\Xh^*Hv$l^\i|MjZºMGN妬U8RDdpK'/zzdŁ7]y08(Ls`#gN6( dq %aIiؖ/g؈S IMQo [g>07]'a  ŀ={r1BmtcucSֺX1jWQ3 IKVgﯧjt$/qI9R#KW1$%gu[HONu[2Zrf7;9H{SC^f d L'}/wSS:=CYYa 5s:ƪbhBa|F+U\ބߔXI_W;k_naf>~]>c=IQtіIo})7 xD3ܡQEp$a"ӐWHm0,Y=Uc;K<%( \Qmn\h&Q[&[SP 7ϹĪK}A8 5Z.9ZPOS>='>!ӇID 7l ,mCa}G10ri ⺖(qTj'/[ Le.%p O'%4vTXq2}M۷sO6?./Pr=@+>R7UTxӒuV[YM.9\-!)OiB]0NH`Ncπ8g##'<vHuFsU&(t!m 'pχ6cXT,_ʣ{YQ !Q#L0&j{sS,+ѰCtD~ٍ~ٶ+Z'^/ 9]S,b8I;oPjbÃJcq!~CB'#E]vd!܋ˠl]d7A0* s>mnਈƈTkl<:[ Cc dAu' owF a`H62` A8S'~Vք@ 0^L9 3]NU2W<Ov]` +gղֻlG,;6&@ܝOWPܟu~aj;{>zLňG¯&>+=>W8Y6gc{~6_ҋr"e[> stream xڛ~܀}=D^8af endstream endobj 52 0 obj <> stream x}Wy\g3*kƸnU-(x‚ZP( GrK xT `Db+]/v׵ju[mn[}[M~7k| -}$̆C`y.?O6E׍}:4\3XUpJ^[0SlGe!d8b:ƖbD2XG)?2oICS15&zGr|>Gi/ e0T++$Y"欃,ds~l<.G'U ?dLց#cz-!3+XG5r='e'qZp6K{|9\hǷ[qlL[s`aW֐I-xs]Y;5& %"OI7C%_~l/0 LOO@"x݆j![ΓLz86}X٣"@њ.swۉh_mEi琕$i3dEiZ/C϶6[Q}fktb/"47vI 7CU1.pM]mWnH%Ԇ<,] `0ڼ[Y-(5i"2ㆾK"+%NYуwDgW}3No'UoLtV T&n7; 4t@╻a{Q1)Fqڼ(Aꫣ,G8GIP,[qJJq\L`Wa{$2L!Vnē, y_>VzBl}BGT7x8ń\? .I_[U*Ĩ#yFX3~[6$ o,޶Dl-+UHTxuTb8l mT'Y 3ݪcĭ ?>FE*Q|BS`nα|=>tUF 3E)L _{FR}q7IRՊu0/ȫ{~oݳ^N#2VAA<4ă-Zc-HLQQyʨ<㯕jSp%iJk `3doudH][T 05ƠऄsXz` rWOCϭ +G0e %ʼn &+m$]!DE9EoiĖ-4SBeGNr(|_ѣCͻl痎Gj51- ,89ǻ2Z(o== HnO|R%mNڰk?+wyޚM%HFhJ+""< sFҊ#"@-(˄|vE--'-Rς`NM;)g>󦮻9{>E|g [^<֢[ I Lkukh)3[$+y3?(Ks _mU&ػa1wiEa:>LFD͍}_iڍ#CM9* L?E;e+,?vH oJ) ʺ`={:}ɫ^H$|Δ/&IC+}綶^~x샵=yWU*ΞN"u}nXFr|$'-*7 Di{QX}fB"teb+܇p"\Mg:_ H8xXۈˤ t*֏'oVfu΀ewy-t\d㵫 o;yڅ6V]8<1d!> stream xڛ&0bnl endstream endobj 56 0 obj <> stream x=W TTG]"v:a NPq5G"D k7؊41$g<6YL" a3WA4F%8fWXTOz[{բ ([i1ۤUW^":_#5 Ti ]cɳsQ4N?Gq|g^ЋSE xٖn4[ry[BBO2u5˚g}b6L-vk 6^o1^fgmV[)-lZmɶdriɋ&{1y1j7W >0a' 0RPQha;a &a.D2!Jb aJX- kx!A#^gg[BX+,n{C"4iFh^| &jhK%_)N:3\'d'LJNл>}r}J؃^=F{~憶6XG5G;鬱R>n 8VulNũzYəsPTj|[_v4G k Lv(]AQ~\|_u=e{:mnb¡BBbd`ݬ\=X<$b\(}"znkЊ#Ijؘ`+OLA.~0mV"t^Oy7э]X .+bISPv gEeFP4Hm *y5V37u҉>gowz="A~s=mڻЉ]"E?­/*s,9@zNf!u$}Eք74qA?+Yo܄z\uaKv+oi]Deos(6ݧ!cF_|e=W0ě;JFp0\m(tvMrSc5gJb6nʜO쎲8>pȩEU;L<b6A]$Wg6s&fc\WtZu)F.E^!;Kgb:Z|L C1T耒&8c,[< َA=b]ιlGd[,쏒>=~ j<=>%&LPu%/;$egMlD+;]Hԫ]vR-K^K?DT;ԣpdsi8)mXQO|jƦwM8M=ʝII)#7`k}>u-E ;jHP泡b6ih8|_tH,SC*5TȬj;P؃/nm7T8Xbg p K9x{6{~Z6xM#)Y&Z| x)w6/>\)$Vn^ mgݬ5>Fɻ-҇cqL-5ϖm=6lxyM&髜}sCMGqxBE¯VdZn**[Q*Tv iqDvqe1ۅtJxy+ek㾱B/`};s_3, yYHHr9zy>)_xw@;.b-\ϖ$?|Ghr?8C (2ܨ g)e 5R+l KUFԷW1 /IH0%f1mE?6` ɀY|:Lhj$yI.܍R{g6xhWb vz5IZ-9 ڰUù]J>s 0 aʥ (Vj$HXaN)b[CT6l۬Ef s>oW?dQ_sW%M[I3,+@V/%斝uW7V"uI/maSNh}Nry%lTJgi\G|Y.'{"޿#3o,zo$(ۋiy1N,+1kZ^A%%e 5h^us? endstream endobj 57 0 obj <> stream x0A}"" endstream endobj 59 0 obj <> stream xU{\W3PQ2LImV-ZZV,T"'!7 o/*jUuZպLlu=9w{bN3k9{Fs}vJx[[ ?_ތ{rDS)y? x `z JaUЅ{u u(( _#T07P*`ExMWDi6-ǐ딴5 )h6ˑD- uס⮺6CBOIL2Ÿ2ϰSE'a:DD׎_:kХ)4eH |u5hvI#Lf[YQ$ Co4eQW+d30/V9P8j%%5 e;)ɘ~Xs&Yi Na?JN4Aw-d*E\[ਨr^}k &; }afYߪSdY ȭi!:`-%Lͺդ׵ܑ˟ D13;X3T>߱hNSED!%52zdnʫfY_:0EÜmHk,ҩܔR$R G;-< ҩ؈gU}8$4-F;tT7:~:If0W /cu\w.w $C|}Ɂ˒bU˨ja4Zh;5}g›#)F{uހWx*:}0SB֜4DYk>1,-=%!VXYQbg 4-W [ M9F;9^]#B rGor ?Gw7'5 7!_%$-YntE0L9 6*lƇ%V['ѴZv)H]0 \ )ߌ} W7: r?;/Piq3 C,W[04O^X50m?U2_]gI?:<1GDoP3laDv4~X6>TykeΛ+(uA+fh}5aF`m}ݍj&q\K x~eQGҹ AVb/LpUԖgZ,9ivy?/Q{M,0dwl1%I#l9zu]LtzC>GzdBͪxʺ\Ugi&"WU73L9v:m3²&57iqgڞ!^'N >`ɨ]2YEy5U x]Bv729f;X|z!).\i`_Ǟx44)& z$x)PrHrI2sͫ/,\Opv\=>˳ l*Nv^[|~[h" q3 0z0{ifq 3#x\^,O-?~s)T~jl߫QYK +ϣ03͸]m`n_{{GN uo>D 'i<qȹ~A>@ԃFS\l׮6Y?;bzk$%6.Qn5 C44Ķ^bn]}Ia$S9eN;s _^uDx_ I6L9N,AI&FfjܜTu<~a 3ٴ!tښNu粒v?3oU(jӮx^Iђ~kuV;s.JQ.er+m4[ـDP Bz}?1.U@wYk!~ R4M,F= 8Io봆$:HND :qY w=Vh{g6xـ@1JA^eqn,F1S[m۹a X_SrHU%d%87ۑ,Bo*t0'/wG/,!#2 * ع ݂ & % endstream endobj 61 0 obj <> stream xk`aŪpX endstream endobj 9 0 obj <> stream xڵX[SH}ϯ;e)*.;I`1dFnvD&=$ x6d6V߾ӟgRaRk&Hecf !ʋH{ORo,@z@;%&<*iJl K>2PF&4ReY~70I+1LDA&]v[FNbUW t˸8Ws9ׁs9,,ۤU:2juQe\wUp<dW p^t<v:cTd=Pn4ybLYۨ5}ծyjeUo\z36.-m,럎mUq[bE-nh԰Qy'dU[e9+[ 2៑*WJ Re/UlO}{[OҷqO/Ea 2N{3y}ͮ!, =˵].b .ߦÀ緳X}/=ɥN$dZǽ0P6r? Zkqud;y=i[cg2_! yR!E6mxZOŢa dT8Pw|"D2h"tfaC:elhZkPY-GYh$OͬiLF՛:AC(0-]XfJ5odҢJ+! 5rT T9؂Uij"$] :&3Dx EC(pkxAZcdxYUӁ[ ₱V<4Aց0:k)u9H\Ɖf ՜""@r[)7 *u1yL=v6̨6[m帖 ՙTȂhG6 І 2dH}>6P1)` iG*6^rʧE\.%mUu`yUw{SgT#h:txCdAWެsq 6`&a5#IJ8T>ækk:vŇ|ATQGDMCP9|H|o3Me>;\-t9]TBn}UQ}GkNeTH]Khqq>M_&ϫY1G*XFmə^W9VG?y6-s#b_aXp< H;P 0+p1r .p!XqO_ˣŏ(oUxŘ L"tZ!nC C bqςCO=7[88 CK!2y9:NR0~|m./;|罣u(>(;~MJBnmD;=>ZxZv1^IͫXm endstream endobj 62 0 obj <]/Root 1 0 R/Info 2 0 R/Size 63/W[1 2 2]/Filter/FlateDecode/Length 169>> stream x%η A@;( Hi2Rz دIhw/&A0a *U ڰDzO,!9ȃ% 4d u@jЁqoGpr_;cU_L@wsnnmqPp endstream endobj startxref 22681 %%EOF actuar/inst/doc/actuar.R0000644000176200001440000000072414522557737014701 0ustar liggesusers### R code from vignette source 'actuar.Rnw' ################################################### ### code chunk number 1: actuar.Rnw:48-50 (eval = FALSE) ################################################### ## vignette(package = "actuar") ## demo(package = "actuar") ################################################### ### code chunk number 2: actuar.Rnw:59-61 (eval = FALSE) ################################################### ## citation() ## citation("actuar") actuar/inst/doc/risk.pdf0000644000176200001440000076210114522560024014725 0ustar liggesusers%PDF-1.5 % 23 0 obj <> stream xڭYɎ#7 +ֈ> [9vN9$Rjq3Awv"Yp>\ο믧?~;|  r.l'jA|Dc= w!_V]|ZIVVtj]ݪϷ_F )o]V[Nڙò+G56s%b[Qa Өd4ТBݝ+ djnS͉aɄ2SE kB뀜t웃NBB6GT>D-nfus]*Geqx|@icg%;f,8s˞8nMxkGXg7{`/ְj*QrRRӐObX$&>< k⭒רy5aPL+n9fERhkވ=!{QiHtaՖ?6[0E#KΗaE~V T_d"utFiÑ)0tRhqZbrl~'\|UB*1hs;RonkJuԻ&"a{ 0"D.2b(mZR`1.MK:>_4L҄š)HW%A鰤e5O%nO?n(@|$*R>zk2g*p6 VbRa{[~`M;&:cvr1-N51FqRէ![?60mLOE餢j^{SW6sI"7Ʃl~YI% vïB\zuk20EӉnǀU IDithu|zrbw镳hhQ!Eznu=?z+T)D#/Nba*.#Zs<5\Pl\\*g{}:iM!ebgq듨As~3ےmaG|^Œ} S*}8w3e%_.UqWS#gN֡.6:&@I>hyArN9ӌ}-JPan7Fnm^f j[R=F]|0X}D:~ƽMJYZN;6Mف%p ;A/N:;:+%)x18&)-o$^L1`wǀǚz l7 r&(1OuiGvx۽xm.^|<6T>st~^p{\{-M%bo?5 endstream endobj 29 0 obj <> stream xZI+Wa"$r17#|p!}i3/oھZ'8I7~_7q?Rx8%Ȼ:AO_$Ȼ0:|U߀ߤC+>ҏR.Qq޼ZKwk#ϜzK~>Ê'C==@^XOLm$z ݝ(0 ~Ό;GdBIWƍ?HJ->6WYF$4^H2EE\͊Tl-¤tL@5"#z‡qNk9 g>2 r%@3J7~fƶnlѼ5>@Y &m̒3l7Jik !g/!N-T>Š#11^xLr#Y0P*|*Qo u;KB]RcŦǪʶ(h :^hpDˑ9sօAgZNqZqP@γkK"_yֽh~0 !FN0h_]t U=/ϣWCvDOY A i%X0 >jlp>`xPدڭnOjH D};5YFMvL- JN2llc&XVT[g>n`{ccҊ6گ'+MD_uՍFR͚TZ R}7g;?s]wMKdɢ.%}O~*݇j}(mϐz&NҸ)kW6191*RFP)1LuV,[ި,Zn'(Fu9/XC4DFW*fe6ۊ^f}E}&I哾z6^ʓ {?SbcZx`˕/w '7xjUːCAc5hF_GcPg^H?vGL0z}Vvv!9MSI}ynH~D= )1yl3ե eN ocdz+cCq3tNPgl*'nQ*!bD)`v]ʆ\^ʷz] _Q7^vڽA=jE 3_~K5/1r\G\c:1YwYmb|bKȅhA?ϥW񀱅9̜Id?w"WyjX"|Z&߰xßFT =ƫREaIJwT=\M][IoaN 퀼XNF'RW*8k WV/rtp۝XN ݤ7 TWJvz~_Jv &?Fտy?faT >Yf_o#'}Za%|AuP~ Z͂zXj]V];E!Ε]W˚oʊUA_q# ~^Cge2U 2৵خ &Mﺅ-?gg&}D*C^GB>}}nJtGF[N%PrV!wGwԝl*0GȣF GME%(qpE/! W=ׄTJ=w:ҖTXMǡ%.:\t]0 ~IkL9Nw#)oK;)p]<I)ө IM:% tu]UM1@D1Cn endstream endobj 33 0 obj <> stream xZˮ6 +QEzYh t.'馳K-I;(#E>O0IS_N'z>}L EdpOC5_xdS/ӏ['`){4ot]ZP:*Hy8߅j\˔q#pZ] !QXE,bi2/(1\A(7?_`ieT^^t<ҨB X!-C¢a@ DӁӐ IXdrlҙ(x,#m-ٽ@cO9>ޛ @ZƆە*|@]7աKo<"<BLݝ.nSξlL~)SY`;ݏc ߹xx`1`th\)dHɞCu8E~JntNu^ѹ0꽛g+bB|4p+BɽR` "AIYx\eZzˤm]p[',%skea쥻81ȀXSA 3q{A1Ȍ97Jtz@!_XwP2>O,!hBk ")A]OB"ȶk{}u+y%4m όU,aDc! '("йYX"&łZT$K|x8ژQ0 @K1{(Rtrz<Q@c%o(6}\҃%%7= ߧ⋝*!XX: J2 --]&\Vj&~#ɼ`Ey+'U!iS(!<3i)f/?VkMɟ60M]msR5c0rQnic/E64YZʫMvC a[!QhK.8 l# M.X}B?J9跭PPd]$GZyh Vz^ TomY s\{-8bzp]ob#7yF-̄d{iޤrueEo k63#Yq2 7ӯ 3bxkduᾐ2NiKo1!XD(~Mn+fg2(\?-sO/{NTh3kcD=}N,g)62gr݋xH.?nW''Ž~Kw'O:f]KYVU:Ϫz2Ϳd:M`OJsݯ[&e`-ai.F`s06 :/$uIٙ'Gw͋w_G߷)]Y2^SeH)okN#ۂoˣ[2u)k&fkz=w\f9o.z#Ӳ*SV%\J1sFT țB6ƴyݕԾʊx ƿTNZ?_\ endstream endobj 40 0 obj <> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 41 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 4808>> stream xڵ˲u)8b7LSJRe]$-%%R^#u{.WSSms_zlOe?ҧڦc~|9e^e*L{eL_=T-sir>S+U:{jmTer" m yQ=y!;.^0wOkoh#Λt ׹lS[ܴQ掎6C;YdvT\& u&CsdRNacޤuE:Y  +RL:Yhx͇t^â1mQ4#SKMJG[= j5yNm^mŃ\]:ڼsGMac>sCG2 T!:XO"+V(Nlo|`dlґL覥\#ЦmOw^;Y\cU]C _ bFwk+zm=ˢZ,++,`aA:WE)2]MyTMީN[)R-%W<^(W?dۼW+0Ч߱Iዧr] Y}ZfM_e ^է['UUOv66h]E6L+t*`YW՛7}onY6^Yسuشw]=k1/wݷ q"mU+Zwru+;k[vU n+z+zjoXE` րVdE.-[Uc`j Em??._=vDy[бE5C,{2ƿ{ ~߬*X .k-k2z?0[?O|dttHTgӛJ[?-DAj^>x}Ec|ņhɓe7KñU3 M>9STp$zU0$J &*+ y 蹿Э_Lt/._jz}uk Y>Wlʒ]& RLICRπ?d5_BTK"DB0w˷?b J]'aK_1_HBc>>[|c//$'(chO~#F.|h"FxhOk2FCڿ~KN?Ne,%?V0ECi4GOTmz҂/ wժyA6֮h*wUѧ^Wqoʒ,kNuac hj-߉ t${V# V rvf2UO/Ն=e@*+U.bT#9F 3ҦiswzaY!A" @R𑭷kt"MNbhUojٱ:ۦZz>-ו0nHުHo/qy[? gnlx}@J[O''u7]$6U96 oVAUYm;m\іǍg14+N<:K{dRS@P@uS ԭ`t3٩6*~f;9(*QNgSd|JÀI O#x*Ny18AHFǨgS6L$Ӟz2禍3D38Ծ/O@}ji2p(? y8F?ml)'iKO+e?Ic@B lP0 P ,@X( f ,@X8 @m-Bbu@XH @XH p!   ]3‹g/^ @h@&EH7b$@1j@j1&P @M?JI`fg#$95.ݫ&zc9`\ŶU5WtUqMU'r B< {Q0 jq 5|~ aнJ{@ʀ@P/`?>СU*!DxE2R!g%>۷?~WBkHQuIQUk 1GBy"g#ۘFfCۘ)ecۘ dc*J \וS8sz1A!ٯWT"ۚ{[pm-We(ϑj[aDlY\1Bk o2f+Ub2m Ž/R}{yTYbEa/c "Kf8Y˻ؼq\Ή͢(ϑj[?K; $:+x,F3H5/u1dmC%@+J²N}{gٻht[;Uhz*7>mS9F+%v-mςyo芜 _p0L&1ں- VFT⊡hk,[b;m\іǍgy_C,~B=?3ϧsPM\J>'duS<坒G)prNSr$~ƽlSrX$T4;{%LLH*KgL2*p3U$#1O&7y~!T{}!Ti {|!T'LC)\)`3U$g LC"o%drE5%WeړpFI1 3FTw-*`Z>:}aoemQ{lQ䊊ϙ>`K#z}`2#FyaO2FEq󆌳GP$Oc:S G?HjIOaPo~> ejw6we:%'P~L MP1taEa$Iz5LPQE;zO2U"qW *J}4֎&xt 3CebLPQ,϶v. ڬݪ'8kLPQC;`eWzp~ֵ*2Ae+7pmۼ*2AeyTT/̍H܀jrʶjZ+Zv~%{aTH-2AY8 ^ Fx<#S!VdPOAeXOe`ƭOAfhƍOfpmOAgxMOg-OIh-Oh-OIi)^r<%qS<%qS<%qS<%qS<%qS<%qS2<%qSR<%qSr<%qS<%qę-O o-Oo-Oo-Oo-Oo-Oo-Oo-Oo-Oo-Oo&qS<%qS<%qS<%qS<%qS<%qS<%qS<%qS<%qS<%qSo-Oo-OoƽAo-Oo-Oo-Oo-Oo-Oo-Oo9?B@8 !N:oǷUVpFmNhqC -Nw8=DrqӋ$(?g9sstHtttu먎;:Qt;ncN8|J)gk> stream xڝXɎ6+bXU\Dч -aF=8H"njL0EvZ?}LOlfoL^i&LD~w̿=_^x&&!SAv̔o?pMuFr_e~׿_~{9냡e9ezk?>2 Pn¤\~ADdmƔ#3V^Bsvn/KDi;[Q,m} eXG|-vV%C])pvV,oہ!&9EiQ3rǍb8js7e=n6ҊX,8Tn$]Z/3c&wuRL(M3>XG46OCBvHT2v("8m x] [Gf.v "4@}Śe 07QɍQ;sǜb1ÈMrҡʢ%p=ynREH֢҃+.k߱mų'2t^?N@x =-hwX@)n߆q$yޕRu |Kih8k;9..+;˶KZ*ѷcid㬈H@J?vkۍ4|MORuw4rS]ޥf:}ʭT}[IBuB{Q+ʪ1/ buCBy(ed{b?C+`4VݐcwO endstream endobj 54 0 obj <> stream x[ˎc +X) $ pMz1Ck,3փCJYz uU?.X|D˓{w-Lu5 casC7`Ra=v3Ցpqz{= thKo _2̵[@Pk*&Ho*N❌px/cFfg ~ Q5hࢫWVHFr= -njYL_SbF7K@DKCgfD^/_grO$ >1wM٤:fStlUE 5˜\ڇIgN!FK9TR85d9`ѭ$!?5?_%TB8C { 78A oi/vF(s LǕ_HaHbx%2|" ϲ4Ti9X%q9k"M{D#,y$kPK]K Ò̓/s<;0Ln˼>@%;5N9v8f!J2A"wwIRqBuvOWU5DP3[1R>_h}XLy2.#Kñ0 Lq Yx&S"u!Vi!6Zv}0+\cJaJ_=[BbƠ aYv@mQRj:vа.U:߆tN;ø1JJ<=.+T^[)|xEl,z#| 鬋7W5VZZ,Dͤ`Fl[LV}#gE9DvlRiZ qNp3 Ƈf᝟Jɤ>d *p+23k?ƁV:KJ`!N G˱3)#oU{>_x9 q쏍Zυ au]nLK4;&{q}1j>?|r9'QͼK,Tfϓ{S-Jzؕz C?"c'+ `JMl:y-bR<hz8$rپg*yCĐ,f_k:*^'c#ۊw\ !.\a$@.~.zg aBj!2Ekű`}Pƥz^-z˭6SZSo6_ Q7^J.S b41{@8 N˂t.,6.k%d$/Nl:>Xagy~ ;ڍ *1HlF`w3BCFR]]]FJgj2..WKAy)R3mLq r-jּ})]>'.vˤyq^5,OYa.̡kRExI85"!!<7Jw* endstream endobj 60 0 obj <> stream xڭ[K$W(LF*ok{=\@IVufSIB/"yvm?`)}{lΉvrAxo'AK_NʫPu{ߥ|<^;^::=IoW:i[]ߪ6VկziLf5z ퟸ'i{8P/k4Hyǿwf`B6 "uxiwd)EBA21%Dl#"Qs׼Q\d%vRs3QE&'b:pS|o#yDBZ뼉+obzs'6F T%g^UxpJ IOu;M%KNkadDQ‚[vp9i-("Bfi/o͵*&%%yo-B׌)hXjL[Uʠlü$4. ?i>)zNZ4iRe)n63~їnNied `e.v) %hQ^9`. lrrgV'讆k2-#6U<v^ßeu*H969@<@ZA!`|竾0bvyoz4_5܅N; C7~Ɩ6bGcp(PE [АެfI/w5"1b$ű{9@}QK 9v@0e[1h*z+@좯ҕLMNjPG* ~wOBLetlP(# < Z}[.!e M_^xJ9љVd@sHc#v@kǩDKgkf+"nigPU4q8m59>N9H0ػJg<-*o8.86"ŇOT9s&lRfek W-IDn"6%NN8:Y9V/AV8+'mBOfj3A5a0#>`P<ϛekjPÅOmmHV`F}'9H-d$LqK3_RHAVFk>zIEXXOxWV^ϫYEf>>Ҫ0jީV iU Ocsਤ} \`wk["Jn:ȮJE5cvȿl+ݤ;k; s01lVhNBwtrhfiu=HDI3K6 e)c{9_٨48n&A#ӦTlבv.*;Tc++ 0k J0@,O3yWenz5j×?3؎vf1f݄(4ZRGUkyS:ADEjȨJƝDٞ}?8' ?qWAe+.̘6PtSq)GۚՅش ETVUF`̵ucCOtPU %osswh쀯,5+<,kѺN*)M] *K}"C4YhgZe/N4S=:2DS"H[ o/ͮ`BNE#MA#s׷TF] -FħON|Aq5E%dpjOYMM.jg(Uԍ+A"倠'qfWU y^ / |^u\#2[PYTrs[Aw}2w47ɜʥ^߶th29@*+UcOΚ&Ç/*w?_r*22 AVvNJYu{j`ݗd8)Gc/p (X͞2-syԌC Z~˒R_"̷p=>ITޅg!Gŝq/ODycjI0؏jq _)XɴQ[y?eƪTm ÿ{j如c|~osX#NvnwWy[~%ӦhV78pe/WOn֓ '%j uNdΔj6k-{&}.Ĥp'zd wҮVLUW]Q[Q2xkҗWps!կHyYa=}->yEaAd_|oeYJiNC2{L*ݙwURv]T^hQQ5 M|Av` 2[Z(*t3v *ǜV1O5{knؐ;}gxQ|j.\1ϛDw0A[S l;o*1 @٦ifɣǖ_wX.TaT`.ZR|qo]D?#Y7I4<TARhJ`b8qſKA]uӁQtp iWPeGO8h;X!lE~C'\)BRm(oCSGɆ ?푣o~ !Nm8u#>zqOc;D;VW28;c|۰ox:Ӊ|izWrڴ~1IFV7:kZ_eU4 U^;eyU\8:hM4ZӖ8&wygjhw|Tiw<ޟ֕J%&JFF-oDΔ(}y/lb\ʥJKJs@H$bvLxf[FZV|r`v J Ͱ$9}YEEst}_+ZQn;94|׿bJ endstream endobj 65 0 obj <> stream xZK6 WDՋz ܊Iaҿ_Rd9bfΞ"c$?aRmj/Y4~-3}XN%}$X,,.Q*JW)-|pb.AP!=,_ʋJ;|[ArN巳is=ws@O'"$ٵ^~Fn7x|~5U[-4Xu`MZߟ^LR:hKB=F? g5d1ت.6 xzm<\`E8K Aikl'; mq놛ñ ,< q,U?>1;Yc&bDdǀ8vF;ic;qx'9a¹Ŧ΋&y.|.?5x 5WUEj .8tl̅}vy&fhvdKjqfȁ!݉blS48I1:!fC4ÂN/Vխ;K(K 1]W N5r.weE8u*|^lI9OJq:7x쀜;7r\/c)bS@df1}ufVc5`H8ZXڋ^/ @:zs?>.Cuȏ~QEǵJ{ HJ6 5⋄ F6ɭF!aHZ|:N4/r⑾JLKMrwk|\Cqr3(?3*ifYXUfTQyFΨ߹{fAυ#q1P=bu"֋X/b)p7qQ\UElI&El~;PawUT9^{1zG #6 b"6$E@5w~fQZ5"vbA >L 1QDv1 |b s4⒨:,bWM?tt1 b F?b F?m&FQ\U'DlYĮ"v?zi?8 4,bD1 Q̂(fAmFuװ0QiN nhʧO$9" }jx(2honV`77St=h.H<&nͯ%V5[v1Du>l xah*c;㖊DAajTI|VA}FL>,&h\/-CI3@~? endstream endobj 73 0 obj <> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 74 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 2841>> stream xڥˎ\,f_$B'%Gď&A?N{@eH ] K @-C?Aݬ|MV⪫11P+/sSIaj_.al\=ݐwo~iiyE%y$rkY Yݓgڞ"Q8 y'=dϛb N=??uNmwm4=_:6MjZW__ *)qkڤ.!/Pzx3><1AfPk3n0%7cKJ1),!J7VeXGتfP),+V 7iUz37 5j:-qJ uggim@%a^%@Ɛ!*PT8vE@"ruuvD@8Y> UCN.'F^CFVG"bӈ\ piM g@#kYjDʙ߼lڴFf ˥huA#Y.ЭMF`[Id~Qj"`SFΑUQ^Un6&4X+ݻF Ј*r- 4"Օ+hDԢofRP+5R'A#k t Be 6XP[ƦrQȜQ;FD-zEOH[QZ~J vh4,oyЈ5V~ QkP9:,K=zhvE5MZS֦UHX|p5KH XTrdaBFVeÑ{4"D^ hDԢX'rfIĝX/%jDԢ;ߗ=Iea,?<hg:> uxѦ`$wf endstream endobj 75 0 obj <> stream xڭVn0 +VHQ+0hs+z=v. /zOC1bHV ?N? =zUHkRicy$NtF:fHttJǏw/(>lF Y.xhTd8/įwJ' q">`lHPhy/.[Ba61K7C{eӞA v}w֌Q+i0*-^X]2$9p$q)UK$V8βRei#ØҔ#3j.%~\rZdOו}JYK+oE (dEFD!%B:IE7[8/0б(C|fvt%KPndD~UF\2eoa\?\/͢I/~o\_z/>,o7pkp8Piɔ$w7*[ĻVY[EFr,g^az~/CJCl 4WxH&FXE2l)38J;,Ck ^õװxy8GڝRonWR;NeP!h Kɬ) {Ͷ=0I?D7m=nt,OiXV0n_C2Nl$_q snS!H0ULSNre6inHLnGkZTA6]:E:VC״׽}gqtO~?pS,O endstream endobj 78 0 obj <> stream xڝY͎6 )qGJ9hm۹=;t~D+)9EƈDD2JQ?|+}*`,%$P'Է'hQEjĨ*> v Sqq֪2˫^+_/ M+S^j]|kҹZzwe좽W' X%7+ߗM)Ld|DS$P\ʽ-W@抬("UdA72#o\th`\u"rmdƻr# d rDWW*~̂w$TdH ]|c]E0V:} x^@ 2%ǭ*]ULCnֶIIX"߅|8D?- #7ױSdOR ,\[I*I*t:o쇇ݥ yWl 1Y ҁǨĐ?+Ce~JHᐧ:K:- ˆ P&IUYMig1y4J++9v)Ac͓T~dA: v$դYPC[HS~0Hv];EZ!)G!DV+䧽$ egQʄz'T {av\> DdC5+t't{b?Wd.\7g[@V`?lӎkrr`i()stxڗ4@~hGryD86|CdRSޑݘ&BNj}܃B::NF"ig +t: I-!PIOl.ӊK43;qvXYr?׽sلNkOV:?{- #Q&[H $ 丂S1' 46zm4l*4d/@^nAg+?cʄ|οhs\i+ he4+\ݞlYio\//i>ۛ6n^>trX_55uO9U+8Ko\B?%ow7)S2YLuzâ7 8= endstream endobj 82 0 obj <> stream xڥZɮ4WyZ@$v!=oSS/qO ~ ,`qHr~w˷?R`x.F Z/IJM{G׃yEeNR>.y}fMOⷖb\xv$?-`EPnYA CWh/3SZ!WhA|dN߅yMY.Sé#W*N6S(3⥡ny{^u]!!jO*Pi&fA(/Vyk$;;=NhmVW.su$y0ykz d2!kgһFF'sC 1:y4 NV(& :o#>aU !_&>;~qc3_Zݘ<&b R(lb!GZ4ۨ=ÝxHՊNp!s1E?tgEW&g? x.fJ(bp#ZdL ! r!: [L`^( KǪ+n#D)1S(}1YAxQNJxB\F.L.L5 y{J:ﴵZ5}-"Gi  :ihѡQΟ򔚠z 4=8ɗް* `ԍF"j R`[5[K$À*0dj4]MՒSpdB[oH<5wlBe3up F5N!)')B,K:fTZtfpGMƺ7kG}64Vи{4qE9:+ N\MJ7<}qF@G{"[|=F o`Y6D믃hMp|6 d4L#&S1Y^ S uf+`?hRq5uq3wqyD8<zEcUaޡ.FJuY dN&)eN;0Њ~OOZq4VBo OT xJ[}(Z_\KTWY bWUE n |tu* ` MBS ζt'rytoYeP)]ꬒa]E5eDr-D(֣ PyaA5 /mQM!랜ćpײ}t&7LQ?ePymE%m`֏}V+w%oW]w:kGiV g ihRU4 U؆ZчZ$X-,瀌/w+ ^c ݇DӊmkYz*[/\գ ݶlU-W o:ClWb7&IÌ7UΌeO"pٽaX]"|"t=JO:yԡ7z5mihJ@Ѐ:F!Uf{-a`պIu<5^KDlu194]RֵƩstɵ{hͼu2ﳖPsƠTOT6d`lmG:5y;at绮3< ٟ,vSܦÝOC7t m؋c,&תNM_:cݷwѓlg4t6n;=zLh֟pS,gFPL X֨1p]9fXLc5;fg&}WssZ n뜹zss_ԃj€Њ(U~,ޠ,.R(hiW%Cu4VPб?yn*iY$s ya2 doƿ虠K)jF֣~7T endstream endobj 90 0 obj <> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 91 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 135850>> stream xԽM6r7?Jo7ɡ$#8HKFdUE5ʓdp>k?{Wu7ן ?_x~_oݯ~h᧥_-돿R?O~.֟!u;S"7 '? @@O?q rR?[ "w`J܀؉?v?W`⯿?y_ǿ\GCh?l?~M{~9wpcp?il?\;W?%,*ӛmy2n܁Q~r3@ :; [ ?vV~?;@a{?R?~<9?<4aq#;Y:%ejgWc)wf4?~~r?կ?o_?_?W|~O_?5yD3_N>7o{{ ok~֏uE~o7?uuwNzw1fw}s59Io}͌27ԡd}nn?O4vn?Af-goPk}iQY2Ż:4ޣ⏿3آf5Nn?}@f1>8~CDfmAln I"\<  ic3O 資 EֿTN3VM"C= 3+$rUz4.a՟*zN F VWgy@ {ԂzmLeh :vJj<.X)OE@Ԃr1rg!טKU{aR3 [ y~^,+R@mk1?W@zd#5n>Ċ'9 +7(-L|+sڟP5| C ֘Mkh buZ Dc-Ђzj;4ƨc D÷CkC˽SS|[@`H=Ȳ-VhA`-g@yh hAhU/o{|Zu헷%J VÇwh j]fj:޳XXz~Uׁ92 ZV f~Z9,d@1K~ѺBݷ=sBn%0Z#q3e#5֮,@ Ĭ YsS5B}4h~:5}cԂl*uNv1{Zip fmR Yk׽[))[p f㥇uN{&9@vk"ud4 ?9uN8㊬!5 [iM$sDm֋1aM$sDvd&地#f؟#>Ht 5*٭t9'n{qs"5s!5s!5s!"o{Dk"Cvk"Cv돿;l{vejg33r23r23rs}djgvejg23rejgvGj.s#5]>"5ݑHenw2+RsgC;QWCD͇nwCD͇nwCD͇nwCD͇n_D͇nݾ5݉>5݉>5݉>5}%j>t5}$j>tJ|v'j>tH|N|+Q۝+Qە3Q۝+QGC;QWCD͇nwCD͇n>5݉ݾ5}$j>tH|#Q۝+QGCD͇n>5}$j>tL|v%j>tL|v%j>tL|v%j>tL|#QO|#QGCD͇nݮD͇n>5}$j>tH|N|N|#Q۝+QGCD͇n>5݉ݾ5}$j>tD#tC3tH|Gm7'jO>B=d;CL>B7}n>QD#t'jK>B+Q|D#tC3tD#tG%jە}n>Q|D#t'jۙ}n?=˯ Cp磼xz~~߿y~ףy %rB }}-'GXYsB^Q|ĈURVQcq4') F\MoatIVv^x)P#uhL(r*Ybli 1aP@pXR"MqXN'A.%5)޳IʇP$NDV(#)FT]BG1+}ĉ% BG{e8D:d8q-+}ĉ3zP'P'ضP'`H[V(s{V(zg#d{CA'w`{8nݲB=NrYw'e8qe8[>D>ĊYaP'Θ5lY#NYN EqxFY#N|[ EqbNB=NCbzg&ٲd{8 WGVlj!HVljmYY`V(ߣL d8mP'hY#NL-僕qaV VDȄP'ff;}UY#N|7= EqbƗ }/BbV(K.ŬP'X~Ya|VYaӾY >ĎOn$cV-£FY5Jc >āY<,9^;^` Eqke8$ EV(g&ַP'V̈cVXmJZA΍ Eq >Ċ/v5+~7+YYx1+2{Vmƛ@K{VZeݪgVwkY!?™pʼn-YaKWʙrʼne%P31$ͲPrYaD,+4밎PJgVf3+Ԩ갎q *Y 5:3+,ze 'V;N.+wX]VX8qbuYazlje 'V;NnVsYavlje '6;Nl.+lw\V8qbsYavlj XG=S3ԹR3ԹR3q|6gR3HmPǥ6gs6gS3m\s6.չCܡKuƥ:u:_u:_u:_u:u2ܙu>2|d6>l|Xl|X#Wfc;Gfc:_u:u2ܙu>2|e6>ֹ2|f6>ֹ3|e6>l|sg6>l|Xl|X#ΝX+Gfc:u>2ܙu2|d6>l|Xl|X#gfc+gfc+gfc:u|fc:u>2|d6>ֹ2|f6>l|X#Wfc;Wfc;Wfc:wfc:u>2|d6>ֹ3|e6>l|[Gs8gX73Xe6㜱of6l>b=9cl>b|:.u#G3Xe6Ε|:>u|fIGG3Xg6Ι|:wf#qGse6l>bܱ/ ;*j c9IAaIiw$g_D6I *@-ZꜤ9|*\"k,ѶX(7ɘX6ZP"Yk>[kc{5X%rP"):A '!݅tRbNbp EI$rO*MDS߃5l#z0=c3X*IO{M" O|*D0|}Ss2| :'g#`) \':J$ȧRFIOeD ?}LQ|1IU1P1EqސESky0(8lOL.O{>5slISO͕[3'#zD3>>[$ȧѺf$ȧK?}SuH3E|=%CŌg?vVG)=lES眜?}LQu7ܝKS5fB+|8F[Sq`OŁOӱ?>n>=6'G"`>>v>>I |}Soo4#c DTL[>>X,IO/EG#Jň)miUc$ȧ$ Ih>>y7IOe\(Sª(#M`$ȧݳ>>G>F=W+ N`)m+-LS6]m6Y2mi1P-sUe?:nVfj5c$ȧ̾O|jq D +>>גɅD{|ƱO|d*'G>Z |}S>=znV{hY=oOdçǦ♵VݷN$ISjg;ZMu TwSW>UzOQ\g-|~>gYZf3|t>ipY 48ݬ~O6kNDžOϝO>;.|w>]|*)TvS§|SمOΧ ʝO>;*.|*w>U\TI~U7SX)?{bu=EXzOQna(V7SX)?5Eqw:q^DaMwD~Gn<&; Evk"ŧ5W:;<\U9$BݚH(٭?*9hl hyhyhy 4ϼ#<+Lx~ę>3}yǙ>3}yǙ>3}yǙ>3}g3}yǙ>3}yǙ>3}g3}g+g#W;W;W;W+gϏ8'wϯ8'wϯ8'qO3}yǙ>3}g#GϏ8'wϯ8'qO3}yř>3}g3}g3}g#g3GOg;GϏ8'qO3}yǙ>3}g3}g3}g#G;WϏ8'qOLx~ř>3}qG'gg7̏3?=<ߊ3?+H<}x ^q7̏Ǚ3?Og~$Wx8#qG̏3?Og~${9pqGyř3?Og~$Wx8#qG̏3?Og~$gxeɻIſҮKT5li5ObH+ƚ<^pcE<35VlVZY pIjx@\+bU602<5W2[7ܡt2/If \1ƚ*/E60Va+I%aNӢdU606'(ݼ5isϞѰ@e+zkF:]{Vl a`&~f1V\>'(nFfPY!cf1Vv1ƏnFbG6*n䋐ߓidxƐ1Aqjpix/arfM6b47XyvU(95:6(ݼ[PY,kfU6 06W(ݼ[f*l^lVyTPY$cfU6a \7|窷fcsl{n#F/"8Ҁff-rlQCf1PM2L7@ac@q3S,J6Ӑ޲Cn#asbT!]esP b437Èy

="N,ԔX{sֿ0 X| 4HĩrT˔[ Yp*m}+8H{g=6#+MY eϚ'ks̰1}oN'P XN5Pֳ9@4@virb</R8,3wHXf} Hᮮ qXfK x Uv5! XNytJQ!]=:}{#g\ ~e'R84@@Q]ʜA`@8/WE*h2i[4@DHTqXf 3Xf{ ]pW i@^1ͳcQN^! b8GlzcQd<H}N(3H0>398V3ԥ<$(R8@4@Y)2[T@THp ̑ G;Q q:irУ'UGSȞ8У|jP̙oY8Qo=J 2{4@))஖v5|X成 2GȮ.ۃq:gQtУ " HĩRT XNd@ N9r @ U(qi8,&H?G-B*e7),H=)'P.GT SYfO]=2pG4Ҁ4.<:'<qg <6`9Q#Q$1@* HUg/R8@4@m}2KTwG]]9ya[>X2#aG]^=Twuː3tHYf qGT@]=Hm~A(:@ ߕ(u2@*h3EGm@4@)XV!]2g [Xm+wmpG4`9Q Ǐ(u;=·SH"AZWTNc”9\ =FH:}} " 'pX]" R8,HYfm]MS* ΏS9HpWi8\E=jԋN&! 38QS `֣$]z ȐSJR XN.qmۮ]-hv8eR8,Hn q t )ʄ24@!#ZX݈ĬOqzTX7q" O{@zTX7q" HĩfM֣a@YX>[0 "hH,3HpWΜ^SN\wuI Yfɐd< @ wu]]H),fHa @@实d=Q-B N=z,%HӸ[4y qXf,@*Hq t 92p]TL]"m34H֛lu&P* o=JvQk[R'2g?[R(,'rh֣a)@*eoe#oe ]pWi8̜ N;a]4@֭G]=?uQt˜Rz:,HpWs}{mwuI,'Z!2繾n=J %HxDi8, Ha=B* Nqin=J5H[TJ}c4`9"WLBP1@* zT^_%ԭG4H)RTN'P! XN @*:H] XN_Q `pX|TV&jmW3K4@ hxF@4@Y)kUz^EG]=?&mQ)h[Xf](#j^EGщ,sDHa2m=JkʠH ҀG}"SN\@# XzTY9^z: G2c4@NBu6֣2 h]Xᮞ![y]]  %HpWQ=C `A w|L#@0@4@9 tDH]Jq:=jZ,ٷN#P Hg~DY.q֣)2](,'X! 'hS tHaDܷE'! '@T Xz&=2S4@ps4`9z(u `%C wui,xDҖeirˬҀ[ pW7JV! XNg@*'@^! X5/֣a#B*@ HkwLѣ2G4birУUHҀyp SdHIJB $dq 4d9;z:,3VHᮎqg{^5-Qp NqӀ4`9:? a9B , Rqwu L#^gVqH@OԆgjC`^ Ţ{6`5|[DuAm,u#P+BEDmXF6` jC`@t^7^gV"ҩ UHA$S"zݐ>^gV&Ҩ iO.auj iauf%a1S9Dt@ԊbѹPEJm,@Ԇ58yP)ZZ!!nm,@ԆBmHz ZZ "Ţ[6r?Fm~!3"XtԆ NdDjEhqF6DX׿qufZo1;_B\"GYH6V%Ҩ 5ZX#1Z۬LRiԆ/1+9$ FjC`qb6D,usB|#,:GjEhqr6DOd))7¢ѵVf*GMZZՉ$jCDr=o¶fq-hC`qrVzJ \xDʍpr6pI XŢK6$s J ڐE(tjC`qC-]!@ԆD.x"F85SG]{5‰p#,EjC`qZ6ppp aѳu7f8K!CҍyKhyK`iXՇhIM:zv}!H6$qK ڐ%'tjCB[k@+B+IԆD2!BmH@!X_ +6!bU@,ԆbѱRENmHj@!bp"-H""XtԆty dP2 VjEhҨ kF8SPjEh񨫙ڐ, T^*Y!F8@!bDs#,z~Y l^ +rZ6_9%ŢWG52.D{]Ԇt dPEx:XF6`djC`qf &X,z]ǣ^7!uHv!L_ݩ \Dʍ|j@Bia{ fe"ڐ?O \H6VqH!bɔ(3E+Ԇ '*HԊ br7.$u^QY,z+l`ݻ%2Y!B"K^UY!FXtԆJmX)H7EwjC:W<2 +srVVrHu>r{yf )\ o+!bU]"XtԆ+:8eP2Щ 5S+B+;$vjC:;=Ԋ^"!Cʍ%t:XL_ejC`6 Ţ{VdYSfLm,LE9]u%^G0-XGڐ5_duX:S{6k8d\z̜۫6IԆji^72#oάDdP ZZH6D,!:2Amj٤a{YE@mx# \WH6DNJm,@ԆtP{"B:N"Xt ԆHmHB2aװ&aXtԆFmHi9l,ua{]fEg^`V`댻2aCpr6 fE]"!Cҍpٿl,u+^`ҩ URnP3"JmH媼@!XtԆĠlSf^gBC4LmXL_jC`iѕ׵AmrZZ!FXtԆ.+ RRnNmHZZ,zjC`ѩ Rי2z:Z$X 5jCĒ^6 ZZH6D,2{ I@B^YH6pȸĢc6V""8jά̢S6^' Xզn GjCĒ^daXt.Ԇ. R!bU@ Ԋ*)7¢K6D(X!FxՇZZ,jCDz@ԆLmXEJmH@!8Sҹt 7l`šM,:^gBCʍP+K{:˵v:Z!FCƅ$|W!KԆQnGwjC`iуX!F8V:¢&u8PR/JmXF6$^YH6D, יjC >z#H|^'6$r}7¢c6Dxn$I"Cʍttҷ@l`Im,^aVТ! ԆnSf͊ωFx@-!Cp")`] l/,]*!be]!8VjC`Z ڨ i\SȠ6=ԊQufUŢ[6 jCjEh螩 Ţ{6wjC:=Q7"CڍpF6D,u/0*!XhԆ4./ dP+9$݈ @D!+Ԇ @+\Q"@mH@"!Dm,N%6Ԇ^'6ZZ,z%k&6k8d\HFmH:@! jE`!8)RŢS6rXArV GjC`qr6Dƣ.WjC`ܩ (ZZR sʠ6dpyYAjVVsHq!P3!XtԆ @+H{\g9цQ79z,us J|^G+;$HsHu9VrH@/ԆHцn<Ԋb#R0!Cƅh3}!,ztjC`y"`i Ĭt#H6$rZ dԅڐEjO$HsHEjC`yR+)68H' \H6$q7vцFmXuS^IY,:jEh54]_`Fq{%fyގ+)6E@mH°@2!8V!Xt~YtԆd. RR0,Fm~!ENmHb@! R"8kdцD $S뉔kц+XZt6sU ՇZZ!FXXuBmx#ک /D{]Ԇ *H{hڐXOd\ Ţ[65jC,hEhu=^G:` K{ 7¢gT`ibzr#,z~`i[_>z-@ԆҢ!k;ȸN$ԆQ7Du׍LmH@:!2NDV ĬNR"zzڐ jC`U 45jCB+rYbXtԆjD:!K.:CҍhуX!B >Ԋ@m,!I |vd{%fE:C-R+9$`~s(X^^IaVd)Q8HsHXeuf7nجz#\ +s֕kzYbhqF6D,u/G(Ԇ.QҸTNm,YP4*Lmq!uU^IY!FNmXu-zP ZZH6D,]_HvH:!˳Ԇ &Ⱥl[3E ŢJ s"Bk[3G PWRl^q+)̊H62YԨ J s" !8QҸAmXEZZ,$jC`q%O)( ҩ URnEׇZXP!8RENmHJe@hڐeȀdjC2!;v!Z6r2ACr# K{]/Ԇ1RRFm,@Ԇ YG:b!؏^G9]:X'~:ZRt/:WRlpȸ]_HvHF$RDmHQ@2!Cʍt"ڐ$a!P+B!Cƅ='>ŢC6riRύ$Ѣ!0Ԇ8aP2 2c{%f ?'ҟLm,@lԆbqP2 )P+B"!KH"5WRl^3+)6Q[S+<'ag{%f蜩 \IDh[Ӎ7EjC` ^hqJ6$p! י@ԆdRPEJmH2@!ԆAmXL_ZZ!F85S`ˁ콎X!F8Q":£vjC:W@9~!C-@+Ԇ7¢[6˪#,z^suC4 ^7ӮiWz^G8HwHu3Jh n0/E Lm,=s׿9z,LR4BmH#@:!Ԇ^'KDjC`5 ,:djC`P UTjC*W8~!uo^IY!F81P+B#!bx"=ڐą&djC2R )\H6qqAC-!AVn<ц/EGݼK+) ,zO+)6E/JDm,@ Ԋ,DjC`蒨 < < ++X!F8bE!bi3}!!FCꍰP+pj6VvHv!j6VtHr#<6D,uVVvH@ ԆPp"B׵HmH@2!8P":£?ԊЪ7¢{6$L|\X!C^Gpf(Xu^G;_ ڐi@2!sTjC*giԆ4~?r#!B׍Nm,)Z2N+)6)ԆNm2 ~ @Cv!uH$PIԆb!S"VcѡRR9)H6s9Amq!ED-@ԆdNR .HԊb)QEJmHn ڐ&S9*mά|#!F8s]%ц f>oGݺ^IY,zi{%Y1H 7XWiufUa3(L+)J,z~隶WRl` A|"Bs"-zPPjEhqJ6$qb/LmH\ ڐɴ'nP!bi3}!Zt6sv*AmSAjV`/m,uSEZXZ6VvH@KԆ5jC`֩ URn3"L_|:Z,z]|:XF6^+uVY_fɔHNmf%"ڐ 5$jC NݬLPR87Dڅd!WRlXȠ6 >Ԋ*,:FjC`蘨 ڐn'2.Dzݡ/8HwHX!FFmH$ARVV'ÍpR6$qLmXEBmx#T s"!|%E~i{%febl`lmX!H7¢UJbSf^+!H4jCgwԆb뒧:(X,z]8^W*!8Q8/Ƞ6VwHuVVrH@ ԆDmXj6VqH@ԆTN.8Ң!ٟH+6e,uuP2ii=ԊЊ7hڐO;Z3}!!F8ʵk֣^7xLuNmH@!MhURo!bi[uxJmH'n0mXz6gAz=z-= !bi3}!2k!2h fU"XH6D, qJ@CF$P"zݮ/$9$X!Bv}!Zt6$^ ڐ'{Od\JmBQKԆtyّfSf7n@oWRl^7 +) ,z]o,@Ԇt> dP2 B{{%fԩ HX!BŢJb9Qk8d\HLm,.WRl." DjC`%QW!՝ȸNLmHsj@!O RjEh |Dʍpj6$ٰ{-];!8uPjE`ikڐNnڐ(@qW?z-VuH-SՁp#!Fxԭk~:Xz6$I7X}^ !XBGXWhݦnpȸu/DԆԆn}1ޏ^G+9$ڐ'cdjC^7 !ϴԆjintjC:HoMݬBQ;_zݮ/$Ԇ@BV R |@F:! Ԇ [3+9$^J+aSf DB|#,:jCĊ,z=b89al`cufu¬ĢS6I7Hڐ/4jCDr-S!_ "X^IY!F89Sp#H6VvH@}V~י=׿9z~!L_p~^GK.Ԇ~dP2 VVqH~!L_`^6$' ڐoTjC*Ҩ iNHP+B9] H6`<Ԋ@mH@!_IH=2!>BmXL_] ̲4jCyA)ڐΈy"@̪722.n=mL$S99RRHBQ;_zZXZ6d0dƢڢ +rfRWRlڐTH6DHzn*!NmHgddP2H7"x@mH`$RHr#X FFm,@ԆtZ'2.K"X|#oجv!9 jC 3 ڐCP+kpr6$2 Ţs6#u8m0 Ȣ ţn9yhe̫hцdԆ jCoOHsHu/G]}URoE@mH%DmHމiiDLmH=BmH JmH}Nmz#DmH%7Jm,:!܂@-@Ԇd^rԆT^,H;!t:Zu^G.hu AjC/~DjC"/[$jC/TjC`e"ڐ ڐ3X3EH-.(WRlV'R +sB6z"FXtԆt jC*P+BԆDN_H 'RÍpb6$QԆb3+)jDZ@ԆFmX9܈ݩ H"8)Q"'2T )l+@*!CC2{ݮ/8܈ݨ +po)!hC?ʂ|:Z,z9:o+! FmH1dP2x H~!օv>z|#,z>hqJ6TjC*H6.cX9HrHuePk8d\HH|# K{]ԆJI7RRnP;!biX,=ԊlSf7k8d8X3}!,zEuX.Gn>[,XѪ7E7jCĊoG]Ԇpz6jC`u ^.hiуXu_Ply葨 .D{ Q72!Bm,-S":"PlάFP"z`(oجx#HԊD!b^IY!FC "ڐi-R9]HxN$<7¢mJͪ7XQyݦ̪9nά|#,zl0+X XuR^gݩ +kуX!FCK" URn9]HDmt#,:ejC`u iT ţ.5jC`P+B!biˉX!FXt.Ԇpr6 7jC`iѝڐi5u/$;$HsHu떪VrHz#!B׭oIB ]~dW@,\d)mP*Y!PY.,F_]'ԂҲ22r xN:ʬPJ JwrR~OׁFPFVXsڟ3]@>t#K1~2Ȼ.CORYם')^ee4eYn#ZAYA|6>IB }߾')^hefee'b'K1COC>"K9JeNJerbR ̤͠WiԠԬjd)VPVR:O]Yd)ZPZVFPFV|,Q(Ya#bo$} , CNrкʺ"K142]W7Y!n gee딓҂ҲcR d)yݧ^>]b^|z%K9ȻwC5(5+ }^>]AI,oC-(-+ =~dW y)'dǘ, :0hd)FPFVvPvRF'K1CoC3(3)u|S7 Y, :头̠̤xFbd<:Oݜd)7͐^?]lC#(#+,9 O/u ^, X, 0T?]b0T?]AYYAYIە,P J CFrw}@%(%+=(=+>"K9ȻN9)gmeSJ!K1QYAuÑIjAiY(, wNJ J͊R -S!ɓjAiYa諓AI,d)zPzV|Ir#>IIa񮽺N<:!_OR]\%+,9 +B,L O]Yd)ȮX@-d)VPVR* x1OR0"KBIrPcu7Y!ߟp_Z%K142]@ڧ@-(-+,u딓RR K1 d)y׵EbeEv] Y,FWfGOOb$K9b9'K1ԂҲ d)y)'[t]: x}S˦u,B)d)Ys$PEd))Evd)XBhe&ź K142IrиʸPYCoC,ȮzPzVVPVRC,P J (,O]d)UvJJ (,FIwNR YAU++t'K1"K9ȻnC-(-+ ٕ>ߧ@,r:Y3~sC,>,O}FOSN CFbhe&Ż9Yp.NrwrRx$K1CoC,`ȮSN , Jwhd)Xd)FPFV|Erw]/b],CIbhe%Żn.C>&K142EvAd)xu ק yu p-~C#(#+ }=OYp, :ԠԬ]R x)'Ňnd)|Abhe'ŻnOC>"K1Co頻_VwO6Eh\d)6J!K9Ⱥ|{>IB AI{Н,PGd)$K9ȺR Л, * 0}6^xbd)|Eb$PJ$K142R,C5(5+,~d)X@Ȯj }o>IB ]+YPYA> ')^$K1Z!bheJb['K1m420tȮ,P J , JwztEbBbhe딓ud)jPjV|Ibȇd)y=:P J Lw}?0@,`vC,9]OׁVPVR&K1j hedBrwrRz5C3(3)ukb#AYa"K9ȻN9)IsIjAiY(YAuE$ ՠԬ Fbhe%źCwC3(3+eTYUȮ:J%K1W'K91W/Eb\,NJ/_#b"K9heK%K1J'K1۫++>"K1CoC;(;)C׋, J} ,O]d)uus.蟮]1]@ y)':=R 6R{(u zbjPcbAYaRWWVZPZVfPfR;:P JJJϊ/`]Y0  , :x׍FbfeedŇd)7''e3]#ǧ@,92B,WNbNrwd)OR x=':C, Lws4>]AYa8>]bR[, X,CCu"K1v%K1v#K1S;YAul|tP]+/4P:Yzn^xR MSCu.C#(#+ hutН, xTuB=(=+>"K9\_\YAYlC]AYaK y)'the%Je ')^e&I **Y!p5C,}9YA>/')^ȇd)X}9 (,VJ+Ya2R 1td)uPdW@,^d)C ]YA* xuB3(3)Ӈd)ȮzPzVX@+d)y׵JbeFbNrwrR|AbIr{Nu _&K1Ȭ1st3t]_庲Ct{:Cuftd<: JwsFГ,Ő/`AISNJJ ?+딓RR22У]7Y!0&YﺱR R Cu"K1TR22f#K9ȻnC ='YSNR 1}2ۧ@,9u+$K1ԂҲ}ΐwsj>]by}]'YﺽR R$ ՠԬ,, wNJ JD)d)vPvR9)=(=+>t%K9hЍ,P J͊/`'YAۇ^d)|, .+~wOR NbܿN;YA xfORP J CBvwNrPaNb/eT_RRSWY!~OR5YP YAuIaR #ZAYIkY!n,CFbhe'Ż-C>&K1Gvb"K1TR22Y@/d)X@d)fPfP9/OׁjPjVXs6YAud|}t$K9\_\YiAiY,딓RR~2+V!K9ȻN9) 'OׁXd)vPvR딓CC+(+)ukbkb}]1.d)M+YRSNJ JJJ ؝, =R Ћ,Ő/`: Xj埤xtBbhT9)eAYYAuf#bxޟpT_Ib\,Bd)뫴++-(-+,ȮX}H\OR8P YAܧѓ+, (,y}yeԋ k#K9heǻbubRWWVX@d)X@]ԵJrK]O]tI'K9ȻN9)5(5+>&K1]w_ ,Zק@3(3+,9YAuIaMк>]bRSN n'b"K1]7*Y!0Y!0&YAucAYa#b]O:the'ŻnC=(=+>"K9ȻN9),`nC,`]dW@ Yʍ>::P J Lw}Xu |ԃҳ۝, VjOׁ>: ؅, =R 1KU>]ZAYIi~Ya{AY7YAuޟj(YwNJEd)zPzVVPVR<òC>$K14PYRZ嫬C_,Mb hedK!KQwNJ J O$B5(5+,R \P_]\_\YiAiYAYl*OsFyBgee&ZR ZR 1tmd)v: xCʬP JˊR򮫛, hPJ O]d)y׵AbeIbErwrR|Mbhe&ŻN9)]gȻ9ROׁjPjVXd)Xsj3]ڧ@=(=+,`,&K1TR22]7/+ YR 1}Cڧ y)'dgee%Ż9OׁXd)Xd)vPvR"K1ԂҲ22]^?+ ^YyC-(-+3(3+,;YAuϱԃҳC딓 d)|,ŐR{u:0nd)Xd)X^d)y)'eeefMrwrRWQ^he%2;7ͲC(,Fd)s`}}⅚)W#(,$K1"K1ԃҳ')_x~^x!𜯇NbIAYa$Paxbe⩫ k#K9x7 6u/o>I!.C5(5+,nC+(+)EvԂҲZ!K12xZ%K1ԃҳ]:Y!Y!zAIYMbO]R,P J , T=w~u zAYait~ΐws''bȻ󛟮ՠԬ0hd)vPvR"K1&K1 p~ΐwrRX,d)Xd)VPVRk:P J , ﺹR Л, XCuAYAYa]Y!5R Ћ, :夰t1?]b"K1uIa+/<,Nw;ĵ>]Y!֧ y)'Ňd)FPFVsʬuuN:uB-(-+AIyiN C+(+)݇^d)jPjV&K12/, YAuY!&Y!pmU֕.?+PYA|]SWY!.,F^䤰pNhedee'*_*Yay'b pQ}J J xΑ[̾ , 琸?]b#b缴?]bo" y׵Nb$K1Y@[d)X@d)FPFVȮWWVXs0۟Ե?]gȻ7C ;Y!Y!'YAu}jAiYAYa"bȻnC =YUO]w_ , Nb}rsC,>,Oݜd)ytfܗE'ZAYISNJ J O:'K9ȻnUC=(=+,`5V'K1 K142CO딓 Xd)zȮY Y!]RSN CAbhedIru]yN:IAYAAwNJE)d)J#K1b]ٲC e7YABvTRd)VPVR*CWIb1d)X}t8Fd)UZJJ (,$K1e7Y C ]Y!P;YAAbgee%e]_e]YauAYa#bȻN9)-(-+,urRjPjV>/: Jw}:Y!AYL딓Swvthe%ŻN9),>/ hed{!K9ȻwC,>/, LwrR|IbEbW'K9Ȼ.1R ̬͠QR,CFbG'K9heEbhed!:夰yAAmOׁ9GOׁzPzVXɓ] P J x1U̾ x(u딓1~л]1T_RR{bdO:̎zzeJ!K142b]I(,PGd)&K9h0UȮZPZVJ%K1b]IakAIY,d)jPjV\dW@ ] YAJbFbheORTR t t^]'S^9:>IB }_x!.ګX3T6C=(=+,942+T_SW'Yz]W7Y!.+VR R 6R x׵IbEbMbCuIa^R ^RSN CNbhedArwrRZPZVfPfPN9)Ibgee%Ż9Oׁ|,Nws韮 1RSN CIbhedMrw]1R 1sY?]bs]7Y, :夰5ɮXZd)zm딓Ev42]\gOׁjPjVXRR RSNJ Jˊ=R Rn4uIAY9C?9Z6yevs^ze*J!K14P*YwNJ JDid)UY_"K9ȺyYٲ+ *Y!:Y^J/YaweIZAYI,9 2B,+y}yeJbhe&eeŇd)zPzVX@d)++>"K1 d)X@ȮIB  y=Ru @ @>"K9\_\Ya"AIk, h, xKu  y,CJbhedFrwrRzPzVX@d)yAbfŇd)|Mrw]qbc~ΐwݨd)Xhd)Xd)xEvŐwd)X\d)XȮXd)7ZQu ~~>]bz2Ȼ9Oׁ9Oׁ|Mb<|ZWfy)'9Oׁ}ΐwݮd)JPJVXd)VPVR K1TR&K1t~}BȺQ.Cd]IAYAYY(, wNJ Jˊ=R YA|U d)]1ԠԬ"K1W!K䤰_ ̤͠\$K13J{2ȻN9)glFd)+R MAru;'LCeZ\CJbFb\, YA/"bϹ^u4Y@d)jPjVtC;(;)AbIbhe&eeEbR I1IIAYaaN<ǘ')U~1OR LJ}ˊ=R Ћ, Jw]d)xڏ Erw]d)X@kd)X@d)r꟮3]dW@]bx2+42]ܐ+B,`.&K1Ig|"K1V!K9ȻnUC Y!^, K1TRS&Y!z]P J ؝, ﺽR ՠԬs1^ X׽sRJ'K14Q&YR{Л, wNJ59W \,9+B,9W RI GMb')zPzVVPVR*C,P J xKʬ (,StޟAYYAIbfŇ^d)vPvR/`b"AI ] YP+YR Н, , , ﺺR VȮ]gȻ+ ֧@3(3)ua}sz2+ԃҳS7YAuIAYaϹ`}st!QR 1d)XXd)y׍Mb hedee%Żn6C-(-+ =;YAusbsbGv"K9ȻnC,~^AY[, :5RnuuzZAYI{.h@ K12},PJϊRZ,]"K1JbS6C_, Y!P~dWnt')9) }')zPzVX}t\WV>u]ORН, ('K9RJVzPzVȮ,>,P J CBrPJj#K1j'K9ȻN9)> K1ԃҳ]wߧ@-(-+Ebhe'ŻnC ~dW@ .Z!K1Z%K1mb6RWWVX@[d)x&Kѥ/upd)X}OSN C7d: LwC,>, 4z]R?+ 0.C = Y!, yC,`ȮfPfREbdBbhe%Ż>^ק@-(-+,`vC;(;)usAYAI[?+ UR RSNJ J CArOWt']0}0ʧ y)'gAYۃ, :̠̤xIbfŇ^d)|, :"K9hed he%e3td)jPjVFPFVxʃ$ż!Ibnbm/%/ϩIbGvPJ"K1ЭAISN O]kd)VPVR딓 K142CO딓 Xd)|, #AYa%+/]+Y,Nw]d)zPzV|Ar}ˊ/`,CٕMus4?]AI@ @,9/M2B,`Ȯ{@ @ @,9uO򮛋,CMb׏슡EbfnUC;(;)Nbeee&Żn C5(5+,`MC+(+)uIiAiY,C;(;)uI7Y!?+EbBbw%K1ON xΑu >]gȻ9Oׁ9-2B=(=+ d]WIj(,@d)vPvRR ̠̤Xוsv[(Y! YJb\,C_,*㗕܅W ++,ȮFPFVvPvRV*dEbBrfYPYʍ6]W΁uN9>IB3(3)\L?]bϯ<@+(+)uIaubyS.+딓-the&ŻUC i@ X@,MCt_d)fPfVvPvR딓҃ҳ] YY>R 6YAuIa#AYa"KC姮/u ϑ: ϑ'bȻN9)=(=+ =/䀹_VX,d)X}`-Oׁ|FrwrRX[ѓAISN=R YAu>]b#bUR UR[,CAbhe%e5R R ԭMbhe'e#bb]wu ރ,PJ ʥ(:P JNu'[6Egee%ź>֓AY(,Nyev>ܳe)ZPZVfPfRC_C_,PJ (BAbe\,N੻/>IB,\d)MpNbfK%K1R Н,*P&Y# >Iq,P J [^ϴ|n)̤͠xݷ'K1TRCOC+(+)ud)ZPZV+Z%K1 K1$K1]dW@,_d)FPFVx"K9ȻN9) =~dW@,`\d)y)'G!K142F%K9ȻN9)t'K1C5{eRQ&YR \\%+,9< BU/+5(5+,952B,9]ba^u] Ƨ@II7Y!=_ bu} C?h>IB \D>IB,C{^uTW)%+> K1CO_VX@d)xڏ he'1tR VR ̤͠x׵FbfNbIrwYЛ, ?+z!K1нb>RZ~Ya}AYYA* , ʃ7Y1t"K1ԃҳs~2Je')^hedee%t_]'SW&Y!~}B3t-d)Xk:, :夰:R R =OSN C h, :0t[d)FPFVX@d)yBvԂҲнA_u'K1\u:夰ۓb/Nv]w>]jAiYac]7YzbGvŐwld)ZPZV:NwrRx$K1Co X?+.C;(;)u*OׁZPZVXd)y)'fFbNrw}Oׁ|IbhefRnt+ >]bz}bd)FPFV?tC,`oC3(3)u)lPER uFbht9)-(-+e(, wNJJ J}ˊ/`bGv2YujAiY(,!>IB }5C,d)VPVR=R Ћ,Ȋ/`܈OR|rR橯OR L#R ՠԬ0}ꪯORNJa,'K1AIO|TR Xd)x&K9ȻȮ>$: , :R 1td)X}r+딓S Y*YAumbmAI?+/C ;YAuIAYa},FU]zAI{Αu~Αu p_М, ⩻pjt$K1]7dW@,`VC }_:CuIasbsAI{u ~dW@,`]d)y)'fW#K1]7Y: w!K9ȻnWC,`OC#(#+;(;(IuKORLBruskYR uNbhe%źn=/')ZPZV|Ibhe'RKV|Mb Y!pUC#(#+ }5z*de\,*zb$K122Ћ,NlC ]~dW@ ].6 (,P J CFbK'KQuN]ʬ xTu 0?]gȻN9) }: xKu:头}'K1]w_:C LwrRX@+d)FPFVvPvR: h,P JˊRk,P JɊ/`ZAYIo1ktȇd)X@]^RSNJJ , :ԠԬН,P=:P J Lws4:>]ZAYISN xʬ , :Ѓ, xnǧ y)'Ňd)FPFVXsWfyBb9&K1"bh랻:C?ud[r0 ~XVk9]Y`0xd֑uݙP2YRR6[j|%PAd))GvЩlTW)9*(,e#3"K1.Ee^ JcGvT/Fs!K1.eR KiQaR6, /C,Ȯ09(RJT,BQ_%Ѝ,Ő/`l_%R.DŇ^d)̠\ ^Jʸu)+(5r&K14/eЍ,PYu)+(uAaήX@d)yוFb K1eb5]1],и\$,e#:pEbۏʋ=2;t,K1T.D$K1"KyPҾF)G q=?+)w[x%Ł̠$*R/GŇd)UrJEd)ƥW)0tJdW@,zd@, N,и^/ͣ5Y!z2Y@NdW@RJT8r&K1.ee2RTX@d)ƥWK)QiҢr#KhН,ŐR KQY.eދ:Cu ~ק y׽W]ur)%*RzT0[3Y@]KQ{[3]^Oׁ䨰 : ,e#:0tdW@,UC,5딃mbGvŐw]Od)8z&K1нZ]+Yz)5*>t#KȻN9(,yog)X@d)8$KȻ/CRJT#S=:P\j,e#:0s~1s~W;KȻYz)5*RFPf"b3bbR6{.u 0'Y~)=*RVP˻t׏ 8PzbGvPaIR q=_2RY@^d)X@IdW@RzT_;^I!9o+)T/Fe\JgR K)QiҢ"KhpLvT/Fk!K1.eŻ.C ~dW@RfP﫬_TX@Kd)0td)<2ɲCRjTXs y)Ňd)|,м:KQaήXs] K1}2], ?+ ~@RVPZ*-ELbh\wDZt\J , ,e#ﺱR 1]R YR6򮛝,Pq)#(us*RGv+<vb<,C'u3:^;@˦KiQ(,e#뺶O׏WRTCZRW)9*RZTƥX׽?~,PAYd):Ȯ̠42Y! Y!N,e*Y!:Y!zl4W)*, ȮX@Nd)8r&Kh2tnd)ڥKAY, C>"K1GvJ&KyP߰Zb^J C+)vwrPX-C1B3]"lg)X@d)֥xBbJb>^Iq Ε, ȍ,e*;Y~)=* ~?pB\ ?NK&K٨2td)䨰R KAi> K1Gv/GLQ_0{}@RFPj%K1QWY~)=*>$KȻN9(RjTȮSJY!R4ut\J xOǧ@RVP딃COCRFPޓ:C'u ~~Ƨ@,g딃Q'Yq)#(u}b#]KiQat!R 1R KQ,e#:堰#2]7Y!,P^]8S]R Ѝ, ,e#:pIbh^ʼ{.@,:c~/Gk:CuAae<2]^Oׁ|AbIbh/`MuRR Fbht2R KAGfǾ#BŔɮ:J!K1J JQa22:-C 3Py)3(.C Yq)#*, w ȃ,Ő=R 1t]y3K:!ZX{GfX{bw+)2C(+)еjҢ֧ y)k'K1ޯȬк#bR 1td)y)Fb_Jʺ K1$K1QCuAabu YFuARz'K1$KȻn+v)-*,`T:堔K)Qa>]b>]gȻN9(,FYq)#(uALCRZT8o$K1"K1f"bȻN9( =3Y!,e#:堰YR KQYF X,иq)E]Oׁ=/KiQazt!:Г, xYu)+(u;u-".EeT>/G SR"(,к?XbTCRFP﫴_T䨰R KA>"K1T/F_J xOWR8΅, (슡J&K1QW Y~)=*RfP (,Pz<_I=ٲ+ E]' ~Qb{?_I! K1޳ztG]KdW y׽u n, h,e#6R 1tOdW@RzT̠x)^J CBbh] w]d)X@od)|Nw{Z?]b#]~.eŻnTC,`tC,`L딃Gvг2],CIbE򠦮S G{>]bpt!}T.D'uu)+(uAa e;bkl]wTߏWR$C%lɕ,PEd)$K1PYF~ή:%C 2YFٵȾC, UCZ2|Ab^J H,e*?+v)-*RfPV*+Es"K1r!K1r%KyГ,м]@,=KQatx%PN_%KQ+,eC7C>t'K1CRfP k"K1j&K1j%KȻ6C ];Y!CuA)R/Ge] H_eKQ;YFuAɗ$K14/eŻN9( dW@,gC,7 u{?>]jҢ2.eŻU>>]*RCOCRVPޫ:Pq)#(ubcbc{orOS x==2{~)=*,`6f'K1s2]zbȮXl]Yz)5* YFuk /R MBu~x?^Iq2R uIbh,J<ޏWRTCRFPJ1{~@RzT̠dd]'T/FŇ^d)X@NdW }g)8r#K1LWRUΓ, ȋ, xuBRVPZ*-G7=и*., (, (,e"K1T/Fe\ʈ ?+j"K1еb:R6Z,%+  Y~)=* *YʃN9(,=^w}ΐws>]'Yv)-*,yug)y׽u ~羚OׁWCRVPz#K1.E K٨JE\J G]_d)֥4e: ,e#R K)QacbGvŐwLd)z6C,`.C,`e+딃.EW#KȻN9(,` C Y=~r?^IahOJEd)ƥX׽زCRrTڥLIQYz)5*ݔ#ZRW)9*RZTXsO~g)WBbȇd)|NQK_\ɮ::CIb(_J (?+ 8^I!4W)*RJTX@d)X@d)UfR KAY,tC>"K1Gv4/e^JR)<ҧ@ <*:ҧ y)]2]P;Y!YFu}bR KA Nb K1cl]7Yz)5* ܑu딃f"K1.EnfUurPMKQa=Q?]gȻN9(> K1 d)y׽u ɮKA[,P=tgh+)>:^IqR 5BbhTR uSR"Z:eC Y!YFU/* :Y~)=*, -& ?+RR 1td)X@d)-'Y!P~dW@RJ9WR<_, xuBRVPC+)wb<_,e*r)%*>"K1j"b]'Wx%ŁNCRVPZ"k,м:堰VR VR 1tkd)y׵Nb^J h,e#ﺶR 1t/dW@,7CRfPz'K1}2"KȻN9( =~dW@ =2Yʃ=2A)RQ?]bNmt!3: ,e#T.D]J xoO{9@>"K1/GDvŐwd)zUC YFNbIbh_9WRh#RR FuݙR.DtCRfP=R KQLCRVP;J1t]TR43wjWR_b\R6J,;:X{r;bׯx%Pfx%Ł䨰R qԕIQI_KQa8NLQeZR KiQalX@md)ʥKQYFuARC/딃ڏ ]J G]d)y , , xǧ y׍Dv#b8^Iqr)%*RzT$Ky0{r@RFP xguB 8Pi#r*9E^JR KYA)_ K1CO*C_+)X@Nd)X@d):CJbAbh\J˓,CBv/GJ`S;N^J C ,e#ﺚR qBbk#KȻ=k:R KQYʃ?]R:CuAaYt_Y!3럮3]Y!?+q)#*,ΐw]d)OC =~dW U02Y!~?]{vOׁ֥x)NbAwݘd)ʥȮ̠x)g&K1f'K1$KȻn.CRZTz%+ X, x@ Y!^,AGfߟXbguq)#(ut\JʳۯUN4/eoJEd):$K1PYFo= WR_Dlv7TC s'b4R6j, g+z)5* YFU/*, WC, 7CRfP=R Ћ, ( h] dR KiQalX@d)ʥKQYʃ''ӻD,=s+)N^Iq^Iq"NdD,^v~QsOk, xO(?2{"Y!&YFuץuv)-*,7z'K1Gv#bl]R 1d)y׍Ib(_J ,CCu*Rf#K1Q7'YFuGvV"K1V&KȻnUC :Y!^,^~5ΦZtݙRQ*Yq)#* ld]C e2=qZG DbC *YF%޳̞IuݙGvޓ̞h^ JcyRyZY@^d)$+ .,eJ'K1T.D&+ ,eQRj!Kh1td)ʥKiQaGvA맮{gu ~XOׁ}.eŻ9YOׁ'+ ~Nyu2 ,P~)=* y[O*,OCRjTX]1],P,e#:0(d)Xd)Xspg)y׍Nbȇd)̠x=;K1 g"K1.eeYR R KA񮛃,P0'Y!0YʃN9( ܮ: xNnwbh] wsҧ@ ܴ\u ",e#:p=7-Wt_J=R6[,P=o-Ⱥe)2J!K1P*YR6CZ:r)%*RzT)GvP_0tJd)X@*d)W0td):5CRfPf*3E^JR6Z~Qa9]KiQaR^]|tP\,Gs]uR*)GuB,๺YFLb\J C??;X:!ܩYFIb^JR Ȯ򮫙,Py)3(ubܝңC$K1"K1Z"bȻeC Y~)=*, $K1T/F{"Z]3Yv)-* +Yʃ~d͝, xʧ@,*KYA{/ʧ@,ཌ)NF%KȻntC ^OׁڥKA񮛉 ^J CJbh] wrPF)1d)50Yr)%*u+]1*d)u&Yz)5*{C]ȺSrtPAd) K14MyOKu;V9NTCZ(,e#UjҢC/UAa`=N_J C?ztJJQa e=NI](3s{գʥR ]稤RRTԨR 2R6v)-*,= (, xnrztP,eJOQRul]*R VR KAk,PY!Cu=jҢF"򢦮S G{V>]ң[=w{n>]bo Vtȇ^d)y){R 1C>]gȻnVCRJTpAwrP|IbCuUtW#K1kbkl]z)5*{ՎZb]w栴KiQ(,e#뺺kʥtSR"ZWY9*RjTX@d)t]':!~uBRzTX{؏sWI)* -G l#, Cuybɮ* ]*Yr)%*,tC ]&YF5[|= ,e*r)%*,:R6zY!OS CLbh^ dbk,Ő=R6k, I򠡮{Oׁ5t]J xƧ y׽yu , xO?2{"~O{~¹Ƨ@ =+Yy)3(Fb<,Ő=R KYA,`.C,`u+ 5R6oY:R KiQ(,e#3LCRzT))]1d]ݮqtCNbh & ?+r)%*RzT֥,Y!3Y!΍,AoY:|)9*RZT8ޯKuC7uB ͣKYA~tG k#*,4CRJT|Abh] JLC,Ȯ&j&K1j!K1$K14/eŻN9(,e+  Y!YFuAai~ KȻ-C 3CFbNwrPԨ0t_d)Z:堰t]J C_O{֧@RJTX{o}Q[3]~]>]b3]KASJ~)=*,QȻ=\KQYu)+(uA{Oׁz%V&K1V%K1/GW#KȻn C,`-CRFP>^G Ab,CӔ4Ȯ;sP*"K14.eDe](yH=iCsZb[ò ȅ,PR KYA>$K1ʏ DQaR K)Qa%gYy)3(<ϲC>$K14.eDCLbR 1td)u h,Pn,eZ'K1T/FAw][d)g+v)-*RfPz!K1нb}Z.%F!bR 1]1]7 Y!0Y!^ W!K(UR R 1Mqd],PFd) K14/eźjYz)5*RzT))]1:eC Y!:YFIbdW@RzT:'F*#EJb Kh2td)X@^d)X@)dW@RfPCJbNbIbDvE2]'ge>NIQ}J, h슡Z&K1T/F[!KȻ CRrTX@d)|EwrPX@OdW@RzT8z&KȻOCRZTX@_d)y׍P~?@,`t K1Q7dW@ =3Y!0 YFubs2]P Y!^,AE]Yz)5*,`-딃~ lPy)3(u,PEid)J'K1.eźnӯrtPzld̾p˲+  Y!:Y!~OuCEb<B, W:CFbs'K1 K14/eepIb^JR KYA,Ȯ$CRfP (, (,G]MdW@ ] Yʃ*̞9(,=G ](1{Ub#bZ=2] Y!~OׁX{' 6R6k,CCBwrPX@d)CRVPZ*-Eи:0Hd)ڥKA,ŐR #bl]7;Y!,иStBbW%K1Ыt'K1슡j"K1QW Y!,Cr+)f*3E^J=R6Z ~dW@RrTX@+d)8Z%KyHi>^Iqr)%*,8]G ^R6J Y!~?ק@,`$+ދ:CJbG#K14/eŻN9(ucYFuGvf!K1.Eg%KȻ^9R R qԽWu딃V!K1+:Cukb5R KQakld] :N CRFT$KȺ.kutPiJJdWx%Ez e)ʥtFbh] Jb|:^Iqz)5*,mYbs"jҢ2/e -8CJbs'K1.eRsT|EbK'bJEIb_J C?gEx%PgZR :R :R6 CAbDvz!KȻWC Y!, !R 1d)z,%{df"{~͘ҧ@RVP x>wb<_, x>St!:0IeW@,`UC,`M"K1.7x%Ł:J!K1P:YFu,PiJJdW YוY*(,PN,e'Bv4.ee0td)X@nd)X@d)X@]14W)* ]Y~)=*,TCEbk&b<(u۶,Gv@RzT;^I!XR Vή5_TXKbm2RMC,-C,hϟKYA,CBbEwHdW@ =Y! LwrP8f!K1rt!R 9R R 1JdW y׭FbNbh/?MZ(,e#3]J@)d)e)ʥЍ,Dd)Y׽3 ^J C+)owQfbb#bRRTʥR 13tB2tdW@RjTX@)d)5RR 1td)`=^Iqy)3(+)Gv4.eDD_epLbk!KhR :R #bR6k, h,иq)U]|ː@ ~nOׁڥZ~ΐw]d)Ԩ0dKYAS CFvУlT~_R.D>Oׁ֥T0&Y!0  ,e#:0d)X{>SX]1]OׁzC,{QXd)Y׵at@ 2b]H=N~dW@RzTJ!Kh?2ھ{Q*"K14Ləʋx%œ Y!~=8P^J ]2Y!~~ WROMO:G.CRZTX)ȬPa-bbR KYAdW@ YFU/*RrTX{7]'QYFJKQa}b#]1]7 Yv)-*,`4딃Q7:Y!, !ﺙR YR 1d)# p/uBld]wFb_JBd)Y}x%Łڥ SO~t#뺾uB ~|@ Y!Cr:RR 1td)XȬP_娰RR 1td)Uz (, xuBRVPC ,иQW Y!,CNbJvbmbR KQa=]yѠw|t!:堰u|/GŇd)y׽u Mzd@,`딃УbG#bl]-OׁzNC =Y!^GO[,CAb$Kh?2ƾ>ʥtLbhRR NY!zjDid)Y׍}@ Y~)=*R֥J4GJKiQaVJ {S@, G 1tYd)<^I!YA8ԨpFQ} CAb]J h?+*CBbkbmbml8 {!K1z#KȻN9(,wC Y!,e FbgW y)AbEbH3]*Y!^, X,^:C"WRx%Ł):ud]7w= J#K1Q:Y!.!vbtC VJ eb]KiQ(,eе*R$K1.eЋ,PCJbgW@ Yy)3(Ebw@ =YFg"b3jҢгlzC,=_#B,`%Cu+)j˦UDbhTr)%*(,e#3bR KYA), ȮJ!K1йlTWR (,к%b29J#K1T.DNb<a;Kh$8CDv5bl4Y@d)NC ]YF h,Pn,AI]\:P(YFuO[stK>]bIήXCl]<*ӧ@ =+Y!,к:0d)zN* X?+ Y!UR 1d)5&Yz)5*۟*(,P3%Ȯ&J%Khw'tCݔɮ֥۟ᖥjҢUW>^I!~_eR.DK"Z.%#yӤb5]q=BτbgB#b/6vv$J M|@ Y~)=*,M CAvϿ+)F"K٨R K)QaɮzVZ*-EAb$KȻne+ ^d=2{v)-*RfP"K1%U#ңPYFugJC)d)ƥXץ}a*RC7Ce 0*s*@l̩[RTGʑ b YwЙuuD,zw?EœJ3uDlp:"&s*@,zs*`QG«s*άΜ |"6;s*@рɖ0Z-)u*9Q80N *9Q֥`ֵnkȬK>J]s*@QR*Vn (9 ]+QE P(V؀SU>UeK "nIQc*[RbիlI! /aSf]"6` ([R$*,z>ɖX% 6`|Ɯ 9SbәSb|œ *s*@,z5Tus*@l=G!bx2h/G:.ޘSb|2īn1ff]cQeK AJiG!ZP| :͗ҨTGb.H2oE(DQR h9 6ĥD,7l-)jJْB?YȬ 6`-.uXϓ-)=s*@l_ȬQ֥T^u1ĢMlI!Eɜ 'ŒYwPc2Ģm0Ģm2/ޙBīs*@QR0F|.[RjTs*@1P| ̺_%N18s*0F 6ْB9=G!2(0ʯbVXt̩hL ؀n̩r6`  `9 6s*1lI!Eb> Q4 P %S̩¬1)dK A3dP0-)?RΜ .9 ]s*ٸG> QҘSZT:s*VXtG!bZcN>]֙Sba> ;s*@lxWz+,zTTGY9fܡ̺Dl}%Q歰YT؀YAl̩=eKDEŜ `(Dl Tإ4lI!E{a> 9 6s*0!*[RTs*@룬Kg/#Ԡ'[RT:s*@NřS Y⍙ˬKԩLTXt]̩Z,53ɜ QqT(Dl@̩͏2o ƜJ gݙSbѣ0 9?κx1r*@,k% >dK Aln4r* ~ 9 ^u0EdN%Pe0i% 6;Q̩E{7d(aܐSjTs*@3P| ̺$2r*@dNhQ1Ta퇕Sj Q؀wjEN%djgNEWcNEWgN h(@*ʠҘSbѭ3Xt̩͘Sb3Ģ{c> ޙSbFe> 0s*/5l% lI! (DQR m% =9 ~dK Al̩l7r*@,z-Tإ46`s*@l ?% 26`ԜuxՍΜ Μ gfe> 0s*@룬-)F? (Vxխ|¢lI!}v+l~Or RY5TX[&[Rb`kl{NP(VX?G!brf_TxygNEdN%ЙuS#K$T*s*@Fe0.$j% pYwPgl1?JQ֭"YWcjuu0Ȩ T#?RcNhB(DNŘS XtG!T97s+,TGŜJ ̺?uX̩1Sb0\ଋ' "EEْBc@HT_<_F> ՘Sb9ْ"Qe_EN X9 6`9s*VXZ%Qƭ֘S YMTG2?ʼ6` 8dtf7h̩GK9Ν9Qڭ̏2o%̶8r*@bNhQqTaœ!MԨTcNȨ8s*EדBĢ[e> Ѥ2Sb1"nIWBĢlI!h}u) dʬK|Q歰lI{ Lu؀ܔYh}u)EdN |QƭoeKD* vcN(eFȩ8s*0b+&[RTs*@룬K0#ԨLTGbPjg> f~9NřSba> ֙Sb`N 0i}ga> $|dV0&QxՍŜʋ%Eܺ#h|q+lbɬ;&nɬKĢ3Ea"[RbRG! % 6s*Μ P4 k% 2S Y&4ْBP?ZȬIe0P;ْ"f݈qْBP QʜJ :͗¢{a> ޟȖ؀qQd%bZR4^Q*s*@1EӤh g~Q\. eJ=y-~hdK AYAJgN%f]Dɖɜ РS2*ƜJ ̺x-)oEBJoLf]"=:s*@,z,Tu6`Vs04,TX~ -) Q+G!b1hh[̩n 0cN |ūs*@,ڝ9QDbǞP¬|)dNȨ,TmbG!P0or%bu0"#?R:cNhQqT݌(D,zʖ؀ˬKJʢ-)1Se 09@W,G!e #:qu؀i̩} [Rbѫ1h_e[a..|ɢm2T?J6œJŢݙSPM*Ɯ :r[4|E1vucNh~y+,棼?ue(Dl]-).˖؀wBSb[G!2*9@E<] cNh~y+lGj,q% ='s*@l\̩lzBĢ߷1]ĢWcN 4̩(D, s*& P(VIK-)œJ :͗ҨTT& S1TaůlI!C)'h}u)uJ-)ڙSbu2| g]l#9 uْB9 6}(@ 9 ^u{$ɖX~˖*^(Dlþȩ=DhsT5(D ZT*s*b r*@`NhP̩GKYcχ.[R .(Deє|d6Q̺P n(D,WSZl@̩͙Se | cѣ3 9 6& r= QGiΜ 0's*/}?z|"ǀlI!h}u+l5g]I![RbG]Ģm0Sb9Μ ŜJoc" FhA)'olI!QY̩ (EʬKdTs*0J ْBnQ&Μ Cy?| :͗¢Ga> 9@ (Dl̩h/)E| ci"6 QxrQ̩EbPRxbNSqT&ZBTs*04_(VJ ̺X;r*@[aW+]Ģyْ"Qc`N 9 =Q:9 6`oȬ 6`ΜJgْBs*@[a0hh?(D,s*@룬K#CIԨLT&\9\DunT:Ŝ Ђ'QU e, (2E.Eo-)z^eK AlqȬ 6s*@eOsْ"Qa/6lI!E?% 6`uuaDԨ4T&cNȠ| ̺WT:gNhA(DNe0N *9 (v)EWgN (Dl@o̩ޙS 42뭰}1D> U7s*@,z TXlG!bdN%s1Ģ1Ģ3(@d> :L Ec #=~JFřSP$% 2S YkvْBP/\@ТRS TYt̩)[RPG6#dTs*0F|$[Rbѽ2>ʺ6Tu6;s*@㣌[aѣ2hc1 cNWG!bo\H4ـSb1|Ţ1EG!LќGfgN%f_DκD[Ts*@QR0f|4![Rbѭ3Ģ{c>Fn>e%jPFc> ~% ;/[R$*l~w1YAldʬKi.[R$¬ uْBPSPn"Ȩ4Ta]ԡ|Q8Y?% = QƜJŜ P(VXG!bӘS 4ـQ֔Y <D,z-TWYϭ˘Sb3WW PmlI!hR̩9ΜJ :͗2|EŘSy⬋D> Q2Sb lI!ȠV>2OoɬKْB9@EŜ Ѝ9 6;s*@,zْ"Q+J+|"6`TxɜJ^^oE|"6` T 6 QhO dK A~e-)ΜJ :̺DJeNhQqTJ+G¬|)JgNEjI@Ƣ{a> 0c0Ģ0Y5T̩0e#nI=>ʒ-)Ǘ-)͏2oŨtTŬOaY'CWlI!h}u+eRkluo̩ *9 lI_[aNs*@,s*:' Q؀YS nߘ!Eʜ `Q̩l|Qh7T%>̵ub֍XL*Q\g 2(ϬK̎X)r*@34*B 1A=T9@u/e@ٟɖ3(m0Q̩f̩ޙKPb> Ѣ̩,z>G!bәSbb> 9@E|"(Dl) r$YktْB(VΜJ ̺\f]=G!T s*@QRxGfu*9Q֯2%ؿ @N~z+㣌[1(CHTX̩fȖ؀wG> Q*6g> |h@pDrf(DJgNhB(DN3.݈ PSbѭ2h f^((D,zs*@,z=G!b`N%Pg3Ģ2EْB'nYhPi̩ŜJ ̺fQŜ Ф̩9ZXt̩u(}2hQ1TaICĢ3 X(Dl2T9åD, Qhcr%r*Ɯʋ*g]<9eCȖ ʞ7%Exdv6ESjP}^YhBy?% =9@E-[RJ4 W ̺{ȖugNȠ(@u)r*@[![Rb8]&◂Y)![RbvQXWM6;s*@l;s*@,ݐ-)GKGfgl(DdNhAqf]u3>{%Fe14|"b̩r=*QXpT؀9BsiFܒ/ْBvc> Q]⽛lI(f݌-"Ԡx ْBФSr(<ɖ G> Q(DqCHnƃ,CTB4|"(v)1f Ѣ̩¬1%LM(1Ƞ| ̺K,g]Ne2g990nr K4b> 6gN%hG!b|1 #CIP3e#nI1WCȖ:ʜ ТҘS Y ْBP.0dK A,J{Ȗ3n|"s*@Qtj=dK AMAaŲaB4tT`N%P<2ɜ Pb̩M*Μ n(@E|e 8(f݊-plI!Czf =G!r*9@1Vw:%et-(fGYuu&Ɯ SY̩ha-`ԡir ZP_lIߝ˖*gN(0$,u`N%f]<;dK AJG!PZg> S1Ta V.|Ee2. %Q s%Pd> A(@u{T:UB4TM<˖*Ɯ РSbޙʯʭDeGfM*9 0gAu=Yh@|EřS Y7fKf]"=(D,z ŜʋnLf]ew^>ʺ6`ll"̺X:2DJslIIْBPb'(q̺DeVʖ0<>-)X,c9A JGYgʐ-)5(u0hB'ȠO,g]ug cU![RZP`> S1TŬ,ge4ɜJu ْBP'hR̩E5~)[R$Ygې-)u(: 2Pb![RjPp*Ϭ4Lg> Q4Ӗ[RX,<3dK AQt,2dK A -)9z*@1,ֱ|AŘS2(^Zlv9h=g e]ɖ mg%Ygwʐ-)EˬK| :|")[RjP͊lI!(`# JoG¬NE{uʖ&Μ C'oYhņlI!Ȩ8s*byֳ S̩Gf}d(:wEgWA{KP`> р2*Q >rkONQe#2DJ+G!r*9@BY|(:j%e>GZрΓN~3P4kBEz3dрg?T%]tُ/!hϺV~_0sK E5KXd( |%E+-)5(äYh7o fnI!Dѱ-) (>B GrP}߳E> QR!K[R(84=Zo<""h_u5>%]tҙ[RYW*G! dPttvѱ(2bTPR$r(vbod(UfnI!(f]ϬcCP-(:.Q:0sK Ebvs?݀ob֭DP-%[Y{Ú9wfX5z~43/aL^ku $'ϖaL]4ΊbÚp}aՓx`FyWC `(edU}^ k"r# kf aL@މOa{a@މo kfjp%؇9>d ؇#s5R3s>|mX5uÑz-/F^q8Ë`G}ݰj&ԊcϖLْH|MaL `FZp$n:zuN3sH@މM3sx.}iëH'@މϷ kfbaz:.`~S.O{Es9\>4wuK39<`G~=F4+ԿuÑjbL,lO9`Fag `Fyp$?4la:e_e5H3ea0Oѓaѓl0;#sH tfaL#eaH+ #s}i #jYtfya-L`F簟؇#ٲH4i؇V68r9P_ a'؇XaLv}=̖K9>;ٲ2 a Gba;:'ٲi1(9p3}8ҙ- ÚFq8w:ߏ |ff؇9p<ၓiY~s `FZ0NjyB<3rl@ D)M#gKj @ D)-3ѥ "m?+q`$7梜  vJ KvJ4KI rBu Wpk #AB@2,љI 0@ DS'cqNR93zT7XSe vO F$D9n "S74,ƙqbA D\)U:DA 3jiua@(e%XfD{Dp[ 8E "Jѥ(zTOe_9N2$D9]=ڔ(͜3=:nuL" ;ڟɚsF8RxsFh) B0*HM!9IB@2W !b/"LTJ H BSfG0N",McΨв9gԉ=8S?'DrF+]sΨt:q0+HsFu\Q'ʩi BD)3ލeFt9<Ո ez /#3j^gԉTr,)q "Z (ƜQpFE "Z Eh vRf "KJaT"[NubA D2g Q{3˩^$~ W2W2QN`t,)q\䊲B)eZQNߟcKr}@ cΨQ?Q'&+1gğfԉ-Z@B@"LMcΨd?Q'v&Rf_ E$D9R:QNT8N2("e] ^8NSwXR?/Q'a*eZ QNMT{ !bS BS~: gԉ3:AB@4㫱ubO? ! .lq,]1ga` "Jq qJk(z-%_A|^b\Rf\!e"ʩ+dT#ʩ aǜQ fԉΨBD@1g^4 gԉ=D "5V@B@2ߛu H#@(uLaV9@ XrF(zTI+H( rߗŘ3jub@Dp=RAB3j%3đB ! Z ubWϯD "IR v\rQNu\QNu\:I Q\BD9k@h`?Kq;D2A DS$DwXN1d@8D "%؏pfToHJl"83wb IRf v/#%v*֏Ф>@B@Sg,)q\TB.e0) TQN|@B8A D2@.aSN %"%* ea%zM?I@ D2@ѤL{@B@SmBD9VA DKL ! ʩ~s{4B]a: I#w tΨ%!gwΨ!u0@ 3jub+Hm@XV !b+ȩ$! J[إQA Dl~9Q'5 $C\HRj "ʩ~w()z-%_Aʴ$D9VA TQ(@B@2@(~¸+H@ 3[ub+L&B !qȌ?uba@D0;:Ql$D)93DK\epF1V9@ D)3D9գ@رɩ$!Qʜ Ž %_AN" Q\a!eZ QNMT{ !2}@x |pF8R($Da@1g` "j Eh vu HRf)ˌ! "KHo%7 "ʩ~?5Q'ʩ~'gc2ϗ&gԉR>9NScErGc2߿uOΨT!@ Z!BD)*Hj "ʩ~_I'gԉQ'6#V@B@4&W Rf@B@S _@ 33D)3Ze"ʩ㩎rQNX ~@(eN޸dF{Q_Q'ʩ~RgԉR8i!js%_AFzqF1V)dqF(ewڋ3s#8NtŽ9}8N0~%cΨ/Ψ[ :QʬBDa@1gԾIub@(ea)e$D9lXQ "JqIs@(z5T[ Q( v R-T_TGt9^@ <_BQ!9sbCF%G"4BDO}sFUB8N"t:@ X:A Dl",!gc2[_BTaǜQB~)-^@B@S'wbgԉ e!@ 8WW+j> ! J@qI@x@+!E&Mʴb+ȩ aG+0ΨL ! Kjo ~LNAB)4sF!ʩw1gԾs:qPA T_R Q(KJ%rK'\EDPEQLI%򐢋AA 4"(RDRtDP躈 KZ' yI",W߸,EA y7tBaB =;.EAY0 4`=D0U }Չ [iEdiPGqD0K|Aܥrefu/H[_>1!+f.$DYDP.8J}Ban>4V"(ҀڈD>.V J(RtD0Kz#x(VG1EIixTQ4`VP#aI^ì\{4<(Y T)zS6:Ru"(DP~ìܤ}0$KD0KѳA)\1JrKE0;dC KQU K ^?Wߙ_di,P(E J(RuRu:AAQ\r1W Qn9g_҈4.q$2d*F%rκ& P(MFy҉ (Z,"(RpҀڈDҀ: KuAAA1AʥQz*,E7#b\2'\(! Y0 Q(RXDP"{/E0 4`>D0U7;Q֏M$[E5%ry.<E~/*\@_di!U:d)֩pR5gߊ*:̈Lʼn KCY 4;diX (R9u"6ne*:*ZA1.z)㣜#Ձ^us6(Jj>҉t \u$7/ʐAJ(Ҁ>DR(D0KѣAA웑YY0sYӣN sQӈ7=zBAY*q+HljCYWNY^NYF=d| (Ҁ@P׭_Egݾ9똥vBaY _:f)zuҀޱpRtDPmAY4`# κr{n Y~,0!s.L\o~i@_DP<'dRDPۭ" 7.\ujnYg0"(VGN κ9L",EO#,  >2{κDJQ֭" XJdu~iDPI%κDPP̏"E[!Rp**?4qC  FnT?.ѯ"Eg:fb)$(J3NH PMI%yd*-}01$OQ*dU] rOUPKՉYKmAAk!d, ok', J3Z,eQ1d)"(2 KA<4`V"(ҀىDv)zN"(  KA1.{)~)z UlYҀ*r!K[E(dunc+gQVWiҀW .$,W>zCYgFYv"(VGC κD:Y9똥> $YgStOՃ%AW.seA\ RGTC rκX@%|/)"(>JM=D0[nT= ~Я"E7B4},5diV,AA؆Gf3RQ(f);dUZV>4`#psRDP"w)z,"(Ҁ,  =C8dizBan"2O)zZ #$KkAA,'\c(VBaAAmAAA1.Uάc Q(VGx#Yg]_E Z8v+ݘsevQfSq"(f.(%J!Rl* rAA2l9b@PZBafBߊ*]PEkSq"(iP di@DPCln:!YnBG(fi@DPA ݍ 4`PcAlҀDPke6P׭⿊Kf',EO'\n(! ϯW/t U~X[uR>9uֽO'gsQ֭_EgScn>4diV2:! YJY ߊ*:*Rd)}-O:<@۫Jv+LQ*iSiDP"Gf_4 H{)[YҢ .WnI!y(&J%Rhm*J㢵?4}uYP9b -)$Kѵ¼neRd)U[RHߗ-)$KѭA)\6NY YQ(UJ*L"( ۭدҤnDP+DP+eP7ɁT.ΚJ'ҹꥌ" xo#A.ѯ"WXDPh#b\V5'Yg|Ba?ޯԒYgDPԏ" Fn~uӉ8g=zBaJrK_EgjDPՉ K"bSiAP}KSs1[E~"Jdu~~+HCY>Pk:fi;皩Pb -)$(Ju=nF%&$4`^5<2+n~" x?)ܒB~RR%d)/"(Ҁ}clZ/֏"E?ܫ-g= ¥LSiDPcA\aRG[_Egݾ1j9똥É KC κY KѳAA2>4`v"(uֽ-gsQh#b\&(! Yg*DP WҼQUD6iDP:ɼQ̏E"(\oiDP&Uz:f-zAAdmA.ѯ"EΞy(~+w=gQ{s!۟uDPEeq!K_Kh \uhCYJ*Pb@DDP"?2b*NyL;"(s֍32 /Qq}ůYJ(ZAA[_ť! YP d)6"(- |> \o~iuVW)Z$n}ia (Ҁ;-)2W)5"(VGY~& ڃ.?q̏" J. 7.\u! Y7ܒ"x.e<E0%.e|Ut֍NJ(Ҁ1 U7&e2Pǭne*:*RDP:Kň KC κU.J%,EFqKqUϬKHYlbκ}g:s1KmY, ط3gmDP }3똥>nYDP:KeA\]RG2?4R1"(ƥ㎲&9똥WVucx#Yg]_E:sɒaU|֟:M,CH\^m qAi]8W#( 1[ }s2Q][BF^A]ѩГps%uF[!(uJJ:#(bse22CkL9u2LWR_I~AIKi],W*_I!,Cq|%s?J<2+, (,{)6FP:Aq3W&#( ~B[a, Xz&W]3FP-*Rdcp X;#(`#(Ɵ%SFbJoRAͱSѮSh+v)Kl֮JA0W#(`YMFP-]G1g#SѮTde# =NBxFewFRR/eA)W #(?Jeܢ.DLnӭt)2tJB xFeJg2_I!,CJ/.eJ.D\=A%WC&#(rO|% #(], WFP<Ay22FJIBJ_ʌTE^IQ _I!,C4|%,`T?NߥS_I!,CJNEn}nzבkTГ<jzבe-15dFP6kyt*VAIW#(`uFP:Lƕɸbem2YΣS{arJY@T:˭uYʸY@l֮TNb]7~B G_ =?1"C;ϻ\R/eDev#ϻܢ.Ţb]2LGTƥO;R[&TFP2#G#>SS(ƟqA1Ĉ+uW{ _I!\EɌGTƩt:UFP2tj(ΟwaWRרKh+dY@Όl˗"CJJRAW#(?`ec ]#(iL,#(`YwqGPr} _IdAWRWRja, hVYn #(`YgGPSώl.rյ E],#(<:r)=*Rdcp F^ʈ8AKiQi"W]l֮?F[!רKJevȌdր+,`4FP6kyt*rُV=*Rdhˌؽ,5AרK{z%{ׁ<:YA']Gةh X0 #(ԻRA|`ޕJ FPuJq*uA ͸]JsLFP&ctsu%m<2NŻNSɢ$FPM XNCN']1FP2AϨS1:F[!reoW:#(O})%3 Y. ]:#(k2AdYxUu5*RFTƥVGo%Kn}+)ep)(9],`}`,:~)2WR8ZJ aYA|\8(T/(w):d, h?F[!Za)^W*#(ߺA|r6(Rdm0YΣSѡ㣨LFP&3Szb,{dGPruc,CFb\R/E0 #(`,Ccܢ.E`Vף<:M\wY^wY>U:vleyzב9t;p{d*. FP>SgBxRA)|(V#UJxARe1`Deh+&C X΅, WFP*l <;SiQibQSAKѡ#(!)%3 RP,],FP q2yХ1Qɗ" (mb+)ov+)kT|攃_I!, Xu֮gF\ >d,CO=ͻ]ѩZb,CNͻ]:#(`Y@ >dlQSѮ?F[!K X #(zeܢ.E;#(O_בu/E>5<2]'#(_Jq*uh+|)AIfxPL~tGRR.E>v:\uOݻ]}t:mjdeKҷud{T0Yn}Jud3栌K|߿ufOݻ,Cf:No}s%3FP6{ץGB~B$FP6{it*%*RdA[TT4:0R5^W#(_ <) Hpe0֡"]#²u:gYWR WR8'z}+)eA1~ӕ2Y1 آbR䪫V2|WRе0QRe2קdBXn?F[7Y@ˌKTʥU #(ߡ <ӥZeKi FPNeA:YPڥza`ud#(`Y@eh+`AIfUPڥ#3dyבe6yב{TUҥԨKn}2:veFP2Ar)+e믟]֮ X^̻, X ϨSѮTthc l֮[ͻ\R.EįRA٬]7#(_`q3Q]7=}Ȭpe0ةxit*U (o>̗"C'cmW&#(s7u%*Rd7TBX>M<2RPRz)2tl2*"_I!, X_EyaY{d9#_I\dAir)A鼓`esARthc, (;JMBNBG_,VFP*oJO"W]meAϨSѮpJz2Y%F[!K Xn#(z)c:NE[ud\udvG"C?:Aiaden2~BnQibQSѮTdAɼJc6+@ FPo)c8:TQq3e31xÕJKge4FP6kyt*:tg׮ FP6,L#(ƿ'Cѧ8KQ] RA U_AnPʥ4Q#(`wYcDP:deϙm, >k, X[J a:UFP*Jces.E:#(`A1}ЕoKˉ?۹ASYPʥK枂ӥЃ, #(ƿ`eʐm,C_|%8~" (?bh,fFP2Je,C'ߥd:,{!̎eߧAUf:v)f:rJYAzGP*#(dev)#*T<:V=*RdAI<>RA)<^ʈ8:N%G%_,WFP*84FP&tFP:#(~)m]ѩKJkW:#(`z#(%F[!2RڕJ'KA1~S]GOŻ, Xw٢b]_SJ "Jb%+(FP ?AWQLFP&t 2e6Q:#(, FP J:#(\lncr%3?WPTz JO" ȅVt2sWy䠌|)A`ebKѡ,m, (3eKKcC\錠gT*UNSiQiCFP6'Y\Ȭ,;LS]G-]֮TjTjgpe02pW&#( Jv]5*Rd!zבe1hA4]efGRR.E6AϨSm\R/E+#(zg>%*RZTڥ1YOF,Cem#3*SvtG"C7: >H7:v,`ͽyב{TЃgY%F[!רK2#(<:YF, }-*v*us#Г,` ~@xFevG"C xDevG"WݬGYnuhcevG򷀶)]wY>wXn}7:rJYub|do}0v{it*U}{T̨S _I!D-*v*uU;z"JgCF<2Ot) xpWR8w:%FP2t*GE], UFP6:uF\R/G_, FP6\u_I!,Ce91z) ȅ, wFP=*Rdl|<>LvsJq*Y:L>2ܢ.Ţb]ѩߣuzב{T֩jzׁ֑izבu XCv]1F,W]1 Y,`0&c:NF^ʈ8:,%F[!K[f>u,FPzבku=3 E],WFP6kyt*%*Rd,FPs]ѩU]i?:ʸYwweG[k},;w٢b]i?:,#(`YAЃkyt* QQ]g?F[!}#AvLGF^ =3#(`Y,GXΣSn6FP;:ND\,`NF7~]+);_I!\R/eRwQ.Q)\I?FlQ1Uu92w#*RfT$Yq|GCFP:1z J], mܣ/eFeJsb>ʲǎGyDeJ.D\,໻#(`J.#(z)=*Rt/E.?F[!WR8_PRd2Q"C}-ҥ1zq*ue2ka>-*R,*J>ΣSQ" N2;|7`vevwhٻ,Cjٻ, hu1.Q)"Coٻ<2Od\R/E?F#]ѩK|'AU ֮Td^AKQ]Q֡'#(q*u똒rՍ G_ = #(<:z)#*TFe>9*RdȔrՍ}]=ҊwY0rJY::vI+ud#(`Y֮[]Gyxב{TXTTfa>5*RdYA٬]iŻ/E]ml֮T!z.Jfʲu|kud꾛Ayבu},{:gGP5*Rtu oͻ, XǷ]G}ze,C}e3Q]#(v):1za>AFarJztF#SPzYGTƩhyt*a[Tڥh+`:+ehkGY`,֮Tdhel,]NUݻ\R.E^]G-]֮[]G|?*#(`A٬]]u:"z&Jb>&Jfewܷ^I\Di+)1 yFeJSa,CkpQ]ѩЩ3Q" H=KQQ2t XBnQibQS1:'F\R.E3#(`raeARZTڥre>Tt G_.3zᔂҥUpiβRA٬]ѩJg,CCk׭C#(K_kû]ѩ!pYgY@l֮}u G_ENEm,C#-3Q] #(v)2tG~AߥK XGX#(`]d<2T<:z̻, X7#βu|3:v:wF^ f]GSyׁdܢ.E?F[_PRd놝yב(ϨSA1}<:eENE #(`QQ22OEΣSѡ;#(`z0za:3FPc>=*RdAl#Yz)CJ#:r)M D錠lN:d>5*R+l6Ȭ%3z΅VF>-*Rd3R~RR.EgT.Ef]',C#_Id\,`0&}˃=K1e%1y䠌|)2t)GTƩ,TF\R.EneA٬]W&#(z)2t͌q]Aϻ, : E]ENE;wYvv>ʲ#(`cJyׁ<:UF<2NEӳ#(r)=*RdcGP6kyt*rյ}u}eh+`:NE #(`v]e}0Q闢C֮?F[!;zeYhl֮Td =#(`v0FP:d>#*Rdmeq:P#(`o]G=yׁ뾏=yבerJݓwXn&FP5*RdmA٬]ѩK}-*v*u]AН<9A}u J]w>]}(umޝTF<2NŻNSѡ#(&Jgl F#]*=, F[!ϨLUGt*2w;$ f;|A}eR+)s JN" ȃ8"Cgc\R.E=شQh+*C_|% ] #(~)Rp;uBX.(jfp.EP Qkc>2t5F#:8FÎGD\=AГuhP5*RFTƩh}z#Fc, X]Gةh׍}ewvrJYeFP6kyt*2UF<2NEQ(Kf:NEAг0za:NE0QnQiCFP6k׭Ż\R.E0AϨLU-O|%pJ!Jb>uy+)KTʥtQ*Qةxit*:tc<2.ebl.r0Sc>U^J aY@2FP4AϨSi9(-_, , 'FP6_PRd\, 7FPxt):1֡'QQbc ]Qة_PRd%34FP2t錠|܎[G]GQ" VuJJv)uiu`:NE^wWwYeu0YnSwYeuwyׁ,`S G_ *n)(-]JJq*u6N#KiQi GX#(z),FP6kyt*-*R,*v*u2.Q)ң/En珻?2{DRR/Ekn{ׁQ{בeȬ,AFcevGY^wY0&QQ]ݻ,C[b>#*T]]G.Q)"Csb#A٬]g(l2k X0 #(`Y媛k׭Y#- wQ#(y*ueh+)( x~TdAK1Q2!]ѩԨKѡ #(,`ιE]ml)(9]JJ]d,W:2%KiQi" #(, 7FP%*RzTXTT, wF,W]IGY.,`Au9(=_,LFP;!Ch+dY@͌GYP #(y*u,6F, }<:z21exבe-1z?<:zv̻<2.E>u֮T[2:EN%" X̻ܣ/Euyבe1Q]>kwY6FPc>ʲA٬]72#(z)2cudYhl֮Tt}u! X h+d,1zy*bRdASѮ X6FPc,`fFq|zבe]G0 ϨSѮ[NwooW&Ja>uuߋ:"Jcܣ/e#Gt*U xDeJա |%pJY:`MN(רK xFewFCF<2Ned, ȉV2tΌeXY@GTƩL:FP9*RZTڥU˟ZKC^I-BDP2wf²Q|wW_Id 2J a;`wYPue2zeV2tMe53za#(`Yw_d2tmGXFPjGE]ENENFPmܣ/eFev]ˌ[TڥZcevGCwF,Ch+dv]όGF^ #(`Y@GXΣS X|n]G.Q)" N2;ze;]֮TjTÎl֮Tɻ,Cɻܣ/Ţb]qG\R/E X`k[TڥGk}%*Rd0geevlGF^,`FP6kMc>:dܢ.Ţb]~(WQ#(!Jf<2OŻnv&QnQibQ1U<2I 2AwQ&QQd<4J z)+)/(w)2t*e2zeYwfGP6#+)u Xvv, 7F#\sPj:FP2tlnc,$F,C X..E]<2NeГ(h+v)v]-kTje, kyt*:tg, uQȺ X]GxׁS JJ" X]Go|]֮5w9G%_,`Aw٢b])ŻCFPc<2OEΣSiQi" ?F[kyt*%*RzTн0YwFP>8ne}2nQi"W1zaAKQ" u3`<2TGyt*:1ze3wY^v FP5*Rdu6u`uudY:xU:,`w٢b]7Q.Q)ң/eFev4FP5*Rds2ٻ#_I!\R.G_A]ѩԨKdFP3*T4:v):ta>¦CWFP%*Rt(ЃS6FP}e)1z?WRѩWRN;zeYAٜdlWRרKsf>ʲ1Aٜev,C_I!,C J]JJ1zezJ *C}kTJfevG"Cc, ?F[![TTjb,C X<ju Xn?F#lAKQ22OeZf, hP]Lݻ\R.ENUݻ l֮[g]G-]GE:I{ׁ͠]G{ב-*v*u}2h+dzFP3*T,`TFPAU7#(1zeYm, }-*v*uVrJ~)kl֮}u X0֮T䪛 = #(`zVFP6kyt*9A =gm,/@>9*RZTڥ(uc+)KTʥtQ(OQ&#(sJΗҢ.En >2E>%v #(~);RӥTQ:#(`z0z J], #(`Y@GYΉV=K:rg,W]l9(#_ (deʏV%*RzTJa>3eKQ"C XP#(uƔyבeaudv:`wD\JJy*u,`2>2, Xk׭yבu X-*v*uޕyבeV *#(`Y@kl֮k}[Tڥ`u J],m, <^rJY@GXΣS)Q)" (ƏVubudzdF<2.eFe2[]GnQiC7F#~AIK)Q)"W:UM:=AٜSPrz)c>uJJY:M>2, f:NE^wY`<:NEG٢b]g, =e F^\u2za:ND\JJYll֮mul߻ͦT(0za:N2AKѡ{it*Օc \~A)K}eA(.F^, m, ΉJ?n9(-_JJY@ΌG鎠˝pJY@l)(#],$F[!Х2~Aߥގe3ze#(g L" ((Vr:NE^ȲҎl֮TJTʥГENE_Y#K|wzvevG" nY#vG" o; YQQ] #(`Y@GY#(1.Q)"Ce2YΣSQ"CKuy*u3nQiC֮Tdc2Xb muwF^ʈ8aٻ,Cuv)+w;zaƔe: S,{בGTƥffev쌠er; J],`#(~):dewܧWR8WQ#(q*uJ0zv);u bGy2Al9(/EN(i0yd>ʲmܣ/EΙqGf5:z)r}aWRq%*Rdv>ʲu4(?)(9]JJ~)"W:¹E]ʈ8* (,F,C X.MC:רKѡue2zeY@MGE]\u1YvFP5*Rdu0zeY@5FP6kyt*:d<2NEΣS: #(`eF&َGF^ʈ8udu|)>ڎ[]֮[]G.Q)" ,`wXnwE],#(d>%*RzTXTTFb\u#3zeIfջ]ѩKiQibQSѮ[]G X0QQ]7pJq*u m?F,C[blQ1Uu"w>5*RFTƥ{z;Yn|wE]vG u}ufu~nuz)#*T<:zVF, (1YΣSQ22.E0'#(<:0ze#}n"("Jc>] x2AuϬ|%pu%UF[!Q#( #(`:#(v)SE^IWRרK8BX]dpWRKpβu8xdVX\u0 Y.ENx eO_I\ebKTʥdlQSi2tMBQ" <.W]-[TڥXTTjc, mgT橘.`2ku-3Qɗ" hETG׭~ûCFP=*Rd@:u@:-*Rd߷8wvݺ7%*Rd^AϨSѮ X'#(`zwXΣS X0 #(`vݺ38%*RzTFgev0FP:d, h+`:ˌKTʥKXaevUFPrYgC#(<:Y:` :,`&FPSŎTdYaYAϨSѮh]G֡;#(`Y:UwXΣSѡ'#(~) HYgﺴ;ƮsQ2DgTxץ}d2vs3ة4AKLFP3*T 9WRRb, Hu :#(`: FP4Al)(.E?F[!K晃2U;#(`:FP>,`<:~)3*TRJʗ" VȲu?οߥK#²2A٬]Ήӻ,CeududYZk XEN1 G_ ~)(=],`ͦwY^ӻ]*#(`5FPA`ev]3FP5*RzTzbv]όe^A[TL;3#(`YwoGP2w?:<$ ;;|ǔAU7#(3yבKTʥE; ٢b]ѩԨKQ" ;;Y #(v)l֮ X`pJz0YΣS#(`zm]7#(|)AU7 #(<:zvFP=*Rds0ٻ.+)[Tڥ UtFRDɌ(ENŻn}pAГYNV9*Rd/ آbRd+)eIfGP(5KiQi" ȝM#(`:#(`z2ةtY@1 YAХ2! (pJXY@1FP=*RdcvGRR/EP3#(<:r)2wdٻlQSѮNU;֡#(q)f:NE5w٢b]ѩ#ӎBQ"CfA#ӎGTƩhyt*:`, h Xݻu/g#=1Q" u0{e,Cf~"  G_ =~֮Td#1Q[mxבeu,uv);Y2kTIYaY::vG"CL#г0 R~RR.E :Żl/C}#U xDewFRD(2Aem\R/RAϨSTddGTƩ, MFP%*Rdm,C) ȅ, WFP#*Cy%E_RAYaY:`Tv\uWR8'zJ a{i²u:gYMAٜeRAKA#`ܣ/E6FP6kו XPGTƩh XP+#(`Y@팠-*v*uu0Tc, ,m]ѩ-3f:NEnpJY@댠l֮TjTꥌ Uu.`0nQibQSѮ[g]GLFP=*RfTh׭L#1YaY@l֮Td>AKfc =#(`z/judY茠l֮ E] =&#(<:Y F[!A6A٬]ѩfb8uGyבKTʥjv, uJJz0Lc~tGҢ.oѧ##S#E RAϨSTjT Q*#(AНpJ]1ٻn=h+d:FP2tjgT橴/EZ6J aJY#²mܣ/eFeHARd0QbRt E], FP6.E6FP XP,WRѩWR7u# oxבeu|udAٜSPrY@MBQ]W#(`Y@e4Ȳuu`AЭ0Q" huJJY@kl֮kpJz0֡'#(VȲAk X+#(`Y@Vu3 c, h+dYFP>̻,CGwYncu40: ]G֡'#(`Y?֮T[G#syׁfa/E0#(`v쌠KTʥdwյpT(0ٻNS)Q)ң/DlTjTН.Al9(/E0Ah+2ӥK XNGt*u|dyDeJ{hf:tcܣ/EAٜu WRK{Wq E]ENrc\R.E |%<:NE`uu ][TڥXTT<:FP2te3Y#(`z2kfe.EP #(`je,CJ{'jt*5*Rd/}DP6k?!֡'#(v);:NEVȲ7DPA٬]:#(`TD[![TT<:Y#"(~)2"([ JK" 8:NE[Tڥu}2Gb,`dFP3*TFa,C xDevG" =AϨLUuJJA٬]7&#(`Ym,  X:+l֮ X G_,#(<:v)3FP6kh+r)2̌-*v*u0Q"Cfies2nQibQS[?SKTʥKdFP6{׭pCD錠(ugAKӏV&Jf,]~,p3`, H$ H, mlQS2tΌe2 XΝE΃, OFPcp$FP2tɌeRA[TT,TFP5*Rt XP]P&#(v)2t1 XfFP%*Rd0keevG" ,vFP6kyt*%*RdA&#(<:m,C XŻ]ѩX;, XGfem0Q闢C#(VȲA!xׁ<:#(`YȌBPk׍ X,` FP3*T1nQiCOFP6Ym,  X xFel0Q"W#(l2V-*Rd31q=n wF^JJYl֮Tt X)vGD)=*R(ȬFREi(uJe0n#(`s%%F[7:FP2te1$ces遯sb,` *! ȅpJ:7FP3*TL;#(`Y@GTƩ_PRdA&#(`"cvJ r)uj:gY:)%KIQAɿKѡ;#(`A[TTd,W]1 Yu0 XP;#(`zuju`:ND\,m,W:4:v]+e2f:NEnpJY@l֮TjTh+y*u=1gFPS] #(`YwսȲuc{בufududYwȬ8:ND\,`$|dY0uc2a{בehKeA٬]g m mM`pJl0֡u2 F^,`6FP6kMc\R.oEt>2lQST(e0#(4:z2*CT+ 2u=*RfT$Y: >2, X's",C X^w4^Iܢ.ŢbRdAרK##β\A\[WR8Kѡ;#(, FP%*Rthc<2O&#(`Y@IBQ2dAK آb]W*#(`1 XPue2nQi" Vu\uyבeu_ļ2au`m, X#SѮ[#ȬsJdevGRR.E]Gyׁzf,C XЍu}2ǏV=*R,*v*u2Q"CfAd, ehKl֮ X>uQ"W5FP6kyt*-*RdAx]>O:rJA[TT=]Gn݀uq)uf?֮[_ uv);ugzבe<4ȲAfﺹO2pQ2DɌl+)KTʥKةxit*:tcCwFP3*T.`0nQiC#(M~B X #(`z^ISN, #(`Y@1I_Iѩy(¹E],໥#(S JJ"CJ g1|ǔAٜsPrv)2t1 ΎKTʥKKfesMARd2f:NE[TڥXTT뾃WyבkT<2Ah+d&FP6k XP #(`vFP2tl)(3],#(`dttw*%:rJY}AiJu`:NEn]G|ߧ,;f@wE],MFP6ke=1{f,Cfﴹ#(`Y1 yDevHsTFflQSѮ)yבkTFc<2OEntFP-*RFTƩhُVrYaܣ/E`uJJ:#(iudYwV-*RdlwXΣS|ǷAKnvFP6kyt*-*RFTƩh D\muu +C xAucpe06Q]?&J|%p0TFP2tjl2tꌠei0$ce_ѩГ B) ȅ #(`:wFP<AxѩUf|%EN%WRK_I!<2O%߽WRYq*Eu|+)KTʥu.ɶ8 J//.?ga"rP :Pfo \!н0v]oesdju䝕}+SpL GYbY[Ѯ g?ʺnE?Fe0Yٷ]ѭУ1Y" u݊=A[)su|{t9YaY9':\u_+]֮ =#(`Yes3]ѭG|U=vje5Aw<]ѭf<2Ųbd,`FP28k X;#(`YތwVhEt+2BYbY1UuS22|:,K8kEt+r՝鈮#ГAq֮;]GY鏢C#(u^FP[stFDi(2Aq:1ˏ+䕕u+u݊ ]:#((2Aq^%)eneפ(2t-e2lAН|Y@݌|luϬƮ YI ᕕu+嗔{Y9ZtYpӢ;+V"Y@یeludza X.[σL#[Ѯ }]GϙբȲAq֮;D#U7 #((nede<ʾQAG زb]7&#((cY.[珑+䙕(YAwu|2w:zYwv]D22E^KJ=,`UFPZud3]ѭ? xee݊v]DC/FP#+Qtg^udzBwe, ؍gA{2Yٷd{1 Xm-+v+[`?FeA3]/,Cd<2egeRR]GY22Ųb]wdD<2egeJt];gV[VڣLQ#(`ˊ+sψ{V[2t)\!Х1Y" RV~"xe2Y" (eneU=$ *?I!, % NxAGkclY[%)<,vFP:`~Iߣb<2Eca$FP=+QfV?$Evw5,Cxk#[ѮzܲE^wVh}c{Vн2r]#(`Y@e}1Yٷ]7~\!Fa<2EAq֮Vdc Y0 #(u݊ =+#((Aq֮V䪛zYAq֮Vtm|ܮ;Ƿ]GnYi" 8']G Eׁ"Y #(`Y92:v9: +#((Aq֮VdsjudZtٲb]ѭGYٷ]pJ{(:1rܳE`gnE og]G]G+]w3,WFP2UFPà]Gd<2E>`ftX.[iYi"  X:3FP" ?L2DY8G K')[VڣLQ#(}+uLv] ]&#((:nebec xе0 XP;#(`ˊ݊u2Y" Wt+:1Wfeqbq)I)QdsORY?I!, 8ڋqIQt X^8_RQdAU\![VV #(`Y@WV֭h e=,FPAq֮^>+ܳE6FPc XnTFP2茠e1Aq޿ߣb<2Eތ8[IG c, +uɎ#v|GבevtYpwtXnUFP2ꌠgVkEt+:1+`]Avg,CG]GdŹfܳEm8kُ+䚕(0gy~"8n$] xfe>R~\Git+#+Q(:ne= ]*#(`ˊ݊νfJgCFP>OR\ѭԬGY"Wݹ')AGYbY[:f<2EpWf~"CG$|}+]pƮ .FP2') *#(`Y#cGdY.[ X6#(`Eׁ"Bv]D"C xfe>,#(u2rܳEeDi뾻dekEבwVhEt+#(`YOBحh}~u䞕(Aq֮pJ{A֏+`AG߹/lY[ѮV[m8OY1rܲE #(`ˊ݊vkyEב{VvcY.[iYi" ؝,`FPFEבu xee=.A\]+d: ?JtGAcGP3+QdVU,ʺK)O nFPC x2AqVzVLQ#(`e3]ѭGYٷ2IG#(`Bح,Y@){V,Q*#([ΉKg, (ʾӡ#(`z3Y 0FP>OR\ѭߓOR[)TpJ{;x5~BزbRe߻,AAA[ѮFבkV6#(`1]~\!9:|Y@8k׵ Xn,{+`nE^AϬGv]eA[Ѯ?FkVFa,Cv]DҲE0&#(`bvu]DCoFP++VQEב[Vڣ(٢ȲGP뾗f<{ZtYenEnB X]֮Vdk1 زb]wN-, ?Fe0]ѭGwgoE.[ѡ#(`A[VV"0r,C[eY#(`Y-FP3+Q,+~b=+Q(p3 FP;+Vy}"g?A[VVZMJC#(`>I]P*#(`Y@igVХ3+sudyhDׁ"{`FtYpL#oE.[Y" #(`ˊ݊v4: \![ѮVd2YbY[AGѡ;#(u}0Y wVh}2ۈ# X0~\!FeY.[Y" gne==A[VLyu9:rJu+u95+Qd@:;+V"Y9N2<2E0#(u݊=A]֮Vthc<2EpNᓯvݪ;]Gwa XnWFP5+Qd)匮#[ѮVZVڣ̬Gحh g?ʺ=A X,:#(]G]G^YYGqtF2D(:')( BKcŹդ(] xAqVdbGVƣ[c g? ]#(`ˊʔ xde< ]'#(KP,BY"C$ORIQd1m3+dY@oe3~^2M$EzYcu`s;2u䝕}+Up7_ nYi"W茠-+v+Mp7_ Y" gs2쌠es2v]D"C xfe>enEnFGVƣ[ѮVd3`,C.IQzVU#(uk3Y" ?FwV*vu]D"CEבgVΟYtX.[YnE{#((:1v]DҳE>O,]ѭC2+#+Q;kEt+[gV翮??=C xRAq/j(e3YٷuWt+]c,C#WKEP #((2t.[iYi22Di8REuKJ=JJ{A[il+䞕(++Q,+v+&G xgeС#((A[VV"Yw,UFP`,C Xn X #Wu݊ +#((gnEnec"((KtY^Dׁ"Yw6 XGP?%C#((c X;J]GY"C زb]7#(`zFP;+V,`nFPi[?FeUAq5AGYYY]#(`zmFP#+QvVh-cܳefe>,`֮Vd]Aл1q.[|OW<YbY[)%)<,;z,W:v]D"C'^#+QdAq֮ g?,{W#(`Y-FPwz#GYYY]w׊S(3حDםwAGYLFPAWQF(-C g?,LFPAqCoFPb|ܤS.X/;?I!,C:?I!o XpN2$ } $Ep%Exn2t+[VڣΑk.C xde<,{#(um1nYiCoFP;+Vze g? ;#(`Y@8k xde< ݍgnE0~\!ϬGGaYnTFP1A,Uuأ-+QfV9Gׁ!Gבesud{x{tY0#(uߓA媛ʾsudY#((2fYu`ng?,` FPbܲE6#(`Y.\kEt+=+QVV֣veY.[YCwFP,`FP-+QfVXVVfܳE`|3+Qd7u݊A[i3FP ~)JalTFP^Ox GYYY]WORГA[2t1r,C XP*#(`ˊJt]q$xu+[P#(`Y@gVЋg#(`Y@\!,UWt+sNxeVXGPr՝?I\ds'){V oe6u\es6')e6A[i6AUwo3<2Eތ8kEt+c,C#Wu0 X;#(}+u,`FPQAFcY.[GgnE.[ѡ#(`zBv쌠媛 =#(ΩjEבe ؊#ΑiEבwVhםd+ܲEpNU+lY[ѮVdlʬʺAл0r<2E+#(u1yhEבe=A7<]ѭGѡ#(u{3nYi 0FPsZudY5FP++V"#(`YMFPی8kEt+:1a6Q #(oPx}+~Qgܲefe>=Aq5)>Je1^YY~IiGKa YpC Jc9N[KgEpL]CP#(`z3Yٷ2e0rܲEZA[VVVI*" ʺK=JJ{(:Aq6z2֡|ˊbWםsEבesN: }]֮;/#GY"CEׁ,BY"Wy`gu`s6:rJ}YygudY@7FP"zTFe3v]D"C X0\k XYAг1حh g?=Aq֮VdAb,W܌8kMcܲefe>,`]]6/<2E6=]ѭQr2wN:,CO8k}GI{V[Ѯۅ+dYe1`Y;_tY7#((7~ud~\!SAq֮ e= m,#(uAGѡοWS8N[4FP;+V? 2AϬGѡ#(')5BY鏲D)8Git+-+Qd5I ᝕}+U=R$pJAꏑ+& ={3I ᝕}+]P,FgVߟ ~"x}'){V[2tڣG4cyU+#W=+QdA[VV1Ǐ+䝕}+KE0 #((2|\'N{V3Ȩu`nE^uʾng?,;2y Y <]7#(`znFP;+V~e }nktٲb2JRFyYWV֭h}Ȩu䖕(5AbYn#(`zB X#(u{2YnEn#((2B0q{#(`Y#(`:vݹouD)#+Q(w$p3LFPV꣌GYYY]wpAʾ! (,4FP2t錠8_RQde0 X6FPWI*" ?Fe0VFP ]#((++VLP#(`A,UFP>uoXAG遟|O<]ѭ Gבe)u`nEQGP^A[VVzc, ,{\g}ѣ:1Ǐ+䝕}+u݊ =*#((Aq֮\uc0֡'#(uc1nYi 0FP21r]7#(`Y쌠es2]ѭGY" u$3=+QdszudY9:v]D"C #,C/cŹR" 8G]G FtY>FtX.[ xee݊vy1-+QdAcDׁ21`, v]D"Cb7?I<_y&` }I ᕕu+u3/FP3+Qtv]DҳE?F"(QAU7*#(ν#G{]GحhEt+:fnE: }WtYVk:,`VFP"fnEn#(`Y\!G/+]&#(`YZgVU6#(u݊,`B^YY] #(`zWFP3+Qd瀱v]DCwFP:`, ؓgnEAlUu瀱ȲDcGבgV瘲u݊,d6_ ^YY]w);C/FPیfqtFEi(2AqV(ʾxevcJ\!OQ#(`AIY2`neAе2r<2egeʖ6FP2tWV֣ddu1֡7#(`rYnEpLƮ <')-+v+Ep;Wfec`Yy\ORWSI a7FP#+QdEׁ"OFPlenEnBGa,Cv]D" |ˊʔ X06#(`fa X.[ XpXtY0#(uJJYes3]#W#+Qd3꺈ne= S/,CǔkEt+ʺnEAG{1u`nES>IlY[=re  ')ӕI`Y@eu2حtnFP=+QdAqrյ#W2wzY" h) h #((Aq^^BWFP;+V,wFPAϬGGe X.[ xeeRh: =5<2E{Y:rJ;]G|{Y.[gg,CFׁ,`NFPU gVXVV.A֏+dY*8k׭ X^xYꌠ8kEt+:f, X X #Wu݊ +#(`z7FP"YgV, #(J܎: }n[tyde<,ܱ:v]DCoFPeh-+v+u盺>%xde<3]g~u-RBTFP/ tFP++V/)(5+Qde0Yٷ2uhcܳefe>,}WMʪ"C X #W[*#(`Zc<2egeߊ`ܳE^|8_OF Ypn;y`Y`}}⏋ >>I, ,Hwv]\u0r]wn{tY,` FPf,C|}+uJJz6FPA`COFPk#Va YpL{tٲb]:#(`Yek3]ѭ #(}+u݊ #(`zoFPm|w$Ep-IQzVU:#(Mu XBA[Ѯ?Fe^Aze, g>A}2v]DҲefe>ene(=+Qtv]DRRE06#(}+u݊ =\!fe, uEבGVƣ[Ѯ;:rJ{z3حhםƊ#GYYY]&#(`YZek3νu݊,ʬ|Y8k XޛʺnE6FP2Fe{Y#((2-FPl3[ܣO TFP[st||M xA(I O~BA[O~BX>w$|}+Upd{V XP #WMݻGPr X>cORwnFPjev|-+v+&eG߹7^^YY2IGd, h,mFP,#((++Qdv]/e>A}3lQB xfe> =:#(u݊,H[tYpn-]:AG|zY[tY>?[tYenEnFP#+QdAqߣGn#(`ˊʐ?f12+, 8,, Xg5AG,c, ?Fva,C X,*#Wux#(u݊,#(`ڌOR/^[LFP++V?k f>x-fŹ g? BحVede<,Y#({&JcCwFP:dy(Bbyu3Y" h?F~8^$E*IYQZVڣZe, h]Ѓʺ X6FP2t1rU)WEt+r}??]GEWkEt+ge]GP:1]ѭƏ+dYw \u-*u`v:xY1r]ѭGgg, g9AU7#((Aq֮[+䑕(28k׭ e=,`mFP22FPve g?,`7FP"(2e{3q^5ܳE~]5lY[Ѯ~ xde< ˪uKJ=,໑ xfe>enE6#(`Y#(u+uOR7Q #(([stw] xb-z,C-/~BX>w$E XP #WS زbeu0 XP7#(&C#W-+Qd2Y٪')VdsORΝi+²^.r XʾKJ=,06v] }I a%v$G XAq֮;-,C Xp)[tygeߊv,\!G X0#(us31^YY] #WȲ5Ak1fYn#((2ju`nE #((r꺈nE`:|Y3u`nE^ugsgڣrYe yfe>ʾ:3FP=+Q~ORGu')(1ޢtFP4&dAq֮VzVv]D" ?FGVƣU76#(u,`VFP9A ㊮k׭ *#(`Yj|;W;,CHwtY>?:ʾꎮ#UwvtYލgnEpnvtY'#(}+u{1 Xpvtٲb]g+䞕(k8kEt+2uFP3+Qd6Aq֮ X^u X`v]DwM ޢ4FP4&Jg:f, ?FkMJ"C X& 8?_ Ʈ nFP.CrJY@8MFP-+QdR+c xU #(`WFP2')e}0jRV}(:dy" \u =*#(& pJ%]]Xud%v#+Qd_xY.[ѡ|Yw+`nede< Eׁ"YlgVXVVzIJ/" \us2]u䚕(coEnBY" XenE;_tY^,<]6#((2\![VV"Y^WV*$KtY0I!\dsOR(ΝWfe쎮#Uwn;wtXnFPsOYeYec3]w:xY8k X^?FeUAVgY.[nMFP2Z8k׭ f>,`#(`z֮ۍpJ{Yۛg:1r,  X`g:댠ehehی_S&]ѭtQ:#((&d9? A[2w2v]p04FP2t錠8VEpn_UstF"C#WȲsbʬʾ! pJnFP)  Xn+d FP,MFP-+Q녑+dWFPwMʮҳE#(&C e=xY1rc]]/,C/d/,C}f:enE_tY+d_tdܲefe> f:p g?,`֮VdUAG|zAq֮VdAVg, ~vݚu xgeߊvw7,`BwalY[ٲA`nEn/FP5+Qd{3lcru]D"CVȲ#(`ˊ݊vw l%,C[Z#d8kEt+r}[Z#ϬGѡ7#(uf{V }}DuAWQ#(!JgE8G'[Vڣ̬GPʏ+Y2Х0%eE. ]#(}+$eGY鏢COFP=,FGVƣе2qa]ܲE <;XeqI)Qd__ʮ | 8WY@[Vڣ_Xek=dm3Y鏢C#(`Y@/\k xde<ʾ>As=YC/FPf,  X0 #Wu2`<2E0#(uc3Y"CenEnVFP#+QdA2{ Xp^-, vZtٲb]wC-, 8'<,`uFPd,C3H#GYٷ] #W=+QdA[VV"SZtYޛ!  e=\uVB1JJY@|,0NvRE>7],C.j], 87_AUW *#WMnpJ{Y@eAq5)>,7YeY@8_RQZVڣί|_U,IQt X6FPs7u݊ =*#(}+[0#(`YAq֮ X0#WȲAx]]w~6[udA#G[]֮;z+,C/c, 8w`_U;]֮VtYޝʾ& ؃,{ #(`z3حtY6FP\!Ug:P-v]p0YE錠8Git+] xfe>R #WuZ`LFPK#W-+QfVXVVLP #(`Y@e:AxKilkV꣌G<1?.2jescu3+Q,+v+&Gsͮ ; 7Y@ڣЋen6#(`Y@1r,Cv]e1 xgeߊv]D" +dYhec0]ѭiGבec1]7 =+#W2es2]ѭG1]]ѭOx]GY"C']֮;z]GnYi" 8YtY+EׁS#va yee݊v]DҲefe>,Vhkם{J#Gѡ#(`ˊ݊v]D"W!Т2FP2Xg<2Ev-FP3FP++VH.AQ,F4.1^YYbYPz m'"W2NDP2@Źjcܲe2A[VVAڏ+dY@+87UFP-+QdJʾ.Wݿ[=DP:fE\Y@eeAqQB xfe> =#(K0&#((Aq֮ X+䑕(;+Vfc,C X0#(`ˊR[+dz FP21r]#(`Y^eh\!Aq댠e6A]u矏A)]w~D\E(ʾc*"((3+Q,R2te2鵤Y+zH]9``x h@S{IҴ}*Z*)Aŧ=Q'޵*+ր4Q!PJ(VtNG:>5 WETVt"*dk@^("2ʲKUDl (]5LETրAٜm \fͺ`+z\fͺ`k@u((TGRDl hIr J(Vt+}ֵ 9J(ր6Q!{KϺފ5'EPTGgET>TDN}k@_}֍Kq9Qc։+Y7"*d;؊Y5`ET>fUDl S%Sc։dJ-ր6QkS/EPVt/}EV*BPDNeb "(q*X#)Bn>Q,kuӔ 8fIY\CIIq7(B^tET15낋)Kr?QV(CVR?̾RMɊ\QW+:7ETٔ ObOͺiJRDҡQQ!SP"*nE ًR<5)BETVtmB3LJ(^TDv)"Χ?5ETvԵͶ"%J r*X+Ҭ  8Yѽ)BkY' gb։QQ![ѣ)B2ߊϺފuc*B"*`uREl Er;QYQW:5`NETրQ!Q?uduk*YGY"*d+zMETTG 8f]{Y\MǩLce|_uTGVR hFTTG4ETT[IV}Z>i%q=Q{DT1wASie|+pIKZIalE窈 ي]:Vj>?Q![ѥ+BnסXTDO+~c"[ѵ*Bԡ P"*aE؊nC5'EPր^QUݛ"*d+/ETրQA!M="*d+z,ETnNq+z+րAQw_ИR::V5~ p7 pH)fg]DoŊy"*dk}֭ )/VRwS"*eJWDn?Wr;Qf())BYWr4낋)Mr?QQ?̾b E8V"*dk@n+BKL2GKRDOk@]"*d+fEPրZQ9۬fDlG~J ~*XN+)55>[؊nMp%_p_, І"*y*+METրQ![{Y'^ފϺQ![ѽ(B gHQ![3)"̬ g]DoŎYQ![u9Ǭ#M5`NETրQ![+)BY"*dkꊨG2eJRDΣN}aJQDf[IŒ˩E7ETӔ 8fݾΘq=Q6B+)5 ETրQ![R\ҡQʩb M}_ɟ"Z%+"R?5ET͎RQ![e(BgV02JZIalEK8Q5)PF(vլ يEԮ P"*dk@A[-+Y׊"*dk@늨ǩ Wk_4NlENN}k_c֑} J(V}d1T[Y[GSElE \RRN|;/SY'^J 0"(bkl}EVQ![[[fRn1V*F-րQǬk~Ƥ͔ y|+1ތTͺJASeRQ?̦WS"*JΊlwTQ![VRSi?k%EpKVDlE$0엨[f%i=Kr;Qb hY5ETVt늨שRӡQRElE ]ҮO%k>4MpӒVRSЗ"*dkȊ}֍ J(րQQ7"*d+z ETրA!Y5`ETV_nubk,xf]4*Y[)4ETTGYtET1:ιk%q;QF(k=#v׬ 7ZIalE "(j /t].RQ![y(BW[f[>?5ETVt{:>5tETրkSYoeXREl Y8Vu(BkUDlE׮ Ъ"(e hCݖ"*q*XzVeY[n莘ub+zuduk:b։EOET>Y'ꃷ[FQD.bE _o5̮ g}[1VQ![GnUETV5Q?̦ꃷS)Q!/S"*ujJUD[O?O>_ f]]"*d+z\j%Ep[fԏbG]mu((Vt۩b h"(jE يkІ"*dk@uRElE Л"*`uk@>Q![})րuDPրQ![󉠐}EVs(B̥ َ9qƬ#[U"*dkLrL:HxZJ ʾW+)G(#-ǬK.Q!wS"*d+$EP1-DTՔ يZ+)]"*dk@-۩2Mi]"*r*XTDNeE/ETTG [ZUDlE'"{SD="*eEϡ /2l XIu(VRѭWS"*aJUDΣRN|nJSDP.EPրQ!SYoY%+B yx+ݎQ!S)P"*dk* xX Y+)A[5+BԮ xZPDlEש يKK5%ETTG[QDugb։ԏb "Yw_ݚS:}z)fpGEl @D[4ub+zVETV슨ש.bEϡ يSpK5`%ETvԭ ي^Cp J(j^(Ϭë/#*bTDBI"(iJUD̺WV)]r%gEPT[yf^Q!SiŊ?xe^ס룔S)Ŋ.I:J[f3 P"(b;qVR'+z,h%5`,d2kl /@El ZI5`ETV}֭?d2kN}y*[KӀOUSeQǬ4S"*q*ĬKl5˩E7ETӔfݾr B0k%_"8Yw4Y+)@DTր"(b+zJ%b (]5,ETvզ C)SiP"*j Cݚ"(b+uETT[iPZ(vԵ يnK5`z(e6[zVDN}+z<GQDl M5` ETT[Y7"(bk,)Y7"*r*Xѫ*"2]Yw_Ok:q=Q1ƬSYo%f]Bլ n>"*u*t(3}k@A!/+:7ETTG䡈 َnb[I񤖬V}zJ ck~uր}"P+)_؊]+)5ETv يK5`\5`$ETրQ![ѣ(VREl k[+)BY[ "*d;7=f9fe¸"(JA!ǬS"*~*So%f]TuTG˥xz+P"*dkRVt-l=VR[Y[f Ь [=NVt/|Yq*d;FQDlEqZIalE Ь{XfVDlEϦ ي]:V5`UEPvԭ y|+1Nk%q1e(BLET+t)BYL+))E0e)Y0۴؊Er \g(5)BPf(Vtmhր:Q/k@A[-+B9r/EPր{p!ր\Q![y*BRDl (Yȇ2GiETVt]"*dk@e)BkQZQ![ZVEl hEm%E E+)=۴Ы"(y*$kɷh%ݧ"*d+>_0"*l ?"BPDX5낭}"P+)݇"*dk@_+u((Vy)"Q\5ր9Q!Se(ր{DP12Wլ nK4)~n}Eo2Q!PrREL]"(jTD?5ǩRQ![VSEN};DPj(V`a&[ ^,ET1 h%q3(B2J:lDD\L銨2CUr̺}o5#*jRDlEKKUDl (M5by*,+^sb-րAQ׆"*7J ugEN}kbh=}Ь gUElEyT[րUASŊo#"*b XKl+ZIaǁ 9fGoŊnIݚ"*a E57ETV4[#+BN5@l Iu՚:ˊ^"(bkjn%x"(m% ETՔ "(eJQDΣN}aJSDFD\N|+vj%?k%EpԦ P"*d+EPՊnM5` /eЛ"(b;RDܬY+))B?5`&EP݊^OElE yx+1gD\L銨{(<9g(<qlp:Q![})BK̮؎:NlEs,-j!bRDCgJxQǬ^VRPGS"*lE窈 ي޿ZIaBgmo5ET1 J c+fETTGԦ ZRDN}+eEPІ"*dk@U͵"[PDl S5`tEPÊEi@ n5,ET1~)8ԏM)שVR[ѥ*BkQesYqwͺJ+>VnVR'kyˬ5`u#=е"8f.ZIa\L[(7)Ep: ee6uwTQ!7S"*d+zY.PJ(ր}>wr[PDlEש Z퉠REl Y3ھƌ="*dkA[fWDܭ뉠ԏbE i@Y̺I!"npƬ3pƬ ~nmx("*bRDC၈YglE*hBKEԏ2LIl+)J c+zNJ ck芨{Z/ͺc+k0WWE4 c.2kLcyVZ(VROS"*?Qi)]]"*d+VEP-PPE޴x2QǬõM+)iDLɊg(cVRǬkx Ŕ 2Q!P Y7M+)DPÔ 8fOh%q %uEP=\APjU( tET#.x2.EP1&g]p eEPV\"(bk`:[ ^f[IFh%q5%+BET1𼺦%I M+)[Ӕ 8f~z,#(b+zETOXlݴxr_V 9fRQ!OS"*;ꊨ)Sr7e)BKUܬAPڥІ"*nE]E^A[VVEl XMp:ފ"*h<éi% %=r̺_Pκv*P;Ysl_jn5.R>J7+B7e/|zeָPwͺ`k}m_Jg N>^p# s| _^-??/~_?!~+;i_eCd~+[rews?1'Vv|㯱'oH9o}S~/~hg?2ڦAZ7qbU7v 7Zʅk5Xk?d?"{(p5?Ap_y^, ki39ec&KJXz Eb֛s5SU?Oogar'ܞy$7}د/u|{H[Ҙ⽖!ʟu}N _ Jch}}7EaX9__1@ڗ\ [|rށ!c⪎~>fE~'~W| 7&w, a؇}> stream xڥX͎7 )>mboESP()Q#i, kDRG ,>C~o_=7ʟV+a98&:&ZeET Y~{J*7*mqViX]8j&]8 )=Gރ&5?~[~}MQiw'+=+=7o7\4wVXfcؑ_j_-uMQP ySp+;yq'Ь$Ul'y#K{ٺ{xf7/Ep[S|b's`$‡UNSҸ%)p6\0!A &t OD} /icTzL _qN ;%T3@); zZ̟sյ:6ܚ5EuVa|a`L=IP7n@ڇ@+[^((o=5dJ4CXں'a138U`84swA^.:DP9g}4ʇ_C%IjPݣqÒ<5WT*ACچX@'h}=y{ VH_~}gVqEh(wϫ@1 yčO̰Q9Cj4ϼg$P _6j9js$Ws>}Ms ( `LӀj-,phIg?`V5`uq7 =;+6 ŃF O$eM/&(ꀃnݱ˪k]3sS%6t8T5{\+1 쀴aSV%0C2ʾQ'E蔔lHepu,+ah@[$Lq%q*OF|ς@%+]יs\h^NhG\4e'asC NCũ@T%=$]%[k13ݡb?nܪ:<#f\߷9QHpMrdE/&@Ks8$+iMIA*GemړR(wy2nYqKH㮦O2H^9k*yaj^%R+{*zW^ ϩQ[C1Iqu111)DArFem$Xs'=> 4ځKN&> stream xZˮ#+D* ;; zy/f6)*=EWo7$*_n+]=oO_`) }oV ~;8/ШGN~' @K.}:uOWeU/8QH.rv^X A Q[+W0`֎d^L8^?@wn2.FˍKD2XڜBZ¤(vckTTN`sQƷtj%<^ޯ2q%]?E5aE^XT P¶Iȭe\sYjǩ@CbP&owFo|a3=Lǂ*Z?@fkK0j. QQQ7K{(Ax;(W 뎥݊pLqĢzM1pjzE`>-{ 1n@p5bR2 Bu0 ޼1&*H8g-Ԯ@TChJ́ $MOZ**HǡBj%[DLZ `,*KU$w1_8x҄3h}@x"A$kPÚ'ٵ'oٸ M,@uao QIc]!MfXIJ cTHZIHҫa:mժ4\M6 0Ƕ[ـ=dgOsռTJM g_BuRgǛQd)ߞc?hM|m @HŖ~qgzy%9Fi1#Nlߴ _qNٶC$eIBm2y%zCdF(=XDw-Ӹj/f:ƺ3+s3΅ ˠ7nv'+ыƌ'ϑp S9udؿv`+;m(,VPJO:RUaWgg?0g("GǃB̬uT@n(;Xɇ%䃁)NMHws2hJϤpKS UDtӮMF;\g99l9qț]Y؊̰YA/PMjuH66|L A$4*ms z 8k"0sX8i|ɣ$j<ǤF}tbzLDR6\$rbFK6]D@cqGFiz)xx+RȎQF蝌fX/ V \Z,Spn90Nk"Nps,9jF.M;&]%Bi>)pkZOP7CAwbڪ1y%\1]6`"MXsyDtV h:9F>qt KcQ.P 2Ere /Ji $Z" -z/~@nGU1#*hD7~O}C;;^$?mF؛FM/1wB)"]N%ykYjb˖޴Ō9JS˖~Ko篧oYEpqhuOZjㄒz\HY:ܻ#~킛uRL>~:ݔ"eoX8`ctk&v㷇o֒h%7bFܶÇCٌ31tp48"'V&&HԆژ;ߋ$w}(˒ZW' 1~۷#Ф[_Hcc-os' jY6pi}ӳQi^4Y4O%JHO,z8]>PyRpj9H}͍tx0z P)h"c c,'G= z:Qkxs%LiVo$s-fa/|sF +cv̙aA( fIY){,Qf!ׯjk!Ƣȑ-'7In?J"k(xmoL bUI|O)hUGɟF|f"&KEm3޵Mj"[]:P\e=x슨,C $.,+2߻0goiz5j/Ncw]c"C2}"篶[Y&Rbڗ2pr}33&Vޚu[</࠭K*\G.ݫ yPRPtx.XN㣂<2og߄?ޯ;wEBSxC$bG¿?ȿ_ endstream endobj 104 0 obj <> stream xڽZˎ# +Z4\ .嶳]L6CJ$%ULHQ<:${M?% v ~ϿNz.f{{lTJnox$m;<1<؃+] |t1nW ;<soy`ʹJ-U%ɢ@,QkյPx؞FRfu@U1m/]ZPlG]Ө:<"|r|q yq+a :_eO^mfs,G d7M9XU4zzgl !HvP^)|G>،l,nl{1xBb6q g(7j7m-{tʄ҅?mjjo޼dHM|Mh֦ e}0[oj/6{[9a\O廸K{Ew:u@zo+zasJf~\aQX_Ds*h 8ݓ)EƇm*6V}gߓoU ܋{J(g:X;j\ntLNqr+m#G?x閲Ԛvܭ n[foeמgxcUGB>m41V3$ӝ.b0FU]/oKXHo<[4r2nn^Цh5T|7t\"F6/~0nhwV C}.CdHH} b"Ji% *8 %`=|'neULmSډk= -GaJv7QG$̏ͨR} ^% 7i(ۯwF1RƟ_1]Yu遻PiAJ P~E>f!Uik)㖦/3O=\g.H):O9$A7cwMuݘ8 m;ON@!O:!s6Ϗ22RWL(x QGgted2fړt.IOBkuL70 &b3lƶ/sDF )1v _$rp7.F음%i\#J[5\ਲ਼GsŠmd{ni/w݆J;Ǣ2D&?ēh5۞T|6։R9;2$xEd K6Z~[C0j}wuj!lQT#BJ'OP@@y.'ܟL͗EZr䗰+=2nKs\|vLDHUֺ!8ׂjp43X[:eSI\ Nuh"qL ^r)/N \t*r"vɾJRI6\SG N_0MkHE۱q 49jk:5F86d👳SL=YSWN FYHQ.3(8BLGeunÑ;\"b#9jO (wUɔD~/$PMQ> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 112 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 1160>> stream xڭWMO7G8djؠR6CCD@QػAbXx&Sܵ徺GWbt ;n m֝-n<;]>|r}Y;@E\.%R ,{TqZQ(+*5YV$VV(e`'بB`joJ00S|9QTWA+OL$c4ƨZa:L"`*'S|P̙Dx /K8,&2U4rB*n -R6ܘm '1UlVՐ8#>o8WV+!N7!?|`!^Ǚ)oyǛAT :t\TpZ!Ov>|Cѹkx3JMWToVi(f ?N!ͧyVVy(ZͿφ"ACݘFZd*ooh}0?jq1eXi(Q#QڂB)=_&lcl?$J{$^0w:_HIЦ㬅n>pVOՎx9 wF liⅥK]#d@ .cJl|q[֍:qzGg>rNCS;'4{3} rpW;th?:ķuGX:v嗍s@k~xCh;ޛu>e_-y=H5k4^7%eb^gvKKr]d[p2 8 : LqN)Nxa߼00C:_h ?_TwK:`hvϝ]|ѵZpPy`{G)ѝ]\^^_c{JTz? aG.qu~ yTєGswހ >|Ï}ޞ_rScTޙ endstream endobj 115 0 obj <> stream xڥXɎ6+永0| I`Kv.iK~?Jxf~Q]oJ'G=p<[]>_3Ts7ޘ+ofLK)i.I,@MY8$^p^l%~C GA%R(>4t䅑 VYX:TttkӽX!Jk+d4L-ri1rŊAeJh<2J cZNܙFpjʍa$$Q%}Y\i΢eUԛ ]@ =R[TQJd[]QfN^L+'.4rrf4TTʫdL*@8;F6V\̔L qx|]* s(R=sPQ@GM[h@1%RʰB ݏ0(]\TdnĥRN_>8ԁIvbyzY΢)B [IU@?X耮)ّ H]*L֚bZk9Iے)ݗ*q~&#fVJ=DT^jށס Bd>~6Fztd=4D;O Hmú9F3grE@((`8eǽArMkݥ<%g}mQ*>mNͅ NiS^ }7.24-KE*Ɛ3 !f; /*HzǼcXc.N:^jg7Ⱥ uY!FoX1==2(3 4@}tϧ6WVmcblTmoK;x" =p-"ГCŀ+@ dHEt&[f@ $`0 8 46W[G)Ϣ#)6LpOlJA^ Yi9&)!)ổ^ m *Ciq{hA endstream endobj 119 0 obj <> stream xڵZ)永0|i [2sSdq)4t (.~߾oIW_n_ ?~+l Ef1l'7j{;} ?o%/(3_eҰ/z&( ^};.'͹8!̒\N[N32" #J̇2B:Q12 EUOazPRZ"Ma,D__4&'-U0XE3?m-AQ]4]gޕw`)v%9[,oc֪ܢ6oᛧxN+^o{`Ak[ (Zm@)[EV2QGDG0@P퀲 4HF$9;OvbKTT%-=g/d=< `Xàuڳ1Oy4ľ1LޣJX= b4T<3UU-\z Ɋ3|WO>^ ,|٪*",lґMKz=Kd)EG{[*o3SiKTu$^Ng5 %u۩ZT6de`XQݫq'왖NEpb͖ HQ,eQ983 %X7;B&꫁3~se6 C`{-(cru3WYX"pŃp<|p|u»8\/21D`)9F>SE,!jPusg%ҘF?9M&V|}yY>TWp],*ōݛ.rB"oSO^ΘHq|6cl20w1(H#\MD͑]˿,zJmHC~&Z:5>x\Ev>D^ CԵ\5]ѴѩX?%!3Eƃ} GNXy0,}'S;;4>zevfm{ڳ>SzA/-YGn&IΆIc֚IN/e@_ʸ3-(ڵYemo?(ɱMZ%BK ?6: ss 'I؞u<֦7>${CھhރL3" Jr;N&UM-x}+L g7>x ʪΚׂ9?KZMM/:P0'Ț6f}7~ZTOߒM/?s&ft۰>nRtB/?ӄNiB`L5_}OʯӚa5,.m7Y)%aQw5)ghR|7ʬ;ّac)$r5[2C"Rg- ?Mu{% (^/Sy/`+[-֥>=ȋOQhEm%ƫb{O 8tOtv= endstream endobj 123 0 obj <> stream xYKo6 WDՋ r(.۶=^K~))?&IhQ$EE~/4!Zg|iUJ?*&Ůϭ'X  +rW8aylAP!)<\0|SV 5w+3鷓V ,6ZIkg= LKefFlp;.ĔyC{_+s2Tuo;mM顑" ha$Y)P$ t@=(2;̊_6gA/ He_+㙂=+Dm-&r$$ Qr#5aTίa54-%52CɸydwGCˊxF84 ȝ9wL-}1!xt>) rn(3Dގ2]8zҁc_.r`35mPXLyz@\D9pGD*Q'*hrdD7o/Qwb}7Y'wrLZt;|ǸvݷN3%UWKuQQLiF pӱ^%<|*I"bl(w, ~~=.LТTyFBiD5&W@l BV_ujkA6Л-~{ Q>4ÇkYl๷VTxMw24 [w uKaLE1Zqyc]r$IՂB!.ES2a.\W_s2ƄqvڏM 7P{BZiR,hD˖툍Kaf;c`rJքtR"uvY,ʚsϬ!:SO[O3P!ʄgF!oDUFWgΟ`┖Վ,3.Q(#Qx\Qb(DT7)F. w.J|b A*|TMmZ2> endstream endobj 131 0 obj <> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 132 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 1216>> stream xڭVn\7 ߯^I= Z4.,Ac (=4ͣF9#CI茄.S25ɲrS1(}~7OzDϷ)%?Bl^P?63]n 7#½21:Nfš;2 f5j7n,͡(MvTuNb,0; \fRY5.*(5źTJ*tf*!A"G \/ bY`SN'.5wqgkg~ENbpRu7ċ' KϦ'i3_5qf-VɏW+ $ vOxV r|+wċ4|v"cau2(nHqG wjӄDWM& @c]mZiv/f55##Pu> ,qFp+f\/4U^il^G\YՀ ϕhB8==ayPUTP&,lwι;,+] %9\gŅasR %S-Fgp"Gq<-!sq >7mars 8|"ո}%5sux?N. P\u^׹4rW}avF2CaJl0FjKf%e-#l>AF )sPB)1UAĘ=~"` qwN0"ꡤg,޺e+'Bׄ=/0G݆ wTmXq {bmxtr+9yGLAxM>F5S~SBr 2GޓO\wd;쯇w;CFrG$60hף)f>[fݲߧ,w^Boo~Ä ˧ÆwAyjd .IT&=MWOCZz4 o_:rY o֫a-Z՜ ,3bC~rɯN#t/\#{MOo߼=}Agߨ6> stream xڭXK$' WƼVdW-ܢK~ zL&A]PWo >b!Gk4N:&e途_~O_A$P/w)2S/?Ƙh,8#O&M8'ǜ|E6ܖm*rd=Fa4LSzWS݆d5)"y}B%9TY[L3?| : b+Q:%tɩ9A}+61W(cT}}~U9&g:g|"8]3eebVσDkt-JFҖeՍKƐ1?\ | 4꯹aqH};VLA[M޹ ΕYsqu"a{,״/7.JC\%pnG&V-/$iQ)JN]M jS(VKtZ)K1.ή ;O*`Ӓ1,Vdsa*N8EB:\X*D/ út0TX] #H}`7Eu@&J pv kXC;7T<8I2-Io1y5fb~XPB,1h3&ɷ!h1@<:PǨiCm "mի 1ҳIӵJVl8D_ KIs5^Mtf5nuue^!INAC&rxh}e<DR]xaqZ`+Wv-bi2 - K}dd:S\8auA??Q KC`E\ׯ1kjbIJ,r&ʏg|kYΑa2c睲Y"hͨx>|.)myl԰enyj7ҵIdnI0my<)SoXdD몧E?I2uqM;ā"Ui2G ՞Gj,*2dò n$:\ʵbkn #F mmoqIEFb|"߃Mf)xȃ(\eqն{"Ac^g'mI[,b6Ƣ_껤 `9gwMk12fCHM}J{p홣xnwBWn\$xw?j0swᩆP>zw9ѩy\48s: -X}J㩆S4~7ieasqM`^9/*"oVG(#څ.V5#{~\젻٘)Ui wP.,\1߇D4ڃ2;o>, e ^@o[}[~c뙊 kdӠU3Ҵ& endstream endobj 145 0 obj <> stream xY+Yd xpdFd77S|5)Q{/`'LClXSFm_o3_~'HmoYR>f{Qv&r'Gt06?ic[FXEv!edHH.^ B8j> rg ޅG}bwqnFkC&3`!{W,r&lսǖ|$щtp1m̒"B2y[KɔVK}uu+(+r2+U"jӴS8,D^6p>8w) g=X7+Q}9W] ?I(U9'\ۗ NJac35\ ׆͸}_/+ vfH$+- n^h<;sy?M<\H',ѱyW7;lw5p}ݠ\|A6xDe"Y%w*BqJyQ Ǎg}rc#4xlFku$mhf p<"'eXLuFCf} ]GZڶ:'ݱƲK}Cq 4&ٞw8Ɨ"dۓI>O0.ay *BP~U0KB*qz(k'vp·֔Ac +0␵|THR^WQp0 Vy'ȦJ9xb}H]О iKNtgb(Yxm=\.f7(N1Mׁ">3.y#d9}qKTc :vnemhR}-Ic>3$9?WUx5%' hu* <^-\4+Ofד6Ǣ+ 3 )1RҐQ=M"$=yZE]Ykn0 bD̆Cm5#fwxun:B uYe.}#V&N<: J(ImP(^{eXR8g#9iVGAᤎܰZ"e L:46ppO1$2mjeٶIe%5p< /RTP2~|`PP (^@bE$>)hqzZp~gD4A;-<^ u#~eHCVpB%߭/ (&)ZcI(g$ PM nl%wwE{^wd ps*% e\fz! sF:t#Y͹9cHOs5rXD)u:Dn*{wlPfYn'vn;d$ܡ/+p/ 7'gn ռ:xDy g> Ӻ&b=d t\d}I^}[UHnASpe]/UgnQJ t[$ dϱe96͟A}$Dik$#~Q\k%X vV'`ã\+U!VL@ oȒU -tmuZr0%H7uwCׁM=+ICK}%b`8nިS*xEiɖf-נe)Ar>{򷩹HJC]6nbiF1z$1~k6~畤P#=׉ \5ET1?f'9Lb`;'h H&'WOǿl\ll`c `nt5M-a Φ9F*zMNJwܛre+ ?<Lj~gمbuT+,+Exo[Ma; {^Z޻Tpl$s}4 o&̅AW?`3Y}w+=4X}Α>K7/> Fs?w< d endstream endobj 149 0 obj <> stream xY͎6 )H?C&@oiV`ع$/IQ'l/EV _3hgiUT~x2T™/m&??>>G6fel}P!!jml k_!* O*o`x]~}06)Wih >c?K8ʜ'R4wS{u_̢l|QS{"f*Jݯ2fp dcB2WM'no[\D"֍n8vKg*uo6. aRpQXь AF[||.7}AQ R&JNf*Ye,r h_gv^~SyBhQ15ʾz>^gr ap,+v5ȒpYը/iđKeA`+ΝSAhp"Y5[gXWǷ#` %?}gG=3ԙTi|2na(U.Bmт (P_+ Y\"+Z"cox9GH2-%$'IZqMQR1Rr_N6+?UkU++ }w+'Ά75Mb?|<|?pcrݜtc?q*~h|M׃@eO7:Ҍ3 kZڪcm3D'faUC 16ګtAe&v{wk M6Y&IP >&@ E睶T+}"vBS.xM7I"vƩ[~ HGC X9$2@jh OA)GeBMy b_tR\"堯;g?}aKJ%`[6(a5eEmQn Bǻc&TA+'U'DUʈbE}8wQEWQ]/˿ endstream endobj 155 0 obj <> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 156 0 obj <>/ExtGState<<>>/ColorSpace<>>>/Filter/FlateDecode/Length 1603>> stream xڥI]5WxIÖ AZbAX14"~>Tٷ(Bz>}]ٮKt޸w;WKq$ߓKs?ooc-(^~} [tߛ[2G߳-?˱[> #v}.[,dRG-r⋻Q(bO>cr#d b58/KyoŜ!Gt15^tL~>?csssB+Ium@WQ?ݐ|c>7q1<|n6_eV7L)<nwοۃl#L,Wk%b\XQLG 8Dn5=^jۥ_{CiPfdn3.ɏ@Y~GS&6YrrX՗Id%RH9o•HHl^lw(eH(r"!;R6kiC){Fr܍>mɂsImy7);|ect;YJ;9[3#Z 5eteAϵhcyt|sA,@'ͽ`sA>z-Py.@mEɻ<S!+<:QУP*E%{}~s44F5Ow'Lj7Ǐ^7GESzyNNSbeh,؊-qZw1j]q(pO/^-V9+sN +#JA~JFd37̮ Gi"-e^1ov ^V8~*,(6h`-LG+u^^2JO:nXiC & t7h0XX VH%D̸Y5^kc0`|J,1K,1KUj[E-n-Ͱ0q Q\bX" .y ݤxNs mFjG/0@J,x!up\IeІ24-xOxk_"oҤG]Ҹsꆗq/nR5G6ԅc ^"/uQ҂R57TM /0TO /U/vKUxsK<"1p‹dI1x/_]///9H ^U ^U ^U ^h ^)/9 ^] ^T^"Yf"j"7hU endstream endobj 158 0 obj <> stream xڝXɎ7 +Z (!Hl 7s rr2ᦥjSE$%R,X,`ro_bR α>zkM@fRQ/'.ۿW5gXj+,o%zkATqyZkŹ ?겙4 M :mjcug_NPt"QM Y /1ޯMMSHMԠI>OR gPm6Q<;t, ]e9NCЩЧq锌OT0_tnN1-Hh={lGczAwCV8K]D]'eƆtQ B k 8V𺱶0oI$Jc bK m$+xOgO@vyWh$QH@ Ea/+B[8(Wjrl>Բ5Y,=X;D`ù`Kqh3nV{f+hQ1_:fCQg! @u|g 5Qdi ;moML#)#3*[DOTiCE$SH/KP{ 0qZ9Re~<֗48eS+p8A. /u}Ɲe6Q)KO5dwCc874ntbJ:F{~8[SݶH0(kim43KTaPô1BY5 |HQD Vb{H @i3F!:4.wͷrȻsy}0^ap՜Ӿg/*`2e2hmNuxMB97t%wL\&&~ ޙBJV`ڕ@xq_Pߕq^D?thϤ[x!5eLS"$F;?ʨa=`%1uվ);KA[>* ٯS˲@+u[&y m[;goh%NT]9-dn73ϝ~iUzt٧V6m}QFSݡI[m&‡ d pt!P#$)A =qhvWApT endstream endobj 161 0 obj <> stream xڥV0 uHE$@)9R7("l$o?8yׯ7./8 "4i n,D/_&|"3N7h kv2`&VԚNS0]kbrhBHc4fxA3:KQ ܤ*khД$CƊcv5;)d[TbC󲺮ݰ:*e 53Φϛ.d/<!^-MCBXAZ+kAB /QZ)Xrt$2mD(W)B M:]Cɽߡ_|,e추u+nL-eo:H2&P0C0ak4b̥RB{+z`W"OC_a9IL]daBe\ݭ˅GBZw:u'#ئ+S˹Y0w0yߴFWY05(GBO$7d%u&\ !MDfŽɦ3` @#cpH=JtgFw >'tp[B_٨e:-ŵvd)&xB1njf:Q[m pMm<V'gv4AOL-\OZسUg犪C' cspf:Ihș] T\9A\x; G~7Vˢ;:ND@ '8 endstream endobj 11 0 obj <> stream x\i_V >85iBҎbH }CV>u pV,ƿX(Sh e  'C|*T(BpELLZՅBcq0p qя`^¡ R -D3 -``c ӅQV4|A %x7(XPj +=}aU  ?H$P :h1QR#K I =(,@ԜEծm,zrL¼zTR(ƎJ CJoC ؇ȞJN) Ob$(Vw`ɂpĴ.)` [vP'<_ e@ |t2T"Z!k d"pKFL(ae- %!YF>*(F`)P-$rEeQ@JQ2KW>A^ZBAJR*r4oZ YQ0TivAK!xrO B5EsJFKa,x2d:|˖==Gmb pv9,W}SlOk kX>ER] f`y?i X("4 90Q GS;BYTTB ӄD_5|Z!QMd"eL5a צH>cD䟥zI:?fYEDWSUVtC]`~ >PI%'z7r" +kAabMR#aiQq!pJ Om=tRS!Kp"rmTK"1) O:D$Hoj'jO ЎhA?pO_S'A8׹usg{9 l":3rd!V.>#u ,Ó2[.PB|绪|0/Wk~ߖ˫jy*_-Pl<t]ՏjY5Y_@ӄtRFj ~[)Ev,NvDЧ}|U-/|\Nn'/|T tA >=f~xR5H@K-8 cȞi7~,~|7@8Ial Wp1To![+<'zҢvJ08#Zp5h7g,(~GB~@O6HH \LWOMyX<T\֌t1Z0G/R҇(ߡ~szfYWWEJQ xT$}%'Mpƿմi?~]-Z]XW^O7+o7u5^הWZOnU9.'7ׯgz:d`x2*ࢪtU z]. xR]Mgqxys=߬śżz[Nonyy|3.ʧqΠ{y2i<.S̖Y<Zf? г0l`܊lԂGbtT<;xp ~)0~dD XaG5牫nk[bIE<$x.6M'"/djVG<fJ6eZXf6ۜ8v:֗YǾ&)E ['wv຅@ՙE#'ް4,$ʞ6/H7B{~F{"NiK=IhiyEI^lZFYϫ-p<#)Ur)\˷ +$nH|:av^Z^0M׍PtWyZMtKiFrX %5 k&9b<0Oh<IwT:uR.6* &Tٺ.:f%ymK 1#A]@,"05}kZ!f.n,Xv\؞ʬP-pwV7U5N/S#S /"ߞx)wReWvk_|I}8kN:Y)u˫Z!<_FfskFLZFխ oH! NyYPeaɄC+{tW:w8АEIS^nGJeJ'\'|҄Ep=zXUoK[n$+>"X{7Б8;Vl[%+by}3_~yk;-ƋҖE¯-ވGcqLLBOװl؎mSv2gqI ymakieB]ݐ°- Q:ߕ:.]jQԱ6*v``}Al#!K߸%^(sOQ.׃M—X~Xi> JSwObdބJ.SZO ko$k^z Ba?eBOu8z^]{||=^Gk,+Zd3eZ)G,mΣz7`7#fiG.nnG*t #U_dH,G;z6ow %8^kLw{ͪ9Sul3SQ:6ZBr|js+^5\WZ[b!j lwp4$V67v;)vBSwZZrWW݆/;sv#t{9d nr>6r<{|:JzA2@B+!AT<k["_ny|行^PŽ^E^E˽^XߪLX{v{5umA3}DW!G ;EۘDlv[{ 廸;RH6t)lUE֛f}@<^Y: Z#5!Jk44 l|:E$6=%;SD;Z~н5 ) *jC㈫n4D@$%iFB3˻Zˀ ̭'`{3 Á}`n4@oETAlMȯ8^e9 2оUx~U?L_p>t}Dzs9>#}}yxoo|]ꡘG6 [:T8ݾ+joQښQQ~x%kca F'~}98:soqϘaV: G-0q-A2&+cqd"$"b@ .;8{afGG`}~C60n =䯦q\ q&͊ӵLl?ęW-~_ endstream endobj 312 0 obj <> stream x}oo0)rbh $A3O.%HwlS^_rmbީ9dUAqpԴ RlM !ɻp~ͿL( &TD/  9I"<R&REDtD.QH4&(&Z"9})E>QD#F)p<"?2 IH9~})%_5b͋]ef6}W)/M$e endstream endobj 313 0 obj <> stream x]j@}L)AWFRQwS!.CΘdA?Ye3ͨ5dj`;ط.mOﺫegϕ~:`S}=eY~J|[nx4\50w|]=tlc1c}͙Rv0jFiͶYJqȞ9V`9Nj%ਫL%`poX %e2 юiAD>ъ(B.!\"[P`dq )+q'"q*9C#S3*M.F dz߻S45sݞdpc&㍶kCx endstream endobj 314 0 obj <> stream x]ok0ScHsiU/kٻioιi_z]xh 0[Ʋ[/{hʛw7TtRLi4bJ&D3syՃ_hV YwN7 0due%usRP:Qa@+Q@z8h4 o|/|5' YW͈LI eih|MW/ԍb endstream endobj 315 0 obj <> stream x}[k#9+qe}`Z] J0Maɿ_uWƐ4ѭT:,گK{86R<!ކ],Ḑve{^,ݗK,?N_緟}eO~x7ﯗ>>EQ,Sex/>cmq8OnC|_RjEI;yw"V]H"7jjRu]T]\iP=HB9 H E2( B;5>Uj@-@ȃ0^5y*襝"C͖"SRu|Rh^: B1?7F)SmSQL9j1FͶ\Xd+ fTgg9КyK,{Iœ*j2g%A%Q3FoϪQDeԓ\;%oXx]WRCV`EAh(`8Y,G%74P:V:(<<(P " -+-Ǡs7E0wuǪFcB)3Kqcw/÷5mpaj/8|KNL)V SUBy˭?mݫApkYVh2_> ^Ԭ'heD:>`9>`y>R|% ׃JHҧCTݸJJ&.s&eR gMVJJmR;8)&wpRlt_rJYܯIѹ_Eh2[Fm'e#rI ѱ-p4m\Շӛ@V=AVPORvOv}ކ!=FOUt8k|:_?h endstream endobj 316 0 obj <> stream x]k0+1jVۘai<]&!C` wq"+i(a`T^V;C+bXߢq#7澾U1/h S[VCCj Yy hc&^j_3<̱[eSZb@j`$9 ]CoU NM+aq>U;s#~Eu8=/ Q@#RnHR(C 3腈":v[|D7W?G'f.T&8s',Fk=Q] Wh3g ۦ endstream endobj 318 0 obj <> stream xڝzwTT 9G8sػ{K] C: HEHWDE5hl1Ƃ1&19fs͛Yg=}J%Rt ˶lnp =pD"~l*DRT"5ZMfԧ40``aq ^#%&Ri_3%W[_ge.@PIV֓ vX,.=_]NN.*'K_7 T2(puwn'?=wX.V{]]&PݓjB==-'Oh=ڪG_zQyK۠@_K@M,w@ I}UWL?C i;C I% TW" I8@Bb.$ wRC2R$%-#5ʥfRN:PKI-JprF>1*AC04DFs-GGP):P9ң TPL"5XZڈ>K#}fبU6BVd41~` ®bۨ&Lj{zk{>} LLL;6ȇ_[/1 j+U7k8b)veX[(rpeJOeޘ|ېCB~~ i"s@H,jֺ/B@sn?,F|A*~__PB `2^@ 6acGٯ=?RjJ 3+0.xh s2܈q{EMaIeEp[+?d=mGkp2ܸiG܏۵87@*[odF*=\FmjLbƙ%I4y/PUH#4Y&HW` ~o ߙg,|qEQ~H1UPGn6fG U؟ż Ż< s'&}V]}]kvgqfJ%: q2/u'C>`F0s~ *ܝjU\6zox[0C6!Q !#Ft6Nɟ~|Kso ɴIbfDM8TJB?E[(%?+9ݯFu$HWXN՟zaƎ 9oxݼ V1ެ @>oBP"Yڐ >,~GBFgJLw˕I mmoz"?B+x=(X} h˸ z'Qp5DxRPa ˽A P_ uH=^lãg t͐X 7ߧsNdi6}a$,#PIW 1 ڕ<> b6Ř{ESfAQ{#=k}G%ċxyQX/5\_Q߬b3bX d5iM^&e}E=8PZГzzq(`.&sHANޟv :.!qN֋ T]zO"*"6{"}L!>ъ7+ԒN*r0BcU.㡗kxsר[U] :%& Tt ^]UAQIGEΡQz <,!.Dd`$jELdPpm &dNk&z 0BRx8Ӥ6‰OSwf6(>4A04L}@LRXCn;4]5P LIaPQ-V &k=DN*V?AlU~"`hP;%l^)N0&`yPLnY=3*uKr7BUH gdf׫~v0>c`n5wW~_8p?KĆUL湣I6)u8|o&fh&u3Lty|~i)*TsEK1v1rq@v۾ =~;q"l܃l@9YUacp(fbJrEg(D ]ȉZ4ӗ| 431 VV w4b:tZaa89¸gAՋ@M&$GQCS5]kf!g:3/3WB=Qq:L,Hy F01qyʬHZt}'DS i KUFSpWk[AqZ i-)xF Z"%ҥ{EdW\N+pY5U؉F YG,59` _Op/~ϋ9Q4SKjvBs>xIA /JHɩ8v} E\< cnK~2.;Qʿ>b5ܭ'lR`9sWjUdX9?b:}?"|YVNŵ&3G+n/#mgm Up >o3l{mQj:]-*, bF=QrSR)A (Gs؛'fGj$/FhB1<`vJg.·1E|L]pa fgw+HQt8yg]!0b2~"Ilbr*ҁN,sOZo񷫖JM.6KM ь._t}mIVhH-ʛY]N.IM;}E.suv 0`}읤0$5f7=} InZzBLj9I$a95iYxOiJ/.<TYW9D1ܝoT'~<d]S.ظYP A"+?)!>p =I]7#/~R\X+PŔ0:*{~U]jY|byӐ:hV08G!?1p !kX|_ϙ)9G=T>4vm99!5ɭ;gbb2q=vt'XG+˗Q]D× t[F8VTZ*SUDomzTv@Te!k,j5eT(9@NᘝBXdypˁׄlS(P%Uz=rL+gQ Io0cVĞ9q垘D5_9r ?&`ۙF{`zBLd W\ICjhPrAJV'{D!F'`U4?Yva|D,zSrse!hIjٝ uG:&TVXȷMdZ跄LӗXҎa[NݴEqz[sw8m߈Xxdڐ첬=BWPE!heTy]Lt,:h&a 6fBw5Qtg'wM4HXn8z/ O.aQd Ѽɐ-[ͮ7ؠ9sIY  rj{ r(p+aЛ;!+CZG1\DvZHe[SٛcI}V%%'YWrO#sJo>M)w 01V[D^/&n CjjL zC+SDиKp<Z9\)peƌd,)̸x97NMYIC,=rexdqS@mGC]UKqt Sln27#YrKj0&_2<(z5n{ȓF0몏lÒa*̂NMtk2tqsnKLeX.s6φ'P-`ʻĕǓц,zjNݗ<,NߟT&ͷl>b-͇Cb1Џ̟f+0 5zk^u! ޛkG Y |HoC0X!&گ ߈61MBDFN`;odPA;=m"PWvyp&e9(?K¡t"5~q;+7&)M57ePJ{eMsF 73Uff啝_}d54wyꌲ3\8G:z(Q,Ric\Pef3&GЦ?ؔmUOC[/(prKK1 KgvkTFs½⺆& Y A-j Ss83ٙ&4ocsbnZj0~Vrㆰj_;O'RoŶ ]5]+;_`2ZsuS[l]4Iۇ6-bhFj :ǿ>=5`01- r/S!n1q[Pt:Hov,NA.d0(3LEoj5pSZo ,g=-? Z kFQ 66;!!63D$_KA#Y Y_ 4JPq爒8(F“Q~P_6C i\#Aˑ|_2 W%w[|RPԔQRY?k2;ADW'Ψ6䣭a# $i~vOe4 f46}A=/ϟR>\2q̪<#̹ڲ'WM9.? UunWvv}o:Ooy0C^,t|.w 'n+﬿8rGS] ێ՗Wk7M]usgo4fz9޴ŅDVhUkF+`9m<m$dk0y_ BFY5lwa"'c\ e3(dF$e'$ ѱJ"j',87UyIb+¹E|_zZ ud _nr&+ϏNWu_bK+Uf-Wﻫ h ~}{.H;8qoBpőve%r Gʑ#A Ju+lk|&p/oVxJh?޳>ZsIyNkKo+Bvۻzr :jO kcb %Ho d9d>dy 'IdЩdh`)z| Ob*ogB[GhrYM_}uuo');ܩ6sIvքް@VSR(}Vb XZ\m)֠aۅ Jwӵ~iug`,x~i в[PJH$p`<5~ۜFՙNWb4EjxY f endstream endobj 320 0 obj <> stream xڛ܀ qq9, NH|?( G3 R endstream endobj 322 0 obj <> stream x}XTT׺aӧ?ŷ R(C"#ϙ7\duhHdg[3\i 0 5qS؅DQJm;23hp_oCC#LlCv(9BwE777{ype|Sxhobal_`b7,ʋF,P Ɨ3tD,2Χ(YhK֗XƸN۲ܖ(mxɩ+8o$u)}0F\+gdtGj2߯3w”VUaa[l]OA-/dq!!m m:&4Ԩ(hf?˷1v] sv#7!˾ <$j;|LM= -bPS(l7F[T~̄sӡN!A..AgqE[ExBCB{zJ Sݹ97OгlPdTϴ~#L^kL,iT[aՒG椂s<Ȏ gRGRҳYDc:c7<@} VYV)iDlH kilDy܊*uZ7H|On?MҚYR oҏ]oH7ת*@ rȈo##V<*j)[UW[ٮ<6G[36xuZG;l7ڵq%kgLڢt_ =zЪCvyIJVF=МH&~66/dFNbjuHFu5v\V3!ipj`-nYfI&U?k0|bwM ^=u7Z_j0h;;^zbp=Bՠ`93pۑUluq|h3X+x死1+ёfwTWx ٛD[S9&i({Gix؇4mv'eDHANDlŤ ȌDx 8\*bEt>_*q.SZpE,OlR\?ҧk"'}EA5Xa&yU\0:wS9VF׵B8&H+tu~Bq;A3`SGfmIWy ${6L>GAIGX< L$n9s(0-dxL` 9bUY RJ33syklJUTfQBEivNNl[L2 ==DB+x{02 EU4m^IҌQb@/ǃD~蘢@-׆HWƒw0G)Xo!yPcEGT>궥OMSĤ< :2A1 ,T'W>}$S ^::#>;'co:o ,:,ܜvTzIFqIi Xu'BU9+ܝralht[Ki2E$up2,p:+{#ZL-0N`ELѴhkvCk`"aPdfӸh`Nr"!cCF?>`s E?)O?"6wie=[fGh{G "[.C9̖i$B~q~N,67eS/ԓ+(Z3f/KV-ɫmM > sT7)s夁,? _n8mI#G;{i \cYSumoYoǎORF3Ͽd/l#%= }Bb̨5rL$9h%#90BBig@' +Cŷ_D A&z0#ئ 3tH(r=]/Q9<ʺ;Ya`mL lKꂏވI y.³\&T 0mvSys@OW&\3no}<T0x n_|[cvLRlC0B*H /CG}20m{5 .J܁>Rȅy)IrrZ{aezWP/:u7޽d-6xW[d0 d+6*6x)|r̓u tTŅچӭ5sR?F є "H`g`ZS,!-RhЙa0}p[oxT#G endstream endobj 324 0 obj <> stream xڛ&ŀ0=@ `\02v5 endstream endobj 326 0 obj <> stream xڵXy|SնNHI)%9jDe(X2D""t6ifhZ:BҖM!'d$$ʌUr]w}Z{ߗ?KV߷kG(ppB+')ׇhSV#fynY)+ܝa8ygQoV4F F]sG><u p ]S𗿀,VUGgL>Ã'LV~%B !1 Q*we*2Q^٦N=t26bذؐddהq ajӧ1}pIPF{Z P'Mݦ!qA]?'O9!fH b`Y F MwaBAP,t: G %B(P*2YxCxH w~E0i 3E )RBD<ZDG o T:aDk #gK$*'.rkU+fK? >~?xj/#q7x[-qPP ==bkg/M\+nUOZXq\&MX{Lo|EM/du-ĸHprlnvXPm+,*rMF?:c"3AU`Gs)|RSZz&<2{QՆ"I =Pcr?-VCLQA~g6_L'|[!/m>(pElt쬁ihNgZjD^,!%עfC':Iݼ? O®I.Bv (}IobXApWzyW! vÛ NfqEKUKlON!ɜe;,E %،GQ0hU(j';\G<:QTѳ-A0(KNc0(CRtd#AEH\//ҳCUe II{<B_D_&ηUQEye{@@ޓ:K϶QHp4YLmW䝬/7l4@Bs@|Ub\fdg xGf;.L&̍(k{ :7]c )}j;@&R{ڹڅ\IL+<~9k{u7??NX''SRT7wfr b[N/S6lJv:uM*Zf fx) Uj)T3?v6W5FJNhTO0xL-Qv2βLmY]xu<-Dv.LKw߱+nnvW`/ SI,FuocЌ,Ź M`lVcګҴJnIgl\S-~`nG ]ֲr.c~f`>%>o}$th ]cf%jgQ[Kz6ENZA?rn)Ԩ,zŹL1ݰMU[LUdn_o?XZ#-P囷Ƽ<-׵t#xSW8RrvԛX!B{/ tWwύN]j 0"%J,>zW^ 4tct<;HNՃE H4`њutOtDEPNPz#+'Y/VHpO9/A(=r'Go9v%L+#"SfAYy~/KT'6WX*)Yᇷ5ى:yxmr/iM[YOڧnu=l퐶p[':ҏg%Uԗrć0mFv xð66jy.(*'5Vd% FO{ȅ QT6R9zbdGၻ"xӌB-o RٸN/|@ӬwJ7AtOwn{R`^֫"Ç5y5vl7[ȢlWPnfygJ&,M&Yv |?70 :=gJ0*xj) 7f{HF7a&IAUb80d 3|XWy s^:9BG3AP Xrb#HԩE b;d節A^x +y5{sZkI]2&p7XǼc7lasI-d/P"kC;3z*lD4JK1[g10?,Qcχ5&)+:V5s3y~-q&&"D* 管~Bڍ v#صF󩢻Bj>Bl'0 Ⱦo߶!я]}o +5+}'@/ ۞0?+memzThxh6܀TmrV|vb1j;.x:5ps'΄u{zЯs'6-cZ q#X)j#Ά7V &kwXgQ-oH<25[dfyc⏍.'{?ip!1Tُ}OA3A22[q %ڑG*$i/'Iz.yL!.Dd/˜ },g| [?;OAv>hɬ৐9TKq 73uv3{h 3|sKr˙ [FnQ(ǘ/LKNI2,9It07A`JcQY-6EW5 XvTQ=[ʊrݦ|M,8J-77!8\ë'@p B</d_ОXSO2@S@渎!{T^[´ X+v+DF[]HJ>A?W0lq0GjN!9Q|()T V`1^2?$DD?0}њh<Ŋsr[wcALΠ e2)̀2p& @H ]I'r=r6S8ѷzZ4M!qUn>~B8-{VEPdP>:wDf",. ew MA*emN/̵(,;|$8y@$H 'KȺ<І *(YW ^GpYZ endstream endobj 328 0 obj <> stream xڛ={=XoR` endstream endobj 330 0 obj <> stream xڍw\I̺쪰ʎ30'bg3YrX`̢H9$YTL(*xN^Ϸ'DztwuUuuuU}-L,<&md! a:,j7 &:Vl zR t -%ii ,} Mg~3J3ZK,Je\//֮6m\<=}'O3Qpao+gh!1[X8[= ]m Ml Wx^6N6Vr{+ ީ7]]< w{LS&/uu44:u$zrWeg\~ుl8O lxZo,9z&zVm۬gUon=K=+=^^^^^%R;g? :ZQZQ}S`E𶏸ώ>>}Q M7y\'̘4`IALv2dJSM[1fcc]Yƞƙ5W>{3"3">ViRlYˢ 2i֫Z/KjEk^A"u;!̼cd_f43Zylrq+M-㨯nuvY4 m]D}$t!۳:QQTZSxg/G%M^ɡNZ7k`]8EWzZzgʰ5㿁.= Z'A[{v(UpC_zvЦ$J^K'%*ڥf|m,F3H=;na3+3gG di+ sşFX?9s4yBgf>a 0{ C2de3p'_a:hf"\|nidFH'q[ =6LmƱ;!wĴhG9??\Z}&˖Ɛ Q 2^8dEMӟqTakvc*6NԚS_a+{v. DrC6[JK0ߠ<@Đ:LACCHʓw.~&xD"rJK'b# od#,cv8iǼ9-_";HB2; ^A+z.hxMA:$Cc" `=@^VlHd!^G0[=FU3,_g/<[> /;U(<4s2Td&W3A",5AAI9> = F2qHh>bА[& 8U[ƅ{Y0FF~. _}Qmfns4Ǫ-n^-1/CRWB:ʺ Y^oW$| ɣQ wG(v - 0?͉귫D9Cp'auzM*" NPE둋 "8pTK gT3_ڴ~&PBrJLJGy?":-ڿ F/`-'X&ȉJO `n Uwx_Oe+f׼GB|d.nݬ9}H.U؁cz1@_aZh́W<% pxa2bdFS3&Gdh-B5q7FLR*-a7f?P׃3Jbr dm2  ` g ɧh|E`A2dRS255Bn< G!?NMG`= XT2©j}l!ÀY|1h_!uR`n.Um? LGtw?+G=R}CUjғK \ƃ%@;_CjKay0w+QoO@0 ­^ ?um&ۼš'@%ނ33ѳgTymp“[0Lq<E[u:'!V$f%3.塰Giu!3hNhg'lu$7= R=(7:a7i+XFz$ys"[ynȮ9y\-hʃԃфGB$KAbyE-S\'L쟂&28Ϳ&rD| ˯MG]5pkRU'|K[0W@;EΠZlgqDwJEl/u$h_DIJڜ{rL*L = vzpP'$Ɲ4_lz5 Ȟ9wNwb+MVy2}VmW,W}l}bK3Z(Gpq"NjNr~/y =OXt',`C"8I덝W:ҋԇ1K/_.F}`8hPqdρygB+xobRiCWq\u#ij%=Jxw$V M?cRd)T#M(鄒=![ [Zz?qk[Vm(APB}4k?Q qtq'*q?LF{UCt Z;{;:Fo[龘YhVuFfȌ0?#qWv h;G W.-0Ƣ0ôxN»N 8jq x ` )tkSSeEqI+.QD[Xre>K^Ws> ,h! G(1Tf7QPwWQDu-L(JKo ]eG9mq/pK :0q6cEsOcȗ(@HۈFSsk \,B `Շٯ.A_L9 /e6]DkY*/D汔ZO (o2/\A9\EeF3ⷢ&3ܜq;qx^w6 4|Y3rPt?%ۈ^{BP9U=Sf `*ugZJ7ΎWW>FHD`$h0eJ6Ϝt+,aG io a߾X\[ 1'N<C)ɏuJ `&zVI e;``Xte5ز;3Յ~9ntKYNB[†T A ܌Hh=\-ǙU~fe0ȉvClsy)$8ӘQw7p#|IOTh'J2Tj U3Z`XiW0=tr7afj0Ȝ.$e>3=#::19u3?5!$liT}7_D(ү&/2C_l)-ld`31%u f#Z9qL;deP g9x߆{`]m)q 0g?(9tڄ}6-cJ4vrRZ< ̱u.R[O;?#749Rt6&K5Ǐ+2 Gr ɳJGRr' ("CI3ѝЏG,Z}w$&aL4oˊM)ل:bG+8c"bf>z2X_5Z ,?lQӫx#{V`_*(b>]|Q1e~D cHĠ+RwZe*-aOf_<P,X >fGq%=3IYnj B;Pp kXs= ?R3x-^'"`)u'?#jgsb'.dh,FG([sd 5l(G$d|ZGFƕ;3*329 h2k{x"6Wb\GеozBғ/a3*m$U> m .x qWZxr 9/s* @;GpBjzl^g ID*fXp`(eqA Js/7/y«]~x>!?ta"uo3weyϤ[r.u05ͨoR+nC+GÞw~' m]W0 ) ~ޮ2z[]^wլx-t{Qs"'²V$Zb:q2tv%@S w)MQM!*ԃc ƹf~?}ؒxBZlxqPv,kw;2H"^le <1":ɧN/i/]?rnw2hkE^=:Տ@KCkS;AK' hu-k\asT#gr7!2콵ˌ, `A|rEBaoSQ]Jw*JZ{S͐>S xF7JtUB+A5@YLW$NF8yy3bXeŝQC HɉPE@* CSp$Uu}J9cˁ%(W5 {lB9 m#C}zQ3~vmFk6mk6v ]h$3;؄Yu`DBkn<ݧwQ ^ S`ڵ^B=8i%] y飉+Yr{& +Q̺s:KWT6??׮0Wͭ+e};swI}܊`M#Ϝ7OW׆ȍ/")ӢA9 b\io&-\BquEx'J?|@~((/t0Ѳc -\3qZ陗ƐsM|pb$t Cȕ!q$8WnmfS)])[$6eG'ןTQQPYɤ <풾)ev! y5N5Ve*k;XE:a}_hbBz\q{sHg0}'/fFEB'adPkY&xogQDzt{-2ӭhv!ڥ#->jG凜{4^h9]u|9Јפg::J8E[8)k޸rDqfZZ~j~pS_Paj.7N ~x k.T頇!^X*Eso<{}%]!KuƆ trm׎-;}_TWٔZY{9Sk:\L :64i֎~{Gy_7|fm=S{ʱS'X|Q.gUU&6WwpLVNJ~<2o? 4 i;^su*AwaL^c^eU[kѡC$.Ŭ_ctiqm]Ac)} bǡh-U,^a[Se oogf[ć\LDL,{IY C9Gxl|Q2gos*YW'huT  aAFEur[{.U—OGN.a:Ԇq rd?((XOnb_A|f|^{sS#J=?UFՠ\u&x*juÑYsS)RI&H)̫rIO ɐK9Ia+"͓Z/{:ɨNJ[6ڱݍ'ʏeN%޲1lI g1M2pԍb~IL0 K=ܭwI ʎ:5G*UN n.ђQPi oY8 o2M0wS meo8Θ]~a'A"$>6OPJ5/a~~Oev:u4.7{ 7 á NI Rq,\*uȵGX5!sYd{)ő[0lwɫխ YL_8]dGU7t=O AN wO(X^ړ4x yU #6Mt;O% 0"0{CzSm]x MIO©T3o'n/lϮ{$hݒ _?Hpl LjE3J9$}dֳO%0c'Yy󅉅LC醑67qQҁ?( Q 6hI e3[ 6Aqؑ0f Sp_d}ae!)06Tb+8*ق,,u;qbDžr3Vyc£.iG+9Id`#k䟐/!_Ohp 0; fB0`9kB;Μ/^lXjKyK)߄2j׌Vo7ljmesU"3O ~49B閠OUڎ\䵙Aa"^W] y YQQ6Ov`5Njn3-CĶ HishE'c砢nI嘆OLlEы Jú /H헧\%86ok{ .q rrs5ay\|Ա۲e 3Պk AWP OBn$,UBhAƟX4F80܋#% _䅀~(Wj"7t"<%![Aѫ?[b>%}CT La8xTHkh:އwo63f!oKF-؜*MF ptUVh1$H%THf4PXdLنq oFlK_&`uoN nBޯQ3f,qƩ`f;5Na=qI&^@wcd-Dh&~||\nux {ڜDj_'4p:{ɛO2r0u@">Vp?Tl bM-ҔD=uZBͥLJ/դҢ Bl 9Rdp砍ѫ!* "Nd[pj3bgyC_K #Y"Qs׭@$ݙYC23IFi5KցOi꒫C118b{%9d#p4p5җ]e3D6YoqD /%6db$cSU__Po v0׮TezM&8Ro *[n/Fh(2Bb\Chu޼܀)jz7<=܀B9Eo C[_˸x? hqwâQ*¡&x)kҵnnVVE^5E:>U 6=8dDe+}4 C#swթn[·}<$2:2*2R5 pš1V€?ꫪoD)#!QP~)H_/XO5HWqf_ }ƕko2E n!r߆,#!2tO* XBn 8q%#1+mD4fDf`X& ۄLEӖn xpơ')#ؙ1įdk s_a-(-2r$vB"Y)>}נK+|vL@.JF̸ۀ &?qo5FGDQ Z)PQ^ aixK>+A"flT= mHH,6y!!r|x#sju&vz;0>a) \;\&$%sH~r C?RgxLZBp@`X V~:B:,tKUl2Iy &Uyv}fVKDXm MJ̌+`ŽP? us̸ "㣲e[f^`J7y5i7P҇Ȁj6EPOM"lD)lgT[ԲC&H@l0a"Kxݓ3]OtT:Wm"Gd[^`7i)Z;x1埝9 22J*><()/** 4_mn͑$!`ཛ0NL;|{h/(J,#8/jǸY5ڟx~ p>s-յSN86;z+=XKN2@77+額8|^y\7KmpƋº}H8 C{^_~K\aۆe _].b}j_ !˛ϡ&+٬s*Pwn/{c_۵k|Y< F)dWR5.?{Bskts=go!7>MEVFWb,lWgmey>/޾,v7NWM4+W0z^6MΆ=̄R'cqJ/>e\6.AZKd4ULy&Ϸ\qj9;yKvYmp`*’cLCr#Vr,6#{#$j'!fO-0tRK{9!\\<.U 쟊`Bmo|VA[3> stream xk`.Ƭ_xv004O080p4C.bI8BJ˛?0rP|N kN5dZրr@a)v}AI^ endstream endobj 334 0 obj <> stream x]X TfqF83.QLPQ܉OP : A|h4MEpAAn(*1E-ϫ&Μ:5U߽ujxcH5&ĭIL'g{2DOd aw !ޗ6z}NV}h? xVqYՆ뜜&4gXmX\2&K6ů;Dֳ'a$G}`|׸ސc\Vh}`LBL1;k||5%⬸ޜ5ׇSs}~ giq =n0gi9ss#Q7M䜹I MfpnlΝp7ys>/7[-8. 䂸E\0…r0n xYÂ=9yb13 R b"TqRԂPSR~6mb;] /+/iXP~Rs1Żv2^X wI~x[IGwJe9 H:):Ӥ{k/wי_rf%Dâ.6ے/c~;mD)eÇ8rxTmƍ:uGjRmq#G-8M=!e߃y;\I\X|:'XWd֪̋*KBӸ֞Qd 0cM3ƈP ZWɃfs,i.Wv{Uē]^>G4ٵr+Z5-<8=1!jYbmSީ3:/,<2^][ژy?NO#)8DbA=TlTSnt17ȣ贇89*gM-.0~FXyڤ&y$P7b(Hnx}p14yx๦|AJZ1ʉf7Njс*R xjJ]:>&5/i_1G +Vxǎ9wJK>t\|U O/^;."s/Ɗje&oW`IsBǮqog铥Ө X<-FxxAoXm42:_{?AYv:96pIܼY̡ .Fr&l)pLPBkȹwV8Rt>aHE w]4Sr'ҙZ܋_*я^ h$V j8?A;Sy9~)IM 1e;IGA5:ujk_gi 8$ -/pv[ 021xP8W@g1#SQy].$=ߛ|+eKH1c63DA9,$d˿k'8 u/~DV T>\P_$C`ÙaRݮ>CU~yu[#R׿(s5~9ݺs;j0 Uddw~[Kh! }jPy ^0-SnmN /e~\RM}UԤ|=+UKQ$.5t*1bY'G4ԕڙ 86G V6K/ov":O ,a&LX=vX&%DmYwTjʪ(IP~u;s8 Q/1>!8CPUۤ=oO˾ Ɵx4=oypW<ѼM#}%XQpq=x, j|j⢳a?hT]NYIU:Q+c-R_ѹGnj~LsTm8Cw# m{ n,ͩ;J3E&JZO/>#jG/7?CϰpƒSu t1F/䜭<$٦ت~@udHG+[܊mʔV% YɅEXf\ۼpyu":0 ?ըbD!$3l%^׼hQk-Oyb6@fF9;4-|yٓ77SfgQ[,a@xLfJ^b.P:V¹}9574C]ɒjRm/VԢyHH=gp>☁AR(:̤)!25iS=E=1Y*CNO{WtBVν?V0Ňʱӕ":3aդlKgxS*s9K.qJt%2oqc pN3k˜G ĬmHyφNfxɂ%Ū I)ۇkv%\E ৪$_8,_ ʢ В][J= G ]~.™60AY$J 05&¸ˑOBKd˧rZ iuѐ ēU:ŏTRoqwZ'=up5(|MS* 5oNnIY{#,Wf2@Ubx@4|cIGSmo՚"ROd˒`H^-loK ]bll6N'jv$FxeB]N3kd}LikOCCFѝt=)1z6"I Rr:E?$Q̜B[+Pir|)i#%MXg ɦv^*&ͬ1_Z_P@4h_+$Bcjg?2zMs%SoK^isEJjPm$YY)҄^Z+ŧֽv[[uzzkm} *h endstream endobj 335 0 obj <> stream xڛifV. endstream endobj 273 0 obj <> stream xڽZks۶~՞-N3N4niY}P,ь#y$M= Nn; AكѶRTUqeMWڄx[i;g_0,/)Ohc*m+w`SNYJ xީ΄{X>uw4Tk?y2h52L'ms{dG@rx͸Sw7gsȹ|= .r2㳳y3]u'}߼[[Y\EeRuS-3[MJy].7=&&8oJc豟 |ccw cUڮMƍK^BRBut'sMSԏb{(X*,xӧ<9>_-鹕/z0fy?cGS|(x`V|46vpwMpOk7Z܈E/g.+c뵹dbs_%LOˋJ {vꮝcgXcU>txгR?NXO*~7Z<=bj8҃$(lq|-1s=oliC3ϋ$ut:5b~m䶻fMf}m{ݬ??;Yߧ,n*nSYT+e{Ρu|:vKg75?fo'c`I˭aT^ORYe"@ S{ir!T!.9 j q4PZUڊx[3z7 KT#y&}[X' 6Ȅd B$INey.BniFh^(DJ@4 #R !BqbFE)I.:-1`v+\> -84ӪHTui1 F֬IxGuz~ !$ "5@tVz&fM]H spGVEeN@W@R.7"EPFGDO~P"(mZ% $:AIL(`ł!*JuB< p)LD'uDXˑ(ćpˊd|\X^MSHd5Ǝj"@˽%j2P_:ah#5//O棗3R&LfʨO%w%EGY2P ؝<=<40ed18392591fe0dfa5eb4ffdd9f1bb4>]/Root 1 0 R/Info 2 0 R/Size 337/W[1 3 2]/Filter/FlateDecode/Length 795>> stream x5WpMQ"h.&&HD{{O^x`xa翗|{ߜܳ1 7a;c7lS! zh1K`I RXszcO1&T)C%\9b_kO9*!b"~jz{ Ve5>h#5eWX1Rpx\ 0Rq%F<K3>,G,79YJ endstream endobj startxref 254030 %%EOF actuar/inst/doc/coverage.R0000644000176200001440000001212714522557737015215 0ustar liggesusers### R code from vignette source 'coverage.Rnw' ################################################### ### code chunk number 1: coverage.Rnw:11-12 ################################################### library(actuar) ################################################### ### code chunk number 2: coverage.Rnw:57-59 ################################################### deductible <- 5 limit <- 13 ################################################### ### code chunk number 3: coverage.Rnw:64-75 ################################################### pgammaL <- coverage(cdf = pgamma, deductible = deductible, limit = limit, per.loss = TRUE) dgammaL <- coverage(dgamma, pgamma, deductible = deductible, limit = limit, per.loss = TRUE) pgammaP <- coverage(cdf = pgamma, deductible = deductible, limit = limit) dgammaP <- coverage(dgamma, pgamma, deductible = deductible, limit = limit) d <- deductible u <- limit - d e <- 0.001 ylim <- c(0, dgammaL(0, 5, 0.6)) ################################################### ### code chunk number 4: coverage.Rnw:100-106 ################################################### par(mar = c(2, 3, 1, 1)) curve(pgammaP(x, 5, 0.6), from = 0, to = u - e, xlim = c(0, limit), ylim = c(0, 1), xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(pgammaP(x, 5, 0.6), from = u, add = TRUE, lwd = 2) axis(1, at = c(0, u), labels = c("0", "u - d")) ################################################### ### code chunk number 5: coverage.Rnw:123-129 ################################################### par(mar = c(2, 3, 1, 1)) curve(dgammaP(x, 5, 0.6), from = 0 + e, to = u - e, xlim = c(0, limit), ylim = ylim, xlab = "", ylab = "", xaxt = "n", lwd = 2) points(u, dgammaP(u, 5, 0.6), pch = 16) axis(1, at = c(0, u), labels = c("0", "u - d")) ################################################### ### code chunk number 6: coverage.Rnw:159-165 ################################################### par(mar = c(2, 3, 1, 1)) curve(pgammaL(x, 5, 0.6), from = 0, to = u - e, xlim = c(0, limit), ylim = c(0, 1), xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(pgammaL(x, 5, 0.6), from = u, add = TRUE, lwd = 2) axis(1, at = c(0, u), labels = c("0", "u - d")) ################################################### ### code chunk number 7: coverage.Rnw:180-186 ################################################### par(mar = c(2, 3, 1, 1)) curve(dgammaL(x, 5, 0.6), from = 0 + e, to = u - e, xlim = c(0, limit), ylim = ylim, xlab = "", ylab = "", xaxt = "n", lwd = 2) points(c(0, u), dgammaL(c(0, u), 5, 0.6), pch = 16) axis(1, at = c(0, u), labels = c("0", "u - d")) ################################################### ### code chunk number 8: coverage.Rnw:194-207 ################################################### pgammaL <- coverage(cdf = pgamma, deductible = deductible, limit = limit, per.loss = TRUE, franchise = TRUE) dgammaL <- coverage(dgamma, pgamma, deductible = deductible, limit = limit, per.loss = TRUE, franchise = TRUE) pgammaP <- coverage(cdf = pgamma, deductible = deductible, limit = limit, franchise = TRUE) dgammaP <- coverage(dgamma, pgamma, deductible = deductible, limit = limit, franchise = TRUE) d <- deductible u <- limit e <- 0.001 ylim <- c(0, dgammaL(0, 5, 0.6)) ################################################### ### code chunk number 9: coverage.Rnw:232-238 ################################################### par(mar = c(2, 3, 1, 1)) curve(pgammaP(x, 5, 0.6), from = 0, to = u - e, xlim = c(0, limit + d), ylim = c(0, 1), xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(pgammaP(x, 5, 0.6), from = u, add = TRUE, lwd = 2) axis(1, at = c(0, d, u), labels = c("0", "d", "u")) ################################################### ### code chunk number 10: coverage.Rnw:255-262 ################################################### par(mar = c(2, 3, 1, 1)) curve(dgammaP(x, 5, 0.6), from = d + e, to = u - e, xlim = c(0, limit + d), ylim = ylim, xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(dgammaL(x, 5, 0.6), from = 0 + e, to = d, add = TRUE, lwd = 2) points(u, dgammaP(u, 5, 0.6), pch = 16) axis(1, at = c(0, d, u), labels = c("0", "d", "u")) ################################################### ### code chunk number 11: coverage.Rnw:292-298 ################################################### par(mar = c(2, 3, 1, 1)) curve(pgammaL(x, 5, 0.6), from = 0, to = u - e, xlim = c(0, limit + d), ylim = c(0, 1), xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(pgammaL(x, 5, 0.6), from = u, add = TRUE, lwd = 2) axis(1, at = c(0, d, u), labels = c("0", "d", "u")) ################################################### ### code chunk number 12: coverage.Rnw:312-319 ################################################### par(mar = c(2, 3, 1, 1)) curve(dgammaL(x, 5, 0.6), from = d + e, to = u - e, xlim = c(0, limit + d), ylim = ylim, xlab = "", ylab = "", xaxt = "n", lwd = 2) curve(dgammaL(x, 5, 0.6), from = 0 + e, to = d, add = TRUE, lwd = 2) points(c(0, u), dgammaL(c(0, u), 5, 0.6), pch = 16) axis(1, at = c(0, d, u), labels = c("0", "d", "u")) actuar/inst/doc/risk.Rnw0000644000176200001440000007576714370340204014736 0ustar liggesusers\input{share/preamble} %\VignetteIndexEntry{Risk and ruin theory} %\VignettePackage{actuar} %\SweaveUTF8 \title{Risk and ruin theory features of \pkg{actuar}} \author{Christophe Dutang \\ Université Paris Dauphine \\[3ex] Vincent Goulet \\ Université Laval \\[3ex] Mathieu Pigeon \\ Université du Québec à Montréal} \date{} %% Additional math commands \newcommand{\VaR}{\mathrm{VaR}} \newcommand{\CTE}{\mathrm{CTE}} <>= library(actuar) options(width = 52, digits = 4) @ \begin{document} \maketitle \section{Introduction} \label{sec:introduction} Risk theory refers to a body of techniques to model and measure the risk associated with a portfolio of insurance contracts. A first approach consists in modeling the distribution of total claims over a fixed period of time using the classical collective model of risk theory. A second input of interest to the actuary is the evolution of the surplus of the insurance company over many periods of time. In \emph{ruin theory}, the main quantity of interest is the probability that the surplus becomes negative, in which case technical ruin of the insurance company occurs. The interested reader can read more on these subjects in \cite{LossModels4e,Gerber_MRT,DenuitCharpentier1,MART:2e}, among others. The current version of \pkg{actuar} \citep{actuar} contains four visible functions related to the above problems: two for the calculation of the aggregate claim amount distribution and two for ruin probability calculations. \section{The collective risk model} \label{sec:collective-risk-model} Let random variable $S$ represent the aggregate claim amount (or total amount of claims) of a portfolio of independent risks over a fixed period of time, random variable $N$ represent the number of claims (or frequency) in the portfolio over that period, and random variable $C_j$ represent the amount of claim $j$ (or severity). Then, we have the random sum \begin{equation} \label{eq:definition-S} S = C_1 + \dots + C_N, \end{equation} where we assume that $C_1, C_2, \dots$ are mutually independent and identically distributed random variables each independent of $N$. The task at hand consists in evaluating numerically the cdf of $S$, given by \begin{align} \label{eq:cdf-S} F_S(x) &= \Pr[S \leq x] \notag \\ &= \sum_{n = 0}^\infty \Pr[S \leq x|N = n] p_n \notag \\ &= \sum_{n = 0}^\infty F_C^{*n}(x) p_n, \end{align} where $F_C(x) = \Pr[C \leq x]$ is the common cdf of $C_1, \dots, C_n$, $p_n = \Pr[N = n]$ and $F_C^{*n}(x) = \Pr[C_1 + \dots + C_n \leq x]$ is the $n$-fold convolution of $F_C(\cdot)$. If $C$ is discrete on $0, 1, 2, \dots$, one has \begin{equation} \label{eq:convolution-formula} F_C^{*k}(x) = \begin{cases} I\{x \geq 0\}, & k = 0 \\ F_C(x), & k = 1 \\ \sum_{y = 0}^x F_C^{*(k - 1)}(x - y) f_C(y), & k = 2, 3, \dots, \end{cases} \end{equation} where $I\{\mathcal{A}\} = 1$ if $\mathcal{A}$ is true and $I\{\mathcal{A}\} = 0$ otherwise. \section{Discretization of claim amount distributions} \label{sec:discretization} Some numerical techniques to compute the aggregate claim amount distribution (see \autoref{sec:aggregate}) require a discrete arithmetic claim amount distribution; that is, a distribution defined on $0, h, 2h, \dots$ for some step (or span, or lag) $h$. The package provides function \code{discretize} to discretize a continuous distribution. (The function can also be used to modify the support of an already discrete distribution, but this requires additional care.) Let $F(x)$ denote the cdf of the distribution to discretize on some interval $(a, b)$ and $f_x$ denote the probability mass at $x$ in the discretized distribution. Currently, \code{discretize} supports the following four discretization methods. \begin{enumerate} \item Upper discretization, or forward difference of $F(x)$: \begin{equation} \label{eq:discretization:upper} f_x = F(x + h) - F(x) \end{equation} for $x = a, a + h, \dots, b - h$. The discretized cdf is always above the true cdf. \item Lower discretization, or backward difference of $F(x)$: \begin{equation} \label{eq:discretization:lower} f_x = \begin{cases} F(a), & x = a \\ F(x) - F(x - h), & x = a + h, \dots, b. \end{cases} \end{equation} The discretized cdf is always under the true cdf. \item Rounding of the random variable, or the midpoint method: \begin{equation} \label{eq:discretization:midpoint} f_x = \begin{cases} F(a + h/2), & x = a \\ F(x + h/2) - F(x - h/2), & x = a + h, \dots, b - h. \end{cases} \end{equation} The true cdf passes exactly midway through the steps of the discretized cdf. \item Unbiased, or local matching of the first moment method: \begin{equation} \label{eq:discretization:unbiased} f_x = \begin{cases} \dfrac{\E{X \wedge a} - \E{X \wedge a + h}}{h} + 1 - F(a), & x = a \\ \dfrac{2 \E{X \wedge x} - \E{X \wedge x - h} - \E{X \wedge x + h}}{h}, & a < x < b \\ \dfrac{\E{X \wedge b} - \E{X \wedge b - h}}{h} - 1 + F(b), & x = b. \end{cases} \end{equation} The discretized and the true distributions have the same total probability and expected value on $(a, b)$. \end{enumerate} \autoref{fig:discretization-methods} illustrates the four methods. It should be noted that although very close in this example, the rounding and unbiased methods are not identical. \begin{figure}[t] \centering <>= fu <- discretize(plnorm(x), method = "upper", from = 0, to = 5) fl <- discretize(plnorm(x), method = "lower", from = 0, to = 5) fr <- discretize(plnorm(x), method = "rounding", from = 0, to = 5) fb <- discretize(plnorm(x), method = "unbiased", from = 0, to = 5, lev = levlnorm(x)) par(mfrow = c(2, 2), mar = c(5, 2, 4, 2)) curve(plnorm(x), from = 0, to = 5, lwd = 2, main = "Upper", ylab = "F(x)") plot(stepfun(0:4, diffinv(fu)), pch = 20, add = TRUE) curve(plnorm(x), from = 0, to = 5, lwd = 2, main = "Lower", ylab = "F(x)") plot(stepfun(0:5, diffinv(fl)), pch = 20, add = TRUE) curve(plnorm(x), from = 0, to = 5, lwd = 2, main = "Rounding", ylab = "F(x)") plot(stepfun(0:4, diffinv(fr)), pch = 20, add = TRUE) curve(plnorm(x), from = 0, to = 5, lwd = 2, main = "Unbiased", ylab = "F(x)") plot(stepfun(0:5, diffinv(fb)), pch = 20, add = TRUE) ## curve(plnorm(x), from = 0, to = 5, lwd = 2, ylab = "F(x)") ## par(col = "blue") ## plot(stepfun(0:4, diffinv(fu)), pch = 19, add = TRUE) ## par(col = "red") ## plot(stepfun(0:5, diffinv(fl)), pch = 19, add = TRUE) ## par(col = "green") ## plot(stepfun(0:4, diffinv(fr)), pch = 19, add = TRUE) ## par(col = "magenta") ## plot(stepfun(0:5, diffinv(fb)), pch = 19, add = TRUE) ## legend(3, 0.3, legend = c("upper", "lower", "rounding", "unbiased"), ## col = c("blue", "red", "green", "magenta"), lty = 1, pch = 19, ## text.col = "black") @ \caption{Comparison of four discretization methods} \label{fig:discretization-methods} \end{figure} Usage of \code{discretize} is similar to R's plotting function \code{curve}. The cdf to discretize and, for the unbiased method only, the limited expected value function are passed to \code{discretize} as expressions in \code{x}. The other arguments are the upper and lower bounds of the discretization interval, the step $h$ and the discretization method. For example, upper and unbiased discretizations of a Gamma$(2, 1)$ distribution on $(0, 17)$ with a step of $0.5$ are achieved with, respectively, <>= fx <- discretize(pgamma(x, 2, 1), method = "upper", from = 0, to = 17, step = 0.5) fx <- discretize(pgamma(x, 2, 1), method = "unbiased", lev = levgamma(x, 2, 1), from = 0, to = 17, step = 0.5) @ Function \code{discretize} is written in a modular fashion making it simple to add other discretization methods if needed. \section{Calculation of the aggregate claim amount distribution} \label{sec:aggregate} Function \code{aggregateDist} serves as a unique front end for various methods to compute or approximate the cdf of the aggregate claim amount random variable $S$. Currently, five methods are supported. \begin{enumerate} \item Recursive calculation using the algorithm of \cite{Panjer_81}. This requires the severity distribution to be discrete arithmetic on $0, 1, 2, \dots, m$ for some monetary unit and the frequency distribution to be a member of either the $(a, b, 0)$ or $(a, b, 1)$ class of distributions \citep{LossModels4e}. (These classes contain the Poisson, binomial, negative binomial and logarithmic distributions and their zero-truncated and zero-modified extensions allowing for a zero or arbitrary mass at $x = 0$.) The general recursive formula is: \begin{displaymath} f_S(x) = \frac{(p_1 - (a + b)p_0)f_C(x) + \sum_{y=1}^{\min(x, m)}(a + by/x)f_C(y)f_S(x - y)}{1 - a f_C(0)}, \end{displaymath} with starting value $f_S(0) = P_N(f_C(0))$, where $P_N(\cdot)$ is the probability generating function of $N$. Probabilities are computed until their sum is arbitrarily close to 1. The recursions are done in C to dramatically increase speed. One difficulty the programmer is facing is the unknown length of the output. This was solved using a common, simple and fast technique: first allocate an arbitrary amount of memory and double this amount each time the allocated space gets full. \item Exact calculation by numerical convolutions using \eqref{eq:cdf-S} and \eqref{eq:convolution-formula}. This also requires a discrete severity distribution. However, there is no restriction on the shape of the frequency distribution. The package merely implements the sum \eqref{eq:cdf-S}, the convolutions being computed with R's function \code{convolve}, which in turn uses the Fast Fourier Transform. This approach is practical for small problems only, even on today's fast computers. \item Normal approximation of the cdf, that is \begin{equation} \label{eq:normal-approximation} F_S(x) \approx \Phi \left( \frac{x - \mu_S}{\sigma_S} \right), \end{equation} where $\mu_S = \E{S}$ and $\sigma_S^2 = \VAR{S}$. For most realistic models, this approximation is rather crude in the tails of the distribution. \item Normal Power II approximation of the cdf, that is \begin{equation} \label{eq:np2-approximation} F_S(x) \approx \Phi \left( -\frac{3}{\gamma_S} + \sqrt{\frac{9}{\gamma_S^2} + 1 + \frac{6}{\gamma_S} \frac{x - \mu_S}{\sigma_S}} \right), \end{equation} where $\gamma_S = \E{(S - \mu_S)^3}/\sigma_S^{3/2}$. The approximation is valid for $x > \mu_S$ only and performs reasonably well when $\gamma_S < 1$. See \cite{Daykin_et_al} for details. \item Simulation of a random sample from $S$ and approximation of $F_S(x)$ by the empirical cdf \begin{equation} F_n(x) = \frac{1}{n} \sum_{j = 1}^n I\{x_j \leq x\}. \end{equation} The simulation itself is done with function \code{simul} (see the \code{"simulation"} vignette). This function admits very general hierarchical models for both the frequency and the severity components. \end{enumerate} Here also, adding other methods to \code{aggregateDist} is simple due to its modular conception. The arguments of \code{aggregateDist} differ according to the chosen calculation method; see the help page for details. One interesting argument to note is \code{x.scale} to specify the monetary unit of the severity distribution. This way, one does not have to mentally do the conversion between the support of $0, 1, 2, \dots$ assumed by the recursive and convolution methods, and the true support of $S$. The recursive method fails when the expected number of claims is so large that $f_S(0)$ is numerically equal to zero. One solution proposed by \citet{LossModels4e} consists in dividing the appropriate parameter of the frequency distribution by $2^n$, with $n$ such that $f_S(0) > 0$ and the recursions can start. One then computes the aggregate claim amount distribution using the recursive method and then convolves the resulting distribution $n$ times with itself to obtain the final distribution. Function \code{aggregateDist} supports this procedure through its argument \code{convolve}. A common problem with the recursive method is failure to obtain a cumulative distribution function that reaching (close to) $1$. This is usually due to too coarse a discretization of the severity distribution. One should make sure to use a small enough discretization step and to discretize the severity distribution far in the right tail. The function \code{aggregateDist} returns an object of class \code{"aggregateDist"} inheriting from the \code{"function"} class. Thus, one can use the object as a function to compute the value of $F_S(x)$ in any $x$. For illustration purposes, consider the following model: the distribution of $S$ is a compound Poisson with parameter $\lambda = 10$ and severity distribution Gamma$(2, 1)$. To obtain an approximation of the cdf of $S$ we first discretize the gamma distribution on $(0, 22)$ with the unbiased method and a step of $0.5$, and then use the recursive method in \code{aggregateDist}: <>= fx <- discretize(pgamma(x, 2, 1), method = "unbiased", from = 0, to = 22, step = 0.5, lev = levgamma(x, 2, 1)) Fs <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx, lambda = 10, x.scale = 0.5) summary(Fs) @ Although useless here, the following is essentially equivalent, except in the far right tail for numerical reasons: <>= Fsc <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx, lambda = 5, convolve = 1, x.scale = 0.5) summary(Fsc) @ We return to object \code{Fs}. It contains an empirical cdf with support <>= knots(Fs) @ A nice graph of this function is obtained with a method of \code{plot} (see \autoref{fig:Fs}): <>= plot(Fs, do.points = FALSE, verticals = TRUE, xlim = c(0, 60)) @ \begin{figure}[t] \centering <>= plot(Fs, do.points = FALSE, verticals = TRUE, xlim = c(0, 60)) @ \caption{Graphic of the empirical cdf of $S$ obtained with the recursive method} \label{fig:Fs} \end{figure} The package defines a few summary methods to extract information from \code{"aggregateDist"} objects. First, there are methods of \code{mean} and \code{quantile} to easily compute the mean and obtain the quantiles of the approximate distribution: <>= mean(Fs) quantile(Fs) quantile(Fs, 0.999) @ Second, a method of \texttt{diff} gives easy access to the underlying probability mass function: <>= diff(Fs) @ Of course, this is defined (and makes sense) for the recursive, direct convolution and simulation methods only. Third, the package introduces the generic functions \code{VaR} and \code{CTE} (with alias \code{TVaR}) with methods for objects of class \code{"aggregateDist"}. The former computes the value-at-risk $\VaR_\alpha$ such that \begin{equation} \label{eq:VaR} \Pr[S \leq \VaR_\alpha] = \alpha, \end{equation} where $\alpha$ is the confidence level. Thus, the value-at-risk is nothing else than a quantile. As for the method of \code{CTE}, it computes the conditional tail expectation (also called Tail Value-at-Risk) \begin{equation} \label{eq:CTE} \CTE_\alpha = \E{S|S > \VaR_\alpha}. \end{equation} Here are examples using object \code{Fs} obtained above: <>= VaR(Fs) CTE(Fs) @ To conclude on the subject, \autoref{fig:Fs-comparison} shows the cdf of $S$ using five of the many combinations of discretization and calculation method supported by \pkg{actuar}. \begin{figure}[t] \centering <>= fx.u <- discretize(pgamma(x, 2, 1), from = 0, to = 22, step = 0.5, method = "upper") Fs.u <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx.u, lambda = 10, x.scale = 0.5) fx.l <- discretize(pgamma(x, 2, 1), from = 0, to = 22, step = 0.5, method = "lower") Fs.l <- aggregateDist("recursive", model.freq = "poisson", model.sev = fx.l, lambda = 10, x.scale = 0.5) Fs.n <- aggregateDist("normal", moments = c(20, 60)) Fs.s <- aggregateDist("simulation", model.freq = expression(y = rpois(10)), model.sev = expression(y = rgamma(2, 1)), nb.simul = 10000) par(col = "black") plot(Fs, do.points = FALSE, verticals = TRUE, xlim = c(0, 60), sub = "") par(col = "blue") plot(Fs.u, do.points = FALSE, verticals = TRUE, add = TRUE, sub = "") par(col = "red") plot(Fs.l, do.points = FALSE, verticals = TRUE, add = TRUE, sub = "") par(col = "green") plot(Fs.s, do.points = FALSE, verticals = TRUE, add = TRUE, sub = "") par(col = "magenta") plot(Fs.n, add = TRUE, sub = "") legend(30, 0.4, c("recursive + unbiased", "recursive + upper", "recursive + lower", "simulation", "normal approximation"), col = c("black", "blue", "red", "green", "magenta"), lty = 1, text.col = "black") @ \caption{Comparison between the empirical or approximate cdf of $S$ obtained with five different methods} \label{fig:Fs-comparison} \end{figure} \section{The continuous time ruin model} \label{sec:ruin-model} We now turn to the multi-period ruin problem. Let $U(t)$ denote the surplus of an insurance company at time $t$, $c(t)$ denote premiums collected through time $t$, and $S(t)$ denote aggregate claims paid through time $t$. If $u$ is the initial surplus at time $t = 0$, then a mathematically convenient definition of $U(t)$ is \begin{equation} \label{eq:definition-surplus} U(t) = u + c(t) - S(t). \end{equation} As mentioned previously, technical ruin of the insurance company occurs when the surplus becomes negative. Therefore, the definition of the infinite time probability of ruin is \begin{equation} \label{eq:definition-ruin} \psi(u) = \Pr[U(t) < 0 \text{ for some } t \geq 0]. \end{equation} We define some other quantities needed in the sequel. Let $N(t)$ denote the number of claims up to time $t \geq 0$ and $C_j$ denote the amount of claim $j$. Then the definition of $S(t)$ is analogous to \eqref{eq:definition-S}: \begin{equation} \label{eq:definition-S(t)} S(t) = C_1 + \dots + C_{N(t)}, \end{equation} assuming $N(0) = 0$ and $S(t) = 0$ as long as $N(t) = 0$. Furthermore, let $T_j$ denote the time when claim $j$ occurs, such that $T_1 < T_2 < T_3 < \dots$ Then the random variable of the interarrival (or wait) time between claim $j - 1$ and claim $j$ is defined as $W_1 = T_1$ and \begin{equation} \label{eq:definition-wait} W_j = T_j - T_{j - 1}, \quad j \geq 2. \end{equation} For the rest of this discussion, we make the following assumptions: \begin{enumerate} \item premiums are collected at a constant rate $c$, hence $c(t) = ct$; \item the sequence $\{T_j\}_{j \geq 1}$ forms an ordinary renewal process, with the consequence that random variables $W_1, W_2, \dots$ are independent and identically distributed; \item claim amounts $C_1, C_2, \dots$ are independent and identically distributed. \end{enumerate} \section{Adjustment coefficient} \label{sec:adjustment-coefficient} The quantity known as the adjustment coefficient $\rho$ hardly has any physical interpretation, but it is useful as an approximation to the probability of ruin since we have the inequality \begin{displaymath} \psi(u) \leq e^{-\rho u}, \quad u \geq 0. \end{displaymath} The adjustment coefficient is defined as the smallest strictly positive solution (if it exists) of the Lundberg equation \begin{equation} \label{eq:definition-adjcoef} h(t) = \E{e^{t C - t c W}} = 1, \end{equation} where the premium rate $c$ satisfies the positive safety loading constraint $\E{C - cW} < 0$. If $C$ and $W$ are independent, as in the most common models, then the equation can be rewritten as \begin{equation} \label{eq:definition-adjcoef-ind} h(t) = M_C(t) M_W(-tc) = 1. \end{equation} Function \code{adjCoef} of \pkg{actuar} computes the adjustment coefficient $\rho$ from the following arguments: either the two moment generating functions $M_C(t)$ and $M_W(t)$ (thereby assuming independence) or else function $h(t)$; the premium rate $c$; the upper bound of the support of $M_C(t)$ or any other upper bound for $\rho$. For example, if $W$ and $C$ are independent and each follow an exponential distribution, $W$ with parameter $2$ and $C$ with parameter $1$, and the premium rate is $c = 2.4$ (for a safety loading of 20\% using the expected value premium principle), then the adjustment coefficient is <>= adjCoef(mgf.claim = mgfexp(x), mgf.wait = mgfexp(x, 2), premium.rate = 2.4, upper = 1) @ The function also supports models with proportional or excess-of-loss reinsurance \citep{Centeno_02}. Under the first type of treaty, an insurer pays a proportion $\alpha$ of every loss and the rest is paid by the reinsurer. Then, for fixed $\alpha$ the adjustment coefficient is the solution of \begin{equation} \label{eq:definition-adjcoef-prop} h(t) = \E{e^{t \alpha C - t c(\alpha) W}} = 1. \end{equation} Under an excess-of-loss treaty, the primary insurer pays each claim up to a limit $L$. Again, for fixed $L$, the adjustment coefficient is the solution of \begin{equation} \label{eq:definition-adjcoef-xl} h(t) = \E{e^{t \min(C, L) - t c(L) W}} = 1. \end{equation} For models with reinsurance, \code{adjCoef} returns an object of class \code{"adjCoef"} inheriting from the \code{"function"} class. One can then use the object to compute the adjustment coefficient for any retention rate $\alpha$ or retention limit $L$. The package also defines a method of \code{plot} for these objects. For example, using the same assumptions as above with proportional reinsurance and a 30\% safety loading for the reinsurer, the adjustment coefficient as a function of $\alpha \in [0, 1]$ is (see \autoref{fig:adjcoef} for the graph): <>= mgfx <- function(x, y) mgfexp(x * y) p <- function(x) 2.6 * x - 0.2 rho <- adjCoef(mgfx, mgfexp(x, 2), premium = p, upper = 1, reins = "prop", from = 0, to = 1) rho(c(0.75, 0.8, 0.9, 1)) plot(rho) @ \begin{figure}[t] \centering <>= plot(rho) @ \caption{Adjustment coefficient as a function of the retention rate} \label{fig:adjcoef} \end{figure} \section{Probability of ruin} \label{sec:ruin} In this subsection, we always assume that interarrival times and claim amounts are independent. The main difficulty with the calculation of the infinite time probability of ruin lies in the lack of explicit formulas except for the most simple models. If interarrival times are Exponential$(\lambda)$ distributed (Poisson claim number process) and claim amounts are Exponential$(\beta)$ distributed, then \begin{equation} \label{eq:ruin-cramer-lundberg} \psi(u) = \frac{\lambda}{c \beta}\, e^{-(\beta - \lambda/c) u}. \end{equation} If the frequency assumption of this model is defensible, the severity assumption can hardly be used beyond illustration purposes. Fortunately, phase-type distributions have come to the rescue since the early 1990s. \cite{AsmussenRolski_91} first show that in the classical Cramér--Lundberg model where interarrival times are Exponential$(\lambda)$ distributed, if claim amounts are Phase-type$(\mat{\pi}, \mat{T})$ distributed, then $\psi(u) = 1 - F(u)$, where $F$ is Phase-type$(\mat{\pi}_+, \mat{Q})$ with \begin{equation} \label{eq:prob-ruin:cramer-lundberg} \begin{split} \mat{\pi}_+ &= - \frac{\lambda}{c}\, \mat{\pi} \mat{T}^{-1} \\ \mat{Q} &= \mat{T} + \mat{t} \mat{\pi}_+, \end{split} \end{equation} and $\mat{t} = -\mat{T} \mat{e}$, $\mat{e}$ is a column vector with all components equal to 1; see the \code{"lossdist"} vignette for details. In the more general Sparre~Andersen model where interarrival times can have any Phase-type$(\mat{\nu}, \mat{S})$ distribution, \cite{AsmussenRolski_91} also show that using the same claim severity assumption as above, one still has $\psi(u) = 1 - F(u)$ where $F$ is Phase-type$(\mat{\pi}_+, \mat{Q})$, but with parameters \begin{equation} \label{eq:prob-ruin:sparre:pi+} \mat{\pi}_+ = \frac{\mat{e}^\prime (\mat{Q} - \mat{T})}{% c \mat{e}^\prime \mat{t}} \end{equation} and $\mat{Q}$ solution of \begin{equation} \label{eq:eq:prob-ruin:sparre:Q} \begin{split} \mat{Q} &= \Psi(\mat{Q}) \\ &= \mat{T} - \mat{t} \mat{\pi} \left[ (\mat{I}_n \otimes \mat{\nu}) (\mat{Q} \oplus \mat{S})^{-1} (\mat{I}_n \otimes \mat{s}) \right]. \end{split} \end{equation} In the above, $\mat{s} = -\mat{S} \mat{e}$, $\mat{I}_n$ is the $n \times n$ identity matrix, $\otimes$ denotes the usual Kronecker product between two matrices and $\oplus$ is the Kronecker sum defined as \begin{equation} \label{eq:kronecker-sum} \mat{A}_{m \times m} \oplus \mat{B}_{n \times n} = \mat{A} \otimes \mat{I}_n + \mat{B} \otimes \mat{I}_m. \end{equation} Function \code{ruin} of \pkg{actuar} returns a function object of class \code{"ruin"} to compute the probability of ruin for any initial surplus $u$. In all cases except the exponential/exponential model where \eqref{eq:ruin-cramer-lundberg} is used, the output object calls function \code{pphtype} to compute the ruin probabilities. Some thought went into the interface of \code{ruin}. Obviously, all models can be specified using phase-type distributions, but the authors wanted users to have easy access to the most common models involving exponential and Erlang distributions. Hence, one first states the claim amount and interarrival times models with any combination of \code{"exponential"}, \code{"Erlang"} and \code{"phase-type"}. Then, one passes the parameters of each model using lists with components named after the corresponding parameters of \code{dexp}, \code{dgamma} and \code{dphtype}. If a component \code{"weights"} is found in a list, the model is a mixture of exponential or Erlang (mixtures of phase-type are not supported). Every component of the parameter lists is recycled as needed. The following examples should make the matter clearer. (All examples use $c = 1$, the default value in \code{ruin}.) First, for the exponential/exponential model, one has <>= psi <- ruin(claims = "e", par.claims = list(rate = 5), wait = "e", par.wait = list(rate = 3)) psi psi(0:10) @ Second, for a mixture of two exponentials claim amount model and exponential interarrival times, the simplest call to \code{ruin} is <>= op <- options(width=50) @ <>= ruin(claims = "e", par.claims = list(rate = c(3, 7), weights = 0.5), wait = "e", par.wait = list(rate = 3)) @ Finally, one will obtain a function to compute ruin probabilities in a model with phase-type claim amounts and mixture of exponentials interarrival times with <>= prob <- c(0.5614, 0.4386) rates <- matrix(c(-8.64, 0.101, 1.997, -1.095), 2, 2) ruin(claims = "p", par.claims = list(prob = prob, rates = rates), wait = "e", par.wait = list(rate = c(5, 1), weights = c(0.4, 0.6))) @ To ease plotting of the probability of ruin function, the package provides a method of \code{plot} for objects returned by \code{ruin} that is a simple wrapper for \code{curve} (see \autoref{fig:prob-ruin}): <>= psi <- ruin(claims = "p", par.claims = list(prob = prob, rates = rates), wait = "e", par.wait = list(rate = c(5, 1), weights = c(0.4, 0.6))) plot(psi, from = 0, to = 50) @ <>= options(op) @ \begin{figure}[t] \centering <>= plot(psi, from = 0, to = 50) @ \caption{Graphic of the probability of ruin as a function of the initial surplus $u$} \label{fig:prob-ruin} \end{figure} \section{Approximation to the probability of ruin} \label{sec:beekman} When the model for the aggregate claim process \eqref{eq:definition-S(t)} does not fit nicely into the framework of the previous section, one can compute ruin probabilities using the so-called Beekman's convolution formula \citep{Beekman_68,BeekmanFormula_EAS}. Let the surplus process and the aggregate claim amount process be defined as in \eqref{eq:definition-surplus} and \eqref{eq:definition-S(t)}, respectively, and let $\{N(t)\}$ be a Poisson process with mean $\lambda$. As before, claim amounts $C_1, C_2, \dots$ are independent and identically distributed with cdf $P(\cdot)$ and mean $\mu = \E{C_1}$. Then the infinite time probability of ruin is given by \begin{equation} \label{eq:beekman:prob-ruin} \psi(u) = 1 - F(u), \end{equation} where $F(\cdot)$ is Compound~Geometric$(p, H)$ with \begin{equation} \label{eq:beekman:p} p = 1 - \frac{\lambda \mu}{c} \end{equation} and \begin{equation} \label{eq:beekman:H} H(x) = \int_0^x \frac{1 - P(y)}{\mu}\, dy. \end{equation} In other words, we have (compare with \eqref{eq:cdf-S}): \begin{equation} \label{eq:beekman:prob-ruin-long} \psi(u) = 1 - \sum_{n = 0}^\infty H^{*n}(u) p (1 - p)^n. \end{equation} In most practical situations, numerical evaluation of \eqref{eq:beekman:prob-ruin-long} is done using Panjer's recursive formula. This usually requires discretization of $H(\cdot)$. In such circumstances, Beekman's formula yields approximate ruin probabilities. For example, let claim amounts have a Pareto$(5, 4)$ distribution, that is \begin{displaymath} P(x) = 1 - \left( \frac{4}{4 + x} \right)^5 \end{displaymath} and $\mu = 1$. Then \begin{align*} H(x) &= \int_0^x \left( \frac{4}{4 + y} \right)^5 dy \\ &= 1 - \left( \frac{4}{4 + x} \right)^4, \end{align*} or else $H$ is Pareto$(4, 4)$. Furthermore, we determine the premium rate $c$ with the expected value premium principle and a safety loading of 20\%, that is $c = 1.2 \lambda \mu$. Thus, $p = 0.2/1.2 = 1/6$. One can get functions to compute lower bounds and upper bounds for $F(u)$ with functions \code{discretize} and \code{aggregateDist} as follows: <>= f.L <- discretize(ppareto(x, 4, 4), from = 0, to = 200, step = 1, method = "lower") f.U <- discretize(ppareto(x, 4, 4), from = 0, to = 200, step = 1, method = "upper") F.L <- aggregateDist(method = "recursive", model.freq = "geometric", model.sev = f.L, prob = 1/6) F.U <- aggregateDist(method = "recursive", model.freq = "geometric", model.sev = f.U, prob = 1/6) @ Corresponding functions for the probability of ruin $\psi(u)$ lower and upper bounds are (see \autoref{fig:beekman:prob-ruin} for the graphic): <>= psi.L <- function(u) 1 - F.U(u) psi.U <- function(u) 1 - F.L(u) u <- seq(0, 50, by = 5) cbind(lower = psi.L(u), upper = psi.U(u)) curve(psi.L, from = 0, to = 100, col = "blue") curve(psi.U, add = TRUE, col = "green") @ \begin{figure}[t] \centering <>= curve(psi.L, from = 0, to = 100, col = "blue") curve(psi.U, add = TRUE, col = "green") @ \caption{Lower and upper bounds for the probability of ruin as determined using Beekman's convolution formula.} \label{fig:beekman:prob-ruin} \end{figure} One can make the bounds as close as one wishes by reducing the discretization step. \bibliography{actuar} \end{document} %%% Local Variables: %%% mode: noweb %%% TeX-master: t %%% coding: utf-8 %%% End: actuar/inst/include/0000755000176200001440000000000014522560035014133 5ustar liggesusersactuar/inst/include/actuarAPI.h0000644000176200001440000004314514264305077016132 0ustar liggesusers/* actuar: Actuarial Functions and Heavy Tailed Distributions * * Support for exported functions at the C level. * * This is derived from code in package zoo. * * Copyright (C) 2020 Vincent Goulet * Copyright (C) 2010 Jeffrey A. Ryan jeff.a.ryan @ gmail.com * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License as * published by the Free Software Foundation; either version 3 of the * License, or (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA * 02110-1301, USA. * * AUTHOR: Vincent Goulet */ #include #include #include #ifdef __cplusplus extern "C" { #endif /* Special integrals */ double betaint(double x, double a, double b, int foo); double betaint_raw(double x, double a, double b, double x1m); /* One parameter distributions */ double mexp(double order, double scale, int give_log); double levexp(double limit, double scale, double order, int give_log); double mgfexp(double t, double scale, int give_log); double dinvexp(double x, double scale, int give_log); double pinvexp(double q, double scale, int lower_tail, int log_p); double qinvexp(double p, double scale, int lower_tail, int log_p); double rinvexp(double scale); double minvexp(double order, double scale, int give_log); double levinvexp(double limit, double scale, double order, int give_log); double dlogarithmic(double x, double p, int give_log); double plogarithmic(double x, double p, int lower_tail, int log_p); double qlogarithmic(double x, double p, int lower_tail, int log_p); double rlogarithmic(double p); double dztpois(double x, double lambda, int give_log); double pztpois(double q, double lambda, int lower_tail, int log_p); double qztpois(double p, double lambda, int lower_tail, int log_p); double rztpois(double lambda); double dztgeom(double x, double prob, int give_log); double pztgeom(double q, double prob, int lower_tail, int log_p); double qztgeom(double p, double prob, int lower_tail, int log_p); double rztgeom(double prob); /* Two parameter distributions */ double munif(double order, double min, double max, int give_log); double levunif(double limit, double min, double max, double order, int give_log); double mgfunif(double t, double min, double max, int give_log); double mnorm(double order, double mean, double sd, int give_log); double mgfnorm(double t, double mean, double sd, int give_log); double mbeta(double order, double shape1, double shape2, int give_log); double levbeta(double limit, double shape1, double shape2, double order, int give_log); double mgamma(double order, double shape, double scale, int give_log); double levgamma(double limit, double shape, double scale, double order, int give_log); double mgfgamma(double t, double shape, double scale, int give_log); double mchisq(double order, double df, double ncp, int give_log); double levchisq(double limit, double df, double ncp, double order, int give_log); double mgfchisq(double t, double df, double ncp, int give_log); double dinvgamma(double x, double scale, double shape, int give_log); double pinvgamma(double q, double scale, double shape, int lower_tail, int log_p); double qinvgamma(double p, double scale, double shape, int lower_tail, int log_p); double rinvgamma(double scale, double shape); double minvgamma(double order, double scale, double shape, int give_log); double levinvgamma(double limit, double scale, double shape, double order, int give_log); double mgfinvgamma(double t, double shape, double scale, int give_log); double dinvparalogis(double x, double shape, double scale, int give_log); double pinvparalogis(double q, double shape, double scale, int lower_tail, int log_p); double qinvparalogis(double p, double shape, double scale, int lower_tail, int log_p); double rinvparalogis(double shape, double scale); double minvparalogis(double order, double shape, double scale, int give_log); double levinvparalogis(double limit, double shape, double scale, double order, int give_log); double dinvpareto(double x, double shape, double scale, int give_log); double pinvpareto(double q, double shape, double scale, int lower_tail, int log_p); double qinvpareto(double p, double shape, double scale, int lower_tail, int log_p); double rinvpareto(double shape, double scale); double minvpareto(double order, double shape, double scale, int give_log); double levinvpareto(double limit, double shape, double scale, double order, int log_p); double dinvweibull(double x, double scale, double shape, int give_log); double pinvweibull(double q, double scale, double shape, int lower_tail, int log_p); double qinvweibull(double p, double scale, double shape, int lower_tail, int log_p); double rinvweibull(double scale, double shape); double minvweibull(double order, double scale, double shape, int give_log); double levinvweibull(double limit, double scale, double shape, double order, int give_log); double dlgamma(double x, double shapelog, double ratelog, int give_log); double plgamma(double q, double shapelog, double ratelog, int lower_tail, int log_p); double qlgamma(double p, double shapelog, double ratelog, int lower_tail, int log_p); double rlgamma(double ratelog, double shapelog); double mlgamma(double order, double shapelog, double ratelog, int give_log); double levlgamma(double limit, double shapelog, double ratelog, double order, int give_log); double dllogis(double x, double shape, double scale, int give_log); double pllogis(double q, double shape, double scale, int lower_tail, int log_p); double qllogis(double p, double shape, double scale, int lower_tail, int log_p); double rllogis(double shape, double scale); double mllogis(double order, double shape, double scale, int give_log); double levllogis(double limit, double shape, double scale, double order, int give_log); double mlnorm(double order, double logmean, double logsd, int give_log); double levlnorm(double limit, double logmean, double logsd, double order, int give_log); double dparalogis(double x, double shape, double scale, int give_log); double pparalogis(double q, double shape, double scale, int lower_tail, int log_p); double qparalogis(double p, double shape, double scale, int lower_tail, int log_p); double rparalogis(double shape, double scale); double mparalogis(double order, double shape, double scale, int give_log); double levparalogis(double limit, double shape, double scale, double order, int give_log); double dpareto(double x, double shape, double scale, int give_log); double ppareto(double q, double shape, double scale, int lower_tail, int log_p); double qpareto(double p, double shape, double scale, int lower_tail, int log_p); double rpareto(double shape, double scale); double mpareto(double order, double shape, double scale, int give_log); double levpareto(double limit, double shape, double scale, double order, int give_log); double dpareto1(double x, double shape, double scale, int give_log); double ppareto1(double q, double shape, double scale, int lower_tail, int log_p); double qpareto1(double p, double shape, double scale, int lower_tail, int log_p); double rpareto1(double shape, double scale); double mpareto1(double order, double shape, double scale, int give_log); double levpareto1(double limit, double shape, double scale, double order, int give_log); double mweibull(double order, double scale, double shape, int give_log); double levweibull(double limit, double scale, double shape, double order, int give_log); double dgumbel(double x, double alpha, double beta, int give_log); double pgumbel(double q, double alpha, double beta, int lower_tail, int log_p); double qgumbel(double p, double alpha, double beta, int lower_tail, int log_p); double rgumbel(double alpha, double beta); double mgumbel(double order, double alpha, double beta, int give_log); double mgfgumbel(double t, double alpha, double beta, int give_log); double dinvgauss(double x, double mu, double phi, int give_log); double pinvgauss(double q, double mu, double phi, int lower_tail, int log_p); double qinvgauss(double q, double mu, double phi, int lower_tail, int log_p, double tol, int maxit, int echo); double rinvgauss(double mu, double phi); double minvgauss(double order, double mean, double phi, int give_log); double levinvgauss(double limit, double mean, double phi, double order, int give_log); double mgfinvgauss(double t, double mean, double phi, int give_log); double dztnbinom(double x, double size, double prob, int give_log); double pztnbinom(double q, double size, double prob, int lower_tail, int log_p); double qztnbinom(double p, double size, double prob, int lower_tail, int log_p); double rztnbinom(double size, double prob); double dztbinom(double x, double size, double prob, int give_log); double pztbinom(double q, double size, double prob, int lower_tail, int log_p); double qztbinom(double p, double size, double prob, int lower_tail, int log_p); double rztbinom(double size, double prob); double dzmlogarithmic(double x, double p, double p0m, int give_log); double pzmlogarithmic(double x, double p, double p0m, int lower_tail, int log_p); double qzmlogarithmic(double x, double p, double p0m, int lower_tail, int log_p); double rzmlogarithmic(double p, double p0m); double dzmpois(double x, double lambda, double p0m, int give_log); double pzmpois(double q, double lambda, double p0m, int lower_tail, int log_p); double qzmpois(double p, double lambda, double p0m, int lower_tail, int log_p); double rzmpois(double lambda, double p0m); double dzmgeom(double x, double prob, double p0m, int give_log); double pzmgeom(double q, double prob, double p0m, int lower_tail, int log_p); double qzmgeom(double p, double prob, double p0m, int lower_tail, int log_p); double rzmgeom(double prob, double p0m); double dpoisinvgauss(double x, double mu, double phi, int give_log); double ppoisinvgauss(double q, double mu, double phi, int lower_tail, int log_p); double qpoisinvgauss(double p, double mu, double phi, int lower_tail, int log_p); double rpoisinvgauss(double mu, double phi); /* Three parameter distributions */ double dburr(double x, double shape1, double shape2, double scale, int give_log); double pburr(double q, double shape1, double shape2, double scale, int lower_tail, int log_p); double qburr(double p, double shape1, double shape2, double scale, int lower_tail, int log_p); double rburr(double shape1, double shape2, double scale); double mburr(double order, double shape1, double shape2, double scale, int give_log); double levburr(double limit, double shape1, double shape2, double scale, double order, int give_log); double dgenpareto(double x, double shape1, double shape2, double scale, int give_log); double pgenpareto(double q, double shape1, double shape2, double scale, int lower_tail, int log_p); double qgenpareto(double p, double shape1, double shape2, double scale, int lower_tail, int log_p); double rgenpareto(double shape1, double shape2, double scale); double mgenpareto(double order, double shape1, double shape2, double scale, int give_log); double levgenpareto(double limit, double shape1, double shape2, double scale, double order, int give_log); double dinvburr(double x, double shape1, double shape2, double scale, int give_log); double pinvburr(double q, double shape1, double shape2, double scale, int lower_tail, int log_p); double qinvburr(double p, double shape1, double shape2, double scale, int lower_tail, int log_p); double rinvburr(double shape1, double shape2, double scale); double minvburr(double order, double shape1, double shape2, double scale, int give_log); double levinvburr(double limit, double shape1, double shape2, double scale, double order, int give_log); double dinvtrgamma(double x, double shape1, double shape2, double scale, int give_log); double pinvtrgamma(double q, double shape1, double shape2, double scale, int lower_tail, int log_p); double qinvtrgamma(double p, double shape1, double shape2, double scale, int lower_tail, int log_p); double rinvtrgamma(double shape1, double shape2, double scale); double minvtrgamma(double order, double shape1, double shape2, double scale, int give_log); double levinvtrgamma(double limit, double shape1, double shape2, double scale, double order, int give_log); double dtrgamma(double x, double shape1, double shape2, double scale, int give_log); double ptrgamma(double q, double shape1, double shape2, double scale, int lower_tail, int log_p); double qtrgamma(double p, double shape1, double shape2, double scale, int lower_tail, int log_p); double rtrgamma(double shape1, double shape2, double scale); double mtrgamma(double order, double shape1, double shape2, double scale, int give_log); double levtrgamma(double limit, double shape1, double shape2, double scale, double order, int give_log); double dpareto2(double x, double min, double shape, double scale, int give_log); double ppareto2(double q, double min, double shape, double scale, int lower_tail, int log_p); double qpareto2(double p, double min, double shape, double scale, int lower_tail, int log_p); double rpareto2(double min, double shape, double scale); double mpareto2(double order, double min, double shape, double scale, int give_log); double levpareto2(double limit, double min, double shape, double scale, double order, int give_log); double dpareto3(double x, double min, double shape, double scale, int give_log); double ppareto3(double q, double min, double shape, double scale, int lower_tail, int log_p); double qpareto3(double p, double min, double shape, double scale, int lower_tail, int log_p); double rpareto3(double min, double shape, double scale); double mpareto3(double order, double min, double shape, double scale, int give_log); double levpareto3(double limit, double min, double shape, double scale, double order, int give_log); double dzmnbinom(double x, double size, double prob, double p0m, int give_log); double pzmnbinom(double q, double size, double prob, double p0m, int lower_tail, int log_p); double qzmnbinom(double p, double size, double prob, double p0m, int lower_tail, int log_p); double rzmnbinom(double size, double prob, double p0m); double dzmbinom(double x, double size, double prob, double p0m, int give_log); double pzmbinom(double q, double size, double prob, double p0m, int lower_tail, int log_p); double qzmbinom(double p, double size, double prob, double p0m, int lower_tail, int log_p); double rzmbinom(double size, double prob, double p0m); /* Four parameter distributions */ double dgenbeta(double x, double shape1, double shape2, double shape3, double scale, int give_log); double pgenbeta(double q, double shape1, double shape2, double shape3, double scale, int lower_tail, int log_p); double qgenbeta(double p, double shape1, double shape2, double shape3, double scale, int lower_tail, int log_p); double rgenbeta(double shape1, double shape2, double shape3, double scale); double mgenbeta(double order, double shape1, double shape2, double shape3, double scale, int give_log); double levgenbeta(double limit, double shape1, double shape2, double shape3, double scale, double order, int give_log); double dtrbeta(double x, double shape1, double shape2, double shape3, double scale, int give_log); double ptrbeta(double q, double shape1, double shape2, double shape3, double scale, int lower_tail, int log_p); double qtrbeta(double p, double shape1, double shape2, double shape3, double scale, int lower_tail, int log_p); double rtrbeta(double shape1, double shape2, double shape3, double scale); double mtrbeta(double order, double shape1, double shape2, double shape3, double scale, int give_log); double levtrbeta(double limit, double shape1, double shape2, double shape3, double scale, double order, int give_log); double dpareto4(double x, double min, double shape1, double shape2, double scale, int give_log); double ppareto4(double q, double min, double shape1, double shape2, double scale, int lower_tail, int log_p); double qpareto4(double p, double min, double shape1, double shape2, double scale, int lower_tail, int log_p); double rpareto4(double min, double shape1, double shape2, double scale); double mpareto4(double order, double min, double shape1, double shape2, double scale, int give_log); double levpareto4(double limit, double min, double shape1, double shape2, double scale, double order, int give_log); /* Five parameter distributions */ double dfpareto(double x, double min, double shape1, double shape2, double shape3, double scale, int give_log); double pfpareto(double q, double min, double shape1, double shape2, double shape3, double scale, int lower_tail, int log_p); double qfpareto(double p, double min, double shape1, double shape2, double shape3, double scale, int lower_tail, int log_p); double rfpareto(double min, double shape1, double shape2, double shape3, double scale); double mfpareto(double order, double min, double shape1, double shape2, double shape3, double scale, int give_log); double levfpareto(double limit, double mu, double shape1, double shape2, double shape3, double scale, double order, int give_log); /* Phase-type distributions */ double dphtype(double x, double *pi, double *T, int m, int give_log); double pphtype(double x, double *pi, double *T, int m, int lower_tail, int log_p); double rphtype(double *pi, double **Q, double *rates, int m); double mphtype(double order, double *pi, double *T, int m, int give_log); double mgfphtype(double x, double *pi, double *T, int m, int give_log); #ifdef __cplusplus } #endif actuar/inst/CITATION0000644000176200001440000000205714370342110013642 0ustar liggesusersp1 <- person("Christophe", "Dutang", email = "dutang@ceremade.dauphine.fr") p2 <- person("Vincent", "Goulet", email = "vincent.goulet@act.ulaval.ca") p3 <- person("Nicholas", "Langevin") p4 <- person("Mathieu", "Pigeon", email = "pigeon.mathieu.2@uqam.ca") bibentry(bibtype = "Article", title = "actuar: An {R} Package for Actuarial Science", author = c(p1, p2, p4), journal = "Journal of Statistical Software", year = "2008", volume = "25", number = "7", pages = "1--37", doi = "10.18637/jss.v025.i07", header = "To cite actuar in publications use:") bibentry(bibtype = "Article", title = "{F}eller-{P}areto and Related Distributions: Numerical Implementation and Actuarial Applications", author = c(p1, p2, p3), journal = "Journal of Statistical Software", year = "2022", volume = "103", number = "6", pages = "1--22", doi = "10.18637/jss.v103.i06", header = "For the implementation of the Feller-Pareto family of distributions, use:") actuar/inst/NEWS.0.Rd0000644000176200001440000004646214264305077013733 0ustar liggesusers\name{NEWS} \title{actuar News} \encoding{UTF-8} \section{LATER NEWS}{ This file covers NEWS for the 0.x series. News for \pkg{actuar} 1.0-0 and later can be found in file \file{NEWS.1.Rd}. } \section{CHANGES IN VERSION 0.9-7}{ \subsection{NEW FEATURES}{ \itemize{ \item \code{plot} method for function objects returned by \code{ruin()}. } } \subsection{BUG FIXES}{ \itemize{ \item Calculation of the Bühlmann-Gisler and Ohlsson estimators was incorrect for hierarchical models with more than one level. \item Better display of first column for grouped data objects. \item Miscellaneous corrections to the vignettes. } } } \section{CHANGES IN VERSION 0.9-6}{ \itemize{ \item Accented letters in comments removed to avoid compilation problems under MacOS X on CRAN (see thread starting at \url{https://stat.ethz.ch/pipermail/r-devel/2008-February/048391.html}). } } \section{CHANGES IN VERSION 0.9-5}{ \subsection{NEW FEATURES}{ \itemize{ \item New \code{simulation} vignette on usage of function \code{simul()}. Most of the material was previously in the \code{credibility} vignette. \item Examples of \code{ruin()} and \code{adjCoef()} added to the \code{risk} demo. } } \subsection{USER-VISIBLE CHANGES}{ \itemize{ \item Following some negative comments on a function name VG had been using for years, function \code{simpf()} is renamed to \code{simul()} and the class of the output from \code{simpf} to \code{portfolio}. \item The components of the list returned by \code{severity.portfolio()} are renamed from \code{"first"} and \code{"last"} to \code{"main"} and \code{"split"}, respectively. } } \subsection{BUG FIXES}{ \itemize{ \item \code{levinvgauss()} returned wrong results. \item Restructuring of the weights matrix in \code{simpf()} may fail with an incorrect number of columns. \item Fixed index entry of the credibility theory vignette. \item \code{adjCoef()} would only accept as argument \code{h} a function named \code{h}. \item \code{ruin()} built incorrect probability vector and intensity matrix for mixture of Erlangs. \item \code{CTE.aggregateDist()} sometimes gave values smaller than the VaR for recursive and simulation methods. } } } \section{CHANGES IN VERSION 0.9-4}{ \itemize{ \item Maintenance and new features release. } \subsection{NEW FEATURES -- LOSS DISTRIBUTIONS}{ \itemize{ \item Functions \code{mgffoo()} to compute the moment (or cumulant if \code{log = TRUE}) generating function of the following distributions: chi-square, exponential, gamma, inverse gaussian (from package \pkg{SuppDists}), inverse gamma, normal, uniform and phase-type (see below). \item Functions \code{mfoo()} to compute the raw moments of all the probability distributions supported in the package and the following of base R: chi-square, exponential, gamma, inverse gaussian (from package \pkg{SuppDists}), inverse gamma, normal, uniform. \item Functions \code{phtype()} to compute the probability density function, cumulative distribution function, moment generating function, raw moments of, and to generate variates from, phase-type distributions. } } \subsection{NEW FEATURES -- RISK THEORY}{ \itemize{ \item Function \code{VaR()} with a method for objects of class \code{"aggregateDist"} to compute the Value at Risk of a distribution. \item Function \code{CTE()} with a method for objects of class \code{"aggregateDist"} to compute the Conditional Tail Expectation of a distribution. \item Function \code{adjCoef()} to compute the adjustment coefficient in ruin theory. If proportional or excess-of-loss reinsurance is included in the model, \code{adjCoef()} returns a function to compute the adjustment coefficient for given limits. A plot method is also included. \item Function \code{ruin()} returns a function to compute the infinite time probability of ruin for given initial surpluses in the Cramér-Lundberg and Sparre Andersen models. Most calculations are done using the cdf of phase-type distributions as per Asmussen and Rolski (1991). \item Calculations of the aggregate claim distribution using the recursive method much faster now that recursions are done in C. } } \subsection{NEW FEATURES -- CREDIBILITY THEORY}{ \itemize{ \item Modular rewrite of \code{cm()}: the function now calls internal functions to carry calculations for each supported credibility model. This is more efficient. \item Basic support for the regression model of Hachemeister in function \code{cm()}. \item For the hierarchical credibility model: support for the variance components estimators of Bühlmann and Gisler (2005) and Ohlsson (2005). Support remains for iterative pseudo-estimators. \item Calculations of iterative pseudo-estimators in hierarchical credibility are much faster now that they are done in C. } } \subsection{OTHER NEW FEATURES}{ \itemize{ \item Four new vignettes: introduction to the package and presentation of the features in loss distributions, risk theory and credibility theory. \item Portfolio simulation material of the \code{credibility} demo moved to demo \code{simulation}. } } \subsection{USER-VISIBLE CHANGES}{ \itemize{ \item Argument \code{approx.lin} of \code{quantile.aggregateDist()} renamed \code{smooth}. \item Function \code{aggregateDist()} gains a \code{maxit} argument for the maximum number of recursions when using Panjer's algorithm. This is to avoid infinite recursion when the cumulative distribution function does not converge to 1. \item Function \code{cm()} gains a \code{maxit} argument for the maximum number of iterations in pseudo-estimators calculations. \item Methods of \code{aggregate()}, \code{frequency()}, \code{severity()} and \code{weights()} for objects of class \code{"simpf"} gain two new arguments: \enumerate{ \item \code{classification}; when \code{TRUE}, the columns giving the classification structure of the portfolio are excluded from the result. This eases calculation of loss ratios (aggregate claim amounts divided by the weights); \item \code{prefix}; specifies a prefix to use in column names, with sensible defaults to avoid name clashes for data and weight columns. } } } \subsection{BUG FIXES}{ \itemize{ \item The way weights had to be specified for the \code{"chi-square"} method of \code{mde()} to give expected results was very unintuitive. The fix has no effect when using the default weights. \item The empirical step function returned by the \code{"recursive"} and \code{"convolution"} methods of \code{aggregateDist()} now correctly returns 1 when evaluated past its largest knot. } } \subsection{DEPRECATED}{ \itemize{ \item Direct usage of \code{bstraub()} is now deprecated in favor of \code{cm()}. The function will remain in the package since it is used internally by \code{cm()}, but it will not be exported in future releases of the package. The current format of the results is also deprecated. } } } \section{CHANGES IN VERSION 0.9-3}{ \subsection{DEPRECATED, DEFUNCT OR NO BACKWARD COMPATIBILITY}{ \itemize{ \item The user interface of \code{coverage()} has changed. Instead of taking in argument the name of a probability law (say \code{foo}) and require that functions \code{dfoo()} and \code{pfoo()} exist, \code{coverage()} now requires a function name or function object to compute the cdf of the unmodified random variable and a function name or function object to compute the pdf. If both functions are provided, \code{coverage()} returns a function to compute the pdf of the modified random variable; if only the cdf is provided, \code{coverage()} returns the cdf of the modified random variable. Hence, argument \code{cdf} is no longer a boolean. The new interface is more in line with other functions of the package. } } \subsection{BUG FIXES}{ \itemize{ \item Methods of \code{summary()} and \code{print.summary()} for objects of class \code{"cm"} were not declared in the NAMESPACE file. \item Various fixes to the demo files. } } } \section{CHANGES IN VERSION 0.9-2}{ \itemize{ Major official update. This version is not backward compatible with the 0.1-x series. Features of the package can be split in the following categories: loss distributions modeling, risk theory, credibility theory. } \subsection{NEW FEATURES -- LOSS DISTRIBUTIONS}{ \itemize{ \item Functions \code{[dpqr]foo()} to compute the density function, cumulative distribution function, quantile function of, and to generate variates from, all probability distributions of Appendix A of Klugman et al. (2004), \emph{Loss Models, Second Edition} (except the inverse gaussian and log-t) not already in R. Namely, this adds the following distributions (the root is what follows the \code{d}, \code{p}, \code{q} or \code{r} in function names): \tabular{ll}{ DISTRIBUTION NAME \tab ROOT \cr Burr \tab \code{burr} \cr Generalized beta \tab \code{genbeta} \cr Generalized Pareto \tab \code{genpareto} \cr Inverse Burr \tab \code{invburr} \cr Inverse exponential \tab \code{invexp} \cr Inverse gamma \tab \code{invgamma} \cr Inverse Pareto \tab \code{invpareto} \cr Inverse paralogistic \tab \code{invparalogis} \cr Inverse transformed gamma \tab \code{invtrgamma} \cr Inverse Weibull \tab \code{invweibull} \cr Loggamma \tab \code{loggamma} \cr Loglogistic \tab \code{llogis} \cr Paralogistic \tab \code{paralogis} \cr Pareto \tab \code{pareto} \cr Single parameter Pareto \tab \code{pareto1} \cr Transformed beta \tab \code{trbeta} \cr Transformed gamma \tab \code{trgamma} } All functions are coded in C for efficiency purposes and should behave exactly like the functions in base R. For all distributions that have a scale parameter, the corresponding functions have \code{rate = 1} and \code{scale = 1/rate} arguments. \item Functions \code{foo()} to compute the \eqn{k}-th raw (non-central) moment and \eqn{k}-th limited moment for all the probability distributions mentioned above, plus the following ones of base R: beta, exponential, gamma, lognormal and Weibull. \item Facilities to store and manipulate grouped data (stored in an interval-frequency fashion). Function \code{grouped.data()} creates a grouped data object similar to a data frame. Methods of \code{"["}, \code{"[<-"}, \code{mean()} and \code{hist()} created for objects of class \code{"grouped.data"}. \item Function \code{ogive()} --- with appropriate methods of \code{knots()}, \code{plot()}, \code{print()} and \code{summary()} --- to compute the ogive of grouped data. Usage is in every respect similar to \code{stats:::ecdf()}. \item Function \code{elev()} to compute the empirical limited expected value of a sample of individual or grouped data. \item Function emm() to compute the k-th empirical raw (non-central) moment of a sample of individual or grouped data. \item Function \code{mde()} to compute minimum distance estimators from a sample of individual or grouped data using one of three distance measures: Cramer-von Mises (CvM), chi-square, layer average severity (LAS). Usage is similar to \code{fitdistr()} of package \pkg{MASS}. \item Function \code{coverage()} to obtain the pdf or cdf of the payment per payment or payment per loss random variable under any combination of the following coverage modifications: ordinary of franchise deductible, policy limit, coinsurance, inflation. The result is a function that can be used in fitting models to data subject to such coverage modifications. \item Individual dental claims data set \code{dental} and grouped dental claims data set \code{gdental} of Klugman et al. (2004), \emph{Loss Models, Second Edition}. } } \subsection{NEW FEATURES -- RISK THEORY}{ \itemize{ \item Function \code{aggregateDist()} returns a function to compute the cumulative distribution function of the total amount of claims random variable for an insurance portfolio using any of the following five methods: \enumerate{ \item exact calculation by convolutions (using function convolve() of package \pkg{stats}; \item recursive calculation using Panjer's algorithm; \item normal approximation; \item normal power approximation; \item simulation. } The modular conception of \code{aggregateDist()} allows for easy inclusion of additional methods. There are special methods of \code{print()}, \code{summary()}, \code{quantile()} and \code{mean()} for objects of class \code{"aggregateDist"}. The objects otherwise inherit from classes \code{"ecdf"} (for methods 1, 2 and 3) and \code{"function"}. See also the DEPRECATED, DEFUNCT OR NO BACKWARD COMPATIBILITY section below. \item Function \code{discretize()} to discretize a continuous distribution using any of the following four methods: \enumerate{ \item upper discretization, where the discretized cdf is always above the true cdf; \item lower discretization, where the discretized cdf is always under the true cdf; \item rounding, where the true cdf passes through the midpoints of the intervals of the discretized cdf; \item first moment matching of the discretized and true distributions. } Usage is similar to \code{curve()} of package \pkg{graphics}. Again, the modular conception allows for easy inclusion of additional discretization methods. } } \subsection{NEW FEATURES -- CREDIBILITY THEORY}{ \itemize{ \item Function \code{simpf()} can now simulate data for hierarchical portfolios of any number of levels. Model specification changed completely; see the DEPRECATED, DEFUNCT OR NO BACKWARD COMPATIBILITY below. The function is also significantly (\eqn{\sim 10\times}{~10x}) faster than the previous version. \item Generic function \code{severity()} defined mostly to provide a method for objects of class \code{"simpf"}; see below. \item Methods of \code{aggregate()}, \code{frequency()}, \code{severity()} and \code{weights()} to extract information from objects of class \code{"simpf"}: \enumerate{ \item \code{aggregate()} returns the matrix of aggregate claim amounts per node; \item \code{frequency()} returns the matrix of the number of claims per node; \item \code{severity()} returns the matrix of individual claim amounts per node; \item \code{weights()} returns the matrix of weights corresponding to the data. } Summaries can be done in various ways; see \code{?simpf.summaries} \item Function \code{cm()} (for \emph{c}redibility \emph{m}odel) to compute structure parameters estimators for hierarchical credibility models, including the Bühlmann and Bühlmann-Straub models. Usage is similar to \code{lm()} of package \pkg{stats} in that the hierarchical structure is specified by means of a formula object and data is extracted from a matrix or data frame. There are special methods of \code{print()}, \code{summary()} for objects of class \code{"cm"}. Credibility premiums are computed using a method of \code{predict()}; see below. For simple Bühlmann and Bühlmann-Straub models, \code{bstraub()} remains simpler to use and faster. \item Function \code{bstraub()} now returns an object of class \code{"bstraub"} for which there exist print and summary methods. The function no longer computes the credibility premiums; see the DEPRECATED, DEFUNCT OR NO BACKWARD COMPATIBILITY section below. \item Methods of \code{predict()} for objects of class \code{"cm"} and \code{"bstraub"} created to actually compute the credibility premiums of credibility models. Function \code{predict.cm()} can return the premiums for specific levels of a hierarchical portfolio only. } } \subsection{OTHER NEW FEATURES}{ \itemize{ \item Function \code{unroll()} to unlist a list with a \code{"dim"} attribute of length 0, 1 or 2 (that is, a vector or matrix of vectors) according to a specific dimension. Currently identical to \code{severity.default()} by lack of a better usage of the default method of \code{severity()}. \item Three new demos corresponding to the three main fields of actuarial science covered by the package. \item French translations of the error and warning messages. \item The package now has a name space. } } \subsection{DEPRECATED, DEFUNCT OR NO BACKWARD COMPATIBILITY}{ \itemize{ \item Function \code{panjer()}, although still present in the package, should no longer be used directly. Recursive calculation of the aggregate claim amount should be done with \code{aggregateDist()}. Further, the function is not backward compatible: model specification has changed, discretization of the claim amount distribution should now be done with \code{discretize()}, and the function now returns a function to compute the cdf instead of a simple vector of probabilities. \item Model specification for \code{simpf()} changed completely and is not backward compatible with previous versions of the package. The new scheme allows for much more general models. \item Function \code{rearrangepf()} is defunct and has been replaced by methods of \code{aggregate()}, \code{frequency()} and \code{severity()}. \item Function \code{bstraub()} no longer computes the credibility premiums. One should now instead use \code{predict()} for this. \item The data set \code{hachemeister} is no longer a list but rather a matrix with a state specification. } } } \section{CHANGES IN VERSION 0.1-3}{ \itemize{ \item Fixed the dependency on R >= 2.1.0 since the package uses function \code{isTRUE()}. } } \section{CHANGES IN VERSION 0.1-2}{ \itemize{ \item First public release. \item Fixed an important bug in \code{bstraub()}: when calculating the range of the weights matrix, \code{NA}s were not excluded. \item Miscellaneous documentation corrections. } } \section{CHANGES IN VERSION 0.1-1}{ \itemize{ \item Initial release. \item Contains functions \code{bstraub()}, \code{simpf()}, \code{rearrangepf()} and \code{panjer()}, and the dataset \code{hachemeister}. } } actuar/inst/NEWS.Rd0000644000176200001440000002570214522557714013573 0ustar liggesusers\name{NEWS} \title{\pkg{actuar} News} \encoding{UTF-8} \section{CHANGES IN \pkg{actuar} VERSION 3.3-4}{ \subsection{BUG FIXES}{ \itemize{ \item{\code{rcompound} will now correctly retrieve the simulation models passed down from other functions as expressions objects.} \item{One error message in \code{rmixture} was quoting the wrong argument.} } } } \section{CHANGES IN \pkg{actuar} VERSION 3.3-3}{ \subsection{BUG FIXES}{ \itemize{ \item{The generics \code{elev} and \code{ogive} no longer rely on local variables added to the environment in which the method is evaluated by \code{UseMethod}. This \dQuote{feature} should be removed from R in the next major release. Thanks to Luke Thierney \email{luke-tierney@uiowa.edu} for the direct notification and for the pointer to a fix.} } } \subsection{USER VISIBLE CHANGES}{ \itemize{ \item{\code{rcomphierarc} is now the base name for the simulation function of compound hierarchical models, whereas \code{simul} is an alias retained for backward compatibility.} \item{The alias \code{simpf} for \code{simul} (or \code{rcomphierarc}) is extinct.} } } } \section{CHANGES IN \pkg{actuar} VERSION 3.3-2}{ \subsection{BUG FIXES}{ \itemize{ \item{\code{rcompound}, \code{rcomppois} and \code{rmixture} evaluate their model arguments in the correct frame for a larger sets of circumstances, notably when called inside another function. \code{?rmixture} provides more information and examples on this matter for that function.} } } \subsection{OTHER CHANGES}{ \itemize{ \item{Package vignettes now use the STYX2 fonts for text and Fira Mono for code.} } } } \section{CHANGES IN \pkg{actuar} VERSION 3.3-1}{ \subsection{BUG FIXES}{ \itemize{ \item{Include prototypes for all C level functions to please \code{-Wstrict-prototypes}.} } } } \section{CHANGES IN \pkg{actuar} VERSION 3.3-0}{ \subsection{NEW FEATURES}{ \itemize{ \item{Italian translations contributed by Daniele Medri \email{dmedri@gmail.com}.} \item{Package help file; use \code{?actuar} to read.} \item{New entry in the CITATION file for the paper in the Journal of Statistical Software presenting our implementation of the Feller-Pareto family of distributions.} } } } \section{CHANGES IN \pkg{actuar} VERSION 3.2-2}{ \subsection{BUG FIXES}{ \itemize{ \item{Replace deprecated (as of R 4.2.0) macro DOUBLE_EPS by DBL_EPSILON in C code.} } } } \section{CHANGES IN \pkg{actuar} VERSION 3.2-1}{ \subsection{BUG FIXES}{ \itemize{ \item{Fix incorrect usage of \code{all.equal} in tests.} } } } \section{CHANGES IN \pkg{actuar} VERSION 3.2-0}{ \subsection{NEW FEATURES}{ \itemize{ \item{Generic versions of \code{var} and \code{sd} with methods for grouped data. The default methods (for individual data) call the standard functions of the \pkg{stats} package. Grouped data methods contributed by Walter Garcia-Fontes \email{walter.garcia@upf.edu}.} \item{Method of \code{summary} for grouped data objects contributed by Walter Garcia-Fontes \email{walter.garcia@upf.edu}.} \item{Examples for the new methods for grouped data objects in \code{lossdist} demonstration \R script.} } } \subsection{BUG FIXES}{ \itemize{ \item{Use \code{USE_FC_LEN_T} in the C prototypes of LAPACK functions to correspond to code produced by gfortran >= 7. The mechanism was introduced in \R 3.6.2 and is planned to make its use obligatory in \R 4.2.0.} \item{Miscellaneous fixes to formulas for grouped data in the documentation for \code{mean.grouped.data} and \code{emm}, as well as in the \dQuote{modeling} package vignette.} } } } \section{CHANGES IN \pkg{actuar} VERSION 3.1-4}{ \subsection{BUG FIXES}{ \itemize{ \item{Due to its use of \code{log1mexp} since the previous release, the package depends on \R >= 4.1.0.} } } } \section{CHANGES IN \pkg{actuar} VERSION 3.1-3}{ \subsection{BUG FIXES}{ \itemize{ \item{Carry over the new implementation of the Cornish-Fisher Expansion of base \R used by \code{qlogarithmic} and \code{qpoisinvgauss}.} \item{Fix computation of \code{[pq]zmpois}, \code{[pq]zmbinom} and \code{[pq]zmnbinom} following fixes to the underlying base \R functions introduced in r80271 of \R sources. With thanks to B.D. Ripley and Martin Maechler.} } } } \section{CHANGES IN \pkg{actuar} VERSION 3.1-2}{ \subsection{BUG FIXES}{ \itemize{ \item{\code{qinvgauss} now returns a finite value when \eqn{1.5/\code{shape} > 1000}. Thanks to Bettina Grün \email{bettina.gruen@wu.ac.at} for the fix.} \item{A protection against rounding errors now ensures that \code{qzmlogarithmic(1 - pzmlogarithmic(x), lower.tail = FALSE) == x} is always \code{TRUE}.} \item{In \code{?dburr}, the scale parameter appeared in the denominator of the density instead of \eqn{x}. Thanks to Etienne Guy for the heads up.} \item{The package tests now correctly use \code{stopifnot} with argument \code{exprs} explicitly named.} \item{The formula for the moment of order \eqn{k} for grouped data in \code{?emm} fixed in version 2.3-3 for the LaTeX version is now also fixed for the text version. Thanks (again) to Walter Garcia-Fontes.} } } } \section{CHANGES IN \pkg{actuar} VERSION 3.1-1}{ \subsection{BUG FIXES}{ \itemize{ \item{\code{rcompound} and \code{rmixture} now correctly find objects defined higher in the call stack.} } } } \section{CHANGES IN \pkg{actuar} VERSION 3.1-0}{ \subsection{BUG FIXES}{ \itemize{ \item{\code{rmixture} now randomly shuffles the variates by default and gains an argument \code{shuffle} (\code{TRUE} by default). Using \code{shuffle = FALSE} restores the previous behaviour where the output vector contains all the random variates from the first model, then all the random variates from the second model, and so on. When the order of the random variates is irrelevant, this cuts execution time roughly in half. Thanks to Adam Kałdus \email{akaldus@wp.pl} for the stimulating comments on this matter.} } } \subsection{USER VISIBLE CHANGES}{ \itemize{ \item{The number of variates returned by \code{rmixture} is now the length of argument \code{n} if larger than 1, like other \code{r} functions.} \item{\code{rmixture} now checks the validity of its arguments.} } } } \section{CHANGES IN \pkg{actuar} VERSION 3.0-0}{ \subsection{NEW FEATURES}{ \itemize{ \item{Support functions \code{[dpqrm,lev]fpareto} for the Feller-Pareto distribution and related Pareto distributions with a location parameter. The Feller-Pareto defines a large family of distributions encompassing the transformed beta family and many variants of the Pareto distribution. Using the nomenclature of Arnold (2015), the following distributions are now supported by \pkg{actuar}: Feller-Pareto, Pareto IV, Pareto III, and Pareto II. The Pareto I was already supported under the name Single Parameter Pareto. Contributed by Christophe Dutang, Vincent Goulet and Nicholas Langevin.} \item{The package now exposes through an API its 200+ C routines for probability functions and the beta integral. This is documented in a new section of the \dQuote{distributions} package vignette. See file \file{include/actuarAPI.h} in the package installation directory for the complete list of exported routines.} \item{Improvements to the accuracy in the right tail of the \code{p} and \code{lev} functions for most probability distributions of the transformed beta family. Achieved by replacing \code{pbeta(u, a, b, lower.tail)} for \eqn{u > 0.5} with \code{pbeta(1 - u, b, a, !lower.tail)} and an accurate computation of \code{u}. Contributed by Nicholas Langevin.} \item{The C workhorse \code{betaint_raw} behind \code{betaint} gains an additional argument to receive an accurate value of \eqn{1 - x}. Used extensively to improve accuracy of the \code{lev} functions for the transformed beta family. Contributed by Nicholas Langevin.} \item{The \dQuote{distributions} package vignette now regroups distributions of the transformed beta families and the single parameter Pareto under the umbrella of the Feller-Pareto family of distributions. The vignette now also includes diagrams showing the interrelations between the members of this family, as well as between the members of the transformed gamma and inverse transformed gamma families.} \item{Exhaustive regression tests for probability functions.} } } \subsection{BUG FIXES}{ \itemize{ \item{Improvements to the simulation algorithm for zero-modified discrete distributions in the \eqn{p_0^M < p_0}{p0m < p0} case. Contributed by Nicholas Langevin.} \item{\code{dpoisinvgauss} no longer returns \code{NaN} for large values of \code{x}. Solved by computing probabilities recursively instead of by calling \code{bessel_k} (the latter would overflow for large \code{nu} and propagate \code{NaN}). Computations are actually about twice as fast.} \item{\code{ppoisinvgauss} now honors argument \code{lower_tail}.} \item{\code{qpoisinvgauss} no longer fails with \code{mu = Inf} and \code{log.p = TRUE}.} \item{\code{betaint(x, Inf, b)} now returns \code{Inf} instead of \code{NaN}.} \item{\code{betaint(.Machine$double.xmin, a, b)}, with \eqn{b < 0}, now returns 0 instead of \code{NaN}.} \item{\code{d} and \code{p} functions for all continuous size distributions now handle limiting cases for infinite scale parameter, or for zero non-scale parameters, consistently with functions of base \R. Affected functions are: \code{[dp]trbeta}, \code{[dp]burr}, \code{[dp]llogis}, \code{[dp]paralogis}, \code{[dp]genpareto}, \code{[dp]pareto}, \code{[dp]invburr}, \code{[dp]invpareto}, \code{[dp]invparalogis} in the Transformed Beta family; \code{[dp]trgamma}, \code{[dp]invtrgamma}, \code{[dp]invgamma}, \code{[dp]invweibull}, \code{[dp]invexp} in the Transformed Gamma family; \code{[dp]lgamma}, \code{[dp]gumbel}, \code{[dp]invgauss}, \code{[dp]genbeta}.} \item{\code{levinvexp} no longer returns \code{NaN} for finite order.} } } \subsection{BREAKING CHANGE}{ \itemize{ \item{Support for the Pareto II distributions comes from functions \code{[dpqrm,lev]pareto2}. These functions were \emph{aliases} to \code{[dpqrm,lev]pareto} in previous version of \pkg{actuar}. The new functions are \emph{not} backward compatible. Therefore, calls to the \code{*pareto2} functions of previous versions of \pkg{actuar} will return wrong results and should be replaced by calls to \code{*pareto} functions.} } } \subsection{DEFUNCT}{ \itemize{ \item{Functions \code{[m,lev,mgf]invGauss} that were deprecated in version 2.0-0.} } } } \note{ \itemize{Older news can be found in files \file{NEWS.2.Rd} (2.x series), \file{NEWS.1.Rd} (1.x series) and \file{NEWS.0.Rd} (0.x series).} } actuar/inst/po/0000755000176200001440000000000014522560035013126 5ustar liggesusersactuar/inst/po/fr/0000755000176200001440000000000014264305077013543 5ustar liggesusersactuar/inst/po/fr/LC_MESSAGES/0000755000176200001440000000000014522557714015334 5ustar liggesusersactuar/inst/po/fr/LC_MESSAGES/R-actuar.mo0000644000176200001440000002337314522557714017357 0ustar liggesusersy8 9 )? i + ) 4 ; ,P } 4 0 $  @ T !h 8 B ( / P 0k   F    #'&)N<x&=A"-d4 ,? Mgv27LS&W%~A %8<XI  0Oi o} 059Yms v&   ',2)9"c G/ 4U^}6U[>a2+9?X7<--)[')=K@+#835U9 170GC4YT"?w8 5 D?6 N m    - " F! M!W!1`!A!K!Z " {" """""""/""# #(,#%U#4{#8#;#%$?$E$ H$S$\$*{$$$ $ $$ $ %%% %#=%a%g%n% t%~%%%%J%5%&8&$A&f&;&&&&&&R3*fY8 \Sp/v V_so&uKX@:WbJIq9M=(E#n>A<leBd5^+yG0)Cg$4"ZQFU,t7H amON%x-jk Lc!wDP' ;.1?T]r[2`6ih!freq%s has many elements: only the first used%s ignored when %s is specified%s is an alias for %s, however they differ.%s measure requires an object of class %s%s must be a function or an expression containing %s%s must be a function or an expression containing %s and %s%s must be a function when using reinsurance%s must be a named list%s must be a numeric vector or an object of class %s%s must be a valid probability (between 0 and 1)%s must be a vector of probabilities%s must be a vector or a matrix%s must be positive%s must be supplied%s must be supplied as a function%s must supply the mean and variance of the distribution%s must supply the mean, variance and skewness of the distribution%s must supply the number of simulations%s not used when %s is specified%s required with method %s%s specifies names which are not arguments to %s,LASPr[S = 0] is numerically equal to 0; impossible to start the recursionbreaksbycdfchi-squarecoinsurance must be between 0 and 1coverage modifications must be positivedeductible must be smaller than the limitempty regression model; fitting with Buhlmann-Straub's modelexpressions in %s and %s must be namedformulafrequency distribution must be supplied as a character stringfrequency distribution not in the (a, b, 0) or (a, b, 1) familiesfrequency must be larger than 0 in all groupsfunfunction not defined for approximating distributionsgroupgrouped.datahhierarchical regression models not supportedimpossible to replace boundaries and frequencies simultaneouslyinfinite group boundariesinternal errorinvalid %s specificationinvalid first argument %sinvalid level nameinvalid level numberinvalid number of group boundaries and frequenciesinvalid parameters in %sinvalid third argument %sinvalid values in %slambdalevlevel names different in %s, %s and %slower bound of the likelihood missingmaximum number of iterations reached before obtaining convergencemgf.claimmgf.waitmissing frequencies replaced by zerosmissing ratios not allowed when weights are not suppliedmissing values are not in the same positions in %s and in %smissing values are not in the same positions in 'weights' and in 'ratios'model.freqmodel.sevmodelsmomentsnnb.simulnclassneed 0, 1, or 2 subscriptsno available data to fit modelno positive probabilitiesnodesnothing to doone of %s or %s is neededone of %s or %s must be non-NULLone of the Beta prior parameter %s or %s missingone of the Gamma prior parameter %s, %s or %s missingonly logical matrix subscripts are allowed in replacementoptimization failedorderp0par.claimspar.waitparameter %s missing in %sparameter %s of the likelihood missingparameter %s or %s missing in %sparameters %s missing in %spremium.rateprobprobabilityrateratesratiosratios have to be supplied if weights arerows extracted in increasing orderscalesd.likshapeshape.likshape1shape2sizestartthere must be at least one node with more than one period of experiencethere must be at least two nodes at every levelthere must be more than one nodeunbiasedunsupported interactions in %sunsupported likelihoodvalue of %s ignored with a zero-truncated distributionvalue of %s missingvalue of %s or %s missingweightsxyProject-Id-Version: actuar 2.0-0 Report-Msgid-Bugs-To: bugs@r-project.org PO-Revision-Date: 2023-11-07 14:45-0500 Last-Translator: Vincent Goulet Language-Team: Vincent Goulet Language: fr MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit !freq%s contient plusieurs éléments: seul le premier est utilisé%s ignoré quand %s est fourni%s est un alias pour %s, cependant ils diffèrent.la mesure %s requiert un objet de classe %s%s doit être une fonction ou une expression contenant %s%s doit être une fonction ou une expression contenant %s et %s%s doit être une fonction en présence de réassurance%s doit être une liste nommée%s doit être un vecteur numérique ou un objet de classe %s%s doit être une probabilité (entre 0 et 1)%s doit être un vecteur de probabilités%s doit être un vecteur ou une matrice%s doit être positif%s doit être fourni%s doit être fourni en tant que fonction%s doit contenir la moyenne et la variance de la distribution%s doit contenir la moyenne, la variance et l'asymétrie de la distribution%s doit spécifier le nombre de simulations%s non utilisé quand %s est fourni%s requis pour la méthode %s%s contient des noms qui ne sont pas des arguments de %s,LASvaleur de Pr[S = 0] numériquement nulle; impossible de démarrer le calcul récursifbreaksbycdfchi-squarele facteur de coassurance doit être entre 0 et 1les modifications de couverture doivent être positivesla franchise doit être inférieure à la limitemodèle de régression vide; utilisation du modèle de Bühlmann-Straubles expressions dans %s et %s doivent être nomméesformulala distribution de fréquence doit être spécifiée sous forme de chaîne de caractèresla distribution de fréquence ne fait pas partie des familles (a, b, 0) ou (a, b, 1)la fréquence doit être supérieure à 0 dans tous les groupesfunfonction non définie pour les méthodes d'approximationgroupgrouped.datahmodèles de régression hiérarchiques non supportésimpossible de remplacer simultanément les bornes et les fréquencesbornes de groupe infinieserreur internevaleur de %s incorrectepremier argument %s incorrectnom de niveau incorrectnuméro de niveau incorrectnombre de bornes de groupe et de fréquences incorrectparamètres incorrects dans %stroisième argument %s incorrectvaleurs incorrectes dans %slambdalevnoms de niveaux différents dans %s, %s et %sseuil de la vraisemblance manquantnombre d'itérations maximal atteint avant obtention de la convergencemgf.claimmgf.waitfréquences manquantes remplacées par des zérosratios manquants non permis lorsque les poids ne sont pas fournisles données manquantes ne sont pas aux mêmes positions dans %s et dans %sles données manquantes ne sont pas aux mêmes positions dans les poids et dans les ratiosmodel.freqmodel.sevmodelsmomentsnnb.simulnclassil faut 0, 1 ou 2 indicesaucune donnée disponible pour la modélisationaucune probabilité positivenodesrien à fairel'une ou l'autre de %s ou %s est requiseun de %s ou %s doit ne pas être NULLun des paramètres %s ou %s de la loi Bêta manquantun des paramètres %s, %s ou %s de la loi Gamma manquantseuls les indices logiques sont permis pour le remplacementl'optimisation a échouéorderp0par.claimspar.waitparamètre %s manquant dans %sparamètre %s de la vraisemblance manquantparamètre %s ou %s manquant dans %sparamètres %s manquants dans %spremium.rateprobprobabilityrateratesratiosratios requis s'il y a des poidslignes extraites en ordre croissantscalesd.likshapeshape.likshape1shape2sizestartil y doit y avoir au moins un noeud avec plus d'une période d'expérienceil doit y avoir au moins deux noeuds à chaque niveauil doit y avoir plus d'un noeudunbiasedinteractions non supportées dans %svraisemblance non validevaleur de %s ignorée pour une distribution zéro tronquéevaleur de %s manquantevaleur de %s ou %s manquanteweightsxyactuar/inst/po/fr/LC_MESSAGES/actuar.mo0000644000176200001440000000727314522554312017150 0ustar liggesusers!$/, /:'8b++0 $51g z     &@"g#####(>)g/AUko/ 1J P| W 9% 9_ A  F 3 "M "p " " " " ( $H %m % % % % *+ +V  5 F G\|&     !'A' is 0-diml'order' (%.2f) must be integer, rounded to %.0fLAPACK routine dgebal returned info code %d when permutingLAPACK routine dgebal returned info code %d when scalingLAPACK routine dgetrf returned info code %dLAPACK routine dgetrs returned info code %dLapack routine dgesv: system is exactly singularNAs producedargument %d of Lapack routine dgesv had invalid valueintegration failedinternal error in actuar_do_dpq1internal error in actuar_do_dpq2internal error in actuar_do_dpq3internal error in actuar_do_dpq4internal error in actuar_do_dpq5internal error in actuar_do_dpq6internal error in actuar_do_dpqphtype2internal error in actuar_do_randominternal error in actuar_do_random1internal error in actuar_do_random2internal error in actuar_do_random3internal error in actuar_do_random4internal error in actuar_do_random5internal error in actuar_do_randomphtypeinternal error in actuar_do_randomphtype2invalid argumentsmaximum number of iterations must be at least 1maximum number of iterations reached before obtaining convergencemaximum number of recursions reached before the probability distribution was completeno right-hand side in 'B'non-conformable argumentsnon-square sub-intensity matrixProject-Id-Version: actuar 1.1-7 Report-Msgid-Bugs-To: PO-Revision-Date: 2020-06-03 12:33-0400 Last-Translator: Vincent Goulet Language-Team: Vincent Goulet Language: fr MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Plural-Forms: nplurals=2; plural=(n > 1); 'A' est de dimension nulle'order' (%.2f) doit être entier, arrondi à %.0fla procédure LAPACK dgebal a produit le code d'erreur %d lors de la permutationla procédure LAPACK dgebal a produit le code d'erreur %d lors de la mise à l'échellela procédure LAPACK dgetrf a produit le code d'erreur %dla procédure LAPACK dgetrs a produit le code d'erreur %dsous-programme Lapack dgesv: le système est exactement singulierproduction de NAvaleur incorrecte pour l'argument %d du sous-programme dgesv de Lapackl'intégration a échouéerreur interne dans actuar_do_dpq1erreur interne dans actuar_do_dpq2erreur interne dans actuar_do_dpq3erreur interne dans actuar_do_dpq4erreur interne dans actuar_do_dpq5erreur interne dans actuar_do_dpq6erreur interne dans actuar_do_dpqphtype2erreur interne dans actuar_do_randomerreur interne dans actuar_do_random1erreur interne dans actuar_do_random2erreur interne dans actuar_do_random3erreur interne dans actuar_do_random4erreur interne dans actuar_do_random5erreur interne dans actuar_do_randomphtypeerreur interne dans actuar_do_randomphtype2arguments incorrectsle nombre d'itérations maximal doit être au moins 1nombre d'itérations maximal atteint avant obtention de la convergencenombre de récursions maximal atteint avant obtention de la convergenceaucun membre de droite dans 'B'arguments non conformesmatrice de sous-intensité non carréeactuar/inst/po/it/0000755000176200001440000000000014522557714013554 5ustar liggesusersactuar/inst/po/it/LC_MESSAGES/0000755000176200001440000000000014522557714015341 5ustar liggesusersactuar/inst/po/it/LC_MESSAGES/R-actuar.mo0000644000176200001440000002313514522557714017360 0ustar liggesusersy8 9 )? i + ) 4 ; ,P } 4 0 $  @ T !h 8 B ( / P 0k   F    #'&)N<x&=A"-d4 ,? Mgv27LS&W%~A %8<XI  0Oi o} 059Yms v&   ',2)9"c G/ 4U^}6U[1a!0-9>N@ ;1+(]/': HF)./68M<  2-B%0hNC:4o4s 0B1N]}2  9 Q X &\ 1 A !& !B1!At!N! " ""!")"+"4";"2V"""""""1"6*#=a#### ###,# $=$ Y$f$ k$w$|$$/$"$$$$ $$%% %?%.R%%% %%9% &6&Q&Y&[&R3*fY8 \Sp/v V_so&uKX@:WbJIq9M=(E#n>A<leBd5^+yG0)Cg$4"ZQFU,t7H amON%x-jk Lc!wDP' ;.1?T]r[2`6ih!freq%s has many elements: only the first used%s ignored when %s is specified%s is an alias for %s, however they differ.%s measure requires an object of class %s%s must be a function or an expression containing %s%s must be a function or an expression containing %s and %s%s must be a function when using reinsurance%s must be a named list%s must be a numeric vector or an object of class %s%s must be a valid probability (between 0 and 1)%s must be a vector of probabilities%s must be a vector or a matrix%s must be positive%s must be supplied%s must be supplied as a function%s must supply the mean and variance of the distribution%s must supply the mean, variance and skewness of the distribution%s must supply the number of simulations%s not used when %s is specified%s required with method %s%s specifies names which are not arguments to %s,LASPr[S = 0] is numerically equal to 0; impossible to start the recursionbreaksbycdfchi-squarecoinsurance must be between 0 and 1coverage modifications must be positivedeductible must be smaller than the limitempty regression model; fitting with Buhlmann-Straub's modelexpressions in %s and %s must be namedformulafrequency distribution must be supplied as a character stringfrequency distribution not in the (a, b, 0) or (a, b, 1) familiesfrequency must be larger than 0 in all groupsfunfunction not defined for approximating distributionsgroupgrouped.datahhierarchical regression models not supportedimpossible to replace boundaries and frequencies simultaneouslyinfinite group boundariesinternal errorinvalid %s specificationinvalid first argument %sinvalid level nameinvalid level numberinvalid number of group boundaries and frequenciesinvalid parameters in %sinvalid third argument %sinvalid values in %slambdalevlevel names different in %s, %s and %slower bound of the likelihood missingmaximum number of iterations reached before obtaining convergencemgf.claimmgf.waitmissing frequencies replaced by zerosmissing ratios not allowed when weights are not suppliedmissing values are not in the same positions in %s and in %smissing values are not in the same positions in 'weights' and in 'ratios'model.freqmodel.sevmodelsmomentsnnb.simulnclassneed 0, 1, or 2 subscriptsno available data to fit modelno positive probabilitiesnodesnothing to doone of %s or %s is neededone of %s or %s must be non-NULLone of the Beta prior parameter %s or %s missingone of the Gamma prior parameter %s, %s or %s missingonly logical matrix subscripts are allowed in replacementoptimization failedorderp0par.claimspar.waitparameter %s missing in %sparameter %s of the likelihood missingparameter %s or %s missing in %sparameters %s missing in %spremium.rateprobprobabilityrateratesratiosratios have to be supplied if weights arerows extracted in increasing orderscalesd.likshapeshape.likshape1shape2sizestartthere must be at least one node with more than one period of experiencethere must be at least two nodes at every levelthere must be more than one nodeunbiasedunsupported interactions in %sunsupported likelihoodvalue of %s ignored with a zero-truncated distributionvalue of %s missingvalue of %s or %s missingweightsxyProject-Id-Version: actuar 2.0-0 Report-Msgid-Bugs-To: bugs@r-project.org PO-Revision-Date: 2023-11-07 14:46-0500 Last-Translator: Daniele Medri Language-Team: Daniele Medri Language: it MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Generator: Poedit 2.4.2 !freq%s ha molti elementi: solo il primo è utilizzato%s ignorato quando %s è presente%s è un alisa per %s, comunque sono differenti.la misura %s richiede un oggetto di classe %s%s dev'essere una funzione o un'espressione contenente %s%s dev'essere una funzione o un'espressione contenente %s e %s%s dev'essere una funzione quando si utilizza la riassicurazione%s dev'essere una lista nominata%s dev'essere un vettore numerico o un oggetto di classe %s%s dev'essere una probabilità valida (tra 0 e 1)%s dev'essere un vettore di probabilità%s dev'essere un vettore numerico o una matrice%s dev'essere positivo%s dev'essere passata%s dev'essere passata come una funzione%s deve fornire la media e la varianza della distribuzione%s deve fornire la media, la varianza e l'asimmetria della distribuzione%s deve indicare il numero di simulazioni%s non viene usata quando viene specificato %s%s richiesto con il metodo %s%s specifica nomi che non sono argomenti per %s,LASPr[S = 0] è numericamente uguale a 0; non è possibile avviare la ricorsionebreaksbycdfchi-squarecoinsurance dev'essere tra 0 e 1le modifiche alla copertura devono essere positivedeductible dev'essere più piccolo del limitemodello di regressione vuoto; stima con il modello Buhlmann-Strauble espressioni in %s e %s devono essere indicateformulala distribuzione di frequenza devono essere passate come una stringa caratteredistribuzione di frequenza non nelle famiglie (a, b, 0) o (a, b, 1)la frequenza dev'essere più grande di 0 in tutti i gruppifunfunzione non definita per approssimare distribuzionigroupgrouped.datahmodelli di regressione gerarchica non supportatinon è possibile sostituire estremi e frequenze contemporaneamenteestremi di gruppo non finitierrore internospecificazione di %s non validaprimo argomento %s non validonome livello non validonumero livello non validonumero di estremi di gruppo e frequenze non validoparametri non validi in %sterzo argomento %s non validovalori non validi in %slambdalevnomi livello differenti in %s, %s e %sestremo inferiore mancante per la verosimiglianzaraggiunto il numero massimo di iterazioni prima della convergenzamgf.claimmgf.waitfrequenze mancanti sostituite con zeronon sono ammessi rapporti mancanti quando i pesi non sono indicatii valori mancanti non sono nelle medesime posizioni in %s e in %si valori mancanti non sono nelle medesime posizioni in 'weights' e in 'ratios'model.freqmodel.sevmodelsmomentsnnb.simulnclassrichiede 0, 1 o due indicinon ci sono abbastanza dati per stimare il modellonessuna probabilità positivanodesniente da farerichiesto uno di %s o %suno di %s o %s non dev'essere NULLmanca uno dei parametri Beta a priori tra %s o %smanca uno dei parametri Gamma a priori tra %s, %s o %sin sostituzione sono consentiti solo pedici di matrice logicaottimizzazione fallitaorderp0par.claimspar.waitparametri %s mancanti in %sparametro %s mancante per la verosimiglianzaparametri %s o %s mancanti in %sparametri %s mancanti in %spremium.rateprobprobabilityrateratesratiosi rapporti devono essere passati se i pesi sonorighe estratte in ordine crescentescalesd.likshapeshape.likshape1shape2sizestartdev'esserci almeno un nodo con più di un periodo di esperienzadevono esserci almeno due nodi in ogni livellodev'esserci più di un nodounbiasedinterazioni non supportate in %sverosimiglianza non supportatavalore di %s ignorato con una distribuzione troncata zerovalore di %s mancantevalore di %s o %s mancanteweightsxyactuar/inst/po/it/LC_MESSAGES/actuar.mo0000644000176200001440000000727214522557714017165 0ustar liggesusers!$/, /:'8b++0 $51g z     &@"g#####(>)g/AUkq 1 7? Zw U B( Bk ?  D F [ | &! "H #k # # # # ( )H r 3 A e c"     !'A' is 0-diml'order' (%.2f) must be integer, rounded to %.0fLAPACK routine dgebal returned info code %d when permutingLAPACK routine dgebal returned info code %d when scalingLAPACK routine dgetrf returned info code %dLAPACK routine dgetrs returned info code %dLapack routine dgesv: system is exactly singularNAs producedargument %d of Lapack routine dgesv had invalid valueintegration failedinternal error in actuar_do_dpq1internal error in actuar_do_dpq2internal error in actuar_do_dpq3internal error in actuar_do_dpq4internal error in actuar_do_dpq5internal error in actuar_do_dpq6internal error in actuar_do_dpqphtype2internal error in actuar_do_randominternal error in actuar_do_random1internal error in actuar_do_random2internal error in actuar_do_random3internal error in actuar_do_random4internal error in actuar_do_random5internal error in actuar_do_randomphtypeinternal error in actuar_do_randomphtype2invalid argumentsmaximum number of iterations must be at least 1maximum number of iterations reached before obtaining convergencemaximum number of recursions reached before the probability distribution was completeno right-hand side in 'B'non-conformable argumentsnon-square sub-intensity matrixProject-Id-Version: actuar 1.1-7 Report-Msgid-Bugs-To: PO-Revision-Date: 2022-04-13 11:12+0200 Last-Translator: Daniele Medri Language-Team: Daniele Medri Language: it_IT MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Plural-Forms: nplurals=2; plural=(n != 1); X-Generator: Poedit 2.4.2 'A' è 0-diml'order' (%.2f) dev'essere un intero, arrotondato a %.0fLa routine dgebal di LAPACK ha restituito il codice informativo %d durante la permutazioneLa routine dgebal di LAPACK ha restituito il codice informativo %d durante lo scalingLa routine dgetrf di LAPACK ha restituito il codice informativo %dLa routine dgetrs di LAPACK ha restituito il codice informativo %dLa routine dgesv di Lapack: il sistema è esattamente singolareGenerati valori NAl'argomento %d della routine dgesv di Lapack ha un valore non validointegrazione fallitaerrore interno in actuar_do_dpq1errore interno in actuar_do_dpq2errore interno in actuar_do_dpq3errore interno in actuar_do_dpq4errore interno in actuar_do_dpq5errore interno in actuar_do_dpq6errore interno in actuar_do_dpqphtype2errore interno in actuar_do_randomerrore interno in actuar_do_random1errore interno in actuar_do_random2errore interno in actuar_do_random3errore interno in actuar_do_random4errore interno in actuar_do_random5errore interno in actuar_do_randomphtypeerrore interno in actuar_do_randomphtype2argomenti non validiil numero massimo di iterazioni dev'essere almeno 1raggiunto il numero massimo di iterazioni prima della convergenzaraggiunto il numero massimo di ricorsioni prima che la distribuzione di probabilità fosse completatanessun membro di destra in 'B'gli argomenti non sono compatibilimatrice non quadrataactuar/inst/po/en@quot/0000755000176200001440000000000014264305077014547 5ustar liggesusersactuar/inst/po/en@quot/LC_MESSAGES/0000755000176200001440000000000014522557714016340 5ustar liggesusersactuar/inst/po/en@quot/LC_MESSAGES/R-actuar.mo0000644000176200001440000002235514522557714020362 0ustar liggesusersy8 9 )? i + ) 4 ; ,P } 4 0 $  @ T !h 8 B ( / P 0k   F    #'&)N<x&=A"-d4 ,? Mgv27LS&W%~A %8<XI  0Oi o} 059Yms v&   ',2)9"c G/ 4U^}6)I+i)4;,0]4u0$ 4!H8jB( 00K|~F #').<X&=A-Dr4v ,?-GVo2,3&7%^A %8<8 Qu       !7!Q! W!e! !0!5!9"A"U"[" ^"i"r"&" "" "" ####)!#"K#n#t#{# #####G#/# $=$F$e$6|$$$$$$R3*fY8 \Sp/v V_so&uKX@:WbJIq9M=(E#n>A<leBd5^+yG0)Cg$4"ZQFU,t7H amON%x-jk Lc!wDP' ;.1?T]r[2`6ih!freq%s has many elements: only the first used%s ignored when %s is specified%s is an alias for %s, however they differ.%s measure requires an object of class %s%s must be a function or an expression containing %s%s must be a function or an expression containing %s and %s%s must be a function when using reinsurance%s must be a named list%s must be a numeric vector or an object of class %s%s must be a valid probability (between 0 and 1)%s must be a vector of probabilities%s must be a vector or a matrix%s must be positive%s must be supplied%s must be supplied as a function%s must supply the mean and variance of the distribution%s must supply the mean, variance and skewness of the distribution%s must supply the number of simulations%s not used when %s is specified%s required with method %s%s specifies names which are not arguments to %s,LASPr[S = 0] is numerically equal to 0; impossible to start the recursionbreaksbycdfchi-squarecoinsurance must be between 0 and 1coverage modifications must be positivedeductible must be smaller than the limitempty regression model; fitting with Buhlmann-Straub's modelexpressions in %s and %s must be namedformulafrequency distribution must be supplied as a character stringfrequency distribution not in the (a, b, 0) or (a, b, 1) familiesfrequency must be larger than 0 in all groupsfunfunction not defined for approximating distributionsgroupgrouped.datahhierarchical regression models not supportedimpossible to replace boundaries and frequencies simultaneouslyinfinite group boundariesinternal errorinvalid %s specificationinvalid first argument %sinvalid level nameinvalid level numberinvalid number of group boundaries and frequenciesinvalid parameters in %sinvalid third argument %sinvalid values in %slambdalevlevel names different in %s, %s and %slower bound of the likelihood missingmaximum number of iterations reached before obtaining convergencemgf.claimmgf.waitmissing frequencies replaced by zerosmissing ratios not allowed when weights are not suppliedmissing values are not in the same positions in %s and in %smissing values are not in the same positions in 'weights' and in 'ratios'model.freqmodel.sevmodelsmomentsnnb.simulnclassneed 0, 1, or 2 subscriptsno available data to fit modelno positive probabilitiesnodesnothing to doone of %s or %s is neededone of %s or %s must be non-NULLone of the Beta prior parameter %s or %s missingone of the Gamma prior parameter %s, %s or %s missingonly logical matrix subscripts are allowed in replacementoptimization failedorderp0par.claimspar.waitparameter %s missing in %sparameter %s of the likelihood missingparameter %s or %s missing in %sparameters %s missing in %spremium.rateprobprobabilityrateratesratiosratios have to be supplied if weights arerows extracted in increasing orderscalesd.likshapeshape.likshape1shape2sizestartthere must be at least one node with more than one period of experiencethere must be at least two nodes at every levelthere must be more than one nodeunbiasedunsupported interactions in %sunsupported likelihoodvalue of %s ignored with a zero-truncated distributionvalue of %s missingvalue of %s or %s missingweightsxyProject-Id-Version: actuar 3.3-4 PO-Revision-Date: 2023-11-07 14:41 Last-Translator: Automatically generated Language-Team: none Language: en MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Plural-Forms: nplurals=2; plural=(n != 1); !freq%s has many elements: only the first used%s ignored when %s is specified%s is an alias for %s, however they differ.%s measure requires an object of class %s%s must be a function or an expression containing %s%s must be a function or an expression containing %s and %s%s must be a function when using reinsurance%s must be a named list%s must be a numeric vector or an object of class %s%s must be a valid probability (between 0 and 1)%s must be a vector of probabilities%s must be a vector or a matrix%s must be positive%s must be supplied%s must be supplied as a function%s must supply the mean and variance of the distribution%s must supply the mean, variance and skewness of the distribution%s must supply the number of simulations%s not used when %s is specified%s required with method %s%s specifies names which are not arguments to %s,LASPr[S = 0] is numerically equal to 0; impossible to start the recursionbreaksbycdfchi-squarecoinsurance must be between 0 and 1coverage modifications must be positivedeductible must be smaller than the limitempty regression model; fitting with Buhlmann-Straub's modelexpressions in %s and %s must be namedformulafrequency distribution must be supplied as a character stringfrequency distribution not in the (a, b, 0) or (a, b, 1) familiesfrequency must be larger than 0 in all groupsfunfunction not defined for approximating distributionsgroupgrouped.datahhierarchical regression models not supportedimpossible to replace boundaries and frequencies simultaneouslyinfinite group boundariesinternal errorinvalid %s specificationinvalid first argument %sinvalid level nameinvalid level numberinvalid number of group boundaries and frequenciesinvalid parameters in %sinvalid third argument %sinvalid values in %slambdalevlevel names different in %s, %s and %slower bound of the likelihood missingmaximum number of iterations reached before obtaining convergencemgf.claimmgf.waitmissing frequencies replaced by zerosmissing ratios not allowed when weights are not suppliedmissing values are not in the same positions in %s and in %smissing values are not in the same positions in ‘weights’ and in ‘ratios’model.freqmodel.sevmodelsmomentsnnb.simulnclassneed 0, 1, or 2 subscriptsno available data to fit modelno positive probabilitiesnodesnothing to doone of %s or %s is neededone of %s or %s must be non-NULLone of the Beta prior parameter %s or %s missingone of the Gamma prior parameter %s, %s or %s missingonly logical matrix subscripts are allowed in replacementoptimization failedorderp0par.claimspar.waitparameter %s missing in %sparameter %s of the likelihood missingparameter %s or %s missing in %sparameters %s missing in %spremium.rateprobprobabilityrateratesratiosratios have to be supplied if weights arerows extracted in increasing orderscalesd.likshapeshape.likshape1shape2sizestartthere must be at least one node with more than one period of experiencethere must be at least two nodes at every levelthere must be more than one nodeunbiasedunsupported interactions in %sunsupported likelihoodvalue of %s ignored with a zero-truncated distributionvalue of %s missingvalue of %s or %s missingweightsxyactuar/inst/po/en@quot/LC_MESSAGES/actuar.mo0000644000176200001440000000672114522557714020162 0ustar liggesusers!$/, /:'8b++0 $51g z     &@"g#####(>)g/AUk/3 :5 8p + + 0 2 5? u - &N "u # # # # #( (L )u  / A U# y        !'A' is 0-diml'order' (%.2f) must be integer, rounded to %.0fLAPACK routine dgebal returned info code %d when permutingLAPACK routine dgebal returned info code %d when scalingLAPACK routine dgetrf returned info code %dLAPACK routine dgetrs returned info code %dLapack routine dgesv: system is exactly singularNAs producedargument %d of Lapack routine dgesv had invalid valueintegration failedinternal error in actuar_do_dpq1internal error in actuar_do_dpq2internal error in actuar_do_dpq3internal error in actuar_do_dpq4internal error in actuar_do_dpq5internal error in actuar_do_dpq6internal error in actuar_do_dpqphtype2internal error in actuar_do_randominternal error in actuar_do_random1internal error in actuar_do_random2internal error in actuar_do_random3internal error in actuar_do_random4internal error in actuar_do_random5internal error in actuar_do_randomphtypeinternal error in actuar_do_randomphtype2invalid argumentsmaximum number of iterations must be at least 1maximum number of iterations reached before obtaining convergencemaximum number of recursions reached before the probability distribution was completeno right-hand side in 'B'non-conformable argumentsnon-square sub-intensity matrixProject-Id-Version: actuar 3.3-4 Report-Msgid-Bugs-To: PO-Revision-Date: 2023-11-07 14:41-0500 Last-Translator: Automatically generated Language-Team: none Language: en MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Plural-Forms: nplurals=2; plural=(n != 1); ‘A’ is 0-diml‘order’ (%.2f) must be integer, rounded to %.0fLAPACK routine dgebal returned info code %d when permutingLAPACK routine dgebal returned info code %d when scalingLAPACK routine dgetrf returned info code %dLAPACK routine dgetrs returned info code %dLapack routine dgesv: system is exactly singularNAs producedargument %d of Lapack routine dgesv had invalid valueintegration failedinternal error in actuar_do_dpq1internal error in actuar_do_dpq2internal error in actuar_do_dpq3internal error in actuar_do_dpq4internal error in actuar_do_dpq5internal error in actuar_do_dpq6internal error in actuar_do_dpqphtype2internal error in actuar_do_randominternal error in actuar_do_random1internal error in actuar_do_random2internal error in actuar_do_random3internal error in actuar_do_random4internal error in actuar_do_random5internal error in actuar_do_randomphtypeinternal error in actuar_do_randomphtype2invalid argumentsmaximum number of iterations must be at least 1maximum number of iterations reached before obtaining convergencemaximum number of recursions reached before the probability distribution was completeno right-hand side in ‘B’non-conformable argumentsnon-square sub-intensity matrixactuar/inst/NEWS.1.Rd0000644000176200001440000002436714264305077013734 0ustar liggesusers\name{NEWS} \title{actuar News} \encoding{UTF-8} \section{LATER NEWS}{ This file covers NEWS for the 1.x series. News for \pkg{actuar} 2.0-0 and later can be found in file \file{NEWS.Rd}. } \section{CHANGES IN VERSION 1.2-2}{ \subsection{BUG FIX}{ \itemize{ \item dpareto() did not handle the case x == 0 correctly. } } } \section{CHANGES IN VERSION 1.2-1}{ \subsection{(MORE OR LESS) USER-VISIBLE CHANGES}{ \itemize{ \item The package now depends on R >= 3.3.0 since it uses chkDots() in a few methods that do not use the content of their '...' argument. \item ogive() lost its argument '...' as it was unused anyway. \item severity.portfolio() calls unroll() directly instead of relying on the default method to be identical to unroll(). } } \subsection{BUG FIXES}{ \itemize{ \item Deleted an unwanted debugging message ("local") printed by CTE() at every execution. \item predict.cm() and summary.cm() now treat the '...' argument as advertised in the help file. \item Fixed bad examples in a few probability law help files that returned unintended results such as Inf or NaN. } } \subsection{MAINTENANCE}{ \itemize{ \item C-level function log1pexp(...) used in a few places in lieu of log1p(exp(...)). \item Names of the internal utility macros defined in dpq.h changed from "R_<...>" to "ACT_<...>" to make it clearer that they are defined by the package (although they were copied from R sources). } } } \section{CHANGES IN VERSION 1.2-0}{ \subsection{NEW FEATURE}{ \itemize{ \item In the computation of the CTE in the Normal Power case, numerical integration has been replaced by the explicit formula given in Castañer, A.; Claramunt, M.M.; Mármol, M. (2013). Tail value at risk. An analysis with the Normal-Power approximation. In Statistical and Soft Computing Approaches in Insurance Problems. Nova Science Publishers. ISBN 978-1-62618-506-7. } } } \section{CHANGES IN VERSION 1.1-10}{ \subsection{BUG FIX}{ \itemize{ \item Results of 'cm' for hierarchical models would get incorrectly sorted when there were 10 nodes or more at a given level. Thanks to Dylan Wienke \email{dwienke2@gmail.com} for the catch. } } } \section{CHANGES IN VERSION 1.1-9}{ \subsection{MAINTENANCE}{ \itemize{ \item Functions 'head' and 'tail' explicitly imported from package utils in NAMESPACE as per a new requirement of R 3.3.x. } } } \section{CHANGES IN VERSION 1.1-8}{ \subsection{BUG FIXES}{ \itemize{ \item Memory allocation problem at the C level in hierarc(). Thanks to Prof. Ripley for identification of the problem and help solving it. \item Abusive use of abs() at the C level in a few places. } } } \section{CHANGES IN VERSION 1.1-7}{ \subsection{BUG FIX}{ \itemize{ \item panjer() result was wrong for the "logarithmic" type of frequency distribution. Thanks to \email{mmclaramunt@ub.edu} for the catch. } } } \section{CHANGES IN VERSION 1.1-6}{ \subsection{BUG FIX}{ \itemize{ \item Fixed a deprecated use of real(). } } } \section{CHANGES IN VERSION 1.1-5}{ \subsection{USER-VISIBLE CHANGES}{ \itemize{ \item Complete rewrite of coverage(); the function it creates no longer relies on ifelse() and, consequently, is much faster. The rewrite was motivated by a change in the way [dp]gamma() handle their arguments in R 2.15.1. } } \subsection{BUG FIX}{ \itemize{ \item summary.ogive() no longer relies on length 'n' to be in the environment of a function created by approxfun(). Fix required by R >= 2.16.0. } } } \section{CHANGES IN VERSION 1.1-4}{ \subsection{USER-VISIBLE CHANGES}{ \itemize{ \item The function resulting from elev() for individual data is now faster for a large number of limits. (Thanks to Frank Zhan \email{FrankZhan@donegalgroup.com} for the catch and report.) } } } \section{CHANGES IN VERSION 1.1-3}{ \subsection{BUG FIX}{ \itemize{ \item Resolved symbol clash at C level tickled by package GeneralizedHyperbolic on Solaris. \item Wrong result given by levinvGauss() because the upper tail of the normal distribution was used in the calculation instead of the lower tail. Thanks to Dan Murphy \email{chiefmurphy@gmail.com} for the heads up. } } } \section{CHANGES IN VERSION 1.1-2}{ \subsection{BUG FIX}{ \itemize{ \item \code{discretize()} would return wrong results when argument \code{step} was omitted in favor of \code{by} \emph{and} the discretization method \code{unbiased} was used. (Thanks to Marie-Pier Côté \email{marie-pier.cote.11@ulaval.ca} for the catch.) } } } \section{CHANGES IN VERSION 1.1-1}{ \subsection{USER-VISIBLE CHANGES}{ \itemize{ \item CITATION file updated. } } \subsection{BUG FIX}{ \itemize{ \item \code{summary.cm()} could skip records in the output thinking they were duplicates. } } } \section{CHANGES IN VERSION 1.1-0}{ \subsection{NEW FEATURES}{ \itemize{ \item New argument \code{convolve} in \code{aggregateDist()} to convolve the distribution obtained with the recursive method a number of times with itself. This is used for large portfolios where the expected number of claims is so large that recursions cannot start. Dividing the frequency parameter by \eqn{2^n} and convolving \eqn{n} times can solve the problem. \item New method of \code{diff()} for \code{"aggregateDist"} objects to return the probability mass function at the knots of the aggregate distribution. Valid (and defined) for \code{"recursive"}, \code{"exact"} and \code{"simulation"} methods only. \item Since the terminology Tail Value-at-Risk is often used instead of Conditional Tail Expectation, \code{TVaR()} is now an alias for \code{CTE()}. } } \subsection{BUG FIXES}{ \itemize{ \item Quantiles (and thus VaRs and CTEs) for \code{"aggregateDist"} objects where off by one knot of the distribution. \item \code{cm()} returned the internal classification codes instead of the original ones for hierarchical models. (Thanks to Zachary Martin for the heads up.) } } } \section{CHANGES IN VERSION 1.0-2}{ \subsection{USER-VISIBLE CHANGES}{ \itemize{ \item Functions \code{m()} and \code{lev()} now return \code{Inf} instead of \code{NaN} for infinite moments. (Thanks to David Humke for the idea.) } } \subsection{BUG FIXES}{ \itemize{ \item Non-ascii characters in one R source file prevented compilation of the package in a C locale (at least on OS X). \item For probability laws that have a strictly positive mode or a mode at zero depending on the value of one or more shape parameters, \code{d(0, ...)} did not handle correctly the case exactly at the boundary condition. (Thanks to Stephen L \email{bulls22eye@gmail.com} for the catch.) } } } \section{CHANGES IN VERSION 1.0-1}{ \subsection{USER-VISIBLE CHANGES}{ \itemize{ \item \code{levinvpareto()} works for \code{order > -shape} and defaults to \code{order = 1}, like all other \code{lev()} functions. } } \subsection{BUG FIXES}{ \itemize{ \item Functions \code{d()} handle the case \code{x == 0} correctly. \item Functions \code{q()} return \code{NaN} instead of an error when argument \code{p} is outside \eqn{[0, 1]} (as in R). \item Functions \code{r()} for three parameter distributions (e.g. Burr) no longer wrongly display the \code{"NaNs produced"} warning message. \item The warning message \code{"NaNs produced"} was not (and could not be) translated. \item Function \code{levinvpareto()} computes limited moments for \code{order > -shape} using numerical integration. } } } \section{CHANGES IN VERSION 1.0-0}{ \subsection{NEW FEATURES}{ \itemize{ \item Improved support for regression credibility models. There is now an option to make the computations with the intercept at the barycenter of time. This assures that the credibility adjusted regression line (or plane, or ...) lies between the individual and collective ones. In addition, contracts without data are now supported like in other credibility models. \item Argument \code{right} for \code{grouped.data()} to allow intervals closed on the right (default) or on the left. \item Method of \code{quantile()} for grouped data objects to compute the inverse of the ogive. } } \subsection{USER-VISIBLE CHANGES}{ \itemize{ \item \code{cm()} no longer returns the values of the unbiased estimators when \code{method = "iterative"}. \item Specification of regression models in \code{cm()} has changed: one should now provide the regression model as a formula and the regressors in a separate matrix or data frame. \item Due to above change, \code{predict.cm()} now expects \code{newdata} to be a data frame as for \code{stats:::predict.lm()}. } } \subsection{DEFUNCT}{ \itemize{ \item Function \code{bstraub()} is no longer exported. Users are expected to use \code{cm()} as interface instead. } } \subsection{BUG FIXES}{ \itemize{ \item Functions \code{r()} are now more consistent in warning when \code{NA}s (specifically \code{NaN}s) are generated (as per the change in R 2.7.0). \item \code{frequency.portfolio()} was wrongly counting \code{NA}s. \item Domain of pdfs returned by \code{aggregateDist()} now restricted to \eqn{[0, 1]}. \item Quantiles are now computed correctly (and more efficiently) in 0 and 1 by \code{quantile.aggregateDist()}. \item \code{coverage()} no longer requires a cdf when it is not needed, namely when there is no deductible and no limit. } } } \section{OLDER NEWS}{ News for \pkg{actuar} 0.9.7 and earlier can be found in file \file{NEWS.0.Rd}. } actuar/po/0000755000176200001440000000000014522560035012151 5ustar liggesusersactuar/po/R-actuar.pot0000644000176200001440000001341614522557714014372 0ustar liggesusersmsgid "" msgstr "" "Project-Id-Version: actuar 3.3-4\n" "POT-Creation-Date: 2023-11-07 14:41\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME \n" "Language-Team: LANGUAGE \n" "Language: \n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=CHARSET\n" "Content-Transfer-Encoding: 8bit\n" msgid "rows extracted in increasing order" msgstr "" msgid "impossible to replace boundaries and frequencies simultaneously" msgstr "" msgid "only logical matrix subscripts are allowed in replacement" msgstr "" msgid "need 0, 1, or 2 subscripts" msgstr "" msgid "one of %s or %s is needed" msgstr "" msgid "mgf.claim" msgstr "" msgid "h" msgstr "" msgid "%s must be a function or an expression containing %s" msgstr "" msgid "x" msgstr "" msgid "mgf.wait" msgstr "" msgid "%s must be a function or an expression containing %s and %s" msgstr "" msgid "y" msgstr "" msgid "%s must be a function when using reinsurance" msgstr "" msgid "premium.rate" msgstr "" msgid "%s must supply the mean and variance of the distribution" msgstr "" msgid "moments" msgstr "" msgid "%s must supply the mean, variance and skewness of the distribution" msgstr "" msgid "%s must supply the number of simulations" msgstr "" msgid "nb.simul" msgstr "" msgid "expressions in %s and %s must be named" msgstr "" msgid "model.freq" msgstr "" msgid "model.sev" msgstr "" msgid "%s must be a vector of probabilities" msgstr "" msgid "frequency distribution must be supplied as a character string" msgstr "" msgid "internal error" msgstr "" msgid "function not defined for approximating distributions" msgstr "" msgid "lower bound of the likelihood missing" msgstr "" msgid "one of the Gamma prior parameter %s, %s or %s missing" msgstr "" msgid "shape" msgstr "" msgid "rate" msgstr "" msgid "scale" msgstr "" msgid "one of the Beta prior parameter %s or %s missing" msgstr "" msgid "shape1" msgstr "" msgid "shape2" msgstr "" msgid "parameter %s of the likelihood missing" msgstr "" msgid "size" msgstr "" msgid "shape.lik" msgstr "" msgid "sd.lik" msgstr "" msgid "unsupported likelihood" msgstr "" msgid "missing ratios not allowed when weights are not supplied" msgstr "" msgid "there must be at least one node with more than one period of experience" msgstr "" msgid "there must be more than one node" msgstr "" msgid "missing values are not in the same positions in %s and in %s" msgstr "" msgid "weights" msgstr "" msgid "ratios" msgstr "" msgid "no available data to fit model" msgstr "" msgid "maximum number of iterations reached before obtaining convergence" msgstr "" msgid "unsupported interactions in %s" msgstr "" msgid "formula" msgstr "" msgid "hierarchical regression models not supported" msgstr "" msgid "ratios have to be supplied if weights are" msgstr "" msgid "empty regression model; fitting with Buhlmann-Straub's model" msgstr "" msgid "invalid level name" msgstr "" msgid "coverage modifications must be positive" msgstr "" msgid "deductible must be smaller than the limit" msgstr "" msgid "coinsurance must be between 0 and 1" msgstr "" msgid "%s must be supplied" msgstr "" msgid "cdf" msgstr "" msgid "%s required with method %s" msgstr "" msgid "lev" msgstr "" msgid "unbiased" msgstr "" msgid "%s must be positive" msgstr "" msgid "order" msgstr "" msgid "%s not used when %s is specified" msgstr "" msgid "nclass" msgstr "" msgid "breaks" msgstr "" msgid "%s ignored when %s is specified" msgstr "" msgid "group" msgstr "" msgid "invalid number of group boundaries and frequencies" msgstr "" msgid "missing frequencies replaced by zeros" msgstr "" msgid "missing values are not in the same positions in 'weights' and in 'ratios'" msgstr "" msgid "there must be at least two nodes at every level" msgstr "" msgid "invalid level number" msgstr "" msgid "infinite group boundaries" msgstr "" msgid "%s is an alias for %s, however they differ." msgstr "" msgid "probability" msgstr "" msgid "!freq" msgstr "" msgid "%s must be a named list" msgstr "" msgid "start" msgstr "" msgid "%s must be supplied as a function" msgstr "" msgid "fun" msgstr "" msgid "%s must be a numeric vector or an object of class %s" msgstr "" msgid "grouped.data" msgstr "" msgid "%s specifies names which are not arguments to %s" msgstr "" msgid "%s measure requires an object of class %s" msgstr "" msgid "chi-square" msgstr "" msgid "frequency must be larger than 0 in all groups" msgstr "" msgid "LAS" msgstr "" msgid "optimization failed" msgstr "" msgid "%s has many elements: only the first used" msgstr "" msgid "p0" msgstr "" msgid "%s must be a valid probability (between 0 and 1)" msgstr "" msgid "value of %s ignored with a zero-truncated distribution" msgstr "" msgid "value of %s missing" msgstr "" msgid "lambda" msgstr "" msgid "value of %s or %s missing" msgstr "" msgid "prob" msgstr "" msgid "frequency distribution not in the (a, b, 0) or (a, b, 1) families" msgstr "" msgid "Pr[S = 0] is numerically equal to 0; impossible to start the recursion" msgstr "" msgid "nodes" msgstr "" msgid "level names different in %s, %s and %s" msgstr "" msgid "one of %s or %s must be non-NULL" msgstr "" msgid "nothing to do" msgstr "" msgid "invalid %s specification" msgstr "" msgid "by" msgstr "" msgid "invalid first argument %s" msgstr "" msgid "n" msgstr "" msgid "invalid values in %s" msgstr "" msgid "no positive probabilities" msgstr "" msgid "invalid third argument %s" msgstr "" msgid "models" msgstr "" msgid "par.claims" msgstr "" msgid "par.wait" msgstr "" msgid "parameters %s missing in %s" msgstr "" msgid "," msgstr "" msgid "parameter %s missing in %s" msgstr "" msgid "parameter %s or %s missing in %s" msgstr "" msgid "rates" msgstr "" msgid "invalid parameters in %s" msgstr "" msgid "%s must be a vector or a matrix" msgstr "" actuar/po/actuar.pot0000644000176200001440000000650314522557714014172 0ustar liggesusers# SOME DESCRIPTIVE TITLE. # Copyright (C) YEAR THE PACKAGE'S COPYRIGHT HOLDER # This file is distributed under the same license as the actuar package. # FIRST AUTHOR , YEAR. # #, fuzzy msgid "" msgstr "" "Project-Id-Version: actuar 3.3-4\n" "Report-Msgid-Bugs-To: \n" "POT-Creation-Date: 2023-11-07 14:41-0500\n" "PO-Revision-Date: YEAR-MO-DA HO:MI+ZONE\n" "Last-Translator: FULL NAME \n" "Language-Team: LANGUAGE \n" "Language: \n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=CHARSET\n" "Content-Transfer-Encoding: 8bit\n" #: betaint.c:143 dpq.c:105 dpq.c:241 dpq.c:497 dpq.c:697 dpq.c:875 dpq.c:1055 #: dpqphtype.c:57 random.c:134 random.c:141 random.c:235 random.c:242 #: random.c:353 random.c:360 random.c:467 random.c:474 random.c:579 #: random.c:586 randomphtype.c:74 randomphtype.c:81 msgid "invalid arguments" msgstr "" #: dpq.c:208 msgid "internal error in actuar_do_dpq1" msgstr "" #: dpq.c:463 msgid "internal error in actuar_do_dpq2" msgstr "" #: dpq.c:659 msgid "internal error in actuar_do_dpq3" msgstr "" #: dpq.c:838 msgid "internal error in actuar_do_dpq4" msgstr "" #: dpq.c:1014 msgid "internal error in actuar_do_dpq5" msgstr "" #: dpq.c:1160 msgid "internal error in actuar_do_dpq6" msgstr "" #: dpqphtype.c:177 msgid "internal error in actuar_do_dpqphtype2" msgstr "" #: fpareto.c:186 fpareto.c:246 pareto2.c:139 pareto2.c:193 pareto3.c:144 #: pareto3.c:199 pareto4.c:160 pareto4.c:219 #, c-format msgid "'order' (%.2f) must be integer, rounded to %.0f" msgstr "" #: hierarc.c:100 invgauss.c:209 msgid "maximum number of iterations reached before obtaining convergence" msgstr "" #: invgauss.c:150 msgid "maximum number of iterations must be at least 1" msgstr "" #: invpareto.c:185 msgid "integration failed" msgstr "" #: panjer.c:71 panjer.c:114 msgid "" "maximum number of recursions reached before the probability distribution was " "complete" msgstr "" #: random.c:81 msgid "NAs produced" msgstr "" #: random.c:171 msgid "internal error in actuar_do_random1" msgstr "" #: random.c:287 msgid "internal error in actuar_do_random2" msgstr "" #: random.c:399 msgid "internal error in actuar_do_random3" msgstr "" #: random.c:509 msgid "internal error in actuar_do_random4" msgstr "" #: random.c:621 msgid "internal error in actuar_do_random5" msgstr "" #: random.c:651 msgid "internal error in actuar_do_random" msgstr "" #: randomphtype.c:101 msgid "non-square sub-intensity matrix" msgstr "" #: randomphtype.c:104 msgid "non-conformable arguments" msgstr "" #: randomphtype.c:123 msgid "internal error in actuar_do_randomphtype2" msgstr "" #: randomphtype.c:150 msgid "internal error in actuar_do_randomphtype" msgstr "" #: util.c:106 #, c-format msgid "LAPACK routine dgebal returned info code %d when permuting" msgstr "" #: util.c:110 #, c-format msgid "LAPACK routine dgebal returned info code %d when scaling" msgstr "" #: util.c:157 #, c-format msgid "LAPACK routine dgetrf returned info code %d" msgstr "" #: util.c:160 #, c-format msgid "LAPACK routine dgetrs returned info code %d" msgstr "" #: util.c:266 msgid "'A' is 0-diml" msgstr "" #: util.c:268 msgid "no right-hand side in 'B'" msgstr "" #: util.c:279 #, c-format msgid "argument %d of Lapack routine dgesv had invalid value" msgstr "" #: util.c:282 msgid "Lapack routine dgesv: system is exactly singular" msgstr "" actuar/po/it.po0000644000176200001440000001143214326566100013127 0ustar liggesusers# Italian translation for actuar package # Copyright (C) 2022 Daniele Medri # This file is distributed under the same license as the actuar package. # Daniele Medri , 2022. # msgid "" msgstr "" "Project-Id-Version: actuar 1.1-7\n" "Report-Msgid-Bugs-To: \n" "POT-Creation-Date: 2022-10-27 15:25-0400\n" "PO-Revision-Date: 2022-04-13 11:12+0200\n" "Last-Translator: Daniele Medri \n" "Language-Team: Daniele Medri \n" "Language: it_IT\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n != 1);\n" "X-Generator: Poedit 2.4.2\n" #: betaint.c:143 dpq.c:105 dpq.c:241 dpq.c:497 dpq.c:697 dpq.c:875 dpq.c:1055 #: dpqphtype.c:57 random.c:134 random.c:141 random.c:235 random.c:242 #: random.c:353 random.c:360 random.c:467 random.c:474 random.c:579 #: random.c:586 randomphtype.c:74 randomphtype.c:81 msgid "invalid arguments" msgstr "argomenti non validi" #: dpq.c:208 msgid "internal error in actuar_do_dpq1" msgstr "errore interno in actuar_do_dpq1" #: dpq.c:463 msgid "internal error in actuar_do_dpq2" msgstr "errore interno in actuar_do_dpq2" #: dpq.c:659 msgid "internal error in actuar_do_dpq3" msgstr "errore interno in actuar_do_dpq3" #: dpq.c:838 msgid "internal error in actuar_do_dpq4" msgstr "errore interno in actuar_do_dpq4" #: dpq.c:1014 msgid "internal error in actuar_do_dpq5" msgstr "errore interno in actuar_do_dpq5" #: dpq.c:1160 msgid "internal error in actuar_do_dpq6" msgstr "errore interno in actuar_do_dpq6" #: dpqphtype.c:177 msgid "internal error in actuar_do_dpqphtype2" msgstr "errore interno in actuar_do_dpqphtype2" #: fpareto.c:186 fpareto.c:246 pareto2.c:139 pareto2.c:193 pareto3.c:144 #: pareto3.c:199 pareto4.c:160 pareto4.c:219 #, c-format msgid "'order' (%.2f) must be integer, rounded to %.0f" msgstr "'order' (%.2f) dev'essere un intero, arrotondato a %.0f" #: hierarc.c:100 invgauss.c:209 msgid "maximum number of iterations reached before obtaining convergence" msgstr "raggiunto il numero massimo di iterazioni prima della convergenza" #: invgauss.c:150 msgid "maximum number of iterations must be at least 1" msgstr "il numero massimo di iterazioni dev'essere almeno 1" #: invpareto.c:185 msgid "integration failed" msgstr "integrazione fallita" #: panjer.c:71 panjer.c:114 msgid "" "maximum number of recursions reached before the probability distribution was " "complete" msgstr "" "raggiunto il numero massimo di ricorsioni prima che la distribuzione di " "probabilità fosse completata" #: random.c:81 msgid "NAs produced" msgstr "Generati valori NA" #: random.c:171 msgid "internal error in actuar_do_random1" msgstr "errore interno in actuar_do_random1" #: random.c:287 msgid "internal error in actuar_do_random2" msgstr "errore interno in actuar_do_random2" #: random.c:399 msgid "internal error in actuar_do_random3" msgstr "errore interno in actuar_do_random3" #: random.c:509 msgid "internal error in actuar_do_random4" msgstr "errore interno in actuar_do_random4" #: random.c:621 msgid "internal error in actuar_do_random5" msgstr "errore interno in actuar_do_random5" #: random.c:651 msgid "internal error in actuar_do_random" msgstr "errore interno in actuar_do_random" #: randomphtype.c:101 msgid "non-square sub-intensity matrix" msgstr "matrice non quadrata" #: randomphtype.c:104 msgid "non-conformable arguments" msgstr "gli argomenti non sono compatibili" #: randomphtype.c:123 msgid "internal error in actuar_do_randomphtype2" msgstr "errore interno in actuar_do_randomphtype2" #: randomphtype.c:150 msgid "internal error in actuar_do_randomphtype" msgstr "errore interno in actuar_do_randomphtype" #: util.c:106 #, c-format msgid "LAPACK routine dgebal returned info code %d when permuting" msgstr "" "La routine dgebal di LAPACK ha restituito il codice informativo %d durante " "la permutazione" #: util.c:110 #, c-format msgid "LAPACK routine dgebal returned info code %d when scaling" msgstr "" "La routine dgebal di LAPACK ha restituito il codice informativo %d durante " "lo scaling" #: util.c:157 #, c-format msgid "LAPACK routine dgetrf returned info code %d" msgstr "La routine dgetrf di LAPACK ha restituito il codice informativo %d" #: util.c:160 #, c-format msgid "LAPACK routine dgetrs returned info code %d" msgstr "La routine dgetrs di LAPACK ha restituito il codice informativo %d" #: util.c:266 msgid "'A' is 0-diml" msgstr "'A' è 0-diml" #: util.c:268 msgid "no right-hand side in 'B'" msgstr "nessun membro di destra in 'B'" #: util.c:279 #, c-format msgid "argument %d of Lapack routine dgesv had invalid value" msgstr "l'argomento %d della routine dgesv di Lapack ha un valore non valido" #: util.c:282 msgid "Lapack routine dgesv: system is exactly singular" msgstr "La routine dgesv di Lapack: il sistema è esattamente singolare" actuar/po/R-it.po0000644000176200001440000002271414522557714013344 0ustar liggesusers# Italian translation for actuar package # Copyright (C) 2022 Daniele Medri # This file is distributed under the same license as the actuar package. # Daniele Medri , 2022. # msgid "" msgstr "" "Project-Id-Version: actuar 2.0-0\n" "Report-Msgid-Bugs-To: bugs@r-project.org\n" "POT-Creation-Date: 2023-11-07 14:41\n" "PO-Revision-Date: 2023-11-07 14:46-0500\n" "Last-Translator: Daniele Medri \n" "Language-Team: Daniele Medri \n" "Language: it\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" "X-Generator: Poedit 2.4.2\n" msgid "rows extracted in increasing order" msgstr "righe estratte in ordine crescente" msgid "impossible to replace boundaries and frequencies simultaneously" msgstr "non è possibile sostituire estremi e frequenze contemporaneamente" msgid "only logical matrix subscripts are allowed in replacement" msgstr "in sostituzione sono consentiti solo pedici di matrice logica" msgid "need 0, 1, or 2 subscripts" msgstr "richiede 0, 1 o due indici" msgid "one of %s or %s is needed" msgstr "richiesto uno di %s o %s" msgid "mgf.claim" msgstr "mgf.claim" msgid "h" msgstr "h" msgid "%s must be a function or an expression containing %s" msgstr "%s dev'essere una funzione o un'espressione contenente %s" msgid "x" msgstr "x" msgid "mgf.wait" msgstr "mgf.wait" msgid "%s must be a function or an expression containing %s and %s" msgstr "%s dev'essere una funzione o un'espressione contenente %s e %s" msgid "y" msgstr "y" msgid "%s must be a function when using reinsurance" msgstr "%s dev'essere una funzione quando si utilizza la riassicurazione" msgid "premium.rate" msgstr "premium.rate" msgid "%s must supply the mean and variance of the distribution" msgstr "%s deve fornire la media e la varianza della distribuzione" msgid "moments" msgstr "moments" msgid "%s must supply the mean, variance and skewness of the distribution" msgstr "" "%s deve fornire la media, la varianza e l'asimmetria della distribuzione" msgid "%s must supply the number of simulations" msgstr "%s deve indicare il numero di simulazioni" msgid "nb.simul" msgstr "nb.simul" msgid "expressions in %s and %s must be named" msgstr "le espressioni in %s e %s devono essere indicate" msgid "model.freq" msgstr "model.freq" msgid "model.sev" msgstr "model.sev" msgid "%s must be a vector of probabilities" msgstr "%s dev'essere un vettore di probabilità" msgid "frequency distribution must be supplied as a character string" msgstr "" "la distribuzione di frequenza devono essere passate come una stringa " "carattere" msgid "internal error" msgstr "errore interno" msgid "function not defined for approximating distributions" msgstr "funzione non definita per approssimare distribuzioni" msgid "lower bound of the likelihood missing" msgstr "estremo inferiore mancante per la verosimiglianza" msgid "one of the Gamma prior parameter %s, %s or %s missing" msgstr "manca uno dei parametri Gamma a priori tra %s, %s o %s" msgid "shape" msgstr "shape" msgid "rate" msgstr "rate" msgid "scale" msgstr "scale" msgid "one of the Beta prior parameter %s or %s missing" msgstr "manca uno dei parametri Beta a priori tra %s o %s" msgid "shape1" msgstr "shape1" msgid "shape2" msgstr "shape2" msgid "parameter %s of the likelihood missing" msgstr "parametro %s mancante per la verosimiglianza" msgid "size" msgstr "size" msgid "shape.lik" msgstr "shape.lik" msgid "sd.lik" msgstr "sd.lik" msgid "unsupported likelihood" msgstr "verosimiglianza non supportata" msgid "missing ratios not allowed when weights are not supplied" msgstr "non sono ammessi rapporti mancanti quando i pesi non sono indicati" msgid "there must be at least one node with more than one period of experience" msgstr "dev'esserci almeno un nodo con più di un periodo di esperienza" msgid "there must be more than one node" msgstr "dev'esserci più di un nodo" msgid "missing values are not in the same positions in %s and in %s" msgstr "i valori mancanti non sono nelle medesime posizioni in %s e in %s" msgid "weights" msgstr "weights" msgid "ratios" msgstr "ratios" msgid "no available data to fit model" msgstr "non ci sono abbastanza dati per stimare il modello" msgid "maximum number of iterations reached before obtaining convergence" msgstr "raggiunto il numero massimo di iterazioni prima della convergenza" msgid "unsupported interactions in %s" msgstr "interazioni non supportate in %s" msgid "formula" msgstr "formula" msgid "hierarchical regression models not supported" msgstr "modelli di regressione gerarchica non supportati" msgid "ratios have to be supplied if weights are" msgstr "i rapporti devono essere passati se i pesi sono" msgid "empty regression model; fitting with Buhlmann-Straub's model" msgstr "modello di regressione vuoto; stima con il modello Buhlmann-Straub" msgid "invalid level name" msgstr "nome livello non valido" msgid "coverage modifications must be positive" msgstr "le modifiche alla copertura devono essere positive" msgid "deductible must be smaller than the limit" msgstr "deductible dev'essere più piccolo del limite" msgid "coinsurance must be between 0 and 1" msgstr "coinsurance dev'essere tra 0 e 1" msgid "%s must be supplied" msgstr "%s dev'essere passata" msgid "cdf" msgstr "cdf" msgid "%s required with method %s" msgstr "%s richiesto con il metodo %s" msgid "lev" msgstr "lev" msgid "unbiased" msgstr "unbiased" msgid "%s must be positive" msgstr "%s dev'essere positivo" msgid "order" msgstr "order" msgid "%s not used when %s is specified" msgstr "%s non viene usata quando viene specificato %s" msgid "nclass" msgstr "nclass" msgid "breaks" msgstr "breaks" msgid "%s ignored when %s is specified" msgstr "%s ignorato quando %s è presente" msgid "group" msgstr "group" msgid "invalid number of group boundaries and frequencies" msgstr "numero di estremi di gruppo e frequenze non valido" msgid "missing frequencies replaced by zeros" msgstr "frequenze mancanti sostituite con zero" msgid "" "missing values are not in the same positions in 'weights' and in 'ratios'" msgstr "" "i valori mancanti non sono nelle medesime posizioni in 'weights' e in " "'ratios'" msgid "there must be at least two nodes at every level" msgstr "devono esserci almeno due nodi in ogni livello" msgid "invalid level number" msgstr "numero livello non valido" msgid "infinite group boundaries" msgstr "estremi di gruppo non finiti" msgid "%s is an alias for %s, however they differ." msgstr "%s è un alisa per %s, comunque sono differenti." msgid "probability" msgstr "probability" msgid "!freq" msgstr "!freq" msgid "%s must be a named list" msgstr "%s dev'essere una lista nominata" msgid "start" msgstr "start" msgid "%s must be supplied as a function" msgstr "%s dev'essere passata come una funzione" msgid "fun" msgstr "fun" msgid "%s must be a numeric vector or an object of class %s" msgstr "%s dev'essere un vettore numerico o un oggetto di classe %s" msgid "grouped.data" msgstr "grouped.data" msgid "%s specifies names which are not arguments to %s" msgstr "%s specifica nomi che non sono argomenti per %s" msgid "%s measure requires an object of class %s" msgstr "la misura %s richiede un oggetto di classe %s" msgid "chi-square" msgstr "chi-square" msgid "frequency must be larger than 0 in all groups" msgstr "la frequenza dev'essere più grande di 0 in tutti i gruppi" msgid "LAS" msgstr "LAS" msgid "optimization failed" msgstr "ottimizzazione fallita" msgid "%s has many elements: only the first used" msgstr "%s ha molti elementi: solo il primo è utilizzato" msgid "p0" msgstr "p0" msgid "%s must be a valid probability (between 0 and 1)" msgstr "%s dev'essere una probabilità valida (tra 0 e 1)" msgid "value of %s ignored with a zero-truncated distribution" msgstr "valore di %s ignorato con una distribuzione troncata zero" msgid "value of %s missing" msgstr "valore di %s mancante" msgid "lambda" msgstr "lambda" msgid "value of %s or %s missing" msgstr "valore di %s o %s mancante" msgid "prob" msgstr "prob" msgid "frequency distribution not in the (a, b, 0) or (a, b, 1) families" msgstr "distribuzione di frequenza non nelle famiglie (a, b, 0) o (a, b, 1)" msgid "Pr[S = 0] is numerically equal to 0; impossible to start the recursion" msgstr "" "Pr[S = 0] è numericamente uguale a 0; non è possibile avviare la ricorsione" msgid "nodes" msgstr "nodes" msgid "level names different in %s, %s and %s" msgstr "nomi livello differenti in %s, %s e %s" msgid "one of %s or %s must be non-NULL" msgstr "uno di %s o %s non dev'essere NULL" msgid "nothing to do" msgstr "niente da fare" msgid "invalid %s specification" msgstr "specificazione di %s non valida" msgid "by" msgstr "by" msgid "invalid first argument %s" msgstr "primo argomento %s non valido" msgid "n" msgstr "n" msgid "invalid values in %s" msgstr "valori non validi in %s" msgid "no positive probabilities" msgstr "nessuna probabilità positiva" msgid "invalid third argument %s" msgstr "terzo argomento %s non valido" msgid "models" msgstr "models" msgid "par.claims" msgstr "par.claims" msgid "par.wait" msgstr "par.wait" msgid "parameters %s missing in %s" msgstr "parametri %s mancanti in %s" msgid "," msgstr "," msgid "parameter %s missing in %s" msgstr "parametri %s mancanti in %s" msgid "parameter %s or %s missing in %s" msgstr "parametri %s o %s mancanti in %s" msgid "rates" msgstr "rates" msgid "invalid parameters in %s" msgstr "parametri non validi in %s" msgid "%s must be a vector or a matrix" msgstr "%s dev'essere un vettore numerico o una matrice" actuar/po/R-fr.po0000644000176200001440000002325714522557714013342 0ustar liggesusers# French translations for actuar package # Traduction française du package actuar. # Copyright (C) 2016 Vincent Goulet # This file is distributed under the same license as the actuar package. # Vincent Goulet , 2010. # msgid "" msgstr "" "Project-Id-Version: actuar 2.0-0\n" "Report-Msgid-Bugs-To: bugs@r-project.org\n" "POT-Creation-Date: 2023-11-07 14:41\n" "PO-Revision-Date: 2023-11-07 14:45-0500\n" "Last-Translator: Vincent Goulet \n" "Language-Team: Vincent Goulet \n" "Language: fr\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" msgid "rows extracted in increasing order" msgstr "lignes extraites en ordre croissant" msgid "impossible to replace boundaries and frequencies simultaneously" msgstr "impossible de remplacer simultanément les bornes et les fréquences" msgid "only logical matrix subscripts are allowed in replacement" msgstr "seuls les indices logiques sont permis pour le remplacement" msgid "need 0, 1, or 2 subscripts" msgstr "il faut 0, 1 ou 2 indices" msgid "one of %s or %s is needed" msgstr "l'une ou l'autre de %s ou %s est requise" msgid "mgf.claim" msgstr "mgf.claim" msgid "h" msgstr "h" msgid "%s must be a function or an expression containing %s" msgstr "%s doit être une fonction ou une expression contenant %s" msgid "x" msgstr "x" msgid "mgf.wait" msgstr "mgf.wait" msgid "%s must be a function or an expression containing %s and %s" msgstr "%s doit être une fonction ou une expression contenant %s et %s" msgid "y" msgstr "y" msgid "%s must be a function when using reinsurance" msgstr "%s doit être une fonction en présence de réassurance" msgid "premium.rate" msgstr "premium.rate" msgid "%s must supply the mean and variance of the distribution" msgstr "%s doit contenir la moyenne et la variance de la distribution" msgid "moments" msgstr "moments" msgid "%s must supply the mean, variance and skewness of the distribution" msgstr "" "%s doit contenir la moyenne, la variance et l'asymétrie de la distribution" msgid "%s must supply the number of simulations" msgstr "%s doit spécifier le nombre de simulations" msgid "nb.simul" msgstr "nb.simul" msgid "expressions in %s and %s must be named" msgstr "les expressions dans %s et %s doivent être nommées" msgid "model.freq" msgstr "model.freq" msgid "model.sev" msgstr "model.sev" msgid "%s must be a vector of probabilities" msgstr "%s doit être un vecteur de probabilités" msgid "frequency distribution must be supplied as a character string" msgstr "" "la distribution de fréquence doit être spécifiée sous forme de chaîne de " "caractères" msgid "internal error" msgstr "erreur interne" msgid "function not defined for approximating distributions" msgstr "fonction non définie pour les méthodes d'approximation" msgid "lower bound of the likelihood missing" msgstr "seuil de la vraisemblance manquant" msgid "one of the Gamma prior parameter %s, %s or %s missing" msgstr "un des paramètres %s, %s ou %s de la loi Gamma manquant" msgid "shape" msgstr "shape" msgid "rate" msgstr "rate" msgid "scale" msgstr "scale" msgid "one of the Beta prior parameter %s or %s missing" msgstr "un des paramètres %s ou %s de la loi Bêta manquant" msgid "shape1" msgstr "shape1" msgid "shape2" msgstr "shape2" msgid "parameter %s of the likelihood missing" msgstr "paramètre %s de la vraisemblance manquant" msgid "size" msgstr "size" msgid "shape.lik" msgstr "shape.lik" msgid "sd.lik" msgstr "sd.lik" msgid "unsupported likelihood" msgstr "vraisemblance non valide" msgid "missing ratios not allowed when weights are not supplied" msgstr "ratios manquants non permis lorsque les poids ne sont pas fournis" msgid "there must be at least one node with more than one period of experience" msgstr "" "il y doit y avoir au moins un noeud avec plus d'une période d'expérience" msgid "there must be more than one node" msgstr "il doit y avoir plus d'un noeud" msgid "missing values are not in the same positions in %s and in %s" msgstr "" "les données manquantes ne sont pas aux mêmes positions dans %s et dans %s" msgid "weights" msgstr "weights" msgid "ratios" msgstr "ratios" msgid "no available data to fit model" msgstr "aucune donnée disponible pour la modélisation" msgid "maximum number of iterations reached before obtaining convergence" msgstr "nombre d'itérations maximal atteint avant obtention de la convergence" msgid "unsupported interactions in %s" msgstr "interactions non supportées dans %s" msgid "formula" msgstr "formula" msgid "hierarchical regression models not supported" msgstr "modèles de régression hiérarchiques non supportés" msgid "ratios have to be supplied if weights are" msgstr "ratios requis s'il y a des poids" msgid "empty regression model; fitting with Buhlmann-Straub's model" msgstr "modèle de régression vide; utilisation du modèle de Bühlmann-Straub" msgid "invalid level name" msgstr "nom de niveau incorrect" msgid "coverage modifications must be positive" msgstr "les modifications de couverture doivent être positives" msgid "deductible must be smaller than the limit" msgstr "la franchise doit être inférieure à la limite" msgid "coinsurance must be between 0 and 1" msgstr "le facteur de coassurance doit être entre 0 et 1" msgid "%s must be supplied" msgstr "%s doit être fourni" msgid "cdf" msgstr "cdf" msgid "%s required with method %s" msgstr "%s requis pour la méthode %s" msgid "lev" msgstr "lev" msgid "unbiased" msgstr "unbiased" msgid "%s must be positive" msgstr "%s doit être positif" msgid "order" msgstr "order" msgid "%s not used when %s is specified" msgstr "%s non utilisé quand %s est fourni" msgid "nclass" msgstr "nclass" msgid "breaks" msgstr "breaks" msgid "%s ignored when %s is specified" msgstr "%s ignoré quand %s est fourni" msgid "group" msgstr "group" msgid "invalid number of group boundaries and frequencies" msgstr "nombre de bornes de groupe et de fréquences incorrect" msgid "missing frequencies replaced by zeros" msgstr "fréquences manquantes remplacées par des zéros" msgid "" "missing values are not in the same positions in 'weights' and in 'ratios'" msgstr "" "les données manquantes ne sont pas aux mêmes positions dans les poids et " "dans les ratios" msgid "there must be at least two nodes at every level" msgstr "il doit y avoir au moins deux noeuds à chaque niveau" msgid "invalid level number" msgstr "numéro de niveau incorrect" msgid "infinite group boundaries" msgstr "bornes de groupe infinies" msgid "%s is an alias for %s, however they differ." msgstr "%s est un alias pour %s, cependant ils diffèrent." msgid "probability" msgstr "probability" msgid "!freq" msgstr "!freq" msgid "%s must be a named list" msgstr "%s doit être une liste nommée" msgid "start" msgstr "start" msgid "%s must be supplied as a function" msgstr "%s doit être fourni en tant que fonction" msgid "fun" msgstr "fun" msgid "%s must be a numeric vector or an object of class %s" msgstr "%s doit être un vecteur numérique ou un objet de classe %s" msgid "grouped.data" msgstr "grouped.data" msgid "%s specifies names which are not arguments to %s" msgstr "%s contient des noms qui ne sont pas des arguments de %s" msgid "%s measure requires an object of class %s" msgstr "la mesure %s requiert un objet de classe %s" msgid "chi-square" msgstr "chi-square" msgid "frequency must be larger than 0 in all groups" msgstr "la fréquence doit être supérieure à 0 dans tous les groupes" msgid "LAS" msgstr "LAS" msgid "optimization failed" msgstr "l'optimisation a échoué" msgid "%s has many elements: only the first used" msgstr "%s contient plusieurs éléments: seul le premier est utilisé" msgid "p0" msgstr "p0" msgid "%s must be a valid probability (between 0 and 1)" msgstr "%s doit être une probabilité (entre 0 et 1)" msgid "value of %s ignored with a zero-truncated distribution" msgstr "valeur de %s ignorée pour une distribution zéro tronquée" msgid "value of %s missing" msgstr "valeur de %s manquante" msgid "lambda" msgstr "lambda" msgid "value of %s or %s missing" msgstr "valeur de %s ou %s manquante" msgid "prob" msgstr "prob" msgid "frequency distribution not in the (a, b, 0) or (a, b, 1) families" msgstr "" "la distribution de fréquence ne fait pas partie des familles (a, b, 0) ou " "(a, b, 1)" msgid "Pr[S = 0] is numerically equal to 0; impossible to start the recursion" msgstr "" "valeur de Pr[S = 0] numériquement nulle; impossible de démarrer le calcul " "récursif" msgid "nodes" msgstr "nodes" msgid "level names different in %s, %s and %s" msgstr "noms de niveaux différents dans %s, %s et %s" msgid "one of %s or %s must be non-NULL" msgstr "un de %s ou %s doit ne pas être NULL" msgid "nothing to do" msgstr "rien à faire" msgid "invalid %s specification" msgstr "valeur de %s incorrecte" msgid "by" msgstr "by" msgid "invalid first argument %s" msgstr "premier argument %s incorrect" msgid "n" msgstr "n" msgid "invalid values in %s" msgstr "valeurs incorrectes dans %s" msgid "no positive probabilities" msgstr "aucune probabilité positive" msgid "invalid third argument %s" msgstr "troisième argument %s incorrect" msgid "models" msgstr "models" msgid "par.claims" msgstr "par.claims" msgid "par.wait" msgstr "par.wait" msgid "parameters %s missing in %s" msgstr "paramètres %s manquants dans %s" msgid "," msgstr "," msgid "parameter %s missing in %s" msgstr "paramètre %s manquant dans %s" msgid "parameter %s or %s missing in %s" msgstr "paramètre %s ou %s manquant dans %s" msgid "rates" msgstr "rates" msgid "invalid parameters in %s" msgstr "paramètres incorrects dans %s" msgid "%s must be a vector or a matrix" msgstr "%s doit être un vecteur ou une matrice" actuar/po/fr.po0000644000176200001440000001151314326566100013122 0ustar liggesusers# French translations for actuar package # Traduction française du package actuar. # Copyright (C) 2007 Vincent Goulet # This file is distributed under the same license as the actuar package. # Vincent Goulet , 2007. # msgid "" msgstr "" "Project-Id-Version: actuar 1.1-7\n" "Report-Msgid-Bugs-To: \n" "POT-Creation-Date: 2022-10-27 15:25-0400\n" "PO-Revision-Date: 2020-06-03 12:33-0400\n" "Last-Translator: Vincent Goulet \n" "Language-Team: Vincent Goulet \n" "Language: fr\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" "Plural-Forms: nplurals=2; plural=(n > 1);\n" #: betaint.c:143 dpq.c:105 dpq.c:241 dpq.c:497 dpq.c:697 dpq.c:875 dpq.c:1055 #: dpqphtype.c:57 random.c:134 random.c:141 random.c:235 random.c:242 #: random.c:353 random.c:360 random.c:467 random.c:474 random.c:579 #: random.c:586 randomphtype.c:74 randomphtype.c:81 msgid "invalid arguments" msgstr "arguments incorrects" #: dpq.c:208 msgid "internal error in actuar_do_dpq1" msgstr "erreur interne dans actuar_do_dpq1" #: dpq.c:463 msgid "internal error in actuar_do_dpq2" msgstr "erreur interne dans actuar_do_dpq2" #: dpq.c:659 msgid "internal error in actuar_do_dpq3" msgstr "erreur interne dans actuar_do_dpq3" #: dpq.c:838 msgid "internal error in actuar_do_dpq4" msgstr "erreur interne dans actuar_do_dpq4" #: dpq.c:1014 msgid "internal error in actuar_do_dpq5" msgstr "erreur interne dans actuar_do_dpq5" #: dpq.c:1160 msgid "internal error in actuar_do_dpq6" msgstr "erreur interne dans actuar_do_dpq6" #: dpqphtype.c:177 msgid "internal error in actuar_do_dpqphtype2" msgstr "erreur interne dans actuar_do_dpqphtype2" #: fpareto.c:186 fpareto.c:246 pareto2.c:139 pareto2.c:193 pareto3.c:144 #: pareto3.c:199 pareto4.c:160 pareto4.c:219 #, c-format msgid "'order' (%.2f) must be integer, rounded to %.0f" msgstr "'order' (%.2f) doit être entier, arrondi à %.0f" #: hierarc.c:100 invgauss.c:209 msgid "maximum number of iterations reached before obtaining convergence" msgstr "nombre d'itérations maximal atteint avant obtention de la convergence" #: invgauss.c:150 msgid "maximum number of iterations must be at least 1" msgstr "le nombre d'itérations maximal doit être au moins 1" #: invpareto.c:185 msgid "integration failed" msgstr "l'intégration a échoué" #: panjer.c:71 panjer.c:114 msgid "" "maximum number of recursions reached before the probability distribution was " "complete" msgstr "nombre de récursions maximal atteint avant obtention de la convergence" #: random.c:81 msgid "NAs produced" msgstr "production de NA" #: random.c:171 msgid "internal error in actuar_do_random1" msgstr "erreur interne dans actuar_do_random1" #: random.c:287 msgid "internal error in actuar_do_random2" msgstr "erreur interne dans actuar_do_random2" #: random.c:399 msgid "internal error in actuar_do_random3" msgstr "erreur interne dans actuar_do_random3" #: random.c:509 msgid "internal error in actuar_do_random4" msgstr "erreur interne dans actuar_do_random4" #: random.c:621 msgid "internal error in actuar_do_random5" msgstr "erreur interne dans actuar_do_random5" #: random.c:651 msgid "internal error in actuar_do_random" msgstr "erreur interne dans actuar_do_random" #: randomphtype.c:101 msgid "non-square sub-intensity matrix" msgstr "matrice de sous-intensité non carrée" #: randomphtype.c:104 msgid "non-conformable arguments" msgstr "arguments non conformes" #: randomphtype.c:123 msgid "internal error in actuar_do_randomphtype2" msgstr "erreur interne dans actuar_do_randomphtype2" #: randomphtype.c:150 msgid "internal error in actuar_do_randomphtype" msgstr "erreur interne dans actuar_do_randomphtype" #: util.c:106 #, c-format msgid "LAPACK routine dgebal returned info code %d when permuting" msgstr "" "la procédure LAPACK dgebal a produit le code d'erreur %d lors de la " "permutation" #: util.c:110 #, c-format msgid "LAPACK routine dgebal returned info code %d when scaling" msgstr "" "la procédure LAPACK dgebal a produit le code d'erreur %d lors de la mise à " "l'échelle" #: util.c:157 #, c-format msgid "LAPACK routine dgetrf returned info code %d" msgstr "la procédure LAPACK dgetrf a produit le code d'erreur %d" #: util.c:160 #, c-format msgid "LAPACK routine dgetrs returned info code %d" msgstr "la procédure LAPACK dgetrs a produit le code d'erreur %d" #: util.c:266 msgid "'A' is 0-diml" msgstr "'A' est de dimension nulle" #: util.c:268 msgid "no right-hand side in 'B'" msgstr "aucun membre de droite dans 'B'" #: util.c:279 #, c-format msgid "argument %d of Lapack routine dgesv had invalid value" msgstr "valeur incorrecte pour l'argument %d du sous-programme dgesv de Lapack" #: util.c:282 msgid "Lapack routine dgesv: system is exactly singular" msgstr "sous-programme Lapack dgesv: le système est exactement singulier"