quantum.ss
;;
;; This file includes the quantum algorithms in the paper
;; "A lambda calculus for quantum computation".
;; However, in this version linearity assumptions are left
;; implicit, and it is up to the programmer to correctly use
;; linear arguments.  Failing to do so may result in nonsensical
;; results.
;;
;; Copyright 2003 - Andre van Tonder
#lang scheme
(require "quantum-definitions.ss")

;==============================================================
; First let's apply a few Hadamard gates in sequence
; to a single qubit:

(qeval (H (H (H 0))))

; => (superposition (0.7071067811865 1)
;                   (0.7071067811865 0))

(qeval (H (H (H (H 0)))))

; => (superposition (1.0 0))


;==============================================================
; Let's define a function that makes an EPR state:

(define (make-epr) (cnot (H 0) 0))

(qeval (make-epr))

; => (superposition (0.7071067811865 (1 1))
;                   (0.7071067811865 (0 0)))


;================================================================
; The Deutsch algorithm is easily defined:
; Here Uf is the oracle corresponding to an unknown
; function f : Bit -> Bit.
; Note that all variables appear linearly.

(define (deutsch Uf)
  (bind* ([x (H 0)]
          [y (H 1)]
          [(x* y*) (Uf x y)])
    (list (H x*) (H y*))))

; For example,
; Uf = cnot corresponds to f(0) = 0, f(1) = 1:

(qeval (deutsch cnot))

; => (superposition (1.0 (1 1)))
;    The first qubit is indeed 1 = f(0) + f(1) mod 2.

; Another example,
; Uf = (lambda (x y) (list x y)) corresponds to f(0) = f(1) = 0:

(qeval (deutsch 
        (lambda (x y) (list x y))))

; => (superposition (1.0 (0 1)))
;    The first qubit is indeed 0 = f(0) + f(1) mod 2.


;==================================================================
; Quantum teleportation:  Once again all variables appear linearly.

(define (teleport x)
  (bind* ([(e1 e2)  (make-epr)]
          [(x* e1*) (alice x e1)])
    (bob x* e1* e2)))

(define (alice x e)
  (bind ([(x* e*) (cnot x e)])
    (list (H x*) e*)))

(define (bob x e1 e2)
  (bind* ([(e1* e2*) (cX e1 e2)]
          [(x* e2**) (cZ x e2*)])
    (list x* e1* e2**)))


; Let's teleport a qubit in the state (|0> - |1>)/sqrt(2):

(qeval (teleport (H 1)))

; => (superposition (-0.3535533905933 (1 0 1))
;                   (-0.3535533905933 (0 0 1))
;                   (-0.3535533905933 (1 1 1))
;                   (-0.3535533905933 (0 1 1))
;                   (0.3535533905933  (1 1 0))
;                   (0.3535533905933  (0 1 0))
;                   (0.3535533905933  (1 0 0))
;                   (0.3535533905933  (0 0 0)))
; Ignoring the first two bits, the third bit, belonging to Bob, is
; now in the state (|0> - |1>)/sqrt(2)


;==================================================================
; Creating a uniform superposition:

(qeval (map (!suspend H) '(0 0 0)))

; => (superposition (0.3535533905933 (1 1 1))
;                   (0.3535533905933 (1 1 0))
;                   (0.3535533905933 (1 0 1))
;                   (0.3535533905933 (1 0 0))
;                   (0.3535533905933 (0 1 1))
;                   (0.3535533905933 (0 1 0))
;                   (0.3535533905933 (0 0 1))


;====================================================================
; Quantum Fourier transform:

(define (fourier lst)
  (reverse (fourier* lst)))

(define (fourier* lst)
  (list-match lst
    [()        '()]
    [(hd . tl) (bind ([(hd* . tl*) (phases (H hd) tl 2)])
                 (cons hd* (fourier* tl*)))]))

(define (phases target controls n)
  (list-match controls
    [() (list target)]
    [(control . tl) 
     (bind* ([(control* target*) ((cR n) control target)]
             [(target** . tl*)   (phases target* tl (add1 n))])
       (cons target** (cons control* tl*)))]))


; Testing the Fourier transform:

(qeval (fourier '(1 0)))

; => (superposition (-0.5 (1 1))
;                   (-0.5 (0 1))
;                   (0.5  (1 0))
;                   (0.5  (0 0)))

(qeval (fourier '(1 1 1)))

; => (superposition (0.25+0.25i            (1 1 1))
;                   (-0.25-0.25i           (0 1 1))
;                   (-0.25+0.25i           (1 0 1))
;                   (0.25-0.25i            (0 0 1))
;                   (0.0+0.3535533905933i  (1 1 0))
;                   (-0.0-0.3535533905933i (0 1 0))
;                   (-0.3535533905933      (1 0 0))
;                   (0.3535533905933       (0 0 0)))