module HABQTlib.UnsafeAPI where
import Control.Applicative (liftA2)
import Control.Monad (replicateM)
import Control.Monad.State.Lazy
import Data.Maybe (fromJust)
import qualified Data.Vector as V
import HABQTlib.Data
import HABQTlib.Data.Particle
import HABQTlib.MeasurementProcessing
import HABQTlib.RandomStates
import qualified Numeric.LinearAlgebra as LA
import Streaming
import qualified Streaming.Prelude as S
import qualified System.Random.MWC as MWC
import Text.Printf (printf)
type TomState = StateT (ParticleHierarchy, [PureStateVector]) IO
type TomFun = PureStateVector -> TomState (DensityMatrix, PurePOVM)
tomographyFun' ::
QBitNum
-> MHMCiter
-> OptIter
-> OutputVerb
-> MWC.GenIO
-> TomFun
tomographyFun' nq mi oi outv gen nextResult = do
(ph, ms) <- get
let nextPH = updateParticleHierarchy nextResult ph
dim = LA.rows . getStateVector $ nextResult
effectiveSizes =
V.map (liftA2 (/) effectiveSize (fromIntegral . ptsNumber)) nextPH
ra = ResampleArgs outv gen dim mi
resampleC es pts =
if es < 0.5
then resample ra (nextResult : ms) pts
else return pts
nextPH' <- lift $ V.zipWithM resampleC effectiveSizes nextPH
sv0s <- liftIO $ replicateM nq (genPureSV 2)
let nextEstimate = getMixedEstimate nextPH'
nextPOVM = optimiseSingleQbPOVM oi sv0s nextPH'
put (nextPH', nextResult : ms)
return (nextEstimate, nextPOVM)
simulatedTomography' ::
DensityMatrix
-> QBitNum
-> MHMCiter
-> OptIter
-> OutputVerb
-> MWC.GenIO
-> StateT PurePOVM TomState Double
simulatedTomography' trueDM nq mi oi outv gen = do
povm <- get
nextResult <- liftIO $ simulateMeasuremet trueDM povm gen
(nextEstimate, nextPOVM) <- lift $ tomographyFun' nq mi oi outv gen nextResult
(nextPH, _) <- lift get
put nextPOVM
let fid = fidelityDM trueDM nextEstimate
when (outv > NoOutput) . liftIO $ do
let dim = 2 ^ nq
rankFids =
V.map
(fidelityDM trueDM . snd . getWDM . reduceParticlesToMean)
nextPH
weightsAndFids =
V.zip3 (V.enumFromN (1 :: Rank) dim) (V.map ptsWeight nextPH) rankFids
putStrLn ""
V.mapM_
(\(a, b, c) ->
printf "(Rank: %4d, Weight: %10.9f, Fidelity: %10.9f)\n" a b c)
weightsAndFids
return $ 1 - fid
streamResults' ::
QBitNum
-> Rank
-> NumberOfParticles
-> MHMCiter
-> OptIter
-> OutputVerb
-> Stream (Of Double) IO ()
streamResults' nq rank pn mi oi outv = do
let dim = 2 ^ nq
trueDM <- liftIO $ genDM dim rank
ph <- liftIO $ initialiseParticleHierarchy dim pn
gen <- liftIO MWC.createSystemRandom
rPOVM <-
liftIO $
productPOVM <$>
replicateM nq (mkAntipodalPOVM . fromJust . svToAngles <$> genPureSV 2)
let tomS = S.repeatM (simulatedTomography' trueDM nq mi oi outv gen)
tomS' = evalStateT (distribute tomS) rPOVM
initInfid = 1 - fidelityDM trueDM (getMixedEstimate ph)
S.yield initInfid
evalStateT (distribute tomS') (ph, [])