├── LICENSE ├── README.md ├── Setup.hs ├── quantum.cabal └── src └── Control └── Quantum.hs /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2014, Igor Babuschkin 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Igor Babuschkin nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | # haskell-quantum 3 | 4 | ## Description 5 | 6 | Implementation of the `Quantum` Monad, which promotes an arbitrary data type to a quantum state. 7 | 8 | Whenever a value of type `Quantum a` is modified, the modification is propagated to all 9 | possible states of the underlying type. 10 | Each possible state is weighted by a complex amplitude and the individual amplitudes can interfere 11 | when the state undergoes a transformation. 12 | This allows (in theory) the simulation of any discrete quantum process. 13 | 14 | The `Quantum` Monad is analogous to the `Probability` Monad used for probabalistic programming. 15 | The main difference is in the normalization of states: While using the L1 norm leads to probabalistic states, the L2 norm is responsible for quantum states. 16 | 17 | Analogously, one can say that this package implements the concept of *quantum programming*. 18 | 19 | ## Tutorial 20 | 21 | The following code defines a `Quantum Int` that is in a superposition of |0> and |1>, 22 | performs a unitary variant of addition and prints the resulting measurement probabilities. 23 | Non-unitary transformations currently lead to a runtime error. 24 | 25 | ```haskell 26 | import Control.Quantum 27 | 28 | state :: Quantum Int 29 | state = quantize [(0, 1 / sqrt 2 ), (1, 1 / sqrt 2)] 30 | 31 | -- All quantum transformations have to be unitary (i.e. reversible) 32 | transform :: Quantum Int -> Quantum Int -> Quantum (Int, Int) 33 | transform qx qy = do 34 | x <- qx 35 | y <- qy 36 | return (x, x + y) 37 | 38 | main = print $ measurements $ transform state state 39 | -- [((0,0),0.25),((0,1),0.25),((1,1),0.25),((1,2),0.25)] 40 | ``` 41 | 42 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /quantum.cabal: -------------------------------------------------------------------------------- 1 | 2 | name: quantum 3 | -- PVP summary: +-+------- breaking API changes 4 | -- | | +----- non-breaking API additions 5 | -- | | | +--- code changes with no API change 6 | version: 0.0.0.0 7 | synopsis: A Monad for simulating quantum processes. 8 | description: Implementation of the 'Quantum' Monad, which promotes an arbitrary data type to a quantum state. 9 | . 10 | Whenever a value of type @Quantum a@ is modified, the modification is propagated to all 11 | possible states of the underlying type. 12 | Each possible state is weighted by a complex amplitude and the individual amplitudes can interfere 13 | when the state undergoes a transformation. 14 | This allows (in theory) the simulation of any discrete quantum process. 15 | . 16 | The @Quantum@ Monad is analogous to the @Probability@ Monad used for probabalistic programming. 17 | The main difference is in the normalization of states: While using the L1 norm leads to probabalistic states, 18 | the L2 norm is responsible for quantum states. 19 | . 20 | Analogously, one can say that this package implements the concept of /quantum programming/. 21 | 22 | license: BSD3 23 | license-file: LICENSE 24 | author: Igor Babuschkin 25 | maintainer: igor@babuschk.in 26 | copyright: 2014 Igor Babuschkin 27 | category: Math 28 | build-type: Simple 29 | -- extra-source-files: 30 | cabal-version: >=1.10 31 | 32 | Source-Repository head 33 | Type: git 34 | Location: https://github.com/ibab/haskell-quantum 35 | 36 | library 37 | exposed-modules: Control.Quantum 38 | -- other-modules: 39 | -- other-extensions: 40 | build-depends: base >=4.6 && <4.8, containers, MonadRandom 41 | hs-source-dirs: src 42 | default-language: Haskell2010 43 | 44 | -------------------------------------------------------------------------------- /src/Control/Quantum.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE StandaloneDeriving #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | 6 | module Control.Quantum 7 | ( Amplitude 8 | , WaveFunction 9 | , Quantum 10 | , quantize 11 | , MonadQuantum 12 | , runQuantum 13 | , runQuantum' 14 | , measure 15 | , measurements 16 | ) 17 | where 18 | 19 | import qualified Data.Map as M 20 | import Data.Map (Map) 21 | import Data.Monoid 22 | import Control.Monad 23 | import Control.Applicative 24 | import Control.Monad.Random as R 25 | import Data.Complex 26 | 27 | nearZero :: Double -> Bool 28 | nearZero x = abs x <= 1e-12 29 | 30 | type Amplitude = Complex Double 31 | 32 | -- | The Wave function is the distribution of amplitudes over the 33 | -- possible states of the underlying data type 34 | type WaveFunction a = [(a, Amplitude)] 35 | 36 | class (Monad m) => MonadQuantum m where 37 | quantize :: (Ord a) => WaveFunction a -> m a 38 | quantize' :: WaveFunction a -> m a 39 | condition :: Bool -> m () 40 | 41 | liftQ :: (Ord b, MonadQuantum m) => (a -> b) -> m a -> m b 42 | liftQ f q1 = q1 >>= always . f 43 | 44 | liftQ2 :: (Ord c, MonadQuantum m) => (a -> b -> c) -> m a -> m b -> m c 45 | liftQ2 f p1 p2 = do x1 <- p1 46 | x2 <- p2 47 | always (f x1 x2) 48 | 49 | liftQ3 :: (Ord d, MonadQuantum m) => (a -> b -> c -> d) -> m a -> m b -> m c -> m d 50 | liftQ3 f p1 p2 p3 = do x1 <- p1 51 | x2 <- p2 52 | x3 <- p3 53 | always (f x1 x2 x3) 54 | 55 | always a = quantize [(a, 1.0:+0.0)] 56 | always' a = quantize' [(a, 1.0:+0.0)] 57 | 58 | -- | Describes the quantized version of an arbitrary data type. 59 | -- The underlying data type defines the basis that the state is measured in. 60 | data Quantum a where 61 | Quantum :: Ord a => Map (Maybe a) Amplitude -> Quantum a 62 | QuantumAny :: [(Maybe a, Amplitude)] -> Quantum a 63 | 64 | noState :: (Ord a) => Quantum a 65 | noState = Quantum (M.singleton Nothing (1.0:+0.0)) 66 | 67 | noState' :: Quantum a 68 | noState' = QuantumAny [(Nothing, 1.0 :+ 0.0)] 69 | 70 | deriving instance (Show a) => Show (Quantum a) 71 | 72 | instance Functor Quantum where 73 | fmap = liftM 74 | 75 | instance Applicative Quantum where 76 | pure = return 77 | (<*>) = ap 78 | 79 | instance Monad Quantum where 80 | return = always' 81 | 82 | m >>= f = if unitary then next 83 | else error "Non-unitary transformation applied to quantum state!" 84 | where 85 | unitary = nearZero $ l2norm (map snd $ toList' next) - 1.0 86 | next = collect [multAmpl q (go a) | (a, q) <- toList' m] 87 | go = maybe noState' f 88 | 89 | multAmpl :: Amplitude -> Quantum a -> Quantum a 90 | multAmpl q (Quantum x) = Quantum $ M.map (* conjugate q) x 91 | multAmpl q (QuantumAny x) = QuantumAny [ (a, q * r) | (a, r) <- x ] 92 | 93 | toList' :: Quantum a -> [(Maybe a, Amplitude)] 94 | toList' (Quantum x) = M.toList x 95 | toList' (QuantumAny x) = x 96 | 97 | toList :: (Ord a) => Quantum a -> [(Maybe a, Amplitude)] 98 | toList (Quantum x) = M.toList x 99 | toList (QuantumAny x) = merge x 100 | 101 | collect :: [Quantum a] -> Quantum a 102 | collect [ ] = QuantumAny [] 103 | collect [x] = x 104 | collect (Quantum x:t) = case collect t of 105 | Quantum y -> Quantum (M.unionWith (+) x y) 106 | QuantumAny y -> Quantum (M.unionWith (+) x (M.fromList y)) 107 | collect (QuantumAny x:t) = case collect t of 108 | Quantum y -> Quantum (M.unionWith (+) (M.fromList x) y) 109 | QuantumAny y -> QuantumAny (x ++ y) 110 | 111 | merge :: (Ord a) => WaveFunction a -> WaveFunction a 112 | merge = M.toList . M.fromListWith (+) 113 | 114 | instance MonadQuantum Quantum where 115 | quantize = Quantum . M.fromListWith (+) . normalize 116 | quantize' = QuantumAny . normalize 117 | condition test = if test then always () else noState 118 | 119 | instance (Ord a, Monoid a) => Monoid (Quantum a) where 120 | mempty = always mempty 121 | mappend = liftQ2 mappend 122 | 123 | 124 | normalize :: WaveFunction a -> [(Maybe a, Amplitude)] 125 | normalize xs = map (\(a, q) -> (Just a, q / total)) xs 126 | where 127 | total = sum $ zipWith (*) (map conjugate ampl) ampl 128 | ampl = map snd xs 129 | 130 | -- | Remove all impossible states from the quantum state and renormalize 131 | collapse :: [(Maybe a, Amplitude)] -> WaveFunction a 132 | collapse xs = [ (x, q / (norm:+0)) | (Just x, q) <- xs ] 133 | where 134 | norm = l2norm [ q | (Just x, q) <- xs ] 135 | 136 | l2norm :: [Amplitude] -> Double 137 | l2norm xs = sqrt $ sum $ map (\x -> (magnitude x)**2) xs 138 | 139 | -- | Extracts the wave function from a quantum state. 140 | runQuantum :: (Ord a) => Quantum a -> WaveFunction a 141 | runQuantum = collapse . toList 142 | 143 | runQuantum' :: Quantum a -> WaveFunction a 144 | runQuantum' = collapse . toList' 145 | 146 | -- | Measures a quantum state. Returns a single realization of the underlying data type 147 | -- with probability equal to the squared magnitude of the amplitude of that realization. 148 | -- Note that if this Module would be backed by a real quantum processor, this would be 149 | -- the only valid way to extract information from the Monad. 150 | measure :: (Ord a) => Quantum a -> IO a 151 | measure q = do 152 | x <- evalRandIO $ R.fromList $ map (\(a, b) -> (a, toRational b)) $ measurements q 153 | return x 154 | 155 | -- | Converts a quantum state into a probability state through measurement. 156 | -- Equivalent to performing repeated measurements on equally prepared quantum states 157 | -- and noting the frequency of each possible realization. 158 | measurements :: (Ord a) => Quantum a -> [(a, Double)] 159 | measurements = f . runQuantum 160 | where f xs = [(x, (magnitude q)**2) | (x, q) <- xs] 161 | 162 | 163 | --------------------------------------------------------------------------------