; 


; Das folgende Fragment enthält einige Routinen zur Ausgabe von 
; Haedern und Footern für Testroutinen.
; 

(define display-test-header
  (lambda (txt)
    (newline)
    (display "================================================")
    (newline)
    (display txt)
    (newline)
    (newline)))


(define display-test-separator
  (lambda ()
    (newline)
    (display "-----------------")
    (newline)))

; Der Testtreiber ;  ieee754-test-conversion;  testet (rudimentär)
;   die Umwandlung von Schemezahlen nach ; ieee754;  und zurück. Es wird einmal
;   hin und zurückgewandelt und die Abweichung mit einer Fehlerschranke
;   verglichen.
; 


(define ieee754-test-conversion
  (lambda (a max-error)
    (let* ((x (number->ieee754 a))
           (b (ieee754->number x)))

      (display a)(display #\tab)(display " -> ")
      (display x)(newline)
      (display #\tab)(display " -> ")
      (display b)(newline)
      (let ((err 
             (abs (/ (- a b) 
                     (abs a)))))
        (if (< max-error err)
            (begin
              (newline)
              (display "*** INCORRECT/PRECISE RESULT ***")
              (newline)
              (display "rel. Error : ")
              (display err))))
      (display-test-separator))))

; Der Testtreiber ;  ieee754-test-add;  testet (rudimentär)
;   die ; ieee754; -Addition. Es wird einmal auf dem Umweg über 
;   ; ieee754;  addiert, einmal direkt, und die Abweichung mit einer 
;   Fehlerschranke verglichen.
; 


(define ieee754-test-add
  (lambda (a b max-error)
    (let* ((x (number->ieee754 a))
           (y (number->ieee754 b))
           (r (ieee754+ x y))
           (c (ieee754->number r)))
          (display a)(display #\tab)(display " -> ")
          (display x)(newline)
          (display b)(display #\tab)(display " -> ")
          (display y)(newline)
          (display a)(display " + ")
          (display b)(display " = ")
          (display r)(display #\tab)(display " -> ")
          (display c)(newline)
          (let ((err 
                (abs (/ (- (+ a b) c) 
                        (max (abs a) (abs b))))))
            (if (< max-error err)
                (begin
                  (newline)
                  (display "*** INCORRECT/PRECISE RESULT ***")
                  (newline)
                  (display "rel. Error : ")
                  (display err))))
          (display-test-separator))))

; Der Testtreiber ;  ieee754-test-mult;  testet (rudimentär)
;   die ; ieee754; -Multiplikation. Es wird einmal auf dem Umweg über 
;   ; ieee754;  multipliziert, einmal direkt, und die Abweichung mit einer 
;   Fehlerschranke verglichen.
; 


(define ieee754-test-mult
  (lambda (a b max-error)
    (let* ((x (number->ieee754 a))
           (y (number->ieee754 b))
           (r (ieee754* x y))
           (c (ieee754->number r)))
          (display a)(display #\tab)(display " -> ")
          (display x)(newline)
          (display b)(display #\tab)(display " -> ")
          (display y)(newline)
          (display a)(display " * ")
          (display b)(display " = ")
          (display r)(display #\tab)(display " -> ")
          (display c)(newline)
          (let ((err 
                (abs (/ (- (* a b) c) 
                        (* (abs a) (abs b))))))
            (if (< max-error err)
                (begin
                  (newline)
                  (display "*** INCORRECT/PRECISE RESULT ***")
                  (newline)
                  (display "rel. Error : ")
                  (display err)))
            (display-test-separator)))))


; Einige Testfälle für die Rechenoperationen auf dem vereinfachte IEEE Type.
; 

(define max-error 0.0)

(display-test-header "Testing IEEE-Conversion <-> Number")

(set! max-error 0.00) ; exact cases
(ieee754-test-conversion 2.0 max-error)
(ieee754-test-conversion -2.0 max-error)
(ieee754-test-conversion 1024.0 max-error)
(ieee754-test-conversion 748145127 max-error)
(ieee754-test-conversion 1.125 max-error)

(set! max-error 0.000000000000001) ; inexact cases
(ieee754-test-conversion 0.003 max-error)


(display-test-header "IEEE754 Addition") 
(set! max-error 0.0000000001) ; rather empirical
;
(ieee754-test-add 1.2 3.2 max-error)
(ieee754-test-add -1.2 3.2 max-error)
(ieee754-test-add 1.2 -3.2 max-error)
(ieee754-test-add 17.3 3.2 max-error)
(ieee754-test-add 17.3e7 100e5 max-error)


(display-test-header "IEEE754 Multiplikation") 
(set! max-error 0.00000000001) ; rather empirical
;
(ieee754-test-mult 1.2 3.2 max-error)
(ieee754-test-mult 1.2 -3.2 max-error)
(ieee754-test-mult -1.2 -3.2 max-error)
(ieee754-test-mult 17.3 3.2 max-error)
(ieee754-test-mult 17.3e7 100e5 max-error)