Implementing/specifying permutation groups in coq - 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.

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.

Abstraction/typing error resulting from case_eq and rewriting in Coq

Consider the situation described by the code below, wherein I have a "piecewise" function h behaving differently (like f, or like g) depending on some (decidable) property condition of its input (h is defined using case_eq). Assume that I can prove that a property is guaranteed of the image of any x after application of either of the partial functions f or g; I should be able to prove that the entire function h guarantees property using a simple case_eq proof, no? Yet the following code rejects the rewrite step:
Section Error.
Variables X Y : Type.
Variables n m : Y.
Variable condition : X -> bool.
Variable property : Y -> Prop.
Definition type1 (x : X) : Prop := condition x = true.
Definition type2 (x : X) : Prop := condition x = false.
Variable f : {x:X | type1 x} -> Y.
Variable g : {x:X | type2 x} -> Y.
Definition h : X -> Y. intro x. case_eq (condition x); intro.
- exact (f (exist type1 x H)).
- exact (g (exist type2 x H)).
Defined.
Hypothesis Hf : forall x, property (f x).
Hypothesis Hg : forall x, property (g x).
Theorem hRange : forall x, property (h x).
Proof. intro. case_eq (condition x); intro.
- unfold h. rewrite H.
with the error
Abstracting over the term "condition x" leads to a term
fun b : bool =>
property
((if b as b0 return (b = b0 -> Y)
then fun H0 : b = true => f (exist type1 x H0)
else fun H0 : b = false => g (exist type2 x H0)) eq_refl)
which is ill-typed.
Reason is: Illegal application:
The term "exist" of type "forall (A : Type) (P : A -> Prop) (x : A), P x -> {x : A | P x}"
cannot be applied to the terms
"X" : "Type"
"type1" : "X -> Prop"
"x" : "X"
"H0" : "b = true"
The 4th term has type "b = true" which should be coercible to "type1 x".
Of course, I wish it would eliminate the if clause, rewriting the goal to property (f (exist type1 x H)) but Coq doesn't like this. Why not?
I feel Coq wouldn't behave like this if the hypothesis generated by case_eq in the definition of h wasn't implicated in the result (in this case, I could've rewritten h with a match clause, and those cause me no issue. In the present situation, just assume that the hypothesis is crucial to constructing some "non-computational" part of either f x or g x, e.g. if Y is itself a sig-type). I've read other threads like this and this, but to the short extent that I understand them, they don't help me understand my situation.
This problem occurs when you try to destruct or rewrite all the occurrences of a subterm. Here, you've rewritten condition x in the type of H0, which causes exist type1 x H0 to be ill-typed (can you see why?).
The solution is to restrict the destruct or rewrite to only some of the subterms. This might require you to generalize part of your goal. For example:
From Coq Require Import ssreflect.
Section Error.
Variables X Y : Type.
Variables n m : Y.
Variable condition : X -> bool.
Variable property : Y -> Prop.
Definition type1 (x : X) : Prop := condition x = true.
Definition type2 (x : X) : Prop := condition x = false.
Variable f : {x:X | type1 x} -> Y.
Variable g : {x:X | type2 x} -> Y.
Definition h : X -> Y. intro x. case_eq (condition x); intro.
- exact (f (exist type1 x H)).
- exact (g (exist type2 x H)).
Defined.
Hypothesis Hf : forall x, property (f x).
Hypothesis Hg : forall x, property (g x).
Theorem hRange : forall x, property (h x).
Proof.
intro; unfold h; generalize (eq_refl (condition x)).
case: {2 3}(condition x).
- intros H. apply Hf.
- intros H. apply Hg.
Qed.
End Error.
After generalizing eq_refl, the goal looks like this:
1 subgoal (ID 16)
X, Y : Type
n, m : Y
condition : X -> bool
property : Y -> Prop
f : {x : X | type1 x} -> Y
g : {x : X | type2 x} -> Y
Hf : forall x : {x : X | type1 x}, property (f x)
Hg : forall x : {x : X | type2 x}, property (g x)
x : X
============================
forall e : condition x = condition x,
property
((if condition x as b return (condition x = b -> Y)
then fun H : condition x = true => f (exist type1 x H)
else fun H : condition x = false => g (exist type2 x H)) e)
The tactic case: {2 3}..., which was imported from ssreflect, says that condition x should only be destructed on the RHS of e and on the condition of the if.

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.

Path induction using eq_rect

According to Homotopy Type Theory (page 49), this is the full induction principle for equality :
Definition path_induction (A : Type) (C : forall x y : A, (x = y) -> Type)
(c : forall x : A, C x x eq_refl) (x y : A) (prEq : x = y)
: C x y prEq :=
match prEq with
| eq_refl => c x
end.
I don't understand much about HoTT, but I do see path induction is stronger than eq_rect :
Lemma path_ind_stronger : forall (A : Type) (x y : A) (P : A -> Type)
(prX : P x) (prEq : x = y),
eq_rect x P prX y prEq =
path_induction A (fun x y pr => P x -> P y) (fun x pr => pr) x y prEq prX.
Proof.
intros. destruct prEq. reflexivity.
Qed.
Conversely, I failed to construct path_induction from eq_rect. Is it possible ? If not, what is the correct induction principle for equality ? I thought those principles were mechanically derived from the Inductive type definitions.
EDIT
Thanks to the answer below, the full induction principle on equality can be generated by
Scheme eq_rect_full := Induction for eq Sort Prop.
Then we get the converse,
Lemma eq_rect_full_works : forall (A : Type) (C : forall x y : A, (x = y) -> Prop)
(c : forall x : A, C x x eq_refl) (x y : A)
(prEq : x = y),
path_induction A C c x y prEq
= eq_rect_full A x (fun y => C x y) (c x) y prEq.
Proof.
intros. destruct prEq. reflexivity.
Qed.
I think you are referring to the fact that the result type of path_induction mentions the path that is being destructed, whereas the one of eq_rect does not. This omission is the default for inductive propositions (as opposed to what happens with Type), because the extra argument is not usually used in proof-irrelevant developments. Nevertheless, you can instruct Coq to generate more complete induction principles with the Scheme command: https://coq.inria.fr/distrib/current/refman/user-extensions/proof-schemes.html?highlight=minimality. (The Minimality variant is the one used for propositions by default.)

Moving from computable functions to inductive relations

I am trying to understand how to move from theorems that operate on computable functions to theorems that use inductively defined relations to represent computations. Consider this simple development below. Let's start with a standard definition of relations and their properties:
Definition relation (X : Type) := X -> X -> Prop.
Definition reflexive {X : Type} (R : relation X) :=
forall a, R a a.
Definition transitive {X : Type} (R : relation X) :=
forall a b c : X, (R a b) -> (R b c) -> (R a c).
Now I define three properties defined for a relation R and two functions F and G:
Definition propA {X : Type} (R : relation X) (F G : X -> X) :=
forall p q, R (F p) q <-> R p (G q).
Definition propB {X : Type} (R : relation X) (F G : X -> X) :=
forall x, R x (G (F x)).
Definition propC {X : Type} (R : relation X) (F : X -> X) :=
forall a b : X, R a b -> R (F a) (F b).
I state a theorem that if R is reflexive and property A holds for R, F and G, then property B also holds R, F and G.
Lemma aPropB {X : Type} {R : relation X} {F G : X -> X} (Rrefl : reflexive R)
(H : propA R F G) :
propB R F G.
Proof.
unfold propB in *.
intros.
apply H. apply Rrefl.
Qed.
Finally I state a theorem that if R is reflexive and transitive, and property A holds for R, F and G, then property C holds for R and F.
Lemma aPropC {X : Type} {R : relation X} {F G : X -> X}
(Rrefl : reflexive R) (Rtrans : transitive R) (H : propA R F G) :
propC R F.
Proof.
unfold propC in *.
intros.
apply H.
eapply Rtrans. eassumption.
apply aPropB; assumption.
Qed.
Now I would like to move from representing F and G as computations to representing them as relations. So instead of saying F : X -> X I will now just say F : relation X and insist that F is deterministic:
Definition deterministic {X : Type} (F : relation X) :=
forall x y1 y2, F x y1 -> F x y2 -> y1 = y2.
I restate all three properties:
Definition propA' {X : Type} (R : relation X) (F G : relation X)
(Fdet : deterministic F) (Gdet : deterministic G) :=
forall p q x y, F p x -> G q y -> R x q <-> R p y.
Definition propB' {X : Type} (R : relation X) (F G : relation X)
(Fdet : deterministic F) (Gdet : deterministic G) :=
forall x y z, F x y -> G y z -> R x z.
Definition propC' {X : Type} (R : relation X) (F : relation X)
(Fdet : deterministic F) :=
forall a b x y : X, F a x -> F b y -> R a b -> R x y.
Transformation pattern that I have followed is that expression R a (F b) is turned into F b x -> R a x, meaning "F b evaluates to some x and a is in relation R with that x". Now for the theorems. First one follows quite easily:
Lemma aPropB' {X : Type} {R : relation X} {Rrefl : reflexive R}
{F G : relation X} {Fdet : deterministic F} {Gdet : deterministic G}
(H : propA' R F G Fdet Gdet) :
propB' R F G Fdet Gdet.
Proof.
unfold propA', propB' in *.
intros.
specialize (H x y y z).
apply H; auto.
Qed.
But I am stuck with the second one. I start the proof like this:
Lemma aPropC' {X : Type} {R : relation X} {F G : relation X}
{Fdet : deterministic F} {Gdet : deterministic G}
(Rrefl : reflexive R) (Rtrans : transitive R)
(H : propA' R F G Fdet Gdet) :
propC' R F Fdet.
Proof.
unfold propC' in *.
intros.
eapply H; try eassumption.
and end with a following goal to prove (some irrelevant hypotheses omitted):
H : propA' R F G Fdet Gdet
H0 : F a x
H1 : F b y
H2 : R a b
─────────────────────────────────────────────────────
G y b
The problem is that G is now an explicit premise of propA' and I have to prove it if I want to rely on propA'. But I have no assumptions about G in my current proof context and I don't see a way to finish the proof. Previously in aPropC, that used functions, G would only appear in conclusions of aPropA and aPropB. So the shape of the goal matched the shape of my hypotheses and known lemmas, allowing me to use them easily.
Where am I going wrong here? Is my transition from functions to relations incorrect? Is there any technique that I could use here?
Functions in Coq are not just deterministic relations but also total ones. So you may want to throw in:
Definition total {X : Type} (R : relation X) : Prop :=
forall x, exists y, R x y.
And then the notion of being functional is the conjunction of deterministic and total:
Definition functional {X : Type} (R : relation X) : Prop :=
deterministic R /\ total R.
Alternatively, you can add assumptions to your lemmas relating the domains of the partial functions your relations represent.