contfrac/0000755000176200001440000000000012721521747012061 5ustar liggesuserscontfrac/tests/0000755000176200001440000000000012721152713013214 5ustar liggesuserscontfrac/tests/aaa.R0000644000176200001440000000237012721152713014063 0ustar liggesusers# Some tests. The functions are defined first, then executed on the # last few lines. The functions all have obvious names. require(contfrac) TOLERANCE <- 1e-10 sqrt.of.11 <- function(...){ lhs <- sqrt(11) rhs <- CF(c(3,rep(c(3,6),30))) return(lhs - rhs) } "sqrt.of.71" <- function(...){ lhs <- sqrt(71) rhs <- CF(c(8,rep(c(2,2,1,7,1,2,2,16),10))) return(lhs-rhs) } "exp.1" <- function(...){ lhs <- exp(1) jj <- t(cbind(1,(1:30)*2,1)) rhs <- CF(c(2,jj)) return(rhs-lhs) } "eulergamma" <- function(...){ lhs <- -psigamma(1) rhs <- CF(c( 0, 1, 1, 2, 1, 2, 1, 4, 3, 13, 5, 1, 1, 8, 1, 2, 4, 1, 1, 40, 1, 11, 3, 7, 1, 7, 1, 1, 5, 1, 49, 4, 1, 65, 1, 4, 7, 11, 1, 399, 2, 1, 3, 2, 1, 2, 1, 5, 3, 2, 1, 10, 1, 1, 1, 1, 2, 1, 1, 3, 1, 4, 1, 1, 2, 5, 1, 3, 6, 2, 1, 2, 1, 1, 1, 2, 1, 3, 16, 8, 1, 1, 2, 16 )) # CF expansion courtesy of Maple return(lhs-rhs) } "tan.1.1i" <- function(...){ lhs <- tan(1 + 1i) z <- 1 + 1i rhs <- GCF(c(z,rep(-z^2,99)),seq(from=1,by=2,len=100)) return(rhs-lhs) } stopifnot(all(as_cf(sqrt(2))[-1] == 2)) test_vector <- abs(c(sqrt.of.11() , sqrt.of.71() , exp.1() , eulergamma() , tan.1.1i() )) stopifnot(all(test_vector < TOLERANCE)) contfrac/src/0000755000176200001440000000000012721152713012641 5ustar liggesuserscontfrac/src/contfrac.c0000644000176200001440000000605512721152727014617 0ustar liggesusers#include void contfrac(double *a, double *b, int *n, double *f, double *tol) { double TINY = 1e-30; double EPS = 2.22044604925031e-16; double C,D,Delta; int j; *f = TINY; C = *f; D = 0.0; for(j=0 ; j < *n ; j++){ D = b[j] + a[j]*D; if(D == 0.0){ D = TINY; } C = b[j] + a[j]/C; if(C == 0.0){ C = TINY; } D = 1.0 / D; Delta = C*D; *f = (*f) * Delta; if( ( (Delta - 1.0) <= EPS) && ((1.0 - Delta) <= EPS)){ *tol = Delta -1.0; for(j++ ; j < *n ; j++){ } return; } } *tol = Delta -1.0; return; } void contfrac_complex(double *ar, double *ai, double *br, double *bi, int *n, double *fr, double *fi, double *tol) { double TINY = 1e-30; double EPS = 2.22044604925031e-16; double Cr, Ci, Dr, Di, Deltar, Deltai; double jj, tempr, tempi, Cinvr, Cinvi; int j; *fr = TINY; *fi = 0.0; Cr = *fr; Ci = *fi; Dr = 0.0; Di = 0.0; for(j=0 ; j < *n ; j++){ tempr = Dr; tempi = Di; Dr = br[j] + ar[j]*tempr - ai[j]*tempi; Di = bi[j] + ar[j]*tempi + ai[j]*tempr; /* D = b[j] + a*D */ if( (Dr == 0.0) && (Di == 0.0)){ Dr = TINY; } jj = Cr*Cr + Ci*Ci; Cinvr = Cr/jj; Cinvi = -Ci/jj; /* Cinv = 1/C */ Cr = br[j] + ar[j]*Cinvr - ai[j]*Cinvi; Ci = bi[j] + ar[j]*Cinvi + ai[j]*Cinvr; /* C = b[j] + a[j]/C [or C = b + a*Cinv ] */ if((Cr == 0.0) && (Ci == 0.0)){ Cr = TINY; } jj = Dr*Dr + Di*Di; Dr = Dr/jj; Di = -Di/jj; /* D=1/D */ Deltar = Cr*Dr - Ci*Di; Deltai = Cr*Di + Ci*Dr; /* Delta = C*D */ tempr = *fr; tempi = *fi; *fr = tempr*Deltar - tempi*Deltai; *fi = tempr*Deltai + tempi*Deltar; /* f = f*D */ /* diff = (Deltar-1.0)*(Deltar-1.0) + Deltai*Deltai; /* diff = mod(Delta-1)^2 */ if( ( (Deltar-1.0) <= EPS) && ( (1.0-Deltar) <= EPS) && ( (0.0-Deltai) <= EPS) && ( (Deltai-0.0) <= EPS) ){ *tol = sqrt((Deltar-1.0)*(Deltar-1.0) + Deltai*Deltai); return; } } *tol = sqrt((Deltar-1.0)*(Deltar-1.0) + Deltai*Deltai); return; } void convergents(double *a, double *b, double *b0, int *n, double *A, double *B){ A[0] = *b0; B[0] = 1.0; A[1] = b[0]*A[0] + a[0]*1.0; /* because A_{-1} = 1 */ B[1] = b[0]*B[0] + a[0]*0.0; /* because B_{-1} = 0 */ for(int j=2; j < (*n)+1 ; j++){ A[j] = b[j-1]*A[j-1] + a[j-1]*A[j-2]; B[j] = b[j-1]*B[j-1] + a[j-1]*B[j-2]; } } void convergents_complex(double *ar, double *ai, double *br, double *bi, double *b0r, double *b0i, int *n, double *Ar, double *Ai, double *Br, double *Bi){ Ar[0] = *b0r; Ai[0] = *b0i; Br[0] = 1.0; Bi[0] = 0.0; /* B[0] = 1 */ Ar[1] = br[0]*Ar[0] - bi[0]*Ai[0] + ar[0]; Ai[1] = br[0]*Ai[0] + bi[0]*Ar[0] + ai[0]; Br[1] = br[0]*Br[0] - bi[0]*Bi[0]; Bi[1] = br[0]*Bi[0] + bi[0]*Br[0]; for(int j=2 ; j < (*n)+1 ; j++){ Ar[j] = br[j-1]*Ar[j-1] - bi[j-1]*Ai[j-1] + ar[j-1]*Ar[j-2] - ai[j-1]*Ai[j-2]; Ai[j] = br[j-1]*Ai[j-1] + bi[j-1]*Ar[j-1] + ar[j-1]*Ai[j-2] + ai[j-1]*Ar[j-2]; Br[j] = br[j-1]*Br[j-1] - bi[j-1]*Bi[j-1] + ar[j-1]*Br[j-2] - ai[j-1]*Bi[j-2]; Bi[j] = br[j-1]*Bi[j-1] + bi[j-1]*Br[j-1] + ar[j-1]*Bi[j-2] + ai[j-1]*Br[j-2]; } } contfrac/NAMESPACE0000644000176200001440000000005512721152713013271 0ustar liggesusersexportPattern("^[^\\.]") useDynLib(contfrac) contfrac/R/0000755000176200001440000000000012721152713012253 5ustar liggesuserscontfrac/R/contfrac.R0000644000176200001440000000556412721152713014207 0ustar liggesusers"CF" <- function(a, finite = FALSE, tol=0){ ii <- is.infinite(a) if(any(ii)){ n <- min(which(ii)) a <- a[seq_len(n-1)] finite <- TRUE } b0 <- a[1] a <- a[-1] return(GCF(a=rep(1,length(a)), b=a, b0=b0, finite=finite, tol=tol)) } "GCF" <- function(a, b, b0=0, finite=FALSE, tol=0){ stopifnot(length(b) == length(a)) stopifnot(length(b0) == 1) stopifnot(length(a) > 0) if(tol <= 0){tol <- .Machine$double.eps} n <- length(a) if(is.complex(a) | is.complex(b)){ a <- as.complex(a) b <- as.complex(b) jj <- .C("contfrac_complex", as.double(Re(a)), as.double(Im(a)), as.double(Re(b)), as.double(Im(b)), as.integer(n), r = double(1), i = double(1), tol = double(1), PACKAGE = "contfrac") if(abs(jj$tol) <= tol | finite){ return(b0 + jj$r + 1i*jj$i) } else { warning("Continued fraction (complex) not converged") return(NA) } } else { stopifnot(is.numeric(a)) stopifnot(is.numeric(b)) jj <- .C("contfrac", a = as.double(as.vector(a)), b = as.double(as.vector(b)), n = as.integer(n), f = double(1), tol = double(1), PACKAGE = "contfrac" ) if(abs(jj$tol) <= tol | finite){ return(b0 + jj$f) } else { warning("Continued fraction not converged") return(NA) } } } "gconvergents" <- function(a,b,b0=0){ n <- length(a) stopifnot(length(a) == length(b)) stopifnot(length(a) > 0) stopifnot(length(b0) == 1) if(is.complex(a) | is.complex(b) | is.complex(b0)){ a <- as.complex(a) b <- as.complex(b) jj <- .C("convergents_complex", as.double(as.vector(Re(a))), as.double(as.vector(Im(a))), as.double(as.vector(Re(b))), as.double(as.vector(Im(b))), as.double(Re(b0)), as.double(Im(b0)), as.integer(n), Ar = double(n+1), Ai = double(n+1), Br = double(n+1), Bi = double(n+1), PACKAGE = "contfrac" ) return(list(A = jj$Ar + 1i*jj$Ai , B = jj$Br + 1i*jj$Bi)) } else { stopifnot(is.numeric(a)) stopifnot(is.numeric(b)) jj <- .C("convergents", as.double(as.vector(a)), as.double(as.vector(b)), as.double(b0), as.integer(n), A=double(n+1), B=double(n+1), PACKAGE = "contfrac" ) return(list(A=jj$A , B=jj$B)) } } "convergents" <- function(a){ gconvergents(a=rep(1,length(a)-1),b=a[-1],b0=a[1]) } "as_cf" <- function(x, n=10){ stopifnot(length(x)==1) stopifnot(is.double(x)) out <- double(n) for(i in seq_len(n)){ jj <- floor(x) out[i] <- jj x <- 1/(x-jj) } out } contfrac/MD50000644000176200001440000000066212721521747012375 0ustar liggesusers3e6eeb10094d4689f83a6cdd2cec3dde *DESCRIPTION 6119adb399676151c3ac5b4e1a873b24 *NAMESPACE 6bd5576478f6c78becf1e30f7c054f17 *R/contfrac.R 864b51292d00c723026d994b4723e080 *man/CF.Rd f2290e99c27ab164d3ba77573f7c15cb *man/as_cf.Rd 9fdc6e2f72269a81f0363a977e1d38e5 *man/contfrac-package.Rd b1386ae8103a14ae1d04b95dd569cb68 *man/convergents.Rd 18696ab2e46891ae7e10adedb05c844e *src/contfrac.c 783e06b91111c01eeb9413287cec5d02 *tests/aaa.R contfrac/DESCRIPTION0000644000176200001440000000053212721521747013567 0ustar liggesusersPackage: contfrac Title: Continued Fractions Version: 1.1-10 Author: Robin K. S. Hankin Description: Various utilities for evaluating continued fractions. Maintainer: Robin K. S. Hankin License: GPL-2 Packaged: 2016-05-24 22:29:43 UTC; rhankin NeedsCompilation: yes Repository: CRAN Date/Publication: 2016-05-26 09:21:11 contfrac/man/0000755000176200001440000000000012721152713012625 5ustar liggesuserscontfrac/man/contfrac-package.Rd0000644000176200001440000000262312721152713016307 0ustar liggesusers\name{contfrac-package} \alias{contfrac-package} \alias{contfrac} \docType{package} \title{ Continued fractions } \description{ Various utilities for manipulating continued fractions } \details{ \tabular{ll}{ Package: \tab contfrac\cr Type: \tab Package\cr Version: \tab 1.0\cr Date: \tab 2008-04-04\cr License: \tab GPL \cr } } \author{ Robin K. S. Hankin Maintainer: } \references{ \itemize{ \item W. H. Press, B. P. Flannery, S. A. Teukolsky, and W. T. Vetterling 1992. \emph{Numerical recipes 3rd edition: the art of scientific computing}. Cambridge University Press; section 5.2 \dQuote{Evaluation of continued fractions} \item W. J. Lenz 1976. Generating Bessel functions in Mie scattering calculations using continued fractions. \emph{Applied Optics}, 15(3):668-671 } } \keyword{ package } \examples{ # approximate real numbers with continued fraction: as_cf(pi) as_cf(exp(1),25) # OK up to element 21 (which should be 14) # Some convergents of pi: jj <- convergents(c(3,7,15,1,292)) jj$A / jj$B - pi # An identity of Euler's: jj <- GCF(a=seq(from=2,by=2,len=30), b=seq(from=3,by=2,len=30), b0=1) jj - 1/(exp(0.5)-1) # should be small # Now a continued fraction representation of tan(z): tan_cf <- function(z,n=14){ GCF(c(z,rep(-z^2,n-1)), seq(from=1,by=2,len=n)) } tan_cf(1+1i) - tan(1+1i) # should be small } contfrac/man/as_cf.Rd0000644000176200001440000000136612721152713014175 0ustar liggesusers\name{as_cf} \alias{as_cf} \title{Approximates a real number in continued fraction form} \description{ Approximates a real number in continued fraction form using a standard simple algorithm } \usage{ as_cf(x, n = 10) } \arguments{ \item{x}{real number to be approximated in continued fraction form} \item{n}{Number of partial denominators to evaluate; see Notes} } \author{Robin K. S. Hankin} \note{ Has difficulties with rational values as expected } \seealso{\code{\link{CF}},\code{\link{convergents}}} \examples{ phi <- (sqrt(5)+1)/2 as_cf(phi,50) # loses it after about 38 iterations ... not bad ... as_cf(pi) # looks about right as_cf(exp(1),20) f <- function(x){CF(as_cf(x,30),TRUE) - x} x <- runif(40) plot(sapply(x,f)) } \keyword{math} contfrac/man/convergents.Rd0000644000176200001440000000371212721152713015454 0ustar liggesusers\name{convergents} \alias{convergents} \alias{gconvergents} \title{Partial convergents of continued fractions} \description{ Partial convergents of continued fractions or generalized continued fractions } \usage{ convergents(a) gconvergents(a,b, b0 = 0) } \arguments{ \item{a,b}{In function \code{convergents()}, the elements of \code{a} are the partial denominators (the first element of \code{a} is the integer part of the continued fraction). In \code{gconvergents()} the elements of \code{a} are the partial numerators and the elements of \code{b} the partial denominators} \item{b0}{The floor of the fraction} } \details{ Function \code{convergents()} returns partial convergents of the continued fraction \deqn{a_0+ \frac{1}{a_1+ \frac{1}{a_2+ \frac{1}{a_3+ \frac{1}{a_4+ \frac{1}{a_5+\ddots }}}}}}{ommitted: see PDF} where \code{a} = \eqn{a_0,a_1,a_2,\ldots}{a_0,a_1,a_2,...} (note the off-by-one issue). Function \code{gconvergents()} returns partial convergents of the continued fraction \deqn{b_0+ \frac{a_1}{b_1+ \frac{a_2}{b_2+ \frac{a_3}{b_3+ \frac{a_4}{b_4+ \frac{a_5}{b_5+\ddots }}}}}}{ommitted: see PDF} where \code{a} = \eqn{a_1,a_2,\ldots}{a_1,a_2,...} } \value{ Returns a list of two elements, \code{A} for the numerators and \code{B} for the denominators } \references{ W. H. Press, B. P. Flannery, S. A. Teukolsky, and W. T. Vetterling 1992. \emph{Numerical recipes 3rd edition: the art of scientific computing}. Cambridge University Press; section 5.2 \dQuote{Evaluation of continued fractions} } \author{Robin K. S. Hankin} \note{ This classical algorithm generates very large partial numerators and denominators. To evaluate limits, use functions \code{CF()} or \code{GCF()}. } \seealso{\code{\link{CF}}} \examples{ # Successive approximations to pi: jj <- convergents(c(3,7,15,1,292)) jj$A/jj$B - pi # should get smaller convergents(rep(1,10)) } \keyword{math} contfrac/man/CF.Rd0000644000176200001440000000445212721152713013411 0ustar liggesusers\name{CF} \alias{CF} \alias{GCF} \title{Continued fraction convergent} \description{ Returns continued fraction convergent using the modified Lenz's algorithm; function \code{CF()} deals with continued fractions and \code{GCF()} deals with generalized continued fractions. } \usage{ CF(a, finite = FALSE, tol=0) GCF(a,b, b0=0, finite = FALSE, tol=0) } \arguments{ \item{a,b}{In function \code{CF()}, the elements of \code{a} are the partial denominators; in \code{GCF()} the elements of \code{a} are the partial numerators and the elements of \code{b} the partial denominators} \item{finite}{Boolean, with default \code{FALSE} meaning to iterate Lenz's algorithm until convergence (a warning is given if the sequence has not converged); and \code{TRUE} meaning to evaluate the finite continued fraction} \item{b0}{In function \code{GCF()}, floor of the continued fraction} \item{tol}{tolerance, with default \code{0} silently replaced with \code{.Machine$double.eps}} } \references{ \itemize{ \item W. H. Press, B. P. Flannery, S. A. Teukolsky, and W. T. Vetterling 1992. \emph{Numerical recipes 3rd edition: the art of scientific computing}. Cambridge University Press; section 5.2 \dQuote{Evaluation of continued fractions} \item W. J. Lenz 1976. Generating Bessel functions in Mie scattering calculations using continued fractions. \emph{Applied Optics}, 15(3):668-671 } } \author{Robin K. S. Hankin} \details{ Function \code{CF()} treats the first element of its argument as the integer part of the convergent. Function \code{CF()} is a wrapper for \code{GCF()}; it includes special dispensation for infinite values (in which case the value of the appropriate finite CF is returned). The implementation is in C; the real and complex cases are treated separately in the interests of efficiency. The algorithm terminates when the convergence criterion is achieved irrespective of the value of \code{finite}. } \seealso{\code{\link{convergents}}} \examples{ phi <- (sqrt(5)+1)/2 phi_cf <- CF(rep(1,100)) # phi = [1;1,1,1,1,1,...] phi - phi_cf # should be small # The tan function: "tan_cf" <- function(z,n=20){GCF(c(z, rep(-z^2,n-1)), seq(from=1,by=2, len=n)) } z <- 1+1i tan(z) - tan_cf(z) # should be small } \keyword{math}