From dd78f5bd9c8e56de65b6ea51e437bdc5eb1af99f Mon Sep 17 00:00:00 2001 From: yamacir-kit Date: Sun, 15 Dec 2024 23:41:37 +0900 Subject: [PATCH] Add procedures `first-kind-bessel` and `second-kind-bessel` Signed-off-by: yamacir-kit --- README.md | 4 ++-- VERSION | 2 +- basis/srfi-144.ss | 10 ++++++++-- include/meevax/kernel/number.hpp | 4 ++++ src/kernel/boot.cpp | 10 ++++++++++ src/kernel/number.cpp | 8 +++++--- test/srfi-144.ss | 22 +++++++++++++++++++++- 7 files changed, 51 insertions(+), 9 deletions(-) diff --git a/README.md b/README.md index 57f0fe787..0c8ddf65a 100644 --- a/README.md +++ b/README.md @@ -97,9 +97,9 @@ Then, select one of the following targets and `make` it according to your purpos | Target | Description |-------------|------------- -| `all` | Build shared-library `libmeevax.0.5.295.so` and executable `meevax`. +| `all` | Build shared-library `libmeevax.0.5.296.so` and executable `meevax`. | `install` | Copy files into `/usr/local` directly. -| `package` | Generate debian package `meevax_0.5.295_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.295_amd64.deb`. +| `package` | Generate debian package `meevax_0.5.296_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.296_amd64.deb`. | `test` | Test executable `meevax`. This target requires Valgrind to be installed. | `uninstall` | Remove files copied to `/usr/local` directly by target `install`. diff --git a/VERSION b/VERSION index df3b72402..f23721ac8 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -0.5.295 +0.5.296 diff --git a/basis/srfi-144.ss b/basis/srfi-144.ss index d078afb0c..c9848327a 100644 --- a/basis/srfi-144.ss +++ b/basis/srfi-144.ss @@ -30,12 +30,14 @@ cosh e euler + first-kind-bessel gamma load-exponent log-gamma next-after phi pi + second-kind-bessel sinh tanh ) @@ -122,8 +124,8 @@ flquotient flremainder flremquo - flgamma flloggamma - ; flfirst-bessel flsecond-bessel flerf flerfc + flgamma flloggamma flfirst-bessel flsecond-bessel + ; flerf flerfc ) (begin (define fl-e e) @@ -389,5 +391,9 @@ (values (log-gamma x) (if (positive? (gamma x)) 1.0 -1.0))) + (define flfirst-bessel first-kind-bessel) + + (define flsecond-bessel second-kind-bessel) + ) ) diff --git a/include/meevax/kernel/number.hpp b/include/meevax/kernel/number.hpp index a05d1b891..7b8dc8afc 100644 --- a/include/meevax/kernel/number.hpp +++ b/include/meevax/kernel/number.hpp @@ -390,6 +390,10 @@ inline namespace number auto copy_sign(object const&, object const&) -> object; auto next_after(object const&, object const&) -> object; + + auto first_kind_bessel(object const&, object const&) -> object; + + auto second_kind_bessel(object const&, object const&) -> object; } // namespace number } // namespace kernel } // namespace meevax diff --git a/src/kernel/boot.cpp b/src/kernel/boot.cpp index bb17a61a5..8ea76fab4 100644 --- a/src/kernel/boot.cpp +++ b/src/kernel/boot.cpp @@ -565,6 +565,16 @@ namespace meevax::inline kernel return load_exponent(car(xs), cadr(xs)); }); + library.define("first-kind-bessel", [](let const& xs) + { + return first_kind_bessel(car(xs), cadr(xs)); + }); + + library.define("second-kind-bessel", [](let const& xs) + { + return second_kind_bessel(car(xs), cadr(xs)); + }); + library.define("e", std::numbers::e); library.define("pi", std::numbers::pi); diff --git a/src/kernel/number.cpp b/src/kernel/number.cpp index d8bc286d3..16a29f845 100644 --- a/src/kernel/number.cpp +++ b/src/kernel/number.cpp @@ -1009,8 +1009,10 @@ inline namespace number return apply_to(f, x, y); \ } - DEFINE_REAL2(atan, std::atan2) - DEFINE_REAL2(copy_sign, std::copysign) - DEFINE_REAL2(next_after, std::nextafter) + DEFINE_REAL2(atan, std::atan2) + DEFINE_REAL2(copy_sign, std::copysign) + DEFINE_REAL2(first_kind_bessel, std::cyl_bessel_j) + DEFINE_REAL2(next_after, std::nextafter) + DEFINE_REAL2(second_kind_bessel, std::cyl_neumann) } // namespace number } // namespace meevax::kernel diff --git a/test/srfi-144.ss b/test/srfi-144.ss index 75c260e1d..477bdd31c 100644 --- a/test/srfi-144.ss +++ b/test/srfi-144.ss @@ -360,6 +360,26 @@ (call-with-values (lambda () (flloggamma 1.0)) (lambda (value sign) (check value => 0.0) (check sign => 1.0))) (call-with-values (lambda () (flloggamma +inf.0)) (lambda (value sign) (check value => +inf.0) (check sign => 1.0))) +(check (flfirst-bessel 0.0 (* 0/3 fl-pi)) => 1.0) +(check (flfirst-bessel 0.0 (* 1/3 fl-pi)) => 0.74407197075292975) +(check (flfirst-bessel 0.0 (* 2/3 fl-pi)) => 0.16979382182100766) +(check (flfirst-bessel 0.5 (* 0/3 fl-pi)) => 0.0) +(check (flfirst-bessel 0.5 (* 1/3 fl-pi)) => 0.67523723711782946) +(check (flfirst-bessel 0.5 (* 2/3 fl-pi)) => 0.47746482927568606) +(check (flfirst-bessel 1.0 (* 0/3 fl-pi)) => 0.0) +(check (flfirst-bessel 1.0 (* 1/3 fl-pi)) => 0.45503061147236740) +(check (flfirst-bessel 1.0 (* 2/3 fl-pi)) => 0.56886896392288921) + +(check (flsecond-bessel 0.0 (* 0/3 fl-pi)) => -inf.0) +(check (flsecond-bessel 0.0 (* 1/3 fl-pi)) => 0.12417445819941761) +(check (flsecond-bessel 0.0 (* 2/3 fl-pi)) => 0.51799555016845289) +(check (flsecond-bessel 0.5 (* 0/3 fl-pi)) => -inf.0) +(check (flsecond-bessel 0.5 (* 1/3 fl-pi)) => -0.38984840061683823) +(check (flsecond-bessel 0.5 (* 2/3 fl-pi)) => 0.27566444771089593) +(check (flsecond-bessel 1.0 (* 0/3 fl-pi)) => -inf.0) +(check (flsecond-bessel 1.0 (* 1/3 fl-pi)) => -0.74108949656080647) +(check (flsecond-bessel 1.0 (* 2/3 fl-pi)) => -0.05472495339562021) + (check-report) -(exit (check-passed? 232)) +(exit (check-passed? 250))