How can I prove the following free theorem with the plugin Paramcoq?
Lemma id_free (f : forall A : Type, A -> A) (X : Type) (x : X), f X x = x.
If it is not possible, then what is the purpose of this plugin?
The plugin can generate the statement of parametricity for any type. You will still need to then declare it as an axiom or an assumption to actually use it:
Declare ML Module "paramcoq".
Definition idt := forall A:Type, A -> A.
Parametricity idt arity 1.
(* ^^^ This command defines the constant idt_P. *)
Axiom param_idt : forall f, idt_P f.
Lemma id_free (f : forall A : Type, A -> A) (X : Type) (x : X) : f X x = x.
Proof.
intros.
apply (param_idt f X (fun y => y = x) x).
reflexivity.
Qed.
Related
I want to rewrite s in the term Forall (P s) l but it fails with my current instance declarations. Did I miss something with the morphisms?
From Coq Require Import List Streams Setoid Morphisms.
Parameter T A : Type.
Parameter P : Stream T -> A -> Prop.
Add Parametric Morphism : P
with signature #EqSt T ==> #eq A ==> iff
as P_morph.
Admitted.
Add Parametric Morphism : (#Forall A)
with signature pointwise_relation A iff ==> (#eq (list A)) ==> iff
as Forall_morph.
Admitted.
Example problematic :
forall s1 s2 l,
EqSt s2 s1 ->
Forall (P s1) l ->
Forall (P s2) l.
Proof.
intros * Heq Hf.
Fail setoid_rewrite Heq.
Abort.
P's signature should also use pointwise_relation.
Add Parametric Morphism : P
with signature #EqSt T ==> pointwise_relation A iff
as P_morph.
I'm trying to reason on a TRS, and I have ran into the following proof obligation:
infinite_sequence : forall t' : Term,
transitive_closure R t t' ->
exists t'' : Term, R t' t''
============================
exists f : nat -> Term, forall n : nat, R (f n) (f (n + 1))
With transitive_closure defined as follows:
Definition transitive_closure (trs : TRS) (x y : Term) :=
exists f: nat -> Term,
f 0 = x
/\
exists l: nat,
f l = y
/\
forall n: nat,
n < l
->
trs (f n) (f (n + 1))
.
So when I unfold:
infinite_sequence : forall t' : Term,
(exists f : nat -> Term,
f 0 = t /\
(exists l : nat,
f l = t' /\
(forall n : nat, n < l -> R (f n) (f (n + 1))))) ->
exists t'' : Term, R t' t''
============================
exists f : nat -> Term, forall n : nat, R (f n) (f (n + 1))
Is this proof obligation possible to fulfill? I am not married this exact definition of transitive_closure, so if it becomes much easier by choosing a different definition for that, I'm open to that.
Since your goal starts with exists f : nat -> Term, you have to explicitly build such a function. The easiest way to do so is to first build a function with a slightly richer return type ({ u: Term | transitive_closure R t u } instead of Term) and then to project pointwise its first component to finish the proof. This would give the following script:
simple refine (let f : nat -> { u: Term | transitive_closure R t u } := _ in _).
- fix f 1.
intros [|n].
{ exists t. exists (fun _ => t). admit. }
destruct (f n) as [t' H].
destruct (infinite_sequence t' H) as [t'' H']. (* ISSUE *)
exists t''.
destruct H as [f' [H1 [l [H2 H3]]]].
exists (fun m => if Nat.ltb m l then f' m else t'').
admit.
- exists (fun n => proj1_sig (f n)).
intros n.
rewrite Nat.add_1_r.
simpl.
destruct (f n) as [fn Hn].
now destruct infinite_sequence as [t'' H'].
The two admit are just there to keep the code simple; there is nothing difficult about them. The real issue comes from the line destruct (infinite_sequence t' H), since Coq will complain that "Case analysis on sort Set is not allowed for inductive definition ex." Indeed, infinite_sequence states that there exists t'' such that R t' t'', but it does so in a non-informative way (i.e., in Prop), while you need it to build a function that lives in the concrete world (i.e., in Set).
There are only two axiom-free solutions, but both might be incompatible with the remaining of your development. The easiest one is to put infinite_sequence in Set, which means its type is changed to forall t', transitive_closure R t t' -> { t'' | R t' t'' }.
The second solution requires R to be a decidable relation and Term to be an enumerable set. That way, you can still build a concrete t'' by enumerating all the terms until you find one that satisfies R t' t''. In that case, infinite_sequence is only used to prove that this process terminates, so it can be non-informative.
I have been having some problems with dependent induction because a "weak hypothesis".
For example :
I have a dependent complete foldable list :
Inductive list (A : Type) (f : A -> A -> A) : A -> Type :=
|Acons : forall {x x'' : A} (y' : A) (cons' : list f (f x x'')), list f (f (f x x'') y')
|Anil : forall (x: A) (y : A), list f (f x y).
And a function that a return the applied fold value from inductive type list and other function that forces a computation of these values through a matching.
Definition v'_list {X} {f : X -> X -> X} {y : X} (A : list f y) := y.
Fixpoint fold {A : Type} {Y : A} (z : A -> A -> A) (d' : list z Y) :=
match d' return A with
|Acons x y => z x (#fold _ _ z y)
|Anil _ x y => z x y
end.
Clearly, that's function return the same value if have the same dependent typed list and prove this don't should be so hard.
Theorem listFold_eq : forall {A : Type} {Y : A} (z : A -> A -> A) (d' : list z Y), fold d' = v'_list d'.
intros.
generalize dependent Y.
dependent induction d'.
(.. so ..)
Qed.
My problem is that dependent definition generates for me a weak hypothesis.
Because i have something like that in the most proof that i use dependent definitions, the problem of proof above:
A : Type
z : A -> A -> A
x, x'', y' : A
d' : list z (z x x'')
IHd' : fold d' = v'_list d'
______________________________________(1/2)
fold (Acons y' d') = v'_list (Acons y' d')
Even i have a polymorphic definition in (z x x'') i can't apply IHd' in my goal.
My question if have a way of define more "powerful" and polymorphic induction, instead of working crazy rewriting terms that sometimes struggling me.
If you do
simpl.
unfold v'_list.
You can see that you're almost there (you can finish with rewriting), but the arguments of z are in the wrong order, because list and fold don't agree on the way the fold should go.
On an unrelated note, Acons could quantify over a single x, replacing f x x'' with just x.
Is there a tactic similar to intros to prove a boolean implication such as
f : nat -> bool
g : nat -> bool
Lemma f_implies_g : forall n : nat, eq_true(implb (f n) (g n)).
This tactic would pull eq_true(f n) into the context and require to prove eq_true(g n).
Let me suggest to use SSReflect in this case. Because it already has the machinery you need. It does not use eq_true to embed bool into Prop, but rather is_true, which is an alternate way to do it.
From Coq Require Import ssreflect ssrbool.
Variables f g : nat -> bool.
Lemma f_implies_g n : (f n) ==> (g n).
Proof.
apply/implyP => Hfn.
Abort.
The snippet above does what you want, implicitly coercing f n and g n into Prop. Having executed the snippet you see this
n : nat
Hfn : f n
============================
g n
but Set Printing Coercions. reveals that it's really
n : nat
Hfn : is_true (f n)
============================
is_true (g n)
that you have.
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.