Product-sum numbers
This commit is contained in:
parent
322a1ecfe3
commit
3466904502
|
@ -0,0 +1,52 @@
|
|||
;;; 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))))
|
Loading…
Reference in New Issue