Pastebin launched a little side project called VERYVIRAL.com, check it out ;-) Want more features on Pastebin? Sign Up, it's FREE!
Guest

x_1+x_2+x_3+x_4+x_5+x_6=29

By: a guest on Jul 2nd, 2012  |  syntax: Lisp  |  size: 4.77 KB  |  views: 52  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. (defun copy-array (a)
  2.   (do ((b (make-array (length a)))
  3.        (i 0 (1+ i)))
  4.       ((= i (length a)) b)
  5.     (setf (aref b i) (aref a i))))
  6.  
  7. (defun pprint-hash (stream fmt colon at)
  8.   (declare (ignore colon at))
  9.   (maphash
  10.    #'(lambda (k v)
  11.        (format stream "~s => ~s~&" k v)) fmt))
  12.  
  13. (defun summands-of (n m)
  14.   (let ((result (make-hash-table :test #'equal)))
  15.     (labels ((summands-internal (remaining iterations &optional so-far)
  16.                (if (zerop (- m iterations))
  17.                    (let ((keys (or (gethash so-far result) 1)))
  18.                      (setf (gethash so-far result) keys)
  19.                      so-far)
  20.                    (do* ((step (ceiling remaining (- m iterations)))
  21.                          (i remaining (1- i))
  22.                          collected)
  23.                         (nil)
  24.                      (when (and (car so-far) (> i (car so-far)))
  25.                        (setq i (car so-far)))
  26.                      (when (< i step) (return collected))
  27.                      (mapc
  28.                       #'(lambda (x)
  29.                           (setq collected (cons x collected)))
  30.                       (summands-internal
  31.                        (- remaining i)
  32.                        (1+ iterations)
  33.                        (cons i so-far)))))))
  34.       (summands-internal n 0))
  35.     result))
  36.  
  37. (defun summands-of-order-matters (n m)
  38.   (let ((result (make-hash-table :test #'equal)))
  39.     (labels ((summands-internal (remaining iterations &optional so-far)
  40.              (if (zerop (- m iterations))
  41.                  (let* ((so-far (progn (incf (car so-far) remaining) so-far))
  42.                           (keys (or (gethash so-far result) 1)))
  43.                      (setf (gethash so-far result) keys)
  44.                      so-far)
  45.                    (do ((i remaining (1- i))
  46.                          collected)
  47.                         ((> 0 i) collected)
  48.                      (mapc
  49.                       #'(lambda (x)
  50.                           (setq collected (cons x collected)))
  51.                       (summands-internal
  52.                        (- remaining i)
  53.                        (1+ iterations)
  54.                        (cons i so-far)))))))
  55.       (summands-internal n 0))
  56.     result))
  57.  
  58. (defun remove-if-hash (hashtable tester)
  59.   (maphash
  60.    #'(lambda (x y)
  61.        (when (funcall tester x y)
  62.          (remhash x hashtable))) hashtable)
  63.   hashtable)
  64.  
  65. (defun assignment-15-2-filter (x y)
  66.   (declare (ignore y))
  67.   (let ((odds 0))
  68.     (dolist (i x (/= odds 3))
  69.       (when (< i 2) (return t))
  70.       ;; (format t "odds ~d, ~s~&" odds x)
  71.       (when (oddp i) (incf odds)))))
  72.  
  73. (defun multiply-powers (powers)
  74.   (if (not (cdr powers)) powers
  75.       (let ((a (car powers))
  76.             (b (cadr powers))
  77.             (c (make-hash-table)) d e)
  78.         (dolist (i a)
  79.           (dolist (j b)
  80.             (setq d (+ (cdr i) (cdr j)))
  81.             (if (gethash d c)
  82.                 (incf (gethash d c) (* (car i) (car j)))
  83.                 (setf (gethash d c) (* (car i) (car j))))))
  84.         (maphash #'(lambda (x y) (setq e (cons (cons y x) e))) c)
  85.         (multiply-powers (cons e (cddr powers))))))
  86.  
  87. ;; 792
  88. (format t "powers: ~s~&"
  89.         (multiply-powers '(((1 . 2) (1 . 4) (1 . 6) (1 . 8) (1 . 10) (1 . 12)
  90.                             (1 . 14) (1 . 16) (1 . 18))
  91.                            ((1 . 2) (1 . 4) (1 . 6) (1 . 8) (1 . 10) (1 . 12)
  92.                             (1 . 14) (1 . 16) (1 . 18))
  93.                            ((1 . 2) (1 . 4) (1 . 6) (1 . 8) (1 . 10) (1 . 12)
  94.                             (1 . 14) (1 . 16) (1 . 18))
  95.                            ((1 . 3) (1 . 5) (1 . 7) (1 . 9) (1 . 11) (1 . 13)
  96.                             (1 . 15) (1 . 17))
  97.                            ((1 . 3) (1 . 5) (1 . 7) (1 . 9) (1 . 11) (1 . 13)
  98.                             (1 . 15) (1 . 17))
  99.                            ((1 . 3) (1 . 5) (1 . 7) (1 . 9) (1 . 11) (1 . 13)
  100.                             (1 . 15) (1 . 17)))))
  101.  
  102. (format t "~/pprint-hash/" (summands-of 29 6))
  103.  
  104. ;; 278256 - don't try this at home!
  105. (format t "~/pprint-hash/" (summands-of-order-matters 29 6))
  106. (format t "count: ~d~&"
  107.         (hash-table-count (summands-of-order-matters 29 6)))
  108.  
  109. ;; 1057
  110. (format t "~/pprint-hash/"
  111.         (remove-if-hash
  112.          (summands-of 29 6) #'assignment-15-2-filter))
  113. (format t "count: ~d~&"
  114.         (hash-table-count (summands-of 29 6)))
  115. ;; 74
  116. (format t "count: ~d~&"
  117.         (hash-table-count
  118.          (remove-if-hash
  119.           (summands-of 29 6) #'assignment-15-2-filter)))
  120.  
  121. ;; 15840
  122. (format t "~/pprint-hash/"
  123.         (remove-if-hash
  124.          (summands-of-order-matters 29 6)
  125.          #'assignment-15-2-filter))
  126. (format t "count: ~d~&"
  127.         (hash-table-count (remove-if-hash
  128.          (summands-of-order-matters 29 6)
  129.          #'assignment-15-2-filter)))
clone this paste RAW Paste Data