all4.dot

digraph g{  graph[rankdir=LR;]; 
v0477 [label="0477\n(33)"]
v0225 [label="0225\n(05)"]
v4689 [label="4689\n(25)"]
v1224 [label="1224\n(03)"]
v2268 [label="2268\n(44)"]
v6678 [label="6678\n(12)"]
v6777 [label="6777\n(01)"]
v5589 [label="5589\n(34)"]
v2889 [label="2889\n(04)"]
v3789 [label="3789\n(14)"]
v0189 [label="0189\n(39)"]
v1179 [label="1179\n(48)"]
v0117 [label="0117\n(04)"]
v0333 [label="0333\n(03)"]
v9999 [label="9999\n(00)"]
v2358 [label="2358\n(24)"]
v3447 [label="3447\n(04)"]
v1233 [label="1233\n(12)"]
v1269 [label="1269\n(48)"]
v0999 [label="0999\n(02)"]
v2799 [label="2799\n(23)"]
v0018 [label="0018\n(12)"]
v0666 [label="0666\n(05)"]
v1566 [label="1566\n(15)"]
v1377 [label="1377\n(44)"]
v3456 [label="3456\n(13)"]
v2367 [label="2367\n(35)"]
v1458 [label="1458\n(13)"]
v1899 [label="1899\n(12)"]
v4455 [label="4455\n(11)"]
v0027 [label="0027\n(23)"]
v0567 [label="0567\n(13)"]
v0045 [label="0045\n(45)"]
v0378 [label="0378\n(48)"]
v0288 [label="0288\n(48)"]
v0144 [label="0144\n(34)"]
v0459 [label="0459\n(11)"]
v3888 [label="3888\n(05)"]
v0009 [label="0009\n(02)"]
v0000 [label="0000\n(00)"]
v0234 [label="0234\n(14)"]
v1188 [label="1188\n(33)"]
v1557 [label="1557\n(05)"]
v0279 [label="0279\n(59)"]
v0126 [label="0126\n(14)"]
v0135 [label="0135\n(25)"]
v1134 [label="1134\n(23)"]
v2259 [label="2259\n(33)"]
v2556 [label="2556\n(04)"]
v0468 [label="0468\n(22)"]
v3348 [label="3348\n(15)"]
v6669 [label="6669\n(03)"]
v3357 [label="3357\n(24)"]
v0036 [label="0036\n(34)"]
v4446 [label="4446\n(02)"]
v2277 [label="2277\n(55)"]
v0099 [label="0099\n(11)"]
v4779 [label="4779\n(05)"]
v1116 [label="1116\n(05)"]
v5688 [label="5688\n(23)"]
v3366 [label="3366\n(33)"]
v1368 [label="1368\n(33)"]
v1449 [label="1449\n(03)"]
v3339 [label="3339\n(05)"]
v4599 [label="4599\n(45)"]
v0369 [label="0369\n(39)"]
v0558 [label="0558\n(03)"]
v3699 [label="3699\n(34)"]
v2466 [label="2466\n(24)"]
v2448 [label="2448\n(05)"]
v1359 [label="1359\n(22)"]
v4788 [label="4788\n(14)"]
v2349 [label="2349\n(13)"]
v2457 [label="2457\n(15)"]
v5679 [label="5679\n(14)"]
v1125 [label="1125\n(14)"]
v1278 [label="1278\n(57)"]
v2223 [label="2223\n(01)"]
v1467 [label="1467\n(24)"]
v3555 [label="3555\n(02)"]
v5778 [label="5778\n(03)"]
v0477 -> v2367;
v0225 -> v4599;
v4689 -> v1557;
v1224 -> v2799;
v2268 -> v3456;
v6678 -> v0288;
v6777 -> v0999;
v5589 -> v2466;
v2889 -> v3699;
v3789 -> v0468;
v0189 -> v1269;
v1179 -> v2358;
v0117 -> v3699;
v0333 -> v2799;
v9999 -> v0000;
v2358 -> v1467;
v3447 -> v3699;
v1233 -> v0288;
v1269 -> v2358;
v0999 -> v1899;
v2799 -> v1377;
v0018 -> v0288;
v0666 -> v4599;
v1566 -> v0558;
v1377 -> v3456;
v3456 -> v0378;
v2367 -> v2556;
v1458 -> v0378;
v1899 -> v0288;
v4455 -> v0189;
v0027 -> v1377;
v0567 -> v0378;
v0045 -> v3555;
v0378 -> v2358;
v0288 -> v2358;
v0144 -> v2466;
v0459 -> v0189;
v3888 -> v4599;
v0009 -> v1899;
v0000 -> v0000;
v0234 -> v0468;
v1188 -> v2367;
v1557 -> v4599;
v0279 -> v1449;
v0126 -> v0468;
v0135 -> v1557;
v1134 -> v1377;
v2259 -> v2367;
v2556 -> v3699;
v0468 -> v1278;
v3348 -> v0558;
v6669 -> v2799;
v3357 -> v1467;
v0036 -> v2466;
v4446 -> v1899;
v2277 -> v4455;
v0099 -> v0189;
v4779 -> v4599;
v1116 -> v4599;
v5688 -> v1377;
v3366 -> v2367;
v1368 -> v2367;
v1449 -> v2799;
v3339 -> v4599;
v4599 -> v3555;
v0369 -> v1269;
v0558 -> v2799;
v3699 -> v2466;
v2466 -> v1467;
v2448 -> v4599;
v1359 -> v1278;
v4788 -> v0468;
v2349 -> v0378;
v2457 -> v0558;
v5679 -> v0468;
v1125 -> v0468;
v1278 -> v3447;
v2223 -> v0999;
v1467 -> v1467;
v3555 -> v1899;
v5778 -> v2799;}

