Source code in the clojure programming language

(ns rosettacode.adder
  (:use clojure.test))

(defn xor-gate [a b]
  (or (and a (not b)) (and b (not a))))

(defn half-adder [a b]
  "output: (S C)"
  (cons (xor-gate a b) (list (and a b))))

(defn full-adder [a b c]
  "output: (C S)"
  (let [HA-ca (half-adder c a)
        HA-ca->sb (half-adder (first HA-ca) b)]
    (cons (or (second HA-ca) (second HA-ca->sb))
          (list (first HA-ca->sb)))))

(defn n-bit-adder
  "first bits on the list are low order bits
1 = true
2 = false true
3 = true true
4 = false false true..."
  can add numbers of different bit-length
  ([a-bits b-bits] (n-bit-adder a-bits b-bits false))
  ([a-bits b-bits carry]
  (let [added (full-adder (first a-bits) (first b-bits) carry)]
    (if(and (nil? a-bits) (nil? b-bits))
      (if carry (list carry) '())
      (cons (second added) (n-bit-adder (next a-bits) (next b-bits) (first added)))))))

;use:
(n-bit-adder [true true true true true true] [true true true true true true])
=> (false true true true true true true)


(ns rosetta.fourbit)

;; a bit is represented as a boolean (true/false)
;; a word is a big-endian vector of bits [true false true true] = 11
;; multiple values are returned as vectors

(defn or-gate [a b]
  (or a b))

(defn and-gate [a b]
  (and a b))

(defn not-gate [a]
  (not a))

(defn xor-gate [a b]
  (or-gate (and-gate (not-gate a) b) (and-gate a (not-gate b))))

(defn half-adder [a b]
  "result is [carry sum]"
  (let [carry (and-gate a b)
        sum (xor-gate a b)]
    [carry sum]))

(defn full-adder [a b c0]
  "result is [carry sum]"
  (let [[ca sa] (half-adder c0 a)
        [cb sb] (half-adder sa b)]
    [(or-gate ca cb) sb]))

(defn nbit-adder [va vb]
  "va and vb should be big endian bit vectors of the same size. The result
is a bit vector having one more bit (carry) than args."
  {:pre [(= (count va) (count vb))]}
  (let [[c sums] (reduce (fn [[carry sums] [a b]]
                              (let [[c s] (full-adder a b carry)]
                                [c (conj sums s)]))
                         ;; initial value: false carry and an empty list of sums
                         [false ()]
                         ;; rseq is constant-time reverse for vectors
                         (map vector (rseq va) (rseq vb)))]
    (vec (conj sums c))))

(defn four-bit-adder [a4 a3 a2 a1 b4 b3 b2 b1]
  "Returns [carry s4 s3 s2 s1]"
  (nbit-adder [a4 a3 a2 a1] [b4 b3 b2 b1]))

(comment
(four-bit-adder false true true false  true false true true)
;; [true false false false true]
)


(defn to-binary-seq [^long x]
  (map #(- (int %) (int \0))
       (Long/toBinaryString x)))

(defn half-adder [a b]
  [(bit-xor a b)
   (bit-and a b)])

(defn full-adder [a b carry]
  (let [added (half-adder b carry)
        half-sum (first added)]
    [(first (half-adder a half-sum))
     (bit-or (second (half-adder a half-sum)) (second added))]))

(defn ripple-carry-adder [a b]
  (loop [a (reverse a)
         b (reverse b)
         sum '()
         carry 0]
    (let [added (full-adder (first a) (first b) carry)]
      (if (and (empty? (next a)) (empty? (next b)))
        (conj sum (first added) (bit-or carry 1))
        (recur (next a) (next b) (conj sum (first added)) (second added))))))

(deftest adder
  (is (= (Long/parseLong (apply str (ripple-carry-adder (to-binary-seq 10) (to-binary-seq 10))) 2)
         (+ 10 10)))
  (is (= (Long/parseLong (apply str (ripple-carry-adder (to-binary-seq 50) (to-binary-seq 50))) 2)
         (+ 50 50)))
  (is (= (Long/parseLong (apply str (ripple-carry-adder (to-binary-seq 32) (to-binary-seq 38))) 2)
         (+ 32 38)))
  (is (= (Long/parseLong (apply str (ripple-carry-adder (to-binary-seq 130) (to-binary-seq 250))) 2)
         (+ 130 250))))