67 lines
2.6 KiB
Common Lisp
67 lines
2.6 KiB
Common Lisp
(defparameter *nlimit* 16)
|
|
(defparameter *klimit* (expt 2 47))
|
|
(defparameter *asht* (make-hash-table))
|
|
(load "proper-divisors")
|
|
|
|
(defun ht-insert (v n)
|
|
(setf (gethash v *asht*) n))
|
|
|
|
(defun ht-find (v n)
|
|
(let ((nprev (gethash v *asht*)))
|
|
(if nprev (- n nprev) nil)))
|
|
|
|
(defun ht-list ()
|
|
(defun sort-keys (&optional (res '()))
|
|
(maphash #'(lambda (k v) (push (cons k v) res)) *asht*)
|
|
(sort (copy-list res) #'< :key (lambda (p) (cdr p))))
|
|
(let ((sorted (sort-keys)))
|
|
(dotimes (i (length sorted)) (format t "~A " (car (nth i sorted))))))
|
|
|
|
(defun aliquot-generator (K1)
|
|
"integer->function::fn to generate aliquot sequence"
|
|
(let ((Kn K1))
|
|
#'(lambda () (setf Kn (reduce #'+ (proper-divisors-recursive Kn) :initial-value 0)))))
|
|
|
|
(defun aliquot (K1)
|
|
"integer->symbol|nil::classify aliquot sequence"
|
|
(defun aliquot-sym (Kn n)
|
|
(let* ((period (ht-find Kn n))
|
|
(sym (if period
|
|
(cond ; period event
|
|
((= Kn K1)
|
|
(case period (1 'PERF) (2 'AMIC) (otherwise 'SOCI)))
|
|
((= period 1) 'ASPI)
|
|
(t 'CYCL))
|
|
(cond ; else check for limit event
|
|
((= Kn 0) 'TERM)
|
|
((> Kn *klimit*) 'TLIM)
|
|
((= n *nlimit*) 'NLIM)
|
|
(t nil)))))
|
|
;; if period event store the period, if no event insert the value
|
|
(if sym (when period (setf (symbol-plist sym) (list period)))
|
|
(ht-insert Kn n))
|
|
sym))
|
|
|
|
(defun aliquot-str (sym &optional (period 0))
|
|
(case sym (TERM "terminating") (PERF "perfect") (AMIC "amicable") (ASPI "aspiring")
|
|
(SOCI (format nil "sociable (period ~A)" (car (symbol-plist sym))))
|
|
(CYCL (format nil "cyclic (period ~A)" (car (symbol-plist sym))))
|
|
(NLIM (format nil "non-terminating (no classification before added term limit of ~A)" *nlimit*))
|
|
(TLIM (format nil "non-terminating (term threshold of ~A exceeded)" *klimit*))
|
|
(otherwise "unknown")))
|
|
|
|
(clrhash *asht*)
|
|
(let ((fgen (aliquot-generator K1)))
|
|
(setf (symbol-function 'aliseq) #'(lambda () (funcall fgen))))
|
|
(ht-insert K1 0)
|
|
(do* ((n 1 (1+ n))
|
|
(Kn (aliseq) (aliseq))
|
|
(alisym (aliquot-sym Kn n) (aliquot-sym Kn n)))
|
|
(alisym (format t "~A:" (aliquot-str alisym)) (ht-list) (format t "~A~%" Kn) alisym)))
|
|
|
|
(defun main ()
|
|
(princ "The last item in each sequence triggers classification.") (terpri)
|
|
(dotimes (k 10)
|
|
(aliquot (+ k 1)))
|
|
(dolist (k '(11 12 28 496 220 1184 12496 1264460 790 909 562 1064 1488 15355717786080))
|
|
(aliquot k)))
|