53 lines
1.7 KiB
Common Lisp
53 lines
1.7 KiB
Common Lisp
;;; Approach: for each set size, test every sum in ascending order to
|
|
;;; find sets of numbers whose product is the desired sum (note:
|
|
;;; creating all the product sets is memoized because the same sums
|
|
;;; are tested for each set size), and then verify that the set (with
|
|
;;; all necessary 1s added back) produces the desired sum.
|
|
|
|
(defun divisiblep (n divisor)
|
|
"Returns non-NIL when N is divisible by DIVISOR"
|
|
(= 0 (mod n divisor)))
|
|
|
|
(defun for-each-product (function n &optional (min 2) set)
|
|
"Runs FUNCTION on all sets of numbers whose product is N"
|
|
(cond ((= n 1) (funcall function set))
|
|
(t (loop for d from min upto n
|
|
do (when (divisiblep n d)
|
|
(for-each-product function
|
|
(/ n d)
|
|
d
|
|
(cons d set)))))))
|
|
|
|
(let ((memo (make-hash-table)))
|
|
(defun for-each-product* (function n)
|
|
"Same as FOR-EACH-PRODUCT, but memoized"
|
|
(let ((result (or (gethash n memo)
|
|
(setf (gethash n memo)
|
|
(let ((sets nil))
|
|
(for-each-product (lambda (set)
|
|
(push set sets))
|
|
n)
|
|
sets)))))
|
|
(loop for set in result
|
|
do (funcall function set)))))
|
|
|
|
(defun min-product-sum (k)
|
|
"Returns the minimal product-sum number for set size K"
|
|
(loop for sum upfrom k
|
|
do (for-each-product* (lambda (set)
|
|
;; Ensure the set has the correct sum, including 1s
|
|
(when (= sum
|
|
(reduce #'+ (cons (- k (length set))
|
|
set)))
|
|
;;(print (remove 1 set))
|
|
(return-from min-product-sum sum)))
|
|
sum)))
|
|
|
|
(defun product-sum-numbers (&optional (max 12000))
|
|
(loop with numbers = (make-hash-table)
|
|
for k from 2 upto max
|
|
for min-product-sum = (min-product-sum k)
|
|
do (setf (gethash min-product-sum numbers) t)
|
|
finally (return (loop for n being the hash-keys in numbers
|
|
sum n))))
|