I'm using a couple of Inductive definitions as counter examples in some proofs. I would however like to encapsulate these definitions by enclosing them in a Section. Regular Definitions can be hidden using Let, but is this also possible for Inductive definitions? And how about Theorems?
Let me give the actual thing I'm trying to achieve, as I may be going about it totally the wrong way in the first place. I want to formalize all the proofs and exercises of the excellent book "Logics of Time and Computation" by Robert Goldblatt into Coq.
For starters we take classical logic as that is what the book does as well.
Require Import Classical_Prop.
Require Import Classical_Pred_Type.
Next we define identifiers the same way it is done in Software Foundations.
Inductive id : Type := Id : nat -> id.
Definition of the syntax.
Inductive modal : Type :=
| Bottom : modal
| V : id -> modal
| Imp : modal -> modal -> modal
| Box : modal -> modal
.
Definition Not (f : modal) : modal := Imp f Bottom.
Definition of the semantics using Kripke frames.
(* Inspired by: www.cs.vu.nl/~tcs/mt/dewind.ps.gz
*)
Record frame : Type :=
{ Worlds : Type
; WorldsExist : exists w : Worlds, True
; Rel : Worlds -> Worlds -> Prop
}.
Record kripke : Type :=
{ Frame : frame
; Label : (Worlds Frame) -> id -> Prop
}.
Fixpoint satisfies (M : kripke) (x : (Worlds (Frame M))) (f : modal) : Prop
:= match f with
| Bottom => False
| V v => (Label M x v)
| Imp f1 f2 => (satisfies M x f1) -> (satisfies M x f2)
| Box f => forall y : (Worlds (Frame M)), (Rel (Frame M) x y) -> (satisfies M y f)
end.
The first lemma relates the modal Not to the one of Coq.
Lemma satisfies_Not
: forall M x f
, satisfies M x (Not f) = ~ satisfies M x f
.
Proof. auto.
Qed.
Next we lift the semantics to complete models.
Definition M_satisfies (M : kripke) (f : modal) : Prop
:= forall w : Worlds (Frame M), satisfies M w f.
And we show what it means for the Not connective.
Lemma M_satisfies_Not : forall M f
, M_satisfies M (Not f) -> ~ M_satisfies M f
.
Proof.
unfold M_satisfies.
intros M f Hn Hcontra.
destruct (WorldsExist (Frame M)).
specialize (Hn x); clear H.
rewrite satisfies_Not in Hn.
specialize (Hcontra x). auto.
Qed.
Here comes the thing. The reverse of the above lemma does not hold and I want to show this by a counter example, exhibiting a model for which it doesn't hold.
Inductive Wcounter : Set := | x1:Wcounter | x2:Wcounter | x3:Wcounter.
Lemma Wcounter_not_empty : exists w : Wcounter, True.
Proof. exists x1. constructor. Qed.
Inductive Rcounter (x : Wcounter) (y : Wcounter) : Prop :=
| E1 : x = x1 -> y = x2 -> Rcounter x y
| E2 : x = x2 -> y = x3 -> Rcounter x y
.
Definition Lcounter : Wcounter -> id -> Prop
:= fun x i => match x with
| x1 => match i with | Id 0 => True | _ => False end
| x2 => match i with | Id 1 => True | _ => False end
| x3 => match i with | Id 0 => True | _ => False end
end.
Definition Fcounter : frame := Build_frame Wcounter Wcounter_not_empty Rcounter.
Definition Kcounter : kripke := Build_kripke Fcounter Lcounter.
Next an Ltac that relieves me from typing verbose asserts.
Ltac counter_example H Hc := match type of H with
| ?P -> ~ ?Q => assert(Hc: Q)
| ?P -> (?Q -> False) => assert(Hc: Q)
| ?P -> ?Q => assert(Hc: ~Q)
end.
Finally I use this counter example to prove the following Lemma.
Lemma M_not_satisfies_Not : ~ forall M f
, (~ M_satisfies M f) -> M_satisfies M (Not f)
.
Proof.
apply ex_not_not_all. exists Kcounter.
apply ex_not_not_all. exists (V (Id 0)).
unfold M_satisfies. simpl.
intro Hcontra. unfold not in Hcontra.
counter_example Hcontra Hn2.
apply ex_not_not_all. exists x1. simpl. auto.
apply Hn2. apply Hcontra. apply ex_not_not_all; exists x2. simpl. auto.
Qed.
Preferably I would have used the remember tactic to define the counter example inside the proof, but I don't think it can be used for the Inductive definitions. All the definitions relating to the counter example are exported as part of my theory, which I prefer not to do. It is only used in the proof of M_not_satisfies_Not. Actually I would not even want to export this Lemma either as it is not very useful. I only put it there to argue that M_satisfies_Not can not be an equivalence.
Section doesn't hide definitions, use Module instead. For example put the counter example in a module.
Module CounterExample.
Import Definitions.
Inductive Wcounter : Set := x1 | x2 | x3.
...
Lemma M_not_satisfies_Not : ...
End CounterExample.
At this stage, only CounterExample is defined at the top level.
If you don't want that either, then you could just put the definitions in one .v file and the counter example in another file that imports the definitions. Actually, the way it works is that .v files are turned into individual modules.
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.
Coq allows to write complex pattern-matchings, but then it decomposes them so that its kernel can handle them.
For instance, let us consider the following code.
Require Import List. Import ListNotations.
Inductive bar := A | B | C.
Definition f (l : list bar) :=
match l with
| _ :: A :: _ => 1
| _ => 2
end.
We pattern-match both on the list and on the second element. Printing f shows that Coq stores a more complex version of it.
Print f.
(* f = fun l : list bar => match l with
| [] => 2
| [_] => 2
| _ :: A :: _ => 1
| _ :: B :: _ => 2
| _ :: C :: _ => 2
end
: list bar -> nat
*)
The problem is that, in the proofs manipulating f, I have to deal with 5 cases instead of only 2, and 4 of them are redundant.
What is the best way to deal with this? Is there a way to reason with the pattern-matching as if it were exactly as defined?
You are correct in that Coq actually simplifies pattern-matching making a lot of redundancies appear.
There are however some ways to reason on the case analysis you meant opposed to what Coq understands.
Using Function and function induction is a way.
More recently, Equations also allows you to define pattern-matching for which it derives induction principles automatically (that you can invoke using funelim).
In order to convince coq cases can be factorised you have to use the notion of view.
They are described in the context of Equations in the examples.
I'll detail how to adapt your example to it.
From Equations Require Import Equations.
Require Import List. Import ListNotations.
Inductive bar := A | B | C.
Equations discr (b : list bar) : Prop :=
discr (_ :: A :: _) := False ;
discr _ := True.
Inductive view : list bar -> Set :=
| view_foo : forall x y, view (x :: A :: y)
| view_other : forall l, discr l -> view l.
Equations viewc l : view l :=
viewc (x :: A :: y) := view_foo x y ;
viewc l := view_other l I.
Equations f (l : list bar) : nat :=
f l with viewc l := {
| view_foo _ _ => 1 ;
| view_other _ _ => 2
}.
Goal forall l, f l < 3.
Proof.
intro l.
funelim (f l).
- repeat constructor.
- repeat constructor.
Qed.
As you can see, funelim only generates two subgoals.
It can be a bit heavy so if you don't want to use Equations of Function, you might have to prove your own induction principles by hand:
Require Import List. Import ListNotations.
Inductive bar := A | B | C.
Definition f (l : list bar) :=
match l with
| _ :: A :: _ => 1
| _ => 2
end.
Definition discr (l : list bar) : Prop :=
match l with
| _ :: A :: _ => False
| _ => True
end.
Lemma f_ind :
forall (P : list bar -> nat -> Prop),
(forall x y, P (x :: A :: y) 1) ->
(forall l, discr l -> P l 2) ->
forall l, P l (f l).
Proof.
intros P h1 h2 l.
destruct l as [| x [|[] l]].
3: eapply h1.
all: eapply h2.
all: exact I.
Qed.
Goal forall l, f l < 3.
Proof.
intro l.
eapply f_ind.
- intros. repeat constructor.
- intros. repeat constructor.
Qed.
I am trying to proof that the application of an empty Substitution on a term is equal to the given term.
Here is the code:
Require Import Coq.Strings.String.
Require Import Coq.Lists.List.
Require Import Coq.Arith.EqNat.
Require Import Recdef.
Require Import Omega.
Import ListNotations.
Set Implicit Arguments.
Inductive Term : Type :=
| Var : nat -> Term
| Fun : string -> list Term -> Term.
Definition Subst : Type := list (nat*Term).
Definition maybe{X Y: Type} (x : X) (f : Y -> X) (o : option Y): X :=
match o with
|None => x
|Some a => f a
end.
Fixpoint lookup {A B : Type} (eqA : A -> A -> bool) (kvs : list (A * B)) (k : A) : option B :=
match kvs with
|[] => None
|(x,y) :: xs => if eqA k x then Some y else lookup eqA xs k
end.
I am trying to proof some properties of this function.
Fixpoint apply (s : Subst) (t : Term) : Term :=
match t with
| Var x => maybe (Var x) id (lookup beq_nat s x )
| Fun f ts => Fun f (map (apply s ) ts)
end.
Lemma empty_apply_on_term:
forall t, apply [] t = t.
Proof.
intros.
induction t.
reflexivity.
I am stuck after the reflexivity. I wanted to do induction on the list build in a term but if i do so i'ĺl get stuck in a loop.
i will appreciate any help.
The problem is that the automatically generated inductive principle for the Term type is too weak, because it has another inductive type list inside it (specifically, list is applied to the very type being constructed). Adam Chlipala's CPDT gives a good explanation of what's going on, as well as an example of how to manually build a better inductive principle for such types in the inductive types chapter. I've adapted his example nat_tree_ind' principle for your Term inductive, using the builtin Forall rather than a custom definition. With it, your theorem becomes easy to prove:
Section Term_ind'.
Variable P : Term -> Prop.
Hypothesis Var_case : forall (n:nat), P (Var n).
Hypothesis Fun_case : forall (s : string) (ls : list Term),
Forall P ls -> P (Fun s ls).
Fixpoint Term_ind' (tr : Term) : P tr :=
match tr with
| Var n => Var_case n
| Fun s ls =>
Fun_case s
((fix list_Term_ind (ls : list Term) : Forall P ls :=
match ls with
| [] => Forall_nil _
| tr'::rest => Forall_cons tr' (Term_ind' tr') (list_Term_ind rest)
end) ls)
end.
End Term_ind'.
Lemma empty_apply_on_term:
forall t, apply [] t = t.
Proof.
intros.
induction t using Term_ind'; simpl; auto.
f_equal.
induction H; simpl; auto.
congruence.
Qed.
This is a typical trap for beginners. The problem is that your definition of Term has a recursive occurrence inside another inductive type -- in this case, list. Coq does not generate a useful inductive principle for such types, unfortunately; you have to program your own. Adam Chlipala's CDPT has a chapter on inductive types that describes the problem. Just look for "nested inductive types".
The following code (which is of course not a complete proof) tries to do pattern matching on a dependent product:
Record fail : Set :=
mkFail {
i : nat ;
f : forall x, x < i -> nat
}.
Definition failomat : forall (m : nat) (f : forall x, x < m -> nat), nat.
Proof.
intros.
apply 0.
Qed.
Function fail_hard_omat fl : nat := failomat (i fl) (f fl).
Definition failhard fl : fail_hard_omat fl = 0.
refine ((fun fl =>
match fl with
| mkFail 0 _ => _
| mkFail (S n) _ => _
end) fl).
The error I get when trying to execute this is
Toplevel input, characters 0-125:
Error: Illegal application (Type Error):
The term "mkFail" of type
"forall i : nat, (forall x : nat, x < i -> nat) -> fail"
cannot be applied to the terms
"i" : "nat"
"f0" : "forall x : nat, x < i0 -> nat"
The 2nd term has type "forall x : nat, x < i0 -> nat"
which should be coercible to "forall x : nat, x < i -> nat".
It seems that the substitution somehow does not reach the inner type parameters.
After playing with the Program command I managed to build a refine that might suites you, but I don't understand everything I did. The main idea is to help Coq with the substitution by introducing intermediate equalities that will serve as brige within the substitution
refine ((fun fl =>
match fl as fl0 return (fl0 = fl -> fail_hard_omat fl0 = 0) with
| mkFail n bar =>
match n as n0 return (forall foo: (forall x:nat, x < n0 -> nat),
mkFail n0 foo = fl -> fail_hard_omat (mkFail n0 foo) = 0) with
| O => _
| S p => _
end bar
end (eq_refl fl) ) fl).
Anyway, I don't know what your purpose here is, but I advise never write dependent match "by hand" and rely on Coq's tactics. In your case, if you define your Definition failomat with Defined. instead of Qed, you will be able to unfold it and you won't need dependent matching.
Hope it helps,
V.
Note: both occurences of bar can be replaced by an underscore.
Another, slightly less involved, alternative is to use nat and fail's induction combinators.
Print nat_rect.
Print fail_rect.
Definition failhard : forall fl, fail_hard_omat fl = 0.
Proof.
refine (fail_rect _ _). (* Performs induction (projection) on fl. *)
refine (nat_rect _ _ _). (* Performs induction on fl's first component. *)
Show Proof.
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.