我试图模拟量子计算机。这是表示量子位的数据类型:
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeOperators #-}
import Control.Monad
import Data.Maybe
import Data.Proxy
import Data.Type.Equality
import GHC.TypeNats
import Data.Group.Cyclic
data QBits :: Nat -> * where
N :: QBits 0
C :: KnownNat n => Bool -> QBits n -> QBits (n+1)
S :: KnownNat n => Cyclic 4 -> QBits n -> QBits n -> QBits (n+1)
N
代表零个量子位。
C
代表“经典”,为第一个qubit分配布尔值,并指定其余值。
S
代表“叠加”,表示第一个量子位处于叠加状态,并为每种可能性指定了其余的量,在测量时,第一个量子位将落入其中。它还指定了相位差,它是Cyclic 4
中的一个值,它是Z / 4Z环,具有Num
实例。
对于instance Eq (QBits n)
,我有一个解决方法,所以我不会惹上Nat
:
(=?=) :: QBits m -> QBits n -> Bool
N =?= N = True
C b x =?= C c y = b == c && x =?= y
S p x y =?= S q u v = p == q && x =?= u && y =?= v
_ =?= _ = False
instance Eq (QBits n) where
(==) = (=?=)
然后我实现了swapGate
,它交换了前两个qubit:
castNat :: forall f m n. (KnownNat m, KnownNat n) => f m -> Maybe (f n)
castNat x = do
refl <- sameNat (Proxy :: Proxy m) (Proxy :: Proxy n)
return (castWith (apply Refl refl) x)
swapGate :: KnownNat n => QBits n -> QBits n
swapGate (C b (C c x)) = C c (C b x)
swapGate (C b (S p x y)) = S p (C b x) (C b y)
swapGate (S r (C False x) (C False y)) = let
Just y' = castNat y
in C False (S r x y')
swapGate (S r (C False x) (S q u v)) = let
Just u' = castNat u
in S (r+q) (S r x u') (C True v)
swapGate (S r (C True y) (C False u)) = S (-r) (C True u) (C False y)
swapGate (S r (C True y) (C True v)) = let
Just v' = castNat v
in C True (S r y v')
swapGate (S r (C True y) (S q u v)) = let
Just v' = castNat v
in S (-r) (C True u) (S (r+q) y v')
swapGate (S r (S p x y) (C False u)) = let
Just u' = castNat u
in S p (S r x u') (C False y)
swapGate (S r (S p x y) (C True v)) = let
Just v' = castNat v
in S p (C False x) (S (p-r) y v')
swapGate (S r (S p x y) (S q u v)) = let
Just u' = castNat u
Just v' = castNat v
in S p (S r x u') (S (q-p+r) y v')
swapGate z = z
我必须投下Nat
的事实太烦人了。 castNat
确实是强制性的吗?
答案 0 :(得分:2)
一方面,要修复语法可憎性,您可以编写:
c :: forall f m n. (KnownNat m, KnownNat n) => f m -> f n
c = fromJust . castNat
然后:
swapGate :: KnownNat n => QBits n -> QBits n
swapGate (C b (C c x)) = C c (C b x)
swapGate (C b (S p x y)) = S p (C b x) (C b y)
swapGate (S r (C False x) (C False y)) = C False (S r x (c y))
swapGate (S r (C False x) (S q u v)) = S (r+q) (S r x (c u)) (C True v)
... etc. ...
正如评论中所解释的,潜在的“问题”是GHC对类型级别自然的内置推断非常有限。运算符将处理具体类型并处理一些特殊的抽象情况,例如0 + m ~ m
,但是GHC无法进行其他甚至是非常简单的推断,例如m + 1 - 1 ~ m
或“ m + 1 ~ n + 1
暗示{{ 1}}”。
您的选择是使用代数m ~ n
类型(例如Peano naturals)或使用求解器插件来重写。
对于这个问题,Peano自然是(erm ...)自然拟合,因为您对类型级别自然的所有操纵都涉及递增或递减它们。将Nat
和Nat
类型的运算符替换为:
+
并调整data Nat = ZZ | SS Nat
type family m + n where
ZZ + n = n
SS m + n = m + SS n
的定义:
QBits
城堡定义类型检查正常:
data QBits :: Nat -> * where
N :: QBits ZZ
C :: Bool -> QBits n -> QBits (SS n)
S :: Cyclic4 -> QBits n -> QBits n -> QBits (SS n)
或者,您可以使用求解器插件。安装swapGate :: QBits n -> QBits n
swapGate (C b (C c x)) = C c (C b x)
swapGate (C b (S p x y)) = S p (C b x) (C b y)
swapGate (S r (C False x) (C False y)) = C False (S r x y)
swapGate (S r (C False x) (S q u v)) = S (r+q) (S r x u) (C True v)
swapGate (S r (C True y) (C False u)) = S (-r) (C True u) (C False y)
swapGate (S r (C True y) (C True v)) = C True (S r y v)
swapGate (S r (C True y) (S q u v)) = S (-r) (C True u) (S (r+q) y v)
swapGate (S r (S p x y) (C False u)) = S p (S r x u) (C False y)
swapGate (S r (S p x y) (C True v)) = S p (C False x) (S (p-r) y v)
swapGate (S r (S p x y) (S q u v)) = S p (S r x u) (S (q-p+r) y v)
swapGate z = z
并添加后:
ghc-typelits-natnormalise
在您代码的顶部,我可以摆脱所有的强制转换,并且-再次-它的类型检查正常。
顺便说一句,这些解决方案中的任何一个 也都允许您从代码中删除{-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-}
约束。如果考虑性能,那可能是一个胜利,因为您不必随身携带所有这些字典。