lamW/0000755000176200001440000000000014532445652011164 5ustar liggesuserslamW/NAMESPACE0000644000176200001440000000022214231261633012366 0ustar liggesusersuseDynLib(lamW, .registration = TRUE) exportPattern("^[[:alpha:]]+") importFrom("Rcpp", "evalCpp") importFrom(RcppParallel, RcppParallelLibs) lamW/LICENSE0000644000176200001440000000005313314347173012163 0ustar liggesusersYEAR: 2015 COPYRIGHT HOLDER: Avraham AdlerlamW/README.md0000644000176200001440000000336714507307172012450 0ustar liggesusers--- title: Package lamW --- [![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) [![](https://cranlogs.r-pkg.org/badges/grand-total/lamW)](https://cran.r-project.org/package=lamW) [![R-CMD-check](https://github.com/aadler/lamW/workflows/R-CMD-check/badge.svg)](https://github.com/aadler/lamW/actions/workflows/R-CMD-check.yaml) [![Codecov test coverage](https://codecov.io/gh/aadler/lamW/branch/master/graph/badge.svg)](https://app.codecov.io/gh/aadler/lamW?branch=master) [![OpenSSF Best Practices](https://bestpractices.coreinfrastructure.org/projects/2022/badge)](https://bestpractices.coreinfrastructure.org/projects/2022) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.5874874.svg)](https://doi.org/10.5281/zenodo.5874874) ## Description **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 per [CITATION](https://CRAN.R-project.org/package=lamW/citation.html). ## Roadmap ### Major * There are no plans for major changes in the foreseeable future ### Minor * There are no plans for minor changes in the foreseeable future ## Contributions Please see [CONTRIBUTING](https://github.com/aadler/lamW/blob/master/CONTRIBUTING.md). ## Security Please see [SECURITY](https://github.com/aadler/lamW/blob/master/SECURITY.md). lamW/man/0000755000176200001440000000000014526505761011740 5ustar liggesuserslamW/man/lamW-internal.Rd0000644000176200001440000000075314464176233014745 0ustar liggesusers% Copyright (c) 2015, Avraham Adler All rights reserved % SPDX-License-Identifier: BSD-2-Clause \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 lamW functions } \details{ These are not to be called directly by the user. } \keyword{internal} lamW/man/lamW.Rd0000644000176200001440000000604714526505761013136 0ustar liggesusers% Copyright (c) 2015, Avraham Adler All rights reserved % SPDX-License-Identifier: BSD-2-Clause \name{lambertW} \alias{lambertW0} \alias{lambertWm1} \title{Lambert-W Function} \encoding{UTF-8} \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{\left[-\frac{1}{e}, +\infty\right)}{[-1/e, +∞)} and is always greater than or equal to \eqn{-1}. The second branch is defined on the interval \eqn{\left[-\frac{1}{e}, 0\right)}{[-1/e, 0)} and is always less than or equal to \eqn{-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}{\strong{numeric} 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{\left(-\frac{1}{e}, 0\right)}{(-1/e, 0)}. The values strictly greater than \eqn{-1} are assigned to the \dQuote{principal} branch, also referred to as \eqn{W_0}{W0}, and the values strictly less than \eqn{-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 \eqn{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.Rd0000644000176200001440000000072114464176233014517 0ustar liggesusers% Copyright (c) 2015, Avraham Adler All rights reserved % SPDX-License-Identifier: BSD-2-Clause \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/DESCRIPTION0000644000176200001440000000165414532445652012700 0ustar liggesusersPackage: lamW Type: Package Title: Lambert-W Function Version: 2.2.3 Date: 2023-11-28 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 Imports: Rcpp, RcppParallel LinkingTo: Rcpp, RcppParallel SystemRequirements: GNU make Suggests: covr, tinytest, methods NeedsCompilation: yes URL: https://github.com/aadler/lamW BugReports: https://github.com/aadler/lamW/issues UseLTO: yes Packaged: 2023-11-30 23:46:51 UTC; Parents Author: Avraham Adler [aut, cph, cre] () Maintainer: Avraham Adler Repository: CRAN Date/Publication: 2023-12-01 21:10:02 UTC lamW/build/0000755000176200001440000000000014532217351012254 5ustar liggesuserslamW/build/partial.rdb0000644000176200001440000000654114532217351014407 0ustar liggesusers]VFcKB.mi@4nI ilk%U}}}E>@3F#0>?~oH8({~qkA.{|Y7Mްii_(7˯bCl+ L~EUyM`7O3Tb³͵]2%ԠDc'qzԦ𬚢Q,kDy=ŗˊFQ|y[i, :g_cFRE¥ٮOAjibP<[]*Vl4wxX{*VERE`o^,bbSL}*TvP'wK'mU}i}iko0?Q8!7)՝7 E 2lsQ]-,ʪX DX?}cYc۱Pũb ` (N'($q! .YLq~ VH}N|4r AqJ1^!C H hAqJ!SIP(X cz %擜 _Y D?Ϻ)N2W;EJkdT3;m-,;tuZZZr wb`z3Zes\f(E4rW?7E)1 dgc|Cl.Ŀt4VtCc&Q4ZRXnH$=2щ79""TձMkjڨ˻BPb6Λ ,T 8ѫ7; .Fh6cwW'(<[o*h)v7D2gxv4hЩKwD;3]MXl^TgǏOd]Y/͗J/^< ݱ]4fohF (UUꮄhlUucdd׺^ )Jw)!Fl'g+Fࣟ5sqAy8l kre}gw}{GK`KvI$VIBs5Wsk*DQ{5|)MWSL~4@Wt'컅w{',{ՃX/mUz>0mTE2Y{G4av(E*=P})VS6V' iX:-yk)צzU^V P-^YVCZeo8+e[ei(ڴjA^hue#%_ 6b gE-ӻz/z+_ܢbYNq{N˥cCw_@L]d4 ~᧟nJ<"әeD覨h6L E8::M!I"O{VSj^oპ%&€f>R]$I44̄%UN}zy9*HJGbwS>.<##+A$"uPRBۺHV&'[g |L-O|OHJC3k ȤMѶ[Wv.lB@*0NuS2 xH~1ހ'(N1{g~jPGl}sBy ?=B{QԊdR{PD@!k$uX-JhsɛoM?ĆnFh7m%Q)!Ll9M`*nv*Dp_eRd@qF/7t8#*όZc.dn FR}z I gLUtOS8aqp+%G~ܙ!5ou;d"rH+}N.1qj8_kș/C+Cml>ygQ%<=cv*w ׷683/- 6]PVtEƑ ȫǏG^c /%c*3 2`ֶjGw瑦C8UM-WVܹf>tWbZWPs?@Ͻ2Tq]*c5DTC" JO =ɳ"W F+k.{ M^uG-οk3M7)%awum 6~I" ^B>;'aط9QD!J2z0`kY!1u&r?h8/'Q`,p}p0gȈ\L5 j|yCk԰zlamW/tests/0000755000176200001440000000000014171650535012323 5ustar liggesuserslamW/tests/tinytest.R0000644000176200001440000000013214171646041014322 0ustar liggesusersif (requireNamespace("tinytest", quietly = TRUE)) { tinytest::test_package("lamW") } lamW/src/0000755000176200001440000000000014532217351011744 5ustar liggesuserslamW/src/lambertW.cpp0000644000176200001440000002050514507307172014232 0ustar liggesusers/* lambertW.cpp Copyright (C) 2015, Avraham Adler All rights reserved. SPDX-License-Identifier: BSD-2-Clause Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. References: Corless, R. M.; Gonnet, G. H.; Hare, D. E.; Jeffrey, D. J. & Knuth, D. E. "On the Lambert W function", Advances in Computational Mathematics, Springer, 1996, 5, 329-359 Fritsch, F. N.; Shafer, R. E. & Crowley, W. P. "Solution of the transcendental equation (we^w = x)", Communications of the ACM, Association for Computing Machinery (ACM), 1973, 16, 123-124 */ // [[Rcpp::depends(RcppParallel)]] // [[Rcpp::interfaces(r, cpp)]] #include #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){ 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); } // Do not include Halley in coverage testing since unused // # nocov start /* Halley Iteration Given x, we want to find W such that Wexp(W) = x, so Wexp(W) - x = 0. We can use Halley iteration to find this root; to do so it needs first and second derivative. f(W) = W * exp(W) - x f'(W) = W * exp(W) + exp(W) = exp(W) * (W + 1) f''(W) = exp(W) + (W + 1) * exp(W) = exp(W) * (W + 2) Halley Step: W_{n+1} = W_n - {2 * f(W_n) * f'(W_n)} / {2 * [f'(W_n)]^2 - f(W_n) * f''(W_n)} */ // Unused as minimax approximation used instead but mechanism left active. double HalleyIter(double x, double w_guess){ double w = w_guess; int MaxEval = 16; bool CONVERGED = false; int i = 0; do { double ew = exp(w); double w1 = w + 1.0; double f0 = w * ew - x; f0 /= ((ew * w1) - (((w1 + 1.0) * f0) / (2 * w1))); /* Corliss et al. 5.9 */ CONVERGED = fabs(f0) <= EPS; w -= f0; ++i; } while (!CONVERGED && i < MaxEval); return(w); } // # nocov end double lambertW0_CS(double x) { if (x == R_PosInf) { return(R_PosInf); } else if (x < -M_1_E) { return(R_NaN); } else if (std::abs(x + M_1_E) <= EPS) { return(-1.0); } else 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 */ return(x); } else { double w; if (std::abs(x) <= 6.4e-3) { /* When this close to 0 the Fritsch iteration may underflow. Instead, * function will use degree-6 minimax polynomial approximation of Halley * iteration-based values. Should be more accurate by three orders of * magnitude than Fritsch's equation (5) in this range. */ // Minimax Approximation calculated using R package minimaxApprox 0.1.0 return((((((-1.0805085529250425e1 * x + 5.2100070265741278) * x - 2.6666665063383532) * x + 1.4999999657268301) * x - 1.0000000000016802) * x + 1.0000000000001752) * x + 2.6020852139652106e-18); // Fritsch Pade Equation // /* Use equation (5) in Fritsch */ // w = ((1.33333333333333333 * x + 1.0) * x) / // ((0.83333333333333333 * x + 2.33333333333333333) * x + 1.0); /* Original Halley step. This is technically most accurate. However, * using minimax approximation is faster and the difference should be * below machine precision. */ // double p = std::sqrt(2.0 * (M_E * x + 1.0)); // double Numer = (0.2787037037037037 * p + 0.311111111111111) * p - 1.0; // double Denom = (0.0768518518518518 * p + 0.688888888888889) * p + 1.0; // return(HalleyIter(x, Numer / Denom)); } else if (x <= M_E) { /* Use expansion in Corliss 4.22 to create (2, 2) Pade approximant. * Equation with a few extra terms is: * -1 + p - 1/3p^2 + 11/72p^3 - 43/540p^4 + 689453/8398080p^4 - O(p^5) * This is just used to estimate a good starting point for the Fritsch * iteration process itself. */ double p = std::sqrt(2.0 * (M_E * x + 1.0)); double Numer = (0.2787037037037037 * p + 0.311111111111111) * p - 1.0; double Denom = (0.0768518518518518 * p + 0.688888888888889) * p + 1.0; w = Numer / Denom; } 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; } return(FritschIter(x, w)); } } double lambertWm1_CS(double x){ if (x == 0.0) { return(R_NegInf); } else if (x < -M_1_E || x > 0.0) { return(R_NaN); } else if (std::abs(x + M_1_E) <= EPS) { return(-1.0); } else { double w; /* 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; return(FritschIter(x, w)); } } 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, 4); // 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, 4); // return the output vector return output; } lamW/src/Makevars0000644000176200001440000000013414507307172013441 0ustar liggesusersPKG_LIBS += $(shell ${R_HOME}/bin/Rscript -e "RcppParallel::RcppParallelLibs()") $(LTO_OPT) lamW/src/Makevars.win0000644000176200001440000000026414507307172014241 0ustar liggesusersPKG_CXXFLAGS += -DRCPP_PARALLEL_USE_TBB=1 $(LTO_OPT) PKG_LIBS += $(shell "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" \ -e "RcppParallel::RcppParallelLibs()") $(LTO_OPT) lamW/src/RcppExports.cpp0000644000176200001440000000757014532216330014746 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("%s", 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("%s", 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/0000755000176200001440000000000014532217323011355 5ustar liggesuserslamW/R/lamW.R0000644000176200001440000000027414377463170012415 0ustar liggesusers# Copyright (c) 2015, Avraham Adler All rights reserved # SPDX-License-Identifier: BSD-2-Clause lambertW0 <- function(x) {lambertW0_C(x)} lambertWm1 <- function(x) {lambertWm1_C(x)} lamW/R/RcppExports.R0000644000176200001440000000064014532217323013771 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`) }) lamW/MD50000644000176200001440000000205414532445652011475 0ustar liggesusers7b976e9e2362184f5a9cfdfd8a6f432d *DESCRIPTION 9fe401759a8da27089ef3979da17fa74 *LICENSE 610b72e22e057e24ad168d21d1b2e89b *NAMESPACE 4a4febc6eb9bbe58cc4ef2805e2a4f6c *R/RcppExports.R a32feeafbebeada43682c0626ecce110 *R/lamW.R 16f6fc3ef44ca47172f86505a73e2237 *README.md 3c8d09017b226a67ecff12af955d6fe8 *build/partial.rdb 05d016651e4d29cf8a178c7f7fc1b99f *inst/CITATION da99f0aa20ef1e15b86a9ca0b58c258b *inst/NEWS.Rd a4124c5d0c43aea90093188d44509854 *inst/include/lamW.h 6dbd1706b7f5f13a00ad8f9fad0dc340 *inst/include/lamW_RcppExports.h ed64ae74f32cd3c03f0aaa207fb0b6b7 *inst/tinytest/test_lamW.R c60a139be4160f2f6b76e324fec68245 *inst/tinytest/test_version.R 200744bd27790d29ccea3ecd34d9096f *man/lamW-internal.Rd 080b7db5f46faf14d5a4de816058cf6e *man/lamW-package.Rd 3867448d81092eb4ab54b69ad4557f36 *man/lamW.Rd 1efe934e119d049da781e53657b69d5d *src/Makevars cc78834491266f1fc33d5d80504495f0 *src/Makevars.win ecbee9bb967d1a3f914fe9524b1dfce4 *src/RcppExports.cpp 28ccdcf7b99c9f8afcf1094913c1eb8d *src/lambertW.cpp acc33156a11f2b43f8856b5eccc1f921 *tests/tinytest.R lamW/inst/0000755000176200001440000000000014532216330012126 5ustar liggesuserslamW/inst/include/0000755000176200001440000000000014377456536013576 5ustar liggesuserslamW/inst/include/lamW_RcppExports.h0000644000176200001440000000547414377456536017232 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.h0000644000176200001440000000035614377456536014653 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/CITATION0000644000176200001440000000132714532216330013266 0ustar liggesusersbibentry(bibtype = "Manual", textversion = NULL, header = paste("To cite the", sQuote("lamW"), "package in publications, please use:"), author = person(given = "Avraham", family = "Adler", role = c("aut", "cph", "cre"), email = "Avraham.Adler@gmail.com", comment = c(ORCID = "0000-0002-3039-0703")), title = "lamW: Lambert-W Function", year = "2015", url = "https://CRAN.R-project.org/package=lamW", doi = "10.5281/zenodo.5874874", note = "R package version 2.2.3" ) lamW/inst/tinytest/0000755000176200001440000000000014464176233014024 5ustar liggesuserslamW/inst/tinytest/test_version.R0000644000176200001440000000137414464176233016700 0ustar liggesusers# Copyright (c) 2015, Avraham Adler All rights reserved # SPDX-License-Identifier: BSD-2-Clause pV <- packageVersion("lamW") # Test CITATION has most recent package version expect_true(any(grepl(pV, toBibtex(citation("lamW")), fixed = TRUE))) # For some unknown reason this passes on Windows and Mac but not Ubuntu. Since # this is mainly for my own personal development purposes, I will wrap it in a # test for HOME. if (Sys.info()["nodename"] == "HOME") { # Test NEWS has most recent package version expect_true(any(grepl(pV, news(package = "lamW"), fixed = TRUE))) # Test that NEWS has an entry with DESCRIPTION's Date expect_true(any(grepl(packageDate("lamW"), news(package = "lamW"), fixed = TRUE))) } lamW/inst/tinytest/test_lamW.R0000644000176200001440000000452114464176233016110 0ustar liggesusers# Copyright (c) 2015, Avraham Adler All rights reserved # SPDX-License-Identifier: BSD-2-Clause tol <- sqrt(.Machine$double.eps) # 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) # Test that function works properly in general expect_equal(lambertW0(principleBranchTests), principleBranchAnswers, tolerance = tol) expect_equal(lambertWm1(secondaryBranchTests), secondaryBranchAnswers, tolerance = tol) # Test that function works properly for larger numbers expect_equal(lambertW0(1000) * exp(lambertW0(1000)), 1000, tolerance = tol) # Test that function behaves properly near 0 V0 <- seq(-2e-2, 2e-2, 2e-6) V0E <- V0 * exp(V0) expect_equal(lambertW0(V0E), V0, tolerance = tol) # Test that W0 behaves properly VERY close to 0 expect_identical(lambertW0(1e-275), 1e-275) expect_identical(lambertW0(7e-48), 7e-48) expect_identical(lambertW0(-3.81e-71), -3.81e-71) # Test that function behaves properly near -1/e expect_identical(lambertW0(-1 / exp(1)), -1) expect_identical(lambertWm1(-1 / exp(1)), -1) # Test that function behaves properly near its asymptotes L <- seq(1e-6 - exp(-1), -0.25, 3e-6) V0 <- lambertW0(L) vm1 <- lambertWm1(L) expect_equal(V0 * exp(V0), L, tolerance = tol) expect_equal(vm1 * exp(vm1), L, tolerance = tol) vm1 <- seq(-714, -714.96865, -3e-5) vm1E <- vm1 * exp(vm1) expect_equal(lambertWm1(vm1E), vm1, tolerance = tol) # Test that function behaves properly at its asymptotes expect_identical(lambertW0(Inf), Inf) expect_identical(lambertWm1(0), -Inf) # Test that NaNs are returned for values outside domain expect_true(is.nan(lambertW0(-Inf))) expect_true(is.nan(lambertW0(-1))) expect_true(is.nan(lambertW0(c(1, -1)))[[2]]) expect_true(is.nan(lambertWm1(-Inf))) expect_true(is.nan(lambertWm1(Inf))) expect_true(is.nan(lambertWm1(-0.5))) # x < -M_1_E expect_true(is.nan(lambertWm1(1.2))) # x > 0 # Test that integers are converted to reals for principle branch expect_identical(lambertW0(c(-1L, 0L, 1L, 2L, 3L, 4L)), lambertW0(c(-1, 0, 1, 2, 3, 4))) lamW/inst/NEWS.Rd0000644000176200001440000002115114532216330013171 0ustar liggesusers% Copyright (c) 2015, Avraham Adler All rights reserved % SPDX-License-Identifier: BSD-2-Clause \name{NEWS} \alias{NEWS} \title{NEWS file for the lamW package} \encoding{UTF-8} \section{Version 2.2.3 (2023-11-28)}{ \subsection{Fixed}{ \itemize{ \item Package built with development version of \pkg{Rcpp} to remove \acronym{CRAN}'s \dQuote{string literal} errors. } } \subsection{Changed}{ \itemize{ \item Corrected some headers in \file{NEWS.Rd} } } } \section{Version 2.2.2 (2023-11-20)}{ \subsection{Fixed}{ \itemize{ \item \acronym{NEWS} was not rendering on \acronym{CRAN} because the file name used lowercase, \file{News.Rd}, and not \file{NEWS.Rd}. } } \subsection{Changed}{ \itemize{ \item Tweaked documentation. } } } \section{Version 2.2.1 (2023-10-04)}{ \subsection{Changed}{ \itemize{ \item Removed line from \file{NEWS.Rd} which may have been preventing proper rendering on \acronym{CRAN}. \item added \code{$(LTO_OPT)} to \file{Makevars} and \file{Makevars.win} and \code{UseLTO} to \file{DESCRIPTION}. \item Cleaned up \file{README.md} and moved citation, contributions, and security information to their own files. } } } \section{Version 2.2.0 (2023-08-07)}{ \subsection{Fixed}{ \itemize{ \item Corrected initial guess for Fritsch step for \eqn{6.4\times 10^{-3} \lt x \le e}{6.4e-3 \lt x \le e}. Does not change results but may converge in one fewer step. } } \subsection{Changed}{ \itemize{ \item Replaced Fritsch's \enc{Padé}{Pade} approximation with a degree-six polynomial minimax approximation for \eqn{x \in \left[-6.4\times 10^{-3}, 6.4\times 10^{-3} \right]}{x in [-6.4e-3, 6.4e-3]} with true values based on the non-underflowing Halley step. Should be faster than Halley iteration and more accurate than the Fritsch's \enc{Padé}{Pade} approximation. \item Various grammar, linting, and unit test updates. } } \subsection{Added}{ \itemize{ \item Added \code{methods} to \code{Suggests} as per \href{https://github.com/aadler/lamW/pull/1}{PR1} (Thanks \href{https://github.com/MichaelChirico}{Michael Chirico}). } } } \section{Version 2.1.2 (2023-02-28)}{ \subsection{Changed}{ \itemize{ \item Adjusted \acronym{TBB} grain size to prevent parallelism for fewer than 4 elements. \item Streamlined C++ code to follow more logical if-else cascade. \item Removed unneeded setup from C++ and \R calls. \item Cleaned up documentation. \item CITATION updated to use \code{bibentry} per \acronym{CRAN} request. \item Updated internal code to be more compliant with personal style guide. \item Updated Github actions. } } } \section{Version 2.1.1 (2022-01-18)}{ \subsection{Changed}{ \itemize{ \item Converted test suite to \pkg{tinytest} framework to reduce dependencies. \item Added \acronym{DOI} and \acronym{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 \enc{Padé}{Pade} expansion (equation 5) for values close to 0, eliminating the need for the 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 \acronym{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 \eqn{\infty} and \eqn{-\infty} as the same on the principle branch (thanks to \acronym{CRAN} & Uwe Ligges). } } \subsection{Added}{ \itemize{ \item Added test to ensure \eqn{\infty} and \eqn{-\infty} are identified accurately. \item Expanded existing tests. } } } \section{Version 1.3.1 (2020-05-24) [YANKED]}{ \subsection{Added}{ \itemize{ \item Use \R magic words and \pkg{Rcpp} sugar instead of calls to \acronym{STD} (caused regression). \item Added more tests near asymptotes and for real vs. integer. \item Added \acronym{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 \pkg{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 \acronym{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 \pkg{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 \pkg{LambertW} and its importing the \pkg{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 \pkg{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 \acronym{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 \enc{Padé}{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. } } }