群論的形式化驗證

DennyQi發表於2024-06-29
Require Import Coq.Bool.Bool.
Require Import Setoid.
Require Import Coq.Classes.Equivalence.
Require Import List.
Require Import ListSet.
Import ListNotations.


(* Law of Excluded Middle *)
Axiom excluded_middle: forall P : Prop, (P \/ ~P).  

Record Group : Type := {
  G :> Set;
  op : G -> G -> G;     (* operation *)
  e : G;                (* identity *)
  inv: G -> G;          (* inverse *)

  assoc_law : forall (a b c : G), op a (op b c) = op (op a b) c;
  id_law : forall (a : G), op a e = a /\ op e a = a;
  inv_law : forall (a : G), op a (inv a) = e /\ op (inv a) a = e
}.

Arguments op {g} _ _.
Arguments e {g}.
Arguments inv {g} _.
Arguments assoc_law {g} _ _ _.
(* why do we need this *)

Notation "x <+> y" := (op x y) (at level 50, left associativity).

Definition is_identity (G : Group) (a : G) :=
  forall (g : G), g <+> a = a /\ a <+> g = a.

Theorem op_identity_is_self (G : Group): forall (a : G),
  a <+> e = a /\ e <+> a = a.
Proof.
  intros.
  split; apply id_law.
Qed.

Theorem identity_unique (G : Group): forall (a b: G), 
  ((is_identity G a) /\ (is_identity G b)) -> a = b.
Proof.
  intros.
  unfold is_identity in H.
  destruct H.
  assert (a=b \/ a<>b). {
    apply excluded_middle.
  }
  destruct H1.
  + tauto.
  + 
  assert (a <+> b = a). { apply H. }
  assert (a <+> b = b). { apply H0. }
  rewrite <- H2.
  apply H0.
Qed.

Definition has_inverse (G : Group) (a : G) :=
  exists (a' : G), a<+>a'=e /\ a'<+>a=e.

Definition is_inverse (G : Group) (a : G) (b : G):=
  a<+>b=e /\ b<+>a=e.

Theorem inverse_unique (G : Group): forall (a b g : G), 
  (is_inverse G a g /\ is_inverse G b g) -> a = b.
Proof.
  unfold is_inverse.
  intros.
  destruct H as [[? ?] [? ?]].
  assert (a=b \/ a<>b). {
    apply excluded_middle.
  }
  destruct H3.
  + tauto.
  + assert (b <+> (g <+> a)= a). {
    pose proof assoc_law b g a.
    rewrite H4.
    rewrite H1.
    apply id_law.
  }
  assert (b <+> e = a). {
    rewrite <- H0.
    tauto.
  }
  rewrite <- H5.
  apply id_law.
Qed.

Lemma operation_is_function (G : Group): forall (a b c : G),
  (a = b -> c<+>a = c<+>b) /\ (a = b -> a<+>c = b<+>c).
Proof.
  intros.
  split; intros; f_equal; tauto.
Qed.

Theorem left_cancel (G : Group): forall (a b c : G), 
  a<+>b=a<+>c <-> b = c. 
Proof.
  intros.
  split.
  + intros.
    assert ((inv a) <+> (a <+> b) = (inv a) <+> (a <+> c)). {
      apply operation_is_function.
      tauto.
    }
    assert ((inv a) <+> a <+> b = (inv a) <+> a <+> c). {
        pose proof assoc_law (inv a) a b.
        pose proof assoc_law (inv a) a c.
        rewrite <- H1.
        rewrite <- H2.
        apply H0.
    }
    assert (inv a <+> a = e). {
        apply inv_law.
    }
    assert (e<+>b = e<+>c). {
        rewrite <- H2.
        apply H1.
    }
    pose proof op_identity_is_self G b.
    pose proof op_identity_is_self G c.
    destruct H4.
    destruct H5.
    rewrite <- H6.
    rewrite <- H7.
    tauto.
  + apply operation_is_function.
Qed.

Theorem right_cancel (G : Group): forall (a b c : G), 
  b<+>a=c<+>a <-> b = c. 
Proof.
  intros.
  split.
  + intros.
    assert ((b <+> a) <+> (inv a) = (c <+> a) <+> (inv a)). {
      apply operation_is_function.
      tauto.
    }
    assert (b <+> (a <+> (inv a)) = (c <+> (a <+> (inv a)))). {
        pose proof assoc_law b a (inv a).
        pose proof assoc_law c a (inv a).
        rewrite H1.
        rewrite H2.
        apply H0.
    }
    assert (a <+> inv a = e). {
        apply inv_law.
    }
    assert (b<+>e = c<+>e). {
        rewrite <- H2.
        apply H1.
    }
    pose proof op_identity_is_self G b.
    pose proof op_identity_is_self G c.
    destruct H4.
    destruct H5.
    rewrite <- H4.
    rewrite <- H5.
    tauto.
  + apply operation_is_function.
Qed.


相關文章