#lang racket
(require racket/flonum)
(provide fixed-point
         tolerance
         almost-equal?)

;;================================================================================
;;    fixed-point function
;;================================================================================

(define tolerance (make-parameter 5e-16))

(define (inexact-number? x)
  (and (number? x) (inexact? x)))

(define (almost-equal? x y)
  (cond
    [(and (number? x)
          (number? y)) (if (or (inexact-number? x)
                               (inexact-number? y))
                         (let ([ε (tolerance)])
                           (or (and (< x ε) (< y ε))
                               (< (magnitude (/ (- x y) (+ x y))) ε)))
                         (= x y))]
    [(and (pair? x) 
          (pair? y)) (and (almost-equal? (car x) (car y))
                          (almost-equal? (cdr x) (cdr y)))]
    [else (equal? x y)]))

;: The iterative procedure which finds the fixed point of the function f
;: (any/c ... -> (values any/c ...)) -> (any/c ... -> (values any/c ...))
(define (fixed-point f #:same-test [eq-test almost-equal?]) 
  (case (procedure-arity f)
    [(1) (λ(x)
           (let F ([x x] [fx (f x)])
             (if (eq-test x fx)
               x
               (F fx (f fx)))))]
    [else (λ x 
            (let F ([x x] [fx (apply (compose list f) x)])
              (if (eq-test x fx)
                (apply values x)
                (F fx (apply (compose list f) fx)))))]))