;;; 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))))