kaprekar_calc.lisp

#!/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)))