A good way to formalize groups in Coq - coq

I try to formalize groups in Coq. I want to be as general as possible. I try to do something, but I'm not really happy with it. I found different implementations and I don't know which one to choose.
For example I found this :
https://people.cs.umass.edu/~arjun/courses/cs691pl-spring2014/assignments/groups.html
(* The set of the group. *)
Parameter G : Set.
(* The binary operator. *)
Parameter f : G -> G -> G.
(* The group identity. *)
Parameter e : G.
(* The inverse operator. *)
Parameter i : G -> G.
(* For readability, we use infix <+> to stand for the binary operator. *)
Infix "<+>" := f (at level 50, left associativity).
(* The operator [f] is associative. *)
Axiom assoc : forall a b c, a <+> b <+> c = a <+> (b <+> c).
(* [e] is the right-identity for all elements [a] *)
Axiom id_r : forall a, a <+> e = a.
(* [i a] is the right-inverse of [a]. *)
Axiom inv_r : forall a, a <+> i a = e.
but why the author use axioms and not definitions ? Moreover, I don't like to have some parameters at top level.
On the book CoqArt, I found this implementation :
Record group : Type :=
{A : Type;
op : A→A→A;
sym : A→A;
e : A;
e_neutral_left : ∀ x:A, op e x = x;
sym_op : ∀ x:A, op (sym x) x = e;
op_assoc : ∀ x y z:A, op (op x y) z = op x (op y z)}.
On this definition I think the definition is to specialize, because if I want to define monoïds, I will redefine op_assoc or neutre left. Beyond that,
for some theorems, I don't need to use groups. For example if I want to proove that right_inverse is the same as left_inverse if the law is associative.
An other question is what are good axioms for groups :
use neutral element as axiom or left neutral element
use inverse element as axiom or left inverse
What is the more convenient to work with ?
Finally, if I want to proove some other theorems, I probably want to have some syntactic sugar in order to use the binary operation and inverse elements. What are your advices to have a convenient notation for groups ?
For the moment I did this :
Definition binary_operation {S:Set} := S -> S -> S.
Definition commutative {S:Set} (dot:binary_operation) := forall (a b:S), dot a b = dot b a.
Definition associative {S:Set} (dot:binary_operation) := forall (a b c:S), dot (dot a b) c = dot a (dot b c).
Definition left_identity {S:Set} (dot:binary_operation) (e:S) := forall a:S, (dot e a) = a.
Definition right_identity {S:Set} (dot:binary_operation) (e:S) := forall a:S, (dot a e) = a.
Definition identity {S:Set} (dot: binary_operation) (e:S) := left_identity dot e /\ right_identity dot e.
Definition left_inv {S:Set} (dot:binary_operation) (a' a e:S) := identity dot e -> dot a' a = e.
Definition right_inv {S:Set} (dot:binary_operation) (a' a e:S) := identity dot e -> dot a a' = e.
Definition inv {S:Set} (dot:binary_operation) (a' a e:S) := left_inv dot a' a e /\ right_inv dot a' a e.
I found an implementation in the code source of Coq but I don't understand why it is a good implementation : https://github.com/tmiya/coq/blob/master/group/group2.v

I can't provide a complete answer, but perhaps this can help you a bit.
Your first article provides definitions and axioms sufficient for proving exercises without paying too much attention to being 'good' or 'useful' implementation. That's why axioms and not definitions.
If you want 'to be as general as possible', you can use example from CoqArt, or wrap your group definition in a section, using Variable instead of Parameter.
Section Group.
(* The set of the group. *)
Variable G : Set.
(* The binary operator. *)
Variable f : G -> G -> G.
(* The group identity. *)
Variable e : G.
(* The inverse operator. *)
Variable i : G -> G.
(* For readability, we use infix <+> to stand for the binary operator. *)
Infix "<+>" := f (at level 50, left associativity).
(* The operator [f] is associative. *)
Variable assoc : forall a b c, a <+> b <+> c = a <+> (b <+> c).
(* [e] is the right-identity for all elements [a] *)
Variable id_r : forall a, a <+> e = a.
(* [i a] is the right-inverse of [a]. *)
Variable inv_r : forall a, a <+> i a = e.
If you then prove some theorems inside this section, like this:
Theorem trivial : forall a b, a <+> e <+> b = a <+> b.
intros.
rewrite id_r.
auto.
Qed.
After section ends,
End Group.
Coq generalizes them
Check trivial.
trivial
: forall (G : Set) (f : G -> G -> G) (e : G),
(forall a : G, f a e = a) -> forall a b : G, f (f a e) b = f a b
As for your last example, it's probably not about actual definition of group, but instead about proving that a set, a binary operation and four axioms for this operation define a group.

Related

Defining functions inside proof scope

I'm trying to prove that injective functions are left invertible in Coq. I've reached a point in my proof where my goal is an "exists" proposition. I want to define a function that uses terms from proof scope (types and functions I've intro'ed before) and then show the function to the "exists" goal. Here's what I wrote so far:
(* function composition *)
Definition fun_comp {A B C: Type} (f:A -> B) (g:B -> C) : A -> C :=
fun a: A => g (f a).
Notation "g .o f" := (fun_comp f g) (at level 70).
Definition nonempty (A: Type) := exists a: A, a = a.
(* identity function for any given type *)
Definition fun_id (A: Type) := fun a: A => a.
(* left invertible *)
Definition l_invertible {A B: Type} (f: A -> B) :=
exists fl:B->A, fl .o f = fun_id A.
Definition injective {A B: Type} (f: A -> B) :=
forall a a': A, f a = f a' -> a = a'.
(* is a given element in a function's image? *)
Definition elem_in_fun_image {A B: Type} (b: B) (f: A -> B) :=
exists a: A, f a = b.
Theorem injective_is_l_invertible:
forall (A B: Type) (f: A -> B), nonempty A /\ injective f -> l_invertible f.
Proof.
intros A B f H.
destruct H as [Hnempty Hinj].
unfold l_invertible.
unfold nonempty in Hnempty.
destruct Hnempty as [a0].
(* here would go my function definition and invoking "exists myfun" *)
Here's the function I'm trying to define:
Definition fL (b: B) := if elem_in_fun_image b f
then f a
else a0.
Here's what the proof window looks like:
1 subgoal
A : Type
B : Type
f : A -> B
a0 : A
H : a0 = a0
Hinj : injective f
========================= (1 / 1)
exists fl : B -> A, (fl .o f) = fun_id A
How do I do this? I'm very new to Coq so other comments and pointers are welcome.
This definition cannot be performed in the basic logic. You need to add in a few extra axioms:
(* from Coq.Logic.FunctionalExtensionality *)
functional_extensionality : forall A B (f g : A -> B),
(forall x, f x = g x) -> f = g
(* from Coq.Logic.Classical *)
classic : forall P : Prop, P \/ ~ P
(* from Coq.Logic.ClassicalChoice *)
choice : forall (A B : Type) (R : A->B->Prop),
(forall x : A, exists y : B, R x y) ->
exists f : A->B, (forall x : A, R x (f x)).
The goal is to define a relation R that characterizes the left inverse that you want to construct. The existentially quantified f will then be the inverse! You will need the classic axiom to show the precondition of choice, and you will need functional extensionality to show the equation that you want. I'll leave it as an exercise to find out what R needs to be and how to complete the proof.
Your script should start with the following line.
Require Import ClassicalChoice FunctionalEquality.
Because, as suggested by #arthur-azevedo-de-amorim, you will need these axioms.
Then, you should use choice with the relation "R y x" being
"f x = A or there is no element in A such whose image by f is y".
You will need the axiom classic to prove the existential statement that is required by choice:
assert (pointwise : forall y: B, exists x : A,
f x = y \/ (forall x : A f x <> y)).
choice will give you an existential statement for a function that returns the value you want. You only need to say that this function is the right one. You can give a name to that function by typing destruct (choice ... pointwise) (you have to fill in the ...).
You will have to prove an equality between two functions, but using the axiom functional_extensionality, you can reduce this problem to just proving that the two functions are equal on any x.
For that x, just instantiate the characteristic property of the function (as produced by destruct (choice ... pointwise) with the
value f x. There is a disjuction, but the right-hand side case is self-contradictory, because obviously f x is f x for some x.
For the left-hand side case, you will get an hypothesis of the form (I name the function produced by (choice ... pointwise) with the name it:
f (it (f x)) = f x
Here you can apply your injectivity assumption. to deduce that it (f x) = x.
This pretty much spells out the proof. In my own, experiment, I used classic, NNP, not_all_ex_not, functional_extensionality, which are lemmas coming from ClassicalChoice of FunctionalEquality.

Induction on a datatype with non-uniform type parameters produces ill-typed terms

I'm working towards formalising Free Selective Applicative Functors in Coq, but struggling with proofs by induction for inductive data types with non-uniform type parameters.
Let me give a bit of an introduction on the datatype I'm dealing with.
In Haskell, we encode Free Selective Functors as a GADT:
data Select f a where
Pure :: a -> Select f a
Select :: Select f (Either a b) -> f (a -> b) -> Select f b
The crucial thing here is the existential type variable b in the second data constructor.
We can translate this definition to Coq:
Inductive Select (F : Type -> Type) (A : Set) : Set :=
Pure : A -> Select F A
| MkSelect : forall (B : Set), Select F (B + A) -> F (B -> A) -> Select F A.
As a side note, I use the -impredicative-set option to encode it.
Coq generates the following induction principle for this datatype:
Select_ind :
forall (F : Type -> Type) (P : forall A : Set, Select F A -> Prop),
(forall (A : Set) (a : A), P A (Pure a)) ->
(forall (A B : Set) (s : Select F (B + A)), P (B + A)%type s ->
forall f0 : F (B -> A), P A (MkSelect s f0)) ->
forall (A : Set) (s : Select F A), P A s
Here, the interesting bit is the predicate P : forall A : Set, Select F A -> Prop which is parametrised not only in the expression, but also in the expressions type parameter. As I understand, the induction principle has this particular form because of the first argument of the MkSelect constructor of type Select F (B + A).
Now, I would like to prove statements like the third Applicative law for the defined datatype:
Theorem Select_Applicative_law3
`{FunctorLaws F} :
forall (A B : Set) (u : Select F (A -> B)) (y : A),
u <*> pure y = pure (fun f => f y) <*> u.
Which involve values of type Select F (A -> B), i.e. expressions containing functions. However,
calling induction on variables of such types produces ill-typed terms. Consider an oversimplified example of an equality that can be trivially proved by reflexivity, but can't be proved using induction:
Lemma Select_induction_fail `{Functor F} :
forall (A B : Set) (a : A) (x : Select F (A -> B)),
Select_map (fun f => f a) x = Select_map (fun f => f a) x.
Proof.
induction x.
Coq complains with the error:
Error: Abstracting over the terms "P" and "x" leads to a term
fun (P0 : Set) (x0 : Select F P0) =>
Select_map (fun f : P0 => f a) x0 = Select_map (fun f : P0 => f a) x0
which is ill-typed.
Reason is: Illegal application (Non-functional construction):
The expression "f" of type "P0" cannot be applied to the term
"a" : "A"
Here, Coq can't construct the predicate abstracted over the type variable because the reversed function application from the statement becomes ill-typed.
My question is, how do I use induction on my datatype? I can't see a way how to modify the induction principle in such a way so the predicate would not abstract the type. I tried to use dependent induction, but it has been producing inductive hypothesis constrained by equalities similar to (A -> B -> C) = (X + (A -> B -> C)) which I think would not be possible to instantiate.
Please see the complete example on GitHub: https://github.com/tuura/selective-theory-coq/blob/impredicative-set/src/Control/Selective/RigidImpredSetMinimal.v
UPDATE:
Following the discussio in the gist I have tried to carry out proofs by induction on depth of expression. Unfortunately, this path was not very fruitful since the induction hypothesis I get in theorems similar to Select_Applicative_law3 appear to be unusable. I will leave this problem for now and will give it a try later.
Li-yao, many thanks again for helping me to improve my understanding!
Proofs by induction are motivated by recursive definitions. So to know what to apply induction to, look for Fixpoints.
Your Fixpoints most likely work on terms indexed by single type variables Select F A, that's exactly where you want to use induction, not at the toplevel of the goal.
A Fixpoint on terms indexed by function types A -> B is useless since no subterms of any Select term are indexed by function types. For the same reason, induction is useless on such terms.
Here I think the strong type discipline actually forces you to work everything out on paper before trying to do anything in Coq (which is a good thing in my opinion). Try to do the proof on paper, without even worrying about types; explicitly write down the predicate(s) you want to prove by induction. Here's a template to see what I mean:
By induction on u, we will show
u <*> pure x = pure (fun f => f x) <*> u
(* Dummy induction predicate for the sake of example. *)
(* Find the right one. *)
(* It may use quantifiers... *)
Base case (set u = Pure f). Prove:
Pure f <*> pure x = pure (fun f => f x) <*> Pure f
Induction step (set u = MkSelect v h). Prove:
MkSelect v h <*> pure x = pure (fun f => f x) <*> MkSelect v h
assuming the induction hypothesis for the subterm v (set u = v):
v <*> pure x = pure (fun f => f x) <*> v
Notice in particular that the last equation is ill-typed, but you can still run along with it to do equational reasoning. Regardless, it will likely turn out that there is no way to apply that hypothesis after simplifying the goal.
If you really need to use Coq to do some exploration, there is a trick, consisting in erasing the problematic type parameter (and all terms that depend on it). Depending on your familiarity with Coq, this tip may turn out to be more confusing than anything. So be careful.
The terms will still have the same recursive structure. Keep in mind that the proof should also follow the same structure, because the point is to add more types on top afterwards, so you should avoid shortcuts that rely on the lack of types if you can.
(* Replace all A and B by unit. *)
Inductive Select_ (F : unit -> Type) : Set :=
| Pure_ : unit -> Select_ F
| MkSelect_ : Select_ F -> F tt -> Select_ F
.
Arguments Pure_ {F}.
Arguments MkSelect_ {F}.
(* Example translating Select_map. The Functor f constraint gets replaced with a dummy function argument. *)
(* forall A B, (A -> B) -> (F A -> F B) *)
Fixpoint Select_map_ {F : unit -> Type} (fmap : forall t, unit -> (F t -> F t)) (f : unit -> unit) (v : Select_ F) : Select_ F :=
match v with
| Pure_ a => Pure_ (f a)
| MkSelect_ w h => MkSelect_ (Select_map_ fmap f w) (fmap _ tt h)
end.
With that, you can try to prove this trimmed down version of the functor laws for example:
Select_map_ fmap f (Select_map_ fmap g v) = Select_map_ fmap (fun x => f (g x)) v
(* Original theorem:
Select_map f (Select_map g v) = Select_map (fun x => f (g x)) v
*)
The point is that removing the parameter avoids the associated typing problems, so you can try to use induction naively to see how things (don't) work out.

How to implement remove with a membership proof as an argument in Coq?

data _∈_ {X : Set} (x : X) : (xs : List X) → Set where
here! : {xs : List X} → x ∈ x ∷ xs
there : {xs : List X} {y : X} (pr : x ∈ xs) → x ∈ y ∷ xs
remove : {X : Set} {x : X} (xs : List X) (pr : x ∈ xs) → List X
remove (_ ∷ xs) here! = xs
remove (y ∷ xs) (there pr) = y ∷ remove xs pr
I am trying to translate the above definition from Agda to Coq and am running into difficulties.
Inductive Any {A : Type} (P : A -> Type) : list A -> Prop :=
| here : forall {x : A} {xs : list A}, P x -> Any P (x :: xs)
| there : forall {x : A} {xs : list A}, Any P xs -> Any P (x :: xs).
Definition In' {A : Type} (x : A) xs := Any (fun x' => x = x') xs.
Fixpoint remove {A : Type} {x : A} {l : list A} (pr : In' x l) : list A :=
match l, pr with
| [], _ => []
| _ :: ls, here _ _ => ls
| x :: ls, there _ pr => x :: remove pr
end.
Incorrect elimination of "pr0" in the inductive type "#Any":
the return type has sort "Type" while it should be "Prop".
Elimination of an inductive object of sort Prop
is not allowed on a predicate in sort Type
because proofs can be eliminated only to build proofs.
In addition to this error, if I leave the [] case out Coq is asks me to provide it despite it being absurd.
Up to this point, I've thought that Agda and Coq were the same languages with a different front end, but now I am starting to think they are different under the hood. Is there a way to replicate the remove function in Coq and if not, what alternative would you recommend?
Edit: I also want to keep the proof between In and In'. Originally I made In' a Type rather than a Prop, but that made the following proof fail with a type error.
Fixpoint In {A : Type} (x : A) (l : list A) : Prop :=
match l with
| [] ⇒ False
| x' :: l' ⇒ x' = x ∨ In x l'
end.
Theorem In_iff_In' :
forall {A : Type} (x : A) (l : list A),
In x l <-> In' x l.
Proof.
intros.
split.
- intros.
induction l.
+ inversion H.
+ simpl in H.
destruct H; subst.
* apply here. reflexivity.
* apply there. apply IHl. assumption.
- intros.
induction H.
+ left. subst. reflexivity.
+ right. assumption.
Qed.
In environment
A : Type
x : A
l : list A
The term "In' x l" has type "Type" while it is expected to have type
"Prop" (universe inconsistency).
The In here is from the Logic chapter of SF. I have a solution of the pigeonhole principle in Agda, so I want this bijection in order to convert to the form that the exercise asks.
Edit2:
Theorem remove_lemma :
forall {A} {x} {y} {l : list A} (pr : In' x l) (pr' : In' y l),
x = y \/ In' y (remove pr).
I also outright run into universe inconsistency in this definition even when using Type when defining In'.
You need to use an informative proof of membership. Right now, your Any takes values in Prop, which, due to its limitations on elimination (see the error message you got), is consistent with the axiom forall (P: Prop) (x y: P), x = y. This means that if you have some term that depends on a term whose type is in Prop (as is the case with remove), it has to only use the fact that such a term exists, not what term it is specifically. Generally, you can't use elimination (usually pattern matching) on a Prop to produce anything other than something that's also a Prop.
There are three essentially different proofs of In' 1 [1; 2; 1; 3; 1; 4], and, depending which proof is used, remove p might be [2; 1; 4; 1; 4], [1; 2; 3; 1; 4] or [1; 2; 1; 3; 4]. So the output depends on the specific proof in an essential way.
To fix this, you can simply replace the Prop in Inductive Any {A : Type} (P : A -> Type) : list A -> Prop with Type.1 Now we can eliminate into non-Prop types and your definition of remove works as written.
To answer your edits, I think the biggest issue is that some of your theorems/definitions need In' to be a Prop (because they depend on uninformative proofs) and others need the informative proof.
I think your best bet is to keep In' as a Type, but then prove uninformative versions of the theorems. In the standard libary, in Coq.Init.Logic, there is an inductive type inhabited.
Inductive inhabited (A: Type): Prop :=
| inhabits: A -> inhabited A.
This takes a type and essentially forgets anything specific about its terms, only remembering if it's inhabited or not. I think your theorem and lemma are provable if you simply replace In' x l with inhabited (In' x l). I was able to prove a variant of your theorem whose conclusion is simply In x l <-> inhabited (In' x l). Your proof mostly worked, but I had to use the following simple lemma in one step:
Lemma inhabited_there {A: Type} {P: A -> Type} {x: A} {xs: list A}:
inhabited (Any P xs) -> inhabited (Any P (x :: xs)).
Note: even though inhabited A is basically just a Prop version of A and we have A -> inhabited A, we can't prove inhabited A -> A in general because that would involve choosing an arbitrary element of A.2
I also suggested Set here before, but this doesn't work since the inductive type depends on A, which is in Type.
In fact, I believe that the proof assistant Lean uses something very similar to this for its axiom of choice.

How to write an Ltac to multiply both sides of a equation by a group element in Coq

Using this definition of a group:
Structure group :=
{
G :> Set;
id : G;
op : G -> G -> G;
inv : G -> G;
op_assoc_def : forall (x y z : G), op x (op y z) = op (op x y) z;
op_inv_l : forall (x : G), id = op (inv x) x;
op_id_l : forall (x : G), x = op id x
}.
(** Set implicit arguments *)
Arguments id {g}.
Arguments op {g} _ _.
Arguments inv {g} _.
Notation "x # y" := (op x y) (at level 50, left associativity).
And having proven this theorem:
Theorem mult_both_sides (G : group) : forall (a b c : G),
a = b <-> c # a = c # b.
How do I write an Ltac that automates the process of left multiplying a given equality (either the goal itself or a hypothesis) by a given term?
Ideally, using this Ltac in a proof would look like this:
left_mult (arbitrary expression).
left_mult (arbitrary expression) in (hypothesis).
Building on the answer given by larsr, you can use Tactic Notations to write
Tactic Notation "left_mult" uconstr(arbitrary_expression) :=
apply (mult_both_sides _ _ _ arbitrary_expression).
Tactic Notation "left_mult" uconstr(arbitrary_expression) "in" hyp(hypothesis) :=
apply (mult_both_sides _ _ _ arbitrary_expression) in hypothesis.
Using uconstr says "delay typechecking of this term until we plug it into apply". (Other options include constr ("typecheck this at the call site") and open_constr ("typecheck this at the call site and fill in holes with evars").)
Do you really need a specific tactic for this? If you just use apply to this
Goal forall (G:group) (a b c: G), a = b.
intros.
apply (mult_both_sides _ _ _ c).
Now your goal is
G0 : group
a, b, c : G0
============================
c # a = c # b
If you want to modify a hypothesis H, then just do apply ... in H.

How to prove functions equal, knowing their bodies are equal?

How can we prove the following?:
Lemma forfun: forall (A B : nat->nat), (forall x:nat, A x = B x) ->
(fun x => A x) = (fun x => B x).
Proof.
The principle you want is known as functional extensionality; in its most general form, it says
Axiom fun_ext : forall (A B : Type) (f g : A -> B),
(forall x : A, f x = g x) -> f = g.
Unfortunately, in spite of being useful, this principle is independent of Coq's base logic, which means that it is not possible to prove it or refute it. However, Coq's logic was designed so that it would be safe to assume this principle as an axiom in the theory, and Coq's standard library already has that principle defined so that you can use it.