{-# LANGUAGE        OverloadedLists #-}
{-# LANGUAGE        BlockArguments  #-}
{-# OPTIONS_HADDOCK not-home        #-}

{-|
Module      : Core
Description : Core language
Stability   : experimental

The core language operations.
-}
module Lib.Core (
    -- * QBit manipulation
      new
    , measure

    -- * Control functions
    , controlbit
    , (===)
    
    -- * Distribution functions
    , dist
    , ndist

    -- * Bit
    , Data.Bit.Bit
) where

import Lib.QM ( QM, QBit(Ptr), io, put, get, modify, run, getState )
import Lib.Internal.Core ( findQbitProb1, remImpossibleStates, Prob, appendState, newVector, rngQbit )
import Data.Bit ( Bit )
import Control.Monad ( replicateM )

-- | Create new `QBit` from a bit.
-- maps \(0 \mapsto |0>\) and \(1 \mapsto |1>\)
new :: Bit -> QM QBit
new :: Bit -> QM QBit
new x :: Bit
x = do
    (_,size :: Int
size) <- QM (QState, Int)
getState
    (QState -> QState) -> QM ()
modify ((QState -> QState) -> QM ()) -> (QState -> QState) -> QM ()
forall a b. (a -> b) -> a -> b
$ QState -> QState -> QState
appendState (Bit -> QState
newVector Bit
x)
    QBit -> QM QBit
forall (m :: * -> *) a. Monad m => a -> m a
return (QBit -> QM QBit) -> QBit -> QM QBit
forall a b. (a -> b) -> a -> b
$ Int -> QBit
Ptr Int
size

-- | Performs a measurement operation, collapsing a `QBit` to a `Bit`.
-- The qubit will still exist in the quantum state, but be collapsed.
--
-- Finds qubit probability to collapse to a zero and one.
-- Uses random number generator to "measure it" to a zero or one.
-- Updates quantum state to remove impossible states, and normalizes it so probabilites sum to one.
measure :: QBit -> QM Bit
measure :: QBit -> QM Bit
measure qbit :: QBit
qbit = do
    QState
state <- QM QState
get
    let p1 :: Prob
p1 = QBit -> QState -> Prob
findQbitProb1 QBit
qbit QState
state
    Bit
bit <- IO Bit -> QM Bit
forall a. IO a -> QM a
io (IO Bit -> QM Bit) -> IO Bit -> QM Bit
forall a b. (a -> b) -> a -> b
$ Prob -> IO Bit
rngQbit Prob
p1 -- Need to use io for randomness
    let newState :: QState
newState = QState -> QBit -> Bit -> QState
remImpossibleStates QState
state QBit
qbit Bit
bit
    QState -> QM ()
put QState
newState
    Bit -> QM Bit
forall (m :: * -> *) a. Monad m => a -> m a
return Bit
bit

-- | Sets a classical bit as the controlbit for a quantum gate.
-- Making it run only when the classical bit is equal to one.
controlbit :: QM a -> Bit -> QM ()
controlbit :: QM a -> Bit -> QM ()
controlbit m :: QM a
m 1 = QM a
m QM a -> QM () -> QM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> QM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
controlbit m :: QM a
m 0 = () -> QM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Synonym for controlbit
(===) :: QM a -> Bit -> QM ()
=== :: QM a -> Bit -> QM ()
(===) = QM a -> Bit -> QM ()
forall a. QM a -> Bit -> QM ()
controlbit

-- | Run a quantum program producing a single bit @reps@ times
-- and print the results
ndist :: Int -> QM Bit -> IO ()
ndist :: Int -> QM Bit -> IO ()
ndist reps :: Int
reps meas :: QM Bit
meas = do
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Runs : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
reps
    [Bit]
ms <- Int -> IO Bit -> IO [Bit]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
reps (QM Bit -> IO Bit
forall a. QM a -> IO a
run QM Bit
meas)
    let is :: [Double]
is = (Bit -> Double) -> [Bit] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Bit -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral [Bit]
ms
    let ones :: Double
ones = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
is :: Double
    let zeros :: Double
zeros = Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
reps Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ones
    let pones :: Double
pones = 100 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
ones Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
reps)
    let pzeros :: Double
pzeros = 100 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
pones
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "|0>  : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
zeros String -> String -> String
forall a. [a] -> [a] -> [a]
++ " (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
pzeros String -> String -> String
forall a. [a] -> [a] -> [a]
++ " %)"
    String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "|1>  : " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
ones String -> String -> String
forall a. [a] -> [a] -> [a]
++ " (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Double -> String
forall a. Show a => a -> String
show Double
pones String -> String -> String
forall a. [a] -> [a] -> [a]
++ " %)"

-- | Print results from a 100 runs of a program
dist :: QM Bit -> IO ()
dist :: QM Bit -> IO ()
dist = Int -> QM Bit -> IO ()
ndist 100