hypergeo/0000755000176200001440000000000012564214747012110 5ustar liggesusershypergeo/inst/0000755000176200001440000000000012564167700013061 5ustar liggesusershypergeo/inst/CITATION0000644000176200001440000000140012564167332014212 0ustar liggesuserscitHeader("To cite in publications use:") citEntry(entry = "Article", title = { paste("A new family of non-negative distributions.") }, author = personList( person(first = "R.", middle = "K. S.", last = "Hankin", email="r.hankin@noc.soton.ac.uk"), person(first = "A.", last = "Lee", email = "lee@stat.auckland.ac.nz") ), journal = "Australia and New Zealand Journal of Statistics", year = "2006", volume = "48", issue = "1", pages = "67-78", textVersion = { paste("R. K. S. Hankin and A. Lee", "2006.", "A new family of non-negative distributions", "Australia and New Zealand Journal of Statistics", "48(1):67-78" ) }) hypergeo/inst/doc/0000755000176200001440000000000012564167700013626 5ustar liggesusershypergeo/inst/doc/hypergeometric.R0000644000176200001440000000312112564167700016774 0ustar liggesusers### R code from vignette source 'hypergeometric.Rnw' ################################################### ### code chunk number 1: set_calculate_from_scratch ################################################### calculate_from_scratch <- FALSE ################################################### ### code chunk number 2: loadpackages ################################################### require("hypergeo") require("elliptic") ################################################### ### code chunk number 3: R_expectation ################################################### expected <- function(a,b,p){ Re( choose(a+b,b) * p^a * (1-p)^b * ( p *b/(1+a) * hypergeo(a+b+1,2,a+2, p) + (1-p)*a/(1+b) * hypergeo(a+b+1,2,b+2,1-p) )) } ################################################### ### code chunk number 4: useit ################################################### c(expected(8,2,0.8),expected(9,1,0.8)) ################################################### ### code chunk number 5: hypergeo_figure_file ################################################### png("hypergeometric_plot.png",width=800,height=800) ################################################### ### code chunk number 6: wp_figure_plot ################################################### x <- seq(from=0,to=2,len=200) y <- seq(from=-1,to=1,len=200) z <- outer(x,1i*y,"+") hz <- hypergeo(2,1/2,2/3,z) par(pty='s') view(x,y,hz,levels=seq(from=-4,to=4),xlab='Real',ylab='Imag') ################################################### ### code chunk number 7: wp_figure_close ################################################### null <- dev.off() hypergeo/inst/doc/hypergeometric.Rnw0000644000176200001440000004321312564167700017347 0ustar liggesusers % -*- mode: noweb; noweb-default-code-mode: R-mode; -*- \documentclass[nojss]{jss} \usepackage{dsfont} \usepackage{bbm} \usepackage{amsmath} \usepackage{amssymb} \usepackage{algpseudocode} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% declarations for jss.cls %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \DeclareMathOperator*{\ketten}{K} \newcommand{\Fmn}[2]{\ensuremath{\operatorname{{}_{#1}F_{#2}}}} \newcommand{\ft}{\ensuremath{\Fmn{2}{1}}} \newcommand{\fall}[2]{\left(#1\right)_{#2}} \newcommand{\rise}[2]{\left(#1\right)^{#2}} \newcommand{\ams}[1]{$\left(#1\right)$} %% just as usual \author{Robin K. S. Hankin\\Auckland University of Technology} \title{Numerical evaluation of the Gauss hypergeometric function with the \pkg{hypergeo} package} %\VignetteIndexEntry{The hyperdirichlet distribution in practice} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Robin K. S. Hankin} \Plaintitle{The hypergeo package} \Keywords{Hypergeometric functions, numerical evaluation, complex plane, \proglang{R}, residue theorem} \Plainkeywords{Hypergeometric functions, numerical evaluation, complex plane, R, residue theorem} \Abstract{This paper introduces the \pkg{hypergeo} package of R routines, for numerical calculation of hypergeometric functions. The package is focussed on efficient and accurate evaluation of the hypergeometric function over the whole of the complex plane within the constraints of fixed-precision arithmetic. The hypergeometric series is convergent only within the unit circle, so analytic continuation must be used to define the function outside the unit circle. This short document outlines the numerical and conceptual methods used in the package; and justifies the package philosophy, which is to maintain transparent and verifiable links between the software and AMS-55. The package is demonstrated in the context of game theory. } %% publication information %% NOTE: This needs to filled out ONLY IF THE PAPER WAS ACCEPTED. %% If it was not (yet) accepted, leave them commented. %% \Volume{13} %% \Issue{9} %% \Month{September} %% \Year{2004} %% \Submitdate{2004-09-29} %% \Acceptdate{2004-09-29} %% The address of (at least) one author should be given %% in the following format: \Address{ Robin K. S. Hankin\\ Auckland University of Technology\\ New Zealand\\ E-mail: \email{hankin.robin@gmail.com}\\ } %% need no \usepackage{Sweave.sty} \SweaveOpts{} \begin{document} <>= calculate_from_scratch <- FALSE @ \section{Introduction} The {\em geometric} series~$\sum_{k=0}^\infty t_k$ with~$t_k=z^k$ may be characterized by its first term and the constant ratio of successive terms~$t_{k+1}/t_k=z$, giving the familiar identity~$\sum_{k=0}^\infty z^k=\left(1-z\right)^{-1}$. Observe that while the series has unit radius of convergence, the right hand side is defined over the whole complex plane except for~$z=1$ where it has a pole. Series of this type may be generalized to a {\em hypergeometric} series in which the ratio of successive terms is a rational function of~$k$: \[ \frac{t_{k+1}}{t_k}=\frac{P(k)}{Q(k)} \] where~$P(k)$ and~$Q(k)$ are polynomials. If both numerator and denominator have been completely factored we would write \[ \frac{t_{k+1}}{t_k} = \frac{(k+a_1)(k+a_2)\cdots(k+a_p)}{(k+b_1)(k+b_2)\cdots(k+b_q)(k+1)}z \] \noindent (the final term in the denominator is due to historical reasons), and if we require~$t_0=1$ then we write \begin{equation}\label{genhypergeo_definition} \sum_{k=0}^\infty t_kz^k= \Fmn{a}{b}\left[{ a_1, a_2, \ldots,a_p\atop b_1, b_2, \ldots,b_q} ; z\right] \end{equation} when defined. An absent factor is indicated with a dash; thus $\Fmn{0}{0}\left[\begin{array}{l}-\\-\end{array};z\right]=e^z$. In most cases of interest one finds that~$p=2$, $q=1$ suffices. Writing~$a,b,c$ for the two upper and one lower argument respectively, the resulting function~$\ft\left(a,b;c;z\right)$ is known as {\em the} hypergeometric function. Many functions of elementary analysis are of this form; examples would include logarithmic and trigonometric functions, Bessel functions, etc. For example, $\ft\left(\frac{1}{2},1;\frac{3}{2};-z^2\right)=z^{-1}\operatorname{\arctan} z$. \citet{michel2008} state that physical applications are ``plethora''. In addition, naturally-occuring combinatorial series frequently have a sum expressible in terms of hypergeometric functions and an example from the author's work in the field game theory is given below. \subsection{Equivalent forms} The hypergeometric function's series representation, namely \begin{equation}\label{series}\tag{15.1.1} \ft\left(a,b;c;z\right)=\sum_{k=0}^\infty\frac{\fall{a}{k}\fall{b}{k}}{\fall{c}{k}k!}z^k,\qquad \fall{a}{k}=\Gamma(a+k)/\Gamma(a) \end{equation} \noindent has unit radius of convergence by the ratio test but the integral form \begin{equation}\label{integral}\tag{15.3.1} \ft\left(a,b;c;z\right)= \frac{\Gamma(c)}{\Gamma(b)\Gamma(c-b)}\int_{t=0}^1 t^{b-1}(1-t)^{c-b-1}(1-tz)^{-a}\,dt, \end{equation} \noindent due to Gauss, furnishes analytic continuation; it is usual to follow Riemann and define a cut along the positive real axis from~$1$ to~$\infty$ and specify continuity from below [NB: equations with three-part numbers, as \ref{series} and \ref{integral} above, are named for their reference in~\citet{abramowitz1965}]. This is implemented as \code{f15.3.1()} in the package and exhibits surprisingly accurate evaluation. Gauss also provided a continued fraction form for the hypergeometric function [implemented as~\code{hypergeo_contfrac()} in the package] which has superior convergence rates for parts of the complex plane at the expense of more complicated convergence properties~\citep{cuyt2008}. \section{The hypergeo package} The \pkg{hypergeo} package provides some functionality for the hypergeometric function; the emphasis is on fast vectorized \proglang{R}-centric code, complex~$z$ and moderate real values for the auxiliary parameters~$a,b,c$. The package is released under GPL-2. Observing the slow convergence of the series representation~\ref{series}, the complex behaviour of the continued fraction representation, and the heavy computational expense of the integral representation~\ref{integral}, it is clear that non-trivial numerical techniques are required for a production package. The package implements a generalization of the method of~\citet{forrey1997} to the complex case. It utilizes the observation that the ratio of successive terms approaches~$z$, and thus the strategy adopted is to seek a transformation which reduces the modulus of~$z$ to a minimum. \citeauthor{abramowitz1965} give the following transformations: \newcommand{\four}[4]{\frac{\Gamma\left(#1\right)\Gamma\left(#2\right)}{\Gamma\left(#3\right)\Gamma\left(#4\right)}} \begin{align} \ft\left(a,b;c;z\right) &= \left(1-z\right)^{-a}\ft\left(a,c-b;c;\frac{z}{z-1}\right)\tag{15.3.4}\label{15.3.4}\\ &= \left(1-z\right)^{-b}\ft\left(a,c-a;c;\frac{z}{z-1}\right)\tag{15.3.5}\label{15.3.5}\\ &= \four{c}{c-a-b}{c-a}{c-b}\ft\left(a,b;a+b-c+1;1-z\right)\nonumber\\ &{}\qquad+ (1-z)^{c-a-b}\four{c}{a+b-c}{a}{b}\ft\left(c-a,c-b;c-a-b+1;1-z\right)\label{15.3.6}\tag{15.3.6}\\ &= \four{c}{b-a}{b}{c-a}\left(-z\right)^{-a}\ft\left(a,1-c+a;1-b+a;\frac{1}{z}\right)\nonumber\\ &{}\qquad+\four{c}{a-b}{a}{c-b}\left(-z\right)^{-b}\ft\left(b,1-c+b;1-a+b;\frac{1}{z}\right)\label{15.3.7}\tag{15.3.7}\\ &= (1-z)^{-a}\four{c}{b-a}{b}{c-a}\ft\left(a,c-b;a-b+1;\frac{1}{1-z}\right)\nonumber\\ &{}\qquad+(1-z)^{-b}\four{c}{a-b}{a}{c-b}\ft\left(b,c-a;b-a+1;\frac{1}{1-z}\right)\label{15.3.8}\tag{15.3.8}\\ &=\four{c}{c-a-b}{c-a}{c-b}z^{-a}\ft\left(a,a-c+1;a+b-c+1;1-\frac{1}{z}\right)\nonumber\\ &{}\qquad+\four{c}{a+b-c}{a}{b}(1-z)^{c-a-b}z^{a-c}\ft\left(c-a,1-a;c-a-b+1;1-\frac{1}{z}\right)\label{15.3.9}\tag{15.3.9}. \end{align} Observing that the set~$\left\{z,\frac{z}{z-1},1-z,\frac{1}{z},\frac{1}{1-z},1-\frac{1}{z}\right\}$ forms a group under functional composition\footnote{It is the anharmonic subgroup of the M\"{o}bius transformations, generated by~$z\longrightarrow 1/z$ and~$z\longrightarrow 1-z$. It is isomorphic to~$S_3$, the symmetric group on~3 elements.} we may apply each of the transformations to the primary argument~$z$ and choose the one of smallest absolute value to evaluate. Given the appropriate transformation, the right hand side is evaluated using direct summation. If~$\left|z\right|<1$, the series is convergent by the ratio test, but may require a large number of terms to achieve acceptable numerical precision. Summation is dispatched to \code{genhypergeo_series()} which evaluates the generalized hypergeometric function~\ref{genhypergeo_definition}; the \proglang{R} implementation uses multiplication by repeatedly incremented upper and lower indices~$a_i,b_i$. %\begin{algorithmic}\label{alt} % \State $\mathit{fac}\gets 1$ % \State $\mathit{temp}\gets\mathit{fac}$ % \State $\mathit{series}\gets\mathit{ZXCVXCVDFADF}$ % \While {$\mathit{series}\neq\mathit{temp}$} % \State $\mathit{fac}\gets % \mathit{fac}\times\frac{a_1\times\cdots\times a_p}{b_1\times\cdots\times b_q}\times z$ % \State $a_1\gets a_1+1,\ldots, b_q\gets b_q+1$ % \State $temp\gets \mathit{series}$ % \State $\mathit{series}\gets \mathit{series}+\mathit{fac}$ % \EndWhile %\end{algorithmic} %(lower indices~$b_i$ are appended with a ``$+1$''). Thus for example if $(1-z)^{-1}$ is small in absolute value we would use function \code{f13.3.8()}: \begin{Schunk} \begin{Sinput} > require("hypergeo") > f15.3.8 \end{Sinput} \begin{Soutput} function(A,B,C,z,tol=0,maxiter=2000){ jj <- i15.3.8(A,B,C) jj[1]*(1-z)^(-A)*genhypergeo(U=c(A,C-B),L=A-B+1,z=1/(1-z),tol=tol,maxiter=maxiter) + jj[2]*(1-z)^(-B)*genhypergeo(U=c(B,C-A),L=B-A+1,z=1/(1-z),tol=tol,maxiter=maxiter) } \end{Soutput} \end{Schunk} \noindent (slightly edited in the interests of visual clarity). This is a typical internal function of the package and like all similar functions is named for its equation number in~\cite{abramowitz1965}. Note the helper function \code{i15.3.9()}, which calculates the Gamma coefficients of the two hypergeometric terms in the identity. This structure allows transparent checking of the code. \subsection{Special cases} The methods detailed above are not applicable for all values of the parameters~$a,b,c$. If, for example, $c=a+b\pm m$, $m\in\mathbb{N}$ (a not uncommon case), then equation~\ref{15.3.6} is not useful because each term has a pole; and it is numerically difficult to approach the limit. In this case the package dispatches to \code{hypergeo_cover1()} which uses~\ref{15.3.4} through~\ref{15.3.9} but with~\ref{15.3.6} replaced with suitable limiting forms such as \begin{equation}\tag{15.3.11}\label{15.3.11} \ft\left(a,b;a+b+m;z\right)=\frac{\Gamma(a+b)}{\Gamma(a)\Gamma(b)} \sum_{n=0}^\infty\frac{(a)_n(b)_n}{(n!)^2}\left[ 2\psi(n+1)-\psi(a+n)-\psi(b+n)-\log(1-z)\right](1-z)^n,\qquad\pi<\left|\operatorname{\arg}(1-z)\right|<\pi,\left|1-z\right|<1 \end{equation} (\citeauthor{abramowitz1965} give a similar expression for negative~$m$). This equation is comparable to~\ref{15.3.6} in terms of computational complexity but requires evaluation of the digamma function~$\psi$. Equation~\ref{15.3.11} is evaluated in the package using an algorithm similar to that for \code{genhypergeo_series()} but includes a runtime option which specifies whether to evaluate~$\psi\left(\cdot\right)$ \emph{ab initio} each time it is needed, or to use the recurrence relation~$\psi\left(z+1\right)=\psi\left(z\right)+1/z$ at each iteration after the first. These two options appear to be comparable in terms of both numerical accuracy and speed of execution, but further work would be needed to specify which is preferable in this context. A similar methodology is used for the case~$b=a\pm m$, $m=0,1,2,\ldots$ in which case the package dispatches to \code{hypergeo_cover2()}. However, the case~$c-a=0,1,2,\ldots$ is not covered by~\cite{abramowitz1965} and the package dispatches to~\code{hypergeo_cover3()} which uses formulae taken from the Wolfram functions site~\citep{wolfram2014}. For example \code{w07.23.06.0026.01()} gives a straightforwardly implementable numerical expression for~$\Fmn{2}{1}$ as a sum of two {\em finite} series and a generalized hypergeometric function~$\Fmn{3}{2}$ with primary argument~$z^{-1}$. In all these cases, the limiting behaviour is problematic. For example, if~$a+b-c$ is close to, but not exactly equal to, an integer then equation~\ref{15.3.11} is not applicable. The analytic value of the hypergeometric function in these circumstances is typically of moderate modulus, but both terms of equation~\ref{15.3.6} have large amplitude and numerics are susceptible to cancellation errors. \subsection{Critical points} All the above methods fail when~$z=\frac{1}{2}\pm\frac{i\sqrt{3}}{2}$, because none of the transformations~\ref{15.3.6}-\ref{15.3.9} change the modulus of~$z$ from 1. The function is convergent at these points but numerical evaluation is difficult. This issue does not arise in the real case considered by~\citet{forrey1997}. These points were considered by \cite{buhring1987} who presented a computational method for these values; however, his method is not suitable for finite-precision arithmetic (a brief discussion is presented at \code{?buhring}) and the package employs either an iterative scheme due to Gosper~\citep{mpmath}, or the residue theorem if~$z$ is close to either of these points. \section{Package testing suite} The package comes with an extensive test suite in the \code{tests/} directory. The tests fall into two main categories, firstly comparison with either \proglang{Maple} or \proglang{Mathematica} output (although~\cite{becken2000} caution that \proglang{Mathematica} routines cannot be used as reference values); and secondly, verification of identities which appear in AMS-55 as named equations. \section{The package in use} The \pkg{hypergeo} package offers direct numerical functionality to the \proglang{R} user on the command line. One example from the author's current work is in game theory. Consider a game in which a player is given~$n$ counters each of which she must allocate into one of two boxes, $A$ or $B$. At times $t = 1,2,3\ldots$ a box is identified at random and, if it is not empty, a counter removed from it; box~$A$ is chosen with probability~$p$ and box~$B$ with probability~$1-p$. The object of the game is to remove all counters as quickly as possible. If the player places~$a$ counters in box~$A$ and~$b$ in~$B$, then the probability mass function of removing the final counter at time~$t=a+b+r$ is <>= require("hypergeo") require("elliptic") @ \begin{equation} p^a(1-p)^b\left[ {a+b+r-1 \choose a-1, b+r}(1-p)^r+ {a+b+r-1 \choose a+r, b-1}p^r \right],\qquad r=0,1,2,\ldots. \end{equation} The two terms correspond to the final counter being removed from box~$A$ or~$B$ respectively. This PMF has expectation \begin{align} p^a(1-p)^b\left[ p {a+b\choose a+1,b-1}\,\ft\left(a+b+1,2;a+2;p\right)+\right.\nonumber\\ \left. (1-p){a+b\choose a-1,b+1}\,\ft\left(a+b+1,2;b+2;1-p\right) \right]\label{expectation} \end{align} with \proglang{R} idiom: <>= expected <- function(a,b,p){ Re( choose(a+b,b) * p^a * (1-p)^b * ( p *b/(1+a) * hypergeo(a+b+1,2,a+2, p) + (1-p)*a/(1+b) * hypergeo(a+b+1,2,b+2,1-p) )) } @ Thus if~$p=0.8$ and given~$n=10$ counters we might wonder whether it is preferable to allocate them~$(8,2)$ or~$(9,1)$: <>= c(expected(8,2,0.8),expected(9,1,0.8)) @ showing that the latter allocation is preferable in expectation. The package is designed for use with \proglang{R} and Figure~\ref{complexhypergeometricplot} shows the package being used to visualize~$\ft\left(2,\frac{1}{2};\frac{2}{3};z\right)$ over a region of the complex plane. %% Thanks to Dario Strbenac for the following structure <>= png("hypergeometric_plot.png",width=800,height=800) @ <>= x <- seq(from=0,to=2,len=200) y <- seq(from=-1,to=1,len=200) z <- outer(x,1i*y,"+") hz <- hypergeo(2,1/2,2/3,z) par(pty='s') view(x,y,hz,levels=seq(from=-4,to=4),xlab='Real',ylab='Imag') @ <>= null <- dev.off() @ \begin{figure}[htbp] \begin{center} \includegraphics{hypergeometric_plot.png} \caption{View of the\label{complexhypergeometricplot} function~$\ft\left(2,\frac{1}{2};\frac{2}{3};z\right)$ evaluated over a part of the complex plane using the \pkg{hypergeo} package. Function visualization following \cite{thaller1998} and the \pkg{elliptic} package~\citep{hankin2006}; hue corresponds to argument and saturation to modulus. Solid contour lines correspond to real function values and dotted to imaginary function values. Note the cut line along the real axis starting at~$\left(1,0\right)$, made visible by an abrupt change in hue} \end{center} \end{figure} \subsection{Conclusions and further work} Evaluation of the hypergeometric function is hard, as evidenced by the extensive literature concerning its numerical evaluation~\citep{becken2000,michel2008,forrey1997,buhring1987}. The \pkg{hypergeo} package is presented as a partial implementation, providing reasonably accurate evaluation over a large portion of the complex plane and covering moderate real values of the auxiliary parameters~$a,b,c$. Difficulties arise when~$b-a$ or~$c-b-a$ become close to, but not exactly, integers because the terms in equations~\ref{15.3.6} through~\ref{15.3.9} become large and cancellation errors become important. Further work might include extension to complex auxiliary parameters but \citeauthor{michel2008} caution that this is not straightforward. \bibliography{hypergeometric} \end{document} hypergeo/inst/doc/hypergeometric.pdf0000644000176200001440000047261312564167702017366 0ustar liggesusers%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4359 /Filter /FlateDecode /N 76 /First 626 >> stream x\ms8~Bߎ[,޺ں@H \aI|Kvaa=-ٞ=8!,5LƒVQ[j!YiL EfR*a s6e)RfB0a$ʒDY&AA3)S&,S%L8lR)ډ-^bǤ`&̌4 8Ư/YKe0;pFc1S|*nĂ,I4`=$JU&T*&F/iit1I2F602!^v$,4ނD3 $<C^*Q4,-i@YIސ% c YʡGI^="k^YP ݲ iAY8% $x e(_EpeaG7xB4eB9R]$([i?oY1!1;au1g :ξ^e?WOb纸/أ|Ǝ"vS> .ag{"c~d pk%?sDeo9AĞe_/K/.4+_FDz3]O3T ',<\fj}aW,2_gl 6֎(oώ_ge-򫂥e=Y^L@`?U"z2(GGM 7?PBJA5Y͊%>g Z10-$%"^y-׋_g"}g04+@탟KZ$ŒI: ƃ{ٲ߽, q,Ʉz&:Ų8J*vCOKJ9^Z5;ټ QOU!?:4C#:h uTtJk:s3ctVN:@c:0 Uk+e䇯+OFq> +"=.h^LB~ a fxUᛥECh|\\Ro(!a׿'ͦkG-qHE(9zY_GFK>0C` fI幡rä_QS]&N.FrDrh /."Oyw?S~Ƈ#|219??9@/%'>S>sͯ8Lv>?/yE9O~{CœŒ0٭FB$~>hKV9f8bG; tr/6?-[Lvfk5g`ws3[櫊Ӵ |uokonN]00҅PVxNRJ6 lj5 FPv:ʃA{mi/mk)ܞڬ;쏆(:|m4ln]홎\OhUj,Q"] ΃#Gj@-cWo &JK) cG]2Z0ߡ7#)@+[Udlc|bӀ/2TƨT{Tu·8=Zƛ4MkiZrrs6p:z~-ޖ~\ G2'Euj# '|g.1 = 0[gX;o0.,*d0seR&*㢅qBV5ud g{hnDvB&6Y3VoG)}sPgTU}9.`~FR7^G{E|qіU[-b[$6:O>|@kOsm;ue')m&W–^}goش1(Lƶ۠ k."J 1h"b8˫ʔnpf{+:k´xW+KRtJktUUhABz:Nv^F#}NJA?&mO| Tծl b|v+3<6֑bmL<gzlF?8L.Qm8; 1.꣼MKAEzʪd}CI.cpȁaZ/Tor| ߶HGVbS=n 0\ W/w)O}l1`ŷvd,`_l x0Vm97r4i& 3!PSoQ.$O_{5* Mnڮ#kn^]c 3 Y .L]S$G 4z"e6=ߓ`jdoˁubla]1reG&ײV17ɦح+BK5 wyəҚpŠ|qתK ʢ;Nun8\pSKWkSaABlgJ^r /اr|1⚒(3β:߬ꝆVg󐡳!^c55~hn&>R]cFnj5-5G#~G* D,uc_!Gk:ujV Nőܓ#'ܝ4~VC!}c-KjZBK-(F¿\ ƽ=á G?pnܯS'HbVykGnDH ntO/eJǝidJdck w:jm$Bqg~K:^7uJk>>j|Hȫi#9x-9 ;eMa & nI'T^eu]:rZ}Kt(w?:>z& 6M[W2'ODYpvi/'8>[ӺOkg}U&=tC>fjǯE_]?bH> +p~?5 J֡3SXVmrSk']X*YL Cmq-ɚ4ٔPnjN&nUQN%ouy(Y .endstream endobj 78 0 obj << /Subtype /XML /Type /Metadata /Length 1630 >> stream GPL Ghostscript 9.10 Hypergeometric functions, numerical evaluation, complex plane, R, residue theorem 2015-08-17T08:17:05+12:00 2015-08-17T08:17:05+12:00 David M. Jones CMBX12Robin K. S. Hankin() endstream endobj 79 0 obj << /Type /ObjStm /Length 2962 /Filter /FlateDecode /N 76 /First 670 >> stream xZYs~JEoUT 0m]#iZh<0bԒZ> `A`YPLiǂf6a{z=:$x&@ґȤEE,*&U3a0EԢe*h͢cZȢg<Ltt .3 `HOa&: Y)Y,Y#O`Јz"6d6u' )܍>9u1IICȼL^0%7C)AxE\W01T෰\ET`Q'a0KaxNHs0^3%&he*1< 4 thASH am!v[G 18jb C|H$6o#@[b)`i)qz$ER/?*ezz7C] A,g2;?g1I|e՞gէ98͏_ѽ ~V+o T5A۳ݘy%I7FW^eYSv9sX&ii9}EJ]m|5vW)ULOfz2ӓd'3=LOez*SwI7L<=~|H- 2f:eÈ?G-aO0@$$w`$`/Q?-{BV);k RDiVD.q5:gQS.is04~Jثciv^*Fg,e2*me db2/@&~y 3)ւ|59eͬjˡ[W`ܚggՄ͚L]gu6AlMb6M6iMdz&3 uV_OgYߦvXV]O/}rܦ0A|]m[Wz_p`|>ka1;YYhbPp̓N!oSo#eN)ȅo!z >"w6!jR)_$ՑEzRM%LgӶ<~k|ԜguY) ?&LYiàI[vgCzmᅈ9Oy<]Wvt^LNaҸ=}^A4'Gmy'%]Rz:nK2qݮ3+9]S+HvH$$^$ZYRE J" b( ű"Tr՛G'QK<`.̯0%UJ_rJm[1E뭜F@1ÌuQk}wMu1c~hayx=HB)?#z^.9s9#o/L~s"z0_VK~kw!k{r{+ڱQ-G%^wutUP\Wť16^K\*n1) %g0G9."p8jץn@j(UIl)m_^=817R﫞eZZ:O PvMKn._TY,BdYf(-pvͮ W{`B4Si}mfFv7KՅd eC*iV-h=*UD`"B,4Y536w*B O*E@40v7.scPrAV DQhP2t 1Zњy:So@^]B!" m ,YѺ:xb>rfGf ڽ1) Z5)K5i%( %e%C4\vHA 0wclŕED]Xv#8m082 s o}"+׃ JE]P|E|P"&LZރ5rPbQ+ C SD,Dv0M'BPpW 2B)) E^@Ю m&uL9HH{ɁS(I[:|Pȏ{PY' (kha Yc"G\/FwL tƤ4_?{OG_a8yqL+:-"ʚB6~uqYDaP.mtv[/@}n:$,-m学(|qE[Z@d}Wy=%36iwYoPT\gP#X}?h OѢSȮ"`8CA?$7j+ܝE0I$I@lzsGx][_^zH ='aJQzL` D|=sa^' +-M䴒}\/2n^Ò4RXm{6&<ӝY=o`tI7[adթبdTuZ aѾߖ:˦5aZ玎V RdJhf'[8k%vR85:d^[% +l$ۢ&o$YAa̭0|7f»ߑ0sDdNYn(yB7$j ͒~fڒA60i%~oXA i5N6FUB 4+7"ir/<'﹧aR8I@kp Y 6mNu2BdhAHҡ3 ݼn,/Drjssfj^}~㨪|0~2~Ŏ[xNEFel''4u/ayzMÆOM&5dSd;(EFKtn`0w"Hp6 F4-K *\UDP7)BhZEX:<`訊!7tdR;9. t\ :\k\]0{ZE?\Є-8GA8LKIJ{OTGG&s,?i}=II5u4C/&LJ;d]\}dVA֯j{|{em܆N8:yr܃zSM79:x"mb}2f3wv:D[feπh^otFQQkqצH`ؕS اSeE@Ê{#xfW |wtai}](眩!߅ƒ:?B<5ٹj[=[G"?T0vNT6GΎH3)غNY(j8i)^Yњ-s^1NrR~B*ҢEGf%-:8 y6ybJ8کTޚDt,rL a2EqiU.n^> 7\\PWS2ͶT9MhBt$==<`>5ekN>5l:$~!oBa RYüJ(R@WH'PMǦӱf*Xk2L{%d qxZ鈇p>iM7r܉m)h3UXM]%@u,Rem;\e!Lji׏$e×s/fw:KBi9=Ev:GbS#r\afSڭC U?q1v2<[DOe+le|SZuy+cإ #Cz,]˕;tY%e)4dútntOnTSvZ9;޻K+Fce _P𻩂+\֘M?5o ]lGV=[[rvYKlR"]p6PN剝ҊOgjKIA${&DG}̯zk3?c7'k^œ/6@;W9.uf[ixo+ɖ Ntj`CQEGWemϳ-L7zVKnEZ"_m@UϋPwLDed^L\,$_Dl&TP j,?.#JejN\TN^Bk~lRo)v-K CXZ@ \KHEZ&j0rk=,ݤ B4%q.Wjiiʳ#D vy`h[ "sf=;Q_tAD/Q] /XG+q;akEѯCE٘0*+ݜ?!1R8f銺 l{PDi7~8 =*eklA.epa)1GHM7=;㌛ʉД=WX]g8-7.\j3uIOjl4ÎjmR߮1"Qli-BNʲ2G?ȶ, Y3?ZR?4]vXM!<LtJz@o0;UT2S=jJXO̵]4.zzQS`RZHr?K͒(r\wӞzT007]HԻ\qEԊ s_1eScI$ ͅtDrKV)}X{1^ 7?nKs^k}_Qvqw_,"F)%=qHd;yjrTz:_wpa}RkwPadݬ6V<pD뛙 ꐋ 9ʰ|Fi,E]J& 6c-*ำo\cT [V Y 'Y_&Y,s*7=o8Buzw'w21/捉qsKY`\PA*~\emKM7?Z Jq=s4IȂ|12MNR f\n%k2woS .5.?i2b9xϙn+OS݌mޟ!bQ Bܜ((Z˩Rl# ̮.\ [:N -RFMbǿ_Lj@K-G<ʟ *)v0T9|sZA?GF;Y#}Τ@>ީaq{g1TV#hkyd>Vۚ?PRѧwc;QgH~h%5]nB)Ŕ1хtG$(*/mN,c,3pw^rٷȞ Pz@HxYnzj댱0\kiID $yjF,Uܹ:A%JsvܤnהOL](aTwI?¤|ӷ!Ϩio CwM+ X0_v9 r9|z¾<]OA @~Cw_jZGa)qe1E=Ea)cP?GCjlONgIJz32ZAs*>}mss߲'l?v>qK%vd@E"M>i4f3 ѩ.4WTD4UEQnIQEGI2-[U09]%u[\<۟m3gC/nաd69? 57vs[ML) FrdHR<^/DR7D%RPFw2?k'nɫM}˳ u j"ՕG%Lag7uyիJKEߦPlj]9V%/˚aw[GA%JgN=.]"_eV>âLz1VRA Kn}ۻ6;jgᖇYe9|[MX(oL*'}3]7i$ߟ&#ɮِ sL+4 #7g"]endstream endobj 157 0 obj << /Filter /FlateDecode /Length 7554 >> stream x][uV^FI^}([C) uhy1A{;OvʑBΈڭCfqP*G8հ`9.a< °zmˡ9~vʚ {/n91V쨳pQ3 `oE-j`cG%J)`&/8aoh`ۧ:%n?ŝ.2r"$+uHP^ gJcq.MB}`d0{/~8Ȧ^8ʪFy ޜ3>MΝ<>>myPʷФp&/w;5w,8ݬ9f1J+rKӈn]WU< c&e&q@Tȳu~g~ZD J{A6t`#HWe՝N,O|<#iC ołC(|$Ǒ E,`%JP2R HH_(< [^(fQB-jH550.:b].߲pJ5B2d. U_8?Iv&|[=0)Zȯw-9y5&*x32x;n䶦!K+3EPn^4K#08i^wWaJ  0`S4+j f|h4t:@V8i| н*-`L:T+ _Qkb ٔ@Yjg%d~kKXk$=`@خYoeBG+bV`bfsʈ1 `_=#,<^o@&8%av/n~OQf)(C^{Ƹ|fAK=DpeE~0V9ݷngP%Cbv@m"NAj#hFC0Gx,5ڸWVeĖܠסP&(;9 Ӷv!IS 7׳ktPZ@] j kMvӃOM7On0B"3$ML1'B3WԮ˚>p,:Mq0gȤ̢M:tua!Xp"dK~&lKۨME]e]N%` #l :ntnyX*'LUf'"jMRل p4+0/2ɀ&p2}'Z}p_~b0_>?)"ƺq">Dn:GJI XWiuoVo6\"="K&C- u{B (F1Ntc䛽 C-(5 =v bcݛY4GsAE>q#*BowsOR)8Y̾ `eC٣p"}10!# _rc#iB Ȟ!^o 2SoEꟊſT߅, K/s;}e 4k\ܺS(&[ V2LL,٘=C} ](eSg> >94zg6Rc\W|SpMu;z2yQIbheJce%7ۧe\Y+3=)J̱ g-ù`D5yknǯm>蝢a2 |/b$\ѽeL{~xzDFb&$aY6-g"*{hP*1{Pǃ5 yeo,`꒰AFwHsbvV2n¹aƱdKz7kFz31+x: W0v\E/X*cw *79\ /HGٕ$c"'/FNw3DXgpT#tVA X#U\8c8,UhBAp[B}fX y ܨY"侕6:FʰS홴 /#,tFw&y[>,vf\ARϑ`V/htdz:k8Z ӂ(EQZIvjc] 9R_0uc8|LӄfrkJ*P+Je.Dħ[l<+YdtnaYB;8Rݫ|C㺬EOyfŹ\3MZTvANT_p'iwJ~Qj7=qʼn[=ډ9MlkqHVRF\zX-x[?[, ٗ$ЕxEGVa MR~9U+E֢y p|bw[`T5:߱?LZ00 ͏ <,.x]:F}W8-@dt&ymfAj~(TPOylu39$)kG:FLBCD) sݱ?Ӽ:hȟOgbYI=1CA^|:鏽jdL$s9QUj=*prs,՟Ke {oAƹfch rL:YmG|,ŸQf-lՅƀ>?HTZ/8ލZW۪m.(JRH"6zQg蒈27(fe}RoX,%|HL;x3U&Gq$i|X;;j}]dh̶=l=Yq9i,g PY S#lFu<e9*R h0*P:\ [mØm5\)DƲ"<ոq+ E/n uP"G_ߊAwCgՃK'3{{GgooƠ;z]i*( M19Y98{/0#QL_*&D} &hAٽŅg¹+{ZƮihq@-Ә%6W]~[W%iH7M&0&Q\qVOsyM7/VE Kf)VZ;%R\@Gby8qA},MK c]+|(uv[klsvm<4pVoQ5p`zE?< &)Q)Kkl]16GfAx>~Wo N>>vvV ? :j38 MG.B{An(p*"=fVE26-xL9 }n2]klܴY o{>btJeT9>{i.|wcpu詼uz?q>D^KŅpȿN6̈h 9em|NL؍n= >[ѳjPo\Ira<59n668 aKΣuGB{pF%%nuXe'}6[05Y3JG c=t<]>t&3ע~´>RoW0ݚ‰_ xPVxۂ#2,Qb& O9 镓+JҸ#i3頼El5)B0JD ]Ю mv<\aݪ khٯ _M |p쎃6 ogIcA?08J"VT}qYk5Wj $q#?`yY-u}ܡpW7ܙo٪==U* YIbZTO'0brn\ޏ!E8%$6R[bK3Y *7Pį%YW%*\ۓ{q5={y R!$ֺ os/^DIq weK=߄4a^ڼDYR٪qeh:r&炥zydDNQf `gqWE^Me5K9,cY9AN5.%U{ta仇 i{["\9jna&oR@/Kwfv9_zpՅy3HJ>h X\ﮱ $]^]:i}]&CsyuJ54_FUu:o6U38Y+Q`lj2ԦQXX<З'"mw!{/Lq'QJQ#oIWO΄|4F+iJgOzܓb2fmesєwqonI ee%}s{H`q*t 8~{g=os#wUQe_~A~\(a[\perh3i85jcQGsAK&]x@"0x¬Z`͏ ?猍1}y6 |Xbn,9=sX) ۈ2!X oY|d |^_xDz;ɩYr.j"j0kKj TF7u:%v z=OrSڏ|zWQ  %DzV/ @S!|τe;oKBY֦_g]K7cnR.@dn/Hw%xanoVÛm0ޭx();!3WM0!:׽qQHrQ =UTsjS%]39- 7-4x~VufWL tUXC0àT't[ 0J?mKoY`754r_2g3`8uئiOJ#N5rEA.!cIor0zK hB8רz{7ǶߤfkۅwYn1g~Uapů|tn'lj$um{op|k9endstream endobj 158 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4108 >> stream xTT8+"(1 vhbQ J6"H=ҕD 0*h$XRԧ+j̋&$/wH̋[ցEs޿32ƪ#y.l<(iLzȖ ձW__~?#ɂ }3gL4~ngvu:3@F_3,~̛>aa;g9:FDDLRN ~k0U!O{0Oc^P0{ ϐ@a 3xAH°E5={zz]?`i&Me ƕɬdV1f ˬc1 ;f,`gf!3Y,f2Ki?e ļP3PևOX1 ^UܫCZ~+eR=!ɸ\[5/Xo~Ch6[llor?V#e@΁KZێ`F'H&m'B"! {@ &C8p*!P pJuafS2hLm`"qRLT)kjg( o=B؝9hw:Q Z"Ns݃b-1 .ŐR*>(nfi`7Spw_:{rT8́ mU*smqg'[K dw?:A{/4ʣ\-5"ϔ侍rxi&#qZ6fqTn]v5E]>)l)2'X`Fe}v2ϛ{Z_;) 7>w0[i*; O rEWX igZrwZ6s.vr9GO-7͂a)̬K%+t #txJohP1 eX:c4u]E,OT,f/鹩3:N'%I z'Ŋ7"<*Ιa4(VBpWEweL*<0fqTg),3iB!3MgHz{\{ljeSGƥ$fB zra[H zqbԄ˦ecvnӮR 8[ɜhB f[Kg|H&I35U SfiLq;Kۈ _iw'1jS n&Tl;چ=] crоbµT 19<:n ?5yE;N[~kw#4k ZVznc`!x[Y:fYVbI|ԏO;q.?Q44AVZPO^* AE/70)Ny$C K3r3j|7Pk'[IK奧e-Dk䃽}GIv\H;0 '[ 8zN/jQ©kwhEشy,y{GK[#ule U:yJɈݹB1q=vY}^|C4?ࠏ)ϷB4m&)I|lAo |p>89R.L,5~Ճ!d?4%0UoN2R|w1+RQBp(Xd( oىi=MG)[F(V&uNғX+n@.m`4 ʫoiՍd q(HܣF'Kkh+ cu5GJLbcCOJ=KG y|q)ۨץ QqAm91Y2J!9d.+l^NKSs24BcvD>ޔ}_Zj+=j.l_:edwM3b!w[ <QYz_ze7^ovb9Z%k6ΣKrɈ~$F'̆(*-oF>mZN@1nuSS-=8湫D@"bh#vK[9~ x6X' {EUmoaVFZ7ќ[ U\C`:0Pض̯m;=qV|!|]wj묍lcQYdz J`Ϋ"t XVPX SKѿl|{e[]&{ko"+( 5̚]8G6&GrmEY9J%5[`m5Ȧwm Jmll%mendstream endobj 159 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1318 >> stream xekLWߗK雩smSt#\t!Q!(RKi+B[.0>팈Tȝ L.u`F.D\[ekK >l_NI9wM (GF^~ tny?HV^Ũ (cM6A*j)"B#"fFmT$zm/LjSݤZ bKJJ0Ye]`+j-Zs6[4]|b1֔_Pd՚lHQBSjhuzCE%Q{}T2uN)T[/sC R U9V5߇^n ƒJvZ}ocHطD>b̑H\JMq4ڡJ/N*Uvה`Rr#Ůދ# L AD`f^Gg\mxy, &c1{,ʜN[9ŇK::'-;d$%xdFܣ_}܊Ԅ>D>S`}$(nK"B}W|~S U(\òۍ2)w ݈"u [  CU"8uTS.1fvcxu>љȇBHq E"x)MW]UpպΞl9 XϘ?6;Ϸk4HbqՕ`g^nrg[&lcQǗBu+)J:k #pU< y~Gc)ýFb}V H8a#7٫ۈ⊑gKQsFnٵXb"\<)?A#?_{1^~Nʐa0]6ɋ&qxA_G)ω3'vG T }*tvVi?pS6g5j:<=*}` V+>803F"*azln@TإLPYFU!ѩah6''" W=lOӤdN|$s6>%jEoﰌ$J4]/W޹D.d>|n?.3O{$N @j,@$Y0X' + tI endstream endobj 160 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7822 >> stream xztSWzf 6'S:B(^ ݸ7n ۲%IȲ&۸PL1a@h}z2d2fͷ*{{}C@uB eǏ3~؅O肵mqVS=8<І_F}_p\\!]F؏>}h M~SSyce[H!!}ahhX'Am#~[[N7W~!˝|ͻk~ q _׉Uoy^gA,.ڹ8iIpeV\cZu>}7L8i)SMaGls1cǍaMQj%5ZE}LO>Pèpj5ZO6Pj4K6S3Cj>5Z@RbjL-P˨rj%ޡX]*GR](;?5(PQP;nTwjՓ|^'5OR6jR<+ ~v _uuVEDOh%%\6߻챹gzmdĺ}&i;ot'6kų'߉Ŷۯw?u۝?u`{]xo1wQ"IJfʠ)U z1xC6d!!Cº-h_Tۖ9ʴH<1g%jK{5u`Vep!FzSLTk$P?+x:I#$;5uKUҴ$^iLYVX*[[5K6Evx?ꂞ&B#r(#mB엠/?n5o7@`.ҭ9#ƃdV>x붍$+h$wgs("]IkPѳ)lq쳢*;]OF!i//=O`~=zӯaad"eZc0}ĚW 8.+佑 }Gb_FnO? 13P pt_F{e˶*pX'unsmݻ/gN%Wc}.U@5ɞݔ*$%x:.ƋL@]!y?g=s`IcZPH @䎿Eudo pП(2$hm.51{G߱Mr4$AL&@K!ӱxntD" qE.0-]tɒ 64۽nQ`'~Wx"N݊h=odyu'~>{h<ԄirGvg'v[5ePGoqAD6#]%g31Thq#*sDl{}6u)@] j1gX_?!YU8xf>@ %hګdȇŃhD{83gCD^D hAk78QIQ2JRdAH#Y&|FrQB}V@|,a "$j?wk~@~?u1E]h,1Ȭ/ZESfNg+$h,_i@XdjXٞbD,a5!27fPjo 6zѣ!VT3;k7vSFaM>H<'Slj AQ!`?Cֳ;02sljo8E*y01.t$dEEF¢}NU|uԷ*6[UNyMœk˚.)}4:.H)ĒNTBl Hpp(R=kk<˥ W$?1Nf}г8t͑6dy4nHNșj\` xhMrVM?%Khq qZt(Φӿ>K^wl8x 'qUክ̀鐿M ~懲hAKD#7ƽ]|;&}!<.,6qPȷ?u\Q䩘MZ| :Hcp+WKU55' <ԊWDjezi3!ț>Ɏ,+#Y|!Bh< ]|zҖs&r蛎onbg84}gk}PY72Sd3H\0#2#2lhMٱ@z¼RY1((⣅$t(){AM:eOUa8eR}njyƮ |Uk!.j_sA< 65Z9IP)՟D]FAFpMkI5_/8?_t-KN'+\8GtS9<́?@'GwKX&w-Yf.(d#֗=ަ'h+8Ef]ʝZ)>{[r@MȁР \RɘŅ`z7wڸ(bzR3 JSV疷0C!y͛4k#~"3aCd81k,rY ?O/PXV] \m:Ŀi+.:h7 hbY|_EC1\ҕ8RiPdUN{=!?жu>QppH-1#KLl2ɄePY $zĘh/yt%D zgCB1ۚ=k:qWV`rzDLR7ǢwfSyr /0e/g5|~)܇85ꙙ DAJoXw`{dKo mW1xay <8/BKSH.)1)vYMOB^ˢNVk4*Yŗv2±i[0tT?>e<&'9|8ı\T#^q2PB]t)K Fp!AuuvL;3;|tsv3 qCm/[g#݆jwN4Ret e{'9ל_lSsEsq[Vg[S ~zEM`U0rO|*EySJj1ER:%QJ۟fĪUiBZ?DC POfxf/!@>`ηې99Bt]Q F3E&*q;YT-ku/Gz?ekx%9t[_  jF 4/?r}Z)}&irdeeiTp\Ơoܺ-D'=GF2#~(bQ6 %fj*A#5 ??#<\<}Vz `Ǣ{x Om:E*i򉛪ݱ|`!,&&U(S Y12KPI<Ã`3~s6暵EĭWe͵W]'~>㗳r"d4UiJviQRJDS2*jґZƶq6ϣ/ϯ' ~mYqY18iwؙc=-SA1^-AMͮPCnmζ#Q\)MΫA2SY2a&v@`GԤdƄ =rw#Xnart yCD͂WhW%TAQ;Q^?>y ۅE$UOiGTUZ~Rp;hJJ|Wә4kMOe/D[G*S1K\ lmˇ#bY [d"Y m l&O膢_ۦ(r4))-^C{<ynR9- ,|,|=$UX K:΋LrEOe*-q:klq]9@ꓖ)TˇvOM0\G/_d99> u 4qs;$ [cNXsMeeJP)/՟ޏie{L4NEhq n*Lfu'^c E/;'/M>b>ҨWv(xBN0MK*W:J|PUW%`#nҠ'S`8q<%F=at~ю.Bd5YzcH9+F;$SS4 X+i\pC:,ӃaZq >ݾ,Vfeu-գ~wmňïC[YcsLm N^PMT9и͡ 9k$.Ct8i\V~ WĈ_XyшSZ&ҹj hτ/D]%_Hl2ex'jʦꯚ^Cc= tjj50NNt$6P$$duweK>n$y\,~O܎lm&Oݑf=|JU Nd _cb=EJ։'|}o  |O[oT?BwH b+if_\7|D !U1D9IEL ;8zrH=]DX xa O ؟sǒKr;k8nQ:T9 UM@a``@оELЦ <} @${C}!M[٭UI9E+7]e'b? 'Nm\Vl}& _"Z'̅Gf.id9̊_Xn7 '={doZ,;{rj*'Btq̐"ivp+ yH8ׅǜA,q7#c k7o9o qO+' 45dpOH >0cR\_~xON-5; e{'/̴#'rD#Wh-o?oBUx]1Դ(?^-~.ddvBb*Wu!Ej5ҤYN,f #2s2g!P20Bd׈6 Eؼ" Z(: BC O׳o$EY57p"Vq3IM֦I~4$nFZnPj=]ȓ PK~~Ox;`KIDS% I!F(DX6|=Y#~(2N+FjcP<#Ոr(4¢9\k2#N a:tυȑ;[Z/UR{B VU\0E:sMi&9Ci1\-*/M\TG;]R pwd%~٪]!:Y)Hƫ,$cqXa?w-ue Y@f7tb:?;5=hjU*Ɍ7ͽU X˳FtA}  Q%ZąhZ$P:oOfE?s}^pn%N:8>O7ѕP~])7 + N8B"ZjBx50 aelIվz>怫Ö&[d"xC,)h-c=y4AxEV=-d'r_kzxIIÃ-8snI_`Fcf$fjbN*@ͩei0Ȉ Y '5f{ttWxؒd'G@%* umf FPo`"b_&?h8UZ_ι*!ّT-@~YzvΦ/wMѳE]^6> stream x=T PW0 1ʵ x "REQ18D9f 9htU$7blDwuZW .;#&Q2YRd}jX+[ti< bR㢴Z]lLV']&Ej:]'gffj|RΌŪbbR3bkuMڄ{pCpRBr.&U1):&5(EPjN/jK>6*ZMSk(%5rPS)Wjėrr_dٝqaCFǗ" :DbduuΑb∿\>$():'N1mhpxiRVmWY|X~ۻ1BI8{[ޠMكDr|R$0͓[k5S mp`F9t,*^rf>}ͭÛwpʞک*ĝ8յ{̗67GAu] 쭧p~[ Βc)*P/1AV4R[lU\wm3 vV͇Y)]\b6 :Ș,( hlȃ<~jx?0(Yi:ZBIc)Tj6m (5Fb-$$N#g.O5;?/5"֍.cpXo6s)vgEKx@ޛvh=dYmlZcG [zI ׺zDظsm"3ŤS˫uݕ c8t @5VۋNd bVyz@7^Dm'Y񩪺JƒgEnyFTjXb tҚGpR*޶n.q &ӁxM '^B՟꿶uG|$'Mb**$\d>v|u_讔D;Uu _ZCh‡,yjHN8ȰiRQR?! jH`ʦv^ʀlOvw>e# hd툃 TH!2ldO@1k7pEZo'jFQP#nkh㑞w stIAQǃendstream endobj 162 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5013 >> stream xX XSg>1RSI=ZkUZ۪EuAeG@  ϗ=! aւeVku:[<3w۟xϽNmmgÓ'[}cgu[V-|;?t?bxW(\8G>C'#C(fp˳EEԴYI#,Zœg_4+E \Ȍܜ[9\K!+%r4y/˳Dy)u)b!AO-f/W}#/uAšĢu)6oޒY'>8w1@l$fēb+1FDOۉeb9xGD+ bXHXK#|b1@dB"xLO"c /g3ecnp>6>$73n8)?i9NT=šʚɚO;v^6"VD슸(X׆$C;|7<\_פd S ՗;glj[.q(@UTnvګGa`_ )S/+2'N6v~ж[PR$ZkkeH@TL˯co)P!nrk5{]A_5 { Jhiɸ# (+P h& weCEAcaŻc[ hzK//d'|v:;sƹuI')zɻ|kDStБ@m7#c-ܲ=v<_`8Xכ0&שAVN]ylǖ/~3Q(q#rP%5/s h 4?O/Qg0Lm>4g$+?SL6!qfnhVhF:CvTXti-nH<h͆vħ 鲁X'T]e6=˷}of$k2q|v 7oیzFjn[\@=| fhOiLjRj/lU8ڱ{EjLL 1bg3PHS2Вe0טw7 f RF[^q#ͪoåƛbPK3*jU*[b9IE9JM >2ܦHW)V!tnھ`Nܲrr2L`0qȼ@.]<P W'dhMsc=ՅB?]Rh¿ζ=R_{FSـ|[vZ;T;%dHDcr~*)g65AtRz= axgje w_]c<У=Eo\IYk?5Qfi0ww 8K<8IX!)czqb^tF@Hz^ z R3*<:o".W>w 57t5C*؛19v@omQw^c>4 0֩p pCk⣵hn]ͥw߳l =TVYIX ibLvevLW2N5BQqD~G\GjFd[-%rH1ɬ:+Ђ۾ܘ=T}G~;ShA.]Ӂn3(cd  dPyĠkR`Y4'B+?@cxz2()v8/]{׾z0=ڻ~LCEl~G mQ.Z[]f^o> GQYjstO;_6PSzS~ ;g2ii*{a=_5Z?uo%WǨhHCRT:߹[8kpДOmV8+sU7p#tDžc0o܉d)|ܻGL^hAV~6|6b@}cSSbu)*ht }0ƜJ}An0Ŵ zbPApc~N .voc|#JK|}[{뱯]x D6c+$B(-ѩ5]EqyHo#5[X]LgF-8?ղ_6/z cuEEl憿Ї~ToѶ`#tWUqKx1V:';p:$K] ȼjކCu1!(tgyˆǗ'tit*ȡ(s+Cz*$bqAZ/{Ю^q.| iGo m@wxΚ)qtZrL 0*29?zĜ%45+ǓbT邤IX~ "t*),MN,յP_mrc1(LYB?W*jƎeDZǞ?+WPI^@Xv"c0[uGZté>ϝ>oy1%5*2[эޡ7TzZ؈HKʤ0F|>Nͩ~t =ο9B9R}SIGVyIi57Smp:wL,^.? F$\xNzD^7JEb\;Ao样.Kojq䋯 0/k_֙ znTe`l ^ڴXWUfŪ7T(չ| 1OٓJ}e9ͅLڐ.n懿}yFɣҐ6@l'' b36CTe]:$i KKi0VRo I\ ^UFveZ:e&W4F5">:(rl|~^V.3}N 8=~oC8PB$iBQmJ, xBѡǮQ>?x_xnN|$%h1xe\~XmqPޮ!|+r"yz3m=RTZ{]emmcPVIP@1rmj,jNJ"I+( Ιa(luࢪWZj-G&d; |w~mQ08k;4p~^"R ujOQh?pkggTL\\] `-7gZ\Km_/@.6{,UNSاղb C]ʠ:d@@O[)8v,2;(V( Jm6ue.uܫΎM̯RWԸuʹ06kY,/"xP1Tku Aujߐ+؝;B}>I<{ }>\9f9E7(+T܆+CJ_YX5F;}!ŎaWe[ 6V4qhS%BǸ0 _(RѨ0]XE! G7cl|i)ÀT1)ƠU>S?jN>yƾ{ٙؠ%8 >7yл# p(b<vCpX +d`1W fɥc"hnVَet[*fgo?f܅[5'n 4\f4: *,O`xP4$WF vH.[,V ,5˪~I_ahzu}~a1yʃACaR#S0Sz^pDmST*))^jA.&ęG-Sa"C!_h`ABwē^iKhO z>Ϩcz/w=^pj<{'2d}endstream endobj 163 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1026 >> stream x]LSG{mi+!ok j`0P~jH϶)R H6u\-טn -( l-0ffK.]B"(Jʊ-_^E!&9v˄X&\m9 DBVLjfDogbw08fok7ab >(efQD69x:Pv4j7}SmvQ^Ŗ0)rn(cggSV`ZBmC54!>"Q JC;P:m"C*rR*KsN1nx0Eiv}EV>d҇VkU%ᄍ u_麆 oÒJlj ,F,MK,JJpV2jcEI<W;` []rp~|y^>"2٦$6K0 1ɬߊx=0 HII_%wxB WxbifE| y Fy4wOԢ}C-3\keBr'"Q:ş~oֲ.J䕝#)&EJJQKL @?NR1endstream endobj 164 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1513 >> stream xUSkPW%!Yv [Zv(V-X[Qh6%!"KI@ ymGV;HAQ>QV:թNgm]Ӎ{ܻ$ HT/X0aj?|SziG' 6Zq#0DQKl!=i*qxD*ȑ$i匆T<5+`9c,lA:œldy+3Tό2%'''Ba0s'39F>YZXngM <1Kz3%q,ΦIF|*ʏ&5ptђf8,xS?`dg Mzy6&O٧e2 b˚5(8 EH; d5YCn"]d-&VXbGx5F1ZQ(B-ԃ>9)C jzy p9ш`}PntE(ƍNIU@aZ| %/ |1ȅ{[I b4>qhz>bB(rتmVޏG߀X6!k2 +@*w 5}'<( dw& (s5 *1؅zsI=U\UU!t?hÒ({]N 6Qn48QnH EQ!t~lI+"iC9֠`t)S_m1VglWIZjXQK|q  ‘yW{%vDS^F4NR rD$u{i1T8 ڐǝ=IJQ|T m^P$nnҙEh ݗܲqP-75iXQ! xc* |rA)_K'yBRӸF7_pzPCI+0pFfўk5f\!.gۣa6#0V-).4/J+(Pv53!򽣆gU[vC'sP ,syuک!j?nޓv|/!ȾEȫ ^3$ OnfY@ bnTB#" G C5| u푷V5c mł*)=:6-]A7o{7ڎmwwWZA:]AALendstream endobj 165 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 547 >> stream xcd`ab`ddds TH3a!W_nn? }/=M1ss~AeQfzFFcnjQfrbobIFjnb ZRaQRR`_^^[_nPYZZTWvt-(-I-ROI-+JLYRP`9M>F|?}/4O墳v/ZT]-"[uiwI|8/2k? >CmZnήUڦ S{N1y9ӿqR={Nw߄ɳ<_ ~Mgɵ{\ e`Sendstream endobj 166 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1771 >> stream xT{lS!ܖ,eֈAK)&RImG'1I߾Nď\ׯ_N$B$(km+dǪ [JS{.v{P##|A V!uڔ)'qUg\%s(j(BQ5{~n~>r8L*R[V۷&*ڛ~h{HۅDm!{g;;; mRE[;ۉ6~P)Tt[_! mI2!T˥-BA\AO H%B . yGB"E,IѬVn^.8TZ;Lp? 7v}~ ҏ?K'˫;+@/q0X>{oФP͈yM&]=c Y:A /K|vnGx>Ϡoj`r@O[K31n1Y5׎u<@8t󅿇DqGqY4`VT3vzȽvx]^̝+&d7t; 31^p68s8˟I%G'=1B7`@U;SU{u`7'IV_ϦuksM<_0by^8E=( tdG{1SB56 R@[R~e硠I-Y_zDtY1(0 )xn0vh HL"Zm´5-xf?ٗݱ<#zBiȌaR5'ǟ]zb %u `# s?m+\zg+tz,~EdFڡDY L/'hlU^kk擴;:{G(k3gsߓ|#gt3&N$e {ιLV2 .֫\?~^Z)36n97ܥi`嵧$rh)C}ʡoT0'AǗө+A϶iiHLtDe5}dgUugs2; #Ԉ)gO*ս6ALڮu@yN׃ e죀! .76ڃZGGIV]L -~+mM|̥) rRIFG0f].5n_۴Φ&zOz g@:m'BY@O~Ju/2_I ]K`/F~)Aٱ܅1wö 6>@.M0w*0FZu6-}ssl<t. k&GN Î';~TDd(|GV陙ITcUU*Eo -ʗAZ6T4֌?{2"'N9endstream endobj 167 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1095 >> stream xQ Lw=v {]muZ$mDcRJi)+UeӡiAQUa:| 8a\&#薠c#_=X{ǂ0C2'.1+8jс >H@{_@9/b3 UƢB Ī fRĤYcZUd8 Wq"1; "bbS4Wnl^җ5 ?S0"NlgYcdJ8fJ2˛]v}cL!5`F'2ұ l0Eb+DYX0vp=Tm{|T2=G|A1LL+ުwUu{;=*ڵ$Z'ͱme$9%lrnflyzT+ͫ(T%[Ie]9-T8?{^∘BqCWN;~>'={h( -(2@U5:do"\:Ԯt`Sia/[; :HQ6<@O|%A3耼qf9vcI{B KQs8wy7Xީ]؟!:=Uh!RxZ`iI/ 7B BDX"йwwQ gFr vnt^gZ NdSy"6f;*dY})ߠGD{JTa;OW 2sIq/tz%)[mɦdaqendstream endobj 168 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3064 >> stream xV}T[ui Hڹ7ZqzZ[V[~Y-$%!@#|&o.MB )P> ~+tlEXu3/g3gwry}437,]2qaaAbτEaIc2!%g~؏P<"Y PVLeiu@,_,Yb ɲ%KVHy%<\V濼%٦WՒEjugh4OV8CQ咭2R&W%$3==,.P%JTQRe5R-E$ϯ\Mb+N%2ueb=XFF.p?q?1xH!!ak񤗓>I.H!ΘH.#se}kKy+e(sLh_}X(6D 7.<1~}2W ׂl11څ;ɩ/Sr‰KbFkQn26Zad'h4.E7t5~} wjG=ɽwBo0Z+ypn k̍Q_/BYp8s,u e= AP] 6lS@JFAN:xHEP\S!GbnZ?d hRhnnq>NǢmlCt SO0+~aґX4Ѿ92p* q48'xXw ԛ>o[Ѳ'\:58'2M8Nvs.z2m^ bӴNV <Zn@"-DOz]{ xM5^&Lm5z?o\gWh{ AwcmoS;bÙ%5TYiKx._ʾ5:90@ahRlG |0k=zXјFślCbHjJ dlV-kvA^Je]}h{\+}3!hwBBedcg*twԇLze'DӝUϊУ0pdQ:FJM~J1@U(j~Dv6[ rT + ÝgcN"U\=X&~/|܆g\\y::ZzCw%ac՛Y GXa}G$ ,Ui+*j#`qV 䮺sCgzѼt)VX,v׷f>tpDp2"b'4kM2;^}|5FZ]V q~Px~߁) b.C@tg}WHTvA[{|71G% ZZ̤U>wp~W}gXvBZPk/ w_87z]S)A7uJ#>{1gFN(͌hT֪@PUGMȗ=]im|c^h6siXeZyfUi*ʗ=%C/9:- Uƀ蟺6hZ14PUzA_S`dC4wh3t߳C1M0#\b3jHƓXAG'na!ڄj1gϴ} c8K~7[mMoo~"!S9UXx)GE{G7z_4-4J8p;ǀ~!Ch8SAtq/ہL-;#TTB+ǺJ Xz9iM&#8WQ4/Eg&$~:!LlK v="b.\Wh?Dٲyud;sdZjݖr9]I+^W|CqwO[CO:)oȜݻvh8=8+zq]iSu8 6L_lVŒORC/] ?~mRa/ pwes>_ka|y8=?ӬUQBW k_㭽N:v޿-}cB5EzԇT3=I)d|LvƤrTL+1yѦ1*>u7E{Ty>1c( + a&6lzP{/b;#HǪ#/37 2}"w9,Y5j논7hur.q(@1JE*hԫh[l怵4%7*tØD묄*O*@{Ҳ} !(*3c(Srf%\,rц#hq L:z;#ϗ6ՔU8D2Y;V ]mQS||HZ)W._# [#TXH< i]/Foc☪D*)Tb1*5o Y{|ss0򿳭|Gg> stream xUQmHSa~Mײ`JjەlnS(M(HZnlwK2  ls30@$ * 9w38syHCcu9۽Z junбkbfY?[<KA@#Co$`P `#v:[ w+!"QPT=(Ѷx> stream x\Ks$3:|P~/;{ yĵ÷E)5T!Q]MrPQ@"/ P^(r7F-No_{?iuQsxjF=}VY/OS0:E//~,WW9m.Uﴎu4ZِZ?AZ=v>3c4c7 FIO8qfsgV}PF7%&>)$~hӋ} {674G0@n ~qdRJ\Z94fwN{bFF)㎹W^Wα)E%&AG6g=o)ӈZquNGt\>emnŗhe; Snvg8u۱sN`:b3t'S²t*ye Y>xBGR2A}4$Cwk)*RwdFBS~xH4{C~72|ݰ' s>vgnG̒wj nne=UVQqU%Cϗ(\ֺ^Q 6W dI=M~q:"ٴlNX#a)ؕ^G{oxd ̧mL]"݆83;=kuy{ְWV@3lك'.?g[LN.D4 hrN)XѷKU[,\#tNdtG[V^WSOܒ*L\E4MqJAEi9hb@T[BȦ,r&FvQ'Dv<p() )J;k|!70I^1Nɵ#V h0E*#RJ/ѢM:P31 b6hd ѳ95dkC q2Gm(!OX n :$ 31tLTvJ 1hd72,Ҏ:$K̸'0WT%/."b}I'Erc  27 @}N Лl?bwG Z_/'Spj]=A``InؐG*ȍ ԇ8"oZP7fcl3޷Kq0 3'}Ͽ'lXw^"MMlYEC?H6v_ g9 ݱ$ѭ[ i=r&>W齞">[ xF49T: yl#w\* WcJ̋z g6d_Td@WeAnyaÂBsVт(-o^OS2j]YcKxL"Hƭ.z +~⽦+&ΔO:ْ ә?x0Y"?:P8KO"&`ctfGd!3$wJT͆!8d`iƿE ukA?v$ݦBwRzaWc#$ Km-|7Z㘫zԍOz~ ? f")B{[T6zp#!hx'?&$cB,!T|X c& b =ckc#aFT8 \dp.pML?d8JiUC29ѷj( ?56hgL0OeD@! :9n䀗 6@ 9N="e{XFAGoq7}c@*JSQΫm>kJb$2a+vMO]MPvh&0^ n̐xYIfS58*L`˥qQ*7ofѓ^yPd6m]OzjRl,BSrhD+@#V_ @([ɪ!b U40USQq5wdK#{A ,>'/` '@-y$ʷ܊zg__| Qw5uMy Y8 n);:pVlk  qG&UZ=#nLHh|܄S`f&!!+GOy9=b̶2 f0ѶpFb Y'+/jtlӋt-d-1 ;xsD޳䟚L QW+&p"*INz@حi΅8Kq<ڕ* jK~6ds9BR;N'_DN#}Х1Ёr,=XM{6Ў#EW]T9m0Sن>čV ) i[8) "|e-;eB\y#H>:&'~QAl@bV~?Mm@kZs-nMv(ugY Ȋ_/GmV3(fr:OFs/+6[U4NC%M<#U-Х5q^WhԺAΦN}h,ӆa]V{ Gp!Q00 DAۊ+H c{Nv`.9l$5Na]>RuYV't'qȑ2b/C*>Il!H mL/PXBDw_#-]eһ=댨V]=Tela?LmTX'+Ŵg5蹛m^ry(#yTǵgM6O,׳DzQgrgTx5X&n1iS=a +QvD X(/"PX!^R:0{Se];\luΕ@2㕵\F7 IZns \ǷN. pL~]N\\=/"7\u!o)dV"L='0[P+zAIiğp]"}]-j*4<-zaZiwI0hQ&02܌:]q>լ7i d{aGTh}Q|.Z&}11`qp}3De@itcn_l*kzy}]S%[iMbUs$}5RX52ΪeMsal)_V5)p& \F~b8ڷd>DHq%ʺlP(^o(ΎεXY8%*Nlzmp!󪕈҉(ZV~b'u#>">v[3A|)eQvZEl9^~n|m  7 ޤ7.[Ag$)`pR ()Nzo\p\nL,$1ޘk6^yYVEɆpʲ(W;u)yf fRPF9g\= 8V/ b&,&''$4Hz |}wtR5QٿGUANua=%Vb@MăDRS>˟yhж_}s_ Dq?냞'-8z1Fۉ[ |.Tgf/ۙxi -P~96Ogl\qmMmצ346umy]Gy#KD<Q\_- {/[9Jɠfz{ʯ(ެX+/Fȁ1}]8!1m^6Oj]m^զňDTvyU);g?Yɚy?&a/PjdzG}`On9o68O]G+硪Ɉa7֕ҽf3Whsk/ubeՋ?A.v)B;EEochR*m^z}05$˘x?_2Jx[6yma{_*0L=mV+(wy1,rk6Ta6?.L/H>_ָfϘGWF5<-~=k}m6>6imՅ V{_uendstream endobj 171 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3600 >> stream xWipSW~BX<43"VH 0%Ci@cpX‍Jw[;OU^dylY aId4 K$t'rc0JwSU?d?ν}?DnNڴdqaHxr؊^bzrZ4/n*z1J,hMksr-Y|ق/^Zܗ9MPi?}J8nL&wŢE:na`aN~ƪy tJMfVE"P.'[Včepkm:WQmIWgSdvNn~AfP} [IY*BzJPI\j5NvRkZ*zZDyj#DmS4xODqSǝo?3CIpB<=njIɿ}~Jm 32jl1) HH@Jo**zK!,jVlVr)G;O;N}Yphwx-g3rV?q,9 ݮ2ʰQ]fE)l9Oq5s42 wˮ&w[2y`jDnkb,MR|f}}G4K8Pq,gͪIf8 ?l7|"IB;P߃^q0hnBtTl 䶥}G* ,}% _I`V*@W*Tg_QRtjBc!ÅJH/?GSr\f+'bY`MN-rP jd\|)I5p6밸P9jx!m׆QyX![h"J]KW;ynv/9@!d@8,7iY[1gT^euZSΣx7շdOHRgDF3 N0 z*֨%/N{X?~鍾F۳HK<=^lB:͒eV?9ECnc c4*l4T}R荟DCS ɓ$|I;tut Zځ΍]6f0H4Zj_y wx`פ3EEdea$]8tlIX4axx .t6T4:9ǟC,}/pylSHsD\)mXt*,,?JżI99gTt!ЃᘊhXA o AQhK&b X#ҿuNwu.ǨL6yR t AA0=Kϭbd58[y_SVm?ǮHSCASкhpT,m+iSdddtro3uc;؃ ](P˧]"\Fb3"skH3)[ {v:)q3d=m 0,Qy PB\x'ت8KM)=MfvXy]߃ =z MjaGÌz0Zs6ԫ`v$>KZ(Xpvb )1y=.K>CRn/ޯ~plo.MAȅvaQ_kgk<3P# 1H#$GC~nĥJZWn#C6`o%[`>czQ <"$;xlx/yr<˾TX^*XO7R v_*sj_wcae׸vBxI㗵DO TGGSHendstream endobj 172 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1165 >> stream xu{LSwr]`ޫd[_8la RZ.WJU@ޞ*TlG-WDf7LƜA3[L6=زLcW_䜓9ID- HTmڰo5O@z6)PG&F-" sjKKLh%&=}m2νc6Er. f e.KQQs+2L`]zfK1+S,|[+9[`v+|i){/YbDJh1Nj%x #G. _鶽>?Ad?:q?Ȟ=6~cZpNW-ͼ]R΢_TbA3Σ/?%es=8-MTnΕeUm88ZV+wHsSN%ַGG""¨=jUSv5L48endstream endobj 173 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5233 >> stream xX XS׶>a89 CUCE['QD$!0fdPqơh[^[šuh;v{v}#99;kֿ#,(@ bńƏ   0ߎ[7K6kRl }mPA/e.' &#G:N6S'ljOs# vt}"qyT8bX*:yFnӆ1c7=QKKj95ZAFR(j5BRcAqTʑI}LYQ)k5M͢P fSz#74xbNz 1==zlϞ{[Z=g}׌^V~Gתfm!h(U5JX g;+v[OW*z*@ v͑pMدTB0DCNc)$⒓! ]Zu2+DS2 R]Ru;ScpPY5}-=Vl ;l6@7BGK(֍]Wh]HK ߈Ӣ/n?u0d)e[v׍NA\}x:'n!xEF2&:䩳}G :ހ>1g CQ a/W9 ̍%9#he(VC1띒-4Y^l_wŹw,?Թx'ĩ諾7n=V ZD,^ L8]w5=Ի>f۪F_Fu8~t]!Ugb!VwM_aU'D?XuJAWC}]((yOtn/_(ȏ؀鰻C¿ȣGnp&hos4T\H:GWZ -,@,Y~u4~2k=2 q F0XHÈJ(5e&XlR1Ņ&ycnI=)fK!5P_m Ap8yŒ FMgy4QPQYtfy~Sr'05' !J@ȣ@MC%H]UkTsVwB0<8Sq5,E4Bkz&p§B2"}meHx'2{t!|ϡ 2Yw(˦eA觼5{5F":2x X}NzLZy鶖n{҅wʭ]WkzwN^&$H#.dqD {t b@4:,AT6%W4fƃ @%# ^R:+v2Rɶ(yGLGam憭Hj!9:^%Kc"fkOh}9 Z\JSR{c0xKI{~-I5vZ޲ru0{!OiD~=נt!#diWe] PĜgJ\!lY?O#޸p $tf -?{`w">Ny[Wk/~џ jxx[)(}TVuaƎhιц#}ډCJ4]u̹#GNuhe7zlj'7mK򚂪̝mITVF֯[淁!.̘yl*/ENBI^Oɯ~'Wbr*&3NHLW@2C:df3 _b>|4.΃!Kqpk}fcQ.4S-'( P%05IA a[qnDWaѢ6"$$<<$"\rX?ц6X?~_v'T'Pw0Ħ+ICDHãg Mh>d}=5A&Z=E}ro77x vDMu뢭wʵdC7Ͷ.}&8ӱ=]iO nQ:u3vD;zxr;~3Z}{ԧG"?ilCwJb^F]JiAVƗQ CYU k`[yhg9ܡυ润MQnV #;1v/2X=1hs̖N'RŘӷPlBbr (YCOL[#C8@_8˭/ wd={N6e6DSY-Hٙ;^{m4헮+-8UN_zԮY)&ZS/3xKv/*&YFb,ys"^ 'A<>(W脚L쪺0u<f9(zmiڦ&M`-+7X[_,709?5nTFWOz)PWl f1w~~jK/=sP>++L'*\" WL|%F6lƉ 幙Au-2*;-[eS*!6;bz: 'r0GM TO-^uT45 =Pm#膠61b4$:83++*yyDP:LA{%cs66~8?; K61xH&ꛛ|{X+5ɜT R2!Yrvv#]G6m n m_]_ EcX.h177|afw̅22 :!5-A{;!9&" &7.? } 2HTosx|Zsڽkw- {n%r+ŻG[HC,cɝFBr40r|c<ޮd()S^߀YG$17<4o8[w wrB5Y} ]gvń;oڛ Jfx񹧧jk4(yk]T)4&O檵s@@`hxld<~1]Ԏ]#NDVO1% I,Q#)+GSO7P0ٲZ %Ϥ@OP'8o17 1vm2Vלo6r͹(9/ğ9>VQϋ|(DAhWi/z;{/=m2&&0?\^n{`e_ۉE٬ok5] LҢ<|;Q rvLeB7MQ yծ.)T"rG$ I1 s9[Uh+;$ݰ;6kU >&SHBpm/Z]ME=r6ם6N4I &Fb `/Ah0]{brx0$%{Pӱ K7^JƖE7U*O(*ix2m9[S+ٝN%ٷwn߃SkWD76_5S'O#[:>^iFix$Cj;$ޮ$Tefs 7o&C68T7$d&餚ֿ3 Yc歴\pdn|ۇ)V2Yx"&0$E$:ȋ+rvfsڞԣ< Ev [ oFCf\vFa7o\nɗ`Fn{Mr E> b&EiɰB B"eѾ5iRh-AUi|Mdt!٤VA}DD3Ԧuv;$[o+Gёɱ)HUtZ5e?½s/zمtyhsz+<ĺZo݋2Y*endstream endobj 174 0 obj << /Filter /FlateDecode /Length 5895 >> stream x][u>&`Y[[]ĩ%vR%Lr(.[*ݍL,)1.U`}wNcYNy/X^\뗫<颈rE~U5q//܈N`zRtFJ9J Fkh2::z:K`c^A៯^&35K-QJ?=ZVwA>Xˇ_E1F6Nj"zVDR !i4טJv?;Ab~wRVY[570jf(jSu11=VB[J)l@W##ި ;S/wǼs59 i9ˍR? u4KsB:5:5]D=1:/WkЛ"iӢ_N(-֙п+@BA sZ2d?5qa"lWvD\]MIZB+,J]k1٘l:=鏲 ʵO 蠱GړB/JڭQw &ZBhHKrOLM)O RI>LW>ٛH9R 7P O13<&jwAԚgΐlš@{R"ZVMDX8X"2Iz[/BKTo,0D-Ep.[dc8[쳰r^bZm`,,# xiM~dR䎶?v(,<` !-Y:G\:0~8 ьI!yH؃l!)r'RM:`'1 1:D&)JM0Pe ҌO)Dz%M Y›͝Qv msa.9^ \:]A!\暒 z;@ Sꀫ*fC!P=WSIc'R1yHloMܘ~gP4tgFѕ:6z9 U -M7Eu@Md )71 4erN ҋ/_H{XnZݟ[ӱG39dzjJ(q0 0"PBY?z ј":@,ʢHC{S>:|딅07FA:/L=i&ZVc+!t3pۯ 'Je"k'ֈG^mll)M@4t|pz l w5BS7-LӾJ!6mM=T9_w|M7{Ṟ8 :byU}d@4xMWɧ:iݓ-׬w~1P~`&V~W6AlHx_Yaq%/Ȗ YY"L'vD~CjcȞTd_ swS7IpPL7JgttTCh56,e l計h"fSqTϳe??wV9?WሒHϖ,vj&0;_:%pfgZqޡ,=WN]?j]fō jo~/:ws H7,Kqܡ\qȆtPQYʲ ;$ 9;C )Ϗ"sq|rB_h2@fII,ɛf|n8T v+Ç1s ]Vc5=S|-U =if/(y{\~17SC̏w,Gc9™ Ȁݩ`'qe8-]R{P.Ȩq|rN2 `"pX[γi?<2GW50粕Kݵwg:>"!}a8} j[ htKP;QY/xDPQuȑReFNORJޝuM;}?퓭P A5/.?şJ#hXU~%wh@ZfTo%;.~tĖN$Mt@8F{IK̡#jv7y0[2p* ܽ~dக~I!P d'aafB^B (ݥ+E>g'90د~&u'W9No/'l|D̫qo*yRq*DM8\4 aܙ8Ol[|lc3?ѨK>?f嫊tX!ۘ 47=JR=F~KFQ&4wO$rIo=aU>^ҽgBk~ k4ޮЅi0ʬF7 YMӍ6W[!նBy N44mقysz;>IȐxފ|}ol톿Ƙ;U92TwDx/ʩ ;aI;Ķq8rL N3{tU8hhM'iO+Nv:3;O~Uw yFK'yФʍlՀ:&7٦Sm2!:}r!L+`#3E*1*IaSCvI"O_9VNY@Q+9`<=nMq+'_py3z\UIhn= cW7|ĺD>#LܱQjZٲMD;߂ ~90L! lf<11n68d8tsʯu*snƸ mtyYaI/nL1Y*5b"xl.ͧ4o_y{fZJvZ"vʏHIb-% X*hbV9P_uрQSW1}O= [ʏu3 4ɣ2(>uWvN-A gER#_*z=!<19䀵}Itb))RΛ;w~BU48=ID3"+nsd@a=swB k fA tӉ'OW6w3*_cKs)S6=gO`N5kIFG+l\FIB PB:sm8UO-%kZI^4>5~YsC^2۔ .19~,Y fhvh$l8K5ڎtةaW;WC{3{ I;]mC`3/򐚡^l>tЮ۷9OD8šCs9D뫌L@CIb"^)wqsxowRwNHBk N#6gN&!$'%\o ',8fTބd*!Yww$u2WzCMabEg>"jrE<5/ͷ4ߔgJSjB-k%[;䑾.{u_%nosέ=-,L"j]+Si=Aђݩmzlҿ*{UiPIMÖͺ)Ο7U7)m9e9燨4eMe(;Gi{9LwXc|[|Qї}YW}i>o}Zos8+]BيXQ.͓zV}@}~gLu*-S!jQڟc^pSA}wXI%N *^;Ó}5t1!zA!~s7J s1`sR3eAAKٿU ]imtP&129)LP}У: AI̻|2}c*|>_nPۜ6*S,ʴo' C&kQ*ŰvI9ikjCZٗH8.u|5W6cN:MW0V~no"Y5/ҭYb4zOqL'Casf{YL֥PIYTwI"+mCc*Qm}mLXØńZe Tk)iZs/ RtܚƄc'X0h9-;)mN+PLJJBl,Y1+Co K+Q2[e[AWI%VjZ,/d_񂖹zVVD,eNEԧk,Qӥ%&Xf?ݲXIf-;e'LWW9kiexsdr<&cf(o 45'3T.H#c8[>?֐ "ގ[!^pendstream endobj 175 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1267 >> stream x}}LSWke)vF')#J!*Z@Q5hRB iGn1:@DuF8HƜј{#ql뜓79}P`(JNIY1tȏC?Qix$T_!}$)d"h*4t夌ٳgMQFEDV8>CTk-:Πe1CY T:4g45Ys'OQZ2̛Le1ע\5p7xo8T`J13"FMma! JB+P,ZQ8J@h1JDKD"5ډQ ŀtJ[D&xU?Weōb%ZN+oO^1z/_Dzcib\H$=BIJC] DLOzcAR̦/i~A}qژx20 ay)~u? sƢ3|X A0 0gUu銺 ;"d{'[UhGnWʟ_(PǏaaS-"f-J`Ldh:S$ٚF 0'N>h=yyŕ,<JMQk-pPoovz7މ?`ܖ[p+ըJl [UQUϭ~+,V0i0-oⴜ}MeOV!,ό/ɪOK;)U1O^2\%Ɨ/.2"̫/O6ok܃S[ Kx /` ~zYd:N>%(v{kX,[u{ i.xN!n8+ܟȒa YOǒ¶ o%>5C& &Qʿǒ$><~?5G pAϺ CEZ0 iG>ܙݺ@{@ ֚@&NN1+OmXŋ;.xߵ.,~f `7\bfAλMF(5d!7ڣ3 ؼLyżReoa.{@&z*6%'/a0x \i>s9gzJ9_^j=3GcʂFsNlM}W$Mf/lĐ > stream x]K$q/>,}kߺmN) :H(0H\@(A}ͮŝpZzGDfUFde a٬g i[؜]7+k͔7s ?x7ﰾ=t1oI@_)ts؟^ͿkJb Suie)e) s1v npONlB} 7*_9=&$r0WalY+ڜ S0e(;f#<Eg ]Q]{K.:8Y'LBj:종7YM+brH2):z;Y<⻶5x>=RW+rt;EcwWO VGy_K#V Ỳa0kM b ب  aɛ,IO@^`N5þiOeri- k4Rp~!z΁8F C M4p:6 ̧ f^& M:v;Ӝ|hW!Dyq-N[]XV D#i'S!G"]KMZ[Ysu1̸s}J0H1ɚ"S2')Le2˕wp-23P W<ߴ) w(c lj{2 `{(f $HL^| 'ҧ8ER{9TKIZG_B~:!JN.p*{O<.coil O@'~e]Ň!iK G@Z:7n1F>}'łok19g&mv 7h4} Ⱦ 9"r- =3K 0c\Q4tq3) RYWaki>tTNd}Dk".ȧuЍ{k_``sL9%HK{iR&5Lŧ M㑺d1t 9[ Ǚ3tꪱĖ좒4o?L0 ,=ULy,J`ゃqQU/ӵ8'P(+-)qgs׋ O {B^=WzJwZڞ&5p/ńUC.lcΫ\v=e<.8җ ӽh|}> 25K !b(e"%U$qm>)Ex 2:k/Uq+XjIrPbDXƻjyB RhK"W9>!Q+PWDv}(ڷ.x3"G9 =pXT?-b*% Sg $bL4 };-?:-@"D~yn1F}xQ!)6?Ej&H8S=h''>;N Ӷ*oC,8J2Ńcެ7NΚ!zÊzGz?k61؟vn@]:mQ#= 45(#ٟv~efK Ek0$t^N͈+ gn<ȵBfJ~8UVIr#H ??4)B&X>V) tWl\σvڣGar 'L/ઃ4. r*,u#vQp>jk&#CG A] #vp-ߣٽ 4'#E1`ßaDRM&]a}cs 9u 0dY"bS-6q3fħz&/(lB?c P_cg˕FFջmӡWSv= Fwz؀m?| ׂ5O.,f+^mOiPE1n03;H΃E\h *G܃t^?{9Ԙ l͉N]~T%`YWlb#GzP+ +5G8: xX> DA%ŗDs3X4jj.ʂ9ˍ5/JZ͋KQ[a,F*#$ONo׊c_\<6p'oݱK5Kj*bJx`vJszsPA`YX 2eЉ"NE:a{ heG#N~ysx`ı/v,8  vAUaԟz @=`%:@D<jrY7z9he 푃OxN>onaD`*MquBwAɸ7O.]ҵw.bSd@_#yzﱝu h<4 XѓF Dz \eP;C@+Ĉ+yxol#RBkN!` upp)$sY*sfʱo(Gk~`#h%TbxPK]1 6I7 QO'ɞیЩUf Ei-K$mDsą@w=k6z.fܱY #Jz Cqvz[W?`ɡq>!zsH vT]>tҦ\mZovןM9D8xoMN&9$Mql Rv.[*K J{ObAt i=*Gp/mt l!bud PAe]C*0b(ĀfÀ^aI1Ǭ%3ඝ%xLkR<4hJ5(m7ZlwFƛXDDA/]~ +J4CoQ@Zi41L*4<>ֳ- .|"Tr7p!S&y4 z-t|+߳$"e"OݪE90 Ju՞ŋیg vY-]L&gv6a00'rP]Llz]@UX0m6R6]xr4;@S[/ۼXgljW6%ޖM^FJ؝ Vf ?"{vQӦiנwJN-F >*&(d!>-Z/׷3YnY"S=% }"eF(%/,w>zi*|c0_`8n.j1,Bhl?ooq]6`]r "9h-0w(GIäCx.{0cޑԠ7aキBp(1ũ_6Mh W]2)DZHj2-y vnZvΒΘ1Koib(4~.O:,>~#x&4O>e(2>F @hy y(u?j3Q\$dqe # ON j=:, & 8M]|MfJo.H[|=3kҤ~ڞ2)ܩP艤D2Gn@h͙) /-jŧ.SsZ"=yOr:3MyTπ*gRM F*4kD4/*nKq<ܻP5ήP>{u᷇sz?^&6ZC&:YղxS@Iẋl/]4TGF/YK8HB4LzXaJ`w*?lv,77ʏZ~p6\aLld"@c>Mǒ9ZØT"1BI ![ YAQ)S5 WrH\L[{'QrV^9R0ȱC+BRC*O$A$,:cR=0|*yF-Z(qKCn|¸˒TƟ(`'= hOwE#w q/J@,>稴TNwH+ Һ0&Nowy p6mu#/ìG X,saX6ljٽڇgWG4J] cJgso.fAvF`_g4Lfli!2*Rbt<.th& `חa@& -]b(Q1"VE83' ̜|7,3Ǵ9NEIz;.nO-QҠ$K\>0Q]UPVI}~oKL˙i7%l/3^TG,oɮ4_ m>MeE$R ,A}ڀuǬTV¬ItϬTWT:Ozoc ־we룱v$wߔ ]-ӆ!BF(k ԑuCX3lW(LC,b;ǍrYs(M*\jE3(7HUdQ'Z_ȀLUh?( a`6/|AqN33BU-T, ,Hp<0p][8Ud͐٧aj3XT%Js] .x0N*mwх2"a!Y$H@3{b2}%\>ZpTPiH`QsjdmHV{xEs ?roƺ?i;n" v .i;_v*#9i+-PX 뷥DAzjBRUU)EXM9{rxW_o~ƞ;KfN8D< %A7{.fa?Ap\̔`t}~x!hٛUXiΘm{;X'0{ZfA;ڈ:#)$DkVdR.< ΈDysڐP$P`1“Cjx%14wE. "Š.ߔ1km9jm* -C 9S2]v]Fviwd>N&+eVWK{I@(TH-M|:yA9kiVaJh%6Zo:\#ช\q͝@a-X9XG9UFiq*#mTn2}6^y )X\C/6~sAH`߷;­e7t fvB\`f-w%8lSZ ;FQd­' G>=D3Ь7S.`FH{T/$E% B:pKeۭ2iB|92+NzJy,,o^&6?%xB"=ѧZ 8_דW7,N6oH3hl_Zφ]|WJD^Uwc#xGG<]. ͷ~{25pƒ?j9?0'`˅:힓eM9c T4]cL~jl!"ߕuqF?dAI[06y}/n9ɸDȅ/ܙpYP~,aVAtsYj= c l{l"؝}kEG~2n"_\H%%yj1|DF0w0ZD*k"(O.K4$P3: be kPWZF tvC)ozcb*",Mvr (ߥ)eQ}zq4 s-QuXJhbl|+*<7a[ p~ںx^YcyXq z#vK?<_5w6endstream endobj 177 0 obj << /Filter /FlateDecode /Length 5563 >> stream x\ߓqEON~ooR'2j[wDk3h`1{$8* G=4{t~{;LĿ\:)zX'c8,*Υѣ7eΟ:fb3S ˋiB8hJ1)뇻Rj4A"XFz(G[\cޡ:H?hFFw|044IN⿞6fuhOsgF[KO㒝r> ia%kb@)ӣκkm\|/lt+iKSW1az@A&Y& I Y"⃰ ՠE T'y!gdM`eP T}t $RY}ʛ 9ggIV"6^,^=%ز9Cا`b(KbT`d23ѿ %а\R O l9Ra26yD``(5eͤt h5}wK`!Q))[!NiusR 0a6oE袰(S": x7#z? 2+`DW>{6}R8p7c"_PN\u?Bvc[H1pҼ/͇ϻJ9=m bPJh~@WpD<+eY7]a1 Q*JǑxF }Pѝ:{рe '5q(;8xar1)'yn-b!(XSBއgq8"3| QF[O ~]Z$We]Kp3ؾYDtBv˞=SkEqpuYRRnU_)Y_eOݺpÓ Ѿ7y< 6 Htx-d^ߌ*",Ieۖԛ B'woKđuY- zXV'us^qqh@V!1//P(a^c3 iw6zrqh& ,3zm`%'35kY6bt ;a4]q;0 X78@S >$ݴ R+&Ue\v)0f?Ru$F6xg^<.ia3n]|O"xUd[hCʸI \MzH 1NÜ@*Kww券Do4D~ b|ZT^/@ $e٨A$:8m<ň4%rdz;JDjJOC$vcm FA2 .hibؾ.n5٢oNMP!*cy^zB79S͋vfig"U72Ɲm۞v e#uQӬaߤ` 4NA$ݔ 1dt℠E ]Dfx˃gPpY9S5$r). 3 ̙*KRR+ķ7o;*kaDjp-=[ntY epExRҏp-::_DqQhBaWvŜh쪟sot % ݲ]=x^7M=Q+Q7PIa]L_Bt^׻Qa|&@liu4&P*qmGF!ۑETܩ7qAtIz]zE"ˍF5T) 'bRpAu60KE]jg}W\.5"*sY#s'0VGo|‡(Ғ*cslY]flkml+XR6݅N#9sB8{%T+"6QjxNFZt̊ӰCPAFq^\iȶ)(6Ke8X%PF6~䧛_n&m`^)Bd:Ps ʆS1}p2\T?_@9d4Q2 DZJ򏔕ã5Gmy]#/ Z[ TMNWH>u ^Z"o[ͤbxl5nl`8 iBl{"yd*0бy]#P5Vl8/4N׳la=#S\ʝ1iRAL_M7_;wx % ?z6i ^RY(e=_fl6+UOS!W?nF_ ͓#|_u3`$:/û dw6F) HWsY9Ö tQ$]+e'PORҡ }e%|Gwv'z`?fw~jJ]oAM]b₪jjsRq#z˞T HrznQohξ(.s ,nqcN[]vnK ijݳ}P51O@J0HUXyJS .D?,P b`(|꫈aOETO{frf; .@[)c)gbϓPU -,劗X5@m 1V\Nse>KT /(Kiд!Y0cI ܷŵuO,E8TkRo4D6@n50?UL%%@3^۰OtŔ@R_:˝^9D+F"깊뢮_%ź_LJo d,#VUKVPS` p(CE?XM85ܤ=9%RGǛK{aʮ N"Ի<)/E،.& nlt+?c/KXZbF(Smy" d"+چXk!:d41:.ӣS1>T/e&q!^TRCENGL [8@C.?6 $x+K(J= ͔B-Mv̿|+!䦄Jʊ{{/!ѕ,^ nQ|U']3ݧq1i")-dQyQo??>]hT2R:Hw 6𠱈`79k.ME %hD]h Q|;Xų5Ytg<Ŕ*dW>ٖr<2~9udn f>Zn>_ZYI2ͷqqX7_3YΠ*L+ug16r FZ+|)k+)gZR^T'4|f_SyM!iCZ(QyTvJc,̼9RH簚D"殌ѷAwY>Js6s91p̵^fg5svTci>n/noVendstream endobj 178 0 obj << /Filter /FlateDecode /Length 3835 >> stream x[r<v&kq(lEHb2֡p")Fz*Yh9 *[F߳듿~o;Do7秴MU֛7'SIz}.lO5k}oLWݷ[ۜvzsJgϮMѣV6V؜]jI;|zS{7J_N цNGS*EiЋ9en 9Cwx3Y'pd_luzzqI;oa^G5=1OimY,nV(avsϓӿ*CSA10s FDXXFQ^+T+>ƌe 풑EZuw5s 8tT+"¨ζLrH+omJFƄ>(­ * ]L!Y:5*=|_ix y0SaoSMQ!X:$exe6H:F4~Gk%}>f\P;/@ U)uC b]PGJݤT&F o{AɪE+&GfB)K]O*\2LӓNJ7*,é "S ME%lzQxA gD9`HAv7題cEk{Sl ddT,̉,8r#R|FZ"Mx`)c#57,ٝޔ9 Sp w(+ R}QB-ٱ7_7 O5ͳ}ta oZZGzc'hE]!h95>{mf>ۜ;96Hp3p7D[ᇜz7x 4:aՙZT_0IJR%3LCx`?Yv MCs 8t8'9D$xVȏ)yVau&U.ilՐfG4 Zr3eYYeƁaB~끡 \5faMQ m3 TK=~HqeRw3e?%VSs $$+YOHE(Łynlb 6SS[qu7E)YNy8fmw碲E:RRJ&SQ2˔lʐbgut{ <777_= E6z1t7Q_xlWCȕnrA8*yuޏ<z;ûU*ٯ*;O%Eeւʸ)1*S'h0spc.籿oX~4[[;SRZP!g=GdiZ1Z2FtrG M,$J#[  s?ڝ3iQEZEL鸴[# _)tIj89JiTfE`&xYNo~~"=(39H&kGdM/F{;;>t h-$3#_ 92Xn1Clްs ~{ۼ`.36H!C"EXD8)4rdiqؾbuBԱ=?gr:) w2wP jgS+۸]٤m(e ety?vXF,FJF@Z>ply5)dI;yޒvTDžL1đ7O\ Go3>RA%`?L>sX#Y6wSf_+&QՋB@F+dQvWsTNTL*xF}TPy!kAVMP"XTQp,_+Y g3a3yF&-sbi4EQ4{'lFemS&f az sǃTR>r':vh(~1"IāxۨoysxևƚYr9ӍƏYW2eTNC"A>1x_ty-`_FWʘ09n1yX5d:~^DJխ}Q\4#Om&,ܠm{-˩Q25LW!ȥ4\L!Etm- 70dgzQMwy1KDo0ݸXF*jE{ÙO4@ G"D,]D!7h>0BE?68D"ޜ]mjyu!|kt4B hhº˵ 2Վo/fO *K#=o#4pqƧaf%xnLq`"N `á +pxW͚4%9jUD^V·С 1oljXfzw"3E*¹ pk|7(:Fw9_tp Coʬ25Z#&eNEl 3}/T#QX$2^VMZjB(w] UM+`2Ϙ8Vp{&:J5c |bW/Ctz]d?f>bSf0ʷ3q yڳ=5)|9²Еd` 1U!:[] mnTQ,\AQׯp"4|C:)zG v}ӎ!ίisgqf8+Ѵ0(y=? 2Eկsks>5*+5g(]Φ:2Nǵdl~KXr#k߉Ysz< u6aXLbw :Ğ뵈γa! uFE9/(l̖;l|endstream endobj 179 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3933 >> stream xWyTgBEӚPuԵ[ݨjM@@M5$$oVHI$@*J]k).,RVm׾zϹRŞw~oygXXbLغq۶q/gX"TB_c=DAd/> ,V^v0D3%}j ͈y!.nAr~('=MOg*L/(;??wYEEEiBQ֒3brc3f 33b13c}J!? ?S  0 *)Iܛ4~ -2u3cgŕưMfl mŶa۱WNl%: [^bxl=6Kƞx{{pl$EbcX6vcci Xf>ab]1oe@~vgxǢWGf#3#?qWFEq2|QG={tcѳo`ѱl:,@p%y`u77Zɕ VP˯ h F`YMW)e^ n::_Nj:BL(qC񘬇hi?~_O -;m6r roH ^8 ځa=bnzpғ(d\Oz\ƈIs hru~a3By6m~T%Kgq=7ɵb2˿P*.[)FpeFS-,eX"B2CU*ڝuʪf?ei1XZW1wA!DrԟAKIk $75h̼OU^ B,JUG]_HVki[#=gT^ ,T*G[UW"e5: MC 맸nНeLnC6:*n9m v4MGs8?*8 {0Eq D3`yni9DG!&¹qQ'hQs@$gy@:O!ݳqNTZqJp//O߿w{.SZu1;=&+n9mj(_v-gAַ{PW좤 Vn f/lg0­D |XơL78_/µjq9gWqtHt}}PtzC3{c##kzᖣ׀)js9:y,|0 BZinaR7yX/\dC~eˆ oMDmwU>jqL5[[\+HOSwSy~? 8_i*pЕ?'I૯oO3_`fN"1b7Ko/)a˦W(&}|z,`J\p K 8V`vg 况9xDG8o@~[Du e{{;D+(yP2|7[o42MH)ɅW(K27ZA >V|#{A: iN}hދ: L_&}BQJ]v}G; Zx{-c0s_^ar3a {ET/5{*B6z2?x(|iMDRP|mn-knUC 1+Z?eL LKQxRFaJA*474T`_m^s&Ay@щRD+QQESuT^Ƞp]1P[Ar-8ńL- Ʒ*`09<ʘG9fx{"lr:@/r;ʧO nz^W_mӷڑݮnhku+ O]?817ES'0)gIb5Yp#4==uK W#Ư3?~awf[' _;ɔ+/v>[^_Қ ZW'CÆ`2ژI"Nс&m&a>L d 7CO"P}iYLzaA|dΆ.8quTf2Ф%gAk;H4xa8?(F'c$ H w,EtJ=nK iWR#VUe$ҊJ9PRh`*f{jJB3|T9l +xjꂙ$v9X_⨨TSЎ֡A\%-%OYmd AlpVXeo_o;!>i5*wT Q ZY/Ɠ-7Z_E u9j&I|{tS@pBZr(_ԡ`xIv"zJQ(;AX#VWJTrEo^M\V%hljqQԪQR?nF[d*{`$aTOµR&)jUPb! .Ѹ702 j=nUa&wg.gݤl xn#`0Sȫz jA4+هfQO,YZ`‘0 lx@_%Tb(eE0_MNڟ/l2)x/lcNDZ aHe.{X0hGBj 6NMuA^7NA 7eYFlr*,z VXC3(s !sr|_7x{ȯgC7",J`JJY+eZuU5R*c^['Hlx'q=|>ĺ˜tΙŢI_thtʷ eīvsN$PhPM"aM[%]-TيmGca첛Y7IP3:N;8$nέ^u Xӣ01AS*+* )%-_ uL[Σ_\Ό-_rGɫ6Z梒#{#ȑa%p 0pendstream endobj 180 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 473 >> stream x1CMR6$v-  >ZUQmqCopyright (c) 1997, 2009 American Mathematical Society (), with Reserved Font Name CMR6.CMR6Computer Modern31vR%I[Bp$^sjpmza(S(S ڥˋ- 2U9`up拔s8Tl+'yp|{mIK%gd͋ǧj~$`dًËËً‡ #`$vCoa  7 ޜ bendstream endobj 181 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2723 >> stream xV PSW1{qgVQkTP|*>@IHDIDB7@EQj]-Xa]Z=^K[gv9L==~5xׅ~;au4I&OV( ack7l# b5,[EbQrl`i=yay:110~e `A+gKOM{*gOOc}s11b]85TE>ә WoybwzXA):I8 զ^).<4`rhCUVoP"L {+K[DlhE~LɄмB$ |gSx6t䏄w"ձ1fڷ:M G_ɎJ4 (n4ʃtBm˱--qK$(qh|A$Py;*XO3xhi>, By^PFc~~QAQ ;qҘ4{ȭh/<zACCNERbT Jle0 "v<Uefs!jYeuiig|P\הa%XRV |2AQ55pdB_{0uUf b*n'b 47fox:ڈ/QdCj\_̈B2lʈ]g)o a"6ht˛u ؛ayMvQzDp?Faķ(KYQKo܊}\4~͒'42cBJt]ܺiƪ6i]+iu]:\q +dY}]\e28iPבtdkf -TrMu&Qdy3KvBjyƛ@QSC' rS#zz(c*9r:0WZ=vcce-Mi )M60s@RU>ﲾQt_yd5mVB[`.^|E5P ·u& `$zǏCJFRar ηM8ZM.u\gҙ;HJǡI.<Š=YelmdoIT6MDm4;yh].i:vb6%#$:.҃AƜ"J>-gt4ډF 'B v?7LfH?d/ A߾~2 hFNL~R9H]"A&Ba682}&&vE$)հ53ssgM)N6øٌL?a{WJ(-_N<Iȗl0Tf%pOhLL2DYXW/t±&i.0A,eq,|7xDŽ8O1/oD= agpP 3lӐyh?P\PXb%wVoҺw07( Obf~Q" Cޗ^E7=ǻ**%Ν5DZ]6t.=(_2]7U5&^h]> @Q$˵W.}֣rk;UPl((lB ^cR29nHbmfDԢuhT!] IxoxC`G;I7`&8XR˲^YKk˫{%d|dql7:!Z-uߴ`⸗8ghI5[; Q4a\5Ph:/}%A*f N"..m?n+ҷE»v%QjRSWKcc {9 >Z[u 8hy2<9_F_ψJ\[?(Σ U[$My'̓XBx2EC.mZr/P3z@)|B o׾!fknMMu6eVTS o*0Nn/Ɏdĉڊ4G4Tr$l((`=J3܌aܩ;(;U*VkNI7Fza<Ms c%a'QR̙(.+> stream xmHK2qTLD FX4BZM6onNE˹Y9R"*HoEAw Z~yx/{PD(ZТT^j*#(4?&!NDZS:r%E-ak8P_M) D=ABf4^䂎PQ=Z%*iX[k6kzc E7UUf-!F&{ C$V-`bHPR$= hLuA3HD1>l`L NBDW#_?=u쩓W\Y fk?aAOjx˟ "!/ÑՍī58p2+"r@.}skF|0n80Gϑ΅p)T)-Bwd;edn׏%1ۄᅲ&rK|G.5e9*] bH\Ȅ%?,endstream endobj 183 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 378 >> stream xcd`ab`ddds T~H3a!]+Tnn߿ }=^19(3=DA#YS\GR17(391O7$#57QOL-Tа())///K-/JQ(,PJ-N-*KMQp+QKMUML:)槤%嗃]Ű%G߯|]n>+Esnਝ=y}r˾s]q}ݓmnچſ%sd*.+=Wdci4| ʻARTB2طqmbK6yx0endstream endobj 184 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 423 >> stream xcd`ab`ddd v541U~H3a!]3#k7s7ˊB߃``fd/r/,L(QHT04Q020TpM-LNSM,HM,rr3SK*4l2JJ s4u3K2RSRSJsS nӃP9E ~ L,tLXйuBY6p$.\s?5a͕] U]Օg;{Z9~ı %tϞ#${)3wpL3{nMwo5ʪwM.}:3;K%;U(c^zZqqqzwoTlߟf+q웹6sq\7y ˤendstream endobj 185 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceGray /DecodeParms << /Columns 800 /Predictor 15 >> /Filter /FlateDecode /Height 800 /Subtype /Image /Width 800 /Length 1926 >> stream x0?M@?2M@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  A A@  _ .endstream endobj 186 0 obj << /BitsPerComponent 8 /ColorSpace /DeviceRGB /Filter /DCTDecode /Height 800 /SMask 185 0 R /Subtype /Image /Width 800 /Length 54790 >> stream AdobedC    %,'..+'+*17F;14B4*+=S>BHJNON/;V\UL[FMNKC $$K2+2KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKK  " }!1AQa"q2#BR$3br %&'()*456789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz w!1AQaq"2B #3Rbr $4%&'()*56789:CDEFGHIJSTUVWXYZcdefghijstuvwxyz ?Z( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( ( (4 3qƥ(I5tdDqk,hvP皽{kֳb 6ljVQ] $H_ ? ܢ$ڐvV̀L a^Y(FxWO֏Z _׮Ձ_x4W:߯ANO/.i_~k~m^=Y ;__z?_xggnk~m^=Y׽m^}~W׽m^Vm~gz߯u[oף:eEx,wdkG}~WčusoK ]Y}wx)3!z5[߯??a3($zR?o~gP+ɿ`޷TuA~ϯ}C((5A~G~~+uz__߃R{~K/Q}Q^XVWkQ![?![QЙQEw(((((((=h/p+T-(VbRӱWRRv) )E%8ShZQIJ)ش8RAJ)ش8RANhH)‹?S PJdu^EJ0t5Vmp hph ,ož)9pMR0SCGLGbJ) g#d6ө+E 44"4u!i iS+C)T\HEb7q) }֐Yd5q9@ޗ &8W✫@8Oz-$E!( J" ԀSj@  N P"0 ZP-#KK"KFW06hEY6(E̙M1Z6s&CmLVm;M1ZB\ͲRRL"FE0Ԇj aM40!\iOoЅq&o_B EWyAEPEPEPEPEPEPEPtQE}%G~H{Q[$ )EUu4RKIJ)ؤMJ)(cD pS3z&8R$Sx;R(ޜ*m}͢)š)†tx h tDx`tDx `tDxAdƁJk9 b'J0є; azJ}4 p sI %5"ijZwWl1H{{Sw=R/oJPsK]÷2 jPS+HGaө$h%%-!i!Hii+E IKHH$2)"8/t$pyC5$i>j fF:TַCQF椁o.AA0!HzHR5pSY# N Rr9C K!KKa" lѶ16i69[ Fڛi>c&6mJӹdiT*&!&D6DE0Ԇj#4Ʃ 0ֈW#4RaDaWoЅqF_BGC[EWyaEPEPEPEPEPEPEPtRW_ Z(REZ@QEZBRQVMŦ:)SH pRH hpaoNE 0)8T[hMC6ON =7Cz5~I9_)i$_lw&LM)˜)⡝)˜)⡝))¥)ƚ)fΈ%6}>6U^EWF 㓜b3Y ;խjϧU\aב\S|-󻭿?/R+##&9JR5S/Ijߥ!_sIc|Y+W<\s4%~ҿJ)HTSH5`ҚWXIW0W` l**piƸޣI@V(JxJ/ҞX9L%8%LN r9B%LKSsHe*}J]J\<_e*ϥ~$)6UJBJ|-~~+0TL*3lF3 j"aQ+DKd-L5#SD܍3RFkDMa!+~VWkY![?!]>48OK+5 ( ( ( ( ( ( (>g1R#/~/wԊ1Et$0Z()h!8SiEZAqœ))!…I')n"֜ YFci~ZxZͳxȋo֠,̰FHwrTd& 1$~5QAJWPƁaT` ]6M&U$F(kc blr5cmD*hSЊ Qi6i <\%i ikL"ҵ9ZiZJDijrҵjEIB1X<{wU>EVf ʒ}_Sd%.i~ JxJD U~Jzc&d0/֡|(gY,0 A"1R*j P='~uR|WN U*@O.ϭXu4_g֍Z9>l՟..c 2O&ϭZ1qO\Tn*Êhev BµFmD¦aQ5j"aQJ Hƭ7"jaXTfBy+5|,p2EwsRI>G$+PL+7 ( ( ( ( ( ( (>lQS|z?}=YZTSJLJR"ˊmjREhRդEBu4PpFަN#4MRNNG pp6Oȕ &"52 *5+"HqҜME+=zu'i\+;Ԋ*Ԋ6R"jEfB*Ԋk6!j@*ԁk6ͣ"I;j+,|8_jn2ȶѶFLb-r9.64ƐXTg!Ztȃ:b:Ju *FAy 2eijbkFDijrҵ" W _<=I V,~# qs7`堋¤ qO O XH88SV23r#T8?))ꕄ܆*T=Jz=R3r)\'sz~_T8Ŭ>[7ES1c5s+6=ST)"rəC~ߥ;*eJGXXR+y~ߥ_VW֧*y^ߥ_[1lHR*B⬸VfYBH*Y]B¬0XVɲDD6B£j&&L*2*VڴBTmR7&4/ipȱXQF6x_S$J#%V=MN dcv +y\?a\aoo?+zE~TQEz'HQEQEQEQEQEQU5[ѦW5k`3j_i`@ت2Y]<˩"HQd/+E|)HB?sSQ#$y2z,RR]W""V+HVBVRINũyb.l8gG1[>l>cg.oҟ1jEmP01Ն@x ><(Q~jHFjdZELJ(TSTT+LrE"Ed٢cT)*UfQ"U`]SOJL0Eh0bFN{bؽ͸Y E*H⦷\g$w4ه*F~s}K(@Ԫ)jEZM&*E"HlHT1q(RI?UZw]^)ӛbD!GUe<FA͹XW#銴mg#[UiV s5.ڑWRFAMlјeF-\v+n%(L8>zogKpG/QT $OҬmy ;J]~S Oma" ⴱ9yfFM6HV-JJikEHܨ%ʔ)f;F ⱐss5Ŝ+OoҞnrw+"H 0Tv5`%Vsw@`}קY3D1`3c%ϟK$Vi5f!Yn S5ct럥XX7 aXKϱ *m\*׿ I,3;02Oz~UaS q\v3r+h:{9@UZɖ3v[.l-Qp vp*[7R"l"b$TC;"S)'j~,Vcjߥs݊eO!aI6\e"OnFj* x622߼U{;m4AnI(?缟s:=Fݻ\w~y$ÞB|">'(w:u*'oQƐ+>LEa!OT6Yv'\Gs eqTÃZ5Rp:[%1#h$~bmBTL2N;xJ,c)e?C~ڦY$eC bH_̕xAڕwMrڥjT.bQJVw"jVڴC Zv? ?+y\?a\qn+DoA(3 ( ( ( ( ( ( (<EU&(ʤ}'G~HGM.6Bd܋mj]m.4ȱFڗmhimmKm+6Իi *RqC-1~؂`&v;Z.w1*UKk4d= ?uR,LX@~Q;1Anjż"NI'ԓY)lh2"j*QHQY6hygLeeL`ORz dp$lxA>f&M α8$3}NQ#mO_ҙc)"Dvȣ}GWVwd1Yđd31u#Q*ƿjꊂT^n>`m ؚ{H.vч+COG<7(ySջ~FE+W%#VUS3Ҵ *=(B#@=O:NPy0zQX=HlJFI=\!#nϨ3HN`#j[_L"C&ÃB=JV}w P}kv(|'xmH{.8r3R y8eBU#' (KK\ qc!X"yw%\Ґ~_i" `JilW'F+>~ZmŬW1r *}AjXY&E'WF2M<4W щq,NĤO๕J 8up}Emf#qB=i/mpsq2zoSѿR,iikBr3򤻶7,? U/=lr?}lscC5r1x 8l}qX]L~ _2h.A0Mu(U=r#,1DG?!Z(lbqq5cd_xveHzG9fJ<+,g( - ڠj j$s8jT>bڥjd>bڥjDRdMQJVa FkD4v? +w\?a\n+DtaQEzgQEQEQEQEQEQEQExUC\Ticʧ_aI_>zod[hRmt&MȶѶFwd[ivԛiȱYE^I䖬&ډPPuU> s1ڿCL*(TPv{hhEa}D? z[Fp\m[g.cՍQpgv}8L@J.FGCJ1il8l86ӂOoҗgRK20?*P)sZh#rA8)iW*CK| ^25I٢d*Jދ5fxȍaHPyImy pG2Šs2H $UKh@q=ԖhhJ\dz{N} '4<uPW>3Vi9T3Dʷh`qy'`*:u~<:R Gz@8V%-TV-ٖ5DFu7Qc ZkCY=L*~rf,O!U$N?*cKh2H%3Nufc7zH0z_B_D,ҷqߗӚPc/ia3cxsWRP{eNm'T;Pؙcбn9re!T (4˥J;m]f1HR[5|s"3ԱΆ衆Sz%1 bq At8j Gy T$2IVy&Ide0kͩ ݹFhޥ*6yգ(OrG?XmRqY1|2i-z}jO7S#nzxm19bOjfY2ֳfmRZԞ8eLb8Ƿ*k+db2VT<[Dƣ$>З+4򳴱$qs7?3O0<ӳ2=6IkW0>:VЎc%[s" h[ rDs.qQmh)g&IHr })q E&vX;S41rƘMWu?=tkJG-15!54in&44k9X Z?~{J Iܱss{pzsTگz=GHfJ4"@>Rim_VsEu86ʛ Ӟw0E`)?{r)RBUV''z@TQjLF¥aQi5F+ hLԤSi>V¹+i![ wz5Q^Q@Q@Q@Q@Q@Q@Q@#b?Э*o\UԟE#ȱKF܏mU|5Lu.v-j0GjHXy&T T`i-+"KKLm.ڗm.W-2 r9 KLA,v)%)YOe,; Ra~~(_(Z\ŦG/ҥJK20JPJ/֔/֧2>ѿp6cn{gL@߼)_֦ d`T8ӂ֥,E8<"8!GJ$YK#8]s犴A_/ßcWx{UR$1:vQ<2v4LU/ JLࠍOV.m% GUB* [ "tNnAa9"$gGczX"qJЌUK ,PmWOoq~#hD"+FB+r41dPROvy?/۝= ?B?+6-= f-&8ـ R:)>WX!\5Wu1e(GPXd Wo@>c[#([ rp{X$$5ڈTt # E!,2з(m6˙0{ :5U/򥉦LȟZ7#} LƯSчzI'IScqT K$0;~oG r]+:LjC,O0O&\cU}L79NarI'{[oHIb3I9'z͊wS- +#>8,&l bHU d#U%Ol^; >PU US'ۭdr*LccqJ=eWү$43* 2ҫ]\r"$ zz𩴯&KgLFUP9<沖\N_F*$re+ʜgV-gu{I Ѥ)a1VֈȹjaO&X$c.2K(?Vսco4r8m}*uK&q*D arh59na"I}-ĒiVr7%ُE3FXV.ťfR\ 緦*9lf\4iƘMbc) lAUBnVcںcFMUYuH<+FK; Q犩lo'`IZ(Fq,\==7O\Jĸ-19f>Iࣹk3~ռPjsSr9! &Mf)MFM8a5p2q֡\[E0 lzdTό];3J-zjsP@*-2TҢa[#DZj1hLT)Zh RL5-u +u\?a\6pمua7QQEzGQEQEQEQEQEQEQExΞj=9_m\ _ѶUS_?չXQԋo;:R tR6Ѷƙ]&]\҅r#K J1i@ wFM;V6fYDdq^ 4j@1N G1i҄4L-8-H$sQ#]}{.Inh~tR3a(?J-SKd=Iu<>#TOtk}M0iv@OԋZŬ#Lb宁Y٫J* k/k ks(܇lSQvZerR7\+ig CI9*o/ߑ?ܵ4L-w@{dOrZGi0 >w<2?+6idx5Rv <[NوGSzzR}K2)x/l;{}žf@m?#"+6Lf?ileix30q">iQyW:lēI=Z2>Sqlu1c?:y}I&?^~Ui <"OfRjKn?m??T6ReQ~(Pʹ^;Us0E@Ӽ->eYL`djXWd(ӱ\X!녒E϶ҫ"]Xً%Bc>7=}1RF|L_5L}~$q[0ܮ'~@A*ͅH#clU±Q4A@㧧4Ak4E$2Xx#4X/d" 0/|w?=+6&:ItmehN 5o,jXS"}hdr+(ݵsK6ıBzY2nC!{tktHlscz\7 p"c#q8GlTt_z}6W5p\*K wpm{:3XI?l OL桨:B*›o`977jAp>!4-;Ҳ1cqU IiEsxDfvCd{ܨ+jqV/Rw"8 >ڬ`0JiȌ6x$n@=)psדPڤI5́-dsw>.L˨dhl\H h}۹)X Cqp9 o_z HQ`*)oM%"QF(m6G t?ANpy U$"XNHJͭ %- I1d) &M8ahLaRi4a&! Jz-/o98+hђSiT܁DaQ8bZd *"*v (2*63 ld,*63 jdDSHZZdDWYB_f]gÏ WMxoШO\(((((((1]k\S Km?"c_OM~G~*ܻF,jϰERzܚmMѾXUӾݽ-jMj+mRm+Իivr" N ONLm.ړm.ڛ&0-(Z-(ZW4Layq 0cŸP{ PAڠy"PLB+BLzT9X; *gi%kFV?>ߝMmj;rܳsRƫMknb(nոH$HQSjD{20FE2C+Oa`-GpmY;Թu4LxZpZxZ$xB"T]C˞!jm"B6 S >EB$*sT:!ݾESSVsڪwe7\eJP,< zĈQ;U25\iO62ތ{~69&;GF~֜R4GfLTkr/'N?jY]$7v8[' 0t@1ޟH(H?,aݘ鏺~{Vmۡ[/ܐ9(<~.T"?W x*7u&dR y?0O[t#+ *1鎧\՛e:85[e\#׾?'zM^vS{HYO'm/5ynZ[ !r>&LWб!659I.)qIqml2ǼAQ܏FPA \ǔmHνwG=jI/ v4̳A¬`q/@8[ds%z6jH'ŭ42!R~?=6+ Ijiފ\:ըm[gvp,qAI!Ryd1zuǠZ`Vl. )@d OLײ#i&w1*֩pֺ|̻v=\"O"4Uic6XPi$#LOdU(u+- ꑏ>}^dCܞzȟlYt<ؗS-oZ6.eD+}a=v,0"{{y%YQIwcI;w'Ltm&I; ~zֳkdEaӼ餟˷r?*{Uj`ċ7ZkU9!UJsDFHщ06 hɲ;[8m7isLci*`$hK"X].+2$ҳj-0ӚMdфUcĭI=ҬR}_?>>N$7P.ړmkK\bF.RdxIm+6ԻiBҹiR JF;m?m(ZW-1iBԁiBҹc6kY>n_LgWS`FM!u?J[D;1k6]--՚ 7p{뚶I5?u~bJWiܘ-8-*mtWB #ҹcӂӰ$jrAdPfNi8n.Xb>rcǷb=՘4ijsNv:/Sgh>_zv"85>"'E܎XzKo$r|(Ԓh83ׯ@;4W+{v>d=նB%2o_SerF۴\#|gS0l 6?L彀wsc`R ѨipL[sCéz5w1Nas{Q m9,C ԪJnn`CnbmɷAq89Yڶ2oJl#p8_lm670.\0`HT1\ N P* * 뤳yx =hM5kYX-vB֠IgKzʣr!Awϫ;?iO9LR<txG63C4mp{c>u< ,3H|w<;D-4X0;3,y&s:AQZ4^NXI%&OV>)VM?MJ0Ih47z|3Z[?a迟j1[ıCQ*QQm~7P9ۉFɨhͲkkQMk8ւmK28H Wవ$2~I \[2;2qӂO+;#X^8vWAUof2h‡\ %&U8S*oW.£bV1Gՠ[1? ƣ50u!-زƫ,BgJRB0 0W{SUWD͸<6 ='=Bgس(s yT3CRXEaPa&A 4t叛Y?Vܟ)kzACMC}o,M4.!R:Gj{p 8* dЮdsuڦu$sTo gd<TRq"[e%:< aQ8ȨSQev ¡a[E@EFÚDµH2j6Tl+T!"5)+D"j~V¹v|<pمoI{EWiQ@Q@Q@Q@Q@Q@Q@[e'[J!\=qg%T}OsT3HlEMε׻Gv]6ԛiv֗26ԛivҸ#Fړm.W)2=jMi\Ӷ҅rmHm+&F,m2D0OS ¥Ƒwv!_IvyAt[#41@G Zך`ZpZxZPZey7]*W*}.=jp_Ps*QUfFpnj$Rݍ^U:[}Z!@>Z[?y$$0{sŴ1C^OEE/xZuPH/V}$1xWFmvv_TiC`NnnA'!-Y݇v;z]’Hlՙ#}m$3S]=f"3)n_Gt־d̬Q'}=A Xd$py?ye.z$l12Jetar H9L* #Bz\<7-1iiiBҹi O P*[)3?RѭX*s-rq>v"Zmޏ0Qsee_>t<ǩP)V^۽K,N0ÃY:éa+<!^y+wiVM.z>vF}FO kxE0% }jF1NW8=B[Cd  z! 4z\ g[uaO>bbubQK1 dp#\Nr [x!'' DžSI;i ef|큞*z|ILA=[,Ktv*@bʷFGp֭?dvb;6o!32z',?h_{gbz\X%2ߙڬ[iGE"_$UoS[ģ̠5uݼ~YT~ W6q}egEIn.o< ?B1NMq`r-"Z?j2l"\?gKqz%miJz^dGRYWW4yYb]#yaseses㤟ҘPD3_M䎠+HZQG!1A9嚎Tb[aL"ݷ6?<ӠY<8'>2]!Uߟ(I4ĐđFQ* HGaDW?>#󩈩q1b")TSq0ddSHKɔ,%Cqxrym4h!W%E^ù#ӵiHZȫ+)+wL+r:=ɢe++e!Al-'/8V?jk{Srdp ЊKK⒝IC!8qLaB&@¢aSV&d *&3 jl L£aVd,)T*6Ft+s\+a]?  ښل2;(l((((=TiwWr*Iqw0hYZF#Ķ6Ү'kml`@Q@Q@a +??Z~ᱺfAlC_oҌT~jcr,RKr,RFW)206ivi\IJJm҅ҹcF_;U"8oδK_YBԶm,N.W)1iii@cE_jO)hGѭ*7<򼟆p-ry`8#J.)6ZfM񹵱0q9sGGUc.6F:>9695b]j#k\ Jem`k9L9V&J65Ħa)%3isHJ O&p8#*I2ozNEu-m Pi*Mt T%uOKbpSI_yXkIJkK{T%uOT--l&\%tJ7YQf\'tOiopDA)\bpj -QRhU>#:{;{DuOSsEa.5Y`A[(.Z9bW #bf$Q -o N POgor²*}GJtv(<+" :Rliu{?5ml'xRE :´'DII>aҦIӂy쭮xREOtOemt’*}å++VsYE4)& NѕGI="O HC]ZM h*[5LtQ-4}y vmne]ؙRhzd)\ω,`udܐ!ÀG(z7QӟjL[\HrsYZQHVh0-{S|j w $yq=J#v i|7ȟG~8"ټ r@3Ɂm< +iPxf~͍BR4w8籮w4 {{Zw͏.bq[:]$\ɦD'`_j= TkLK3oW;$ y恝vyx|[ (\^M3$/n85G!$rMwpIdOqX փ",1k< |1}{MxmaE"FA9#C a^;A:6JġvrGwx7CdF8&NOB;arʑ\}sqXZt-F;x,˷F@Q, uFnb́A9GO3O 8eHsng"w{βuZ@ZtemԬK4aA9# G~f-V0} ncXؠz*]_eU&,YVqY%U-N-W0]*KlqǾ3Mּ-n򬐽۶çnZ~ɒ-CYRAwVpjpB8/́r#v:gfᥖ qxny~;`tm7U!yX/]$Mgq1gޏbFޭkm}Hb09ST͊xIXsn~|* ov!GC=Z{ cA玼SG!c1 G<]ps#𤸹[ϰ2#)wt?+Cur1b,XqEޓާY UY>NZnL|r۞E=>>nzGn=W9_%P@( mcYHbr}LJVkݰ!9zu乵i EHǧҲo-#g&[#i}#o >.\& n''oOD{կ9X[bFgz*&Nfy\ۂ9t¦<ȳ"ܡˤ΅GrvcO".6\x e_LpM 1W7a* ΀ib(.fL"pb\/@͜SțK2x34\ znbqLo<( segLEQ +.[$;D'ZCy\שA?8] GFGHnal9='(eWR+ FAo&t>$N~EQEydž>[%_X %-mV&GeMtOC]Z)(b:J(Zm(RKK:SE(Z -4R4CTӾIobݜe ɫB/!чRm /p pR 8S8\ƈpz)ۧG ~UTq\Bx['O°5.F٣DS0P$H#"c.bV/k3/kU꤆+@V6p~fC$1hIn.K-з=qW7RKȭB?TB߀ u TiXbET0)¦+c;DѪH+%AIJMo"ڱeRVOQpI^DO3M߷ W5@n$eUrw zWM O!d _׀rin≬TOI^{s*rķ۶&v4rr:ޕZ{W> 4۟N+s-n_pCH ^wVm-Ŵ[<$br#e85P(0 r3RSiE+QIKEBW ]j#,engN3j.aI(?W+ܪ722?wWTPVW!:-25NLjv=fFp>oUYQч lc6:{u#[[N&ė_cD1kTp*bl=BƊ; c=57ַQ2qQcy$|9\1b })YZ)[kzcZ(b\nN^g㞸پ#=F^f%33*%vO%.. QO6%&rz1R]ڜ[U]݉Ǣ%/M/QKkG%/M/Q2E(}iJ$ Te VMiMbB|/9o?+v Mo?+tΌ:=.($Š(((((((6wsvmd-mVEM7-?&O?P+N Vxc"C]*GVMͲJ)3KG1RQG0RiisR)isR\šԴJ)s f8Qͳ?ѿO*Х`A .cX;;Rޜ+?LcdgçWkk; 0S.bjis ٷYz2#?*f'q Up;zHb\<͕9 *SܚW6m{%n\|2qۦGҦ츓 NIegvnŤOhO?Z`ҹ 0 ATt6>Bpu>5xU=^3%cV7SW4bLm 叵6(L(8p=j5.Hi+dJhUhO]3ՔöH=1˙ĆP EQM?俑_>j$h8c_/7@=O?J*BI䜓V`HF`ucRW-)E4Ci ^^ (ۉ.p8ca^{O@m!oH=d=ӑ SE;ӑ&;&Vп/Z~e|?#|G*;'5x} -Ȕ_½ZBhxVSgoi2\o:s\+|qu}RH@2>AqI.5VEKJ;Yx]; R}SCQU`1ղx?PHHO۽k$N9R?~+IdRBA#?$2 .ʣH6B`e)uX9gkw@܎aoqr5o3UYA\(Y䚴- jĎsiTټ )1 +YOH/6~߃[SZ=C4g: Hn4b~k(cԥ[o4潹ML$#^\ӧ>XF6#h&]r`^쬒ɦۆėO9wG5NG{;7PdQA?jKF5U`v7Qt*ux !?Um4quv]lq'P/tΠkw;2>{ڬ*P*7ozB* =Pz{jUHTہN C `l28g1ޢgLGSY&zDTKAۃ*R A$Y(RieH7'#O%3\m7ҘsB9oOaMEX ߒ{HZƛzȆ/L/[L\Sw=i7(P\C&) T[7{C)jBzMՌ?u&fLMaQΫ{\+]sVW)~Q^=>((((((((C.^"O>SjO›E-<ݏ8 >ZԜ{Qb--60ťRE&iisRe(ZJ 0Sh Pi҃KVOwO~Q-_=V%),MdQT$Ν3ΠYeP?շǷK>Pƕman"@$ܮ)"2Pk>DG2vgגuZY $¢X\AW,s1Ƒdn`l(A\{b,j2oچ4QN~clUie/:;YV&Q$0Kor=T$JUXZh%o <_0hh 8=ij3% ]?r'?Ҟh̗Q˽iQ\IfB7#!U4%9jD߿"jd q02q86Z&ҹS bQ{~^~5'WF T͒FRˡI>.cTԷܾ 8A i\CVkq7E#91!N0ۨ(5ܩHݕ G,~H5r@ ń1͌ c;_G .cDˣynW yn¬ceul~`3R45pnQV ~|: >cTKLqv!V+!8 ?ޙAOR]G/9Yy-V.dh* fZ_INǾrHc9*.u {WأG?JiDE\+E+j&[+ #K@2w'^( +s qNgm q)Dsݘqh9&M!5)"%6-R'7oZM46E 0AE‹bJ*kpŕS_Wi66biis)R)i1hu-74-, @j2ICm*]؎J@qbEu%-Ղdbǒ56iӅO1wiAJ .cD,GX3[$` 8?~*i:x! 0fUb;GMxxF!]7AJ_\MA.[>T~QbP01EMok-'(Bp);*ycn["ZAhmH98'&m@[˷냟d{bMs|qQ-l؁mmbI|7M<S-E \rX$>Vo^aͥ9# ZM= l9D?}OuI#a#1Nqj-b]0('XfmY[(ӹ*l4;A ėW1I iCb!8n8L@au[itToʝM0SL&H o=q )O} 8՛im$fx˽'逸hi]BQkVR!?5p-[ +}o#?Z4TPz0-Ue{;%y)y8hi ݙ<)qe{Ŀf!<)r;s} 18OF-QVApAܥ r8ך˱4S k 8V=3>jqya&9|eOOH-=T0}*hlx4 W-Ki .|F*rm"&#(݁jpT(,I~5W7D]kLԻ^qzSן.=nd'uo{iF ĒY$aRv*ی5js}kM@PZIY]vR@szՉfc,i72Foku>Bg}p;՛;h-ڽ%r}I<]6 {˕q8)i?'گ*+3*{ wlQ.R=??SӢ@ 35"$0,gl@K{ΧF?U4C?$ CFh[9D?:Zՠk2(4ggd~a;HP90A&h&FA4jO!?RM%ɻ!D$rOI==ţD1%PfeOfǮQDrS@ PX'PiӴ0+aX~ޑ*p#hDP$%JAB1' }1UȖ8RN֦Hm"yآhe{{~T\1`iιSmHʔ {1FuNK:H#?Cf:&7Xox\}CsEc߼vN?jh(6H%m>+XnD]kf%XEG}}1۽\Bk) UqDg˺Jهr$*}=X0ZN~A+Iu2[ĥzk$gcs)֒yֱ\sVہޔ,~#YNw'cP.k#"sT`IHcׂ?ϥZsUeidr4,ixfc5܂SU[jyNxDSHZ&a(L&avq;sM5!)JFN$dRO"k2yFMB+1rJűXJJZJɰ J(½uyz7o ?*_RtQExFEPEPEPEPEPEPEPhxWcAxdg$_(Vw2JZ\IhRFR1)G_qժ(*-_ +6[~}G$i*Ѻ U56|\GLݗxQTx⭣d`zr &QiR{S'EN!UbT4sJ .bJ 4\-8fisK<Pi1no#6 VU";w+Ȩ<{kg ,裚zobا 'Pn!_qAE=4Ԑr (VwN؇ eg}BmD=ڴcқslPnXrYNHGRchŁO^9i0 )8=Ҭ .j9{Qúɧ> c cPET8N3@Vۤ" >Iu7QUAzCj h8kXш¬.B 0O5$-^rdҁhdeSOSX : {ƥWu ,@zfS|9+v#u9c]Pg wz#bg[(. ~!ڨF0o H;nL{F;rH泮-f6B?wq$<9'A{U!So y>Q|lA{ջk.-Duv"Xw<ЯlˍD;`qCӍ"hz/"P |{㯧֛A72`yېHQZEu1 :}Go%#:rO?_Z3TKE+Hv*MXcU-Xw2ơ9cզly}),2œO/巖T>#=P]I*4&%ܦ@$)jMբf o+4#Bz_U1}tc8}n[\B2W la#+'+TKg6 ұ(ʆ޼5xajԃ"y[W-YvDky5>UƭD[DpA\ޣ]9 #VehEvqd}K;VYfz3tVKWDjT*ч"q4p+0% =i0@5Zep%Hg8?9M\(wD%tD.2R~GXP@0*g^"BLw?ʺ"'.PGQ̋L񫲵V~MnIt++"$A N%ht?Z)_)TS0Hd iq4/92)"k9HČiɲiE4-HiƐMaO4b)M%fج%z7o ?*oUŋ w=n( (((((((]ĦG g%6_?Ukɛ՟U{$ ;5fC-Q1ii-V}>ܱxաsաbՌ5ث^&&Q=Rm(zjQZ$f$>sE-5Hgb1N]NĜ}}  0S̆{XqI$ؤڥv:$ފ鑚dRjVI-U?-OwNUW1N4N%a}+ovڃ9)v_VE~YZ&l{X#S)P!n Ts䉖`2>`1ZŗؕU$V&k잿Sf]Rbpbb8c;޴V`1!j߿h݌n8-L-]f%?%WVM;0.H0jt˕̕gfAP[7uu7m%(&8AnFr4bݚB@Ԇ8]YM<0uBƪTY8Ti.M 7GR-3Z^tr}j5+t "s괇dl~uY]1Bd/ɦRL"LQ""51*9G7xlÏjF*IJcoz~-лTrGsM": 2G55*SL"Čiifn# 4yɲi 8Ͳ,0S!S*uyz' ?*ſ0KS袊J ( ( ( ( ( ( (]yB'@2BM>u"Uluz;8?[^ѿb7ZQvPp?΢h[^F?ljI33V FkD͕f]B%sAc8% 9XW#{TѬq HQGEQ)KVfܐVGxU dsǡyjke*#Y| c$?Q96"Crz*asxs{a[ōXG9`>cǒK!֬0ڳvߡPde=Ed㾦V)0kii6ii!Ӎ4maJa+Ы> WQ W&+LV=j(((((("Cv#8kv^IJQUA9b;)'O}?] nTo(3hN1{u7hɫ#F.$@矨A]pOUjWg\At|m_^dD 8ɳ&ANlZ)(qKMqWT! 84E rq# ##[,oۤT94_BfLSqœ))\8S4S;ž))#8SKxvv1@GZ^@&,FМrN{VjƋ* t A=Dx `\*jIOƟ5lU;Z^C KFoi BhZ+gDr$DR߀^6Dk"@ݲaN?v(m(E^\NΜmX+tƉ$$d?6tjT)ݖ<"pއ>η DNTᕆOk6bFi ?zRsfmi 8MKd44qhm!Jɰ^cBp_ ur_,(Q@Q@Q@Q@Q@;ynx%0,L HބQevc3F~޴G#R`x`-6<̔@0? *.DqZGRGj ? O) hgnLiUGRNW]v%#yQ[YPfx $zqۏJ3UvD[-bWw>$1$f噹,}.ij,C[ S SwVf#S SKS WDYJ#>+ DVqU(QvDUTN[5 &WWJjrЖ8($=H-(_,WAGik2fR"H&Zj|,TmRDG$TmR50ԶsIaalHayZiu!DD܏QKdSFW+ǷjɶIF5cM%:ԶKCk> WQ Wע|\BlC!zQ^YEPEPEPEPEPEPEPi_ ) RKm?"^O#Q{lp54keb@i`Ӂ-O dhh4 Z))jn0Xyi `-6Xh9Q{SOR @QR 6*)š)‹!œ)()˜)⋛Dp` .mATK.bI=GnAmXSKۛ{`CJļ;}ND{8SUnV)*nR)š)‹!ž)(Gpe[ m(ǰSB(NZ|!"U* +0Ǔ}*Ч)keC76Ip54k&f 4`Ӂ-N͓bPi@جH 8p5- Ģ ?5!aEGpf+2J{R.:1œ*H̍w4n+ A$H)š)¦p h .mª_??T̖I4Xzt/G>d߀*r7NO͢w6Lq<7;FԌ Ǯ:}izԌxXRFǚHǚktRZoFBǚZ5gDQHs[&tˆRd5]f2$jYU,ϿUMҶIIKZKM*bITFiwv0SOH{ϙufёM&4ff4i3[))4sHMjbi 搚HɱsHM&iթ6)4A4s 0Ӎ4ӹaiM4M572cM4Ӎ4ҹBii im+5_+ЫMz ?*·̧4QEpQ@Q@Q@Q@Q@Q@Q@=$BU4oUk|Lzi`ӳY31ӁYl<p54jJ (54jAQNXx54jZ N4j*g40]ۙR돭N)’v4Pr"* "H)ᔌxvv%QGz$N)š)rrI4V&^_?(O?Ziotr=˟5|UMtyLY#]bv140 £M9nfvo#q G>Jebw!b= XzhɛhȈ|=>>aI pFAYm-&̃x?=>К6h皁6+,9GX߆jT,"sPsP9L#s֡cHǭBǚ3(BsP9S:bd\diq{Zd$y5ZV(SBG{J~kDɳ۷fLֱ`њni3[ř6;45YcIni 2lq4sHMjc搚L֊FMBi3HMZbHM!4)A43l 4ғHiɌ4N4JLiq 4Ӎ6ؔN4Sruyz ?*ʷ̪|'QEsQ@Q@Q@Q@Q@Q@Q@7DžrO*5WO?T5_?43Kəx4j0i1Xx4i҃PЬH 8p5"(4j0iԴ$ D <bPiJi4;O CE$J .$#J`4jYi 'Ȋd.}<[Q-!cf"U-y~5|jA>?"/y>tC4NZZ#SmR)I2<@: MpdcHȧ MDS: iC!# #ʓOQdS4R2Vf$U7&70(>[m,cϱЧnX)A*NrTg}ɩk:"K/+Ē#INJ}*]F*c֬CpأTRsK-+hP ku[Bǚ6gDQJ f!n +*[E+\TWgm ?&/&a皾j5dֆ)Z$ j\C0ԨjӚ<$8x!XLk8Fv?D98SS ڌiEU$]RLњnhZ!sFim&f4lbijcILfLͱsILfLɱI&i LͱsHM&i LͱI&i3Tb曚3If3HM;i&HiM!s66iƐҹ i4$1 z ?*^kBp_ 3 QEqEPEPEPEPEPEPEPi/c5VcSgQErQ@Q@Q@Q@Q@Q@Q@%cVX'ʬ_??=51ӳL.k2,<Pi҃H,<PiӁ  0PiQNؐp54jZ*ĀӁR$ D 8Hv'XgsPI>0#By+&"/O OhCSCSTj04j N N RѬISTZ6`585@xff٨H ֢fj#hQ;RTLղFcY3qPVōcDƜǚjc\,x֩1Dǚ{54R#jj&5-HTmR1j)8Jj֨ &t&hP[r.iqOKgqsFi3IKbf5hͱsILњ24L4f4LŤ&hRd64Rd6-% 3E%rXRQE;’Jw$(aE%\B5!]C/^y^kBp_ eSgQErQ@Q@Q@Q@Q@_PM>UfKxF Ԁ3Y꺕,uvY.빂T:ڢ(,ʧ8?* L'1٧S3J A6 (4KXx4N<p58i`Ӂ; F (5-b@i@ӁhiN MHX9?W(|nРAzQXEPEPEPEPEP&1TGL{ r#gCp6\)2:fe9xE7YXd0=AgvtZ|l"L#kqڀ6ꌗ;tcpG1WbϻgpvOqzoOSH5upz-0jqpn<3QmٚoO^P(wgfjY?”iO\ûC Z)gûϰ_> Qc}@+ԨOC|/O +i?½>?c{b, w? )fX 'WsE/_i?”$wvQKR$w0q> 'WsE*|O. *3 Uc˕Iƶ+OW%Ciy>7 'S ^4^EWm>쯭K 'T2FA!r9'tHKVKTHs YQY|;>Ǚ:d au_,^EWaݏ:f@)JԿ}{쯯O}E>D/O>}:$XΕ~`f|1v/#+%F-g гF@OWi쏟ֿ,I@}Cd v'>=PY?“kv>|{Z>'#+J)_ZcGu 'R;QY?¾0._Ow[6} E̻<;QY?G5j? 'WSbĻ<9QY?G5j? _CG;cG5j? 'Q@mG_+(acG5j? 'R7QY?¾v/l;7QW ~׶ZvwF||J"] 5t9­Q@ 45$TDUT`:)Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@Q@ZP >XIcC5>[+{.c1;%\8KãU֯oePpғ> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 188 /ID [<5aa3662cab6d797cec1bf1a00b28c154><5137c880948bf0fac770eacf7d4c77d4>] >> stream xcb&F~0 $8Ja?`V }(N_('3ũWPlʞ DʿW@ "]@$S-VDH/ R4 Dee_IFQ`?xDHWɿl16,v0IN 60 endstream endobj startxref 160724 %%EOF hypergeo/tests/0000755000176200001440000000000012564167332013247 5ustar liggesusershypergeo/tests/aaa.R0000644000176200001440000001111012564167332014106 0ustar liggesusersrequire(hypergeo) # First some test values for z, generated randomly. These values are # selected so as to use each of the subfunctions of hypergeom(): z <- c( 0.28 - 0.21i, -0.79 - 0.40i, 0.56 + 0.05i, 2.13 + 0.68i, -0.43 - 1.47i, 1.23 + 0.48i ) # First test: some randomly chosen values for A,B,C; my package: my.ans <- hypergeo(A=1.21,B=1.443,C=1.88,z=z) # Compare with Maple's: maple.ans <- c( 1.26242625279896547050 - 0.33515733250598455101i , 0.55218026726586346626 - 0.11826012518395685586i , 2.08656513655255552950 + 0.21074089910422408972i , -0.71334498434004598167 + 0.59647479085505445853i , 0.36911468617705947291 - 0.35906488952504313903i , -0.44806924103752606401 + 1.91140611055324833040i ) stopifnot(all(Mod(my.ans-maple.ans) < 1e-9)) # Now verify eqn 15.1.15, p556: "eqn15.1.15a" <- function(a,z){ hypergeo(A=a, B=1-a, C=3/2, z=sin(z)^2,tol=1e-9) } "eqn15.1.15b" <- function(a,z){sin((2*a-1)*z)/((2*a-1)*sin(z))} Mod(eqn15.1.15a(0.2,z)-eqn15.1.15b(0.2,z)) # Observe the mismatch for # element 4. BUT # hypergeo() agrees with # Maple, which gives # 1.038571815 - 0.1598166166i "eqn15.2.10" <- function(A,B,C,z){ # page 558 (C-A)*hypergeo(A-1,B,C,z) + (2*A-C-A*z+B*z)*hypergeo(A,B,C,z) + A*(z-1)*hypergeo(A+1,B,C,z) } stopifnot(all(Mod(eqn15.2.10(0.1,0.44,0.611,z))<1e-6)) ## Now some special elementary cases, on page 556. Here, "rhs" means ## "right hand side" and "lhs" means "left hand side". "f15.1.3" <- function(z){ lhs <- hypergeo(1,1,2,z) rhs <- -log(1-z)/z return(rhs-lhs) } "f15.1.4" <- function(z){ lhs <- hypergeo(1/2,1,3/2,z^2) rhs <- 0.5*log((1+z)/(1-z))/z return(rhs-lhs) } "f15.1.5" <- function(z){ lhs <- hypergeo(1/2,1,3/2,-z^2) rhs <- atan(z)/z return(rhs-lhs) } "f15.1.6a" <- function(z){ lhs <- hypergeo(1/2,1/2,3/2,z^2) rhs <- sqrt(1-z^2)*hypergeo(1,1,3/2,z^2) return(rhs-lhs) } "f15.1.6b" <- function(z){ lhs <- hypergeo(1/2,1/2,3/2,z^2) rhs <- asin(z)/z return(rhs-lhs) } "f15.1.7a" <- function(z){ lhs <- hypergeo(1/2,1/2,3/2,-z^2) rhs <- sqrt(1+z^2)*hypergeo(1,1,3/2,-z^2) return(rhs-lhs) } "f15.1.7b" <- function(z){ lhs <- hypergeo(1/2,1/2,3/2,-z^2) rhs <- log(z+sqrt(1+z^2))/z return(rhs-lhs) } f.all <- function(z){ cbind( f15.1.3 (z), f15.1.4 (z), f15.1.5 (z), f15.1.6a(z), f15.1.6b(z), f15.1.7a(z), f15.1.7b(z) ) } stopifnot(max(Mod(f.all(z))) < 1e-10) # Below, jjR means value obtained from R via the package, and jjM means the value given by maple. # Following test fails sometimes. It passes on my mac, fails on the linuxbox: jjR <- genhypergeo_contfrac_single(U=0.2 , L=c(9.9,2.7,8.7) , z=1+10i) jjM <- 1.0007289707983569879 + 0.86250714217251837317e-2i stopifnot(Mod(jjR-jjM)<1e-10) # Test hypergeo_cover1(): jjR <- hypergeo(pi,pi/2,3*pi/2-4, z=0.1+0.2i) # ie negative m; ie f15.3.12() jjM <- 0.53745229690249593045 + 1.8917456473240515664i stopifnot(Mod(jjR-jjM)<1e-10) jjR <- hypergeo(pi,pi/2,3*pi/2-4, z=10.1+0.2i) # another negative m jjM <- 0.31486642443024026933e-2 + 0.10505111398350790590e-2i stopifnot(Mod(jjR-jjM)<1e-10) jjR <- hypergeo(pi,pi/2,3*pi/2, z=0.1+0.2i) # m=0 (ie 15.3.10) jjM <- 1.0654685003741342889 +0.24452141417139649656i stopifnot(Mod(jjR-jjM)<1e-10) jjR <- hypergeo(pi,pi/2,3*pi/2+4, z=10.1+0.2i) # This is positive m (15.3.11) jjM <- -0.29639970263878733845 - 0.34765230143995441172i stopifnot(Mod(jjR-jjM)<1e-10) jjR <- hypergeo(pi,pi/2,3*pi/2+4, z=10.1+0.2i) # m>0 jjM <- -0.29639970263878733845 -0.34765230143995441172i stopifnot(Mod(jjR-jjM)<1e-10) jjM <- -0.90818366414720846181e-2 - 0.10746858256201734833i jjR <- hypergeo(pi,pi/2,3*pi/2, z=10.1+0.2i) # m=0 stopifnot(Mod(jjR-jjM)<1e-10) # Test hypergeo_cover2(): jjM <- -0.15888831928748121465e-5 + 0.40339599711492215912e-4i jjR <- hypergeo(pi,pi+2, 1.1 , 1+10i) stopifnot(Mod(jjR-jjM)<1e-10) # Test hypergeo_cover3() jjM <- -0.24397135980533720308e-1 + 0.28819643319432922231i jjR <- hypergeo(pi, 1.4, pi+4,1+6i) stopifnot(Mod(jjR-jjM)<1e-10) jjM <- -0.10592465301475818414e-1 - 0.15993048891187879153e-1i jjR <- hypergeo(pi , pi+1 , pi + 3 , 1+6i) stopifnot(Mod(jjR-jjM)<1e-10) # Test for hypergeo_taylor(): jjR <- hypergeo(pi,-4,2.2,1+5i) jjM <- 1670.8287595795885335 - 204.81995157365381258i stopifnot(Mod(jjR-jjM)<1e-10) # quick test for a bug reported by Igor Kojanov options(warn=2) ignore <- hypergeo(1,2,3,0) ignore <- hypergeo(1,1.64,2.64,-0.1111) hypergeo/NAMESPACE0000644000176200001440000000022012564167332013316 0ustar liggesusersexportPattern("^[^\\.]") importFrom(elliptic, view, integrate.segments, myintegrate, residue) importFrom(contfrac, GCF) importFrom(deSolve,ode) hypergeo/R/0000755000176200001440000000000012564167332012306 5ustar liggesusershypergeo/R/hypergeo_ODE.R0000644000176200001440000000625212564167332014747 0ustar liggesusers"to_real" <- function(o){ out <- c(rbind(Re(o),Im(o))) if(!is.null(names(o))){ names(out) <- # pathetic kludge apply(expand.grid(c("_real","_imag"),names(o))[,2:1],1,paste,collapse="") } else { names(out) <- NULL } return(out) } "to_complex" <- function(p){ if(is.vector(p)){ jj <- Recall(t(p)) out <- c(jj) names(out) <- colnames(jj) return(out) } # if not a vector, assumed to be a matrix out <- ( p[,seq(from=1,by=2,to=ncol(p)),drop=FALSE] + 1i*p[,seq(from=2,by=2,to=ncol(p)),drop=FALSE] ) f <- function(string){sub("_real","",string)} colnames(out) <- sapply(colnames(out),f) return(out) } "complex_ode" <- function(y, times, func, parms=NA, method=NULL, u, udash, ...){ out <- ode(y=to_real(y), times=times, func=func, parms=to_real(parms), method, u=u, udash=udash, ...) out <- cbind(z=u(out[,1]),to_complex(out[,-1])) class(out) <- c("deSolve", "matrix") return(out) } hypergeo_press <- function(A,B,C,z, ...){ # Press et al, 5.14 if(Re(z)<=0){ startz <- -0.5 } else if( (Re(z)<=0.5)){ startz <- 0.5 } else if(Im(z)>=0){ startz <- 0.5i } else if(Im(z)<0){ startz <- -0.5i } initial_value <- hypergeo(A,B,C,z=startz) initial_deriv <- (A*B)/C*hypergeo(A+1,B+1,C+1,z=startz) # 15.2.1 complex_ode(y = c(F=initial_value, Fdash=initial_deriv), times = seq(0,1,by=0.05), func = hypergeo_func, parms = c(A=A, B=B, C=C)+0i, u = function(u){startz + (z-startz)*u}, # path udash = function(u){z-startz}, # derivative of path ...) } "hypergeo_func" <- function(Time, State, Pars, u, udash) { with(as.list(c(to_complex(State), to_complex(Pars))), { z <- u(Time) dz <- udash(Time) ## 'meat' of function: AMS-55 15.5.1; w -> F dF <- dz * Fdash dFdash <- dz * (A*B*F -(C-(A+B+1)*z)*Fdash)/(z*(1-z)) ## Now coerce back to real: out <- to_real(c(dF,dFdash)) names(out) <- names(State) return(list(out)) }) } f15.5.1 <- function(A,B,C,z,startz,u,udash,give=FALSE, ...){ # solves the ODE, 15.5.1, directly. out <- complex_ode(y = c(F=hypergeo(A,B,C,startz), Fdash=hypergeo(A+1,B+1,C+1,startz)*A*B/C), times = seq(0,1,by=0.1), func = hypergeo_func, parms = c(A=A, B=B, C=C)+0i, u = u, udash = udash, ...) if(give){ return(out) } else { return(unname(out[11,2])) } } "semicircle" <- function(t,z0,z1,clockwise=TRUE){ if(clockwise){m <- -1} else {m <- 1} center <- (z0+z1)/2 center + (z0-center)*exp(1i*t*pi*m) } "semidash" <- function(t,z0,z1,clockwise=TRUE){ if(clockwise){m <- -1} else {m <- 1} center <- (z0+z1)/2 (z0-center)*(1i*pi*m)*exp(1i*t*pi*m) } "straight" <- function(t,z0,z1){ z0 + t*(z1-z0) } "straightdash" <- function(t,z0,z1){ (z1-z0) } hypergeo/R/hypergeo.R0000644000176200001440000012363312564167332014263 0ustar liggesusers"f15.1.1" <- function(A, B, C, z, tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} genhypergeo(U=c(A,B), L=C, z=z, tol=tol, maxiter=maxiter) } "f15.3.1" <- function(A,B,C,z,h=0){ if(!is.null(getOption("showHGcalls"))){print(match.call())} mult <- gamma(C)/(gamma(B)*gamma(C-B)) f <- function(t){t^(B-1)*(1-t)^(C-B-1)*(1-t*z)^(-A)} if(length(h)==1){ if(h==0){ return(mult * myintegrate(f,lower=0,upper=1)) } else { if(is.double(h)){ h <- 0.5 + h*1i } } } return(mult * integrate.segments(f,c(0,h,1),close=FALSE)) } "f15.3.3" <- function(A,B,C,z,tol=0,maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} (1-z)^(C-A-B)*genhypergeo(U=c(C-A,C-B),L=C,z=z,tol=tol,maxiter=maxiter) } "f15.3.4" <- function(A,B,C,z,tol=0,maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} (1-z)^(-A)*genhypergeo(U=c(A,C-B),L=C,z=z/(z-1),tol=tol,maxiter=maxiter) } "f15.3.5" <- function(A,B,C,z,tol=0,maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} (1-z)^(-B)*genhypergeo(U=c(B,C-A),L=C,z=z/(z-1),tol=tol,maxiter=maxiter) } "i15.3.6" <- function(A,B,C){ if(!is.null(getOption("showHGcalls"))){print(match.call())} return(c( ifelse(is.nonpos(C-A) | is.nonpos(C-B), 0, gamma(C)*gamma(C-A-B)/(gamma(C-A)*gamma(C-B))), ifelse(is.nonpos(A ) | is.nonpos(B ), 0, gamma(C)*gamma(A+B-C)/(gamma( A)*gamma( B))) )) } "j15.3.6" <- function(A,B,C){ if(!is.null(getOption("showHGcalls"))){print(match.call())} is.nonpos(c( C , C-A-B , C , A+B-C )) } "f15.3.6" <- function(A,B,C,z,tol=0,maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} if(length(z)==0){ return(z) } jj <- i15.3.6(A,B,C) jj[1] * genhypergeo(U=c( A, B),L=A+B-C+1,z=1-z,tol=tol,maxiter=maxiter) + jj[2] * genhypergeo(U=c(C-A,C-B),L=C-A-B+1,z=1-z,tol=tol,maxiter=maxiter) * (1-z)^(C-A-B) } "i15.3.7" <- function(A,B,C){ if(!is.null(getOption("showHGcalls"))){print(match.call())} return(c( ifelse(is.nonpos(B) | is.nonpos(C-A), 0, gamma(C)*gamma(B-A)/(gamma(B)*gamma(C-A))), ifelse(is.nonpos(A) | is.nonpos(C-B), 0, gamma(C)*gamma(A-B)/(gamma(A)*gamma(C-B))) )) } "j15.3.7" <- function(A,B,C){ if(!is.null(getOption("showHGcalls"))){print(match.call())} is.nonpos(c( C , B-A, C , A-B )) } "f15.3.7" <- function(A,B,C,z,tol=0,maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} if(length(z)==0){ return(z) } jj <- i15.3.7(A,B,C) jj[1] * (-z)^(-A) * genhypergeo(U=c(A,1-C+A),L=1-B+A,z=1/z,tol=tol,maxiter=maxiter) + jj[2] * (-z)^(-B) * genhypergeo(U=c(B,1-C+B),L=1-A+B,z=1/z,tol=tol,maxiter=maxiter) } "i15.3.8" <- function(A,B,C){ if(!is.null(getOption("showHGcalls"))){print(match.call())} return(c( ifelse(is.nonpos(B) | is.nonpos(C-A), 0, gamma(C)*gamma(B-A)/(gamma(B)*gamma(C-A))), ifelse(is.nonpos(A) | is.nonpos(C-B), 0, gamma(C)*gamma(A-B)/(gamma(A)*gamma(C-B))) )) } "j15.3.8" <- function(A,B,C){ if(!is.null(getOption("showHGcalls"))){print(match.call())} is.nonpos(c( C , B-A , C , A-B )) } "f15.3.8" <- function(A,B,C,z,tol=0,maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} if(length(z)==0){ return(z) } jj <- i15.3.8(A,B,C) return( jj[1] * (1-z)^(-A) * genhypergeo(U=c(A,C-B),L=A-B+1,z=1/(1-z),tol=tol,maxiter=maxiter) + jj[2] * (1-z)^(-B) * genhypergeo(U=c(B,C-A),L=B-A+1,z=1/(1-z),tol=tol,maxiter=maxiter) ) } "i15.3.9" <- function(A,B,C){ if(!is.null(getOption("showHGcalls"))){print(match.call())} return(c( ifelse(is.nonpos(C-A)|is.nonpos(C-B), 0, gamma(C)*gamma(C-A-B)/(gamma(C-A)*gamma(C-B))), ifelse(is.nonpos( A)|is.nonpos(B) , 0, gamma(C)*gamma(A+B-C)/(gamma( A)*gamma( B))) )) } "j15.3.9" <- function(A,B,C){ if(!is.null(getOption("showHGcalls"))){print(match.call())} is.nonpos(c( C , C-A-B , C , A+B-C )) } "f15.3.9" <- function(A,B,C,z,tol=0,maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} if(length(z)==0){ return(z) } jj <- i15.3.9(A,B,C) jj[1] * z^( -A)*genhypergeo(U=c(A,A-C+1),L=A+B-C+1,z=1-1/z,tol=tol,maxiter=maxiter) + jj[2] * (1-z)^(C-A-B)*z^(A-C)*genhypergeo(U=c(C-A,1-A),L=C-A-B+1,z=1-1/z,tol=tol,maxiter=maxiter) } "isgood" <- function(x,tol){ all(abs(x[!is.na(x)]) <= tol)} "genhypergeo" <- function (U, L, z, tol = 0, maxiter=2000, check_mod=TRUE, polynomial=FALSE, debug=FALSE, series=TRUE) { if(series){ return(genhypergeo_series(U, L, z, tol = tol, maxiter=maxiter, check_mod=check_mod, polynomial=polynomial, debug=debug)) } else { return(genhypergeo_contfrac(U, L, z, maxiter=maxiter)) } } "genhypergeo_series" <- function (U, L, z, tol = 0, maxiter=2000, check_mod=TRUE, polynomial=FALSE, debug=FALSE) { if(!is.null(getOption("showHGcalls"))){print(match.call())} if(debug){ stopifnot(length(z)==1) out <- NULL } if(check_mod){ lU <- length(U) lL <- length(L) if(lU > lL+1){ greater <- Mod(z)>0 } else if(lU > lL) { greater <- Mod(z)>1 } else { greater <- Mod(z)<0 } if(all(greater)){ return(z*NA) } else { z[greater] <- NA } } fac <- 1 temp <- fac if(debug){out <- temp} if(maxiter==0){ return(z*0+fac) } for (n in seq_len(maxiter)) { fac <- fac * (prod(U)/prod(L)) * (z/n) series <- temp + fac if(debug){out <- c(out,fac)} if (isgood(series-temp,tol)){ if(debug){ return(list(series,out)) } else { return(series) } } temp <- series U <- U + 1 L <- L + 1 } if(debug){ return(list(series,out)) } if(polynomial){ return(series) } else { warning("series not converged") return(z*NA) } } "hypergeo_taylor" <- function(A, B, C, z, tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} genhypergeo(U=c(A,B), L=C, z=z, tol=tol, maxiter=maxiter, check_mod=FALSE, polynomial=TRUE) } "is.near_integer" <- function(i , tol=getOption("tolerance")){ if(is.null(tol)){ tol <- 1e-11 } abs(i-round(Re(i))) <= tol } "is.nonpos" <- function(i){ is.near_integer(i) & (Re(i) < 0.5) } "is.zero" <- function(i){ is.near_integer(i) & (abs(i) < 0.5) } "hypergeo_A_nonpos_int" <- function(A, B, C, z, tol=0){ # Assumed: A integer <=0 , B # either non-integer or (if an # integer) <= A. (for example: # A = -2, B = -5). The # hypergeometric series is a # polynomial. if(!is.null(getOption("showHGcalls"))){print(match.call())} stopifnot(is.nonpos(A)) if(( is.near_integer(C) ) & is.near_integer(C) & (abs(C-A) < 0.5) ){ # A==C==integer warning("this case is not uniquely defined: proceed, assuming both A and C approach the same nonpositive integer at the same speed [that is, (a)_n cancels (c)_n for all 'n']") return(genhypergeo(U=B,L=NULL,z,tol=tol,check_mod = FALSE)) } else { return(hypergeo_taylor(A,B,C,z,tol=tol,maxiter = -A)) } } "hypergeo_AorB_nonpos_int" <- function(A, B, C, z, tol=0){ if(!is.null(getOption("showHGcalls"))){print(match.call())} stopifnot(is.nonpos(A) | is.nonpos(B)) if(is.nonpos(A) & is.nonpos(B)){ if(A>B){ # eg A = -2, B = -5 return(hypergeo_A_nonpos_int(A,B,C,z,tol=tol)) # Note A,B not swapped over } else { return(hypergeo_A_nonpos_int(B,A,C,z,tol=tol)) # Note A,B swapped over } } ## Thus from here on, A is a nonpositive integer and B is not an ## integer. if(is.nonpos(A)){ return(hypergeo_A_nonpos_int(A,B,C,z,tol=tol)) } else { # Former bug! return(hypergeo_A_nonpos_int(B,A,C,z,tol=tol)) } } ".process_args" <- function(...){ # slight modification of process.args() of package gsl... a <- list(...) attr <- attributes(a[[which.max(unlist(lapply(a,length)))]]) a <- lapply(a,as.vector) out <- do.call("cbind",a) return(list(out=out, attr = attr)) } "crit" <- function(...){ c( 1/2 + 1i*sqrt(3)/2, 1/2 - 1i*sqrt(3)/2 ) } "hypergeo" <- function(A, B, C, z, tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} if(is.complex(c(A,B,C))){ stop("complex values of A,B,C not supported. If you really really want complex values, let me know") } if(length(A)>1 | length(B)>1 | length(C)>1){ jj <- .process_args(A,B,C,z) f <- function(x){hypergeo(A=Re(x[1]), B=Re(x[2]),C=Re(x[3]),z=x[4],tol=tol,maxiter=maxiter)} out <- apply(jj$out , 1, f) attributes(out) <- jj$attr return(out) } # if you are here, length(A)=length(B)=length(C)=1. jj <- crit() c1 <- jj[1] c2 <- jj[2] close_to_crit <- (abs(z-c1) < 0.1) | (abs(z-c2) < 0.1) ## following lines commented out because ifelse() evaluates both ## functions for *every* value of z, irregardless of the value of ## close_to_crit. So both hypergeo_residue_close_to_crit() *and* ## hypergeo_powerseries() return errors [and there is also the risk ## of an infinite regress]. ## out <- ifelse(close_to_crit, ## hypergeo_residue_close_to_crit_multiple(A,B,C,z, tol=tol, maxiter=maxiter), ## hypergeo_powerseries (A,B,C,z, tol=tol, maxiter=maxiter) ## ) out <- z*NA # if(any( close_to_crit)){out[ close_to_crit] <- hypergeo_residue_close_to_crit_multiple(A,B,C,z[ close_to_crit], tol=tol, maxiter=maxiter)} # if(any(!close_to_crit)){out[!close_to_crit] <- hypergeo_powerseries (A,B,C,z[!close_to_crit], tol=tol, maxiter=maxiter)} if(any( close_to_crit)){out[ close_to_crit] <- hypergeo_gosper (A,B,C,z[ close_to_crit], tol=tol, maxiter=maxiter)} if(any(!close_to_crit)){out[!close_to_crit] <- hypergeo_powerseries (A,B,C,z[!close_to_crit], tol=tol, maxiter=maxiter)} do_with_cf <- !is.na(z) & is.na(out) # ie failures to converge; do_with_cf == "do with Continued Fraction" if(any(do_with_cf)){ out[do_with_cf] <- hypergeo_contfrac(A=A, B=B, C=C, z=z[do_with_cf], maxiter=maxiter) } do_with_integration <- !is.na(z) & is.na(out) if(any(do_with_integration)){ g <- function(z){f15.3.1(A=A, B=B, C=C, z=z)} out[do_with_integration] <- sapply(z[do_with_integration] , g) } return(out) } "hypergeo_powerseries" <- function(A, B, C, z, tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} z <- z+0i if(is.zero(A) | is.zero(B)){ if(is.zero(C)){ return(z*NA) } else { return(z*0+1) } } if(is.zero(C)){ return(z*Inf) } if(is.zero(A-C)){ return( (1-z)^(-B) ) } else if (is.zero(B-C)){ return( (1-z)^(-A) ) } if(is.nonpos(A) | is.nonpos(B)){ return(hypergeo_AorB_nonpos_int(A,B,C,z,tol=tol)) } if(is.nonpos(C)){ # C is a nonpositive integer; series not defined [unless it terminates in which case a limit is used] return(z*NA) } ## So from here on, A, B, C are either non-integer, or integers >0. if(Re(A) > Re(B)){ swap <- A A <- B B <- swap } # So from here on, A <= B m <- C-A n <- B-A # remember: 'n' must be >= 0 because of the 'swap' above. if(is.near_integer(m)){ if(m <= 0){ return( (1-z)^(C-A-B)*Recall(C-A,C-B,C,z=z,tol=tol,maxiter=maxiter) ) # This is 15.3.3, but do not call f15.3.3(), because this leads to an infinite recursion } else { if(is.near_integer(n)){ # This means B-A and C-A are both integers; the "limiting process" on p560 [just after 15.3.4] needs hypergeo_cover3() return(hypergeo_cover3(A,n,m,z,tol=tol,maxiter=maxiter)) } } } m <- -(A+B-C) # Former bug! if(is.near_integer(m)){ # This is the "Each term of 15.3.6 has a pole..." on p559 return(hypergeo_cover1(A,B,m,z,tol=tol,maxiter=maxiter)) } m <- B-A if(is.near_integer(m)){ # This is the "Similarly each term of 15.3.7..." on p560 return(hypergeo_cover2(A,C,m,z,tol=tol,maxiter=maxiter)) } return(hypergeo_general(A,B,C,z,tol=tol,maxiter=maxiter)) } "hypergeo_general" <- function(A, B, C, z, tol=0, maxiter=2000, give=FALSE){ if(!is.null(getOption("showHGcalls"))){print(match.call())} attr <- attributes(z) z <- as.vector(as.complex(z)) things <- thingfun(z) choice <- apply(things,1,which.min) if(!is.null(getOption("showHGcalls"))){ print("choice: ") print(choice) } u15.1.1 <- choice==1 u15.3.4 <- choice==2 u15.3.6 <- choice==3 u15.3.7 <- choice==4 u15.3.8 <- choice==5 u15.3.9 <- choice==6 out <- z*NA if(any(u15.1.1)){ out[u15.1.1] <- f15.1.1(A=A,B=B,C=C, z[u15.1.1], tol=tol,maxiter=maxiter) } # 1 if(any(u15.3.4)){ out[u15.3.4] <- f15.3.4(A=A,B=B,C=C, z[u15.3.4], tol=tol,maxiter=maxiter) } # 2 if(any(u15.3.6)){ out[u15.3.6] <- f15.3.6(A=A,B=B,C=C, z[u15.3.6], tol=tol,maxiter=maxiter) } # 3 if(any(u15.3.7)){ out[u15.3.7] <- f15.3.7(A=A,B=B,C=C, z[u15.3.7], tol=tol,maxiter=maxiter) } # 4 if(any(u15.3.8)){ out[u15.3.8] <- f15.3.8(A=A,B=B,C=C, z[u15.3.8], tol=tol,maxiter=maxiter) } # 5 if(any(u15.3.9)){ out[u15.3.9] <- f15.3.9(A=A,B=B,C=C, z[u15.3.9], tol=tol,maxiter=maxiter) } # 6 attributes(out) <- attr if(give){ return(list(choice,out)) } else { return(out) } } "thingfun" <- function(z,complex=FALSE){ things <- cbind("z" = z, # 1 "z/(z-1)" = z/(z-1), # 2 "1-z" = 1-z, # 3 "1/z" = 1/z, # 4 "1/(1-z)" = 1/(1-z), # 5 "1-1/z" = 1-1/z # 6 ) if(complex){return(things)} things <- Mod(things) if(any(apply(things,1,min, na.rm=TRUE)>1)){ # Thanks to Igor Kojanov for fixing this stop("odd: none of the transformations take the argument inside the unit disk. Contact the package maintainer") } return(things) } "hypergeo_cover1" <- function(A, B, m, z, tol=0, maxiter=2000, method="a", give=FALSE){ ## use equation 15.3.3 - 15.3.9 EXCEPT 15.3.6, which has a pole when ## a+b-c is an integer. See the bit between 15.3.9 and 15.3.10, ## p559. if(!is.null(getOption("showHGcalls"))){print(match.call())} stopifnot(is.near_integer(m)) C <- A+B+m attr <- attributes(z) z <- as.vector(as.complex(z)) things <- thingfun(z) ## Now to discourage bad ones: if(any(j15.3.7(A,B,C))){ things[,4] <- Inf } if(any(j15.3.8(A,B,C))){ things[,5] <- Inf } if(any(j15.3.9(A,B,C))){ things[,6] <- Inf } ## thus we take the minimum modulus of non-forbidden options. ## Compare similar lines in hypergeo_cover2(): here the functions ## are 7,8,9; there they are 6,8,9 choice <- apply(things,1,which.min) u15.1.1 <- choice==1 u15.3.4 <- choice==2 u15.3.x <- choice==3 # This one! [corresponds to u15.3.6()] u15.3.7 <- choice==4 u15.3.8 <- choice==5 u15.3.9 <- choice==6 out <- z*NA if(any(u15.1.1)){ out[u15.1.1] <- f15.1.1 (A=A,B=B,C=C, z[u15.1.1], tol=tol,maxiter=maxiter) } if(any(u15.3.4)){ out[u15.3.4] <- f15.3.4 (A=A,B=B,C=C, z[u15.3.4], tol=tol,maxiter=maxiter) } if(any(u15.3.x)){ out[u15.3.x] <- f15.3.10_11_12(A=A,B=B,m=m, z[u15.3.x], tol=tol,maxiter=maxiter, method=method) } if(any(u15.3.7)){ out[u15.3.7] <- f15.3.7 (A=A,B=B,C=C, z[u15.3.7], tol=tol,maxiter=maxiter) } if(any(u15.3.8)){ out[u15.3.8] <- f15.3.8 (A=A,B=B,C=C, z[u15.3.8], tol=tol,maxiter=maxiter) } if(any(u15.3.9)){ out[u15.3.9] <- f15.3.9 (A=A,B=B,C=C, z[u15.3.9], tol=tol,maxiter=maxiter) } attributes(out) <- attr if(give){ return(list(choice,out)) } else { return(out) } } "hypergeo_cover2" <- function(A, C, m, z, tol=0, maxiter=2000, method="a", give=FALSE){ if(!is.null(getOption("showHGcalls"))){print(match.call())} ## use equation 15.3.3 - 15.3.9 EXCEPT 15.3.7, which has a pole when ## a+b-c is an integer. See the bit between 15.3.13 and 15.3.15, ## p559. stopifnot(is.near_integer(m)) B <- A+m attr <- attributes(z) z <- as.vector(as.complex(z)) things <- thingfun(z) ## Now to discourage bad ones: if(any(j15.3.6(A,B,C))){ things[,3] <- Inf } if(any(j15.3.8(A,B,C))){ things[,5] <- Inf } if(any(j15.3.9(A,B,C))){ things[,6] <- Inf } choice <- apply(things,1,which.min) u15.1.1 <- choice==1 u15.3.4 <- choice==2 u15.3.6 <- choice==3 u15.3.x <- choice==4 # This one! [corresponds to u15.3.7()] u15.3.8 <- choice==5 u15.3.9 <- choice==6 out <- z*NA if(any(u15.1.1)){ out[u15.1.1] <- f15.1.1 (A=A,B=B,C=C, z[u15.1.1], tol=tol,maxiter=maxiter) } if(any(u15.3.4)){ out[u15.3.4] <- f15.3.4 (A=A,B=B,C=C, z[u15.3.4], tol=tol,maxiter=maxiter) } if(any(u15.3.6)){ out[u15.3.6] <- f15.3.6 (A=A,B=B,C=C, z[u15.3.6], tol=tol,maxiter=maxiter) } if(any(u15.3.x)){ out[u15.3.x] <- f15.3.13_14(A=A,C=C,m=m, z[u15.3.x], tol=tol,maxiter=maxiter, method=method) } if(any(u15.3.8)){ out[u15.3.8] <- f15.3.8 (A=A,B=B,C=C, z[u15.3.8], tol=tol,maxiter=maxiter) } if(any(u15.3.9)){ out[u15.3.9] <- f15.3.9 (A=A,B=B,C=C, z[u15.3.9], tol=tol,maxiter=maxiter) } attributes(out) <- attr if(give){ return(list(choice,out)) } else { return(out) } } "hypergeo_cover3" <- function(A, n, m, z, tol=0, maxiter=2000, method="a", give=FALSE){ if(!is.null(getOption("showHGcalls"))){print(match.call())} stopifnot(is.near_integer(n)) stopifnot(is.near_integer(m)) attr <- attributes(z) z <- as.vector(as.complex(z)) ## following is a cut-down version of thingfun(), tailored for the Wolfram functions: things <- Mod(cbind( "z" = z, # 1 "1/z" = 1/z # 4 ) ) if(any(apply(things,1,min,na.rm=TRUE)>1)){ stop("odd: none of the transformations take the argument inside the unit disk. Contact the package maintainer") } choice <- apply(things,1,which.min) u15.1.1 <- choice==1 u07.23.06.0026.01 <- (choice==2) & (m > n) u07.23.06.0031.01 <- (choice==2) & (m <= n) out <- z*NA if(any(u15.1.1)){ out[u15.1.1] <- f15.1.1(A=A,B=A+n,C=A+m, z[u15.1.1], tol=tol,maxiter=maxiter) } if(any(u07.23.06.0026.01)){ out[u07.23.06.0026.01] <- w07.23.06.0026.01(A=A,n,m, z[u07.23.06.0026.01], tol=tol, maxiter=maxiter, method=method) } if(any(u07.23.06.0031.01)){ out[u07.23.06.0031.01] <- w07.23.06.0031.01(A=A,n,m, z[u07.23.06.0031.01], tol=tol, maxiter=maxiter) } attributes(out) <- attr if(give){ return(list(choice,out)) } else { return(out) } } "f15.3.10_a" <- function(A, B, z, tol=0, maxiter=2000){ #"_a" means use psigamma, "_b" means use 6.3.5, p258 if(!is.null(getOption("showHGcalls"))){print(match.call())} U <- c(A,B) z[Mod(1-z) >= 1] <- NA fac <- 1 l1mz <- log(1+0i-z) temp <- 2*psigamma(0+1)-psigamma(A+0)-psigamma(B+0)-l1mz # n=0 for(n in seq_len(maxiter)){ fac <- fac * prod(U) * ((1-z)/n^2) series <- temp + fac * (2*psigamma(n+1)- psigamma(A+n) - psigamma(B+n) - l1mz) if(isgood(series-temp,tol)){ return(series/beta(A,B)) } temp <- series U <- U+1 } warning("series not converged") return(z*NA) } "f15.3.10_b" <- function(A, B, z, tol=0, maxiter=2000){ #"_a" means use psigamma, "_b" means use 6.3.5, p258 if(!is.null(getOption("showHGcalls"))){print(match.call())} U <- c(A,B) z[Mod(1-z) >= 1] <- NA fac <- 1 pn <- psigamma(1) pa <- psigamma(A) pb <- psigamma(B) l1mz <- log(1+0i-z) temp <- 2*pn-pa-pb-l1mz # n=0 for(n in seq_len(maxiter)){ fac <- fac * prod(U) * ((1-z)/n^2) pn <- pn + 1/n pa <- pa + 1/(A+n-1) # no repeated psigamma() calls; cf 6.3.2, 6.3.5, p258 pb <- pb + 1/(B+n-1) series <- temp + fac * (2*pn - pa - pb - l1mz) if(isgood(series-temp,tol)){ return(series/beta(A,B)) } temp <- series U <- U+1 } warning("series not converged") return(z*NA) } "f15.3.10" <- function(A, B, z, tol=0, maxiter=2000, method="a"){ if(!is.null(getOption("showHGcalls"))){print(match.call())} switch(method, a = f15.3.10_a(A,B,z,tol=tol,maxiter=2000), b = f15.3.10_b(A,B,z,tol=tol,maxiter=2000), stop("method must be either 'a' or 'b'") ) } "f15.3.11_bit1" <- function(A, B, m, z, tol=0){ if(!is.null(getOption("showHGcalls"))){print(match.call())} stopifnot(is.near_integer(m)) stopifnot(m>0) m <- round(m) U <- c(A,B) L <- 1-m mult <- gamma(m)*gamma(A+B+m)/(gamma(A+m)*gamma(B+m)) series <- z*0+1 z[Mod(1-z)>1] <- NA fac <- 1 temp <- fac for (n in seq_len(m-1)) { fac <- fac * (prod(U)/prod(L)) * (1-z)/n series <- temp + fac if (isgood(series-temp,tol)){ return(series * mult) } temp <- series U <- U + 1 L <- L + 1 } return(series*mult) } "f15.3.11_bit2_a" <- function(A, B, m, z, tol=0, maxiter=2000){ #"_a" means use psigamma, "_b" means use 6.3.5. if(!is.null(getOption("showHGcalls"))){print(match.call())} stopifnot(is.near_integer(m)) stopifnot(m>0) U <- c(A+m , B+m) # sic z[Mod(1-z) >= 1] <- NA fac <- 1/factorial(m) l1mz <- log(1+0i-z) temp <- (l1mz-psigamma(0+1)-psigamma(0+m+1) + psigamma(A+0+m) + psigamma(B+0+m) ) * fac for(n in seq_len(maxiter)){ fac <- fac * prod(U) * (1-z)/(n*(n+m)) series <- temp + fac * (l1mz - psigamma(n+1) - psigamma(n+m+1) + psigamma(A+n+m) + psigamma(B+n+m)) if(isgood(series-temp,tol)){ return((z-1)^m * gamma(A+B+m)/(gamma(A)*gamma(B)) * series) } temp <- series U <- U+1 } warning("series not converged") return(z*NA) } "f15.3.11_bit2_b" <- function(A, B, m, z, tol=0, maxiter=2000){ # "_a" means use psigamma, "_b" means use 6.3.5. if(!is.null(getOption("showHGcalls"))){print(match.call())} stopifnot(is.near_integer(m)) stopifnot(m>0) U <- c(A+m , B+m) # sic z[Mod(1-z) >= 1] <- NA fac <- 1/factorial(m) pn <- psigamma( 1) pm <- psigamma(m+1) pa <- psigamma(m+A) pb <- psigamma(m+B) l1mz <- log(1+0i-z) temp <- (l1mz - pn - pm + pa + pb ) * fac for(n in seq_len(maxiter)){ fac <- fac * prod(U) * (1-z)/(n*(n+m)) pn <- pn + 1/n pm <- pm + 1/(n+m) pa <- pa + 1/(A+n+m-1) pb <- pb + 1/(B+n+m-1) series <- temp + fac * (l1mz - pn - pm + pa + pb) if(isgood(series-temp,tol)){ return((z-1)^m * gamma(A+B+m)/(gamma(A)*gamma(B)) * series) } temp <- series U <- U+1 } warning("series not converged") return(z*NA) } "f15.3.11" <- function(A,B,m,z,tol=0, maxiter=2000,method="a"){ if(!is.null(getOption("showHGcalls"))){print(match.call())} switch(method, a = f15.3.11_bit1(A,B,m,z,tol=tol) - f15.3.11_bit2_a(A,B,m,z,tol=tol, maxiter=maxiter), b = f15.3.11_bit1(A,B,m,z,tol=tol) - f15.3.11_bit2_a(A,B,m,z,tol=tol, maxiter=maxiter), stop("method must be either 'a' or 'b'") ) } "f15.3.12_bit1" <- function(A, B, m, z, tol=0){ if(!is.null(getOption("showHGcalls"))){print(match.call())} m <- round(m) U <- c(A-m,B-m) L <- 1-m mult <- ((gamma(m)*gamma(A+B-m))/(gamma(A)*gamma(B))) / (1-z)^m z[Mod(1-z)>1] <- NA fac <- 1 temp <- fac series <- z*0+1 for (n in seq_len(m-1)) { fac <- fac * (prod(U)/prod(L)) * (1-z)/n series <- temp + fac if (isgood(series-temp,tol)){ return(series * mult) } temp <- series U <- U + 1 L <- L + 1 } return(series*mult) } "f15.3.12_bit2_a" <- function(A, B, m, z, tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} m <- round(m) if(is.nonpos(A-m)|is.nonpos(B-m)){return(z*0)} mult <- (-1)^m * gamma(A+B-m)/(gamma(A-m)*gamma(B-m)) U <- c(A , B) # sic z[Mod(1-z) >= 1] <- NA fac <- 1/factorial(m) l1mz <- log(1+0i-z) temp <- (l1mz-psigamma(1)-psigamma(m+1) + psigamma(A) + psigamma(B) ) * fac for(n in seq_len(maxiter)){ fac <- fac * prod(U) * (1-z)/(n*(n+m)) series <- temp + fac * (l1mz - psigamma(n+1) - psigamma(n+m+1) + psigamma(A+n) + psigamma(B+n)) if(isgood(series-temp,tol)){ return(mult * series) } temp <- series U <- U+1 } warning("series not converged") return(z*NA) } "f15.3.12_bit2_b" <- function(A, B, m, z, tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} m <- round(m) if(is.nonpos(A-m)|is.nonpos(B-m)){return(z*0)} mult <- (-1)^m * gamma(A+B-m)/(gamma(A-m)*gamma(B-m)) U <- c(A , B) # sic z[Mod(1-z) >= 1] <- NA fac <- 1/factorial(m) pn <- psigamma(1) pm <- psigamma(m+1) pa <- psigamma(A) pb <- psigamma(B) l1mz <- log(1+0i-z) temp <- (l1mz-pn - pm + pa + pb ) * fac for(n in seq_len(maxiter)){ fac <- fac * prod(U) * (1-z)/(n*(n+m)) pn <- pn + 1/n pm <- pm + 1/(n+m) pa <- pa + 1/(A+n-1) pb <- pb + 1/(B+n-1) series <- temp + fac * (l1mz - pn - pm + pa + pb) if(isgood(series-temp,tol)){ return(mult * series) } temp <- series U <- U+1 } warning("series not converged") return(z*NA) } "f15.3.12" <- function(A, B, m, z, tol=0, maxiter=2000, method = "a"){ if(!is.null(getOption("showHGcalls"))){print(match.call())} switch(method, a = f15.3.12_bit1(A,B,m,z,tol=tol) - f15.3.12_bit2_a(A,B,m,z,tol=tol, maxiter=maxiter), b = f15.3.12_bit1(A,B,m,z,tol=tol) - f15.3.12_bit2_b(A,B,m,z,tol=tol, maxiter=maxiter), stop("method must be one of 'a' or 'b'") ) } "f15.3.13" <- function(A, C, z, tol=0, maxiter=2000, method = "a"){ if(!is.null(getOption("showHGcalls"))){print(match.call())} switch(method, a = f15.3.13_a(A,C,z,tol=tol,maxiter=maxiter), b = f15.3.13_b(A,C,z,tol=tol,maxiter=maxiter) ) } "f15.3.13_a" <- function(A, C, z, tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} U <- c(A,1-C+A) z[Mod(z) < 1] <- NA fac <- 1 pn <- psigamma(1) pa <- psigamma(A) pc <- psigamma(C-A) lmz <- log(0i-z) temp <- lmz + 2*psigamma(1) - psigamma(A) - psigamma(C-A) # n=0 for(n in seq_len(maxiter)){ fac <- fac * prod(U) / (z*n^2) series <- temp + fac * (lmz + 2*psigamma(n+1) - psigamma(A+n) - psigamma(C-A-n)) if(isgood(series-temp,tol)){ return(series * (gamma(C)/(gamma(A)*gamma(C-A))) * (0i-z)^(-A)) } temp <- series U <- U+1 } warning("series not converged") return(z*NA) } "f15.3.13_b" <- function(A, C, z, tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} U <- c(A,1-C+A) z[Mod(z) < 1] <- NA fac <- 1 pn <- psigamma(1) pa <- psigamma(A) pc <- psigamma(C-A) lmz <- log(0i-z) temp <- lmz + 2*pn - pa - pc for(n in seq_len(maxiter)){ fac <- fac * prod(U) / (z*n^2) pn <- pn + 1/n pa <- pa + 1/(A+n-1) pc <- pc - 1/(C-A-n) # The term is psi(c-a-n), not psi(c-a+n) series <- temp + fac * (lmz + 2*pn - pa - pc) if(isgood(series-temp,tol)){ return(series * (gamma(C)/(gamma(A)*gamma(C-A))) * (0i-z)^(-A)) } temp <- series U <- U+1 } warning("series not converged") return(z*NA) } "f15.3.14_bit1_a" <- function(A, C, m, z, tol=0, maxiter=2000){ # "_a" means use psigamma, "_b" means use 6.3.5. if(!is.null(getOption("showHGcalls"))){print(match.call())} m <- round(m) U <- c(A+m, 1-C+A+m) z[Mod(z) < 1] <- NA fac <- (gamma(A+m)/gamma(A)) * (gamma(1-C+A+m)/gamma(1-C+A)) / factorial(m) lmz <- log(0i-z) temp <- (lmz + psigamma(1+m) + psigamma(1) - psigamma(A+m) - psigamma(C-A-m)) * fac for(n in seq_len(maxiter)){ fac <- fac * prod(U) / (z*n*(n+m)) series <- temp + fac * (lmz + psigamma(1+m+n) + psigamma(1+n) - psigamma(A+m+n) - psigamma(C-A-m-n)) if(isgood(series-temp,tol)){ return( (0i-z)^(-A-m) * gamma(C) / (gamma(A+m)*gamma(C-A)) * series) } temp <- series U <- U+1 } warning("series not converged") return(z*NA) } "f15.3.14_bit1_b" <- function(A, C, m, z, tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} m <- round(m) U <- c(A+m, 1-C+A+m) z[Mod(z) < 1] <- NA fac <- (gamma(A+m)/gamma(A)) * (gamma(1-C+A+m)/gamma(1-C+A)) / factorial(m) pm <- psigamma(m+1) pn <- psigamma(1) pa <- psigamma(m+A) pc <- psigamma(C-A-m) lmz <- log(0i-z) temp <- (lmz + pm + pn - pa - pc) * fac for(n in seq_len(maxiter)){ fac <- fac * prod(U) / (z*n*(n+m)) pm <- pm + 1/(n+m) pn <- pn + 1/n pa <- pa + 1/(m+A+n-1) pc <- pc - 1/(C-A-m-n) series <- temp + fac * (lmz + pm + pn - pa - pc) if(isgood(series-temp,tol)){ return( (0i-z)^(-A-m) * gamma(C) / (gamma(A+m)*gamma(C-A)) * series) } temp <- series U <- U+1 } warning("series not converged") return(z*NA) } "f15.3.14_bit2" <- function(A, C, m, z, tol=0){ if(!is.null(getOption("showHGcalls"))){print(match.call())} m <- round(m) stopifnot(m>0) stopifnot(is.near_integer(m)) U <- c(A) mult <- (0i-z)^(-A) * gamma(C) / gamma(A+m) z[Mod(z)<1] <- NA fac <- 1 temp <- gamma(m)/gamma(C-A) series <- z*0+temp for (n in seq_len(m-1)) { fac <- fac * prod(U) / (z*n) series <- temp + fac * gamma(m-n)/gamma(C-A-n) if (isgood(series-temp,tol)){ return(series * mult) } temp <- series U <- U + 1 } return(series*mult) } "f15.3.14" <- function(A, C, m, z, tol=0, maxiter=2000, method="a"){ if(!is.null(getOption("showHGcalls"))){print(match.call())} a1 <- f15.3.14_bit1_a(A,C,m,z,tol=tol,maxiter=maxiter) a2 <- f15.3.14_bit2(A,C,m,z,tol=tol) switch(method, a=f15.3.14_bit1_a(A,C,m,z,tol=tol,maxiter=maxiter) + f15.3.14_bit2(A,C,m,z,tol=tol), b=f15.3.14_bit1_b(A,C,m,z,tol=tol,maxiter=maxiter) + f15.3.14_bit2(A,C,m,z,tol=tol), stop("method must be one of 'a' or 'b'") ) } "f15.3.10_11_12" <- function(A,B,m,z,tol=0,maxiter=2000,method="a"){ if(!is.null(getOption("showHGcalls"))){print(match.call())} stopifnot(is.near_integer(m)) m <- round(m) if(is.zero(m)){ return(f15.3.10(A,B, z,tol=tol,maxiter=maxiter,method=method)) } else if (m>0){ return(f15.3.11(A,B, m,z,tol=tol,maxiter=maxiter,method=method)) } else if (m<0){ return(f15.3.12(A,B,-m,z,tol=tol,maxiter=maxiter,method=method)) } else { stop("this cannot happen") } } "f15.3.13_14" <- function(A, C, m, z, tol=0, maxiter=2000, method="a"){ if(!is.null(getOption("showHGcalls"))){print(match.call())} stopifnot(is.near_integer(m)) m <- round(m) if(is.zero(m)){ return(f15.3.13(A ,C ,z,tol=tol,maxiter=maxiter,method=method)) } else if (m>0){ return(f15.3.14(A ,C, m,z,tol=tol,maxiter=maxiter,method=method)) } else if (m<0){ return(f15.3.14(A+m,C,-m,z,tol=tol,maxiter=maxiter,method=method)) #F(a,b,c;z)==F(b,a,c;z) } else { stop("this cannot happen") } } "w07.23.06.0029.01" <- function(A, n, m, z, tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} ((-1)^m*gamma(A-m)*factorial(m+n)*(0i-z)^(-A-n)/(gamma(A)*factorial(n)))* hypergeo(A+n , m+n+1, n+1, 1/z,tol=tol,maxiter=maxiter) } "w07.23.06.0031.01_bit1" <- function(A, n, m, z, tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} stopifnot(is.near_integer(m)) stopifnot(m>0) U <- c(A,1-m) L <- 1-n mult <- gamma(A+m)*gamma(n) / (gamma(m)*gamma(A+n)) * (0i-z)^(-A) series <- z*0+1 z[Mod(z) < 1] <- NA fac <- 1 temp <- fac for (k in seq_len(m-1)) { # Note iteration is over "k", not "n", as per 07.23.06.0031.01 fac <- fac * (prod(U)/prod(L)) / (k*z) series <- temp + fac if (isgood(series-temp,tol)){ return(series * mult) } temp <- series U <- U + 1 L <- L + 1 } return(series*mult) } "w07.23.06.0031.01_bit2" <- function(A, n, m, z, tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} (-1)^m* (gamma(A+m)/gamma(A)) * factorial(n-m) *(0i-z)^(-A-n) / factorial(n) * hypergeo(A+n , 1-m+n , n+1 , 1/z , tol=tol , maxiter=maxiter) } "w07.23.06.0031.01" <- function(A, n, m, z, tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} stopifnot(m <= n) w07.23.06.0031.01_bit1(A, n, m, z, tol=tol, maxiter=maxiter) + w07.23.06.0031.01_bit2(A, n, m, z, tol=tol, maxiter=maxiter) } "w07.23.06.0026.01" <- function(A, n, m, z, tol=0, maxiter=2000, method="a"){ # checks out with maple. if(!is.null(getOption("showHGcalls"))){print(match.call())} stopifnot(m >= n) stopifnot(m >= 0) stopifnot(n >= 0) stopifnot(is.near_integer(n)) stopifnot(is.near_integer(m)) m <- round(m) n <- round(n) z <- z+0i bit1 <- w07.23.06.0026.01_bit1(A, n, m, z, tol=tol) bit2 <- w07.23.06.0026.01_bit2(A, n, m, z, tol=tol, maxiter=maxiter) bit3 <- switch(method, a = w07.23.06.0026.01_bit3_a(A, n, m, z, tol=tol), b = w07.23.06.0026.01_bit3_b(A, n, m, z, tol=tol), c = w07.23.06.0026.01_bit3_c(A, n, m, z, tol=tol), stop("method must be 'a' or 'b' or 'c'") ) return(bit1 + bit2 + bit3) } "w07.23.06.0026.01_bit1" <- function(A, n, m, z, tol=0){ # Checks with Maple if(!is.null(getOption("showHGcalls"))){print(match.call())} if(length(z)==0){return(z)} if(is.zero(n)){ return(0) } mult <- gamma(n)*gamma(A+m)*(-z)^(-A) / (gamma(m)*gamma(A+n)) U <- c(A,1-m) L <- 1-n series <- z*0+1 z[Mod(z) < 1] <- NA fac <- 1 # k=0 temp <- fac for (k in seq_len(n-1)) { fac <- fac * (prod(U)/prod(L)) /(z*k) series <- temp + fac if (isgood(series-temp,tol)){ return(series * mult) } temp <- series U <- U + 1 L <- L + 1 } return(series*mult) } "w07.23.06.0026.01_bit2" <- function(A, n, m, z, tol=0, maxiter = 2000){ # checks with Maple if(!is.null(getOption("showHGcalls"))){print(match.call())} mult <- (-1)^n * gamma(A+m)^2 * (-z)^(-A-m) / (gamma(A)*gamma(A+n)*factorial(m)*factorial(m-n)) return(mult * genhypergeo(U=c(1,1,A+m),L=c(m+1,m-n+1), z=1/z, tol=tol, maxiter=maxiter)) } "w07.23.06.0026.01_bit3_a" <- function(A, n, m, z, tol=0){ #"_a" means use psigamma, "_b" means use 6.3.5. if(!is.null(getOption("showHGcalls"))){print(match.call())} U <- c(A+n , 1-m+n) mult <- (-1)^n * gamma(A+m) / (gamma(A)*factorial(m-n-1)) * (-z)^(-A-n) fac <- 1/factorial(n) lmz <- log(0i-z) temp <- (lmz - psigamma(m-n-0) +psigamma(0+1) + psigamma(0+n+1) - psigamma(A+0+n)) * fac #k=0 series <- temp for(k in seq_len(m-n-1)){ fac <- fac * prod(U) / (z * k * (k+n)) series <- temp + fac * (lmz - psigamma(m-n-k) + psigamma(k+1) + psigamma(k+n+1) - psigamma(A+k+n)) if(isgood(series-temp,tol)){ return(series*mult) } temp <- series U <- U+1 } return(series*mult) } "w07.23.06.0026.01_bit3_b" <- function(A, n, m, z, tol=0){ #"_a" means use psigamma, "_b" means use 6.3.5. if(!is.null(getOption("showHGcalls"))){print(match.call())} U <- c(A+n , 1-m+n) mult <- (-1)^n*gamma(A+m) / (gamma(A)*factorial(m-n-1)) * (-z)^(-A-n) fac <- 1/factorial(n) lmz <- log(0i-z) p1 <- psigamma(m-n) p2 <- psigamma(1) p3 <- psigamma(n+1) p4 <- psigamma(A+n) temp <- (lmz - p1 + p2 + p3 - p4) * fac series <- temp for(k in seq_len(m-n-1)){ fac <- fac * prod(U) / (z * k * (k+n) ) p1 <- p1 - 1/(m-n-k) p2 <- p2 + 1/k p3 <- p3 + 1/(k+n) p4 <- p4 + 1/(A+k+n-1) series <- temp + fac * (lmz - p1 + p2 + p3 - p4) if(isgood(series-temp,tol)){ return(series*mult) } temp <- series U <- U+1 } return(series*mult) } "w07.23.06.0026.01_bit3_c" <- function(A, n, m, z, tol=0){ #"_a" means # use psigamma, "_b" means use 6.3.5; here "_c" means use a totally # dull, slow, direct (but clearly correct) summation, for the # purposes of debugging. if(!is.null(getOption("showHGcalls"))){print(match.call())} poch <- function(x,j){ prod(x + (seq_len(j)-1)) } mult <- ((-1)^n*gamma(A+m)/(gamma(A)*factorial(m-n-1)))*(-z)^(-A-n) out <- 0 for(k in 0:(m-n-1)){ out <- out + ( (poch(A+n,k) * poch(1-m+n,k))/(factorial(k)*factorial(k+n)) ) * (log(-z) - psigamma(m-n-k)+psigamma(k+1)+psigamma(k+n+1)-psigamma(A+k+n))*z^(-k) } return(out * mult) } "genhypergeo_contfrac_single" <- function(U, L, z, tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} f <- function(k){prod(U+k)/prod(k+c(1,L))} alpha <- z*sapply(seq_len(maxiter), f) 1+z*prod(U)/(prod(L)*(1+GCF(a = -alpha , b = 1+alpha, tol=tol))) } "genhypergeo_contfrac" <- function(U, L, z, tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} attr <- attributes(z) f <- function(z){genhypergeo_contfrac_single(U, L, z=z, tol=tol, maxiter=maxiter)} out <- sapply(z,f) attributes(out) <- attr return(out) } "hypergeo_contfrac" <- function(A, B, C, z, tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} attr <- attributes(z) f <- function(z){genhypergeo_contfrac_single(U=c(A, B), L=C, z=z, tol=tol, maxiter=maxiter)} out <- sapply(z,f) attributes(out) <- attr return(out) } "hypergeo_residue_general" <- function(A, B, C, z, r, O=z, tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} stopifnot(length(z)==1) residue(f=function(z){hypergeo(A,B,C,z,tol=tol,maxiter=maxiter)}, z0=z, r=0.15, O=O) # NB: residue() is defined in the elliptic package } "hypergeo_residue_close_to_crit_single" <- function(A, B, C, z, strategy='A', tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} jj <- crit() c1 <- jj[1] c2 <- jj[2] if( (abs(z-c1) <= 0.1) & (abs(z-c2) <= 0.1) ) {stop("this cannot happen")} stopifnot( (abs(z-c1) <= 0.1) | (abs(z-c2) <= 0.1) ) if(abs(z-c1) <= 0.1){ crit <- c1 } else { crit <- c2 } O <- switch( strategy, A = crit, B = z, stop('strategy must be A or B') ) hypergeo_residue_general(A=A,B=B,C=C, z=z, r=0.15, O=O, tol=tol, maxiter=maxiter) } "hypergeo_residue_close_to_crit_multiple" <- function(A, B, C, z, strategy='A', tol=0, maxiter=2000){ if(!is.null(getOption("showHGcalls"))){print(match.call())} sapply(z, function(z){ hypergeo_residue_close_to_crit_single(A,B,C,z,strategy=strategy,tol=tol,maxiter=maxiter) } ) } "lpham" <- function(x,n){lgamma(x+n)-lgamma(x)} "buhring_eqn11" <- function(n,S,A,B,C,z0=1/2){ #NB no z stopifnot(length(z0)==1) if(length(n)>1) {return(sapply(n,function(nn){buhring_eqn11(n=nn,S,A,B,C,z0=z0)}))} return( exp( +lpham(S,n) +lpham(1+S-C,n) -lpham(1+2*S-A-B,n) -lfactorial(n) ) * hypergeo(-n, A+B-2*S-n, C-S-n, z=z0) ) } "buhring_eqn12" <- function(n,S,A,B,C,z0=1/2){ stopifnot(length(z0)==1) if(length(n)>1) {return(sapply(n,function(nn){buhring_eqn12(n=nn,S,A,B,C,z0=z0)}))} return( (-1)^n* exp( +lpham(S,n) +lpham(S+C-A-B,n) -lpham(1+2*S-A-B,n) -lfactorial(n) ) * hypergeo(-n,A+B-2*S-n, 1+A+B-S-C-n, z=1-z0) ) } "buhring_eqn5_factors" <- function(A,B,C,z,z0=1/2){ c( exp( +lgamma(C) +lgamma(B-A) -lgamma(B) -lgamma(C-A) -A*log(z0-z) ), exp( +lgamma(C) +lgamma(A-B) -lgamma(A) -lgamma(C-B) -B*log(z0-z) ) ) } "buhring_eqn5_series" <- function(S,A,B,C,z,z0=1/2,use11=FALSE,tol=0,maxiter=2000){ # sum if(!is.null(getOption("showHGcalls"))){print(match.call())} if(length(z)==0){return(z)} if(use11){ f <- buhring_eqn11 } else { f <- buhring_eqn12 } temp <- 1 n <- 1 while(n < maxiter){ out <- temp + f(n,S=S,A=A,B=B,C=C,z0=z0)/(z-z0)^n if(isgood(out-temp,tol)){return(out)} temp <- out n <- n+1 } warning("series not converged") return(out) } "hypergeo_buhring" <- function(A,B,C,z,z0=1/2,tol=0,maxiter=2000,use11=TRUE){ jj <- buhring_eqn5_factors(A,B,C,z,z0) return( jj[1]*buhring_eqn5_series(S=A,A,B,C,z,z0=1/2,use11=use11,tol=tol,maxiter=maxiter)+ jj[2]*buhring_eqn5_series(S=B,A,B,C,z,z0=1/2,use11=use11,tol=tol,maxiter=maxiter) ) } "shanks" <- function(Last,This,Next){ if(identical(Next,This)){return(Next)} num <- Next*Last - This^2 den <- Next-2*This+Last if(den==0){ return(Next) } else { return(num/den) } } "genhypergeo_shanks" <- function (U, L, z, maxiter=20){ if(!is.null(getOption("showHGcalls"))){print(match.call())} fac <- 1 temp <- fac if(maxiter==0){ return(z*0+fac) } Last <- 0 This <- 1 Next <- 2 Shanks <- shanks(Last,This,Next) for (n in seq_len(maxiter)) { fac.old <- fac fac <- fac * (prod(U)/prod(L)) * (z/n) fac.new <- fac series <- temp + fac ## following three lines a "conveyor belt" Next -> This -> Last Last <- This This <- Next Next <- series Shanks.old <- Shanks Shanks <- shanks(Last,This,Next) temp <- series U <- U + 1 L <- L + 1 } return(series) } "hypergeo_shanks" <- function (A, B, C, z, maxiter = 20){ genhypergeo_shanks(U=c(A,B), L=C, z=z,maxiter=maxiter) } "hypergeo_gosper" <- function(A, B, C, z, tol=0, maxiter=2000){ d <- 0 e <- 1 f <- 0 for(k in 0:maxiter){ dnew <- (k+A)*(k+B)*z*(e-(k+C-B-A)*d*z/(1-z)) /(4*(k+1)*(k+C/2)*(k+(C+1)/2)) enew <- (k+A)*(k+B)*z*(A*B*d*z/(1-z) + (k+C)*e)/(4*(k+1)*(k+C/2)*(k+(C+1)/2)) fnew <- f-d*(k*((C-B-A)*z+k*(z-2)-C)-A*B*z) /(2* (k+C/2)*(1-z) )+e if(isgood(f-fnew,tol)){return(f)} d <- dnew e <- enew f <- fnew } warning("not converged") return(f) } hypergeo/vignettes/0000755000176200001440000000000012564167700014114 5ustar liggesusershypergeo/vignettes/hypergeometric.bib0000644000176200001440000000476012564167332017630 0ustar liggesusers@Book{abramowitz1965, author = {M. Abramowitz and I. A. Stegun}, title = {Handbook of Mathematical Functions}, publisher = {New York: Dover}, year = {1965} } @Article{buhring1987, author = {W. Buhring}, title = {An analytic continuation of the hypergeometric series}, journal = {Siam J. Math. Anal.}, year = {1987}, volume = {18}, number = {3}, pages = {884-889} } @Article{thaller1998, author = {B. Thaller}, title = {Visualization of Complex Functions}, journal = {The \proglang{Mathematica} Journal}, year = {1998}, volume = {7}, number = {2}, pages = {163--180}} @Article{forrey1997, author = {R. C. Forrey}, title = {Computing the hypergeometric function}, journal = {Journal of computational physics}, year = {1997}, volume = {137}, pages = {79--100} } @Article{michel2008, author = {N. Michel and M. V. Stoitsov}, title = {Fast computation of the {G}auss hypergeometric function with all its parameters complex with application to the {P}\"{o}schl-{T}eller-{G}inocchio potential wave functions}, journal = {Computer Physics Communictions}, year = {2008}, volume = {178}, pages = {535--551} } @Article{becken2000, author = {W. Becken and P. Schmelcher}, title = {The analytic continuation of the {G}aussian hypergeometric function $\ft\left(a,b;c;z\right)$ for arbitrary parameters}, journal = {Journal of Computational and Applied Mathematics}, year = {2000}, volume = {126}, pages = {449--478} } @manual{mpmath, author = {Fredrik Johansson and others}, title = {\proglang{mpmath}: A \proglang{Python} library for arbitrary-precision floating-point arithmetic (version 0.14)}, note = {\url{http://code.google.com/p/mpmath/}}, month = {February}, year = {2010} } @Article{hankin2006, title = {Introducing \pkg{elliptic}, an \proglang{R} package for elliptic and modular functions}, author = {Robin K. S. Hankin}, journal = {Journal of Statistical Software}, year = {2006}, month = {February}, volume = {15}, issue = {7} } @Book{cuyt2008, author = {A. Cuyt and others}, title = {Handbook of continued fractions for special functions}, publisher = {Springer}, year = {2008} } @Misc{wolfram2014, author = {S. Wolfram}, title = {The Hypergeometric function}, year = {2014}, note = {File \code{Hypergeometric2F1.pdf}, downloaded from \url{http:/functions.wolfram.com/HypergeometricFunctions/}} } hypergeo/vignettes/hypergeometric.Rnw0000644000176200001440000004321312564167332017636 0ustar liggesusers % -*- mode: noweb; noweb-default-code-mode: R-mode; -*- \documentclass[nojss]{jss} \usepackage{dsfont} \usepackage{bbm} \usepackage{amsmath} \usepackage{amssymb} \usepackage{algpseudocode} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% declarations for jss.cls %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \DeclareMathOperator*{\ketten}{K} \newcommand{\Fmn}[2]{\ensuremath{\operatorname{{}_{#1}F_{#2}}}} \newcommand{\ft}{\ensuremath{\Fmn{2}{1}}} \newcommand{\fall}[2]{\left(#1\right)_{#2}} \newcommand{\rise}[2]{\left(#1\right)^{#2}} \newcommand{\ams}[1]{$\left(#1\right)$} %% just as usual \author{Robin K. S. Hankin\\Auckland University of Technology} \title{Numerical evaluation of the Gauss hypergeometric function with the \pkg{hypergeo} package} %\VignetteIndexEntry{The hyperdirichlet distribution in practice} %% for pretty printing and a nice hypersummary also set: \Plainauthor{Robin K. S. Hankin} \Plaintitle{The hypergeo package} \Keywords{Hypergeometric functions, numerical evaluation, complex plane, \proglang{R}, residue theorem} \Plainkeywords{Hypergeometric functions, numerical evaluation, complex plane, R, residue theorem} \Abstract{This paper introduces the \pkg{hypergeo} package of R routines, for numerical calculation of hypergeometric functions. The package is focussed on efficient and accurate evaluation of the hypergeometric function over the whole of the complex plane within the constraints of fixed-precision arithmetic. The hypergeometric series is convergent only within the unit circle, so analytic continuation must be used to define the function outside the unit circle. This short document outlines the numerical and conceptual methods used in the package; and justifies the package philosophy, which is to maintain transparent and verifiable links between the software and AMS-55. The package is demonstrated in the context of game theory. } %% publication information %% NOTE: This needs to filled out ONLY IF THE PAPER WAS ACCEPTED. %% If it was not (yet) accepted, leave them commented. %% \Volume{13} %% \Issue{9} %% \Month{September} %% \Year{2004} %% \Submitdate{2004-09-29} %% \Acceptdate{2004-09-29} %% The address of (at least) one author should be given %% in the following format: \Address{ Robin K. S. Hankin\\ Auckland University of Technology\\ New Zealand\\ E-mail: \email{hankin.robin@gmail.com}\\ } %% need no \usepackage{Sweave.sty} \SweaveOpts{} \begin{document} <>= calculate_from_scratch <- FALSE @ \section{Introduction} The {\em geometric} series~$\sum_{k=0}^\infty t_k$ with~$t_k=z^k$ may be characterized by its first term and the constant ratio of successive terms~$t_{k+1}/t_k=z$, giving the familiar identity~$\sum_{k=0}^\infty z^k=\left(1-z\right)^{-1}$. Observe that while the series has unit radius of convergence, the right hand side is defined over the whole complex plane except for~$z=1$ where it has a pole. Series of this type may be generalized to a {\em hypergeometric} series in which the ratio of successive terms is a rational function of~$k$: \[ \frac{t_{k+1}}{t_k}=\frac{P(k)}{Q(k)} \] where~$P(k)$ and~$Q(k)$ are polynomials. If both numerator and denominator have been completely factored we would write \[ \frac{t_{k+1}}{t_k} = \frac{(k+a_1)(k+a_2)\cdots(k+a_p)}{(k+b_1)(k+b_2)\cdots(k+b_q)(k+1)}z \] \noindent (the final term in the denominator is due to historical reasons), and if we require~$t_0=1$ then we write \begin{equation}\label{genhypergeo_definition} \sum_{k=0}^\infty t_kz^k= \Fmn{a}{b}\left[{ a_1, a_2, \ldots,a_p\atop b_1, b_2, \ldots,b_q} ; z\right] \end{equation} when defined. An absent factor is indicated with a dash; thus $\Fmn{0}{0}\left[\begin{array}{l}-\\-\end{array};z\right]=e^z$. In most cases of interest one finds that~$p=2$, $q=1$ suffices. Writing~$a,b,c$ for the two upper and one lower argument respectively, the resulting function~$\ft\left(a,b;c;z\right)$ is known as {\em the} hypergeometric function. Many functions of elementary analysis are of this form; examples would include logarithmic and trigonometric functions, Bessel functions, etc. For example, $\ft\left(\frac{1}{2},1;\frac{3}{2};-z^2\right)=z^{-1}\operatorname{\arctan} z$. \citet{michel2008} state that physical applications are ``plethora''. In addition, naturally-occuring combinatorial series frequently have a sum expressible in terms of hypergeometric functions and an example from the author's work in the field game theory is given below. \subsection{Equivalent forms} The hypergeometric function's series representation, namely \begin{equation}\label{series}\tag{15.1.1} \ft\left(a,b;c;z\right)=\sum_{k=0}^\infty\frac{\fall{a}{k}\fall{b}{k}}{\fall{c}{k}k!}z^k,\qquad \fall{a}{k}=\Gamma(a+k)/\Gamma(a) \end{equation} \noindent has unit radius of convergence by the ratio test but the integral form \begin{equation}\label{integral}\tag{15.3.1} \ft\left(a,b;c;z\right)= \frac{\Gamma(c)}{\Gamma(b)\Gamma(c-b)}\int_{t=0}^1 t^{b-1}(1-t)^{c-b-1}(1-tz)^{-a}\,dt, \end{equation} \noindent due to Gauss, furnishes analytic continuation; it is usual to follow Riemann and define a cut along the positive real axis from~$1$ to~$\infty$ and specify continuity from below [NB: equations with three-part numbers, as \ref{series} and \ref{integral} above, are named for their reference in~\citet{abramowitz1965}]. This is implemented as \code{f15.3.1()} in the package and exhibits surprisingly accurate evaluation. Gauss also provided a continued fraction form for the hypergeometric function [implemented as~\code{hypergeo_contfrac()} in the package] which has superior convergence rates for parts of the complex plane at the expense of more complicated convergence properties~\citep{cuyt2008}. \section{The hypergeo package} The \pkg{hypergeo} package provides some functionality for the hypergeometric function; the emphasis is on fast vectorized \proglang{R}-centric code, complex~$z$ and moderate real values for the auxiliary parameters~$a,b,c$. The package is released under GPL-2. Observing the slow convergence of the series representation~\ref{series}, the complex behaviour of the continued fraction representation, and the heavy computational expense of the integral representation~\ref{integral}, it is clear that non-trivial numerical techniques are required for a production package. The package implements a generalization of the method of~\citet{forrey1997} to the complex case. It utilizes the observation that the ratio of successive terms approaches~$z$, and thus the strategy adopted is to seek a transformation which reduces the modulus of~$z$ to a minimum. \citeauthor{abramowitz1965} give the following transformations: \newcommand{\four}[4]{\frac{\Gamma\left(#1\right)\Gamma\left(#2\right)}{\Gamma\left(#3\right)\Gamma\left(#4\right)}} \begin{align} \ft\left(a,b;c;z\right) &= \left(1-z\right)^{-a}\ft\left(a,c-b;c;\frac{z}{z-1}\right)\tag{15.3.4}\label{15.3.4}\\ &= \left(1-z\right)^{-b}\ft\left(a,c-a;c;\frac{z}{z-1}\right)\tag{15.3.5}\label{15.3.5}\\ &= \four{c}{c-a-b}{c-a}{c-b}\ft\left(a,b;a+b-c+1;1-z\right)\nonumber\\ &{}\qquad+ (1-z)^{c-a-b}\four{c}{a+b-c}{a}{b}\ft\left(c-a,c-b;c-a-b+1;1-z\right)\label{15.3.6}\tag{15.3.6}\\ &= \four{c}{b-a}{b}{c-a}\left(-z\right)^{-a}\ft\left(a,1-c+a;1-b+a;\frac{1}{z}\right)\nonumber\\ &{}\qquad+\four{c}{a-b}{a}{c-b}\left(-z\right)^{-b}\ft\left(b,1-c+b;1-a+b;\frac{1}{z}\right)\label{15.3.7}\tag{15.3.7}\\ &= (1-z)^{-a}\four{c}{b-a}{b}{c-a}\ft\left(a,c-b;a-b+1;\frac{1}{1-z}\right)\nonumber\\ &{}\qquad+(1-z)^{-b}\four{c}{a-b}{a}{c-b}\ft\left(b,c-a;b-a+1;\frac{1}{1-z}\right)\label{15.3.8}\tag{15.3.8}\\ &=\four{c}{c-a-b}{c-a}{c-b}z^{-a}\ft\left(a,a-c+1;a+b-c+1;1-\frac{1}{z}\right)\nonumber\\ &{}\qquad+\four{c}{a+b-c}{a}{b}(1-z)^{c-a-b}z^{a-c}\ft\left(c-a,1-a;c-a-b+1;1-\frac{1}{z}\right)\label{15.3.9}\tag{15.3.9}. \end{align} Observing that the set~$\left\{z,\frac{z}{z-1},1-z,\frac{1}{z},\frac{1}{1-z},1-\frac{1}{z}\right\}$ forms a group under functional composition\footnote{It is the anharmonic subgroup of the M\"{o}bius transformations, generated by~$z\longrightarrow 1/z$ and~$z\longrightarrow 1-z$. It is isomorphic to~$S_3$, the symmetric group on~3 elements.} we may apply each of the transformations to the primary argument~$z$ and choose the one of smallest absolute value to evaluate. Given the appropriate transformation, the right hand side is evaluated using direct summation. If~$\left|z\right|<1$, the series is convergent by the ratio test, but may require a large number of terms to achieve acceptable numerical precision. Summation is dispatched to \code{genhypergeo_series()} which evaluates the generalized hypergeometric function~\ref{genhypergeo_definition}; the \proglang{R} implementation uses multiplication by repeatedly incremented upper and lower indices~$a_i,b_i$. %\begin{algorithmic}\label{alt} % \State $\mathit{fac}\gets 1$ % \State $\mathit{temp}\gets\mathit{fac}$ % \State $\mathit{series}\gets\mathit{ZXCVXCVDFADF}$ % \While {$\mathit{series}\neq\mathit{temp}$} % \State $\mathit{fac}\gets % \mathit{fac}\times\frac{a_1\times\cdots\times a_p}{b_1\times\cdots\times b_q}\times z$ % \State $a_1\gets a_1+1,\ldots, b_q\gets b_q+1$ % \State $temp\gets \mathit{series}$ % \State $\mathit{series}\gets \mathit{series}+\mathit{fac}$ % \EndWhile %\end{algorithmic} %(lower indices~$b_i$ are appended with a ``$+1$''). Thus for example if $(1-z)^{-1}$ is small in absolute value we would use function \code{f13.3.8()}: \begin{Schunk} \begin{Sinput} > require("hypergeo") > f15.3.8 \end{Sinput} \begin{Soutput} function(A,B,C,z,tol=0,maxiter=2000){ jj <- i15.3.8(A,B,C) jj[1]*(1-z)^(-A)*genhypergeo(U=c(A,C-B),L=A-B+1,z=1/(1-z),tol=tol,maxiter=maxiter) + jj[2]*(1-z)^(-B)*genhypergeo(U=c(B,C-A),L=B-A+1,z=1/(1-z),tol=tol,maxiter=maxiter) } \end{Soutput} \end{Schunk} \noindent (slightly edited in the interests of visual clarity). This is a typical internal function of the package and like all similar functions is named for its equation number in~\cite{abramowitz1965}. Note the helper function \code{i15.3.9()}, which calculates the Gamma coefficients of the two hypergeometric terms in the identity. This structure allows transparent checking of the code. \subsection{Special cases} The methods detailed above are not applicable for all values of the parameters~$a,b,c$. If, for example, $c=a+b\pm m$, $m\in\mathbb{N}$ (a not uncommon case), then equation~\ref{15.3.6} is not useful because each term has a pole; and it is numerically difficult to approach the limit. In this case the package dispatches to \code{hypergeo_cover1()} which uses~\ref{15.3.4} through~\ref{15.3.9} but with~\ref{15.3.6} replaced with suitable limiting forms such as \begin{equation}\tag{15.3.11}\label{15.3.11} \ft\left(a,b;a+b+m;z\right)=\frac{\Gamma(a+b)}{\Gamma(a)\Gamma(b)} \sum_{n=0}^\infty\frac{(a)_n(b)_n}{(n!)^2}\left[ 2\psi(n+1)-\psi(a+n)-\psi(b+n)-\log(1-z)\right](1-z)^n,\qquad\pi<\left|\operatorname{\arg}(1-z)\right|<\pi,\left|1-z\right|<1 \end{equation} (\citeauthor{abramowitz1965} give a similar expression for negative~$m$). This equation is comparable to~\ref{15.3.6} in terms of computational complexity but requires evaluation of the digamma function~$\psi$. Equation~\ref{15.3.11} is evaluated in the package using an algorithm similar to that for \code{genhypergeo_series()} but includes a runtime option which specifies whether to evaluate~$\psi\left(\cdot\right)$ \emph{ab initio} each time it is needed, or to use the recurrence relation~$\psi\left(z+1\right)=\psi\left(z\right)+1/z$ at each iteration after the first. These two options appear to be comparable in terms of both numerical accuracy and speed of execution, but further work would be needed to specify which is preferable in this context. A similar methodology is used for the case~$b=a\pm m$, $m=0,1,2,\ldots$ in which case the package dispatches to \code{hypergeo_cover2()}. However, the case~$c-a=0,1,2,\ldots$ is not covered by~\cite{abramowitz1965} and the package dispatches to~\code{hypergeo_cover3()} which uses formulae taken from the Wolfram functions site~\citep{wolfram2014}. For example \code{w07.23.06.0026.01()} gives a straightforwardly implementable numerical expression for~$\Fmn{2}{1}$ as a sum of two {\em finite} series and a generalized hypergeometric function~$\Fmn{3}{2}$ with primary argument~$z^{-1}$. In all these cases, the limiting behaviour is problematic. For example, if~$a+b-c$ is close to, but not exactly equal to, an integer then equation~\ref{15.3.11} is not applicable. The analytic value of the hypergeometric function in these circumstances is typically of moderate modulus, but both terms of equation~\ref{15.3.6} have large amplitude and numerics are susceptible to cancellation errors. \subsection{Critical points} All the above methods fail when~$z=\frac{1}{2}\pm\frac{i\sqrt{3}}{2}$, because none of the transformations~\ref{15.3.6}-\ref{15.3.9} change the modulus of~$z$ from 1. The function is convergent at these points but numerical evaluation is difficult. This issue does not arise in the real case considered by~\citet{forrey1997}. These points were considered by \cite{buhring1987} who presented a computational method for these values; however, his method is not suitable for finite-precision arithmetic (a brief discussion is presented at \code{?buhring}) and the package employs either an iterative scheme due to Gosper~\citep{mpmath}, or the residue theorem if~$z$ is close to either of these points. \section{Package testing suite} The package comes with an extensive test suite in the \code{tests/} directory. The tests fall into two main categories, firstly comparison with either \proglang{Maple} or \proglang{Mathematica} output (although~\cite{becken2000} caution that \proglang{Mathematica} routines cannot be used as reference values); and secondly, verification of identities which appear in AMS-55 as named equations. \section{The package in use} The \pkg{hypergeo} package offers direct numerical functionality to the \proglang{R} user on the command line. One example from the author's current work is in game theory. Consider a game in which a player is given~$n$ counters each of which she must allocate into one of two boxes, $A$ or $B$. At times $t = 1,2,3\ldots$ a box is identified at random and, if it is not empty, a counter removed from it; box~$A$ is chosen with probability~$p$ and box~$B$ with probability~$1-p$. The object of the game is to remove all counters as quickly as possible. If the player places~$a$ counters in box~$A$ and~$b$ in~$B$, then the probability mass function of removing the final counter at time~$t=a+b+r$ is <>= require("hypergeo") require("elliptic") @ \begin{equation} p^a(1-p)^b\left[ {a+b+r-1 \choose a-1, b+r}(1-p)^r+ {a+b+r-1 \choose a+r, b-1}p^r \right],\qquad r=0,1,2,\ldots. \end{equation} The two terms correspond to the final counter being removed from box~$A$ or~$B$ respectively. This PMF has expectation \begin{align} p^a(1-p)^b\left[ p {a+b\choose a+1,b-1}\,\ft\left(a+b+1,2;a+2;p\right)+\right.\nonumber\\ \left. (1-p){a+b\choose a-1,b+1}\,\ft\left(a+b+1,2;b+2;1-p\right) \right]\label{expectation} \end{align} with \proglang{R} idiom: <>= expected <- function(a,b,p){ Re( choose(a+b,b) * p^a * (1-p)^b * ( p *b/(1+a) * hypergeo(a+b+1,2,a+2, p) + (1-p)*a/(1+b) * hypergeo(a+b+1,2,b+2,1-p) )) } @ Thus if~$p=0.8$ and given~$n=10$ counters we might wonder whether it is preferable to allocate them~$(8,2)$ or~$(9,1)$: <>= c(expected(8,2,0.8),expected(9,1,0.8)) @ showing that the latter allocation is preferable in expectation. The package is designed for use with \proglang{R} and Figure~\ref{complexhypergeometricplot} shows the package being used to visualize~$\ft\left(2,\frac{1}{2};\frac{2}{3};z\right)$ over a region of the complex plane. %% Thanks to Dario Strbenac for the following structure <>= png("hypergeometric_plot.png",width=800,height=800) @ <>= x <- seq(from=0,to=2,len=200) y <- seq(from=-1,to=1,len=200) z <- outer(x,1i*y,"+") hz <- hypergeo(2,1/2,2/3,z) par(pty='s') view(x,y,hz,levels=seq(from=-4,to=4),xlab='Real',ylab='Imag') @ <>= null <- dev.off() @ \begin{figure}[htbp] \begin{center} \includegraphics{hypergeometric_plot.png} \caption{View of the\label{complexhypergeometricplot} function~$\ft\left(2,\frac{1}{2};\frac{2}{3};z\right)$ evaluated over a part of the complex plane using the \pkg{hypergeo} package. Function visualization following \cite{thaller1998} and the \pkg{elliptic} package~\citep{hankin2006}; hue corresponds to argument and saturation to modulus. Solid contour lines correspond to real function values and dotted to imaginary function values. Note the cut line along the real axis starting at~$\left(1,0\right)$, made visible by an abrupt change in hue} \end{center} \end{figure} \subsection{Conclusions and further work} Evaluation of the hypergeometric function is hard, as evidenced by the extensive literature concerning its numerical evaluation~\citep{becken2000,michel2008,forrey1997,buhring1987}. The \pkg{hypergeo} package is presented as a partial implementation, providing reasonably accurate evaluation over a large portion of the complex plane and covering moderate real values of the auxiliary parameters~$a,b,c$. Difficulties arise when~$b-a$ or~$c-b-a$ become close to, but not exactly, integers because the terms in equations~\ref{15.3.6} through~\ref{15.3.9} become large and cancellation errors become important. Further work might include extension to complex auxiliary parameters but \citeauthor{michel2008} caution that this is not straightforward. \bibliography{hypergeometric} \end{document} hypergeo/MD50000644000176200001440000000310512564214747012417 0ustar liggesusers9ea4c8f43b037c83c5fd955856d1d330 *DESCRIPTION 4e86dd02472144647148025c26b1bd99 *NAMESPACE 4dd632437c6add520a5e69fa03c20a07 *R/hypergeo.R fe4b1db176b33230ceacfc9d6df94689 *R/hypergeo_ODE.R dc2495d8074e3da43d55084cb8108852 *build/vignette.rds 9fca3ecd77fca74062fa41efb058383d *inst/CITATION 97c20a03e78f040affea25bbfd58ce79 *inst/doc/hypergeometric.R 469c426b5c6584f1cb050e6e6e012382 *inst/doc/hypergeometric.Rnw 70cf0405d1687d13fecf7d1493c46291 *inst/doc/hypergeometric.pdf c8a4463bc2d17c9db8130be319e36370 *man/buhring.Rd 7fefa4bec729d99e942b537949299536 *man/f15.3.1.Rd 4cb813110626c4bf05432696309ec7f1 *man/f15.3.10.Rd be64f0a8ecf2fac543c0e635d570dd68 *man/f15.3.3.Rd b6a138119fb12f9bb3089e13b65d59da *man/f15.5.1.Rd b069a62f1b9d1bc54d4b90f73f7099f2 *man/genhypergeo.Rd 1035ee52d1d750bcc6d5903ea89c0803 *man/hypergeo-package.Rd ad0ae45e15efbd598a845807ef6b95d1 *man/hypergeo.Rd cb09627e7f531facf8e9255d8fe35147 *man/hypergeo_A_nonpos_int.Rd 4eaafe15868d29d4fae07d6b9400e932 *man/hypergeo_contfrac.Rd d43e1b448635a86a264f183b598b8312 *man/hypergeo_cover1.Rd c07e80bba13f0b2c644a704392656402 *man/hypergeo_gosper.Rd da444b2f63ba435fa0b4c0c0b3668ecf *man/hypergeo_powerseries.Rd 4f29a4b3231103af7d0d39e5094bd454 *man/hypergeo_residue.Rd d6791005c8e6e2a46b27f76f77c88d7a *man/i15.3.6.Rd a775af609139978ad75a746880bf9f6a *man/is.nonpos.Rd 823659b3fd44fa60eadc9237619c004e *man/shanks.Rd c6e90c69cb40b5594243e51c41b22c92 *man/wolfram.Rd a1488627cc177f9136f845be8b820366 *tests/aaa.R 469c426b5c6584f1cb050e6e6e012382 *vignettes/hypergeometric.Rnw 0a72f0f2b1e668f6089f4e50158837f3 *vignettes/hypergeometric.bib hypergeo/build/0000755000176200001440000000000012564167700013203 5ustar liggesusershypergeo/build/vignette.rds0000644000176200001440000000034512564167700015544 0ustar liggesusers 0GVB | 񦛐.]2]O^M#Wm`GbǶ`lyhE\}_kPgJJa"[r=yr }hQI*$KHOgMp?H2ɻo0$\J ƺgCh%f_'/UՆ nAӂ5>gB}'Vhypergeo/DESCRIPTION0000644000176200001440000000067512564214747013626 0ustar liggesusersPackage: hypergeo Title: The Gauss Hypergeometric Function Version: 1.2-11 Author: Robin K. S. Hankin Depends: R (>= 3.1.0), Imports: elliptic (>= 1.3-5), contfrac (>= 1.1-9), deSolve Description: The Gaussian hypergeometric function for complex numbers. Maintainer: Robin K. S. Hankin License: GPL-2 NeedsCompilation: no Packaged: 2015-08-16 20:17:06 UTC; rhankin Repository: CRAN Date/Publication: 2015-08-17 01:16:55 hypergeo/man/0000755000176200001440000000000012564167332012660 5ustar liggesusershypergeo/man/shanks.Rd0000644000176200001440000000250012564167332014433 0ustar liggesusers\name{shanks} \alias{shanks} \alias{hypergeo_shanks} \alias{genhypergeo_shanks} \title{Evaluation of the hypergeometric function using Shanks's method} \description{ Evaluation of the hypergeometric function using Shanks transformation of successive sums } \usage{ hypergeo_shanks(A,B,C,z,maxiter=20) genhypergeo_shanks(U,L,z,maxiter=20) shanks(Last,This,Next) } \arguments{ \item{A,B,C}{Parameters (real)} \item{U,L}{Upper and lower vectors} \item{z}{Primary complex argument} \item{maxiter}{Maximum number of iterations} \item{Last,This,Next}{Three successive convergents} } \details{ The Shanks transformation of successive partial sums is \deqn{S(n)=\frac{A_{n+1}A_{n-1}-A_n^2}{A_{n+1}-2A_n+A_{n-1}}} and if the \eqn{A_n} tend to a limit then the sequence \eqn{S(n)} often converges more rapidly than \eqn{A_n}. However, the denominator is susceptible to catastrophic rounding under fixed-precision arithmetic and it is difficult to know when to stop iterating. } \references{ \itemize{ \item Shanks, D. (1955). \dQuote{Non-linear transformation of divergent and slowly convergent sequences}, \emph{Journal of Mathematics and Physics} 34:1-42 } } \author{Robin K. S. Hankin} \note{ The } \seealso{\code{\link{buhring}}} \examples{ hypergeo_shanks(1/2,1/3,pi,z= 0.1+0.2i) } \keyword{math} hypergeo/man/wolfram.Rd0000644000176200001440000000540412564167332014621 0ustar liggesusers\name{wolfram} \alias{wolfram} \alias{w07.23.06.0026.01} \alias{w07.23.06.0026.01_bit1} \alias{w07.23.06.0026.01_bit2} \alias{w07.23.06.0026.01_bit3_a} \alias{w07.23.06.0026.01_bit3_b} \alias{w07.23.06.0026.01_bit3_c} \alias{w07.23.06.0029.01} \alias{w07.23.06.0031.01} \alias{w07.23.06.0031.01_bit1} \alias{w07.23.06.0031.01_bit2} \title{Various functions taken from the Wolfram Functions Site} \description{ Various functions taken from the Wolfram Functions Site } \usage{ w07.23.06.0026.01(A, n, m, z, tol = 0, maxiter = 2000, method = "a") w07.23.06.0026.01_bit1(A, n, m, z, tol = 0) w07.23.06.0026.01_bit2(A, n, m, z, tol = 0, maxiter = 2000) w07.23.06.0026.01_bit3_a(A, n, m, z, tol = 0) w07.23.06.0026.01_bit3_b(A, n, m, z, tol = 0) w07.23.06.0026.01_bit3_c(A, n, m, z, tol = 0) w07.23.06.0029.01(A, n, m, z, tol = 0, maxiter = 2000) w07.23.06.0031.01(A, n, m, z, tol = 0, maxiter = 2000) w07.23.06.0031.01_bit1(A, n, m, z, tol = 0, maxiter = 2000) w07.23.06.0031.01_bit2(A, n, m, z, tol = 0, maxiter = 2000) } \arguments{ \item{A}{Parameter of hypergeometric function} \item{m,n}{Integers} \item{z}{Primary complex argument} \item{tol,maxiter}{Numerical arguments as per \code{genhypergeo()}} \item{method}{Character, specifying method to be used} } \details{ The \code{method} argument is described at \code{f15.3.10}. All functions' names follow the conventions in \code{Hypergeometric2F1.pdf}. \itemize{ \item Function \code{w07.23.06.0026.01(A, n, m, z)} returns \eqn{{}_2F_1(A,A+n,A+m,z)}{hypergeo(A,A+n,A+m,z)} where \eqn{m} and \eqn{n} are nonnegative integers with \eqn{m\geq n}{m>=n}. \item Function \code{w07.23.06.0029.01(A, n, m, z)} returns \eqn{{}_2F_1(A,A+n,A-m,z)}{hypergeo(A,A+n,A-m,z)}. \item Function \code{w07.23.06.0031.01(A, n, m, z)} returns \eqn{{}_2F_1(A,A+n,A+m,z)}{hypergeo(A,A+n,A-m,z)} with \eqn{m\leq n}{m<=n}. } } \references{ \url{http://functions.wolfram.com/Hypergeometric2F1.pdf} } \author{Robin K. S. Hankin} \seealso{\code{\link{f15.3.10}},\code{\link{hypergeo}}} \examples{ # Here we catch some answers from Maple (jjM) and compare it with R's: jjM <- 0.95437201847068289095 + 0.80868687461954479439i # Maple's answer jjR <- w07.23.06.0026.01(A=1.1 , n=1 , m=4 , z=1+1i) # [In practice, one would type 'hypergeo(1.1, 2.1, 5.1, 1+1i)'] stopifnot(Mod(jjM - jjR) < 1e-10) jjM <- -0.25955090546083991160e-3 - 0.59642767921444716242e-3i jjR <- w07.23.06.0029.01(A=4.1 , n=1 , m=1 , z=1+4i) # [In practice, one would type 'hypergeo(4.1, 3.1, 5.1, 1+1i)'] stopifnot(Mod(jjM - jjR) < 1e-15) jjM <- 0.33186808222278923715e-1 - 0.40188208572232037363e-1i jjR <- w07.23.06.0031.01(6.7,2,1,2+1i) # [In practice, one would type 'hypergeo(6.7, 8.7, 7.7, 2+1i)'] stopifnot(Mod(jjM - jjR) < 1e-10) } \keyword{math} hypergeo/man/hypergeo_contfrac.Rd0000644000176200001440000000341112564167332016647 0ustar liggesusers\name{hypergeo_contfrac} \alias{hypergeo_contfrac} \alias{genhypergeo_contfrac_single} \title{Continued fraction expansion of the hypergeometric function} \description{ Continued fraction expansion of the hypergeometric and generalized hypergeometric functions using continued fraction expansion. } \usage{ hypergeo_contfrac(A, B, C, z, tol = 0, maxiter = 2000) genhypergeo_contfrac_single(U, L, z, tol = 0, maxiter = 2000) } \arguments{ \item{A,B,C}{Parameters (real)} \item{U,L}{In function \code{genhypergeo_contfrac()}, upper and lower arguments as in \code{genhypergeo()}} \item{z}{Complex argument} \item{tol}{tolerance (passed to \code{GCF()})} \item{maxiter}{maximum number of iterations} } \details{ These functions are included in the package in the interests of completeness, but it is not clear when it is advantageous to use continued fraction form rather than the series form. } \references{ \itemize{ \item M. Abramowitz and I. A. Stegun 1965. \emph{Handbook of mathematical functions}. New York: Dover \item \url{http://functions.wolfram.com/Hypergeometric2F1.pdf} } } \author{Robin K. S. Hankin} \note{ The continued fraction expression is the RHS identity 07.23.10.0001.01 of \code{Hypergeometric2F1.pdf}. The function sometimes fails to converge to the correct value but no warning is given. Function \code{genhypergeo_contfrac()} is documented under \code{genhypergeo.Rd}. } \seealso{\code{\link{genhypergeo}}} \examples{ hypergeo_contfrac(0.3 , 0.6 , 3.3 , 0.1+0.3i) # Compare Maple: 1.0042808294775511972+0.17044041575976110947e-1i genhypergeo_contfrac_single(U=0.2 , L=c(9.9,2.7,8.7) , z=1+10i) # (powerseries does not converge) # Compare Maple: 1.0007289707983569879 + 0.86250714217251837317e-2i } \keyword{math} hypergeo/man/f15.5.1.Rd0000644000176200001440000001223212564167332014044 0ustar liggesusers\name{f15.5.1} \alias{f15.5.1} \alias{f15.5.1} \alias{hypergeo_press} \alias{hypergeo_func} \alias{to_real} \alias{to_complex} \alias{complex_ode} \alias{semicircle} \alias{semidash} \alias{straight} \alias{straightdash} \title{ Hypergeometric functions via direct numerical integration } \description{ The hypergeometric function may be evaluated using Gauss's differential equation 15.5.1: \deqn{z(1-z)w''+(c-(a+b+1)z)w'-abw=0} using a start value away from the three singular points. This page documents a suite of related functionality. } \usage{ hypergeo_press(A,B,C,z, ...) f15.5.1(A, B, C, z, startz, u, udash, give=FALSE, ...) hypergeo_func(Time, State, Pars, u, udash) to_real(o) to_complex(p) complex_ode(y, times, func, parms=NA, method=NULL, u, udash, ...) semicircle(t,z0,z1,clockwise=TRUE) semidash(t,z0,z1,clockwise=TRUE) straight(t,z0,z1) straightdash(t,z0,z1) } \arguments{ \item{A,B,C,z}{Standard parameters for the hypergeometric function} \item{u,udash}{Functions to specify the path of integration, and its derivative} \item{give}{In function \code{f15.5.1()}, Boolean with \code{TRUE} meaning to return extra information from \code{ode()} and default \code{FALSE} meaning to return only the evaluated function} \item{startz}{In function \code{f15.5.1(}, the start position of the path} \item{\dots}{Further arguments passed to \code{ode()}} \item{o,p}{Real and complex objects to be coerced to each other in \code{to_real()} and \code{to_complex()}} \item{y, times, func, parms, method}{In function \code{complex_ode()}, arguments matching those of \code{ode()}} \item{t,z0,z1,clockwise}{Arguments for the standard path functions \code{semicircle()} et seq: \code{u} is the primary argument (real, \eqn{0\leq u\leq 1}{1<=u<=1}); \code{z0} and \code{z1} are the start and end points of the path; and \code{clockwise} is Boolean, indicating whether the path proceeds clockwise or not} \item{Time, State, Pars}{arguments matchin those of standard examples in the \code{deSolve} package} } \details{ Function \code{hypergeo_press()} is the most user-friendly of the functions documented here. It performs integration of Gauss's ODE, along a straight line path from the start-point to \code{z}. It follows Press et al's suggestion of start-point. Function \code{f15.5.1()} is a little more flexible in that it allows the user to choose a start point and an integration path. Function \code{complex_ode()} is a complex generalization of \code{ode()} of package \pkg{deSolve}; function \code{hypergeo_func} is an internal function, designed for use with \code{complex_ode()}, that specifies the Gauss ODE which is satisified by the hypergeometric function. Functions \code{to_real()} and \code{to_complex()} are internal functions which coerce from real to complex and back; they are needed because \code{ode()} deals only with real values. Functions \code{semicircle()} and \code{straight()} are helper functions which specify straight or semicircular paths from \code{z0} to \code{z1}; note that \code{f(0)=z0} and \code{f(1)=z1}. Functions \code{semidash()} and \code{straightdash()} provide the differential of the path. } \references{ W. H. Press et al. 1997. \emph{Numerical Recipes in C}. Cambridge University Press, Second Edition. } \author{ Robin K. S. Hankin } \note{ Accuracy is low compared with the other methods in the package. } \seealso{ \code{\link{hypergeo_residue}} } \examples{ hypergeo_press(A=pi,B=sqrt(2),C=1.4,z=1-2i) hypergeo (A=pi,B=sqrt(2),C=1.4,z=1-2i) jj1 <- f15.5.1( A=1.1, B=2.2, C=3.3, z=3+0.5i, startz=0.5, u =function(u){semicircle(u,0.5,3+0.5i,FALSE)}, udash=function(u){semidash(u,0.5,3+0.5i,FALSE)} ) jj2 <- f15.5.1( A=1.1, B=2.2, C=3.3, z=3+0.5i, startz=0.5, u =function(u){semicircle(u,0.5,3+0.5i,TRUE)}, udash=function(u){semidash(u,0.5,3+0.5i,TRUE)} ) jj3 <- hypergeo( A=1.1, B=2.2, C=3.3, z=3+0.5i) ## First one agrees with jj3=hypergeo(...), the second one does not # Now try the Airy Ai function; satisfies f'' = zf: pars <- c(kay = 1+1i, ell = 0.1+0.2i) # not actually used airy_ai_func <- function(Time, State, Pars, u, udash) { with(as.list(c(to_complex(State), to_complex(Pars))), { z <- u(Time) dz <- udash(Time) dF <- Fdash*dz dFdash <- z*F*dz # could use kay and ell from pars here if necessary ## coerce back to real: out <- to_real(c(dF,dFdash)) names(out) <- names(State) return(list(out)) }) } complex_ode( y = c(F = 1/3^(2/3)/gamma(2/3), Fdash= -1/3^(1/3)/gamma(1/3)), times = seq(0,1,by=0.1), func = airy_ai_func, parms = pars, u = function(t){straight(t,0,1)}, udash = function(t){straightdash(t,0,1)} ) # Look at the last line for the value at 1. # compare gsl: Ai(1) = 0.1352924 ; Ai'(1) = -0.1591474 # ...although in this case there is actually a hypergeometric series # representation: f <- function(z){ return( +genhypergeo(U=NULL,L=2/3,z^3/9)/3^(2/3)/gamma(2/3) -genhypergeo(U=NULL,L=4/3,z^3/9)/3^(1/3)/gamma(1/3)*z ) } f(1) } hypergeo/man/hypergeo_gosper.Rd0000644000176200001440000000151412564167332016351 0ustar liggesusers\name{hypergeo_gosper} \alias{hypergeo_gosper} \title{Evaluation of the hypergeometric function using Gosper's method} \description{ Evaluation of the hypergeometric function using Gosper's method } \usage{ hypergeo_gosper(A, B, C, z, tol = 0, maxiter = 2000) } \arguments{ \item{A,B,C}{Parameters (real)} \item{z}{Complex argument} \item{tol}{tolerance (passed to \code{GCF()})} \item{maxiter}{maximum number of iterations} } \details{ Gosper provides a three-term recurrence which converges when \eqn{z} is close to a critical point} \references{ \itemize{ \item \url{https://www.ma.utexas.edu/pipermail/maxima/2006/000126.html} } } \author{Robin K. S. Hankin} \seealso{\code{\link{hypergeo_contfrac}}} \examples{ z <- 1/2 - sqrt(3)/2i hypergeo_gosper(1.1,5.1,3.1,z) # Compare MMA: -0.192225 + 0.692328 I } \keyword{math} hypergeo/man/f15.3.3.Rd0000644000176200001440000000211412564167332014042 0ustar liggesusers\name{f15.3.3} \alias{f15.3.3} \alias{f15.3.4} \alias{f15.3.5} \alias{f15.3.6} \alias{f15.3.7} \alias{f15.3.8} \alias{f15.3.9} \title{Various transformation formulae for the hypergeometric function} \description{ Transformations of the hypergeometric function: equations 15.3.3 to 15.3.9 } \usage{ f15.3.3(A, B, C, z, tol = 0, maxiter = 2000) f15.3.4(A, B, C, z, tol = 0, maxiter = 2000) f15.3.5(A, B, C, z, tol = 0, maxiter = 2000) f15.3.6(A, B, C, z, tol = 0, maxiter = 2000) f15.3.7(A, B, C, z, tol = 0, maxiter = 2000) f15.3.8(A, B, C, z, tol = 0, maxiter = 2000) f15.3.9(A, B, C, z, tol = 0, maxiter = 2000) } \arguments{ \item{A,B,C}{Parameters of the hypergeometric function} \item{z}{Primary complex argument} \item{tol,maxiter}{parameters passed to \code{genhypergeo()}} } \details{ The naming scheme follows that of Abramowitz and Stegun } \references{ M. Abramowitz and I. A. Stegun 1965. \dQuote{Handbook of mathematical functions}. New York: Dover } \author{Robin K. S. Hankin} \seealso{\code{\link{hypergeo}}} \examples{ f15.3.4(1.1,2.2,3.4,-1+0.1i) } \keyword{math} hypergeo/man/hypergeo_residue.Rd0000644000176200001440000000627112564167332016517 0ustar liggesusers\name{hypergeo_residue} \alias{hypergeo_residue} \alias{hypergeo_residue_general} \alias{hypergeo_residue_close_to_crit_single} \alias{hypergeo_residue_close_to_crit_multiple} \title{Evaluation of the hypergeometric function using the residue theorem} \description{ Expansion of the hypergeometric function using the residue theorem; useful for when the primary argument is close to the critical points \eqn{1/2\pm i\sqrt{3}/2}{0.5+/-i.sqrt(3)/2} } \usage{ hypergeo_residue_general(A, B, C, z, r, O=z, tol=0, maxiter=2000) hypergeo_residue_close_to_crit_single(A, B, C, z, strategy='A', tol=0, maxiter=2000) hypergeo_residue_close_to_crit_multiple(A, B, C, z, strategy='A', tol=0, maxiter=2000) } \arguments{ \item{A,B,C}{Parameters (real)} \item{z}{Complex argument} \item{tol,maxiter}{tolerance and maximum number of iterations (passed to \code{hypergeo()})} \item{r,O}{Radius and center of circle to integrate over} \item{strategy}{Indicates which strategy to use. Strategy \sQuote{A} means to use the critical point as the centre of the circle and strategy \sQuote{B} means to use \eqn{z}} } \details{ These functions are not really intended for the user; \code{hypergeo()} uses \code{hypergeo_residue_close_to_crit_multiple()} when \eqn{\left|z-c\right|}{abs(z-c)} is less than \eqn{0.1} (hardwired) for \eqn{c} being either of the two critical points. Infinite regress is avoided because the contour is always more than this distance from the critical points. These functions use the residue theorem \eqn{f\left(z_0\right)=\oint_C\frac{f(z)\,dz}{z-z_0}}{f(z_0)=int dz f(z)/(z-z_0)} to evaluate the hypergeometric function near the two critical points \eqn{1/2\pm i\sqrt{3}/2}{0.5+/-i.sqrt(3)/2}. These points are problematic because all of the transformations listed under \code{thingfun()} take the points either to themselves or each other. At these points the ratio of successive terms in the hypergeometric series tends to one and thus numerical summation is difficult. The hypergeometric function, however, is not at all badly behaved near these critical points (see examples); but OTOH there do not seem to be any identities for the hypergeometric function at these points. I have not investigated in detail whether strategy \sQuote{A} or \sQuote{B} is better. I would expect that \sQuote{A} is faster but \sQuote{B} more accurate, on the grounds that \sQuote{A} uses a contour whose closest approach to the critical point is further than that of \sQuote{B}; but \sQuote{B} uses a contour which does not vary in distance from \eqn{z}. But both seem to be fairly accurate and fairly fast, and I have not systematically investigated the pros and cons. } \references{ \itemize{ \item W. Buhring 1987. \dQuote{An analytic continuation of the hypergeometric series}, \emph{Siam J. Math. Anal.} 18(3) } } \author{Robin K. S. Hankin} \note{ The residue theorem appears to be absurdly accurate for numerical evaluation } \seealso{\code{\link{buhring}}} \examples{ c1 <- 1/2-sqrt(3)/2i c2 <- 1/2+sqrt(3)/2i a1_R <- hypergeo(1/2,1/3,pi,c1) a1_M <- 1.0154051314906669 + 0.0544835896509068i x <- y <- seq(from=-0.1,to=0.1,len=100) elliptic::view(x,y,hypergeo(1/2,1,1/3,outer(x,1i*y,"+"))) } \keyword{math} hypergeo/man/f15.3.10.Rd0000644000176200001440000000730512564167332014127 0ustar liggesusers\name{f15.3.10} \alias{f15.1.1} \alias{f15.3.10} \alias{f15.3.10_a} \alias{f15.3.10_b} \alias{f15.3.11} \alias{f15.3.11_bit1} \alias{f15.3.11_bit2_a} \alias{f15.3.11_bit2_b} \alias{f15.3.12} \alias{f15.3.12_bit1} \alias{f15.3.12_bit2_a} \alias{f15.3.12_bit2_b} \alias{f15.3.13} \alias{f15.3.13_14} \alias{f15.3.13_a} \alias{f15.3.13_b} \alias{f15.3.14} \alias{f15.3.14_bit1_a} \alias{f15.3.14_bit1_b} \alias{f15.3.14_bit2} \alias{f15.3.10_11_12} \title{Transformations of the hypergeometric function} \description{ Transformations of the hypergeometric function detailed in AMS-55, page 559-560. } \usage{ f15.3.10 (A, B, z, tol = 0, maxiter = 2000, method = "a") f15.3.10_a (A, B, z, tol = 0, maxiter = 2000 ) f15.3.10_b (A, B, z, tol = 0, maxiter = 2000 ) f15.3.11 (A, B, m, z, tol = 0, maxiter = 2000, method = "a") f15.3.11_bit1 (A, B, m, z, tol = 0 ) f15.3.11_bit2_a(A, B, m, z, tol = 0, maxiter = 2000 ) f15.3.11_bit2_b(A, B, m, z, tol = 0, maxiter = 2000 ) f15.3.12 (A, B, m, z, tol = 0, maxiter = 2000, method = "a") f15.3.12_bit1 (A, B, m, z, tol = 0 ) f15.3.12_bit2_a(A, B, m, z, tol = 0, maxiter = 2000 ) f15.3.12_bit2_b(A, B, m, z, tol = 0, maxiter = 2000 ) f15.3.13 (A, C, z, tol = 0, maxiter = 2000, method = "a") f15.3.13_a (A, C, z, tol = 0, maxiter = 2000 ) f15.3.13_b (A, C, z, tol = 0, maxiter = 2000 ) f15.3.14 (A, C, m, z, tol = 0, maxiter = 2000, method = "a") f15.3.14_bit1_a(A, C, m, z, tol = 0, maxiter = 2000 ) f15.3.14_bit1_b(A, C, m, z, tol = 0, maxiter = 2000 ) f15.3.14_bit2 (A, C, m, z, tol = 0 ) f15.3.13_14 (A, C, m, z, tol = 0, maxiter = 2000, method = "a") f15.3.10_11_12 (A, B, m, z, tol = 0, maxiter = 2000, method = "a") f15.1.1 (A, B, C, z, tol = 0, maxiter = 2000 ) } \arguments{ \item{A,B,C}{Parameters of the hypergeometric function} \item{m}{Integer linking \code{A}, \code{B}, \code{C} as set out in AMS-55, page 559,560} \item{z}{primary complex argument} \item{tol,maxiter}{numerical parameters} \item{method}{Length 1 character vector specifying the method. See details} } \details{ Naming scheme (functions and arguments) follows AMS-55, pages 559-560. The \code{method} argument to (eg) \code{f15.3.14()} specifies whether to use \code{psigamma()} directly (method \dQuote{\code{a}}), or the recurrence 6.3.5 (method \dQuote{\code{b}}). Press et al recommend method \dQuote{\code{b}}, presumably on the grounds of execution speed. I'm not so sure (method \dQuote{\code{a}} seems to be more accurate in the sense that it returns values closer to those of Maple). Method \dQuote{\code{c}} means to use a totally dull, slow, direct (but clearly correct) summation, for the purposes of debugging. This is only used for the functions documented under \code{wolfram.Rd} Functions \code{f15.3.13_14()} and \code{f15.3.10_11_12()} are convenience wrappers. For example, function \code{f15.3.13_14()} dispatches to either \code{f15.3.13()} or \code{f15.3.14()} depending on the value of \code{m}. } \references{ M. Abramowitz and I. A. Stegun 1965. \emph{Handbook of mathematical functions}. New York: Dover } \author{Robin K. S. Hankin} \note{ These functions are not really designed to be called by the user: use \code{hypergeo()} instead, or \code{hypergeo_cover[123]()} for specific cases. } \seealso{\code{\link{hypergeo}},\code{\link{wolfram}},\code{\link{hypergeo_cover1}}} \examples{ f15.3.10_11_12(A=1.1, B=pi, m= +3, z=.1+.1i) f15.3.10_11_12(A=1.1, B=pi, m= -3, z=.1+.1i) } \keyword{math} hypergeo/man/buhring.Rd0000644000176200001440000000414212564167332014606 0ustar liggesusers\name{buhring} \alias{buhring} \alias{buhring_eqn11} \alias{buhring_eqn12} \alias{buhring_eqn5_factors} \alias{buhring_eqn5_series} \alias{hypergeo_buhring} \alias{buhring_eqn12} \title{Evaluation of the hypergeometric function using Buhring's method} \description{ Expansion of the hypergeometric function using the residue theorem; useful for when the primary argument is close to the critical points \eqn{1/2\pm i\sqrt{3}/2}{0.5+/-i.sqrt(3)/2} } \usage{ hypergeo_buhring(A,B,C,z,z0=1/2,tol=0,maxiter=2000,use11=TRUE) buhring_eqn11(n,S,A,B,C,z0=1/2) buhring_eqn12(n,S,A,B,C,z0=1/2) buhring_eqn5_factors(A,B,C,z,z0=1/2) buhring_eqn5_series(S,A,B,C,z,z0=1/2,use11=FALSE,tol=0,maxiter=2000) } \arguments{ \item{A,B,C}{Parameters (real)} \item{S}{Parameter taken to be either \code{A} or \code{B}} \item{n}{Term to calculate in \code{buhring_eqn11()} or \code{buhring_eqn12()}} \item{z}{Primary complex argument} \item{z0}{Centre of circle of non-convergence; series expressed in powers of \eqn{1/\left(z-z_0\right)^n}{1/(z-z0)^n}} \item{tol,maxiter}{tolerance and maximum number of iterations (as in \code{hypergeo()})} \item{use11}{Boolean with default \code{TRUE} meaning to use \code{buhring_eqn11()} and \code{FALSE} meaning to use \code{buhring_eqn12()}} } \details{ The functions are direct transcriptions of Buhring 1987. The basic idea is to expand the hypergeometric function in powers of \eqn{(z-z_0)^{-1}}{1/(z-z0)}. Functions \code{buhring_eqn11()} and \code{buhring_eqn12()} return the coefficients \eqn{d_n}{d(n)} given by equations 11 and 12 of Buhring 1987. } \references{ \itemize{ \item W. Buhring 1987. \dQuote{An analytic continuation of the hypergeometric series}, \emph{Siam J. Math. Anal.} 18(3) } } \author{Robin K. S. Hankin} \note{ The } \seealso{\code{\link{residue}}} \examples{ # should be identical: buhring_eqn11(n=0:10,S=1/2,A=1/2,B=1/3,C=pi) buhring_eqn12(n=0:10,S=1/2,A=1/2,B=1/3,C=pi) # but differ in one element # following command fails due to numerical instability: \dontrun{ hypergeo_buhring(1/2,1/3,pi,z=1/2 + 1i*sqrt(3)/2) } } \keyword{math} hypergeo/man/hypergeo_cover1.Rd0000644000176200001440000000467212564167332016261 0ustar liggesusers\name{hypergeo_cover1} \alias{hypergeo_cover1} \alias{hypergeo_cover2} \alias{hypergeo_cover3} \title{Hypergeometric functions for special values of the parameters} \description{ Hypergeometric functions for special values of the parameters } \usage{ hypergeo_cover1(A, B, m, z, tol = 0, maxiter = 2000, method = "a", give = FALSE) hypergeo_cover2(A, C, m, z, tol = 0, maxiter = 2000, method = "a", give = FALSE) hypergeo_cover3(A, n, m, z, tol = 0, maxiter = 2000, method = "a", give = FALSE) } \arguments{ \item{A,B,C}{parameters for the hypergeometric function} \item{m,n}{Integers (positive or negative)} \item{z}{Primary complex argument} \item{tol,maxiter}{Numerical arguments passed to \code{genhypergeo()}} \item{method}{Method, passed to \code{f15.3.10()} (qv)} \item{give}{Boolean with \code{TRUE} meaning to return the choice of function used and default \code{FALSE} meaning to return the function's evaluate} } \details{ These functions deal with the exceptional cases listed on page 559-560. \itemize{ \item Function \code{hypergeo_cover1()} deals with the case \eqn{C=A+B\pm m,m=0,1,2,\ldots}{C=A+B +/- m, m=0,1,2,...} \item Function \code{hypergeo_cover2()} deals with the case \eqn{B=A\pm m,m=0,1,2,\ldots}{B=A +/- m, m=0,1,2,...} \item Function \code{hypergeo_cover3()} deals with the case \eqn{C-A=0,-1,-2,\ldots}{C-A=0,-1,-2,...} [elementary] and \eqn{C-A=1,2,\ldots}{C-A=1,2,...} [not covered by AMS-55] } } \references{ M. Abramowitz and I. A. Stegun 1965. \emph{Handbook of mathematical functions}. New York: Dover } \note{ Function \code{hypergeo_cover3()} is required because the \dQuote{limiting process} mentioned on p560, just after 15.3.14, is not explicit. Which is why it dispatches to \code{w07.23.06.0026.01()} and \code{w07.23.06.0031.01()}, documented at \code{wolfram}. } \author{Robin K. S. Hankin} \seealso{\code{\link{hypergeo}},\code{\link{f15.3.10}},\code{\link{wolfram}}} \examples{ # Test hypergeo_cover1(): jjR <- hypergeo(pi,pi/2,3*pi/2-4, z=0.1+0.2i) jjM <- 0.53745229690249593045 + 1.8917456473240515664i # Test hypergeo_cover2(): jjM <- -0.15888831928748121465e-5 + 0.40339599711492215912e-4i jjR <- hypergeo(pi,pi+2, 1.1 , 1+10i) # This is 15.3.13 stopifnot(Mod(jjR-jjM)<1e-10) # Test hypergeo_cover3() jjM <- -0.24397135980533720308e-1 + 0.28819643319432922231i jjR <- hypergeo(pi, 1.4, pi+4, 1+6i) stopifnot(Mod(jjR-jjM)<1e-10) } \keyword{math} hypergeo/man/is.nonpos.Rd0000644000176200001440000000501612564167332015077 0ustar liggesusers\name{is.nonpos} \alias{is.nonpos} \alias{is.near_integer} \alias{is.zero} \alias{isgood} \alias{thingfun} \alias{crit} \alias{lpham} \title{Various utilities} \description{ Various utilities needing nonce functions } \usage{ is.near_integer(i, tol=getOption("tolerance")) is.nonpos(i) is.zero(i) isgood(x, tol) thingfun(z, complex=FALSE) crit(...) lpham(x,n) } \arguments{ \item{i}{Numerical vector of suspected integers} \item{tol}{Tolerance} \item{x}{Argument to \code{isgood()} and \code{lpham()}} \item{z}{Complex vector} \item{complex}{In function \code{thingfun()}, Boolean with default \code{FALSE} meaning to return the modulus of the transforms and \code{TRUE} meaning to return the complex values themselves} \item{n}{second argument to \code{lpham()}} \item{...}{Ignored} } \details{ \itemize{ \item Function \code{is.near_integer(i)} returns \code{TRUE} if \code{i} is \dQuote{near} [that is, within \code{tol}] an integer; if the option is unset then \code{1e-11} is used. \item Function \code{is.nonpos()} returns \code{TRUE} if \code{i} is near a nonpositive integer \item Function \code{is.zero()} returns \code{TRUE} if \code{i} is, er, near zero \item Function \code{isgood()} checks for all elements of \code{x} having absolute values less than \code{tol} \item Function \code{thingfun()} transforms input vector \code{z} by each of the six members of the anharmonic group, viewed as a subgroup of the Mobius group of functions. It returns a real six-column matrix with columns being the modulus of \eqn{z,z/(z-1),1-z,1/z,1/(1-z),1-1/z}. These six columns correspond to the primary argument in equations 15.3.3 to 15.3.9, p551 of AMS-55 \item Function \code{crit()} returns the two critical points, \eqn{\frac{1}{2}\pm\frac{\sqrt{3}i}{2}}{1/2 +/- sqrt(3)i/2}. These points have unit modulus as do their six transforms by \code{thingfun()} \item Function \code{lpham()} returns the log of the Pochhammer function \eqn{log\left(\Gamma(x+n)/\Gamma(x)\right)}{log(Gamma(x+n)/Gamma(x))} } } \author{Robin K. S. Hankin} \note{ Function \code{isgood()} uses zero as the default tolerance (argument \code{tol} passed in from \code{hypergeo()}); compare the different meaning of \code{tol} used in \code{is.near_integer()}. Here, \dQuote{integer} means one of the sequence \eqn{0,\pm 1,\pm 2,\ldots}{0, +/-1, +/-2, ...} [ie \emph{not} the Gaussian integers]. } \examples{ is.near_integer(-3) is.zero(4) } \keyword{math} hypergeo/man/genhypergeo.Rd0000644000176200001440000000712212564167332015465 0ustar liggesusers\name{genhypergeo} \alias{genhypergeo} \alias{genhypergeo_series} \alias{genhypergeo_contfrac} \title{The generalized hypergeometric function} \description{ The generalized hypergeometric function, using either the series expansion or the continued fraction expansion. } \usage{ genhypergeo(U, L, z, tol=0, maxiter=2000, check_mod=TRUE, polynomial=FALSE, debug=FALSE, series=TRUE) genhypergeo_series(U, L, z, tol=0, maxiter=2000, check_mod=TRUE, polynomial=FALSE, debug=FALSE) genhypergeo_contfrac(U, L, z, tol = 0, maxiter = 2000) } \arguments{ \item{U,L}{Upper and lower arguments respectively (currently real)} \item{z}{Primary complex argument (see notes)} \item{tol}{tolerance with default zero meaning to iterate until additional terms to not change the partial sum} \item{maxiter}{Maximum number of iterations to perform} \item{check_mod}{Boolean, with default \code{TRUE} meaning to check that the modulus of \code{z} is less than 1} \item{polynomial}{Boolean, with default \code{FALSE} meaning to evaluate the series until converged, or return a warning; and \code{TRUE} meaning to return the sum of \code{maxiter} terms, whether or not converged. This is useful when either \code{A} or\code{B} is a nonpositive integer in which case the hypergeometric function is a polynomial} \item{debug}{Boolean, with \code{TRUE} meaning to return debugging information and default \code{FALSE} meaning to return just the evaluate} \item{series}{In function \code{genhypergeo()}, Boolean argument with default \code{TRUE} meaning to return the result of \code{genhypergeo_series()} and \code{FALSE} the result of \code{genhypergeo_contfrac()}} } \details{ Function \code{genhypergeo()} is a wrapper for functions \code{genhypergeo_series()} and \code{genhypergeo_contfrac()}. Function \code{genhypergeo_series()} is the workhorse for the whole package; every call to \code{hypergeo()} uses this function except for the (apparently rare---but see the examples section) cases where continued fractions are used. The generalized hypergeometric function [here \code{genhypergeo()}] appears from time to time in the literature (eg Mathematica) as \deqn{F(U,L;z) = \sum_{n=0}^\infty\frac{(u_1)_n(u_2)_n\ldots (u_i)_n}{(l_1)_n(l_2)_n\ldots (l_j)_n}\cdot\frac{z^n}{n!}}{[omitted; see PDF]} where \eqn{U=\left(u_1,\ldots,u_i\right)}{U=(u_1,...,u_i)} and \eqn{L=\left(l_1,\ldots,l_i\right)}{L=(l_1,...,l_i)} are the \dQuote{upper} and \dQuote{lower} vectors respectively. The radius of convergence of this formula is 1. For the Confluent Hypergeometric function, use \code{genhypergeo()} with length-1 vectors for arguments \code{U} and \code{V}. For the \eqn{{}_0\!F_1}{0F1} function (ie no \dQuote{upper} arguments), use \code{genhypergeo(NULL,L,x)}. See documentation for \code{genhypergeo_contfrac()} for details of the continued fraction representation. } \references{ M. Abramowitz and I. A. Stegun 1965. \emph{Handbook of mathematical functions}. New York: Dover } \author{Robin K. S. Hankin} \note{ The radius of convergence for the series is 1 but under some circumstances, analytic continuation defines a function over the whole complex plane (possibly cut along \eqn{(1,\infty)}{(1,inf)}). Further work would be required to implement this. } \seealso{\code{\link{hypergeo}},\code{\link{genhypergeo_contfrac}}} \examples{ genhypergeo(U=c(1.1,0.2,0.3), L=c(10.1,pi*4), check_mod=FALSE, z=1.12+0.2i) genhypergeo(U=c(1.1,0.2,0.3), L=c(10.1,pi*4),z=4.12+0.2i,series=FALSE) } \keyword{math} hypergeo/man/hypergeo_powerseries.Rd0000644000176200001440000000236312564167332017424 0ustar liggesusers\name{hypergeo_powerseries} \alias{hypergeo_powerseries} \alias{hypergeo_taylor} \alias{hypergeo_general} \title{The hypergeometric function as determined by power series} \description{ The hypergeometric function as determined by infinite (\code{hypergeo_powerseries()}) or finite (\code{hypergeo_taylor()}) power series } \usage{ hypergeo_powerseries(A, B, C, z, tol = 0, maxiter = 2000) } \arguments{ \item{A,B,C}{Parameters of the hypergeometric function} \item{z}{Primary complex argument} \item{tol,maxiter}{Numerical arguments} } \details{ Function \code{hypergeo_powerseries()} is the primary decision-making function of the package. It is this function that detects degenerate cases of the three parameters and dispatches accordingly. Non-degenerate cases are sent to function \code{hypergeo_general()}. Function \code{hypergeo_taylor()} deals with cases where the hypergeometric function is a polynomial. } \references{ M. Abramowitz and I. A. Stegun 1965. \emph{Handbook of mathematical functions}. New York: Dover } \author{Robin K. S. Hankin} \seealso{\code{\link{hypergeo}},\code{\link{genhypergeo}}} \examples{ jjR <- hypergeo(pi,-4,2.2,1+5i) jjM <- 1670.8287595795885335 - 204.81995157365381258i } \keyword{math} hypergeo/man/f15.3.1.Rd0000644000176200001440000000312112564167332014037 0ustar liggesusers\name{f15.3.1} \alias{f15.3.1} \alias{hypergeo_integral} \title{Hypergeometric function using Euler's integral representation} \description{ Hypergeometric function using Euler's integral representation, evaluated using numerical contour integrals. } \usage{ f15.3.1(A, B, C, z, h = 0) } \arguments{ \item{A,B,C}{Parameters} \item{z}{Primary complex argument} \item{h}{specification for the path to be taken; see details} } \details{ Argument \code{h} specifies the path to be taken (the path has to avoid the point \eqn{1/z}). If \code{h} is real and of length 1, the path taken comprises two straight lines: one from \eqn{0} to \eqn{0.5+hi} and one from \eqn{0.5+hi} to \eqn{1} (if \eqn{h=0} the integration is performed over a single segment). Otherwise, the integration is performed over \code{length(h)+1} segments: \eqn{0} to \code{h[1]}, then \code{h[i]} to \code{h[i+1]} for \eqn{1\leq i\leq n-1}{1 <= i <= n-1} and finally \code{h[n]} to 1. See examples and notes sections below. } \references{ M. Abramowitz and I. A. Stegun 1965. \emph{Handbook of mathematical functions}. New York: Dover } \author{Robin K. S. Hankin} \note{ The Mellin-Barnes form is not yet coded up. } \seealso{\code{\link{hypergeo}}} \examples{ # For |z| <1 the path can be direct: f15.3.1(2,1,2,-1/2) -2/3 # cf identity 07.23.03.0046.01 of Hypergeometric2F1.pdf with b=1 f <- function(h){f15.3.1(1,2,3, z=2, h=h)} # Winding number [around 1/z] matters: f(0.5) f(c(1-1i, 1+1i, -2i)) # Accuracy isn't too bad; compare numerical to analytical result : f(0.5) - (-1+1i*pi/2) } \keyword{math} hypergeo/man/i15.3.6.Rd0000644000176200001440000000177112564167332014060 0ustar liggesusers\name{i15.3.6} \alias{i15.3.6} \alias{i15.3.7} \alias{i15.3.8} \alias{i15.3.9} \alias{j15.3.6} \alias{j15.3.7} \alias{j15.3.8} \alias{j15.3.9} \title{Helper functions} \description{ Helper functions for equations 15.3.6-15.3.9 } \usage{ i15.3.6(A, B, C) i15.3.7(A, B, C) i15.3.8(A, B, C) i15.3.9(A, B, C) j15.3.6(A, B, C) j15.3.7(A, B, C) j15.3.8(A, B, C) j15.3.9(A, B, C) } \arguments{ \item{A,B,C}{Parameters of the hypergeometric function} } \details{ Functions \code{i15.3.?()} return the factors at the beginning of equations 15.3.6-9. These functions return zero if the denominator is infinite (because it includes a gamma function of a nonpositive integer). Functions \code{j15.3.?()} check for the appropriate arguments of the gamma function being nonpositive integers. } \references{ M. Abramowitz and I. A. Stegun 1965. \emph{Handbook of mathematical functions}. New York: Dover } \author{Robin K. S. Hankin} \seealso{\code{\link{hypergeo}}} \examples{ i15.3.6(1.1, 3.2, pi) } \keyword{math} hypergeo/man/hypergeo_A_nonpos_int.Rd0000644000176200001440000000232712564167332017503 0ustar liggesusers\name{hypergeo_A_nonpos_int} \alias{hypergeo_A_nonpos_int} \alias{hypergeo_AorB_nonpos_int} \title{Hypergeometric functions for integer arguments} \description{ Hypergeometric functions for A and/or B being integers } \usage{ hypergeo_A_nonpos_int(A, B, C, z, tol = 0) hypergeo_AorB_nonpos_int(A, B, C, z, tol = 0) } \arguments{ \item{A,B,C}{Parameters for the hypergeometric function} \item{z}{Primary complex argument} \item{tol}{tolerance} } \details{ The \dQuote{point} of these functions is that if A and C (or B and C) are identical nonpositive integers, a warning needs to be given because the function is defined as the appropriate limit and one needs to be sure that both A and C approach that limit at the same speed. Function \code{hypergeo_AorB_nonpos_int()} is a convenience wrapper for \code{hypergeo_A_nonpos_int()}. } \references{ M. Abramowitz and I. A. Stegun 1965. \emph{Handbook of mathematical functions}. New York: Dover } \author{Robin K. S. Hankin} \seealso{\code{\link{hypergeo}}} \examples{ jjR1 <- hypergeo(-4, pi, 2.2 , 1+6i) jjR2 <- hypergeo(pi, -4, 2.2 , 1+6i) # former bug jjM <- 3464.1890402837334002-353.94143580568566281i # value given by Mathematica } \keyword{math} hypergeo/man/hypergeo.Rd0000644000176200001440000001010612564167332014767 0ustar liggesusers\name{hypergeo} \alias{hypergeo} \title{The hypergeometric function} \description{ The Hypergeometric and generalized hypergeometric functions as defined by Abramowitz and Stegun. Function \code{hypergeo()} is the user interface to the majority of the package functionality; it dispatches to one of a number of subsidiary functions. } \usage{ hypergeo(A, B, C, z, tol = 0, maxiter=2000) } \arguments{ \item{A,B,C}{Parameters for \code{hypergeo()}} \item{z}{Primary argument, complex} \item{tol}{absolute tolerance; default value of zero means to continue iterating until the result does not change to machine precision; strictly positive values give less accuracy but faster evaluation} \item{maxiter}{Integer specifying maximum number of iterations} } \details{ The hypergeometric function as defined by Abramowitz and Stegun, equation 15.1.1, page 556 is \deqn{ {}_2F_1(a,b;c;z) = \sum_{n=0}^\infty\frac{(a)_n(b)_n}{(c)_n}\cdot\frac{z^n}{n!}}{[omitted; see PDF]} where \eqn{(a)_n=a(a+1)\ldots(a+n-1)=\Gamma(a+n)/\Gamma(a)}{(a)_n=Gamma(a+n)/Gamma(a)} is the Pochammer symbol (6.1.22, page 256). Function \code{hypergeo()} is the front-end for a rather unwieldy set of back-end functions which are called when the parameters \code{A}, \code{B}, \code{C} take certain values. The general case (that is, when the parameters do not fall into a \dQuote{special} category), is handled by \code{hypergeo_general()}. This applies whichever of the transformations given on page 559 gives the smallest modulus for the argument \code{z}. Sometimes \code{hypergeo_general()} and all the transformations on page 559 fail to converge, in which case \code{hypergeo()} uses the continued fraction expansion \code{hypergeo_contfrac()}. If this fails, the function uses integration via \code{f15.3.1()}. } \references{Abramowitz and Stegun 1955. \emph{Handbook of mathematical functions with formulas, graphs and mathematical tables} (AMS-55). National Bureau of Standards} \author{Robin K. S. Hankin} \note{ Abramowitz and Stegun state: \dQuote{The radius of convergence of the Gauss hypergeometric series \eqn{\ldots}{...} is \eqn{\left|z\right|=1}{|z|=1}} (AMS-55, section 15.1, page 556). This reference book gives the correct radius of convergence; use the ratio test to verify it. Thus if \eqn{|z|>1}, the hypergeometric series will diverge and function \code{genhypergeo()} will fail to converge. However, the hypergeometric function is defined over the whole of the complex plane, so analytic continuation may be used if appropriate cut lines are used. A cut line must join \eqn{z=1} to (complex) infinity; it is conventional for it to follow the real axis in a positive direction from \eqn{z=1} but other choices are possible. Note that in using the package one sometimes draws a \dQuote{full precision not achieved} warning from \code{gamma()}; and complex arguments are not allowed. I would suggest either ignoring the warning (the error of \code{gamma()} is unlikely to be large) or to use one of the bespoke functions such as \code{f15.3.4()} and tolerate the slower convergence, although this is not always possible. } \seealso{\code{\link{hypergeo_powerseries}}, \code{\link{hypergeo_contfrac}}, \code{\link{genhypergeo}}} \examples{ # equation 15.1.3, page 556: f1 <- function(x){-log(1-x)/x} f2 <- function(x){hypergeo(1,1,2,x)} f3 <- function(x){hypergeo(1,1,2,x,tol=1e-10)} x <- seq(from = -0.6,to=0.6,len=14) f1(x)-f2(x) f1(x)-f3(x) # Note tighter tolerance # equation 15.1.7, p556: g1 <- function(x){log(x + sqrt(1+x^2))/x} g2 <- function(x){hypergeo(1/2,1/2,3/2,-x^2)} g1(x)-g2(x) # should be small abs(g1(x+0.1i) - g2(x+0.1i)) # should have small modulus. # Just a random call, verified by Maple [ Hypergeom([],[1.22],0.9087) ]: genhypergeo(NULL,1.22,0.9087) # Little test of vectorization (warning: inefficient): hypergeo(A=1.2+matrix(1:10,2,5)/10, B=1.4, C=1.665, z=1+2i) # following calls test for former bugs: hypergeo(1,2.1,4.1,1+0.1i) hypergeo(1.1,5,2.1,1+0.1i) hypergeo(1.9, 2.9, 1.9+2.9+4,1+0.99i) # c=a+b+4; hypergeo_cover1() } \keyword{math} hypergeo/man/hypergeo-package.Rd0000644000176200001440000000155712564167332016372 0ustar liggesusers\name{hypergeo-package} \alias{hypergeo-package} \docType{package} \title{ The hypergeometric function } \description{ The hypergeometric function for the whole complex plane } \details{ \tabular{ll}{ Package: \tab hypergeo\cr Type: \tab Package\cr Version: \tab 1.0\cr Date: \tab 2008-04-16\cr License: \tab GPL\cr } The front end function of the package is \code{hypergeo()}: depending on the value of the parameters, this executes one or more of many sub-functions. } \author{ Robin K. S. Hankin Maintainer: } \references{ M. Abramowitz and I. A. Stegun 1965. \emph{Handbook of mathematical functions}. New York: Dover } \keyword{ package } \examples{ hypergeo(1.1,2.3,1.9 , 1+6i) options(showHGcalls = TRUE) # any non-null value counts as TRUE hypergeo(4.1, 3.1, 5.1, 1+1i) # shows trace back options(showHGcalls = FALSE) # reset }