I'm able to use rewrite under bindings with one parameter
Require Import Setoid.
Require Import Relation_Definitions.
Require Import FunctionalExtensionality.
Parameters f f' : nat -> nat.
Parameter wrap : nat -> (nat -> nat) -> nat.
Axiom ff'_eq : forall x, f x = f' x.
Add Parametric Morphism :
wrap
with signature (Logic.eq ==> pointwise_relation nat Logic.eq ==> Logic.eq)
as wrap_mor.
Proof.
cbv. intros x f f' H.
apply functional_extensionality in H.
rewrite H.
reflexivity.
Qed.
Lemma test_lemma y :
wrap y (fun x => f x) = wrap y (fun x => f' x).
setoid_rewrite ff'_eq.
reflexivity.
Qed.
But I'm not able to go through a bit more involved case, namely when wrap : nat -> (nat -> nat -> nat) and f f' : nat -> nat -> nat -> nat.
Require Import Setoid.
Require Import Relation_Definitions.
Require Import FunctionalExtensionality.
Parameter f f' : nat -> nat -> nat -> nat.
Parameter wrap : nat -> (nat -> nat -> nat) -> nat.
(* Axiom ff'_eq : forall x y z, f x y z = f' x y z. *)
Axiom ff''_eq : forall z, (forall x y, f x y z = f' x y z).
Definition pointwise_relation2 :
forall (A1 A2 : Type) {B : Type}, relation B -> relation (A1 -> A2 -> B) :=
let U := Type in
fun (A1 A2 B : U) (R : relation B) (f g : A1 -> A2 -> B) =>
forall (a1 : A1) (a2 : A2), R (f a1 a2) (g a1 a2).
Axiom test1 : forall (x : nat) (f g : nat -> nat -> nat),
pointwise_relation2 nat nat Logic.eq f g -> wrap x f = wrap x g.
Add Parametric Morphism :
wrap with signature
(Logic.eq ==> pointwise_relation2 nat nat Logic.eq ==> Logic.eq)
as wrap_mor.
Proof. exact test1. Qed.
Lemma test_lemma2 y z:
wrap y (fun x1 x2 => f x1 x2 z) = wrap y (fun x1 x2 => f' x1 x2 z).
specialize (ff''_eq z) as feq.
Fail setoid_rewrite feq.
A question mainly is: what should I use as a relation?
I'm not sure what namely i'm doing wrong here. Do I use wrong relation or do I try to pass wrong argument to setoid_rewrite?
You can use the "pointwise relation of a pointwise relation" as a relation on binary functions:
Require Import Setoid Morphisms.
Parameter f f' : nat -> nat -> nat -> nat.
Parameter wrap : nat -> (nat -> nat -> nat) -> nat.
(* Axiom ff'_eq : forall x y z, f x y z = f' x y z. *)
Axiom ff''_eq : forall z, (forall x y, f x y z = f' x y z).
(* The "Add Parametric Morphism" command expands to this instance, which is simpler to write... *)
Axiom test1 : Proper (eq ==> pointwise_relation nat (pointwise_relation nat eq) ==> eq) wrap.
Existing Instance test1.
Lemma test_lemma2 y z:
wrap y (fun x1 x2 => f x1 x2 z) = wrap y (fun x1 x2 => f' x1 x2 z).
Proof.
specialize (ff''_eq z) as feq.
setoid_rewrite feq.
Related
I have a problem in proving trivial proposition.
First, We define a composition of function with general domain and codomain:
Definition fun_comp {X Y Z W}
(f : X -> Y) (g : Z -> W) (H : Y = Z) : X -> W.
destruct H. refine (fun x => g (f x)). Defined.
We will now try to prove a trivial lemma:
Lemma compose_trivial {X Y Z} (f : X -> Y) (g : Y -> Z) (H : Y = Y)
: forall x, fun_comp f g H x = g (f x).
Proof.
intros x. revert f g. destruct H.
But destruct H. fails with an error message:
Cannot instantiate metavariable P of type
"forall a : Type, Y = a -> Prop" with abstraction
"fun (Y : Type) (H : Y = Y) =>
forall (f : X -> Y) (g : Y -> Z), fun_comp f g H x = g (f x)"
of incompatible type
"forall Y : Type, Y = Y -> Prop".
If it is able to generalize Y in the right hand side of H independently, the destruct tactic would work, but it would contradict to the right hand side of the goal g (f x).
Is it possible to prove trivial_compose? If possible, how can I?
This is not trivial at all. This has to do with uniqueness of identity proof that is not provable in Coq. You need an extra axiom.
For example,
Require Import ProofIrrelevance.
Lemma compose_trivial {X Y Z} (f : X -> Y) (g : Y -> Z) (H : Y = Y)
: forall x, fun_comp f g H x = g (f x).
Proof.
intros x.
now rewrite <- (proof_irrelevance _ (eq_refl Y) H).
Qed.
I have a following code. I didn't write the full code, but this should work.
Definition in_domain {X Y : Set} (f : X -> option Y) x := match (f x) with | Some y => True | None => False end.
Definition injective {X Y : Set} (f : X -> option Y) := forall x y z, f x = Some z -> f y = Some z -> x = y.
Definition surjective {X Y : Set} (f : X -> option Y) := forall y, exists x, f x = Some y.
Definition bijective {X Y : Set} (f : X -> option Y) := injective f /\ surjective f.
Definition compose {X Y Z : Set} (f : X -> option Y) (g : Y -> option Z) (H : forall x, in_domain f x -> in_domain g (f x)) := fun x => match (f x) with | Some y => g y | None => None end.
Now I am trying to write Definition inverse {X Y : Set} (f : X -> option Y) (H : bijective f) : Y -> option X. I couldn't make the function g that f x = Some y <-> g y = Some x.
If generating such function is possible, could you please demonstrate how to?
You need axioms to do this, because Coq does not allow you by default to extract the witness out of an existential proof. In this case, you only need functional extensionality and the principle of unique choice, a weaker variant of the axiom of choice. Here is one possibility for a simplified variant of your problem:
Require Import Coq.Logic.Description.
Require Import Coq.Logic.FunctionalExtensionality.
Definition injective {X Y : Set} (f : X -> Y) := forall x y, f x = f y -> x = y.
Definition surjective {X Y : Set} (f : X -> Y) := forall y, exists x, f x = y.
Definition bijective {X Y : Set} (f : X -> Y) := injective f /\ surjective f.
Lemma inverse {X Y : Set} (f : X -> Y) :
bijective f -> {g : Y -> X | (forall x, g (f x) = x) /\
(forall y, f (g y) = y) }.
Proof.
intros [inj sur].
apply constructive_definite_description.
assert (H : forall y, exists! x, f x = y).
{ intros y.
destruct (sur y) as [x xP].
exists x; split; trivial.
intros x' x'P.
now apply inj; rewrite xP, x'P. }
exists (fun y => proj1_sig (constructive_definite_description _ (H y))).
split.
- split.
+ intros x.
destruct (constructive_definite_description _ _).
simpl.
now apply inj.
+ intros y.
now destruct (constructive_definite_description _ _).
- intros g' [H1 H2].
apply functional_extensionality.
intros y.
destruct (constructive_definite_description _ _) as [x e].
simpl.
now rewrite <- e, H1.
Qed.
I am trying to implement/specify the permutation groups (symmetric groups) in coq. This went well for a bit, until I tried to prove that the identity is actually the identity. My proof gets stuck on proving that the proposition "x is invertible" is exactly the same as the proposition "id * x is invertible".
Are these two propositions actually the same? Am I trying to prove something that is not true? Is there a better way of specifying the permutation group (as a type)?
(* The permutation group on X contains all functions between X and X that are bijective/invertible *)
Inductive G {X : Type} : Type :=
| function (f: X -> X) (H: exists g: X -> X, forall x : X, f (g x) = x /\ g (f x) = x).
(* Composing two functions preserves invertibility *)
Lemma invertible_composition {X : Type} (f g: X -> X) :
(exists f' : X -> X, forall x : X, f (f' x) = x /\ f' (f x) = x) ->
(exists g' : X -> X, forall x : X, g (g' x) = x /\ g' (g x) = x) ->
exists h : X -> X, forall x : X, (fun x => f (g x)) (h x) = x /\ h ((fun x => f (g x)) x) = x.
Admitted.
(* The group operation is composition *)
Definition op {X : Type} (a b : G) : G :=
match a, b with
| function f H, function g H' => function (fun x => f (g x)) (#invertible_composition X f g H H')
end.
Definition id' {X : Type} (x : X) : X := x.
(* The identity function is invertible *)
Lemma id_invertible {X : Type} : exists g : X -> X, forall x : X, id' (g x) = x /\ g (id' x) = x.
Admitted.
Definition id {X : Type} : (#G X) := function id' id_invertible.
(* The part on which I get stuck: proving that composition with the identity does not change elements. *)
Lemma identity {X: Type} : forall x : G, op id x = x /\ #op X x id = x.
Proof.
intros.
split.
- destruct x.
simpl.
apply f_equal.
Abort.
I believe that your statement cannot be proved without assuming extra axioms:
proof_irrelevance:
forall (P : Prop) (p q : P), p = q.
You need this axiom to show that two elements of G are equal when the underlying functions are:
Require Import Coq.Logic.ProofIrrelevance.
Inductive G X : Type :=
| function (f: X -> X) (H: exists g: X -> X, forall x : X, f (g x) = x /\ g (f x) = x).
Arguments function {X} _ _.
Definition fun_of_G {X} (f : G X) : X -> X :=
match f with function f _ => f end.
Lemma fun_of_G_inj {X} (f g : G X) : fun_of_G f = fun_of_G g -> f = g.
Proof.
destruct f as [f fP], g as [g gP].
simpl.
intros e.
destruct e.
f_equal.
apply proof_irrelevance.
Qed.
(As a side note, it is usually better to declare the X parameter of G explicitly, rather than implicitly. It is rarely the case that Coq can figure out what X should be on its own.)
With fun_of_G_inj, it should be possible to show identity simply by applying it to each equality, because fun a => (fun x => x) (g a) is equal to g for any g.
If you want to use this representation for groups, you'll probably also need the axiom of functional extensionality eventually:
functional_extensionality:
forall X Y (f g : X -> Y), (forall x, f x = g x) -> f = g.
This axiom is available in the Coq.Logic.FunctionalExtensionality module.
If you want to define the inverse element as a function, you probably also need some form of the axiom of choice: it is necessary for extracting the inverse element g from the existence proof.
If you don't want to assume extra axioms, you have to place restrictions on your permutation group. For instance, you can restrict your attention to elements with finite support -- that is, permutation that fix all elements of X, except for a finite set. There are multiple libraries that allow you to work with permutations this way, including my own extensional structures.
I am trying to learn COQ, by implementing facts on Posets. While proving my first theorem I am stuck here.
Class Poset {A: Type} ( leq : A -> A -> Prop ) : Prop := {
reflexivity: forall x y : A, x = y -> (leq x y);
antisymmetry: forall x y : A, ((leq x y) /\ (leq y x)) -> x = y;
transitivity: forall x y z :A, ((leq x y) /\ (leq y z) -> (leq x z))
}.
Module Poset.
Parameter A : Type.
Parameter leq : A -> A -> Prop.
Parameter poset : #Poset A leq.
Definition null_element (n : A) :=
forall a : A, leq n a.
Theorem uniqueness_of_null_element (n1 : A) (n2 : A) : null_element(n1) /\ null_element(n2) -> n1 = n2.
Proof.
unfold null_element.
Qed.
End Poset.
I am not sure how to proceed after this. Can someone help?
I think I got it.
This is what I did.
Proof.
unfold null_element.
intros [H1 H2].
specialize H1 with n2.
specialize H2 with n1.
apply antisymmetry.
split.
- apply H1.
- apply H2.
Qed.
I have a formula inductively defined as follows:
Parameter world : Type.
Parameter R : world -> world -> Prop.
Definition Proposition : Type := world -> Prop
(* This says that R has only a finite number of steps it can take *)
Inductive R_ends : world -> Prop :=
| re : forall w, (forall w', R w w' -> R_ends w') -> R_ends w.
(* if every reachable state will end then this state will end *)
And hypothesis:
Hypothesis W : forall w, R_ends w.
I would like to prove:
forall P: Proposition, (forall w, (forall w0, R w w0 -> P w0) -> P w)) -> (forall w, P w)
I tried using the induction tactic on the type world but failed since it is not an inductive type.
Is it provable in Coq and if yes, can you suggest how?
You can use structural induction on a term of type R_ends:
Lemma lob (P : Proposition) (W : forall w, R_ends w) :
(forall w, (forall w0, R w w0 -> P w0) -> P w) -> (forall w, P w).
Proof.
intros H w.
specialize (W w).
induction W.
apply H.
intros w' Hr.
apply H1.
assumption.
Qed.
Incidentally, you could have defined R_ends in a slightly different manner, using a parameter instead of an index:
Inductive R_ends (w : world) : Prop :=
| re : (forall w', R w w' -> R_ends w') -> R_ends w.
When written this way, it's easy to see that R_ends is analogous to the accessibility predicate Acc, defined in the standard library (Coq.Init.Wf):
Inductive Acc (x: A) : Prop :=
Acc_intro : (forall y:A, R y x -> Acc y) -> Acc x.
It's used to work with well-founded induction.