Add procedure log-gamma

Signed-off-by: yamacir-kit <[email protected]>

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.294.so` and executable `meevax`.
+| `all`       | Build shared-library `libmeevax.0.5.295.so` and executable `meevax`.
 | `install`   | Copy files into `/usr/local` directly.
-| `package`   | Generate debian package `meevax_0.5.294_amd64.deb` (only Ubuntu). The generated package can be installed by `sudo apt install build/meevax_0.5.294_amd64.deb`.
+| `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`.
 | `test`      | Test executable `meevax`. This target requires Valgrind to be installed.
 | `uninstall` | Remove files copied to `/usr/local` directly by target `install`.
 

VERSION

@@ -1 +1 @@
-0.5.294
+0.5.295

basis/srfi-144.ss

@@ -32,6 +32,7 @@
             euler
             gamma
             load-exponent
+            log-gamma
             next-after
             phi
             pi
@@ -121,8 +122,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)
@@ -382,5 +383,11 @@
              (values (car rq)
                      (cdr rq))))
 
+         (define flgamma gamma)
+
+         (define (flloggamma x)
+           (values (log-gamma x)
+                   (if (positive? (gamma x)) 1.0 -1.0)))
+
          )
   )

include/meevax/kernel/number.hpp

@@ -385,6 +385,8 @@ inline namespace number
 
   auto gamma(object const&) -> object;
 
+  auto log_gamma(object const&) -> object;
+
   auto copy_sign(object const&, object const&) -> object;
 
   auto next_after(object const&, object const&) -> object;

src/kernel/boot.cpp

@@ -545,6 +545,11 @@ namespace meevax::inline kernel
         return gamma(car(xs));
       });
 
+      library.define<procedure>("log-gamma", [](let const& xs)
+      {
+        return log_gamma(car(xs));
+      });
+
       library.define<procedure>("next-after", [](let const& xs)
       {
         return next_after(car(xs), cadr(xs));

src/kernel/number.cpp

@@ -994,7 +994,8 @@ inline namespace number
     return apply_to<real_number>(f, x);                                        \
   }
 
-  DEFINE_REAL1(gamma, std::tgamma)
+  DEFINE_REAL1(gamma,     std::tgamma)
+  DEFINE_REAL1(log_gamma, std::lgamma)
 
   #define DEFINE_REAL2(NAME, CMATH)                                            \
   auto NAME(object const& x, object const& y) -> object                        \

test/srfi-144.ss

@@ -343,15 +343,23 @@
 (check (flremainder 3.14 -0.5) (=> =) 0.14)
 (check (flremainder -3.14 -0.5) (=> =) -0.14)
 
-(call-with-values (lambda () (flremquo 5.0 2.0)) (lambda (r q) (check q => 2) (check r => 1.0)))
-(call-with-values (lambda () (flremquo 6.0 4.0)) (lambda (r q) (check q => 2) (check r => -2.0)))
-(call-with-values (lambda () (flremquo 6.3 3.0)) (lambda (r q) (check q => 2) (check r (=> =) 0.3)))
-(call-with-values (lambda () (flremquo 6.3 -3.0)) (lambda (r q) (check q => -2) (check r (=> =) 0.3)))
-(call-with-values (lambda () (flremquo -6.3 3.0)) (lambda (r q) (check q => -2) (check r (=> =) -0.3)))
-(call-with-values (lambda () (flremquo -6.3 -3.0)) (lambda (r q) (check q => 2) (check r (=> =) -0.3)))
-(call-with-values (lambda () (flremquo 6.3 3.15)) (lambda (r q) (check q => 2) (check r => 0.0)))
-(call-with-values (lambda () (flremquo 6.0 2.0)) (lambda (r q) (check q => 3) (check r => 0.0)))
+(call-with-values (lambda () (flremquo  5.0  2.0 )) (lambda (r q) (check q =>  2) (check r  =>     1.0)))
+(call-with-values (lambda () (flremquo  6.0  4.0 )) (lambda (r q) (check q =>  2) (check r  =>    -2.0)))
+(call-with-values (lambda () (flremquo  6.3  3.0 )) (lambda (r q) (check q =>  2) (check r (=> =)  0.3)))
+(call-with-values (lambda () (flremquo  6.3 -3.0 )) (lambda (r q) (check q => -2) (check r (=> =)  0.3)))
+(call-with-values (lambda () (flremquo -6.3  3.0 )) (lambda (r q) (check q => -2) (check r (=> =) -0.3)))
+(call-with-values (lambda () (flremquo -6.3 -3.0 )) (lambda (r q) (check q =>  2) (check r (=> =) -0.3)))
+(call-with-values (lambda () (flremquo  6.3  3.15)) (lambda (r q) (check q =>  2) (check r  =>     0.0)))
+(call-with-values (lambda () (flremquo  6.0  2.0 )) (lambda (r q) (check q =>  3) (check r  =>     0.0)))
+
+(check (flgamma 0.5) => fl-gamma-1/2)
+(check (flgamma 2/3) => fl-gamma-2/3)
+
+(call-with-values (lambda () (flloggamma    0.0)) (lambda (value sign) (check value =>             +inf.0) (check sign => 1.0)))
+(call-with-values (lambda () (flloggamma    0.5)) (lambda (value sign) (check value => (log fl-gamma-1/2)) (check sign => 1.0)))
+(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-report)
 
-(exit (check-passed? 222))
+(exit (check-passed? 232))