Lemma about Sortedness of concatenated lists - sorting

I have the following inductive definition for sortedness of a list:
Class DecTotalOrder (A : Type) := {
leb : A -> A -> bool;
leb_total_dec : forall x y, {leb x y}+{leb y x};
leb_antisym : forall x y, leb x y -> leb y x -> x = y;
leb_trans : forall x y z, leb x y -> leb y z -> leb x z }.
Inductive Sorted {A} {dto : DecTotalOrder A} : list A -> Prop :=
| Sorted_0 : Sorted []
| Sorted_1 : forall x, Sorted [x]
| Sorted_2 : forall x y, leb x y ->
forall l, Sorted (y :: l) ->
Sorted (x :: y :: l).
And the following two definitions to declare that an element x is smaller or equal than each element of the list (LeLst) and bigger or equal than each element of the list (LstLe) :
Definition LeLst {A} {dto : DecTotalOrder A} (x : A) (l : list A) :=
List.Forall (leb x) l.
Definition LstLe {A} {dto : DecTotalOrder A} (x : A) (l : list A) :=
List.Forall (fun y => leb y x) l.
I am trying to prove the following lemma about sortedness which basically states that if we know that h is greater or equal to each element in l and h is smaller or equal than each element in l' we can put it in between the two:
Lemma lem_lstle_lelst {A} {dto: DecTotalOrder A} : forall h l l',
LstLe h l -> LeLst h l' -> Sorted (l ++ h :: l').
It seems very intuitiv but i get stuck every time in the proof. This is my current attempt:
Lemma lem_lstle_lelst {A} {dto: DecTotalOrder A} : forall h l l',
LstLe h l -> LeLst h l' -> Sorted (l ++ h :: l').
Proof.
intros h l l' H_LstLe.
induction H_LstLe.
- intros. simpl. Search (Sorted (_ :: _)).
unfold LeLst in H. Search (List.Forall _ _).
induction l'.
+ constructor.
+ Search (List.Forall _ _).
constructor.
{ hauto use: List.Forall_inv. }
{ generalize (List.Forall_inv_tail H).
intros.
generalize (List.Forall_inv H).
intros.
generalize (IHl' H0).
intros.
generalize (lem_sorted_tail H2).
intros.
However I get stuck here, because the hypotheses just don't seem strong enough:
1 subgoal
A : Type
dto : DecTotalOrder A
h, a : A
l' : list A
H : List.Forall (fun x : A => leb h x) (a :: l')
IHl' : List.Forall (fun x : A => leb h x) l' -> Sorted (h :: l')
H0 : List.Forall (fun x : A => leb h x) l'
H1 : leb h a
H2 : Sorted (h :: l')
H3 : Sorted l'
______________________________________(1/1)
Sorted (a :: l')
I'd be really glad if someone could give me a hint, maybe something is wrong with my definitions and that is why i can't get on with the proof? Or am I just missing out on some tactics that I could use?
Here is a list of lemmata allready proven about sortedness:
Lemma lem_sorted_tail {A} {dto : DecTotalOrder A}{l x} :
Sorted (x :: l) -> Sorted l.
Lemma lem_sorted_prepend {A} {dto: DecTotalOrder A} : forall x l l',
Sorted((x :: l) ++ l') -> Sorted(l ++ l').
Lemma lem_sort_conc_mid {A} {dto: DecTotalOrder A} : forall x y l,
Sorted (x :: y :: l) -> Sorted (x :: l).

As stated in a comment the Lemma is not provable.
Instead its defintion has to be expanded by adding properties about the sortedness of l
and l':
Lemma lem_lstle_lelst {A} {dto: DecTotalOrder A} : forall h l l',
LstLe h l -> LeLst h l' -> Sorted l -> Sorted l' -> Sorted (l ++ h :: l').
This is possible to prove with the following:
Proof.
intros h l l' H_Lstle_h_l.
induction H_Lstle_h_l.
- intros H_Lelst_h_l' H_Sort_1 H_Sort_2.
simpl;inversion H_Lelst_h_l';sauto.
- intros H_Lelst_h_l' H_Sort_1 H_Sort_2.
generalize (lem_sorted_tail H_Sort_1).
intros H_Sort_l.
generalize (IHH_Lstle_h_l H_Lelst_h_l' H_Sort_l H_Sort_2).
intros H_Sort_l_h_l'.
generalize (lem_sorted_lelst x l H_Sort_1).
intros H_Lelst_x_l.
hauto use: lem_Sorted_prepend_inv.
Qed.
introducing new helper lemmata:
Lemma lem_Sorted_prepend_inv {A} {dto: DecTotalOrder A} :
forall x h l l', leb x h -> Sorted(l ++ h :: l') -> LeLst x l -> Sorted(x::l++ h::l').
Lemma lem_sorted_lelst {A} {dto: DecTotalOrder A} :
forall x l, Sorted(x :: l) -> LeLst x l.

Related

How to build a proof of correctness in coq for elements_tr

I want to build a proof of correctness for elements_tr...
It is actually related to some sort of reimplementation of BSTs with int keys.
Elements_tr is defined as follows:
Fixpoint elements_aux {V : Type} (t : tree V)
(acc : list (key * V)) : list (key * V) :=
match t with
| E => acc
| T l k v r => elements_aux l ((k, v) :: elements_aux r acc)
end.
Definition elements_tr {V : Type} (t : tree V) : list (key * V) :=
elements_aux t [].
However I am unable to build such proof as I continuously get false = true...
What Am I doing wrong?
Corollary elements_tr_correct :
forall (V : Type) (k : key) (v d : V) (t : tree V),
BST t ->
In (k, v) (elements_tr t) ->
bound k t = true /\ lookup d k t = v.
Proof.
intros.
split.
induction t.
- unfold elements_tr.
unfold elements. simpl.
admit.
- admit.
- admit.
Admitted.
Bellow is the full code to run...
From Coq Require Import String.
From Coq Require Export Arith.
From Coq Require Export Lia.
Notation "a >=? b" := (Nat.leb b a) (at level 70) : nat_scope.
Notation "a >? b" := (Nat.ltb b a) (at level 70) : nat_scope.
From Coq Require Export Lists.List.
Export ListNotations.
Definition key := nat.
Inductive tree (V : Type) : Type :=
| E
| T (l : tree V) (k : key) (v : V) (r : tree V).
Arguments E {V}.
Arguments T {V}.
Definition ex_tree : tree string :=
(T (T E 2 "two" E) 4 "four" (T E 5 "five" E))%string.
Definition empty_tree {V : Type} : tree V := E.
Fixpoint bound {V : Type} (x : key) (t : tree V) :=
match t with
| E => false
| T l y v r => if x <? y then bound x l
else if x >? y then bound x r
else true
end.
Fixpoint lookup {V : Type} (d : V) (x : key) (t : tree V) : V :=
match t with
| E => d
| T l y v r => if x <? y then lookup d x l
else if x >? y then lookup d x r
else v
end.
Fixpoint insert {V : Type} (x : key) (v : V) (t : tree V) : tree V :=
match t with
| E => T E x v E
| T l y v' r => if x <? y then T (insert x v l) y v' r
else if x >? y then T l y v' (insert x v r)
else T l x v r
end.
Fixpoint ForallT {V : Type} (P: key -> V -> Prop) (t: tree V) : Prop :=
match t with
| E => True
| T l k v r => P k v /\ ForallT P l /\ ForallT P r
end.
Inductive BST {V : Type} : tree V -> Prop :=
| BST_E : BST E
| BST_T : forall l x v r,
ForallT (fun y _ => y < x) l ->
ForallT (fun y _ => y > x) r ->
BST l ->
BST r ->
BST (T l x v r).
Hint Constructors BST.
Ltac inv H := inversion H; clear H; subst.
Inductive reflect (P : Prop) : bool -> Set :=
| ReflectT : P -> reflect P true
| ReflectF : ~ P -> reflect P false.
Theorem iff_reflect : forall P b, (P <-> b = true) -> reflect P b.
Proof.
intros P b H. destruct b.
- apply ReflectT. rewrite H. reflexivity.
- apply ReflectF. rewrite H. intros H'. inversion H'.
Qed.
Lemma eqb_reflect : forall x y, reflect (x = y) (x =? y).
Proof.
intros x y. apply iff_reflect. symmetry.
apply Nat.eqb_eq.
Qed.
Lemma ltb_reflect : forall x y, reflect (x < y) (x <? y).
Proof.
intros x y. apply iff_reflect. symmetry.
apply Nat.ltb_lt.
Qed.
Lemma leb_reflect : forall x y, reflect (x <= y) (x <=? y).
Proof.
intros x y. apply iff_reflect. symmetry.
apply Nat.leb_le.
Qed.
Hint Resolve ltb_reflect leb_reflect eqb_reflect : bdestruct.
Ltac bdestruct X :=
let H := fresh in let e := fresh "e" in
evar (e: Prop);
assert (H: reflect e X); subst e;
[eauto with bdestruct
| destruct H as [H|H];
[ | try first [apply not_lt in H | apply not_le in H]]].
Lemma ForallT_insert : forall (V : Type) (P : key -> V -> Prop) (t : tree V),
ForallT P t -> forall (k : key) (v : V),
P k v -> ForallT P (insert k v t).
Proof.
intros V P t.
induction t; intros H k' v' Pkv.
- simpl. auto.
- simpl in *.
destruct H as [H1 [H2 H3]].
bdestruct (k >? k').
+ simpl. repeat split.
* assumption.
* apply (IHt1 H2 k' v' Pkv).
* assumption.
+ bdestruct (k' >? k).
++ simpl. repeat split.
* assumption.
* assumption.
* apply (IHt2 H3 k' v' Pkv).
++ simpl. repeat split.
* assumption.
* assumption.
* assumption.
Qed.
Fixpoint elements {V : Type} (t : tree V) : list (key * V) :=
match t with
| E => []
| T l k v r => elements l ++ [(k, v)] ++ elements r
end.
Fixpoint elements_aux {V : Type} (t : tree V)
(acc : list (key * V)) : list (key * V) :=
match t with
| E => acc
| T l k v r => elements_aux l ((k, v) :: elements_aux r acc)
end.
Definition elements_tr {V : Type} (t : tree V) : list (key * V) :=
elements_aux t [].
Corollary elements_tr_correct :
forall (V : Type) (k : key) (v d : V) (t : tree V),
BST t ->
In (k, v) (elements_tr t) ->
bound k t = true /\ lookup d k t = v.
Proof.
intros.
split.
induction t.
- unfold elements_tr.
unfold elements. simpl.
admit.
- admit.
- admit.
Admitted.

Error with using sort on type a in Haskell

I am pretty new to Haskell and I am trying to write a function neighbours :: Int -> Metric a -> Point a -> [Point a] -> [Point a] such that neighbours k d p xs returns a list of the k nearest neighbours, in distance order, according to metric d to point p in the list xs of points. My code is
type Point a = (a, a)
type Metric a = Point a -> Point a -> Double
type Tuple a = (Double, Point a)
create:: Metric a -> Point a -> [Point a] -> [Tuple a] -> [Tuple a]
create d p (x:xs) ys | length xs == 0 = sort(((d p x), x) : ys)
| otherwise = create d p xs (((d p x), x) : ys)
takeP:: Tuple a -> Point a
takeP (_,p) = p
pList:: [Tuple a] ->[Point a]-> [Point a]
pList (x:xs) ys | length xs == 0 = reverse (takeP x : ys)
| otherwise = pList xs (takeP x : ys)
neighbours :: Int -> Metric a -> Point a -> [Point a] -> [Point a]--
neighbours k d p xs = take k (pList (create d p xs []) [])
But I am getting an error on sort which is:
* No instance for (Ord a) arising from a use of `sort'
Possible fix:
add (Ord a) to the context of
the type signature for:
create :: forall a.
Metric a -> Point a -> [Point a] -> [Tuple a] -> [Tuple a]
* In the expression: sort (((d p x), x) : ys)
In an equation for `create':
create d p (x : xs) ys
| length xs == 0 = sort (((d p x), x) : ys)
| otherwise = create d p xs (((d p x), x) : ys)
I used type Point a = (Int, Int) at first and it was working fine but in the specification it is required that Point is type Point a = (a, a) which caused my error. The other problem is that I cannot change the function types so I can't just add (Ord a) as proposed.
Is there a way to sort the Tuples' list by the first variable without encountering errors?
In your create function, you make use of sort :: Ord a => [a] -> [a]:
… = sort (((d p x), x) : ys)
this thus means that type of objects that we are sorting, in this case Tuple a, needs to be an instance of the Ord typeclass. A 2-tuple is an instance of the Ord typeclass, if both the type of the items are instances of Ord as well, so in this case Double and Point a. Since Point a is also a 2-tuple, but of two as, this thus means that Tuple a is an instance of Ord, if a is an instance of Ord. You thus should add a type constraint:
create :: Ord a => Metric a -> Point a -> [Point a] -> [Tuple a] -> [Tuple a]
create d p (x:xs) ys | length xs == 0 = sort(((d p x), x) : ys)
| otherwise = create d p xs (((d p x), x) : ys)
The create function makes use of some anti-patterns like using length, which takes linear time. You can in fact rewrite this to sorting a mapping:
create :: Ord a => Metric a -> Point a -> [Point a] -> [Tuple a]
create d p = sort . map f
where f x = (d p x, x)
This removes the ys parameter, which here only seems to be used as a accumulator.
If you wish to only sort on the first item of the 2-tuple, you can make use of sortOn :: Ord b => (a -> b) -> [a] -> [a]:
create :: Metric a -> Point a -> [Point a] -> [Tuple a]
create d p = sortOn fst . map f
where f x = (d p x, x)

How to define the range function on a relation in Agda (set theory)

I'm trying to find a way to prove a couple of set theory-based problems in Agda, but I'm having a hard time defining the function range.
I took the definition of Subset from Proving decidability of subset in Agda and built on top of it. This is what I got so far:
open import Data.Bool as Bool using (Bool; true; false; T; _∨_; _∧_)
open import Data.Unit using (⊤; tt)
open import Level using (Level; _⊔_; 0ℓ) renaming (suc to lsuc)
open import Data.Product using (_×_) renaming (_,_ to ⟨_,_⟩)
Subset : ∀ {α} (A : Set α) -> Set _
Subset A = A → Bool
_∈_ : ∀ {α} {A : Set α} → A → Subset A → Set
a ∈ p = T (p a)
Relation : ∀ {α β} (A : Set α) (B : Set β) → Set (α ⊔ β)
Relation A B = Subset (A × B)
Range : ∀ {A B : Set} → Relation A B → Subset B
Range = ?
_⊆_ : ∀ {A : Set} → Subset A → Subset A → Set
A ⊆ B = ∀ x → x ∈ A → x ∈ B
wholeSet : ∀ (A : Set) → Subset A
wholeSet _ = λ _ → true
∀subset⊆set : ∀ {A : Set} {sub : Subset A} → sub ⊆ wholeSet A
∀subset⊆set = λ _ _ → tt
_∩_ : ∀ {A : Set} → Subset A → Subset A → Subset A
A ∩ B = λ x → (A x) ∧ (B x)
⊆-range-∩ : ∀ {A B : Set}
(F G : Relation A B)
→ Range (F ∩ G) ⊆ (Range F ∩ Range G)
⊆-range-∩ f g = ?
The problem is that Range takes as an input a function of type A × B → Bool and must return a function B → Bool such that a value B is true iff there exists a value A × B which is true in the initial function. Basically, I would need to iterate through all values of A to know whether B is in the range of the relation. Something impossible to do, isn't it?
There must be surely a better way to implement Range, doesn't it?
Here is the implementation I suggest :
open import Data.Unit
open import Data.Product renaming (_,_ to ⟨_,_⟩)
open import Data.Sum
open import Function
Change the definition of Subset to go to Set instead of Bool. I know this might be controversial, but in my experience this has always been the way to go, and also this is how subsets are implemented in the standard library. (By the way, if you are interested to see the implementation in the standard library, it is in the file Relation/Unary.agda). I also removed the levels of universe since you didn't use them in your later definitions, which led me to clean up the types of the module.
Subset : Set → Set₁
Subset A = A → Set
The definition of membership is changed accordingly.
_∈_ : ∀ {A} → A → Subset A → Set
a ∈ P = P a
Relation : ∀ A B → Set₁
Relation A B = Subset (A × B)
The range becomes then very natural : b is in the range of R if their exists an a such as R of a and b holds.
Range : ∀ {A B} → Relation A B → Subset B
Range R b = ∃ (R ∘ ⟨_, b ⟩) -- equivalent to ∃ \a → R ⟨ a , b ⟩
_⊆_ : ∀ {A} → Subset A → Subset A → Set
A ⊆ B = ∀ x → x ∈ A → x ∈ B
Not much to say about the wholeset
wholeSet : ∀ A → Subset A
wholeSet _ _ = ⊤
∀subset⊆set : ∀ {A sub} → sub ⊆ wholeSet A
∀subset⊆set _ _ = tt
_∩_ : ∀ {A} → Subset A → Subset A → Subset A
(A ∩ B) x = x ∈ A × x ∈ B
The proof of range inclusion is done very naturally with this definition.
⊆-range-∩ : ∀ {A B} {F G : Relation A B} → Range (F ∩ G) ⊆ (Range F ∩ Range G)
⊆-range-∩ _ ⟨ a , ⟨ Fab , Gab ⟩ ⟩ = ⟨ ⟨ a , Fab ⟩ , ⟨ a , Gab ⟩ ⟩
I also took the liberty to add the corresponding property about union.
_⋃_ : ∀ {A} → Subset A → Subset A → Subset A
(A ⋃ B) x = x ∈ A ⊎ x ∈ B
⋃-range-⊆ : ∀ {A B} {F G : Relation A B} → (Range F ⋃ Range G) ⊆ Range (F ⋃ G)
⋃-range-⊆ _ (inj₁ ⟨ a , Fab ⟩) = ⟨ a , inj₁ Fab ⟩
⋃-range-⊆ _ (inj₂ ⟨ a , Gab ⟩) = ⟨ a , inj₂ Gab ⟩

Sorting algorithm in Haskell

I am trying to implement a very trivial sorting algorithm in Haskell. It compiles but keeps giving me incorrect outputs.
Here is the code
import Data.List
minimum' :: (Ord a) => [a] -> a
minimum' (x:xs) = foldr (\ x y -> if x <= y then x else y) x xs
qsrt :: (Ord a) => [a] -> [a]
qsrt [] = []
qsrt l#(x:xs) = minimum' l : qsrt xs
Any thoughts?
The logic error is that qsrt takes the minimum element of l and then skips x, but x would only be the minimum element of l by accident so you're usually skipping the wrong element.
Just as an addendum to Rein Henrichs's answer, I managed to craft a correct version of the above using a filter.
import Data.List
minimum' :: (Ord a) => [a] -> a
minimum' (x:xs) = foldl' (\ x y -> if x <= y then x else y) x xs
srt :: (Ord a) => [a] -> [a]
srt [] = []
srt l = ml : srt (delete ml l)
where ml = minimum' l

Existential quantifier in coq impredicative logic (System F)

I was trying to code into Coq logical connectives encoded in lambda calculus with type à la System F. Here is the bunch of code I wrote (standard things, I think)
Definition True := forall X: Prop, X -> X.
Lemma I: True.
Proof.
unfold True. intros. apply H.
Qed.
Section s.
Variables A B: Prop.
(* conjunction *)
Definition and := forall X: Prop, (A -> B -> X) -> X.
Infix "/\" := and.
Lemma and_intro: A -> B -> A/\B.
Proof.
intros HA HB. split.
apply HA.
apply HB.
Qed.
Lemma and_elim_l: A/\B -> A.
Proof.
intros H. destruct H as [HA HB]. apply HA.
Qed.
Lemma and_elim_r: A/\B -> B.
Proof.
intros H. destruct H as [HA HB]. apply HB.
Qed.
(* disjunction *)
Definition or := forall X:Prop, (A -> X) -> (B -> X) -> X.
Infix "\/" := or.
Lemma or_intro_l: A -> A\/B.
intros HA. left. apply HA.
Qed.
Lemma or_elim: forall C:Prop, A \/ B -> (A -> C) -> (B -> C) -> C.
Proof.
intros C HOR HAC HBC. destruct HOR.
apply (HAC H).
apply (HBC H).
Qed.
(* falsity *)
Definition False := forall Y:Prop, Y.
Lemma false_elim: False -> A.
Proof.
unfold False. intros. apply (H A).
Qed.
End s.
Basically, I wrote down the elimination and introduction laws for conjunction, disjunction, true and false. I am not sure of having done thing correctly, but I think that things should work that way. Now I would like to define the existential quantification, but I have no idea of how to proceed. Does anyone have a suggestion?
Existential quantification is just a generalization of conjunction, where the type of the second component of the pair depends on the value of the first component. When there's no dependency they're equivalent:
Goal forall P1 P2 : Prop, (exists _ : P1, P2) <-> P1 /\ P2.
Proof. split. intros [H1 H2]. eauto. intros [H1 H2]. eauto. Qed.
Coq'Art has a section on impredicativity starting at page 130.
Definition ex (T1 : Type) (P1 : T1 -> Prop) : Prop :=
forall P2 : Prop, (forall x1, P1 x1 -> P2) -> P2.
Notation "'exists' x1 .. x2 , P1" :=
(ex (fun x1 => .. (ex (fun x2 => P1)) ..))
(at level 200, x1 binder, right associativity,
format "'[' 'exists' '/ ' x1 .. x2 , '/ ' P1 ']'") : type_scope.
The problem with impredicative definitions (unless I'm mistaken) is that there's no dependent elimination. It's possible prove
forall (A : Type) (P : A -> Prop) (Q : Prop),
(forall x : A, P x -> Q) -> (exists x, P x) -> Q,
but not
forall (A : Type) (P : A -> Prop) (Q : (exists x, P x) -> Prop),
(forall (x : A) (H : P x), Q (ex_intro P x H)) ->
forall H : exists x, P x, Q H

Resources