I'd like to simplify a proof by induction in Lean.
I've defined an inductive type with 3 constructors in Lean and a binary relation on this type. I've included the axioms because Lean wouldn't let me have them as constructors for rel.
inductive Fintype : Type
| a : Fintype
| b : Fintype
| c : Fintype
inductive rel : Fintype → Fintype → Prop
| r1 : rel Fintype.a Fintype.b
| r2 : ∀ p : Prop, (p → rel Fintype.a Fintype.c )
| r3 : ∀ p : Prop, (¬ p → rel Fintype.c Fintype.b)
axiom asymmetry_for_Fintype : ∀ x y : Fintype, rel x y → ¬ rel y x
axiom trivial1 : ¬ rel Fintype.c Fintype.a
axiom trivial2 : ¬ rel Fintype.b Fintype.c
axiom trivial3 : ∀ p : Prop, rel Fintype.a Fintype.c → p
axiom trivial4 : ∀ p : Prop, rel Fintype.c Fintype.b → ¬ p
A goal was to prove the following theorem:
def nw_o_2 (X : Type) (binrel : X → X → Prop) (x y : X) : Prop := ¬ binrel y x
def pw_o_2 (X : Type) (binrel : X → X → Prop )(x y : X) : Prop := ∀ z : X, (binrel z x → binrel z y) ∧ (binrel y z → binrel x z)
theorem simple17: ∀ x y : Fintype, nw_o_2 Fintype rel x y → pw_o_2 Fintype rel x y :=
I've proved it by induction on x, y, and z; the "z" comes from the definition of pw_o_2 above. But the proof is quite long (~136 lines). Is there another way to have a shorter proof?
Note that your first two axioms are really theorems, provable with an empty pattern match. (The constructors of an inductive types are assumed to be surjective.) The periods at the ends of these lines indicates that the declaration is over, that no body is expected. Internally, Lean is recursing on a proof of rel Fintype.c Fintype.a and showing that each case is structurally impossible.
lemma trivial1 : ¬ rel Fintype.c Fintype.a.
lemma trivial2 : ¬ rel Fintype.b Fintype.c.
Your second two axioms are inconsistent, which makes the proof of your theorem easy but uninteresting.
theorem simple17: ∀ x y : Fintype, nw_o_2 Fintype rel x y → pw_o_2 Fintype rel x y :=
false.elim (trivial3 _ (rel.r2 _ trivial))
I'm not sure that you've defined rel in the way you meant to. The second and third constructors are equivalent to just rel Fintype.a Fintype.c and rel Fintype.c Fintype.b respectively.
lemma rel_a_c : rel Fintype.a Fintype.c :=
rel.r2 true trivial
lemma rel_c_b : rel Fintype.c Fintype.b :=
rel.r3 false not_false
Related
I have
1 subgoals, subgoal 1
n : nat
b : bool
m : nat
H1: P1
H2: P2
H3: P1
H4: P2
=========
some_goal
after I run the tactic auto_group_duplicates,
it will become
1 subgoals, subgoal 1
n, m : nat
b : bool
H1, H3: P1
H2, H4: P2
=========
some_goal
Is there a tactic like this one?
I don't think that there is a tactic like this. But you can always come up with something using Ltac.
From Coq Require Import Utf8.
Definition mark {A : Type} (x : A) := x.
Ltac bar :=
match goal with
| x : ?A, y : ?A |- _ =>
lazymatch A with
| context [ mark ] => fail
| _ =>
move y after x ;
change A with (mark A) in x
end
end.
Ltac remove_marks :=
repeat match goal with
| x : mark ?A |- _ =>
change (mark A) with A in x
end.
Ltac auto_group_duplicates :=
repeat bar ; remove_marks.
Lemma foo :
∀ (n : nat) (b : bool) (m : nat) (c : bool),
n = m →
b = c →
n = m →
b = c →
n = m →
True.
Proof.
intros n b m c e1 e2 e3 e4 e5.
auto_group_duplicates.
auto_group_duplicates.
Here I have to apply the tactic twice because Ltac unifies A with mark A annoyingly.
You can manually use the move tactic (see https://coq.inria.fr/refman/proof-engine/tactics.html?highlight=top#coq:tacn.move-%E2%80%A6-after-%E2%80%A6) to rearrange hypothesis.
I doubt that there is a general automatic tactic like the one you are looking for, but one could probably cook up a fancy match-goal-based one to automate rearranging hypothesis using this tactic as a basic block, although this is out of my league.
The main problem is I cannot define such an Inductive proposition:
Inductive forces : nat -> Prop :=
| KM_cond (n : nat) : ~ forces 0 ->
forces n.
In fact, I am trying to define the Kripke Semantics for Intuitionistic Logic
Inductive forces (M : Kripke_model) (x : world) : prop -> Prop :=
| KM_cond (A B : prop) : set_In x (worlds M) ->
(forall y, (rel M) x y -> (~ forces M y A \/ forces M y B)) ->
forces M x (A then B).
but I get the following error
Non strictly positive occurrence of "forces"
If I just remove the negation, the problem goes away
Inductive forces (M : Kripke_model) (x : world) : prop -> Prop :=
| KM_cond (A B : prop) : set_In x (worlds M) ->
(forall y, (rel M) x y -> (forces M y A \/ forces M y B)) ->
forces M x (A then B).
but the problem exists with -> also
Inductive forces (M : Kripke_model) (x : world) : prop -> Prop :=
| KM_cond (A B : prop) : set_In x (worlds M) ->
(forall y, (rel M) x y -> (forces M y A -> forces M y B)) ->
forces M x (A then B).
I cannot understand what would possibly go wrong if I define this Inductive thing, and I cannot think of any other way to achieve this definition.
UPDATE:
These are the needed definitions:
From Coq Require Import Lists.List.
From Coq Require Import Lists.ListSet.
From Coq Require Import Relations.
Import ListNotations.
Definition var := nat.
Inductive prop : Type :=
| bot
| atom (p : var)
| conj (A B : prop)
| disj (A B : prop)
| cond (A B : prop).
Notation "A 'and' B" := (conj A B) (at level 50, left associativity).
Notation "A 'or' B" := (disj A B) (at level 50, left associativity).
Notation "A 'then' B" := (cond A B) (at level 60, no associativity).
Definition world := nat.
Definition preorder {X : Type} (R : relation X) : Prop :=
(forall x : X, R x x) /\ (forall x y z : X, R x y -> R y z -> R x z).
Inductive Kripke_model : Type :=
| Kripke (W : set world) (R : relation world) (v : var -> world -> bool)
(HW : W <> empty_set world)
(HR : preorder R)
(Hv : forall x y p, In x W -> In y W ->
R x y -> (v p x) = true -> (v p y) = true).
Definition worlds (M : Kripke_model) :=
match M with
| Kripke W _ _ _ _ _ => W
end.
Definition rel (M : Kripke_model) :=
match M with
| Kripke _ R _ _ _ _ => R
end.
Definition val (M : Kripke_model) :=
match M with
| Kripke _ _ v _ _ _ => v
end.
You cannot define this relation as an inductive predicate, but you can define it by recursion on the formula:
Fixpoint forces (M : Kripke_model) (x : world) (p : prop) : Prop :=
match p with
| bot => False
| atom p => val M p x = true
| conj p q => forces M x p /\ forces M x q
| disj p q => forces M x p \/ forces M x q
| cond p q => forall y, rel M x y -> forces M y p -> forces M y q
end.
This trick does not work if the definition is not well-founded with respect to the formula structure, but it might be enough for your use case.
data _∈_ {X : Set} (x : X) : (xs : List X) → Set where
here! : {xs : List X} → x ∈ x ∷ xs
there : {xs : List X} {y : X} (pr : x ∈ xs) → x ∈ y ∷ xs
remove : {X : Set} {x : X} (xs : List X) (pr : x ∈ xs) → List X
remove (_ ∷ xs) here! = xs
remove (y ∷ xs) (there pr) = y ∷ remove xs pr
I am trying to translate the above definition from Agda to Coq and am running into difficulties.
Inductive Any {A : Type} (P : A -> Type) : list A -> Prop :=
| here : forall {x : A} {xs : list A}, P x -> Any P (x :: xs)
| there : forall {x : A} {xs : list A}, Any P xs -> Any P (x :: xs).
Definition In' {A : Type} (x : A) xs := Any (fun x' => x = x') xs.
Fixpoint remove {A : Type} {x : A} {l : list A} (pr : In' x l) : list A :=
match l, pr with
| [], _ => []
| _ :: ls, here _ _ => ls
| x :: ls, there _ pr => x :: remove pr
end.
Incorrect elimination of "pr0" in the inductive type "#Any":
the return type has sort "Type" while it should be "Prop".
Elimination of an inductive object of sort Prop
is not allowed on a predicate in sort Type
because proofs can be eliminated only to build proofs.
In addition to this error, if I leave the [] case out Coq is asks me to provide it despite it being absurd.
Up to this point, I've thought that Agda and Coq were the same languages with a different front end, but now I am starting to think they are different under the hood. Is there a way to replicate the remove function in Coq and if not, what alternative would you recommend?
Edit: I also want to keep the proof between In and In'. Originally I made In' a Type rather than a Prop, but that made the following proof fail with a type error.
Fixpoint In {A : Type} (x : A) (l : list A) : Prop :=
match l with
| [] ⇒ False
| x' :: l' ⇒ x' = x ∨ In x l'
end.
Theorem In_iff_In' :
forall {A : Type} (x : A) (l : list A),
In x l <-> In' x l.
Proof.
intros.
split.
- intros.
induction l.
+ inversion H.
+ simpl in H.
destruct H; subst.
* apply here. reflexivity.
* apply there. apply IHl. assumption.
- intros.
induction H.
+ left. subst. reflexivity.
+ right. assumption.
Qed.
In environment
A : Type
x : A
l : list A
The term "In' x l" has type "Type" while it is expected to have type
"Prop" (universe inconsistency).
The In here is from the Logic chapter of SF. I have a solution of the pigeonhole principle in Agda, so I want this bijection in order to convert to the form that the exercise asks.
Edit2:
Theorem remove_lemma :
forall {A} {x} {y} {l : list A} (pr : In' x l) (pr' : In' y l),
x = y \/ In' y (remove pr).
I also outright run into universe inconsistency in this definition even when using Type when defining In'.
You need to use an informative proof of membership. Right now, your Any takes values in Prop, which, due to its limitations on elimination (see the error message you got), is consistent with the axiom forall (P: Prop) (x y: P), x = y. This means that if you have some term that depends on a term whose type is in Prop (as is the case with remove), it has to only use the fact that such a term exists, not what term it is specifically. Generally, you can't use elimination (usually pattern matching) on a Prop to produce anything other than something that's also a Prop.
There are three essentially different proofs of In' 1 [1; 2; 1; 3; 1; 4], and, depending which proof is used, remove p might be [2; 1; 4; 1; 4], [1; 2; 3; 1; 4] or [1; 2; 1; 3; 4]. So the output depends on the specific proof in an essential way.
To fix this, you can simply replace the Prop in Inductive Any {A : Type} (P : A -> Type) : list A -> Prop with Type.1 Now we can eliminate into non-Prop types and your definition of remove works as written.
To answer your edits, I think the biggest issue is that some of your theorems/definitions need In' to be a Prop (because they depend on uninformative proofs) and others need the informative proof.
I think your best bet is to keep In' as a Type, but then prove uninformative versions of the theorems. In the standard libary, in Coq.Init.Logic, there is an inductive type inhabited.
Inductive inhabited (A: Type): Prop :=
| inhabits: A -> inhabited A.
This takes a type and essentially forgets anything specific about its terms, only remembering if it's inhabited or not. I think your theorem and lemma are provable if you simply replace In' x l with inhabited (In' x l). I was able to prove a variant of your theorem whose conclusion is simply In x l <-> inhabited (In' x l). Your proof mostly worked, but I had to use the following simple lemma in one step:
Lemma inhabited_there {A: Type} {P: A -> Type} {x: A} {xs: list A}:
inhabited (Any P xs) -> inhabited (Any P (x :: xs)).
Note: even though inhabited A is basically just a Prop version of A and we have A -> inhabited A, we can't prove inhabited A -> A in general because that would involve choosing an arbitrary element of A.2
I also suggested Set here before, but this doesn't work since the inductive type depends on A, which is in Type.
In fact, I believe that the proof assistant Lean uses something very similar to this for its axiom of choice.
I noticed that Coq synthesizes different induction principles on equality for Prop and Type. Does anybody have an explanation for that?
Equality is defined as
Inductive eq (A : Type) (x : A) : A -> Prop := eq_refl : x = x
And the associated induction principle has the following type:
eq_ind
: forall (A : Type) (x : A) (P : A -> Prop),
P x -> forall y : A, x = y -> P y
Now let's define a Type pendant of eq:
Inductive eqT {A:Type}(x:A):A->Type:= eqT_refl: eqT x x.
The automatically generated induction principle is
eqT_ind
: forall (A : Type) (x : A) (P : forall a : A, eqT x a -> Prop),
P x (eqT_refl x) -> forall (y : A) (e : eqT x y), P y e
Note: I'm going to use _rect principles everywhere instead of _ind, since _ind principles are usually implemented via the _rect ones.
Type of eqT_rect
Let's take a look at the predicate P.
When dealing with inductive families, the number of arguments of P is equal to the number of non-parametric arguments (indices) + 1.
Let me give some examples (they can be easily skipped).
Natural numbers don't have parameters at all:
Inductive nat : Set := O : nat | S : nat -> nat.
So, the predicate P will be of type nat -> Type.
Lists have one parametric argument (A):
Inductive list (A : Type) : Type :=
nil : list A | cons : A -> list A -> list A.
Again, P has only one argument: P : list A -> Type.
Vectors are a different:
Inductive vec (A : Type) : nat -> Type :=
nil : vec A 0
| cons : A -> forall n : nat, vec A n -> vec A (S n).
P has 2 arguments, because n in vec A n is a non-parameteric argument:
P : forall n : nat, vec A n -> Type
The above explains eqT_rect (and, of course, eqT_ind as a consequence), since the argument after (x : A) is non-parametric, P has 2 arguments:
P : forall a : A, eqT x a -> Type
which justifies the overall type for eqT_rect:
eqT_rect
: forall (A : Type) (x : A) (P : forall a : A, eqT x a -> Type),
P x (eqT_refl x) -> forall (y : A) (e : eqT x y), P y e
The induction principle obtained in this way is called a maximal induction principle.
Type of eq_rect
The generated induction principles for inductive predicates (such as eq) are simplified to express proof irrelevance (the term for this is simplified induction principle).
When defining a predicate P, Coq simply drops the last argument of the predicate (which is the type being defined, and it lives in Prop). That's why the predicate used in eq_rect is unary. This fact shapes the type of eq_rect:
eq_rect :
forall (A : Type) (x : A) (P : A -> Type),
P x -> forall y : A, x = y -> P y
How to generate maximal induction principle
We can also make Coq generate non-simplified induction principle for eq:
Scheme eq_rect_max := Induction for eq Sort Type.
The resulting type is
eq_rect_max :
forall (A : Type) (x : A) (P : forall a : A, x = a -> Type),
P x eq_refl -> forall (y : A) (e : x = y), P y e
and it has the same structure as eqT_rect.
References
For more detailed explanation see sect. 14.1.3 ... 14.1.6 of the book "Interactive Theorem Proving and Program Development (Coq'Art: The Calculus of Inductive Constructions)" by Bertot and Castéran (2004).
As a rough and untutored background, in HoTT, one deduces the heck out of the inductively defined type
Inductive paths {X : Type } : X -> X -> Type :=
| idpath : forall x: X, paths x x.
which allows the very general construction
Lemma transport {X : Type } (P : X -> Type ){ x y : X} (γ : paths x y):
P x -> P y.
Proof.
induction γ.
exact (fun a => a).
Defined.
The Lemma transport would be at the heart of HoTT "replace" or "rewrite" tactics; the trick, so far as I understand it, would be, supposing a goal which you or I can abstractly recognize as
...
H : paths x y
[ Q : (G x) ]
_____________
(G y)
to figure out what is the necessary dependent type G, so that we can apply (transport G H). So far, all I've figured out is that
Ltac transport_along γ :=
match (type of γ) with
| ?a ~~> ?b =>
match goal with
|- ?F b => apply (transport F γ)
| _ => idtac "apparently couldn't abstract" b "from the goal." end
| _ => idtac "Are you sure" γ "is a path?" end.
isn't general enough. That is, the first idtac gets used rather often.
The question is
[Is there a | what is the] Right Thing to Do?
There is a bug about using rewrite for relations in type, which would allow you to just say rewrite <- y.
In the mean time,
Ltac transport_along γ :=
match (type of γ) with
| ?a ~~> ?b => pattern b; apply (transport _ y)
| _ => idtac "Are you sure" γ "is a path?"
end.
probably does what you want.
The feature request mentioned by Tom Prince in his answer has been granted:
Require Import Coq.Setoids.Setoid Coq.Classes.CMorphisms.
Inductive paths {X : Type } : X -> X -> Type :=
| idpath : forall x: X, paths x x.
Lemma transport {X : Type } (P : X -> Type ){ x y : X} (γ : paths x y):
P x -> P y.
Proof.
induction γ.
exact (fun a => a).
Defined.
Global Instance paths_Reflexive {A} : Reflexive (#paths A) := idpath.
Global Instance paths_Symmetric {A} : Symmetric (#paths A).
Proof. intros ?? []; constructor. Defined.
Global Instance proper_paths {A} (x : A) : Proper paths x := idpath x.
Global Instance paths_subrelation
(A : Type) (R : crelation A)
{RR : Reflexive R}
: subrelation paths R.
Proof.
intros ?? p.
apply (transport _ p), RR.
Defined.
Global Instance reflexive_paths_dom_reflexive
{B} {R' : crelation B} {RR' : Reflexive R'}
{A : Type}
: Reflexive (#paths A ==> R')%signature.
Proof. intros ??? []; apply RR'. Defined.
Goal forall (x y : nat) G, paths x y -> G x -> G y.
intros x y G H Q.
rewrite <- H.
exact Q.
Qed.
I found the required instances by comparing the logs I got with Set Typeclasses Debug from setoid_rewrite <- H when H : paths x y and when H : eq x y.