Created
February 4, 2010 16:43
-
-
Save deltam/294845 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/opt/local/bin/sbcl --script | |
;; 2009-10-06 | |
;; カプレカー操作の検算 | |
;; 4桁の場合 | |
(defparameter *num-keta* 4) | |
;;; リストをその並びの十進数に変換する | |
(defun list-to-dig (lst) | |
(reduce #'(lambda (a b) (+ (* a 10) b)) lst)) | |
;;; 十進数を各桁を要素とするリストに変換する | |
(defun dig-to-list (num) | |
(labels ((rec (num log_n) | |
(if (= log_n 0) | |
'() | |
(cons (- num (* (floor (/ num 10)) 10)) | |
(rec (floor (/ num 10)) (- log_n 1)))))) | |
(rec num *num-keta*))) | |
;; テスト | |
;(list-to-dig '(9 5 0)) | |
;(dig-to-list 9) | |
;; カプレカー操作 | |
(defun calc-decnum (num) | |
(let ((smaller (sort (dig-to-list num) #'<)) | |
(bigger (sort (dig-to-list num) #'>))) | |
(- (list-to-dig bigger) (list-to-dig smaller)))) | |
;; numに対するカプレカー操作をn回実施 | |
(defun calc-fixed-point (num n) | |
(loop for i from 1 to n collect | |
(setq num (calc-decnum num)))) | |
;; 各桁で不動点があるかどうか実験 | |
;(setf *num-keta* 9) | |
;; 0 - 1000 の値でカプレカー操作を10回実施 | |
(dotimes (x 1000) | |
(let ((lst (calc-fixed-point x 10))) | |
(format t "~A: ~A~%" x lst))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment