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.
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 have a conjunction, let's abstract it as: A /\ B and I have a Lemma proven that C -> A and I wish to get as a result the goal C /\ B. Is this possible?
If yes, I'd be interested in how to do it. If I use split and then apply the lemma to the first subgoal, I can't reassemble the two resulting subgoals C and B to C /\ B - or can I? Also apply does not seem to be applyable to only one branch of a conjunction.
If no, please explain to me why this is not possible :-)
You could introduce a lemma like :
Theorem cut: forall (A B C: Prop), C /\ B -> (C -> A) -> A /\ B.
Proof.
intros; destruct H; split; try apply H0; assumption.
Qed.
And then define a tactic like :
Ltac apply_left lemma := eapply cut; [ | apply lemma].
As an example, you could do stuff like :
Theorem test: forall (m n:nat), n <= m -> max n m = m /\ min n m = n.
Proof.
intros.
apply_left max_r.
...
Qed.
In this case, the context goes from :
Nat.max n m = m /\ Nat.min n m = n
to
n <= m /\ Nat.min n m = n
I assume that's what you are looking for.
Hope this will help you !
In answer to this question Assisting Agda's termination checker the recursion is proven to be well-founded.
Given the function defined like so (and everything else like in Vitus's answer there):
f : ℕ → ℕ
f n = go _ (<-wf n)
where
go : ∀ n → Acc n → ℕ
go zero _ = 0
go (suc n) (acc a) = go ⌊ n /2⌋ (a _ (s≤s (/2-less _)))
I cannot see how to prove f n == f ⌊ n /2⌋. (My actual problem has a different function, but the problem seems to boil down to the same thing)
My understanding is that go gets Acc n computed in different ways. I suppose, f n can be shown to pass Acc ⌊ n /2⌋ computed by a _ (s≤s (/2-less _)), and f ⌊ n /2⌋ passes Acc ⌊ n /2⌋ computed by <-wf ⌊ n /2⌋, so they cannot be seen identical.
It seems to me proof-irrelevance must be used somehow, to say that it's enough to just have an instance of Acc n, no matter how computed - but any way I try to use it, it seems to contaminate everything with restrictions (eg pattern matching doesn't work, or irrelevant function cannot be applied, etc).
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.
I recently started using the Isabelle theorem prover. As I want to prove another lemma, I would like to use a different notation than the one used in the lemma "det_linear_row_setsum", which can be found in the HOL library. More specifically, I would like to use the "χ i j notation" instead of "χ i". I have been trying to formulate an equivalent expression for some time, but couldn't figure it out yet.
(* ORIGINAL lemma from library *)
(* from HOL/Multivariate_Analysis/Determinants.thy *)
lemma det_linear_row_setsum:
assumes fS: "finite S"
shows "det ((χ i. if i = k then setsum (a i) S else c i)::'a::comm_ring_1^'n^'n) = setsum (λj. det ((χ i. if i = k then a i j else c i)::'a^'n^'n)) S"
proof(induct rule: finite_induct[OF fS])
case 1 thus ?case apply simp unfolding setsum_empty det_row_0[of k] ..
next
case (2 x F)
then show ?case by (simp add: det_row_add cong del: if_weak_cong)
qed
..
(* My approach to rewrite the above lemma in χ i j matrix notation *)
lemma mydet_linear_row_setsum:
assumes fS: "finite S"
fixes A :: "'a::comm_ring_1^'n^'n" and k :: "'n" and vec1 :: "'vec1 ⇒ ('a, 'n) vec"
shows "det ( χ r c . if r = k then (setsum (λj .vec1 j $ c) S) else A $ r $ c ) =
(setsum (λj . (det( χ r c . if r = k then vec1 j $ c else A $ r $ c ))) S)"
proof-
show ?thesis sorry
qed
First, make yourself clear what the original lemma says: a is a family of vectors indexed by i and j, c is a family of vectors indexed by i. The k-th row of the matrix on the left is the sum of the vectors a k j ranged over all j from the set S.
The other rows are taken from c. On the right, the matrices are the same except that row k is now a k j and the j is bound in the outer sum.
As you have realised, the family of vectors a is only used for the index i = k, so you can replace a by %_ j. vec1 $ j. Your matrix A yields the family of rows, i.e., c becomes %r. A $ r. Then, you merely have to exploit that (χ n. x $ n) = x (theorem vec_nth_inverse) and push the $ through the if and setsum. The result looks as follows:
lemma mydet_linear_row_setsum:
assumes fS: "finite S"
fixes A :: "'a::comm_ring_1^'n^'n" and k :: "'n" and vec1 :: "'vec1 => 'a^'n"
shows "det (χ r c . if r = k then setsum (%j. vec1 j $ c) S else A $ r $ c) =
(setsum (%j. (det(χ r c . if r = k then vec1 j $ c else A $ r $ c))) S)"
To prove this, you just have to undo the expansion and the pushing through, the lemmas if_distrib, cond_application_beta, and setsum_component might help you in doing so.