Использование системы типов для проверки длины вывода по отношению к списку ввода

Предположим, что список L с длиной n чередуется в списке J с длиной n + 1. Мы хотели бы знать, для каждого элемента J, который из его соседей из L больше. Следующая функция принимает L как свой вход и создает список K, также длины n + 1, так что i-й элемент из K является искомым соседом i-го элемента из J.

aux [] prev acc = prev:acc
aux (hd:tl) prev acc = aux tl hd ((max hd prev):acc)

expand row = reverse (aux row 0 [])

Я могу доказать себе, неформально, что длина результата этой функции (что я первоначально написано в Ocaml), является одним большим, чем длина ввода. Но я перескочил на Haskell (новый язык для меня), потому что меня заинтересовало способный доказать через систему типов, что этот инвариант имеет место. С помощью этот предыдущий ответ, я был чтобы получить следующее:

{-# LANGUAGE GADTs, TypeOperators, TypeFamilies #-}

data Z
data S n

type family (:+:) a b :: *
type instance (:+:) Z n = n
type instance (:+:) (S m) n = S (m :+: n)

-- A List of length 'n' holding values of type 'a'
data List a n where
    Nil  :: List a Z
    Cons :: a -> List a m -> List a (S m)

aux :: List a n -> a -> List a m -> List a (n :+: (S m))
aux Nil prev acc = Cons prev acc
aux (Cons hd tl) prev acc = aux tl hd (Cons (max hd prev) acc)

Однако в последней строке появляется следующая ошибка:

* Could not deduce: (m1 :+: S (S m)) ~ S (m1 :+: S m)
  from the context: n ~ S m1
    bound by a pattern with constructor:
               Cons :: forall a m. a -> List a m -> List a (S m),
             in an equation for `aux'
    at pyramid.hs:23:6-15
  Expected type: List a (n :+: S m)
    Actual type: List a (m1 :+: S (S m))
* In the expression: aux tl hd (Cons (max hd prev) acc)
  In an equation for `aux':
      aux (Cons hd tl) prev acc = aux tl hd (Cons (max hd prev) acc)
* Relevant bindings include
    acc :: List a m (bound at pyramid.hs:23:23)
    tl :: List a m1 (bound at pyramid.hs:23:14)
    aux :: List a n -> a -> List a m -> List a (n :+: S m)
      (bound at pyramid.hs:22:1)

Кажется, что мне нужно сделать, это научить компилятор, что (x :+: (S y)) ~ S (x :+: y). Возможно ли это?

В качестве альтернативы, есть ли лучшие инструменты для этой проблемы, чем система типов?

Ответы

Ответ 1

Во-первых, некоторые импортные и языковые расширения:

{-# LANGUAGE GADTs, TypeInType, RankNTypes, TypeOperators, TypeFamilies, TypeApplications, AllowAmbiguousTypes #-}

import Data.Type.Equality

Теперь мы имеем DataKinds (или TypeInType), что позволяет нам продвигать любые данные на уровень типа (со своим видом), поэтому тип нулевые уровни на самом деле заслуживают того, чтобы их можно было определить как регулярные data (черт возьми, это как раз мотивы, приведенные в предыдущей ссылке на документы GHC!). Ничего не меняется с вашим типом List, но (:+:) действительно должен быть закрытым типом семейства (теперь над вещами рода Nat).

-- A natural number type (that can be promoted to the type level)
data Nat = Z | S Nat

-- A List of length 'n' holding values of type 'a'
data List a n where
  Nil  :: List a Z
  Cons :: a -> List a m -> List a (S m)

type family (+) (a :: Nat) (b :: Nat) :: Nat where
  Z + n = n
  S m + n = S (m + n)

Теперь, чтобы сделать доказательства для aux, полезно определить одноэлементные типы для натуральных чисел.

-- A singleton type for `Nat`
data SNat n where
  SZero :: SNat Z
  SSucc :: SNat n -> SNat (S n)

-- Utility for taking the predecessor of an `SNat`
sub1 :: SNat (S n) -> SNat n
sub1 (SSucc x) = x

-- Find the size of a list
size :: List a n -> SNat n
size Nil = SZero
size (Cons _ xs) = SSucc (size xs)

Теперь мы в форме, чтобы начать доказывать некоторые вещи. Из Data.Type.Equality, a :~: b представляет доказательство того, что a ~ b. Нам нужно доказать одну простую вещь об арифметике.

-- Proof that     n + (S m) == S (n + m)
plusSucc :: SNat n -> SNat m -> (n + S m) :~: S (n + m)
plusSucc SZero _ = Refl
plusSucc (SSucc n) m = gcastWith (plusSucc n m) Refl

Наконец, мы можем использовать gcastWith, чтобы использовать это доказательство в aux. О, и вам не удалось ограничить Ord a.:)

aux :: Ord a => List a n -> a -> List a m -> List a (n + S m)
aux Nil prev acc = Cons prev acc
aux (Cons hd tl) prev acc = gcastWith (plusSucc (size tl) (SSucc (size acc)))
                                      aux tl hd (Cons (max hd prev) acc)

-- append to a list
(|>) :: List a n -> a -> List a (S n)
Nil |> y = Cons y Nil
(Cons x xs) |> y = Cons x (xs |> y)

-- reverse 'List'
rev :: List a n -> List a n
rev Nil = Nil
rev (Cons x xs) = rev xs |> x

Сообщите мне, если это ответит на ваш вопрос - начало работы с такими вещами связано с большим количеством новых вещей.