GATES.HS

module Gates where 
import Complex

type Gate = ([Int], [Complex Double])

oneOverRootTwo :: Complex Double
oneOverRootTwo = 2**(-0.5) :+ 0

--------------------------------------------------------------------------
-- Matrices
sqrtNotMatrix ::[ Complex Double ]
sqrtNotMatrix = [ oneOverRootTwo, -oneOverRootTwo, oneOverRootTwo, oneOverRootTwo ]

flipMatrix :: [ Complex Double ]
flipMatrix = [ 1, 0, 0, 0
             , 0, 1, 0, 0
             , 0, 0, oneOverRootTwo, -oneOverRootTwo
             , 0, 0, oneOverRootTwo, oneOverRootTwo
             ]

shorRMatrix :: [ Complex Double ]
shorRMatrix = [ oneOverRootTwo, oneOverRootTwo, oneOverRootTwo, -oneOverRootTwo ]

shorTheta :: Int -> Double
shorTheta n = pi / 2^n

shorSMatrix :: Int -> Int -> [Complex Double]
shorSMatrix j k = [ 1, 0, 0, 0
                  , 0, 1, 0, 0
                  , 0, 0, 1, 0
                  , 0, 0, 0, exp( 0 :+ (shorTheta (k-j)))
                  ]

swapMatrix :: [Complex Double]
swapMatrix = [ 1, 0, 0, 0
             , 0, 0, 1, 0
             , 0, 1, 0, 0
             , 0, 0, 0, 1
             ]

--------------------------------------------------------------------------
-- sqrtGate n, where n is the bit for the gate to act on
sqrtGate :: Int -> Gate
sqrtGate n = ([n], sqrtNotMatrix)

-- sqrtGates [n]. Constructs a column of sqrtNot gates, where
--                [n] gives the bits to act on
sqrtGates :: [Int] -> [Gate]
sqrtGates [] = []
sqrtGates (b:bs) = (sqrtGate b) : sqrtGates bs

--------------------------------------------------------------------------
flipGate :: (Int, Int) -> Gate
flipGate (a,b) = ([a,b], flipMatrix)

flipGates :: [Int] -> [Gate]
flipGates [] = []
flipGates (b1:b2:bs) = (flipGate (b1,b2)) : flipGates bs

--------------------------------------------------------------------------
-- swaps two bits around
swapGate :: (Int, Int) -> Gate
swapGate (a, b) = ([a, b], swapMatrix)

-- mirrors a circuit around its mid-point
swapGates :: [Int] -> [Gate]
swapGates [] = []
swapGates (b:[]) = []
swapGates (b:bs) = (swapGate (b, last bs)) : swapGates (init bs)


--------------------------------------------------------------------------
-- Gate for the QFT
shorRGate :: Int -> Gate
shorRGate j = ([j], shorRMatrix)

shorSGate :: (Int, Int) -> Gate
shorSGate (j, k) = (([j,k], shorSMatrix j k))

shorSGates :: Int -> Int -> [Gate]
shorSGates j k = if (k>j) 
                  then ((shorSGate (j,k)) : (shorSGates j (k-1))) 
                  else []