expint/0000755000176200001440000000000015133352067011566 5ustar liggesusersexpint/tests/0000755000176200001440000000000015133327562012732 5ustar liggesusersexpint/tests/expint-tests.R0000644000176200001440000002021314326667517015534 0ustar liggesusers### == expint: Exponential Integral and Incomplete Gamma Function == ### ### Tests for the exponential integral Ei and the exponential integral ### of order 'n = 1, 2, ...' ### ### E_n = int_x^infty exp(-t)/t^n dt. ### ### AUTHOR: Vincent Goulet ## Load the package library(expint) ### ### Basic functionality ### ## Some values of x x <- runif(10, 0, 10) ## Equivalence between interfaces stopifnot(exprs = { identical(expint(x, order = 1), expint_E1(x), expint_En(x, order = 1)) identical(expint(x, order = 2), expint_E2(x), expint_En(x, order = 2)) identical(expint(x, order = 3), expint_En(x, order = 3)) identical(expint(x, order = 10), expint_En(x, order = 10)) identical(expint(x, order = 1, scale = TRUE), expint_E1(x, scale = TRUE)) identical(expint(x, order = 2, scale = TRUE), expint_E2(x, scale = TRUE)) identical(expint(x, order = 3, scale = TRUE), expint_En(x, order = 3, scale = TRUE)) identical(expint(x, order = 10, scale = TRUE), expint_En(x, order = 10, scale = TRUE)) }) ## Identity between Ei and E1 stopifnot(exprs = { identical(expint_Ei(x), -expint_E1(-x)) identical(expint_Ei(x, scale = TRUE), -expint_E1(-x, scale = TRUE)) }) ## Vectorization of arguments stopifnot(exprs = { identical(expint(head(x), order = 1:3), c(expint(x[1], 1), expint(x[2], 2), expint(x[3], 3), expint(x[4], 1), expint(x[5], 2), expint(x[6], 3))) }) ### ### Values from Table 5.1 of Abramovitz and Stegun ### ## Target values xsmall <- c(1:4/100, seq(0.05, 0.5, by = 0.05)) TARGET_EI_SMALL <- c(1.002505566, 1.005022306, 1.007550283, 1.010089560, 1.012640202, 1.025566141, 1.038786018, 1.052308298, 1.066141726, 1.080295334, 1.094778451, 1.109600714, 1.124772082, 1.140302841) TARGET_E1_SMALL <- c(0.9975055452, 0.9950221392, 0.9925497201, 0.9900882265, 0.9876375971, 0.9755453033, 0.9637156702, 0.9521414833, 0.9408157528, 0.9297317075, 0.9188827858, 0.9082626297, 0.8978650778, 0.8876841584) xmed <- c(0.50, 0.60, 0.75, 1.00, 1.25, 1.55, 1.80, 2.00) TARGET_EI_MED <- c(0.454219905, 0.769881290, 1.207332816, 1.895117816, 2.581047974, 3.451954503, 4.249867557, 4.954234356) TARGET_E1_MED <- c(0.559773595, 0.454379503, 0.340340813, 0.219383934, 0.146413373, 0.092882108, 0.064713129, 0.048900511) xlarge <- c(2.0, 3.5, 5.0, 7.5, 10.0) TARGET_EI_LARGE <- c(1.340965420, 1.471782389, 1.353831278, 1.200421500, 1.131470205) TARGET_E1_LARGE <- c(0.722657234, 0.807867661, 0.852110880, 0.892687854, 0.915633339) EULER <- 0.57721566490153286060651209008 ## Tests stopifnot(exprs = { all.equal((expint_Ei(xsmall) - log(xsmall) - EULER)/xsmall, TARGET_EI_SMALL) all.equal((expint_E1(xsmall) + log(xsmall) + EULER)/xsmall, TARGET_E1_SMALL) all.equal(expint_Ei(xmed), TARGET_EI_MED) all.equal(expint_E1(xmed), TARGET_E1_MED) all.equal(xlarge * exp(-xlarge) * expint_Ei(xlarge), TARGET_EI_LARGE) all.equal(xlarge * expint_Ei(xlarge, scale = TRUE), TARGET_EI_LARGE) all.equal(xlarge * exp(xlarge) * expint_E1(xlarge), TARGET_E1_LARGE) all.equal(xlarge * expint_E1(xlarge, scale = TRUE), TARGET_E1_LARGE) }) ### ### Values from Table 5.2 of Abramovitz and Stegun ### ## Target values xinv <- seq(0.100, 0.005, by = -0.005) TARGET_EI <- c(1.13147021, 1.12249671, 1.11389377, 1.10564739, 1.09773775, 1.09014087, 1.08283054, 1.07578038, 1.06896548, 1.06236365, 1.05595591, 1.04972640, 1.04366194, 1.03775135, 1.03198503, 1.02635451, 1.02085228, 1.01547157, 1.01020625, 1.00505077) TARGET_E1 <- c(0.9156333394, 0.9192568286, 0.9229315844, 0.9266590998, 0.9304409399, 0.9342787466, 0.9381742450, 0.9421292486, 0.9461456670, 0.9502255126, 0.9543709099, 0.9585841038, 0.9628674711, 0.9672235311, 0.9716549596, 0.9761646031, 0.9807554965, 0.9854308813, 0.9901942287, 0.9950492646) ## Tests stopifnot(exprs = { all.equal(expint_Ei(1/xinv) * exp(-1/xinv)/xinv, TARGET_EI) all.equal(expint_Ei(1/xinv, scale = TRUE)/xinv, TARGET_EI) all.equal(expint_E1(1/xinv) * exp(1/xinv)/xinv, TARGET_E1) all.equal(expint_E1(1/xinv, scale = TRUE)/xinv, TARGET_E1) }) ### ### Values from Table 5.4 of Abramovitz and Stegun ### ## Target values xsmall <- c(0.01, 0.10, 0.25, 0.30, 0.50) osmall <- c(3, 4, 10, 20) TARGET_E2_SMALL <- c(0.9957222, 0.9528035, 0.8643037, 0.8303071, 0.6732175) TARGET_EN_SMALL <- c(0.4902766, 0.3283824, 0.1098682, 0.0520790, 0.4162915, 0.2877361, 0.0992984, 0.0473600, 0.3246841, 0.2325432, 0.0839220, 0.0404285, 0.3000418, 0.2169352, 0.0793524, 0.0383518, 0.2216044, 0.1652428, 0.0634583, 0.0310612) TARGET_EN_SMALL <- matrix(TARGET_EN_SMALL, nrow = length(xsmall), ncol = length(osmall), byrow = TRUE) xlarge <- c(0.55, 1.00, 1.25, 1.50, 2.00) olarge <- c(2, 3, 4, 10, 20) TARGET_EN_LARGE <- c(0.3000996, 0.2059475, 0.1545596, 0.0600159, 0.0294670, 0.1484955, 0.1096920, 0.0860625, 0.0363940, 0.0183460, 0.1034881, 0.0785723, 0.0627631, 0.0275988, 0.0141035, 0.0731008, 0.0567395, 0.0460070, 0.0209461, 0.0108440, 0.0375343, 0.0301334, 0.0250228, 0.0120921, 0.0064143) TARGET_EN_LARGE <- matrix(TARGET_EN_LARGE, nrow = length(xlarge), ncol = length(olarge), byrow = TRUE) ## Tests stopifnot(exprs = { all.equal(expint_E2(xsmall) - xsmall * log(xsmall), TARGET_E2_SMALL, tol = 5e-8) all.equal(outer(xsmall, osmall, expint), TARGET_EN_SMALL, tol = 5e-7) all.equal(outer(xlarge, olarge, expint), TARGET_EN_LARGE, tol = 5e-7) }) ### ### Values from Table 5.5 of Abramovitz and Stegun ### ## Target values xinv <- c(seq(0.50, 0.10, by = -0.05), seq(0.09, 0.01, by = -0.01)) order <- c(2, 3, 4, 10, 20) TARGET_EN <- c(1.10937, 1.11329, 1.10937, 1.07219, 1.04270, 1.09750, 1.10285, 1.10071, 1.06926, 1.04179, 1.08533, 1.09185, 1.09136, 1.06586, 1.04067, 1.07292, 1.08026, 1.08125, 1.06187, 1.03932, 1.06034, 1.06808, 1.07031, 1.05712, 1.03762, 1.04770, 1.05536, 1.05850, 1.05138, 1.03543, 1.03522, 1.04222, 1.04584, 1.04432, 1.03249, 1.02325, 1.02895, 1.03247, 1.03550, 1.02837, 1.01240, 1.01617, 1.01889, 1.02436, 1.02222, 1.01045, 1.01377, 1.01624, 1.02182, 1.02060, 1.00861, 1.01147, 1.01366, 1.01917, 1.01883, 1.00688, 1.00927, 1.01116, 1.01642, 1.01688, 1.00528, 1.00721, 1.00878, 1.01360, 1.01472, 1.00384, 1.00531, 1.00654, 1.01074, 1.01234, 1.00258, 1.00361, 1.00451, 1.00790, 1.00973, 1.00152, 1.00217, 1.00275, 1.00516, 1.00692, 1.00071, 1.00103, 1.00133, 1.00271, 1.00401, 1.00019, 1.00027, 1.00036, 1.00081, 1.00137) TARGET_EN <- matrix(TARGET_EN, nrow = length(xinv), ncol = length(order), byrow = TRUE) ## Tests stopifnot(exprs = { all.equal(outer(1/xinv, order, "+") * exp(1/xinv) * outer(1/xinv, order, expint), TARGET_EN, tolerance = 5e-6) all.equal(outer(1/xinv, order, "+") * outer(1/xinv, order, expint, scale = TRUE), TARGET_EN, tolerance = 5e-6) }) ### ### Examples from section 5.3 of Abramowitz and Stegun ### ## Target values order <- 1:10 xsmall <- 1.275 TARGET_SMALL <- c(0.1408099, 0.0998984, 0.0760303, 0.0608307, 0.0504679, 0.0430168, 0.0374307, 0.0331009, 0.0296534, 0.0268469) xlarge <- 10 TARGET_LARGE <- c(0.41570, 0.38302, 0.35488, 0.33041, 0.30898, 0.29005, 0.27325, 0.25822, 0.24472, 0.23253) ## Tests stopifnot(exprs = { all.equal(expint(xsmall, order), TARGET_SMALL, tolerance = 1e-6) all.equal(expint(xlarge, order) * 1e5, TARGET_LARGE, tolerance = 1e-5) }) expint/tests/gammainc-tests.R0000644000176200001440000000322215132742437015771 0ustar liggesusers### == expint: Exponential Integral and Incomplete Gamma Function == ### ### Tests for the incomplete gamma function ### ### G(a,x) = int_x^infty t^{a-1} exp(-t) dt ### ### for a *real* and x >= 0. ### ### AUTHOR: Vincent Goulet ## Load the package library(expint) ## a > 0; direct link to the standard incomplete gamma function x <- c(0.2, 2.5, 5, 8, 10) a <- 1.2 stopifnot(exprs = { identical(gammainc(a, x), gamma(a) * pgamma(x, a, 1, lower = FALSE)) }) ## a = 0; direct link to the exponential integral x <- c(0.2, 2.5, 5, 8, 10) a <- 0 stopifnot(exprs = { identical(gammainc(a, x), expint(x)) identical(gammainc(a, x), expint_E1(x)) }) ## a < 0; compare to the recursive formula x <- c(0.2, 2.5, 5, 8, 10) a <- c(-0.25, -1.2, -2) stopifnot(exprs = { all.equal(gammainc(a[1], x), -(x^a[1] * exp(-x))/a[1] + gamma(a[1] + 1) * pgamma(x, a[1] + 1, 1, lower = FALSE)/a[1]) all.equal(gammainc(a[2], x), -(x^a[2] * exp(-x))/a[2] + (-(x^(a[2] + 1) * exp(-x))/(a[2] + 1) + gamma(a[2] + 2) * pgamma(x, a[2] + 2, 1, lower = FALSE)/(a[2] + 1))/a[2]) all.equal( gammainc(a[3], x), -(x^a[3] * exp(-x))/a[3] + (-(x^(a[3] + 1) * exp(-x))/(a[3] + 1) + expint_E1(x)/(a[3] + 1))/a[3]) }) ## Issue #2: use the recursion even for -0.5 < a < 0 (unlike GSL ## sources), relying on the accuracy of 'pgamma' near a = 0.5 x <- 1e-5 a <- seq(-0.501, -0.499, length.out = 1000) stopifnot(exprs = { all.equal(gammainc(a, x), -(x^a * exp(-x))/a + gamma(a + 1) * pgamma(x, a + 1, 1, lower = FALSE)/a) }) expint/MD50000644000176200001440000000403415133352067012077 0ustar liggesusers314adb0a3ab4722bbaf54966e6af3e52 *DESCRIPTION 5f8a7f85a3e0abba979c1c9979b8b00f *NAMESPACE d7c07c6689aa28184a4df0b6325cabc1 *R/expint.R 7471ef9868ba408f12a5a498e58501f7 *R/gammainc.R 30c4cb2faeb68da2dea8754b7d9d3773 *build/partial.rdb 83b67e87ca6d22b659f0c5b1775b0ab3 *build/vignette.rds 0ceb626122121eb5a213457ab7a72a38 *inst/CITATION 23bb62e4922776bd35d0210d83a386c9 *inst/NEWS.Rd d8c5fbcbad5d8537fe2511d792b7f68c *inst/doc/expint.R 07623d988b07534eb9668928aa24f37a *inst/doc/expint.Rnw 8693236112a369a31bf27cbb28f92258 *inst/doc/expint.pdf d7d472fd5b250cb674d8346b0a542d62 *inst/example_API/DESCRIPTION 3369a2d761d00f69ff6cd4d7239100e3 *inst/example_API/NAMESPACE b5da8158d9ed99f4ea41439428aa0a59 *inst/example_API/R/pkg.R 0e2eb3df0ea6c5c8390f57cfbd4a144a *inst/example_API/man/pkg.Rd 40df19637b270a88d3d38bf46bf91548 *inst/example_API/src/bar.c 9951c44ab3127c3be39de8874b104e98 *inst/example_API/src/foo.c 389d2bce80b57f560da3aaf2d1b11502 *inst/example_API/src/init.c b6d56cad2a4918add4ffec77171ac36e *inst/example_API/src/locale.h 3d2f0b06e8d1485c694ded0525962d94 *inst/example_API/src/pkg.h 779de94c41564597814c2f91ac086985 *inst/include/expintAPI.h 0028cb1f88b81fd2fdc9534a96fe3574 *man/expint-package.Rd f46559b620171a5da7757a0ed91b3bbd *man/expint.Rd bf718b5610becfb0d36c8973b6a033e3 *man/gammainc.Rd a59d7f0b2c6e6a86c611305d1e0a0e89 *po/expint.pot baf05e5561b399035f01b5c8717e6ef2 *po/fr.po 9b1fc46b8311156241488e0d836933b0 *src/Makevars dbd997048f1ec3cd4d6fb04638d622c2 *src/expint.c dfab4ace29e6e8d0eae0628fb1bffd9f *src/expint.h a6084a5b885c75a91371b80bac17e788 *src/gamma_inc.c 94a10521f6882d1cd70a9c97b5446c97 *src/init.c 87053b6138fe649fec962930ee98a47e *src/locale.h 40c5dc5621a325aca8b61d06834d65e4 *tests/expint-tests.R 7459a17dc52bfe23262fa81c9b83ed7a *tests/gammainc-tests.R d2a3b910f1f59fe9bfaf43896f526159 *vignettes/Makefile 07623d988b07534eb9668928aa24f37a *vignettes/expint.Rnw 7479fe181ac56095cab8faefb73913ab *vignettes/expint.bib 7ec15c16d0d66790f28e90343c5434a3 *vignettes/framed.sty dce48c3209ead3561fa5e6cee54b108e *vignettes/share/preamble.tex expint/po/0000755000176200001440000000000015132742437012207 5ustar liggesusersexpint/po/fr.po0000644000176200001440000000317415132742437013163 0ustar liggesusers# expint: Exponential Integrals and Incomplete Gamma Function # Copyright (C) 2016-2026 Vincent Goulet # This file is distributed under the same license as the expint package. # Vincent Goulet , 2016 # msgid "" msgstr "" "Project-Id-Version: expint 1.0-0\n" "Report-Msgid-Bugs-To: Vincent Goulet\n" "POT-Creation-Date: 2026-01-16 15:52-0500\n" "PO-Revision-Date: 2016-12-15 00:56-0500\n" "Last-Translator: Vincent Goulet \n" "Language-Team: French\n" "Language: fr_CA\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" #: expint.c:357 msgid "overflow in expint_E1" msgstr "dépassement de capacité dans expint_E1" #: expint.c:403 expint.c:410 msgid "underflow in expint_E1" msgstr "soupassement de capacité dans expint_E1" #: expint.c:428 msgid "overflow in expint_E2" msgstr "dépassement de capacité dans expint_E2" #: expint.c:462 expint.c:469 msgid "underflow in expint_E2" msgstr "soupassement de capacité dans expint_E2" #: expint.c:477 msgid "underflow in expint_En" msgstr "soupassement de capacité dans expint_En" #: expint.c:547 expint.c:614 gamma_inc.c:192 msgid "invalid arguments" msgstr "arguments incorrects" #: expint.c:591 msgid "internal error in expint_do_expint1" msgstr "erreur interne dans expint_do_expint1" #: expint.c:673 msgid "internal error in expint_do_expint2" msgstr "erreur interne dans expint_do_expint2" #: gamma_inc.c:107 msgid "maximum number of iterations reached in gamma_inc_F_CF" msgstr "nombre d'itérations maximal atteint dans gamma_inc_F_CF" expint/po/expint.pot0000644000176200001440000000240215132742437014240 0ustar liggesusers# expint: Exponential Integrals and Incomplete Gamma Function # Copyright (C) 2016-2026 Vincent Goulet # This file is distributed under the same license as the expint package. # Vincent Goulet , 2016 # #, fuzzy msgid "" msgstr "" "Project-Id-Version: expint 1.0-0\n" "Report-Msgid-Bugs-To: Vincent Goulet\n" "POT-Creation-Date: 2026-01-16 15:52-0500\n" "PO-Revision-Date: 2016-12-20 01:57-0500\n" "Last-Translator: Vincent Goulet \n" "Language-Team: LANGUAGE \n" "Language: \n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=UTF-8\n" "Content-Transfer-Encoding: 8bit\n" #: expint.c:357 msgid "overflow in expint_E1" msgstr "" #: expint.c:403 expint.c:410 msgid "underflow in expint_E1" msgstr "" #: expint.c:428 msgid "overflow in expint_E2" msgstr "" #: expint.c:462 expint.c:469 msgid "underflow in expint_E2" msgstr "" #: expint.c:477 msgid "underflow in expint_En" msgstr "" #: expint.c:547 expint.c:614 gamma_inc.c:192 msgid "invalid arguments" msgstr "" #: expint.c:591 msgid "internal error in expint_do_expint1" msgstr "" #: expint.c:673 msgid "internal error in expint_do_expint2" msgstr "" #: gamma_inc.c:107 msgid "maximum number of iterations reached in gamma_inc_F_CF" msgstr "" expint/R/0000755000176200001440000000000014220225222011753 5ustar liggesusersexpint/R/expint.R0000644000176200001440000000203714220225222013407 0ustar liggesusers### == expint: Exponential Integral and Incomplete Gamma Function == ### ### Functions to compute the exponential integral Ei and the ### exponential integral of order 'n = 1, 2, ...' ### ### E_n = int_x^infty exp(-t)/t^n dt. ### ### Function 'expint' is a unified and fully vectorized interface with ### default the most common case E_1. The other functions are simpler, ### slightly faster interfaces to E_1, E_2, E_n and Ei. ### ### When 'scale' is TRUE, the value returned is scaled by exp(x). ### ### AUTHOR: Vincent Goulet expint <- function(x, order = 1L, scale = FALSE) .External(C_expint_do_expint, "En", x, order, scale) expint_E1 <- function(x, scale = FALSE) .External(C_expint_do_expint, "E1", x, scale) expint_E2 <- function(x, scale = FALSE) .External(C_expint_do_expint, "E2", x, scale) expint_En <- function(x, order, scale = FALSE) .External(C_expint_do_expint, "En", x, order[1L], scale) expint_Ei <- function(x, scale = FALSE) -.External(C_expint_do_expint, "E1", -x, scale) expint/R/gammainc.R0000644000176200001440000000054414220225222013655 0ustar liggesusers### == expint: Exponential Integral and Incomplete Gamma Function == ### ### The incomplete gamma function ### ### G(a,x) = int_x^infty t^{a-1} exp(-t) dt ### ### for a *real* and x >= 0. Note the order of the arguments. ### ### AUTHOR: Vincent Goulet gammainc <- function(a, x) .External(C_expint_do_gammainc, a, x) expint/vignettes/0000755000176200001440000000000015133327562013600 5ustar liggesusersexpint/vignettes/expint.Rnw0000644000176200001440000003540515133325413015577 0ustar liggesusers\input{share/preamble} %\VignetteIndexEntry{expint user manual} %\VignettePackage{expint} %\SweaveUTF8 \title{\pkg{expint}: Exponential integral and incomplete gamma function} \author{Vincent Goulet \\ Université Laval} \date{} %% Additional commands specific to this document \newcommand{\Ei}{\operatorname{Ei}} <>= library(expint) options(width = 60) @ \begin{document} \maketitle \section{Introduction} \label{sec:introduction} The exponential integral \begin{equation*} E_1(x) = \int_x^\infty \frac{e^{-t}}{t}\, dt, \quad x \in \mathbb{R} \end{equation*} and the incomplete gamma function \begin{equation*} \Gamma(a, x) = \int_x^\infty t^{a-1} e^{-t}\, dt, \quad x > 0, \quad a \in \mathbb{R} \end{equation*} are two closely related functions that arise in various fields of mathematics. \pkg{expint} is a small package provides facilities to compute the exponential integral and the incomplete gamma function. Furthermore, and perhaps most conveniently for R package developers, the package also gives easy access to the underlying C workhorses through an API. The C routines are derived from the GNU Scientific Library \citep[GSL;][]{GSL}. The package \pkg{expint} started its life in version~2.0-0 of \pkg{actuar} \citep{actuar}, where we extended the range of admissible values in the computation of limited expected value functions. This required an incomplete gamma function that accepts negative values of argument $a$, as explained at the beginning of Appendix~A of \citet{LossModels4e}. \section{Exponential integral} \label{sec:expint} \citet[Section~5.1]{Abramowitz:1972} first define the exponential integral as \begin{equation} \label{eq:E1} E_1(x) = \int_x^\infty \frac{e^{-t}}{t}\, dt. \end{equation} An alternative definition (to be understood in terms of the Cauchy principal value due to the singularity of the integrand at zero) is \begin{equation*} \Ei(x) = - \int_{-x}^\infty \frac{e^{-t}}{t}\, dt = \int_{-\infty}^x \frac{e^t}{t}\, dt, \quad x > 0. \end{equation*} The above two definitions are related as follows: \begin{equation} \label{eq:Ei_vs_E1} E_1(-x) = - \Ei(x), \quad x > 0. \end{equation} The exponential integral can also generalized to \begin{equation*} E_n(x) = \int_1^\infty \frac{e^{-xt}}{t^n}\, dt, \quad n = 0, 1, 2, \dots, \quad x > 0, \end{equation*} where $n$ is then the \emph{order} of the integral. The latter expression is closely related to the incomplete gamma function (\autoref{sec:gammainc}) as follows: \begin{equation} \label{eq:En_vs_gammainc} E_n(x) = x^{n - 1} \Gamma(1 - n, x). \end{equation} One should note that the first argument of function $\Gamma$ is negative for $n > 1$. The following recurrence relation holds between exponential integrals of successive orders: \begin{equation} \label{eq:En:recurrence} E_{n+1}(x) = \frac{1}{n} [e^{-x} - x E_n(x)]. \end{equation} Finally, $E_n(x)$ has the following asymptotic expansion: \begin{equation} \label{eq:En:asymptotic} E_n(x) \asymp \frac{e^{-x}}{x} \left( 1 - \frac{n}{x} + \frac{n(n+1)}{x^2} - \frac{n(n+1)(n+2)}{x^3} + \dots \right). \end{equation} \section{Incomplete gamma function} \label{sec:gammainc} From a probability theory perspective, the incomplete gamma function is usually defined as \begin{equation*} P(a, x) = \frac{1}{\Gamma(a)} \int_0^x t^{a - 1} e^{-t}\, dt, \quad x > 0, \quad a > 0. \end{equation*} Function \code{pgamma} already implements this function in R (just note the differing order of the arguments). Now, the definition of the incomplete gamma function of interest for this package is rather the following \citep[Section~6.5]{Abramowitz:1972}: \begin{equation} \label{eq:gammainc} \Gamma(a, x) = \int_x^\infty t^{a-1} e^{-t}\, dt, \quad x > 0, \quad a \in \mathbb{R}. \end{equation} Note that $a$ can be negative with this definition. Of course, for $a > 0$ one has \begin{equation} \label{eq:gammainc_vs_pgamma} \Gamma(a, x) = \Gamma(a) [1 - P(a, x)]. \end{equation} Integration by parts of the integral in \eqref{eq:gammainc} yields the recursive relation \begin{equation} \label{eq:gammainc_recursion} \Gamma(a, x) = -\frac{x^a e^{-x}}{a} + \frac{1}{a} \Gamma(a + 1, x). \end{equation} When $a < 0$, this relation can be used repeatedly $k$ times until $a + k$ is a positive number. The right hand side can then be evaluated with \eqref{eq:gammainc_vs_pgamma}. If $a = 0, -1, -2, \dots$, this calculation requires the value of \begin{equation*} G(0, x) = \int_x^\infty \frac{e^{-t}}{t}\, dt = E_1(x), \end{equation*} the exponential integral defined in \eqref{eq:E1}. \section{R interfaces} \label{sec:interfaces} \pkg{expint} provides one main and four auxiliary R functions to compute the exponential integral, and one function to compute the incomplete gamma function. Their signatures are the following: \begin{Schunk} \begin{Sinput} expint(x, order = 1L, scale = FALSE) expint_E1(x, scale = FALSE) expint_E2(x, scale = FALSE) expint_En(x, order, scale = FALSE) expint_Ei(x, scale = FALSE) gammainc(a, x) \end{Sinput} \end{Schunk} Let us first go over function \code{gammainc} since there is less to discuss. The function takes in argument two vectors or real numbers (non-negative for argument \code{x}) and returns the value of $\Gamma(a, x)$. The function is vectorized in arguments \code{a} and \code{x}, so it works similar to, say, \code{pgamma}. We now turn to the \code{expint} family of functions. The function \code{expint} is a unified interface to compute exponential integrals $E_n(x)$ of any (non-negative) order, with default the most common case $E_1(x)$. The function is vectorized in arguments \code{x} and \code{order}. In other words, one can compute the exponential integral of a different order for each value of $x$. <>= expint(c(1.275, 10, 12.3), order = 1:3) @ The argument \code{order} should be a vector of integers. Non-integer values are silently coerced to integers using truncation towards zero. When the argument \code{scale} is \code{TRUE}, the result is scaled by $e^{x}$. The functions \code{expint\_E1}, \code{expint\_E2} and \code{expint\_En} are simpler, slightly faster ways to directly compute exponential integrals $E_1(x)$, $E_2(x)$ and $E_n(x)$, the latter for a \emph{single} order $n$ (the first value of \code{order} if \code{order} is a vector). <>= expint_E1(1.275) expint_E2(10) expint_En(12.3, order = 3L) @ Finally, the function \code{expint\_Ei} is provided as a convenience to compute $\Ei(x)$ using \eqref{eq:Ei_vs_E1}. <>= expint_Ei(5) -expint_E1(-5) # same @ \section{Accessing the C routines} \label{sec:api} The actual workhorses behind the R functions of \autoref{sec:interfaces} are C routines with the following prototypes: \begin{Schunk} \begin{Sinput} double expint_E1(double x, int scale); double expint_E2(double x, int scale); double expint_En(double x, int order, int scale); double gamma_inc(double a, double x); \end{Sinput} \end{Schunk} \pkg{expint} makes these routines available to other packages through declarations in the header file \file{include/expintAPI.h} in the package installation directory. If you want to use a routine --- say \code{expint\_E1} --- in your package \pkg{pkg}, proceed as follows: \begin{enumerate} \item Add the package \pkg{expint} to the \code{Imports} and \code{LinkingTo} directives of the \file{DESCRIPTION} file of \pkg{pkg}; \item Add an entry \samp{import(expint)} 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]{WRE}. 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_expint_E1 = (double(*)(double,int,int)) R_GetCCallable("expint", "expint_E1"); } \end{Sinput} \end{Schunk} \item Define a native routine interface, say \code{pkg\_expint\_E1} to avoid any name clash, in \file{src/init.c} that will call \code{expint\_E1}: \begin{Schunk} \begin{Sinput} double(*pkg_expint_E1)(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{src/pkg.h} would contain: \begin{Schunk} \begin{Sinput} extern double(*pkg_expint_E1)(double,int); \end{Sinput} \end{Schunk} \item Include the package header file \file{pkg.h} in any C file making use of the routine \code{pkg\_expint\_E1}. \end{enumerate} To help developers get started, \pkg{expint} ships with a complete test package implementing the above; see the \file{example\_API} sub-directory in the installation directory. This test package uses the \code{.External} R to C interface and, as a bonus, shows how to vectorize an R function on the C side (the code for this being mostly derived from base R). There are various ways to define a package API. The approach described above was derived from the package \pkg{zoo} \citep{zoo}. The package \pkg{xts} \citep{xts} --- and probably a few others on CRAN --- draws from \pkg{Matrix} \citep{Matrix} to propose a somewhat simpler approach where the API exposes routines that can be used directly in a package. However, the provided header file can be included only once in a package, otherwise one gets \samp{duplicate symbols} errors at link time. This constraint does not show in the example provided with \pkg{xts} or in packages \pkg{RcppXts} \citep{RcppXts} and \pkg{TTR} \citep{TTR} that link to it (the only two at the time of writing). A way around the issue is to define a native routine calling the routines exposed in the API. In this scenario, tests we conducted proved the approach we retained to be up to 10\% faster most of the time. \section{Implementation details} \label{sec:implementation} As already stated, the C routines mentioned in \autoref{sec:api} are derived from code in the GNU Scientific Library \citep{GSL}. For exponential integrals, the main routine \code{expint\_E1} computes $E_1(x)$ using Chebyshev expansions \citep[chapter~3]{Gil:2007}. Routine \code{expint\_E2} computes $E_2(x)$ using \code{expint\_E1} with relation \eqref{eq:En:recurrence} for $x < 100$, and using the asymptotic expression \eqref{eq:En:asymptotic} otherwise. Routine \code{expint\_En} simply relies on \code{gamma\_inc} to compute $E_n(x)$ for $n > 2$ through relation \eqref{eq:En_vs_gammainc}. For the sake of providing routines that better fit within the R ecosystem and coding style, we made the following changes to the original GSL code: \begin{enumerate} \item routines now compute a single value and return their result by value; \item accordingly, calculation of the approximation error was dropped in all routines; \item most importantly, \code{gamma\_inc} computes $\Gamma(a, x)$ for $a > 0$ with \eqref{eq:gammainc_vs_pgamma} using the routines \code{gammafn} and \code{pgamma} of the R API, rather than using the GSL routines, as the example below illustrates; <>= op <- options() # remember default number of digits @ <>= options(digits = 20) gammainc(1.2, 3) gamma(1.2) * pgamma(3, 1.2, 1, lower = FALSE) @ <>= options(op) # restore defaults @ \item finally, \code{gamma\_inc} computes $\Gamma(a, x)$ for $-0.5 < a < 0$ using the recursion \eqref{eq:gammainc_recursion} instead of a series expansion as in the GSL routines, thereby relying on the accuracy of \code{pgamma} near $a = 0.5$ (fixes \href{https://gitlab.com/vigou3/expint/-/issues/2}{issue \#2}). \end{enumerate} \section{Alternative packages} \label{sec:alternatives} The Comprehensive R Archive Network\footnote{% \url{https://cran.r-project.org}} % (CRAN) contains a number of packages with features overlapping \pkg{expint}. We review the similarities and differences here. The closest package in functionality is \pkg{gsl} \citep{gsl-package}. This package is an R wrapper for the special functions and quasi random number generators of the GNU Scientific Library. As such, it provides access to basically the same C code as used in \pkg{expint}. Apart from the changes to the GSL code mentioned in \autoref{sec:implementation}, the main difference between the two packages is that \pkg{gsl} requires that the GSL be installed on one's system, whereas \pkg{expint} is a regular, free standing R package. Package \pkg{VGAM} \citep{VGAM} is a large, high quality package that provides functions to compute the exponential integral $\Ei(x)$ for real values, as well as $e^{-x} \Ei(x)$ and $E_1(x)$ and their derivatives (up to the third derivative). Functions \code{expint}, \code{expexpint} and \code{expint.E1} are wrappers to the Netlib\footnote{% \url{https://www.netlib.org}} % FORTRAN subroutines in file \code{ei.f}. \pkg{VGAM} does not provide an API to its C routines. Package \pkg{pracma} \citep{pracma} provides a large number of functions from numerical analysis, linear algebra, numerical optimization, differential equations and special functions. Its versions of \code{expint}, \code{expint\_E1}, \code{expint\_Ei} and \code{gammainc} are entirely written in R with perhaps less focus on numerical accuracy than the GSL and Netlib implementations. The functions are not vectorized. Package \pkg{frmqa} \citep{frmqa} has a function \code{gamma\_inc\_err} that computes the incomplete gamma function using the incomplete Laplace integral, but it is only valid for $a = j + \frac{1}{2}$, $j = 0, 1, 2, \dots$. Package \pkg{zipfR} \citep{zipfR} introduces a set of functions to compute various quantities related to the gamma and incomplete gamma functions, but these are essentially wrappers around the base R functions \code{gamma} and \code{pgamma} with no new functionalities. \section{Examples} \label{sec:examples} We tabulate the values of $E_n(x)$ for $x = 1.275, 10, 12.3$ and $n = 1, 2, \dots, 10$ as found in examples~4--6 of \citet[section~5.3]{Abramowitz:1972}. <>= x <- c(1.275, 10, 12.3) n <- 1:10 structure(t(outer(x, n, expint)), dimnames = list(n, paste("x =", x))) @ We also tabulate the values of $\Gamma(a, x)$ for $a = -1.5, -1, -0.5, 1$ and $x = 1, 2, \dots, 10$. <>= a <- c(-1.5, -1, -0.5, 1) x <- 1:10 structure(t(outer(a, x, gammainc)), dimnames = list(x, paste("a =", a))) @ \section{Acknowledgments} We built on the source code of R and many of the packages cited in this manual to create \pkg{expint}, so the R Core Team and the package developers deserve credit. We also extend our thanks to Dirk Eddelbuettel who was of great help in putting together the package API, through both his posts in online forums and private communication. Joshua Ulrich provided a fix to the API infrastructure to avoid duplicated symbols that was implemented in version 0.1-6 of the package. \bibliography{expint} \end{document} expint/vignettes/expint.bib0000644000176200001440000001116215133326036015561 0ustar liggesusers@Book{Abramowitz:1972, author = {Abramowitz, M. and Stegun, I. A.}, title = {Handbook of Mathematical Functions}, publisher = {Dover}, year = 1972, url = {https://personal.math.ubc.ca/~cbm/aands/}, language = {english} } @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}, year = 2009, isbn = {0-95461207-8}, url = {https://www.gnu.org/software/gsl/}, language = {english} } @Book{Gil:2007, author = {Gil, A. and Segura, J. and Temme, N. M.}, title = {Numerical Methods for Special Functions}, publisher = {Society for Industrial and Applied Mathematics}, year = 2007, isbn = {978-0-89871634-4}, url = {https://dx.doi.org/10.1137/1.9780898717822}, 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-11831532-3}, language = {english} } @Manual{Matrix, title = {Matrix: Sparse and Dense Matrix Classes and Methods}, author = {D. Bates and M. Maechler}, year = 2016, note = {R package version 1.2-7.1}, url = {https://CRAN.R-project.org/package=Matrix}, language = {english} } @Manual{RcppXts, title = {RcppXts: Interface the xts API via Rcpp}, author = {D. Eddelbuettel}, year = 2013, note = {R package version 0.0.4}, url = {https://CRAN.R-project.org/package=RcppXts}, language = {english} } @Manual{TTR, title = {TTR: Technical Trading Rules}, author = {J. Ulrich}, year = 2016, note = {R package version 0.23-1}, url = {https://CRAN.R-project.org/package=TTR}, language = {english} } @Book{VGAM, author = {Yee, T. W.}, title = {Vector Generalized Linear and Additive Models: With an Implementation in {R}}, publisher = {Springer}, year = 2015, isbn = {978-1-49392818-7}, url = {https://cran.r-project.org/package=VGAM}, language = {english} } @Manual{WRE, title = {Writing {R} Extensions}, author = {{R Core Team}}, year = 2025, note = {Manual for {R} version 4.5.2}, url = {https://cran.r-project.org/doc/manuals/R-exts.html}, 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, url = {https://www.jstatsoft.org/v25/i07}, language = {english} } @Manual{frmqa, title = {\pkg{frmqa}: The Generalized Hyperbolic Distribution, Related Distributions and Their Applications in Finance}, author = {Thanh T. Tran}, year = 2012, note = {R package}, url = {https://cran.r-project.org/package=frmqa}, language = {english} } @Article{gsl-package, title = {Special functions in {R}: introducing the \pkg{gsl} package}, author = {Hankin, R. K. S.}, journal = {R News}, year = {2006}, month = {October}, volume = {6}, issue = {4}, language = {english} } @Manual{pracma, title = {\pkg{pracma}: Practical Numerical Math Functions}, author = {Borchers, H. W.}, year = {2016}, note = {R package}, url = {https://cran.r-project.org/package=pracma}, language = {english} } @Manual{xts, title = {xts: {eXtensible} Time Series}, author = {J. A. Ryan and J. M. Ulrich}, year = 2014, note = {R package version 0.9-7}, url = {https://CRAN.R-project.org/package=xts}, language = {english} } @InProceedings{zipfR, title = {\pkg{zipfR}: Word Frequency Distributions in {R}}, author = {Evert, S. and Baroni, M.}, booktitle = {Proceedings of the 45\textsuperscript{th} Annual Meeting of the Association for Computational Linguistics, Posters and Demonstrations Sessions}, address = {Prague, Czech Republic}, year = {2007}, pages = {29--32}, note = {R package}, url = {https://cran.r-project.org/package=zipfR}, language = {english} } @Article{zoo, title = {zoo: S3 Infrastructure for Regular and Irregular Time Series}, author = {A. Zeileis and G. Grothendieck}, journal = {Journal of Statistical Software}, year = 2005, volume = 14, number = 6, pages = {1--27}, doi = {10.18637/jss.v014.i06}, language = {english} } expint/vignettes/framed.sty0000644000176200001440000005366114220225222015574 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 } %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% expint/vignettes/Makefile0000644000176200001440000000074515133327563015247 0ustar liggesusers### -*-Makefile-*- to build expint vignettes ## ## AUTHOR: Vincent Goulet ## List of vignettes to build VIGNETTES = expint.pdf ## Toolset SWEAVE = "$(R_HOME)/bin/R" CMD Sweave --encoding="utf-8" TEXI2DVI = LATEX=xelatex 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/ share/auto/ expint/vignettes/share/0000755000176200001440000000000015133327562014702 5ustar liggesusersexpint/vignettes/share/preamble.tex0000644000176200001440000000616215132507363017216 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[babel=true]{microtype} \usepackage{fontenc} \usepackage{unicode-math} \setmainfont{STIXTwoText} [ Extension = .otf, UprightFont = *-Regular, BoldFont = *-SemiBold, ItalicFont = *-Italic, BoldItalicFont = *-SemiBoldItalic, Scale = 1, Ligatures = TeX ] \setmathfont{STIXTwoMath-Regular} [ Extension = .otf, Scale = 1, bold-style = TeX ] \usepackage[book,medium,proportional,lining,scale=0.92]{FiraSans} \usepackage[medium,lining,scale=0.90]{FiraMono} %% 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 similar to those of RJournal.sty \newcommand{\pkg}[1]{\textbf{#1}} \newcommand{\code}[1]{\texttt{#1}} \newcommand{\samp}[1]{{`\normalfont\texttt{#1}'}} \newcommand{\file}[1]{{`\normalfont\textsf{#1}'}} \bibliographystyle{plainnat} expint/src/0000755000176200001440000000000015133327562012357 5ustar liggesusersexpint/src/gamma_inc.c0000644000176200001440000001460015133326604014433 0ustar liggesusers/* == expint: Exponential Integral and Incomplete Gamma Function == * * Functions to compute the incomplete gamma function * * G(a,x) = int_x^infty t^{a-1} exp(-t) dt * * for 'a' real and 'x' >= 0. [This differs from 'pgamma' of base R * in that negative values of 'a' are admitted.] * * Copyright (C) 2016-2026 Vincent Goulet * * The code in part IMPLEMENTATION is derived from the GNU Scientific * Library (GSL) v2.2.1 * * Copyright (C) 2007 Brian Gough * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 Gerard Jungman * * The code in part R TO C INTERFACE is derived from R source code. * * Copyright (C) 1998--2025 The R Core Team * Copyright (C) 2003--2023 The R Foundation * Copyright (C) 1995--1997 Robert Gentleman and Ross Ihaka * * 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 for the GSL: G. Jungman * AUTHOR for expint: Vincent Goulet * with much indirect help from the R Core Team */ #include #include #include #include "locale.h" #include "expint.h" /* * IMPLEMENTATION OF THE WORKHORSE * * Adapted from "special functions" material in the GSL. * */ /* Continued fraction which occurs in evaluation * of Q(a,x) or Gamma(a,x). * * 1 (1-a)/x 1/x (2-a)/x 2/x (3-a)/x * F(a,x) = ---- ------- ----- -------- ----- -------- ... * 1 + 1 + 1 + 1 + 1 + 1 + * * Hans E. Plesser, 2002-01-22 (hans dot plesser at itf dot nlh dot no). * * Split out from gamma_inc_Q_CF() by GJ [Tue Apr 1 13:16:41 MST 2003]. * See gamma_inc_Q_CF() below. * */ double gamma_inc_F_CF(double a, double x) { const int nmax = 5000; const double small = R_pow_di(DBL_EPSILON, 3); double hn = 1.0; /* convergent */ double Cn = 1.0 / small; double Dn = 1.0; int n; /* n == 1 has a_1, b_1, b_0 independent of a,x, so that has been done by hand */ for (n = 2 ; n < nmax ; n++) { double an; double delta; if (E1_IS_ODD(n)) an = 0.5 * (n - 1)/x; else an = (0.5 * n - a)/x; Dn = 1.0 + an * Dn; if (fabs(Dn) < small) Dn = small; Cn = 1.0 + an/Cn; if (fabs(Cn) < small) Cn = small; Dn = 1.0/Dn; delta = Cn * Dn; hn *= delta; if (fabs(delta-1.0) < DBL_EPSILON) break; } if (n == nmax) warning(_("maximum number of iterations reached in gamma_inc_F_CF")); return hn; } /* Adapted from specfun/gamma_inc.c in GSL sources. Note that base R * function 'gammafn' and 'pgamma' are used for positive values of * 'a'. */ double gamma_inc(double a, double x) { #ifdef IEEE_754 if (ISNAN(x) || ISNAN(a)) return a + x; #endif if (x < 0.0) return(R_NaN); else if (x == 0.0) return gammafn(a); else if (a == 0.0) return expint_E1(x, 0); else if (a > 0.0) return gammafn(a) * pgamma(x, a, 1, 0, 0); else if (x > 0.25) { /* continued fraction seems to fail for x too small; otherwise it is ok, independent of the value of |x/a|, because of the non-oscillation in the expansion, i.e. the CF is un-conditionally convergent for a < 0 and x > 0 */ return exp((a - 1) * log(x) - x) * gamma_inc_F_CF(a, x); } else if(fabs(a) < 0.5) { /* expint: use the recursion for -0.5 < a < 0 (instead of a * series expansion as in GSL), relying on the accuracy of * pgamma for "small" values of 'a', but nevertheless treat * this case separately to avoid rounding errors in the loop * below */ const double da = a + 1.0; const double gax = gammafn(da) * pgamma(x, da, 1, 0, 0); const double shift = exp(-x + a * log(x)); return (gax - shift)/a; } else { /* a = fa + da; da >= 0 */ const double fa = floor(a); const double da = a - fa; double gax = (da > 0.0 ? gammafn(da) * pgamma(x, da, 1, 0, 0) : expint_E1(x, 0)); double alpha = da; /* Gamma(alpha-1,x) = 1/(alpha-1) (Gamma(a,x) - x^(alpha-1) e^-x) */ do { const double shift = exp(-x + (alpha - 1.0) * log(x)); gax = (gax - shift)/(alpha - 1.0); alpha -= 1.0; } while (alpha > a); return gax; } } /* * R TO C INTERFACE * * Adapted from src/main/arithmetic.c in R sources and from a similar * scheme in package actuar. Main difference: everything is in this * one file. * */ #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) /* Function called by .External() */ SEXP expint_do_gammainc(SEXP args) { SEXP sx, sa, sy; R_xlen_t i, ix, ia, n, nx, na; double ai, *a, xi, *x, *y; Rboolean naflag = FALSE; args = CDR(args); /* drop function name from arguments */ if (!isNumeric(CAR(args)) || !isNumeric(CADR(args))) error(_("invalid arguments")); na = XLENGTH(CAR(args)); nx = XLENGTH(CADR(args)); if ((na == 0) || (nx == 0)) return(allocVector(REALSXP, 0)); n = (nx < na) ? na : nx; PROTECT(sa = coerceVector(CAR(args), REALSXP)); PROTECT(sx = coerceVector(CADR(args), REALSXP)); PROTECT(sy = allocVector(REALSXP, n)); a = REAL(sa); x = REAL(sx); y = REAL(sy); mod_iterate1(na, nx, ia, ix) { ai = a[ia]; xi = x[ix]; if (ISNA(ai) || ISNA(xi)) y[i] = NA_REAL; else if (ISNAN(ai) || ISNAN(xi)) y[i] = R_NaN; else { y[i] = gamma_inc(ai, xi); if (ISNAN(y[i])) naflag = TRUE; } } if (naflag) warning(R_MSG_NA); if (n == na) SHALLOW_DUPLICATE_ATTRIB(sy, sa); else if (n == nx) SHALLOW_DUPLICATE_ATTRIB(sy, sx); UNPROTECT(3); return sy; } expint/src/init.c0000644000176200001440000000171314326537046013473 0ustar liggesusers/* == expint: Exponential Integral and Incomplete Gamma Function == * * Native routines registration, as per "Writing R extensions". * * AUTHOR: Vincent Goulet */ #include #include #include #include "expint.h" static const R_ExternalMethodDef ExternalEntries[] = { {"expint_do_expint", (DL_FUNC) &expint_do_expint, -1}, {"expint_do_gammainc", (DL_FUNC) &expint_do_gammainc, -1}, {NULL, NULL, 0} }; void attribute_visible R_init_expint(DllInfo *dll) { R_registerRoutines(dll, NULL, NULL, NULL, ExternalEntries); R_useDynamicSymbols(dll, FALSE); R_forceSymbols(dll, TRUE); R_RegisterCCallable("expint", "expint_E1", (DL_FUNC) expint_E1); R_RegisterCCallable("expint", "expint_E2", (DL_FUNC) expint_E2); R_RegisterCCallable("expint", "expint_En", (DL_FUNC) expint_En); R_RegisterCCallable("expint", "gamma_inc", (DL_FUNC) gamma_inc); } expint/src/Makevars0000644000176200001440000000012514324537534014054 0ustar liggesusers## Hide entry points (but for R_init_expint in init.c) PKG_CFLAGS = $(C_VISIBILITY) expint/src/locale.h0000644000176200001440000000023714220225222013753 0ustar liggesusers/* Localization */ #include #ifdef ENABLE_NLS #include #define _(String) dgettext ("expint", String) #else #define _(String) (String) #endif expint/src/expint.c0000644000176200001440000004275615132742437014051 0ustar liggesusers/* == expint: Exponential Integral and Incomplete Gamma Function == * * Functions to compute the exponential integral functions * * E_1(x) = int_x^infty exp(-t)/t dt, * E_2(x) = int_x^infty exp(-t)/t^2 dt * * and * * E_n(x) = int_x^infty exp(-t)/t^n dt. * * Copyright (C) 2016-2026 Vincent Goulet * * The code in part IMPLEMENTATION is derived from the GNU Scientific * Library (GSL) v2.2.1 * * Copyright (C) 2007 Brian Gough * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002 Gerard Jungman * * The code in part R TO C INTERFACE is derived from R source code. * * Copyright (C) 1998--2025 The R Core Team * Copyright (C) 2003--2023 The R Foundation * Copyright (C) 1995--1997 Robert Gentleman and Ross Ihaka * * 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 for the GSL: G. Jungman * AUTHOR for expint: Vincent Goulet * with much indirect help from the R Core Team */ #include #include #include #include "locale.h" #include "expint.h" /* Prototypes of auxiliary functions */ static SEXP expint1_1(SEXP, SEXP, double (*f)(double, int)); static SEXP expint2_1(SEXP, SEXP, SEXP, double (*f)(double, int, int)); /* * IMPLEMENTATION OF THE WORKHORSES * * Adapted from "special functions" material in the GSL. * */ /* Data structure for a Chebyshev series over a given interval */ struct cheb_series_struct { double * c; /* coefficients */ int order; /* order of expansion */ double a; /* lower interval point */ double b; /* upper interval point */ int order_sp; /* effective single precision order */ }; typedef struct cheb_series_struct cheb_series; /* Chebyshev expansions: based on SLATEC e1.f, W. Fullerton Series for AE11 on the interval -1.00000D-01 to 0. with weighted error 1.76E-17 log weighted error 16.75 significant figures required 15.70 decimal places required 17.55 Series for AE12 on the interval -2.50000D-01 to -1.00000D-01 with weighted error 5.83E-17 log weighted error 16.23 significant figures required 15.76 decimal places required 16.93 Series for E11 on the interval -4.00000D+00 to -1.00000D+00 with weighted error 1.08E-18 log weighted error 17.97 significant figures required 19.02 decimal places required 18.61 Series for E12 on the interval -1.00000D+00 to 1.00000D+00 with weighted error 3.15E-18 log weighted error 17.50 approx significant figures required 15.8 decimal places required 18.10 Series for AE13 on the interval 2.50000D-01 to 1.00000D+00 with weighted error 2.34E-17 log weighted error 16.63 significant figures required 16.14 decimal places required 17.33 Series for AE14 on the interval 0. to 2.50000D-01 with weighted error 5.41E-17 log weighted error 16.27 significant figures required 15.38 decimal places required 16.97 */ static double AE11_data[39] = { 0.121503239716065790, -0.065088778513550150, 0.004897651357459670, -0.000649237843027216, 0.000093840434587471, 0.000000420236380882, -0.000008113374735904, 0.000002804247688663, 0.000000056487164441, -0.000000344809174450, 0.000000058209273578, 0.000000038711426349, -0.000000012453235014, -0.000000005118504888, 0.000000002148771527, 0.000000000868459898, -0.000000000343650105, -0.000000000179796603, 0.000000000047442060, 0.000000000040423282, -0.000000000003543928, -0.000000000008853444, -0.000000000000960151, 0.000000000001692921, 0.000000000000607990, -0.000000000000224338, -0.000000000000200327, -0.000000000000006246, 0.000000000000045571, 0.000000000000016383, -0.000000000000005561, -0.000000000000006074, -0.000000000000000862, 0.000000000000001223, 0.000000000000000716, -0.000000000000000024, -0.000000000000000201, -0.000000000000000082, 0.000000000000000017 }; static cheb_series AE11_cs = { AE11_data, 38, -1, 1, 20 }; static double AE12_data[25] = { 0.582417495134726740, -0.158348850905782750, -0.006764275590323141, 0.005125843950185725, 0.000435232492169391, -0.000143613366305483, -0.000041801320556301, -0.000002713395758640, 0.000001151381913647, 0.000000420650022012, 0.000000066581901391, 0.000000000662143777, -0.000000002844104870, -0.000000000940724197, -0.000000000177476602, -0.000000000015830222, 0.000000000002905732, 0.000000000001769356, 0.000000000000492735, 0.000000000000093709, 0.000000000000010707, -0.000000000000000537, -0.000000000000000716, -0.000000000000000244, -0.000000000000000058 }; static cheb_series AE12_cs = { AE12_data, 24, -1, 1, 15 }; static double E11_data[19] = { -16.11346165557149402600, 7.79407277874268027690, -1.95540581886314195070, 0.37337293866277945612, -0.05692503191092901938, 0.00721107776966009185, -0.00078104901449841593, 0.00007388093356262168, -0.00000620286187580820, 0.00000046816002303176, -0.00000003209288853329, 0.00000000201519974874, -0.00000000011673686816, 0.00000000000627627066, -0.00000000000031481541, 0.00000000000001479904, -0.00000000000000065457, 0.00000000000000002733, -0.00000000000000000108 }; static cheb_series E11_cs = { E11_data, 18, -1, 1, 13 }; static double E12_data[16] = { -0.03739021479220279500, 0.04272398606220957700, -0.13031820798497005440, 0.01441912402469889073, -0.00134617078051068022, 0.00010731029253063780, -0.00000742999951611943, 0.00000045377325690753, -0.00000002476417211390, 0.00000000122076581374, -0.00000000005485141480, 0.00000000000226362142, -0.00000000000008635897, 0.00000000000000306291, -0.00000000000000010148, 0.00000000000000000315 }; static cheb_series E12_cs = { E12_data, 15, -1, 1, 10 }; static double AE13_data[25] = { -0.605773246640603460, -0.112535243483660900, 0.013432266247902779, -0.001926845187381145, 0.000309118337720603, -0.000053564132129618, 0.000009827812880247, -0.000001885368984916, 0.000000374943193568, -0.000000076823455870, 0.000000016143270567, -0.000000003466802211, 0.000000000758754209, -0.000000000168864333, 0.000000000038145706, -0.000000000008733026, 0.000000000002023672, -0.000000000000474132, 0.000000000000112211, -0.000000000000026804, 0.000000000000006457, -0.000000000000001568, 0.000000000000000383, -0.000000000000000094, 0.000000000000000023 }; static cheb_series AE13_cs = { AE13_data, 24, -1, 1, 15 }; static double AE14_data[26] = { -0.18929180007530170, -0.08648117855259871, 0.00722410154374659, -0.00080975594575573, 0.00010999134432661, -0.00001717332998937, 0.00000298562751447, -0.00000056596491457, 0.00000011526808397, -0.00000002495030440, 0.00000000569232420, -0.00000000135995766, 0.00000000033846628, -0.00000000008737853, 0.00000000002331588, -0.00000000000641148, 0.00000000000181224, -0.00000000000052538, 0.00000000000015592, -0.00000000000004729, 0.00000000000001463, -0.00000000000000461, 0.00000000000000148, -0.00000000000000048, 0.00000000000000016, -0.00000000000000005 }; static cheb_series AE14_cs = { AE14_data, 25, -1, 1, 13 }; /* Adapted from specfun/cheb_eval.c in GSL sources */ static inline double cheb_eval(const cheb_series * cs, const double x) { int j; double d = 0.0; double dd = 0.0; double y = (2.0*x - cs->a - cs->b) / (cs->b - cs->a); double y2 = 2.0 * y; for(j = cs->order; j >= 1; j--) { double temp = d; d = y2*d - dd + cs->c[j]; dd = temp; } return y*d - dd + 0.5 * cs->c[0]; } /* Adapted from specfun/expint.c::expint_E1_impl in GSL sources */ double expint_E1(double x, int scale) { #ifdef IEEE_754 if (ISNAN(x)) return x; #endif const double xmaxt = -LOG_DBL_MIN; /* XMAXT = -LOG(DBL_MIN) */ const double xmax = xmaxt - log(xmaxt); /* XMAX = XMAXT - LOG(XMAXT) */ if (x < -xmax && !scale) { warning(_("overflow in expint_E1")); return R_PosInf; } else if (x <= -10.0) { const double s = 1.0/x * (scale ? 1.0 : exp(-x)); const double cheb = cheb_eval(&AE11_cs, 20.0/x+1.0); return s * (1.0 + cheb); } else if (x <= -4.0) { const double s = 1.0/x * (scale ? 1.0 : exp(-x)); const double cheb = cheb_eval(&AE12_cs, (40.0/x+7.0)/3.0); return s * (1.0 + cheb); } else if (x <= -1.0) { const double s = (scale ? exp(x) : 1.0); const double ln_term = -log(fabs(x)); const double cheb = cheb_eval(&E11_cs, (2.0*x+5.0)/3.0); return s * (ln_term + cheb); } else if (x == 0.0) { return R_NaN; } else if (x <= 1.0) { const double s = (scale ? exp(x) : 1.0); const double ln_term = -log(fabs(x)); const double cheb = cheb_eval(&E12_cs, x); return s * (ln_term - 0.6875 + x + cheb); } else if (x <= 4.0) { const double s = 1.0/x * (scale ? 1.0 : exp(-x)); const double cheb = cheb_eval(&AE13_cs, (8.0/x-5.0)/3.0); return s * (1.0 + cheb); } else if (x <= xmax || scale) { const double s = 1.0/x * (scale ? 1.0 : exp(-x)); const double cheb = cheb_eval(&AE14_cs, 8.0/x-1.0); double res = s * (1.0 + cheb); if (res == 0.0) { warning(_("underflow in expint_E1")); return 0.0; } else return res; } else { warning(_("underflow in expint_E1")); return 0.0; } } /* Adapted from specfun/expint.c::expint_E2_impl in GSL sources */ double expint_E2(double x, int scale) { #ifdef IEEE_754 if (ISNAN(x)) return x; #endif const double xmaxt = -LOG_DBL_MIN; const double xmax = xmaxt - log(xmaxt); if (x < -xmax && !scale) { warning(_("overflow in expint_E2")); return R_PosInf; } else if (x == 0.0) { return 1.0; } else if (x < 100.0) { const double ex = (scale ? 1.0 : exp(-x)); return ex - x * expint_E1(x, scale); } else if (x < xmax || scale) { const double s = (scale ? 1.0 : exp(-x)); const double c1 = -2.0; const double c2 = 6.0; const double c3 = -24.0; const double c4 = 120.0; const double c5 = -720.0; const double c6 = 5040.0; const double c7 = -40320.0; const double c8 = 362880.0; const double c9 = -3628800.0; const double c10 = 39916800.0; const double c11 = -479001600.0; const double c12 = 6227020800.0; const double c13 = -87178291200.0; const double y = 1.0/x; const double sum6 = c6+y*(c7+y*(c8+y*(c9+y*(c10+y*(c11+y*(c12+y*c13)))))); const double sum = y*(c1+y*(c2+y*(c3+y*(c4+y*(c5+y*sum6))))); double res = s * (1.0 + sum)/x; if (res == 0.0) { warning(_("underflow in expint_E2")); return 0.0; } else return res; } else { warning(_("underflow in expint_E2")); return 0.0; } } /* Macro used in expint_En (only) */ #define CHECK_UNDERFLOW(x) \ if (fabs(x) < DBL_MIN) { \ warning(_("underflow in expint_En")); \ return 0.0; \ } \ /* Adapted from specfun/expint.c::expint_En_impl in GSL sources */ double expint_En(double x, int n, int scale) { #ifdef IEEE_754 if (ISNAN(x)) return x; #endif if (n < 0) return R_NaN; else if (n == 0) { if (x == 0) return R_NaN; else { double res = (scale ? 1.0 : exp(-x)) / x; CHECK_UNDERFLOW(res); return res; } } else if (n == 1) return expint_E1(x, scale); else if (n == 2) return expint_E2(x, scale); else { if (x < 0) return R_NaN; if (x == 0) { double res = (scale ? exp(x) : 1 ) * (1/(n-1.0)); CHECK_UNDERFLOW(res); return res; } else { double s = (scale ? exp(x) : 1.0); double res = gamma_inc((double) 1 - n, x); res *= s * R_pow_di(x, n - 1); CHECK_UNDERFLOW(res); return res; } } } /* * R TO C INTERFACE * * Adapted from src/main/arithmetic.c in R sources and from a similar * scheme in package actuar. Main difference: everything is in this * one file. * */ /* Functions to handle cases with one argument (REAL) and an integer * flag */ static SEXP expint1_1(SEXP sx, SEXP sI, double (*f)(double, int)) { SEXP sy; R_xlen_t i, nx; double xi, *x, *y; Rboolean naflag = FALSE; if (!isNumeric(sx)) error(_("invalid arguments")); nx = XLENGTH(sx); if (nx == 0) return(allocVector(REALSXP, 0)); PROTECT(sx = coerceVector(sx, REALSXP)); PROTECT(sy = allocVector(REALSXP, nx)); x = REAL(sx); y = REAL(sy); int i_1 = asInteger(sI); for (i = 0; i < nx; i++) { xi = x[i]; if (ISNA(xi)) y[i] = NA_REAL; else if (ISNAN(xi)) y[i] = R_NaN; else { y[i] = f(xi, i_1); if (ISNAN(y[i])) naflag = TRUE; } } if (naflag) warning(R_MSG_NA); SHALLOW_DUPLICATE_ATTRIB(sy, sx); UNPROTECT(2); return sy; } #define EXPINT1_1(A, FUN) expint1_1(CAR(A), CADR(A), FUN); SEXP expint_do_expint1(int code, SEXP args) { switch (code) { case 1: return EXPINT1_1(args, expint_E1); case 2: return EXPINT1_1(args, expint_E2); default: error(_("internal error in expint_do_expint1")); } return args; /* never used; to keep -Wall happy */ } /* Functions to handle cases with two arguments (REAL and INTEGER) and * an integer flag */ #define mod_iterate2(n1, n2, i1, i2) \ for (i = i1 = i2 = 0; i < n; \ i1 = (++i1 == n1) ? 0 : i1, \ i2 = (++i2 == n2) ? 0 : i2, \ ++i) static SEXP expint2_1(SEXP sx, SEXP sa, SEXP sI, double (*f)(double, int, int)) { SEXP sy; R_xlen_t i, ix, ia, n, nx, na; double xi, *x, *y; int ai, *a; Rboolean naflag = FALSE; if (!isNumeric(sx) || !isNumeric(sa)) error(_("invalid arguments")); nx = XLENGTH(sx); na = XLENGTH(sa); if ((nx == 0) || (na == 0)) return(allocVector(REALSXP, 0)); n = (nx < na) ? na : nx; PROTECT(sx = coerceVector(sx, REALSXP)); PROTECT(sa = coerceVector(sa, INTSXP)); PROTECT(sy = allocVector(REALSXP, n)); x = REAL(sx); a = INTEGER(sa); y = REAL(sy); int i_1 = asInteger(sI); mod_iterate2(nx, na, ix, ia) { xi = x[ix]; ai = a[ia]; if (ISNA(xi) || ai == NA_INTEGER) y[i] = NA_REAL; else if (ISNAN(xi)) y[i] = R_NaN; else { if (ai == 1) y[i] = expint_E1(xi, i_1); else if (ai == 2) y[i] = expint_E2(xi, i_1); else y[i] = f(xi, ai, i_1); if (ISNAN(y[i])) naflag = TRUE; } } if (naflag) warning(R_MSG_NA); if (n == nx) SHALLOW_DUPLICATE_ATTRIB(sy, sx); else if (n == na) SHALLOW_DUPLICATE_ATTRIB(sy, sa); UNPROTECT(3); return sy; } #define EXPINT2_1(A, FUN) expint2_1(CAR(A), CADR(A), CADDR(A), FUN); SEXP expint_do_expint2(int code, SEXP args) { switch (code) { case 1: return EXPINT2_1(args, expint_En); default: error(_("internal error in expint_do_expint2")); } return args; /* never used; to keep -Wall happy */ } /* Data structure for internal functions */ typedef struct { char *name; SEXP (*cfun)(int, SEXP); int code; } expint_tab_struct; static expint_tab_struct expint_tab[] = { /* One argument functions */ {"E1", expint_do_expint1, 1}, {"E2", expint_do_expint1, 2}, /* Two argument functions */ {"En", expint_do_expint2, 1}, {0, 0, 0} }; /* Function called by .External() */ SEXP expint_do_expint(SEXP args) { R_xlen_t i; const char *name; /* Extract type of exponential integral */ args = CDR(args); name = CHAR(STRING_ELT(CAR(args), 0)); /* Dispatch to expint_do_expint[1,2] */ for (i = 0; expint_tab[i].name; i++) { if (!strcmp(expint_tab[i].name, name)) { return expint_tab[i].cfun(expint_tab[i].code, CDR(args)); } } /* No dispatch is an error */ error("internal error in expint_do_expint"); return args; /* never used; to keep -Wall happy */ } expint/src/expint.h0000644000176200001440000000162215132730460014032 0ustar liggesusers/* == expint: Exponential Integral and Incomplete Gamma Function == * * Declarations for the package and various constant and macro * definitions. * * AUTHOR: Vincent Goulet */ #include /* Error messages */ #define R_MSG_NA _("NaNs produced") /* Functions accessed from .External() */ SEXP expint_do_expint(SEXP); SEXP expint_do_expint1(int, SEXP); SEXP expint_do_expint2(int, SEXP); SEXP expint_do_gammainc(SEXP); /* Exported functions */ double expint_E1(double, int); double expint_E2(double, int); double expint_En(double, int, int); double gamma_inc(double, double); /* Constants (taken from gsl_machine.h in GSL sources) */ #define LOG_DBL_MIN (-7.0839641853226408e+02) #define LOG_DBL_MAX 7.0978271289338397e+02 #define EULER_CNST 0.57721566490153286060651209008 /* Macros */ #define E1_IS_ODD(n) ((n) & 1) /* taken from GSL */ expint/NAMESPACE0000644000176200001440000000023314220225222012767 0ustar liggesusers### C code useDynLib(expint, .registration = TRUE, .fixes = "C_") ### Exports export(expint, expint_E1, expint_E2, expint_En, expint_Ei) export(gammainc) expint/inst/0000755000176200001440000000000015133327562012545 5ustar liggesusersexpint/inst/include/0000755000176200001440000000000014220225222014152 5ustar liggesusersexpint/inst/include/expintAPI.h0000644000176200001440000000256514220225222016174 0ustar liggesusers/* == expint: Exponential Integral and Incomplete Gamma Function == * * Support for exported functions at the C level. * * This is derived from code in package zoo. * * Copyright (C) 2016 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 double expint_E1(double x, int scale); double expint_E2(double x, int scale); double expint_En(double x, int order, int scale); double gamma_inc(double a, double x); #ifdef __cplusplus } #endif expint/inst/CITATION0000644000176200001440000000056615133050343013677 0ustar liggesusersbibentry(bibtype = "Manual", title = "expint: Exponential Integral and Incomplete Gamma Function", author = person("Vincent", "Goulet", email = "vincent.goulet@act.ulaval.ca"), year = 2026, note = "R package", url = "https://cran.r-project.org/package=expint", header = "To cite expint in publications use:") expint/inst/example_API/0000755000176200001440000000000014220225222014653 5ustar liggesusersexpint/inst/example_API/R/0000755000176200001440000000000014220225222015054 5ustar liggesusersexpint/inst/example_API/R/pkg.R0000644000176200001440000000015314220225222015757 0ustar liggesusersfoo <- function(x) .External("pkg_do_foo", x) bar <- function(a, x) .External("pkg_do_bar", a, x) expint/inst/example_API/src/0000755000176200001440000000000014220225222015442 5ustar liggesusersexpint/inst/example_API/src/bar.c0000644000176200001440000000546214220225222016361 0ustar liggesusers/* * Example of a routine making use of the interface defined in * init.c. The routine will iterate on both arguments passed from R, * thereby making the R function vectorized. * * The code is derived from package actuar and base R. * * Copyright (C) 2016 Vincent Goulet * Copyright (C) 1995--1997 Robert Gentleman and Ross Ihaka * Copyright (C) 1998--2016 The R Core Team. * Copyright (C) 2003--2016 The R Foundation * * 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 "locale.h" #include "pkg.h" #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) SEXP pkg_do_bar(SEXP args) { SEXP sx, sa, sy; int i, ix, ia, n, nx, na; double ai, *a, xi, *x, *y; Rboolean naflag = FALSE; args = CDR(args); /* drop function name from arguments */ if (!isNumeric(CAR(args)) || !isNumeric(CADR(args))) error(_("invalid arguments")); na = LENGTH(CAR(args)); nx = LENGTH(CADR(args)); if ((na == 0) || (nx == 0)) return(allocVector(REALSXP, 0)); n = (nx < na) ? na : nx; PROTECT(sa = coerceVector(CAR(args), REALSXP)); PROTECT(sx = coerceVector(CADR(args), REALSXP)); PROTECT(sy = allocVector(REALSXP, n)); a = REAL(sa); x = REAL(sx); y = REAL(sy); mod_iterate1(na, nx, ia, ix) { ai = a[ia]; xi = x[ix]; if (ISNA(ai) || ISNA(xi)) y[i] = NA_REAL; else if (ISNAN(ai) || ISNAN(xi)) y[i] = R_NaN; else { /* this is where the expint routine is used */ y[i] = pkg_gamma_inc(ai, xi); if (ISNAN(y[i])) naflag = TRUE; } } if (naflag) warning(R_MSG_NA); if (n == na) { SET_ATTRIB(sy, duplicate(ATTRIB(sa))); SET_OBJECT(sy, OBJECT(sa)); } else if (n == nx) { SET_ATTRIB(sy, duplicate(ATTRIB(sx))); SET_OBJECT(sy, OBJECT(sx)); } UNPROTECT(3); return sy; } expint/inst/example_API/src/foo.c0000644000176200001440000000422314220225222016372 0ustar liggesusers/* * Example of a routine making use of the interface defined in * init.c. The routine will iterate on both arguments passed from R, * thereby making the R function vectorized. * * The code is derived from package actuar and base R. * * Copyright (C) 2016 Vincent Goulet * Copyright (C) 1995--1997 Robert Gentleman and Ross Ihaka * Copyright (C) 1998--2016 The R Core Team. * Copyright (C) 2003--2016 The R Foundation * * 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 "locale.h" #include "pkg.h" SEXP pkg_do_foo(SEXP args) { SEXP sx, sy; int i, nx; double xi, *x, *y; Rboolean naflag = FALSE; if (!isNumeric(CADR(args))) error(_("invalid arguments")); nx = LENGTH(CADR(args)); if (nx == 0) return(allocVector(REALSXP, 0)); PROTECT(sx = coerceVector(CADR(args), REALSXP)); PROTECT(sy = allocVector(REALSXP, nx)); x = REAL(sx); y = REAL(sy); for (i = 0; i < nx; i++) { xi = x[i]; if (ISNA(xi)) y[i] = NA_REAL; \ else if (ISNAN(xi)) y[i] = R_NaN; else { /* this is where the expint routine is used */ y[i] = pkg_expint_E1(xi, 0); if (ISNAN(y[i])) naflag = TRUE; } } if (naflag) warning(R_MSG_NA); SET_ATTRIB(sy, duplicate(ATTRIB(sx))); SET_OBJECT(sy, OBJECT(sx)); UNPROTECT(2); return sy; } expint/inst/example_API/src/init.c0000644000176200001440000000404414220225222016553 0ustar liggesusers/* * Native routines registration, as per "Writing R extensions" and * definition of native interfaces to two routines exported by * package expint. * * This is derived from code in packages zoo and xts. * * Copyright (C) 2016 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 /* this is actually optional */ #include "pkg.h" /* This package uses the .External interface between R and C */ static const R_ExternalMethodDef ExternalEntries[] = { {"pkg_do_foo", (DL_FUNC) &pkg_do_foo, -1}, {"pkg_do_bar", (DL_FUNC) &pkg_do_bar, -1}, {NULL, NULL, 0} }; /* Routine registration and native interfaces definitions. We prefix * names with pkg_ to avoid name clashes with expintAPI.h. */ void R_init_pkg(DllInfo *dll) { R_registerRoutines(dll, NULL, NULL, NULL, ExternalEntries); /* native interfaces to routines from package expint */ pkg_expint_E1 = (double(*)(double,int)) R_GetCCallable("expint", "expint_E1"); pkg_gamma_inc = (double(*)(double,double)) R_GetCCallable("expint", "gamma_inc"); } /* Declaration of interfaces to routines from package expint */ double(*pkg_expint_E1)(double,int); double(*pkg_gamma_inc)(double,double); expint/inst/example_API/src/locale.h0000644000176200001440000000023414220225222017051 0ustar liggesusers/* Localization */ #include #ifdef ENABLE_NLS #include #define _(String) dgettext ("pkg", String) #else #define _(String) (String) #endif expint/inst/example_API/src/pkg.h0000644000176200001440000000050714220225222016376 0ustar liggesusers#include /* Error messages */ #define R_MSG_NA _("NaNs produced") /* Functions accessed from .External() */ SEXP pkg_do_foo(SEXP args); SEXP pkg_do_bar(SEXP args); /* Interfaces to routines from package expint */ extern double(*pkg_expint_E1)(double,int); extern double(*pkg_gamma_inc)(double,double); expint/inst/example_API/NAMESPACE0000644000176200001440000000013414220225222016070 0ustar liggesusers### C code useDynLib(pkg, .registration = TRUE) import(expint) ### Exports export(foo,bar) expint/inst/example_API/man/0000755000176200001440000000000014220225222015426 5ustar liggesusersexpint/inst/example_API/man/pkg.Rd0000644000176200001440000000130514220225222016475 0ustar liggesusers\name{foo} \alias{foo} \alias{bar} \title{Test functions} \description{ These functions test the interface to the C routines of package \pkg{expint}. } \usage{ foo(x) bar(a, x) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x, a}{vectors of real numbers} } \details{ \code{foo} is an interface to \code{expint_E1}. \code{bar} is an interface to \code{gamma_inc}. Both functions are vectorized. } \value{ ... } \author{ ~~who you are~~ } \seealso{ ~~objects to See Also as \code{\link{help}}, ~~~ } \examples{ ## Compare results with functions expint() and gammainc() ## of package expint foo(1.275) x <- c(0.2, 2.5, 5, 8, 10) a <- 1.2 bar(a, x) } \keyword{math} expint/inst/example_API/DESCRIPTION0000644000176200001440000000064214220225222016363 0ustar liggesusersPackage: pkg Type: Package Title: Test package Version: 0.0-1 Date: 2016-12-25 Authors@R: c(person("Vincent", "Goulet", role = c("cre", "aut"), email = "vincent.goulet@act.ulaval.ca")) Description: Tests the interface to include the C routines of package expint in another package. Depends: R (>= 3.3.0) Imports: expint LinkingTo: expint License: GPL (>= 2) Encoding: UTF-8 LazyLoad: yes LazyData: yes expint/inst/doc/0000755000176200001440000000000015133327562013312 5ustar liggesusersexpint/inst/doc/expint.Rnw0000644000176200001440000003540515133325413015311 0ustar liggesusers\input{share/preamble} %\VignetteIndexEntry{expint user manual} %\VignettePackage{expint} %\SweaveUTF8 \title{\pkg{expint}: Exponential integral and incomplete gamma function} \author{Vincent Goulet \\ Université Laval} \date{} %% Additional commands specific to this document \newcommand{\Ei}{\operatorname{Ei}} <>= library(expint) options(width = 60) @ \begin{document} \maketitle \section{Introduction} \label{sec:introduction} The exponential integral \begin{equation*} E_1(x) = \int_x^\infty \frac{e^{-t}}{t}\, dt, \quad x \in \mathbb{R} \end{equation*} and the incomplete gamma function \begin{equation*} \Gamma(a, x) = \int_x^\infty t^{a-1} e^{-t}\, dt, \quad x > 0, \quad a \in \mathbb{R} \end{equation*} are two closely related functions that arise in various fields of mathematics. \pkg{expint} is a small package provides facilities to compute the exponential integral and the incomplete gamma function. Furthermore, and perhaps most conveniently for R package developers, the package also gives easy access to the underlying C workhorses through an API. The C routines are derived from the GNU Scientific Library \citep[GSL;][]{GSL}. The package \pkg{expint} started its life in version~2.0-0 of \pkg{actuar} \citep{actuar}, where we extended the range of admissible values in the computation of limited expected value functions. This required an incomplete gamma function that accepts negative values of argument $a$, as explained at the beginning of Appendix~A of \citet{LossModels4e}. \section{Exponential integral} \label{sec:expint} \citet[Section~5.1]{Abramowitz:1972} first define the exponential integral as \begin{equation} \label{eq:E1} E_1(x) = \int_x^\infty \frac{e^{-t}}{t}\, dt. \end{equation} An alternative definition (to be understood in terms of the Cauchy principal value due to the singularity of the integrand at zero) is \begin{equation*} \Ei(x) = - \int_{-x}^\infty \frac{e^{-t}}{t}\, dt = \int_{-\infty}^x \frac{e^t}{t}\, dt, \quad x > 0. \end{equation*} The above two definitions are related as follows: \begin{equation} \label{eq:Ei_vs_E1} E_1(-x) = - \Ei(x), \quad x > 0. \end{equation} The exponential integral can also generalized to \begin{equation*} E_n(x) = \int_1^\infty \frac{e^{-xt}}{t^n}\, dt, \quad n = 0, 1, 2, \dots, \quad x > 0, \end{equation*} where $n$ is then the \emph{order} of the integral. The latter expression is closely related to the incomplete gamma function (\autoref{sec:gammainc}) as follows: \begin{equation} \label{eq:En_vs_gammainc} E_n(x) = x^{n - 1} \Gamma(1 - n, x). \end{equation} One should note that the first argument of function $\Gamma$ is negative for $n > 1$. The following recurrence relation holds between exponential integrals of successive orders: \begin{equation} \label{eq:En:recurrence} E_{n+1}(x) = \frac{1}{n} [e^{-x} - x E_n(x)]. \end{equation} Finally, $E_n(x)$ has the following asymptotic expansion: \begin{equation} \label{eq:En:asymptotic} E_n(x) \asymp \frac{e^{-x}}{x} \left( 1 - \frac{n}{x} + \frac{n(n+1)}{x^2} - \frac{n(n+1)(n+2)}{x^3} + \dots \right). \end{equation} \section{Incomplete gamma function} \label{sec:gammainc} From a probability theory perspective, the incomplete gamma function is usually defined as \begin{equation*} P(a, x) = \frac{1}{\Gamma(a)} \int_0^x t^{a - 1} e^{-t}\, dt, \quad x > 0, \quad a > 0. \end{equation*} Function \code{pgamma} already implements this function in R (just note the differing order of the arguments). Now, the definition of the incomplete gamma function of interest for this package is rather the following \citep[Section~6.5]{Abramowitz:1972}: \begin{equation} \label{eq:gammainc} \Gamma(a, x) = \int_x^\infty t^{a-1} e^{-t}\, dt, \quad x > 0, \quad a \in \mathbb{R}. \end{equation} Note that $a$ can be negative with this definition. Of course, for $a > 0$ one has \begin{equation} \label{eq:gammainc_vs_pgamma} \Gamma(a, x) = \Gamma(a) [1 - P(a, x)]. \end{equation} Integration by parts of the integral in \eqref{eq:gammainc} yields the recursive relation \begin{equation} \label{eq:gammainc_recursion} \Gamma(a, x) = -\frac{x^a e^{-x}}{a} + \frac{1}{a} \Gamma(a + 1, x). \end{equation} When $a < 0$, this relation can be used repeatedly $k$ times until $a + k$ is a positive number. The right hand side can then be evaluated with \eqref{eq:gammainc_vs_pgamma}. If $a = 0, -1, -2, \dots$, this calculation requires the value of \begin{equation*} G(0, x) = \int_x^\infty \frac{e^{-t}}{t}\, dt = E_1(x), \end{equation*} the exponential integral defined in \eqref{eq:E1}. \section{R interfaces} \label{sec:interfaces} \pkg{expint} provides one main and four auxiliary R functions to compute the exponential integral, and one function to compute the incomplete gamma function. Their signatures are the following: \begin{Schunk} \begin{Sinput} expint(x, order = 1L, scale = FALSE) expint_E1(x, scale = FALSE) expint_E2(x, scale = FALSE) expint_En(x, order, scale = FALSE) expint_Ei(x, scale = FALSE) gammainc(a, x) \end{Sinput} \end{Schunk} Let us first go over function \code{gammainc} since there is less to discuss. The function takes in argument two vectors or real numbers (non-negative for argument \code{x}) and returns the value of $\Gamma(a, x)$. The function is vectorized in arguments \code{a} and \code{x}, so it works similar to, say, \code{pgamma}. We now turn to the \code{expint} family of functions. The function \code{expint} is a unified interface to compute exponential integrals $E_n(x)$ of any (non-negative) order, with default the most common case $E_1(x)$. The function is vectorized in arguments \code{x} and \code{order}. In other words, one can compute the exponential integral of a different order for each value of $x$. <>= expint(c(1.275, 10, 12.3), order = 1:3) @ The argument \code{order} should be a vector of integers. Non-integer values are silently coerced to integers using truncation towards zero. When the argument \code{scale} is \code{TRUE}, the result is scaled by $e^{x}$. The functions \code{expint\_E1}, \code{expint\_E2} and \code{expint\_En} are simpler, slightly faster ways to directly compute exponential integrals $E_1(x)$, $E_2(x)$ and $E_n(x)$, the latter for a \emph{single} order $n$ (the first value of \code{order} if \code{order} is a vector). <>= expint_E1(1.275) expint_E2(10) expint_En(12.3, order = 3L) @ Finally, the function \code{expint\_Ei} is provided as a convenience to compute $\Ei(x)$ using \eqref{eq:Ei_vs_E1}. <>= expint_Ei(5) -expint_E1(-5) # same @ \section{Accessing the C routines} \label{sec:api} The actual workhorses behind the R functions of \autoref{sec:interfaces} are C routines with the following prototypes: \begin{Schunk} \begin{Sinput} double expint_E1(double x, int scale); double expint_E2(double x, int scale); double expint_En(double x, int order, int scale); double gamma_inc(double a, double x); \end{Sinput} \end{Schunk} \pkg{expint} makes these routines available to other packages through declarations in the header file \file{include/expintAPI.h} in the package installation directory. If you want to use a routine --- say \code{expint\_E1} --- in your package \pkg{pkg}, proceed as follows: \begin{enumerate} \item Add the package \pkg{expint} to the \code{Imports} and \code{LinkingTo} directives of the \file{DESCRIPTION} file of \pkg{pkg}; \item Add an entry \samp{import(expint)} 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]{WRE}. 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_expint_E1 = (double(*)(double,int,int)) R_GetCCallable("expint", "expint_E1"); } \end{Sinput} \end{Schunk} \item Define a native routine interface, say \code{pkg\_expint\_E1} to avoid any name clash, in \file{src/init.c} that will call \code{expint\_E1}: \begin{Schunk} \begin{Sinput} double(*pkg_expint_E1)(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{src/pkg.h} would contain: \begin{Schunk} \begin{Sinput} extern double(*pkg_expint_E1)(double,int); \end{Sinput} \end{Schunk} \item Include the package header file \file{pkg.h} in any C file making use of the routine \code{pkg\_expint\_E1}. \end{enumerate} To help developers get started, \pkg{expint} ships with a complete test package implementing the above; see the \file{example\_API} sub-directory in the installation directory. This test package uses the \code{.External} R to C interface and, as a bonus, shows how to vectorize an R function on the C side (the code for this being mostly derived from base R). There are various ways to define a package API. The approach described above was derived from the package \pkg{zoo} \citep{zoo}. The package \pkg{xts} \citep{xts} --- and probably a few others on CRAN --- draws from \pkg{Matrix} \citep{Matrix} to propose a somewhat simpler approach where the API exposes routines that can be used directly in a package. However, the provided header file can be included only once in a package, otherwise one gets \samp{duplicate symbols} errors at link time. This constraint does not show in the example provided with \pkg{xts} or in packages \pkg{RcppXts} \citep{RcppXts} and \pkg{TTR} \citep{TTR} that link to it (the only two at the time of writing). A way around the issue is to define a native routine calling the routines exposed in the API. In this scenario, tests we conducted proved the approach we retained to be up to 10\% faster most of the time. \section{Implementation details} \label{sec:implementation} As already stated, the C routines mentioned in \autoref{sec:api} are derived from code in the GNU Scientific Library \citep{GSL}. For exponential integrals, the main routine \code{expint\_E1} computes $E_1(x)$ using Chebyshev expansions \citep[chapter~3]{Gil:2007}. Routine \code{expint\_E2} computes $E_2(x)$ using \code{expint\_E1} with relation \eqref{eq:En:recurrence} for $x < 100$, and using the asymptotic expression \eqref{eq:En:asymptotic} otherwise. Routine \code{expint\_En} simply relies on \code{gamma\_inc} to compute $E_n(x)$ for $n > 2$ through relation \eqref{eq:En_vs_gammainc}. For the sake of providing routines that better fit within the R ecosystem and coding style, we made the following changes to the original GSL code: \begin{enumerate} \item routines now compute a single value and return their result by value; \item accordingly, calculation of the approximation error was dropped in all routines; \item most importantly, \code{gamma\_inc} computes $\Gamma(a, x)$ for $a > 0$ with \eqref{eq:gammainc_vs_pgamma} using the routines \code{gammafn} and \code{pgamma} of the R API, rather than using the GSL routines, as the example below illustrates; <>= op <- options() # remember default number of digits @ <>= options(digits = 20) gammainc(1.2, 3) gamma(1.2) * pgamma(3, 1.2, 1, lower = FALSE) @ <>= options(op) # restore defaults @ \item finally, \code{gamma\_inc} computes $\Gamma(a, x)$ for $-0.5 < a < 0$ using the recursion \eqref{eq:gammainc_recursion} instead of a series expansion as in the GSL routines, thereby relying on the accuracy of \code{pgamma} near $a = 0.5$ (fixes \href{https://gitlab.com/vigou3/expint/-/issues/2}{issue \#2}). \end{enumerate} \section{Alternative packages} \label{sec:alternatives} The Comprehensive R Archive Network\footnote{% \url{https://cran.r-project.org}} % (CRAN) contains a number of packages with features overlapping \pkg{expint}. We review the similarities and differences here. The closest package in functionality is \pkg{gsl} \citep{gsl-package}. This package is an R wrapper for the special functions and quasi random number generators of the GNU Scientific Library. As such, it provides access to basically the same C code as used in \pkg{expint}. Apart from the changes to the GSL code mentioned in \autoref{sec:implementation}, the main difference between the two packages is that \pkg{gsl} requires that the GSL be installed on one's system, whereas \pkg{expint} is a regular, free standing R package. Package \pkg{VGAM} \citep{VGAM} is a large, high quality package that provides functions to compute the exponential integral $\Ei(x)$ for real values, as well as $e^{-x} \Ei(x)$ and $E_1(x)$ and their derivatives (up to the third derivative). Functions \code{expint}, \code{expexpint} and \code{expint.E1} are wrappers to the Netlib\footnote{% \url{https://www.netlib.org}} % FORTRAN subroutines in file \code{ei.f}. \pkg{VGAM} does not provide an API to its C routines. Package \pkg{pracma} \citep{pracma} provides a large number of functions from numerical analysis, linear algebra, numerical optimization, differential equations and special functions. Its versions of \code{expint}, \code{expint\_E1}, \code{expint\_Ei} and \code{gammainc} are entirely written in R with perhaps less focus on numerical accuracy than the GSL and Netlib implementations. The functions are not vectorized. Package \pkg{frmqa} \citep{frmqa} has a function \code{gamma\_inc\_err} that computes the incomplete gamma function using the incomplete Laplace integral, but it is only valid for $a = j + \frac{1}{2}$, $j = 0, 1, 2, \dots$. Package \pkg{zipfR} \citep{zipfR} introduces a set of functions to compute various quantities related to the gamma and incomplete gamma functions, but these are essentially wrappers around the base R functions \code{gamma} and \code{pgamma} with no new functionalities. \section{Examples} \label{sec:examples} We tabulate the values of $E_n(x)$ for $x = 1.275, 10, 12.3$ and $n = 1, 2, \dots, 10$ as found in examples~4--6 of \citet[section~5.3]{Abramowitz:1972}. <>= x <- c(1.275, 10, 12.3) n <- 1:10 structure(t(outer(x, n, expint)), dimnames = list(n, paste("x =", x))) @ We also tabulate the values of $\Gamma(a, x)$ for $a = -1.5, -1, -0.5, 1$ and $x = 1, 2, \dots, 10$. <>= a <- c(-1.5, -1, -0.5, 1) x <- 1:10 structure(t(outer(a, x, gammainc)), dimnames = list(x, paste("a =", a))) @ \section{Acknowledgments} We built on the source code of R and many of the packages cited in this manual to create \pkg{expint}, so the R Core Team and the package developers deserve credit. We also extend our thanks to Dirk Eddelbuettel who was of great help in putting together the package API, through both his posts in online forums and private communication. Joshua Ulrich provided a fix to the API infrastructure to avoid duplicated symbols that was implemented in version 0.1-6 of the package. \bibliography{expint} \end{document} expint/inst/doc/expint.R0000644000176200001440000000366515133327553014756 0ustar liggesusers### R code from vignette source 'expint.Rnw' ################################################### ### code chunk number 1: expint.Rnw:14-16 ################################################### library(expint) options(width = 60) ################################################### ### code chunk number 2: expint.Rnw:180-181 ################################################### expint(c(1.275, 10, 12.3), order = 1:3) ################################################### ### code chunk number 3: expint.Rnw:195-198 ################################################### expint_E1(1.275) expint_E2(10) expint_En(12.3, order = 3L) ################################################### ### code chunk number 4: expint.Rnw:203-205 ################################################### expint_Ei(5) -expint_E1(-5) # same ################################################### ### code chunk number 5: expint.Rnw:317-318 ################################################### op <- options() # remember default number of digits ################################################### ### code chunk number 6: expint.Rnw:320-323 ################################################### options(digits = 20) gammainc(1.2, 3) gamma(1.2) * pgamma(3, 1.2, 1, lower = FALSE) ################################################### ### code chunk number 7: expint.Rnw:325-326 ################################################### options(op) # restore defaults ################################################### ### code chunk number 8: expint.Rnw:389-393 ################################################### x <- c(1.275, 10, 12.3) n <- 1:10 structure(t(outer(x, n, expint)), dimnames = list(n, paste("x =", x))) ################################################### ### code chunk number 9: expint.Rnw:398-402 ################################################### a <- c(-1.5, -1, -0.5, 1) x <- 1:10 structure(t(outer(a, x, gammainc)), dimnames = list(x, paste("a =", a))) expint/inst/doc/expint.pdf0000644000176200001440000020551615133327562015325 0ustar liggesusers%PDF-1.7 % 19 0 obj <> stream xYˎ+51*?( $@b$lˆߧlLAHhnn;v=OxzYݏ^oBfy.vv92>,/ߎ4"+OLF&*p@@GӶFRHh2Y}MHad-zH=%0+٬E[*Bܞ@WkmLD Ѯ)Z8L-Ҋ  aE4:Y>18r&TZ2mƃ$#c:%j?TôN|ip1XR>2sdI\L0}e%eѴ:BrPX:^3 <"eʲUrmj+G.ǃSp{$٬.}6^1Md+َv3І TX"dj[v' vF9t Cve<5}]On{A h=)4va4\#/ 6"'/14tYqH5;c`8{N6+s6H*d`M=m % Md|+"8kzA=ȅ9ûrs%o1 r^aNq2`َG,$s3}uT3{hK8-378]Aۥ )T4J'PHcLԧ Hm\̴H`ɕwI&*K +n 19!{汵ObntbVZ/̢e~BEMہH-U+9VqgU֭Id^{JN[R8w4IR!|*#@UͭylT/lbbMGhwi"N$ ENz E{DKY_?ڴlWly—aT፣aAqcP2xylxCEy1p]whƑd>ɉv`mEVyU*-?6<+cKMAx>i| ;&#5 m;Is@b*]_SH~!ΟiʟLU<͏kσ04g{ +ӆN+>]?@PVy rL/? ?zo2im̧n nh"4s =,ic8|:Hxnì^q? 17dr ۼBY7|Žب2S'O;gIq.080㔂$SA+ v{|}Nsz99&S(NC_x&L/g|-d{C{p&ahMyp486="?4) endstream endobj 29 0 obj <> stream xڽZɎ$7W,R;P`/2?vE(2# XPH?Xr|?~R Hd8)2z4.I)y}?twYwFWkM|_alAc0w2KxNAVe@j ؤa#{צQtgܬijY[=범^T_j- W C8+tk&G&6h*5%MyжWz)#:EƁLQ E!%!DP Bb<̍=wl+|ҖH 4:>!8mdE/ۻl@-~%"]1N};J6vyAbXQF bۈg䲅GF&mAr۰B+r]MV Em" c cV{  R}ѾhT#>ptDEkPHSnϦ*F۪1$PļߟŎJ4+E,vMż9]kt"i۰2.~N6hw9{){CcC pmH;*ª"|o|~p—0u YEu +D'{  _GHH.3} MBPMc[ˎ_^=jbϩU7)҃^ZSbd2dŊ.uuz^d/Ҧp1;<0;i .:- EVX2_CBAPBI2PoC\ &\Sb+ kLL;J4XLU<[~dHbay/D~l )]LOكo?w7e2 yueEkЦKwZ 򐿌X"9i s4i !"niQH@G4Jr<b"= w%&1 1V“DLl!&PڼK:Xk~&յ U6ܕۥٗ'.4T%ܹ́ 7''XnRKh8xaW90#sfLK6KfتV` Iq:`çR GrNL*Nz՘U:ӫCQNy}xe>=NGfG]$͐bՌdG"r<$BS 8@P؇((`D o^d* ߉)ljߘN$cĭ\O(3DRGca9$d:3f]e!r/rAOha̫Ech՘#E$~Y]d:ICuwtGCv|ibV!!f}૊'ţ_+ŒY.O[dJNJAiaAG{!L;a"01iRTU?AޱG(IM3_CȾޥz݁d|G2弾.ɂ6m,^|UE2N1O<_1H0dA߿<^X;w3h"v"M^;t$U;Dn[ [qHlPWC?8}{|~nWt(W<Oqx句f!^9oM='c#W_\% ҢĔ== endstream endobj 35 0 obj <> stream xZɎ#+D3n@6v $sߟΤmѣK0EP 6-`s(E,Z`n ~;X7A7Eл~@ ߬kzɔf2ziR:B}@ g]FhZ3~嫓fЖI:C;6/y1h`Yɣ͡y?pTMx(Zb@9Z.=`*$R:p^NKURS`=#Lȇ[(v䩈GY4?oE U%QĎo<"]4/:/AoGrL^.$!+}g}i-) ɜ"G+2vtZ_;S[ULa=?qr%'/*SE8݋h@ۡU9NNّ:n ; u0҉ 7jc$S@op*1DY| qXf,Y [Kf.bX.ceюY[篛lpojŁYE"Uvl헅۰GmyS~lC VqJt[Ě\h)ؕh.A[9'{fhA @s&+*gltD\|'Ot7@-'amF^r zD`M<45X̑APxAu;sqMs^4\kqZQhz2L1amv5iU2ߥ?</p6-e!`*rM[6 7z `mdSgAG;Ks(JI(CXí%M,MG}{ؘpN _PªP9/I&h 3rSJ{KpGeI\;.{/ @52eߺo bd{Z6bQ ș0tw;N,-Vi`(FS^%CdFys@PoAssZ@( >Af2z]$$2z TEI@sqR D@R5l_:tnB_Y.GÐlUSTp=ζD]JWa iA.(\C{KCK(92QǬ_² &1Y?H]r\t-$䣄Q<|(u+D{PT3"Y Js2[EzZBTAҏ|>خR7䂾ΘfDMEa*҆Bui|i7$?st.9ѓGUw)0nVjb({7#XsN X yFBƶI+^vdBy×8vpԅDb M&`i!+1. nJL% pjcPe,)W4@7Op#s1& =jE'Zf[ZI|%vȗ\v*::]TK8LӐTH#<3 .!yěq:Id{Qp+0Gey%lm-md:ϵt~F)nIK`Ykڨdl K3LKfe\g4zf yؽì ~B}%tfi*v9qK+ԝ=7 I]O3u5x;{ȋvG.oHciNz$M64ԍ8gKs wn(+ %P,C#o;[U_Z YRahmyS뱙*KNݩf@N@1 bX_ž 󐞸Vh$L8ӽ0~uf)q%ړCᚄnTf|;Ü+I9~GA އ@/F/Kv6Cc̝Ib(\R77~K?W(%пZC)g0afnIp,ym%ߨ-OT{(@XJt;D6pˮ+͚DǍN;J[bb pzccF|IK睶9NJܟo?%y{.њ'NE<4ѳgoz:!)D2?&/v_Vn/G_?zڤ7%;?*X+xCx|Js[ endstream endobj 42 0 obj <> stream xYˎ++DoBl]f&^n9|-j$]Fbx폍6?_n׏~chA k{{aY8kln?( _~~FW+U"o.'d+ϰcvpZH7}`ēvR.>I&I#i\K]DoW_-6c^g'w +Eu<).i3Ct*|Gy,Sf3 i4+$1㩍2$9)k %xA &›IDxcp׸ǯ;pHU3ŅQ}!Ȗ5pq()g/>qeKasKAq,n\4C}bxPS Q{B@I8gUfdܔ0:qE+(Ub 2!"UK}FQ9,_X]PNI}tH"ی뢉0t92EEA]AYa2MUY]ՕWF(绫lp/ݗ۽zT[s}%]ȶ;4c;Y_bF7݂׸v#3rEFi*KgmVY!$1B03B}`^lu@2Q=9oXb]M|+ifI]n4B"Y(<I:'[]G /h`۵M "v\#.J|+M߀l6{Lm/~+Yp.i835`3iwLeiv fAP%+"P e=!퐷F󕔣dCTbbMKd|%u/{Wj;.3g]I+QV>ABF[nWb(kMws%0ByΖ7e([xEu(Qtc(Q}F-k|0֨p.R{Et7Y]AE Cp>ߖ ;2KCyax|c_\|d!BLu22Ϻr ]i 0Tc&{+[10Pu+ GB,lʡh@?\ktiwb|ifjEtx€!^WDZ@򫈮 mG.!Snw(^$(;0ƙF3BQd/?[}g84 >8ЖKL>+5zYgCzsk-vA(or~ 5+Kek,#uO&ʒQ^ekF%SlNjXs'a8'l9l^-N^}Rp Dz52k3C NI $S5K_Ʃ8W]}Rd;WK?Wt Ut+ vFl–-n'ϩD =t&ě P"/rM_d* 3D4IQZO PQѹ}"]Д` Imss,5Iy{;(WS I㌌ ? 7]o6)x`И(͕fIv|o#7Ģ֫q=A> A3^qzS(_[*)u6d(yT㔑3ǡ+YQ K|_D9omjS8i gpyYr㱹a?5_U9Цv}n՛ g0c:xǒ!:AZ6M z{ 0j&_܆sLpB6 Q%;f+oSԇWj̲VB2)7笫Z׽iJ7esUV2,;!+'4챒 endstream endobj 53 0 obj <> stream xZɮ+ +T.f@"@l ;'od!]I {ɚ[ýesݝ!*CT##TԡZYM7f&j\j|k>5gcϹj]DFkK ##FȜuM̻gJEH<뙆okv_P[~2.aPMե.$v]RCIL/Sٸ"|b,Kd30oV]RH Z$DK `ow[î:!sjlhwV-M0iIz|T5{kf#*.Y.&n${J t~]M<:oP >"j/N/kAݮv iL:ї7 NPCn ֧7}ci{&cœi+gA1tÈmh]P!F+/"xZ`ǵ}}"(pM0~h '腠1Rwј7iW/] #m411 ӒXulB=YWsJd9:0 6hlMJ4TJY(7x ]~k-Q/_~xR1w2G/>)lQ`ܒ-ܖu'ё`)dp9\D8t.3?{:^V=maTl!]^s_%/o a!8 Њl < &%*qkQM!Ih쳑ʬ.1YHXZ+3{"Ww\p:N~p8JsQ^kWAk4l͊A`*2V^ҫ5P81h_U+HՌ*?ΰQɮ_7]c'Y(^gpWz ཋeDxƢ!zšTO8&&y= ={n)j R\-xenwkI"\?o_?X`H/.Civ٨-߆!wa2n|9OHm߯|HNwU,x2s*j$'=Tp Q){u0iKy"gLPNXWyCAӍ2d,y|P +Y|&+S[w0|Yω1(֖.3TwR$--5(c8C@Pgߡ[ qc$;M5ei@>q F'J}?ȗ4'Tɭ].yj\4LsY N* :KeGV)ZY˼.),LU$lR%y!V(3sY# 4\u-4~M6Cɍ`@p7AT4aQrjkeCZ s,˰T+4z:N B~khM<{ܚ4fy>+$:=J( lV8ˣPߢ%E"[f9啺^6dd3nϾD1 =oV]NjW׎NC.I=S άU eݩggI @9탄!4YN٥CZrkGv͜sǖI{쎯RV6Q9[iHC[zk^ƽW&deyGt7+a[3.oxZ{*8)Rz eVrǤZ[3~0߆$w_lWqN֬>c&k̪&'j',"Pa]|'H6KOru,brcAZZi(d# I-P9azO벺ˆ4+>߆w0Vl h*zuV> stream x[$E17P(Cdt]hYGL6b%`\|`6Wn/t6}翩 2%\z4n?:J7 EtOOkibNs' L$\Yj+qt!:eRFiw:XG3KCӥRc,2G*8m ҡ0sRC\G$*[/q@zGUI'y2ˋ9@@%LGjY[9Djsq揽**\v cj5g򸘤U>ql"MDVa1O\heP+$p2ۼ4dL+?R\cpJ#AGAiPx&VBVv 3* _T^ )q;xMQݢ3}I^HsF/1E3$'iY/MG9a ? u f7tY],lQG %zV>*ՌjWD-h߰ PR5t;*ٯ98DkB+m!.A4C;|Ҳglg~C XE?'yXR0NaRwθh2.OOi&b:dXi`9jO'eq$eJuu2]'x/uҦ4T(l[x|e+\& dxЂAL./wj:K^hf۳R qUn!cQnĩM{(ܫ9bgթ!Ai쬢: P,Nd0-q-|_u\`Pm#e\IO$8"A~{U';^NJ?*QPǿ4:O jk]N1-҄:8 BXDF<hRuƈK&BG T @ZS&@rUmڋR未W7:oKGکIIcj [6e #cjGH—St؈o %EDkvNA͘Ke|ן%`۴xa)w]ho)LJK%oh[XF_O-0Dfo[@:»<ۅTcPkvS~d%f<*y .eҺKOZve]5¸9hN m R n'(=3[!L|dL3"j %DZX")$I71P9Һ-c\n>䨊:B+2L+HSfkY7P})<'OGZG7GaD0(bh"F7GY\GAYv w؅ ÷wq Lq7\ɞ+It5ywZSh#9ev.kI1KTS| G~(qmŀ{/v6SLYv)V:@߆0L>CEfZ ecF'-!A.J. ^oGvzOH ߍXDqAc4U*崐bJhE<{hk@f\m+U0zD)C r0JKVU>ٚq1g< wzK]NS{8X*ϭP ȟR9;PHㄅI:ʯ<Ӽ.y*3)Rjٺ{cw̴tRQPp*)|Gq #16a5'ޅYif‰P_5 @:=VS:fԩZؘtAZP('d]ȽrzM)'T;aSȡ7w'5jSs( r5 ]ZsaJ Եdt UW}d}i+]Kw1^ #tyȮ f~ YM(ylC䌬.O1 _,.вT&@ ݺY|)竀Q N'k8yV1gYg[f.}x]Q#Lo6 bzOɖ{Q-YRBNh:%51rjl4BUd B61 #e`k,uWv\s$ㆪ$^[HBgN qn66T(/JKܶq)4% ,u1JJ0Wc%ez_ҹ=9=gL.θ_4×9c]Icd~ks.&ݭEk5oL6cȤED2`{ᯁQNU>>|94 5! igd ېF6W\E dd S.B]Cֱ>;xT& mfBǰ @/w PWp^΃$sT'w- 컧Y]adNV{&w\q2ՠ`v3HA!plӕEsBp(\xo[]ۨxJ޶\H1~~/ GD}֏'C7V,|eDl+(;$rn}~N(9[tB֠Os=S endstream endobj 92 0 obj <> stream xڭ[c ~+.$ d N-v~HI(>`ƸDQ>4C4_>~O?.÷[s:CRN:Z}N?߫;=/_Ɩ:3s#7Ze9*khr+3vHēO7|}usnd.[DuJv̆6{s+Ў!oM^A9|?~h jlVκ1kel|đMB2. <fZ(͕m!W̴ݚ\l;rbq}<=wMĚϽK\4d٨o G (f9IzZ2%|L/g=W)Y@QSRZ<maCw-iD 0)O>ԩSpݪV8 X<\$MaC"EM2tLw;CQ9m꩹܅hXriۢ)*8 u4LGt'4\qM]DʪM|(Ԭ!1)eK%plW O%2J]bHsXq!ͧ:J6ڌ$cM5Tt hPEq6]qENaG]Ӎr3fjMxE.I{nu[}A,D3'_.̷3M4N+0 ]/>dYʼnoGGZ*^ L]bk3{Vz';oqc܄6tr BpY[4҅ےͩc?ib8YJ}AmhXG 6"5|hKUJS&ӷwdd'^4qmTZ{_is6=uZ5[H.Y2H}ߔ-`Z,7d5.礇pz- #,de!:r^ u,uOJ?j-|*Z؞LN9RqK{ 26{O0 vknG3S,}f`)򲥈 FNJXuΤ !K;[?uSTeT*gFHڷG'gw)Pfc^#n Eh^LJj\πɂ})nl,8& -DY;kF*>9 i'dBKwԑx4 Nu%Tյ$J䌱J:zNUB@劋aؓWyT˱qӚ.mA# _vbFX\69X^C&Qg)U%"S>NΘ>KVS)߻| XΌ7T4qxsT6ZSkJ.q~~%4A C Aia_A ,(MDm|Q m߶vWݶyEi\̒NGMQ0Vge H 9y*jva-?w ϠK񾀴""Y^)lFfy9)k`xS#AkƂt.ÝNe/O鹞oP!K@b۬a#yBܽXͭiY~Z%TfAY;@kKŧZ@5ѥs^J\KSHH5pc`LBx|[b JIBQ76P}2bmuuѹ¿ƺ[LwMigص5\%,sw#lT\D62F.He(&4(QfvW[t-T[fJhDi@ƕ5JDLrW ׈<p}#H>v:bd\ZtlxU|ī^D,dZpA'WhrVD(oG#_x7_i>|YlBZUkv-mjnT(+0YV6hz܅U8Q,+&;~?H  „7yx?Vc+}!"X1+8c{]m#]Gt@[[xPϯv!:}Ub[WsJ =r!ҼMO.BYCp` ([+N)FQܝ>{'1}_!L]Ưbi5&4_p.b4rCY^/d&{ډ9Sfn=|ߵS6xp|P7.1N#e(Px"V_ j9 e-\}WU{PVk"νL"O" endstream endobj 95 0 obj <> stream xYɎ6+p+.`b9[ԋ/S$bFH0[_-IM5 >ykE?&G.E#N `}eZQack|8u@5)6sf %>=Q\6}!NC5=&V. )q닔Z^؂]J= ؛qMexW4w#dE61Z8S;6w_/ckXU4\ZgnKzy]Zڥf} =!Hy^ SƕQ() ^ ;m ̈ ˴dr2QFL(XL9'ّD+4CV^x:gE>*h\ EPQ߅Xql5OZA٧BP6R' Tv/&?'-ZXc0FY#rfRpX<!vcā%0+n:ڹ~.25 2g8ݦ1V͝HSā3c3üq{a14>"Ͷ6gyxq K :Ҋҹ13cLj%f}IY3큳)+|R,cĖď[%}@+>6=\Q?n~{}Ơ|{4"ʘABIkª/Oic5<[T*J~3(ӊݮ,T1 'e$nuciZYf IVy}ܥs/ tՑtl 7ho0UnT6TjDq#,H e][ c]vDk4aťsc-nX2kɘ(g3bP#D+5bp2dd1?MUM#C5v䶂t#z6;ePAY#AEFt&&1Y&¾cRI(,V[&ŕYQr 3Cʢfmo6O{Ҏ_ w+cե'R{ew#INxae̾ˠƶ;DCaNVC#P_!c.)T`^"ݓ $=0OkhAdXWLG&cߚlOeKͳQw󡽮/lT^]|ᔟڎz~[qhTϽQύagb-n%K@[4$ MjaRPN;'qcqG;u߰> stream xZK# WLC%[mCS^ f ("Q?p \xO?Ǔw[wݟO9nӷҶޜ\.w7y; W< > 8&Lpy|c<)B^BD& W8T8|\/_ʓ/ā,B<N< U   Zw瑏Ul T^eSW!+K#x,nȊ~;2? YDUZx3yF]Qű08>zс(2*x'q: bK&ED;{{i7x[lQ}bDJåȹNxyS«U5Y gSAꎨUH7qU4 4w=^U<氥w26*YcLt Jmo[C;n{CHoZDȰ6-hVЗhCz4vUSuL{T⃳P6zm9= /o)e<34dFW>SŌjܖ|z~b\B$'[{ Q3ذҕ  !y~1(!wḂ1F/ORxn蒸PR s*?&Tdعl(OsLrmO,OCz kƑC2CGfeT(BVa`XL~͸E.:JU,[m5V>o1ƒ6 ' B{ɬ2-*1l [$g_a/=akp 9/BzRf,j}w8k1wO̝ټOq7Pԁv?cuYc1QӭȦY{+/U +և@S%KNu֑@ZsCl Y;ضM0foG 1f} ^75^58Jóswro-3Y|m Siڗgjڗŷ1ҪK"yǠ9j3 n6g;hqA4U) (&5AC8#'r`KOM<]DT1#jzs[ ;MOYߤ˰h؎uYԼXV oD>@RȒs,VhˋV*!}7>ekV-OAv}ٲ$Y؟@}V^Zd k=֌1j L#v#rGl0KIĥ yM) m7љ8ICi (EJ`n%$<bP@nc&T'$#=+ 5"h'"&} KwloSHGAH^8s/T6h+.W#;RU&IhceuzVW :\ҹ("yF!*G4}֎0MAk!k[ΐ`d6FTw`ç5XRL &W)czZӺ5K KLy׈8Q{k="9ˌ/MkC^ӂؾKsVydwbᝠ؎ <[έip|͌l Tm 6Sa;|;9 7k5 P&n~Zbv6.3kig ho}[]B|@0',CWK@Xg@C>x-`Uv:^v&nA $-:v+Mwz71F;_s]>#T[(U8lH2 e{nzYQ[KU G~^/cg`Dއi4GQ_77PlەM&}8sl҆vnA.AQt,RHoTO0.ap;l䛴SMK}A(.>-io2D#?]fuVi\HϾw"/"ϣy? yli+~~.Na. .W~ЈDY&?NW8I_ ܶMKY7 BV,1(&Gۛ{&=d[d=3}QWT]\wޫgaO/\_T4,ն+2,|!8]TtY挻(s?|"#Aڽ\dj&nw%ӧ'@ޙ+n6ըVEl-092]oĂ73."8Pޏ?_"dk'kzKzڹjC*x~3(eZwNd&UIx%m)iԿ?] endstream endobj 123 0 obj <> stream xڵX͎6 )QE|(.[=L?)$.f ;DR$&,M׻^qXSle3Igk',l`orG/}{Q,m4ho#PɥQEk>%UtJB1ja)hrM 98q%ϯУ9EEF9 Ȼl\o 6 ,8 (JT'ԫP=`aF @v SԁRSwAD?BN:8Z5ˀxoxhkS c0 ,YuὫPrP`<[s՛:bX%Nja%ժaMO!D]#TI.#ՑB MY^o]L]Px m6ݎ<֞DOu)L:tA wߓ|Y}#HpLOՓ\S9)!Oڈ&BMnk8ID[͂j}3}wR_ uSdl6{_b^ h|Jd'օoQ Q !,\%1zBKN[9\Գ=H |9 *k{*nlTDcɵ:9U+(v{]tlǦՀjenUOHZ[l:rwbW|t/qsfxu;zer | *EX׏P~ ۱)h_-zE2V{ZxΕ[x#>26`)&+JZS^ʑ^i 7 t-JG{Ff3!~WN=X德%3Cg=c+2r2 w@8t| QZ.b!+oyЧN67nw[t_ Hx^=(\ۊ]wZ"iihVi5UbWa (w8y-r:C9Klz\#R endstream endobj 11 0 obj <> stream x\IsG9J8<[1CAifzDB2I Ƈ^fV @AP}kɪ5d#BLkmr QW &z<&lmdpƻ*Ǎֹ/8Le 1x>̗TjLLJ6&5ZX̬5hKx>#&q p6N7F%:T! A% "hJ +(h(j)&H")`F034` r.hD0YF)⨀Q0Sx "@;ڃ#jj 6& S' ^" D!AJJbR'0S8N4B(UIs7a >H')-<(U,tBJkb{Ze2Yf4@% R5HW6cE  Qy*|,qQ5\0[CcT!蘊%z0ab Czf7FBTpYҧxg&/6gyxyfyM+Xə99l,)|&sϳC!3>kszO/2m ΐ;a5Ā4EPf)C-$DkET|7j{t.c+OeUϮ@~fmFIm"~O=Pvj5^e]#C9^Pi-^j-GӾ<-JSb>}M;qIw @Ӡd!i>'4XO깏^+>kN'*hk:@T;[3K[qJ(i:k5Tʎ/8rĂ|&Ono7k^=mby5[^0ד?OM~rb7LǓZ%2(@Z@ct "?(=ꭠ͝r}?]v }4>]G+=!`)xdDIjjv dEJYݱZxjBZsrǬW-$ ?y,׿ 'wo"T턣_IHgmԞ5PN@;}XOL~(gФŀp/n`wNi(A` Kpɒ &:a^1@DtZanp򔱡uF p_CO6uQDݸ vYrp8hNHH<Rg.٨@x?G#ŞCtc`n|D1v=Epe'e˰O: usA,GV2_$ ?kթH;$^8>Cߨv۰:dN'rۂuy}|֫88!QW4qxƷ>Xa݀Q\7ral026$)Bz2Ӳ6vw~/}J8&\]<0SHɮXz`UZjOG6T>>կ^ks,jɓjC-WCg%4jHujpVSڇ=HfNo8e2T :S_ *U '$ x$R6Lm4}~{];@5Z=w=nCSp5{>5d:KHW8yih:al,R8A/,iwlq-8J4ؗkg}z}v2y7__O߈Ž>oדGju?[MzU5vQC52#B^0HQF^Ц_]緋ozťQH E@u˅BUZh$#V׏EÀAO4!.Kg|Bق`yI9 ?j ֎Il%3 b(zp={u:Cpk5+2 רqG˛lSY *=h=9tLhGdrBC~{bqXlW 'kzl٠4p߽=r!A @;ĶbBj$'3>\ÆQ [>uWߴ{j=D@~m#d*!݆F*e5T,TX=ft>CRCnl0_3:K2(IIj0rJr WJd$}Ƈ~MPLzyQOYɃ-*=Jc#tA\- eL1uo/p-q&Ú[=9fWDsGd\-.'7jrį;8r W;1 2"1tw=މYFjjmQ_U뙼ҹz&DLJ2goe'Šk8Щ bcB5,XQŬJXuHY[pi'kp_̟@8$TkewvL>2Dŗ㆕zu͏G/lЊz=ez3tЏ>=}ƭḷzvl{Ky54jsiθ~ {m;Kw#S%@8nxe:Se1}TD 's~Wx9#Q>.u{6vuq٦ú[Rf`uY^un6 M:~ȓqdnp9ij4ݽ"_CX@7L)Cw[8eF~lQتNף/G?2nQ~Bz[QXoɰYG9a>o}ނAy2RֻPA9Bo}N_ennL7 Ć!OHWU9`hL#쉣dznHm pP__75|gq}сیK|q҃;`s2;>0fڅ f%?JBɉ4H逘cnXK TQ/HϣJ?]ް5ȡPpIa <18\.1&s1zGeHƆsNelpyŒk.?9Amg [Wos#[͆\sx;T&MR2Nq#q|$=Ʊ͟c\9@gh,UN%To2L:e+=[Z|݄ïTn-y=~=ï8mVOF5J-1:%džz%0WaznU(SjMJcWwWT#vfƇhg>M`mn? hт4?/~>;q(;H`jɍ!j_d97wogoJiPOC)MRnxy;MS?{LްbݮDu0!'[ J4PyC7?*^,g/{\͐UdK}YpiqxUUv{_Y;5>q[`;k=:q }\.?+7eㆯʢUz<}w7{[2ږm銪p8>jgC<9M=oŵu%šOhg`cc8lՇmF`-|SC =9ʇ-y|Zwtա:aqWUKZj^G}jM\+\l_^eW]o׸F=U 2^Pfi6zP6n^U64+Л*M',m~q_ik=Ei65})E?aڻ׭(Ǧ4*Mæ lJG)]-DJs)"~9[SzkMFYScMi5 ֔ ˜,:Cǂ-Y\Sij5Ք&VSWM>5PJMi'5VFi5)ԔFPS?Mr}tO#maIJp?dxq+zQAMTՋdc:2Y=TGHMTP[ں֧NUUTT%En#>;T~*zRP5Ÿ@3[UϳŇT1iHy?}r endstream endobj 229 0 obj <> stream x]ok0)rcMZmeZ^섚hwYa DwOKϊ]ځ{E kZ%-j[9Wt6ou/lRVű v/rvr2 T7lؕ~PfI1`oi# ػ`[ufOHy5^'BKM- ^+eI>%a٩_ŘK"DъhMmD9/VshID)'pNEl9|JkyIKxԈb̋b:O8M}-pLi'h3U: endstream endobj 230 0 obj <> stream x}]o0tY EĐ hƒ}d`[#B*f߯=}$<9Sz$K3}mC϶5ۓm`( V7U?~C9nTv?}^dg[W?~i_Xհgi~>pԶeØkҚcl܋A7jF$Ǚu{8Dq`p tv=Dl2O䀪%emGm4_hϛ"(F2JCQ3>'%&g$( JW~aM'aJN)PT`̻ *!Ø $"Z "*OD\D+$9D"AqKD'HH%ׇ7 m~#qBQ{l+vBuJj6 ~[k;7 endstream endobj 231 0 obj <> stream xuQo0~4U6"EHA4Ү{$H ʷ}G!6$*-dѵ#Y}]ۮԟuNΡ4m=NUT Q?r[m?j|J?lsF1~{aFu,}O6IkOw~F;<Ç:n$EpEuߨPJWA9<5w7HJp&khhe)R!ICe>"C5) R$ $<@Tb(JF) GB>%F];Sל$/r)zSx7'AW &:us c |W\ȔċY8*٢@ҥ"(*lQ*K-!*rQKuOKooIܓtۄY-S*ĭU$V)ٝ \vm]yf`ao튵~Y $: endstream endobj 232 0 obj <> stream x]QO0}1 ma !AFXrLQHa}{ ߟڳtz`iUj]ۓQp%$+k5̄oe'E-`=ݽfy9| t(ZX 9]g~&Ub~".=Lړ)$C%;uVT[B L`|\ 7,( F;c4箈&iőF> stream x]Qk0ylEڵ B >ti<]&!C4gр/3s2/e` ^B+SR >,d߼cq⦗*BvRRmol.ߒ >5pW~"qNi̝z^45![d]FoЁ$v\k0ق{HH\L#q@/{̺6MўGiGJh#HRniJTXp-'0Ϥ壥# }B\ܡE!9O[13 5R:7³hT-smgCi, endstream endobj 234 0 obj <> stream x][k@RoB酚@_NRijg>tA۝9sfw|_u7 ME8w547Ӑ8ѥӎT͵7J}|͟Oegj߫㡔h̑@BY}^l6,> stream x]Qj0+R4cHm.t!WEXL뿯'Hf)Bik $7803^L`vEf#IZQNGPS:G񢮼*ض$C,[qSdql䠠(uY`sa8!/6xY+(-dIY:d)CC"sVBqtV&(>VMviD><*: wkO@HHdzyIV=w_UF endstream endobj 237 0 obj <> stream xUX \׺O 3֌]TE\@D@1,Ev} dQEj Vu}ZzYm׾M~df|gKKT*U{xyDybUB7VYւ(HD,%AX qbk3֖>-HӇOBW[O $JdNK%i$.Ov\UZ6vYg_ KTk#}U|#5QaA*{(*[2_XF|CD7,Te<4PREFM"~3c#ՁAZ3gΚ>{YȰ`*onmPXd}V9/l ߽cN3=wL?F$%C%$#$v%JɟRK)#eH:D:Tj-ʤäR*v#QD_}( G:hAM?S%S~ϡjmtphiq>9.`'Պz5xC f}ck}fMlv gնaK_# t<;v[9mp,{YݭnBϏ: UQ@ D۹]?ZakAއ/7c]IQY_]q/mAA,2q cz]MPpMp`A >;ϊg 2"IhLsHbT3 HxRE\ D+0,0oXTA\XI`dpg\3 ~;s~A"{K<}2 fqv ExZN}$RgYJxl$LX0IeUT0榃MԵUBqK}=#KjVy,!K/#`9~5~~A}Bއ0[%ŗXTthjN'.O%J&|tU++ V^Ϗuo0O.ϸF ń<ʎai>h O ꧵ rs~oĆB&zd7(.O3G\F"K Y`^93fq"qdE?{#O>(n 2oDtf_}4&T1ڐB.)RtWնGnsgMh'd!a0۟>29r09MZeD ٝlUG3 +=If jMMHLJJOk&UtĒ&e6&Sz߻fR1WXAqi%d0K9T|[/:LVІo7J9 Tn l/ǔ!H-1\`sE5xyLt;sWh<̞E)5lR4x(Uܓ \T #(7p+3wi۷ٸb)|ԑa א|H\XgԎp:xHù`HTw vY3Z '`_!H&OEf O(k}S]וdX9tbFs |=|?F~dEK&s:'<,ɥ[QjI&;k_OAx x :[|cb=o4oWtR|jGF^*SMzŧ{{~KTYtZܣmi=FdrtN\Nq ꘈlX PI&O>sTc]٧% g kDr ֝8W38n2;D[hD"1 [[–|E,瑕yf :9F o*q endstream endobj 239 0 obj <> stream xڛȵ7`0[ endstream endobj 241 0 obj <> stream xڝzwTo7mAV)K0QPt̘1gED d$5%IMBw$ fӨ̌i:qΨ]{Nzk=Uug Ţ^DbxкK7W+5ظD" M7N$bL$ 3KfINj_5PHߟ 8tphlq(X\'EOynK=>vllvX/PX*ݭ{^]֮֡ `OK!D2,øcghNWOJ!֋^>J Dd>^ޡv66ll{_"o=/,; 8;440dOwۤ F~#sML?CAY}cwP*69π~k> 3)$/suX kKKLˇVdV VǬ O4L>O+k&? 8D3вV<, ͳOouw~)4+gx쯕G\Nʄ<7Ӑ MbcLi7zۊCk8C`Ei^5ϼl ϨWW_=Ó[ȃWC)^,/z{6R2]k1*0O%XfꀶhO &[*O/2FG)L6ʿS8^hhmH#.vZ*B (`k)7zEԷBVBo_0= 4MUvgobLug諨F4 jo1 j{~pGYRQ2 m6c'/W_nRC^3Z];!u^_xظ' w {nǖe?h0-T<XK3 t\=7LC3c's?9TfL(X^W#Zū2^zom 5'uHB +)? _fbh7D=h?z*K0fBpĘ|fIe(͎'#+$S6?`C.;x>II }V=L3/2+dBnfW[c4/*nGPV5psL)u̯MeQzQJz~\b=ZUpя7{ҩ{ ޡhv9hdL[? >D| ך{DZdyMdd(ݮa.bGGG"бzU;/H#&B3PR*jz/}/8l~0 <`+ Jrq(v`F։h 7/'v΋F jV  kfr0%T` '@ŃxI3 tT7GԱ!Tj(GřDTtf-tb5>XI!PӃhސ}lN>'UQ·1n s6?y}iE xFEA?A?όr݉1բ v92+JOTtLL|P *),b |ˢK՗K/\N\ba+׭N8,+ʗݡ>uy9/uo,~)oT 9C?la7s3 $l Pl,o^Xb|*\^Em ׇm/ #0 a H?VSDl3 gkݕڤK/OƔѫTƒ)?,Wv1t.'=i%*q\ "67Kki{eO[bmpQNK8Ag2O\0cg^!~r_{w1]Y<8G0z9 i,yUeޜ! L)AC O69xrJQ-6Wke1]dʶ"00dV)L.?ek(G. c@ dG*aaA :8}N=1Ϲ;` $[-(J-?!M[9Nl].D#DHQQx|`>KFax1?@nT%CFƉ a7:X=&McNrlTL\J ex$ .QzInWΐǫW8%G`$k#l#YxpgHCR'*gvk8w1 {󐂴-u-0G+SIR+Am7nVnXϥ'T>Gֲ̝%Ξ6)4s1GBhm0YN_sWd֝4@m6 V?Ҫ_wiAj@͎rRY0 /Lz:'>f<݈Pӌ^3jzp.~r @P u0QYg|cƶkaLW'+}"^dW&J ʤՕ~`svpH1ɰA9gTѩ0R1]Tla]k~3{/#ɷyElq]8,SRI*~A3Y@pl뾻&O&IS0<yMUlۦ4 _E:ﯕ5q҃<|">jUύ0"xQ}Y~Y"*1"`Ƚ^IbE:xZaFcwof7yF5a=[d-4)䘐rb['nzQg ^dB<0PD(; 3%&V(T_F\ !T&%7O^鰗UaW&ݾf]'poD I2׃߃1`o(NؕC0fPyqP)\yAnV#Pe|b^J$@cI3gcxb1Lm(42'{`&~/xapٞE<)0ҕ3OJ_;:jwt'm C(C5sUkoɍr#w=66oڇULۗsHS]?>Į I]q%%1ݞZxWs0 4SxyO\y&QMfbdUbzO"?%=IZ8$qJ(̓fsL*Q&641G*75V\9/,aT )Ǵp-n0fV2+n`Ƕ`Y I2z(p F?I7`HeCa('iԁÖ!r %/.ERai_oK9 F밻:!-Y9Q^S1SH녇u_ W e`{8q.B_jGVx-^t4R{L_`#lm{щ>q/]BH$g,\(<^m7nr9yɝlPlhxP9p) SUo g^%L]E,j9%%\+86Z'du&}D\ hRtA'XMU*BX }ѪPƈ{Č#"Љ۟AO5\H&ϰn|ba^{tۍԆs$⪅/>?&O1?C߮ z7t}mbkm]ȥ".~3壺7)FQzϯK6Ǽ^s129Ko[乔|Zt'']r(.Aw'}&yL #9] 8l0A|;bsQEX$j絗0Xz;<~^ 2U-WւgUmNe~֝30gdD9̉v.f'ͷԴf^|Ԣ|>3kR+mVy 6ja<> stream xڛ ܀`qq`9, YP6  - endstream endobj 245 0 obj <> stream xڍXy\׷OLfQ3Ռ̠hET7/@HB’@hAְ*";jQQ ֥B+U_3?/ܙ={9>O(ܗykVy' R+QђfiY[K;z;ZX ,KeeC7Qly?rҎ7ϷH?~y- U9LoP+S3KgVzɽ*0[@?e*N2B, Q+|B>Y Q.  S&q"> Qʠ@4Gǩ9NI?:wS8y06PVf#|\oѭSʽBx<`ppF8N8^8A8Q.T UBP# +'S{H߆[XlV|V,+К'=5aeg<>ϑ8{:{Ÿ7,pduT[Z,\. `X[D+E.x}A Nklo*jU^08tnr<5$ǚ<`_ȥl7r!_m~j[z4k^7L 6a⵳OD 7!)j4˥e94r@d- Ww!1Y)Pr'r Nxc)+7K%0%4|xD9{ώ4'D\}΅1O5hgr-Mb8R؊[`bɔbaEA;Af?LzYQɇ44Sy2%9` =k?߀yҎH+b!r삾4PξT~Js.VfoFNYz"B8XxFpK-Wޝe_ mAWI|dvV&@CI8 Mˈ+PQíLߓ\`W2*&+^DVU`ޝmÔgAbTS($/A N(aH`&fN .9X̼Kll^"dfrQcaepVr-WS^97n(}wTPhء]M!N@~ L%3Èx.\Y="zVΙ@uhx3=bJ~Ϡ| ?MBd/b.uwr nf+9F; (bRg10۝xt0D;r4^I&$Ro/CglD4$#V^IJögD !7Dy6l^s;ghr4ɽjsŷMIڣIeuUN ,:640s4-P bJF3Bwx-6ARc#VeT?gD#[Է(.2$G B,c; %WAoZu% J@^/~$>|uۨeo4 L&.\ꉦ".owNtJiTi6p%0b4EYV=?#kGM\c@<|\G)5~E-`WYL;;&ր)DƬ,ӡDaMdMP`nTyynN-aWŽJ)6+N+?Zxl:61H{WkMІfc^MTgSO1FDA<>\, 5iB J wFo1vb}|[%Q B2RQGSRR {b+UJd1 4iǓu0< ao KQGڄ0Nc#gm.VuV;)|dqGv6NjAɹЦJ ͈=7~2elޢ`cO?7xJB y$tV0\lXD&hqNN{ax}3-^db;w]j]%İ7c꠺x"l$DBAcYNye(? 1w%ly"~ [Ea*MHIC҂o>p{,iR4X[{8I$m2Ctnp/ۥq_z;֚lNFE%e027&_ry1Wx_S_lhmnx]%*rGqȘ?nM*P:A,vrce~4a:*\³εT\E!vd{_N;[ʄ|C *X}⭜Q޿|̔YBGRNĥS&SYl2O nlY 5+Z$/o"ʡ^72_7tؼ;cM 0o {-h%?1nrs7o-A6DOBFwkk栨t+Օ]7a i(N`2 KK:V aK'KR--$[Zg#s,݇ endstream endobj 247 0 obj <> stream xk``)ƬjS<@&B pe1 0%,?TH`.L, l endstream endobj 249 0 obj <> stream xmYw\WO "F1yVk[w{:p WBBdž’ 7b:ZGZ;l˯#{~ϹN  /V/r_YH距_^̽ 299c܋"2:(pk=g$ xO8uYrq^(t"?2+{wO7j1#C W`/1WpoWewGx5u`zoWm1$ou^`opeBB5~;|ƌ;rܘqc |ex?:;BpU*CSw)}#GDO_$( d7B>" )X #tJNBZ8P(: +t+_E篖D1&:M,#lM,8p8;c 6Vrf``W RrZ xT=Kѓul-A:Eh|,ECLF]]Ec?횆 O%VBվfx&ϭAs - lNKg?u0z 4*rp?GAl!Ic39ڭa`,nǒ./HU>3gUp2+1? 7QbVڏ==j1)EaxZG+0*w9pD#56[I sͺJ7<ysXqA)YEI~> WޗTT񃘌e]R{0X8mӰbr'x,(8Z(WhW_ɗAE$P e}K>ާpcW[/dUDz"ܼ<K+d4Tʚx,)I+p))Rs~I^^i];T#GkA0eZ:.X<PrBF' KpsEn@w t: %cZ7D]c/H6ׁeBŦ"sQU.Jd0q,ZkZIm\HmK##T~e6V8梏[6:rt$ &Xve䖬`=`w*@JU7]Zo`%u7TR8*Jhw ,]I~wg(2WktI:^9s?IwGa|qfkj! ܝ[*4WqJ ޲}pD?^/o߷TWyy54n2)OQJzVk)qMƃlӛ!-١|˯Ȋ~0?!_slMۅߥ }_*;.Z+!G rߡ>|V>y}nIoI>B<&c=.1S=nqT9&yv;TszL#7AHhcxHH@ZC'MpuLeu8u90!Lhnuzt&!,Q#_]nfڜ\yr7djp܎=[7Ք6%Yaf*[AhX(9Q2>%k1[,Xvȷ͋t;|6/; FNid"C|A,9RP#6MK -*}0cH-ʬ7LeT%b~|bJI{咸sv:> H?z+0rMjAX}lk}L=mˉ.M>v,&9?L`r="`68fb/-HabJnvJSdWEl5qJ2|,042N)H`LZP䛎$->x,y2enDD+()9L}qS:[eO%$7E].% v` ΅5g*&#cd>G)~BX[@@j«ǧ̔\>Ӹ)`0pk|v #=ҾjVU*Eiyª.":􏨺RPZTce  Km c7L"24z^Ot(;)kJzg/4z.,_̈́UJKSֱ~'y= ) Du8|V5gjO8T0 lN03{f퉼&~!zMܫ]#ņ*X> h潓E`qJvvJ6әu}{B!Ӱ]N̓C/ ;EP҂dT d>.qrn;7WJ=&TWQKdQ~vPKf*% K"E#p&r"pr `j @68/[LVSez^.fO/Qog5ʰZeVdߟc ꤷ>E%V,.QDl$_.:<Ý/ endstream endobj 251 0 obj <> stream xڛ{܀}S`@9lP2 endstream endobj 253 0 obj <> stream x]X XǶvqF̸cNl**o# x]c\((hDpwֈAQ1D)WM˽:9spcqot쪄ycbGh9㉾ ,Xf;®ba0q}ؓnݵj([ꭆFp*__gE#DE'4\8ax7Ca(}Tp}1yM!6n>rwqzgpqU;m0&Ó 1$Cdo쬱>zY!ΒYq95ׇYs6I-ן qzn7ɍ܇Xn9sI 7\Yl΍s<8O΋qޜ7[-qp@.[-qr. /5ۃ򎼑/]=ãǑ5 ; A, ap[[9N@I[߽ koe?hmly2R'/6/]Pqի /%dZ`uQ섾xOIGUջ NAx+Ĩϓnm[7[sv'B,^6*}φ=Y;s &H9kٛ{ ='MS{R+d`y4!+4:o0h3G˙8B^A.l7h[)8J>,+Gg 4; 0c?1@]@*]~xErIg _N(GRxv.82%al8W3h&yi<=S+'@6B?2 'e8MiB)?PoAeq'kx)㨄;:xE76IKNEW\*9Uq1tВ訥Zݎ%2: SL΅I5t5]D5hM5z&j%JÂ\&N l0 DGS,X$*(,9i,֩3Õ>QKRpگd!t'`POd `,x#VeJVC@-\iJ$cUio5j :1dCtOxNkiA[ Lb[x>f|C-Ҍ/8w9 sd1p)N(g̖BbΝ/*)/3 ^n ˋ^2C ۋ eK7|?/ !yOʁtq]|! ʻ!I+Hih&846`;0W=Zdl %dZZ@|(1&TCb&<w'FH9@3?ztӝSn¡zIDYBn+K Ԏ4Ӿ8]Jψ!ׅƙ,-0cԣ \XW#^!ϒjIy҆g_*H&i:޻ጛXk_bBʛPH72@uԆeFy/Uoޝ ,=7N:Y - U;mM<$_;$'tWnm_b5;]!;"6tծBԪЌeLS+ Ƹk݀5QB@Ea(+zjI3?%Nfאd8I ;1cW_$M~ޝ:ݝ#Ŋ .%x]_X;G?}URuAT%:YtP6]PW7m+fE+͍ͬ1h_׼ #C*_~sW W_ć3ua3Tt|ʍ7Cg.f/+I-$w "M<⋪L(Aʄ%@bS .O;fk+j7 a.4.>UׄϧbЮUS|z|J 7Җl#ψ\ĨKSOW#Xkeyާ2'zw ufVbzR9\ YQ&ZFTOoe=l)!/dI~~(%?F]M&/oL'ym5gY/7QL gd^> \BZ l鱈D̞+`I 4LCUӄ̇y0g 倮= *~ jIg5)Li 'w^j=9BRqcA/ˣIHԄ&M3#b0^ aE1B\tg.<ִScTGd/Y{ؾ4;w2`WVQ^9wG( 9DM]6W7c>KL6j? te;:Q?3c-ŋ9TGut zԟj:~dO9kR9# ~ ь]̎T.msi mppL:$C6Sj)йκ%28p[#n1 |.:}Ud6CL L]MEB\|os= 8R&vcIh"DUXR&c '&6=YO̘8@ȉzkњ0ld#"++ANRS=;VmO '*%;Q$ Q`Zo'S`[|2ZsR *%#x nUG7c!3 I*uXvWyL^>s=h06]TMQ5|EcC L g͑CfRs^SC(Z%>Dyn%K^>& kK/&'6"aEL 67n8%) {P<'AY'c"`>:&xMp| `Ԝ 1zWA3roˁ-&]{38w<""Q˟AV#S䏻6u?g,U,պl'ESkܪ+KUcYceګժ?4 endstream endobj 254 0 obj <> stream xkm`?hl endstream endobj 256 0 obj <> stream xMV XW$L8*LpVZ!hZ7lt*BC^ ^4vJEPjF(.Q?UBA3$TI§7I$jB}b*NdatRؤPJ! L&RE'DDUGgEa!N, +:`1+*! Ngsĥ>iL"E"V{D`}XU$PIkN^<E`O4BJߑIIq (W;¸m*K[sC%̰ޛvƕ+⌏'ap56oܚwoƞ}܁_u+SL~_r^d/:#!-Ygۜn&4z-_ +cJO7srss8h<ޱxo(aP#1Gx/J0S{[~ <\Πi-D( dh|RVQk֫H.*ӢW5'=YVB6O%sPɠI#Jp' %Pf7"?v A[QAbnw6H!H!|X2P%s2C:$(gTl^BQ$Z'e.rޏqaB8 p5~d<vXƊ! aBwpH~k ]p;Y A̜'Ej'8G]ArA*@w6mygAޗ6y!2`|)&HG0`l Gg"0X uR(sf+\c8G@ .RDQUѴ!=A@=?dLJ{_IGLX~hv 9/S!$(Bow7pi\sګn&~ŋL-;x!n{މ'Y@zi)vR!+:b`T;wZ{m;9@hmИV0Y%/kjHHʪ*nW71+?|J硄O؁ HPDB(g> stream x;L , `"\F82*@ :Jr0p0(0 e 9k endstream endobj 260 0 obj <> stream xmTkPWJ@:f%ŊVeTA" bAm! !DA$1< JQ+jNuV[蠖N¥vڙg9~<1'' q*2*4&*C%70"婊5jeB(#U*0v&]bqVYlGi?!8wz1;&mvxȟcW^spbCl98A-&U1-G) QDJ%R\h TvNND%%*Lgvz<*ʗWZI֫*\[A֪5F")/^srUpxIp:$ ѭHR02xu*W.!~8IJNR*E2Έq'Wy'OqGh9cxu0~QeAk=;4 (X=f;?ܼDNj$ z"70I Y?N X;U<å_B_oKz ٺ" M&k6~+y!D%J㑓V"lZMɉ=)L'Vcn3- y4 7ۮ2<ߜ-֛z?7"Vׁ,FEr-E.|Er&!B"D(&#[qxcu4&.sYJwn0 ]V g(1 ou Q%SSaqXK>MgkDڬ澺]CQ5\nhZ%&G}.ib7 =߁py?LıKXG :(4M-NS-5gG7{g'켄8S. 7<]GMKzvI,;z=SN'@kh `ԥL9%e#e4)3_PXZ$0ٲ`߂DU@n-5LC&0$23H(4dMq@>a46C5JefCLH};>@Еi8 jlYN:ͅm9FHY:$v+Cv= `}|kB8n+IʘX: T)z+ (xUssĈ0(iƆRw@>7׶euS a6}2fE~[|UUgnyH߹Ϻ\ew#D۪Tp~`#A$CD]~3ȓPOz*oӥT]g A)rmFlW 7V=ybd9 jހli.ȏ:V۩}dy2-=f6 F#;Y?ۼ}_ƚ%ȡ"zWVTI\ PnA + d endstream endobj 262 0 obj <> stream xk` =8Q endstream endobj 228 0 obj <> stream xڵmS9ߧлrVU<,6  !7;/<댇n';*Zݿ5θd|oBĤg8 crvtvԵt!4dD׍&u4rޛd6/:$a7 Vc( #؄;o7!BElĖNN0aGSkKlB,Fœز%2HflK6lHjeMRu6 G3r)l5aA"K.v\c@rS@O@Y AZ<`@NT2Er|$ā,Й+ FkH%!rڱ#]aX% @u@Fs\CR>Pކ"(w(2j oZFEjլ 𘏹 U^sT#"!36lǩl** B^ B^v;:6F:."aU >5%ԫO#2@U;RDa7rqxΪD*O螩©ĶbAljTJpH>tZA4*$W*I^C0!TiVKäƖ5Q (skk*Vf(N>/pt{yݽ=tie18o{d3Nhz`xo펚vn6gѨ.Ƌmlv{;ohNA=oQH\|l& WQ/t(^T@$TN]koR2 tbUR/vWp2ͼ~e7,6AIM8klVF=O[M^L/GS @ Mlޡ/3 3d3/?:{qgΗ`&=b1τ2!ψ<3D?6\&Aî47ˌ|8 4 %"\ (:+(Xt+͠.omWgsKܐ[>cFFܲh+03z0aބSB?!od8?/C(oeޠ (; }D9+B mYۭR"딤<6ef185567c0b1f58d27f0c5748a3396d>]/Root 1 0 R/Info 2 0 R/Size 264/W[1 3 2]/Filter/FlateDecode/Length 588>> stream x-GPQn`aaAT0b,&0fTDD",fj)oW9xңW=3ZDCY%d?tb0[Q)*YS^@oQ@Sćt ֜1?t8̳>*&s0=0B%T tO pH6j:+lc숝3aݰ;x쩒Lo7?&b88 $6sG;Ds20Gq1辫8xp"ǚΓN8 b: pJf6w` ܀17\܄13p V,y89< q;^x`.ijx .X.xkp fZ\qVne>\ģaVq\'$Әp5^x 6x?#|uS|o_G|mƼ&ۂ4 ۢ$/5R0C*)&{6lDTrM*LO{zs;do&[_>ַX[/ endstream endobj startxref 67627 %%EOF expint/inst/NEWS.Rd0000644000176200001440000000733415133325322013607 0ustar liggesusers\name{NEWS} \title{\pkg{expint} News} \encoding{UTF-8} \section{CHANGES IN \pkg{expint} VERSION 0.2-0}{ \subsection{BUG FIXES}{ \itemize{ \item{\code{gammainc} now handles values of \code{a} in \eqn{(-0.5, 0)} correctly by using the standard recursion, relying on the accuracy of \code{pgamma} for small values of \code{a}; fixes \href{https://gitlab.com/vigou3/expint/-/issues/2}{issue #2}}. } } } \section{CHANGES IN \pkg{expint} VERSION 0.1-9}{ \subsection{BUG FIXES}{ \itemize{ \item{Replacement of a few API entry points for C API compliance introduced in R 4.5.0.} } } } \section{CHANGES IN \pkg{expint} VERSION 0.1-8}{ \subsection{NEW FEATURE}{ \itemize{ \item{Unit tests for the incomplete gamma function based on the definition, and for the exponential integrals based on a table of Abramowitz and Stegun.} } } \subsection{BUG FIXES}{ \itemize{ \item{Include prototypes for all C level functions to please \code{-Wstrict-prototypes}.} } } } \section{CHANGES IN \pkg{expint} VERSION 0.1-7}{ \subsection{BUG FIXES}{ \itemize{ \item{Replace deprecated (as of R 4.2.0) macro \code{DOUBLE_EPS} by \code{DBL_EPSILON} in C code.} \item{Remove the unnecessary \code{LazyData} entry in the \code{DESCRIPTION} file.} } } } \section{CHANGES IN \pkg{expint} VERSION 0.1-6}{ \itemize{ \item{Fixed the example API and the documentation in the vignette. The previous implementation yielded duplicated symbols 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.} } } \section{CHANGES IN \pkg{expint} VERSION 0.1-5}{ \itemize{ \item{Minor documentation and comments updates.} } } \section{CHANGES IN \pkg{expint} VERSION 0.1-4}{ \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{Vignette no longer uses LaTeX package framed as it was not found on OS X in CRAN builds.} } } } \section{CHANGES IN \pkg{expint} VERSION 0.1-3}{ \subsection{BUG FIX}{ \itemize{ \item{Fixed wrong values for expint_E1(x, scale = TRUE) for x in (-4, -1] or x in (0, 1]. Thanks to Vincent Dorie \email{vjd4@nyu.edu} for the catch and report.} } } } \section{CHANGES IN \pkg{expint} VERSION 0.1-2}{ \itemize{ \item{Yet more authors (actually copyright holders) added to the list of authors.} } } \section{CHANGES IN \pkg{expint} VERSION 0.1-1}{ \subsection{BUG FIX}{ \itemize{ \item{Fixed improper use of macro \code{ISNAN} (and \code{ISNA}) that caused compilation to fail on Linux and Solaris.} } } \subsection{OTHER CHANGES}{ \itemize{ \item{Original author of GSL code for \code{expint} and \code{gamma_inc} (G. Jungman) added as an author of the package.} \item{Improved (read: more explicit) copyright notices to GSL, R Core Team and R Foundation where appropriate.} } } } \section{CHANGES IN \pkg{expint} VERSION 0.1-0}{ \itemize{ \item{Initial release. The package provides the \R functions to compute the exponential integrals \eqn{E_1(x)}, \eqn{E_2(x)}, \eqn{E_n(x)} and \eqn{Ei(x)}, and the incomplete gamma function \eqn{G(a, x)}. The package also provides a C API to access the actual workhorses \code{expint_E1}, \code{expint_E2}, \code{expint_En} and \code{gamma_inc}. Sub-directory \file{example_API} of the package installation directory contains a complete test package implementing API usage.} } } expint/build/0000755000176200001440000000000015133327562012667 5ustar liggesusersexpint/build/vignette.rds0000644000176200001440000000031215133327562015222 0ustar liggesusersb```b`aeb`b2 1# 'J(+ +G()&&[&3a8DXԱ%ifwI-HK î?}ީE0=(jؠjX2sRad9.nP&c0Gq?gQ~nݣ9JI,IK+5texpint/build/partial.rdb0000644000176200001440000000765115133327553015025 0ustar liggesusersVFV ;!4Iw a `L(IIBd iبȒ+a}}}=caO#>0]Ι Ͻsh~HЗ^^"B/W[g.8O$p T^ITЗa>/)mB0;}Kσ=-S6qPVY0Tp~ t-r~ rX E+ r;gubsm|5`_?#˚dy#gi{^=Y929* [5;_3Նd|C2eCSi_? ?(Zy@QV?JuTvdWkm@ʗvꪦ/+yWXReWΖ+W>?3֥i@=^Yѕ80)`^҂_/d}3GvvW-\5+j(idȦ۪1ZJ8A'!L?RINT ys^}P S+٤_xZBdG4OL>E"f[OLeĉ9 C=zD2 0珶jkxvj05wB>wFmKk륷!x >_ël"M(dxP3t۪  _dZӰ+Z˺.۪Puf4{l\ob G=BҜ@!YU丣 Rfb{%d{Mw1Œ`aOMo&YKޚ_X=PNj&'>|ᘏ9w{Y%_eW4s*礙,4S뀯wE3_|Ěur6l+|4bn;ɞMCU _Ս,^LFD'-Q, >q8CQ"L]~D~"gPX6%8Zcq)a{6"-|`y. F-yL&]6H--ou5_"2;:bƁ9cap0،M,Sxa&&ko+kĞ5]od(T|}Ip7}TB(|` G{Dj( i 褒{Fw[%8@[L7ug-1b1ILNon _{jLrkԖD[iQC'ee3sAV+;=Cniv tbn`Z`ŲZl]ClgN;@6@' aѪXhveZ%y k2 .׻y Z-SmVcڡr:v N;wHA-cbǻJrRxm> 'eCMg\8D H:F$6Gu^bz\4먟i+*km4$Q $螣$ s޼3Tbr#V\#5ŰYB,C0 x-G"<g pZQ6Yu4A`Tv? R]HGۆ,qDhh"aY4q]c %mPDj~Y;6*H7LPXБ|u@T\7Nepͫ^N\s"Mp ZԶu-q 'r6uNɅVkyL6ܛ;eRd n^}T2L >inʧ_Vvv8Q>sl2KWɪ$B=s+3 ёKE8s\yQG1';nޖ:3N>g efMrCNwHY`[U3UҪ4Ԯ9;0v2Y20J!oBsziStc/DJ`|7Oaѽ8ӝ)R f*&FR\pӉr|soVKKB3mih5ur`lT;|6tEur4$,T~22J[륍woߤ#5C<:fi"p%g̘Bp1x'*μNb\Q gu 2}). The following relation holds: \deqn{ E_n(x) = x^{n - 1} \Gamma(1 - n, x),}{% E_n(x) = x^(n-1) G(1-n, x),} where \eqn{\Gamma(a, x)}{G(a, x)} is the incomplete gamma function implemented in \code{\link{gammainc}}. By definition, \eqn{E_0(x) = x^{-1} e^{-x}}{E_0(x) = exp(-x)/x}, \eqn{x \ne 0}{x != 0}. Function \code{expint} is vectorized in both \code{x} and \code{order}, whereas function \code{expint_En} expects a single value for \code{order} and will only use the first value if \code{order} is a vector. Non-integer values of \code{order} will be silently coerced to integers using truncation towards zero. } \value{ The value of the exponential integral. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ The C implementation is based on code from the GNU Software Library \url{https://www.gnu.org/software/gsl/}. } \references{ Abramowitz, M. and Stegun, I. A. (1972), \emph{Handbook of Mathematical Functions}, Dover. } \seealso{ \code{\link{gammainc}} } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ ## See section 5.3 of Abramowitz and Stegun expint(1.275, order = 1:10) expint(10, order = 1:10) * 1e5 expint(c(1.275, 10), order = c(1, 2)) expint_E1(1.275) # same as above expint_E2(10) # same as above ## Figure 5.1 of Abramowitz and Stegun curve(expint_Ei, xlim = c(0, 1.6), ylim = c(-3.9, 3.9), ylab = "y") abline(h = 0) curve(expint_E1, add = TRUE) x <- 1.5 text(x, c(expint_Ei(x), expint_E1(x)), expression(Ei(x), E[1](x)), adj = c(0.5, -0.5)) ## Figure 5.2 of Abramowitz and Stegun plot(NA, xlim = c(-1.6, 1.6), ylim = c(0, 1), xlab = "x", ylab = expression(E[n](x))) n <- c(10, 5, 3, 2, 1, 0) for (order in n) curve(expint_En(x, order), add = TRUE) x <- c(0.1, 0.15, 0.25, 0.35, 0.5, 0.7) text(x, expint(x, n), paste("n =", n), adj = c(-0.2, -0.5)) } \keyword{math} expint/man/gammainc.Rd0000644000176200001440000000352114220225222014371 0ustar liggesusers\name{gammainc} \alias{gammainc} \alias{gamma_inc} \alias{IncompleteGammaFunction} \title{Incomplete Gamma Function} \description{ The incomplete gamma function \eqn{\Gamma(a, x)}{G(a, x)}. } \usage{ gammainc(a, x) } \arguments{ \item{a}{vector of real numbers.} \item{x}{vector of non-negative real numbers.} } \details{ As defined in 6.5.3 of Abramowitz and Stegun (1972), the incomplete gamma function is \deqn{ \Gamma(a, x) = \int_x^\infty t^{a-1} e^{-t}\, dt}{% G(a, x) = int_x^Inf t^(a - 1) exp(-t) dt} for \eqn{a} real and \eqn{x \ge 0}. For non-negative values of \eqn{a}, we have \deqn{ \Gamma(a, x) = \Gamma(a) (1 - P(a, x)),}{% G(a, x) = Gamma(a) (1 - P(a, x)),} where \eqn{\Gamma(a)}{Gamma(a)} is the function implemented by \R's \code{\link{gamma}()} and \eqn{P(a, x)}{P(a, x)} is the cumulative distribution function of the gamma distribution (with scale equal to one) implemented by \R's \code{\link{pgamma}()}. Also, \eqn{\Gamma(0, x) = E_1(x)}{G(0, x) = E_1(x)}, \eqn{x > 0}, where \eqn{E_1(x)} is the exponential integral implemented in \code{\link{expint}}. } \value{ The value of the incomplete gamma function. Invalid arguments will result in return value \code{NaN}, with a warning. } \note{ The C implementation is based on code from the GNU Software Library \url{https://www.gnu.org/software/gsl/}. } \references{ Abramowitz, M. and Stegun, I. A. (1972), \emph{Handbook of Mathematical Functions}, Dover. } \seealso{ \code{\link{expint}} } \author{ Vincent Goulet \email{vincent.goulet@act.ulaval.ca} } \examples{ ## a > 0 x <- c(0.2, 2.5, 5, 8, 10) a <- 1.2 gammainc(a, x) gamma(a) * pgamma(x, a, 1, lower = FALSE) # same ## a = 0 a <- 0 gammainc(a, x) expint(x) # same ## a < 0 a <- c(-0.25, -1.2, -2) sapply(a, gammainc, x = x) } \keyword{math} expint/DESCRIPTION0000644000176200001440000000424515133352067013301 0ustar liggesusersPackage: expint Type: Package Title: Exponential Integral and Incomplete Gamma Function Version: 0.2-0 Date: 2026-01-19 Authors@R: c(person("Vincent", "Goulet", role = c("cre", "aut"), email = "vincent.goulet@act.ulaval.ca"), person("Gerard", "Jungman", role = "aut", email = "jungman@lanl.gov", comment = "Original GSL code"), person("Brian", "Gough", role = "aut", email = "jungman@lanl.gov", comment = "Original GSL code"), 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(given = "R Core Team", role = "aut", comment = "Parts of the R to C interface"), person(given = "R Foundation", role = "aut", comment = "Parts of the R to C interface")) Description: The exponential integrals E_1(x), E_2(x), E_n(x) and Ei(x), and the incomplete gamma function G(a, x) defined for negative values of its first argument. The package also gives easy access to the underlying C routines through an API; see the package vignette for details. A test package included in sub-directory example_API provides an implementation. C routines derived from the GNU Scientific Library . Depends: R (>= 3.3.0) License: GPL (>= 2) URL: https://gitlab.com/vigou3/expint BugReports: https://gitlab.com/vigou3/expint/-/issues Encoding: UTF-8 NeedsCompilation: yes Packaged: 2026-01-19 04:13:39 UTC; vincent Author: Vincent Goulet [cre, aut], Gerard Jungman [aut] (Original GSL code), Brian Gough [aut] (Original GSL code), 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: 2026-01-19 06:50:31 UTC