lamW/0000755000176200001440000000000014634035135011156 5ustar liggesuserslamW/tests/0000755000176200001440000000000014633633510012320 5ustar liggesuserslamW/tests/tinytest.R0000644000176200001440000000013214633633510014322 0ustar liggesusersif (requireNamespace("tinytest", quietly = TRUE)) { tinytest::test_package("lamW") } lamW/MD50000644000176200001440000000206514634035135011471 0ustar liggesusers7d6020f39e3e81b9ab4661e4f393044b *DESCRIPTION 9fe401759a8da27089ef3979da17fa74 *LICENSE 610b72e22e057e24ad168d21d1b2e89b *NAMESPACE 4a4febc6eb9bbe58cc4ef2805e2a4f6c *R/RcppExports.R a32feeafbebeada43682c0626ecce110 *R/lamW.R 16f6fc3ef44ca47172f86505a73e2237 *README.md e78c013171ab159c35ebb8458cf45dae *build/partial.rdb 00ffe072bc5c3b5aebd2032dfa2e5cf3 *inst/CITATION 80f8d53e3f31821cd0e5b537571f8162 *inst/NEWS.Rd a4124c5d0c43aea90093188d44509854 *inst/include/lamW.h 6dbd1706b7f5f13a00ad8f9fad0dc340 *inst/include/lamW_RcppExports.h ed64ae74f32cd3c03f0aaa207fb0b6b7 *inst/tinytest/test_lamW.R 11631057f110014c8f0e9a04a2b9531a *inst/tinytest/test_package_metadata.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 3a9701bb035d553139dbd21db548bcae *src/lambertW.cpp acc33156a11f2b43f8856b5eccc1f921 *tests/tinytest.R lamW/R/0000755000176200001440000000000014633644347011371 5ustar liggesuserslamW/R/RcppExports.R0000644000176200001440000000064014633644347014005 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/R/lamW.R0000644000176200001440000000027414633633510012405 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/src/0000755000176200001440000000000014633644407011754 5ustar liggesuserslamW/src/RcppExports.cpp0000644000176200001440000000757014633633510014753 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/src/Makevars.win0000644000176200001440000000026414633633510014237 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/lambertW.cpp0000644000176200001440000002051114633643540014231 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 = std::abs(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/Makevars0000644000176200001440000000013414633633510013437 0ustar liggesusersPKG_LIBS += $(shell ${R_HOME}/bin/Rscript -e "RcppParallel::RcppParallelLibs()") $(LTO_OPT) lamW/NAMESPACE0000644000176200001440000000022214633633510012371 0ustar liggesusersuseDynLib(lamW, .registration = TRUE) exportPattern("^[[:alpha:]]+") importFrom("Rcpp", "evalCpp") importFrom(RcppParallel, RcppParallelLibs) lamW/LICENSE0000644000176200001440000000005313314347173012163 0ustar liggesusersYEAR: 2015 COPYRIGHT HOLDER: Avraham AdlerlamW/inst/0000755000176200001440000000000014633644410012134 5ustar liggesuserslamW/inst/include/0000755000176200001440000000000014633633510013556 5ustar liggesuserslamW/inst/include/lamW.h0000644000176200001440000000035614633633510014633 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/include/lamW_RcppExports.h0000644000176200001440000000547414633633510017212 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/CITATION0000644000176200001440000000133314633643540013274 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.32614/CRAN.package.lamW", note = "R package version 2.2.3" ) lamW/inst/tinytest/0000755000176200001440000000000014633643540014022 5ustar liggesuserslamW/inst/tinytest/test_package_metadata.R0000644000176200001440000000203414633643540020436 0ustar liggesusers# Copyright (c) 2015, Avraham Adler All rights reserved # SPDX-License-Identifier: BSD-2-Clause # Only test at home. rhub valgrind complains and it should not affect covr. if (Sys.info()["nodename"] == "HOME") { curPkg <- "lamW" pV <- packageVersion(curPkg) cit <- toBibtex(citation(curPkg)) nws <- news(package = curPkg) myOtherPkgs <- c("Delaporte", "minimaxApprox", "Pade", "revss", "MBBEFDLite") # Test CITATION has most recent package version expect_true(any(grepl(pV, cit), fixed = TRUE)) # Test NEWS has most recent package version expect_true(any(grepl(pV, nws, fixed = TRUE))) # Test that NEWS has an entry with DESCRIPTION's Date expect_true(any(grepl(packageDate(curPkg), nws, fixed = TRUE))) # Test that CITATION doesn't contain the name of any other of my packages expect_false(any(sapply(myOtherPkgs, grepl, x = cit, fixed = TRUE))) # Test that NEWS doesn't contain the name of any other of my packages expect_false(any(sapply(myOtherPkgs, grepl, x = nws, fixed = TRUE))) } lamW/inst/tinytest/test_lamW.R0000644000176200001440000000452114633633510016102 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.Rd0000644000176200001440000002173214633643540013207 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.4 (2024-06-16)}{ \subsection{Added}{ \itemize{ \item Installed new version of \pkg{rhub} testing. } } \subsection{Changed}{ \itemize{ \item Updated \acronym{DOI} to native \acronym{CRAN}. \item Minor changes to C code for consistency. \item Updated package metadata unit tests. } } } \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. } } } lamW/README.md0000644000176200001440000000336714633633510012446 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/build/0000755000176200001440000000000014633644407012264 5ustar liggesuserslamW/build/partial.rdb0000644000176200001440000000667414633644407014426 0ustar liggesusers]r(RN>Ȳ|hR\K(#˶Lɮft $'$*@PqF_7] ,D8#pf/oFI1 Dka_aHc˚~dȵΊsb{ƛe<=t4\^^r l)`vz4= m~:Zv(J c"hh>q dcbShTac_6Uђ5Cc&Q4]u!r HE'r QodbOǙvJδMq+ũ˦yӖ)S'zU``DŨۦB;Ġ)6p fͪ4V Ad*kێU :u).(z~f˚d <[zxi}"irP*^,.>}'[uiz*[ՌSBP*l 쫽ͅ^~H )>}P"N1)0Kd; 889}dbֈ]u+#ũ0ѿW6v7vYܩlWIMbIau=-4Ih󪔢tkNn9D96q{57dH}Vezϥ,a d8ʼn>o ®%HO6e~Zɽ# ܄4{,ak!$צ#{Z @YQ;4YKV,hyP26pjn.+Bjkn3%uB&[f-c/5$+?܂l$ ~sM`I}L羀 *1 gX^_}F]eiA3js}iˈ-AV-@pttև'!eUE`#ى)acx#J}Pcg iHGՁˢ֙B9:S}InS4#0"Zy2iFC,wV߃MH)nJp"8o>ڀ"(NHB S߳{?^#6ċ9v~* .fyPf7)FwGs^ፖ1i48y,(pQ޶;+gsP^G2)ƽv ԐZkq:,vyŴ-7qhlÌpN3h#[ض^撨 W& `Ȣl V*& z% =ʛ͊ v-mv)*x9T8 dyM0Fe-3JSETȋxM=aT)D\I7rs'L< VeQ 񢦊@'۠^@s0hӝ@L;3„NEo-3@d3RR2Pi5G )s7@X#Zzo`43C"iZE:A6D2BQ0(AЛ;i0=ki>{."Gx5.(5-QzD,(^ TÙu)򜴣{9A4/UIϏR:P2 W@CQZ[7MLk>}jG=jR] !s)Ҧxgx~k ~⟓FR:ܴqe zZ /T*(| r0Jrl\ux{3X>:c"{7;G0S #UM7f`tÔyOO3z vHB(A"8T04 OL("}[ŝiw*㎔<)=׃BbTqڞ6_Ư !A?*D_ do#WP(/WnVK(.Ig:Z0![os].$?xfgJTpOpI !ގ=<:Vc4:>vjñXz!˱+rpL Qw}N|nh5E@S8dz[fx)-aFP;ΤC47SXPD)ω(t/sd=ї앢c**{C]k+\:F6(N`X Ǧ&aaiZE梇6GqxG;LKPm ?Ou!ax Sڸ8b 0 &ƈ8Ӽ?Veks޵Kġo,w9Q أo44x] É'2=}?Њj|j)}lamW/man/0000755000176200001440000000000014633633510011731 5ustar liggesuserslamW/man/lamW-internal.Rd0000644000176200001440000000075314633633510014737 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.Rd0000644000176200001440000000604714633633510013127 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.Rd0000644000176200001440000000072114633633510014511 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/DESCRIPTION0000644000176200001440000000165414634035135012672 0ustar liggesusersPackage: lamW Type: Package Title: Lambert-W Function Version: 2.2.4 Date: 2024-06-16 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: 2024-06-16 20:20:25 UTC; Parents Author: Avraham Adler [aut, cph, cre] () Maintainer: Avraham Adler Repository: CRAN Date/Publication: 2024-06-17 13:30:05 UTC