Mercurial > hg > Members > kono > Proof > galois
changeset 8:4e275f918e63
deriving-inv done
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 17 Aug 2020 12:56:53 +0900 |
parents | ec1cb153af22 |
children | 6bbd861e9ae8 |
files | Solvable.agda |
diffstat | 1 files changed, 40 insertions(+), 51 deletions(-) [+] |
line wrap: on
line diff
--- a/Solvable.agda Mon Aug 17 11:30:12 2020 +0900 +++ b/Solvable.agda Mon Aug 17 12:56:53 2020 +0900 @@ -38,6 +38,7 @@ gsym = Algebra.Group.sym G grefl = Algebra.Group.refl G + lemma3 : ε ≈ ε ⁻¹ lemma3 = begin ε ≈⟨ gsym (proj₁ inverse _) ⟩ @@ -45,43 +46,47 @@ ε ⁻¹ ∎ where open EqReasoning (Algebra.Group.setoid G) -open import Data.List using ([] ; _∷_ ; List ; length ) - -data Node (A : Set n) : Set (Level.suc n) where - leaf : A → Node A - node : Node A → Node A → Node A - -flatten : Node Carrier → List Carrier -flatten x = flatten1 x [] where - flatten1 : Node Carrier → List Carrier → List Carrier - flatten1 (leaf x) y = x ∷ y - flatten1 (node left right) y = flatten1 left (flatten1 right y ) - -gnode : Node Carrier → Carrier -gnode (leaf x) = x -gnode (node left right) = gnode left ∙ gnode right +lemma6 : {f : Carrier } → ( f ⁻¹ ) ⁻¹ ≈ f +lemma6 {f} = begin + ( f ⁻¹ ) ⁻¹ ≈⟨ gsym ( proj₁ identity _) ⟩ + ε ∙ ( f ⁻¹ ) ⁻¹ ≈⟨ ∙-cong (gsym ( proj₂ inverse _ )) grefl ⟩ + (f ∙ f ⁻¹ ) ∙ ( f ⁻¹ ) ⁻¹ ≈⟨ assoc _ _ _ ⟩ + f ∙ ( f ⁻¹ ∙ ( f ⁻¹ ) ⁻¹ ) ≈⟨ ∙-cong grefl (proj₂ inverse _) ⟩ + f ∙ ε ≈⟨ proj₂ identity _ ⟩ + f + ∎ where open EqReasoning (Algebra.Group.setoid G) -glist : List Carrier → Carrier -glist [] = ε -glist (x ∷ []) = x -glist (x ∷ y) = x ∙ glist y +lemma5 : (f g : Carrier ) → g ⁻¹ ∙ f ⁻¹ ≈ (f ∙ g) ⁻¹ +lemma5 f g = begin + g ⁻¹ ∙ f ⁻¹ ≈⟨ gsym (proj₂ identity _) ⟩ + g ⁻¹ ∙ f ⁻¹ ∙ ε ≈⟨ gsym (∙-cong grefl (proj₂ inverse _ )) ⟩ + g ⁻¹ ∙ f ⁻¹ ∙ ( (f ∙ g) ∙ (f ∙ g) ⁻¹ ) ≈⟨ assoc _ _ _ ⟩ + g ⁻¹ ∙ (f ⁻¹ ∙ (f ∙ g ∙ (f ∙ g) ⁻¹)) ≈⟨ ∙-cong grefl (gsym (assoc _ _ _)) ⟩ + g ⁻¹ ∙ (f ⁻¹ ∙ (f ∙ g) ∙ (f ∙ g) ⁻¹) ≈⟨ gsym ( assoc _ _ _) ⟩ + g ⁻¹ ∙ (f ⁻¹ ∙ (f ∙ g)) ∙ (f ∙ g) ⁻¹ ≈⟨ ∙-cong (gsym (assoc _ _ _ )) grefl ⟩ + (g ⁻¹ ∙ f ⁻¹) ∙ (f ∙ g) ∙ (f ∙ g) ⁻¹ ≈⟨ ∙-cong (assoc _ _ _ ) grefl ⟩ + (g ⁻¹ ∙ (f ⁻¹ ∙ (f ∙ g))) ∙ (f ∙ g) ⁻¹ ≈⟨ ∙-cong (∙-cong grefl (gsym (assoc _ _ _ )) ) grefl ⟩ + (g ⁻¹ ∙ ((f ⁻¹ ∙ f) ∙ g)) ∙ (f ∙ g) ⁻¹ ≈⟨ ∙-cong (gsym (assoc _ _ _ )) grefl ⟩ + (g ⁻¹ ∙ (f ⁻¹ ∙ f) ∙ g) ∙ (f ∙ g) ⁻¹ ≈⟨ ∙-cong (assoc _ _ _) grefl ⟩ + g ⁻¹ ∙ ((f ⁻¹ ∙ f) ∙ g) ∙ (f ∙ g) ⁻¹ ≈⟨ ∙-cong (∙-cong grefl (∙-cong (proj₁ inverse _ ) grefl )) grefl ⟩ + g ⁻¹ ∙ (ε ∙ g) ∙ (f ∙ g) ⁻¹ ≈⟨ ∙-cong (∙-cong grefl ( proj₁ identity _) ) grefl ⟩ + g ⁻¹ ∙ g ∙ (f ∙ g) ⁻¹ ≈⟨ ∙-cong (proj₁ inverse _) grefl ⟩ + ε ∙ (f ∙ g) ⁻¹ ≈⟨ proj₁ identity _ ⟩ + (f ∙ g) ⁻¹ + ∎ where open EqReasoning (Algebra.Group.setoid G) -gpattern : (p q : Node Carrier) → flatten p ≡ flatten q → gnode p ≈ gnode q -gpattern p q eq = gpattern1 p q (flatten p) _≡_.refl eq where - gnot0 : ( left right : Node Carrier ) → length (flatten (node left right) ) > 1 - gnot0 (leaf x) (leaf x₁) = s≤s ( s≤s z≤n) - gnot0 (leaf x) (node q q₁) = {!!} - gnot0 (node p p₁) q = {!!} - gnot1 : (x : Carrier ) → ( left right : Node Carrier ) → ¬ ( x ∷ [] ≡ flatten (node left right) ) - gnot1 x p q eq0 = {!!} - gpattern1 : (p q : Node Carrier) → (r : List Carrier ) → flatten p ≡ r → r ≡ flatten q → gnode p ≈ gnode q - gpattern1 (leaf x) (leaf x) (x ∷ []) _≡_.refl _≡_.refl = grefl - gpattern1 (leaf x) (node left right) (x ∷ []) _≡_.refl r=q = {!!} - gpattern1 (node p p₁) (leaf x) r p=r r=q = {!!} - gpattern1 (node (leaf x) p₁) (node (leaf x₁) q₁) r p=r r=q = {!!} - gpattern1 (node (leaf x) p₁) (node (node q q₂) q₁) r p=r r=q = {!!} - gpattern1 (node (node p p₂) p₁) (node (leaf x) q₁) r p=r r=q = {!!} - gpattern1 (node (node p p₂) p₁) (node (node q q₂) q₁) r p=r r=q = {!!} +lemma4 : (g h : Carrier ) → [ h , g ] ≈ [ g , h ] ⁻¹ +lemma4 g h = begin + [ h , g ] ≈⟨ grefl ⟩ + (h ⁻¹ ∙ g ⁻¹ ∙ h ) ∙ g ≈⟨ assoc _ _ _ ⟩ + h ⁻¹ ∙ g ⁻¹ ∙ (h ∙ g) ≈⟨ ∙-cong grefl (gsym (∙-cong lemma6 lemma6)) ⟩ + h ⁻¹ ∙ g ⁻¹ ∙ ((h ⁻¹) ⁻¹ ∙ (g ⁻¹) ⁻¹) ≈⟨ ∙-cong grefl (lemma5 _ _ ) ⟩ + h ⁻¹ ∙ g ⁻¹ ∙ (g ⁻¹ ∙ h ⁻¹) ⁻¹ ≈⟨ assoc _ _ _ ⟩ + h ⁻¹ ∙ (g ⁻¹ ∙ (g ⁻¹ ∙ h ⁻¹) ⁻¹) ≈⟨ ∙-cong grefl (lemma5 (g ⁻¹ ∙ h ⁻¹ ) g ) ⟩ + h ⁻¹ ∙ (g ⁻¹ ∙ h ⁻¹ ∙ g) ⁻¹ ≈⟨ lemma5 (g ⁻¹ ∙ h ⁻¹ ∙ g) h ⟩ + (g ⁻¹ ∙ h ⁻¹ ∙ g ∙ h) ⁻¹ ≈⟨ grefl ⟩ + [ g , h ] ⁻¹ + ∎ where open EqReasoning (Algebra.Group.setoid G) deriving-mul : { i : ℕ } → { x y : Carrier } → deriving i x → deriving i y → deriving i ( x ∙ y ) deriving-mul {zero} {x} {y} _ _ = lift tt @@ -91,22 +96,6 @@ deriving-inv {zero} {x} (lift tt) = lift tt deriving-inv {suc i} {ε} uni = ccong lemma3 uni deriving-inv {suc i} {_} (comm x x₁ ) = ccong (lemma4 _ _) (comm x₁ x) where - lemma4 : (g h : Carrier ) → [ h , g ] ≈ [ g , h ] ⁻¹ - lemma4 g h = begin - h ⁻¹ ∙ g ⁻¹ ∙ h ∙ g ≈⟨ {!!} ⟩ - [ g , h ] ⁻¹ - ∎ where open EqReasoning (Algebra.Group.setoid G) deriving-inv {suc i} {_} (gen x x₁ ) = ccong (lemma5 _ _ ) ( gen (deriving-inv x₁) (deriving-inv x)) where - lemma5 : (f g : Carrier ) → g ⁻¹ ∙ f ⁻¹ ≈ (f ∙ g) ⁻¹ - lemma5 f g = begin - g ⁻¹ ∙ f ⁻¹ ≈⟨ {!!} ⟩ - g ⁻¹ ∙ f ⁻¹ ∙ ( (f ∙ g) ∙ (f ∙ g) ⁻¹ ) ≈⟨ {!!} ⟩ - (g ⁻¹ ∙ f ⁻¹ ∙ (f ∙ g)) ∙ (f ∙ g) ⁻¹ ≈⟨ {!!} ⟩ - (g ⁻¹ ∙ (f ⁻¹ ∙ f) ∙ g) ∙ (f ∙ g) ⁻¹ ≈⟨ {!!} ⟩ - (g ⁻¹ ∙ (ε ∙ g)) ∙ (f ∙ g) ⁻¹ ≈⟨ {!!} ⟩ - (g ⁻¹ ∙ g) ∙ (f ∙ g) ⁻¹ ≈⟨ {!!} ⟩ - ε ∙ (f ∙ g) ⁻¹ ≈⟨ {!!} ⟩ - (f ∙ g) ⁻¹ - ∎ where open EqReasoning (Algebra.Group.setoid G) deriving-inv {suc i} {x} (ccong eq ix ) = ccong (⁻¹-cong eq) ( deriving-inv ix )