annotate sym2.agda @ 109:5d60a060453c

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Tue, 01 Sep 2020 20:00:24 +0900
parents f4ff8e352aa7
children d3da6e2c0d90
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
68
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
1 open import Level hiding ( suc ; zero )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
2 open import Algebra
70
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
3 module sym2 where
68
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
4
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
5 open import Symmetric
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
6 open import Data.Unit
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
7 open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
8 open import Function
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
9 open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
10 open import Relation.Nullary
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
11 open import Data.Empty
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
12 open import Data.Product
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
13
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
14 open import Gutil
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
15 open import Putil
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
16 open import Solvable using (solvable)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
17 open import Relation.Binary.PropositionalEquality hiding ( [_] )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
18
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
19 open import Data.Fin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
20 open import Data.Fin.Permutation
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
21
70
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
22 sym2solvable : solvable (Symmetric 2)
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
23 solvable.dervied-length sym2solvable = 1
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
24 solvable.end sym2solvable x d = solved x d where
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
25
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
26 open import Data.List using ( List ; [] ; _∷_ )
68
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
27
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
28 open Solvable (Symmetric 2)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
29 -- open Group (Symmetric 2) using (_⁻¹)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
30
97
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
31
70
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
32 p0 : FL→perm ((# 0) :: ((# 0 ) :: f0)) =p= pid
90
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 88
diff changeset
33 p0 = pleq _ _ refl
70
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
34
97
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
35 p0r : perm→FL pid ≡ ((# 0) :: ((# 0 ) :: f0))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
36 p0r = refl
70
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
37
90
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 88
diff changeset
38 p1 : FL→perm ((# 1) :: ((# 0 ) :: f0)) =p= pswap pid
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 88
diff changeset
39 p1 = pleq _ _ refl
68
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
40
97
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
41 p1r : perm→FL (pswap pid) ≡ ((# 1) :: ((# 0 ) :: f0))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
42 p1r = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
43
70
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
44 open _=p=_
97
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
45 open import logic
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
46 p01 : (p : Permutation 2 2 ) → ( p =p= pid ) ∨ ( p =p= pswap pid ) --- p =p= FL→perm ((# 0) :: ((# 0) :: f0))
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
47 p01 p with perm→FL p | inspect perm→FL p
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
48 p01 p | (zero :: (zero :: f0)) | record { eq = e } = case1 (ptrans {!!} p0 ) -- e : perm→FL p = zero :: (zero :: f0)
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
49 p01 p |((suc zero) :: (zero :: f0)) | record { eq = e } = case2 (ptrans {!!} p1 )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
50
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
51 FL→iso : (fl : FL 2 ) → perm→FL ( FL→perm fl ) ≡ fl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
52 FL→iso (zero :: (zero :: f0)) = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
53 FL→iso ((suc zero) :: (zero :: f0)) = refl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
54
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
55 FL←iso : (perm : Permutation 2 2 ) → FL→perm ( perm→FL perm ) =p= perm
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 90
diff changeset
56 FL←iso p = {!!}
70
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
57
68
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
58 sym2lem0 : ( g h : Permutation 2 2 ) → (q : Fin 2) → ([ g , h ] ⟨$⟩ʳ q) ≡ (pid ⟨$⟩ʳ q)
70
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
59 sym2lem0 g h q with perm→FL g | perm→FL h | inspect perm→FL g
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
60 sym2lem0 g h q | zero :: (zero :: f0) | _ | record { eq = g=00} = begin
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
61 [ g , h ] ⟨$⟩ʳ q
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
62 ≡⟨⟩
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
63 h ⟨$⟩ʳ (g ⟨$⟩ʳ ( h ⟨$⟩ˡ ( g ⟨$⟩ˡ q )))
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
64 ≡⟨ cong (λ k → h ⟨$⟩ʳ (g ⟨$⟩ʳ ( h ⟨$⟩ˡ k))) ((peqˡ sym2lem1 _ )) ⟩
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
65 h ⟨$⟩ʳ (g ⟨$⟩ʳ ( h ⟨$⟩ˡ ( pid ⟨$⟩ˡ q )))
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
66 ≡⟨ cong (λ k → h ⟨$⟩ʳ k ) (peq sym2lem1 _ ) ⟩
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
67 h ⟨$⟩ʳ (pid ⟨$⟩ʳ ( h ⟨$⟩ˡ ( pid ⟨$⟩ˡ q )))
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
68 ≡⟨⟩
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
69 [ pid , h ] ⟨$⟩ʳ q
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
70 ≡⟨ peq (idcomtl h) q ⟩
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
71 q
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
72 ∎ where
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
73 open ≡-Reasoning
88
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 70
diff changeset
74 sym2lem1 : g =p= pid
90
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 88
diff changeset
75 sym2lem1 = pleq _ _ {!!}
70
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
76 -- it works but very slow
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
77 -- sym2lem1 = ptrans (psym ( FL←iso g )) (subst (λ k → FL→perm k =p= pid) (sym g=00) p0 )
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
78 sym2lem0 g h q | _ | zero :: (zero :: f0) | record { eq = g=00} = begin
69
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 68
diff changeset
79 [ g , h ] ⟨$⟩ʳ q
70
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
80 ≡⟨⟩
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
81 h ⟨$⟩ʳ (g ⟨$⟩ʳ ( h ⟨$⟩ˡ ( g ⟨$⟩ˡ q )))
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
82 ≡⟨ peq sym2lem2 _ ⟩
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
83 pid ⟨$⟩ʳ (g ⟨$⟩ʳ ( h ⟨$⟩ˡ ( g ⟨$⟩ˡ q )))
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
84 ≡⟨ cong (λ k → pid ⟨$⟩ʳ (g ⟨$⟩ʳ k)) ((peqˡ sym2lem2 _ )) ⟩
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
85 pid ⟨$⟩ʳ (g ⟨$⟩ʳ ( pid ⟨$⟩ˡ ( g ⟨$⟩ˡ q )))
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
86 ≡⟨⟩
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
87 [ g , pid ] ⟨$⟩ʳ q
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
88 ≡⟨ peq (idcomtr g) q ⟩
69
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 68
diff changeset
89 q
70
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
90 ∎ where
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
91 open ≡-Reasoning
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
92 postulate sym2lem2 : h =p= pid
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
93 sym2lem0 g h q | suc zero :: (zero :: f0) | suc zero :: (zero :: f0) | _ = begin
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
94 [ g , h ] ⟨$⟩ʳ q
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
95 ≡⟨⟩
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
96 h ⟨$⟩ʳ (g ⟨$⟩ʳ ( h ⟨$⟩ˡ ( g ⟨$⟩ˡ q )))
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
97 ≡⟨ peq sym2lem3 _ ⟩
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
98 pid ⟨$⟩ʳ ( h ⟨$⟩ˡ ( g ⟨$⟩ˡ q ))
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
99 ≡⟨ cong (λ k → pid ⟨$⟩ʳ k) (peq sym2lem4 _ )⟩
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
100 pid ⟨$⟩ʳ ( pid ⟨$⟩ˡ q )
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
101 ≡⟨⟩
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
102 q
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
103 ∎ where
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
104 open ≡-Reasoning
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
105 postulate
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
106 sym2lem3 : (g ∘ₚ h ) =p= pid
32004c9a70b1 sym2 done
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents: 69
diff changeset
107 sym2lem4 : (pinv g ∘ₚ pinv h ) =p= pid
68
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
108 solved : (x : Permutation 2 2) → Commutator (λ x₁ → Lift (Level.suc Level.zero) ⊤) x → x =p= pid
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
109 solved x uni = prefl
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
110 solved x (comm {g} {h} _ _) = record { peq = sym2lem0 g h }
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
111 solved x (gen {f} {g} d d₁) with solved f d | solved g d₁
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
112 ... | record { peq = f=e } | record { peq = g=e } = record { peq = λ q → genlem q } where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
113 genlem : ( q : Fin 2 ) → g ⟨$⟩ʳ ( f ⟨$⟩ʳ q ) ≡ q
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
114 genlem q = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
115 g ⟨$⟩ʳ ( f ⟨$⟩ʳ q )
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
116 ≡⟨ g=e ( f ⟨$⟩ʳ q ) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
117 f ⟨$⟩ʳ q
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
118 ≡⟨ f=e q ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
119 q
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
120 ∎ where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
121 solved x (ccong {f} {g} (record {peq = f=g}) d) with solved f d
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
122 ... | record { peq = f=e } = record { peq = λ q → cc q } where
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
123 cc : ( q : Fin 2 ) → x ⟨$⟩ʳ q ≡ q
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
124 cc q = begin
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
125 x ⟨$⟩ʳ q
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
126 ≡⟨ sym (f=g q) ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
127 f ⟨$⟩ʳ q
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
128 ≡⟨ f=e q ⟩
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
129 q
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
130 ∎ where open ≡-Reasoning
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
131
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
132
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
133
Shinji KONO <kono@ie.u-ryukyu.ac.jp>
parents:
diff changeset
134