module QIO.QExamples where
import Data.Monoid as Monoid
import QIO.QioSyn
import QIO.Qdata
import QIO.QioClass
import QIO.Qio
q0 :: QIO Qbit
q0 = mkQ False
q1 :: QIO Qbit
q1 = mkQ True
qPlus :: QIO Qbit
qPlus = do qa <- q0
applyU (uhad qa)
return qa
qMinus :: QIO Qbit
qMinus = do qa <- q1
applyU (uhad qa)
return qa
randBit :: QIO Bool
randBit = do qa <- qPlus
x <- measQbit qa
return x
share :: Qbit -> QIO Qbit
share qa = do qb <- q0
applyU (cond qa (\a -> if a then (unot qb)
else (mempty) ) )
return qb
bell :: QIO (Qbit, Qbit)
bell = do qa <- qPlus
qb <- share qa
return (qa,qb)
test_bell :: QIO (Bool,Bool)
test_bell = do qb <- bell
b <- measQ qb
return b
hadTwice :: Bool -> QIO Bool
hadTwice x = do q <- mkQ x
applyU (uhad q `mappend` uhad q)
b <- measQ q
return b
hadTwice' :: Bool -> QIO Bool
hadTwice' x = do q <- mkQ x
applyU (uhad q)
applyU (uhad q)
b <- measQ q
return b
alice :: Qbit -> Qbit -> QIO (Bool,Bool)
alice aq eq = do applyU (cond aq (\a -> if a then (unot eq)
else (mempty) ) )
applyU (uhad aq)
cd <- measQ (aq,eq)
return cd
uZZ :: Qbit -> U
uZZ qb = (uphase qb pi)
bobsU :: (Bool,Bool) -> Qbit -> U
bobsU (False,False) eq = mempty
bobsU (False,True) eq = (unot eq)
bobsU (True,False) eq = (uZZ eq)
bobsU (True,True) eq = ((unot eq)
`mappend` (uZZ eq))
bob :: Qbit -> (Bool,Bool) -> QIO Qbit
bob eq cd = do applyU (bobsU cd eq)
return eq
teleportation :: Qbit -> QIO Qbit
teleportation iq = do (eq1,eq2) <- bell
cd <- alice iq eq1
tq <- bob eq2 cd
return tq
test_teleport :: QIO (Bool,Bool)
test_teleport = do (q1,q2) <- bell
tq2 <- teleportation q2
result <- measQ (q1,tq2)
return result
teleport_true' :: QIO Qbit
teleport_true' = do q <- q1
tq <- teleportation q
return tq
teleport_true :: QIO Bool
teleport_true = do q <- teleport_true'
result <- measQ q
return result
teleport_random' :: QIO Qbit
teleport_random' = do q <- qPlus
tq <- teleportation q
return tq
teleport_random :: QIO Bool
teleport_random = do q <- teleport_random'
result <- measQ q
return result
u :: (Bool -> Bool) -> Qbit -> Qbit -> U
u f x y = cond x (\ b -> if f b then unot y else mempty)
deutsch :: (Bool -> Bool) -> QIO Bool
deutsch f = do
x <- qPlus
y <- qMinus
applyU (u f x y)
applyU (uhad x)
measQ x
problem :: QIO Bool
problem = do q <- qPlus
x <- measQ q
if x then return x else problem