├── .gitignore ├── project.clj ├── src └── com │ └── gfredericks │ └── qubits │ ├── examples │ ├── deutsch_jozsa.clj │ ├── bell_violations.clj │ └── key_distribution.clj │ ├── objects.clj │ └── data.clj ├── test └── com │ └── gfredericks │ └── qubits │ └── objects_test.clj └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /lib 3 | /classes 4 | /checkouts 5 | pom.xml 6 | pom.xml.asc 7 | *.jar 8 | *.class 9 | .lein-deps-sum 10 | .lein-failures 11 | .lein-plugins 12 | .lein-repl-history 13 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject qubits "0.1.0-SNAPSHOT" 2 | :description "Qubits in Clojure" 3 | :url "https://github.com/fredericksgary/qubits" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :dependencies [[org.clojure/clojure "1.6.0"] 7 | [com.gfredericks/z "0.1.3"]]) 8 | -------------------------------------------------------------------------------- /src/com/gfredericks/qubits/examples/deutsch_jozsa.clj: -------------------------------------------------------------------------------- 1 | (ns com.gfredericks.qubits.examples.deutsch-jozsa 2 | "http://en.wikipedia.org/wiki/Deutsch%E2%80%93Jozsa_algorithm" 3 | (:require [com.gfredericks.qubits.objects :as q])) 4 | 5 | ;; 6 | ;; Function constructors 7 | ;; 8 | 9 | (defn constant-zero 10 | [inputs output] 11 | ;; noop 12 | ) 13 | 14 | (defn constant-one 15 | [inputs output] 16 | (q/X output)) 17 | 18 | (defn odd-inputs 19 | [inputs output] 20 | (doseq [input inputs] 21 | (q/X output input))) 22 | 23 | (defn even-inputs 24 | [inputs output] 25 | (odd-inputs inputs output) 26 | (q/X output)) 27 | 28 | ;; 29 | ;; Deutsch-Jozsa circuit 30 | ;; 31 | 32 | (defn deutsch-jozsa 33 | "Returns :constant or :balanced." 34 | [f bit-count] 35 | (let [inputs (vec (repeatedly bit-count q/qubit)) 36 | output (q/qubit)] 37 | (doseq [input inputs] (q/H input)) 38 | (q/X output) 39 | (q/H output) 40 | (f inputs output) 41 | (doseq [input inputs] (q/H input)) 42 | (case (q/observe (first inputs)) 43 | 0 :constant 44 | 1 :balanced))) 45 | 46 | (comment 47 | (deutsch-jozsa constant-one 3) => :constant 48 | (deutsch-jozsa constant-zero 3) => :constant 49 | (deutsch-jozsa odd-inputs 3) => :balanced 50 | (deutsch-jozsa even-inputs 3) => :balanced 51 | ) 52 | -------------------------------------------------------------------------------- /src/com/gfredericks/qubits/examples/bell_violations.clj: -------------------------------------------------------------------------------- 1 | (ns com.gfredericks.qubits.examples.bell-violations 2 | (:require [com.gfredericks.qubits.objects :refer :all])) 3 | 4 | ;; 5 | ;; CHSH game 6 | ;; 7 | ;; Following along clumsily with 8 | ;; http://blog.sigfpe.com/2010/11/beating-odds-with-entangled-qubits.html 9 | ;; 10 | 11 | ;; 12 | ;; The main idea is that Alice and Bob are playing a "game" where they 13 | ;; each receive a single bit (x for Alice and y for Bob) and are 14 | ;; expected to individually choose bits a (from Alice) and b (from 15 | ;; Bob), without communicating, and they win the game iff 16 | ;; (= (bit-and x y) (bit-xor a b)). 17 | ;; 18 | ;; Supposedly the best Alice and Bob can do classically (assuming x 19 | ;; and y are uniform and independent) is to win 75% of the time. They 20 | ;; can trivially do this by always outputting a=0 and b=0. People say 21 | ;; it is "easy" to prove that they can't do any better, even with 22 | ;; shared randomness, but I haven't tried. 23 | ;; 24 | 25 | ;; Here's the code for the classical game, showing a 75% win rate with 26 | ;; the zeros strategy: 27 | 28 | (def classical-alice (constantly 0)) 29 | (def classical-bob (constantly 0)) 30 | 31 | (defn play-classical 32 | [] 33 | (let [x (rand-int 2) 34 | y (rand-int 2)] 35 | (= (bit-and x y) 36 | (bit-xor (classical-alice x) (classical-bob y))))) 37 | 38 | (defn report 39 | [{t true, f false}] 40 | (format "%.3f%%" (double (* 100 (/ t (+ f t)))))) 41 | 42 | (comment 43 | (report (frequencies (repeatedly 100000 play-classical))) 44 | ;; => "75.076%" 45 | ) 46 | 47 | ;; 48 | ;; The interesting part is that they can do better than 75% if they each 49 | ;; have half of a pair of entangled qubits. They each manipulate their 50 | ;; qubit in a particular way depending on the value of x/y, and then 51 | ;; observe the value of the qubit, outputting the result directly. 52 | ;; 53 | ;; Through some trigonometric magic that I don't understand, this can 54 | ;; give them a win rate of ~85%. 55 | ;; 56 | 57 | (def TAU (* 2 Math/PI)) ; of course 58 | 59 | ;; Alice and Bob's strategies are the same except for the angles they 60 | ;; use in the phase gate. 61 | 62 | (defn quantum-alice 63 | [q x] 64 | (observe 65 | (doto q 66 | S 67 | H 68 | (phase (case x 69 | 0 0 70 | 1 (/ TAU 4))) 71 | H 72 | S))) 73 | 74 | (defn quantum-bob 75 | [q y] 76 | (let [TAU8 (/ TAU 8)] 77 | (observe 78 | (doto q 79 | S 80 | H 81 | (phase (case y 82 | 0 TAU8 83 | 1 (- TAU8))) 84 | H 85 | S)))) 86 | 87 | (defn bell-qubits 88 | "Returns a pair of entangled qubits, a superposition of [0 0] and [1 1]." 89 | [] 90 | (qubits [x y] 91 | (H x) 92 | (X y x) 93 | [x y])) 94 | 95 | (defn play-quantum 96 | [] 97 | (let [[q1 q2] (bell-qubits) 98 | x (rand-int 2) 99 | y (rand-int 2)] 100 | (= (bit-and x y) 101 | (bit-xor (quantum-alice q1 x) (quantum-bob q2 y))))) 102 | 103 | (comment 104 | (report (frequencies (repeatedly 1000 play-quantum))) 105 | ;; => "85.800%" 106 | ) 107 | 108 | 109 | 110 | ;; 111 | ;; Mermin-Peres Magic Square Game 112 | ;; 113 | ;; http://en.wikipedia.org/wiki/Quantum_pseudo-telepathy#The_Mermin-Peres_magic_square_game 114 | ;; 115 | 116 | ;; 117 | ;; I can't quite figure this one out. If anybody else could that'd be 118 | ;; cool. 119 | ;; 120 | 121 | (defn alice 122 | [q1 q2 row-num] 123 | {:pre [(#{0 1 2} row-num)]} 124 | ) 125 | 126 | (defn bob 127 | [q1 q2 col-num] 128 | {:pre [(#{0 1 2} col-num)]} 129 | ) 130 | -------------------------------------------------------------------------------- /test/com/gfredericks/qubits/objects_test.clj: -------------------------------------------------------------------------------- 1 | (ns com.gfredericks.qubits.objects-test 2 | (:require [clojure.test :refer :all] 3 | [com.gfredericks.qubits.objects :refer :all])) 4 | 5 | (defn =ish [x y] (< (- x y) 0.0000001)) 6 | (def one? #(= 1 %)) 7 | 8 | (defn probably? 9 | [q p0 p1] 10 | (let [p (probabilities q)] 11 | (and (=ish p0 (p 0)) 12 | (=ish p1 (p 1))))) 13 | 14 | (deftest single-qubit-probabilities-tests 15 | (testing "that qubits start out in the |0> state" 16 | (qubits [q] 17 | (is (probably? q 1 0)))) 18 | (testing "that the X gate puts a qubit in the |1> state" 19 | (qubits [q] 20 | (X q) 21 | (is (probably? q 0 1)))) 22 | (testing "that the Z gate doesn't change initial probabilities" 23 | (qubits [q] 24 | (Z q) 25 | (is (probably? q 1 0)))) 26 | (testing "that the Y gate flips the initial probabilities" 27 | (qubits [q] 28 | (Y q) 29 | (is (probably? q 0 1)))) 30 | (testing "that the H gate gives equal probabilities" 31 | (qubits [q] 32 | (H q) 33 | (is (probably? q 1/2 1/2)))) 34 | (testing "that two H gates reverts to initial probabilities" 35 | (qubits [q] 36 | (H q) 37 | (H q) 38 | (is (probably? q 1 0)))) 39 | (testing "that two H gates with a Z or a Y in between reverses probabilities" 40 | (are [G] (qubits [q] 41 | (doto q H G H) 42 | (probably? q 0 1)) 43 | Z 44 | Y)) 45 | (testing "that H Y Z H reverts to initial probabilities" 46 | (qubits [q] 47 | (doto q H Y Z H) 48 | (is (probably? q 1 0))))) 49 | 50 | (deftest single-qubit-observation-tests 51 | (testing "That qubits with single possibilities observe correctly." 52 | (qubits [q] 53 | (is (zero? (observe q))) 54 | (X q) 55 | (is (one? (observe q))))) 56 | (testing "That observing a qubit after an H gives sane probabilities." 57 | (qubits [q] 58 | (H q) 59 | (is (case (observe q) 60 | 0 (probably? q 1 0) 61 | 1 (probably? q 0 1))) 62 | ;; doing this twice as a regression test (a bug failed it) 63 | (is (case (observe q) 64 | 0 (probably? q 1 0) 65 | 1 (probably? q 0 1)))))) 66 | 67 | (deftest multiple-qubit-probability-tests 68 | (testing "that we can entangle two qubits" 69 | (qubits [a b] 70 | (H a) 71 | (X b a) 72 | (is (probably? a 1/2 1/2)) 73 | (is (probably? b 1/2 1/2)) 74 | (let [va (observe a)] 75 | (is (case va 76 | 0 (probably? b 1 0) 77 | 1 (probably? b 0 1))) 78 | (is (= (observe b) va))))) 79 | (testing "This complicated thing that I worked up in my circuit app" 80 | (qubits [a b] 81 | (H a) 82 | (Y b a) 83 | (Z b a) 84 | (Y b a) 85 | (H a) 86 | (is (probably? a 0 1)))) 87 | (testing "I think this tests that I defined Y correctly rather than backwards" 88 | (qubits [a b] 89 | (H a) 90 | (Y b a) 91 | ;; these next four should be equivalent to undoing Y 92 | (S b a) 93 | (S b a) 94 | (S b a) 95 | (X b a) 96 | (H a) 97 | (is (probably? a 1 0)))) 98 | 99 | (testing "Quantum teleportation" 100 | (qubits [source b1 b2] 101 | ;; initialize the source in an arbitrary state 102 | (doto source H T H) 103 | (is (probably? source 0.8535533905932735 0.14644660940672616)) 104 | (is (probably? b2 1 0)) 105 | ;; create the EPR pair 106 | (H b1) 107 | (X b2 b1) 108 | (is (probably? b2 1/2 1/2)) 109 | ;; do the entangling thing 110 | (X b1 source) 111 | (H source) 112 | ;; observe 113 | (let [bit-source (observe source) 114 | bit-b1 (observe b1)] 115 | ;; modify b2 based on observations 116 | (when (one? bit-b1) 117 | (X b2)) 118 | (when (one? bit-source) 119 | (Z b2))) 120 | ;; check; this doesn't quite capture everything, as the Z above 121 | ;; can be skipped and this test wouldn't notice. Oh well. 122 | (is (probably? b2 0.8535533905932735 0.14644660940672616))))) 123 | 124 | 125 | (deftest deterministic-value-test 126 | (qubits [q] 127 | (is (= 0 (deterministic-value q))) 128 | (X q) 129 | (is (= 1 (deterministic-value q))) 130 | (H q) 131 | (is (nil? (deterministic-value q))) 132 | (let [outcome (observe q)] 133 | (is (= outcome (deterministic-value q)))))) 134 | -------------------------------------------------------------------------------- /src/com/gfredericks/qubits/objects.clj: -------------------------------------------------------------------------------- 1 | (ns com.gfredericks.qubits.objects 2 | "Qubits as Objects." 3 | (:require [com.gfredericks.qubits.data :as data])) 4 | 5 | (declare deterministic-value) 6 | 7 | (deftype Qubit [name system] 8 | Object 9 | (toString [this] 10 | (format "#" 11 | name 12 | (str (or (deterministic-value this) \?))))) 13 | 14 | (defmethod print-method Qubit 15 | [q ^java.io.Writer w] 16 | (.write w (str q))) 17 | 18 | (defn init-system 19 | "Initializes a qubit to 0 inside its own system." 20 | [^Qubit q] 21 | (let [system (data/single-qubit-system q 0)] 22 | (dosync 23 | (alter (.system q) (constantly system))) 24 | (set-validator! (.system q) data/system?))) 25 | 26 | (defn qubit 27 | ([] (qubit (gensym "qubit-"))) 28 | ([name'] 29 | (doto (->Qubit (name name') (ref nil)) 30 | (init-system)))) 31 | 32 | (defmacro qubits 33 | "Macro for creating new qubits with the same name as their local bindings. 34 | E.g.: 35 | 36 | (qubits [a b c] 37 | (some) 38 | (functions)) 39 | 40 | creates three qubits named \"a\" \"b\" and \"c\", binds them to the locals 41 | a, b, and c, and executes the body." 42 | [name-vector & body] 43 | {:pre [(vector? name-vector) 44 | (every? symbol? name-vector)]} 45 | `(let [~@(mapcat (juxt identity (fn [name] `(qubit ~(str name)))) 46 | name-vector)] 47 | ~@body)) 48 | 49 | (defn probabilities 50 | "Returns a map like {0 p1, 1 p2}." 51 | [^Qubit q] 52 | (data/probabilities @(.system q) q)) 53 | 54 | (defn deterministic-value 55 | "Given a qubit, returns a 0 or a 1 if it has a deterministic value, 56 | or nil otherwise." 57 | [^Qubit q] 58 | (data/deterministic-value @(.system q) q)) 59 | 60 | (defn update-system-pointers! 61 | "Given a system-map, updates all the .system refs of the :qubits 62 | list to point to that map." 63 | [system] 64 | (doseq [^Qubit q (:qubits system)] 65 | (alter (.system q) (constantly system)))) 66 | 67 | (defn merge-systems! 68 | "Updates the system properties of the qubits so that they are all 69 | together." 70 | [qs] 71 | (dosync 72 | (let [systems (distinct (map (fn [^Qubit q] @(.system q)) qs))] 73 | (when (> (count systems) 1) 74 | (let [system (reduce data/merge-systems systems)] 75 | (update-system-pointers! system)))))) 76 | 77 | (defn single-qubit-gate-fn 78 | "Given a gate definition [[a b] [c d]], returns a function that 79 | takes a primary qubit and optional control qubits and executes 80 | the gate on it." 81 | [gate] 82 | (fn [^Qubit q & controls] 83 | (dosync 84 | (when (seq controls) 85 | (merge-systems! (cons q controls))) 86 | (let [new-system (data/apply-single-qubit-gate gate @(.system q) q controls)] 87 | (update-system-pointers! new-system))) 88 | q)) 89 | 90 | (let [g data/single-qubit-gates] 91 | (def X (single-qubit-gate-fn (g :X))) 92 | (def Y (single-qubit-gate-fn (g :Y))) 93 | (def Z (single-qubit-gate-fn (g :Z))) 94 | (def S (single-qubit-gate-fn (g :S))) 95 | (def T (single-qubit-gate-fn (g :T))) 96 | (def H (single-qubit-gate-fn (g :H)))) 97 | 98 | (defn phase 99 | [q theta & controls] 100 | (apply (single-qubit-gate-fn (data/phase-gate theta)) q controls)) 101 | 102 | (defn observe 103 | "Returns 0 or 1." 104 | [^Qubit q] 105 | (dosync 106 | (let [[outcome new-system] (data/observe @(.system q) q)] 107 | ;; if the qubit was previously entangled, detangle it 108 | (if (> (count (:qubits new-system)) 1) 109 | (let [new-system-1 (data/factor-qubit-from-system new-system q) 110 | new-system-2 (data/single-qubit-system q outcome)] 111 | (update-system-pointers! new-system-1) 112 | (update-system-pointers! new-system-2)) 113 | (update-system-pointers! new-system)) 114 | outcome))) 115 | 116 | (defn measure-along-axis 117 | "Measures the qubit along the :X, :Y, or :Z axis of the bloch sphere." 118 | [q axis] 119 | (case axis 120 | :Z (observe q) 121 | :X (do (H q) (let [res (observe q)] (H q) res)) 122 | :Y (do (doto q S H) (let [res (observe q)] (doto q H S) res)))) 123 | 124 | (defn characterize 125 | "Given a function that repeatedly returns new qubits in the 126 | same (presumably unentangled) state, measures them n times along 127 | each axis and returns a map containing the average value (i.e., the 128 | proportion of the time that the measurement was 1). For qubits in a 129 | pure (unentangled) state, the result should statistically completely 130 | characterize the state." 131 | [qubit-source n] 132 | (into {} 133 | (for [axis [:X :Y :Z]] 134 | [axis (-> (->> (repeatedly n qubit-source) 135 | (map #(measure-along-axis % axis)) 136 | (filter #{1}) 137 | (count)) 138 | (/ n) 139 | (double))]))) 140 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # qubits 2 | 3 | Spooky action at a distance, in your repl! 4 | 5 | Below is a basic introduction. There are also some more involved 6 | examples in [`/src/com/gfredericks/qubits/examples`](https://github.com/fredericksgary/qubits/tree/master/src/com/gfredericks/qubits/examples). 7 | 8 | ## Hey okay let me have some of these qubits 9 | 10 | Alright let's see. 11 | 12 | ``` clojure 13 | (require '[com.gfredericks.qubits.objects :refer :all]) 14 | 15 | (def foo (qubit "foo")) 16 | 17 | ;; here is the qubit we just made 18 | foo 19 | => # 20 | 21 | ;; we can ask for its value 22 | (observe foo) 23 | => 0 24 | 25 | ;; and again if we like 26 | (observe foo) 27 | => 0 28 | ``` 29 | 30 | ### Can I do anything interesting with this qubit? 31 | 32 | There are a few "gates" that we can send the qubit through to 33 | potentially change its state. 34 | 35 | ``` clojure 36 | ;; The "X" gate changes the 0 value to 1 and vice versa. It's a "NOT" 37 | (X foo) 38 | => # 39 | 40 | (X foo) 41 | => # 42 | 43 | ;; The "Z" gate flip's the qubit's phase. What the hell does that mean? 44 | ;; It doesn't seem to have any effect. 45 | (Z foo) 46 | => # 47 | 48 | (doto foo Z Z Z Z Z) 49 | => # 50 | 51 | ;; Well nevermind that for now. 52 | 53 | ;; The H gate is trickier. If the qubit has a value of 0, it puts it into 54 | ;; equal superposition of 0 and 1. 55 | (H foo) 56 | => # 57 | 58 | ;; We can observe it to force it to decide its value: 59 | (observe foo) 60 | => 1 61 | 62 | foo 63 | => # 64 | 65 | ;; Repeated observations give the same value 66 | (repeatedly 20 #(observe foo)) 67 | => (1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1) 68 | 69 | ;; But repeated applications of the H gate followed by an observation 70 | ;; are nondeterministic 71 | (repeatedly 20 #(-> foo H observe)) 72 | => (1 1 1 0 0 0 0 0 1 1 0 1 1 0 1 1 1 1 0 0) 73 | 74 | ;; But but but! What if we do two H gates in a row before observing? 75 | (repeatedly 20 #(-> foo H H observe)) 76 | => (1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1) 77 | 78 | ;; How about three of them? 79 | (repeatedly 20 #(-> foo H H H observe)) 80 | => (1 1 0 1 1 0 1 1 1 0 1 1 0 0 1 1 0 0 0 0) 81 | 82 | ;; Or what if we observe in between two H's? 83 | (repeatedly 20 #(-> foo H (doto observe) H observe)) 84 | => (0 1 0 0 0 1 1 0 0 0 1 0 0 0 1 1 0 1 0 0) 85 | ``` 86 | 87 | ### WAT 88 | 89 | Look I don't have time to make sense of all that. Let's try entangling 90 | some qubits! 91 | 92 | ``` clojure 93 | ;; We'll start off with a fresh pair of qubits. 94 | (def foo (qubit "foo")) 95 | (def bar (qubit "bar")) 96 | 97 | [foo bar] 98 | => [# #] 99 | 100 | ;; So they're both starting off 0 101 | (map observe [foo bar]) 102 | => (0 0) 103 | 104 | ;; Now these gates we were using before can take extra arguments, 105 | ;; which are controls -- the gate is only effective when all the 106 | ;; controls have a value of 1. 107 | 108 | ;; This X has no effect since bar is 0 109 | (X foo bar) 110 | => # 111 | 112 | [foo bar] 113 | => [# #] 114 | 115 | ;; But if we change bar to 1 first: 116 | (X bar) 117 | => # 118 | 119 | ;; And then try it: 120 | (X foo bar) 121 | => # 122 | 123 | [foo bar] 124 | => [# #] 125 | 126 | ;; Okay so then let's set them back to 0: 127 | (X foo) 128 | # 129 | (X bar) 130 | # 131 | 132 | ;; Now we put the foo qubit in a superposition. 133 | (H foo) 134 | # 135 | 136 | ;; Just to check what's going on, we can ask for its observation probabilities 137 | (probabilities foo) 138 | => {0 0.4999999999999999, 1 0.4999999999999999} ; 50/50, modulo some floating point nonsense 139 | 140 | ;; whereas bar is still hanging out at 0: 141 | (probabilities bar) 142 | => {0 1.0, 1 0} 143 | 144 | ;; Now let's flip bar's value with foo (who is in superposition) as the control: 145 | (X bar foo) 146 | => # 147 | 148 | [foo bar] 149 | => [# #] 150 | 151 | (probabilities foo) 152 | => {0 0.4999999999999999, 1 0.4999999999999999} 153 | 154 | (probabilities bar) 155 | => {0 0.4999999999999999, 1 0.4999999999999999} 156 | 157 | ;; So they're both in a superposition. But because bar's value depends on foo, 158 | ;; they're effectively entangled. Observing one will necessarily effect the 159 | ;; possible observations of the other. 160 | 161 | ;; observing foo tells us what its value was when the X gate was applied to bar -- 162 | ;; i.e., we learn whether or not the X gate was actually applied 163 | (observe foo) 164 | => 1 165 | 166 | ;; Since we observed a 1, we know the X gate _was_ applied, so bar should be 1 167 | ;; as well 168 | (observe bar) 169 | => 1 170 | 171 | [foo bar] 172 | => [# #] 173 | 174 | ;; The qubits are no longer entangled. 175 | 176 | ;; To confirm that we didn't get the same outcome from both 177 | ;; observations by chance, we can do it a few times: 178 | 179 | (repeatedly 10 (fn [] 180 | ;; using fresh qubits here to make sure they start off 0 181 | (qubits [q1 q2] 182 | (H q1) 183 | (X q2 q1) 184 | (map observe [q1 q2])))) 185 | => ((0 0) (0 0) (1 1) (0 0) (0 0) (1 1) (0 0) (1 1) (0 0) (1 1)) 186 | ``` 187 | 188 | ### ... 189 | 190 | I dunno man look play around with it yourself and see if it makes any 191 | more sense. 192 | 193 | ## License 194 | 195 | Copyright © 2013 Gary Fredericks 196 | 197 | Distributed under the Eclipse Public License, the same as Clojure. 198 | -------------------------------------------------------------------------------- /src/com/gfredericks/qubits/data.clj: -------------------------------------------------------------------------------- 1 | (ns com.gfredericks.qubits.data 2 | "The logical underpinnings." 3 | (:require [com.gfredericks.z :as z] 4 | [com.gfredericks.z.impl :refer [IComplex]])) 5 | 6 | (def ^:const TAU (* 2 Math/PI)) 7 | 8 | ;; it feels messy to need indexOf. Should we be using maps instead? 9 | ;; 10 | ;; For that matter should we be using the term "PureState" instead of 11 | ;; "system"? 12 | (defn index-of 13 | [^clojure.lang.APersistentVector v x] 14 | (.indexOf v x)) 15 | 16 | (defn amplitude->probability 17 | [c] 18 | (let [m (z/magnitude c)] (* m m))) 19 | 20 | (defn system? 21 | "Checks that m looks roughly like a decent system map." 22 | [m] 23 | (and (vector? (:qubits m)) 24 | (map? (:amplitudes m)) 25 | (every? (fn [[vals amp]] 26 | (and (vector? vals) 27 | (every? #{0 1} vals) 28 | (satisfies? IComplex amp))) 29 | (:amplitudes m)))) 30 | 31 | (defn single-qubit-system 32 | "Given a qubit and a 0/1, returns a system map that consists of just 33 | that qubit in the |0> state or the |1> state." 34 | [q v] 35 | {:pre [(#{0 1} v)]} 36 | {:qubits [q] 37 | :amplitudes {[v] z/ONE}}) 38 | 39 | (defn merge-systems 40 | "Given two system maps, returns a new map with the systems merged." 41 | [system1 system2] 42 | (let [qs (into (:qubits system1) (:qubits system2))] 43 | (assert (apply distinct? qs) "Why do these systems already overlap?") 44 | (let [amplitudes 45 | (for [[vs amp] (:amplitudes system1) 46 | [vs' amp'] (:amplitudes system2)] 47 | [(into vs vs') (z/* amp amp')])] 48 | {:qubits qs, :amplitudes (into {} amplitudes)}))) 49 | 50 | (defn vec-remove 51 | [v i] 52 | (cond (zero? i) 53 | (subvec v 1) 54 | 55 | (= i (dec (count v))) 56 | (pop v) 57 | 58 | :else 59 | (into (subvec v 0 i) (rest (drop i v))))) 60 | 61 | (defn factor-qubit-from-system 62 | "Given a system of at least two qubits, and one of the qubits from 63 | that system, returns a new system without that qubit. The given 64 | qubit must (currently) have only one possible value, so it can be 65 | assumed to be unentangled." 66 | [system q] 67 | (let [{:keys [qubits amplitudes]} system 68 | qi (index-of qubits q)] 69 | (assert (> (count qubits) 1)) 70 | ;; check that it has the same value in all cases 71 | (assert (apply = (map #(% qi) (keys amplitudes)))) 72 | (let [amplitudes' (into {} 73 | (for [[vals amp] amplitudes] 74 | [(vec-remove vals qi) amp]))] 75 | {:qubits (vec-remove qubits qi) 76 | :amplitudes amplitudes'}))) 77 | 78 | (defn probabilities 79 | [system q] 80 | (let [{:keys [qubits amplitudes]} system 81 | i (index-of qubits q)] 82 | (reduce 83 | (fn [ret [vals amp]] 84 | (update-in ret [(nth vals i)] + 85 | (amplitude->probability amp))) 86 | {0 0, 1 0} 87 | amplitudes))) 88 | 89 | (defn ^:private zeroish? [z] (< (z/magnitude z) 1e-10)) 90 | 91 | (defn apply-single-qubit-gate 92 | "Gate is in the form [[a b] [c d]]. Returns a new system map." 93 | [gate system q controls] 94 | {:post [(system? %)]} 95 | (let [{:keys [qubits amplitudes]} system 96 | qi (index-of qubits q) 97 | controls-i (map #(index-of qubits %) controls) 98 | 99 | new-amplitudes 100 | (->> (for [[vals amp] amplitudes 101 | :let [control-vals (map vals controls-i)]] 102 | (if (every? #{1} control-vals) 103 | (let [q-val (vals qi) 104 | [amp0 amp1] (gate q-val)] 105 | {(assoc vals qi 0) (z/* amp0 amp) 106 | (assoc vals qi 1) (z/* amp1 amp)}) 107 | {vals amp})) 108 | (apply merge-with z/+) 109 | (remove (comp zeroish? val)) 110 | (into {}))] 111 | (assoc system :amplitudes new-amplitudes))) 112 | 113 | (defn ^:private weighted-choice 114 | "Given a sequence of [x w], chooses an x with probability 115 | governed by the weights w." 116 | [pairs] 117 | (let [total (apply + (map second pairs)) 118 | z (rand total)] 119 | (loop [[[x w] & more] pairs, z z] 120 | (if (or (empty? more) (< z w)) 121 | x 122 | (recur more (- z w)))))) 123 | 124 | (defn observe 125 | "Given a system map and one of the qubits in the system, 126 | chooses a measurement outcome according to the current 127 | probabilities, and returns [outcome new-system]." 128 | [system qubit] 129 | (let [{:keys [qubits amplitudes]} system 130 | qi (index-of qubits qubit) 131 | vals (weighted-choice 132 | (for [[vals amp] amplitudes] 133 | [vals (amplitude->probability amp)])) 134 | v (vals qi) 135 | 136 | filtered-amps 137 | (filter (fn [[vals _]] (= v (vals qi))) amplitudes) 138 | 139 | normalizer (->> filtered-amps 140 | (map second) 141 | (map amplitude->probability) 142 | (apply +)) 143 | 144 | new-amplitudes 145 | (for [[vals amp] filtered-amps] 146 | [vals (z/* amp (-> normalizer Math/sqrt / z/real->z))])] 147 | [v (assoc system :amplitudes (into {} new-amplitudes))])) 148 | 149 | (def single-qubit-gates 150 | (let [z0 z/ZERO 151 | z1 z/ONE 152 | zi z/I 153 | -zi (z/- zi) 154 | -z1 (z/- z1) 155 | inv-root2 (z/real->z (/ (Math/sqrt 2))) 156 | -inv-root2 (z/- inv-root2)] 157 | {:X [[z0 z1] [z1 z0]] 158 | :Y [[z0 zi] [-zi z0]] 159 | :Z [[z1 z0] [z0 -z1]] 160 | :S [[z1 z0] [z0 zi]] 161 | :T [[z1 z0] [z0 (z/polar->z 1 (/ TAU 8))]] 162 | :H [[inv-root2 inv-root2] [inv-root2 -inv-root2]]})) 163 | 164 | (defn phase-gate 165 | [theta] 166 | (assoc-in (single-qubit-gates :Z) [1 1] (z/polar->z 1 theta))) 167 | 168 | (defn deterministic-value 169 | "If q has a deterministic value in the system, return it (0 or 1); 170 | else return nil." 171 | [system q] 172 | (let [{:keys [qubits amplitudes]} system 173 | qi (index-of qubits q) 174 | vals (->> amplitudes 175 | keys 176 | (map #(% qi)))] 177 | (if (apply = vals) (first vals)))) 178 | -------------------------------------------------------------------------------- /src/com/gfredericks/qubits/examples/key_distribution.clj: -------------------------------------------------------------------------------- 1 | (ns com.gfredericks.qubits.examples.key-distribution 2 | (:require [com.gfredericks.qubits.objects :refer :all])) 3 | 4 | ;; 5 | ;; Quantum Key Distribution is a protocol that allows Alice and Bob to 6 | ;; establish a random shared secret key, using quantum mechanics to 7 | ;; give them an arbitrarily high likelihood of detecting evesdropping. 8 | ;; 9 | 10 | ;; First some background. We need to introduce the idea of making 11 | ;; different kinds of observations on a qubit. Our traditional 12 | ;; function (com.gfredericks.qubits.object/observe) measures what 13 | ;; we'll call the "value" of the qubit. Here we make a function that 14 | ;; instead measures its "sign". We can implement it using the normal 15 | ;; observation function by manipulating the qubit before observation, 16 | ;; and then undoing that manipulation afterwards: 17 | 18 | (defn observe-sign 19 | [q] 20 | (H q) 21 | (let [outcome (observe q)] 22 | (H q) 23 | (case outcome 0 :+ 1 :-))) 24 | 25 | ;; We also make constructors for four different qubit states that 26 | ;; we'll care about: 27 | 28 | (defn zero [] (qubit)) 29 | (defn one [] (doto (qubit) (X))) 30 | (defn plus [] (doto (qubit) (H))) 31 | (defn minus [] (doto (one) (H))) 32 | 33 | ;; Let's also make an easy way to get statistical information about 34 | ;; qubit states 35 | 36 | (defmacro sample 37 | [times & body] 38 | `(frequencies (repeatedly ~times (fn [] ~@body)))) 39 | 40 | ;; Now we can demonstrate how these four states relate to our two 41 | ;; different observation functions. The zero/one functions represent 42 | ;; qubits with particular "values", so when we observe their value 43 | ;; the result is deterministic: 44 | 45 | (comment 46 | (sample 1000 (observe (zero))) 47 | ;; => {0 1000} 48 | (sample 1000 (observe (one))) 49 | ;; => {1 1000} 50 | ) 51 | 52 | ;; But when we observe their sign the result is random: 53 | 54 | (comment 55 | (sample 1000 (observe-sign (zero))) 56 | ;; => {:- 504, :+ 496} 57 | (sample 1000 (observe-sign (one))) 58 | ;; => {:- 491, :+ 509} 59 | ) 60 | 61 | ;; Conversely, the plus/minus states are nondeterministic when we 62 | ;; observe their values: 63 | 64 | (comment 65 | (sample 1000 (observe (plus))) 66 | ;; => {0 469, 1 531} 67 | (sample 1000 (observe (minus))) 68 | ;; => {0 487, 1 513} 69 | ) 70 | 71 | ;; But deterministic when we observe their sign: 72 | 73 | (comment 74 | (sample 1000 (observe-sign (plus))) 75 | ;; => {:+ 1000} 76 | (sample 1000 (observe-sign (minus))) 77 | ;; => {:- 1000} 78 | ) 79 | 80 | ;; Just like the value observation function, repeated observations 81 | ;; of the sign will yield the same result, even if the first one 82 | ;; was nondeterministic: 83 | 84 | (comment 85 | (let [q (zero)] 86 | [(observe-sign q) 87 | (observe-sign q) 88 | (observe-sign q) 89 | (observe-sign q) 90 | (observe-sign q)]) 91 | ;; => [:+ :+ :+ :+ :+] 92 | ) 93 | 94 | ;; When we observe a qubit's sign and see the :+ result, the qubit's 95 | ;; state is now exactly the same as a fresh qubit returned from the 96 | ;; (plus) function, and likewise [:- (minus)], [0 (zero)], and 97 | ;; [1 (one)]. This means if we alternate between different kind of 98 | ;; observations, the results will be repeatedly random: 99 | 100 | (comment 101 | (let [q (zero)] 102 | (map #(% q) (take 20 (cycle [observe-sign observe])))) 103 | ;; => (:+ 1 :- 1 :- 1 :+ 1 :- 1 :- 0 :- 1 :- 0 :+ 0 :- 0) 104 | ) 105 | 106 | ;; So what we've established is that we have two different ways to 107 | ;; measure a qubit, and whichever way we choose causes the qubit to be 108 | ;; maximally undefined with regard to the other measurement. This is, 109 | ;; I think, the essense of the Heisenburg Uncertainty Principle. 110 | 111 | 112 | ;; Now we can describe the protocol. The basic idea is that Alice will 113 | ;; generate some random bits, and then encode those bits in a series 114 | ;; of qubits, where in each case she randomly decides to encode as 115 | ;; either the value of the qubit or the sign. She keeps track of which 116 | ;; way she encoded it for each qubit. 117 | ;; 118 | ;; Then she sends the qubits to Bob, who picks randomly for each one 119 | ;; whether to measure its sign or value, and decodes based on that 120 | ;; random choice. He then sends back to Alice the list of how he 121 | ;; chose to measure each qubit. 122 | ;; 123 | ;; Alice receives that list and compares it to her own to determine 124 | ;; which qubits Bob observed correctly. The incorrect ones can be 125 | ;; tossed since Bob would have just observed a random value. Of the 126 | ;; correct ones, a subset are chosen at random to serve as 127 | ;; verification bits. For these Alice sends the actual bit values to 128 | ;; Bob so he can check that he observed the correct value for them. 129 | ;; If he didn't eavesdropping is assumed and the protocol is aborted. 130 | ;; Otherwise Alice and Bob assume that the correctly-observed bits 131 | ;; that weren't used for verification can function as a shared secret. 132 | 133 | 134 | ;; To the code. I'm going to model Alice and Bob as maps describing 135 | ;; the messages that each actor can receive, where the values are 136 | ;; functions taking two arguments (the current state of the agent and 137 | ;; the message received) and returning a pair (the new state of the 138 | ;; agent and the message to send back). 139 | ;; 140 | ;; The main flow of control (that passes the messages back and forth) 141 | ;; will also function as the evesdropper. Alice and Bob pass both 142 | ;; classical and quantum messages, but since we're dealing with 143 | ;; Objects in both cases we don't really have to distinguish. 144 | 145 | 146 | (def alice-responses 147 | ;; Step 1 of the protocol 148 | {:start 149 | (fn [{:keys [bitcount], :as state} _] 150 | ;; We start by generating some random bits from which the shared 151 | ;; secret will be drawn 152 | (let [bits (repeatedly bitcount #(rand-int 2)) 153 | ;; We also need to pick how to encode each bit, as either 154 | ;; the value or the sign of a qubit 155 | bases (repeatedly bitcount #(rand-nth [:value :sign])) 156 | ;; Here we actually construct the qubits to send to Bob 157 | qubits (map (fn [bit basis] 158 | (case basis 159 | :value 160 | (case bit 0 (zero), 1 (one)) 161 | :sign 162 | (case bit 0 (plus), 1 (minus)))) 163 | bits 164 | bases)] 165 | [(assoc state 166 | :bits bits 167 | :bases bases) 168 | [:qubits qubits]])) 169 | 170 | ;; Step 3 of the protocol -- Bob has just sent the list of bases he 171 | ;; used to measure the qubits we sent. I.e., it is a list like 172 | ;; [:value :value :sign :value ...] 173 | ;; 174 | ;; We're going to compare that to the list of bases we used to 175 | ;; figure out which bits Bob should have measured correctly; then 176 | ;; we'll pick half of those to use as verification bits, and send 177 | ;; the values for those bits to Bob for evesdropping-checking. 178 | :bases 179 | (fn [{:keys [bits bases], :as state} bases-from-bob] 180 | (let [good-indices 181 | ;; First figure out which qubits were measured correctly 182 | (for [[i basis basis-from-bob] (map list (range) bases bases-from-bob) 183 | :when (= basis basis-from-bob)] 184 | i) 185 | 186 | ;; Split the correctly measured qubits into verification 187 | ;; and key groups 188 | [verification-indices key-indices] 189 | (->> good-indices 190 | (shuffle) 191 | (split-at (quot (count good-indices) 2)) 192 | (map sort)) 193 | 194 | ;; Assemble the verification message 195 | verification (into {} (for [i verification-indices] 196 | [i (nth bits i)]))] 197 | [(assoc state 198 | :key-indices key-indices) 199 | [:verify {:verification verification 200 | :key-indices key-indices}]])) 201 | 202 | ;; Step 5 just prints a success message. 203 | :success 204 | (fn [{:keys [key-indices bits]} _] 205 | (let [key-bits (map #(nth bits %) key-indices)] 206 | (println "Alice succeeds with: " key-bits))) 207 | :abort (constantly nil)}) 208 | 209 | (def bob-responses 210 | ;; Step 2 of the protocol -- Alice has just sent the qubits. 211 | {:qubits 212 | (fn [state qubits] 213 | (let [bitcount (count qubits) 214 | ;; Randomly pick how to measure the qubits 215 | bases (repeatedly bitcount #(rand-nth [:value :sign])) 216 | ;; Do the measurements 217 | bits (map (fn [qubit basis] 218 | (case basis 219 | :value 220 | (case (observe qubit) 0 0, 1 1) 221 | :sign 222 | (case (observe-sign qubit) :+ 0, :- 1))) 223 | qubits 224 | bases)] 225 | ;; Send back to Alice the information about how we measured the 226 | ;; qubits 227 | [(assoc state 228 | :bits bits 229 | :bases bases) 230 | [:bases bases]])) 231 | 232 | ;; Step 4: Alice sends back the verification info, and the list of 233 | ;; which qubits to use for the key. We check the verification info 234 | ;; against the values we observed in step 2. 235 | :verify 236 | (fn [{:keys [bits], :as state} {:keys [verification key-indices]}] 237 | (let [error-count (apply + (for [[i v] verification 238 | :when (not= v (nth bits i))] 239 | 1))] 240 | (if (pos? error-count) 241 | [state [:abort error-count]] 242 | (let [key-bits (map #(nth bits %) key-indices)] 243 | (println "Bob succeeds with: " key-bits) 244 | [state [:success nil]]))))}) 245 | 246 | (defn make-actor 247 | "Returns a stateful function that accepts messages and executes the responses." 248 | [responses init-state] 249 | (let [state (atom init-state)] 250 | (fn [[msg body]] 251 | (let [[new-state msg'] ((responses msg) @state body)] 252 | (reset! state new-state) 253 | msg')))) 254 | 255 | ;; The basic runner just passes messages back and forth 256 | (defn run-without-evesdropping 257 | [] 258 | (let [alice (make-actor alice-responses {:bitcount 100}) 259 | bob (make-actor bob-responses {})] 260 | (loop [next-msg [:start nil] 261 | people (cycle [alice bob])] 262 | (println "Sending" (first next-msg)) 263 | (if-let [resp ((first people) next-msg)] 264 | (recur resp (rest people)))))) 265 | 266 | (comment 267 | (run-without-evesdropping) 268 | ;; prints: 269 | ;; Sending :start 270 | ;; Sending :qubits 271 | ;; Sending :bases 272 | ;; Sending :verify 273 | ;; Bob succeeds with: (0 1 1 1 0 0 0 1 0 1 1 1 0 0 0 0 1 1 0 0 1 1 1) 274 | ;; Sending :success 275 | ;; Alice succeeds with: (0 1 1 1 0 0 0 1 0 1 1 1 0 0 0 0 1 1 0 0 1 1 1) 276 | ) 277 | 278 | ;; This is just like run-without-evesdropping except we observe the 279 | ;; qubits in transit 280 | (defn run-with-evesdropping 281 | [] 282 | (let [alice (make-actor alice-responses {:bitcount 100}) 283 | bob (make-actor bob-responses {})] 284 | (loop [next-msg [:start nil] 285 | people (cycle [alice bob])] 286 | (println "Sending" (first next-msg)) 287 | 288 | ;; Here we do the actualy evesdropping. We can observe all the 289 | ;; qubits, or just some. We could also be more creative about 290 | ;; whether to measure the sign or the value 291 | ;; 292 | ;; The fewer qubits you observe, the less of a chance Alice and 293 | ;; Bob will notice, but the less information you get. 294 | (when (= :qubits (first next-msg)) 295 | (let [qubits (second next-msg) 296 | observed (doall (for [q (take 20 qubits)] 297 | (observe q)))] 298 | (println "Evesdropped and observed" observed))) 299 | 300 | (if-let [resp ((first people) next-msg)] 301 | (recur resp (rest people)))))) 302 | 303 | (comment 304 | (run-with-evesdropping) 305 | ;; prints: 306 | ;; Sending :start 307 | ;; Sending :qubits 308 | ;; Evesdropped and observed (0 1 1 0 1 0 1 0 1 0 1 0 1 1 1 1 1 1 0 0) 309 | ;; Sending :bases 310 | ;; Sending :verify 311 | ;; Sending :abort 312 | ) 313 | --------------------------------------------------------------------------------