[clisp-list] *-float-*-epsilon in clisp

[Stefan K. <sm...@us...>]

Hi fellow clisp-ers,

I have written the following functions
which determine the various floating-point-epsilons.

I get discrepancies for the double-float-*-epsilon values
on my machine. I don't think, that my FP-Coprocessor is
wrong. Maybe there is just a wrong definition shipped
with clisp. If you  want to read, what this all is about,
have a look at: 

http://www.xanalys.com/software_tools/reference/HyperSpec/Body/v_short_.htm

Simply load the functions given below and enter
into the repl:

(test-epsilons)

Could you give them a try and report your results for your
local installation to clisp-list?

That would be very kind! Thanks!

Bye,
Stefan

===============================================================
(defun test-pos-epsilon (<EPSILON>)
  (= (float 1 <EPSILON>) (+ (float 1 <EPSILON>) <EPSILON>)))

(defun test-neg-epsilon (<EPSILON>)
  (= (float 1 <EPSILON>) (- (float 1 <EPSILON>) <EPSILON>)))

(defun binary-search (lower_bound upper_bound old_value precision test-fun)
  (let* ((new_bound (/ (+ (float lower_bound precision)
                          (float upper_bound precision)) 2))
         (new_value (float new_bound precision)))
    (if (= old_value new_value)
      ;; then
      ;; (format t "~A ~A~%" old_string new_string)
      (float upper_bound precision)
      ;; else
      (progn 
        ;;  (format t "~A ~A~%" (float lower_bound precision)
        ;;          (float upper_bound precision))
        (if (funcall test-fun new_bound)
          ;; then
          (binary-search new_bound upper_bound new_value
                         precision test-fun)
          ;; else
          (binary-search lower_bound new_bound new_value
                         precision test-fun))))))


;;;; test:      
(defun test-epsilons ()
  (let ((fmt "~30E~30E~30E~%"))
    (format t "~30<~A~>~30<~A~>~30<~A~>~%"
            "system value"
            "computed value"
            "difference")

    ;; short-float-epsilon:
    (format t "short-float-epsilon:~%")
    (format t fmt
            short-float-epsilon
            (binary-search 0.0 1.0 0.0 1.0s0 #'test-pos-epsilon)
            (- (binary-search 0.0 1.0 0.0 1.0s0 #'test-pos-epsilon)
               short-float-epsilon))

    ;; short-float-negative-epsilon:
    (format t "short-float-negative-epsilon:~%")
    (format t fmt 
            short-float-negative-epsilon
            (binary-search 0.0 1.0 0.0 1.0s0 #'test-neg-epsilon)
            (- (binary-search 0.0 1.0 0.0 1.0s0 #'test-neg-epsilon)
               short-float-negative-epsilon))

    ;; single-float-epsilon:
    (format t "single-float-epsilon:~%")
    (format t fmt 
            single-float-epsilon
            (binary-search 0.0 1.0 0.0 1.0 #'test-pos-epsilon)
            (- (binary-search 0.0 1.0 0.0 1.0 #'test-pos-epsilon)
               single-float-epsilon))

    ;; single-float-negative-epsilon:
    (format t "single-float-negative-epsilon:~%")
    (format t fmt 
            single-float-negative-epsilon
            (binary-search 0.0 1.0 0.0 1.0 #'test-neg-epsilon)
            (- (binary-search 0.0 1.0 0.0 1.0 #'test-neg-epsilon)
               single-float-negative-epsilon))

    ;; double-float-epsilon:
    (format t "double-float-epsilon:~%")
    (format t fmt
            double-float-epsilon
            (binary-search 0.0 1.0 0.0 1.0d0 #'test-pos-epsilon)
            (- (binary-search 0.0 1.0 0.0 1.0d0 #'test-pos-epsilon)
               double-float-epsilon))

    ;; double-float-negative-epsilon:
    (format t "double-float-negative-epsilon:~%")
    (format t fmt
            double-float-negative-epsilon
            (binary-search 0.0 1.0 0.0 1.0d0 #'test-neg-epsilon)
            (- (binary-search 0.0 1.0 0.0 1.0d0 #'test-neg-epsilon)
               double-float-negative-epsilon))

    ;; long-float-epsilon:
    (format t "long-float-epsilon:~%")
    (format t fmt 
            long-float-epsilon
            (binary-search 0.0 1.0 0.0 1.0l0 #'test-pos-epsilon)
            (- (binary-search 0.0 1.0 0.0 1.0l0 #'test-pos-epsilon)
               long-float-epsilon))

    ;;long-float-negative-epsilon:
    (format t "long-float-negative-epsilon:~%")
    (format t fmt
            long-float-negative-epsilon
            (binary-search 0.0 1.0 0.0 1.0l0 #'test-neg-epsilon)
            (- (binary-search 0.0 1.0 0.0 1.0l0 #'test-neg-epsilon)
               long-float-negative-epsilon))))