]> birchwood-abbey.net Git - mit-scheme.git/commitdiff
Fix various logsumexp tests.
authorTaylor R Campbell <campbell+mit-scheme@mumble.net>
Thu, 11 Feb 2021 04:17:04 +0000 (04:17 +0000)
committerTaylor R Campbell <campbell+mit-scheme@mumble.net>
Thu, 11 Feb 2021 05:04:24 +0000 (05:04 +0000)
- logsumexp{..., -inf, +inf, ...} = log(... + e^-inf + e^+inf + ...)
  = log(... + 0 + inf + ...) = inf, not NaN.

- logsumexp(log(tiny1) + log(1 + tiny2)) = log(1 + tiny1 + tiny2),
  requires log1p to compute precisely.

(cherry picked from commit 1030084696b7dd118a1c6a1e323d3d7be74ebf22)

tests/runtime/test-arith.scm

index ab8d7e9d793a5ee012a709f150fe85aa2b558ddc..a133614eb72f339c3a7f2ab34e8ede9307b06d53 100644 (file)
@@ -442,9 +442,15 @@ USA.
    (list (iota 1000) 999.45867514538713)
    (list '(999 1000) 1000.3132616875182)
    (list '(-1000 -1000) (+ -1000 (log 2)))
-   (list '(0 0) (log 2)))
-  (lambda (l s)
-    (assert-<= (relerr s (logsumexp l)) 1e-15)))
+   (list '(0 0) (log 2))
+   ;; log(2^-30), log(1 + 2^-29) -> log(1 + 2^-29 + 2^-30)
+   (list (list -20.79441541679836 1.8626451474962336e-9)
+        2.7939677199433077e-9
+        expect-failure))
+  (lambda (l s #!optional xfail)
+    (with-expected-failure xfail
+      (lambda ()
+       (assert-<= (relerr s (logsumexp l)) 1e-15)))))
 
 (define-enumerated-test 'logsumexp-edges
   (list
@@ -461,17 +467,19 @@ USA.
    (list (list (flo:+inf.0)) (flo:+inf.0))
    (list (list (flo:+inf.0) 1) (flo:+inf.0))
    (list (list 1 (flo:+inf.0)) (flo:+inf.0))
+   (list (list 1 (flo:-inf.0) (flo:+inf.0)) (flo:+inf.0) expect-failure)
+   (list (list (flo:-inf.0) (flo:+inf.0) 1) (flo:+inf.0) expect-failure)
    (list (list (flo:-inf.0) (flo:-inf.0)) (flo:-inf.0))
-   (list (list (flo:+inf.0) (flo:+inf.0)) (flo:+inf.0)))
-  (lambda (l s)
-    (assert-eqv (logsumexp l) s)))
+   (list (list (flo:-inf.0) (flo:+inf.0)) (flo:+inf.0) expect-failure)
+   (list (list (flo:+inf.0) (flo:+inf.0)) (flo:+inf.0))
+   (list (list (flo:+inf.0) (flo:-inf.0)) (flo:+inf.0) expect-failure))
+  (lambda (l s #!optional xfail)
+    (with-expected-failure xfail
+      (lambda ()
+       (assert-eqv (logsumexp l) s)))))
 
 (define-enumerated-test 'logsumexp-nan
   (list
-   (list (list (flo:-inf.0) (flo:+inf.0)))
-   (list (list (flo:+inf.0) (flo:-inf.0)))
-   (list (list 1 (flo:-inf.0) (flo:+inf.0)))
-   (list (list (flo:-inf.0) (flo:+inf.0) 1))
    (list (list (flo:nan.0)))
    (list (list (flo:+inf.0) (flo:nan.0)))
    (list (list (flo:-inf.0) (flo:nan.0)))