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.
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 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.
A monic and epic function is an isomorphism, hence it has an inverse. I'd like a proof of that in Coq.
Axiom functional_extensionality: forall A B (f g : A->B), (forall a, f a = g a) -> f = g.
Definition compose {A B C} (f : B->C) (g: A->B) a := f (g a).
Notation "f ∘ g" := (compose f g) (at level 40).
Definition id {A} (a:A) := a.
Definition monic {A B} (f:A->B) := forall C {h k:C->A}, f ∘ h = f ∘ k -> h = k.
Definition epic {A B} (f:A->B) := forall C {h k:B->C}, h ∘ f = k ∘ f -> h = k.
Definition iso {A B} (f:A->B) := monic f /\ epic f.
Goal forall {A B} (f:A->B), iso f -> exists f', f∘f' = id /\ f'∘f = id.
The proofs I have found online (1, 2) do not give a construction of f' (the inverse). Is it possible to show this in Coq? (It is not obvious to me that the inverse is computable...)
First, a question of terminology. In category theory, an isomorphism is a morphism that has a left and a right inverse, so I am changing slightly your definitions:
Definition compose {A B C} (f : B->C) (g: A->B) a := f (g a).
Notation "f ∘ g" := (compose f g) (at level 40).
Definition id {A} (a:A) := a.
Definition monic {A B} (f:A->B) := forall C {h k:C->A}, f ∘ h = f ∘ k -> h = k.
Definition epic {A B} (f:A->B) := forall C {h k:B->C}, h ∘ f = k ∘ f -> h = k.
Definition iso {A B} (f:A->B) :=
exists g : B -> A, f ∘ g = id /\ g ∘ f = id.
It is possible to prove this result by assuming a few standard axioms, namely propositional extensionality and constructive definite description (a.k.a. the axiom of unique choice):
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Logic.PropExtensionality.
Require Import Coq.Logic.Description.
Section MonoEpiIso.
Context (A B : Type).
Implicit Types (f : A -> B) (x : A) (y : B).
Definition surjective f := forall y, exists x, f x = y.
Lemma epic_surjective f : epic f -> surjective f.
Proof.
intros epic_f y.
assert (H : (fun y => exists x, f x = y) = (fun y => True)).
{ apply epic_f.
apply functional_extensionality.
intros x; apply propositional_extensionality; split.
- intros _; exact I.
- now intros _; exists x. }
now pattern y; rewrite H.
Qed.
Definition injective f := forall x1 x2, f x1 = f x2 -> x1 = x2.
Lemma monic_injective f : monic f -> injective f.
Proof.
intros monic_f x1 x2 e.
assert (H : f ∘ (fun a : unit => x1) = f ∘ (fun a : unit => x2)).
{ now unfold compose; simpl; rewrite e. }
assert (e' := monic_f _ _ _ H).
exact (f_equal (fun g => g tt) e').
Qed.
Lemma monic_epic_iso f : monic f /\ epic f -> iso f.
Proof.
intros [monic_f epic_f].
assert (Hf : forall y, exists! x, f x = y).
{ intros y.
assert (sur_f := epic_surjective _ epic_f).
destruct (sur_f y) as [x xP].
exists x; split; trivial.
intros x' x'P.
now apply (monic_injective _ monic_f); rewrite xP, x'P. }
exists (fun a => proj1_sig (constructive_definite_description _ (Hf a))).
split; apply functional_extensionality; unfold compose, id.
- intros y.
now destruct (constructive_definite_description _ (Hf y)).
- intros x.
destruct (constructive_definite_description _ (Hf (f x))); simpl.
now apply (monic_injective _ monic_f).
Qed.
End MonoEpiIso.
I believe it is not possible to prove this result without at least some form of unique choice. Assume propositional and functional extensionality. Note that, if exists! x : A, P x holds, then the unique function
{x | P x} -> unit
is both injective and surjective. (Injectivity follows from the uniqueness part, and surjectivity follows from the existence part.) If this function had an inverse for every P : A -> Type, then we could use this inverse to implement the axiom of unique choice. Since this axiom does not hold in Coq, it shouldn't be possible to build this inverse in the basic theory.
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 two elements f : X -> bool and x : X.
How to define g : X -> bool such g x = true and g y = f y for y != x.
Following your answer to my comment, I don't think you can define a "function" g, because you need a constructive way do distinguish x from other instances of type X. However you could define a relation between the two, which could be transformed into a function if you get decidability.
Something like:
Parameter X : Type.
Parameter f : X -> bool.
Parameter x : X.
Inductive gRel : X -> bool -> Prop :=
| is_x : gRel x true
| is_not_x : forall y: X, y <> x -> gRel y (f y)
.
Definition gdec (h: forall a b: X, {a = b}+{a <> b}) : X -> bool :=
fun a => if h a x then true else f a.
Lemma gRel_is_a_fun: (forall a b: X, {a = b}+{a <> b}) ->
exists g : X -> bool, forall a, gRel a (g a).
Proof.
intro hdec.
exists (gdec hdec); unfold gdec.
intro a; destruct (hdec a x).
now subst; apply is_x.
now apply is_not_x.
Qed.
Just complementing Vinz's answer, there's no way of defining such a function for arbitrary X, because it implies that X has "almost decidable" equality:
Section Dec.
Variable X : Type.
Variable override : (X -> bool) -> X -> X -> bool.
Hypothesis Hoverride_eq : forall f x, override f x x = true.
Hypothesis Hoverride_neq : forall f x x', x <> x' -> override f x x' = f x'.
Lemma xeq_dec' (x x' : X) : {~ x <> x'} + {x <> x'}.
Proof.
destruct (override (fun _ => false) x x') eqn:E.
- left.
intros contra.
assert (H := Hoverride_neq (fun _ => false) _ _ contra).
simpl in H.
congruence.
- right.
intros contra.
subst x'.
rewrite Hoverride_eq in E.
discriminate.
Qed.
End Dec.
This lemma says that if there's a way of doing what you asked for for X, then one can test whether two elements x and x' of X are equal, except that the proof of equality that one gets in the true case is actually a proof of the double negation of x = x'.