lamW/0000755000176200001440000000000014171660332011155 5ustar liggesuserslamW/NAMESPACE0000644000176200001440000000022213766326312012376 0ustar liggesusersuseDynLib(lamW, .registration = TRUE) exportPattern("^[[:alpha:]]+") importFrom("Rcpp", "evalCpp") importFrom(RcppParallel, RcppParallelLibs) lamW/LICENSE0000644000176200001440000000005313314347173012163 0ustar liggesusersYEAR: 2015 COPYRIGHT HOLDER: Avraham AdlerlamW/README.md0000644000176200001440000000566114171652714012451 0ustar liggesusers [![CRAN Status Badge](https://www.r-pkg.org/badges/version/lamW)](https://CRAN.R-project.org/package=lamW) [![](http://cranlogs.r-pkg.org/badges/last-month/lamW)](https://cran.r-project.org/package=lamW) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.5874874.svg)](https://doi.org/10.5281/zenodo.5874874) [![CII Best Practices](https://bestpractices.coreinfrastructure.org/projects/2022/badge)](https://bestpractices.coreinfrastructure.org/projects/2022) [![R-CMD-check](https://github.com/aadler/lamW/workflows/R-CMD-check/badge.svg)](https://github.com/aadler/lamW/actions) [![Codecov test coverage](https://codecov.io/gh/aadler/lamW/branch/master/graph/badge.svg)](https://app.codecov.io/gh/aadler/lamW?branch=master) # lamW **lamW** is an `R` package which calculates the real-valued branches of the [Lambert-W function](https://en.wikipedia.org/wiki/Lambert_W_function) without the need to install the entire GSL. It uses compiled code and [`RcppParallel`](https://rcppcore.github.io/RcppParallel/) to achieve significant speed. ## Citation If you use the package, please cite it as: Avraham Adler (2015). lamW: Lambert-W Function. R package version 2.1.1. https://CRAN.R-project.org/package=lamW doi: 10.5281/zenodo.5874874 A BibTeX entry for LaTeX users is: ``` @Manual{, title = {lamW: Lambert-W Function}, author = {Avraham Adler}, year = {2015}, url = {https://CRAN.R-project.org/package=lamW}, doi = "10.5281/zenodo.5874874", note = {R package version 2.1.1.}, } ``` ## Contributions Please ensure that all contributions comply with both [R and CRAN standards for packages](https://cran.r-project.org/doc/manuals/r-release/R-exts.html). ### Versioning This project attempts to follow [Semantic Versioning](https://semver.org/) ### Changelog This project attempts to follow the changelog system at [Keep a CHANGELOG](https://keepachangelog.com/) ### Dependancies This project intends to have as few dependancies as possible. Please consider that when writing code. ### Style Please review and conform to the current code stylistic choices (e.g. 80 character lines, two-space indentations). ### Documentation Please provide valid .Rd files and **not** roxygen-style documentation. ### Tests Please review the current test suite and supply similar `tinytest`-compatible unit tests for all added functionality. ### Submission If you would like to contribute to the project, it may be prudent to first contact the maintainer via email. A request or suggestion may be raised as an issue as well. To supply a pull request (PR), please: 1. Fork the project and then clone into your own local repository 2. Create a branch in your repository in which you will make your changes 3. Push that branch to your remote and then create a pull request At this point, the PR will be discussed and eventually accepted or rejected. lamW/man/0000755000176200001440000000000013766326312011736 5ustar liggesuserslamW/man/lamW-internal.Rd0000644000176200001440000000061513767003365014742 0ustar liggesusers\name{lamW-internal} %% These are the internal C++ functions called by the package \alias{lambertW0_C} \alias{lambertWm1_C} \alias{lamW_RcppExport_registerCCallable} \alias{lamW_lambertW0_C} \alias{lamW_lambertWm1_C} \title{Internal lamW Functions} \description{ Internal lambert-W functions } \details{ These are not to be called directly by the user. } \keyword{internal} lamW/man/lamW.Rd0000644000176200001440000000552014051573463013126 0ustar liggesusers\name{lambertW} \alias{lambertW0} \alias{lambertWm1} \title{Lambert-W Function} \description{ The Lambert-W function is defined as the multivalued inverse of the function \eqn{z = f(W) = We^W}{z = f(W) = W * exp(W)}. The function has two branches. The principal branch is defined on the interval \eqn{[-\frac{1}{e}, \infty)}{[-1/e, Infinity)} and is always greater than or equal to-1. The second branch is defined on the interval \eqn{[-\frac{1}{e}, 0)}{[-1/e, 0)} and is always less than or equal to-1. The real-valued function is not defined for values less than \eqn{-\frac{1}{e}}{-1/e}. } \usage{ lambertW0(x) lambertWm1(x) } \arguments{ \item{x}{vector of values}} \details{ The Lambert-W function is defined for all real \eqn{x \geq -\frac{1}{e}}{x >= -1/e}. It has two values in the interval \eqn{(-\frac{1}{e}, 0)}{(-1/e, 0)}. The values strictly greater than -1 are assigned to the \dQuote{principal} branch, also referred to as \eqn{W_0}{W0}, and the values strictly less than -1 are assigned to the \dQuote{secondary} branch, referred to as \eqn{W_{-1}}{Wm1}. For non-negative \eqn{x}, only the principal branch exists as the other real-valued branch approaches negative infinity as \eqn{x} approaches 0. The algorithms used to calculate the values predominantly follow those in the reference with some simplifications. There are many applications in which the Lambert-W function is useful, such as combinatorics, physics, and hydrology. The interested reader is directed to the references for more detail. } \value{ Both functions return the appropriate values in the intervals for which they are defined. Outside of those intervals, they will return \code{NaN}, except that \code{lambertW0(Inf)} will return its limit \code{Inf} and \code{lambertWm1(0)} will return its limit -\code{Inf}. } \references{ Corless, R. M., Gonnet, G. H., Hare, D. E., Jeffrey, D. J., Knuth, D. E. 1996 "On the Lambert W function", \emph{Advances in Computational Mathematics}, \bold{5}, 329--359, Springer Fritsch, F. N.; Shafer, R. E. & Crowley, W. P. 1973 "Solution of the transcendental equation (we^w = x)", \emph{Communications of the ACM}, \bold{16}, 123--124, Association for Computing Machinery (ACM) } \author{ Avraham Adler \email{Avraham.Adler@gmail.com} } \seealso{ This package provides similar functionality to the \code{\link[gsl:Lambert]{Lambert}} functions in the \pkg{gsl} package without having to obtain or install the entire \acronym{GSL}. } \examples{ lambertW0(exp(1)) ## Should equal 1, as 1 * exp(1) = e. lambertW0(0) ## Should equal 0, as 0 * exp(0) = 0. lambertW0(-exp(-1)) ## Should equal -1. lambertWm1(-exp(-1)) ## Should also equal -1. A <- -2 * exp(-2) lambertWm1(A) ## Should equal -2 } \keyword{NumericalMathematics} lamW/man/lamW-package.Rd0000644000176200001440000000055513767003372014522 0ustar liggesusers\name{lamW-package} \alias{lamW-package} \alias{lamW} \docType{package} \title{ \packageTitle{lamW} } \description{ \packageDescription{lamW} } \details{ The DESCRIPTION file: \packageDESCRIPTION{lamW} \packageIndices{lamW} } \author{ \packageAuthor{lamW} Maintainer: \packageMaintainer{lamW} } \keyword{package} \keyword{NumericalMathematics} lamW/DESCRIPTION0000644000176200001440000000170514171660332012666 0ustar liggesusersPackage: lamW Type: Package Title: Lambert-W Function Version: 2.1.1 Date: 2022-01-18 Authors@R: c(person(given="Avraham", family="Adler",role=c("aut", "cph", "cre"), email="Avraham.Adler@gmail.com", comment = c(ORCID = "0000-0002-3039-0703"))) Description: Implements both real-valued branches of the Lambert-W function (Corless et al, 1996) without the need for installing the entire GSL. License: BSD_2_clause + file LICENSE Depends: R (>= 3.0.2) Imports: Rcpp, RcppParallel (>= 4.3.20) LinkingTo: Rcpp, RcppParallel (>= 4.3.20) SystemRequirements: GNU make Suggests: covr, tinytest NeedsCompilation: yes URL: https://github.com/aadler/lamW BugReports: https://github.com/aadler/lamW/issues Packaged: 2022-01-19 00:29:21 UTC; Parents Author: Avraham Adler [aut, cph, cre] () Maintainer: Avraham Adler Repository: CRAN Date/Publication: 2022-01-19 00:52:42 UTC lamW/build/0000755000176200001440000000000014171655540012261 5ustar liggesuserslamW/build/partial.rdb0000644000176200001440000000640614171655540014414 0ustar liggesusers]SF`!IpLhHsW HB MUCT8&/wMܷ V+b[|<~֣ϾHZ8n !_7T5fH"B(pZb>ɉ!@3 (N=z%W,n>ũG MG خ˖2;:X쥥%8`0z税fg.}_n/WׄW ~ў)ɖAX=$;[R ,g eG5.݃T/-)FN7":-2ILqȂr7BRb[ik~>颚6jWȘ}V-[Pc!zo1-voZ6D9f@W [@$ _$]n7j|;p4֥MB<̮l/i'.-ץ/ʕʃ*Ua5mn#mTRӓGVdd׺Q ?J7)!Dl'(3!DukME\\q X1LAo ;{yFԭl$IMI|H!zV=I[hݓjPӺ8nվ =(OF\ '&N@N˘KE.:R܌O[ PC unvlVRl#D NH'1)NϬX6tHTt}iuIc(:Z+Je/qYXuaτ~˳&M }}yfRsfIMU;(f-C:l6YhB&jJs6 nĺ)ySULh# $ Aq1H Si-%;#w~EA"W:!^LRx[RG/M`!kHk݃yCBEc@'|H"q|bkQ͚(|K!7ȉߥ$u) d^ߺt7,ָuFOqJ+SnX,i/% Ni:v pֹrqU8f(:Tjs\Bq$\M#p:;+~cAUe+ M}Ix^z&Әzpe-3"Ժkm G&dEPH\A7J$gm_Ίi6b!ΦQUmjLK3RBxr FPHE@ˋnj51DGπK:?oNHғHԍMG$$Ca{~ tE\w݀;C"҇4,|(¬zj<ȘRuR͟ =}͊f7uDv,#L)øvie-tEM1bWBABA4tBń*-Q+$F.hyõӃ6~IT .FC/)VTA%tMy&$Q 0\g+a*(vff@S# XJg4ЏެgacOSrIp5@lʁ+(0zV b`R A m2o{8-ZGDm4"Ng6J$NrV@\sª!˽Ikd7H #include #define _USE_MATH_DEFINES #include using namespace Rcpp; using namespace RcppParallel; const double EPS = 2.2204460492503131e-16; const double M_1_E = 1.0 / M_E; /* Fritsch Iteration * W_{n+1} = W_n * (1 + e_n) * z_n = ln(x / W_n) - W_n * q_n = 2 * (1 + W_n) * (1 + W_n + 2 / 3 * z_n) * e_n = z_n / (1 + W_n) * (q_n - z_n) / (q_n - 2 * z_n) */ double FritschIter(double x, double w_guess){ double w = w_guess; int MaxEval = 5; bool CONVERGED = false; double k = 2.0 / 3.0; int i = 0; do { double z = std::log(x / w) - w; double w1 = w + 1.0; double q = 2.0 * w1 * (w1 + k * z); double qmz = q - z; double e = z / w1 * qmz / (qmz - z); CONVERGED = std::abs(e) <= EPS; w *= (1.0 + e); ++i; } while (!CONVERGED && i < MaxEval); return(w); } double lambertW0_CS(double x) { double result; double w; if (x == R_PosInf) { result = R_PosInf; } else if (x < -M_1_E) { result = R_NaN; } else if (std::abs(x + M_1_E) <= EPS) { result = -1.0; } else if (x <= M_E - 0.5) { if (std::abs(x) <= 1e-16) { /* This close to 0 the W_0 branch is best estimated by its Taylor/Pade expansion whose first term is the value x and remaining terms are below machine double precision. See https://math.stackexchange.com/questions/1700919/how-to-derive-the-lambert-w-function-series-expansion */ result = x; } else { if (std::abs(x) <= 7e-3) { /* Use equation (5) in Fritsch */ w = ((1.33333333333333333 * x + 1.0) * x) / ((0.83333333333333333 * x + 2.33333333333333333) * x + 1.0); } else { /* Use expansion in Corliss 4.22 to create (3, 2) Pade approximant Numerator:-10189 / 303840 * p^3 + 40529 / 303840 * p^2 + 489 / 844 * p-1 Denominator: -14009 / 303840 * p^2 + 355 / 844 * p + 1 Converted to digits to reduce needed operations */ double p = std::sqrt(2.0 * (M_E * x + 1.0)); double Numer = ((-0.03353409689310163 * p + 0.1333892838335966) * p + 0.5793838862559242) * p - 1.0; double Denom = (-0.04610650342285413 * p + 0.4206161137440758) * p + 1.0; w = Numer / Denom; } result = FritschIter(x, w); } } else { /* Use first five terms of Corliss et al. 4.19 */ w = std::log(x); double L_2 = std::log(w); double L_3 = L_2 / w; double L_3_sq = L_3 * L_3; w += -L_2 + L_3 + 0.5 * L_3_sq - L_3 / w + L_3 / (w * w) - 1.5 * L_3_sq / w + L_3_sq * L_3 / 3.0; result = FritschIter(x, w); } return(result); } double lambertWm1_CS(double x){ double result; double w; if (x == 0.0) { result = R_NegInf; } else if (x < -M_1_E || x > 0.0) { result = R_NaN; } else if (std::abs(x + M_1_E) <= EPS) { result = -1.0; } else { /* Use first five terms of Corliss et al. 4.19 */ w = std::log(-x); double L_2 = std::log(-w); double L_3 = L_2 / w; double L_3_sq = L_3 * L_3; w += -L_2 + L_3 + 0.5 * L_3_sq - L_3 / w + L_3 / (w * w) - 1.5 * L_3_sq / w + L_3_sq * L_3 / 3.0; result = FritschIter(x, w); } return(result); } struct LW0 : public Worker { // source and output const RVector input; RVector output; // initialization LW0(const NumericVector input, NumericVector output) : input(input), output(output) {} // Transform using primary branch void operator() (std::size_t begin, std::size_t end) { std::transform(input.begin() + begin, input.begin() + end, output.begin() + begin, lambertW0_CS); } }; struct LWm1 : public Worker { // source and output const RVector input; RVector output; // initialization LWm1(const NumericVector input, NumericVector output) : input(input), output(output) {} // Transform using primary branch void operator() (std::size_t begin, std::size_t end) { std::transform(input.begin() + begin, input.begin() + end, output.begin() + begin, lambertWm1_CS); } }; // [[Rcpp::export]] NumericVector lambertW0_C(NumericVector x) { // allocate the output vector NumericVector output(x.size()); // Lambert W0 functor (pass input and output matrixes) LW0 LW0(x, output); // call parallelFor to do the work parallelFor(0, x.length(), LW0); // return the output vector return output; } // [[Rcpp::export]] NumericVector lambertWm1_C(NumericVector x) { // allocate the output vector NumericVector output(x.size()); // Lambert Wm1 functor (pass input and output matrixes) LWm1 LWm1(x, output); // call parallelFor to do the work parallelFor(0, x.length(), LWm1); // return the output vector return output; } lamW/src/Makevars0000644000176200001440000000014113766326312013442 0ustar liggesusersCXX_STD = CXX11 PKG_LIBS += $(shell ${R_HOME}/bin/Rscript -e "RcppParallel::RcppParallelLibs()") lamW/src/Makevars.win0000644000176200001440000000025713766326312014246 0ustar liggesusersCXX_STD = CXX11 PKG_CXXFLAGS += -DRCPP_PARALLEL_USE_TBB=1 PKG_LIBS += $(shell "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" \ -e "RcppParallel::RcppParallelLibs()") lamW/src/RcppExports.cpp0000644000176200001440000000755414171645414014760 0ustar liggesusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include "../inst/include/lamW.h" #include #include #include using namespace Rcpp; #ifdef RCPP_USE_GLOBAL_ROSTREAM Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); #endif // lambertW0_C NumericVector lambertW0_C(NumericVector x); static SEXP _lamW_lambertW0_C_try(SEXP xSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); rcpp_result_gen = Rcpp::wrap(lambertW0_C(x)); return rcpp_result_gen; END_RCPP_RETURN_ERROR } RcppExport SEXP _lamW_lambertW0_C(SEXP xSEXP) { SEXP rcpp_result_gen; { Rcpp::RNGScope rcpp_rngScope_gen; rcpp_result_gen = PROTECT(_lamW_lambertW0_C_try(xSEXP)); } Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error"); if (rcpp_isInterrupt_gen) { UNPROTECT(1); Rf_onintr(); } bool rcpp_isLongjump_gen = Rcpp::internal::isLongjumpSentinel(rcpp_result_gen); if (rcpp_isLongjump_gen) { Rcpp::internal::resumeJump(rcpp_result_gen); } Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error"); if (rcpp_isError_gen) { SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen); UNPROTECT(1); Rf_error(CHAR(rcpp_msgSEXP_gen)); } UNPROTECT(1); return rcpp_result_gen; } // lambertWm1_C NumericVector lambertWm1_C(NumericVector x); static SEXP _lamW_lambertWm1_C_try(SEXP xSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< NumericVector >::type x(xSEXP); rcpp_result_gen = Rcpp::wrap(lambertWm1_C(x)); return rcpp_result_gen; END_RCPP_RETURN_ERROR } RcppExport SEXP _lamW_lambertWm1_C(SEXP xSEXP) { SEXP rcpp_result_gen; { Rcpp::RNGScope rcpp_rngScope_gen; rcpp_result_gen = PROTECT(_lamW_lambertWm1_C_try(xSEXP)); } Rboolean rcpp_isInterrupt_gen = Rf_inherits(rcpp_result_gen, "interrupted-error"); if (rcpp_isInterrupt_gen) { UNPROTECT(1); Rf_onintr(); } bool rcpp_isLongjump_gen = Rcpp::internal::isLongjumpSentinel(rcpp_result_gen); if (rcpp_isLongjump_gen) { Rcpp::internal::resumeJump(rcpp_result_gen); } Rboolean rcpp_isError_gen = Rf_inherits(rcpp_result_gen, "try-error"); if (rcpp_isError_gen) { SEXP rcpp_msgSEXP_gen = Rf_asChar(rcpp_result_gen); UNPROTECT(1); Rf_error(CHAR(rcpp_msgSEXP_gen)); } UNPROTECT(1); return rcpp_result_gen; } // validate (ensure exported C++ functions exist before calling them) static int _lamW_RcppExport_validate(const char* sig) { static std::set signatures; if (signatures.empty()) { signatures.insert("NumericVector(*lambertW0_C)(NumericVector)"); signatures.insert("NumericVector(*lambertWm1_C)(NumericVector)"); } return signatures.find(sig) != signatures.end(); } // registerCCallable (register entry points for exported C++ functions) RcppExport SEXP _lamW_RcppExport_registerCCallable() { R_RegisterCCallable("lamW", "_lamW_lambertW0_C", (DL_FUNC)_lamW_lambertW0_C_try); R_RegisterCCallable("lamW", "_lamW_lambertWm1_C", (DL_FUNC)_lamW_lambertWm1_C_try); R_RegisterCCallable("lamW", "_lamW_RcppExport_validate", (DL_FUNC)_lamW_RcppExport_validate); return R_NilValue; } static const R_CallMethodDef CallEntries[] = { {"_lamW_lambertW0_C", (DL_FUNC) &_lamW_lambertW0_C, 1}, {"_lamW_lambertWm1_C", (DL_FUNC) &_lamW_lambertWm1_C, 1}, {"_lamW_RcppExport_registerCCallable", (DL_FUNC) &_lamW_RcppExport_registerCCallable, 0}, {NULL, NULL, 0} }; RcppExport void R_init_lamW(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } lamW/R/0000755000176200001440000000000014171655522011363 5ustar liggesuserslamW/R/lamW.R0000644000176200001440000000031214051574145012400 0ustar liggesuserslambertW0 <- function(x) { LAM <- double(length(x)) LAM <- lambertW0_C(x) return(LAM) } lambertWm1 <- function(x) { LAM <- double(length(x)) LAM <- lambertWm1_C(x) return(LAM) } lamW/R/RcppExports.R0000644000176200001440000000066214171655522014003 0ustar liggesusers# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 lambertW0_C <- function(x) { .Call(`_lamW_lambertW0_C`, x) } lambertWm1_C <- function(x) { .Call(`_lamW_lambertWm1_C`, x) } # Register entry points for exported C++ functions methods::setLoadAction(function(ns) { .Call('_lamW_RcppExport_registerCCallable', PACKAGE = 'lamW') }) lamW/MD50000644000176200001440000000175514171660332011475 0ustar liggesusersc61a6f585c8a89e134de2cf57b1aee02 *DESCRIPTION 9fe401759a8da27089ef3979da17fa74 *LICENSE 610b72e22e057e24ad168d21d1b2e89b *NAMESPACE c473cef7bbb064706393fffeff855365 *R/RcppExports.R d4ad43d04eca7beb9b98433329b2a745 *R/lamW.R f12ddd9c032be24b9077a75a7ece5622 *README.md b32da2cf1dad56537b1314bca6d8011f *build/partial.rdb 00602812442eed5e3e2501869cc1ff42 *inst/CITATION a780cd29bd3001926f35b825a3fea38b *inst/NEWS.Rd a4124c5d0c43aea90093188d44509854 *inst/include/lamW.h 6dbd1706b7f5f13a00ad8f9fad0dc340 *inst/include/lamW_RcppExports.h a993df92acce1f200daad1846d0ef473 *inst/tinytest/test_lamW.R b438cbf7be7215630ab00a843b54c20d *man/lamW-internal.Rd 96b1ab390f18840efc9859e6f0e871cb *man/lamW-package.Rd 43cd2ce3b8a9e2aef78ab7cfdce10c1b *man/lamW.Rd 8465ee3c046dc4b929d81033152f5339 *src/Makevars 1344f2b0991ab305a1a99893493c907d *src/Makevars.win 177a216abcd8edef783ce5af027564d8 *src/RcppExports.cpp e0d4107fab40e44fbf14671c670f2f52 *src/lambertW.cpp acc33156a11f2b43f8856b5eccc1f921 *tests/tinytest.R lamW/inst/0000755000176200001440000000000014171651251012132 5ustar liggesuserslamW/inst/include/0000755000176200001440000000000013766326312013563 5ustar liggesuserslamW/inst/include/lamW_RcppExports.h0000644000176200001440000000547413766326312017217 0ustar liggesusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #ifndef RCPP_lamW_RCPPEXPORTS_H_GEN_ #define RCPP_lamW_RCPPEXPORTS_H_GEN_ #include namespace lamW { using namespace Rcpp; namespace { void validateSignature(const char* sig) { Rcpp::Function require = Rcpp::Environment::base_env()["require"]; require("lamW", Rcpp::Named("quietly") = true); typedef int(*Ptr_validate)(const char*); static Ptr_validate p_validate = (Ptr_validate) R_GetCCallable("lamW", "_lamW_RcppExport_validate"); if (!p_validate(sig)) { throw Rcpp::function_not_exported( "C++ function with signature '" + std::string(sig) + "' not found in lamW"); } } } inline NumericVector lambertW0_C(NumericVector x) { typedef SEXP(*Ptr_lambertW0_C)(SEXP); static Ptr_lambertW0_C p_lambertW0_C = NULL; if (p_lambertW0_C == NULL) { validateSignature("NumericVector(*lambertW0_C)(NumericVector)"); p_lambertW0_C = (Ptr_lambertW0_C)R_GetCCallable("lamW", "_lamW_lambertW0_C"); } RObject rcpp_result_gen; { RNGScope RCPP_rngScope_gen; rcpp_result_gen = p_lambertW0_C(Shield(Rcpp::wrap(x))); } if (rcpp_result_gen.inherits("interrupted-error")) throw Rcpp::internal::InterruptedException(); if (Rcpp::internal::isLongjumpSentinel(rcpp_result_gen)) throw Rcpp::LongjumpException(rcpp_result_gen); if (rcpp_result_gen.inherits("try-error")) throw Rcpp::exception(Rcpp::as(rcpp_result_gen).c_str()); return Rcpp::as(rcpp_result_gen); } inline NumericVector lambertWm1_C(NumericVector x) { typedef SEXP(*Ptr_lambertWm1_C)(SEXP); static Ptr_lambertWm1_C p_lambertWm1_C = NULL; if (p_lambertWm1_C == NULL) { validateSignature("NumericVector(*lambertWm1_C)(NumericVector)"); p_lambertWm1_C = (Ptr_lambertWm1_C)R_GetCCallable("lamW", "_lamW_lambertWm1_C"); } RObject rcpp_result_gen; { RNGScope RCPP_rngScope_gen; rcpp_result_gen = p_lambertWm1_C(Shield(Rcpp::wrap(x))); } if (rcpp_result_gen.inherits("interrupted-error")) throw Rcpp::internal::InterruptedException(); if (Rcpp::internal::isLongjumpSentinel(rcpp_result_gen)) throw Rcpp::LongjumpException(rcpp_result_gen); if (rcpp_result_gen.inherits("try-error")) throw Rcpp::exception(Rcpp::as(rcpp_result_gen).c_str()); return Rcpp::as(rcpp_result_gen); } } #endif // RCPP_lamW_RCPPEXPORTS_H_GEN_ lamW/inst/include/lamW.h0000644000176200001440000000035613766326312014640 0ustar liggesusers// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #ifndef RCPP_lamW_H_GEN_ #define RCPP_lamW_H_GEN_ #include "lamW_RcppExports.h" #endif // RCPP_lamW_H_GEN_ lamW/inst/CITATION0000644000176200001440000000172414171652071013274 0ustar liggesuserscitHeader("To cite the", sQuote("lamW"), "package in publications, please use:") citEntry(entry = "Manual", title = "lamW: Lambert-W Function", author = personList(c(person(given = "Avraham", family = "Adler", role = c("aut", "cph", "cre"), email = "Avraham.Adler@gmail.com", comment = c(ORCID = "0000-0002-3039-0703")))), year = "2015", url = "https://CRAN.R-project.org/package=lamW", doi = "10.5281/zenodo.5874874", note = "R package version 2.1.1", textVersion = paste("Avraham Adler (2015).", "lamW: Lambert-W Function.", "R package version 2.1.1.", "https://CRAN.R-project.org/package=lamW", "doi: 10.5281/zenodo.5874874") ) lamW/inst/tinytest/0000755000176200001440000000000014171645735014027 5ustar liggesuserslamW/inst/tinytest/test_lamW.R0000644000176200001440000000375614171651021016105 0ustar liggesusers# Test that functions return proper values PrincipleBranchAnswers <- runif(5000, min = -1, max = 703.22703310477016) PrincipleBranchTests <- PrincipleBranchAnswers * exp(PrincipleBranchAnswers) SecondaryBranchAnswers <- runif(5000, min = -714.96865723796657, max = -1) SecondaryBranchTests <- SecondaryBranchAnswers * exp(SecondaryBranchAnswers) expect_equal(lambertW0(PrincipleBranchTests), PrincipleBranchAnswers) expect_equal(lambertWm1(SecondaryBranchTests), SecondaryBranchAnswers) # Test that function behaves properly near 0 V0 <- seq(-2e-2, 2e-2, 2e-6) V0E <- V0 * exp(V0) LV0 <- lambertW0(V0E) expect_equal(V0, LV0) # Test that W0 behaves properly VERY close to 0 expect_equal(lambertW0(1e-275), 1e-275) expect_equal(lambertW0(7e-48), 7e-48) expect_equal(lambertW0(-3.81e-71), -3.81e-71) # Test that function behaves properly near -1/e expect_equal(lambertW0(-1/exp(1)), -1) expect_equal(lambertWm1(-1/exp(1)), -1) # Test that function behaves properly near asymptotes L <- seq(1e-6 - exp(-1), -0.25, 3e-6) V0 <- lambertW0(L) Vm1 <- lambertWm1(L) expect_equal(V0 * exp(V0), L) expect_equal(Vm1 * exp(Vm1), L) Vm1 <- seq(-714, -714.96865, -3e-5) Vm1E <- Vm1 * exp(Vm1) LVm1 <- lambertWm1(Vm1E) expect_equal(Vm1, LVm1) # Test that function behaves properly at asymptotes expect_equal(lambertW0(Inf), Inf) expect_equal(lambertWm1(0), -Inf) # Test that NaNs are returned for values outside domain expect_true(is.nan(lambertW0(-Inf))) expect_true(is.nan(lambertWm1(-Inf))) expect_true(is.nan(lambertWm1(Inf))) expect_true(is.nan(lambertW0(-1))) expect_true(is.nan(lambertWm1(-1))) expect_true(is.nan(lambertWm1(1))) expect_true(is.nan(lambertW0(c(1, -1)))[[2]]) # Test that integers are converted to reals for principle branch expect_equal(lambertW0(c(-1L, 0L, 1L, 2L, 3L, 4L)), lambertW0(c(-1, 0, 1, 2, 3, 4))) ## Test CITATION expect_true(any(grepl(packageVersion('lamW'), toBibtex(citation('lamW')), fixed = TRUE))) lamW/inst/NEWS.Rd0000644000176200001440000001320514171652017013177 0ustar liggesusers\name{NEWS} \alias{NEWS} \alias{Changelog} \title{NEWS file for the lamW package} \section{Version 2.1.1 (2022-01-18)}{ \subsection{Changed}{ \itemize{ \item Converted test suite to \code{tinytest} framework to reduce dependencies. \item Added DOI and CFF for citation purposes } } } \section{Version 2.1.0 (2021-05-20)}{ \subsection{Changed}{ \itemize{ \item Obtained access to original Fritsch paper and used supplied Pade expansion (equation 5) for values close to 0, eliminating need for Halley step close to 0 and speeding up code slightly } } } \section{Version 2.0.0 (2021-01-05)}{ \subsection{Changed}{ \itemize{ \item Used series expansion around 0 for more accurate return value for \eqn{x \le 10^{-16}}{x \le 1e-16} (thanks to Jerry Lewis) \item Contracted region around \eqn{\frac{-1}{e}}{-1/e} which returns -1 to \code{Machine$double.eps} \item Converted continuous integration to Github actions } } } \section{Version 1.3.3 (2020-06-26)}{ \subsection{Fixed}{ \itemize{ \item Corrected minor issues tripping CRAN checks \item Adjusted linking to other packages in help documentation } } \subsection{Changed}{ \itemize{ \item Moved repository to Github } } \subsection{Added}{ \itemize{ \item Added travis, appveyor, and codecovr \item Added check for package version and behavior at \eqn{\frac{-1}{e}}{-1/e} \item explicit calls to \code{std::} in the C++ code } } } \section{Version 1.3.2 (2020-05-25)}{ \subsection{Fixed}{ \itemize{ \item Corrected regression which treated PosInf and NegInf the same on principle branch (thanks to CRAN & Uwe Ligges) } } \subsection{Added}{ \itemize{ \item Added test to ensure PosInf and NegInf are properly identified accurately \item Expanded existing tests } } } \section{Version 1.3.1 (2020-05-24) [YANKED]}{ \subsection{Added}{ \itemize{ \item Use R magic words and Rcpp sugar instead of calls to STD (caused regression) \item Added more tests near asymptotes and for real vs. integer \item Added ORCID to DESCRIPTION } } \subsection{Changed}{ \itemize{ \item Reduced max interations in some loops as convergence acheived more quickly \item Refactored old nomenclature \item Cleaned code for whitespace and unnecessary comments \item Spellcheck and minor cleanup of help file } } } \section{Version 1.3.0 (2017-04-24)}{ \subsection{Added}{ \itemize{ \item Added new package native routine registration. } } } \section{Version 1.2.0 (2016-10-26)}{ \subsection{Changed}{ \itemize{ \item Now using RcppParallel for calculation. Speedup when calculating more than one value at a time should be noticeable, e.g. around a 5X speedup on an 8 core machine. There should be no noticeable change when calculating single values at a time. } } } \section{Version 1.1.1 (2016-05-02)}{ \subsection{Added}{ \itemize{ \item Added testing for proper behavior near 0 due to log in Fritsch step implementation } } \subsection{Fixed}{ \itemize{ \item Edited NEWS.Rd so that it shows properly on CRAN } } } \section{Version 1.1.0 (2016-03-15)}{ \subsection{Changed}{ \itemize{ \item Switched from exclusively using Halley iteration to usually using Fritsch iteration resulting in a significant increase in speed in both branches } } } \section{Version 1.0.0 (2015-12-27)}{ \subsection{Added}{ \itemize{ \item Added explicit exportation of headers for use in the \link[lambertW]{LambertW} package (Thanks to Georg M. Goerg). } } \subsection{Changed}{ \itemize{ \item Update to initial release \item Adjust NEWS to more closely follow \href{https://keepachangelog.com/}{keep a changelog} suggestions \item Removed mention of LambertW and its importing the \code{gsl} package from the documentation as it now imports this package instead. } } } \section{Version 0.1.2 (2015-10-07)}{ \subsection{Added}{ \itemize{ \item Have both branches of the function return their respective limits. The main branch returns \code{Inf} when it is passed \code{Inf} and the secondary branch returns -\code{Inf} when it is passed 0 (Thanks to Georg M. Gorg) } } \subsection{Changed}{ \itemize{ \item Make unit tests more robust \item Update code for tests for equality for changes in \code{testthat} package } } } \section{Version 0.1.1 (2015-05-20)}{ \subsection{Fixed}{ \itemize{ \item Remove extra parenthesis which was causing boolean to be passed to \code{fabs} (thanks to Professor Brian Ripley) } } \subsection{Added}{ \itemize{ \item Added URL and Bugreports to DESCRIPTION \item Implemented minor optimizations to reduce number of needed calculations \item Added comments to source explaining Halley step and provenance of numeric coefficients in Pade approximant \item Added more robust unit testing } } \subsection{Changed}{ \itemize{ \item Enhanced and cleaned documentation \item Cleaned up source code from unnecessary comments } } } \section{Version 0.0.1 (2015-05-19)}{ \subsection{Added}{ \itemize{ \item Initial release } } }