doin decomposition

decompose.lisp

(macrolet ((addiv (d)
             `(if (gethash ,d table)
                  (incf (gethash ,d table))
                  (setf (gethash ,d table) 1))))
  (defun %decompose (n table)
    (cond
      ((= n 1) table)
      ((<= n 3) (addiv n)
       table)
      ((evenp n) (addiv 2) (%decompose (/ n 2) table))
      ((zerop (mod n 3)) (addiv 3) (%decompose (/ n 3) table))
      (t (loop :for i :from 5 :by 6
               :for byi := (zerop (mod n i))
               :for byi2 := (zerop (mod n (+ 2 i)))
               :while (and (<= (* i i) n) (not byi) (not byi2))
               :finally (return (cond (byi (addiv i)
                                           (%decompose (/ n i) table))
                                      (byi2 (addiv (+ 2 i))
                                            (%decompose (/ n (+ i 2)) table))
                                      (t (addiv n)
                                         table))))))))

(defun decompose (n)
  (check-type n integer)
  (macrolet ((addiv (d)
               `(if (gethash ,d table)
                    (incf (gethash ,d table))
                    (setf (gethash ,d table) 1))))
    (labels ((%decompose (n table)
               (declare (optimize (speed 3) (safety 0)) (integer n) (hash-table table))
               (cond
                 ((= n 1)
                  table)
                 ((<= n 3)
                  (addiv n)
                  table)
                 ((evenp n)
                  (addiv 2)
                  (%decompose (/ n 2) table))
                 ((zerop (mod n 3))
                  (addiv 3)
                  (%decompose (/ n 3) table))
                 (t
                  (%loop 5 n table))))
             (%loop (i n table)
                (declare (optimize (speed 3) (safety 0)) (integer n) (integer i) (hash-table table))
               (block nil
                 (when (> (* i i) n)
                   (addiv n)
                   (return table))
                 (multiple-value-bind (quo rem) (truncate n i)
                   (when (zerop rem)
                     (addiv i)
                     (return (%decompose quo table))))
                 (multiple-value-bind (quo rem) (truncate n (+ 2 i))
                   (when (zerop rem)
                     (addiv (+ 2 i))
                     (return (%decompose quo table))))
                 (%loop (+ i 6) n table))))
      (%decompose n (make-hash-table)))))


(defun decompose2 (n)
  (check-type n integer)
  (macrolet ((addiv (d)
               `(if (gethash ,d table)
                    (incf (gethash ,d table))
                    (setf (gethash ,d table) 1)))
             (check (i)
               `(multiple-value-bind (quo rem) (truncate n ,i)
                   (when (zerop rem)
                     (addiv ,i)
                     (return (%decompose quo table))))))
    (labels ((%decompose (n table)
               (declare (optimize (speed 3) (safety 0)) (integer n) (hash-table table))
               (block nil
                 (when (= n 1)
                   (return table))
                 (when (<= n 3)
                   (addiv n)
                   (return table))
                 (check 2)
                 (check 3)
                 (%loop 5 n table)))
             (%loop (i n table)
               (declare (optimize (speed 3) (safety 0)) (integer n) (integer i) (hash-table table))
               (block nil
                 (when (> (* i i) n)
                   (addiv n)
                   (return table))
                 (check i)
                 (check (+ 2 i))
                 (%loop (+ i 6) n table))))
      (%decompose n (make-hash-table)))))