Change a function at one point - coq

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'.

Related

"Cannot instantiate metavariable P of type ..." when destructing in Coq proof mode

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.

How to make an inverse function in coq

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.

Implementing/specifying permutation groups in coq

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.

Stuck on proving uniqueness of null element in posets

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.

How to introduce a new existential condition from a witness in Coq?

My question relates to how to construct an exist term in the set of conditions/hypotheses.
I have the following intermediate proof state:
X : Type
P : X -> Prop
H : (exists x : X, P x -> False) -> False
x : X
H0 : P x -> False
______________________________________(1/1)
P x
In my mind, I know that because of H0, x is a witness for (exists x : X, P x -> False), and I want to introduce a name:
w: (exists x : X, P x -> False)
based on the above reasoning and then use it with apply H in w to generate a False in the hypothesis, and finally inversion the False.
But I don't know what tactic/syntax to use to introduce the witness w above. The best I can reach so far is that Check (ex_intro _ (fun x => P x -> False) x H0)). gives False.
Can someone explain how to introduce the existential condition, or an alternative way to finish the proof?
Thanks.
P.S. What I have for the whole theorem to prove is:
Theorem not_exists_dist :
excluded_middle ->
forall (X:Type) (P : X -> Prop),
~ (exists x, ~ P x) -> (forall x, P x).
Proof.
unfold excluded_middle. unfold not.
intros exm X P H x.
destruct (exm (P x)).
apply H0.
Check (H (ex_intro _ (fun x => P x -> False) x H0)).
Here, since you already know how to construct a term of type False, you can add it to the context using pose proof. This gives:
pose proof (H (ex_intro (fun x => P x -> False) x H0))
You can even directly destruct the term, which solves the goal.
destruct (H (ex_intro (fun x => P x -> False) x H0))
Another way to finish your proof is to prove False. You can change the goal to False with tactics like exfalso or contradiction. With this approach, you can use hypotheses of the form _ -> False that are otherwise difficult to manipulate. For your proof, you can write:
exfalso. apply H. (* or directly, contradiction H *)
exists x. assumption.
You could use the assert tactic:
assert(w: exists x, P x -> False).
It will ask you to prove this statement in a new sub-goal, and will add w to your existing goal. For this kind of trivial proof, you can inline the proof directly:
assert(w: exists x, P x -> False) by (exists x; exact H0).