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.
Related
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.
I define a sorted list as follows:
Require Import Coq.Lists.List.
Import ListNotations.
Inductive SortedList : list nat -> Prop :=
| sort0 : SortedList []
| sort1 : forall a, SortedList [a]
| sort2 : forall z1 z2 l, z1 <= z2 -> SortedList (z2 :: l) -> SortedList (z1 :: z2 :: l).
And I think the following theorem is correct.
Theorem SortedList_sep:
forall l1 l2,
SortedList (l1 ++ l2) -> SortedList l1 /\ SortedList l2.
But I cannot prove this theorem. Can anyone give me some idea?
Here is one way to do it. I tried to keep it simple to step through.
Require Import List.
Import ListNotations.
Inductive SortedList : list nat -> Prop :=
| sort0 : SortedList []
| sort1 : forall a, SortedList [a]
| sort2 : forall z1 z2, forall l, z1 <= z2 -> SortedList (z2 :: l) -> SortedList (z1 :: z2 :: l).
Theorem SortedList_sep1:
forall l1 l2,
SortedList (l1 ++ l2) -> SortedList l1.
Proof.
induction l1;
firstorder.
- now constructor.
- destruct l1.
now constructor.
rewrite <- ?app_comm_cons in *.
inversion H.
constructor.
+ now trivial.
+ apply IHl1 with l2.
rewrite <- ?app_comm_cons in *.
now trivial.
Qed.
Theorem SortedList_sep2:
forall l1 l2,
SortedList (l1 ++ l2) -> SortedList l2.
Proof.
induction l1;
firstorder.
rewrite <- app_comm_cons in *.
inversion H.
- apply IHl1.
rewrite <- H2.
now constructor.
- apply IHl1.
rewrite H1 in H3.
now apply H3.
Qed.
Theorem SortedList_sep:
forall l1 l2,
SortedList (l1 ++ l2) -> SortedList l1 /\ SortedList l2.
Proof.
firstorder.
now apply SortedList_sep1 with l2.
now apply SortedList_sep2 with l1.
Qed.
and here is a 'code golfed' version, which is shorter, but less "grokkable".
Theorem SortedList_sep:
forall l1 l2,
SortedList (l1 ++ l2) -> SortedList l1 /\ SortedList l2.
Proof.
induction l1; firstorder; try destruct l1; inversion H;
rewrite <- ?app_comm_cons in *; try constructor; firstorder.
Qed.
One way to do the proof is using induction on l1 because the operation ++ is defined by recursion on its first argument. Another option is to do induction on the term of type SortedList (l1 ++ l2) in the context, that would require a bit more context & goal management (e.g. generalization, etc.) and also it seems that you'd need several destructions on l1 anyways.
#larsr's answer shows one approach to the problem. Here is a "combined" approach where we prove the original theorem with conjunction:
Theorem SortedList_sep l1 l2 :
SortedList (l1 ++ l2) -> SortedList l1 /\ SortedList l2.
Proof.
induction l1 as [|h1 l1 IH]; simpl; intros H.
- split; [constructor | assumption].
- inversion H; subst.
+ apply eq_sym, app_eq_nil in H2 as [->->].
split; constructor.
+ destruct l1 as [|h2 l1]; simpl in * |-.
* subst l2; split; [constructor | assumption].
* inversion H1; subst. apply IH in H3 as [? ?].
split; [now constructor | assumption].
Qed.
Now we can easily define special cases like SortedList_sep1:
Theorem SortedList_sep1 l1 l2 :
SortedList (l1 ++ l2) -> SortedList l1.
Proof. apply SortedList_sep. Qed.
Theorem SortedList_sep2 l1 l2 :
SortedList (l1 ++ l2) -> SortedList l2.
Proof. apply SortedList_sep. Qed.
Let me also suggest a solution using the mathematical components library:
Theorem SortedList_sep l1 l2 :
sorted leq (l1 ++ l2) ->
sorted leq l1 /\ sorted leq l2.
Proof.
rewrite -(path_min_sorted (x:=0)) // cat_path => /andP[h1 h2].
by have/allP h := order_path_min leq_trans h2; rewrite !path_min_sorted in h1 h2.
Qed.
I guess the proof style can be improved but that's an exercise for the reader.
Edit: Anton Trunov proposes this nicer proof, which is the "right" one:
Proof.
by move/(subseq_sorted leq_trans)=> h; rewrite !h ?suffix_subseq ?prefix_subseq.
Qed.
Note that contrary to other solutions, none of the above proofs use induction directly, but they are based on more general lemmas. This is much preferred, as it reflects the reasoning a "real" mathematician would do. Concretely, the "right" proof states: "a subsequence of an ordered sequence is ordered", which IMO is the right intuition in this case.
Written in Haskell, here is the data type that proves that one list is a permutation of another:
data Belongs (x :: k) (ys :: [k]) (zs :: [k]) where
BelongsHere :: Belongs x xs (x ': xs)
BelongsThere :: Belongs x xs xys -> Belongs x (y ': xs) (y ': xys)
data Permutation (xs :: [k]) (ys :: [k]) where
PermutationEmpty :: Permutation '[] '[]
PermutationCons :: Belongs x ys xys -> Permutation xs ys -> Permutation (x ': xs) xys
With a Permutation, we can now permute a record:
data Rec :: (u -> *) -> [u] -> * where
RNil :: Rec f '[]
(:&) :: !(f r) -> !(Rec f rs) -> Rec f (r ': rs)
insertRecord :: Belongs x ys zs -> f x -> Rec f ys -> Rec f zs
insertRecord BelongsHere v rs = v :& rs
insertRecord (BelongsThere b) v (r :& rs) = r :& insertRecord b v rs
permute :: Permutation xs ys -> Rec f xs -> Rec f ys
permute PermutationEmpty RNil = RNil
permute (PermutationCons b pnext) (r :& rs) = insertRecord b r (permute pnext rs)
This works fine. However, permute is O(n^2) where n is the length of the record. I'm wondering if there is a way to get it to be any faster by using a different data type to represent a permutation.
For comparison, in a mutable and untyped setting (which I know is a very different setting indeed), we could apply a permutation to a heterogeneous record like this in O(n) time. You represent the record as an array of values and the permutation as an array of new positions (no duplicates are allowed and all digits must be between 0 and n). Applying the permutation is just iterating that array and indexing into the record's array with those positions.
I don't expect that an O(n) permutation is possible in a more rigorously typed settings. But it seems like O(n*log(n)) might be possible. I appreciate any feedback, and let me know if I need to clarify anything. Also, answers to this can use Haskell, Agda, or Idris depending on what it feels easier to communicate with.
A faster simple solution is to compare the sorted permutation of the permutations.
Given permutation A and B.
Then there exist the sorted permutations,
As = sort(A)
Bs = sort(B)
As is a permutation of A and Bs is a permutation of B.
If As == Bs then A is a permutation of B.
Thus the order of this algorithm is O(n log(n)) < O(n²)
And this is leading to the optimal solution.
Using a different storage of permutation yields O(n)
Using the statements from above, we are changing the storage format of each permutation into
the sorted data
the original unsorted data
To determine if a list is a permutation of another one, simple a comparison of the sorted data is necessary -> O(n).
This answers the question correctly, but the effort is hidden in creating the doubled data storage ^^ So it will depend on the use if this is a real advantage or not.
I did some implementation of the insert sort algorithm in Isabelle/HOL for the generation of code (ML, Python, among others). I'm sure the corresponding functions work fine, but I need to create some theorems to prove it and be super sure it works. My functions are these:
(* The following functions are used to prove the algorithm works fine *)
fun menor_igual :: "nat ⇒ nat list ⇒ bool" where
"menor_igual n [] = True" |
"menor_igual n (x # xs) = (n ≤ x ∧ menor_igual n xs)"
fun ordenado :: "nat list ⇒ bool" where
"ordenado [] = True" |
"ordenado (x # xs) = (menor_igual x xs ∧ ordenado xs)"
fun cuantos :: "nat list ⇒ nat ⇒ nat" where
"cuantos [] num = 0" |
"cuantos (x # xs) num = (if x = num then Suc (cuantos xs num) else cuantos xs num)"
(* These functions make the algorithm itself *)
fun insertar:: "nat ⇒ nat list ⇒ nat list" where
"insertar num [] = [num]" |
"insertar num (x # xs) = (if (num ≤ x) then (num # x # xs) else x # insertar num xs)"
fun asc :: "nat list ⇒ nat list" where
"asc [] = []" |
"asc (x # xs) = insertar x (asc xs)"
The issues is I don't know how to create the theorems correctly. I need to prove that the ordered list has the same length as the original list, and that both lists have the same name of elements. My first theorems are these:
theorem "ordenado (asc xs)"
apply (induction xs rule: asc.induct)
apply auto
theorem "cuantos (asc xs) x = cuantos xs x"
apply (induction xs rule: asc.induct)
apply auto
The first theorem tries to prove that the list is correctly ordered, the second one tries to prove that both lists have the same length.
When I apply induction and auto I expect to get 0 subgoals, that says the theorems are right and the algorithm works fine, but after that I don't know how to remove the subgolas, I mean I don't know how to do the simplification rules (lemma [simp]: "") to do it, I'll appreciate your help.
After
theorem "ordenado (asc xs)"
apply (induction xs rule: asc.induct)
apply auto
you still have to prove the following subgoal:
1. ⋀x xs.
ordenado (asc xs) ⟹
ordenado (insertar x (asc xs))
That is, assuming that asc xs is sorted, you have to prove that insertar x (asc xs) is sorted. This suggests to first prove an auxiliary lemma about the interaction between insertar and ordenado
lemma ordenado_insertar [simp]:
"ordenado (insertar x xs) = ordenado xs"
...
which states that insertar x xs is sorted if and only if xs was already sorted. In order to prove this lemma you will again need auxiliary lemmas. This time about menor_igual and the interaction between menor_igual and insertar.
lemma le_menor_igual [simp]:
"y ≤ x ⟹ menor_igual x xs ⟹ menor_igual y xs"
...
lemma menor_igual_insertar [simp]:
"menor_igual y (insertar x xs) ⟷ y ≤ x ∧ menor_igual y xs"
...
The first one states that if y is smaller-equal x and x is smaller-equal all elements of xs, then y is smaller-equal all elements of xs, etc. ...
I leave the proofs as an exercise ;).
For your second theorem I suggest to follow the same recipe. First try induct followed by auto (as you already did), then find out what properties are still missing, prove them as auxiliary lemmas and finish your proofs.
As the title suggests, my question concerns proving the correctness and totality of lazy evaluation of arithmetic expressions in Coq. The theorems that I would like to prove are three in total:
Computations only give canonical
expressions as results
Theorem Only_canonical_results:
(forall x y: Aexp, Comp x y -> Canonical y).
Correctness: the computation relation
preserves denotation of expressions
Theorem correct_wrt_semantics:
(forall x y: Aexp, Comp x y ->
I N (denotation x) (denotation y)).
Every input leads to some result.
Theorem Comp_is_total: (forall x:Aexp,
(Sigma Aexp (fun y =>
prod (Comp x y) (Canonical y)))).
The necessary definitions are to be found in the code attached below. I should make it clear I am a novice when it comes to Coq; which more experienced users will probably notice right away. It is most certainly the case that the majority, or perhaps even all of the background material I have written can be found in the standard library. But, then again, if I knew exactly what to import from the standard library in order to prove the desired results, I would most probably not be here bothering you. That is why I submit to you the material I have so far, in the hope that some kind spirited person/s may help me. Thanks!
(* Sigma types *)
Inductive Sigma (A:Set)(B:A -> Set) :Set :=
Spair: forall a:A, forall b : B a,Sigma A B.
Definition E (A:Set)(B:A -> Set)
(C: Sigma A B -> Set)
(c: Sigma A B)
(d: (forall x:A, forall y:B x,
C (Spair A B x y))): C c :=
match c as c0 return (C c0) with
| Spair a b => d a b
end.
Definition project1 (A:Set)(B:A -> Set)(c: Sigma A B):=
E A B (fun z => A) c (fun x y => x).
(* Binary sum type *)
Inductive sum' (A B:Set):Set :=
inl': A -> sum' A B | inr': B -> sum' A B.
Print sum'_rect.
Definition D (A B : Set)(C: sum' A B -> Set)
(c: sum' A B)
(d: (forall x:A, C (inl' A B x)))
(e: (forall y:B, C (inr' A B y))): C c :=
match c as c0 return C c0 with
| inl' x => d x
| inr' y => e y
end.
(* Three useful finite sets *)
Inductive N_0: Set :=.
Definition R_0
(C:N_0 -> Set)
(c: N_0): C c :=
match c as c0 return (C c0) with
end.
Inductive N_1: Set := zero_1:N_1.
Definition R_1
(C:N_1 -> Set)
(c: N_1)
(d_zero: C zero_1): C c :=
match c as c0 return (C c0) with
| zero_1 => d_zero
end.
Inductive N_2: Set := zero_2:N_2 | one_2:N_2.
Definition R_2
(C:N_2 -> Set)
(c: N_2)
(d_zero: C zero_2)
(d_one: C one_2): C c :=
match c as c0 return (C c0) with
| zero_2 => d_zero
| one_2 => d_one
end.
(* Natural numbers *)
Inductive N:Set :=
zero: N | succ : N -> N.
Print N.
Print N_rect.
Definition R
(C:N -> Set)
(d: C zero)
(e: (forall x:N, C x -> C (succ x))):
(forall n:N, C n) :=
fix F (n: N): C n :=
match n as n0 return (C n0) with
| zero => d
| succ n0 => e n0 (F n0)
end.
(* Boolean to truth-value converter *)
Definition Tr (c:N_2) : Set :=
match c as c0 with
| zero_2 => N_0
| one_2 => N_1
end.
(* Identity type *)
Inductive I (A: Set)(x: A) : A -> Set :=
r : I A x x.
Print I_rect.
Theorem J
(A:Set)
(C: (forall x y:A,
forall z: I A x y, Set))
(d: (forall x:A, C x x (r A x)))
(a:A)(b:A)(c:I A a b): C a b c.
induction c.
apply d.
Defined.
(* functions are extensional wrt
identity types *)
Theorem I_I_extensionality (A B: Set)(f: A -> B):
(forall x y:A, I A x y -> I B (f x) (f y)).
Proof.
intros x y P.
induction P.
apply r.
Defined.
(* addition *)
Definition add (m n:N) : N
:= R (fun z=> N) m (fun x y => succ y) n.
(* multiplication *)
Definition mul (m n:N) : N
:= R (fun z=> N) zero (fun x y => add y m) n.
(* Axioms of Peano verified *)
Theorem P1a: (forall x: N, I N (add x zero) x).
intro x.
(* force use of definitional equality
by applying reflexivity *)
apply r.
Defined.
Theorem P1b: (forall x y: N,
I N (add x (succ y)) (succ (add x y))).
intros.
apply r.
Defined.
Theorem P2a: (forall x: N, I N (mul x zero) zero).
intros.
apply r.
Defined.
Theorem P2b: (forall x y: N,
I N (mul x (succ y)) (add (mul x y) x)).
intros.
apply r.
Defined.
Definition pd (n: N): N :=
R (fun _=> N) zero (fun x y=> x) n.
(* alternatively
Definition pd (x: N): N :=
match x as x0 with
| zero => zero
| succ n0 => n0
end.
*)
Theorem P3: (forall x y:N,
I N (succ x) (succ y) -> I N x y).
intros x y p.
apply (I_I_extensionality N N pd (succ x) (succ y)).
apply p.
Defined.
Definition not (A:Set): Set:= (A -> N_0).
Definition isnonzero (n: N): N_2:=
R (fun _ => N_2) zero_2 (fun x y => one_2) n.
Theorem P4 : (forall x:N,
not (I N (succ x) zero)).
intro x.
intro p.
apply (J N (fun x y z =>
Tr (isnonzero x) -> Tr (isnonzero y))
(fun x => (fun t => t)) (succ x) zero)
.
apply p.
simpl.
apply zero_1.
Defined.
Theorem P5 (P:N -> Set):
P zero -> (forall x:N, P x -> P (succ x))
-> (forall x:N, P x).
intros base step n.
apply R.
apply base.
apply step.
Defined.
(* I(A,-,-) is an equivalence relation *)
Lemma Ireflexive (A:Set): (forall x:A, I A x x).
intro x.
apply r.
Defined.
Lemma Isymmetric (A:Set): (forall x y:A, I A x y -> I A y x).
intros x y P.
induction P.
apply r.
Defined.
Lemma Itransitive (A:Set):
(forall x y z:A, I A x y -> I A y z -> I A x z).
intros x y z P Q.
induction P.
assumption.
Defined.
Definition or (A B : Set):= sum' A B.
(* arithmetical expressions *)
Inductive Aexp :Set :=
zer: Aexp
| suc: Aexp -> Aexp
| pls: Aexp -> Aexp -> Aexp.
(* denotation of an expression *)
Definition denotation: Aexp->N:=
fix F (a: Aexp): N :=
match a as a0 with
| zer => zero
| suc a1 => succ (F a1)
| pls a1 a2 => add (F a1) (F a2)
end.
(* predicate for distinguishing
canonical expressions *)
Definition Canonical (x:Aexp):Set :=
or (I Aexp x zer)
(Sigma Aexp (fun y =>
I Aexp x (suc y))).
(* the computation relation is
an inductively defined relation *)
Inductive Comp : Aexp -> Aexp -> Set
:=
refrule: forall a: Aexp,
forall p: Canonical a, Comp a a
| zerrule: forall a b c:Aexp,
forall p: Comp b zer,
forall q: Comp a c,
Comp (pls a b) c
| sucrule: forall a b c:Aexp,
forall p: Comp b (suc c),
Comp (pls a b) (suc (pls a c)).
(* Computations only give canonical
expressions as results *)
Theorem Only_canonical_results:
(forall x y: Aexp, Comp x y -> Canonical y).
admit.
Defined.
(* Here is where help is needed *)
(* Correctness: the computation relation
preserves denotation of expressions *)
Theorem correct_wrt_semantics:
(forall x y: Aexp, Comp x y ->
I N (denotation x) (denotation y)).
admit.
(* Here is where help is need*)
Defined.
(* every input leads to some result *)
Theorem Comp_is_total: (forall x:Aexp,
(Sigma Aexp (fun y =>
prod (Comp x y) (Canonical y)))).
admit.
(* Proof required *)
Defined.
The first two theorems can be proved almost blindly. They follow by induction on the definition of Comp. The third one requires some thinking and some auxiliary theorems though. But you should be following a tutorial if you want to learn Coq.
About the tactics I used:
induction 1 does induction on the first unnamed hypothesis.
info_eauto tries to finish a goal by blindly applying theorems.
Hint Constructors adds the constructors of an inductive definition to the database of theorems info_eauto can use.
unfold, simpl, and rewrite should be self-explanatory.
.
Hint Constructors sum' prod Sigma I Comp.
Theorem Only_canonical_results:
(forall x y: Aexp, Comp x y -> Canonical y).
unfold Canonical, or.
induction 1.
info_eauto.
info_eauto.
info_eauto.
Defined.
Theorem correct_wrt_semantics:
(forall x y: Aexp, Comp x y ->
I N (denotation x) (denotation y)).
induction 1.
info_eauto.
simpl. rewrite IHComp1. rewrite IHComp2. simpl. info_eauto.
simpl. rewrite IHComp. simpl. info_eauto.
Defined.
Theorem Comp_is_total: (forall x:Aexp,
(Sigma Aexp (fun y =>
prod (Comp x y) (Canonical y)))).
unfold Canonical, or.
induction x.
eapply Spair. eapply pair.
eapply refrule. unfold Canonical, or. info_eauto.
info_eauto.
Admitted.