gistfile1.scm

(load "/Users/colin/lib/test-manager/load.scm")

(define (is-proper-factor? product possible-factor)
  (and
   (not (= product possible-factor))
   (= 0 (modulo product possible-factor))))

(define (has-proper-factors? product test-factor)
  (and (> product test-factor)
       (or
        (is-proper-factor? product test-factor)
        (has-proper-factors? product (+ 1 test-factor)))))

(define (append-factor factor factor-list)
  (append (list factor) factor-list))

(define (list-factors product test-factor)
  (cond ((< product 2)
         ;; it's 1 or 0
         (list))
        ((has-proper-factors? product 2)
         (if (> product test-factor)
             (if (is-proper-factor? product test-factor)
                 (append-factor test-factor (list-factors (/ product test-factor) test-factor))
                 (list-factors product (+ 1 test-factor)))
             (list)))
        (else
         ;; it's prime
         (list product))))

(define (prime-factors product)
  (list-factors product 2))

(define-each-test
  (assert-equal (list) (prime-factors 0))
  (assert-equal (list) (prime-factors 1))
  (assert-equal (list 2) (prime-factors 2))
  (assert-equal (list 3) (prime-factors 3))
  (assert-equal (list 2 2) (prime-factors 4))
  (assert-equal (list 5) (prime-factors 5))
  (assert-equal (list 2 3) (prime-factors 6))
  (assert-equal (list 7) (prime-factors 7))
  (assert-equal (list 2 2 2) (prime-factors 8))
  (assert-equal (list 3 3) (prime-factors 9))
  (assert-equal (list 2 5) (prime-factors 10))
  (assert-equal (list 2 5 7 13 37) (prime-factors (* 2 5 7 13 37)))
)

(run-registered-tests)