The proof that typing derivations are unique in the simply-typed lambda calculus is trivial on paper. The proof that I am familiar with proceeds by complete induction on typing derivations. However, I am having trouble proving that typing derivations, represented via the type of typing derivations, are unique. Here, the predicate dec Γ x τ is true if the variable x has type τ in environment Γ. The typing predicate J is defined as usual, simply reading off the typing rules for the simply-typed lambda calculus:
Inductive J (Γ : env) : term → type → Set :=
| tvar : ∀ x τ, dec Γ x τ → J γ (var x) τ
| tabs : ∀ τ₁ τ₂ e, J (τ₁ :: γ) e τ₂ → J γ (abs τ₁ e) (arr τ₁ τ₂)
| tapp : ∀ τ₁ τ₂ e₁ e₂, J γ e₁ (arr τ₁ τ₂) → J γ e₂ τ₁ → J γ (app e₁ e₂) τ₂.
I am having trouble exposing the structure of a term of type J when proving that typing derivations are unique. For instance, I can induct on either d1 or d2 in the following lemma, but cannot induction on d1 then destruct d2 and conversely. The error message given by Coq (abstracting over terms leads to a term which is ill-typed) is slightly obscure, and the Coq wiki doesn't provide any help. For reference, this is the lemma that I am trying to prove:
Lemma unique_derivation : ∀ Γ e τ (d₁ d₂ : J Γ e τ), d₁ = d₂.
I have no problems when inducting on terms, for instance, when proving that the types are unique.
EDIT: I added the the minimal number of definitions necessary to state the result that I am having trouble with. In response to huitseeker's comment, the sort of J was chosen because I wanted to reason about typing derivations as structured objects in order to perform operations like extraction and prove results like uniqueness, which I haven't done in Coq before.
In response to the first part of the comment, I can perform induction on either d1 or d2, but after performing induction I cannot use destruct, case, or induction on the remaining term. This means that I cannot expose the structure of both d1 and d2 in order to reason about both proof trees. The error that I receive when I attempt to do so, says that abstracting over the remaining terms leads to a term which is ill-typed.
Require Import Unicode.Utf8.
Require Import Utf8_core.
Require Import List.
Inductive type : Set :=
| tau : type
| arr : type → type → type.
Inductive term : Set :=
| var : nat → term
| abs : type → term → term
| app : term → term → term.
Definition dec (Γ : list type) x τ : Prop :=
nth_error γ x = Some τ.
Inductive J (Γ : list type) : term → type → Set :=
| tvar : ∀ x τ, dec Γ x τ → J Γ (var x) τ
| tabs : ∀ τ₁ τ₂ e, J (τ₁ :: Γ) e τ₂ → J Γ (abs τ₁ e) (arr τ₁ τ₂)
| tapp : ∀ τ₁ τ₂ e₁ e₂, J Γ e₁ (arr τ₁ τ₂) → J Γ e₂ τ₁ → J Γ (app e₁ e₂) τ₂.
Lemma derivations_unique : ∀ Γ e τ (d1 d2 : J Γ e τ), d1 = d2.
Proof. admit. Qed.
I've tried experimenting with dependent induction and several results from the Coq.Logic library, but without success. That derivations are unique seems like it should be an easy proposition to prove.
You have three problems.
One is the purely technical problem of making the induction work. You can solve the main difficulty with the dependent destruction tactic (courtesy of Matthieu Sozeau on the Coq-Club mailing list). This is an inversion tactic. I don't pretend to understand how it works under the hood.
A second difficulty is in one of the base cases, for environments. You need to prove that equality proofs in list nat are unique; this holds on all decidable domains, and the tools for that are in the Eqdep_dec module.
A third difficulty is problem-related. The unicity of derivations does not follow by a direct induction over the term or derivation structure, because your terms do not carry enough type information to reconstruct the derivation. In an application app e1 e2, there is no direct way to know the type of the argument. In the simply-typed lambda calculus, type reconstruction does hold, and is easy to prove; in larger calculi (with polymorphism or subtyping) it might not hold (for example, with ML-style polymorphism, there is a unique principal type scheme and associated derivation, but there are many derivations using base types).
Here's a quickie proof of your lemma. I omitted the proof of the unicity of environment lookups. You can induct on the term structure or on the derivation structure — this simple proof works because they're the same.
Require Import Unicode.Utf8.
Require Import Utf8_core.
Require Import List.
Require Import Program.Equality.
Inductive type : Set :=
| tau : type
| arr : type → type → type.
Inductive term : Set :=
| var : nat → term
| abs : type → term → term
| app : term → term → term.
Definition dec (Γ : list type) x τ : Prop :=
nth_error Γ x = Some τ.
Inductive J (Γ : list type) : term → type → Set :=
| tvar : ∀ x τ, dec Γ x τ → J Γ (var x) τ
| tabs : ∀ τ₁ τ₂ e, J (τ₁ :: Γ) e τ₂ → J Γ (abs τ₁ e) (arr τ₁ τ₂)
| tapp : ∀ τ₁ τ₂ e₁ e₂, J Γ e₁ (arr τ₁ τ₂) → J Γ e₂ τ₁ → J Γ (app e₁ e₂) τ₂.
Lemma unique_variable_type :
forall G x t1 t2, dec G x t1 -> dec G x t2 -> t1 = t2.
Proof.
unfold dec; intros.
assert (value t1 = value t2). congruence.
inversion H1. reflexivity.
Qed.
Axiom unique_variable_type_derivation :
forall G x t (d1 d2 : dec G x t), d1 = d2.
Lemma unique_type : forall G e t1 t2 (d1 : J G e t1) (d2 : J G e t2), t1 = t2.
Proof.
intros G e; generalize dependent G.
induction e; intros.
dependent destruction d1. dependent destruction d2.
apply (unique_variable_type G n); assumption.
dependent destruction d1. dependent destruction d2.
firstorder congruence.
dependent destruction d1. dependent destruction d2.
assert (arr τ₁ τ₂ = arr τ₁0 τ₂0).
firstorder congruence.
congruence.
Qed.
Lemma unique_derivation : forall G e t (d1 d2 : J G e t), d1 = d2.
Proof.
intros G e; generalize dependent G.
induction e; intros.
dependent destruction d1. dependent destruction d2.
f_equal. solve [apply (unique_variable_type_derivation G n)].
dependent destruction d1. dependent destruction d2.
f_equal. solve [apply IHe].
dependent destruction d1. dependent destruction d2.
assert (τ₁ = τ₁0). 2: subst τ₁.
solve [eapply unique_type; eauto].
f_equal; solve [firstorder].
Qed.
Related
The two definitions are these:
Inductive perm : list nat -> list nat -> Prop :=
| perm_eq: forall l1, perm l1 l1
| perm_swap: forall x y l1, perm (x :: y :: l1) (y :: x :: l1)
| perm_hd: forall x l1 l2, perm l1 l2 -> perm (x :: l1) (x :: l2)
| perm_trans: forall l1 l2 l3, perm l1 l2 -> perm l2 l3 -> perm l1 l3.
Fixpoint num_oc (x: nat) (l: list nat): nat :=
match l with
| nil => 0
| h::tl =>
if (x =? h) then S (num_oc x tl) else num_oc x tl
end.
Definition equiv l l' := forall n:nat, num_oc n l = num_oc n l'.
The theorem that I'm trying to prove is this:
Theorem perm_equiv: forall l l', equiv l l' <-> perm l l'.
The perm -> equiv direction is ready, but the equiv -> perm direction isn't working. I tried this strategy:
- intro H. unfold equiv in H.
generalize dependent l'.
induction l.
+ intros l' H. admit.
+ intros l' H. simpl in H.
generalize dependent l'.
intro l'. induction l'.
* intro H. specialize (H a).
rewrite <- beq_nat_refl in H.
simpl in H. Search False.
inversion H.
destruct (a =? a0) eqn:Ha.
** simpl in H. inversion H.
** apply False_ind.
apply beq_nat_false in Ha.
apply Ha. reflexivity.
* destruct (x =? a). *).
I'm out of ideas for the first branch, so it's admitted for now, but the second one is crashing at the destruct tactic. How do I proceed with this proof?
You should attempt to write a proof on paper before attempting to encode it in Coq. Here is a possible strategy.
Nil case
When l = [], you know that every number in l' occurs zero times because of H. It should be possible to prove an auxiliary lemma that implies that l' = [] in this case. You can conclude with perm_eq.
Cons case
Suppose that l = x :: xs. Let n = num_oc x xs. We know that num_oc x l' = S n by H. You should be able to prove a lemma saying that l' is of the form ys1 ++ x :: ys2 where num_oc x ys1 = 0. This would allow you to show that equiv xs (ys1 ++ ys2). By the induction hypothesis, you find that perm xs (ys1 ++ ys2). Hence, by perm_hd, perm (x :: xs) (x :: ys1 ++ ys2).
You should be able to prove that perm is a transitive relation and that perm (x :: ys1 ++ ys2) (ys1 ++ x :: ys2) holds. Combined with the last assertion, this will yield perm l l'.
The main takeaway in this case is that attempting to write every proof with single, direct induction is only going to work for the simplest results. You should start thinking about how to break down your results into simpler intermediate lemmas that you can combine to prove your final result.
I want to prove that when receiving a binary search tree as an argument, the [insert] function generates another binary search tree.
Insert Function:
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.
I have written the following proof. However I am stuck in the middle of the proof.
I can see what I have to proove BST (T t1 k v t2), but I am unable to proceed by applying the hypothesis H : BST (T t1 k0 v0 t2)...
What can I do next in order to proove that
Theorem insert_BST : forall (V : Type) (k : key) (v : V) (t : tree V),
BST t -> BST (insert k v t).
Proof.
intros V k v t.
induction t; intros H.
- simpl. apply BST_T.
+ simpl. constructor.
+ simpl. constructor.
+ constructor.
+ constructor.
- inversion H; subst.
simpl in *.
bdestruct (k0 >? k).
+ apply BST_T.
* apply ForallT_insert.
apply H4.
apply H0.
* apply H5.
* apply IHt1.
apply H6.
* apply H7.
+ bdall.
** constructor. apply H4.
* apply ForallT_insert.
assumption.
assumption.
*apply H6.
* apply IHt2 in H7.
apply H7.
** constructor; apply H.
The whole code is here down below:
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.
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 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.
(** Nossa primeira tarefa será mostrar que a função [insert] de fato preserva esta invariante. Vamos então formalizar a invariante de uma árvore binária de busca. Faremos isto com a ajuda da função [ForallT]: *)
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.
Theorem reflect_iff : forall P b, reflect P b -> (P <-> b = true).
Proof.
intros P b H; split.
- intro H'.
inv H.
+ reflexivity.
+ contradiction.
- intro H'; subst.
inv H; assumption.
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]]].
Theorem empty_tree_BST : forall (V : Type),
BST (#empty_tree V).
Proof.
unfold empty_tree.
constructor;try lia.
Qed.
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.
Ltac bdestruct_guard :=
match goal with
| |- context [ if ?X =? ?Y then _ else _ ] => bdestruct (X =? Y)
| |- context [ if ?X <=? ?Y then _ else _ ] => bdestruct (X <=? Y)
| |- context [ if ?X <? ?Y then _ else _ ] => bdestruct (X <? Y)
end.
Ltac bdall :=
repeat (simpl; bdestruct_guard; try lia; auto).
Theorem insert_BST : forall (V : Type) (k : key) (v : V) (t : tree V),
BST t -> BST (insert k v t).
Proof.
intros V k v t.
induction t; intros H.
- simpl. apply BST_T.
+ simpl. constructor.
+ simpl. constructor.
+ constructor.
+ constructor.
- inversion H; subst.
simpl in *.
bdestruct (k0 >? k).
+ apply BST_T.
* apply ForallT_insert.
apply H4.
apply H0.
* apply H5.
* apply IHt1.
apply H6.
* apply H7.
+ bdall.
** constructor. apply H4.
* apply ForallT_insert.
assumption.
assumption.
*apply H6.
* apply IHt2 in H7.
apply H7.
**
The shortest way to complete your proof may be (just at your last **):
** assert (k = k0) by auto with arith; subst.
inversion_clear H; now constructor.
Qed.
(the second line replaces the lemma BST_irrel of my previous post)
Indeed, you were very close to the Qed! Quite often, if some conclusion looks difficult to prove, it may be useful to look at the context. If you are lucky, you may find a contradiction and it's done. Otherwise, you can try to do a few forward-reasoning steps (like infering k=k0 in your example, and replace k with k0in appropriate occurrences).
Pierre
In your last goal, you have k0 = k (by H0and H1), and you know T t1 k0 v0 t2 is a search tree.
H : BST (T t1 k0 v0 t2)
H0 : k >= k0
H1 : k0 >= k
============================
BST (T t1 k v t2)
So, you may replace kwith k0 in the conclusion. If you prove
that the value v is irrelevant for T l k v r's searchness (a small lemma to prove), your proof is almost completed.
Lemma BST_irrel {V: Type} : forall l r k (v w:V),
BST (T l k v r) -> BST (T l k w r).
Proof. inversion 1; now constructor. Qed.
I'm trying to prove insert_SearchTree, a theorem about the preservation of a binary search tree after an insertion relation, below. I'm not sure how to use the induction hypothesis which relies on the nested Inductive definitions, namely SearchTree's single constructor calls on SearchTree'. Once I instantiate and invert the IH, though, we are given an arguement hi0 which is incomparable to k?
....
H1 : SearchTree' 0 (insert k0 v0 l) hi0
H2 : k0 < k
============================
SearchTree' 0 (insert k0 v0 l) k
Is my approach to this proof flawed, or is there a trick to make them comparable? I had thought to try to prove something like
Theorem insert_SearchTree'':
forall k v t hi,
SearchTree' 0 t hi -> SearchTree' 0 (insert k v t) hi .
Proof.
but after attempting I realized this is not equivalent (and I think unproveable, although I'm not sure)... Any advice is welcome. Most of the code is auxiliary, and I included it based on the advice that questions be stand-alone.
Require Export Coq.Arith.Arith.
Require Export Coq.Arith.EqNat.
Require Export Coq.omega.Omega.
Notation "a >=? b" := (Nat.leb b a)
(at level 70, only parsing) : nat_scope.
Notation "a >? b" := (Nat.ltb b a)
(at level 70, only parsing) : nat_scope.
Notation " a =? b" := (beq_nat a b)
(at level 70) : nat_scope.
Print reflect.
Lemma beq_reflect : forall x y, reflect (x = y) (x =? y).
Proof.
intros x y.
apply iff_reflect. symmetry. apply beq_nat_true_iff.
Qed.
Lemma blt_reflect : forall x y, reflect (x < y) (x <? y).
Proof.
intros x y.
apply iff_reflect. symmetry. apply Nat.ltb_lt.
Qed.
Lemma ble_reflect : forall x y, reflect (x <= y) (x <=? y).
Proof.
intros x y.
apply iff_reflect. symmetry. apply Nat.leb_le.
Qed.
Hint Resolve blt_reflect ble_reflect beq_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]]].
Section TREES.
Variable V : Type.
Variable default: V.
Definition key := nat.
Inductive tree : Type :=
| E : tree
| T: tree -> key -> V -> tree -> tree.
Inductive SearchTree' : key -> tree -> key -> Prop :=
| ST_E : forall lo hi, lo <= hi -> SearchTree' lo E hi
| ST_T: forall lo l k v r hi,
SearchTree' lo l k ->
SearchTree' (S k) r hi ->
SearchTree' lo (T l k v r) hi.
Inductive SearchTree: tree -> Prop :=
| ST_intro: forall t hi, SearchTree' 0 t hi -> SearchTree t.
Fixpoint insert (x: key) (v: V) (s: tree) : tree :=
match s with
| E => T E x v E
| T a y v' b => if x <? y then T (insert x v a) y v' b
else if y <? x then T a y v' (insert x v b)
else T a x v b
end.
Theorem insert_SearchTree:
forall k v t,
SearchTree t -> SearchTree (insert k v t).
Proof.
clear default.
intros.
generalize dependent v.
generalize dependent k.
induction H.
induction H.
- admit.
- intros.
specialize (IHSearchTree'1 k0 v0).
inversion IHSearchTree'1.
subst.
simpl.
bdestruct (k0 <? k).
apply (ST_intro _ hi0 ).
constructor.
admit.
End TREES.
The goal is currently too weak when you start induction. At the beginning of the second case, the goal looks like this:
H : SearchTree' lo l k
H0 : SearchTree' (S k) r hi
IHSearchTree'1 : forall (k : key) (v : V), SearchTree (insert k v l)
IHSearchTree'2 : forall (k : key) (v : V), SearchTree (insert k v r)
============================
forall (k0 : key) (v0 : V), SearchTree (insert k0 v0 (T l k v r))
and the high-level idea to go on is to combine H and IHSearchTree'2, or H0 and IHSearchTree'1, depending on which side the insertion goes. But this is impossible because the SearchTree predicate in the two IH assumptions is not compositional: knowing only that insert k0 v0 l is a search tree does not help to know whether a tree containing it, T (insert k0 v0 l) k v r, is also a search tree. So the proof doesn't go through.
When putting search trees together, we don't just want to know that something is a search tree. We also want to know some bounds on the keys (here in particular, they must be bounded by k). This is what the auxiliary predicate SearchTree' provides. This matter of compositionality is precisely why SearchTree is defined using an auxiliary inductive predicate SearchTree', which is compositional (it can be, and is, defined in terms of itself).
Properties about recursive functions on trees mentioning SearchTree should first be generalized as more informative properties using SearchTree' so induction can go through. It will look like this:
Lemma insert_SearchTree' :
forall t k0 v0 ??? ,
SearchTree' ??? t ??? -> SearchTree' ??? (insert k0 v0 t) ???.
There are multiple valid ways of filling these "???" blanks. Coming up with new ones is a good exercise for the reader. One way that should work well here and many other situations is to put variables for all the missing arguments of predicates, and then figure out some suitable relation between them:
Lemma insert_SearchTree' :
forall t k0 v0 lo hi lo' hi',
??? (* find a suitable assumption *) ->
SearchTree' lo t hi -> SearchTree' lo' (insert k0 v0 t) hi'.
The relation should reflect the behavior of insert. What insert does, as far as those bounds are concerned, is to add the key k0 to the tree, so the bounds must bound that, in addition to the rest of the tree:
Lemma insert_SearchTree' :
forall t k0 v0 lo hi lo' hi',
lo' <= lo -> hi <= hi' ->
lo' <= k0 -> k0 < hi' ->
SearchTree' lo t hi -> SearchTree' lo' (insert k0 v0 t) hi'.
Finally, since we're going to use induction on the SearchTree' lo t hi assumption, it's desirable to move most variables and hypotheses that it does not mention to the right, to strengthen the induction hypothesis further (as far as I can tell, this is always safe to do):
Lemma insert_SearchTree' :
forall t k0 v0 lo hi, (* k0 and v0 remain constant throughout the recursive applications of (insert k0 v0), so they can stay here (it would still be fine if they are moved with the rest). *)
SearchTree' lo t hi ->
forall lo' hi', (* The bounds are going to change at every step, so they move to the right of the inductive predicate. *)
lo' <= lo -> hi <= hi' ->
lo' <= k0 -> k0 < hi' ->
SearchTree' lo' (insert k0 v0 t) hi'.
Proving this lemma and using it to prove insert_SearchTree is left as an exercise for the reader.
In the section on insertion into Braun trees of the Verified Programming in Agda book (page 118), the author does some explanation of what the code is supposed to be doing, but leaving what it does aside, a singificant ommision in the book so far is not explaining the strange syntax in function pattern matching for theorem proving.
I understand that the with pattern can be further destructured by using | and I can understand that when using rewrite, | can also be used to separate the different rewrites, but this makes it confusing.
As far as I can tell, rewrite is definitely not a function. And then comes the following:
bt-insert a (bt-node{n}{m} a' l r p)
rewrite +comm n m with p | if a <A a' then (a , a') else (a' , a)
bt-insert a (bt-node{n}{m} a' l r _) | inj₁ p | (a1 , a2)
rewrite p = (bt-node a1 (bt-insert a2 r) l (inj₂ refl))
bt-insert a (bt-node{n}{m} a' l r _) | inj₂ p | (a1 , a2) =
(bt-node a1 (bt-insert a2 r) l (inj₁ (sym p)))
I am really confused as to how rewrite +comm n m with p | if a <A a' then (a , a') else (a' , a) should be parsed mentally. And how does one read | inj₁ p | (a1 , a2) rewrite p? Also, while testing the previous examples I've discovered that for some reason the order of the rewrites does not matter. Why is that?
If you ignore the proofs for a sec, this function can be simplified as
bt-insert : ∀ {n: ℕ} → A → braun-tree n → braun-tree (suc n)
bt-insert a (bt-node {n} {m} a' l r _) = bt-node a1 (bt-insert a2 r) l _
where
(a1, a2) = if a <A a' then (a , a') else (a' , a)
So (a1, a2) is just (min a a', max a a') i.e. (a, a') sorted.
All the other code is there to maintain the proofs of the invariants:
We rewrite +comm n m so that we can return a braun-tree (2 + (m + n)) even though the return type requires a braun-tree (2 + (n + m)).
p is used to prove that the resulting tree is still balanced: p proves that n ≡ m ∨ n ≡ suc m, so it's either inj₁ (p : n ≡ m) or inj₂ (p : n ≡ suc m). We use the proof of either property to compute the proof of suc m ≡ n ∨ suc m ≡ suc n (remember we flipped n and m via the proof of commutativity).
After pondering it for a bit, I realized that if...
p | if a <A a' then (a , a') else (a' , a)
inj₁ p | (a1 , a2)
I put the expressions like that then it makes sense visually. In bt_insert's second case the rewrite comes before the if statement and in the third case it comes after the destructuring of the if pattern.
Well, that leaves figuring out what the rest of the function is doing.
How does one prove (R->P) in Coq. I'm a beginner at this and don't know much of this tool. This is what I wrote:
Require Import Classical.
Theorem intro_neg : forall P Q : Prop,(P -> Q /\ ~Q) -> ~P.
Proof.
intros P Q H.
intro HP.
apply H in HP.
inversion HP.
apply H1.
assumption.
Qed.
Section Question1.
Variables P Q R: Prop.
Hypotheses H1 : R -> P \/ Q.
Hypotheses H2 : R -> ~Q.
Theorem trans : R -> P.
Proof.
intro HR.
apply NNPP.
apply intro_neg with (Q := Q).
intro HNP.
I can only get to this point.
The subgoals at this point are:
1 subgoals
P : Prop
Q : Prop
R : Prop
H1 : R -> P \/ Q
H2 : R -> ~ Q
HR : R
HNP : ~ P
______________________________________(1/1)
Q /\ ~ Q
You can use tauto to prove it automatically:
Section Question1.
Variables P Q R: Prop.
Hypotheses H1 : R -> P \/ Q.
Hypotheses H2 : R -> ~Q.
Theorem trans : R -> P.
Proof.
intro HR.
tauto.
Qed.
If you want to prove it manually, H1 says that given R, either P or Q is true. So if you destruct H1, you get 3 goals. One to prove the premise (R), one to prove the goal (P) using the left conclusion (P) of the or, and one to prove the goal (P) using the right conclusion (Q).
Theorem trans' : R -> P.
Proof.
intro HR.
destruct H1.
- (* Prove the premise, R *)
assumption.
- (* Prove that P is true given that P is true *)
assumption.
- (* Prove that P is true given that Q is false *)
contradiction H2.
Qed.
End Question1.