Functions for Euler #152, Common Lisp

Language: Layout:

;gnu clisp 2.49

(defparameter primes '(79 73 71 67 61 59 53 47 43 41 37 31 29 23 19 17 13 11 7 5 3 2))

(defun largest-divisor (n)
   (loop for i in primes when (zerop (rem n i)) return i))

(defparameter fractions (loop with frac = (mapcar #'(lambda(x) (cons x Nil)) primes)
                                                for i from 2 to 80 do (push (expt i -2) (cdr (assoc (largest-divisor i) frac)))
                                                finally (return frac)))

(defun all-sums (lst)
   (loop for i from 0 below (expt 2 (length lst))
            collecting (loop for j in lst
                                      for k = i then (floor k 2) until (zerop k)
                                      when (oddp k) summing j)))

(defun all-reductions (n)
    (mapcan #'(lambda (x) (if (< (largest-divisor (denominator x)) n) (list x)))
                   (cdr (all-sums (cdr (assoc n fractions))))))

(print (loop for i in fractions 
                   when (all-reductions (car i)) collect it))

[ + ] Show input
Absolute running time: 0.71 sec, cpu time: 0.96 sec, memory peak: 6 Mb, absolute service time: 0,72 sec