Factorials in Racket

factorial.rkt

#lang racket

;;
;; These are some examples of different ways to compute factorials
;; using various paradigms and features provided by Racket. There
;; are more options available in packages which are not imported
;; by default, but that rabbit hole goes very deep indeed.
;;
;; Comments and suggestions welcome!
;;    leo@lwh.jp
;;

(define (apply-factorial n)
  (apply * (build-list n add1)))

(define (continuation-factorial n)
  (letrec
      ([f (λ (n cc)
            (if (zero? n)
                (cc 1)
                (f (sub1 n)
                   (λ (a)
                     (cc (* n a))))))])
    (call-with-current-continuation
     (λ (cc)
       (f n cc)))))

(define (do-factorial n)
  (do ([i 1 (add1 i)]
       [a 1 (* i a)])
    ((> i n) a)))

(define (fold-factorial n)
  (foldl (λ (i a)
           (* i a))
         1
         (build-list n add1)))

(define (for-factorial n)
  (for/product ([i (in-range 1 (add1 n))])
    i))

(define (generator-factorial n)
  (let ([g (let ([i 0]
                 [a 1])
             (λ ()
               (begin0
                 a
                 (set! i (add1 i))
                 (set! a (* i a)))))])
    (for/last ([i (in-range (add1 n))])
      (g))))

(define (inc-dec-factorial n)
  (letrec
      ([f (λ (a i)
            (if (zero? i)
                a
                (f (g a a i) (sub1 i))))]
       [g (λ (a b j)
            (if (zero? j)
                a
                (g (h a b) b (sub1 j))))]
       [h (λ (a k)
            (if (zero? k)
                a
                (h (add1 a) (sub1 k))))])
    (if (zero? n)
        1
        (f 1 (sub1 n)))))

(define lazy-factorial
  (letrec ([f (λ (i [a 1])
                (lazy
                 (if (zero? i)
                     a
                     (f (sub1 i)
                        (* a i)))))])
    (λ (n)
      (force
       (f n)))))

(define library-factorial
  (dynamic-require
   'math/number-theory
   'factorial
   (λ ()
     (λ (n)
       (error "not available in this version of Racket")))))

(define-syntax (macro-factorial stx)
  (syntax-case stx ()
    [(_ 0) #'1]
    [(_ n)
     #`(* n (macro-factorial
             #,(sub1 (syntax->datum #'n))))]))

(define memoized-factorial
  (let ([cache (make-hasheqv '((0 . 1)))])
    (λ (n)
      (hash-ref!
       cache
       n
       (λ ()
         (* n (memoized-factorial (sub1 n))))))))

(define pattern-matching-factorial
  (match-lambda
    [0 1]
    [(? positive? n) 
     (* n (pattern-matching-factorial (sub1 n)))]))

(define (recursive-factorial n)
  (if (zero? n)
      1
      (* n (recursive-factorial (sub1 n)))))

(define sequence-factorial
  (let ([factorial-sequence
         (make-do-sequence
          (thunk
           (values
            cdr
            (λ (pos)
              (cons (add1 (car pos))
                    (* (car pos) (cdr pos))))
            '(1 . 1)
            #f
            #f
            #f)))])
    (λ (n)
      (sequence-ref factorial-sequence n))))

(define stream-factorial
  (let ([factorial-stream
         (let loop ([i 1]
                    [a 1])
           (stream-cons
            a
            (loop (add1 i) (* a i))))])
    (λ (n)
      (stream-ref factorial-stream n))))

(define (tail-recursive-factorial n)
  (let loop ([i n]
             [result 1])
    (cond
      [(zero? i) result]
      [else (loop (sub1 i)
                  (* result i))])))

(define y-factorial
  ((λ (f)
     ((λ (g)
        (f (λ (x)
             ((g g) x))))
      (λ (g)
        (f (λ (x)
             ((g g) x))))))
   (λ (f)
     (λ (n)
       (if (zero? n)
           1
           (* n (f (sub1 n))))))))