Sorted list in idris (insertion sort)

Question

I am writing an undergraduate thesis on usefulness of dependent types. I am trying to construct a container, that can only be constructed into a sorted list, so that it is proven sorted by construction:

import Data.So

mutual
  data SortedList : (a : Type) -> {ord : Ord a) -> Type where
    SNil : SortedList a
    SMore : (ord : Ord a) => (el: a) -> (xs : SortedList a) -> So (canPrepend el xs) -> SortedList a

  canPrepend : Ord a => a -> SortedList a -> Bool
  canPrepend el SNil = True
  canPrepend el (SMore x xs prf) = el <= x

SMore requires a runtime proof that the element being prepended is smaller or equal than the smallest (first) element in the sorted list.

To sort an unsorted list, I have created a function sinsert that takes a sorted list and inserts an element and returns a sorted list:

sinsert : (ord : Ord a) => SortedList a {ord} -> a -> SortedList a {ord}
sinsert SNil el = SMore el SNil Oh
sinsert (SMore x xs prf) el = either 
  (\p => 
    -- if el <= x we can prepend it directly
    SMore el (SMore x xs prf) p
  ) 
  (\np =>  
    -- if not (el <= x) then we have to insert it in the tail somewhere
    -- does not (el <= x) imply el > x ???

    -- we construct a new tail by inserting el into xs
    let (SMore nx nxs nprf) = (sinsert xs el) in
    -- we get two cases:
    -- 1) el was prepended to xs and is now the 
    --    smalest element in the new tail
    --    we know that el == nx
    --    therefor we can substitute el with nx
    --    and we get nx > x and this also means 
    --    x < nx and also x <= nx and we can
    --    prepend x to the new tail
    -- 2) el was inserted somewhere deeper in the
    --    tail. The first element of the new tail
    --    nx is the same as it was in the original
    --    tail, therefor we can prepend x to the
    --    new tail based on the old proof `prf`
    either 
      (\pp => 
        SMore x (SMore nx nxs nprf) ?iins21
      )
      (\npp => 
        SMore x (SMore nx nxs nprf) ?iins22
      ) (choose (el == nx))
  ) (choose (el <= x))

I am having trouble constructing the proofs (?iins21, ?iins22) and I would appreciate some help. I may be relying on an assumption that does not hold, but I do not see it.

I would also like to encourage you to provide a better solution for constructing a sorted list (maybe a normal list with a proof value that it is sorted?)

Answer 1

I think that the main problem with your proofs there is that, as Cactus noted in a comment, is that you don't have properties like transitivity and antisymmetry that are needed for the proof of insertion sort to work. However, you can still make a polymorphic container: the Poset class from Decidable.Order in contrib contains exactly the properties that you want. However, Decidable.Order.Order is better in this case since it encapsulates the totality of the relation, ensuring that for any two elements we can get a proof that one of them is smaller.

I have another insertion sort algorithm that I was working on anyway that uses Order; it also explicitly decomposes the distintion between Empty and NonEmpty lists and keeps the max (the largest element that can now be added to the list) value in the type of NonEmpty lists, which simplifies proofs somewhat.

I am also in the process of learning Idris, so this code may not be the most idiomatic; also, many thanks to Melvar and {AS} on the #idris Freenode IRC channel for helping me figure out why previous versions didn't work.

The weird with (y) | <pattern matches on y> syntax in sinsert is there in order to bind y for assert_smaller, since, for some reason, y@(NonEmpty xs) does not work.

I hope this is helpful!

import Data.So
import Decidable.Order

%default total

data NonEmptySortedList :  (a : Type)
                        -> (po : a -> a -> Type)
                        -> (max : a)
                        -> Type where
  SOne   : (el : a) -> NonEmptySortedList a po el
  SMany  :  (el : a)
         -> po el max
         -> NonEmptySortedList a po max
         -> NonEmptySortedList a po el

data SortedList : (a : Type) -> (po : a -> a -> Type) -> Type where
  Empty : SortedList _ _
  NonEmpty : NonEmptySortedList a po _ -> SortedList a po

head : NonEmptySortedList a _ _ -> a
head (SOne a) = a
head (SMany a _ _) = a

tail : NonEmptySortedList a po _ -> SortedList a po
tail (SOne _) = Empty
tail (SMany _ _ xs) = NonEmpty xs

max : {m : a} -> NonEmptySortedList a _ m -> a
max {m} _ = m

newMax : (Ordered a po) => SortedList a po -> a -> a
newMax Empty x = x
newMax (NonEmpty xs) x = either (const x)
                                (const (max xs))
                                (order {to = po} x (max xs))

either' :  {P : Either a b -> Type}
        -> (f : (l : a) -> P (Left l))
        -> (g : (r : b) -> P (Right r))
        -> (e : Either a b) -> P e
either' f g (Left l) = f l
either' f g (Right r) = g r

sinsert :  (Ordered a po)
        => (x : a)
        -> (xs : SortedList a po)
        -> NonEmptySortedList a po (newMax xs x)
sinsert x y with (y)
  | Empty = SOne {po = po} x
  | (NonEmpty xs) = either' { P = NonEmptySortedList a po
                            . either (const x) (const (max xs))
                            }
                            insHead
                            insTail
                            (order {to = po} x (max xs))
  where insHead : po x (max xs) -> NonEmptySortedList a po x
        insHead p = SMany x p xs
        max_lt_newmax : po (max xs) x -> po (max xs) (newMax (tail xs) x)
        max_lt_newmax max_xs_lt_x with (xs)
          | (SOne _) = max_xs_lt_x
          | (SMany _ max_xs_lt_max_xxs xxs)
            = either' { P = po (max xs) . either (const x)
                                                 (const (max xxs))}
                      (const {a = po (max xs) x} max_xs_lt_x)
                      (const {a = po (max xs) (max xxs)} max_xs_lt_max_xxs)
                      (order {to = po} x (max xxs))
        insTail : po (max xs) x -> NonEmptySortedList a po (max xs)
        insTail p = SMany (max xs)
                          (max_lt_newmax p)
                          (sinsert x (assert_smaller y (tail xs)))

insSort :  (Ordered a po) => List a -> SortedList a po
insSort = foldl (\xs, x => NonEmpty (sinsert x xs)) Empty