Всего постоянных очередей в реальном времени

Окасаки описывает постоянные очереди реального времени, которые могут быть реализованы в Haskell с использованием типа

data Queue a = forall x . Queue
  { front :: [a]
  , rear :: [a]
  , schedule :: [x]
  }

где инкрементальные вращения поддерживают инвариант

length schedule = length front - length rear

Подробнее

Если вы знакомы с задействованными очередями, вы можете пропустить этот раздел.

Функция вращения выглядит так

rotate :: [a] -> [a] -> [a] -> [a]
rotate [] (y : _) a = y : a
rotate (x : xs) (y : ys) a =
  x : rotate xs ys (y : a)

и вызывается умным конструктором

exec :: [a] -> [a] -> [x] -> Queue a
exec f r (_ : s) = Queue f r s
exec f r [] = Queue f' [] f' where
  f' = rotate f r []

после каждой операции с очередью. Интеллектуальный конструктор всегда вызывается при length s = length f - length r + 1, гарантируя, что совпадение с образцом в rotate будет успешным.

Эта проблема

Я ненавижу частичные функции! Я хотел бы найти способ выразить структурный инвариант в типах. Обычный зависимый вектор кажется вероятным выбором:

data Nat = Z | S Nat

data Vec n a where
  Nil :: Vec 'Z a
  Cons :: a -> Vec n a -> Vec ('S n) a

а потом (возможно)

data Queue a = forall x rl sl . Queue
  { front :: Vec (sl :+ rl) a
  , rear :: Vec rl a
  , schedule :: Vec sl x
  }

Беда в том, что я не смог понять, как жонглировать типами. Весьма вероятно, что для эффективной работы потребуется некоторое количество unsafeCoerce. Тем не менее, я не смог придумать подход, который хотя бы смутно управляем. Можно ли сделать это красиво в Haskell?


person dfeuer    schedule 13.04.2016    source источник
comment
Я не думаю, что понимаю этот тип очереди - какими будут типы exec и rotate с векторной реализацией?   -  person user2407038    schedule 14.04.2016
comment
Что вам дает forall x . { ... ; schedule :: Vec sl x }? Мне кажется, что schedule по существу является натуральным числом, потому что единственное, что вы знаете о нем, — это его длина, поскольку его содержание экзистенциально квантифицировано. Таким образом, тип schedule, вероятно, должен быть Sing sl.   -  person user3237465    schedule 14.04.2016
comment
@ user3237465, schedule действительно представляет натуральное число (и я ввел x специально, чтобы убедиться, что оно используется только как натуральное число), но на самом деле это часть переднего списка, поэтому сопоставление с образцом для него управляет инкрементным вычислением этого списка.   -  person dfeuer    schedule 14.04.2016
comment
@user2407038 user2407038, тип exec может быть выражен по-разному, в зависимости от того, что работает лучше всего, но я считаю, что одним допустимым выражением является Vec (sl1 :+ rl) a -> Vec rl a -> Vec ('S sl1) a -> Queue a   -  person dfeuer    schedule 14.04.2016
comment
Так у вас все заработало? Кстати, вам, вероятно, следует принять ответ Алека, поскольку он явно более информативен.   -  person user3237465    schedule 26.10.2016


Ответы (2)


Вот что я получил:

open import Function
open import Data.Nat.Base
open import Data.Vec

grotate : ∀ {n m} {A : Set}
        -> (B : ℕ -> Set)
        -> (∀ {n} -> A -> B n -> B (suc n))
        -> Vec A n
        -> Vec A (suc n + m)
        -> B m
        -> B (suc n + m)
grotate B cons  []      (y ∷ ys) a = cons y a
grotate B cons (x ∷ xs) (y ∷ ys) a = grotate (B ∘ suc) cons xs ys (cons y a)

rotate : ∀ {n m} {A : Set} -> Vec A n -> Vec A (suc n + m) -> Vec A m -> Vec A (suc n + m)
rotate = grotate (Vec _) _∷_

record Queue (A : Set) : Set₁ where
  constructor queue
  field
    {X}      : Set
    {n m}    : ℕ
    front    : Vec A (n + m)
    rear     : Vec A m
    schedule : Vec X n

open import Relation.Binary.PropositionalEquality
open import Data.Nat.Properties.Simple

exec : ∀ {m n A} -> Vec A (n + m) -> Vec A (suc m) -> Vec A n -> Queue A
exec {m} {suc n} f r (_ ∷ s) = queue (subst (Vec _) (sym (+-suc n m)) f) r s
exec {m}         f r  []     = queue (with-zero f') [] f' where
 with-zero    = subst (Vec _ ∘ suc) (sym (+-right-identity m))
 without-zero = subst (Vec _ ∘ suc) (+-right-identity m)

 f' = without-zero (rotate f (with-zero r) [])

rotate определяется через grotate по той же причине reverse определяется в терминах foldl (или enumerate в терминах genumerate): потому что Vec A (suc n + m) не является по определению Vec A (n + suc m), а (B ∘ suc) m по определению является B (suc m).

exec имеет ту же реализацию, что и вы (по модулю этих substs), но я не уверен насчет типов: нормально ли, что r должно быть непустым?

person user3237465    schedule 14.04.2016
comment
Ваузеры. Этот бит grotate требует некоторого размышления, так как у меня очень мало опыта в программировании такого рода. Является ли subst какой-то операцией для добавления равенств в выражения? Ограничение на r могло раздражать, и это моя вина за плохой комментарий. Извини за это. Я сомневаюсь, что это было бы ужасно, но, вероятно, раздражает. - person dfeuer; 14.04.2016
comment
@dfeuer, да, subst переписывает тип термина уравнением. В вашем комментарии это schedule должно быть непустым (опечатка?), а в моем это rear. Это как раз то, что другие типы заставляли меня делать. Кстати, вот пример того, как foldl можно перевести на Haskell, вам, вероятно, понадобится сделать то же самое, чтобы перевести grotate. - person user3237465; 14.04.2016
comment
Прошу прощения за то, что не смог присудить награду! Два дня у меня не было сотовой связи. - person dfeuer; 02.11.2016
comment
@dfeuer, не беспокойтесь, другой ответ заслуживает большего (хотя он получил только половину). - person user3237465; 02.11.2016

другой ответ очень умный (пожалуйста, найдите время, чтобы проголосовать за него), но как человек, не знакомый с Agda, как это будет реализован на Haskell, для меня не было очевидным. Вот полная версия Haskell. Нам понадобится множество расширений, а также Data.Type.Equality (поскольку нам нужно будет выполнить некоторое ограниченное количество проверок типов).

{-# LANGUAGE GADTs, ScopedTypeVariables,RankNTypes,
             TypeInType, TypeFamilies, TypeOperators #-}

import Data.Type.Equality

Определение Nat, Vec и Queue

Затем мы определяем обычные натуральные числа на уровне типа (это выглядит как обычное определение data, но поскольку у нас включено TypeInType, оно будет автоматически повышаться, когда мы используем его в типе) и функцию типа (type family) для добавление. Обратите внимание, что хотя существует несколько способов определения +, наш выбор здесь повлияет на то, что будет дальше. Мы также определим обычный Vec, который очень похож на список, за исключением того, что он кодирует свою длину в фантомном типе n. С этим мы можем пойти дальше и определить тип нашей очереди.

data Nat = Z | S Nat

type family n + m where
    Z   + m = m
    S n + m = S (n + m)

data Vec a n where
    Nil   :: Vec a Z
    (:::) :: a -> Vec a n -> Vec a (S n)

data Queue a where
    Queue :: { front :: Vec a (n + m)
             , rear :: Vec a m
             , schedule :: Vec x n } -> Queue a

Определение rotate

Теперь все начинает становиться более волосатым. Мы хотим определить функцию rotate, имеющую тип rotate :: Vec a n -> Vec a (S n + m) -> Vec a m -> Vec a (S n + m), но вы быстро столкнетесь с множеством проблем, связанных с доказательствами, просто определяя ее рекурсивно. Решение состоит в том, чтобы вместо этого определить немного более общий grotate, который может быть определен рекурсивно, и для которого rotate является частным случаем.

Смысл Bump в том, чтобы обойти тот факт, что в Haskell нет такой вещи, как композиция на уровне типов. Невозможно записать такие операторы, как (∘), чтобы (S ∘ S) x было S (S x). Обходной путь заключается в постоянном переносе/развертывании с помощью Bump/lower.

newtype Bump p n = Bump { lower :: p (S n) }

grotate :: forall p n m a.
           (forall n. a -> p n -> p (S n)) ->
           Vec a n ->
           Vec a (S n + m) ->
           p m ->
           p (S n + m)
grotate cons Nil        (y ::: _)  zs = cons y zs
grotate cons (x ::: xs) (y ::: ys) zs = lower (grotate consS xs ys (Bump (cons y zs))) 
  where
    consS :: forall n. a -> Bump p n -> Bump p (S n)
    consS = \a -> Bump . cons a . lower 

rotate :: Vec a n -> Vec a (S n + m) -> Vec a m -> Vec a (S n + m)
rotate = grotate (:::)

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

Одноэлементные натуральные числа SNat

Прежде чем мы перейдем к exec, мы настроим некоторый механизм, который позволит нам доказать некоторые арифметические утверждения на уровне типов (которые нам нужны для того, чтобы exec выполнил проверку типов). Начнем с создания типа SNat (который является одноэлементным типом, соответствующим Nat). SNat отражает свое значение в переменной фантомного типа.

data SNat n where
  SZero :: SNat Z
  SSucc :: SNat n -> SNat (S n)

Затем мы можем сделать пару полезных функций для работы с SNat.

sub1 :: SNat (S n) -> SNat n
sub1 (SSucc x) = x

size :: Vec a n -> SNat n
size Nil = SZero
size (_ ::: xs) = SSucc (size xs)

Наконец, мы готовы доказать некоторую арифметику, а именно, что n + S m ~ S (n + m) и n + Z ~ n.

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

plusZero :: SNat n -> (n + Z) :~: n
plusZero SZero = Refl
plusZero (SSucc n) = gcastWith (plusZero n) Refl 

Определение exec

Теперь, когда у нас есть rotate, мы можем определить exec. Это определение выглядит почти так же, как и в вопросе (со списками), за исключением аннотации gcastWith <some-proof>.

exec :: Vec a (n + m) -> Vec a (S m) -> Vec a n -> Queue a
exec f r (_ ::: s) = gcastWith (plusSucc (size s) (sub1 (size r))) $ Queue f r s
exec f r Nil       = gcastWith (plusZero (sub1 (size r))) $
  let f' = rotate f r Nil in (Queue f' Nil f')

Вероятно, стоит отметить, что мы можем получить кое-что бесплатно, используя singletons. С включенными правильными расширениями следующий более читаемый код

import Data.Singletons.TH 

singletons [d|
    data Nat = Z | S Nat

    (+) :: Nat -> Nat -> Nat
    Z   + n = n
    S m + n = S (m + n)
  |]

определяет Nat, семейство типов :+ (эквивалентное моему +) и одноэлементный тип SNat (с конструкторами SZ и SS эквивалентными моим SZero и SSucc) все в одном.

person Alec    schedule 26.10.2016
comment
Это действительно очень полезно. Я сам разработал перевод Agda foldl, но еще не пробовал этот. Обратите внимание на \a -> Bump . cons a . lower = (Bump .) . (. lower) . cons = ((Bump .) . (. lower)) #. cons, которое должно быть свободным принуждением. Остается только plusZero и plusSucc для оптимизации с небезопасными преобразованиями. - person dfeuer; 30.10.2016