For example in Coq there is rewrite and we can also put arrows `<-:
Inductive bool: Set :=
| true
| false.
Lemma equality_of_functions_commutes:
forall (f: bool->bool) x y,
(f x) = (f y) -> (f y) = (f x).
Proof.
intros.
rewrite H.
reflexivity.
Qed.
source: https://pjreddie.com/coq-tactics/#rewrite
I don't believe that it is as strong as the Coq version, but
subst, described in 5.8.1 of the old tutorial and
rewrite, shown in the examples
rewrite theorems. However, you cannot easily rewrite assumptions in apply-style.
Related
Isabelle has some automation for quotient reasoning through the quotient package. I would like to see if that automation is of any use for my example. The relevant definitions is:
definition e_proj where "e_proj = e'_aff_bit // gluing"
So I try to write:
typedef e_aff_t = e'_aff_bit
quotient_type e_proj_t = "e'_aff_bit" / "gluing
However, I get the error:
Extra type variables in representing set: "'a"
The error(s) above occurred in typedef "e_aff_t"
Because as Manuel Eberl explains here, we cannot have type definitions that depend on type parameters. In the past, I was suggested to use the type-to-sets approach.
How would that approach work in my example? Would it lead to more automation?
In the past, I was suggested to use the type-to-sets approach ...
The suggestion that was made in my previous answer was to use the standard set-based infrastructure for reasoning about quotients. I only mentioned that there exist other options for completeness.
I still believe that it is best not to use Types-To-Sets, provided that the definition of a quotient type is the only reason why you wish to use Types-To-Sets:
Even with Types-To-Sets, you will only be able to mimic the behavior of a quotient type in a local context with certain additional assumptions. Upon leaving the local context, the theorems that use locally defined quotient types would need to be converted to the set-based theorems that would inevitably rely on the standard set-based infrastructure for reasoning about quotients.
One would need to develop additional Isabelle/ML infrastructure before Local Typedef Rule can be used to define quotient types locally conveniently. It should not be too difficult to develop an infrastructure that is useable, but it would take some time to develop something that is universally applicable. Personally, I do not consider this application to be sufficiently important to invest my time in it.
In my view, it is only viable to use Types-To-Sets for the definition of quotient types locally if you are already using Types-To-Sets for its intended purpose in a given development. Then, the possibility of using the framework for the definition of quotient types locally can be seen as a 'value-added benefit'.
For completeness, I provide an example that I developed for an answer on the mailing list some time ago. Of course, this is merely the demonstration of the concept, not a solution that can be used for work that is meant to be published in some form. To make this useable, one would need to convert this development to an Isabelle/ML command that would take care of all the details automatically.
theory Scratch
imports Main
"HOL-Types_To_Sets.Prerequisites"
"HOL-Types_To_Sets.Types_To_Sets"
begin
locale local_typedef =
fixes R :: "['a, 'a] ⇒ bool"
assumes is_equivalence: "equivp R"
begin
(*The exposition subsumes some of the content of
HOL/Types_To_Sets/Examples/Prerequisites.thy*)
context
fixes S and s :: "'s itself"
defines S: "S ≡ {x. ∃u. x = {v. R u v}}"
assumes Ex_type_definition_S:
"∃(Rep::'s ⇒ 'a set) (Abs::'a set ⇒ 's). type_definition Rep Abs S"
begin
definition "rep = fst (SOME (Rep::'s ⇒ 'a set, Abs). type_definition Rep
Abs S)"
definition "Abs = snd (SOME (Rep::'s ⇒ 'a set, Abs). type_definition Rep
Abs S)"
definition "rep' a = (SOME x. a ∈ S ⟶ x ∈ a)"
definition "Abs' x = (SOME a. a ∈ S ∧ a = {v. R x v})"
definition "rep'' = rep' o rep"
definition "Abs'' = Abs o Abs'"
lemma type_definition_S: "type_definition rep Abs S"
unfolding Abs_def rep_def split_beta'
by (rule someI_ex) (use Ex_type_definition_S in auto)
lemma rep_in_S[simp]: "rep x ∈ S"
and rep_inverse[simp]: "Abs (rep x) = x"
and Abs_inverse[simp]: "y ∈ S ⟹ rep (Abs y) = y"
using type_definition_S
unfolding type_definition_def by auto
definition cr_S where "cr_S ≡ λs b. s = rep b"
lemmas Domainp_cr_S = type_definition_Domainp[OF type_definition_S
cr_S_def, transfer_domain_rule]
lemmas right_total_cr_S = typedef_right_total[OF type_definition_S
cr_S_def, transfer_rule]
and bi_unique_cr_S = typedef_bi_unique[OF type_definition_S cr_S_def,
transfer_rule]
and left_unique_cr_S = typedef_left_unique[OF type_definition_S cr_S_def,
transfer_rule]
and right_unique_cr_S = typedef_right_unique[OF type_definition_S
cr_S_def, transfer_rule]
lemma cr_S_rep[intro, simp]: "cr_S (rep a) a" by (simp add: cr_S_def)
lemma cr_S_Abs[intro, simp]: "a∈S ⟹ cr_S a (Abs a)" by (simp add: cr_S_def)
(* this part was sledgehammered - please do not pay attention to the
(absence of) proof style *)
lemma r1: "∀a. Abs'' (rep'' a) = a"
unfolding Abs''_def rep''_def comp_def
proof-
{
fix s'
note repS = rep_in_S[of s']
then have "∃x. x ∈ rep s'" using S equivp_reflp is_equivalence by force
then have "rep' (rep s') ∈ rep s'"
using repS unfolding rep'_def by (metis verit_sko_ex')
moreover with is_equivalence repS have "rep s' = {v. R (rep' (rep s'))
v}"
by (smt CollectD S equivp_def)
ultimately have arr: "Abs' (rep' (rep s')) = rep s'"
unfolding Abs'_def by (smt repS some_sym_eq_trivial verit_sko_ex')
have "Abs (Abs' (rep' (rep s'))) = s'" unfolding arr by (rule
rep_inverse)
}
then show "∀a. Abs (Abs' (rep' (rep a))) = a" by auto
qed
lemma r2: "∀a. R (rep'' a) (rep'' a)"
unfolding rep''_def rep'_def
using is_equivalence unfolding equivp_def by blast
lemma r3: "∀r s. R r s = (R r r ∧ R s s ∧ Abs'' r = Abs'' s)"
apply(intro allI)
apply standard
subgoal unfolding Abs''_def Abs'_def
using is_equivalence unfolding equivp_def by auto
subgoal unfolding Abs''_def Abs'_def
using is_equivalence unfolding equivp_def
by (smt Abs''_def Abs'_def CollectD S comp_apply local.Abs_inverse
mem_Collect_eq someI_ex)
done
definition cr_Q where "cr_Q = (λx y. R x x ∧ Abs'' x = y)"
lemma quotient_Q: "Quotient R Abs'' rep'' cr_Q"
unfolding Quotient_def
apply(intro conjI)
subgoal by (rule r1)
subgoal by (rule r2)
subgoal by (rule r3)
subgoal by (rule cr_Q_def)
done
(* instantiate the quotient lemmas from the theory Lifting *)
lemmas Q_Quotient_abs_rep = Quotient_abs_rep[OF quotient_Q]
(*...*)
(* prove the statements about the quotient type 's *)
(*...*)
(* transfer the results back to 'a using the capabilities of transfer -
not demonstrated in the example *)
lemma aa: "(a::'a) = (a::'a)"
by auto
end
thm aa[cancel_type_definition]
(* this shows {x. ∃u. x = {v. R u v}} ≠ {} ⟹ ?a = ?a *)
end
For a uni project I'm working on a proof with Iabelle/HOL 2018. I'm getting an error when applying obvious results. However, this error is not stating anything about what is going wrong.
At first I thought it was an unification problem. But when I simplified it turned out to be a behavior I totally don't understand.
I have a minimal example which is as follows:
I define proposition formulas as type1 and then I have a tail-recursive function that simply collects each sub formula. There are probably better ways to do that. I just tried to replicate the error in the easiest way possible. Then I want to show a simple equality (I have proven that in my code, here I just simplify by "sorry") and then I want to use that fact in some other proof, however it doesn't seem to apply the proven fact, even though I added it to the simp set. Even, directly applying it doesn't work for me.
Here is the Code:
theory test
imports Main
begin
datatype 'a type1 =
Bot
| Atm 'a
| Neg "'a type1"
| Imp "'a type1" "'a type1"
fun func :: "'a type1 ⇒ ('a type1) list list ⇒ ('a type1) list list"
where
"func Bot acc = acc"
| "func (Atm p) acc = acc"
| "func (Neg p) acc = func p ([Neg p] # acc)"
| "func (Imp p q) acc = func q (func p ([Imp p q] # acc))"
lemma lemma1 [simp]:
"func p acc = func p [] # acc"
sorry
lemma lemma2:
"func p acc = func p acc"
proof -
have "func p acc = func p [] # acc" by auto
show ?thesis sorry
qed
end
In my opinion this should be no problem. However, in the first line of the proof of lemma2 I get an error. But there is no explanation to the error such as "failed to finish proof" or anything similar.
Does anyone know what I'm doing wrong? Or did anyone have similar problems or behavior?
Quoting from the book 'A Proof Assistant for Higher-Order Logic': "In its most basic form, simplification means the repeated application of equations from left to right ... Only equations that really simplify, like rev (rev xs) = xs and xs # [] = xs, should be declared as default simplification rules." (there are other valuable resources that explain this issue, e.g. the official Isabelle/Isar reference manual or the textbook 'Concrete Semantics with Isabelle/HOL'). Therefore, lemma1 is not a good choice for a default simplification rule and adding it to the simpset can lead to nontermination, as your example demonstrates.
If you would like to use lemma1 in another proof, perhaps, you can use something similar to
have "func p acc = func p [] # acc by (rule lemma1)"
or merely rewrite the simp rule as
func p [] # acc = func p acc.
However, in general, you need to be very careful when introducing new simp rules, especially in the global theory context.
I've got stuck with theorem which is easy to formulate:
"If the maximal element of the vector is 0 then each element of the vector is 0".
The goal is to be able to use such an idiom as "fold_left orb false v".
So my first aim is to prove this particular lemma:
Lemma all_then_some (A:Type) :
forall (n:nat) (p:Fin.t (S n))
(v : Vector.t bool (S n))
(H : (Vector.fold_left orb false v) = false),
(Vector.nth v p) = false.
Proof.
...
Some thoughts:
1) To strengthen the hypothesis and prove something like this:
(forall (b:bool), (List.fold_left orb l b) = b) <->
(forall (p:nat), (List.nth p l false) = false)
(** NB: variant for lists here! **)
2) Use principle "rectS" from the standard library /Vectors/Fin.v
3) Use small scale reflection library.
UPDATE: to find the partial solution please see my answer below.(ged)
UPDATE2: Solution is here: https://github.com/georgydunaev/TRASH/blob/master/UNIV_INST.v
(it is called "Theorem all_then_someV")
You can indeed use a more structured lemma from math-comp, a quick example [that can surely be improved]:
From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Lemma nat_of_bool_inj : injective nat_of_bool.
Proof. by case=> [] []. Qed.
Lemma all_false n (r : n.-tuple bool) :
\max_(i in 'I_n) tnth r i <= 0 ->
forall i, tnth r i = false.
Proof.
by move/bigmax_leqP => H i; apply/nat_of_bool_inj/eqP; rewrite -leqn0 H.
Qed.
You have some more specialized lemmas relating \big[orb/false] with has.
The code consists of two parts:
I have proved my lemma for List in the 1st part and, similarly, I have almost proved for Vector in the 2nd part.
There is a problem in the last step of the second part.
("induction p." causes "Abstracting over the terms "n0" and "p" leads to a term … which is ill-typed". I don't understand what shall I do instead of "induction p.".)
(*PART 1*)
Require Import Coq.Lists.List.
Import ListNotations.
Fixpoint A2 l :fold_left orb l true = true.
Proof.
destruct l; simpl.
reflexivity.
apply A2.
Defined.
Theorem A1 (x y:bool): (orb x y = false)->(x=false)/\(y=false).
Proof. intro H. destruct x, y; firstorder || inversion H. Defined.
Fixpoint A0 b l : fold_left orb (b :: l) false = orb b (fold_left orb l false) .
Proof.
destruct l.
simpl. firstorder.
simpl.
destruct b.
simpl.
apply A2.
simpl.
reflexivity.
Defined.
Fixpoint all_then_some (l:list bool) {struct l}:
(List.fold_left orb l false) = false ->
(forall (p:nat), (List.nth p l false) = false).
Proof.
intros.
destruct l. simpl. destruct p; trivial.
simpl.
rewrite A0 in H.
pose (Q:=A1 _ _ H).
destruct Q.
destruct p. trivial.
apply all_then_some.
trivial.
Defined.
(*PART 2*)
Require Import Coq.Vectors.Vector.
Import VectorNotations.
Fixpoint B2 (n:nat) (l:t bool n) :fold_left orb true l = true.
Proof.
destruct l; simpl.
reflexivity.
apply B2.
Defined.
Fixpoint B0 b (n:nat) (l:t bool n) :
fold_left orb false (b :: l) = orb b (fold_left orb false l) .
Proof.
destruct l.
simpl. firstorder.
simpl.
destruct b.
simpl.
apply B2.
simpl.
reflexivity.
Defined.
Fixpoint all_then_someV (n:nat) (l:Vector.t bool n) {struct l}:
(Vector.fold_left orb false l ) = false ->
(forall p, (Vector.nth l p ) = false).
Proof.
intros.
induction l eqn:equa.
inversion p. (* simpl. destruct p; trivial.*)
(*simpl.*)
rewrite B0 in H.
pose (Q:=A1 _ _ H).
destruct Q.
induction p.
I think something like the following code can help (because "destruct" tactic is like "_rect" application), but I am not sure.
Definition G0 h (n:nat) (l:Vector.t bool n) := fold_left orb false (h :: l) = false.
fold G0 in H.
assert (vari : G0 h n l).
exact H.
clear H.
revert h l vari.
set (P := fun n p => forall (h : bool) (l : t bool n) (_ : G0 h n l),
#eq bool (#nth bool (S n) (cons bool h n l) p) false).
unshelve eapply (#Fin.rectS P).
UPDATE2: Solution is here: https://github.com/georgydunaev/TRASH/blob/master/UNIV_INST.v
(it is called "Theorem all_then_someV")
I’d like to define the following function using Program Fixpoint or Function in Coq:
Require Import Coq.Lists.List.
Import ListNotations.
Require Import Coq.Program.Wf.
Require Import Recdef.
Inductive Tree := Node : nat -> list Tree -> Tree.
Fixpoint height (t : Tree) : nat :=
match t with
| Node x ts => S (fold_right Nat.max 0 (map height ts))
end.
Program Fixpoint mapTree (f : nat -> nat) (t : Tree) {measure (height t)} : Tree :=
match t with
Node x ts => Node (f x) (map (fun t => mapTree f t) ts)
end.
Next Obligation.
Unfortunately, at this point I have a proof obligation height t < height (Node x ts) without knowing that t is a member of ts.
Similarly with Function instead of Program Fixpoint, only that Function detects the problem and aborts the definition:
Error:
the term fun t : Tree => mapTree f t can not contain a recursive call to mapTree
I would expect to get a proof obligation of In t ts → height t < height (Node x ts).
Is there a way of getting that that does not involve restructuring the function definition? (I know work-arounds that require inlining the definition of map here, for example – I’d like to avoid these.)
Isabelle
To justify that expectation, let me show what happens when I do the same in Isabelle, using the function command, which is (AFAIK) related to Coq’s Function command:
theory Tree imports Main begin
datatype Tree = Node nat "Tree list"
fun height where
"height (Node _ ts) = Suc (foldr max (map height ts) 0)"
function mapTree where
"mapTree f (Node x ts) = Node (f x) (map (λ t. mapTree f t) ts)"
by pat_completeness auto
termination
proof (relation "measure (λ(f,t). height t)")
show "wf (measure (λ(f, t). height t))" by auto
next
fix f :: "nat ⇒ nat" and x :: nat and ts :: "Tree list" and t
assume "t ∈ set ts"
thus "((f, t), (f, Node x ts)) ∈ measure (λ(f, t). height t)"
by (induction ts) auto
qed
In the termination proof, I get the assumption t ∈ set ts.
Note that Isabelle does not require a manual termination proof here, and the following definition works just fine:
fun mapTree where
"mapTree f (Node x ts) = Node (f x) (map (λ t. mapTree f t) ts)"
This works because the map function has a “congruence lemma” of the form
xs = ys ⟹ (⋀x. x ∈ set ys ⟹ f x = g x) ⟹ map f xs = map g ys
that the function command uses to find out that the termination proof only needs to consider t ∈ set ts..
If such a lemma is not available, e.g. because I define
definition "map' = map"
and use that in mapTree, I get the same unprovable proof obligation as in Coq. I can make it work again by declaring a congruence lemma for map', e.g. using
declare map_cong[folded map'_def,fundef_cong]
In this case, you actually do not need well-founded recursion in its full generality:
Require Import Coq.Lists.List.
Set Implicit Arguments.
Inductive tree := Node : nat -> list tree -> tree.
Fixpoint map_tree (f : nat -> nat) (t : tree) : tree :=
match t with
| Node x ts => Node (f x) (map (fun t => map_tree f t) ts)
end.
Coq is able to figure out by itself that recursive calls to map_tree are performed on strict subterms. However, proving anything about this function is difficult, as the induction principle generated for tree is not useful:
tree_ind :
forall P : tree -> Prop,
(forall (n : nat) (l : list tree), P (Node n l)) ->
forall t : tree, P t
This is essentially the same problem you described earlier. Luckily, we can fix the issue by proving our own induction principle with a proof term.
Require Import Coq.Lists.List.
Import ListNotations.
Unset Elimination Schemes.
Inductive tree := Node : nat -> list tree -> tree.
Set Elimination Schemes.
Fixpoint tree_ind
(P : tree -> Prop)
(IH : forall (n : nat) (ts : list tree),
fold_right (fun t => and (P t)) True ts ->
P (Node n ts))
(t : tree) : P t :=
match t with
| Node n ts =>
let fix loop ts :=
match ts return fold_right (fun t' => and (P t')) True ts with
| [] => I
| t' :: ts' => conj (tree_ind P IH t') (loop ts')
end in
IH n ts (loop ts)
end.
Fixpoint map_tree (f : nat -> nat) (t : tree) : tree :=
match t with
| Node x ts => Node (f x) (map (fun t => map_tree f t) ts)
end.
The Unset Elimination Schemes command prevents Coq from generating its default (and not useful) induction principle for tree. The occurrence of fold_right on the induction hypothesis simply expresses that the predicate P holds of every tree t' appearing in ts.
Here is a statement that you can prove using this induction principle:
Lemma map_tree_comp f g t :
map_tree f (map_tree g t) = map_tree (fun n => f (g n)) t.
Proof.
induction t as [n ts IH]; simpl; f_equal.
induction ts as [|t' ts' IHts]; try easy.
simpl in *.
destruct IH as [IHt' IHts'].
specialize (IHts IHts').
now rewrite IHt', <- IHts.
Qed.
You can now do this with Equations and get the right elimination principle automatically, using either structural nested recursion or well-founded recursion
In general, it might be advisable to avoid this problem. But if one really wants to obtain the proof obligation that Isabelle gives you, here is a way:
In Isabelle, we can give an external lemma that stats that map applies its arguments only to members of the given list. In Coq, we cannot do this in an external lemma, but we can do it in the type. So instead of the normal type of map
forall A B, (A -> B) -> list A -> list B
we want the type to say “f is only ever applied to elements of the list:
forall A B (xs : list A), (forall x : A, In x xs -> B) -> list B
(It requires reordering the argument so that the type of f can mention xs).
Writing this function is not trivial, and I found it easier to use a proof script:
Definition map {A B} (xs : list A) (f : forall (x:A), In x xs -> B) : list B.
Proof.
induction xs.
* exact [].
* refine (f a _ :: IHxs _).
- left. reflexivity.
- intros. eapply f. right. eassumption.
Defined.
But you can also write it “by hand”:
Fixpoint map {A B} (xs : list A) : forall (f : forall (x:A), In x xs -> B), list B :=
match xs with
| [] => fun _ => []
| x :: xs => fun f => f x (or_introl eq_refl) :: map xs (fun y h => f y (or_intror h))
end.
In either case, the result is nice: I can use this function in mapTree, i.e.
Program Fixpoint mapTree (f : nat -> nat) (t : Tree) {measure (height t)} : Tree :=
match t with
Node x ts => Node (f x) (map ts (fun t _ => mapTree f t))
end.
Next Obligation.
and I don’t have to do anything with the new argument to f, but it shows up in the the termination proof obligation, as In t ts → height t < height (Node x ts) as desired. So I can prove that and define mapTree:
simpl.
apply Lt.le_lt_n_Sm.
induction ts; inversion_clear H.
- subst. apply PeanoNat.Nat.le_max_l.
- rewrite IHts by assumption.
apply PeanoNat.Nat.le_max_r.
Qed.
It only works with Program Fixpoint, not with Function, unfortunately.
Let's suppose that I have
type T
wellfounded relation R: T->T->Prop
function F1: T->T that makes argument "smaller"
condition C: T->Prop that describes "start values" of R
function F2: T->T that makes argument "bigger"
How can I make Fixpoint that looks similar to this:
Fixpoint Example (n:T):X :=
match {C n} + {~C n} with
left _ => ... |
right _ => Example (F1 n)
end.
And how I can make possible the following usage of tactic 'induction' (or similar):
Theorem ...
Proof.
...
induction n F.
(* And now I have two goals:
the first with assumption C n and goal P n,
the second with assumption P n and goal P (F2 n) *)
...
Qed.
I tried to do that with type nz: {n:nat | n<>O} (looking in the chapter 7.1 of Certified Programming with Dependent Types book) but got only this far:
Require Import Omega.
Definition nz: Set := {n:nat | n<>O}.
Theorem nz_t1 (n:nat): S n<>O. Proof. auto. Qed.
Definition nz_eq (n m:nz) := eq (projT1 n) (projT1 m).
Definition nz_one: nz := exist _ 1 (nz_t1 O).
Definition nz_lt (n m:nz) := lt (projT1 n) (projT1 m).
Definition nz_pred (n:nz): nz := exist _ (S (pred (pred (projT1 n)))) (nz_t1 _).
Theorem nz_Acc: forall (n:nz), Acc nz_lt n.
Proof.
intro. destruct n as [n pn], n as [|n]. omega.
induction n; split; intros; destruct y as [y py]; unfold nz_lt in *; simpl in *.
omega.
assert (y<S n\/y=S n). omega. destruct H0.
assert (S n<>O); auto.
assert (nz_lt (exist _ y py) (exist _ (S n) H1)). unfold nz_lt; simpl; assumption.
fold nz_lt in *. apply Acc_inv with (exist (fun n0:nat=>n0<>O) (S n) H1). apply IHn.
unfold nz_lt; simpl; assumption.
rewrite <- H0 in IHn. apply IHn.
Defined.
Theorem nz_lt_wf: well_founded nz_lt. Proof. exact nz_Acc. Qed.
Lemma pred_wf: forall (n m:nz), nz_lt nz_one n -> m = nz_pred n -> nz_lt m n.
Proof.
intros. unfold nz_lt, nz_pred in *. destruct n as [n pn], m as [m pm]. simpl in *.
destruct n, m; try omega. simpl in *. inversion H0. omega.
Defined.
I couldn't understand what happens further because it was too complicated for me.
P.S. As I see it - there isn't any good enough tutorial about general recursion and induction in Coq for beginners. At least I could find. :(
I'll try to write a more complete answer later, but Coq has a command called Function that makes it easier to write functions whose arguments decrease according to some well-ordering. Look for the command on the reference manual (http://coq.inria.fr/distrib/current/refman/Reference-Manual004.html#hevea_command48), specifically the "wf" variant.