Должен ли я каждый раз использовать Nat-kind?

Question

Я попытался смоделировать квантовый компьютер. Вот тип данных, представляющий кубиты:

{-# 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, что означает «классический», присваивает первому кубиту логическое значение и указывает rest.

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, который меняет местами первые два кубита:

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 s, слишком раздражает . Действительно ли castNat обязательно?

Answer 1

Во-первых, чтобы исправить синтаксис c мерзости, вы можете написать:

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. ...

Как объяснено в комментариях, нижележащий " проблема »в том, что встроенный в GH C вывод для естественных типов на уровне типов очень ограничен. Операторы будут работать с конкретными типами и обрабатывать несколько специальных абстрактных случаев, например 0 + m ~ m, но GH C не может сделать другой, даже чрезвычайно простой вывод, например m + 1 - 1 ~ m или «m + 1 ~ n + 1 подразумевает m ~ n».

Ваш выбор - переписать, используя алгебраический тип c Nat (например, Peano naturals) или использовать плагин решателя.

Для этой проблемы Peano naturals является (erm. ..) естественное совпадение, поскольку все ваши манипуляции с естественными значениями уровня типа включают их увеличение или уменьшение. После замены 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 #-}

в начало вашего кода, я могу избавиться от всех приведений, и - опять же - он отлично проверяет типы.

Автор кстати, или из этих решений также позволяют исключить ограничения KnownNat из кода. Если производительность важна, это может быть победой, поскольку вам не придется таскать с собой все эти словари.