mirror of
https://github.com/Smaug123/agdaproofs
synced 2025-10-11 22:58:40 +00:00
292 lines
17 KiB
Agda
292 lines
17 KiB
Agda
{-# OPTIONS --safe --warning=error #-}
|
||
|
||
open import Groups
|
||
open import Orders
|
||
open import Integers
|
||
open import Setoids
|
||
open import LogicalFormulae
|
||
open import FinSet
|
||
open import Functions
|
||
open import Naturals
|
||
open import IntegersModN
|
||
open import RingExamples
|
||
open import PrimeNumbers
|
||
open import Groups2
|
||
|
||
module GroupsExamples where
|
||
integersMinusNotGroup : Group (reflSetoid ℤ) (_-Z_) → False
|
||
integersMinusNotGroup record { wellDefined = wellDefined ; identity = identity ; inverse = inverse ; multAssoc = multAssoc ; multIdentRight = multIdentRight ; multIdentLeft = multIdentLeft ; invLeft = invLeft ; invRight = invRight } with multAssoc {nonneg 3} {nonneg 2} {nonneg 1}
|
||
integersMinusNotGroup record { wellDefined = wellDefined ; identity = identity ; inverse = inverse ; multAssoc = multAssoc ; multIdentRight = multIdentRight ; multIdentLeft = multIdentLeft ; invLeft = invLeft ; invRight = invRight } | ()
|
||
|
||
integersTimesNotGroup : Group (reflSetoid ℤ) (_*Z_) → False
|
||
integersTimesNotGroup record { wellDefined = wellDefined ; identity = (nonneg zero) ; inverse = inverse ; multAssoc = multAssoc ; multIdentRight = multIdentRight ; multIdentLeft = multIdentLeft ; invLeft = invLeft ; invRight = invRight } with multIdentLeft {negSucc 1}
|
||
... | ()
|
||
integersTimesNotGroup record { wellDefined = wellDefined ; identity = (nonneg (succ zero)) ; inverse = inverse ; multAssoc = multAssoc ; multIdentRight = multIdentRight ; multIdentLeft = multIdentLeft ; invLeft = invLeft ; invRight = invRight } with invLeft {nonneg zero}
|
||
... | bl with inverse (nonneg zero)
|
||
integersTimesNotGroup record { wellDefined = wellDefined ; identity = (nonneg (succ zero)) ; inverse = inverse ; multAssoc = multAssoc ; multIdentRight = multIdentRight ; multIdentLeft = multIdentLeft ; invLeft = invLeft ; invRight = invRight } | () | nonneg zero
|
||
integersTimesNotGroup record { wellDefined = wellDefined ; identity = (nonneg (succ zero)) ; inverse = inverse ; multAssoc = multAssoc ; multIdentRight = multIdentRight ; multIdentLeft = multIdentLeft ; invLeft = invLeft ; invRight = invRight } | () | nonneg (succ x)
|
||
integersTimesNotGroup record { wellDefined = wellDefined ; identity = (nonneg (succ zero)) ; inverse = inverse ; multAssoc = multAssoc ; multIdentRight = multIdentRight ; multIdentLeft = multIdentLeft ; invLeft = invLeft ; invRight = invRight } | () | negSucc x
|
||
integersTimesNotGroup record { wellDefined = wellDefined ; identity = (nonneg (succ (succ x))) ; inverse = inverse ; multAssoc = multAssoc ; multIdentRight = multIdentRight ; multIdentLeft = multIdentLeft ; invLeft = invLeft ; invRight = invRight } with succInjective (negSuccInjective (multIdentLeft {negSucc 1}))
|
||
... | ()
|
||
integersTimesNotGroup record { wellDefined = wellDefined ; identity = (negSucc x) ; inverse = inverse ; multAssoc = multAssoc ; multIdentRight = multIdentRight ; multIdentLeft = multIdentLeft ; invLeft = invLeft ; invRight = invRight } with multIdentLeft {nonneg 2}
|
||
integersTimesNotGroup record { wellDefined = wellDefined ; identity = (negSucc x) ; inverse = inverse ; multAssoc = multAssoc ; multIdentRight = multIdentRight ; multIdentLeft = multIdentLeft ; invLeft = invLeft ; invRight = invRight } | ()
|
||
|
||
-- Groups example 8.9 from lecture 1
|
||
data Weird : Set where
|
||
e : Weird
|
||
a : Weird
|
||
b : Weird
|
||
c : Weird
|
||
|
||
_+W_ : Weird → Weird → Weird
|
||
e +W t = t
|
||
a +W e = a
|
||
a +W a = e
|
||
a +W b = c
|
||
a +W c = b
|
||
b +W e = b
|
||
b +W a = c
|
||
b +W b = e
|
||
b +W c = a
|
||
c +W e = c
|
||
c +W a = b
|
||
c +W b = a
|
||
c +W c = e
|
||
|
||
+WAssoc : {x y z : Weird} → (x +W (y +W z)) ≡ (x +W y) +W z
|
||
+WAssoc {e} {y} {z} = refl
|
||
+WAssoc {a} {e} {z} = refl
|
||
+WAssoc {a} {a} {e} = refl
|
||
+WAssoc {a} {a} {a} = refl
|
||
+WAssoc {a} {a} {b} = refl
|
||
+WAssoc {a} {a} {c} = refl
|
||
+WAssoc {a} {b} {e} = refl
|
||
+WAssoc {a} {b} {a} = refl
|
||
+WAssoc {a} {b} {b} = refl
|
||
+WAssoc {a} {b} {c} = refl
|
||
+WAssoc {a} {c} {e} = refl
|
||
+WAssoc {a} {c} {a} = refl
|
||
+WAssoc {a} {c} {b} = refl
|
||
+WAssoc {a} {c} {c} = refl
|
||
+WAssoc {b} {e} {z} = refl
|
||
+WAssoc {b} {a} {e} = refl
|
||
+WAssoc {b} {a} {a} = refl
|
||
+WAssoc {b} {a} {b} = refl
|
||
+WAssoc {b} {a} {c} = refl
|
||
+WAssoc {b} {b} {e} = refl
|
||
+WAssoc {b} {b} {a} = refl
|
||
+WAssoc {b} {b} {b} = refl
|
||
+WAssoc {b} {b} {c} = refl
|
||
+WAssoc {b} {c} {e} = refl
|
||
+WAssoc {b} {c} {a} = refl
|
||
+WAssoc {b} {c} {b} = refl
|
||
+WAssoc {b} {c} {c} = refl
|
||
+WAssoc {c} {e} {z} = refl
|
||
+WAssoc {c} {a} {e} = refl
|
||
+WAssoc {c} {a} {a} = refl
|
||
+WAssoc {c} {a} {b} = refl
|
||
+WAssoc {c} {a} {c} = refl
|
||
+WAssoc {c} {b} {e} = refl
|
||
+WAssoc {c} {b} {a} = refl
|
||
+WAssoc {c} {b} {b} = refl
|
||
+WAssoc {c} {b} {c} = refl
|
||
+WAssoc {c} {c} {e} = refl
|
||
+WAssoc {c} {c} {a} = refl
|
||
+WAssoc {c} {c} {b} = refl
|
||
+WAssoc {c} {c} {c} = refl
|
||
|
||
weirdGroup : Group (reflSetoid Weird) _+W_
|
||
Group.wellDefined weirdGroup = reflGroupWellDefined
|
||
Group.identity weirdGroup = e
|
||
Group.inverse weirdGroup t = t
|
||
Group.multAssoc weirdGroup {r} {s} {t} = +WAssoc {r} {s} {t}
|
||
Group.multIdentRight weirdGroup {e} = refl
|
||
Group.multIdentRight weirdGroup {a} = refl
|
||
Group.multIdentRight weirdGroup {b} = refl
|
||
Group.multIdentRight weirdGroup {c} = refl
|
||
Group.multIdentLeft weirdGroup {e} = refl
|
||
Group.multIdentLeft weirdGroup {a} = refl
|
||
Group.multIdentLeft weirdGroup {b} = refl
|
||
Group.multIdentLeft weirdGroup {c} = refl
|
||
Group.invLeft weirdGroup {e} = refl
|
||
Group.invLeft weirdGroup {a} = refl
|
||
Group.invLeft weirdGroup {b} = refl
|
||
Group.invLeft weirdGroup {c} = refl
|
||
Group.invRight weirdGroup {e} = refl
|
||
Group.invRight weirdGroup {a} = refl
|
||
Group.invRight weirdGroup {b} = refl
|
||
Group.invRight weirdGroup {c} = refl
|
||
|
||
weirdAb : AbelianGroup weirdGroup
|
||
AbelianGroup.commutative weirdAb {e} {e} = refl
|
||
AbelianGroup.commutative weirdAb {e} {a} = refl
|
||
AbelianGroup.commutative weirdAb {e} {b} = refl
|
||
AbelianGroup.commutative weirdAb {e} {c} = refl
|
||
AbelianGroup.commutative weirdAb {a} {e} = refl
|
||
AbelianGroup.commutative weirdAb {a} {a} = refl
|
||
AbelianGroup.commutative weirdAb {a} {b} = refl
|
||
AbelianGroup.commutative weirdAb {a} {c} = refl
|
||
AbelianGroup.commutative weirdAb {b} {e} = refl
|
||
AbelianGroup.commutative weirdAb {b} {a} = refl
|
||
AbelianGroup.commutative weirdAb {b} {b} = refl
|
||
AbelianGroup.commutative weirdAb {b} {c} = refl
|
||
AbelianGroup.commutative weirdAb {c} {e} = refl
|
||
AbelianGroup.commutative weirdAb {c} {a} = refl
|
||
AbelianGroup.commutative weirdAb {c} {b} = refl
|
||
AbelianGroup.commutative weirdAb {c} {c} = refl
|
||
|
||
weirdProjection : Weird → FinSet 4
|
||
weirdProjection a = ofNat 0 (le 3 refl)
|
||
weirdProjection b = ofNat 1 (le 2 refl)
|
||
weirdProjection c = ofNat 2 (le 1 refl)
|
||
weirdProjection e = ofNat 3 (le zero refl)
|
||
|
||
weirdProjectionSurj : Surjection weirdProjection
|
||
Surjection.property weirdProjectionSurj fzero = a , refl
|
||
Surjection.property weirdProjectionSurj (fsucc fzero) = b , refl
|
||
Surjection.property weirdProjectionSurj (fsucc (fsucc fzero)) = c , refl
|
||
Surjection.property weirdProjectionSurj (fsucc (fsucc (fsucc fzero))) = e , refl
|
||
Surjection.property weirdProjectionSurj (fsucc (fsucc (fsucc (fsucc ()))))
|
||
|
||
weirdProjectionInj : (x y : Weird) → weirdProjection x ≡ weirdProjection y → Setoid._∼_ (reflSetoid Weird) x y
|
||
weirdProjectionInj e e fx=fy = refl
|
||
weirdProjectionInj e a ()
|
||
weirdProjectionInj e b ()
|
||
weirdProjectionInj e c ()
|
||
weirdProjectionInj a e ()
|
||
weirdProjectionInj a a fx=fy = refl
|
||
weirdProjectionInj a b ()
|
||
weirdProjectionInj a c ()
|
||
weirdProjectionInj b e ()
|
||
weirdProjectionInj b a ()
|
||
weirdProjectionInj b b fx=fy = refl
|
||
weirdProjectionInj b c ()
|
||
weirdProjectionInj c e ()
|
||
weirdProjectionInj c a ()
|
||
weirdProjectionInj c b ()
|
||
weirdProjectionInj c c fx=fy = refl
|
||
|
||
weirdFinite : FiniteGroup weirdGroup (FinSet 4)
|
||
SetoidToSet.project (FiniteGroup.toSet weirdFinite) = weirdProjection
|
||
SetoidToSet.wellDefined (FiniteGroup.toSet weirdFinite) x y = applyEquality weirdProjection
|
||
SetoidToSet.surj (FiniteGroup.toSet weirdFinite) = weirdProjectionSurj
|
||
SetoidToSet.inj (FiniteGroup.toSet weirdFinite) = weirdProjectionInj
|
||
FiniteSet.size (FiniteGroup.finite weirdFinite) = 4
|
||
FiniteSet.mapping (FiniteGroup.finite weirdFinite) = id
|
||
FiniteSet.bij (FiniteGroup.finite weirdFinite) = idIsBijective
|
||
|
||
weirdOrder : groupOrder weirdFinite ≡ 4
|
||
weirdOrder = refl
|
||
|
||
elementPowZ : (n : ℕ) → (elementPower ℤGroup (nonneg 1) n) ≡ nonneg n
|
||
elementPowZ zero = refl
|
||
elementPowZ (succ n) rewrite elementPowZ n = refl
|
||
|
||
ℤCyclic : CyclicGroup ℤGroup
|
||
CyclicGroup.generator ℤCyclic = nonneg 1
|
||
CyclicGroup.cyclic ℤCyclic {nonneg x} = inl (x , elementPowZ x)
|
||
CyclicGroup.cyclic ℤCyclic {negSucc x} = inr (succ x , ans)
|
||
where
|
||
ans : additiveInverseZ (nonneg 1 +Z elementPower ℤGroup (nonneg 1) x) ≡ negSucc x
|
||
ans rewrite elementPowZ x = refl
|
||
|
||
elementPowZn : (n : ℕ) → {pr : 0 <N succ (succ n)} → (power : ℕ) → (powerLess : power <N succ (succ n)) → {p : 1 <N succ (succ n)} → elementPower (ℤnGroup (succ (succ n)) pr) (record { x = 1 ; xLess = p }) power ≡ record { x = power ; xLess = powerLess }
|
||
elementPowZn n zero powerLess = equalityZn _ _ refl
|
||
elementPowZn n {pr} (succ power) powerLess {p} with orderIsTotal (ℤn.x (elementPower (ℤnGroup (succ (succ n)) pr) (record { x = 1 ; xLess = p }) power)) (succ n)
|
||
elementPowZn n {pr} (succ power) powerLess {p} | inl (inl x) = equalityZn _ _ (applyEquality succ v)
|
||
where
|
||
t : elementPower (ℤnGroup (succ (succ n)) pr) (record { x = 1 ; xLess = succPreservesInequality (succIsPositive n) }) power ≡ record { x = power ; xLess = PartialOrder.transitive (TotalOrder.order ℕTotalOrder) (a<SuccA power) powerLess }
|
||
t = elementPowZn n {pr} power (PartialOrder.transitive (TotalOrder.order ℕTotalOrder) (a<SuccA power) powerLess) {succPreservesInequality (succIsPositive n)}
|
||
u : elementPower (ℤnGroup (succ (succ n)) pr) (record { x = 1 ; xLess = p }) power ≡ record { x = power ; xLess = PartialOrder.transitive (TotalOrder.order ℕTotalOrder) (a<SuccA power) powerLess }
|
||
u rewrite <NRefl p (succPreservesInequality (succIsPositive n)) = t
|
||
v : ℤn.x (elementPower (ℤnGroup (succ (succ n)) pr) (record { x = 1 ; xLess = p }) power) ≡ power
|
||
v rewrite u = refl
|
||
elementPowZn n {pr} (succ power) powerLess {p} | inl (inr x) with elementPower (ℤnGroup (succ (succ n)) pr) (record { x = 1 ; xLess = p }) power
|
||
elementPowZn n {pr} (succ power) powerLess {p} | inl (inr x) | record { x = x' ; xLess = xLess } = exFalso (noIntegersBetweenXAndSuccX _ x xLess)
|
||
elementPowZn n {pr} (succ power) powerLess {p} | inr x with inspect (elementPower (ℤnGroup (succ (succ n)) pr) (record { x = 1 ; xLess = p }) power)
|
||
elementPowZn n {pr} (succ power) powerLess {p} | inr x | record { x = x' ; xLess = p' } with≡ inspected rewrite elementPowZn n {pr} power (PartialOrder.transitive (TotalOrder.order ℕTotalOrder) (a<SuccA power) powerLess) {p} | x = exFalso (PartialOrder.irreflexive (TotalOrder.order ℕTotalOrder) powerLess)
|
||
|
||
ℤnCyclic : (n : ℕ) → (pr : 0 <N n) → CyclicGroup (ℤnGroup n pr)
|
||
ℤnCyclic zero ()
|
||
CyclicGroup.generator (ℤnCyclic (succ zero) pr) = record { x = 0 ; xLess = pr }
|
||
CyclicGroup.cyclic (ℤnCyclic (succ zero) pr) {record { x = zero ; xLess = xLess }} rewrite <NRefl xLess (succIsPositive 0) | <NRefl pr (succIsPositive 0) = inl (0 , refl)
|
||
CyclicGroup.cyclic (ℤnCyclic (succ zero) _) {record { x = succ x ; xLess = xLess }} = exFalso (zeroNeverGreater (canRemoveSuccFrom<N xLess))
|
||
ℤnCyclic (succ (succ n)) pr = record { generator = record { x = 1 ; xLess = succPreservesInequality (succIsPositive n) } ; cyclic = λ {x} → inl (ans x) }
|
||
where
|
||
ans : (z : ℤn (succ (succ n)) pr) → Sg ℕ (λ i → (elementPower (ℤnGroup (succ (succ n)) pr) (record { x = 1 ; xLess = succPreservesInequality (succIsPositive n) }) i) ≡ z)
|
||
ans record { x = x ; xLess = xLess } = x , elementPowZn n x xLess
|
||
|
||
multiplyByNHom : (n : ℕ) → GroupHom ℤGroup ℤGroup (λ i → i *Z nonneg n)
|
||
GroupHom.groupHom (multiplyByNHom n) {x} {y} = lemma1
|
||
where
|
||
open Setoid (reflSetoid ℤ)
|
||
open Group ℤGroup
|
||
lemma : nonneg n *Z (x +Z y) ≡ (nonneg n) *Z x +Z nonneg n *Z y
|
||
lemma = additionZDistributiveMulZ (nonneg n) x y
|
||
lemma1 : (x +Z y) *Z nonneg n ≡ x *Z nonneg n +Z y *Z nonneg n
|
||
lemma1 rewrite multiplicationZIsCommutative (x +Z y) (nonneg n) | multiplicationZIsCommutative x (nonneg n) | multiplicationZIsCommutative y (nonneg n) = lemma
|
||
GroupHom.wellDefined (multiplyByNHom n) {x} {.x} refl = refl
|
||
|
||
modNExampleGroupHom : (n : ℕ) → (pr : 0 <N n) → GroupHom ℤGroup (ℤnGroup n pr) (mod n pr)
|
||
modNExampleGroupHom = {!!}
|
||
|
||
intoZn : {n : ℕ} → {pr : 0 <N n} → (x : ℕ) → (x<n : x <N n) → mod n pr (nonneg x) ≡ record { x = x ; xLess = x<n }
|
||
intoZn {zero} {()}
|
||
intoZn {succ n} {0<n} x x<n with divisionAlg (succ n) x
|
||
intoZn {succ n} {0<n} x x<n | record { quot = quot ; rem = rem ; pr = pr ; remIsSmall = inl y ; quotSmall = quotSmall } = equalityZn _ _ (modIsUnique (record { quot = quot ; rem = rem ; pr = pr ; remIsSmall = inl y ; quotSmall = quotSmall }) (record { quot = 0 ; rem = x ; pr = ans ; remIsSmall = inl x<n ; quotSmall = inl (succIsPositive n)}))
|
||
where
|
||
ans : n *N 0 +N x ≡ x
|
||
ans rewrite multiplicationNIsCommutative n 0 = refl
|
||
intoZn {succ n} {0<n} x x<n | record { quot = quot ; rem = rem ; pr = pr ; remIsSmall = inr () ; quotSmall = quotSmall }
|
||
|
||
quotientZn : (n : ℕ) → (pr : 0 <N n) → GroupIso (quotientGroup ℤGroup (modNExampleGroupHom n pr)) (ℤnGroup n pr) (mod n pr)
|
||
GroupHom.groupHom (GroupIso.groupHom (quotientZn n pr)) = GroupHom.groupHom (modNExampleGroupHom n pr)
|
||
GroupHom.wellDefined (GroupIso.groupHom (quotientZn n pr)) {x} {y} x~y = need
|
||
where
|
||
given : mod n pr (x +Z (Group.inverse ℤGroup y)) ≡ record { x = 0 ; xLess = pr }
|
||
given = x~y
|
||
given' : (mod n pr x) +n (mod n pr (Group.inverse ℤGroup y)) ≡ record { x = 0 ; xLess = pr }
|
||
given' = transitivity (equalityCommutative (GroupHom.groupHom (modNExampleGroupHom n pr))) given
|
||
given'' : (mod n pr x) +n Group.inverse (ℤnGroup n pr) (mod n pr y) ≡ record { x = 0 ; xLess = pr}
|
||
given'' = transitivity (applyEquality (λ i → mod n pr x +n i) (equalityCommutative (homRespectsInverse (modNExampleGroupHom n pr)))) given'
|
||
need : mod n pr x ≡ mod n pr y
|
||
need = transferToRight (ℤnGroup n pr) given''
|
||
GroupIso.inj (quotientZn n pr) {x} {y} fx~fy = need
|
||
where
|
||
given : mod n pr x +n Group.inverse (ℤnGroup n pr) (mod n pr y) ≡ record { x = 0 ; xLess = pr }
|
||
given = transferToRight'' (ℤnGroup n pr) fx~fy
|
||
given' : mod n pr (x +Z (Group.inverse ℤGroup y)) ≡ record { x = 0 ; xLess = pr }
|
||
given' = identityOfIndiscernablesLeft _ _ _ _≡_ given (equalityCommutative (transitivity (GroupHom.groupHom (modNExampleGroupHom n pr) {x}) (applyEquality (λ i → mod n pr x +n i) (homRespectsInverse (modNExampleGroupHom n pr)))))
|
||
need' : (mod n pr x) +n (mod n pr (Group.inverse ℤGroup y)) ≡ record { x = 0 ; xLess = pr }
|
||
need' rewrite equalityCommutative (GroupHom.groupHom (modNExampleGroupHom n pr) {x} {Group.inverse ℤGroup y}) = given'
|
||
need : mod n pr (x +Z (Group.inverse ℤGroup y)) ≡ record { x = 0 ; xLess = pr}
|
||
need = identityOfIndiscernablesLeft _ _ _ _≡_ need' (equalityCommutative (GroupHom.groupHom (modNExampleGroupHom n pr)))
|
||
GroupIso.surj (quotientZn n pr) {record { x = x ; xLess = xLess }} = nonneg x , intoZn x xLess
|
||
|
||
trivialGroupHom : {a b : _} {A : Set a} {S : Setoid {a} {b} A} {_+_ : A → A → A} (G : Group S _+_) → GroupHom trivialGroup G (λ _ → Group.identity G)
|
||
GroupHom.groupHom (trivialGroupHom {S = S} G) = symmetric multIdentRight
|
||
where
|
||
open Setoid S
|
||
open Group G
|
||
open Symmetric (Equivalence.symmetricEq eq)
|
||
GroupHom.wellDefined (trivialGroupHom {S = S} G) _ = Reflexive.reflexive (Equivalence.reflexiveEq (Setoid.eq S))
|
||
|
||
trivialSubgroupIsNormal : {a b : _} {A : Set a} {S : Setoid {a} {b} A} {_+A_ : A → A → A} (G : Group S _+A_) → NormalSubgroup G trivialGroup (trivialGroupHom G)
|
||
Subgroup.fInj (NormalSubgroup.subgroup (trivialSubgroupIsNormal G)) {fzero} {fzero} _ = refl
|
||
Subgroup.fInj (NormalSubgroup.subgroup (trivialSubgroupIsNormal G)) {fzero} {fsucc ()} _
|
||
Subgroup.fInj (NormalSubgroup.subgroup (trivialSubgroupIsNormal G)) {fsucc ()} {y} _
|
||
NormalSubgroup.normal (trivialSubgroupIsNormal {S = S} {_+A_ = _+A_} G) = fzero , transitive (wellDefined (multIdentRight) reflexive) invRight
|
||
where
|
||
open Setoid S
|
||
open Group G
|
||
open Transitive (Equivalence.transitiveEq eq)
|
||
open Reflexive (Equivalence.reflexiveEq eq)
|
||
|
||
improperSubgroupIsNormal : {a b : _} {A : Set a} {S : Setoid {a} {b} A} {_+A_ : A → A → A} (G : Group S _+A_) → NormalSubgroup G G (identityHom G)
|
||
Subgroup.fInj (NormalSubgroup.subgroup (improperSubgroupIsNormal G)) = id
|
||
NormalSubgroup.normal (improperSubgroupIsNormal {S = S} {_+A_ = _+A_} G) {g} {h} = ((g +A h) +A inverse g) , reflexive
|
||
where
|
||
open Group G
|
||
open Setoid S
|
||
open Reflexive (Equivalence.reflexiveEq eq)
|