#lang racket
(require racket/flonum)
(provide fixed-point
tolerance
almost-equal?)
(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)]))
(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)))))]))