all4.png

find_kap_loops.clj

;; example to find loop in kaprekar's operation sequence.
;; Usage: clj find-kap-loops.clj 3 >> loops.txt

(use '[kaprekar :only (kap-seq)])


(defn distinct-by
  "Return distinct sequence of the item in coll,
   where the distinct order is determined by comparing (keyfn item)."
  ([      coll] (distinct coll))
  ([keyfn coll] (for [dc (distinct (map keyfn coll))]
                  (some #(if (= dc (keyfn %)) %) coll)))
  {:test (fn []
           (assert (= (distinct-by '(1 1 2 3)) '(1 2 3)))
           (assert (= (distinct-by #(* 1 %) '(1 1 2 3)) '(1 2 3)))
           (assert (= (distinct-by #(* 0 %) '(1 1 2 3)) '(1)))
           (assert (= (distinct-by #(.toUpperCase %) '("a" "b" "B" "c")) '("a" "b" "c"))))})


(defn get-loop [n dig]
  (let [max (* 3 dig) ; max of loop length (note: this is not proved now)
        ks  (take-while
             #(not= % n)
             (drop 1 (take max (kap-seq n dig))))]
    (if (= (count ks) (- max 1))
      nil
      (list (cons n ks)))))


(defn print-ans [loops]
  (if (zero? (count loops))
    (println "nothing.")
    (do (println "count:" (count loops))
        (doseq [ans loops]
          (println (count ans) ":" ans)))))


(defn find-kap-loops [dig]
  (let [xnines (range 9 (Math/pow 10 dig) 9) ; sequence by multiples of 9
        lseq   (for [s xnines
                     l (get-loop s dig)
                     :when (not (nil? l))]
                 l)]
    (let [loops (distinct-by #(sort %) lseq)]
      (print-ans loops))))


;; main
(time
 (let [digit (Integer/parseInt (first *command-line-args*))]
   (println "Kaprekar loops by digit" digit)
   (find-kap-loops digit)))
(println)

kaprekar.clj

;; Kaprekar's operation on Clojure
;;
;; What is Kaprekar constant? / Kaprekar's operation?
;; http://en.wikipedia.org/wiki/Kaprekar
;; http://en.wikipedia.org/wiki/6174_%28number%29
;;
;; written by deltam@gmail.com
;;

(ns kaprekar)

(defn num->lst
  "Return list of decompose number n by digits."
  ([n digits]
  (loop [lst '(), a n, dig (.intValue (Math/pow 10 (dec digits)))]
    (if (<= dig 0)
      (reverse lst)
      (recur (conj lst (quot a dig)), (rem a dig), (quot dig 10)))))
  {:test (fn []
           (assert (= (num->lst   123 3)    '(1 2 3)))
           (assert (= (num->lst   123 3)    '(1 2 3)))
           (assert (= (num->lst    12 3)    '(0 1 2)))
           (assert (= (num->lst 12345 4) '(12 3 4 5))))})


(defn lst->num
  "Return number that compose of lst."
  ([lst]
  (if (empty? lst)
    0
    (reduce #(+ (* %1 10) %2) lst)))
  {:test (fn []
           (assert (= (lst->num        '())   0))
           (assert (= (lst->num       '(1))   1))
           (assert (= (lst->num   '(1 2 3)) 123))
           (assert (= (lst->num '(0 1 2 3)) 123)))})


(defn calc
  "Calculation Kaprekar's operation one step."
  ([n digits]
  (let [bigger  (sort #(> %1 %2) (num->lst n digits))
        smaller (reverse bigger)]
    (- (lst->num bigger) (lst->num smaller))))
  {:test (fn []
           (assert (= (calc  111 3)     0))
           (assert (= (calc  234 3)   198))
           (assert (= (calc  495 3)   495))
           (assert (= (calc 3453 4)  2088))
           (assert (= (calc 6174 4)  6174)))})

(def mcalc (memoize calc))

(defn step [lst]
  (let [d (count lst)
        s (mcalc (lst->num lst) d)]
    (sort (num->lst s d))))

(defn step-diff [lst]
  (map - (rest lst) lst))

(defn mirror-diff [lst]
  (let [half (int (/ (count lst) 2))]
    (drop half
          (map -
               lst
               (reverse lst)))))

(defn mirror-id [lst]
  (->> (mirror-diff lst)
       (reduce (fn [[ret carry prev] cur]
                 (if (zero? cur)
                   [(conj ret cur) 1 cur]
                   (let [m (min cur (- (+ 10 carry) cur))
                         cur2 (if (<= prev m) m cur)]
                     [(conj ret cur2) 0 cur2])))
               [[] 0 0])
       (first)))

(defn kap-seq
  "Return Kaprekar Lazy-Sequence that begin taken number n."
  ([n]        (kap-seq n (inc (Math/floor (Math/log10 n)))))
  ([n digits] (let [i (calc n digits)]
                (cons n (iterate #(mcalc % digits) i))))
  {:test (fn []
           (assert (= (take 3 (kap-seq    9 2)) '(   9   81   63)))
           (assert (= (take 3 (kap-seq  111))   '( 111    0    0)))
           (assert (= (take 3 (kap-seq  234))   '( 234  198  792)))
           (assert (= (take 3 (kap-seq 6174))   '(6174 6174 6174))))})

(defn kap-set
  ""
  ([digits] (let [max (- (Math/pow 10 digits) 1)
                  calc1 (for [num (range 0 max)] (calc num digits))]
              (sort (distinct calc1)))))



;; to use
(comment

(def k (kap-sep 123 4))
(println (take 7 k))

)

(comment

(def fs (set (map #(sort (kaprekar/num->lst % 4)) (range 0 10000 9))))
(->> fs
     (map #(let [s (apply str %)
                 md (kaprekar/mirror-id %)]
             (format "v%s [label=\"%s\\n(%s)\"]" s s (apply str md))))
     (clojure.string/join "\n")
     (spit "vs4.dot"))

(def ss (->> (for [l (set (map #(sort (kaprekar/num->lst % 4)) (range 0 10000 9)))
                   :let [s (kaprekar/step l)]]
               (format "v%s -> v%s;" (apply str l) (apply str s)))
             (clojure.string/join "\n")))

(->> fs
     (map kaprekar/step)
     (map kaprekar/step)
     (map kaprekar/step)
     (map kaprekar/step)
     (map kaprekar/step)
     (map kaprekar/step)
     (map #(apply str (kaprekar/mirror-diff %)))
     (distinct)
     (sort))


(->> (map #(kaprekar/num->lst % 4) (range 10000))
     (map sort)
     (distinct)
     (group-by kaprekar/mirror-id)
     (keys)
     (sort))

(->> fs
     (map #(vector (kaprekar/mirror-id %) (kaprekar/step %)))
     (group-by second)
     (map (fn [[k v]] (vector k (distinct (map first v))))))

;; カプレカー操作前のmirror-idと結果が一対一対応
([(0 1 8 9) ([1 1])]
 [(2 3 5 8) ([4 8])]
 [(3 4 4 7) ([5 7])]
 [(1 2 6 9) ([3 9])]
 [(0 9 9 9) ([0 1])]
 [(2 7 9 9) ([0 3])]
 [(1 3 7 7) ([2 3])]
 [(3 4 5 6) ([4 4])]
 [(2 3 6 7) ([3 3])]
 [(1 8 9 9) ([0 2])]
 [(4 4 5 5) ([5 5])]
 [(0 3 7 8) ([1 3])]
 [(0 2 8 8) ([1 2])]
 [(0 0 0 0) ([0 0])]
 [(1 5 5 7) ([2 5])]
 [(2 5 5 6) ([3 5])]
 [(0 4 6 8) ([1 4])]
 [(1 4 4 9) ([5 9])]
 [(4 5 9 9) ([0 5])]
 [(0 5 5 8) ([1 5])]
 [(3 6 9 9) ([0 4])]
 [(2 4 6 6) ([3 4])]
 [(1 2 7 8) ([2 2])]
 [(1 4 6 7) ([2 4])]
 [(3 5 5 5) ([4 5])])

;; N=6 では違うか？
(def fs6 (set (map #(sort (kaprekar/num->lst % 6)) (range 0 1000000 9))))
(->> fs6
     (map #(vector (kaprekar/mirror-id %) (kaprekar/step %)))
     (group-by second)
     (map (fn [[k v]] (vector k (distinct (map first v)))))
     (filter (fn [[k v]] (>=(count v) 2)))
     (count))
;> 46
;; かぶるやつがある
;; 組み合わせをなんとかしないと

)

loops.txt

; memoize calc 
Kaprekar loops by digit 1
nothing.
"Elapsed time: 49.673 msecs"

Kaprekar loops by digit 2
count: 1
5 : (9 81 63 27 45)
"Elapsed time: 63.723 msecs"

Kaprekar loops by digit 3
count: 1
1 : (495)
"Elapsed time: 103.203 msecs"

Kaprekar loops by digit 4
count: 1
1 : (6174)
"Elapsed time: 1077.618 msecs"

Kaprekar loops by digit 5
count: 3
2 : (53955 59994)
4 : (61974 82962 75933 63954)
4 : (62964 71973 83952 74943)
"Elapsed time: 1982.263 msecs"

Kaprekar loops by digit 6
count: 3
7 : (420876 851742 750843 840852 860832 862632 642654)
1 : (549945)
1 : (631764)
"Elapsed time: 4813.086 msecs"

Kaprekar loops by digit 7
count: 1
8 : (7509843 9529641 8719722 8649432 7519743 8429652 7619733 8439552)
"Elapsed time: 41308.71 msecs"

Kaprekar loops by digit 8
count: 4
7 : (43208766 85317642 75308643 84308652 86308632 86326632 64326654)
1 : (63317664)
3 : (64308654 83208762 86526432)
1 : (97508421)
"Elapsed time: 465583.39 msecs"

Kaprekar loops by digit 9
count: 3
1 : (554999445)
14 : (753098643 954197541 883098612 976494321 874197522 865296432 763197633 844296552 762098733 964395531 863098632 965296431 873197622 865395432)
1 : (864197532)
"Elapsed time: 5186006.193 msecs"