{-|
 -Module      : Gates
 -Description : Basic Quantum Gates
 -Copyright   : (c) Mihai Sebastian Ardelean, 2024
 -License     : BSD3
 -Maintainer  : ardeleanasm@gmail.com
 -Portability : POSIX
 -}
module Quantum.Gates
  (
    iGate
  , swapGate
  , hGate
  , xGate
  , yGate
  , zGate
  , cNotGate
  , Gate
  )where


import qualified Numeric.LinearAlgebra as LA

import Quantum.QDataTypes

{-|
 -  iGate function represent an Identity Matrix
 
 >>>iGate
 (2><2)
 [ 1.0 :+ 0.0, 0.0 :+ 0.0
 , 0.0 :+ 0.0, 1.0 :+ 0.0 ]
 -}
iGate :: Gate
iGate :: Gate
iGate = Int -> Gate
forall a. (Num a, Element a) => Int -> Matrix a
LA.ident Int
2 :: Gate

{-|
 -  swapGate function represent a Swap Gate
 
 >>>swapGate
 (4><4)
 [ 1.0 :+ 0.0, 0.0 :+ 0.0, 0.0 :+ 0.0, 0.0 :+ 0.0
 , 0.0 :+ 0.0, 0.0 :+ 0.0, 1.0 :+ 0.0, 0.0 :+ 0.0
 , 0.0 :+ 0.0, 1.0 :+ 0.0, 0.0 :+ 0.0, 0.0 :+ 0.0
 , 0.0 :+ 0.0, 0.0 :+ 0.0, 0.0 :+ 0.0, 1.0 :+ 0.0 ]
 -}
swapGate :: Gate
swapGate :: Gate
swapGate = (Int
4Int -> Int -> [Complex Double] -> Gate
forall a. Storable a => Int -> Int -> [a] -> Matrix a
LA.><Int
4)
    [ Complex Double
1, Complex Double
0, Complex Double
0, Complex Double
0 
    , Complex Double
0, Complex Double
0, Complex Double
1, Complex Double
0 
    , Complex Double
0, Complex Double
1, Complex Double
0, Complex Double
0 
    , Complex Double
0, Complex Double
0, Complex Double
0, Complex Double
1]::Gate

{-|
 -  hGate function represent a Hadamard Gate
  
  >>>hGate
 (2><2)
 [ 0.7071067811865475 :+ 0.0,    0.7071067811865475 :+ 0.0
 , 0.7071067811865475 :+ 0.0, (-0.7071067811865475) :+ 0.0 ]
 -}
hGate :: Gate
hGate :: Gate
hGate = (Int
2Int -> Int -> [Complex Double] -> Gate
forall a. Storable a => Int -> Int -> [a] -> Matrix a
LA.><Int
2) [Complex Double
1Complex Double -> Complex Double -> Complex Double
forall a. Fractional a => a -> a -> a
/Complex Double -> Complex Double
forall a. Floating a => a -> a
sqrt Complex Double
2,Complex Double
1Complex Double -> Complex Double -> Complex Double
forall a. Fractional a => a -> a -> a
/Complex Double -> Complex Double
forall a. Floating a => a -> a
sqrt Complex Double
2,Complex Double
1Complex Double -> Complex Double -> Complex Double
forall a. Fractional a => a -> a -> a
/Complex Double -> Complex Double
forall a. Floating a => a -> a
sqrt Complex Double
2,(-Complex Double
1)Complex Double -> Complex Double -> Complex Double
forall a. Fractional a => a -> a -> a
/Complex Double -> Complex Double
forall a. Floating a => a -> a
sqrt Complex Double
2] :: Gate

{-|
 -  yGate function represent a Pauli Y-Gate
 
 >>>yGate
(2><2)
 [ 0.0 :+ 0.0, 0.0 :+ (-1.0)
 , 0.0 :+ 1.0,    0.0 :+ 0.0 ]
 -}
yGate :: Gate
yGate :: Gate
yGate = (Int
2Int -> Int -> [Complex Double] -> Gate
forall a. Storable a => Int -> Int -> [a] -> Matrix a
LA.><Int
2) [Complex Double
0.0,Double
0.0Double -> Double -> Complex Double
forall a. a -> a -> Complex a
LA.:+(-Double
1.0),Double
0.0Double -> Double -> Complex Double
forall a. a -> a -> Complex a
LA.:+Double
1.0,Complex Double
0.0] :: Gate

{-|
 -  zGate function represent a Pauli Z-Gate
 
 >>>zGate
 (2><2)
 [ 1.0 :+ 0.0,       0.0 :+ 0.0
 , 0.0 :+ 0.0, (-1.0) :+ (-0.0) ]
 -}
zGate :: Gate
zGate :: Gate
zGate = (Int
2Int -> Int -> [Complex Double] -> Gate
forall a. Storable a => Int -> Int -> [a] -> Matrix a
LA.><Int
2) [Complex Double
1,Complex Double
0,Complex Double
0,-Complex Double
1] :: Gate

{-|
 -  xGate function represent a Pauli X-Gate
 
 >>>xGate
 (2><2)
 [ 0.0 :+ 0.0, 1.0 :+ 0.0
 , 1.0 :+ 0.0, 0.0 :+ 0.0 ]
 -}
xGate :: Gate
xGate :: Gate
xGate = (Int
2Int -> Int -> [Complex Double] -> Gate
forall a. Storable a => Int -> Int -> [a] -> Matrix a
LA.><Int
2) [Complex Double
0,Complex Double
1,Complex Double
1,Complex Double
0] :: Gate

{-|
 -  cNotGate function represent a Controlled-Not Gate
 
 >>>cNotGate
 (4><4)
 [ 1.0 :+ 0.0, 0.0 :+ 0.0, 0.0 :+ 0.0, 0.0 :+ 0.0
 , 0.0 :+ 0.0, 1.0 :+ 0.0, 0.0 :+ 0.0, 0.0 :+ 0.0
 , 0.0 :+ 0.0, 0.0 :+ 0.0, 0.0 :+ 0.0, 1.0 :+ 0.0
 , 0.0 :+ 0.0, 0.0 :+ 0.0, 1.0 :+ 0.0, 0.0 :+ 0.0 ]
 -}
cNotGate :: Gate
cNotGate :: Gate
cNotGate = (Int
4Int -> Int -> [Complex Double] -> Gate
forall a. Storable a => Int -> Int -> [a] -> Matrix a
LA.><Int
4)
  [Complex Double
1,Complex Double
0,Complex Double
0,Complex Double
0,
   Complex Double
0,Complex Double
1,Complex Double
0,Complex Double
0,
   Complex Double
0,Complex Double
0,Complex Double
0,Complex Double
1
  ,Complex Double
0,Complex Double
0,Complex Double
1,Complex Double
0] :: Gate