FRACTRAN

fractran.clj

(ns prime
  (:require
    [clojure.math :as math]))


;; エラトステネスの篩で素數列を生成する
(deftype Primes
  [prime numbers]

  clojure.lang.ISeq

  ;; cons は意味を成さない
  (cons [this o] nil)


  (first [this] prime)


  (more
    [this]
    (let [[[prime] numbers] (->> numbers
                                 (filter #(not (zero? (mod % prime))))
                                 (split-at 1))]
      (Primes. prime numbers)))


  (next
    [this]
    (let [[[prime] numbers] (->> numbers
                                 (filter #(not (zero? (mod % prime))))
                                 (split-at 1))]
      (Primes. prime numbers)))


  (seq [this] this))


(def primes
  "エラトステネスの篩で素數列を生成する"
  (Primes. 2 (drop 2 (range))))


(defn composite
  "素因數の指數列から自然數を復元する
   例へば [1 1 0 1] は 42
   例へば [0 1 0 0 0 0 0 1] は 57"
  [factors]
  (->> factors
       (map vector primes)
       (map (fn [[l r]] (math/pow l r)))
       (reduce (fn [l r] (* l r)))
       int))


(defn factorization
  "素因數分解し、指數を素數列の昇順に竝べた列
   例へば 42 は [1 1 0 1]
   例へば 57 は [0 1 0 0 0 0 0 1]"
  [n]
  (loop [factors []
         primes primes
         n n]
    (let [prime (first primes)]
      (if (= n 1)
        ;; (if (empty? factors) [0] factors)
        factors
        (let [[factor n] (loop [factor 0
                                n n]
                           (if (zero? (mod n prime))
                             (recur (inc factor)
                                    (/ n prime))
                             [factor n]))]
          (recur (conj factors factor)
                 (drop 1 primes)
                 n))))))


(defn product
  "積
   [0 2 0 3] と [5 1] の積は [5 3 0 3]"
  [l r]
  (map (fn [i] (+ (nth l i 0) (nth r i 0)))
       (range (max (count l) (count r)))))


(ns rational
  "素因數分解された分子と分母の組
   2/3 = [[1] [0 1]]")


(defn reduction
  "約分"
  [[n d]]
  [(->> n
        (map vector (range))
        (map (fn [[i nf]] (let [df (nth d i 0)] (max (- nf df) 0))))
        reverse
        (drop-while #(= 0 %))
        reverse)
   (->> d
        (map vector (range))
        (map (fn [[i df]] (let [nf (nth n i 0)] (max (- df nf) 0))))
        reverse
        (drop-while #(= 0 %))
        reverse)])


(defn clj->rational
  "Clojure の有理數から、素因數分解された有理數に變換する"
  [clj-rational]
  [(prime/factorization (if (integer? clj-rational) clj-rational (numerator clj-rational)))
   (prime/factorization (if (integer? clj-rational) 1 (denominator clj-rational)))])


(defn rational->clj
  "素因數分解された有理數から、Clojure の有理數に變換する"
  [[n d]]
  (/ (prime/composite n) (prime/composite d)))


(defn product
  "積"
  [[ln ld] [rn rd]]
  (reduction [(prime/product ln rn)
              (prime/product ld rd)]))


(defn integerr?
  "整數? 分母が 1?"
  [[n d]]
  (= (count d) 0))


(ns fractran
  (:require
    [clojure.math :as math]))


(defn- fractran-in-rational
  ""
  [program input]
  (->> program
       (map #(rational/product % input))
       (filter #(rational/integerr? %))
       first
       ((fn [n]
          (if (nil? n)
            input
            (fractran-in-rational program n))))))


(defn fractran
  "FRACTRAN.
   https://ja.wikipedia.org/wiki/FRACTRAN"
  [program input]
  (nth (fractran-in-rational (map rational/clj->rational program)
                             [input []])
       0))


(ns user)


(defn eval-print-fractran
  "FRACTRAN を實行し、結果を表示する"
  [program input]
  (println "program: " program)
  (println "input:   " input)
  (println "output:  " (fractran/fractran program input))
  (println))


(println "加算")
(eval-print-fractran [3/2] [0 0]) ; [0]
(eval-print-fractran [3/2] [0 1]) ; [0 1]
(eval-print-fractran [3/2] [1 0]) ; [0 1]
(eval-print-fractran [3/2] [1 1]) ; [0 2]
(eval-print-fractran [3/2] [2 3]) ; [0 5]
(eval-print-fractran [3/2] [3 2]) ; [0 5]


(println "乘算")
(eval-print-fractran [455/33 11/13 1/11 3/7 11/2 1/3] [0 0]) ; [0]
(eval-print-fractran [455/33 11/13 1/11 3/7 11/2 1/3] [0 1]) ; [0]
(eval-print-fractran [455/33 11/13 1/11 3/7 11/2 1/3] [1 1]) ; [0 0 1]
(eval-print-fractran [455/33 11/13 1/11 3/7 11/2 1/3] [2 3]) ; [0 0 6]
(eval-print-fractran [455/33 11/13 1/11 3/7 11/2 1/3] [3 2]) ; [0 0 6]


(println "除算")
(eval-print-fractran [91/66 11/13 1/33 85/11 57/119 17/19 11/17 1/3] [0 1 0 0 1]) ; [0]
(eval-print-fractran [91/66 11/13 1/33 85/11 57/119 17/19 11/17 1/3] [1 1 0 0 1]) ; [0 0 1]
(eval-print-fractran [91/66 11/13 1/33 85/11 57/119 17/19 11/17 1/3] [7 1 0 0 1]) ; [0 0 7]
(eval-print-fractran [91/66 11/13 1/33 85/11 57/119 17/19 11/17 1/3] [7 2 0 0 1]) ; [0 0 3 1]
(eval-print-fractran [91/66 11/13 1/33 85/11 57/119 17/19 11/17 1/3] [7 3 0 0 1]) ; [0 0 2 1]
(eval-print-fractran [91/66 11/13 1/33 85/11 57/119 17/19 11/17 1/3] [7 4 0 0 1]) ; [0 0 1 3]
(eval-print-fractran [91/66 11/13 1/33 85/11 57/119 17/19 11/17 1/3] [7 5 0 0 1]) ; [0 0 1 2]
(eval-print-fractran [91/66 11/13 1/33 85/11 57/119 17/19 11/17 1/3] [7 6 0 0 1]) ; [0 0 1 1]
(eval-print-fractran [91/66 11/13 1/33 85/11 57/119 17/19 11/17 1/3] [7 7 0 0 1]) ; [0 0 1]
(eval-print-fractran [91/66 11/13 1/33 85/11 57/119 17/19 11/17 1/3] [7 8 0 0 1]) ; [0 0 0 7]