(defun copy-array (a)
(do ((b (make-array (length a)))
(i 0 (1+ i)))
((= i (length a)) b)
(setf (aref b i) (aref a i))))
(defun pprint-hash (stream fmt colon at)
(declare (ignore colon at))
(maphash
#'(lambda (k v)
(format stream "~s => ~s~&" k v)) fmt))
(defun summands-of (n m)
(let ((result (make-hash-table :test #'equal)))
(labels ((summands-internal (remaining iterations &optional so-far)
(if (zerop (- m iterations))
(let ((keys (or (gethash so-far result) 1)))
(setf (gethash so-far result) keys)
so-far)
(do* ((step (ceiling remaining (- m iterations)))
(i remaining (1- i))
collected)
(nil)
(when (and (car so-far) (> i (car so-far)))
(setq i (car so-far)))
(when (< i step) (return collected))
(mapc
#'(lambda (x)
(setq collected (cons x collected)))
(summands-internal
(- remaining i)
(1+ iterations)
(cons i so-far)))))))
(summands-internal n 0))
result))
(defun summands-of-order-matters (n m)
(let ((result (make-hash-table :test #'equal)))
(labels ((summands-internal (remaining iterations &optional so-far)
(if (zerop (- m iterations))
(let* ((so-far (progn (incf (car so-far) remaining) so-far))
(keys (or (gethash so-far result) 1)))
(setf (gethash so-far result) keys)
so-far)
(do ((i remaining (1- i))
collected)
((> 0 i) collected)
(mapc
#'(lambda (x)
(setq collected (cons x collected)))
(summands-internal
(- remaining i)
(1+ iterations)
(cons i so-far)))))))
(summands-internal n 0))
result))
(defun remove-if-hash (hashtable tester)
(maphash
#'(lambda (x y)
(when (funcall tester x y)
(remhash x hashtable))) hashtable)
hashtable)
(defun assignment-15-2-filter (x y)
(declare (ignore y))
(let ((odds 0))
(dolist (i x (/= odds 3))
(when (< i 2) (return t))
;; (format t "odds ~d, ~s~&" odds x)
(when (oddp i) (incf odds)))))
(defun multiply-powers (powers)
(if (not (cdr powers)) powers
(let ((a (car powers))
(b (cadr powers))
(c (make-hash-table)) d e)
(dolist (i a)
(dolist (j b)
(setq d (+ (cdr i) (cdr j)))
(if (gethash d c)
(incf (gethash d c) (* (car i) (car j)))
(setf (gethash d c) (* (car i) (car j))))))
(maphash #'(lambda (x y) (setq e (cons (cons y x) e))) c)
(multiply-powers (cons e (cddr powers))))))
;; 792
(format t "powers: ~s~&"
(multiply-powers '(((1 . 2) (1 . 4) (1 . 6) (1 . 8) (1 . 10) (1 . 12)
(1 . 14) (1 . 16) (1 . 18))
((1 . 2) (1 . 4) (1 . 6) (1 . 8) (1 . 10) (1 . 12)
(1 . 14) (1 . 16) (1 . 18))
((1 . 2) (1 . 4) (1 . 6) (1 . 8) (1 . 10) (1 . 12)
(1 . 14) (1 . 16) (1 . 18))
((1 . 3) (1 . 5) (1 . 7) (1 . 9) (1 . 11) (1 . 13)
(1 . 15) (1 . 17))
((1 . 3) (1 . 5) (1 . 7) (1 . 9) (1 . 11) (1 . 13)
(1 . 15) (1 . 17))
((1 . 3) (1 . 5) (1 . 7) (1 . 9) (1 . 11) (1 . 13)
(1 . 15) (1 . 17)))))
(format t "~/pprint-hash/" (summands-of 29 6))
;; 278256 - don't try this at home!
(format t "~/pprint-hash/" (summands-of-order-matters 29 6))
(format t "count: ~d~&"
(hash-table-count (summands-of-order-matters 29 6)))
;; 1057
(format t "~/pprint-hash/"
(remove-if-hash
(summands-of 29 6) #'assignment-15-2-filter))
(format t "count: ~d~&"
(hash-table-count (summands-of 29 6)))
;; 74
(format t "count: ~d~&"
(hash-table-count
(remove-if-hash
(summands-of 29 6) #'assignment-15-2-filter)))
;; 15840
(format t "~/pprint-hash/"
(remove-if-hash
(summands-of-order-matters 29 6)
#'assignment-15-2-filter))
(format t "count: ~d~&"
(hash-table-count (remove-if-hash
(summands-of-order-matters 29 6)
#'assignment-15-2-filter)))