Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (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)))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement