Beating the odds with entangled qubits

Quantum mechanics allows the possibility of "spooky action at a distance", correlations between widely separated but simultaneous random events that can't be explained by probability theory. These events look like they secretly communicate with each other, but we also know that quantum mechanics prevents us sending messages faster than the speed of light. Nonetheless, even though we can't exploit non-locality to send messages faster than the speed of light, two cooperating parties can exploit non-locality to perform tasks better than would be possible without non-locality. The CHSH game is one such example.

My goal here is to write code to emulate the CHSH game. It will require reusing the probability and quantum mechanics monads I've used here many times before. So I won't be explaining how these work.

> import Data.Map (toList, fromListWith)
> import Complex
> infixl 7 .*

The CHSH game is cooperative in the sense that the two players, A and B, are attempting to work together to win. The two players are widely separated. Between the two players is the game show host. The host randomly generates a pair of bits, s and t. s is sent to A and t is sent to B. Neither A nor B gets to see the message sent to their partner. A and B must now simultaneously make their moves, stating a choice of bit.

Call A's move a and B's move b. A and B win if they can arrange that a XOR b equals s AND t. So, for example, if A receives a true bit, and thinks B has also received a true bit, then A wants to make a move that differs from B's, otherwise A wants to make the same move as B. A and B are allowed to plan as much as they like beforehand but it should be pretty clear that they can't possibly guarantee a win.

We can formally write the victory condition as:

> victory a b s t = (a `xor` b) == (s && t)

Now there's a pretty good strategy A and B can adopt: three quarters of the time, s AND t will be false. In that case, A and B want their answers to match. So they could simply choose false, regardless of what message the game show host sends them. We can give their strategies as a function of the host's message:

> astrategy s = False
> bstrategy t = False

Now we can simulate our game:

> game = do

The host picks a random bit to send to each player:

>    s <- 0.5 .* return False + 0.5 .* return True
>    t <- 0.5 .* return False + 0.5 .* return True

The players now respond to each of their messages:

>    let a = astrategy s
>    let b = bstrategy t

Now we can collect the replies and score the result:

>    let score = victory a b s t
>    return score

> play1 = collect game

Running play1 gives the expected result that A and B have a 3/4 chance of winning. It's not hard to prove classically that they can do no better than this.

But in a quantum universe it is possible to do better! We now allow A and B to adopt strategies that involve making measurements of a quantum system. To describe their strategies we need to use the quantum monad. Here is the previous strategy rewritten for this monad. In this case, the argument b is the state of the quantum system they observe. The first element of the pair is the move in the game, the second element is the state the physical system is left in by the player:

> aqstrategy b s = qreturn (False, b)
> bqstrategy b t = qreturn (False, b)

Now we can rewrite game to support quantum processes:

> game' aqstrategy bqstrategy bits = do
>    s <- 0.5 .* preturn False + 0.5 .* preturn True
>    t <- 0.5 .* preturn False + 0.5 .* preturn True
>    (score, _, _) <- collect $ observe $ do
>        (abit, bbit) <- bits
>        (a, abit') <- aqstrategy abit s
>        (b, bbit') <- bqstrategy bbit t
>        let score = victory a b s t

Note that we have to return abit' and bbit' because quantum processes are reversible and can't erase information about a state. Also note that abit' and bbit' can be widely separated in space.

>        qreturn (score, abit', bbit')

Probabilistic processes can erase whatever they like:

>    preturn score

The quantum version of a coin toss to generate a random bit, ie. an equal superposition of False and True:

> coin' = (1/sqrt 2) .* qreturn False + (1/sqrt 2) .* qreturn True

> bits = do
>   a <- coin'
>   b <- coin'
>   return (a, b)

So now we play exactly as in play1 except that we give each player an independent qubit, which they ignore:

> play2 = collect $ game' aqstrategy bqstrategy bits

Unsurprisingly, the probability of winning is just the same as before.

But now we can try something impossible in the classical case. We give each player half of a perfectly correlated pair of qubits. The players are now entangled and can exploit non-locality. Of course if their strategies ignore the qubits we get the same result as before:

> bell = (1/sqrt 2) .* qreturn (False, False) + (1/sqrt 2) .* qreturn (True, True)
> play3 = collect $ game' aqstrategy bqstrategy bell

Now comes the surprising bit. The players can each look at the (classical) bit given to them by the game host. Depending what it is they rotate the qubit's state through some angle in state space. (In the case of the qubit being an electron state, this is an actual physical rotation of the electron.) In these strategies, the choice of move is the same as the state the qubit is left in after observation, hence the qreturn (b', b') bit.

> aqstrategy' b False = rotate (0) b >>= \b' -> qreturn (b', b')
> aqstrategy' b True  = rotate (pi/2) b >>= \b' -> qreturn (b', b')

> bqstrategy' b False = rotate (pi/4) b >>= \b' -> qreturn (b', b')
> bqstrategy' b True  = rotate (-pi/4) b >>= \b' -> qreturn (b', b')

And now when we play, the probability of winning is greater than 3/4.

> play4 = collect $ game' aqstrategy' bqstrategy' bell

All of the 'communication' took place before the game started. A and B didn't communicate s and t to each other. And yet they can beat the classical odds.

So in conclusion: Quantum mechanics gives opportunities for collusion that are impossible classically. Sadly we don't yet know how to maintain the state of separated entangled qubits for extended periods of time. But I remember seeing recently that people are managing to maintain qubit states for nanoseconds.

By the way, there are games where it is possible to achieve a 100% success rate with the help of quantum states. These give examples of what is known as quantum pseudo-telepathy. I presume the "pseudo" is because despite the 100% success rate, it still doesn't give a way to send messages instantly.

A last thought from me: one reason why humans send messages is to allow them to coordinate strategies. But quantum game theory shows that we can coordinate strategies without sending messages. In other words, even though non-locality doesn't give us faster-than-light communication, it does allow us to do things that were previously thought to require FTL. I think this may have some profound consequences.

And an example from a different domain: in biochemistry one could imagine remote parts of ligands coordinating the way they bind to receptors, something that would be completely missed by the kind of quasi-classical simulation I've seen biochemists use.

---

My standard quantum mechanics code:

> data W b a = W { runW :: [(a, b)] } deriving (Eq, Show, Ord)

> mapW f (W l) = W $ map (\(a, b) -> (a, f b)) l

> instance Functor (W b) where
>  fmap f (W a) = W $ map (\(a, p) -> (f a, p)) a

> instance Num b => Monad (W b) where
>  return x = W [(x, 1)]
>  l >>= f = W $ concatMap (\(W d, p) -> map (\(x, q)->(x, p*q)) d) (runW $ fmap f l)

> a .* b = mapW (a*) b

> instance (Eq a, Show a, Num b) => Num (W b a) where
>   W a + W b = W $ (a ++ b)
>   a - b = a + (-1) .* b
>   _ * _ = error "Num is annoying"
>   abs _ = error "Num is annoying"
>   signum _ = error "Num is annoying"
>   fromInteger a = if a==0 then W [] else error "fromInteger can only take zero argument"

> collect :: (Ord a, Num b) => W b a -> W b a
> collect = W . filter ((/= 0) . snd) . toList . fromListWith (+) . runW

> type P a = W Double a
> type Q a = W (Complex Double) a

> a `xor` b = a/=b

> rotate :: Double -> Bool -> Q Bool
> rotate theta True = let theta' = theta :+ 0
>   in cos (theta'/2) .* return True - sin (theta'/2) .* return False
> rotate theta False = let theta' = theta :+ 0
>   in cos (theta'/2) .* return False + sin (theta'/2) .* return True

> observe :: Ord a => Q a -> P a
> observe = W . map (\(a, w) -> (a, magnitude (w*w))) . runW . collect

Some help for the compiler (and maybe humans too):

> preturn = return :: a -> P a
> qreturn = return :: a -> Q a

Statistical Fingertrees

I have no time to post a proper article. But I have time to post a mini-article with details in the links.

> {-# LANGUAGE MultiParamTypeClasses #-}
> import Data.FingerTree
> import Data.Monoid

I'm a bad person. I often use this method to compute the mean and variance of some samples. It's not robust. It performs badly if the variance is small compared to the size of the samples. I shouldn't use it. As penance, this is a quick article on dynamically computing variances robustly and efficiently for datasets that are frequently manipulated.

For convenience I'll talk about the unscaled variance: the sum, not the average of the square deviation from the mean. You can easily compute the variance from this if you know the dataset size.

If we know the size, mean and unscaled variance of two sets (more properly, multisets) we can find the mean and unscaled variance of the their union using the formula here. This method is much more robust that the naive algorithm.

The rule for combining two datasets gives us a monoid:

> data Stats = Stats { n :: Float, mean :: Float, unscaledVariance :: Float }
>              deriving Show

> instance Monoid Stats where
>     mempty = Stats 0 0 undefined
>     Stats n m v `mappend` Stats 0 _ _ = Stats n m v
>     Stats 0 _ _ `mappend` Stats n m v = Stats n m v
>     Stats n m v `mappend` Stats n' m' v' = 
>       let delta = m' - m
>       in Stats (n + n') ((n*m+n'*m')/(n+n'))
>                (v + v' + delta*delta*n*n'/(n+n'))

Given a single sample, we can compute its stats:

> instance Measured Stats Float where
>     measure x = Stats 1 x 0

Now we need just one more line of code:

> type StatsTree = FingerTree Stats Float

We now have a data structure that allows us to freely split, join, delete elements from and add elements to sequences of samples, all the while robustly keeping track of their mean and unscaled variance (and hence their variance).

For example:

> example = fromList [1..10] :: StatsTree
> test = let (_, b) = split ((>=4) . n) example
>            (c, _) = split ((>3)  . n) b
>        in measure c

computes the stats for the 3 elements starting at the 4th element of example.

An example application might be maintaining rolling averages and variances for a sliding window.

This was inspired an article by John D Cook somewhere around here.