# HG changeset patch
# User Shinji KONO <kono@ie.u-ryukyu.ac.jp>
# Date 1610155088 -32400
# Node ID 6d1619d9f880673daf35beb5d483b79ea2bbe0bc
# Parent  a5b3061f15eed2446f6520bc6210d567db1d5881
library

diff -r a5b3061f15ee -r 6d1619d9f880 FLComm.agda
--- a/FLComm.agda	Tue Dec 15 08:50:32 2020 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,174 +0,0 @@
-{-# OPTIONS --allow-unsolved-metas #-}
-open import Data.Nat -- using (ℕ; suc; zero; s≤s ; z≤n )
-module FLComm (n : ℕ) where
-
-open import Level renaming ( suc to Suc ; zero to Zero ) hiding (lift)
-open import Data.Fin hiding ( _<_  ; _≤_ ; _-_ ; _+_ ; _≟_)
-open import Data.Fin.Properties hiding ( <-trans ; ≤-refl ; ≤-trans ; ≤-irrelevant ; _≟_ ) renaming ( <-cmp to <-fcmp )
-open import Data.Fin.Permutation  
-open import Data.Nat.Properties 
-open import Relation.Binary.PropositionalEquality hiding ( [_] ) renaming ( sym to ≡-sym )
-open import Data.List using (List; []; _∷_ ; length ; _++_ ; tail ) renaming (reverse to rev )
-open import Data.Product hiding (_,_ )
-open import Relation.Nullary 
-open import Data.Unit hiding (_≤_)
-open import Data.Empty
-open import  Relation.Binary.Core 
-open import  Relation.Binary.Definitions hiding (Symmetric )
-open import logic
-open import nat
-
-open import FLutil
-open import Putil
-import Solvable 
-open import Symmetric
-
--- infixr  100 _::_
-
-open import Relation.Nary using (⌊_⌋)
-open import Data.List.Fresh hiding ([_])
-open import Data.List.Fresh.Relation.Unary.Any
-
-open import Algebra 
-open Group (Symmetric n) hiding (refl)
-open Solvable (Symmetric n) 
-open _∧_
--- open import Relation.Nary using (⌊_⌋)
-open import Relation.Nullary.Decidable hiding (⌊_⌋)
-
-open import fin
-
--- all cobmbination in P and Q (could be more general)
-record AnyComm {n m l : ℕ}  (P : FList n) (Q : FList m) (fpq : (p : FL n) (q : FL m) → FL l) : Set where
-   field
-     commList : FList l
-     commAny : (p : FL n) (q : FL m)
-         → Any ( p ≡_ ) P →  Any ( q ≡_ ) Q
-         → Any (fpq p q ≡_) commList
-
--------------
---    (p,q)   (p,qn) ....           (p,q0)
---    pn,q       
---     :        AnyComm FL0 FL0 P  Q
---    p0,q       
-
-open AnyComm 
-anyComm : {n m l : ℕ } → (P : FList n) (Q : FList m) → (fpq : (p : FL n) (q : FL m) → FL l)  → AnyComm P Q fpq
-anyComm [] [] _ = record { commList = [] ; commAny = λ _ _ () }
-anyComm [] (cons q Q qr) _ = record { commList = [] ; commAny = λ _ _ () }
-anyComm (cons p P pr) [] _ = record { commList = [] ; commAny = λ _ _ _ () }
-anyComm {n} {m} {l} (cons p P pr) (cons q Q qr) fpq = record { commList = FLinsert (fpq p q) (commListQ Q)  ; commAny = anyc0n } where 
-  commListP : (P1 : FList n) → FList l
-  commListP [] = commList (anyComm P Q fpq)
-  commListP (cons p₁ P1 x) =  FLinsert (fpq p₁ q) (commListP P1)
-  commListQ : (Q1 : FList m) → FList l
-  commListQ [] = commListP P
-  commListQ (cons q₁ Q1 qr₁) = FLinsert (fpq p q₁) (commListQ Q1)
-  anyc0n : (p₁ : FL n) (q₁ : FL m) → Any (_≡_ p₁) (cons p P pr) → Any (_≡_ q₁) (cons q Q qr)
-    → Any (_≡_ (fpq p₁ q₁)) (FLinsert (fpq p q) (commListQ Q))
-  anyc0n p₁ q₁ (here refl) (here refl) = x∈FLins _ (commListQ Q )
-  anyc0n p₁ q₁ (here refl) (there anyq) = insAny (commListQ Q) (anyc01 Q anyq) where 
-     anyc01 : (Q1 : FList m) → Any (_≡_ q₁) Q1 → Any (_≡_ (fpq p₁ q₁)) (commListQ Q1)
-     anyc01 (cons q Q1 qr₂) (here refl) = x∈FLins _ _
-     anyc01 (cons q₂ Q1 qr₂) (there any) = insAny _ (anyc01 Q1 any)
-  anyc0n p₁ q₁ (there anyp) (here refl) = insAny _ (anyc02 Q) where
-     anyc03 : (P1 : FList n) → Any (_≡_ p₁) P1  → Any (_≡_ (fpq p₁ q₁)) (commListP P1)
-     anyc03 (cons a P1 x) (here refl) = x∈FLins _ _ 
-     anyc03 (cons a P1 x) (there any) = insAny _ ( anyc03 P1 any) 
-     anyc02 : (Q1 : FList m) → Any (_≡_ (fpq p₁ q₁)) (commListQ Q1)
-     anyc02 [] = anyc03 P anyp
-     anyc02 (cons a Q1 x) = insAny _ (anyc02 Q1)
-  anyc0n p₁ q₁ (there anyp) (there anyq) = insAny (commListQ Q) (anyc04 Q) where
-     anyc05 : (P1 : FList n) → Any (_≡_ (fpq p₁ q₁)) (commListP P1)
-     anyc05 [] = commAny (anyComm P Q fpq) p₁ q₁ anyp anyq
-     anyc05 (cons a P1 x) = insAny _ (anyc05 P1)
-     anyc04 : (Q1 : FList m) → Any (_≡_ (fpq p₁ q₁)) (commListQ Q1)
-     anyc04 [] = anyc05 P 
-     anyc04 (cons a Q1 x) = insAny _ (anyc04 Q1)
-
--------------
---    # 0 :: # 0 :: # 0 : # 0 :: f0
---    # 0 :: # 0 :: # 1 : # 0 :: f0
---    # 0 :: # 1 :: # 0 : # 0 :: f0
---    # 0 :: # 1 :: # 1 : # 0 :: f0
---    # 0 :: # 2 :: # 0 : # 0 :: f0
---       ...
---    # 3 :: # 2 :: # 0 : # 0 :: f0
---    # 3 :: # 2 :: # 1 : # 0 :: f0
-
--- all FL
-record AnyFL (n : ℕ) : Set where
-   field
-     allFL : FList n
-     anyP : (x : FL n) → Any (x ≡_ ) allFL 
-
-open AnyFL
-
---   all FL as all combination  
---      anyComm ( #0 :: FL0 ... # n :: FL0 ) (all n) (λ p q → FLpos p :: q ) = all (suc n)
-
-anyFL01 :  (n : ℕ) → AnyFL (suc n) 
-anyFL01 zero    = record { allFL = (zero :: f0) ∷# [] ; anyP = λ x → anyFL2 x ((zero :: f0) ∷# []) refl }  where
-     anyFL2 : (x : FL 1) → (y : FList 1) → y ≡ ((zero :: f0) ∷# []) → Any (_≡_ x) y
-     anyFL2 (zero :: f0) .(cons (zero :: f0) [] (Level.lift tt)) refl = here refl
-anyFL01 (suc n) = record { allFL = commList anyC ;  anyP =  anyFL02 } where
-     anyFL05 : {n i : ℕ} → (i < suc n) → FList (suc n)
-     anyFL05 {_} {0} (s≤s z≤n) = zero :: FL0 ∷# []
-     anyFL05 {n} {suc i} (s≤s i<n) = FLinsert (fromℕ< (s≤s i<n) :: FL0) (anyFL05 {n} {i} (<-trans i<n a<sa))
-     anyFL08 : {n i : ℕ} {x : Fin (suc n)} {i<n : suc i < suc n}  → toℕ x ≡ suc i → x ≡ suc (fromℕ< (≤-pred i<n))
-     anyFL08 {n} {i} {x} {i<n} eq = toℕ-injective ( begin
-                toℕ x                               ≡⟨ eq ⟩
-                suc i                               ≡⟨ cong suc (≡-sym (toℕ-fromℕ< _ )) ⟩
-                suc (toℕ (fromℕ< (≤-pred i<n)) )
-          ∎ ) where open ≡-Reasoning
-     anyFL06 : {n i : ℕ} → (i<n : i < suc n) → (x : Fin (suc n)) → toℕ x < suc i → Any (_≡_ (x :: FL0)) (anyFL05 i<n)
-     anyFL06 (s≤s z≤n) zero (s≤s lt) = here refl
-     anyFL06 {n} {suc i} (s≤s (s≤s i<n)) x (s≤s lt) with <-cmp (toℕ x) (suc i)
-     ... | tri< a ¬b ¬c = insAny _ (anyFL06 (<-trans (s≤s i<n) a<sa) x a) 
-     ... | tri≈ ¬a b ¬c = subst (λ k →  Any (_≡_ (x :: FL0)) (FLinsert (k :: FL0) (anyFL05 {n} {i} (<-trans (s≤s i<n) a<sa))))
-                  (anyFL08 {n} {i} {x} {s≤s (s≤s i<n)} b) (x∈FLins (x :: FL0)  (anyFL05 {n} {i} (<-trans (s≤s i<n) a<sa)))
-     ... | tri> ¬a ¬b c = ⊥-elim ( nat-≤> c (s≤s lt) )
-     anyC = anyComm (anyFL05 a<sa) (allFL (anyFL01 n)) (λ p q → FLpos p :: q )
-     anyFL02 : (x : FL (suc (suc n))) → Any (_≡_ x) (commList anyC)
-     anyFL02 (x :: y) = commAny anyC (x :: FL0) y
-                       (subst (λ k → Any (_≡_ (k :: FL0) ) _) (fromℕ<-toℕ _ _) (anyFL06 a<sa (fromℕ< x≤n) fin<n) ) (anyP (anyFL01 n) y) where
-         x≤n : suc (toℕ x)  ≤ suc (suc n)
-         x≤n = toℕ<n x
-
-anyFL :  (n : ℕ) → AnyFL n 
-anyFL zero = record { allFL = f0 ∷# [] ; anyP = anyFL4 } where
-    anyFL4 : (x : FL zero) → Any (_≡_ x) ( f0 ∷# [] )
-    anyFL4 f0 = here refl
-anyFL (suc n) = anyFL01 n
-
-at1 = proj₁ (toList (allFL (anyFL 1)))
-at2 = proj₁ (toList (allFL (anyFL 2)))
-at3 = proj₁ (toList (allFL (anyFL 3)))
-at4 = proj₁ (toList (allFL (anyFL 4)))
-
-CommFListN  : ℕ →  FList n
-CommFListN  zero = allFL (anyFL n)
-CommFListN (suc i ) = commList (anyComm ( CommFListN i ) ( CommFListN i ) (λ p q →  perm→FL [ FL→perm p , FL→perm q ] ))
-
-CommStage→ : (i : ℕ) → (x : Permutation n n ) → deriving i x → Any (perm→FL x ≡_) (CommFListN i)
-CommStage→ zero x (Level.lift tt) = anyP (anyFL n) (perm→FL x)
-CommStage→ (suc i) .( [ g , h ] ) (comm {g} {h} p q) = comm2 where
-  G = perm→FL g
-  H = perm→FL h
-  comm3 :  perm→FL [ FL→perm G , FL→perm H ] ≡ perm→FL [ g , h ]
-  comm3 = begin
-              perm→FL [ FL→perm G , FL→perm H ] 
-           ≡⟨ pcong-pF (comm-resp (FL←iso _) (FL←iso _)) ⟩
-              perm→FL [ g , h ]
-          ∎  where open ≡-Reasoning
-  comm2 : Any (_≡_ (perm→FL [ g , h ])) (CommFListN (suc i))
-  comm2 = subst (λ k → Any (_≡_ k) (CommFListN (suc i)) ) comm3
-     ( commAny ( anyComm (CommFListN i) (CommFListN i) (λ p q →  perm→FL [ FL→perm p , FL→perm q ] )) G H (CommStage→ i g p) (CommStage→ i h q) )
-CommStage→ (suc i) x (ccong {f} {x} eq p) =
-      subst (λ k → Any (k ≡_) (commList (anyComm ( CommFListN i ) ( CommFListN i ) (λ p q →  perm→FL [ FL→perm p , FL→perm q ] ))))
-          (comm4 eq) (CommStage→ (suc i) f p ) where
-   comm4 : f =p= x →  perm→FL f ≡ perm→FL x
-   comm4 = pcong-pF
-
-CommSolved : (x : Permutation n n) → (y : FList n) → y ≡ FL0 ∷# [] → (FL→perm (FL0 {n}) =p= pid ) → Any (perm→FL x ≡_) y → x =p= pid
-CommSolved x .(cons FL0 [] (Level.lift tt)) refl eq0 (here eq) = FLpid _ eq eq0
diff -r a5b3061f15ee -r 6d1619d9f880 FLutil.agda
--- a/FLutil.agda	Tue Dec 15 08:50:32 2020 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,271 +0,0 @@
-{-# OPTIONS --allow-unsolved-metas #-}
-module FLutil where
-
-open import Level hiding ( suc ; zero )
-open import Data.Fin hiding ( _<_  ; _≤_ ; _-_ ; _+_ ; _≟_)
-open import Data.Fin.Properties hiding ( <-trans ; ≤-refl ; ≤-trans ; ≤-irrelevant ; _≟_ ) renaming ( <-cmp to <-fcmp )
-open import Data.Fin.Permutation  -- hiding ([_,_])
-open import Data.Nat -- using (ℕ; suc; zero; s≤s ; z≤n )
-open import Data.Nat.Properties as DNP
-open import Relation.Binary.PropositionalEquality hiding ( [_] )
-open import Data.List using (List; []; _∷_ ; length ; _++_ ; tail ) renaming (reverse to rev )
-open import Data.Product
-open import Relation.Nullary
-open import Data.Empty
-open import  Relation.Binary.Core
-open import  Relation.Binary.Definitions 
-open import logic
-open import nat
-
-infixr  100 _::_
-
-data  FL : (n : ℕ )→ Set where
-   f0 :  FL 0 
-   _::_ :  { n : ℕ } → Fin (suc n ) → FL n → FL (suc n)
-
-data _f<_  : {n : ℕ } (x : FL n ) (y : FL n)  → Set  where
-   f<n : {m : ℕ } {xn yn : Fin (suc m) } {xt yt : FL m} → xn Data.Fin.< yn →   (xn :: xt) f< ( yn :: yt )
-   f<t : {m : ℕ } {xn : Fin (suc m) } {xt yt : FL m} → xt f< yt →   (xn :: xt) f< ( xn :: yt )
-
-FLeq : {n : ℕ } {xn yn : Fin (suc n)} {x : FL n } {y : FL n}  → xn :: x ≡ yn :: y → ( xn ≡ yn )  × (x ≡ y )
-FLeq refl = refl , refl 
-
-FLpos : {n : ℕ} → FL (suc n) → Fin (suc n)
-FLpos (x :: _) = x
-
-f-<> :  {n : ℕ } {x : FL n } {y : FL n}  → x f< y → y f< x → ⊥
-f-<> (f<n x) (f<n x₁) = nat-<> x x₁
-f-<> (f<n x) (f<t lt2) = nat-≡< refl x
-f-<> (f<t lt) (f<n x) = nat-≡< refl x
-f-<> (f<t lt) (f<t lt2) = f-<> lt lt2
-
-f-≡< :  {n : ℕ } {x : FL n } {y : FL n}  → x ≡ y → y f< x → ⊥
-f-≡< refl (f<n x) = nat-≡< refl x
-f-≡< refl (f<t lt) = f-≡< refl lt 
-
-FLcmp : {n : ℕ } → Trichotomous {Level.zero} {FL n}  _≡_  _f<_
-FLcmp f0 f0 = tri≈ (λ ()) refl (λ ())
-FLcmp (xn :: xt) (yn :: yt) with <-fcmp xn yn
-... | tri< a ¬b ¬c = tri< (f<n a) (λ eq → nat-≡< (cong toℕ (proj₁ (FLeq eq)) ) a) (λ lt  → f-<> lt (f<n a) )
-... | tri> ¬a ¬b c = tri> (λ lt  → f-<> lt (f<n c) ) (λ eq → nat-≡< (cong toℕ (sym (proj₁ (FLeq eq)) )) c) (f<n c)
-... | tri≈ ¬a refl ¬c with FLcmp xt yt
-... | tri< a ¬b ¬c₁ = tri< (f<t a) (λ eq → ¬b (proj₂ (FLeq eq) )) (λ lt  → f-<> lt (f<t a) )
-... | tri≈ ¬a₁ refl ¬c₁ = tri≈ (λ lt → f-≡< refl lt )  refl (λ lt → f-≡< refl lt )
-... | tri> ¬a₁ ¬b c = tri> (λ lt  → f-<> lt (f<t c) ) (λ eq → ¬b (proj₂ (FLeq eq) )) (f<t c)
-
-f<-trans : {n : ℕ } { x y z : FL n } → x f< y → y f< z → x f< z
-f<-trans {suc n} (f<n x) (f<n x₁) = f<n ( Data.Fin.Properties.<-trans x x₁ )
-f<-trans {suc n} (f<n x) (f<t y<z) = f<n x
-f<-trans {suc n} (f<t x<y) (f<n x) = f<n x
-f<-trans {suc n} (f<t x<y) (f<t y<z) = f<t (f<-trans x<y y<z)
-
-infixr 250 _f<?_
-
-_f<?_ : {n  : ℕ} → (x y : FL n ) → Dec (x f< y )
-x f<? y with FLcmp x y
-... | tri< a ¬b ¬c = yes a
-... | tri≈ ¬a refl ¬c = no ( ¬a )
-... | tri> ¬a ¬b c = no ( ¬a )
-
-_f≤_ : {n : ℕ } (x : FL n ) (y : FL n)  → Set
-_f≤_ x y = (x ≡ y ) ∨  (x f< y )
-
-FL0 : {n : ℕ } → FL n
-FL0 {zero} = f0
-FL0 {suc n} = zero :: FL0
-
-fmax : { n : ℕ } →  FL n
-fmax {zero} = f0
-fmax {suc n} = fromℕ< a<sa :: fmax {n}
-
-fmax< : { n : ℕ } → {x : FL n } → ¬ (fmax f< x )
-fmax< {suc n} {x :: y} (f<n lt) = nat-≤> (fmax1 x) lt where
-    fmax1 : {n : ℕ } → (x : Fin (suc n)) → toℕ x ≤ toℕ (fromℕ< {n} a<sa)
-    fmax1 {zero} zero = z≤n
-    fmax1 {suc n} zero = z≤n
-    fmax1 {suc n} (suc x) = s≤s (fmax1 x) 
-fmax< {suc n} {x :: y} (f<t lt) = fmax< {n} {y} lt
-
-fmax¬ : { n : ℕ } → {x : FL n } → ¬ ( x ≡ fmax ) → x f< fmax
-fmax¬ {zero} {f0} ne = ⊥-elim ( ne refl ) 
-fmax¬ {suc n} {x} ne with FLcmp x fmax
-... | tri< a ¬b ¬c = a
-... | tri≈ ¬a b ¬c = ⊥-elim ( ne b)
-... | tri> ¬a ¬b c = ⊥-elim (fmax< c)
-
-x≤fmax : {n : ℕ } → {x : FL n} → x f≤ fmax
-x≤fmax {n} {x} with FLcmp x fmax
-... | tri< a ¬b ¬c = case2 a
-... | tri≈ ¬a b ¬c = case1 b
-... | tri> ¬a ¬b c = ⊥-elim ( fmax< c )
-
-open import Data.Nat.Properties using ( ≤-trans ; <-trans )
-fsuc : { n : ℕ } → (x : FL n ) → x f< fmax → FL n 
-fsuc {n} (x :: y) (f<n lt) = fromℕ< fsuc1 :: y where
-    fsuc1 : suc (toℕ x) < n
-    fsuc1 =  Data.Nat.Properties.≤-trans (s≤s lt) ( s≤s ( toℕ≤pred[n] (fromℕ< a<sa)) )
-fsuc (x :: y) (f<t lt) = x :: fsuc y lt
-
-open import fin
-
-flist1 :  {n : ℕ } (i : ℕ) → i < suc n → List (FL n) → List (FL n) → List (FL (suc n)) 
-flist1 zero i<n [] _ = []
-flist1 zero i<n (a ∷ x ) z  = ( zero :: a ) ∷ flist1 zero i<n x z 
-flist1 (suc i) (s≤s i<n) [] z  = flist1 i (Data.Nat.Properties.<-trans i<n a<sa) z z 
-flist1 (suc i) i<n (a ∷ x ) z  = ((fromℕ< i<n ) :: a ) ∷ flist1 (suc i) i<n x z 
-
-flist : {n : ℕ } → FL n → List (FL n) 
-flist {zero} f0 = f0 ∷ [] 
-flist {suc n} (x :: y)  = flist1 n a<sa (flist y) (flist y)   
-
-FL1 : List ℕ → List ℕ
-FL1 [] = []
-FL1 (x ∷ y) = suc x ∷ FL1 y
-
-FL→plist : {n : ℕ} → FL n → List ℕ
-FL→plist {0} f0 = []
-FL→plist {suc n} (zero :: y) = zero ∷ FL1 (FL→plist y) 
-FL→plist {suc n} (suc x :: y) with FL→plist y
-... | [] = zero ∷ []
-... | x1 ∷ t = suc x1 ∷ FL2 x t where
-  FL2 : {n : ℕ} → Fin n → List ℕ → List ℕ
-  FL2 zero y = zero ∷ FL1 y
-  FL2 (suc i) [] = zero ∷ []
-  FL2 (suc i) (x ∷ y) = suc x ∷ FL2 i y
-
-tt0 = (# 2) :: (# 1) :: (# 0) :: zero :: f0
-tt1 = FL→plist tt0
-
-open _∧_
-
-find-zero : {n i : ℕ} → List ℕ → i < n  → Fin n ∧ List ℕ
-find-zero  [] i<n = record { proj1 = fromℕ< i<n  ; proj2 = [] }
-find-zero x (s≤s z≤n) = record { proj1 = fromℕ< (s≤s z≤n)  ; proj2 = x }
-find-zero (zero ∷ y) (s≤s (s≤s i<n)) = record { proj1 = fromℕ< (s≤s (s≤s i<n)) ; proj2 = y }
-find-zero (suc x ∷ y) (s≤s (s≤s i<n)) with find-zero y (s≤s i<n) 
-... | record { proj1 = i ; proj2 = y1 } = record { proj1 = suc i ; proj2 = suc x ∷ y1 }
-
-plist→FL : {n : ℕ} → List ℕ → FL n -- wrong implementation
-plist→FL {zero} [] = f0
-plist→FL {suc n} [] = zero :: plist→FL {n} []
-plist→FL {zero} x = f0
-plist→FL {suc n} x with find-zero x a<sa
-... | record { proj1 = i ; proj2 = y } = i :: plist→FL y
-
-tt2 = 2 ∷ 1 ∷ 0 ∷ 3 ∷ []
-tt3 : FL 4
-tt3 = plist→FL tt2
-tt4 = FL→plist tt3
-tt5 = plist→FL {4} (FL→plist tt0)
-
--- maybe FL→iso can be easier using this ...
--- FL→plist-iso : {n : ℕ} → (f : FL n ) → plist→FL (FL→plist f ) ≡ f
--- FL→plist-iso = {!!}
--- FL→plist-inject : {n : ℕ} → (f g : FL n ) → FL→plist f ≡ FL→plist g → f ≡ g
--- FL→plist-inject = {!!}
-
-open import Relation.Binary as B hiding (Decidable; _⇔_)
-open import Data.Sum.Base as Sum --  inj₁
-open import Relation.Nary using (⌊_⌋)
-open import Data.List.Fresh hiding ([_])
-
-FList : (n : ℕ ) → Set
-FList n = List# (FL n) ⌊ _f<?_ ⌋
-
-fr1 : FList 3
-fr1 =
-   ((# 0) :: ((# 0) :: ((# 0 ) :: f0))) ∷# 
-   ((# 0) :: ((# 1) :: ((# 0 ) :: f0))) ∷# 
-   ((# 1) :: ((# 0) :: ((# 0 ) :: f0))) ∷# 
-   ((# 2) :: ((# 0) :: ((# 0 ) :: f0))) ∷# 
-   ((# 2) :: ((# 1) :: ((# 0 ) :: f0))) ∷# 
-   []
-
-open import Data.Product
-open import Relation.Nullary.Decidable hiding (⌊_⌋)
--- open import Data.Bool hiding (_<_ ; _≤_ )
-open import Data.Unit.Base using (⊤ ; tt)
-
---  fresh a []        = ⊤
---  fresh a (x ∷# xs) = R a x × fresh a xs
-
--- toWitness
--- ttf< :  {n : ℕ } → {x a : FL n } → x f< a  → T (isYes (x f<? a))
--- ttf< {n} {x} {a} x<a with x f<? a
--- ... | yes y = subst (λ k → Data.Bool.T k ) refl tt
--- ... | no nn = ⊥-elim ( nn x<a )
-
-ttf : {n : ℕ } {x a : FL (n)} → x f< a → (y : FList (n)) →  fresh (FL (n)) ⌊ _f<?_ ⌋  a y  → fresh (FL (n)) ⌊ _f<?_ ⌋  x y
-ttf _ [] fr = Level.lift tt
-ttf {_} {x} {a} lt (cons a₁ y x1) (lift lt1 , x2 ) = (Level.lift (fromWitness (ttf1 lt1 lt ))) , ttf (ttf1 lt1 lt) y x1 where 
-       ttf1 : True (a f<? a₁) → x f< a  → x f< a₁
-       ttf1 t x<a = f<-trans x<a (toWitness t)
-
--- by https://gist.github.com/aristidb/1684202
-
-FLinsert : {n : ℕ } → FL n → FList n  → FList n 
-FLfresh : {n : ℕ } → (a x : FL (suc n) ) → (y : FList (suc n) ) → a f< x
-     → fresh (FL (suc n)) ⌊ _f<?_ ⌋ a y → fresh (FL (suc n)) ⌊ _f<?_ ⌋ a (FLinsert x y)
-FLinsert {zero} f0 y = f0 ∷# []
-FLinsert {suc n} x [] = x ∷# []
-FLinsert {suc n} x (cons a y x₁) with FLcmp x a
-... | tri≈ ¬a b ¬c  = cons a y x₁
-... | tri< lt ¬b ¬c  = cons x ( cons a y x₁) ( Level.lift (fromWitness lt ) , ttf lt y  x₁) 
-FLinsert {suc n} x (cons a [] x₁) | tri> ¬a ¬b lt  = cons a ( x  ∷# []  ) ( Level.lift (fromWitness lt) , Level.lift tt )
-FLinsert {suc n} x (cons a y yr)  | tri> ¬a ¬b a<x = cons a (FLinsert x y) (FLfresh a x y a<x yr )
-
-FLfresh a x [] a<x (Level.lift tt) = Level.lift (fromWitness a<x) , Level.lift tt
-FLfresh a x (cons b [] (Level.lift tt)) a<x (Level.lift a<b , a<y) with FLcmp x b
-... | tri< x<b ¬b ¬c  = Level.lift (fromWitness a<x) , Level.lift a<b , Level.lift tt
-... | tri≈ ¬a refl ¬c = Level.lift (fromWitness a<x) , Level.lift tt
-... | tri> ¬a ¬b b<x =  Level.lift a<b  ,  Level.lift (fromWitness  (f<-trans (toWitness a<b) b<x))  , Level.lift tt
-FLfresh a x (cons b y br) a<x (Level.lift a<b , a<y) with FLcmp x b
-... | tri< x<b ¬b ¬c =  Level.lift (fromWitness a<x) , Level.lift a<b , ttf (toWitness a<b) y br
-... | tri≈ ¬a refl ¬c = Level.lift (fromWitness a<x) , ttf a<x y br
-FLfresh a x (cons b [] br) a<x (Level.lift a<b , a<y) | tri> ¬a ¬b b<x =
-    Level.lift a<b , Level.lift (fromWitness (f<-trans (toWitness a<b) b<x)) , Level.lift tt
-FLfresh a x (cons b (cons a₁ y x₁) br) a<x (Level.lift a<b , a<y) | tri> ¬a ¬b b<x =
-    Level.lift a<b , FLfresh a x (cons a₁ y x₁) a<x a<y
-
-fr6 = FLinsert ((# 1) :: ((# 1) :: ((# 0 ) :: f0))) fr1 
-
-open import Data.List.Fresh.Relation.Unary.Any 
-open import Data.List.Fresh.Relation.Unary.All 
-
-x∈FLins : {n : ℕ} → (x : FL n ) → (xs : FList n)  → Any (x ≡_) (FLinsert x xs)
-x∈FLins {zero} f0 [] = here refl
-x∈FLins {zero} f0 (cons f0 xs x) = here refl
-x∈FLins {suc n} x [] = here refl
-x∈FLins {suc n} x (cons a xs x₁) with FLcmp x a
-... | tri< x<a ¬b ¬c = here refl
-... | tri≈ ¬a b ¬c   = here b
-x∈FLins {suc n} x (cons a [] x₁)              | tri> ¬a ¬b a<x = there ( here refl )
-x∈FLins {suc n} x (cons a (cons a₁ xs x₂) x₁) | tri> ¬a ¬b a<x = there ( x∈FLins x (cons a₁ xs x₂) )
-
-nextAny : {n : ℕ} → {x h : FL n } → {L : FList n}  → {hr : fresh (FL n) ⌊ _f<?_ ⌋ h L } → Any (x ≡_) L → Any (x ≡_) (cons h L hr )
-nextAny (here x₁) = there (here x₁)
-nextAny (there any) = there (there any)
-
-insAny : {n : ℕ} → {x h : FL n } → (xs : FList n)  → Any (x ≡_) xs → Any (x ≡_) (FLinsert h xs)
-insAny {zero} {f0} {f0} (cons a L xr) (here refl) = here refl
-insAny {zero} {f0} {f0} (cons a L xr) (there any) = insAny {zero} {f0} {f0} L any 
-insAny {suc n} {x} {h} (cons a L xr) any with FLcmp h a 
-... | tri< x<a ¬b ¬c = there any
-... | tri≈ ¬a b ¬c = any
-insAny {suc n} {a} {h} (cons a [] (Level.lift tt)) (here refl) | tri> ¬a ¬b c = here refl
-insAny {suc n} {x} {h} (cons a (cons a₁ L x₁) xr) (here refl) | tri> ¬a ¬b c = here refl
-insAny {suc n} {x} {h} (cons a (cons a₁ L x₁) xr) (there any) | tri> ¬a ¬b c = there (insAny (cons a₁ L x₁) any)
-
--- FLinsert membership
-
-module FLMB { n : ℕ } where
-
-  FL-Setoid : Setoid Level.zero Level.zero
-  FL-Setoid  = record { Carrier = FL n ; _≈_ = _≡_ ; isEquivalence = record { sym = sym ; refl = refl ; trans = trans }}
-
-  open import Data.List.Fresh.Membership.Setoid FL-Setoid
-
-  FLinsert-mb :  (x : FL n ) → (xs : FList n)  → x ∈ FLinsert x xs
-  FLinsert-mb x xs = x∈FLins {n} x xs 
-
-  
diff -r a5b3061f15ee -r 6d1619d9f880 Galois.agda-lib
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Galois.agda-lib	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,2 @@
+name: Galois
+depend: standard-library include: src 
diff -r a5b3061f15ee -r 6d1619d9f880 Galois.agda-pkg
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Galois.agda-pkg	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,12 @@
+name:              Galois
+version:           v0.0.1
+
+
+homepage:          https://ie.u-ryukyu.ac.jp/~kono
+license:           MIT
+license-file:      LICENSE.md
+source-repository: https://github.com/shinji-kono/Galois
+tested-with:       2.6.2-102d9c8
+description:       Solvability on Symmetry
+
+# End 
diff -r a5b3061f15ee -r 6d1619d9f880 Gutil.agda
--- a/Gutil.agda	Tue Dec 15 08:50:32 2020 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,130 +0,0 @@
-open import Level hiding ( suc ; zero )
-open import Algebra
-module Gutil {n m : Level} (G : Group n m ) where
-
-open import Data.Unit
-open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
-open import Function
-open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
-open import Relation.Nullary
-open import Data.Empty
-open import Data.Product
-open import  Relation.Binary.PropositionalEquality hiding ( [_] )
-
-
-open Group G
-
-import Relation.Binary.Reasoning.Setoid as EqReasoning
-
-gsym = Algebra.Group.sym G
-grefl = Algebra.Group.refl G
-gtrans = Algebra.Group.trans G
-
-lemma3 : ε ≈ ε ⁻¹
-lemma3 = begin
-     ε          ≈⟨ gsym (proj₁ inverse _) ⟩
-     ε ⁻¹ ∙ ε   ≈⟨ proj₂ identity _ ⟩
-     ε ⁻¹
-   ∎ where open EqReasoning (Algebra.Group.setoid G)
-
-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)
-
-≡→≈ : {f g : Carrier } → f ≡ g → f ≈ g
-≡→≈ refl = grefl
-
----
--- to avoid assoc storm, flatten multiplication according to the template
---
-
-data MP  : Carrier → Set (Level.suc n) where
-    am  : (x : Carrier )   →  MP  x
-    _o_ : {x y : Carrier } →  MP  x →  MP  y → MP  ( x ∙ y )
-
-mpf : {x : Carrier } → (m : MP x ) → Carrier → Carrier
-mpf (am x) y = x ∙ y
-mpf (m o m₁) y = mpf m ( mpf m₁ y )
-
-mp-flatten : {x : Carrier } → (m : MP x ) → Carrier 
-mp-flatten  m = mpf m ε 
-
-mpl1 : Carrier → {x : Carrier } → MP x → Carrier
-mpl1 x (am y) = x ∙ y
-mpl1 x (y o y1) = mpl1 ( mpl1 x y ) y1
-
-mpl : {x z : Carrier } → MP x → MP z  → Carrier
-mpl (am x)  m = mpl1 x m 
-mpl (m o m1) m2 = mpl m (m1 o m2)
-
-mp-flattenl : {x : Carrier } → (m : MP x ) → Carrier
-mp-flattenl m = mpl m (am ε)
-
-test1 : ( f g : Carrier ) → Carrier
-test1 f g = mp-flattenl ((am (g ⁻¹) o am (f ⁻¹) ) o ( (am f o am g) o am ((f ∙ g) ⁻¹ ))) 
-
-test2 : ( f g : Carrier ) → test1 f g ≡  g ⁻¹ ∙ f ⁻¹ ∙ f ∙ g ∙  (f ∙ g) ⁻¹  ∙ ε
-test2 f g = _≡_.refl
-
-test3 : ( f g : Carrier ) → Carrier
-test3 f g = mp-flatten ((am (g ⁻¹) o am (f ⁻¹) ) o ( (am f o am g) o am ((f ∙ g) ⁻¹ ))) 
-
-test4 : ( f g : Carrier ) → test3 f g ≡ g ⁻¹ ∙ (f ⁻¹ ∙ (f ∙ (g ∙ ((f ∙ g) ⁻¹ ∙ ε))))
-test4 f g = _≡_.refl
-
-  
-∙-flatten : {x : Carrier } → (m : MP x ) → x ≈ mp-flatten m
-∙-flatten {x} (am x) = gsym (proj₂ identity _)
-∙-flatten {_} (am x o q) = ∙-cong grefl ( ∙-flatten q )
-∙-flatten (_o_ {_} {z} (_o_ {x} {y} p q) r) = lemma9 _ _ _ ( ∙-flatten {x ∙ y } (p o q )) ( ∙-flatten {z} r ) where
-   mp-cong : {p q r : Carrier} → (P : MP p)  → q ≈ r → mpf P q ≈ mpf P r
-   mp-cong (am x) q=r = ∙-cong grefl q=r
-   mp-cong (P o P₁) q=r = mp-cong P ( mp-cong P₁ q=r )
-   mp-assoc : {p q r : Carrier} → (P : MP p)  → mpf P q ∙ r ≈ mpf P (q ∙ r )
-   mp-assoc (am x) = assoc _ _ _ 
-   mp-assoc {p} {q} {r} (P o P₁) = begin
-       mpf P (mpf  P₁ q) ∙ r      ≈⟨ mp-assoc P ⟩
-       mpf P (mpf P₁ q ∙ r)       ≈⟨ mp-cong P (mp-assoc P₁)  ⟩ mpf P ((mpf  P₁) (q ∙ r))
-    ∎ where open EqReasoning (Algebra.Group.setoid G)
-   lemma9 : (x y z : Carrier) →  x ∙ y ≈ mpf p (mpf q ε) → z ≈ mpf r ε →  x ∙ y ∙ z ≈ mp-flatten ((p o q) o r)
-   lemma9 x y z t s = begin
-       x ∙ y ∙ z                    ≈⟨ ∙-cong t grefl  ⟩
-       mpf p (mpf q ε) ∙ z          ≈⟨ mp-assoc p ⟩
-       mpf p (mpf q ε ∙ z)          ≈⟨ mp-cong p (mp-assoc q ) ⟩
-       mpf p (mpf q (ε ∙ z))        ≈⟨ mp-cong p (mp-cong q (proj₁ identity _  )) ⟩
-       mpf p (mpf q z)              ≈⟨ mp-cong p (mp-cong q s) ⟩
-       mpf p (mpf q (mpf r ε))
-    ∎ where open EqReasoning (Algebra.Group.setoid G)
-
-grepl : { x y0 y1 z  : Carrier } → x ∙ y0 ≈ y1  → x ∙ ( y0 ∙ z ) ≈ y1 ∙ z 
-grepl eq = gtrans (gsym (assoc _ _ _ )) (∙-cong eq grefl )
-
-grm : { x y0 y1 z  : Carrier } → x ∙ y0 ≈ ε  → x ∙ ( y0 ∙ z ) ≈  z 
-grm eq = gtrans ( gtrans (gsym (assoc _ _ _ )) (∙-cong eq grefl )) ( proj₁ identity _ )
-
--- ∙-flattenl : {x : Carrier } → (m : MP x ) → x ≈ mp-flattenl m
--- ∙-flattenl (am x) = gsym (proj₂ identity _)
--- ∙-flattenl (q o am x) with ∙-flattenl q    -- x₁ ∙ x ≈ mpl q (am x o am ε) ,  t : x₁ ≈ mpl q (am ε)
--- ... | t = {!!}
--- ∙-flattenl (q o (x o y )) with ∙-flattenl q 
--- ... | t = gtrans (gsym (assoc _ _ _ )) {!!}
-
-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) ⁻¹ )         ≈⟨ ∙-flatten ((am (g ⁻¹) o am (f ⁻¹) ) o ( (am f o am g) o am ((f ∙ g) ⁻¹ )))  ⟩
-     g ⁻¹ ∙ (f ⁻¹ ∙ (f ∙ (g ∙ ((f ∙ g) ⁻¹ ∙ ε))))    ≈⟨ ∙-cong grefl (gsym (assoc _ _ _ )) ⟩
-     g ⁻¹ ∙ ((f ⁻¹ ∙ f) ∙ (g ∙ ((f ∙ g) ⁻¹ ∙ ε)))    ≈⟨ ∙-cong grefl (gtrans (∙-cong (proj₁ inverse _ ) grefl) (proj₁ identity _)) ⟩
-     g ⁻¹ ∙ (g ∙ ((f ∙ g) ⁻¹ ∙ ε))                   ≈⟨ gsym (assoc _ _ _) ⟩
-     (g ⁻¹ ∙ g ) ∙ ((f ∙ g) ⁻¹ ∙ ε)                  ≈⟨ gtrans (∙-cong (proj₁ inverse _ ) grefl) (proj₁ identity _) ⟩
-     (f ∙ g) ⁻¹ ∙ ε                                  ≈⟨ proj₂ identity _ ⟩
-     (f ∙ g) ⁻¹
-     ∎ where open EqReasoning (Algebra.Group.setoid G)
-
diff -r a5b3061f15ee -r 6d1619d9f880 LICENSE.md
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/LICENSE.md	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,19 @@
+Copyright (c) 2020 <copyright Shinji KONO, University of the Ryukyus, kono@ie.u-ryukyu.ac.jp >
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
diff -r a5b3061f15ee -r 6d1619d9f880 Putil.agda
--- a/Putil.agda	Tue Dec 15 08:50:32 2020 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,703 +0,0 @@
-{-# OPTIONS --allow-unsolved-metas #-} 
-module Putil where
-
-open import Level hiding ( suc ; zero )
-open import Algebra
-open import Algebra.Structures
-open import Data.Fin hiding ( _<_  ; _≤_ ; _-_ ; _+_ ; _≟_)
-open import Data.Fin.Properties hiding ( <-trans ; ≤-trans ; ≤-irrelevant ; _≟_ ) renaming ( <-cmp to <-fcmp )
-open import Data.Fin.Permutation
-open import Function hiding (id ; flip)
-open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
-open import Function.LeftInverse  using ( _LeftInverseOf_ )
-open import Function.Equality using (Π)
-open import Data.Nat -- using (ℕ; suc; zero; s≤s ; z≤n )
-open import Data.Nat.Properties -- using (<-trans)
-open import Relation.Binary.PropositionalEquality hiding ( [_] )
-open import Data.List using (List; []; _∷_ ; length ; _++_ ; head ; tail ) renaming (reverse to rev )
-open import nat
-
-open import Symmetric
-
-
-open import Relation.Nullary
-open import Data.Empty
-open import  Relation.Binary.Core
-open import  Relation.Binary.Definitions
-open import fin
-
--- An inductive construction of permutation
-
-pprep  : {n : ℕ }  → Permutation n n → Permutation (suc n) (suc n)
-pprep {n} perm =  permutation p→ p← record { left-inverse-of = piso→ ; right-inverse-of = piso← } where
-   p→ : Fin (suc n) → Fin (suc n)
-   p→ zero = zero
-   p→ (suc x) = suc ( perm  ⟨$⟩ʳ x)
-
-   p← : Fin (suc n) → Fin (suc n)
-   p← zero = zero
-   p← (suc x) = suc ( perm  ⟨$⟩ˡ x)
-
-   piso← : (x : Fin (suc n)) → p→ ( p← x ) ≡ x
-   piso← zero = refl
-   piso← (suc x) = cong (λ k → suc k ) (inverseʳ perm) 
-
-   piso→ : (x : Fin (suc n)) → p← ( p→ x ) ≡ x
-   piso→ zero = refl
-   piso→ (suc x) = cong (λ k → suc k ) (inverseˡ perm) 
-
-pswap  : {n : ℕ }  → Permutation n n → Permutation (suc (suc n)) (suc (suc  n ))
-pswap {n} perm = permutation p→ p← record { left-inverse-of = piso→ ; right-inverse-of = piso← } where
-   p→ : Fin (suc (suc n)) → Fin (suc (suc n)) 
-   p→ zero = suc zero 
-   p→ (suc zero) = zero 
-   p→ (suc (suc x)) = suc ( suc ( perm  ⟨$⟩ʳ x) )
-
-   p← : Fin (suc (suc n)) → Fin (suc (suc n)) 
-   p← zero = suc zero 
-   p← (suc zero) = zero 
-   p← (suc (suc x)) = suc ( suc ( perm  ⟨$⟩ˡ x) )
-   
-   piso← : (x : Fin (suc (suc n)) ) → p→ ( p← x ) ≡ x
-   piso← zero = refl
-   piso← (suc zero) = refl
-   piso← (suc (suc x)) = cong (λ k → suc (suc k) ) (inverseʳ perm) 
-
-   piso→ : (x : Fin (suc (suc n)) ) → p← ( p→ x ) ≡ x
-   piso→ zero = refl
-   piso→ (suc zero) = refl
-   piso→ (suc (suc x)) = cong (λ k → suc (suc k) ) (inverseˡ perm) 
-
-psawpn : {n : ℕ} → 1 < n → Permutation n n
-psawpn {suc zero}  (s≤s ())
-psawpn {suc n} (s≤s (s≤s x)) = pswap pid 
-
-pfill : { n m : ℕ } → m ≤ n → Permutation  m m → Permutation n n
-pfill {n} {m} m≤n perm = pfill1 (n - m) (n-m<n n m ) (subst (λ k → Permutation k k ) (n-n-m=m m≤n ) perm) where
-   pfill1 : (i : ℕ ) → i ≤ n  → Permutation (n - i) (n - i)  →  Permutation n n
-   pfill1 0 _ perm = perm
-   pfill1 (suc i) i<n perm = pfill1 i (≤to< i<n) (subst (λ k → Permutation k k ) (si-sn=i-n i<n ) ( pprep perm ) )
-
---
---  psawpim (inseert swap at position m )
---
-psawpim : {n m : ℕ} → suc (suc m) ≤ n → Permutation n n
-psawpim {n} {m} m≤n = pfill m≤n ( psawpn (s≤s (s≤s z≤n)) )
-
-n≤ : (i : ℕ ) → {j : ℕ } → i ≤ i + j
-n≤ (zero) {j} = z≤n
-n≤ (suc i) {j} = s≤s ( n≤ i )
-
-lem0 : {n : ℕ } → n ≤ n
-lem0 {zero} = z≤n
-lem0 {suc n} = s≤s lem0
-
-lem00 : {n m : ℕ } → n ≡ m → n ≤ m
-lem00 refl = lem0
-
-plist1 : {n  : ℕ} → Permutation (suc n) (suc n) → (i : ℕ ) → i < suc n → List ℕ
-plist1  {n} perm zero _           = toℕ ( perm ⟨$⟩ˡ (fromℕ< {zero} (s≤s z≤n))) ∷ []
-plist1  {n} perm (suc i) (s≤s lt) = toℕ ( perm ⟨$⟩ˡ (fromℕ< (s≤s lt)))         ∷ plist1 perm  i (<-trans lt a<sa) 
-
-plist  : {n  : ℕ} → Permutation n n → List ℕ
-plist {0} perm = []
-plist {suc n} perm = rev (plist1 perm n a<sa) 
-
--- 
---    from n-1 length create n length inserting new element at position m
---
--- 0 ∷ 1 ∷ 2 ∷ 3 ∷ []                               -- 0 ∷ 1 ∷ 2 ∷ 3 ∷ [] 
--- 1 ∷ 0 ∷ 2 ∷ 3 ∷ []    plist ( pins {3} (n≤ 1) )     1 ∷ 0 ∷ 2 ∷ 3 ∷ []
--- 1 ∷ 2 ∷ 0 ∷ 3 ∷ []    plist ( pins {3} (n≤ 2) )     2 ∷ 0 ∷ 1 ∷ 3 ∷ []
--- 1 ∷ 2 ∷ 3 ∷ 0 ∷ []    plist ( pins {3} (n≤ 3) )     3 ∷ 0 ∷ 1 ∷ 2 ∷ []
---
--- defined by pprep and pswap
---
--- pins  : {n m : ℕ} → m ≤ n → Permutation (suc n) (suc n)
--- pins {_} {zero} _ = pid
--- pins {suc _} {suc zero} _ = pswap pid
--- pins {suc (suc n)} {suc m} (s≤s m<n) =  pins1 (suc m) (suc (suc n)) lem0 where
---     pins1 : (i j : ℕ ) → j ≤ suc (suc n)  → Permutation (suc (suc (suc n ))) (suc (suc (suc n)))
---     pins1 _ zero _ = pid
---     pins1 zero _ _ = pid
---     pins1 (suc i) (suc j) (s≤s si≤n) = psawpim {suc (suc (suc n))} {j}  (s≤s (s≤s si≤n))  ∘ₚ  pins1 i j (≤-trans si≤n a≤sa ) 
-
-open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ )
-open ≡-Reasoning
-
-pins  : {n m : ℕ} → m ≤ n → Permutation (suc n) (suc n)
-pins {_} {zero} _ = pid
-pins {suc n} {suc m} (s≤s  m≤n) = permutation p← p→  record { left-inverse-of = piso← ; right-inverse-of = piso→ } where
-
-   next : Fin (suc (suc n)) → Fin (suc (suc n))
-   next zero = suc zero
-   next (suc x) = fromℕ< (≤-trans (fin<n {_} {x} ) a≤sa )
-
-   p→ : Fin (suc (suc n)) → Fin (suc (suc n)) 
-   p→ x with <-cmp (toℕ x) (suc m)
-   ... | tri< a ¬b ¬c = fromℕ< (≤-trans (s≤s  a) (s≤s (s≤s  m≤n) )) 
-   ... | tri≈ ¬a b ¬c = zero
-   ... | tri> ¬a ¬b c = x
-
-   p← : Fin (suc (suc n)) → Fin (suc (suc n)) 
-   p← zero = fromℕ< (s≤s (s≤s m≤n))
-   p← (suc x) with <-cmp (toℕ x) (suc m)
-   ... | tri< a ¬b ¬c = fromℕ< (≤-trans (fin<n {_} {x}) a≤sa )
-   ... | tri≈ ¬a b ¬c = suc x
-   ... | tri> ¬a ¬b c = suc x
-
-   mm : toℕ (fromℕ< {suc m} {suc (suc n)} (s≤s (s≤s m≤n))) ≡ suc m 
-   mm = toℕ-fromℕ< (s≤s (s≤s  m≤n)) 
-
-   mma : (x : Fin (suc n) ) → suc (toℕ x) ≤ suc m → toℕ ( fromℕ< (≤-trans (fin<n {_} {x}) a≤sa ) ) ≤ m
-   mma x (s≤s x<sm) = subst (λ k → k ≤ m) (sym (toℕ-fromℕ< (≤-trans fin<n a≤sa ) )) x<sm
-   
-   p3 : (x : Fin (suc n) ) →  toℕ (fromℕ< (≤-trans (fin<n {_} {suc x} ) (s≤s a≤sa))) ≡ suc (toℕ x)
-   p3 x = begin
-            toℕ (fromℕ< (≤-trans (fin<n {_} {suc x} ) (s≤s a≤sa)))
-          ≡⟨ toℕ-fromℕ< ( s≤s ( ≤-trans fin<n  a≤sa ) ) ⟩
-            suc (toℕ x)
-          ∎ 
-
-   piso→ : (x : Fin (suc (suc n)) ) → p← ( p→ x ) ≡ x
-   piso→ zero with <-cmp (toℕ (fromℕ< (≤-trans (s≤s z≤n) (s≤s (s≤s  m≤n) )))) (suc m)
-   ... | tri< a ¬b ¬c = refl
-   piso→ (suc x) with <-cmp (toℕ (suc x)) (suc m)
-   ... | tri≈ ¬a refl ¬c = p13 where
-       p13 : fromℕ< (s≤s (s≤s m≤n)) ≡ suc x
-       p13 = cong (λ k → suc k ) (fromℕ<-toℕ _ (s≤s m≤n) )
-   ... | tri> ¬a ¬b c = p16 (suc x) refl where
-       p16 : (y :  Fin (suc (suc n))) → y ≡ suc x → p← y ≡ suc x
-       p16 zero eq = ⊥-elim ( nat-≡< (cong (λ k → suc (toℕ k) ) eq) (s≤s (s≤s (z≤n))))
-       p16 (suc y) eq with <-cmp (toℕ y) (suc m)   -- suc (suc m) < toℕ (suc x)
-       ... | tri< a ¬b ¬c = ⊥-elim ( nat-≡< refl ( ≤-trans c (subst (λ k → k < suc m) p17 a )) ) where
-           --  x = suc m case, c : suc (suc m) ≤ suc (toℕ x), a : suc (toℕ y) ≤ suc m,  suc y ≡ suc x
-           p17 : toℕ y ≡ toℕ x
-           p17 with <-cmp (toℕ y) (toℕ x) | cong toℕ eq
-           ... | tri< a ¬b ¬c | seq =  ⊥-elim ( nat-≡< seq (s≤s a) )
-           ... | tri≈ ¬a b ¬c | seq = b
-           ... | tri> ¬a ¬b c | seq =  ⊥-elim ( nat-≡< (sym seq) (s≤s c))
-       ... | tri≈ ¬a b ¬c = eq 
-       ... | tri> ¬a ¬b c₁ = eq 
-   ... | tri< a ¬b ¬c = p10 (fromℕ< (≤-trans (s≤s  a) (s≤s (s≤s  m≤n) ))) refl  where
-       p10 : (y : Fin (suc (suc n)) ) → y ≡ fromℕ< (≤-trans (s≤s  a) (s≤s (s≤s  m≤n) ))  → p← y ≡ suc x
-       p10 zero ()
-       p10 (suc y) eq = p15 where
-          p12 : toℕ y ≡ suc (toℕ x)
-          p12 = begin
-               toℕ y
-             ≡⟨ cong (λ k → Data.Nat.pred (toℕ k)) eq ⟩
-               toℕ (fromℕ< (≤-trans a (s≤s m≤n)))
-             ≡⟨ toℕ-fromℕ< {suc (toℕ x)} {suc n} (≤-trans a (s≤s m≤n)) ⟩
-               suc (toℕ x)
-             ∎
-          p15 : p← (suc y) ≡ suc x
-          p15 with <-cmp (toℕ y) (suc m) -- eq : suc y ≡ suc (suc (fromℕ< (≤-pred (≤-trans a (s≤s m≤n))))) ,  a : suc x < suc m
-          ... | tri< a₁ ¬b ¬c = p11 where
-            p11 : fromℕ< (≤-trans (fin<n {_} {y}) a≤sa ) ≡ suc x
-            p11 = begin
-               fromℕ< (≤-trans (fin<n {_} {y}) a≤sa )
-              ≡⟨ lemma10 {suc (suc n)} {_} {_} p12 {≤-trans (fin<n {_} {y}) a≤sa} {s≤s (fin<n {suc n} {x} )}  ⟩
-               suc (fromℕ< (fin<n {suc n} {x} )) 
-              ≡⟨ cong suc (fromℕ<-toℕ x _ ) ⟩
-               suc x
-              ∎
-          ... | tri≈ ¬a b ¬c = ⊥-elim ( nat-≡< b (subst (λ k → k < suc m) (sym p12) a ))  --  suc x < suc m -> y = suc x  → toℕ y < suc m 
-          ... | tri> ¬a ¬b c = ⊥-elim ( nat-<> c (subst (λ k → k < suc m) (sym p12) a ))  
-
-   piso← : (x : Fin (suc (suc n)) ) → p→ ( p← x ) ≡ x
-   piso← zero with <-cmp (toℕ (fromℕ< (s≤s (s≤s m≤n)))) (suc m) | mm
-   ... | tri< a ¬b ¬c | t = ⊥-elim ( ¬b t )
-   ... | tri≈ ¬a b ¬c | t = refl
-   ... | tri> ¬a ¬b c | t = ⊥-elim ( ¬b t )
-   piso← (suc x) with <-cmp (toℕ x) (suc m)
-   ... | tri> ¬a ¬b c with <-cmp (toℕ (suc x)) (suc m)
-   ... | tri< a ¬b₁ ¬c = ⊥-elim ( nat-<> a (<-trans c a<sa ) )
-   ... | tri≈ ¬a₁ b ¬c = ⊥-elim (  nat-≡< (sym b) (<-trans c a<sa ))
-   ... | tri> ¬a₁ ¬b₁ c₁ = refl
-   piso← (suc x) | tri≈ ¬a b ¬c with <-cmp (toℕ (suc x)) (suc m)
-   ... | tri< a ¬b ¬c₁ = ⊥-elim (  nat-≡< b (<-trans a<sa a) ) 
-   ... | tri≈ ¬a₁ refl ¬c₁ = ⊥-elim ( nat-≡< b a<sa )
-   ... | tri> ¬a₁ ¬b c = refl
-   piso← (suc x) | tri< a ¬b ¬c with <-cmp (toℕ ( fromℕ< (≤-trans (fin<n {_} {x}) a≤sa ) )) (suc m)
-   ... | tri≈ ¬a b ¬c₁ = ⊥-elim ( ¬a (s≤s (mma x a)))
-   ... | tri> ¬a ¬b₁ c = ⊥-elim ( ¬a (s≤s (mma x a)))
-   ... | tri< a₁ ¬b₁ ¬c₁ = p0 where
-       p2 : suc (suc (toℕ x)) ≤ suc (suc n)
-       p2 = s≤s (fin<n {suc n} {x})
-       p6 : suc (toℕ (fromℕ< (≤-trans (fin<n {_} {suc x}) (s≤s a≤sa)))) ≤ suc (suc n)
-       p6 = s≤s (≤-trans a₁ (s≤s m≤n))
-       p0 : fromℕ< (≤-trans (s≤s  a₁) (s≤s (s≤s  m≤n) ))  ≡ suc x
-       p0 = begin
-             fromℕ< (≤-trans (s≤s  a₁) (s≤s (s≤s  m≤n) ))
-          ≡⟨⟩
-             fromℕ< (s≤s (≤-trans a₁ (s≤s m≤n))) 
-          ≡⟨ lemma10 {suc (suc n)} (p3 x) {p6} {p2} ⟩
-             fromℕ< ( s≤s (fin<n {suc n} {x}) )
-          ≡⟨⟩
-             suc (fromℕ< (fin<n {suc n} {x} )) 
-          ≡⟨ cong suc (fromℕ<-toℕ x _ ) ⟩
-             suc x
-          ∎ 
-
-t7 =  plist (pins {3} (n≤ 3)) ∷ plist (flip ( pins {3} (n≤ 3) )) ∷  plist ( pins {3} (n≤ 3)  ∘ₚ  flip ( pins {3} (n≤ 3))) ∷ []
--- t8 =  {!!}
-
-open import logic 
-
-open _∧_
-
-perm1 :  {perm : Permutation 1 1 } {q : Fin 1}  → (perm ⟨$⟩ʳ q ≡ # 0)  ∧ ((perm ⟨$⟩ˡ q ≡ # 0))
-perm1 {p} {q} = ⟪ perm01 _ _ , perm00 _ _ ⟫ where
-   perm01 : (x y : Fin 1) → (p ⟨$⟩ʳ x) ≡  y
-   perm01 x y with p ⟨$⟩ʳ x
-   perm01 zero zero | zero = refl
-   perm00 : (x y : Fin 1) → (p ⟨$⟩ˡ x) ≡  y
-   perm00 x y with p ⟨$⟩ˡ x
-   perm00 zero zero | zero = refl
-
-
-----
---  find insertion point of pins
-----
-p=0 : {n : ℕ }  → (perm : Permutation (suc n) (suc n) ) → ((perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) ⟨$⟩ˡ (# 0)) ≡ # 0
-p=0 {zero} perm with ((perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) ⟨$⟩ˡ (# 0)) 
-... | zero = refl
-p=0 {suc n} perm with perm ⟨$⟩ʳ (# 0) | inspect (_⟨$⟩ʳ_ perm ) (# 0)| toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)) | inspect toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))
-... | zero |  record { eq = e} |  m<n | _ = p001 where
-   p001 : perm ⟨$⟩ˡ ( pins m<n ⟨$⟩ʳ zero) ≡ zero
-   p001 = subst (λ k → perm ⟨$⟩ˡ k ≡ zero ) e (inverseˡ perm)
-... | suc t |  record { eq = e } | m<n | record { eq = e1 }  = p002 where   -- m<n  : suc (toℕ t) ≤ suc n
-   p002 : perm ⟨$⟩ˡ ( pins m<n ⟨$⟩ʳ zero) ≡ zero
-   p002 = p005 zero (toℕ t)  refl m<n refl where   -- suc (toℕ t) ≤ suc n
-      p003 : (s : Fin (suc (suc n))) → s ≡ (perm ⟨$⟩ʳ (# 0)) → perm ⟨$⟩ˡ s  ≡ # 0
-      p003 s eq = subst (λ k → perm ⟨$⟩ˡ k ≡ zero ) (sym eq) (inverseˡ perm)
-      p005 : (x :  Fin (suc (suc n))) → (m : ℕ ) → x ≡ zero → (m≤n : suc m ≤ suc n ) → m ≡ toℕ t → perm ⟨$⟩ˡ ( pins m≤n ⟨$⟩ʳ zero) ≡ zero
-      p005 zero m eq (s≤s m≤n) meq = p004 where
-          p004 :  perm ⟨$⟩ˡ (fromℕ< (s≤s (s≤s m≤n))) ≡ zero
-          p004 = p003  (fromℕ< (s≤s (s≤s m≤n))) (
-             begin
-                fromℕ< (s≤s (s≤s m≤n))
-             ≡⟨  lemma10 {suc (suc n)}  (cong suc meq) {s≤s (s≤s m≤n)} {subst (λ k →  suc k < suc (suc n)) meq (s≤s (s≤s m≤n)) } ⟩
-                fromℕ< (subst (λ k →  suc k < suc (suc n)) meq (s≤s (s≤s m≤n)) )
-             ≡⟨ fromℕ<-toℕ {suc (suc n)} (suc t) (subst (λ k →  suc k < suc (suc n)) meq (s≤s (s≤s m≤n)) ) ⟩
-                suc t
-             ≡⟨ sym e ⟩
-                (perm ⟨$⟩ʳ (# 0))
-             ∎ )
-
-----
---  other elements are preserved in pins
-----
-px=x : {n : ℕ }  → (x : Fin (suc n)) → pins ( toℕ≤pred[n] x ) ⟨$⟩ʳ (# 0) ≡ x
-px=x {n} zero = refl
-px=x {suc n} (suc x) = p001 where
-     p002 : fromℕ< (s≤s (toℕ≤pred[n] x)) ≡ x
-     p002 =  fromℕ<-toℕ x (s≤s (toℕ≤pred[n] x)) 
-     p001 :  (pins (toℕ≤pred[n] (suc x)) ⟨$⟩ʳ (# 0)) ≡ suc x
-     p001 with <-cmp 0 ((toℕ x))
-     ... | tri< a ¬b ¬c = cong suc p002
-     ... | tri≈ ¬a b ¬c = cong suc p002
-
--- pp : {n : ℕ }  → (perm : Permutation (suc n) (suc n) ) →  Fin (suc n)
--- pp  perm → (( perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) ⟨$⟩ˡ (# 0))
-
-plist2 : {n  : ℕ} → Permutation (suc n) (suc n) → (i : ℕ ) → i < suc n → List ℕ
-plist2  {n} perm zero _           = toℕ ( perm ⟨$⟩ʳ (fromℕ< {zero} (s≤s z≤n))) ∷ []
-plist2  {n} perm (suc i) (s≤s lt) = toℕ ( perm ⟨$⟩ʳ (fromℕ< (s≤s lt)))         ∷ plist2 perm  i (<-trans lt a<sa) 
-
-plist0  : {n  : ℕ} → Permutation n n → List ℕ
-plist0 {0} perm = []
-plist0 {suc n} perm = plist2 perm n a<sa
-
-open _=p=_
-
---
--- plist cong
---
-←pleq  : {n  : ℕ} → (x y : Permutation n n ) → x =p= y → plist0 x ≡ plist0 y 
-←pleq {zero} x y eq = refl
-←pleq {suc n} x y eq =  ←pleq1  n a<sa where
-   ←pleq1  :   (i : ℕ ) → (i<sn : i < suc n ) →  plist2 x i i<sn ≡ plist2 y i i<sn
-   ←pleq1  zero _           = cong ( λ k → toℕ k ∷ [] ) ( peq eq (fromℕ< {zero} (s≤s z≤n)))
-   ←pleq1  (suc i) (s≤s lt) = cong₂ ( λ j k → toℕ j ∷ k ) ( peq eq (fromℕ< (s≤s lt)))  ( ←pleq1  i (<-trans lt a<sa) )
-
-headeq : {A : Set } →  {x y : A } → {xt yt : List A } → (x ∷ xt)  ≡ (y ∷ yt)  →  x ≡ y
-headeq refl = refl
-
-taileq : {A : Set } →  {x y : A } → {xt yt : List A } → (x ∷ xt)  ≡ (y ∷ yt)  →  xt ≡ yt
-taileq refl = refl
-
---
--- plist injection / equalizer 
---
---    if plist0 of two perm looks the same, the permutations are the same
---
-pleq  : {n  : ℕ} → (x y : Permutation n n ) → plist0 x ≡ plist0 y → x =p= y
-pleq  {0} x y refl = record { peq = λ q → pleq0 q } where
-  pleq0 : (q : Fin 0 ) → (x ⟨$⟩ʳ q) ≡ (y ⟨$⟩ʳ q)
-  pleq0 ()
-pleq  {suc n} x y eq = record { peq = λ q → pleq1 n a<sa eq q fin<n } where
-  pleq1 : (i : ℕ ) → (i<sn : i < suc n ) →  plist2 x i i<sn ≡ plist2 y i i<sn → (q : Fin (suc n)) → toℕ q < suc i → x ⟨$⟩ʳ q ≡ y ⟨$⟩ʳ q
-  pleq1 zero i<sn eq q q<i with  <-cmp (toℕ q) zero
-  ... | tri< () ¬b ¬c
-  ... | tri> ¬a ¬b c = ⊥-elim (nat-≤> c q<i )
-  ... | tri≈ ¬a b ¬c = begin
-          x ⟨$⟩ʳ q
-       ≡⟨ cong ( λ k → x ⟨$⟩ʳ k ) (toℕ-injective b )⟩
-          x ⟨$⟩ʳ zero
-       ≡⟨ toℕ-injective (headeq eq) ⟩
-          y ⟨$⟩ʳ zero
-       ≡⟨ cong ( λ k → y ⟨$⟩ʳ k ) (sym (toℕ-injective b )) ⟩
-          y ⟨$⟩ʳ q
-       ∎ 
-  pleq1 (suc i) (s≤s i<sn) eq q q<i with <-cmp (toℕ q) (suc i)
-  ... | tri< a ¬b ¬c = pleq1 i (<-trans i<sn a<sa ) (taileq eq) q a
-  ... | tri> ¬a ¬b c = ⊥-elim (nat-≤> c q<i )
-  ... | tri≈ ¬a b ¬c = begin
-            x ⟨$⟩ʳ q
-       ≡⟨ cong (λ k → x ⟨$⟩ʳ k) (pleq3 b) ⟩
-            x ⟨$⟩ʳ (suc (fromℕ< i<sn))
-       ≡⟨ toℕ-injective pleq2  ⟩
-            y ⟨$⟩ʳ (suc (fromℕ< i<sn))
-       ≡⟨ cong (λ k → y ⟨$⟩ʳ k) (sym (pleq3 b)) ⟩
-            y ⟨$⟩ʳ q
-       ∎ where
-          pleq3 : toℕ q ≡ suc i → q ≡ suc (fromℕ< i<sn)
-          pleq3 tq=si = toℕ-injective ( begin
-                  toℕ  q
-               ≡⟨ b ⟩
-                  suc i
-               ≡⟨ sym (toℕ-fromℕ< (s≤s i<sn)) ⟩
-                  toℕ (fromℕ< (s≤s i<sn))
-               ≡⟨⟩
-                  toℕ (suc (fromℕ< i<sn))
-               ∎ ) 
-          pleq2 : toℕ ( x ⟨$⟩ʳ (suc (fromℕ< i<sn)) ) ≡ toℕ ( y ⟨$⟩ʳ (suc (fromℕ< i<sn)) )
-          pleq2 = headeq eq
-
-is-=p= : {n  : ℕ} → (x y : Permutation n n ) → Dec (x =p= y )
-is-=p= {zero} x y = yes record { peq = λ () }
-is-=p= {suc n} x y with ℕL-eq? (plist0 x ) ( plist0 y )
-... | yes t = yes (pleq x y t)
-... | no t = no ( contra-position (←pleq x y) t )
-
-pprep-cong : {n  : ℕ} → {x y : Permutation n n } → x =p= y → pprep x =p= pprep y
-pprep-cong {n} {x} {y} x=y = record { peq = pprep-cong1 } where
-   pprep-cong1 : (q : Fin (suc n)) → (pprep x ⟨$⟩ʳ q) ≡ (pprep y ⟨$⟩ʳ q)
-   pprep-cong1 zero = refl
-   pprep-cong1 (suc q) = begin
-          pprep x ⟨$⟩ʳ suc q
-        ≡⟨⟩
-          suc ( x ⟨$⟩ʳ q )
-        ≡⟨ cong ( λ k → suc k ) ( peq x=y q ) ⟩
-          suc ( y ⟨$⟩ʳ q )
-        ≡⟨⟩
-          pprep y ⟨$⟩ʳ suc q
-        ∎  
-
-pprep-dist : {n  : ℕ} → {x y : Permutation n n } → pprep (x ∘ₚ y) =p= (pprep x ∘ₚ pprep y)
-pprep-dist {n} {x} {y} = record { peq = pprep-dist1 } where
-   pprep-dist1 : (q : Fin (suc n)) → (pprep (x ∘ₚ y) ⟨$⟩ʳ q) ≡ ((pprep x ∘ₚ pprep y) ⟨$⟩ʳ q)
-   pprep-dist1 zero = refl
-   pprep-dist1 (suc q) =  cong ( λ k → suc k ) refl
-
-pswap-cong : {n  : ℕ} → {x y : Permutation n n } → x =p= y → pswap x =p= pswap y
-pswap-cong {n} {x} {y} x=y = record { peq = pswap-cong1 } where
-   pswap-cong1 : (q : Fin (suc (suc n))) → (pswap x ⟨$⟩ʳ q) ≡ (pswap y ⟨$⟩ʳ q)
-   pswap-cong1 zero = refl
-   pswap-cong1 (suc zero) = refl
-   pswap-cong1 (suc (suc q)) = begin
-          pswap x ⟨$⟩ʳ suc (suc q)
-        ≡⟨⟩
-          suc (suc (x ⟨$⟩ʳ q))
-        ≡⟨ cong ( λ k → suc (suc k) ) ( peq x=y q ) ⟩
-          suc (suc (y ⟨$⟩ʳ q))
-        ≡⟨⟩
-          pswap y ⟨$⟩ʳ suc (suc q)
-        ∎  
- 
-pswap-dist : {n  : ℕ} → {x y : Permutation n n } → pprep (pprep (x ∘ₚ y)) =p= (pswap x ∘ₚ pswap y)
-pswap-dist {n} {x} {y} = record { peq = pswap-dist1 } where
-   pswap-dist1 : (q : Fin (suc (suc n))) → ((pprep (pprep (x ∘ₚ y))) ⟨$⟩ʳ q) ≡ ((pswap x ∘ₚ pswap y) ⟨$⟩ʳ q)
-   pswap-dist1 zero = refl
-   pswap-dist1 (suc zero) = refl
-   pswap-dist1 (suc (suc q)) =  cong ( λ k → suc (suc k) ) refl
-
-shlem→ : {n  : ℕ} → (perm : Permutation (suc n) (suc n) ) → (p0=0 : perm ⟨$⟩ˡ (# 0) ≡ # 0 ) → (x : Fin (suc n) ) →  perm ⟨$⟩ˡ x ≡ zero → x ≡ zero
-shlem→ perm p0=0 x px=0 = begin
-          x                                  ≡⟨ sym ( inverseʳ perm ) ⟩
-          perm ⟨$⟩ʳ ( perm ⟨$⟩ˡ x)           ≡⟨ cong (λ k →  perm ⟨$⟩ʳ k ) px=0 ⟩
-          perm ⟨$⟩ʳ zero                     ≡⟨ cong (λ k →  perm ⟨$⟩ʳ k ) (sym p0=0) ⟩
-          perm ⟨$⟩ʳ ( perm ⟨$⟩ˡ zero)        ≡⟨ inverseʳ perm  ⟩
-          zero
-       ∎ 
-
-shlem← : {n  : ℕ} → (perm : Permutation (suc n) (suc n) ) → (p0=0 : perm ⟨$⟩ˡ (# 0) ≡ # 0 ) → (x : Fin (suc n)) → perm ⟨$⟩ʳ x ≡ zero → x ≡ zero
-shlem← perm p0=0 x px=0 =  begin
-          x                                  ≡⟨ sym (inverseˡ perm ) ⟩
-          perm ⟨$⟩ˡ ( perm ⟨$⟩ʳ x )          ≡⟨ cong (λ k →  perm ⟨$⟩ˡ k ) px=0 ⟩
-          perm ⟨$⟩ˡ zero                     ≡⟨ p0=0  ⟩
-          zero
-       ∎ 
-
-sh2 : {n  : ℕ} → (perm : Permutation (suc n) (suc n) ) → (p0=0 : perm ⟨$⟩ˡ (# 0) ≡ # 0 ) → {x : Fin n} → ¬ perm ⟨$⟩ˡ (suc x) ≡ zero
-sh2 perm p0=0 {x} eq with shlem→ perm p0=0 (suc x) eq
-sh2 perm p0=0 {x} eq | ()
-
-sh1 : {n  : ℕ} → (perm : Permutation (suc n) (suc n) ) → (p0=0 : perm ⟨$⟩ˡ (# 0) ≡ # 0 ) → {x : Fin n} → ¬ perm ⟨$⟩ʳ (suc x) ≡ zero
-sh1 perm p0=0 {x} eq with shlem← perm p0=0 (suc x) eq
-sh1 perm p0=0 {x} eq | ()
-
-
--- 0 ∷ 1 ∷ 2 ∷ 3 ∷ [] → 0 ∷ 1 ∷ 2 ∷ [] 
-shrink : {n  : ℕ} → (perm : Permutation (suc n) (suc n) ) → perm ⟨$⟩ˡ (# 0) ≡ # 0 → Permutation n n
-shrink {n} perm p0=0  = permutation p→ p← record { left-inverse-of = piso→ ; right-inverse-of = piso← } where
-
-   p→ : Fin n → Fin n 
-   p→ x with perm ⟨$⟩ʳ (suc x) | inspect (_⟨$⟩ʳ_ perm ) (suc x) 
-   p→ x | zero  | record { eq = e } = ⊥-elim ( sh1 perm p0=0 {x} e )
-   p→ x | suc t | _ = t
-
-   p← : Fin n → Fin n 
-   p← x with perm ⟨$⟩ˡ (suc x) | inspect (_⟨$⟩ˡ_ perm ) (suc x) 
-   p← x | zero  | record { eq = e } = ⊥-elim ( sh2 perm p0=0 {x} e )
-   p← x | suc t | _ = t
-
-   piso← : (x : Fin n ) → p→ ( p← x ) ≡ x
-   piso← x with perm ⟨$⟩ˡ (suc x) | inspect (_⟨$⟩ˡ_ perm ) (suc x) 
-   piso← x | zero  | record { eq = e } = ⊥-elim ( sh2 perm p0=0 {x} e )
-   piso← x | suc t | _ with perm ⟨$⟩ʳ (suc t) | inspect (_⟨$⟩ʳ_ perm ) (suc t)
-   piso← x | suc t | _ | zero |  record { eq = e } =  ⊥-elim ( sh1 perm p0=0 e )
-   piso← x | suc t |  record { eq = e0 } | suc t1 |  record { eq = e1 } = begin
-          t1
-       ≡⟨ plem0 plem1 ⟩
-          x
-       ∎ where
-          open ≡-Reasoning
-          plem0 :  suc t1 ≡ suc x → t1 ≡ x
-          plem0 refl = refl
-          plem1 :  suc t1 ≡ suc x
-          plem1 = begin
-               suc t1
-            ≡⟨ sym e1 ⟩
-               Inverse.to perm Π.⟨$⟩ suc t
-            ≡⟨ cong (λ k →  Inverse.to perm Π.⟨$⟩ k ) (sym e0) ⟩
-               Inverse.to perm Π.⟨$⟩ ( Inverse.from perm Π.⟨$⟩ suc x )
-            ≡⟨ inverseʳ perm   ⟩
-               suc x
-            ∎ 
-
-   piso→ : (x : Fin n ) → p← ( p→ x ) ≡ x
-   piso→ x with perm ⟨$⟩ʳ (suc x) | inspect (_⟨$⟩ʳ_ perm ) (suc x)
-   piso→ x | zero  | record { eq = e } = ⊥-elim ( sh1 perm p0=0 {x} e )
-   piso→ x | suc t | _ with perm ⟨$⟩ˡ (suc t) | inspect (_⟨$⟩ˡ_ perm ) (suc t)
-   piso→ x | suc t | _ | zero |  record { eq = e } =  ⊥-elim ( sh2 perm p0=0 e )
-   piso→ x | suc t |  record { eq = e0 } | suc t1 |  record { eq = e1 } = begin
-          t1
-       ≡⟨ plem2 plem3 ⟩
-          x
-       ∎ where
-          plem2 :  suc t1 ≡ suc x → t1 ≡ x
-          plem2 refl = refl
-          plem3 :  suc t1 ≡ suc x
-          plem3 = begin
-               suc t1
-            ≡⟨ sym e1 ⟩
-               Inverse.from perm Π.⟨$⟩ suc t
-            ≡⟨ cong (λ k →  Inverse.from perm Π.⟨$⟩ k ) (sym e0 ) ⟩
-               Inverse.from perm Π.⟨$⟩ ( Inverse.to perm Π.⟨$⟩ suc x )
-            ≡⟨ inverseˡ perm   ⟩
-               suc x
-            ∎
-
-shrink-iso : { n : ℕ } → {perm : Permutation n n} → shrink (pprep perm)  refl =p=  perm
-shrink-iso {n} {perm} = record { peq = λ q → refl  } 
-
-shrink-iso2 : { n : ℕ } → {perm : Permutation (suc n) (suc n)} 
-   → (p=0 : perm ⟨$⟩ˡ (# 0) ≡ # 0)  → pprep (shrink perm p=0) =p= perm
-shrink-iso2 {n} {perm} p=0 = record { peq =  s001 } where
-    s001 : (q : Fin (suc n)) → (pprep (shrink perm p=0) ⟨$⟩ʳ q) ≡ perm ⟨$⟩ʳ q
-    s001 zero = begin
-         zero
-       ≡⟨ sym ( inverseʳ perm ) ⟩
-         perm ⟨$⟩ʳ ( perm ⟨$⟩ˡ zero )
-       ≡⟨ cong (λ k → perm ⟨$⟩ʳ k ) p=0 ⟩
-         perm ⟨$⟩ʳ zero
-       ∎ 
-    s001 (suc q) with perm ⟨$⟩ʳ (suc q) | inspect (_⟨$⟩ʳ_ perm ) (suc q) 
-    ... | zero | record {eq = e}  = ⊥-elim (sh1 perm p=0 {q} e)
-    ... | suc t | e = refl
-
-
-shrink-cong : { n : ℕ } → {x y : Permutation (suc n) (suc n)}
-    → x =p= y
-    → (x=0 :  x ⟨$⟩ˡ (# 0) ≡ # 0 ) → (y=0 : y ⟨$⟩ˡ (# 0) ≡ # 0 )  → shrink x x=0 =p=  shrink y y=0 
-shrink-cong {n} {x} {y} x=y x=0 y=0  = record  { peq = p002 } where
-    p002 : (q : Fin n) → (shrink x x=0 ⟨$⟩ʳ q) ≡ (shrink y y=0 ⟨$⟩ʳ q)
-    p002 q with x ⟨$⟩ʳ (suc q) | inspect (_⟨$⟩ʳ_ x ) (suc q) | y ⟨$⟩ʳ (suc q) | inspect (_⟨$⟩ʳ_ y ) (suc q)
-    p002 q | zero   | record { eq = ex } | zero   | ey                  = ⊥-elim ( sh1 x x=0 ex )
-    p002 q | zero   | record { eq = ex } | suc py | ey                  = ⊥-elim ( sh1 x x=0 ex )
-    p002 q | suc px | ex                 | zero   | record { eq = ey }  = ⊥-elim ( sh1 y y=0 ey )
-    p002 q | suc px | record { eq = ex } | suc py | record { eq = ey }  = p003 ( begin
-           suc px
-         ≡⟨ sym ex ⟩
-           x ⟨$⟩ʳ (suc q)
-         ≡⟨ peq x=y (suc q) ⟩
-           y ⟨$⟩ʳ (suc q)
-         ≡⟨ ey ⟩
-           suc py
-         ∎ ) where
-        p003 : suc px ≡ suc py → px ≡ py
-        p003 refl = refl
-
-open import FLutil
-
-FL→perm   : {n : ℕ }  → FL n → Permutation n n 
-FL→perm f0 = pid
-FL→perm (x :: fl) = pprep (FL→perm fl)  ∘ₚ pins ( toℕ≤pred[n] x )
-
-t40 =                (# 2) :: ( (# 1) :: (( # 0 ) :: f0 )) 
-t4 =  FL→perm ((# 2) :: t40 )
-
--- t1 = plist (shrink (pid {3}  ∘ₚ (pins (n≤ 1))) refl)
-t2 = plist ((pid {5} ) ∘ₚ transpose (# 2) (# 4)) ∷ plist (pid {5} ∘ₚ reverse )   ∷  []
-t3 = plist (FL→perm t40) -- ∷ plist (pprep (FL→perm t40))
-    -- ∷ plist ( pprep (FL→perm t40) ∘ₚ  pins ( n≤ 0 {3}  ))
-    -- ∷ plist ( pprep (FL→perm t40 )∘ₚ  pins ( n≤ 1 {2}  ))
-    -- ∷ plist ( pprep (FL→perm t40 )∘ₚ  pins ( n≤ 2 {1}  ))
-    -- ∷ plist ( pprep (FL→perm t40 )∘ₚ  pins ( n≤ 3 {0}  ))
-    ∷ plist ( FL→perm ((# 0) :: t40))  --  (0 ∷ 1 ∷ 2 ∷ []) ∷
-    ∷ plist ( FL→perm ((# 1) :: t40))  --  (0 ∷ 2 ∷ 1 ∷ []) ∷
-    ∷ plist ( FL→perm ((# 2) :: t40))  --  (1 ∷ 0 ∷ 2 ∷ []) ∷
-    ∷ plist ( FL→perm ((# 3) :: t40))  --  (2 ∷ 0 ∷ 1 ∷ []) ∷
-    -- ∷ plist ( FL→perm ((# 3) :: ((# 2) :: ( (# 0) :: (( # 0 ) :: f0 )) )))  --  (1 ∷ 2 ∷ 0 ∷ []) ∷
-    -- ∷ plist ( FL→perm ((# 3) :: ((# 2) :: ( (# 1) :: (( # 0 ) :: f0 )) )))  --  (2 ∷ 1 ∷ 0 ∷ []) ∷ 
-    -- ∷ plist ( (flip (FL→perm ((# 3) :: ((# 1) :: ( (# 0) :: (( # 0 ) :: f0 )) )))))
-    -- ∷ plist ( (flip (FL→perm ((# 3) :: ((# 1) :: ( (# 0) :: (( # 0 ) :: f0 )) ))) ∘ₚ (FL→perm ((# 3) :: (((# 1) :: ( (# 0) :: (( # 0 ) :: f0 )) )))) ))
-    ∷ []
-
-
--- FL→plist-iso : {n : ℕ} → (f : FL n ) → plist→FL (FL→plist f ) ≡ f
--- FL→plist-inject : {n : ℕ} → (f g : FL n ) → FL→plist f ≡ FL→plist g → f ≡ g
-
-perm→FL   : {n : ℕ }  → Permutation n n → FL n
-perm→FL {zero} perm = f0
-perm→FL {suc n} perm = (perm ⟨$⟩ʳ (# 0)) :: perm→FL (shrink (perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) (p=0 perm) ) 
-
----FL→perm   : {n : ℕ }  → FL n → Permutation n n 
----FL→perm   x = plist→perm ( FL→plis x)
--- perm→FL   : {n : ℕ }  → Permutation n n → FL n
--- perm→FL p  = plist→FL (plist p)
-
--- pcong-pF : {n : ℕ }  → {x y : Permutation n n}  → x =p= y → perm→FL x ≡ perm→FL y
--- pcong-pF {n} {x} {y} x=y = FL→plist-inject (subst ... (pleq← eq)) (perm→FL x) (perm→FL y)
-
--- FL→iso : {n : ℕ }  → (fl : FL n )  → perm→FL ( FL→perm fl ) ≡ fl
--- FL→iso = 
--- pcong-Fp : {n : ℕ }  → {x y : FL n}  → x ≡ y → FL→perm x =p= FL→perm y
--- FL←iso : {n : ℕ }  → (perm : Permutation n n )  → FL→perm ( perm→FL perm  ) =p= perm
-
-_p<_ : {n : ℕ } ( x y : Permutation n n ) → Set
-x p< y = perm→FL x f<  perm→FL y
-
-pcong-pF : {n : ℕ }  → {x y : Permutation n n}  → x =p= y → perm→FL x ≡ perm→FL y
-pcong-pF {zero} eq = refl
-pcong-pF {suc n} {x} {y} eq = cong₂ (λ j k → j :: k ) ( peq eq (# 0)) (pcong-pF (shrink-cong (presp eq p001 ) (p=0 x) (p=0 y))) where
-    p002 : x ⟨$⟩ʳ (# 0) ≡  y ⟨$⟩ʳ (# 0)
-    p002 = peq eq (# 0)
-    p001 : flip (pins (toℕ≤pred[n] (x ⟨$⟩ʳ (# 0)))) =p=  flip (pins (toℕ≤pred[n] (y ⟨$⟩ʳ (# 0))))
-    p001 = subst ( λ k →  flip (pins (toℕ≤pred[n] (x ⟨$⟩ʳ (# 0)))) =p=  flip (pins (toℕ≤pred[n] k ))) p002 prefl 
-
--- t5 = plist t4 ∷ plist ( t4  ∘ₚ flip (pins ( n≤  3 ) ))
-t5 = plist (t4) ∷ plist (flip t4)
-    ∷ ( toℕ (t4 ⟨$⟩ˡ fromℕ< a<sa) ∷ [] )
-    ∷ ( toℕ (t4 ⟨$⟩ʳ (# 0)) ∷ [] )
-    -- ∷  plist ( t4  ∘ₚ flip (pins ( n≤  1 ) ))
-    ∷  plist (remove (# 0) t4  )
-    ∷  plist ( FL→perm t40 )
-    ∷ []
- 
-t6 = perm→FL t4
-
-FL→iso : {n : ℕ }  → (fl : FL n )  → perm→FL ( FL→perm fl ) ≡ fl
-FL→iso f0 = refl
-FL→iso {suc n} (x :: fl) = cong₂ ( λ j k → j :: k ) f001 f002 where
-    perm = pprep (FL→perm fl)  ∘ₚ pins ( toℕ≤pred[n] x )
-    f001 : perm ⟨$⟩ʳ (# 0) ≡ x
-    f001 = begin
-       (pprep (FL→perm fl)  ∘ₚ pins ( toℕ≤pred[n] x )) ⟨$⟩ʳ (# 0) 
-     ≡⟨⟩
-       pins ( toℕ≤pred[n] x ) ⟨$⟩ʳ (# 0) 
-     ≡⟨ px=x x ⟩
-       x 
-     ∎
-    x=0 :  (perm ∘ₚ flip (pins (toℕ≤pred[n] x))) ⟨$⟩ˡ (# 0) ≡ # 0
-    x=0 = subst ( λ k → (perm ∘ₚ flip (pins (toℕ≤pred[n] k))) ⟨$⟩ˡ (# 0) ≡ # 0 ) f001 (p=0 perm)
-    x=0' : (pprep (FL→perm fl) ∘ₚ pid) ⟨$⟩ˡ (# 0) ≡ # 0
-    x=0' = refl
-    f003 : (q : Fin (suc n)) →
-            ((perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) ⟨$⟩ʳ q) ≡
-            ((perm ∘ₚ flip (pins (toℕ≤pred[n] x))) ⟨$⟩ʳ q)
-    f003 q = cong (λ k → (perm ∘ₚ flip (pins (toℕ≤pred[n] k))) ⟨$⟩ʳ q ) f001 
-    f002 : perm→FL (shrink (perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) (p=0 perm) )  ≡ fl
-    f002 = begin
-        perm→FL (shrink (perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) (p=0 perm) )  
-     ≡⟨ pcong-pF (shrink-cong {n} {perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))} {perm ∘ₚ flip (pins (toℕ≤pred[n] x))} record {peq = f003 }  (p=0 perm)  x=0) ⟩
-        perm→FL (shrink (perm ∘ₚ flip (pins (toℕ≤pred[n] x))) x=0 ) 
-     ≡⟨⟩
-        perm→FL (shrink ((pprep (FL→perm fl)  ∘ₚ pins ( toℕ≤pred[n] x )) ∘ₚ flip (pins (toℕ≤pred[n] x))) x=0 )
-     ≡⟨ pcong-pF (shrink-cong (passoc (pprep (FL→perm fl)) (pins ( toℕ≤pred[n] x )) (flip (pins (toℕ≤pred[n] x))) )  x=0 x=0) ⟩
-        perm→FL (shrink (pprep (FL→perm fl)  ∘ₚ (pins ( toℕ≤pred[n] x ) ∘ₚ flip (pins (toℕ≤pred[n] x)))) x=0 )
-     ≡⟨ pcong-pF (shrink-cong {n} {pprep (FL→perm fl)  ∘ₚ (pins ( toℕ≤pred[n] x ) ∘ₚ flip (pins (toℕ≤pred[n] x)))} {pprep (FL→perm fl)  ∘ₚ pid}
-             ( presp {suc n} {pprep (FL→perm fl) }  {_} {(pins ( toℕ≤pred[n] x ) ∘ₚ flip (pins (toℕ≤pred[n] x)))} {pid} prefl
-             record { peq = λ q → inverseˡ (pins ( toℕ≤pred[n] x )) } )  x=0 x=0') ⟩
-        perm→FL (shrink (pprep (FL→perm fl)  ∘ₚ pid) x=0' )
-     ≡⟨ pcong-pF (shrink-cong {n} {pprep (FL→perm fl)  ∘ₚ pid} {pprep (FL→perm fl)} record {peq = λ q → refl }  x=0' x=0') ⟩ -- prefl won't work
-        perm→FL (shrink (pprep (FL→perm fl)) x=0' )
-     ≡⟨ pcong-pF shrink-iso ⟩
-        perm→FL ( FL→perm fl ) 
-     ≡⟨ FL→iso fl  ⟩
-        fl 
-     ∎ 
-
-pcong-Fp : {n : ℕ }  → {x y : FL n}  → x ≡ y → FL→perm x =p= FL→perm y
-pcong-Fp {n} {x} {x} refl = prefl
-
-FL←iso : {n : ℕ }  → (perm : Permutation n n )  → FL→perm ( perm→FL perm  ) =p= perm
-FL←iso {0} perm = record { peq = λ () }
-FL←iso {suc n} perm = record { peq = λ q → ( begin
-        FL→perm ( perm→FL perm  ) ⟨$⟩ʳ q
-     ≡⟨⟩
-        (pprep (FL→perm (perm→FL (shrink (perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) (p=0 perm) )))  ∘ₚ pins ( toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)) ) ) ⟨$⟩ʳ q
-     ≡⟨  peq (presp {suc n} {_} {_} {pins ( toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)))} (pprep-cong {n} {FL→perm (perm→FL (shrink (perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) (p=0 perm) ))} (FL←iso _ ) ) prefl ) q  ⟩
-         (pprep (shrink (perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) (p=0 perm))   ∘ₚ pins ( toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)) ))  ⟨$⟩ʳ q 
-     ≡⟨ peq (presp {suc n} {pprep (shrink (perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) (p=0 perm))} {perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))} {pins ( toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)) )} (shrink-iso2 (p=0 perm)) prefl) q  ⟩
-         ((perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) ∘ₚ pins ( toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)) ))  ⟨$⟩ʳ q 
-     ≡⟨ peq (presp {suc n} {perm} {_} {flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)))) ∘ₚ pins ( toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)))} {pid} prefl record { peq = λ q → inverseʳ (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)))) }) q  ⟩
-        ( perm ∘ₚ pid ) ⟨$⟩ʳ q
-     ≡⟨⟩
-        perm ⟨$⟩ʳ q
-     ∎  ) } 
-
-FL-inject : {n : ℕ }  → {g h : Permutation n n }  → perm→FL g ≡  perm→FL h → g =p= h
-FL-inject {n} {g} {h} g=h = record { peq = λ q → ( begin
-       g ⟨$⟩ʳ q
-     ≡⟨ peq (psym (FL←iso g )) q ⟩
-        (  FL→perm (perm→FL g) ) ⟨$⟩ʳ q
-     ≡⟨ cong ( λ k → FL→perm  k ⟨$⟩ʳ q  ) g=h  ⟩
-        (  FL→perm (perm→FL h) ) ⟨$⟩ʳ q
-     ≡⟨ peq (FL←iso h) q ⟩
-        h ⟨$⟩ʳ q
-     ∎  ) }
-
-FLpid :  {n : ℕ} → (x : Permutation n n) → perm→FL x ≡ FL0 → FL→perm FL0 =p= pid   → x =p= pid
-FLpid x eq p0id = ptrans pf2 (ptrans pf0 p0id ) where
-   pf2 : x =p= FL→perm (perm→FL x)
-   pf2 = psym (FL←iso x)
-   pf0 : FL→perm (perm→FL x) =p= FL→perm FL0
-   pf0 = pcong-Fp eq
-
-pFL0 : {n : ℕ } → FL0 {n} ≡ perm→FL pid
-pFL0 {zero} = refl
-pFL0 {suc n} = cong (λ k → zero :: k ) pFL0
diff -r a5b3061f15ee -r 6d1619d9f880 Solvable.agda
--- a/Solvable.agda	Tue Dec 15 08:50:32 2020 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,103 +0,0 @@
-open import Level hiding ( suc ; zero )
-open import Algebra
-module Solvable {n m : Level} (G : Group n m ) where
-
-open import Data.Unit
-open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
-open import Function
-open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
-open import Relation.Nullary
-open import Data.Empty
-open import Data.Product
-open import  Relation.Binary.PropositionalEquality hiding ( [_] ; sym )
-
-
-open Group G
-open import Gutil G
-
-[_,_] :  Carrier   → Carrier   → Carrier  
-[ g , h ] = g ⁻¹ ∙ h ⁻¹ ∙ g ∙ h 
-
-data Commutator (P : Carrier → Set (Level.suc n ⊔ m)) : (f : Carrier) → Set (Level.suc n ⊔ m) where
-  comm  : {g h : Carrier} → P g → P h  → Commutator P [ g , h ] 
-  ccong : {f g : Carrier} → f ≈ g → Commutator P f → Commutator P g
-
-deriving : ( i : ℕ ) → Carrier → Set (Level.suc n ⊔ m)
-deriving 0 x = Lift (Level.suc n ⊔ m) ⊤
-deriving (suc i) x = Commutator (deriving i) x 
-
-open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ )
-
-deriving-subst : { i : ℕ } → {x y : Carrier } → x ≈ y → (dx : deriving i x ) → deriving i y 
-deriving-subst {zero} {x} {y} x=y dx = lift tt
-deriving-subst {suc i} {x} {y} x=y dx = ccong x=y dx
-
-record solvable : Set (Level.suc n ⊔ m) where
-  field 
-     dervied-length : ℕ
-     end : (x : Carrier ) → deriving dervied-length x →  x ≈ ε  
-
--- deriving stage is closed on multiplication and inversion
-
-import Relation.Binary.Reasoning.Setoid as EqReasoning
-
-open EqReasoning (Algebra.Group.setoid G)
-
-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 ]  ⁻¹                  
-     ∎ 
-
-deriving-inv : { i : ℕ } → { x  : Carrier } → deriving i x → deriving i ( x ⁻¹ )
-deriving-inv {zero} {x} (lift tt) = lift tt
-deriving-inv {suc i} {_} (comm x x₁ )   = ccong (lemma4 _ _) (comm x₁ x) 
-deriving-inv {suc i} {x} (ccong eq ix ) = ccong (⁻¹-cong eq) ( deriving-inv ix )
-
-idcomtr : (g  : Carrier ) → [ g , ε  ] ≈ ε 
-idcomtr g  = begin
-       (g ⁻¹ ∙ ε  ⁻¹ ∙   g ∙ ε )              ≈⟨ ∙-cong (∙-cong (∙-cong grefl (sym lemma3 )) grefl ) grefl ⟩ 
-       (g ⁻¹ ∙ ε   ∙   g ∙ ε )                ≈⟨ ∙-cong (∙-cong (proj₂ identity _) grefl)  grefl ⟩
-       (g ⁻¹   ∙   g ∙ ε     )                ≈⟨ ∙-cong (proj₁ inverse _ )   grefl ⟩
-       (  ε  ∙ ε     )                        ≈⟨  proj₂ identity _  ⟩
-       ε
-     ∎ 
-
-idcomtl : (g  : Carrier ) → [ ε ,  g ] ≈ ε 
-idcomtl g  = begin
-       (ε ⁻¹ ∙ g  ⁻¹ ∙   ε ∙ g )              ≈⟨ ∙-cong (proj₂ identity _) grefl ⟩ 
-       (ε ⁻¹ ∙ g  ⁻¹ ∙    g )                ≈⟨ ∙-cong (∙-cong (sym lemma3 ) grefl ) grefl ⟩
-       (ε  ∙ g  ⁻¹ ∙    g )                  ≈⟨ ∙-cong (proj₁ identity _) grefl ⟩
-       (g ⁻¹   ∙    g     )                ≈⟨  proj₁ inverse _ ⟩
-       ε
-     ∎ 
-
-deriving-ε : { i : ℕ } → deriving i ε
-deriving-ε {zero} = lift tt
-deriving-ε {suc i} = ccong (idcomtr ε) (comm deriving-ε deriving-ε) 
-
-comm-refl : {f g : Carrier } → f ≈ g  → [ f ,  g ] ≈ ε 
-comm-refl {f} {g} f=g = begin
-       f ⁻¹ ∙ g ⁻¹ ∙   f ∙ g
-     ≈⟨ ∙-cong (∙-cong (∙-cong (⁻¹-cong f=g ) grefl ) f=g ) grefl ⟩
-       g ⁻¹ ∙ g ⁻¹ ∙   g ∙ g
-     ≈⟨ ∙-cong (assoc _ _ _ ) grefl  ⟩
-       g ⁻¹ ∙ (g ⁻¹ ∙   g ) ∙ g
-     ≈⟨ ∙-cong (∙-cong grefl (proj₁ inverse _) ) grefl ⟩
-       g ⁻¹ ∙ ε  ∙ g 
-     ≈⟨ ∙-cong (proj₂ identity _) grefl  ⟩
-       g ⁻¹ ∙  g 
-     ≈⟨  proj₁ inverse _  ⟩
-       ε
-     ∎ 
-
-comm-resp : {g h g1 h1  : Carrier } → g ≈ g1  → h ≈ h1 → [ g , h ] ≈ [ g1 , h1 ] 
-comm-resp {g} {h} {g1} {h1} g=g1 h=h1 =  ∙-cong (∙-cong (∙-cong (⁻¹-cong g=g1 ) (⁻¹-cong h=h1 )) g=g1 ) h=h1
-
diff -r a5b3061f15ee -r 6d1619d9f880 Symmetric.agda
--- a/Symmetric.agda	Tue Dec 15 08:50:32 2020 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,87 +0,0 @@
-module Symmetric where
-
-open import Level hiding ( suc ; zero )
-open import Algebra
-open import Algebra.Structures
-open import Data.Fin hiding ( _<_  ; _≤_ ; _-_ ; _+_ )
-open import Data.Fin.Properties hiding ( <-trans ; ≤-trans ) renaming ( <-cmp to <-fcmp )
-open import Data.Product
-open import Data.Fin.Permutation
-open import Function hiding (id ; flip)
-open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
-open import Function.LeftInverse  using ( _LeftInverseOf_ )
-open import Function.Equality using (Π)
-open import Data.Nat -- using (ℕ; suc; zero; s≤s ; z≤n )
-open import Data.Nat.Properties -- using (<-trans)
-open import Relation.Binary.PropositionalEquality 
-open import Data.List using (List; []; _∷_ ; length ; _++_ ; head ) renaming (reverse to rev )
-open import nat
-
-fid : {p : ℕ } → Fin p → Fin p
-fid x = x
-
--- Data.Fin.Permutation.id
-pid : {p : ℕ } → Permutation p p
-pid = permutation fid fid record { left-inverse-of = λ x → refl ; right-inverse-of = λ x → refl }
-
--- Data.Fin.Permutation.flip
-pinv : {p : ℕ } → Permutation p p → Permutation p p
-pinv {p} P = permutation (_⟨$⟩ˡ_ P) (_⟨$⟩ʳ_ P ) record { left-inverse-of = λ x → inverseʳ P ; right-inverse-of = λ x → inverseˡ P }
-
-record _=p=_ {p : ℕ } ( x y : Permutation p p )  : Set where
-    field
-       peq : ( q : Fin p ) → x ⟨$⟩ʳ q ≡ y ⟨$⟩ʳ q
-
-open _=p=_
-
-prefl : {p : ℕ } { x  : Permutation p p } → x =p= x
-peq (prefl {p} {x}) q = refl
-
-psym : {p : ℕ } { x y : Permutation p p } → x =p= y →  y =p= x
-peq (psym {p} {x} {y}  eq ) q = sym (peq eq q)
-
-ptrans : {p : ℕ } { x y z : Permutation p p } → x =p= y  → y =p= z →  x =p= z
-peq (ptrans {p} {x} {y} x=y y=z ) q = trans (peq x=y q) (peq y=z q)
-
-peqˡ :  {p : ℕ }{ x y : Permutation p p } → x =p= y → (q : Fin p)  →  x ⟨$⟩ˡ q ≡ y ⟨$⟩ˡ q
-peqˡ {p} {x} {y} eq q = begin
-       x ⟨$⟩ˡ q
-   ≡⟨ sym ( inverseˡ y ) ⟩
-       y ⟨$⟩ˡ (y ⟨$⟩ʳ ( x ⟨$⟩ˡ  q ))
-   ≡⟨ cong (λ k → y ⟨$⟩ˡ k ) (sym (peq eq _ )) ⟩
-       y ⟨$⟩ˡ (x ⟨$⟩ʳ ( x ⟨$⟩ˡ  q ))
-   ≡⟨ cong (λ k → y ⟨$⟩ˡ k ) ( inverseʳ x ) ⟩
-       y ⟨$⟩ˡ q
-   ∎ where open ≡-Reasoning
-
-presp : { p : ℕ } {x y u v : Permutation p p } → x =p= y → u =p= v → (x ∘ₚ u) =p= (y ∘ₚ v)
-presp {p} {x} {y} {u} {v} x=y u=v = record { peq = λ q → lemma4 q } where
-   lemma4 : (q : Fin p) → ((x ∘ₚ u) ⟨$⟩ʳ q) ≡ ((y ∘ₚ v) ⟨$⟩ʳ q)
-   lemma4 q = trans (cong (λ k → Inverse.to u Π.⟨$⟩ k) (peq x=y q) ) (peq u=v _ )
-passoc : { p : ℕ } (x y z : Permutation p p) → ((x ∘ₚ y) ∘ₚ z) =p=  (x ∘ₚ (y ∘ₚ z))
-passoc x y z = record { peq = λ q → refl }
-p-inv : { p : ℕ } {i j : Permutation p p} →  i =p= j → (q : Fin p) → pinv i ⟨$⟩ʳ q ≡ pinv j ⟨$⟩ʳ q
-p-inv {p} {i} {j} i=j q = begin
-   i ⟨$⟩ˡ q                      ≡⟨ cong (λ k → i ⟨$⟩ˡ k) (sym (inverseʳ j)  )  ⟩
-   i ⟨$⟩ˡ ( j ⟨$⟩ʳ ( j ⟨$⟩ˡ q )) ≡⟨ cong (λ k  →  i ⟨$⟩ˡ k) (sym (peq i=j _ ))  ⟩
-   i ⟨$⟩ˡ ( i ⟨$⟩ʳ ( j ⟨$⟩ˡ q )) ≡⟨ inverseˡ i  ⟩
-   j ⟨$⟩ˡ q
-   ∎ where open ≡-Reasoning
-
-Symmetric : ℕ → Group  Level.zero Level.zero
-Symmetric p = record {
-      Carrier        = Permutation p p
-    ; _≈_            = _=p=_
-    ; _∙_            = _∘ₚ_
-    ; ε              = pid
-    ; _⁻¹            = pinv
-    ; isGroup = record { isMonoid  = record { isSemigroup = record { isMagma = record {
-       isEquivalence = record {refl = prefl ; trans = ptrans ; sym = psym }
-       ; ∙-cong = presp }
-       ; assoc = passoc }
-       ; identity = ( (λ q → record { peq = λ q → refl } ) , (λ q → record { peq = λ q → refl } ))  }
-       ; inverse   = ( (λ x → record { peq = λ q → inverseʳ x} ) , (λ x → record { peq = λ q → inverseˡ x} ))  
-       ; ⁻¹-cong   = λ i=j → record { peq = λ q → p-inv i=j q }
-      }
-   } 
-
diff -r a5b3061f15ee -r 6d1619d9f880 fin.agda
--- a/fin.agda	Tue Dec 15 08:50:32 2020 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,117 +0,0 @@
-{-# OPTIONS --allow-unsolved-metas #-} 
-
-module fin where
-
-open import Data.Fin hiding (_<_ ; _≤_ )
-open import Data.Fin.Properties hiding ( <-trans )
-open import Data.Nat
-open import logic
-open import nat
-open import Relation.Binary.PropositionalEquality
-
-
--- toℕ<n
-fin<n : {n : ℕ} {f : Fin n} → toℕ f < n
-fin<n {_} {zero} = s≤s z≤n
-fin<n {suc n} {suc f} = s≤s (fin<n {n} {f})
-
--- toℕ≤n
-fin≤n : {n : ℕ} (f : Fin (suc n)) → toℕ f ≤ n
-fin≤n {_} zero = z≤n
-fin≤n {suc n} (suc f) = s≤s (fin≤n {n} f)
-
-pred<n : {n : ℕ} {f : Fin (suc n)} → n > 0  → Data.Nat.pred (toℕ f) < n
-pred<n {suc n} {zero} (s≤s z≤n) = s≤s z≤n
-pred<n {suc n} {suc f} (s≤s z≤n) = fin<n
-
-fin<asa : {n : ℕ} → toℕ (fromℕ< {n} a<sa) ≡ n
-fin<asa = toℕ-fromℕ< nat.a<sa
-
--- fromℕ<-toℕ
-toℕ→from : {n : ℕ} {x : Fin (suc n)} → toℕ x ≡ n → fromℕ n ≡ x
-toℕ→from {0} {zero} refl = refl
-toℕ→from {suc n} {suc x} eq = cong (λ k → suc k ) ( toℕ→from {n} {x} (cong (λ k → Data.Nat.pred k ) eq ))
-
-0≤fmax : {n : ℕ } → (# 0) Data.Fin.≤ fromℕ< {n} a<sa
-0≤fmax  = subst (λ k → 0 ≤ k ) (sym (toℕ-fromℕ< a<sa)) z≤n
-
-0<fmax : {n : ℕ } → (# 0) Data.Fin.< fromℕ< {suc n} a<sa
-0<fmax = subst (λ k → 0 < k ) (sym (toℕ-fromℕ< a<sa)) (s≤s z≤n)
-
--- toℕ-injective
-i=j : {n : ℕ} (i j : Fin n) → toℕ i ≡ toℕ j → i ≡ j
-i=j {suc n} zero zero refl = refl
-i=j {suc n} (suc i) (suc j) eq = cong ( λ k → suc k ) ( i=j i j (cong ( λ k → Data.Nat.pred k ) eq) )
-
--- raise 1
-fin+1 :  { n : ℕ } → Fin n → Fin (suc n)
-fin+1  zero = zero 
-fin+1  (suc x) = suc (fin+1 x)
-
-open import Data.Nat.Properties as NatP  hiding ( _≟_ )
-
-fin+1≤ : { i n : ℕ } → (a : i < n)  → fin+1 (fromℕ< a) ≡ fromℕ< (<-trans a a<sa)
-fin+1≤ {0} {suc i} (s≤s z≤n) = refl
-fin+1≤ {suc n} {suc (suc i)} (s≤s (s≤s a)) = cong (λ k → suc k ) ( fin+1≤ {n} {suc i} (s≤s a) )
-
-fin+1-toℕ : { n : ℕ } → { x : Fin n} → toℕ (fin+1 x) ≡ toℕ x
-fin+1-toℕ {suc n} {zero} = refl
-fin+1-toℕ {suc n} {suc x} = cong (λ k → suc k ) (fin+1-toℕ {n} {x})
-
-open import Relation.Nullary 
-open import Data.Empty
-
-fin-1 :  { n : ℕ } → (x : Fin (suc n)) → ¬ (x ≡ zero )  → Fin n
-fin-1 zero ne = ⊥-elim (ne refl )
-fin-1 {n} (suc x) ne = x 
-
-fin-1-sx : { n : ℕ } → (x : Fin n) →  fin-1 (suc x) (λ ()) ≡ x 
-fin-1-sx zero = refl
-fin-1-sx (suc x) = refl
-
-fin-1-xs : { n : ℕ } → (x : Fin (suc n)) → (ne : ¬ (x ≡ zero ))  → suc (fin-1 x ne ) ≡ x
-fin-1-xs zero ne = ⊥-elim ( ne refl )
-fin-1-xs (suc x) ne = refl
-
--- suc-injective
--- suc-eq : {n : ℕ } {x y : Fin n} → Fin.suc x ≡ Fin.suc y  → x ≡ y
--- suc-eq {n} {x} {y} eq = subst₂ (λ j k → j ≡ k ) {!!} {!!} (cong (λ k → Data.Fin.pred k ) eq )
-
--- this is refl
-lemma3 : {a b : ℕ } → (lt : a < b ) → fromℕ< (s≤s lt) ≡ suc (fromℕ< lt)
-lemma3 (s≤s lt) = refl
-
--- fromℕ<-toℕ 
-lemma12 : {n m : ℕ } → (n<m : n < m ) → (f : Fin m )  → toℕ f ≡ n → f ≡ fromℕ< n<m 
-lemma12 {zero} {suc m} (s≤s z≤n) zero refl = refl
-lemma12 {suc n} {suc m} (s≤s n<m) (suc f) refl =  cong suc ( lemma12 {n} {m} n<m f refl  ) 
-
-open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) 
-open import Data.Fin.Properties
-
--- <-irrelevant
-<-nat=irr : {i j n : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → i<n ≅ j<n  
-<-nat=irr {zero} {zero} {suc n} refl {s≤s z≤n} {s≤s z≤n} = HE.refl
-<-nat=irr {suc i} {suc i} {suc n} refl {s≤s i<n} {s≤s j<n} = HE.cong (λ k → s≤s k ) ( <-nat=irr {i} {i} {n} refl  )
-
-lemma8 : {i j n : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → i<n ≅ j<n  
-lemma8 {zero} {zero} {suc n} refl {s≤s z≤n} {s≤s z≤n} = HE.refl
-lemma8 {suc i} {suc i} {suc n} refl {s≤s i<n} {s≤s j<n} = HE.cong (λ k → s≤s k ) ( lemma8 {i} {i} {n} refl  )
-
--- fromℕ<-irrelevant 
-lemma10 : {n i j  : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n }  → fromℕ< i<n ≡ fromℕ< j<n
-lemma10 {n} refl  = HE.≅-to-≡ (HE.cong (λ k → fromℕ< k ) (lemma8 refl  ))
-
-lemma31 : {a b c : ℕ } → { a<b : a < b } { b<c : b < c } { a<c : a < c } → NatP.<-trans a<b b<c ≡ a<c
-lemma31 {a} {b} {c} {a<b} {b<c} {a<c} = HE.≅-to-≡ (lemma8 refl) 
-
--- toℕ-fromℕ<
-lemma11 : {n m : ℕ } {x : Fin n } → (n<m : n < m ) → toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m)) ≡ toℕ x
-lemma11 {n} {m} {x} n<m  = begin
-              toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m))
-           ≡⟨ toℕ-fromℕ< _ ⟩
-              toℕ x
-           ∎  where
-               open ≡-Reasoning
-
-
diff -r a5b3061f15ee -r 6d1619d9f880 logic.agda
--- a/logic.agda	Tue Dec 15 08:50:32 2020 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,151 +0,0 @@
-module logic where
-
-open import Level
-open import Relation.Nullary
-open import Relation.Binary hiding (_⇔_ )
-open import Data.Empty
-
-
-data Bool : Set where
-    true : Bool
-    false : Bool
-
-record  _∧_  {n m : Level} (A  : Set n) ( B : Set m ) : Set (n ⊔ m) where
-   constructor ⟪_,_⟫
-   field
-      proj1 : A
-      proj2 : B
-
-data  _∨_  {n m : Level} (A  : Set n) ( B : Set m ) : Set (n ⊔ m) where
-   case1 : A → A ∨ B
-   case2 : B → A ∨ B
-
-_⇔_ : {n m : Level } → ( A : Set n ) ( B : Set m )  → Set (n ⊔ m)
-_⇔_ A B =  ( A → B ) ∧ ( B → A )
-
-contra-position : {n m : Level } {A : Set n} {B : Set m} → (A → B) → ¬ B → ¬ A
-contra-position {n} {m} {A} {B}  f ¬b a = ¬b ( f a )
-
-double-neg : {n  : Level } {A : Set n} → A → ¬ ¬ A
-double-neg A notnot = notnot A
-
-double-neg2 : {n  : Level } {A : Set n} → ¬ ¬ ¬ A → ¬ A
-double-neg2 notnot A = notnot ( double-neg A )
-
-de-morgan : {n  : Level } {A B : Set n} →  A ∧ B  → ¬ ( (¬ A ) ∨ (¬ B ) )
-de-morgan {n} {A} {B} and (case1 ¬A) = ⊥-elim ( ¬A ( _∧_.proj1 and ))
-de-morgan {n} {A} {B} and (case2 ¬B) = ⊥-elim ( ¬B ( _∧_.proj2 and ))
-
-dont-or :　{n m : Level} {A  : Set n} { B : Set m } →  A ∨ B → ¬ A → B
-dont-or {A} {B} (case1 a) ¬A = ⊥-elim ( ¬A a )
-dont-or {A} {B} (case2 b) ¬A = b
-
-dont-orb :　{n m : Level} {A  : Set n} { B : Set m } →  A ∨ B → ¬ B → A
-dont-orb {A} {B} (case2 b) ¬B = ⊥-elim ( ¬B b )
-dont-orb {A} {B} (case1 a) ¬B = a
-
-
-infixr  130 _∧_
-infixr  140 _∨_
-infixr  150 _⇔_
-
-_/\_ : Bool → Bool → Bool 
-true /\ true = true
-_ /\ _ = false
-
-_\/_ : Bool → Bool → Bool 
-false \/ false = false
-_ \/ _ = true
-
-not_ : Bool → Bool 
-not true = false
-not false = true 
-
-_<=>_ : Bool → Bool → Bool  
-true <=> true = true
-false <=> false = true
-_ <=> _ = false
-
-infixr  130 _\/_
-infixr  140 _/\_
-
-open import Relation.Binary.PropositionalEquality
-
-≡-Bool-func : {A B : Bool } → ( A ≡ true → B ≡ true ) → ( B ≡ true → A ≡ true ) → A ≡ B
-≡-Bool-func {true} {true} a→b b→a = refl
-≡-Bool-func {false} {true} a→b b→a with b→a refl
-... | ()
-≡-Bool-func {true} {false} a→b b→a with a→b refl
-... | ()
-≡-Bool-func {false} {false} a→b b→a = refl
-
-bool-≡-? : (a b : Bool) → Dec ( a ≡ b )
-bool-≡-? true true = yes refl
-bool-≡-? true false = no (λ ())
-bool-≡-? false true = no (λ ())
-bool-≡-? false false = yes refl
-
-¬-bool-t : {a : Bool} →  ¬ ( a ≡ true ) → a ≡ false
-¬-bool-t {true} ne = ⊥-elim ( ne refl )
-¬-bool-t {false} ne = refl
-
-¬-bool-f : {a : Bool} →  ¬ ( a ≡ false ) → a ≡ true
-¬-bool-f {true} ne = refl
-¬-bool-f {false} ne = ⊥-elim ( ne refl )
-
-¬-bool : {a : Bool} →  a ≡ false  → a ≡ true → ⊥
-¬-bool refl ()
-
-lemma-∧-0 : {a b : Bool} → a /\ b ≡ true → a ≡ false → ⊥
-lemma-∧-0 {true} {true} refl ()
-lemma-∧-0 {true} {false} ()
-lemma-∧-0 {false} {true} ()
-lemma-∧-0 {false} {false} ()
-
-lemma-∧-1 : {a b : Bool} → a /\ b ≡ true → b ≡ false → ⊥
-lemma-∧-1 {true} {true} refl ()
-lemma-∧-1 {true} {false} ()
-lemma-∧-1 {false} {true} ()
-lemma-∧-1 {false} {false} ()
-
-bool-and-tt : {a b : Bool} → a ≡ true → b ≡ true → ( a /\ b ) ≡ true
-bool-and-tt refl refl = refl
-
-bool-∧→tt-0 : {a b : Bool} → ( a /\ b ) ≡ true → a ≡ true 
-bool-∧→tt-0 {true} {true} refl = refl
-bool-∧→tt-0 {false} {_} ()
-
-bool-∧→tt-1 : {a b : Bool} → ( a /\ b ) ≡ true → b ≡ true 
-bool-∧→tt-1 {true} {true} refl = refl
-bool-∧→tt-1 {true} {false} ()
-bool-∧→tt-1 {false} {false} ()
-
-bool-or-1 : {a b : Bool} → a ≡ false → ( a \/ b ) ≡ b 
-bool-or-1 {false} {true} refl = refl
-bool-or-1 {false} {false} refl = refl
-bool-or-2 : {a b : Bool} → b ≡ false → (a \/ b ) ≡ a 
-bool-or-2 {true} {false} refl = refl
-bool-or-2 {false} {false} refl = refl
-
-bool-or-3 : {a : Bool} → ( a \/ true ) ≡ true 
-bool-or-3 {true} = refl
-bool-or-3 {false} = refl
-
-bool-or-31 : {a b : Bool} → b ≡ true  → ( a \/ b ) ≡ true 
-bool-or-31 {true} {true} refl = refl
-bool-or-31 {false} {true} refl = refl
-
-bool-or-4 : {a : Bool} → ( true \/ a ) ≡ true 
-bool-or-4 {true} = refl
-bool-or-4 {false} = refl
-
-bool-or-41 : {a b : Bool} → a ≡ true  → ( a \/ b ) ≡ true 
-bool-or-41 {true} {b} refl = refl
-
-bool-and-1 : {a b : Bool} →  a ≡ false → (a /\ b ) ≡ false
-bool-and-1 {false} {b} refl = refl
-bool-and-2 : {a b : Bool} →  b ≡ false → (a /\ b ) ≡ false
-bool-and-2 {true} {false} refl = refl
-bool-and-2 {false} {false} refl = refl
-
-
diff -r a5b3061f15ee -r 6d1619d9f880 nat.agda
--- a/nat.agda	Tue Dec 15 08:50:32 2020 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,340 +0,0 @@
-{-# OPTIONS --allow-unsolved-metas #-}
-module nat where
-
-open import Data.Nat 
-open import Data.Nat.Properties
-open import Data.Empty
-open import Relation.Nullary
-open import  Relation.Binary.PropositionalEquality
-open import  Relation.Binary.Core
-open import Relation.Binary.Definitions
-open import  logic
-
-
-nat-<> : { x y : ℕ } → x < y → y < x → ⊥
-nat-<>  (s≤s x<y) (s≤s y<x) = nat-<> x<y y<x
-
-nat-≤> : { x y : ℕ } → x ≤ y → y < x → ⊥
-nat-≤>  (s≤s x<y) (s≤s y<x) = nat-≤> x<y y<x
-
-nat-<≡ : { x : ℕ } → x < x → ⊥
-nat-<≡  (s≤s lt) = nat-<≡ lt
-
-nat-≡< : { x y : ℕ } → x ≡ y → x < y → ⊥
-nat-≡< refl lt = nat-<≡ lt
-
-¬a≤a : {la : ℕ} → suc la ≤ la → ⊥
-¬a≤a  (s≤s lt) = ¬a≤a  lt
-
-a<sa : {la : ℕ} → la < suc la 
-a<sa {zero} = s≤s z≤n
-a<sa {suc la} = s≤s a<sa 
-
-refl-≤s : {x : ℕ } → x ≤ suc x
-refl-≤s {zero} = z≤n
-refl-≤s {suc x} = s≤s (refl-≤s {x})
-
-a≤sa : {x : ℕ } → x ≤ suc x
-a≤sa {zero} = z≤n
-a≤sa {suc x} = s≤s (a≤sa {x})
-
-=→¬< : {x : ℕ  } → ¬ ( x < x )
-=→¬< {zero} ()
-=→¬< {suc x} (s≤s lt) = =→¬< lt
-
->→¬< : {x y : ℕ  } → (x < y ) → ¬ ( y < x )
->→¬< (s≤s x<y) (s≤s y<x) = >→¬< x<y y<x
-
-<-∨ : { x y : ℕ } → x < suc y → ( (x ≡ y ) ∨ (x < y) )
-<-∨ {zero} {zero} (s≤s z≤n) = case1 refl
-<-∨ {zero} {suc y} (s≤s lt) = case2 (s≤s z≤n)
-<-∨ {suc x} {zero} (s≤s ())
-<-∨ {suc x} {suc y} (s≤s lt) with <-∨ {x} {y} lt
-<-∨ {suc x} {suc y} (s≤s lt) | case1 eq = case1 (cong (λ k → suc k ) eq)
-<-∨ {suc x} {suc y} (s≤s lt) | case2 lt1 = case2 (s≤s lt1)
-
-n≤n : (n : ℕ) →  n Data.Nat.≤ n
-n≤n zero = z≤n
-n≤n (suc n) = s≤s (n≤n n)
-
-<→m≤n : {m n : ℕ} → m  < n →  m Data.Nat.≤ n
-<→m≤n {zero} lt = z≤n
-<→m≤n {suc m} {zero} ()
-<→m≤n {suc m} {suc n} (s≤s lt) = s≤s (<→m≤n lt)
-
-max : (x y : ℕ) → ℕ
-max zero zero = zero
-max zero (suc x) = (suc x)
-max (suc x) zero = (suc x)
-max (suc x) (suc y) = suc ( max x y )
-
--- _*_ : ℕ → ℕ → ℕ
--- _*_ zero _ = zero
--- _*_ (suc n) m = m + ( n * m )
-
-exp : ℕ → ℕ → ℕ
-exp _ zero = 1
-exp n (suc m) = n * ( exp n m )
-
-minus : (a b : ℕ ) →  ℕ
-minus a zero = a
-minus zero (suc b) = zero
-minus (suc a) (suc b) = minus a b
-
-_-_ = minus
-
-m+= : {i j  m : ℕ } → m + i ≡ m + j → i ≡ j
-m+= {i} {j} {zero} refl = refl
-m+= {i} {j} {suc m} eq = m+= {i} {j} {m} ( cong (λ k → pred k ) eq )
-
-+m= : {i j  m : ℕ } → i + m ≡ j + m → i ≡ j
-+m= {i} {j} {m} eq = m+= ( subst₂ (λ j k → j ≡ k ) (+-comm i _ ) (+-comm j _ ) eq )
-
-less-1 :  { n m : ℕ } → suc n < m → n < m
-less-1 {zero} {suc (suc _)} (s≤s (s≤s z≤n)) = s≤s z≤n
-less-1 {suc n} {suc m} (s≤s lt) = s≤s (less-1 {n} {m} lt)
-
-sa=b→a<b :  { n m : ℕ } → suc n ≡ m → n < m
-sa=b→a<b {0} {suc zero} refl = s≤s z≤n
-sa=b→a<b {suc n} {suc (suc n)} refl = s≤s (sa=b→a<b refl)
-
-minus+n : {x y : ℕ } → suc x > y  → minus x y + y ≡ x
-minus+n {x} {zero} _ = trans (sym (+-comm zero  _ )) refl
-minus+n {zero} {suc y} (s≤s ())
-minus+n {suc x} {suc y} (s≤s lt) = begin
-           minus (suc x) (suc y) + suc y
-        ≡⟨ +-comm _ (suc y)    ⟩
-           suc y + minus x y 
-        ≡⟨ cong ( λ k → suc k ) (
-           begin
-                 y + minus x y 
-              ≡⟨ +-comm y  _ ⟩
-                 minus x y + y
-              ≡⟨ minus+n {x} {y} lt ⟩
-                 x 
-           ∎  
-           ) ⟩
-           suc x
-        ∎  where open ≡-Reasoning
-
-sn-m=sn-m : {m n : ℕ } →  m ≤ n → suc n - m ≡ suc ( n - m )
-sn-m=sn-m {0} {n} z≤n = refl
-sn-m=sn-m {suc m} {suc n} (s≤s m<n) = sn-m=sn-m m<n
-
-si-sn=i-n : {i n : ℕ } → n < i  → suc (i - suc n) ≡ (i - n)
-si-sn=i-n {i} {n} n<i = begin
-   suc (i - suc n) ≡⟨ sym (sn-m=sn-m n<i )  ⟩
-   suc i - suc n ≡⟨⟩
-   i - n
-   ∎  where
-      open ≡-Reasoning
-
-n-m<n : (n m : ℕ ) →  n - m ≤ n
-n-m<n zero zero = z≤n
-n-m<n (suc n) zero = s≤s (n-m<n n zero)
-n-m<n zero (suc m) = z≤n
-n-m<n (suc n) (suc m) = ≤-trans (n-m<n n m ) refl-≤s
-
-n-n-m=m : {m n : ℕ } → m ≤ n  → m ≡ (n - (n - m))
-n-n-m=m {0} {zero} z≤n = refl
-n-n-m=m {0} {suc n} z≤n = n-n-m=m {0} {n} z≤n
-n-n-m=m {suc m} {suc n} (s≤s m≤n) = sym ( begin
-   suc n - ( n - m )    ≡⟨ sn-m=sn-m (n-m<n  n m) ⟩
-   suc (n - ( n - m ))  ≡⟨ cong (λ k → suc k ) (sym (n-n-m=m m≤n)) ⟩
-   suc m
-   ∎  ) where
-      open ≡-Reasoning
-
-0<s : {x : ℕ } → zero < suc x
-0<s {_} = s≤s z≤n 
-
-<-minus-0 : {x y z : ℕ } → z + x < z + y → x < y
-<-minus-0 {x} {suc _} {zero} lt = lt
-<-minus-0 {x} {y} {suc z} (s≤s lt) = <-minus-0 {x} {y} {z} lt
-
-<-minus : {x y z : ℕ } → x + z < y + z → x < y
-<-minus {x} {y} {z} lt = <-minus-0 ( subst₂ ( λ j k → j < k ) (+-comm x _) (+-comm y _ ) lt )
-
-x≤x+y : {z y : ℕ } → z ≤ z + y
-x≤x+y {zero} {y} = z≤n
-x≤x+y {suc z} {y} = s≤s  (x≤x+y {z} {y})
-
-<-plus : {x y z : ℕ } → x < y → x + z < y + z 
-<-plus {zero} {suc y} {z} (s≤s z≤n) = s≤s (subst (λ k → z ≤ k ) (+-comm z _ ) x≤x+y  )
-<-plus {suc x} {suc y} {z} (s≤s lt) = s≤s (<-plus {x} {y} {z} lt)
-
-<-plus-0 : {x y z : ℕ } → x < y → z + x < z + y 
-<-plus-0 {x} {y} {z} lt = subst₂ (λ j k → j < k ) (+-comm _ z) (+-comm _ z) ( <-plus {x} {y} {z} lt )
-
-≤-plus : {x y z : ℕ } → x ≤ y → x + z ≤ y + z
-≤-plus {0} {y} {zero} z≤n = z≤n
-≤-plus {0} {y} {suc z} z≤n = subst (λ k → z < k ) (+-comm _ y ) x≤x+y 
-≤-plus {suc x} {suc y} {z} (s≤s lt) = s≤s ( ≤-plus {x} {y} {z} lt )
-
-≤-plus-0 : {x y z : ℕ } → x ≤ y → z + x ≤ z + y 
-≤-plus-0 {x} {y} {zero} lt = lt
-≤-plus-0 {x} {y} {suc z} lt = s≤s ( ≤-plus-0 {x} {y} {z} lt )
-
-x+y<z→x<z : {x y z : ℕ } → x + y < z → x < z 
-x+y<z→x<z {zero} {y} {suc z} (s≤s lt1) = s≤s z≤n
-x+y<z→x<z {suc x} {y} {suc z} (s≤s lt1) = s≤s ( x+y<z→x<z {x} {y} {z} lt1 )
-
-*≤ : {x y z : ℕ } → x ≤ y → x * z ≤ y * z 
-*≤ lt = *-mono-≤ lt ≤-refl
-
-*< : {x y z : ℕ } → x < y → x * suc z < y * suc z 
-*< {zero} {suc y} lt = s≤s z≤n
-*< {suc x} {suc y} (s≤s lt) = <-plus-0 (*< lt)
-
-<to<s : {x y  : ℕ } → x < y → x < suc y
-<to<s {zero} {suc y} (s≤s lt) = s≤s z≤n
-<to<s {suc x} {suc y} (s≤s lt) = s≤s (<to<s {x} {y} lt)
-
-<tos<s : {x y  : ℕ } → x < y → suc x < suc y
-<tos<s {zero} {suc y} (s≤s z≤n) = s≤s (s≤s z≤n)
-<tos<s {suc x} {suc y} (s≤s lt) = s≤s (<tos<s {x} {y} lt)
-
-≤to< : {x y  : ℕ } → x < y → x ≤ y 
-≤to< {zero} {suc y} (s≤s z≤n) = z≤n
-≤to< {suc x} {suc y} (s≤s lt) = s≤s (≤to< {x} {y}  lt)
-
-x<y→≤ : {x y : ℕ } → x < y →  x ≤ suc y
-x<y→≤ {zero} {.(suc _)} (s≤s z≤n) = z≤n
-x<y→≤ {suc x} {suc y} (s≤s lt) = s≤s (x<y→≤ {x} {y} lt)
-
-open import Data.Product
-
-minus<=0 : {x y : ℕ } → x ≤ y → minus x y ≡ 0
-minus<=0 {0} {zero} z≤n = refl
-minus<=0 {0} {suc y} z≤n = refl
-minus<=0 {suc x} {suc y} (s≤s le) = minus<=0 {x} {y} le
-
-minus>0 : {x y : ℕ } → x < y → 0 < minus y x 
-minus>0 {zero} {suc _} (s≤s z≤n) = s≤s z≤n
-minus>0 {suc x} {suc y} (s≤s lt) = minus>0 {x} {y} lt
-
-distr-minus-* : {x y z : ℕ } → (minus x y) * z ≡ minus (x * z) (y * z) 
-distr-minus-* {x} {zero} {z} = refl
-distr-minus-* {x} {suc y} {z} with <-cmp x y
-distr-minus-* {x} {suc y} {z} | tri< a ¬b ¬c = begin
-          minus x (suc y) * z
-        ≡⟨ cong (λ k → k * z ) (minus<=0 {x} {suc y} (x<y→≤ a)) ⟩
-           0 * z 
-        ≡⟨ sym (minus<=0 {x * z} {z + y * z} le ) ⟩
-          minus (x * z) (z + y * z) 
-        ∎  where
-            open ≡-Reasoning
-            le : x * z ≤ z + y * z
-            le  = ≤-trans lemma (subst (λ k → y * z ≤ k ) (+-comm _ z ) (x≤x+y {y * z} {z} ) ) where
-               lemma : x * z ≤ y * z
-               lemma = *≤ {x} {y} {z} (≤to< a)
-distr-minus-* {x} {suc y} {z} | tri≈ ¬a refl ¬c = begin
-          minus x (suc y) * z
-        ≡⟨ cong (λ k → k * z ) (minus<=0 {x} {suc y} refl-≤s ) ⟩
-           0 * z 
-        ≡⟨ sym (minus<=0 {x * z} {z + y * z} (lt {x} {z} )) ⟩
-          minus (x * z) (z + y * z) 
-        ∎  where
-            open ≡-Reasoning
-            lt : {x z : ℕ } →  x * z ≤ z + x * z
-            lt {zero} {zero} = z≤n
-            lt {suc x} {zero} = lt {x} {zero}
-            lt {x} {suc z} = ≤-trans lemma refl-≤s where
-               lemma : x * suc z ≤   z + x * suc z
-               lemma = subst (λ k → x * suc z ≤ k ) (+-comm _ z) (x≤x+y {x * suc z} {z}) 
-distr-minus-* {x} {suc y} {z} | tri> ¬a ¬b c = +m= {_} {_} {suc y * z} ( begin
-           minus x (suc y) * z + suc y * z
-        ≡⟨ sym (proj₂ *-distrib-+ z  (minus x (suc y) )  _) ⟩
-           ( minus x (suc y) + suc y ) * z
-        ≡⟨ cong (λ k → k * z) (minus+n {x} {suc y} (s≤s c))  ⟩
-           x * z 
-        ≡⟨ sym (minus+n {x * z} {suc y * z} (s≤s (lt c))) ⟩
-           minus (x * z) (suc y * z) + suc y * z
-        ∎ ) where
-            open ≡-Reasoning
-            lt : {x y z : ℕ } → suc y ≤ x → z + y * z ≤ x * z
-            lt {x} {y} {z} le = *≤ le 
-
-minus- : {x y z : ℕ } → suc x > z + y → minus (minus x y) z ≡ minus x (y + z)
-minus- {x} {y} {z} gt = +m= {_} {_} {z} ( begin
-           minus (minus x y) z + z
-        ≡⟨ minus+n {_} {z} lemma ⟩
-           minus x y
-        ≡⟨ +m= {_} {_} {y} ( begin
-              minus x y + y 
-           ≡⟨ minus+n {_} {y} lemma1 ⟩
-              x
-           ≡⟨ sym ( minus+n {_} {z + y} gt ) ⟩
-              minus x (z + y) + (z + y)
-           ≡⟨ sym ( +-assoc (minus x (z + y)) _  _ ) ⟩
-              minus x (z + y) + z + y
-           ∎ ) ⟩
-           minus x (z + y) + z
-        ≡⟨ cong (λ k → minus x k + z ) (+-comm _ y )  ⟩
-           minus x (y + z) + z
-        ∎  ) where
-             open ≡-Reasoning
-             lemma1 : suc x > y
-             lemma1 = x+y<z→x<z (subst (λ k → k < suc x ) (+-comm z _ ) gt )
-             lemma : suc (minus x y) > z
-             lemma = <-minus {_} {_} {y} ( subst ( λ x → z + y < suc x ) (sym (minus+n {x} {y}  lemma1 ))  gt )
-
-minus-* : {M k n : ℕ } → n < k  → minus k (suc n) * M ≡ minus (minus k n * M ) M
-minus-* {zero} {k} {n} lt = begin
-           minus k (suc n) * zero
-        ≡⟨ *-comm (minus k (suc n)) zero ⟩
-           zero * minus k (suc n) 
-        ≡⟨⟩
-           0 * minus k n 
-        ≡⟨ *-comm 0 (minus k n) ⟩
-           minus (minus k n * 0 ) 0
-        ∎  where
-        open ≡-Reasoning
-minus-* {suc m} {k} {n} lt with <-cmp k 1
-minus-* {suc m} {.0} {zero} lt | tri< (s≤s z≤n) ¬b ¬c = refl
-minus-* {suc m} {.0} {suc n} lt | tri< (s≤s z≤n) ¬b ¬c = refl
-minus-* {suc zero} {.1} {zero} lt | tri≈ ¬a refl ¬c = refl
-minus-* {suc (suc m)} {.1} {zero} lt | tri≈ ¬a refl ¬c = minus-* {suc m} {1} {zero} lt 
-minus-* {suc m} {.1} {suc n} (s≤s ()) | tri≈ ¬a refl ¬c
-minus-* {suc m} {k} {n} lt | tri> ¬a ¬b c = begin
-           minus k (suc n) * M
-        ≡⟨ distr-minus-* {k} {suc n} {M}  ⟩
-           minus (k * M ) ((suc n) * M)
-        ≡⟨⟩
-           minus (k * M ) (M + n * M  )
-        ≡⟨ cong (λ x → minus (k * M) x) (+-comm M _ ) ⟩
-           minus (k * M ) ((n * M) + M )
-        ≡⟨ sym ( minus- {k * M} {n * M} (lemma lt) ) ⟩
-           minus (minus (k * M ) (n * M)) M
-        ≡⟨ cong (λ x → minus x M ) ( sym ( distr-minus-* {k} {n} )) ⟩
-           minus (minus k n * M ) M
-        ∎  where
-             M = suc m
-             lemma : {n k m : ℕ } → n < k  → suc (k * suc m) > suc m + n * suc m
-             lemma {zero} {suc k} {m} (s≤s lt) = s≤s (s≤s (subst (λ x → x ≤ m + k * suc m) (+-comm 0 _ ) x≤x+y ))
-             lemma {suc n} {suc k} {m} lt = begin
-                         suc (suc m + suc n * suc m) 
-                      ≡⟨⟩
-                         suc ( suc (suc n) * suc m)
-                      ≤⟨ ≤-plus-0 {_} {_} {1} (*≤ lt ) ⟩
-                         suc (suc k * suc m)
-                      ∎   where open ≤-Reasoning
-             open ≡-Reasoning
-
-open import Data.List
-
-ℕL-inject : {h h1 : ℕ } {x y : List ℕ } → h ∷ x ≡ h1 ∷ y → h ≡ h1
-ℕL-inject refl = refl
-
-ℕL-inject-t : {h h1 : ℕ } {x y : List ℕ } → h ∷ x ≡ h1 ∷ y → x ≡ y
-ℕL-inject-t refl = refl
-
-ℕL-eq? : (x y : List ℕ ) → Dec (x ≡ y )
-ℕL-eq? [] [] = yes refl
-ℕL-eq? [] (x ∷ y) = no (λ ())
-ℕL-eq? (x ∷ x₁) [] = no (λ ())
-ℕL-eq? (h ∷ x) (h1 ∷ y) with h ≟ h1 | ℕL-eq? x y
-... | yes y1 | yes y2 = yes ( cong₂ (λ j k → j ∷ k ) y1 y2 )
-... | yes y1 | no n = no (λ e → n (ℕL-inject-t e))
-... | no n  | t = no (λ e → n (ℕL-inject e)) 
-
diff -r a5b3061f15ee -r 6d1619d9f880 src/FLComm.agda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/FLComm.agda	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,174 @@
+{-# OPTIONS --allow-unsolved-metas #-}
+open import Data.Nat -- using (ℕ; suc; zero; s≤s ; z≤n )
+module FLComm (n : ℕ) where
+
+open import Level renaming ( suc to Suc ; zero to Zero ) hiding (lift)
+open import Data.Fin hiding ( _<_  ; _≤_ ; _-_ ; _+_ ; _≟_)
+open import Data.Fin.Properties hiding ( <-trans ; ≤-refl ; ≤-trans ; ≤-irrelevant ; _≟_ ) renaming ( <-cmp to <-fcmp )
+open import Data.Fin.Permutation  
+open import Data.Nat.Properties 
+open import Relation.Binary.PropositionalEquality hiding ( [_] ) renaming ( sym to ≡-sym )
+open import Data.List using (List; []; _∷_ ; length ; _++_ ; tail ) renaming (reverse to rev )
+open import Data.Product hiding (_,_ )
+open import Relation.Nullary 
+open import Data.Unit hiding (_≤_)
+open import Data.Empty
+open import  Relation.Binary.Core 
+open import  Relation.Binary.Definitions hiding (Symmetric )
+open import logic
+open import nat
+
+open import FLutil
+open import Putil
+import Solvable 
+open import Symmetric
+
+-- infixr  100 _::_
+
+open import Relation.Nary using (⌊_⌋)
+open import Data.List.Fresh hiding ([_])
+open import Data.List.Fresh.Relation.Unary.Any
+
+open import Algebra 
+open Group (Symmetric n) hiding (refl)
+open Solvable (Symmetric n) 
+open _∧_
+-- open import Relation.Nary using (⌊_⌋)
+open import Relation.Nullary.Decidable hiding (⌊_⌋)
+
+open import fin
+
+-- all cobmbination in P and Q (could be more general)
+record AnyComm {n m l : ℕ}  (P : FList n) (Q : FList m) (fpq : (p : FL n) (q : FL m) → FL l) : Set where
+   field
+     commList : FList l
+     commAny : (p : FL n) (q : FL m)
+         → Any ( p ≡_ ) P →  Any ( q ≡_ ) Q
+         → Any (fpq p q ≡_) commList
+
+-------------
+--    (p,q)   (p,qn) ....           (p,q0)
+--    pn,q       
+--     :        AnyComm FL0 FL0 P  Q
+--    p0,q       
+
+open AnyComm 
+anyComm : {n m l : ℕ } → (P : FList n) (Q : FList m) → (fpq : (p : FL n) (q : FL m) → FL l)  → AnyComm P Q fpq
+anyComm [] [] _ = record { commList = [] ; commAny = λ _ _ () }
+anyComm [] (cons q Q qr) _ = record { commList = [] ; commAny = λ _ _ () }
+anyComm (cons p P pr) [] _ = record { commList = [] ; commAny = λ _ _ _ () }
+anyComm {n} {m} {l} (cons p P pr) (cons q Q qr) fpq = record { commList = FLinsert (fpq p q) (commListQ Q)  ; commAny = anyc0n } where 
+  commListP : (P1 : FList n) → FList l
+  commListP [] = commList (anyComm P Q fpq)
+  commListP (cons p₁ P1 x) =  FLinsert (fpq p₁ q) (commListP P1)
+  commListQ : (Q1 : FList m) → FList l
+  commListQ [] = commListP P
+  commListQ (cons q₁ Q1 qr₁) = FLinsert (fpq p q₁) (commListQ Q1)
+  anyc0n : (p₁ : FL n) (q₁ : FL m) → Any (_≡_ p₁) (cons p P pr) → Any (_≡_ q₁) (cons q Q qr)
+    → Any (_≡_ (fpq p₁ q₁)) (FLinsert (fpq p q) (commListQ Q))
+  anyc0n p₁ q₁ (here refl) (here refl) = x∈FLins _ (commListQ Q )
+  anyc0n p₁ q₁ (here refl) (there anyq) = insAny (commListQ Q) (anyc01 Q anyq) where 
+     anyc01 : (Q1 : FList m) → Any (_≡_ q₁) Q1 → Any (_≡_ (fpq p₁ q₁)) (commListQ Q1)
+     anyc01 (cons q Q1 qr₂) (here refl) = x∈FLins _ _
+     anyc01 (cons q₂ Q1 qr₂) (there any) = insAny _ (anyc01 Q1 any)
+  anyc0n p₁ q₁ (there anyp) (here refl) = insAny _ (anyc02 Q) where
+     anyc03 : (P1 : FList n) → Any (_≡_ p₁) P1  → Any (_≡_ (fpq p₁ q₁)) (commListP P1)
+     anyc03 (cons a P1 x) (here refl) = x∈FLins _ _ 
+     anyc03 (cons a P1 x) (there any) = insAny _ ( anyc03 P1 any) 
+     anyc02 : (Q1 : FList m) → Any (_≡_ (fpq p₁ q₁)) (commListQ Q1)
+     anyc02 [] = anyc03 P anyp
+     anyc02 (cons a Q1 x) = insAny _ (anyc02 Q1)
+  anyc0n p₁ q₁ (there anyp) (there anyq) = insAny (commListQ Q) (anyc04 Q) where
+     anyc05 : (P1 : FList n) → Any (_≡_ (fpq p₁ q₁)) (commListP P1)
+     anyc05 [] = commAny (anyComm P Q fpq) p₁ q₁ anyp anyq
+     anyc05 (cons a P1 x) = insAny _ (anyc05 P1)
+     anyc04 : (Q1 : FList m) → Any (_≡_ (fpq p₁ q₁)) (commListQ Q1)
+     anyc04 [] = anyc05 P 
+     anyc04 (cons a Q1 x) = insAny _ (anyc04 Q1)
+
+-------------
+--    # 0 :: # 0 :: # 0 : # 0 :: f0
+--    # 0 :: # 0 :: # 1 : # 0 :: f0
+--    # 0 :: # 1 :: # 0 : # 0 :: f0
+--    # 0 :: # 1 :: # 1 : # 0 :: f0
+--    # 0 :: # 2 :: # 0 : # 0 :: f0
+--       ...
+--    # 3 :: # 2 :: # 0 : # 0 :: f0
+--    # 3 :: # 2 :: # 1 : # 0 :: f0
+
+-- all FL
+record AnyFL (n : ℕ) : Set where
+   field
+     allFL : FList n
+     anyP : (x : FL n) → Any (x ≡_ ) allFL 
+
+open AnyFL
+
+--   all FL as all combination  
+--      anyComm ( #0 :: FL0 ... # n :: FL0 ) (all n) (λ p q → FLpos p :: q ) = all (suc n)
+
+anyFL01 :  (n : ℕ) → AnyFL (suc n) 
+anyFL01 zero    = record { allFL = (zero :: f0) ∷# [] ; anyP = λ x → anyFL2 x ((zero :: f0) ∷# []) refl }  where
+     anyFL2 : (x : FL 1) → (y : FList 1) → y ≡ ((zero :: f0) ∷# []) → Any (_≡_ x) y
+     anyFL2 (zero :: f0) .(cons (zero :: f0) [] (Level.lift tt)) refl = here refl
+anyFL01 (suc n) = record { allFL = commList anyC ;  anyP =  anyFL02 } where
+     anyFL05 : {n i : ℕ} → (i < suc n) → FList (suc n)
+     anyFL05 {_} {0} (s≤s z≤n) = zero :: FL0 ∷# []
+     anyFL05 {n} {suc i} (s≤s i<n) = FLinsert (fromℕ< (s≤s i<n) :: FL0) (anyFL05 {n} {i} (<-trans i<n a<sa))
+     anyFL08 : {n i : ℕ} {x : Fin (suc n)} {i<n : suc i < suc n}  → toℕ x ≡ suc i → x ≡ suc (fromℕ< (≤-pred i<n))
+     anyFL08 {n} {i} {x} {i<n} eq = toℕ-injective ( begin
+                toℕ x                               ≡⟨ eq ⟩
+                suc i                               ≡⟨ cong suc (≡-sym (toℕ-fromℕ< _ )) ⟩
+                suc (toℕ (fromℕ< (≤-pred i<n)) )
+          ∎ ) where open ≡-Reasoning
+     anyFL06 : {n i : ℕ} → (i<n : i < suc n) → (x : Fin (suc n)) → toℕ x < suc i → Any (_≡_ (x :: FL0)) (anyFL05 i<n)
+     anyFL06 (s≤s z≤n) zero (s≤s lt) = here refl
+     anyFL06 {n} {suc i} (s≤s (s≤s i<n)) x (s≤s lt) with <-cmp (toℕ x) (suc i)
+     ... | tri< a ¬b ¬c = insAny _ (anyFL06 (<-trans (s≤s i<n) a<sa) x a) 
+     ... | tri≈ ¬a b ¬c = subst (λ k →  Any (_≡_ (x :: FL0)) (FLinsert (k :: FL0) (anyFL05 {n} {i} (<-trans (s≤s i<n) a<sa))))
+                  (anyFL08 {n} {i} {x} {s≤s (s≤s i<n)} b) (x∈FLins (x :: FL0)  (anyFL05 {n} {i} (<-trans (s≤s i<n) a<sa)))
+     ... | tri> ¬a ¬b c = ⊥-elim ( nat-≤> c (s≤s lt) )
+     anyC = anyComm (anyFL05 a<sa) (allFL (anyFL01 n)) (λ p q → FLpos p :: q )
+     anyFL02 : (x : FL (suc (suc n))) → Any (_≡_ x) (commList anyC)
+     anyFL02 (x :: y) = commAny anyC (x :: FL0) y
+                       (subst (λ k → Any (_≡_ (k :: FL0) ) _) (fromℕ<-toℕ _ _) (anyFL06 a<sa (fromℕ< x≤n) fin<n) ) (anyP (anyFL01 n) y) where
+         x≤n : suc (toℕ x)  ≤ suc (suc n)
+         x≤n = toℕ<n x
+
+anyFL :  (n : ℕ) → AnyFL n 
+anyFL zero = record { allFL = f0 ∷# [] ; anyP = anyFL4 } where
+    anyFL4 : (x : FL zero) → Any (_≡_ x) ( f0 ∷# [] )
+    anyFL4 f0 = here refl
+anyFL (suc n) = anyFL01 n
+
+at1 = proj₁ (toList (allFL (anyFL 1)))
+at2 = proj₁ (toList (allFL (anyFL 2)))
+at3 = proj₁ (toList (allFL (anyFL 3)))
+at4 = proj₁ (toList (allFL (anyFL 4)))
+
+CommFListN  : ℕ →  FList n
+CommFListN  zero = allFL (anyFL n)
+CommFListN (suc i ) = commList (anyComm ( CommFListN i ) ( CommFListN i ) (λ p q →  perm→FL [ FL→perm p , FL→perm q ] ))
+
+CommStage→ : (i : ℕ) → (x : Permutation n n ) → deriving i x → Any (perm→FL x ≡_) (CommFListN i)
+CommStage→ zero x (Level.lift tt) = anyP (anyFL n) (perm→FL x)
+CommStage→ (suc i) .( [ g , h ] ) (comm {g} {h} p q) = comm2 where
+  G = perm→FL g
+  H = perm→FL h
+  comm3 :  perm→FL [ FL→perm G , FL→perm H ] ≡ perm→FL [ g , h ]
+  comm3 = begin
+              perm→FL [ FL→perm G , FL→perm H ] 
+           ≡⟨ pcong-pF (comm-resp (FL←iso _) (FL←iso _)) ⟩
+              perm→FL [ g , h ]
+          ∎  where open ≡-Reasoning
+  comm2 : Any (_≡_ (perm→FL [ g , h ])) (CommFListN (suc i))
+  comm2 = subst (λ k → Any (_≡_ k) (CommFListN (suc i)) ) comm3
+     ( commAny ( anyComm (CommFListN i) (CommFListN i) (λ p q →  perm→FL [ FL→perm p , FL→perm q ] )) G H (CommStage→ i g p) (CommStage→ i h q) )
+CommStage→ (suc i) x (ccong {f} {x} eq p) =
+      subst (λ k → Any (k ≡_) (commList (anyComm ( CommFListN i ) ( CommFListN i ) (λ p q →  perm→FL [ FL→perm p , FL→perm q ] ))))
+          (comm4 eq) (CommStage→ (suc i) f p ) where
+   comm4 : f =p= x →  perm→FL f ≡ perm→FL x
+   comm4 = pcong-pF
+
+CommSolved : (x : Permutation n n) → (y : FList n) → y ≡ FL0 ∷# [] → (FL→perm (FL0 {n}) =p= pid ) → Any (perm→FL x ≡_) y → x =p= pid
+CommSolved x .(cons FL0 [] (Level.lift tt)) refl eq0 (here eq) = FLpid _ eq eq0
diff -r a5b3061f15ee -r 6d1619d9f880 src/FLutil.agda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/FLutil.agda	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,271 @@
+{-# OPTIONS --allow-unsolved-metas #-}
+module FLutil where
+
+open import Level hiding ( suc ; zero )
+open import Data.Fin hiding ( _<_  ; _≤_ ; _-_ ; _+_ ; _≟_)
+open import Data.Fin.Properties hiding ( <-trans ; ≤-refl ; ≤-trans ; ≤-irrelevant ; _≟_ ) renaming ( <-cmp to <-fcmp )
+open import Data.Fin.Permutation  -- hiding ([_,_])
+open import Data.Nat -- using (ℕ; suc; zero; s≤s ; z≤n )
+open import Data.Nat.Properties as DNP
+open import Relation.Binary.PropositionalEquality hiding ( [_] )
+open import Data.List using (List; []; _∷_ ; length ; _++_ ; tail ) renaming (reverse to rev )
+open import Data.Product
+open import Relation.Nullary
+open import Data.Empty
+open import  Relation.Binary.Core
+open import  Relation.Binary.Definitions 
+open import logic
+open import nat
+
+infixr  100 _::_
+
+data  FL : (n : ℕ )→ Set where
+   f0 :  FL 0 
+   _::_ :  { n : ℕ } → Fin (suc n ) → FL n → FL (suc n)
+
+data _f<_  : {n : ℕ } (x : FL n ) (y : FL n)  → Set  where
+   f<n : {m : ℕ } {xn yn : Fin (suc m) } {xt yt : FL m} → xn Data.Fin.< yn →   (xn :: xt) f< ( yn :: yt )
+   f<t : {m : ℕ } {xn : Fin (suc m) } {xt yt : FL m} → xt f< yt →   (xn :: xt) f< ( xn :: yt )
+
+FLeq : {n : ℕ } {xn yn : Fin (suc n)} {x : FL n } {y : FL n}  → xn :: x ≡ yn :: y → ( xn ≡ yn )  × (x ≡ y )
+FLeq refl = refl , refl 
+
+FLpos : {n : ℕ} → FL (suc n) → Fin (suc n)
+FLpos (x :: _) = x
+
+f-<> :  {n : ℕ } {x : FL n } {y : FL n}  → x f< y → y f< x → ⊥
+f-<> (f<n x) (f<n x₁) = nat-<> x x₁
+f-<> (f<n x) (f<t lt2) = nat-≡< refl x
+f-<> (f<t lt) (f<n x) = nat-≡< refl x
+f-<> (f<t lt) (f<t lt2) = f-<> lt lt2
+
+f-≡< :  {n : ℕ } {x : FL n } {y : FL n}  → x ≡ y → y f< x → ⊥
+f-≡< refl (f<n x) = nat-≡< refl x
+f-≡< refl (f<t lt) = f-≡< refl lt 
+
+FLcmp : {n : ℕ } → Trichotomous {Level.zero} {FL n}  _≡_  _f<_
+FLcmp f0 f0 = tri≈ (λ ()) refl (λ ())
+FLcmp (xn :: xt) (yn :: yt) with <-fcmp xn yn
+... | tri< a ¬b ¬c = tri< (f<n a) (λ eq → nat-≡< (cong toℕ (proj₁ (FLeq eq)) ) a) (λ lt  → f-<> lt (f<n a) )
+... | tri> ¬a ¬b c = tri> (λ lt  → f-<> lt (f<n c) ) (λ eq → nat-≡< (cong toℕ (sym (proj₁ (FLeq eq)) )) c) (f<n c)
+... | tri≈ ¬a refl ¬c with FLcmp xt yt
+... | tri< a ¬b ¬c₁ = tri< (f<t a) (λ eq → ¬b (proj₂ (FLeq eq) )) (λ lt  → f-<> lt (f<t a) )
+... | tri≈ ¬a₁ refl ¬c₁ = tri≈ (λ lt → f-≡< refl lt )  refl (λ lt → f-≡< refl lt )
+... | tri> ¬a₁ ¬b c = tri> (λ lt  → f-<> lt (f<t c) ) (λ eq → ¬b (proj₂ (FLeq eq) )) (f<t c)
+
+f<-trans : {n : ℕ } { x y z : FL n } → x f< y → y f< z → x f< z
+f<-trans {suc n} (f<n x) (f<n x₁) = f<n ( Data.Fin.Properties.<-trans x x₁ )
+f<-trans {suc n} (f<n x) (f<t y<z) = f<n x
+f<-trans {suc n} (f<t x<y) (f<n x) = f<n x
+f<-trans {suc n} (f<t x<y) (f<t y<z) = f<t (f<-trans x<y y<z)
+
+infixr 250 _f<?_
+
+_f<?_ : {n  : ℕ} → (x y : FL n ) → Dec (x f< y )
+x f<? y with FLcmp x y
+... | tri< a ¬b ¬c = yes a
+... | tri≈ ¬a refl ¬c = no ( ¬a )
+... | tri> ¬a ¬b c = no ( ¬a )
+
+_f≤_ : {n : ℕ } (x : FL n ) (y : FL n)  → Set
+_f≤_ x y = (x ≡ y ) ∨  (x f< y )
+
+FL0 : {n : ℕ } → FL n
+FL0 {zero} = f0
+FL0 {suc n} = zero :: FL0
+
+fmax : { n : ℕ } →  FL n
+fmax {zero} = f0
+fmax {suc n} = fromℕ< a<sa :: fmax {n}
+
+fmax< : { n : ℕ } → {x : FL n } → ¬ (fmax f< x )
+fmax< {suc n} {x :: y} (f<n lt) = nat-≤> (fmax1 x) lt where
+    fmax1 : {n : ℕ } → (x : Fin (suc n)) → toℕ x ≤ toℕ (fromℕ< {n} a<sa)
+    fmax1 {zero} zero = z≤n
+    fmax1 {suc n} zero = z≤n
+    fmax1 {suc n} (suc x) = s≤s (fmax1 x) 
+fmax< {suc n} {x :: y} (f<t lt) = fmax< {n} {y} lt
+
+fmax¬ : { n : ℕ } → {x : FL n } → ¬ ( x ≡ fmax ) → x f< fmax
+fmax¬ {zero} {f0} ne = ⊥-elim ( ne refl ) 
+fmax¬ {suc n} {x} ne with FLcmp x fmax
+... | tri< a ¬b ¬c = a
+... | tri≈ ¬a b ¬c = ⊥-elim ( ne b)
+... | tri> ¬a ¬b c = ⊥-elim (fmax< c)
+
+x≤fmax : {n : ℕ } → {x : FL n} → x f≤ fmax
+x≤fmax {n} {x} with FLcmp x fmax
+... | tri< a ¬b ¬c = case2 a
+... | tri≈ ¬a b ¬c = case1 b
+... | tri> ¬a ¬b c = ⊥-elim ( fmax< c )
+
+open import Data.Nat.Properties using ( ≤-trans ; <-trans )
+fsuc : { n : ℕ } → (x : FL n ) → x f< fmax → FL n 
+fsuc {n} (x :: y) (f<n lt) = fromℕ< fsuc1 :: y where
+    fsuc1 : suc (toℕ x) < n
+    fsuc1 =  Data.Nat.Properties.≤-trans (s≤s lt) ( s≤s ( toℕ≤pred[n] (fromℕ< a<sa)) )
+fsuc (x :: y) (f<t lt) = x :: fsuc y lt
+
+open import fin
+
+flist1 :  {n : ℕ } (i : ℕ) → i < suc n → List (FL n) → List (FL n) → List (FL (suc n)) 
+flist1 zero i<n [] _ = []
+flist1 zero i<n (a ∷ x ) z  = ( zero :: a ) ∷ flist1 zero i<n x z 
+flist1 (suc i) (s≤s i<n) [] z  = flist1 i (Data.Nat.Properties.<-trans i<n a<sa) z z 
+flist1 (suc i) i<n (a ∷ x ) z  = ((fromℕ< i<n ) :: a ) ∷ flist1 (suc i) i<n x z 
+
+flist : {n : ℕ } → FL n → List (FL n) 
+flist {zero} f0 = f0 ∷ [] 
+flist {suc n} (x :: y)  = flist1 n a<sa (flist y) (flist y)   
+
+FL1 : List ℕ → List ℕ
+FL1 [] = []
+FL1 (x ∷ y) = suc x ∷ FL1 y
+
+FL→plist : {n : ℕ} → FL n → List ℕ
+FL→plist {0} f0 = []
+FL→plist {suc n} (zero :: y) = zero ∷ FL1 (FL→plist y) 
+FL→plist {suc n} (suc x :: y) with FL→plist y
+... | [] = zero ∷ []
+... | x1 ∷ t = suc x1 ∷ FL2 x t where
+  FL2 : {n : ℕ} → Fin n → List ℕ → List ℕ
+  FL2 zero y = zero ∷ FL1 y
+  FL2 (suc i) [] = zero ∷ []
+  FL2 (suc i) (x ∷ y) = suc x ∷ FL2 i y
+
+tt0 = (# 2) :: (# 1) :: (# 0) :: zero :: f0
+tt1 = FL→plist tt0
+
+open _∧_
+
+find-zero : {n i : ℕ} → List ℕ → i < n  → Fin n ∧ List ℕ
+find-zero  [] i<n = record { proj1 = fromℕ< i<n  ; proj2 = [] }
+find-zero x (s≤s z≤n) = record { proj1 = fromℕ< (s≤s z≤n)  ; proj2 = x }
+find-zero (zero ∷ y) (s≤s (s≤s i<n)) = record { proj1 = fromℕ< (s≤s (s≤s i<n)) ; proj2 = y }
+find-zero (suc x ∷ y) (s≤s (s≤s i<n)) with find-zero y (s≤s i<n) 
+... | record { proj1 = i ; proj2 = y1 } = record { proj1 = suc i ; proj2 = suc x ∷ y1 }
+
+plist→FL : {n : ℕ} → List ℕ → FL n -- wrong implementation
+plist→FL {zero} [] = f0
+plist→FL {suc n} [] = zero :: plist→FL {n} []
+plist→FL {zero} x = f0
+plist→FL {suc n} x with find-zero x a<sa
+... | record { proj1 = i ; proj2 = y } = i :: plist→FL y
+
+tt2 = 2 ∷ 1 ∷ 0 ∷ 3 ∷ []
+tt3 : FL 4
+tt3 = plist→FL tt2
+tt4 = FL→plist tt3
+tt5 = plist→FL {4} (FL→plist tt0)
+
+-- maybe FL→iso can be easier using this ...
+-- FL→plist-iso : {n : ℕ} → (f : FL n ) → plist→FL (FL→plist f ) ≡ f
+-- FL→plist-iso = {!!}
+-- FL→plist-inject : {n : ℕ} → (f g : FL n ) → FL→plist f ≡ FL→plist g → f ≡ g
+-- FL→plist-inject = {!!}
+
+open import Relation.Binary as B hiding (Decidable; _⇔_)
+open import Data.Sum.Base as Sum --  inj₁
+open import Relation.Nary using (⌊_⌋)
+open import Data.List.Fresh hiding ([_])
+
+FList : (n : ℕ ) → Set
+FList n = List# (FL n) ⌊ _f<?_ ⌋
+
+fr1 : FList 3
+fr1 =
+   ((# 0) :: ((# 0) :: ((# 0 ) :: f0))) ∷# 
+   ((# 0) :: ((# 1) :: ((# 0 ) :: f0))) ∷# 
+   ((# 1) :: ((# 0) :: ((# 0 ) :: f0))) ∷# 
+   ((# 2) :: ((# 0) :: ((# 0 ) :: f0))) ∷# 
+   ((# 2) :: ((# 1) :: ((# 0 ) :: f0))) ∷# 
+   []
+
+open import Data.Product
+open import Relation.Nullary.Decidable hiding (⌊_⌋)
+-- open import Data.Bool hiding (_<_ ; _≤_ )
+open import Data.Unit.Base using (⊤ ; tt)
+
+--  fresh a []        = ⊤
+--  fresh a (x ∷# xs) = R a x × fresh a xs
+
+-- toWitness
+-- ttf< :  {n : ℕ } → {x a : FL n } → x f< a  → T (isYes (x f<? a))
+-- ttf< {n} {x} {a} x<a with x f<? a
+-- ... | yes y = subst (λ k → Data.Bool.T k ) refl tt
+-- ... | no nn = ⊥-elim ( nn x<a )
+
+ttf : {n : ℕ } {x a : FL (n)} → x f< a → (y : FList (n)) →  fresh (FL (n)) ⌊ _f<?_ ⌋  a y  → fresh (FL (n)) ⌊ _f<?_ ⌋  x y
+ttf _ [] fr = Level.lift tt
+ttf {_} {x} {a} lt (cons a₁ y x1) (lift lt1 , x2 ) = (Level.lift (fromWitness (ttf1 lt1 lt ))) , ttf (ttf1 lt1 lt) y x1 where 
+       ttf1 : True (a f<? a₁) → x f< a  → x f< a₁
+       ttf1 t x<a = f<-trans x<a (toWitness t)
+
+-- by https://gist.github.com/aristidb/1684202
+
+FLinsert : {n : ℕ } → FL n → FList n  → FList n 
+FLfresh : {n : ℕ } → (a x : FL (suc n) ) → (y : FList (suc n) ) → a f< x
+     → fresh (FL (suc n)) ⌊ _f<?_ ⌋ a y → fresh (FL (suc n)) ⌊ _f<?_ ⌋ a (FLinsert x y)
+FLinsert {zero} f0 y = f0 ∷# []
+FLinsert {suc n} x [] = x ∷# []
+FLinsert {suc n} x (cons a y x₁) with FLcmp x a
+... | tri≈ ¬a b ¬c  = cons a y x₁
+... | tri< lt ¬b ¬c  = cons x ( cons a y x₁) ( Level.lift (fromWitness lt ) , ttf lt y  x₁) 
+FLinsert {suc n} x (cons a [] x₁) | tri> ¬a ¬b lt  = cons a ( x  ∷# []  ) ( Level.lift (fromWitness lt) , Level.lift tt )
+FLinsert {suc n} x (cons a y yr)  | tri> ¬a ¬b a<x = cons a (FLinsert x y) (FLfresh a x y a<x yr )
+
+FLfresh a x [] a<x (Level.lift tt) = Level.lift (fromWitness a<x) , Level.lift tt
+FLfresh a x (cons b [] (Level.lift tt)) a<x (Level.lift a<b , a<y) with FLcmp x b
+... | tri< x<b ¬b ¬c  = Level.lift (fromWitness a<x) , Level.lift a<b , Level.lift tt
+... | tri≈ ¬a refl ¬c = Level.lift (fromWitness a<x) , Level.lift tt
+... | tri> ¬a ¬b b<x =  Level.lift a<b  ,  Level.lift (fromWitness  (f<-trans (toWitness a<b) b<x))  , Level.lift tt
+FLfresh a x (cons b y br) a<x (Level.lift a<b , a<y) with FLcmp x b
+... | tri< x<b ¬b ¬c =  Level.lift (fromWitness a<x) , Level.lift a<b , ttf (toWitness a<b) y br
+... | tri≈ ¬a refl ¬c = Level.lift (fromWitness a<x) , ttf a<x y br
+FLfresh a x (cons b [] br) a<x (Level.lift a<b , a<y) | tri> ¬a ¬b b<x =
+    Level.lift a<b , Level.lift (fromWitness (f<-trans (toWitness a<b) b<x)) , Level.lift tt
+FLfresh a x (cons b (cons a₁ y x₁) br) a<x (Level.lift a<b , a<y) | tri> ¬a ¬b b<x =
+    Level.lift a<b , FLfresh a x (cons a₁ y x₁) a<x a<y
+
+fr6 = FLinsert ((# 1) :: ((# 1) :: ((# 0 ) :: f0))) fr1 
+
+open import Data.List.Fresh.Relation.Unary.Any 
+open import Data.List.Fresh.Relation.Unary.All 
+
+x∈FLins : {n : ℕ} → (x : FL n ) → (xs : FList n)  → Any (x ≡_) (FLinsert x xs)
+x∈FLins {zero} f0 [] = here refl
+x∈FLins {zero} f0 (cons f0 xs x) = here refl
+x∈FLins {suc n} x [] = here refl
+x∈FLins {suc n} x (cons a xs x₁) with FLcmp x a
+... | tri< x<a ¬b ¬c = here refl
+... | tri≈ ¬a b ¬c   = here b
+x∈FLins {suc n} x (cons a [] x₁)              | tri> ¬a ¬b a<x = there ( here refl )
+x∈FLins {suc n} x (cons a (cons a₁ xs x₂) x₁) | tri> ¬a ¬b a<x = there ( x∈FLins x (cons a₁ xs x₂) )
+
+nextAny : {n : ℕ} → {x h : FL n } → {L : FList n}  → {hr : fresh (FL n) ⌊ _f<?_ ⌋ h L } → Any (x ≡_) L → Any (x ≡_) (cons h L hr )
+nextAny (here x₁) = there (here x₁)
+nextAny (there any) = there (there any)
+
+insAny : {n : ℕ} → {x h : FL n } → (xs : FList n)  → Any (x ≡_) xs → Any (x ≡_) (FLinsert h xs)
+insAny {zero} {f0} {f0} (cons a L xr) (here refl) = here refl
+insAny {zero} {f0} {f0} (cons a L xr) (there any) = insAny {zero} {f0} {f0} L any 
+insAny {suc n} {x} {h} (cons a L xr) any with FLcmp h a 
+... | tri< x<a ¬b ¬c = there any
+... | tri≈ ¬a b ¬c = any
+insAny {suc n} {a} {h} (cons a [] (Level.lift tt)) (here refl) | tri> ¬a ¬b c = here refl
+insAny {suc n} {x} {h} (cons a (cons a₁ L x₁) xr) (here refl) | tri> ¬a ¬b c = here refl
+insAny {suc n} {x} {h} (cons a (cons a₁ L x₁) xr) (there any) | tri> ¬a ¬b c = there (insAny (cons a₁ L x₁) any)
+
+-- FLinsert membership
+
+module FLMB { n : ℕ } where
+
+  FL-Setoid : Setoid Level.zero Level.zero
+  FL-Setoid  = record { Carrier = FL n ; _≈_ = _≡_ ; isEquivalence = record { sym = sym ; refl = refl ; trans = trans }}
+
+  open import Data.List.Fresh.Membership.Setoid FL-Setoid
+
+  FLinsert-mb :  (x : FL n ) → (xs : FList n)  → x ∈ FLinsert x xs
+  FLinsert-mb x xs = x∈FLins {n} x xs 
+
+  
diff -r a5b3061f15ee -r 6d1619d9f880 src/Gutil.agda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Gutil.agda	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,130 @@
+open import Level hiding ( suc ; zero )
+open import Algebra
+module Gutil {n m : Level} (G : Group n m ) where
+
+open import Data.Unit
+open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
+open import Function
+open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
+open import Relation.Nullary
+open import Data.Empty
+open import Data.Product
+open import  Relation.Binary.PropositionalEquality hiding ( [_] )
+
+
+open Group G
+
+import Relation.Binary.Reasoning.Setoid as EqReasoning
+
+gsym = Algebra.Group.sym G
+grefl = Algebra.Group.refl G
+gtrans = Algebra.Group.trans G
+
+lemma3 : ε ≈ ε ⁻¹
+lemma3 = begin
+     ε          ≈⟨ gsym (proj₁ inverse _) ⟩
+     ε ⁻¹ ∙ ε   ≈⟨ proj₂ identity _ ⟩
+     ε ⁻¹
+   ∎ where open EqReasoning (Algebra.Group.setoid G)
+
+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)
+
+≡→≈ : {f g : Carrier } → f ≡ g → f ≈ g
+≡→≈ refl = grefl
+
+---
+-- to avoid assoc storm, flatten multiplication according to the template
+--
+
+data MP  : Carrier → Set (Level.suc n) where
+    am  : (x : Carrier )   →  MP  x
+    _o_ : {x y : Carrier } →  MP  x →  MP  y → MP  ( x ∙ y )
+
+mpf : {x : Carrier } → (m : MP x ) → Carrier → Carrier
+mpf (am x) y = x ∙ y
+mpf (m o m₁) y = mpf m ( mpf m₁ y )
+
+mp-flatten : {x : Carrier } → (m : MP x ) → Carrier 
+mp-flatten  m = mpf m ε 
+
+mpl1 : Carrier → {x : Carrier } → MP x → Carrier
+mpl1 x (am y) = x ∙ y
+mpl1 x (y o y1) = mpl1 ( mpl1 x y ) y1
+
+mpl : {x z : Carrier } → MP x → MP z  → Carrier
+mpl (am x)  m = mpl1 x m 
+mpl (m o m1) m2 = mpl m (m1 o m2)
+
+mp-flattenl : {x : Carrier } → (m : MP x ) → Carrier
+mp-flattenl m = mpl m (am ε)
+
+test1 : ( f g : Carrier ) → Carrier
+test1 f g = mp-flattenl ((am (g ⁻¹) o am (f ⁻¹) ) o ( (am f o am g) o am ((f ∙ g) ⁻¹ ))) 
+
+test2 : ( f g : Carrier ) → test1 f g ≡  g ⁻¹ ∙ f ⁻¹ ∙ f ∙ g ∙  (f ∙ g) ⁻¹  ∙ ε
+test2 f g = _≡_.refl
+
+test3 : ( f g : Carrier ) → Carrier
+test3 f g = mp-flatten ((am (g ⁻¹) o am (f ⁻¹) ) o ( (am f o am g) o am ((f ∙ g) ⁻¹ ))) 
+
+test4 : ( f g : Carrier ) → test3 f g ≡ g ⁻¹ ∙ (f ⁻¹ ∙ (f ∙ (g ∙ ((f ∙ g) ⁻¹ ∙ ε))))
+test4 f g = _≡_.refl
+
+  
+∙-flatten : {x : Carrier } → (m : MP x ) → x ≈ mp-flatten m
+∙-flatten {x} (am x) = gsym (proj₂ identity _)
+∙-flatten {_} (am x o q) = ∙-cong grefl ( ∙-flatten q )
+∙-flatten (_o_ {_} {z} (_o_ {x} {y} p q) r) = lemma9 _ _ _ ( ∙-flatten {x ∙ y } (p o q )) ( ∙-flatten {z} r ) where
+   mp-cong : {p q r : Carrier} → (P : MP p)  → q ≈ r → mpf P q ≈ mpf P r
+   mp-cong (am x) q=r = ∙-cong grefl q=r
+   mp-cong (P o P₁) q=r = mp-cong P ( mp-cong P₁ q=r )
+   mp-assoc : {p q r : Carrier} → (P : MP p)  → mpf P q ∙ r ≈ mpf P (q ∙ r )
+   mp-assoc (am x) = assoc _ _ _ 
+   mp-assoc {p} {q} {r} (P o P₁) = begin
+       mpf P (mpf  P₁ q) ∙ r      ≈⟨ mp-assoc P ⟩
+       mpf P (mpf P₁ q ∙ r)       ≈⟨ mp-cong P (mp-assoc P₁)  ⟩ mpf P ((mpf  P₁) (q ∙ r))
+    ∎ where open EqReasoning (Algebra.Group.setoid G)
+   lemma9 : (x y z : Carrier) →  x ∙ y ≈ mpf p (mpf q ε) → z ≈ mpf r ε →  x ∙ y ∙ z ≈ mp-flatten ((p o q) o r)
+   lemma9 x y z t s = begin
+       x ∙ y ∙ z                    ≈⟨ ∙-cong t grefl  ⟩
+       mpf p (mpf q ε) ∙ z          ≈⟨ mp-assoc p ⟩
+       mpf p (mpf q ε ∙ z)          ≈⟨ mp-cong p (mp-assoc q ) ⟩
+       mpf p (mpf q (ε ∙ z))        ≈⟨ mp-cong p (mp-cong q (proj₁ identity _  )) ⟩
+       mpf p (mpf q z)              ≈⟨ mp-cong p (mp-cong q s) ⟩
+       mpf p (mpf q (mpf r ε))
+    ∎ where open EqReasoning (Algebra.Group.setoid G)
+
+grepl : { x y0 y1 z  : Carrier } → x ∙ y0 ≈ y1  → x ∙ ( y0 ∙ z ) ≈ y1 ∙ z 
+grepl eq = gtrans (gsym (assoc _ _ _ )) (∙-cong eq grefl )
+
+grm : { x y0 y1 z  : Carrier } → x ∙ y0 ≈ ε  → x ∙ ( y0 ∙ z ) ≈  z 
+grm eq = gtrans ( gtrans (gsym (assoc _ _ _ )) (∙-cong eq grefl )) ( proj₁ identity _ )
+
+-- ∙-flattenl : {x : Carrier } → (m : MP x ) → x ≈ mp-flattenl m
+-- ∙-flattenl (am x) = gsym (proj₂ identity _)
+-- ∙-flattenl (q o am x) with ∙-flattenl q    -- x₁ ∙ x ≈ mpl q (am x o am ε) ,  t : x₁ ≈ mpl q (am ε)
+-- ... | t = {!!}
+-- ∙-flattenl (q o (x o y )) with ∙-flattenl q 
+-- ... | t = gtrans (gsym (assoc _ _ _ )) {!!}
+
+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) ⁻¹ )         ≈⟨ ∙-flatten ((am (g ⁻¹) o am (f ⁻¹) ) o ( (am f o am g) o am ((f ∙ g) ⁻¹ )))  ⟩
+     g ⁻¹ ∙ (f ⁻¹ ∙ (f ∙ (g ∙ ((f ∙ g) ⁻¹ ∙ ε))))    ≈⟨ ∙-cong grefl (gsym (assoc _ _ _ )) ⟩
+     g ⁻¹ ∙ ((f ⁻¹ ∙ f) ∙ (g ∙ ((f ∙ g) ⁻¹ ∙ ε)))    ≈⟨ ∙-cong grefl (gtrans (∙-cong (proj₁ inverse _ ) grefl) (proj₁ identity _)) ⟩
+     g ⁻¹ ∙ (g ∙ ((f ∙ g) ⁻¹ ∙ ε))                   ≈⟨ gsym (assoc _ _ _) ⟩
+     (g ⁻¹ ∙ g ) ∙ ((f ∙ g) ⁻¹ ∙ ε)                  ≈⟨ gtrans (∙-cong (proj₁ inverse _ ) grefl) (proj₁ identity _) ⟩
+     (f ∙ g) ⁻¹ ∙ ε                                  ≈⟨ proj₂ identity _ ⟩
+     (f ∙ g) ⁻¹
+     ∎ where open EqReasoning (Algebra.Group.setoid G)
+
diff -r a5b3061f15ee -r 6d1619d9f880 src/Putil.agda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Putil.agda	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,703 @@
+{-# OPTIONS --allow-unsolved-metas #-} 
+module Putil where
+
+open import Level hiding ( suc ; zero )
+open import Algebra
+open import Algebra.Structures
+open import Data.Fin hiding ( _<_  ; _≤_ ; _-_ ; _+_ ; _≟_)
+open import Data.Fin.Properties hiding ( <-trans ; ≤-trans ; ≤-irrelevant ; _≟_ ) renaming ( <-cmp to <-fcmp )
+open import Data.Fin.Permutation
+open import Function hiding (id ; flip)
+open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
+open import Function.LeftInverse  using ( _LeftInverseOf_ )
+open import Function.Equality using (Π)
+open import Data.Nat -- using (ℕ; suc; zero; s≤s ; z≤n )
+open import Data.Nat.Properties -- using (<-trans)
+open import Relation.Binary.PropositionalEquality hiding ( [_] )
+open import Data.List using (List; []; _∷_ ; length ; _++_ ; head ; tail ) renaming (reverse to rev )
+open import nat
+
+open import Symmetric
+
+
+open import Relation.Nullary
+open import Data.Empty
+open import  Relation.Binary.Core
+open import  Relation.Binary.Definitions
+open import fin
+
+-- An inductive construction of permutation
+
+pprep  : {n : ℕ }  → Permutation n n → Permutation (suc n) (suc n)
+pprep {n} perm =  permutation p→ p← record { left-inverse-of = piso→ ; right-inverse-of = piso← } where
+   p→ : Fin (suc n) → Fin (suc n)
+   p→ zero = zero
+   p→ (suc x) = suc ( perm  ⟨$⟩ʳ x)
+
+   p← : Fin (suc n) → Fin (suc n)
+   p← zero = zero
+   p← (suc x) = suc ( perm  ⟨$⟩ˡ x)
+
+   piso← : (x : Fin (suc n)) → p→ ( p← x ) ≡ x
+   piso← zero = refl
+   piso← (suc x) = cong (λ k → suc k ) (inverseʳ perm) 
+
+   piso→ : (x : Fin (suc n)) → p← ( p→ x ) ≡ x
+   piso→ zero = refl
+   piso→ (suc x) = cong (λ k → suc k ) (inverseˡ perm) 
+
+pswap  : {n : ℕ }  → Permutation n n → Permutation (suc (suc n)) (suc (suc  n ))
+pswap {n} perm = permutation p→ p← record { left-inverse-of = piso→ ; right-inverse-of = piso← } where
+   p→ : Fin (suc (suc n)) → Fin (suc (suc n)) 
+   p→ zero = suc zero 
+   p→ (suc zero) = zero 
+   p→ (suc (suc x)) = suc ( suc ( perm  ⟨$⟩ʳ x) )
+
+   p← : Fin (suc (suc n)) → Fin (suc (suc n)) 
+   p← zero = suc zero 
+   p← (suc zero) = zero 
+   p← (suc (suc x)) = suc ( suc ( perm  ⟨$⟩ˡ x) )
+   
+   piso← : (x : Fin (suc (suc n)) ) → p→ ( p← x ) ≡ x
+   piso← zero = refl
+   piso← (suc zero) = refl
+   piso← (suc (suc x)) = cong (λ k → suc (suc k) ) (inverseʳ perm) 
+
+   piso→ : (x : Fin (suc (suc n)) ) → p← ( p→ x ) ≡ x
+   piso→ zero = refl
+   piso→ (suc zero) = refl
+   piso→ (suc (suc x)) = cong (λ k → suc (suc k) ) (inverseˡ perm) 
+
+psawpn : {n : ℕ} → 1 < n → Permutation n n
+psawpn {suc zero}  (s≤s ())
+psawpn {suc n} (s≤s (s≤s x)) = pswap pid 
+
+pfill : { n m : ℕ } → m ≤ n → Permutation  m m → Permutation n n
+pfill {n} {m} m≤n perm = pfill1 (n - m) (n-m<n n m ) (subst (λ k → Permutation k k ) (n-n-m=m m≤n ) perm) where
+   pfill1 : (i : ℕ ) → i ≤ n  → Permutation (n - i) (n - i)  →  Permutation n n
+   pfill1 0 _ perm = perm
+   pfill1 (suc i) i<n perm = pfill1 i (≤to< i<n) (subst (λ k → Permutation k k ) (si-sn=i-n i<n ) ( pprep perm ) )
+
+--
+--  psawpim (inseert swap at position m )
+--
+psawpim : {n m : ℕ} → suc (suc m) ≤ n → Permutation n n
+psawpim {n} {m} m≤n = pfill m≤n ( psawpn (s≤s (s≤s z≤n)) )
+
+n≤ : (i : ℕ ) → {j : ℕ } → i ≤ i + j
+n≤ (zero) {j} = z≤n
+n≤ (suc i) {j} = s≤s ( n≤ i )
+
+lem0 : {n : ℕ } → n ≤ n
+lem0 {zero} = z≤n
+lem0 {suc n} = s≤s lem0
+
+lem00 : {n m : ℕ } → n ≡ m → n ≤ m
+lem00 refl = lem0
+
+plist1 : {n  : ℕ} → Permutation (suc n) (suc n) → (i : ℕ ) → i < suc n → List ℕ
+plist1  {n} perm zero _           = toℕ ( perm ⟨$⟩ˡ (fromℕ< {zero} (s≤s z≤n))) ∷ []
+plist1  {n} perm (suc i) (s≤s lt) = toℕ ( perm ⟨$⟩ˡ (fromℕ< (s≤s lt)))         ∷ plist1 perm  i (<-trans lt a<sa) 
+
+plist  : {n  : ℕ} → Permutation n n → List ℕ
+plist {0} perm = []
+plist {suc n} perm = rev (plist1 perm n a<sa) 
+
+-- 
+--    from n-1 length create n length inserting new element at position m
+--
+-- 0 ∷ 1 ∷ 2 ∷ 3 ∷ []                               -- 0 ∷ 1 ∷ 2 ∷ 3 ∷ [] 
+-- 1 ∷ 0 ∷ 2 ∷ 3 ∷ []    plist ( pins {3} (n≤ 1) )     1 ∷ 0 ∷ 2 ∷ 3 ∷ []
+-- 1 ∷ 2 ∷ 0 ∷ 3 ∷ []    plist ( pins {3} (n≤ 2) )     2 ∷ 0 ∷ 1 ∷ 3 ∷ []
+-- 1 ∷ 2 ∷ 3 ∷ 0 ∷ []    plist ( pins {3} (n≤ 3) )     3 ∷ 0 ∷ 1 ∷ 2 ∷ []
+--
+-- defined by pprep and pswap
+--
+-- pins  : {n m : ℕ} → m ≤ n → Permutation (suc n) (suc n)
+-- pins {_} {zero} _ = pid
+-- pins {suc _} {suc zero} _ = pswap pid
+-- pins {suc (suc n)} {suc m} (s≤s m<n) =  pins1 (suc m) (suc (suc n)) lem0 where
+--     pins1 : (i j : ℕ ) → j ≤ suc (suc n)  → Permutation (suc (suc (suc n ))) (suc (suc (suc n)))
+--     pins1 _ zero _ = pid
+--     pins1 zero _ _ = pid
+--     pins1 (suc i) (suc j) (s≤s si≤n) = psawpim {suc (suc (suc n))} {j}  (s≤s (s≤s si≤n))  ∘ₚ  pins1 i j (≤-trans si≤n a≤sa ) 
+
+open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ )
+open ≡-Reasoning
+
+pins  : {n m : ℕ} → m ≤ n → Permutation (suc n) (suc n)
+pins {_} {zero} _ = pid
+pins {suc n} {suc m} (s≤s  m≤n) = permutation p← p→  record { left-inverse-of = piso← ; right-inverse-of = piso→ } where
+
+   next : Fin (suc (suc n)) → Fin (suc (suc n))
+   next zero = suc zero
+   next (suc x) = fromℕ< (≤-trans (fin<n {_} {x} ) a≤sa )
+
+   p→ : Fin (suc (suc n)) → Fin (suc (suc n)) 
+   p→ x with <-cmp (toℕ x) (suc m)
+   ... | tri< a ¬b ¬c = fromℕ< (≤-trans (s≤s  a) (s≤s (s≤s  m≤n) )) 
+   ... | tri≈ ¬a b ¬c = zero
+   ... | tri> ¬a ¬b c = x
+
+   p← : Fin (suc (suc n)) → Fin (suc (suc n)) 
+   p← zero = fromℕ< (s≤s (s≤s m≤n))
+   p← (suc x) with <-cmp (toℕ x) (suc m)
+   ... | tri< a ¬b ¬c = fromℕ< (≤-trans (fin<n {_} {x}) a≤sa )
+   ... | tri≈ ¬a b ¬c = suc x
+   ... | tri> ¬a ¬b c = suc x
+
+   mm : toℕ (fromℕ< {suc m} {suc (suc n)} (s≤s (s≤s m≤n))) ≡ suc m 
+   mm = toℕ-fromℕ< (s≤s (s≤s  m≤n)) 
+
+   mma : (x : Fin (suc n) ) → suc (toℕ x) ≤ suc m → toℕ ( fromℕ< (≤-trans (fin<n {_} {x}) a≤sa ) ) ≤ m
+   mma x (s≤s x<sm) = subst (λ k → k ≤ m) (sym (toℕ-fromℕ< (≤-trans fin<n a≤sa ) )) x<sm
+   
+   p3 : (x : Fin (suc n) ) →  toℕ (fromℕ< (≤-trans (fin<n {_} {suc x} ) (s≤s a≤sa))) ≡ suc (toℕ x)
+   p3 x = begin
+            toℕ (fromℕ< (≤-trans (fin<n {_} {suc x} ) (s≤s a≤sa)))
+          ≡⟨ toℕ-fromℕ< ( s≤s ( ≤-trans fin<n  a≤sa ) ) ⟩
+            suc (toℕ x)
+          ∎ 
+
+   piso→ : (x : Fin (suc (suc n)) ) → p← ( p→ x ) ≡ x
+   piso→ zero with <-cmp (toℕ (fromℕ< (≤-trans (s≤s z≤n) (s≤s (s≤s  m≤n) )))) (suc m)
+   ... | tri< a ¬b ¬c = refl
+   piso→ (suc x) with <-cmp (toℕ (suc x)) (suc m)
+   ... | tri≈ ¬a refl ¬c = p13 where
+       p13 : fromℕ< (s≤s (s≤s m≤n)) ≡ suc x
+       p13 = cong (λ k → suc k ) (fromℕ<-toℕ _ (s≤s m≤n) )
+   ... | tri> ¬a ¬b c = p16 (suc x) refl where
+       p16 : (y :  Fin (suc (suc n))) → y ≡ suc x → p← y ≡ suc x
+       p16 zero eq = ⊥-elim ( nat-≡< (cong (λ k → suc (toℕ k) ) eq) (s≤s (s≤s (z≤n))))
+       p16 (suc y) eq with <-cmp (toℕ y) (suc m)   -- suc (suc m) < toℕ (suc x)
+       ... | tri< a ¬b ¬c = ⊥-elim ( nat-≡< refl ( ≤-trans c (subst (λ k → k < suc m) p17 a )) ) where
+           --  x = suc m case, c : suc (suc m) ≤ suc (toℕ x), a : suc (toℕ y) ≤ suc m,  suc y ≡ suc x
+           p17 : toℕ y ≡ toℕ x
+           p17 with <-cmp (toℕ y) (toℕ x) | cong toℕ eq
+           ... | tri< a ¬b ¬c | seq =  ⊥-elim ( nat-≡< seq (s≤s a) )
+           ... | tri≈ ¬a b ¬c | seq = b
+           ... | tri> ¬a ¬b c | seq =  ⊥-elim ( nat-≡< (sym seq) (s≤s c))
+       ... | tri≈ ¬a b ¬c = eq 
+       ... | tri> ¬a ¬b c₁ = eq 
+   ... | tri< a ¬b ¬c = p10 (fromℕ< (≤-trans (s≤s  a) (s≤s (s≤s  m≤n) ))) refl  where
+       p10 : (y : Fin (suc (suc n)) ) → y ≡ fromℕ< (≤-trans (s≤s  a) (s≤s (s≤s  m≤n) ))  → p← y ≡ suc x
+       p10 zero ()
+       p10 (suc y) eq = p15 where
+          p12 : toℕ y ≡ suc (toℕ x)
+          p12 = begin
+               toℕ y
+             ≡⟨ cong (λ k → Data.Nat.pred (toℕ k)) eq ⟩
+               toℕ (fromℕ< (≤-trans a (s≤s m≤n)))
+             ≡⟨ toℕ-fromℕ< {suc (toℕ x)} {suc n} (≤-trans a (s≤s m≤n)) ⟩
+               suc (toℕ x)
+             ∎
+          p15 : p← (suc y) ≡ suc x
+          p15 with <-cmp (toℕ y) (suc m) -- eq : suc y ≡ suc (suc (fromℕ< (≤-pred (≤-trans a (s≤s m≤n))))) ,  a : suc x < suc m
+          ... | tri< a₁ ¬b ¬c = p11 where
+            p11 : fromℕ< (≤-trans (fin<n {_} {y}) a≤sa ) ≡ suc x
+            p11 = begin
+               fromℕ< (≤-trans (fin<n {_} {y}) a≤sa )
+              ≡⟨ lemma10 {suc (suc n)} {_} {_} p12 {≤-trans (fin<n {_} {y}) a≤sa} {s≤s (fin<n {suc n} {x} )}  ⟩
+               suc (fromℕ< (fin<n {suc n} {x} )) 
+              ≡⟨ cong suc (fromℕ<-toℕ x _ ) ⟩
+               suc x
+              ∎
+          ... | tri≈ ¬a b ¬c = ⊥-elim ( nat-≡< b (subst (λ k → k < suc m) (sym p12) a ))  --  suc x < suc m -> y = suc x  → toℕ y < suc m 
+          ... | tri> ¬a ¬b c = ⊥-elim ( nat-<> c (subst (λ k → k < suc m) (sym p12) a ))  
+
+   piso← : (x : Fin (suc (suc n)) ) → p→ ( p← x ) ≡ x
+   piso← zero with <-cmp (toℕ (fromℕ< (s≤s (s≤s m≤n)))) (suc m) | mm
+   ... | tri< a ¬b ¬c | t = ⊥-elim ( ¬b t )
+   ... | tri≈ ¬a b ¬c | t = refl
+   ... | tri> ¬a ¬b c | t = ⊥-elim ( ¬b t )
+   piso← (suc x) with <-cmp (toℕ x) (suc m)
+   ... | tri> ¬a ¬b c with <-cmp (toℕ (suc x)) (suc m)
+   ... | tri< a ¬b₁ ¬c = ⊥-elim ( nat-<> a (<-trans c a<sa ) )
+   ... | tri≈ ¬a₁ b ¬c = ⊥-elim (  nat-≡< (sym b) (<-trans c a<sa ))
+   ... | tri> ¬a₁ ¬b₁ c₁ = refl
+   piso← (suc x) | tri≈ ¬a b ¬c with <-cmp (toℕ (suc x)) (suc m)
+   ... | tri< a ¬b ¬c₁ = ⊥-elim (  nat-≡< b (<-trans a<sa a) ) 
+   ... | tri≈ ¬a₁ refl ¬c₁ = ⊥-elim ( nat-≡< b a<sa )
+   ... | tri> ¬a₁ ¬b c = refl
+   piso← (suc x) | tri< a ¬b ¬c with <-cmp (toℕ ( fromℕ< (≤-trans (fin<n {_} {x}) a≤sa ) )) (suc m)
+   ... | tri≈ ¬a b ¬c₁ = ⊥-elim ( ¬a (s≤s (mma x a)))
+   ... | tri> ¬a ¬b₁ c = ⊥-elim ( ¬a (s≤s (mma x a)))
+   ... | tri< a₁ ¬b₁ ¬c₁ = p0 where
+       p2 : suc (suc (toℕ x)) ≤ suc (suc n)
+       p2 = s≤s (fin<n {suc n} {x})
+       p6 : suc (toℕ (fromℕ< (≤-trans (fin<n {_} {suc x}) (s≤s a≤sa)))) ≤ suc (suc n)
+       p6 = s≤s (≤-trans a₁ (s≤s m≤n))
+       p0 : fromℕ< (≤-trans (s≤s  a₁) (s≤s (s≤s  m≤n) ))  ≡ suc x
+       p0 = begin
+             fromℕ< (≤-trans (s≤s  a₁) (s≤s (s≤s  m≤n) ))
+          ≡⟨⟩
+             fromℕ< (s≤s (≤-trans a₁ (s≤s m≤n))) 
+          ≡⟨ lemma10 {suc (suc n)} (p3 x) {p6} {p2} ⟩
+             fromℕ< ( s≤s (fin<n {suc n} {x}) )
+          ≡⟨⟩
+             suc (fromℕ< (fin<n {suc n} {x} )) 
+          ≡⟨ cong suc (fromℕ<-toℕ x _ ) ⟩
+             suc x
+          ∎ 
+
+t7 =  plist (pins {3} (n≤ 3)) ∷ plist (flip ( pins {3} (n≤ 3) )) ∷  plist ( pins {3} (n≤ 3)  ∘ₚ  flip ( pins {3} (n≤ 3))) ∷ []
+-- t8 =  {!!}
+
+open import logic 
+
+open _∧_
+
+perm1 :  {perm : Permutation 1 1 } {q : Fin 1}  → (perm ⟨$⟩ʳ q ≡ # 0)  ∧ ((perm ⟨$⟩ˡ q ≡ # 0))
+perm1 {p} {q} = ⟪ perm01 _ _ , perm00 _ _ ⟫ where
+   perm01 : (x y : Fin 1) → (p ⟨$⟩ʳ x) ≡  y
+   perm01 x y with p ⟨$⟩ʳ x
+   perm01 zero zero | zero = refl
+   perm00 : (x y : Fin 1) → (p ⟨$⟩ˡ x) ≡  y
+   perm00 x y with p ⟨$⟩ˡ x
+   perm00 zero zero | zero = refl
+
+
+----
+--  find insertion point of pins
+----
+p=0 : {n : ℕ }  → (perm : Permutation (suc n) (suc n) ) → ((perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) ⟨$⟩ˡ (# 0)) ≡ # 0
+p=0 {zero} perm with ((perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) ⟨$⟩ˡ (# 0)) 
+... | zero = refl
+p=0 {suc n} perm with perm ⟨$⟩ʳ (# 0) | inspect (_⟨$⟩ʳ_ perm ) (# 0)| toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)) | inspect toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))
+... | zero |  record { eq = e} |  m<n | _ = p001 where
+   p001 : perm ⟨$⟩ˡ ( pins m<n ⟨$⟩ʳ zero) ≡ zero
+   p001 = subst (λ k → perm ⟨$⟩ˡ k ≡ zero ) e (inverseˡ perm)
+... | suc t |  record { eq = e } | m<n | record { eq = e1 }  = p002 where   -- m<n  : suc (toℕ t) ≤ suc n
+   p002 : perm ⟨$⟩ˡ ( pins m<n ⟨$⟩ʳ zero) ≡ zero
+   p002 = p005 zero (toℕ t)  refl m<n refl where   -- suc (toℕ t) ≤ suc n
+      p003 : (s : Fin (suc (suc n))) → s ≡ (perm ⟨$⟩ʳ (# 0)) → perm ⟨$⟩ˡ s  ≡ # 0
+      p003 s eq = subst (λ k → perm ⟨$⟩ˡ k ≡ zero ) (sym eq) (inverseˡ perm)
+      p005 : (x :  Fin (suc (suc n))) → (m : ℕ ) → x ≡ zero → (m≤n : suc m ≤ suc n ) → m ≡ toℕ t → perm ⟨$⟩ˡ ( pins m≤n ⟨$⟩ʳ zero) ≡ zero
+      p005 zero m eq (s≤s m≤n) meq = p004 where
+          p004 :  perm ⟨$⟩ˡ (fromℕ< (s≤s (s≤s m≤n))) ≡ zero
+          p004 = p003  (fromℕ< (s≤s (s≤s m≤n))) (
+             begin
+                fromℕ< (s≤s (s≤s m≤n))
+             ≡⟨  lemma10 {suc (suc n)}  (cong suc meq) {s≤s (s≤s m≤n)} {subst (λ k →  suc k < suc (suc n)) meq (s≤s (s≤s m≤n)) } ⟩
+                fromℕ< (subst (λ k →  suc k < suc (suc n)) meq (s≤s (s≤s m≤n)) )
+             ≡⟨ fromℕ<-toℕ {suc (suc n)} (suc t) (subst (λ k →  suc k < suc (suc n)) meq (s≤s (s≤s m≤n)) ) ⟩
+                suc t
+             ≡⟨ sym e ⟩
+                (perm ⟨$⟩ʳ (# 0))
+             ∎ )
+
+----
+--  other elements are preserved in pins
+----
+px=x : {n : ℕ }  → (x : Fin (suc n)) → pins ( toℕ≤pred[n] x ) ⟨$⟩ʳ (# 0) ≡ x
+px=x {n} zero = refl
+px=x {suc n} (suc x) = p001 where
+     p002 : fromℕ< (s≤s (toℕ≤pred[n] x)) ≡ x
+     p002 =  fromℕ<-toℕ x (s≤s (toℕ≤pred[n] x)) 
+     p001 :  (pins (toℕ≤pred[n] (suc x)) ⟨$⟩ʳ (# 0)) ≡ suc x
+     p001 with <-cmp 0 ((toℕ x))
+     ... | tri< a ¬b ¬c = cong suc p002
+     ... | tri≈ ¬a b ¬c = cong suc p002
+
+-- pp : {n : ℕ }  → (perm : Permutation (suc n) (suc n) ) →  Fin (suc n)
+-- pp  perm → (( perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) ⟨$⟩ˡ (# 0))
+
+plist2 : {n  : ℕ} → Permutation (suc n) (suc n) → (i : ℕ ) → i < suc n → List ℕ
+plist2  {n} perm zero _           = toℕ ( perm ⟨$⟩ʳ (fromℕ< {zero} (s≤s z≤n))) ∷ []
+plist2  {n} perm (suc i) (s≤s lt) = toℕ ( perm ⟨$⟩ʳ (fromℕ< (s≤s lt)))         ∷ plist2 perm  i (<-trans lt a<sa) 
+
+plist0  : {n  : ℕ} → Permutation n n → List ℕ
+plist0 {0} perm = []
+plist0 {suc n} perm = plist2 perm n a<sa
+
+open _=p=_
+
+--
+-- plist cong
+--
+←pleq  : {n  : ℕ} → (x y : Permutation n n ) → x =p= y → plist0 x ≡ plist0 y 
+←pleq {zero} x y eq = refl
+←pleq {suc n} x y eq =  ←pleq1  n a<sa where
+   ←pleq1  :   (i : ℕ ) → (i<sn : i < suc n ) →  plist2 x i i<sn ≡ plist2 y i i<sn
+   ←pleq1  zero _           = cong ( λ k → toℕ k ∷ [] ) ( peq eq (fromℕ< {zero} (s≤s z≤n)))
+   ←pleq1  (suc i) (s≤s lt) = cong₂ ( λ j k → toℕ j ∷ k ) ( peq eq (fromℕ< (s≤s lt)))  ( ←pleq1  i (<-trans lt a<sa) )
+
+headeq : {A : Set } →  {x y : A } → {xt yt : List A } → (x ∷ xt)  ≡ (y ∷ yt)  →  x ≡ y
+headeq refl = refl
+
+taileq : {A : Set } →  {x y : A } → {xt yt : List A } → (x ∷ xt)  ≡ (y ∷ yt)  →  xt ≡ yt
+taileq refl = refl
+
+--
+-- plist injection / equalizer 
+--
+--    if plist0 of two perm looks the same, the permutations are the same
+--
+pleq  : {n  : ℕ} → (x y : Permutation n n ) → plist0 x ≡ plist0 y → x =p= y
+pleq  {0} x y refl = record { peq = λ q → pleq0 q } where
+  pleq0 : (q : Fin 0 ) → (x ⟨$⟩ʳ q) ≡ (y ⟨$⟩ʳ q)
+  pleq0 ()
+pleq  {suc n} x y eq = record { peq = λ q → pleq1 n a<sa eq q fin<n } where
+  pleq1 : (i : ℕ ) → (i<sn : i < suc n ) →  plist2 x i i<sn ≡ plist2 y i i<sn → (q : Fin (suc n)) → toℕ q < suc i → x ⟨$⟩ʳ q ≡ y ⟨$⟩ʳ q
+  pleq1 zero i<sn eq q q<i with  <-cmp (toℕ q) zero
+  ... | tri< () ¬b ¬c
+  ... | tri> ¬a ¬b c = ⊥-elim (nat-≤> c q<i )
+  ... | tri≈ ¬a b ¬c = begin
+          x ⟨$⟩ʳ q
+       ≡⟨ cong ( λ k → x ⟨$⟩ʳ k ) (toℕ-injective b )⟩
+          x ⟨$⟩ʳ zero
+       ≡⟨ toℕ-injective (headeq eq) ⟩
+          y ⟨$⟩ʳ zero
+       ≡⟨ cong ( λ k → y ⟨$⟩ʳ k ) (sym (toℕ-injective b )) ⟩
+          y ⟨$⟩ʳ q
+       ∎ 
+  pleq1 (suc i) (s≤s i<sn) eq q q<i with <-cmp (toℕ q) (suc i)
+  ... | tri< a ¬b ¬c = pleq1 i (<-trans i<sn a<sa ) (taileq eq) q a
+  ... | tri> ¬a ¬b c = ⊥-elim (nat-≤> c q<i )
+  ... | tri≈ ¬a b ¬c = begin
+            x ⟨$⟩ʳ q
+       ≡⟨ cong (λ k → x ⟨$⟩ʳ k) (pleq3 b) ⟩
+            x ⟨$⟩ʳ (suc (fromℕ< i<sn))
+       ≡⟨ toℕ-injective pleq2  ⟩
+            y ⟨$⟩ʳ (suc (fromℕ< i<sn))
+       ≡⟨ cong (λ k → y ⟨$⟩ʳ k) (sym (pleq3 b)) ⟩
+            y ⟨$⟩ʳ q
+       ∎ where
+          pleq3 : toℕ q ≡ suc i → q ≡ suc (fromℕ< i<sn)
+          pleq3 tq=si = toℕ-injective ( begin
+                  toℕ  q
+               ≡⟨ b ⟩
+                  suc i
+               ≡⟨ sym (toℕ-fromℕ< (s≤s i<sn)) ⟩
+                  toℕ (fromℕ< (s≤s i<sn))
+               ≡⟨⟩
+                  toℕ (suc (fromℕ< i<sn))
+               ∎ ) 
+          pleq2 : toℕ ( x ⟨$⟩ʳ (suc (fromℕ< i<sn)) ) ≡ toℕ ( y ⟨$⟩ʳ (suc (fromℕ< i<sn)) )
+          pleq2 = headeq eq
+
+is-=p= : {n  : ℕ} → (x y : Permutation n n ) → Dec (x =p= y )
+is-=p= {zero} x y = yes record { peq = λ () }
+is-=p= {suc n} x y with ℕL-eq? (plist0 x ) ( plist0 y )
+... | yes t = yes (pleq x y t)
+... | no t = no ( contra-position (←pleq x y) t )
+
+pprep-cong : {n  : ℕ} → {x y : Permutation n n } → x =p= y → pprep x =p= pprep y
+pprep-cong {n} {x} {y} x=y = record { peq = pprep-cong1 } where
+   pprep-cong1 : (q : Fin (suc n)) → (pprep x ⟨$⟩ʳ q) ≡ (pprep y ⟨$⟩ʳ q)
+   pprep-cong1 zero = refl
+   pprep-cong1 (suc q) = begin
+          pprep x ⟨$⟩ʳ suc q
+        ≡⟨⟩
+          suc ( x ⟨$⟩ʳ q )
+        ≡⟨ cong ( λ k → suc k ) ( peq x=y q ) ⟩
+          suc ( y ⟨$⟩ʳ q )
+        ≡⟨⟩
+          pprep y ⟨$⟩ʳ suc q
+        ∎  
+
+pprep-dist : {n  : ℕ} → {x y : Permutation n n } → pprep (x ∘ₚ y) =p= (pprep x ∘ₚ pprep y)
+pprep-dist {n} {x} {y} = record { peq = pprep-dist1 } where
+   pprep-dist1 : (q : Fin (suc n)) → (pprep (x ∘ₚ y) ⟨$⟩ʳ q) ≡ ((pprep x ∘ₚ pprep y) ⟨$⟩ʳ q)
+   pprep-dist1 zero = refl
+   pprep-dist1 (suc q) =  cong ( λ k → suc k ) refl
+
+pswap-cong : {n  : ℕ} → {x y : Permutation n n } → x =p= y → pswap x =p= pswap y
+pswap-cong {n} {x} {y} x=y = record { peq = pswap-cong1 } where
+   pswap-cong1 : (q : Fin (suc (suc n))) → (pswap x ⟨$⟩ʳ q) ≡ (pswap y ⟨$⟩ʳ q)
+   pswap-cong1 zero = refl
+   pswap-cong1 (suc zero) = refl
+   pswap-cong1 (suc (suc q)) = begin
+          pswap x ⟨$⟩ʳ suc (suc q)
+        ≡⟨⟩
+          suc (suc (x ⟨$⟩ʳ q))
+        ≡⟨ cong ( λ k → suc (suc k) ) ( peq x=y q ) ⟩
+          suc (suc (y ⟨$⟩ʳ q))
+        ≡⟨⟩
+          pswap y ⟨$⟩ʳ suc (suc q)
+        ∎  
+ 
+pswap-dist : {n  : ℕ} → {x y : Permutation n n } → pprep (pprep (x ∘ₚ y)) =p= (pswap x ∘ₚ pswap y)
+pswap-dist {n} {x} {y} = record { peq = pswap-dist1 } where
+   pswap-dist1 : (q : Fin (suc (suc n))) → ((pprep (pprep (x ∘ₚ y))) ⟨$⟩ʳ q) ≡ ((pswap x ∘ₚ pswap y) ⟨$⟩ʳ q)
+   pswap-dist1 zero = refl
+   pswap-dist1 (suc zero) = refl
+   pswap-dist1 (suc (suc q)) =  cong ( λ k → suc (suc k) ) refl
+
+shlem→ : {n  : ℕ} → (perm : Permutation (suc n) (suc n) ) → (p0=0 : perm ⟨$⟩ˡ (# 0) ≡ # 0 ) → (x : Fin (suc n) ) →  perm ⟨$⟩ˡ x ≡ zero → x ≡ zero
+shlem→ perm p0=0 x px=0 = begin
+          x                                  ≡⟨ sym ( inverseʳ perm ) ⟩
+          perm ⟨$⟩ʳ ( perm ⟨$⟩ˡ x)           ≡⟨ cong (λ k →  perm ⟨$⟩ʳ k ) px=0 ⟩
+          perm ⟨$⟩ʳ zero                     ≡⟨ cong (λ k →  perm ⟨$⟩ʳ k ) (sym p0=0) ⟩
+          perm ⟨$⟩ʳ ( perm ⟨$⟩ˡ zero)        ≡⟨ inverseʳ perm  ⟩
+          zero
+       ∎ 
+
+shlem← : {n  : ℕ} → (perm : Permutation (suc n) (suc n) ) → (p0=0 : perm ⟨$⟩ˡ (# 0) ≡ # 0 ) → (x : Fin (suc n)) → perm ⟨$⟩ʳ x ≡ zero → x ≡ zero
+shlem← perm p0=0 x px=0 =  begin
+          x                                  ≡⟨ sym (inverseˡ perm ) ⟩
+          perm ⟨$⟩ˡ ( perm ⟨$⟩ʳ x )          ≡⟨ cong (λ k →  perm ⟨$⟩ˡ k ) px=0 ⟩
+          perm ⟨$⟩ˡ zero                     ≡⟨ p0=0  ⟩
+          zero
+       ∎ 
+
+sh2 : {n  : ℕ} → (perm : Permutation (suc n) (suc n) ) → (p0=0 : perm ⟨$⟩ˡ (# 0) ≡ # 0 ) → {x : Fin n} → ¬ perm ⟨$⟩ˡ (suc x) ≡ zero
+sh2 perm p0=0 {x} eq with shlem→ perm p0=0 (suc x) eq
+sh2 perm p0=0 {x} eq | ()
+
+sh1 : {n  : ℕ} → (perm : Permutation (suc n) (suc n) ) → (p0=0 : perm ⟨$⟩ˡ (# 0) ≡ # 0 ) → {x : Fin n} → ¬ perm ⟨$⟩ʳ (suc x) ≡ zero
+sh1 perm p0=0 {x} eq with shlem← perm p0=0 (suc x) eq
+sh1 perm p0=0 {x} eq | ()
+
+
+-- 0 ∷ 1 ∷ 2 ∷ 3 ∷ [] → 0 ∷ 1 ∷ 2 ∷ [] 
+shrink : {n  : ℕ} → (perm : Permutation (suc n) (suc n) ) → perm ⟨$⟩ˡ (# 0) ≡ # 0 → Permutation n n
+shrink {n} perm p0=0  = permutation p→ p← record { left-inverse-of = piso→ ; right-inverse-of = piso← } where
+
+   p→ : Fin n → Fin n 
+   p→ x with perm ⟨$⟩ʳ (suc x) | inspect (_⟨$⟩ʳ_ perm ) (suc x) 
+   p→ x | zero  | record { eq = e } = ⊥-elim ( sh1 perm p0=0 {x} e )
+   p→ x | suc t | _ = t
+
+   p← : Fin n → Fin n 
+   p← x with perm ⟨$⟩ˡ (suc x) | inspect (_⟨$⟩ˡ_ perm ) (suc x) 
+   p← x | zero  | record { eq = e } = ⊥-elim ( sh2 perm p0=0 {x} e )
+   p← x | suc t | _ = t
+
+   piso← : (x : Fin n ) → p→ ( p← x ) ≡ x
+   piso← x with perm ⟨$⟩ˡ (suc x) | inspect (_⟨$⟩ˡ_ perm ) (suc x) 
+   piso← x | zero  | record { eq = e } = ⊥-elim ( sh2 perm p0=0 {x} e )
+   piso← x | suc t | _ with perm ⟨$⟩ʳ (suc t) | inspect (_⟨$⟩ʳ_ perm ) (suc t)
+   piso← x | suc t | _ | zero |  record { eq = e } =  ⊥-elim ( sh1 perm p0=0 e )
+   piso← x | suc t |  record { eq = e0 } | suc t1 |  record { eq = e1 } = begin
+          t1
+       ≡⟨ plem0 plem1 ⟩
+          x
+       ∎ where
+          open ≡-Reasoning
+          plem0 :  suc t1 ≡ suc x → t1 ≡ x
+          plem0 refl = refl
+          plem1 :  suc t1 ≡ suc x
+          plem1 = begin
+               suc t1
+            ≡⟨ sym e1 ⟩
+               Inverse.to perm Π.⟨$⟩ suc t
+            ≡⟨ cong (λ k →  Inverse.to perm Π.⟨$⟩ k ) (sym e0) ⟩
+               Inverse.to perm Π.⟨$⟩ ( Inverse.from perm Π.⟨$⟩ suc x )
+            ≡⟨ inverseʳ perm   ⟩
+               suc x
+            ∎ 
+
+   piso→ : (x : Fin n ) → p← ( p→ x ) ≡ x
+   piso→ x with perm ⟨$⟩ʳ (suc x) | inspect (_⟨$⟩ʳ_ perm ) (suc x)
+   piso→ x | zero  | record { eq = e } = ⊥-elim ( sh1 perm p0=0 {x} e )
+   piso→ x | suc t | _ with perm ⟨$⟩ˡ (suc t) | inspect (_⟨$⟩ˡ_ perm ) (suc t)
+   piso→ x | suc t | _ | zero |  record { eq = e } =  ⊥-elim ( sh2 perm p0=0 e )
+   piso→ x | suc t |  record { eq = e0 } | suc t1 |  record { eq = e1 } = begin
+          t1
+       ≡⟨ plem2 plem3 ⟩
+          x
+       ∎ where
+          plem2 :  suc t1 ≡ suc x → t1 ≡ x
+          plem2 refl = refl
+          plem3 :  suc t1 ≡ suc x
+          plem3 = begin
+               suc t1
+            ≡⟨ sym e1 ⟩
+               Inverse.from perm Π.⟨$⟩ suc t
+            ≡⟨ cong (λ k →  Inverse.from perm Π.⟨$⟩ k ) (sym e0 ) ⟩
+               Inverse.from perm Π.⟨$⟩ ( Inverse.to perm Π.⟨$⟩ suc x )
+            ≡⟨ inverseˡ perm   ⟩
+               suc x
+            ∎
+
+shrink-iso : { n : ℕ } → {perm : Permutation n n} → shrink (pprep perm)  refl =p=  perm
+shrink-iso {n} {perm} = record { peq = λ q → refl  } 
+
+shrink-iso2 : { n : ℕ } → {perm : Permutation (suc n) (suc n)} 
+   → (p=0 : perm ⟨$⟩ˡ (# 0) ≡ # 0)  → pprep (shrink perm p=0) =p= perm
+shrink-iso2 {n} {perm} p=0 = record { peq =  s001 } where
+    s001 : (q : Fin (suc n)) → (pprep (shrink perm p=0) ⟨$⟩ʳ q) ≡ perm ⟨$⟩ʳ q
+    s001 zero = begin
+         zero
+       ≡⟨ sym ( inverseʳ perm ) ⟩
+         perm ⟨$⟩ʳ ( perm ⟨$⟩ˡ zero )
+       ≡⟨ cong (λ k → perm ⟨$⟩ʳ k ) p=0 ⟩
+         perm ⟨$⟩ʳ zero
+       ∎ 
+    s001 (suc q) with perm ⟨$⟩ʳ (suc q) | inspect (_⟨$⟩ʳ_ perm ) (suc q) 
+    ... | zero | record {eq = e}  = ⊥-elim (sh1 perm p=0 {q} e)
+    ... | suc t | e = refl
+
+
+shrink-cong : { n : ℕ } → {x y : Permutation (suc n) (suc n)}
+    → x =p= y
+    → (x=0 :  x ⟨$⟩ˡ (# 0) ≡ # 0 ) → (y=0 : y ⟨$⟩ˡ (# 0) ≡ # 0 )  → shrink x x=0 =p=  shrink y y=0 
+shrink-cong {n} {x} {y} x=y x=0 y=0  = record  { peq = p002 } where
+    p002 : (q : Fin n) → (shrink x x=0 ⟨$⟩ʳ q) ≡ (shrink y y=0 ⟨$⟩ʳ q)
+    p002 q with x ⟨$⟩ʳ (suc q) | inspect (_⟨$⟩ʳ_ x ) (suc q) | y ⟨$⟩ʳ (suc q) | inspect (_⟨$⟩ʳ_ y ) (suc q)
+    p002 q | zero   | record { eq = ex } | zero   | ey                  = ⊥-elim ( sh1 x x=0 ex )
+    p002 q | zero   | record { eq = ex } | suc py | ey                  = ⊥-elim ( sh1 x x=0 ex )
+    p002 q | suc px | ex                 | zero   | record { eq = ey }  = ⊥-elim ( sh1 y y=0 ey )
+    p002 q | suc px | record { eq = ex } | suc py | record { eq = ey }  = p003 ( begin
+           suc px
+         ≡⟨ sym ex ⟩
+           x ⟨$⟩ʳ (suc q)
+         ≡⟨ peq x=y (suc q) ⟩
+           y ⟨$⟩ʳ (suc q)
+         ≡⟨ ey ⟩
+           suc py
+         ∎ ) where
+        p003 : suc px ≡ suc py → px ≡ py
+        p003 refl = refl
+
+open import FLutil
+
+FL→perm   : {n : ℕ }  → FL n → Permutation n n 
+FL→perm f0 = pid
+FL→perm (x :: fl) = pprep (FL→perm fl)  ∘ₚ pins ( toℕ≤pred[n] x )
+
+t40 =                (# 2) :: ( (# 1) :: (( # 0 ) :: f0 )) 
+t4 =  FL→perm ((# 2) :: t40 )
+
+-- t1 = plist (shrink (pid {3}  ∘ₚ (pins (n≤ 1))) refl)
+t2 = plist ((pid {5} ) ∘ₚ transpose (# 2) (# 4)) ∷ plist (pid {5} ∘ₚ reverse )   ∷  []
+t3 = plist (FL→perm t40) -- ∷ plist (pprep (FL→perm t40))
+    -- ∷ plist ( pprep (FL→perm t40) ∘ₚ  pins ( n≤ 0 {3}  ))
+    -- ∷ plist ( pprep (FL→perm t40 )∘ₚ  pins ( n≤ 1 {2}  ))
+    -- ∷ plist ( pprep (FL→perm t40 )∘ₚ  pins ( n≤ 2 {1}  ))
+    -- ∷ plist ( pprep (FL→perm t40 )∘ₚ  pins ( n≤ 3 {0}  ))
+    ∷ plist ( FL→perm ((# 0) :: t40))  --  (0 ∷ 1 ∷ 2 ∷ []) ∷
+    ∷ plist ( FL→perm ((# 1) :: t40))  --  (0 ∷ 2 ∷ 1 ∷ []) ∷
+    ∷ plist ( FL→perm ((# 2) :: t40))  --  (1 ∷ 0 ∷ 2 ∷ []) ∷
+    ∷ plist ( FL→perm ((# 3) :: t40))  --  (2 ∷ 0 ∷ 1 ∷ []) ∷
+    -- ∷ plist ( FL→perm ((# 3) :: ((# 2) :: ( (# 0) :: (( # 0 ) :: f0 )) )))  --  (1 ∷ 2 ∷ 0 ∷ []) ∷
+    -- ∷ plist ( FL→perm ((# 3) :: ((# 2) :: ( (# 1) :: (( # 0 ) :: f0 )) )))  --  (2 ∷ 1 ∷ 0 ∷ []) ∷ 
+    -- ∷ plist ( (flip (FL→perm ((# 3) :: ((# 1) :: ( (# 0) :: (( # 0 ) :: f0 )) )))))
+    -- ∷ plist ( (flip (FL→perm ((# 3) :: ((# 1) :: ( (# 0) :: (( # 0 ) :: f0 )) ))) ∘ₚ (FL→perm ((# 3) :: (((# 1) :: ( (# 0) :: (( # 0 ) :: f0 )) )))) ))
+    ∷ []
+
+
+-- FL→plist-iso : {n : ℕ} → (f : FL n ) → plist→FL (FL→plist f ) ≡ f
+-- FL→plist-inject : {n : ℕ} → (f g : FL n ) → FL→plist f ≡ FL→plist g → f ≡ g
+
+perm→FL   : {n : ℕ }  → Permutation n n → FL n
+perm→FL {zero} perm = f0
+perm→FL {suc n} perm = (perm ⟨$⟩ʳ (# 0)) :: perm→FL (shrink (perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) (p=0 perm) ) 
+
+---FL→perm   : {n : ℕ }  → FL n → Permutation n n 
+---FL→perm   x = plist→perm ( FL→plis x)
+-- perm→FL   : {n : ℕ }  → Permutation n n → FL n
+-- perm→FL p  = plist→FL (plist p)
+
+-- pcong-pF : {n : ℕ }  → {x y : Permutation n n}  → x =p= y → perm→FL x ≡ perm→FL y
+-- pcong-pF {n} {x} {y} x=y = FL→plist-inject (subst ... (pleq← eq)) (perm→FL x) (perm→FL y)
+
+-- FL→iso : {n : ℕ }  → (fl : FL n )  → perm→FL ( FL→perm fl ) ≡ fl
+-- FL→iso = 
+-- pcong-Fp : {n : ℕ }  → {x y : FL n}  → x ≡ y → FL→perm x =p= FL→perm y
+-- FL←iso : {n : ℕ }  → (perm : Permutation n n )  → FL→perm ( perm→FL perm  ) =p= perm
+
+_p<_ : {n : ℕ } ( x y : Permutation n n ) → Set
+x p< y = perm→FL x f<  perm→FL y
+
+pcong-pF : {n : ℕ }  → {x y : Permutation n n}  → x =p= y → perm→FL x ≡ perm→FL y
+pcong-pF {zero} eq = refl
+pcong-pF {suc n} {x} {y} eq = cong₂ (λ j k → j :: k ) ( peq eq (# 0)) (pcong-pF (shrink-cong (presp eq p001 ) (p=0 x) (p=0 y))) where
+    p002 : x ⟨$⟩ʳ (# 0) ≡  y ⟨$⟩ʳ (# 0)
+    p002 = peq eq (# 0)
+    p001 : flip (pins (toℕ≤pred[n] (x ⟨$⟩ʳ (# 0)))) =p=  flip (pins (toℕ≤pred[n] (y ⟨$⟩ʳ (# 0))))
+    p001 = subst ( λ k →  flip (pins (toℕ≤pred[n] (x ⟨$⟩ʳ (# 0)))) =p=  flip (pins (toℕ≤pred[n] k ))) p002 prefl 
+
+-- t5 = plist t4 ∷ plist ( t4  ∘ₚ flip (pins ( n≤  3 ) ))
+t5 = plist (t4) ∷ plist (flip t4)
+    ∷ ( toℕ (t4 ⟨$⟩ˡ fromℕ< a<sa) ∷ [] )
+    ∷ ( toℕ (t4 ⟨$⟩ʳ (# 0)) ∷ [] )
+    -- ∷  plist ( t4  ∘ₚ flip (pins ( n≤  1 ) ))
+    ∷  plist (remove (# 0) t4  )
+    ∷  plist ( FL→perm t40 )
+    ∷ []
+ 
+t6 = perm→FL t4
+
+FL→iso : {n : ℕ }  → (fl : FL n )  → perm→FL ( FL→perm fl ) ≡ fl
+FL→iso f0 = refl
+FL→iso {suc n} (x :: fl) = cong₂ ( λ j k → j :: k ) f001 f002 where
+    perm = pprep (FL→perm fl)  ∘ₚ pins ( toℕ≤pred[n] x )
+    f001 : perm ⟨$⟩ʳ (# 0) ≡ x
+    f001 = begin
+       (pprep (FL→perm fl)  ∘ₚ pins ( toℕ≤pred[n] x )) ⟨$⟩ʳ (# 0) 
+     ≡⟨⟩
+       pins ( toℕ≤pred[n] x ) ⟨$⟩ʳ (# 0) 
+     ≡⟨ px=x x ⟩
+       x 
+     ∎
+    x=0 :  (perm ∘ₚ flip (pins (toℕ≤pred[n] x))) ⟨$⟩ˡ (# 0) ≡ # 0
+    x=0 = subst ( λ k → (perm ∘ₚ flip (pins (toℕ≤pred[n] k))) ⟨$⟩ˡ (# 0) ≡ # 0 ) f001 (p=0 perm)
+    x=0' : (pprep (FL→perm fl) ∘ₚ pid) ⟨$⟩ˡ (# 0) ≡ # 0
+    x=0' = refl
+    f003 : (q : Fin (suc n)) →
+            ((perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) ⟨$⟩ʳ q) ≡
+            ((perm ∘ₚ flip (pins (toℕ≤pred[n] x))) ⟨$⟩ʳ q)
+    f003 q = cong (λ k → (perm ∘ₚ flip (pins (toℕ≤pred[n] k))) ⟨$⟩ʳ q ) f001 
+    f002 : perm→FL (shrink (perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) (p=0 perm) )  ≡ fl
+    f002 = begin
+        perm→FL (shrink (perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) (p=0 perm) )  
+     ≡⟨ pcong-pF (shrink-cong {n} {perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))} {perm ∘ₚ flip (pins (toℕ≤pred[n] x))} record {peq = f003 }  (p=0 perm)  x=0) ⟩
+        perm→FL (shrink (perm ∘ₚ flip (pins (toℕ≤pred[n] x))) x=0 ) 
+     ≡⟨⟩
+        perm→FL (shrink ((pprep (FL→perm fl)  ∘ₚ pins ( toℕ≤pred[n] x )) ∘ₚ flip (pins (toℕ≤pred[n] x))) x=0 )
+     ≡⟨ pcong-pF (shrink-cong (passoc (pprep (FL→perm fl)) (pins ( toℕ≤pred[n] x )) (flip (pins (toℕ≤pred[n] x))) )  x=0 x=0) ⟩
+        perm→FL (shrink (pprep (FL→perm fl)  ∘ₚ (pins ( toℕ≤pred[n] x ) ∘ₚ flip (pins (toℕ≤pred[n] x)))) x=0 )
+     ≡⟨ pcong-pF (shrink-cong {n} {pprep (FL→perm fl)  ∘ₚ (pins ( toℕ≤pred[n] x ) ∘ₚ flip (pins (toℕ≤pred[n] x)))} {pprep (FL→perm fl)  ∘ₚ pid}
+             ( presp {suc n} {pprep (FL→perm fl) }  {_} {(pins ( toℕ≤pred[n] x ) ∘ₚ flip (pins (toℕ≤pred[n] x)))} {pid} prefl
+             record { peq = λ q → inverseˡ (pins ( toℕ≤pred[n] x )) } )  x=0 x=0') ⟩
+        perm→FL (shrink (pprep (FL→perm fl)  ∘ₚ pid) x=0' )
+     ≡⟨ pcong-pF (shrink-cong {n} {pprep (FL→perm fl)  ∘ₚ pid} {pprep (FL→perm fl)} record {peq = λ q → refl }  x=0' x=0') ⟩ -- prefl won't work
+        perm→FL (shrink (pprep (FL→perm fl)) x=0' )
+     ≡⟨ pcong-pF shrink-iso ⟩
+        perm→FL ( FL→perm fl ) 
+     ≡⟨ FL→iso fl  ⟩
+        fl 
+     ∎ 
+
+pcong-Fp : {n : ℕ }  → {x y : FL n}  → x ≡ y → FL→perm x =p= FL→perm y
+pcong-Fp {n} {x} {x} refl = prefl
+
+FL←iso : {n : ℕ }  → (perm : Permutation n n )  → FL→perm ( perm→FL perm  ) =p= perm
+FL←iso {0} perm = record { peq = λ () }
+FL←iso {suc n} perm = record { peq = λ q → ( begin
+        FL→perm ( perm→FL perm  ) ⟨$⟩ʳ q
+     ≡⟨⟩
+        (pprep (FL→perm (perm→FL (shrink (perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) (p=0 perm) )))  ∘ₚ pins ( toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)) ) ) ⟨$⟩ʳ q
+     ≡⟨  peq (presp {suc n} {_} {_} {pins ( toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)))} (pprep-cong {n} {FL→perm (perm→FL (shrink (perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) (p=0 perm) ))} (FL←iso _ ) ) prefl ) q  ⟩
+         (pprep (shrink (perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) (p=0 perm))   ∘ₚ pins ( toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)) ))  ⟨$⟩ʳ q 
+     ≡⟨ peq (presp {suc n} {pprep (shrink (perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) (p=0 perm))} {perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))} {pins ( toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)) )} (shrink-iso2 (p=0 perm)) prefl) q  ⟩
+         ((perm ∘ₚ flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0))))) ∘ₚ pins ( toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)) ))  ⟨$⟩ʳ q 
+     ≡⟨ peq (presp {suc n} {perm} {_} {flip (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)))) ∘ₚ pins ( toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)))} {pid} prefl record { peq = λ q → inverseʳ (pins (toℕ≤pred[n] (perm ⟨$⟩ʳ (# 0)))) }) q  ⟩
+        ( perm ∘ₚ pid ) ⟨$⟩ʳ q
+     ≡⟨⟩
+        perm ⟨$⟩ʳ q
+     ∎  ) } 
+
+FL-inject : {n : ℕ }  → {g h : Permutation n n }  → perm→FL g ≡  perm→FL h → g =p= h
+FL-inject {n} {g} {h} g=h = record { peq = λ q → ( begin
+       g ⟨$⟩ʳ q
+     ≡⟨ peq (psym (FL←iso g )) q ⟩
+        (  FL→perm (perm→FL g) ) ⟨$⟩ʳ q
+     ≡⟨ cong ( λ k → FL→perm  k ⟨$⟩ʳ q  ) g=h  ⟩
+        (  FL→perm (perm→FL h) ) ⟨$⟩ʳ q
+     ≡⟨ peq (FL←iso h) q ⟩
+        h ⟨$⟩ʳ q
+     ∎  ) }
+
+FLpid :  {n : ℕ} → (x : Permutation n n) → perm→FL x ≡ FL0 → FL→perm FL0 =p= pid   → x =p= pid
+FLpid x eq p0id = ptrans pf2 (ptrans pf0 p0id ) where
+   pf2 : x =p= FL→perm (perm→FL x)
+   pf2 = psym (FL←iso x)
+   pf0 : FL→perm (perm→FL x) =p= FL→perm FL0
+   pf0 = pcong-Fp eq
+
+pFL0 : {n : ℕ } → FL0 {n} ≡ perm→FL pid
+pFL0 {zero} = refl
+pFL0 {suc n} = cong (λ k → zero :: k ) pFL0
diff -r a5b3061f15ee -r 6d1619d9f880 src/Solvable.agda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Solvable.agda	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,103 @@
+open import Level hiding ( suc ; zero )
+open import Algebra
+module Solvable {n m : Level} (G : Group n m ) where
+
+open import Data.Unit
+open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
+open import Function
+open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
+open import Relation.Nullary
+open import Data.Empty
+open import Data.Product
+open import  Relation.Binary.PropositionalEquality hiding ( [_] ; sym )
+
+
+open Group G
+open import Gutil G
+
+[_,_] :  Carrier   → Carrier   → Carrier  
+[ g , h ] = g ⁻¹ ∙ h ⁻¹ ∙ g ∙ h 
+
+data Commutator (P : Carrier → Set (Level.suc n ⊔ m)) : (f : Carrier) → Set (Level.suc n ⊔ m) where
+  comm  : {g h : Carrier} → P g → P h  → Commutator P [ g , h ] 
+  ccong : {f g : Carrier} → f ≈ g → Commutator P f → Commutator P g
+
+deriving : ( i : ℕ ) → Carrier → Set (Level.suc n ⊔ m)
+deriving 0 x = Lift (Level.suc n ⊔ m) ⊤
+deriving (suc i) x = Commutator (deriving i) x 
+
+open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ )
+
+deriving-subst : { i : ℕ } → {x y : Carrier } → x ≈ y → (dx : deriving i x ) → deriving i y 
+deriving-subst {zero} {x} {y} x=y dx = lift tt
+deriving-subst {suc i} {x} {y} x=y dx = ccong x=y dx
+
+record solvable : Set (Level.suc n ⊔ m) where
+  field 
+     dervied-length : ℕ
+     end : (x : Carrier ) → deriving dervied-length x →  x ≈ ε  
+
+-- deriving stage is closed on multiplication and inversion
+
+import Relation.Binary.Reasoning.Setoid as EqReasoning
+
+open EqReasoning (Algebra.Group.setoid G)
+
+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 ]  ⁻¹                  
+     ∎ 
+
+deriving-inv : { i : ℕ } → { x  : Carrier } → deriving i x → deriving i ( x ⁻¹ )
+deriving-inv {zero} {x} (lift tt) = lift tt
+deriving-inv {suc i} {_} (comm x x₁ )   = ccong (lemma4 _ _) (comm x₁ x) 
+deriving-inv {suc i} {x} (ccong eq ix ) = ccong (⁻¹-cong eq) ( deriving-inv ix )
+
+idcomtr : (g  : Carrier ) → [ g , ε  ] ≈ ε 
+idcomtr g  = begin
+       (g ⁻¹ ∙ ε  ⁻¹ ∙   g ∙ ε )              ≈⟨ ∙-cong (∙-cong (∙-cong grefl (sym lemma3 )) grefl ) grefl ⟩ 
+       (g ⁻¹ ∙ ε   ∙   g ∙ ε )                ≈⟨ ∙-cong (∙-cong (proj₂ identity _) grefl)  grefl ⟩
+       (g ⁻¹   ∙   g ∙ ε     )                ≈⟨ ∙-cong (proj₁ inverse _ )   grefl ⟩
+       (  ε  ∙ ε     )                        ≈⟨  proj₂ identity _  ⟩
+       ε
+     ∎ 
+
+idcomtl : (g  : Carrier ) → [ ε ,  g ] ≈ ε 
+idcomtl g  = begin
+       (ε ⁻¹ ∙ g  ⁻¹ ∙   ε ∙ g )              ≈⟨ ∙-cong (proj₂ identity _) grefl ⟩ 
+       (ε ⁻¹ ∙ g  ⁻¹ ∙    g )                ≈⟨ ∙-cong (∙-cong (sym lemma3 ) grefl ) grefl ⟩
+       (ε  ∙ g  ⁻¹ ∙    g )                  ≈⟨ ∙-cong (proj₁ identity _) grefl ⟩
+       (g ⁻¹   ∙    g     )                ≈⟨  proj₁ inverse _ ⟩
+       ε
+     ∎ 
+
+deriving-ε : { i : ℕ } → deriving i ε
+deriving-ε {zero} = lift tt
+deriving-ε {suc i} = ccong (idcomtr ε) (comm deriving-ε deriving-ε) 
+
+comm-refl : {f g : Carrier } → f ≈ g  → [ f ,  g ] ≈ ε 
+comm-refl {f} {g} f=g = begin
+       f ⁻¹ ∙ g ⁻¹ ∙   f ∙ g
+     ≈⟨ ∙-cong (∙-cong (∙-cong (⁻¹-cong f=g ) grefl ) f=g ) grefl ⟩
+       g ⁻¹ ∙ g ⁻¹ ∙   g ∙ g
+     ≈⟨ ∙-cong (assoc _ _ _ ) grefl  ⟩
+       g ⁻¹ ∙ (g ⁻¹ ∙   g ) ∙ g
+     ≈⟨ ∙-cong (∙-cong grefl (proj₁ inverse _) ) grefl ⟩
+       g ⁻¹ ∙ ε  ∙ g 
+     ≈⟨ ∙-cong (proj₂ identity _) grefl  ⟩
+       g ⁻¹ ∙  g 
+     ≈⟨  proj₁ inverse _  ⟩
+       ε
+     ∎ 
+
+comm-resp : {g h g1 h1  : Carrier } → g ≈ g1  → h ≈ h1 → [ g , h ] ≈ [ g1 , h1 ] 
+comm-resp {g} {h} {g1} {h1} g=g1 h=h1 =  ∙-cong (∙-cong (∙-cong (⁻¹-cong g=g1 ) (⁻¹-cong h=h1 )) g=g1 ) h=h1
+
diff -r a5b3061f15ee -r 6d1619d9f880 src/Symmetric.agda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/Symmetric.agda	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,87 @@
+module Symmetric where
+
+open import Level hiding ( suc ; zero )
+open import Algebra
+open import Algebra.Structures
+open import Data.Fin hiding ( _<_  ; _≤_ ; _-_ ; _+_ )
+open import Data.Fin.Properties hiding ( <-trans ; ≤-trans ) renaming ( <-cmp to <-fcmp )
+open import Data.Product
+open import Data.Fin.Permutation
+open import Function hiding (id ; flip)
+open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
+open import Function.LeftInverse  using ( _LeftInverseOf_ )
+open import Function.Equality using (Π)
+open import Data.Nat -- using (ℕ; suc; zero; s≤s ; z≤n )
+open import Data.Nat.Properties -- using (<-trans)
+open import Relation.Binary.PropositionalEquality 
+open import Data.List using (List; []; _∷_ ; length ; _++_ ; head ) renaming (reverse to rev )
+open import nat
+
+fid : {p : ℕ } → Fin p → Fin p
+fid x = x
+
+-- Data.Fin.Permutation.id
+pid : {p : ℕ } → Permutation p p
+pid = permutation fid fid record { left-inverse-of = λ x → refl ; right-inverse-of = λ x → refl }
+
+-- Data.Fin.Permutation.flip
+pinv : {p : ℕ } → Permutation p p → Permutation p p
+pinv {p} P = permutation (_⟨$⟩ˡ_ P) (_⟨$⟩ʳ_ P ) record { left-inverse-of = λ x → inverseʳ P ; right-inverse-of = λ x → inverseˡ P }
+
+record _=p=_ {p : ℕ } ( x y : Permutation p p )  : Set where
+    field
+       peq : ( q : Fin p ) → x ⟨$⟩ʳ q ≡ y ⟨$⟩ʳ q
+
+open _=p=_
+
+prefl : {p : ℕ } { x  : Permutation p p } → x =p= x
+peq (prefl {p} {x}) q = refl
+
+psym : {p : ℕ } { x y : Permutation p p } → x =p= y →  y =p= x
+peq (psym {p} {x} {y}  eq ) q = sym (peq eq q)
+
+ptrans : {p : ℕ } { x y z : Permutation p p } → x =p= y  → y =p= z →  x =p= z
+peq (ptrans {p} {x} {y} x=y y=z ) q = trans (peq x=y q) (peq y=z q)
+
+peqˡ :  {p : ℕ }{ x y : Permutation p p } → x =p= y → (q : Fin p)  →  x ⟨$⟩ˡ q ≡ y ⟨$⟩ˡ q
+peqˡ {p} {x} {y} eq q = begin
+       x ⟨$⟩ˡ q
+   ≡⟨ sym ( inverseˡ y ) ⟩
+       y ⟨$⟩ˡ (y ⟨$⟩ʳ ( x ⟨$⟩ˡ  q ))
+   ≡⟨ cong (λ k → y ⟨$⟩ˡ k ) (sym (peq eq _ )) ⟩
+       y ⟨$⟩ˡ (x ⟨$⟩ʳ ( x ⟨$⟩ˡ  q ))
+   ≡⟨ cong (λ k → y ⟨$⟩ˡ k ) ( inverseʳ x ) ⟩
+       y ⟨$⟩ˡ q
+   ∎ where open ≡-Reasoning
+
+presp : { p : ℕ } {x y u v : Permutation p p } → x =p= y → u =p= v → (x ∘ₚ u) =p= (y ∘ₚ v)
+presp {p} {x} {y} {u} {v} x=y u=v = record { peq = λ q → lemma4 q } where
+   lemma4 : (q : Fin p) → ((x ∘ₚ u) ⟨$⟩ʳ q) ≡ ((y ∘ₚ v) ⟨$⟩ʳ q)
+   lemma4 q = trans (cong (λ k → Inverse.to u Π.⟨$⟩ k) (peq x=y q) ) (peq u=v _ )
+passoc : { p : ℕ } (x y z : Permutation p p) → ((x ∘ₚ y) ∘ₚ z) =p=  (x ∘ₚ (y ∘ₚ z))
+passoc x y z = record { peq = λ q → refl }
+p-inv : { p : ℕ } {i j : Permutation p p} →  i =p= j → (q : Fin p) → pinv i ⟨$⟩ʳ q ≡ pinv j ⟨$⟩ʳ q
+p-inv {p} {i} {j} i=j q = begin
+   i ⟨$⟩ˡ q                      ≡⟨ cong (λ k → i ⟨$⟩ˡ k) (sym (inverseʳ j)  )  ⟩
+   i ⟨$⟩ˡ ( j ⟨$⟩ʳ ( j ⟨$⟩ˡ q )) ≡⟨ cong (λ k  →  i ⟨$⟩ˡ k) (sym (peq i=j _ ))  ⟩
+   i ⟨$⟩ˡ ( i ⟨$⟩ʳ ( j ⟨$⟩ˡ q )) ≡⟨ inverseˡ i  ⟩
+   j ⟨$⟩ˡ q
+   ∎ where open ≡-Reasoning
+
+Symmetric : ℕ → Group  Level.zero Level.zero
+Symmetric p = record {
+      Carrier        = Permutation p p
+    ; _≈_            = _=p=_
+    ; _∙_            = _∘ₚ_
+    ; ε              = pid
+    ; _⁻¹            = pinv
+    ; isGroup = record { isMonoid  = record { isSemigroup = record { isMagma = record {
+       isEquivalence = record {refl = prefl ; trans = ptrans ; sym = psym }
+       ; ∙-cong = presp }
+       ; assoc = passoc }
+       ; identity = ( (λ q → record { peq = λ q → refl } ) , (λ q → record { peq = λ q → refl } ))  }
+       ; inverse   = ( (λ x → record { peq = λ q → inverseʳ x} ) , (λ x → record { peq = λ q → inverseˡ x} ))  
+       ; ⁻¹-cong   = λ i=j → record { peq = λ q → p-inv i=j q }
+      }
+   } 
+
diff -r a5b3061f15ee -r 6d1619d9f880 src/fin.agda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/fin.agda	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,117 @@
+{-# OPTIONS --allow-unsolved-metas #-} 
+
+module fin where
+
+open import Data.Fin hiding (_<_ ; _≤_ )
+open import Data.Fin.Properties hiding ( <-trans )
+open import Data.Nat
+open import logic
+open import nat
+open import Relation.Binary.PropositionalEquality
+
+
+-- toℕ<n
+fin<n : {n : ℕ} {f : Fin n} → toℕ f < n
+fin<n {_} {zero} = s≤s z≤n
+fin<n {suc n} {suc f} = s≤s (fin<n {n} {f})
+
+-- toℕ≤n
+fin≤n : {n : ℕ} (f : Fin (suc n)) → toℕ f ≤ n
+fin≤n {_} zero = z≤n
+fin≤n {suc n} (suc f) = s≤s (fin≤n {n} f)
+
+pred<n : {n : ℕ} {f : Fin (suc n)} → n > 0  → Data.Nat.pred (toℕ f) < n
+pred<n {suc n} {zero} (s≤s z≤n) = s≤s z≤n
+pred<n {suc n} {suc f} (s≤s z≤n) = fin<n
+
+fin<asa : {n : ℕ} → toℕ (fromℕ< {n} a<sa) ≡ n
+fin<asa = toℕ-fromℕ< nat.a<sa
+
+-- fromℕ<-toℕ
+toℕ→from : {n : ℕ} {x : Fin (suc n)} → toℕ x ≡ n → fromℕ n ≡ x
+toℕ→from {0} {zero} refl = refl
+toℕ→from {suc n} {suc x} eq = cong (λ k → suc k ) ( toℕ→from {n} {x} (cong (λ k → Data.Nat.pred k ) eq ))
+
+0≤fmax : {n : ℕ } → (# 0) Data.Fin.≤ fromℕ< {n} a<sa
+0≤fmax  = subst (λ k → 0 ≤ k ) (sym (toℕ-fromℕ< a<sa)) z≤n
+
+0<fmax : {n : ℕ } → (# 0) Data.Fin.< fromℕ< {suc n} a<sa
+0<fmax = subst (λ k → 0 < k ) (sym (toℕ-fromℕ< a<sa)) (s≤s z≤n)
+
+-- toℕ-injective
+i=j : {n : ℕ} (i j : Fin n) → toℕ i ≡ toℕ j → i ≡ j
+i=j {suc n} zero zero refl = refl
+i=j {suc n} (suc i) (suc j) eq = cong ( λ k → suc k ) ( i=j i j (cong ( λ k → Data.Nat.pred k ) eq) )
+
+-- raise 1
+fin+1 :  { n : ℕ } → Fin n → Fin (suc n)
+fin+1  zero = zero 
+fin+1  (suc x) = suc (fin+1 x)
+
+open import Data.Nat.Properties as NatP  hiding ( _≟_ )
+
+fin+1≤ : { i n : ℕ } → (a : i < n)  → fin+1 (fromℕ< a) ≡ fromℕ< (<-trans a a<sa)
+fin+1≤ {0} {suc i} (s≤s z≤n) = refl
+fin+1≤ {suc n} {suc (suc i)} (s≤s (s≤s a)) = cong (λ k → suc k ) ( fin+1≤ {n} {suc i} (s≤s a) )
+
+fin+1-toℕ : { n : ℕ } → { x : Fin n} → toℕ (fin+1 x) ≡ toℕ x
+fin+1-toℕ {suc n} {zero} = refl
+fin+1-toℕ {suc n} {suc x} = cong (λ k → suc k ) (fin+1-toℕ {n} {x})
+
+open import Relation.Nullary 
+open import Data.Empty
+
+fin-1 :  { n : ℕ } → (x : Fin (suc n)) → ¬ (x ≡ zero )  → Fin n
+fin-1 zero ne = ⊥-elim (ne refl )
+fin-1 {n} (suc x) ne = x 
+
+fin-1-sx : { n : ℕ } → (x : Fin n) →  fin-1 (suc x) (λ ()) ≡ x 
+fin-1-sx zero = refl
+fin-1-sx (suc x) = refl
+
+fin-1-xs : { n : ℕ } → (x : Fin (suc n)) → (ne : ¬ (x ≡ zero ))  → suc (fin-1 x ne ) ≡ x
+fin-1-xs zero ne = ⊥-elim ( ne refl )
+fin-1-xs (suc x) ne = refl
+
+-- suc-injective
+-- suc-eq : {n : ℕ } {x y : Fin n} → Fin.suc x ≡ Fin.suc y  → x ≡ y
+-- suc-eq {n} {x} {y} eq = subst₂ (λ j k → j ≡ k ) {!!} {!!} (cong (λ k → Data.Fin.pred k ) eq )
+
+-- this is refl
+lemma3 : {a b : ℕ } → (lt : a < b ) → fromℕ< (s≤s lt) ≡ suc (fromℕ< lt)
+lemma3 (s≤s lt) = refl
+
+-- fromℕ<-toℕ 
+lemma12 : {n m : ℕ } → (n<m : n < m ) → (f : Fin m )  → toℕ f ≡ n → f ≡ fromℕ< n<m 
+lemma12 {zero} {suc m} (s≤s z≤n) zero refl = refl
+lemma12 {suc n} {suc m} (s≤s n<m) (suc f) refl =  cong suc ( lemma12 {n} {m} n<m f refl  ) 
+
+open import Relation.Binary.HeterogeneousEquality as HE using (_≅_ ) 
+open import Data.Fin.Properties
+
+-- <-irrelevant
+<-nat=irr : {i j n : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → i<n ≅ j<n  
+<-nat=irr {zero} {zero} {suc n} refl {s≤s z≤n} {s≤s z≤n} = HE.refl
+<-nat=irr {suc i} {suc i} {suc n} refl {s≤s i<n} {s≤s j<n} = HE.cong (λ k → s≤s k ) ( <-nat=irr {i} {i} {n} refl  )
+
+lemma8 : {i j n : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n } → i<n ≅ j<n  
+lemma8 {zero} {zero} {suc n} refl {s≤s z≤n} {s≤s z≤n} = HE.refl
+lemma8 {suc i} {suc i} {suc n} refl {s≤s i<n} {s≤s j<n} = HE.cong (λ k → s≤s k ) ( lemma8 {i} {i} {n} refl  )
+
+-- fromℕ<-irrelevant 
+lemma10 : {n i j  : ℕ } → ( i ≡ j ) → {i<n : i < n } → {j<n : j < n }  → fromℕ< i<n ≡ fromℕ< j<n
+lemma10 {n} refl  = HE.≅-to-≡ (HE.cong (λ k → fromℕ< k ) (lemma8 refl  ))
+
+lemma31 : {a b c : ℕ } → { a<b : a < b } { b<c : b < c } { a<c : a < c } → NatP.<-trans a<b b<c ≡ a<c
+lemma31 {a} {b} {c} {a<b} {b<c} {a<c} = HE.≅-to-≡ (lemma8 refl) 
+
+-- toℕ-fromℕ<
+lemma11 : {n m : ℕ } {x : Fin n } → (n<m : n < m ) → toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m)) ≡ toℕ x
+lemma11 {n} {m} {x} n<m  = begin
+              toℕ (fromℕ< (NatP.<-trans (toℕ<n x) n<m))
+           ≡⟨ toℕ-fromℕ< _ ⟩
+              toℕ x
+           ∎  where
+               open ≡-Reasoning
+
+
diff -r a5b3061f15ee -r 6d1619d9f880 src/logic.agda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/logic.agda	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,151 @@
+module logic where
+
+open import Level
+open import Relation.Nullary
+open import Relation.Binary hiding (_⇔_ )
+open import Data.Empty
+
+
+data Bool : Set where
+    true : Bool
+    false : Bool
+
+record  _∧_  {n m : Level} (A  : Set n) ( B : Set m ) : Set (n ⊔ m) where
+   constructor ⟪_,_⟫
+   field
+      proj1 : A
+      proj2 : B
+
+data  _∨_  {n m : Level} (A  : Set n) ( B : Set m ) : Set (n ⊔ m) where
+   case1 : A → A ∨ B
+   case2 : B → A ∨ B
+
+_⇔_ : {n m : Level } → ( A : Set n ) ( B : Set m )  → Set (n ⊔ m)
+_⇔_ A B =  ( A → B ) ∧ ( B → A )
+
+contra-position : {n m : Level } {A : Set n} {B : Set m} → (A → B) → ¬ B → ¬ A
+contra-position {n} {m} {A} {B}  f ¬b a = ¬b ( f a )
+
+double-neg : {n  : Level } {A : Set n} → A → ¬ ¬ A
+double-neg A notnot = notnot A
+
+double-neg2 : {n  : Level } {A : Set n} → ¬ ¬ ¬ A → ¬ A
+double-neg2 notnot A = notnot ( double-neg A )
+
+de-morgan : {n  : Level } {A B : Set n} →  A ∧ B  → ¬ ( (¬ A ) ∨ (¬ B ) )
+de-morgan {n} {A} {B} and (case1 ¬A) = ⊥-elim ( ¬A ( _∧_.proj1 and ))
+de-morgan {n} {A} {B} and (case2 ¬B) = ⊥-elim ( ¬B ( _∧_.proj2 and ))
+
+dont-or :　{n m : Level} {A  : Set n} { B : Set m } →  A ∨ B → ¬ A → B
+dont-or {A} {B} (case1 a) ¬A = ⊥-elim ( ¬A a )
+dont-or {A} {B} (case2 b) ¬A = b
+
+dont-orb :　{n m : Level} {A  : Set n} { B : Set m } →  A ∨ B → ¬ B → A
+dont-orb {A} {B} (case2 b) ¬B = ⊥-elim ( ¬B b )
+dont-orb {A} {B} (case1 a) ¬B = a
+
+
+infixr  130 _∧_
+infixr  140 _∨_
+infixr  150 _⇔_
+
+_/\_ : Bool → Bool → Bool 
+true /\ true = true
+_ /\ _ = false
+
+_\/_ : Bool → Bool → Bool 
+false \/ false = false
+_ \/ _ = true
+
+not_ : Bool → Bool 
+not true = false
+not false = true 
+
+_<=>_ : Bool → Bool → Bool  
+true <=> true = true
+false <=> false = true
+_ <=> _ = false
+
+infixr  130 _\/_
+infixr  140 _/\_
+
+open import Relation.Binary.PropositionalEquality
+
+≡-Bool-func : {A B : Bool } → ( A ≡ true → B ≡ true ) → ( B ≡ true → A ≡ true ) → A ≡ B
+≡-Bool-func {true} {true} a→b b→a = refl
+≡-Bool-func {false} {true} a→b b→a with b→a refl
+... | ()
+≡-Bool-func {true} {false} a→b b→a with a→b refl
+... | ()
+≡-Bool-func {false} {false} a→b b→a = refl
+
+bool-≡-? : (a b : Bool) → Dec ( a ≡ b )
+bool-≡-? true true = yes refl
+bool-≡-? true false = no (λ ())
+bool-≡-? false true = no (λ ())
+bool-≡-? false false = yes refl
+
+¬-bool-t : {a : Bool} →  ¬ ( a ≡ true ) → a ≡ false
+¬-bool-t {true} ne = ⊥-elim ( ne refl )
+¬-bool-t {false} ne = refl
+
+¬-bool-f : {a : Bool} →  ¬ ( a ≡ false ) → a ≡ true
+¬-bool-f {true} ne = refl
+¬-bool-f {false} ne = ⊥-elim ( ne refl )
+
+¬-bool : {a : Bool} →  a ≡ false  → a ≡ true → ⊥
+¬-bool refl ()
+
+lemma-∧-0 : {a b : Bool} → a /\ b ≡ true → a ≡ false → ⊥
+lemma-∧-0 {true} {true} refl ()
+lemma-∧-0 {true} {false} ()
+lemma-∧-0 {false} {true} ()
+lemma-∧-0 {false} {false} ()
+
+lemma-∧-1 : {a b : Bool} → a /\ b ≡ true → b ≡ false → ⊥
+lemma-∧-1 {true} {true} refl ()
+lemma-∧-1 {true} {false} ()
+lemma-∧-1 {false} {true} ()
+lemma-∧-1 {false} {false} ()
+
+bool-and-tt : {a b : Bool} → a ≡ true → b ≡ true → ( a /\ b ) ≡ true
+bool-and-tt refl refl = refl
+
+bool-∧→tt-0 : {a b : Bool} → ( a /\ b ) ≡ true → a ≡ true 
+bool-∧→tt-0 {true} {true} refl = refl
+bool-∧→tt-0 {false} {_} ()
+
+bool-∧→tt-1 : {a b : Bool} → ( a /\ b ) ≡ true → b ≡ true 
+bool-∧→tt-1 {true} {true} refl = refl
+bool-∧→tt-1 {true} {false} ()
+bool-∧→tt-1 {false} {false} ()
+
+bool-or-1 : {a b : Bool} → a ≡ false → ( a \/ b ) ≡ b 
+bool-or-1 {false} {true} refl = refl
+bool-or-1 {false} {false} refl = refl
+bool-or-2 : {a b : Bool} → b ≡ false → (a \/ b ) ≡ a 
+bool-or-2 {true} {false} refl = refl
+bool-or-2 {false} {false} refl = refl
+
+bool-or-3 : {a : Bool} → ( a \/ true ) ≡ true 
+bool-or-3 {true} = refl
+bool-or-3 {false} = refl
+
+bool-or-31 : {a b : Bool} → b ≡ true  → ( a \/ b ) ≡ true 
+bool-or-31 {true} {true} refl = refl
+bool-or-31 {false} {true} refl = refl
+
+bool-or-4 : {a : Bool} → ( true \/ a ) ≡ true 
+bool-or-4 {true} = refl
+bool-or-4 {false} = refl
+
+bool-or-41 : {a b : Bool} → a ≡ true  → ( a \/ b ) ≡ true 
+bool-or-41 {true} {b} refl = refl
+
+bool-and-1 : {a b : Bool} →  a ≡ false → (a /\ b ) ≡ false
+bool-and-1 {false} {b} refl = refl
+bool-and-2 : {a b : Bool} →  b ≡ false → (a /\ b ) ≡ false
+bool-and-2 {true} {false} refl = refl
+bool-and-2 {false} {false} refl = refl
+
+
diff -r a5b3061f15ee -r 6d1619d9f880 src/nat.agda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/nat.agda	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,340 @@
+{-# OPTIONS --allow-unsolved-metas #-}
+module nat where
+
+open import Data.Nat 
+open import Data.Nat.Properties
+open import Data.Empty
+open import Relation.Nullary
+open import  Relation.Binary.PropositionalEquality
+open import  Relation.Binary.Core
+open import Relation.Binary.Definitions
+open import  logic
+
+
+nat-<> : { x y : ℕ } → x < y → y < x → ⊥
+nat-<>  (s≤s x<y) (s≤s y<x) = nat-<> x<y y<x
+
+nat-≤> : { x y : ℕ } → x ≤ y → y < x → ⊥
+nat-≤>  (s≤s x<y) (s≤s y<x) = nat-≤> x<y y<x
+
+nat-<≡ : { x : ℕ } → x < x → ⊥
+nat-<≡  (s≤s lt) = nat-<≡ lt
+
+nat-≡< : { x y : ℕ } → x ≡ y → x < y → ⊥
+nat-≡< refl lt = nat-<≡ lt
+
+¬a≤a : {la : ℕ} → suc la ≤ la → ⊥
+¬a≤a  (s≤s lt) = ¬a≤a  lt
+
+a<sa : {la : ℕ} → la < suc la 
+a<sa {zero} = s≤s z≤n
+a<sa {suc la} = s≤s a<sa 
+
+refl-≤s : {x : ℕ } → x ≤ suc x
+refl-≤s {zero} = z≤n
+refl-≤s {suc x} = s≤s (refl-≤s {x})
+
+a≤sa : {x : ℕ } → x ≤ suc x
+a≤sa {zero} = z≤n
+a≤sa {suc x} = s≤s (a≤sa {x})
+
+=→¬< : {x : ℕ  } → ¬ ( x < x )
+=→¬< {zero} ()
+=→¬< {suc x} (s≤s lt) = =→¬< lt
+
+>→¬< : {x y : ℕ  } → (x < y ) → ¬ ( y < x )
+>→¬< (s≤s x<y) (s≤s y<x) = >→¬< x<y y<x
+
+<-∨ : { x y : ℕ } → x < suc y → ( (x ≡ y ) ∨ (x < y) )
+<-∨ {zero} {zero} (s≤s z≤n) = case1 refl
+<-∨ {zero} {suc y} (s≤s lt) = case2 (s≤s z≤n)
+<-∨ {suc x} {zero} (s≤s ())
+<-∨ {suc x} {suc y} (s≤s lt) with <-∨ {x} {y} lt
+<-∨ {suc x} {suc y} (s≤s lt) | case1 eq = case1 (cong (λ k → suc k ) eq)
+<-∨ {suc x} {suc y} (s≤s lt) | case2 lt1 = case2 (s≤s lt1)
+
+n≤n : (n : ℕ) →  n Data.Nat.≤ n
+n≤n zero = z≤n
+n≤n (suc n) = s≤s (n≤n n)
+
+<→m≤n : {m n : ℕ} → m  < n →  m Data.Nat.≤ n
+<→m≤n {zero} lt = z≤n
+<→m≤n {suc m} {zero} ()
+<→m≤n {suc m} {suc n} (s≤s lt) = s≤s (<→m≤n lt)
+
+max : (x y : ℕ) → ℕ
+max zero zero = zero
+max zero (suc x) = (suc x)
+max (suc x) zero = (suc x)
+max (suc x) (suc y) = suc ( max x y )
+
+-- _*_ : ℕ → ℕ → ℕ
+-- _*_ zero _ = zero
+-- _*_ (suc n) m = m + ( n * m )
+
+exp : ℕ → ℕ → ℕ
+exp _ zero = 1
+exp n (suc m) = n * ( exp n m )
+
+minus : (a b : ℕ ) →  ℕ
+minus a zero = a
+minus zero (suc b) = zero
+minus (suc a) (suc b) = minus a b
+
+_-_ = minus
+
+m+= : {i j  m : ℕ } → m + i ≡ m + j → i ≡ j
+m+= {i} {j} {zero} refl = refl
+m+= {i} {j} {suc m} eq = m+= {i} {j} {m} ( cong (λ k → pred k ) eq )
+
++m= : {i j  m : ℕ } → i + m ≡ j + m → i ≡ j
++m= {i} {j} {m} eq = m+= ( subst₂ (λ j k → j ≡ k ) (+-comm i _ ) (+-comm j _ ) eq )
+
+less-1 :  { n m : ℕ } → suc n < m → n < m
+less-1 {zero} {suc (suc _)} (s≤s (s≤s z≤n)) = s≤s z≤n
+less-1 {suc n} {suc m} (s≤s lt) = s≤s (less-1 {n} {m} lt)
+
+sa=b→a<b :  { n m : ℕ } → suc n ≡ m → n < m
+sa=b→a<b {0} {suc zero} refl = s≤s z≤n
+sa=b→a<b {suc n} {suc (suc n)} refl = s≤s (sa=b→a<b refl)
+
+minus+n : {x y : ℕ } → suc x > y  → minus x y + y ≡ x
+minus+n {x} {zero} _ = trans (sym (+-comm zero  _ )) refl
+minus+n {zero} {suc y} (s≤s ())
+minus+n {suc x} {suc y} (s≤s lt) = begin
+           minus (suc x) (suc y) + suc y
+        ≡⟨ +-comm _ (suc y)    ⟩
+           suc y + minus x y 
+        ≡⟨ cong ( λ k → suc k ) (
+           begin
+                 y + minus x y 
+              ≡⟨ +-comm y  _ ⟩
+                 minus x y + y
+              ≡⟨ minus+n {x} {y} lt ⟩
+                 x 
+           ∎  
+           ) ⟩
+           suc x
+        ∎  where open ≡-Reasoning
+
+sn-m=sn-m : {m n : ℕ } →  m ≤ n → suc n - m ≡ suc ( n - m )
+sn-m=sn-m {0} {n} z≤n = refl
+sn-m=sn-m {suc m} {suc n} (s≤s m<n) = sn-m=sn-m m<n
+
+si-sn=i-n : {i n : ℕ } → n < i  → suc (i - suc n) ≡ (i - n)
+si-sn=i-n {i} {n} n<i = begin
+   suc (i - suc n) ≡⟨ sym (sn-m=sn-m n<i )  ⟩
+   suc i - suc n ≡⟨⟩
+   i - n
+   ∎  where
+      open ≡-Reasoning
+
+n-m<n : (n m : ℕ ) →  n - m ≤ n
+n-m<n zero zero = z≤n
+n-m<n (suc n) zero = s≤s (n-m<n n zero)
+n-m<n zero (suc m) = z≤n
+n-m<n (suc n) (suc m) = ≤-trans (n-m<n n m ) refl-≤s
+
+n-n-m=m : {m n : ℕ } → m ≤ n  → m ≡ (n - (n - m))
+n-n-m=m {0} {zero} z≤n = refl
+n-n-m=m {0} {suc n} z≤n = n-n-m=m {0} {n} z≤n
+n-n-m=m {suc m} {suc n} (s≤s m≤n) = sym ( begin
+   suc n - ( n - m )    ≡⟨ sn-m=sn-m (n-m<n  n m) ⟩
+   suc (n - ( n - m ))  ≡⟨ cong (λ k → suc k ) (sym (n-n-m=m m≤n)) ⟩
+   suc m
+   ∎  ) where
+      open ≡-Reasoning
+
+0<s : {x : ℕ } → zero < suc x
+0<s {_} = s≤s z≤n 
+
+<-minus-0 : {x y z : ℕ } → z + x < z + y → x < y
+<-minus-0 {x} {suc _} {zero} lt = lt
+<-minus-0 {x} {y} {suc z} (s≤s lt) = <-minus-0 {x} {y} {z} lt
+
+<-minus : {x y z : ℕ } → x + z < y + z → x < y
+<-minus {x} {y} {z} lt = <-minus-0 ( subst₂ ( λ j k → j < k ) (+-comm x _) (+-comm y _ ) lt )
+
+x≤x+y : {z y : ℕ } → z ≤ z + y
+x≤x+y {zero} {y} = z≤n
+x≤x+y {suc z} {y} = s≤s  (x≤x+y {z} {y})
+
+<-plus : {x y z : ℕ } → x < y → x + z < y + z 
+<-plus {zero} {suc y} {z} (s≤s z≤n) = s≤s (subst (λ k → z ≤ k ) (+-comm z _ ) x≤x+y  )
+<-plus {suc x} {suc y} {z} (s≤s lt) = s≤s (<-plus {x} {y} {z} lt)
+
+<-plus-0 : {x y z : ℕ } → x < y → z + x < z + y 
+<-plus-0 {x} {y} {z} lt = subst₂ (λ j k → j < k ) (+-comm _ z) (+-comm _ z) ( <-plus {x} {y} {z} lt )
+
+≤-plus : {x y z : ℕ } → x ≤ y → x + z ≤ y + z
+≤-plus {0} {y} {zero} z≤n = z≤n
+≤-plus {0} {y} {suc z} z≤n = subst (λ k → z < k ) (+-comm _ y ) x≤x+y 
+≤-plus {suc x} {suc y} {z} (s≤s lt) = s≤s ( ≤-plus {x} {y} {z} lt )
+
+≤-plus-0 : {x y z : ℕ } → x ≤ y → z + x ≤ z + y 
+≤-plus-0 {x} {y} {zero} lt = lt
+≤-plus-0 {x} {y} {suc z} lt = s≤s ( ≤-plus-0 {x} {y} {z} lt )
+
+x+y<z→x<z : {x y z : ℕ } → x + y < z → x < z 
+x+y<z→x<z {zero} {y} {suc z} (s≤s lt1) = s≤s z≤n
+x+y<z→x<z {suc x} {y} {suc z} (s≤s lt1) = s≤s ( x+y<z→x<z {x} {y} {z} lt1 )
+
+*≤ : {x y z : ℕ } → x ≤ y → x * z ≤ y * z 
+*≤ lt = *-mono-≤ lt ≤-refl
+
+*< : {x y z : ℕ } → x < y → x * suc z < y * suc z 
+*< {zero} {suc y} lt = s≤s z≤n
+*< {suc x} {suc y} (s≤s lt) = <-plus-0 (*< lt)
+
+<to<s : {x y  : ℕ } → x < y → x < suc y
+<to<s {zero} {suc y} (s≤s lt) = s≤s z≤n
+<to<s {suc x} {suc y} (s≤s lt) = s≤s (<to<s {x} {y} lt)
+
+<tos<s : {x y  : ℕ } → x < y → suc x < suc y
+<tos<s {zero} {suc y} (s≤s z≤n) = s≤s (s≤s z≤n)
+<tos<s {suc x} {suc y} (s≤s lt) = s≤s (<tos<s {x} {y} lt)
+
+≤to< : {x y  : ℕ } → x < y → x ≤ y 
+≤to< {zero} {suc y} (s≤s z≤n) = z≤n
+≤to< {suc x} {suc y} (s≤s lt) = s≤s (≤to< {x} {y}  lt)
+
+x<y→≤ : {x y : ℕ } → x < y →  x ≤ suc y
+x<y→≤ {zero} {.(suc _)} (s≤s z≤n) = z≤n
+x<y→≤ {suc x} {suc y} (s≤s lt) = s≤s (x<y→≤ {x} {y} lt)
+
+open import Data.Product
+
+minus<=0 : {x y : ℕ } → x ≤ y → minus x y ≡ 0
+minus<=0 {0} {zero} z≤n = refl
+minus<=0 {0} {suc y} z≤n = refl
+minus<=0 {suc x} {suc y} (s≤s le) = minus<=0 {x} {y} le
+
+minus>0 : {x y : ℕ } → x < y → 0 < minus y x 
+minus>0 {zero} {suc _} (s≤s z≤n) = s≤s z≤n
+minus>0 {suc x} {suc y} (s≤s lt) = minus>0 {x} {y} lt
+
+distr-minus-* : {x y z : ℕ } → (minus x y) * z ≡ minus (x * z) (y * z) 
+distr-minus-* {x} {zero} {z} = refl
+distr-minus-* {x} {suc y} {z} with <-cmp x y
+distr-minus-* {x} {suc y} {z} | tri< a ¬b ¬c = begin
+          minus x (suc y) * z
+        ≡⟨ cong (λ k → k * z ) (minus<=0 {x} {suc y} (x<y→≤ a)) ⟩
+           0 * z 
+        ≡⟨ sym (minus<=0 {x * z} {z + y * z} le ) ⟩
+          minus (x * z) (z + y * z) 
+        ∎  where
+            open ≡-Reasoning
+            le : x * z ≤ z + y * z
+            le  = ≤-trans lemma (subst (λ k → y * z ≤ k ) (+-comm _ z ) (x≤x+y {y * z} {z} ) ) where
+               lemma : x * z ≤ y * z
+               lemma = *≤ {x} {y} {z} (≤to< a)
+distr-minus-* {x} {suc y} {z} | tri≈ ¬a refl ¬c = begin
+          minus x (suc y) * z
+        ≡⟨ cong (λ k → k * z ) (minus<=0 {x} {suc y} refl-≤s ) ⟩
+           0 * z 
+        ≡⟨ sym (minus<=0 {x * z} {z + y * z} (lt {x} {z} )) ⟩
+          minus (x * z) (z + y * z) 
+        ∎  where
+            open ≡-Reasoning
+            lt : {x z : ℕ } →  x * z ≤ z + x * z
+            lt {zero} {zero} = z≤n
+            lt {suc x} {zero} = lt {x} {zero}
+            lt {x} {suc z} = ≤-trans lemma refl-≤s where
+               lemma : x * suc z ≤   z + x * suc z
+               lemma = subst (λ k → x * suc z ≤ k ) (+-comm _ z) (x≤x+y {x * suc z} {z}) 
+distr-minus-* {x} {suc y} {z} | tri> ¬a ¬b c = +m= {_} {_} {suc y * z} ( begin
+           minus x (suc y) * z + suc y * z
+        ≡⟨ sym (proj₂ *-distrib-+ z  (minus x (suc y) )  _) ⟩
+           ( minus x (suc y) + suc y ) * z
+        ≡⟨ cong (λ k → k * z) (minus+n {x} {suc y} (s≤s c))  ⟩
+           x * z 
+        ≡⟨ sym (minus+n {x * z} {suc y * z} (s≤s (lt c))) ⟩
+           minus (x * z) (suc y * z) + suc y * z
+        ∎ ) where
+            open ≡-Reasoning
+            lt : {x y z : ℕ } → suc y ≤ x → z + y * z ≤ x * z
+            lt {x} {y} {z} le = *≤ le 
+
+minus- : {x y z : ℕ } → suc x > z + y → minus (minus x y) z ≡ minus x (y + z)
+minus- {x} {y} {z} gt = +m= {_} {_} {z} ( begin
+           minus (minus x y) z + z
+        ≡⟨ minus+n {_} {z} lemma ⟩
+           minus x y
+        ≡⟨ +m= {_} {_} {y} ( begin
+              minus x y + y 
+           ≡⟨ minus+n {_} {y} lemma1 ⟩
+              x
+           ≡⟨ sym ( minus+n {_} {z + y} gt ) ⟩
+              minus x (z + y) + (z + y)
+           ≡⟨ sym ( +-assoc (minus x (z + y)) _  _ ) ⟩
+              minus x (z + y) + z + y
+           ∎ ) ⟩
+           minus x (z + y) + z
+        ≡⟨ cong (λ k → minus x k + z ) (+-comm _ y )  ⟩
+           minus x (y + z) + z
+        ∎  ) where
+             open ≡-Reasoning
+             lemma1 : suc x > y
+             lemma1 = x+y<z→x<z (subst (λ k → k < suc x ) (+-comm z _ ) gt )
+             lemma : suc (minus x y) > z
+             lemma = <-minus {_} {_} {y} ( subst ( λ x → z + y < suc x ) (sym (minus+n {x} {y}  lemma1 ))  gt )
+
+minus-* : {M k n : ℕ } → n < k  → minus k (suc n) * M ≡ minus (minus k n * M ) M
+minus-* {zero} {k} {n} lt = begin
+           minus k (suc n) * zero
+        ≡⟨ *-comm (minus k (suc n)) zero ⟩
+           zero * minus k (suc n) 
+        ≡⟨⟩
+           0 * minus k n 
+        ≡⟨ *-comm 0 (minus k n) ⟩
+           minus (minus k n * 0 ) 0
+        ∎  where
+        open ≡-Reasoning
+minus-* {suc m} {k} {n} lt with <-cmp k 1
+minus-* {suc m} {.0} {zero} lt | tri< (s≤s z≤n) ¬b ¬c = refl
+minus-* {suc m} {.0} {suc n} lt | tri< (s≤s z≤n) ¬b ¬c = refl
+minus-* {suc zero} {.1} {zero} lt | tri≈ ¬a refl ¬c = refl
+minus-* {suc (suc m)} {.1} {zero} lt | tri≈ ¬a refl ¬c = minus-* {suc m} {1} {zero} lt 
+minus-* {suc m} {.1} {suc n} (s≤s ()) | tri≈ ¬a refl ¬c
+minus-* {suc m} {k} {n} lt | tri> ¬a ¬b c = begin
+           minus k (suc n) * M
+        ≡⟨ distr-minus-* {k} {suc n} {M}  ⟩
+           minus (k * M ) ((suc n) * M)
+        ≡⟨⟩
+           minus (k * M ) (M + n * M  )
+        ≡⟨ cong (λ x → minus (k * M) x) (+-comm M _ ) ⟩
+           minus (k * M ) ((n * M) + M )
+        ≡⟨ sym ( minus- {k * M} {n * M} (lemma lt) ) ⟩
+           minus (minus (k * M ) (n * M)) M
+        ≡⟨ cong (λ x → minus x M ) ( sym ( distr-minus-* {k} {n} )) ⟩
+           minus (minus k n * M ) M
+        ∎  where
+             M = suc m
+             lemma : {n k m : ℕ } → n < k  → suc (k * suc m) > suc m + n * suc m
+             lemma {zero} {suc k} {m} (s≤s lt) = s≤s (s≤s (subst (λ x → x ≤ m + k * suc m) (+-comm 0 _ ) x≤x+y ))
+             lemma {suc n} {suc k} {m} lt = begin
+                         suc (suc m + suc n * suc m) 
+                      ≡⟨⟩
+                         suc ( suc (suc n) * suc m)
+                      ≤⟨ ≤-plus-0 {_} {_} {1} (*≤ lt ) ⟩
+                         suc (suc k * suc m)
+                      ∎   where open ≤-Reasoning
+             open ≡-Reasoning
+
+open import Data.List
+
+ℕL-inject : {h h1 : ℕ } {x y : List ℕ } → h ∷ x ≡ h1 ∷ y → h ≡ h1
+ℕL-inject refl = refl
+
+ℕL-inject-t : {h h1 : ℕ } {x y : List ℕ } → h ∷ x ≡ h1 ∷ y → x ≡ y
+ℕL-inject-t refl = refl
+
+ℕL-eq? : (x y : List ℕ ) → Dec (x ≡ y )
+ℕL-eq? [] [] = yes refl
+ℕL-eq? [] (x ∷ y) = no (λ ())
+ℕL-eq? (x ∷ x₁) [] = no (λ ())
+ℕL-eq? (h ∷ x) (h1 ∷ y) with h ≟ h1 | ℕL-eq? x y
+... | yes y1 | yes y2 = yes ( cong₂ (λ j k → j ∷ k ) y1 y2 )
+... | yes y1 | no n = no (λ e → n (ℕL-inject-t e))
+... | no n  | t = no (λ e → n (ℕL-inject e)) 
+
diff -r a5b3061f15ee -r 6d1619d9f880 src/sym2.agda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/sym2.agda	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,114 @@
+open import Level hiding ( suc ; zero )
+open import Algebra
+module sym2 where
+
+open import Symmetric 
+open import Data.Unit
+open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
+open import Function
+open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
+open import Relation.Nullary
+open import Data.Empty
+open import Data.Product
+
+open import Gutil 
+open import Putil 
+open import FLutil 
+open import Solvable using (solvable)
+open import  Relation.Binary.PropositionalEquality hiding ( [_] )
+
+open import Data.Fin
+open import Data.Fin.Permutation
+
+sym2solvable : solvable (Symmetric 2)
+solvable.dervied-length sym2solvable = 1
+solvable.end sym2solvable x d = solved x d where
+
+   open import Data.List using ( List ; [] ; _∷_ )
+
+   open Solvable (Symmetric 2)
+   -- open Group (Symmetric 2) using (_⁻¹)
+
+
+   p0 :  FL→perm ((# 0) :: ((# 0 ) :: f0)) =p= pid
+   p0 = pleq _ _ refl
+
+   p0r :  perm→FL pid ≡  ((# 0) :: ((# 0 ) :: f0)) 
+   p0r = refl
+
+   p1 :  FL→perm ((# 1) :: ((# 0 ) :: f0)) =p= pswap pid
+   p1 = pleq _ _ refl
+
+   p1r :  perm→FL (pswap pid) ≡  ((# 1) :: ((# 0 ) :: f0)) 
+   p1r = refl
+
+   -- FL→iso : (fl : FL 2 )  → perm→FL ( FL→perm fl ) ≡ fl
+   -- FL→iso  (zero :: (zero :: f0)) = refl
+   -- FL→iso ((suc zero) :: (zero :: f0)) = refl
+
+   open _=p=_
+   open ≡-Reasoning
+
+   sym2lem0 :  ( g h : Permutation 2 2 ) → (q : Fin 2)  → ([ g , h ]  ⟨$⟩ʳ q) ≡ (pid ⟨$⟩ʳ q)
+   sym2lem0 g h q with perm→FL g | perm→FL h | inspect perm→FL g | inspect perm→FL h
+   sym2lem0 g h q | zero :: (zero :: f0) | _ | record { eq = g=00} | record { eq = h=00}  = begin
+             [ g , h ]  ⟨$⟩ʳ q
+           ≡⟨⟩
+              h ⟨$⟩ʳ  (g ⟨$⟩ʳ ( h ⟨$⟩ˡ ( g ⟨$⟩ˡ q ))) 
+           ≡⟨ cong (λ k → h ⟨$⟩ʳ  (g ⟨$⟩ʳ ( h ⟨$⟩ˡ  k))) ((peqˡ sym2lem1 _ )) ⟩
+              h ⟨$⟩ʳ  (g ⟨$⟩ʳ ( h ⟨$⟩ˡ ( pid ⟨$⟩ˡ q ))) 
+           ≡⟨ cong (λ k →  h ⟨$⟩ʳ k ) (peq sym2lem1 _ )  ⟩
+              h ⟨$⟩ʳ  (pid ⟨$⟩ʳ ( h ⟨$⟩ˡ ( pid ⟨$⟩ˡ q ))) 
+           ≡⟨⟩
+             [ pid , h ]  ⟨$⟩ʳ q
+           ≡⟨ peq (idcomtl h) q ⟩
+             q
+           ∎ where
+             sym2lem1 :  g =p= pid
+             sym2lem1 = FL-inject  g=00
+   sym2lem0 g h q | _ | zero :: (zero :: f0) | record { eq = g=00} | record { eq = h=00} = begin
+             [ g , h ]  ⟨$⟩ʳ q
+           ≡⟨⟩
+              h ⟨$⟩ʳ  (g ⟨$⟩ʳ ( h ⟨$⟩ˡ ( g ⟨$⟩ˡ q ))) 
+           ≡⟨ peq sym2lem2 _   ⟩
+              pid ⟨$⟩ʳ  (g ⟨$⟩ʳ ( h ⟨$⟩ˡ ( g ⟨$⟩ˡ q ))) 
+           ≡⟨ cong (λ k → pid ⟨$⟩ʳ  (g ⟨$⟩ʳ k)) (peqˡ sym2lem2 _ ) ⟩
+              pid ⟨$⟩ʳ  (g ⟨$⟩ʳ ( pid ⟨$⟩ˡ ( g ⟨$⟩ˡ q ))) 
+           ≡⟨⟩
+             [ g , pid ]  ⟨$⟩ʳ q
+           ≡⟨ peq (idcomtr g) q ⟩
+             q
+          ∎ where
+             sym2lem2 :  h =p= pid
+             sym2lem2 = FL-inject h=00
+   sym2lem0 g h q | suc zero :: (zero :: f0) | suc zero :: (zero :: f0) | record { eq = g=00} | record { eq = h=00}= begin
+             [ g , h ]  ⟨$⟩ʳ q
+           ≡⟨⟩
+              h ⟨$⟩ʳ  (g ⟨$⟩ʳ ( h ⟨$⟩ˡ ( g ⟨$⟩ˡ q ))) 
+           ≡⟨ peq (psym g=h ) _  ⟩
+              g ⟨$⟩ʳ  (g ⟨$⟩ʳ ( h ⟨$⟩ˡ ( g ⟨$⟩ˡ q ))) 
+           ≡⟨ cong (λ k →   g ⟨$⟩ʳ  (g ⟨$⟩ʳ  k) ) (peqˡ (psym g=h) _)  ⟩
+              g ⟨$⟩ʳ  (g ⟨$⟩ʳ ( g ⟨$⟩ˡ ( g ⟨$⟩ˡ q ))) 
+           ≡⟨ cong (λ k → g  ⟨$⟩ʳ k) ( inverseʳ g )  ⟩
+              g ⟨$⟩ʳ  ( g ⟨$⟩ˡ q ) 
+           ≡⟨ inverseʳ g   ⟩
+             q
+          ∎ where
+              g=h :  g =p= h
+              g=h =  FL-inject (trans g=00 (sym h=00))
+   solved :  (x : Permutation 2 2) → Commutator  (λ x₁ → Lift (Level.suc Level.zero) ⊤) x → x =p= pid
+   solved x (comm {g} {h} _ _) = record { peq = sym2lem0 g h  } 
+   solved x (ccong {f} {g} (record {peq = f=g}) d) with solved f d
+   ... | record { peq = f=e }  =  record  { peq = λ q → cc q } where
+      cc : ( q : Fin 2 ) → x ⟨$⟩ʳ q ≡ q
+      cc q = begin
+             x ⟨$⟩ʳ q
+          ≡⟨ sym (f=g q) ⟩
+             f ⟨$⟩ʳ q
+          ≡⟨ f=e q ⟩
+             q
+          ∎ where open ≡-Reasoning
+
+
+
+
diff -r a5b3061f15ee -r 6d1619d9f880 src/sym2n.agda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/sym2n.agda	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,51 @@
+open import Level hiding ( suc ; zero )
+open import Algebra
+module sym2n where
+
+open import Symmetric 
+open import Data.Unit
+open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
+open import Function
+open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
+open import Relation.Nullary
+open import Data.Empty
+open import Data.Product
+
+open import Gutil 
+open import Putil 
+open import Solvable using (solvable)
+open import  Relation.Binary.PropositionalEquality hiding ( [_] )
+
+open import Data.Fin
+open import Data.Fin.Permutation hiding (_∘ₚ_)
+
+infixr  200 _∘ₚ_
+_∘ₚ_ = Data.Fin.Permutation._∘ₚ_
+
+
+sym2solvable : solvable (Symmetric 2)
+solvable.dervied-length sym2solvable = 1
+solvable.end sym2solvable x d = solved1 x d where
+
+   open import Data.List using ( List ; [] ; _∷_ )
+
+   open Solvable (Symmetric 2)
+   open import FLutil
+   open import Data.List.Fresh hiding ([_])
+   open import Relation.Nary using (⌊_⌋)
+
+   p0id :  FL→perm ((# 0) :: ((# 0) :: f0)) =p= pid
+   p0id = pleq _ _ refl
+
+   open import Data.List.Fresh.Relation.Unary.Any
+   open import FLComm
+
+   stage2FList : CommFListN 2 1 ≡ cons (zero :: zero :: f0) [] (Level.lift tt)
+   stage2FList = refl
+
+   solved1 :  (x : Permutation 2 2) → deriving 1 x → x =p= pid
+   solved1 x dr = CommSolved 2 x ( CommFListN 2 1 ) stage2FList p0id solved0 where
+      solved0 : Any (perm→FL x ≡_) ( CommFListN 2 1 )
+      solved0 = CommStage→ 2 1 x dr
+
+
diff -r a5b3061f15ee -r 6d1619d9f880 src/sym3.agda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/sym3.agda	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,185 @@
+open import Level hiding ( suc ; zero )
+open import Algebra
+module sym3 where
+
+open import Symmetric 
+open import Data.Unit
+open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
+open import Function
+open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
+open import Relation.Nullary
+open import Data.Empty
+open import Data.Product
+
+open import Gutil 
+open import Putil 
+open import FLutil 
+open import Solvable using (solvable)
+open import  Relation.Binary.PropositionalEquality hiding ( [_] )
+
+open import Data.Fin
+open import Data.Fin.Permutation hiding (_∘ₚ_)
+
+infixr  200 _∘ₚ_
+_∘ₚ_ = Data.Fin.Permutation._∘ₚ_
+
+
+sym3solvable : solvable (Symmetric 3)
+solvable.dervied-length sym3solvable = 2
+solvable.end sym3solvable x d = solved1 x d where
+
+   open import Data.List using ( List ; [] ; _∷_ )
+
+   open Solvable (Symmetric 3)
+
+   p0id :  FL→perm ((# 0) :: ((# 0) :: ((# 0 ) :: f0))) =p= pid
+   p0id = pleq _ _ refl 
+
+   p0 =  FL→perm ((# 0) :: ((# 0) :: ((# 0 ) :: f0))) 
+   p1 =  FL→perm ((# 0) :: ((# 1) :: ((# 0 ) :: f0))) 
+   p2 =  FL→perm ((# 1) :: ((# 0) :: ((# 0 ) :: f0))) 
+   p3 =  FL→perm ((# 1) :: ((# 1) :: ((# 0 ) :: f0))) 
+   p4 =  FL→perm ((# 2) :: ((# 0) :: ((# 0 ) :: f0))) 
+   p5 =  FL→perm ((# 2) :: ((# 1) :: ((# 0 ) :: f0))) 
+   t0  =  plist p0 ∷ plist p1 ∷  plist p2 ∷ plist p3 ∷ plist p4 ∷  plist p5 ∷ [] 
+
+   t1  =  plist [ p0 , p0 ] ∷ plist [ p1 , p0 ] ∷  plist [ p2 , p0 ] ∷ plist [ p3 , p0 ] ∷ plist [ p4 , p0 ] ∷  plist [ p5 , p1 ] ∷ 
+          plist [ p0 , p1 ] ∷ plist [ p1 , p1 ] ∷  plist [ p2 , p1 ] ∷ plist [ p3 , p1 ] ∷ plist [ p4 , p1 ] ∷  plist [ p5 , p1 ] ∷ 
+          plist [ p0 , p2 ] ∷ plist [ p1 , p2 ] ∷  plist [ p2 , p2 ] ∷ plist [ p3 , p2 ] ∷ plist [ p4 , p2 ] ∷  plist [ p5 , p2 ] ∷ 
+          plist [ p0 , p3 ] ∷ plist [ p1 , p3 ] ∷  plist [ p3 , p3 ] ∷ plist [ p3 , p3 ] ∷ plist [ p4 , p3 ] ∷  plist [ p5 , p3 ] ∷ 
+          plist [ p0 , p4 ] ∷ plist [ p1 , p4 ] ∷  plist [ p3 , p4 ] ∷ plist [ p3 , p4 ] ∷ plist [ p4 , p4 ] ∷  plist [ p5 , p4 ] ∷ 
+          plist [ p0 , p5 ] ∷ plist [ p1 , p5 ] ∷  plist [ p3 , p5 ] ∷ plist [ p3 , p5 ] ∷ plist [ p4 , p4 ] ∷  plist [ p5 , p5 ] ∷ 
+          []
+
+   open _=p=_
+   
+   stage1 :  (x : Permutation 3 3) →  Set (Level.suc Level.zero)
+   stage1 x = Commutator (λ x₂ → Lift (Level.suc Level.zero) ⊤)  x 
+
+   open import logic
+
+   p33=4 : ( p3  ∘ₚ p3 ) =p= p4
+   p33=4 = pleq _ _ refl
+
+   p44=3 : ( p4  ∘ₚ p4 ) =p= p3
+   p44=3 = pleq _ _ refl
+
+   p34=0 : ( p3  ∘ₚ p4 ) =p= pid
+   p34=0 = pleq _ _ refl
+
+   p43=0 : ( p4  ∘ₚ p3 ) =p= pid
+   p43=0 = pleq _ _ refl
+
+   com33 : [ p3 , p3 ] =p= pid
+   com33 = pleq _ _ refl
+
+   com44 : [ p4 , p4 ] =p= pid
+   com44 = pleq _ _ refl
+
+   com34 : [ p3 , p4 ] =p= pid
+   com34 = pleq _ _ refl
+
+   com43 : [ p4 , p3 ] =p= pid
+   com43 = pleq _ _ refl
+
+
+   pFL : ( g : Permutation 3 3) → { x : FL 3 } →  perm→FL g ≡ x → g =p=  FL→perm x
+   pFL g {x} refl = ptrans (psym (FL←iso g)) ( FL-inject refl ) 
+
+   open ≡-Reasoning
+
+--   st01 : ( x y : Permutation 3 3) →   x =p= p3 →  y =p= p3 → x ∘ₚ  y =p= p4 
+--   st01 x y s t = record { peq = λ q → ( begin
+--         (x ∘ₚ y) ⟨$⟩ʳ q
+--       ≡⟨ peq ( presp s t ) q ⟩
+--          ( p3  ∘ₚ p3 ) ⟨$⟩ʳ q
+--       ≡⟨ peq  p33=4 q  ⟩
+--         p4 ⟨$⟩ʳ q
+--       ∎ ) }
+
+   st00 = perm→FL [ FL→perm ((suc zero) :: (suc zero :: (zero :: f0 ))) , FL→perm  ((suc (suc zero)) :: (suc zero) :: (zero :: f0))  ]
+
+   st02 :  ( g h : Permutation 3 3) →  ([ g , h ] =p= pid) ∨ ([ g , h ] =p= p3) ∨ ([ g , h ] =p= p4)
+   st02 g h with perm→FL g | perm→FL h | inspect perm→FL g | inspect perm→FL h
+   ... | (zero :: (zero :: (zero :: f0))) | t | record { eq = ge } | te = case1 (ptrans (comm-resp {g} {h} {pid} (FL-inject ge ) prefl ) (idcomtl h) )
+   ... | s | (zero :: (zero :: (zero :: f0))) | se |  record { eq = he } = case1 (ptrans (comm-resp {g} {h} {_} {pid} prefl (FL-inject he ))(idcomtr g) )
+   ... | (zero :: (suc zero) :: (zero :: f0 )) |  (zero :: (suc zero) :: (zero :: f0 )) |  record { eq = ge } |  record { eq = he } =
+        case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) )
+   ... | (suc zero) :: (zero :: (zero :: f0 )) | (suc zero) :: (zero :: (zero :: f0 )) |  record { eq = ge } |  record { eq = he } = 
+        case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) )
+   ... | (suc zero) :: (suc zero :: (zero :: f0 )) |  (suc zero) :: (suc zero :: (zero :: f0 )) |  record { eq = ge } |  record { eq = he } = 
+        case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) )
+   ... | (suc (suc zero)) :: (zero :: (zero :: f0 )) | (suc (suc zero)) :: (zero :: (zero :: f0 )) | record { eq = ge } |  record { eq = he } =
+        case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) )
+   ... | (suc (suc zero)) :: (suc zero) :: (zero :: f0) | (suc (suc zero)) :: (suc zero) :: (zero :: f0) | record { eq = ge } |  record { eq = he } =
+        case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) )
+
+   ... | (zero :: (suc zero) :: (zero :: f0 )) | ((suc zero) :: (zero :: (zero :: f0 ))) | record { eq = ge } |  record { eq = he } =
+           case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   ... | (zero :: (suc zero) :: (zero :: f0 )) | (suc zero) :: (suc zero :: (zero :: f0 )) | record { eq = ge } |  record { eq = he } = 
+           case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   ... | (zero :: (suc zero) :: (zero :: f0 )) |  (suc (suc zero)) :: (zero :: (zero :: f0 ))| record { eq = ge } |  record { eq = he } =  
+           case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   ... | (zero :: (suc zero) :: (zero :: f0 )) | ((suc (suc zero)) :: (suc zero) :: (zero :: f0))| record { eq = ge } |  record { eq = he } =   
+           case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   ... | ((suc zero) :: (zero :: (zero :: f0 ))) | (zero :: (suc zero) :: (zero :: f0 )) | record { eq = ge } |  record { eq = he } = 
+          case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   ... | ((suc zero) :: (zero :: (zero :: f0 ))) | (suc zero) :: (suc zero :: (zero :: f0 )) | record { eq = ge } |  record { eq = he } = 
+            case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   ... | ((suc zero) :: (zero :: (zero :: f0 ))) | ((suc (suc zero)) :: (zero :: (zero :: f0 )))| record { eq = ge } |  record { eq = he } =  
+            case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   ... | ((suc zero) :: (zero :: (zero :: f0 ))) |  (suc (suc zero)) :: (suc zero) :: (zero :: f0) | record { eq = ge } |  record { eq = he } =  
+            case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   ... | (suc zero) :: (suc zero :: (zero :: f0 )) |  (zero :: (suc zero) :: (zero :: f0 )) | record { eq = ge } |  record { eq = he } =  
+            case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   ... | (suc zero) :: (suc zero :: (zero :: f0 )) |  ((suc zero) :: (zero :: (zero :: f0 ))) | record { eq = ge } |  record { eq = he } =  
+            case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   ... | (suc zero) :: (suc zero :: (zero :: f0 )) |  ((suc (suc zero)) :: (zero :: (zero :: f0 ))) | record { eq = ge } |  record { eq = he } =  
+         case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) )
+   ... | (suc zero) :: (suc zero :: (zero :: f0 )) |  ((suc (suc zero)) :: (suc zero) :: (zero :: f0)) | record { eq = ge } |  record { eq = he } =   
+            case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   ... | (suc (suc zero)) :: (zero :: (zero :: f0 )) | ((zero :: (suc zero) :: (zero :: f0 )) ) | record { eq = ge } |  record { eq = he } =
+          case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   ... | (suc (suc zero)) :: (zero :: (zero :: f0 )) | ((suc zero) :: (zero :: (zero :: f0 ))) | record { eq = ge } |  record { eq = he } =
+          case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   ... | (suc (suc zero)) :: (zero :: (zero :: f0 )) | ((suc zero) :: (suc zero :: (zero :: f0 ))) | record { eq = ge } |  record { eq = he } =
+          case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) )
+   ... | (suc (suc zero)) :: (zero :: (zero :: f0 )) | ((suc (suc zero)) :: (suc zero) :: (zero :: f0)) | record { eq = ge } |  record { eq = he } = 
+          case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   ... |  ((suc (suc zero)) :: (suc zero) :: (zero :: f0)) | ((zero :: (suc zero) :: (zero :: f0 )) ) | record { eq = ge } |  record { eq = he } =
+          case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   ... |  ((suc (suc zero)) :: (suc zero) :: (zero :: f0)) | ((suc zero) :: (zero :: (zero :: f0 ))) | record { eq = ge } |  record { eq = he } =
+          case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   ... |  ((suc (suc zero)) :: (suc zero) :: (zero :: f0)) | ((suc zero) :: (suc zero :: (zero :: f0 )))  | record { eq = ge } |  record { eq = he } =
+          case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   ... |  ((suc (suc zero)) :: (suc zero) :: (zero :: f0)) | (suc (suc zero)) :: (zero :: (zero :: f0 ))  | record { eq = ge } |  record { eq = he } =
+          case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
+   
+   stage12  :  (x : Permutation 3 3) → stage1 x →  ( x =p= pid ) ∨ ( x =p= p3 ) ∨ ( x =p= p4 )
+   stage12 x (comm {g} {h} x1 y1 ) = st02 g h
+   stage12 _ (ccong {y} x=y sx) with stage12 y sx
+   ... | case1 id = case1 ( ptrans (psym x=y ) id )
+   ... | case2 (case1 x₁) = case2 (case1 ( ptrans (psym x=y ) x₁ ))
+   ... | case2 (case2 x₁) = case2 (case2 ( ptrans (psym x=y ) x₁ ))
+
+
+   solved1 :  (x : Permutation 3 3) →  Commutator (λ x₁ → Commutator (λ x₂ → Lift (Level.suc Level.zero) ⊤) x₁) x → x =p= pid
+   solved1 x (ccong {f} {g} (record {peq = f=g}) d) with solved1 f d
+   ... | record { peq = f=e }  =  record  { peq = λ q → cc q } where
+      cc : ( q : Fin 3 ) → x ⟨$⟩ʳ q ≡ q
+      cc q = begin
+             x ⟨$⟩ʳ q
+          ≡⟨ sym (f=g q) ⟩
+             f ⟨$⟩ʳ q
+          ≡⟨ f=e q ⟩
+             q
+          ∎ 
+   solved1 _ (comm {g} {h} x y) with stage12 g x | stage12 h y
+   ... | case1 t | case1 s = ptrans (comm-resp t s) (comm-refl {pid} prefl)
+   ... | case1 t | case2 s = ptrans (comm-resp {g} {h} {pid} t prefl) (idcomtl h)
+   ... | case2 t | case1 s = ptrans (comm-resp {g} {h} {_} {pid} prefl s) (idcomtr g)
+   ... | case2 (case1 t) | case2 (case1 s) = record { peq = λ q → trans ( peq ( comm-resp {g} {h}  t s ) q ) (peq com33 q) }
+   ... | case2 (case2 t) | case2 (case2 s) = record { peq = λ q → trans ( peq ( comm-resp {g} {h}  t s ) q ) (peq com44 q) }
+   ... | case2 (case1 t) | case2 (case2 s) = record { peq = λ q → trans ( peq ( comm-resp {g} {h}  t s ) q ) (peq com34 q) }
+   ... | case2 (case2 t) | case2 (case1 s) = record { peq = λ q → trans ( peq ( comm-resp {g} {h}  t s ) q ) (peq com43 q) }
+
diff -r a5b3061f15ee -r 6d1619d9f880 src/sym3n.agda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/sym3n.agda	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,51 @@
+open import Level hiding ( suc ; zero )
+open import Algebra
+module sym3n where
+
+open import Symmetric 
+open import Data.Unit
+open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
+open import Function
+open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
+open import Relation.Nullary
+open import Data.Empty
+open import Data.Product
+
+open import Gutil 
+open import Putil 
+open import Solvable using (solvable)
+open import  Relation.Binary.PropositionalEquality hiding ( [_] )
+
+open import Data.Fin
+open import Data.Fin.Permutation hiding (_∘ₚ_)
+
+infixr  200 _∘ₚ_
+_∘ₚ_ = Data.Fin.Permutation._∘ₚ_
+
+
+sym3solvable : solvable (Symmetric 3)
+solvable.dervied-length sym3solvable = 2
+solvable.end sym3solvable x d = solved1 x d where
+
+   open import Data.List using ( List ; [] ; _∷_ )
+
+   open Solvable (Symmetric 3)
+   open import FLutil
+   open import Data.List.Fresh hiding ([_])
+   open import Relation.Nary using (⌊_⌋)
+
+   p0id :  FL→perm ((# 0) :: ((# 0) :: ((# 0 ) :: f0))) =p= pid
+   p0id = pleq _ _ refl
+
+   open import Data.List.Fresh.Relation.Unary.Any
+   open import FLComm
+
+   stage3FList : CommFListN 3 2 ≡ cons (zero :: zero :: zero :: f0) [] (Level.lift tt)
+   stage3FList = refl
+
+   solved1 :  (x : Permutation 3 3) → deriving 2 x → x =p= pid
+   solved1 x dr = CommSolved 3 x ( CommFListN 3 2 ) stage3FList p0id solved2 where
+      solved2 : Any (perm→FL x ≡_) ( CommFListN 3 2 )
+      solved2 = CommStage→ 3 2 x dr
+
+
diff -r a5b3061f15ee -r 6d1619d9f880 src/sym4.agda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/sym4.agda	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,65 @@
+open import Level hiding ( suc ; zero )
+open import Algebra
+module sym4 where
+
+open import Symmetric 
+open import Data.Unit
+open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
+open import Function
+open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
+open import Relation.Nullary
+open import Data.Empty
+open import Data.Product
+
+open import Gutil 
+open import Putil 
+open import Solvable using (solvable)
+open import  Relation.Binary.PropositionalEquality hiding ( [_] )
+
+open import Data.Fin
+open import Data.Fin.Permutation hiding (_∘ₚ_)
+
+infixr  200 _∘ₚ_
+_∘ₚ_ = Data.Fin.Permutation._∘ₚ_
+
+sym4solvable : solvable (Symmetric 4)
+solvable.dervied-length sym4solvable = 3
+solvable.end sym4solvable x d = solved1 x d where
+
+   open import Data.List using ( List ; [] ; _∷_ )
+   open Solvable (Symmetric 4)
+
+   -- Klien
+   --
+   --  1                     (1,2),(3,4)           (1,3),(2,4)           (1,4),(2,3)
+   --  0 ∷ 1 ∷ 2 ∷ 3 ∷ [] ,  1 ∷ 0 ∷ 3 ∷ 2 ∷ [] ,  2 ∷ 3 ∷ 0 ∷ 1 ∷ [] ,  3 ∷ 2 ∷ 1 ∷ 0 ∷ [] ,  
+
+   a0 =  pid {4}
+   a1 =  pswap (pswap (pid {0}))
+   a2 =  pid {4} ∘ₚ pins (n≤ 3) ∘ₚ pins (n≤ 3 ) 
+   a3 =  pins (n≤ 3)  ∘ₚ  pins (n≤ 2) ∘ₚ pswap (pid {2})
+
+   k3 = plist  (a1  ∘ₚ a2 ) ∷ plist (a1 ∘ₚ a3)  ∷ plist (a2 ∘ₚ a1 ) ∷  []
+
+   open import FLutil
+   open import Data.List.Fresh hiding ([_])
+   open import Relation.Nary using (⌊_⌋)
+
+   p0id :  FL→perm ((# 0) :: (# 0) :: ((# 0) :: ((# 0 ) :: f0))) =p= pid
+   p0id = pleq _ _ refl
+
+
+   open import Data.List.Fresh.Relation.Unary.Any
+   open import FLComm
+
+   stage3FList : CommFListN 4 3 ≡ cons (zero :: zero :: zero :: zero :: f0) [] (Level.lift tt)
+   stage3FList = refl
+
+   st3 = proj₁ (toList ( CommFListN 4 2 ))
+   -- st4 = {!!}
+ 
+   solved1 :  (x : Permutation 4 4) → deriving 3 x → x =p= pid 
+   solved1 x dr = CommSolved 4 x ( CommFListN 4 3 ) stage3FList p0id solved2 where
+      --    p0id :  FL→perm ((# 0) :: ((# 0) :: ((# 0 ) :: f0))) =p= pid
+      solved2 : Any (perm→FL x ≡_) ( CommFListN 4 3 )
+      solved2 = CommStage→ 4 3 x dr 
diff -r a5b3061f15ee -r 6d1619d9f880 src/sym5.agda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/sym5.agda	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,220 @@
+open import Level hiding ( suc ; zero )
+open import Algebra
+module sym5 where
+
+open import Symmetric 
+open import Data.Unit using (⊤ ; tt )
+open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
+open import Function hiding (flip)
+open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
+open import Data.Nat.Properties
+open import Relation.Nullary
+open import Data.Empty
+open import Data.Product
+
+open import Gutil 
+open import Putil 
+open import Solvable using (solvable)
+open import  Relation.Binary.PropositionalEquality hiding ( [_] )
+
+open import Data.Fin hiding (_<_ ; _≤_  ; lift )
+open import Data.Fin.Permutation  hiding (_∘ₚ_)
+
+infixr  200 _∘ₚ_
+_∘ₚ_ = Data.Fin.Permutation._∘ₚ_
+
+open import Data.List  hiding ( [_] )
+open import nat
+open import fin
+open import logic
+
+open _∧_
+
+¬sym5solvable : ¬ ( solvable (Symmetric 5) )
+¬sym5solvable sol = counter-example (end5 (abc 0<3 0<4 ) (dervie-any-3rot0 (dervied-length sol) 0<3 0<4 ) ) where
+--
+--    dba       1320      d → b → a → d
+--    (dba)⁻¹   3021      a → b → d → a
+--    aec       21430
+--    (aec)⁻¹   41032
+--    [ dba , aec ] = (abd)(cea)(dba)(aec) = abc
+--      so commutator always contains abc, dba and aec
+
+     open ≡-Reasoning
+
+     open solvable
+     open Solvable ( Symmetric 5) 
+     end5 : (x : Permutation 5 5) → deriving (dervied-length sol) x →  x =p= pid  
+     end5 x der = end sol x der
+
+     0<4 : 0 < 4
+     0<4 = s≤s z≤n
+
+     0<3 : 0 < 3
+     0<3 = s≤s z≤n
+
+     --- 1 ∷ 2 ∷ 0 ∷ []      abc
+     3rot : Permutation 3 3
+     3rot = pid {3} ∘ₚ pins (n≤ 2)
+
+     save2 : {i j : ℕ }  → (i ≤ 3 ) → ( j ≤ 4 ) →  Permutation  5 5 
+     save2 i<3 j<4 = flip (pins (s≤s i<3)) ∘ₚ flip (pins j<4) 
+
+     ins2 : {i j : ℕ }  → Permutation 3 3  → (i ≤ 3 ) → ( j ≤ 4 ) → Permutation  5 5
+     ins2 abc i<3 j<4 = (save2 i<3 j<4 ∘ₚ (pprep (pprep abc))) ∘ₚ flip (save2 i<3 j<4 ) 
+
+     ins2cong : {i j : ℕ }  → {x y : Permutation 3 3 } → {i<3 : i ≤ 3 } → {j<4 : j ≤ 4 } → x =p= y → ins2 x i<3 j<4  =p= ins2 y i<3 j<4
+     ins2cong {i} {j} {x} {y} {i<3} {j<4} x=y = presp {5} {save2 i<3 j<4 ∘ₚ (pprep (pprep x))} {_} {flip (save2 i<3 j<4 )}
+         (presp {5} {save2 i<3 j<4} prefl (pprep-cong (pprep-cong x=y)) ) prefl 
+
+     open _=p=_
+
+     abc : {i j : ℕ }  → (i ≤ 3 ) → ( j ≤ 4 ) → Permutation  5 5
+     abc i<3 j<4 = ins2 3rot i<3 j<4
+     dba : {i j : ℕ }  → (i ≤ 3 ) → ( j ≤ 4 ) → Permutation  5 5
+     dba i<3 j<4 = ins2 (3rot ∘ₚ 3rot) i<3 j<4
+
+     counter-example :  ¬ (abc 0<3 0<4  =p= pid )
+     counter-example eq with ←pleq _ _ eq
+     ...  | ()
+
+     record Triple {i j : ℕ } (i<3 : i ≤ 3) (j<4 : j ≤ 4) (rot : Permutation 3 3) : Set where
+       field 
+         dba0<3 : Fin 4
+         dba1<4 : Fin 5
+         aec0<3 : Fin 4
+         aec1<4 : Fin 5
+         abc= : ins2 rot i<3 j<4 =p= [ ins2 (rot ∘ₚ rot)  (fin≤n {3} dba0<3) (fin≤n {4} dba1<4)  , ins2 (rot ∘ₚ rot) (fin≤n {3} aec0<3) (fin≤n {4} aec1<4) ]
+
+     open Triple
+     triple : {i j : ℕ } → (i<3 : i ≤ 3) (j<4 : j ≤ 4) → Triple i<3 j<4 3rot
+     triple z≤n z≤n =                               record { dba0<3 = # 0 ; dba1<4 = # 4 ; aec0<3 = # 2 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     triple z≤n (s≤s z≤n) =                         record { dba0<3 = # 0 ; dba1<4 = # 4 ; aec0<3 = # 2 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     triple z≤n (s≤s (s≤s z≤n)) =                   record { dba0<3 = # 1 ; dba1<4 = # 0 ; aec0<3 = # 3 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
+     triple z≤n (s≤s (s≤s (s≤s z≤n))) =             record { dba0<3 = # 1 ; dba1<4 = # 3 ; aec0<3 = # 0 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     triple z≤n (s≤s (s≤s (s≤s (s≤s z≤n)))) =       record { dba0<3 = # 0 ; dba1<4 = # 0 ; aec0<3 = # 2 ; aec1<4 = # 4 ; abc= = pleq _ _ refl } 
+     triple (s≤s z≤n) z≤n =                         record { dba0<3 = # 0 ; dba1<4 = # 2 ; aec0<3 = # 3 ; aec1<4 = # 1 ; abc= = pleq _ _ refl }
+     triple (s≤s z≤n) (s≤s z≤n) =                   record { dba0<3 = # 0 ; dba1<4 = # 2 ; aec0<3 = # 3 ; aec1<4 = # 1 ; abc= = pleq _ _ refl }
+     triple (s≤s z≤n) (s≤s (s≤s z≤n)) =             record { dba0<3 = # 1 ; dba1<4 = # 0 ; aec0<3 = # 3 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
+     triple (s≤s z≤n) (s≤s (s≤s (s≤s z≤n))) =       record { dba0<3 = # 0 ; dba1<4 = # 3 ; aec0<3 = # 1 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     triple (s≤s z≤n) (s≤s (s≤s (s≤s (s≤s z≤n)))) = record { dba0<3 = # 2 ; dba1<4 = # 4 ; aec0<3 = # 0 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
+     triple (s≤s (s≤s z≤n)) z≤n =                   record { dba0<3 = # 3 ; dba1<4 = # 0 ; aec0<3 = # 1 ; aec1<4 = # 3 ; abc= = pleq _ _ refl }
+     triple (s≤s (s≤s z≤n)) (s≤s z≤n) =             record { dba0<3 = # 3 ; dba1<4 = # 0 ; aec0<3 = # 1 ; aec1<4 = # 3 ; abc= = pleq _ _ refl }
+     triple (s≤s (s≤s z≤n)) (s≤s (s≤s z≤n)) =       record { dba0<3 = # 1 ; dba1<4 = # 3 ; aec0<3 = # 0 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     triple (s≤s (s≤s z≤n)) (s≤s (s≤s (s≤s z≤n))) = record { dba0<3 = # 0 ; dba1<4 = # 3 ; aec0<3 = # 1 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     triple (s≤s (s≤s z≤n)) (s≤s (s≤s (s≤s (s≤s z≤n)))) = record { dba0<3 = # 1 ; dba1<4 = # 4 ; aec0<3 = # 2 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
+     triple (s≤s (s≤s (s≤s z≤n))) z≤n =             record { dba0<3 = # 2 ; dba1<4 = # 4 ; aec0<3 = # 1 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     triple (s≤s (s≤s (s≤s z≤n))) (s≤s z≤n) =       record { dba0<3 = # 2 ; dba1<4 = # 4 ; aec0<3 = # 1 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     triple (s≤s (s≤s (s≤s z≤n))) (s≤s (s≤s z≤n)) = record { dba0<3 = # 0 ; dba1<4 = # 0 ; aec0<3 = # 2 ; aec1<4 = # 4 ; abc= = pleq _ _ refl }
+     triple (s≤s (s≤s (s≤s z≤n))) (s≤s (s≤s (s≤s z≤n))) = record { dba0<3 = # 2 ; dba1<4 = # 4 ; aec0<3 = # 0 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
+     triple (s≤s (s≤s (s≤s z≤n))) (s≤s (s≤s (s≤s (s≤s z≤n)))) = 
+                                                    record { dba0<3 = # 1 ; dba1<4 = # 4 ; aec0<3 = # 0 ; aec1<4 = # 3 ; abc= = pleq _ _ refl }  
+     
+     _⁻¹ : {n : ℕ } ( x : Permutation n n) → Permutation n n 
+     _⁻¹ = pinv 
+
+     -- tt5 : (i : Fin 4) (j : Fin 5) → (z : Fin 4) → (w : Fin 5) → (x : Fin 5) (y : Fin 4)  → (rot : Permutation 3 3 )  → List (List ℕ) → List (List ℕ)
+     -- tt5 i j z w x y rot t with is-=p= (ins2 rot (fin≤n  i) (fin≤n  j)) 
+     --             [ ins2 (rot ∘ₚ rot)   (fin≤n  z) (fin≤n  x)  , ins2 (pinv rot) (fin≤n  y)  (fin≤n  w) ]
+     -- ... | yes _ = ( toℕ i ∷ toℕ j ∷ 9 ∷ toℕ z ∷ toℕ x ∷ toℕ y ∷ toℕ w  ∷ [] ) ∷ t
+     -- ... | no _ = t
+
+     -- open import  Relation.Binary.Definitions
+
+     -- tt2 : (i : Fin 4) (j : Fin 5) →  (rot : Permutation 3 3 ) → List (List ℕ)
+     -- tt2  i j rot = tt3 (# 4) (# 3) (# 3) (# 4) [] where
+     --     tt3 : (w : Fin 5) (z : Fin 4) (x : Fin 4) (y : Fin 5) → List (List ℕ) → List (List ℕ)
+     --     tt3 zero zero zero zero t =                                       ( tt5 i j zero zero zero zero    rot [] ) ++ t
+     --     tt3 (suc w)  zero zero zero t =  tt3 (fin+1 w) (# 3) (# 3) (# 4)       ((tt5 i j zero (suc w) zero zero    rot [] ) ++ t)
+     --     tt3 w z zero (suc y) t =       tt3 w z         (# 3) (fin+1 y)   ((tt5 i j z w (suc y) zero    rot [] ) ++ t) 
+     --     tt3 w z (suc x) y    t =       tt3 w z         (fin+1 x)    y    ((tt5 i j z  w y    (suc x) rot [] ) ++ t) 
+     --     tt3 w (suc z) zero zero t =    tt3 w (fin+1 z) (# 3) (# 4)       ((tt5 i j (suc z) w zero zero    rot [] ) ++ t)
+
+     -- tt4 :  List (List (List ℕ))
+     -- tt4  = tt2 (# 0) (# 0) (pinv 3rot) ∷
+     --       tt2 (# 1) (# 0) (pinv 3rot) ∷
+     --       tt2 (# 2) (# 0) (pinv 3rot) ∷
+     --       tt2 (# 3) (# 0) (pinv 3rot) ∷
+     --       tt2 (# 0) (# 1) (pinv 3rot) ∷
+     --       tt2 (# 1) (# 1) (pinv 3rot) ∷
+     --       tt2 (# 2) (# 1) (pinv 3rot) ∷
+     --       tt2 (# 3) (# 1) (pinv 3rot) ∷
+     --       tt2 (# 0) (# 2) (pinv 3rot) ∷
+     --       tt2 (# 1) (# 2) (pinv 3rot) ∷
+     --       tt2 (# 2) (# 2) (pinv 3rot) ∷
+     --       tt2 (# 3) (# 2) (pinv 3rot) ∷
+     --       tt2 (# 0) (# 3) (pinv 3rot) ∷
+     --       tt2 (# 1) (# 3) (pinv 3rot) ∷
+     --       tt2 (# 2) (# 3) (pinv 3rot) ∷
+     --       tt2 (# 3) (# 3) (pinv 3rot) ∷
+     --       tt2 (# 0) (# 4) (pinv 3rot) ∷
+     --       tt2 (# 1) (# 4) (pinv 3rot) ∷
+     --       tt2 (# 2) (# 4) (pinv 3rot) ∷
+     --       tt2 (# 3) (# 4) (pinv 3rot) ∷
+     --       []
+
+     open Triple 
+     dba-triple : {i j : ℕ }  → (i<3 : i ≤ 3 ) → (j<4 :  j ≤ 4 ) → Triple i<3 j<4 (3rot  ∘ₚ 3rot )
+     dba-triple z≤n z≤n =                               record { dba0<3 = # 0 ; dba1<4 = # 2 ; aec0<3 = # 2 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     dba-triple z≤n (s≤s z≤n) =                         record { dba0<3 = # 0 ; dba1<4 = # 2 ; aec0<3 = # 2 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     dba-triple z≤n (s≤s (s≤s z≤n)) =                   record { dba0<3 = # 1 ; dba1<4 = # 3 ; aec0<3 = # 3 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
+     dba-triple z≤n (s≤s (s≤s (s≤s z≤n))) =             record { dba0<3 = # 0 ; dba1<4 = # 2 ; aec0<3 = # 2 ; aec1<4 = # 4 ; abc= = pleq _ _ refl }
+     dba-triple z≤n (s≤s (s≤s (s≤s (s≤s z≤n)))) =       record { dba0<3 = # 3 ; dba1<4 = # 0 ; aec0<3 = # 0 ; aec1<4 = # 2 ; abc= = pleq _ _ refl } 
+     dba-triple (s≤s z≤n) z≤n =                         record { dba0<3 = # 0 ; dba1<4 = # 0 ; aec0<3 = # 1 ; aec1<4 = # 3 ; abc= = pleq _ _ refl }
+     dba-triple (s≤s z≤n) (s≤s z≤n) =                   record { dba0<3 = # 0 ; dba1<4 = # 0 ; aec0<3 = # 1 ; aec1<4 = # 3 ; abc= = pleq _ _ refl }
+     dba-triple (s≤s z≤n) (s≤s (s≤s z≤n)) =             record { dba0<3 = # 1 ; dba1<4 = # 3 ; aec0<3 = # 3 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
+     dba-triple (s≤s z≤n) (s≤s (s≤s (s≤s z≤n))) =       record { dba0<3 = # 1 ; dba1<4 = # 4 ; aec0<3 = # 2 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     dba-triple (s≤s z≤n) (s≤s (s≤s (s≤s (s≤s z≤n)))) = record { dba0<3 = # 1 ; dba1<4 = # 3 ; aec0<3 = # 3 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     dba-triple (s≤s (s≤s z≤n)) z≤n =                   record { dba0<3 = # 2 ; dba1<4 = # 4 ; aec0<3 = # 0 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     dba-triple (s≤s (s≤s z≤n)) (s≤s z≤n) =             record { dba0<3 = # 2 ; dba1<4 = # 4 ; aec0<3 = # 0 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     dba-triple (s≤s (s≤s z≤n)) (s≤s (s≤s z≤n)) =       record { dba0<3 = # 0 ; dba1<4 = # 2 ; aec0<3 = # 2 ; aec1<4 = # 4 ; abc= = pleq _ _ refl }
+     dba-triple (s≤s (s≤s z≤n)) (s≤s (s≤s (s≤s z≤n))) = record { dba0<3 = # 1 ; dba1<4 = # 4 ; aec0<3 = # 2 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     dba-triple (s≤s (s≤s z≤n)) (s≤s (s≤s (s≤s (s≤s z≤n)))) = record { dba0<3 = # 2 ; dba1<4 = # 0 ; aec0<3 = # 3 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
+     dba-triple (s≤s (s≤s (s≤s z≤n))) z≤n =             record { dba0<3 = # 0 ; dba1<4 = # 4 ; aec0<3 = # 1 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     dba-triple (s≤s (s≤s (s≤s z≤n))) (s≤s z≤n) =       record { dba0<3 = # 0 ; dba1<4 = # 4 ; aec0<3 = # 1 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     dba-triple (s≤s (s≤s (s≤s z≤n))) (s≤s (s≤s z≤n)) = record { dba0<3 = # 3 ; dba1<4 = # 0 ; aec0<3 = # 0 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
+     dba-triple (s≤s (s≤s (s≤s z≤n))) (s≤s (s≤s (s≤s z≤n))) = record { dba0<3 = # 1 ; dba1<4 = # 3 ; aec0<3 = # 3 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
+     dba-triple (s≤s (s≤s (s≤s z≤n))) (s≤s (s≤s (s≤s (s≤s z≤n)))) = 
+                                                    record { dba0<3 = # 2 ; dba1<4 = # 0 ; aec0<3 = # 3 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }  
+     
+     -3=33 : pinv 3rot =p= (3rot ∘ₚ 3rot )
+     -3=33 = pleq _ _ refl
+
+     4=1 : (3rot ∘ₚ 3rot) ∘ₚ (3rot ∘ₚ 3rot ) =p= 3rot
+     4=1 = pleq _ _ refl
+
+     dervie-any-3rot0 : (n : ℕ ) → {i j : ℕ }  → (i<3 : i ≤ 3 ) → (j<4 : j ≤ 4 )
+          → deriving n (abc i<3 j<4 ) 
+     dervie-any-3rot1 : (n : ℕ ) → {i j : ℕ }  → (i<3 : i ≤ 3 ) → (j<4 : j ≤ 4 )
+          → deriving n (dba i<3 j<4 ) 
+
+     commd : {n : ℕ } → (f g : Permutation 5 5)
+           →  deriving n f
+           →  deriving n g
+           → Commutator (deriving n) [ f , g ]
+     commd {n} f g df dg =  comm {deriving n} {f} {g} df dg
+
+     dervie-any-3rot0 0 i<3 j<4 = lift tt 
+     dervie-any-3rot0 (suc i) i<3 j<4 = ccong {deriving i} (psym ceq) (commd dba0 aec0 df dg )where
+        tc = triple i<3 j<4
+        dba0 = dba (fin≤n {3} (dba0<3 tc)) (fin≤n {4} (dba1<4 tc))
+        aec0 = dba (fin≤n {3} (aec0<3 tc)) (fin≤n {4} (aec1<4 tc))
+        ceq : abc i<3 j<4  =p=  [ dba0 , aec0 ]  
+        ceq = record { peq = peq (abc= tc) }
+        df =  dervie-any-3rot1 i  (fin≤n {3} (dba0<3 tc)) (fin≤n {4} (dba1<4 tc))
+        dg =  dervie-any-3rot1 i  (fin≤n {3} (aec0<3 tc)) (fin≤n {4} (aec1<4 tc)) 
+
+     dervie-any-3rot1 0 i<3 j<4 = lift tt 
+     dervie-any-3rot1 (suc n) {i} {j} i<3 j<4 = ccong {deriving n} ( psym ceq )  (commd aec0 abc0 df dg ) where
+        tdba = dba-triple i<3 j<4
+        aec0 = ins2 ((3rot ∘ₚ 3rot) ∘ₚ (3rot ∘ₚ 3rot )) (fin≤n {3} (dba0<3 tdba)) (fin≤n {4} (dba1<4 tdba))
+        abc0 = ins2 ((3rot ∘ₚ 3rot) ∘ₚ (3rot ∘ₚ 3rot )) (fin≤n {3} (aec0<3 tdba)) (fin≤n {4} (aec1<4 tdba))
+        ceq : dba i<3 j<4 =p=  [ aec0 , abc0 ]  
+        ceq = record { peq = peq (abc= tdba) }
+        df : deriving n (ins2 ((3rot ∘ₚ 3rot) ∘ₚ (3rot ∘ₚ 3rot )) (fin≤n {3} (dba0<3 tdba)) (fin≤n {4} (dba1<4 tdba)))
+        df = deriving-subst (psym (ins2cong {toℕ (dba0<3 (dba-triple i<3 j<4))} {toℕ (dba1<4 (dba-triple i<3 j<4))} 4=1 ))
+             (dervie-any-3rot0 n  (fin≤n {3} (dba0<3 tdba)) (fin≤n {4} (dba1<4 tdba)))
+        dg : deriving n (ins2 ((3rot ∘ₚ 3rot) ∘ₚ (3rot ∘ₚ 3rot )) (fin≤n {3} (aec0<3 tdba)) (fin≤n {4} (aec1<4 tdba)))
+        dg = deriving-subst (psym (ins2cong {toℕ (aec0<3 (dba-triple i<3 j<4))} {toℕ (aec1<4 (dba-triple i<3 j<4))} 4=1 )) 
+             (dervie-any-3rot0 n  (fin≤n {3} (aec0<3 tdba)) (fin≤n {4} (aec1<4 tdba)))
+
diff -r a5b3061f15ee -r 6d1619d9f880 src/sym5a.agda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/sym5a.agda	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,94 @@
+open import Level hiding ( suc ; zero )
+open import Algebra
+module sym5a where
+
+open import Symmetric 
+open import Data.Unit using (⊤ ; tt )
+open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
+open import Function hiding (flip)
+open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
+open import Data.Nat.Properties
+open import Relation.Nullary
+open import Data.Empty
+open import Data.Product
+
+open import Gutil 
+open import Putil 
+open import Solvable using (solvable)
+open import  Relation.Binary.PropositionalEquality hiding ( [_] )
+
+open import Data.Fin hiding (_<_ ; _≤_  ; lift )
+open import Data.Fin.Permutation  hiding (_∘ₚ_)
+
+infixr  200 _∘ₚ_
+_∘ₚ_ = Data.Fin.Permutation._∘ₚ_
+
+open import Data.List  hiding ( [_] )
+open import nat
+open import fin
+open import logic
+
+open _∧_
+
+¬sym5solvable : ¬ ( solvable (Symmetric 5) )
+¬sym5solvable sol = counter-example (end5 (abc 0<3 0<4 ) (any3de (dervied-length sol) 3rot 0<3 0<4 ) ) where
+--
+--    dba       1320      d → b → a → d
+--    (dba)⁻¹   3021      a → b → d → a
+--    aec       21430
+--    (aec)⁻¹   41032
+--    [ dba , aec ] = (abd)(cea)(dba)(aec) = abc
+--      so commutator always contains abc, dba and aec
+
+     open ≡-Reasoning
+
+     open solvable
+     open Solvable ( Symmetric 5) 
+     end5 : (x : Permutation 5 5) → deriving (dervied-length sol) x →  x =p= pid  
+     end5 x der = end sol x der
+
+     0<4 : 0 < 4
+     0<4 = s≤s z≤n
+
+     0<3 : 0 < 3
+     0<3 = s≤s z≤n
+
+     --- 1 ∷ 2 ∷ 0 ∷ []      abc
+     3rot : Permutation 3 3
+     3rot = pid {3} ∘ₚ pins (n≤ 2)
+
+     save2 : {i j : ℕ }  → (i ≤ 3 ) → ( j ≤ 4 ) →  Permutation  5 5 
+     save2 i<3 j<4 = flip (pins (s≤s i<3)) ∘ₚ flip (pins j<4) 
+
+     -- Permutation 5 5 include any Permutation 3 3
+     any3 : {i j : ℕ }  → Permutation 3 3  → (i ≤ 3 ) → ( j ≤ 4 ) → Permutation  5 5
+     any3 abc i<3 j<4 = (save2 i<3 j<4 ∘ₚ (pprep (pprep abc))) ∘ₚ flip (save2 i<3 j<4 ) 
+
+     any3cong : {i j : ℕ }  → {x y : Permutation 3 3 } → {i<3 : i ≤ 3 } → {j<4 : j ≤ 4 } → x =p= y → any3 x i<3 j<4  =p= any3 y i<3 j<4
+     any3cong {i} {j} {x} {y} {i<3} {j<4} x=y = presp {5} {save2 i<3 j<4 ∘ₚ (pprep (pprep x))} {_} {flip (save2 i<3 j<4 )}
+         (presp {5} {save2 i<3 j<4} prefl (pprep-cong (pprep-cong x=y)) ) prefl 
+
+     open _=p=_
+
+     -- derving n includes any Permutation 3 3, 
+     any3de : {i j : ℕ } → (n : ℕ) → (abc : Permutation 3 3) →  (i<3 : i ≤ 3 ) → (j<4 :  j ≤ 4 ) → deriving n (any3 abc i<3 j<4)
+     any3de {i} {j} zero abc i<3 j<4 = Level.lift tt
+     any3de {i} {j} (suc n) abc i<3 j<4 = ccong abc-from-comm (comm (any3de n (abc  ∘ₚ abc) i<3 j0<4 ) (any3de n (abc  ∘ₚ abc) i0<3 j<4 ))  where
+         i0 : ℕ
+         i0 = ?
+         j0 : ℕ
+         j0 = ?
+         i0<3 : i0 ≤ 3
+         i0<3 = {!!}
+         j0<4 : j0 ≤ 4
+         j0<4 = {!!}
+         abc-from-comm : [ any3 (abc  ∘ₚ abc) i<3 j0<4  , any3 (abc  ∘ₚ abc) i0<3 j<4 ] =p= any3 abc i<3 j<4
+         abc-from-comm = {!!}
+
+     abc : {i j : ℕ }  → (i ≤ 3 ) → ( j ≤ 4 ) → Permutation  5 5
+     abc i<3 j<4 = any3 3rot i<3 j<4
+
+     counter-example :  ¬ (abc 0<3 0<4  =p= pid )
+     counter-example eq with ←pleq _ _ eq
+     ...  | ()
+
diff -r a5b3061f15ee -r 6d1619d9f880 src/sym5n.agda
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/sym5n.agda	Sat Jan 09 10:18:08 2021 +0900
@@ -0,0 +1,103 @@
+open import Level hiding ( suc ; zero )
+open import Algebra
+module sym5n where
+
+open import Symmetric 
+open import Data.Unit
+open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
+open import Function
+open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
+open import Relation.Nullary
+open import Data.Empty
+open import Data.Product
+
+open import Gutil 
+open import Putil 
+open import Solvable using (solvable)
+open import  Relation.Binary.PropositionalEquality hiding ( [_] )
+
+open import Data.Fin
+open import Data.Fin.Permutation hiding (_∘ₚ_)
+
+infixr  200 _∘ₚ_
+_∘ₚ_ = Data.Fin.Permutation._∘ₚ_
+
+-- open import IO
+open import Data.String hiding (toList)
+open import Data.Unit
+open import Agda.Builtin.String 
+
+sym5solvable : (n : ℕ) → String -- ¬ solvable (Symmetric 5)
+sym5solvable n = FListtoStr (CommFListN 5 n) where
+
+   open import Data.List using ( List ; [] ; _∷_ )
+   open Solvable (Symmetric 5)
+
+   open import FLutil
+   open import Data.List.Fresh hiding ([_])
+   open import Relation.Nary using (⌊_⌋)
+
+   p0id :  FL→perm (zero :: zero :: zero :: (zero :: (zero :: f0))) =p= pid
+   p0id = pleq _ _ refl
+
+   open import Data.List.Fresh.Relation.Unary.Any
+   open import FLComm
+
+
+   stage4FList = CommFListN 5 0 
+   stage6FList = CommFListN 5 3 
+
+   -- stage5FList = {!!}
+   -- s2=s3 :  CommFListN 5 2 ≡ CommFListN 5 3 
+   -- s2=s3 = refl
+
+   FLtoStr : {n : ℕ} → (x : FL n) → String
+   FLtoStr f0 = "f0"
+   FLtoStr (x :: y) = primStringAppend ( primStringAppend (primShowNat (toℕ x)) " :: " ) (FLtoStr y)
+
+   FListtoStr : {n : ℕ} → (x : FList n) → String
+   FListtoStr [] = ""
+   FListtoStr (cons a x x₁) = primStringAppend (FLtoStr a) (primStringAppend "\n" (FListtoStr x))
+
+open import Codata.Musical.Notation
+open import Data.Maybe hiding (_>>=_)
+open import Data.List  
+open import Data.Char  
+open import IO.Primitive
+open import Codata.Musical.Costring
+
+postulate
+    getArgs : IO (List (List Char))
+{-# FOREIGN GHC import qualified System.Environment #-}
+{-# COMPILE GHC getArgs = System.Environment.getArgs #-}
+
+charToDigit : Char → Maybe ℕ
+charToDigit '0' = just ( 0)
+charToDigit '1' = just ( 1)
+charToDigit '2' = just ( 2)
+charToDigit '3' = just ( 3)
+charToDigit '4' = just ( 4)
+charToDigit '5' = just ( 5)
+charToDigit '6' = just ( 6)
+charToDigit '7' = just ( 7)
+charToDigit '8' = just ( 8)
+charToDigit '9' = just ( 9)
+charToDigit _   = nothing
+
+getNumArg1 : (List (List Char)) → ℕ
+getNumArg1 [] = 0
+getNumArg1 ([] ∷ y) = 0
+getNumArg1 ((x ∷ _) ∷ y) with charToDigit x
+... | just n = n
+... | nothing  = 0
+
+
+--
+-- CommFListN 5 x is too slow use compiler
+-- agda --compile sym5n.agda
+--
+
+main : IO ⊤
+main = getArgs >>= (λ x →  putStrLn $ toCostring $ sym5solvable $ getNumArg1 x ) 
+
+
diff -r a5b3061f15ee -r 6d1619d9f880 sym2.agda
--- a/sym2.agda	Tue Dec 15 08:50:32 2020 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,125 +0,0 @@
-open import Level hiding ( suc ; zero )
-open import Algebra
-module sym2 where
-
-open import Symmetric 
-open import Data.Unit
-open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
-open import Function
-open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
-open import Relation.Nullary
-open import Data.Empty
-open import Data.Product
-
-open import Gutil 
-open import Putil 
-open import FLutil 
-open import Solvable using (solvable)
-open import  Relation.Binary.PropositionalEquality hiding ( [_] )
-
-open import Data.Fin
-open import Data.Fin.Permutation
-
-sym2solvable : solvable (Symmetric 2)
-solvable.dervied-length sym2solvable = 1
-solvable.end sym2solvable x d = solved x d where
-
-   open import Data.List using ( List ; [] ; _∷_ )
-
-   open Solvable (Symmetric 2)
-   -- open Group (Symmetric 2) using (_⁻¹)
-
-
-   p0 :  FL→perm ((# 0) :: ((# 0 ) :: f0)) =p= pid
-   p0 = pleq _ _ refl
-
-   p0r :  perm→FL pid ≡  ((# 0) :: ((# 0 ) :: f0)) 
-   p0r = refl
-
-   p1 :  FL→perm ((# 1) :: ((# 0 ) :: f0)) =p= pswap pid
-   p1 = pleq _ _ refl
-
-   p1r :  perm→FL (pswap pid) ≡  ((# 1) :: ((# 0 ) :: f0)) 
-   p1r = refl
-
-   -- FL→iso : (fl : FL 2 )  → perm→FL ( FL→perm fl ) ≡ fl
-   -- FL→iso  (zero :: (zero :: f0)) = refl
-   -- FL→iso ((suc zero) :: (zero :: f0)) = refl
-
-   open _=p=_
-   open ≡-Reasoning
-
-   sym2lem0 :  ( g h : Permutation 2 2 ) → (q : Fin 2)  → ([ g , h ]  ⟨$⟩ʳ q) ≡ (pid ⟨$⟩ʳ q)
-   sym2lem0 g h q with perm→FL g | perm→FL h | inspect perm→FL g | inspect perm→FL h
-   sym2lem0 g h q | zero :: (zero :: f0) | _ | record { eq = g=00} | record { eq = h=00}  = begin
-             [ g , h ]  ⟨$⟩ʳ q
-           ≡⟨⟩
-              h ⟨$⟩ʳ  (g ⟨$⟩ʳ ( h ⟨$⟩ˡ ( g ⟨$⟩ˡ q ))) 
-           ≡⟨ cong (λ k → h ⟨$⟩ʳ  (g ⟨$⟩ʳ ( h ⟨$⟩ˡ  k))) ((peqˡ sym2lem1 _ )) ⟩
-              h ⟨$⟩ʳ  (g ⟨$⟩ʳ ( h ⟨$⟩ˡ ( pid ⟨$⟩ˡ q ))) 
-           ≡⟨ cong (λ k →  h ⟨$⟩ʳ k ) (peq sym2lem1 _ )  ⟩
-              h ⟨$⟩ʳ  (pid ⟨$⟩ʳ ( h ⟨$⟩ˡ ( pid ⟨$⟩ˡ q ))) 
-           ≡⟨⟩
-             [ pid , h ]  ⟨$⟩ʳ q
-           ≡⟨ peq (idcomtl h) q ⟩
-             q
-           ∎ where
-             sym2lem1 :  g =p= pid
-             sym2lem1 = FL-inject  g=00
-   sym2lem0 g h q | _ | zero :: (zero :: f0) | record { eq = g=00} | record { eq = h=00} = begin
-             [ g , h ]  ⟨$⟩ʳ q
-           ≡⟨⟩
-              h ⟨$⟩ʳ  (g ⟨$⟩ʳ ( h ⟨$⟩ˡ ( g ⟨$⟩ˡ q ))) 
-           ≡⟨ peq sym2lem2 _   ⟩
-              pid ⟨$⟩ʳ  (g ⟨$⟩ʳ ( h ⟨$⟩ˡ ( g ⟨$⟩ˡ q ))) 
-           ≡⟨ cong (λ k → pid ⟨$⟩ʳ  (g ⟨$⟩ʳ k)) (peqˡ sym2lem2 _ ) ⟩
-              pid ⟨$⟩ʳ  (g ⟨$⟩ʳ ( pid ⟨$⟩ˡ ( g ⟨$⟩ˡ q ))) 
-           ≡⟨⟩
-             [ g , pid ]  ⟨$⟩ʳ q
-           ≡⟨ peq (idcomtr g) q ⟩
-             q
-          ∎ where
-             sym2lem2 :  h =p= pid
-             sym2lem2 = FL-inject h=00
-   sym2lem0 g h q | suc zero :: (zero :: f0) | suc zero :: (zero :: f0) | record { eq = g=00} | record { eq = h=00}= begin
-             [ g , h ]  ⟨$⟩ʳ q
-           ≡⟨⟩
-              h ⟨$⟩ʳ  (g ⟨$⟩ʳ ( h ⟨$⟩ˡ ( g ⟨$⟩ˡ q ))) 
-           ≡⟨ peq (psym g=h ) _  ⟩
-              g ⟨$⟩ʳ  (g ⟨$⟩ʳ ( h ⟨$⟩ˡ ( g ⟨$⟩ˡ q ))) 
-           ≡⟨ cong (λ k →   g ⟨$⟩ʳ  (g ⟨$⟩ʳ  k) ) (peqˡ (psym g=h) _)  ⟩
-              g ⟨$⟩ʳ  (g ⟨$⟩ʳ ( g ⟨$⟩ˡ ( g ⟨$⟩ˡ q ))) 
-           ≡⟨ cong (λ k → g  ⟨$⟩ʳ k) ( inverseʳ g )  ⟩
-              g ⟨$⟩ʳ  ( g ⟨$⟩ˡ q ) 
-           ≡⟨ inverseʳ g   ⟩
-             q
-          ∎ where
-              g=h :  g =p= h
-              g=h =  FL-inject (trans g=00 (sym h=00))
-   solved :  (x : Permutation 2 2) → Commutator  (λ x₁ → Lift (Level.suc Level.zero) ⊤) x → x =p= pid
-   solved x uni = prefl
-   solved x (comm {g} {h} _ _) = record { peq = sym2lem0 g h  } 
-   solved x (gen {f} {g} d d₁) with solved f d | solved g d₁
-   ... | record { peq = f=e } | record { peq = g=e } = record { peq = λ q → genlem q } where
-      genlem : ( q : Fin 2 ) → g ⟨$⟩ʳ ( f ⟨$⟩ʳ q ) ≡ q
-      genlem q = begin
-             g ⟨$⟩ʳ ( f ⟨$⟩ʳ q )
-          ≡⟨ g=e ( f ⟨$⟩ʳ q ) ⟩
-             f ⟨$⟩ʳ q 
-          ≡⟨ f=e q ⟩
-             q
-          ∎ where open ≡-Reasoning
-   solved x (ccong {f} {g} (record {peq = f=g}) d) with solved f d
-   ... | record { peq = f=e }  =  record  { peq = λ q → cc q } where
-      cc : ( q : Fin 2 ) → x ⟨$⟩ʳ q ≡ q
-      cc q = begin
-             x ⟨$⟩ʳ q
-          ≡⟨ sym (f=g q) ⟩
-             f ⟨$⟩ʳ q
-          ≡⟨ f=e q ⟩
-             q
-          ∎ where open ≡-Reasoning
-
-
-
-
diff -r a5b3061f15ee -r 6d1619d9f880 sym2n.agda
--- a/sym2n.agda	Tue Dec 15 08:50:32 2020 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,51 +0,0 @@
-open import Level hiding ( suc ; zero )
-open import Algebra
-module sym2n where
-
-open import Symmetric 
-open import Data.Unit
-open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
-open import Function
-open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
-open import Relation.Nullary
-open import Data.Empty
-open import Data.Product
-
-open import Gutil 
-open import Putil 
-open import Solvable using (solvable)
-open import  Relation.Binary.PropositionalEquality hiding ( [_] )
-
-open import Data.Fin
-open import Data.Fin.Permutation hiding (_∘ₚ_)
-
-infixr  200 _∘ₚ_
-_∘ₚ_ = Data.Fin.Permutation._∘ₚ_
-
-
-sym2solvable : solvable (Symmetric 2)
-solvable.dervied-length sym2solvable = 1
-solvable.end sym2solvable x d = solved1 x d where
-
-   open import Data.List using ( List ; [] ; _∷_ )
-
-   open Solvable (Symmetric 2)
-   open import FLutil
-   open import Data.List.Fresh hiding ([_])
-   open import Relation.Nary using (⌊_⌋)
-
-   p0id :  FL→perm ((# 0) :: ((# 0) :: f0)) =p= pid
-   p0id = pleq _ _ refl
-
-   open import Data.List.Fresh.Relation.Unary.Any
-   open import FLComm
-
-   stage2FList : CommFListN 2 1 ≡ cons (zero :: zero :: f0) [] (Level.lift tt)
-   stage2FList = refl
-
-   solved1 :  (x : Permutation 2 2) → deriving 1 x → x =p= pid
-   solved1 x dr = CommSolved 2 x ( CommFListN 2 1 ) stage2FList p0id solved0 where
-      solved0 : Any (perm→FL x ≡_) ( CommFListN 2 1 )
-      solved0 = CommStage→ 2 1 x dr
-
-
diff -r a5b3061f15ee -r 6d1619d9f880 sym3.agda
--- a/sym3.agda	Tue Dec 15 08:50:32 2020 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,185 +0,0 @@
-open import Level hiding ( suc ; zero )
-open import Algebra
-module sym3 where
-
-open import Symmetric 
-open import Data.Unit
-open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
-open import Function
-open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
-open import Relation.Nullary
-open import Data.Empty
-open import Data.Product
-
-open import Gutil 
-open import Putil 
-open import FLutil 
-open import Solvable using (solvable)
-open import  Relation.Binary.PropositionalEquality hiding ( [_] )
-
-open import Data.Fin
-open import Data.Fin.Permutation hiding (_∘ₚ_)
-
-infixr  200 _∘ₚ_
-_∘ₚ_ = Data.Fin.Permutation._∘ₚ_
-
-
-sym3solvable : solvable (Symmetric 3)
-solvable.dervied-length sym3solvable = 2
-solvable.end sym3solvable x d = solved1 x d where
-
-   open import Data.List using ( List ; [] ; _∷_ )
-
-   open Solvable (Symmetric 3)
-
-   p0id :  FL→perm ((# 0) :: ((# 0) :: ((# 0 ) :: f0))) =p= pid
-   p0id = pleq _ _ refl 
-
-   p0 =  FL→perm ((# 0) :: ((# 0) :: ((# 0 ) :: f0))) 
-   p1 =  FL→perm ((# 0) :: ((# 1) :: ((# 0 ) :: f0))) 
-   p2 =  FL→perm ((# 1) :: ((# 0) :: ((# 0 ) :: f0))) 
-   p3 =  FL→perm ((# 1) :: ((# 1) :: ((# 0 ) :: f0))) 
-   p4 =  FL→perm ((# 2) :: ((# 0) :: ((# 0 ) :: f0))) 
-   p5 =  FL→perm ((# 2) :: ((# 1) :: ((# 0 ) :: f0))) 
-   t0  =  plist p0 ∷ plist p1 ∷  plist p2 ∷ plist p3 ∷ plist p4 ∷  plist p5 ∷ [] 
-
-   t1  =  plist [ p0 , p0 ] ∷ plist [ p1 , p0 ] ∷  plist [ p2 , p0 ] ∷ plist [ p3 , p0 ] ∷ plist [ p4 , p0 ] ∷  plist [ p5 , p1 ] ∷ 
-          plist [ p0 , p1 ] ∷ plist [ p1 , p1 ] ∷  plist [ p2 , p1 ] ∷ plist [ p3 , p1 ] ∷ plist [ p4 , p1 ] ∷  plist [ p5 , p1 ] ∷ 
-          plist [ p0 , p2 ] ∷ plist [ p1 , p2 ] ∷  plist [ p2 , p2 ] ∷ plist [ p3 , p2 ] ∷ plist [ p4 , p2 ] ∷  plist [ p5 , p2 ] ∷ 
-          plist [ p0 , p3 ] ∷ plist [ p1 , p3 ] ∷  plist [ p3 , p3 ] ∷ plist [ p3 , p3 ] ∷ plist [ p4 , p3 ] ∷  plist [ p5 , p3 ] ∷ 
-          plist [ p0 , p4 ] ∷ plist [ p1 , p4 ] ∷  plist [ p3 , p4 ] ∷ plist [ p3 , p4 ] ∷ plist [ p4 , p4 ] ∷  plist [ p5 , p4 ] ∷ 
-          plist [ p0 , p5 ] ∷ plist [ p1 , p5 ] ∷  plist [ p3 , p5 ] ∷ plist [ p3 , p5 ] ∷ plist [ p4 , p4 ] ∷  plist [ p5 , p5 ] ∷ 
-          []
-
-   open _=p=_
-   
-   stage1 :  (x : Permutation 3 3) →  Set (Level.suc Level.zero)
-   stage1 x = Commutator (λ x₂ → Lift (Level.suc Level.zero) ⊤)  x 
-
-   open import logic
-
-   p33=4 : ( p3  ∘ₚ p3 ) =p= p4
-   p33=4 = pleq _ _ refl
-
-   p44=3 : ( p4  ∘ₚ p4 ) =p= p3
-   p44=3 = pleq _ _ refl
-
-   p34=0 : ( p3  ∘ₚ p4 ) =p= pid
-   p34=0 = pleq _ _ refl
-
-   p43=0 : ( p4  ∘ₚ p3 ) =p= pid
-   p43=0 = pleq _ _ refl
-
-   com33 : [ p3 , p3 ] =p= pid
-   com33 = pleq _ _ refl
-
-   com44 : [ p4 , p4 ] =p= pid
-   com44 = pleq _ _ refl
-
-   com34 : [ p3 , p4 ] =p= pid
-   com34 = pleq _ _ refl
-
-   com43 : [ p4 , p3 ] =p= pid
-   com43 = pleq _ _ refl
-
-
-   pFL : ( g : Permutation 3 3) → { x : FL 3 } →  perm→FL g ≡ x → g =p=  FL→perm x
-   pFL g {x} refl = ptrans (psym (FL←iso g)) ( FL-inject refl ) 
-
-   open ≡-Reasoning
-
---   st01 : ( x y : Permutation 3 3) →   x =p= p3 →  y =p= p3 → x ∘ₚ  y =p= p4 
---   st01 x y s t = record { peq = λ q → ( begin
---         (x ∘ₚ y) ⟨$⟩ʳ q
---       ≡⟨ peq ( presp s t ) q ⟩
---          ( p3  ∘ₚ p3 ) ⟨$⟩ʳ q
---       ≡⟨ peq  p33=4 q  ⟩
---         p4 ⟨$⟩ʳ q
---       ∎ ) }
-
-   st00 = perm→FL [ FL→perm ((suc zero) :: (suc zero :: (zero :: f0 ))) , FL→perm  ((suc (suc zero)) :: (suc zero) :: (zero :: f0))  ]
-
-   st02 :  ( g h : Permutation 3 3) →  ([ g , h ] =p= pid) ∨ ([ g , h ] =p= p3) ∨ ([ g , h ] =p= p4)
-   st02 g h with perm→FL g | perm→FL h | inspect perm→FL g | inspect perm→FL h
-   ... | (zero :: (zero :: (zero :: f0))) | t | record { eq = ge } | te = case1 (ptrans (comm-resp {g} {h} {pid} (FL-inject ge ) prefl ) (idcomtl h) )
-   ... | s | (zero :: (zero :: (zero :: f0))) | se |  record { eq = he } = case1 (ptrans (comm-resp {g} {h} {_} {pid} prefl (FL-inject he ))(idcomtr g) )
-   ... | (zero :: (suc zero) :: (zero :: f0 )) |  (zero :: (suc zero) :: (zero :: f0 )) |  record { eq = ge } |  record { eq = he } =
-        case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) )
-   ... | (suc zero) :: (zero :: (zero :: f0 )) | (suc zero) :: (zero :: (zero :: f0 )) |  record { eq = ge } |  record { eq = he } = 
-        case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) )
-   ... | (suc zero) :: (suc zero :: (zero :: f0 )) |  (suc zero) :: (suc zero :: (zero :: f0 )) |  record { eq = ge } |  record { eq = he } = 
-        case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) )
-   ... | (suc (suc zero)) :: (zero :: (zero :: f0 )) | (suc (suc zero)) :: (zero :: (zero :: f0 )) | record { eq = ge } |  record { eq = he } =
-        case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) )
-   ... | (suc (suc zero)) :: (suc zero) :: (zero :: f0) | (suc (suc zero)) :: (suc zero) :: (zero :: f0) | record { eq = ge } |  record { eq = he } =
-        case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) )
-
-   ... | (zero :: (suc zero) :: (zero :: f0 )) | ((suc zero) :: (zero :: (zero :: f0 ))) | record { eq = ge } |  record { eq = he } =
-           case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   ... | (zero :: (suc zero) :: (zero :: f0 )) | (suc zero) :: (suc zero :: (zero :: f0 )) | record { eq = ge } |  record { eq = he } = 
-           case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   ... | (zero :: (suc zero) :: (zero :: f0 )) |  (suc (suc zero)) :: (zero :: (zero :: f0 ))| record { eq = ge } |  record { eq = he } =  
-           case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   ... | (zero :: (suc zero) :: (zero :: f0 )) | ((suc (suc zero)) :: (suc zero) :: (zero :: f0))| record { eq = ge } |  record { eq = he } =   
-           case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   ... | ((suc zero) :: (zero :: (zero :: f0 ))) | (zero :: (suc zero) :: (zero :: f0 )) | record { eq = ge } |  record { eq = he } = 
-          case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   ... | ((suc zero) :: (zero :: (zero :: f0 ))) | (suc zero) :: (suc zero :: (zero :: f0 )) | record { eq = ge } |  record { eq = he } = 
-            case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   ... | ((suc zero) :: (zero :: (zero :: f0 ))) | ((suc (suc zero)) :: (zero :: (zero :: f0 )))| record { eq = ge } |  record { eq = he } =  
-            case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   ... | ((suc zero) :: (zero :: (zero :: f0 ))) |  (suc (suc zero)) :: (suc zero) :: (zero :: f0) | record { eq = ge } |  record { eq = he } =  
-            case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   ... | (suc zero) :: (suc zero :: (zero :: f0 )) |  (zero :: (suc zero) :: (zero :: f0 )) | record { eq = ge } |  record { eq = he } =  
-            case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   ... | (suc zero) :: (suc zero :: (zero :: f0 )) |  ((suc zero) :: (zero :: (zero :: f0 ))) | record { eq = ge } |  record { eq = he } =  
-            case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   ... | (suc zero) :: (suc zero :: (zero :: f0 )) |  ((suc (suc zero)) :: (zero :: (zero :: f0 ))) | record { eq = ge } |  record { eq = he } =  
-         case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) )
-   ... | (suc zero) :: (suc zero :: (zero :: f0 )) |  ((suc (suc zero)) :: (suc zero) :: (zero :: f0)) | record { eq = ge } |  record { eq = he } =   
-            case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   ... | (suc (suc zero)) :: (zero :: (zero :: f0 )) | ((zero :: (suc zero) :: (zero :: f0 )) ) | record { eq = ge } |  record { eq = he } =
-          case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   ... | (suc (suc zero)) :: (zero :: (zero :: f0 )) | ((suc zero) :: (zero :: (zero :: f0 ))) | record { eq = ge } |  record { eq = he } =
-          case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   ... | (suc (suc zero)) :: (zero :: (zero :: f0 )) | ((suc zero) :: (suc zero :: (zero :: f0 ))) | record { eq = ge } |  record { eq = he } =
-          case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) )
-   ... | (suc (suc zero)) :: (zero :: (zero :: f0 )) | ((suc (suc zero)) :: (suc zero) :: (zero :: f0)) | record { eq = ge } |  record { eq = he } = 
-          case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   ... |  ((suc (suc zero)) :: (suc zero) :: (zero :: f0)) | ((zero :: (suc zero) :: (zero :: f0 )) ) | record { eq = ge } |  record { eq = he } =
-          case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   ... |  ((suc (suc zero)) :: (suc zero) :: (zero :: f0)) | ((suc zero) :: (zero :: (zero :: f0 ))) | record { eq = ge } |  record { eq = he } =
-          case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   ... |  ((suc (suc zero)) :: (suc zero) :: (zero :: f0)) | ((suc zero) :: (suc zero :: (zero :: f0 )))  | record { eq = ge } |  record { eq = he } =
-          case2 (case2 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   ... |  ((suc (suc zero)) :: (suc zero) :: (zero :: f0)) | (suc (suc zero)) :: (zero :: (zero :: f0 ))  | record { eq = ge } |  record { eq = he } =
-          case2 (case1 (ptrans (comm-resp (pFL g ge) (pFL h he)) (FL-inject refl) ))
-   
-   stage12  :  (x : Permutation 3 3) → stage1 x →  ( x =p= pid ) ∨ ( x =p= p3 ) ∨ ( x =p= p4 )
-   stage12 x (comm {g} {h} x1 y1 ) = st02 g h
-   stage12 _ (ccong {y} x=y sx) with stage12 y sx
-   ... | case1 id = case1 ( ptrans (psym x=y ) id )
-   ... | case2 (case1 x₁) = case2 (case1 ( ptrans (psym x=y ) x₁ ))
-   ... | case2 (case2 x₁) = case2 (case2 ( ptrans (psym x=y ) x₁ ))
-
-
-   solved1 :  (x : Permutation 3 3) →  Commutator (λ x₁ → Commutator (λ x₂ → Lift (Level.suc Level.zero) ⊤) x₁) x → x =p= pid
-   solved1 x (ccong {f} {g} (record {peq = f=g}) d) with solved1 f d
-   ... | record { peq = f=e }  =  record  { peq = λ q → cc q } where
-      cc : ( q : Fin 3 ) → x ⟨$⟩ʳ q ≡ q
-      cc q = begin
-             x ⟨$⟩ʳ q
-          ≡⟨ sym (f=g q) ⟩
-             f ⟨$⟩ʳ q
-          ≡⟨ f=e q ⟩
-             q
-          ∎ 
-   solved1 _ (comm {g} {h} x y) with stage12 g x | stage12 h y
-   ... | case1 t | case1 s = ptrans (comm-resp t s) (comm-refl {pid} prefl)
-   ... | case1 t | case2 s = ptrans (comm-resp {g} {h} {pid} t prefl) (idcomtl h)
-   ... | case2 t | case1 s = ptrans (comm-resp {g} {h} {_} {pid} prefl s) (idcomtr g)
-   ... | case2 (case1 t) | case2 (case1 s) = record { peq = λ q → trans ( peq ( comm-resp {g} {h}  t s ) q ) (peq com33 q) }
-   ... | case2 (case2 t) | case2 (case2 s) = record { peq = λ q → trans ( peq ( comm-resp {g} {h}  t s ) q ) (peq com44 q) }
-   ... | case2 (case1 t) | case2 (case2 s) = record { peq = λ q → trans ( peq ( comm-resp {g} {h}  t s ) q ) (peq com34 q) }
-   ... | case2 (case2 t) | case2 (case1 s) = record { peq = λ q → trans ( peq ( comm-resp {g} {h}  t s ) q ) (peq com43 q) }
-
diff -r a5b3061f15ee -r 6d1619d9f880 sym3n.agda
--- a/sym3n.agda	Tue Dec 15 08:50:32 2020 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,51 +0,0 @@
-open import Level hiding ( suc ; zero )
-open import Algebra
-module sym3n where
-
-open import Symmetric 
-open import Data.Unit
-open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
-open import Function
-open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
-open import Relation.Nullary
-open import Data.Empty
-open import Data.Product
-
-open import Gutil 
-open import Putil 
-open import Solvable using (solvable)
-open import  Relation.Binary.PropositionalEquality hiding ( [_] )
-
-open import Data.Fin
-open import Data.Fin.Permutation hiding (_∘ₚ_)
-
-infixr  200 _∘ₚ_
-_∘ₚ_ = Data.Fin.Permutation._∘ₚ_
-
-
-sym3solvable : solvable (Symmetric 3)
-solvable.dervied-length sym3solvable = 2
-solvable.end sym3solvable x d = solved1 x d where
-
-   open import Data.List using ( List ; [] ; _∷_ )
-
-   open Solvable (Symmetric 3)
-   open import FLutil
-   open import Data.List.Fresh hiding ([_])
-   open import Relation.Nary using (⌊_⌋)
-
-   p0id :  FL→perm ((# 0) :: ((# 0) :: ((# 0 ) :: f0))) =p= pid
-   p0id = pleq _ _ refl
-
-   open import Data.List.Fresh.Relation.Unary.Any
-   open import FLComm
-
-   stage3FList : CommFListN 3 2 ≡ cons (zero :: zero :: zero :: f0) [] (Level.lift tt)
-   stage3FList = refl
-
-   solved1 :  (x : Permutation 3 3) → deriving 2 x → x =p= pid
-   solved1 x dr = CommSolved 3 x ( CommFListN 3 2 ) stage3FList p0id solved2 where
-      solved2 : Any (perm→FL x ≡_) ( CommFListN 3 2 )
-      solved2 = CommStage→ 3 2 x dr
-
-
diff -r a5b3061f15ee -r 6d1619d9f880 sym4.agda
--- a/sym4.agda	Tue Dec 15 08:50:32 2020 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,65 +0,0 @@
-open import Level hiding ( suc ; zero )
-open import Algebra
-module sym4 where
-
-open import Symmetric 
-open import Data.Unit
-open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
-open import Function
-open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
-open import Relation.Nullary
-open import Data.Empty
-open import Data.Product
-
-open import Gutil 
-open import Putil 
-open import Solvable using (solvable)
-open import  Relation.Binary.PropositionalEquality hiding ( [_] )
-
-open import Data.Fin
-open import Data.Fin.Permutation hiding (_∘ₚ_)
-
-infixr  200 _∘ₚ_
-_∘ₚ_ = Data.Fin.Permutation._∘ₚ_
-
-sym4solvable : solvable (Symmetric 4)
-solvable.dervied-length sym4solvable = 3
-solvable.end sym4solvable x d = solved1 x d where
-
-   open import Data.List using ( List ; [] ; _∷_ )
-   open Solvable (Symmetric 4)
-
-   -- Klien
-   --
-   --  1                     (1,2),(3,4)           (1,3),(2,4)           (1,4),(2,3)
-   --  0 ∷ 1 ∷ 2 ∷ 3 ∷ [] ,  1 ∷ 0 ∷ 3 ∷ 2 ∷ [] ,  2 ∷ 3 ∷ 0 ∷ 1 ∷ [] ,  3 ∷ 2 ∷ 1 ∷ 0 ∷ [] ,  
-
-   a0 =  pid {4}
-   a1 =  pswap (pswap (pid {0}))
-   a2 =  pid {4} ∘ₚ pins (n≤ 3) ∘ₚ pins (n≤ 3 ) 
-   a3 =  pins (n≤ 3)  ∘ₚ  pins (n≤ 2) ∘ₚ pswap (pid {2})
-
-   k3 = plist  (a1  ∘ₚ a2 ) ∷ plist (a1 ∘ₚ a3)  ∷ plist (a2 ∘ₚ a1 ) ∷  []
-
-   open import FLutil
-   open import Data.List.Fresh hiding ([_])
-   open import Relation.Nary using (⌊_⌋)
-
-   p0id :  FL→perm ((# 0) :: (# 0) :: ((# 0) :: ((# 0 ) :: f0))) =p= pid
-   p0id = pleq _ _ refl
-
-
-   open import Data.List.Fresh.Relation.Unary.Any
-   open import FLComm
-
-   stage3FList : CommFListN 4 3 ≡ cons (zero :: zero :: zero :: zero :: f0) [] (Level.lift tt)
-   stage3FList = refl
-
-   st3 = proj₁ (toList ( CommFListN 4 2 ))
-   -- st4 = {!!}
- 
-   solved1 :  (x : Permutation 4 4) → deriving 3 x → x =p= pid 
-   solved1 x dr = CommSolved 4 x ( CommFListN 4 3 ) stage3FList p0id solved2 where
-      --    p0id :  FL→perm ((# 0) :: ((# 0) :: ((# 0 ) :: f0))) =p= pid
-      solved2 : Any (perm→FL x ≡_) ( CommFListN 4 3 )
-      solved2 = CommStage→ 4 3 x dr 
diff -r a5b3061f15ee -r 6d1619d9f880 sym5.agda
--- a/sym5.agda	Tue Dec 15 08:50:32 2020 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,220 +0,0 @@
-open import Level hiding ( suc ; zero )
-open import Algebra
-module sym5 where
-
-open import Symmetric 
-open import Data.Unit using (⊤ ; tt )
-open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
-open import Function hiding (flip)
-open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
-open import Data.Nat.Properties
-open import Relation.Nullary
-open import Data.Empty
-open import Data.Product
-
-open import Gutil 
-open import Putil 
-open import Solvable using (solvable)
-open import  Relation.Binary.PropositionalEquality hiding ( [_] )
-
-open import Data.Fin hiding (_<_ ; _≤_  ; lift )
-open import Data.Fin.Permutation  hiding (_∘ₚ_)
-
-infixr  200 _∘ₚ_
-_∘ₚ_ = Data.Fin.Permutation._∘ₚ_
-
-open import Data.List  hiding ( [_] )
-open import nat
-open import fin
-open import logic
-
-open _∧_
-
-¬sym5solvable : ¬ ( solvable (Symmetric 5) )
-¬sym5solvable sol = counter-example (end5 (abc 0<3 0<4 ) (dervie-any-3rot0 (dervied-length sol) 0<3 0<4 ) ) where
---
---    dba       1320      d → b → a → d
---    (dba)⁻¹   3021      a → b → d → a
---    aec       21430
---    (aec)⁻¹   41032
---    [ dba , aec ] = (abd)(cea)(dba)(aec) = abc
---      so commutator always contains abc, dba and aec
-
-     open ≡-Reasoning
-
-     open solvable
-     open Solvable ( Symmetric 5) 
-     end5 : (x : Permutation 5 5) → deriving (dervied-length sol) x →  x =p= pid  
-     end5 x der = end sol x der
-
-     0<4 : 0 < 4
-     0<4 = s≤s z≤n
-
-     0<3 : 0 < 3
-     0<3 = s≤s z≤n
-
-     --- 1 ∷ 2 ∷ 0 ∷ []      abc
-     3rot : Permutation 3 3
-     3rot = pid {3} ∘ₚ pins (n≤ 2)
-
-     save2 : {i j : ℕ }  → (i ≤ 3 ) → ( j ≤ 4 ) →  Permutation  5 5 
-     save2 i<3 j<4 = flip (pins (s≤s i<3)) ∘ₚ flip (pins j<4) 
-
-     ins2 : {i j : ℕ }  → Permutation 3 3  → (i ≤ 3 ) → ( j ≤ 4 ) → Permutation  5 5
-     ins2 abc i<3 j<4 = (save2 i<3 j<4 ∘ₚ (pprep (pprep abc))) ∘ₚ flip (save2 i<3 j<4 ) 
-
-     ins2cong : {i j : ℕ }  → {x y : Permutation 3 3 } → {i<3 : i ≤ 3 } → {j<4 : j ≤ 4 } → x =p= y → ins2 x i<3 j<4  =p= ins2 y i<3 j<4
-     ins2cong {i} {j} {x} {y} {i<3} {j<4} x=y = presp {5} {save2 i<3 j<4 ∘ₚ (pprep (pprep x))} {_} {flip (save2 i<3 j<4 )}
-         (presp {5} {save2 i<3 j<4} prefl (pprep-cong (pprep-cong x=y)) ) prefl 
-
-     open _=p=_
-
-     abc : {i j : ℕ }  → (i ≤ 3 ) → ( j ≤ 4 ) → Permutation  5 5
-     abc i<3 j<4 = ins2 3rot i<3 j<4
-     dba : {i j : ℕ }  → (i ≤ 3 ) → ( j ≤ 4 ) → Permutation  5 5
-     dba i<3 j<4 = ins2 (3rot ∘ₚ 3rot) i<3 j<4
-
-     counter-example :  ¬ (abc 0<3 0<4  =p= pid )
-     counter-example eq with ←pleq _ _ eq
-     ...  | ()
-
-     record Triple {i j : ℕ } (i<3 : i ≤ 3) (j<4 : j ≤ 4) (rot : Permutation 3 3) : Set where
-       field 
-         dba0<3 : Fin 4
-         dba1<4 : Fin 5
-         aec0<3 : Fin 4
-         aec1<4 : Fin 5
-         abc= : ins2 rot i<3 j<4 =p= [ ins2 (rot ∘ₚ rot)  (fin≤n {3} dba0<3) (fin≤n {4} dba1<4)  , ins2 (rot ∘ₚ rot) (fin≤n {3} aec0<3) (fin≤n {4} aec1<4) ]
-
-     open Triple
-     triple : {i j : ℕ } → (i<3 : i ≤ 3) (j<4 : j ≤ 4) → Triple i<3 j<4 3rot
-     triple z≤n z≤n =                               record { dba0<3 = # 0 ; dba1<4 = # 4 ; aec0<3 = # 2 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     triple z≤n (s≤s z≤n) =                         record { dba0<3 = # 0 ; dba1<4 = # 4 ; aec0<3 = # 2 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     triple z≤n (s≤s (s≤s z≤n)) =                   record { dba0<3 = # 1 ; dba1<4 = # 0 ; aec0<3 = # 3 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
-     triple z≤n (s≤s (s≤s (s≤s z≤n))) =             record { dba0<3 = # 1 ; dba1<4 = # 3 ; aec0<3 = # 0 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     triple z≤n (s≤s (s≤s (s≤s (s≤s z≤n)))) =       record { dba0<3 = # 0 ; dba1<4 = # 0 ; aec0<3 = # 2 ; aec1<4 = # 4 ; abc= = pleq _ _ refl } 
-     triple (s≤s z≤n) z≤n =                         record { dba0<3 = # 0 ; dba1<4 = # 2 ; aec0<3 = # 3 ; aec1<4 = # 1 ; abc= = pleq _ _ refl }
-     triple (s≤s z≤n) (s≤s z≤n) =                   record { dba0<3 = # 0 ; dba1<4 = # 2 ; aec0<3 = # 3 ; aec1<4 = # 1 ; abc= = pleq _ _ refl }
-     triple (s≤s z≤n) (s≤s (s≤s z≤n)) =             record { dba0<3 = # 1 ; dba1<4 = # 0 ; aec0<3 = # 3 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
-     triple (s≤s z≤n) (s≤s (s≤s (s≤s z≤n))) =       record { dba0<3 = # 0 ; dba1<4 = # 3 ; aec0<3 = # 1 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     triple (s≤s z≤n) (s≤s (s≤s (s≤s (s≤s z≤n)))) = record { dba0<3 = # 2 ; dba1<4 = # 4 ; aec0<3 = # 0 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
-     triple (s≤s (s≤s z≤n)) z≤n =                   record { dba0<3 = # 3 ; dba1<4 = # 0 ; aec0<3 = # 1 ; aec1<4 = # 3 ; abc= = pleq _ _ refl }
-     triple (s≤s (s≤s z≤n)) (s≤s z≤n) =             record { dba0<3 = # 3 ; dba1<4 = # 0 ; aec0<3 = # 1 ; aec1<4 = # 3 ; abc= = pleq _ _ refl }
-     triple (s≤s (s≤s z≤n)) (s≤s (s≤s z≤n)) =       record { dba0<3 = # 1 ; dba1<4 = # 3 ; aec0<3 = # 0 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     triple (s≤s (s≤s z≤n)) (s≤s (s≤s (s≤s z≤n))) = record { dba0<3 = # 0 ; dba1<4 = # 3 ; aec0<3 = # 1 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     triple (s≤s (s≤s z≤n)) (s≤s (s≤s (s≤s (s≤s z≤n)))) = record { dba0<3 = # 1 ; dba1<4 = # 4 ; aec0<3 = # 2 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
-     triple (s≤s (s≤s (s≤s z≤n))) z≤n =             record { dba0<3 = # 2 ; dba1<4 = # 4 ; aec0<3 = # 1 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     triple (s≤s (s≤s (s≤s z≤n))) (s≤s z≤n) =       record { dba0<3 = # 2 ; dba1<4 = # 4 ; aec0<3 = # 1 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     triple (s≤s (s≤s (s≤s z≤n))) (s≤s (s≤s z≤n)) = record { dba0<3 = # 0 ; dba1<4 = # 0 ; aec0<3 = # 2 ; aec1<4 = # 4 ; abc= = pleq _ _ refl }
-     triple (s≤s (s≤s (s≤s z≤n))) (s≤s (s≤s (s≤s z≤n))) = record { dba0<3 = # 2 ; dba1<4 = # 4 ; aec0<3 = # 0 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
-     triple (s≤s (s≤s (s≤s z≤n))) (s≤s (s≤s (s≤s (s≤s z≤n)))) = 
-                                                    record { dba0<3 = # 1 ; dba1<4 = # 4 ; aec0<3 = # 0 ; aec1<4 = # 3 ; abc= = pleq _ _ refl }  
-     
-     _⁻¹ : {n : ℕ } ( x : Permutation n n) → Permutation n n 
-     _⁻¹ = pinv 
-
-     -- tt5 : (i : Fin 4) (j : Fin 5) → (z : Fin 4) → (w : Fin 5) → (x : Fin 5) (y : Fin 4)  → (rot : Permutation 3 3 )  → List (List ℕ) → List (List ℕ)
-     -- tt5 i j z w x y rot t with is-=p= (ins2 rot (fin≤n  i) (fin≤n  j)) 
-     --             [ ins2 (rot ∘ₚ rot)   (fin≤n  z) (fin≤n  x)  , ins2 (pinv rot) (fin≤n  y)  (fin≤n  w) ]
-     -- ... | yes _ = ( toℕ i ∷ toℕ j ∷ 9 ∷ toℕ z ∷ toℕ x ∷ toℕ y ∷ toℕ w  ∷ [] ) ∷ t
-     -- ... | no _ = t
-
-     -- open import  Relation.Binary.Definitions
-
-     -- tt2 : (i : Fin 4) (j : Fin 5) →  (rot : Permutation 3 3 ) → List (List ℕ)
-     -- tt2  i j rot = tt3 (# 4) (# 3) (# 3) (# 4) [] where
-     --     tt3 : (w : Fin 5) (z : Fin 4) (x : Fin 4) (y : Fin 5) → List (List ℕ) → List (List ℕ)
-     --     tt3 zero zero zero zero t =                                       ( tt5 i j zero zero zero zero    rot [] ) ++ t
-     --     tt3 (suc w)  zero zero zero t =  tt3 (fin+1 w) (# 3) (# 3) (# 4)       ((tt5 i j zero (suc w) zero zero    rot [] ) ++ t)
-     --     tt3 w z zero (suc y) t =       tt3 w z         (# 3) (fin+1 y)   ((tt5 i j z w (suc y) zero    rot [] ) ++ t) 
-     --     tt3 w z (suc x) y    t =       tt3 w z         (fin+1 x)    y    ((tt5 i j z  w y    (suc x) rot [] ) ++ t) 
-     --     tt3 w (suc z) zero zero t =    tt3 w (fin+1 z) (# 3) (# 4)       ((tt5 i j (suc z) w zero zero    rot [] ) ++ t)
-
-     -- tt4 :  List (List (List ℕ))
-     -- tt4  = tt2 (# 0) (# 0) (pinv 3rot) ∷
-     --       tt2 (# 1) (# 0) (pinv 3rot) ∷
-     --       tt2 (# 2) (# 0) (pinv 3rot) ∷
-     --       tt2 (# 3) (# 0) (pinv 3rot) ∷
-     --       tt2 (# 0) (# 1) (pinv 3rot) ∷
-     --       tt2 (# 1) (# 1) (pinv 3rot) ∷
-     --       tt2 (# 2) (# 1) (pinv 3rot) ∷
-     --       tt2 (# 3) (# 1) (pinv 3rot) ∷
-     --       tt2 (# 0) (# 2) (pinv 3rot) ∷
-     --       tt2 (# 1) (# 2) (pinv 3rot) ∷
-     --       tt2 (# 2) (# 2) (pinv 3rot) ∷
-     --       tt2 (# 3) (# 2) (pinv 3rot) ∷
-     --       tt2 (# 0) (# 3) (pinv 3rot) ∷
-     --       tt2 (# 1) (# 3) (pinv 3rot) ∷
-     --       tt2 (# 2) (# 3) (pinv 3rot) ∷
-     --       tt2 (# 3) (# 3) (pinv 3rot) ∷
-     --       tt2 (# 0) (# 4) (pinv 3rot) ∷
-     --       tt2 (# 1) (# 4) (pinv 3rot) ∷
-     --       tt2 (# 2) (# 4) (pinv 3rot) ∷
-     --       tt2 (# 3) (# 4) (pinv 3rot) ∷
-     --       []
-
-     open Triple 
-     dba-triple : {i j : ℕ }  → (i<3 : i ≤ 3 ) → (j<4 :  j ≤ 4 ) → Triple i<3 j<4 (3rot  ∘ₚ 3rot )
-     dba-triple z≤n z≤n =                               record { dba0<3 = # 0 ; dba1<4 = # 2 ; aec0<3 = # 2 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     dba-triple z≤n (s≤s z≤n) =                         record { dba0<3 = # 0 ; dba1<4 = # 2 ; aec0<3 = # 2 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     dba-triple z≤n (s≤s (s≤s z≤n)) =                   record { dba0<3 = # 1 ; dba1<4 = # 3 ; aec0<3 = # 3 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
-     dba-triple z≤n (s≤s (s≤s (s≤s z≤n))) =             record { dba0<3 = # 0 ; dba1<4 = # 2 ; aec0<3 = # 2 ; aec1<4 = # 4 ; abc= = pleq _ _ refl }
-     dba-triple z≤n (s≤s (s≤s (s≤s (s≤s z≤n)))) =       record { dba0<3 = # 3 ; dba1<4 = # 0 ; aec0<3 = # 0 ; aec1<4 = # 2 ; abc= = pleq _ _ refl } 
-     dba-triple (s≤s z≤n) z≤n =                         record { dba0<3 = # 0 ; dba1<4 = # 0 ; aec0<3 = # 1 ; aec1<4 = # 3 ; abc= = pleq _ _ refl }
-     dba-triple (s≤s z≤n) (s≤s z≤n) =                   record { dba0<3 = # 0 ; dba1<4 = # 0 ; aec0<3 = # 1 ; aec1<4 = # 3 ; abc= = pleq _ _ refl }
-     dba-triple (s≤s z≤n) (s≤s (s≤s z≤n)) =             record { dba0<3 = # 1 ; dba1<4 = # 3 ; aec0<3 = # 3 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
-     dba-triple (s≤s z≤n) (s≤s (s≤s (s≤s z≤n))) =       record { dba0<3 = # 1 ; dba1<4 = # 4 ; aec0<3 = # 2 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     dba-triple (s≤s z≤n) (s≤s (s≤s (s≤s (s≤s z≤n)))) = record { dba0<3 = # 1 ; dba1<4 = # 3 ; aec0<3 = # 3 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     dba-triple (s≤s (s≤s z≤n)) z≤n =                   record { dba0<3 = # 2 ; dba1<4 = # 4 ; aec0<3 = # 0 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     dba-triple (s≤s (s≤s z≤n)) (s≤s z≤n) =             record { dba0<3 = # 2 ; dba1<4 = # 4 ; aec0<3 = # 0 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     dba-triple (s≤s (s≤s z≤n)) (s≤s (s≤s z≤n)) =       record { dba0<3 = # 0 ; dba1<4 = # 2 ; aec0<3 = # 2 ; aec1<4 = # 4 ; abc= = pleq _ _ refl }
-     dba-triple (s≤s (s≤s z≤n)) (s≤s (s≤s (s≤s z≤n))) = record { dba0<3 = # 1 ; dba1<4 = # 4 ; aec0<3 = # 2 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     dba-triple (s≤s (s≤s z≤n)) (s≤s (s≤s (s≤s (s≤s z≤n)))) = record { dba0<3 = # 2 ; dba1<4 = # 0 ; aec0<3 = # 3 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
-     dba-triple (s≤s (s≤s (s≤s z≤n))) z≤n =             record { dba0<3 = # 0 ; dba1<4 = # 4 ; aec0<3 = # 1 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     dba-triple (s≤s (s≤s (s≤s z≤n))) (s≤s z≤n) =       record { dba0<3 = # 0 ; dba1<4 = # 4 ; aec0<3 = # 1 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     dba-triple (s≤s (s≤s (s≤s z≤n))) (s≤s (s≤s z≤n)) = record { dba0<3 = # 3 ; dba1<4 = # 0 ; aec0<3 = # 0 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }
-     dba-triple (s≤s (s≤s (s≤s z≤n))) (s≤s (s≤s (s≤s z≤n))) = record { dba0<3 = # 1 ; dba1<4 = # 3 ; aec0<3 = # 3 ; aec1<4 = # 0 ; abc= = pleq _ _ refl }
-     dba-triple (s≤s (s≤s (s≤s z≤n))) (s≤s (s≤s (s≤s (s≤s z≤n)))) = 
-                                                    record { dba0<3 = # 2 ; dba1<4 = # 0 ; aec0<3 = # 3 ; aec1<4 = # 2 ; abc= = pleq _ _ refl }  
-     
-     -3=33 : pinv 3rot =p= (3rot ∘ₚ 3rot )
-     -3=33 = pleq _ _ refl
-
-     4=1 : (3rot ∘ₚ 3rot) ∘ₚ (3rot ∘ₚ 3rot ) =p= 3rot
-     4=1 = pleq _ _ refl
-
-     dervie-any-3rot0 : (n : ℕ ) → {i j : ℕ }  → (i<3 : i ≤ 3 ) → (j<4 : j ≤ 4 )
-          → deriving n (abc i<3 j<4 ) 
-     dervie-any-3rot1 : (n : ℕ ) → {i j : ℕ }  → (i<3 : i ≤ 3 ) → (j<4 : j ≤ 4 )
-          → deriving n (dba i<3 j<4 ) 
-
-     commd : {n : ℕ } → (f g : Permutation 5 5)
-           →  deriving n f
-           →  deriving n g
-           → Commutator (deriving n) [ f , g ]
-     commd {n} f g df dg =  comm {deriving n} {f} {g} df dg
-
-     dervie-any-3rot0 0 i<3 j<4 = lift tt 
-     dervie-any-3rot0 (suc i) i<3 j<4 = ccong {deriving i} (psym ceq) (commd dba0 aec0 df dg )where
-        tc = triple i<3 j<4
-        dba0 = dba (fin≤n {3} (dba0<3 tc)) (fin≤n {4} (dba1<4 tc))
-        aec0 = dba (fin≤n {3} (aec0<3 tc)) (fin≤n {4} (aec1<4 tc))
-        ceq : abc i<3 j<4  =p=  [ dba0 , aec0 ]  
-        ceq = record { peq = peq (abc= tc) }
-        df =  dervie-any-3rot1 i  (fin≤n {3} (dba0<3 tc)) (fin≤n {4} (dba1<4 tc))
-        dg =  dervie-any-3rot1 i  (fin≤n {3} (aec0<3 tc)) (fin≤n {4} (aec1<4 tc)) 
-
-     dervie-any-3rot1 0 i<3 j<4 = lift tt 
-     dervie-any-3rot1 (suc n) {i} {j} i<3 j<4 = ccong {deriving n} ( psym ceq )  (commd aec0 abc0 df dg ) where
-        tdba = dba-triple i<3 j<4
-        aec0 = ins2 ((3rot ∘ₚ 3rot) ∘ₚ (3rot ∘ₚ 3rot )) (fin≤n {3} (dba0<3 tdba)) (fin≤n {4} (dba1<4 tdba))
-        abc0 = ins2 ((3rot ∘ₚ 3rot) ∘ₚ (3rot ∘ₚ 3rot )) (fin≤n {3} (aec0<3 tdba)) (fin≤n {4} (aec1<4 tdba))
-        ceq : dba i<3 j<4 =p=  [ aec0 , abc0 ]  
-        ceq = record { peq = peq (abc= tdba) }
-        df : deriving n (ins2 ((3rot ∘ₚ 3rot) ∘ₚ (3rot ∘ₚ 3rot )) (fin≤n {3} (dba0<3 tdba)) (fin≤n {4} (dba1<4 tdba)))
-        df = deriving-subst (psym (ins2cong {toℕ (dba0<3 (dba-triple i<3 j<4))} {toℕ (dba1<4 (dba-triple i<3 j<4))} 4=1 ))
-             (dervie-any-3rot0 n  (fin≤n {3} (dba0<3 tdba)) (fin≤n {4} (dba1<4 tdba)))
-        dg : deriving n (ins2 ((3rot ∘ₚ 3rot) ∘ₚ (3rot ∘ₚ 3rot )) (fin≤n {3} (aec0<3 tdba)) (fin≤n {4} (aec1<4 tdba)))
-        dg = deriving-subst (psym (ins2cong {toℕ (aec0<3 (dba-triple i<3 j<4))} {toℕ (aec1<4 (dba-triple i<3 j<4))} 4=1 )) 
-             (dervie-any-3rot0 n  (fin≤n {3} (aec0<3 tdba)) (fin≤n {4} (aec1<4 tdba)))
-
diff -r a5b3061f15ee -r 6d1619d9f880 sym5a.agda
--- a/sym5a.agda	Tue Dec 15 08:50:32 2020 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,94 +0,0 @@
-open import Level hiding ( suc ; zero )
-open import Algebra
-module sym5a where
-
-open import Symmetric 
-open import Data.Unit using (⊤ ; tt )
-open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
-open import Function hiding (flip)
-open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
-open import Data.Nat.Properties
-open import Relation.Nullary
-open import Data.Empty
-open import Data.Product
-
-open import Gutil 
-open import Putil 
-open import Solvable using (solvable)
-open import  Relation.Binary.PropositionalEquality hiding ( [_] )
-
-open import Data.Fin hiding (_<_ ; _≤_  ; lift )
-open import Data.Fin.Permutation  hiding (_∘ₚ_)
-
-infixr  200 _∘ₚ_
-_∘ₚ_ = Data.Fin.Permutation._∘ₚ_
-
-open import Data.List  hiding ( [_] )
-open import nat
-open import fin
-open import logic
-
-open _∧_
-
-¬sym5solvable : ¬ ( solvable (Symmetric 5) )
-¬sym5solvable sol = counter-example (end5 (abc 0<3 0<4 ) (any3de (dervied-length sol) 3rot 0<3 0<4 ) ) where
---
---    dba       1320      d → b → a → d
---    (dba)⁻¹   3021      a → b → d → a
---    aec       21430
---    (aec)⁻¹   41032
---    [ dba , aec ] = (abd)(cea)(dba)(aec) = abc
---      so commutator always contains abc, dba and aec
-
-     open ≡-Reasoning
-
-     open solvable
-     open Solvable ( Symmetric 5) 
-     end5 : (x : Permutation 5 5) → deriving (dervied-length sol) x →  x =p= pid  
-     end5 x der = end sol x der
-
-     0<4 : 0 < 4
-     0<4 = s≤s z≤n
-
-     0<3 : 0 < 3
-     0<3 = s≤s z≤n
-
-     --- 1 ∷ 2 ∷ 0 ∷ []      abc
-     3rot : Permutation 3 3
-     3rot = pid {3} ∘ₚ pins (n≤ 2)
-
-     save2 : {i j : ℕ }  → (i ≤ 3 ) → ( j ≤ 4 ) →  Permutation  5 5 
-     save2 i<3 j<4 = flip (pins (s≤s i<3)) ∘ₚ flip (pins j<4) 
-
-     -- Permutation 5 5 include any Permutation 3 3
-     any3 : {i j : ℕ }  → Permutation 3 3  → (i ≤ 3 ) → ( j ≤ 4 ) → Permutation  5 5
-     any3 abc i<3 j<4 = (save2 i<3 j<4 ∘ₚ (pprep (pprep abc))) ∘ₚ flip (save2 i<3 j<4 ) 
-
-     any3cong : {i j : ℕ }  → {x y : Permutation 3 3 } → {i<3 : i ≤ 3 } → {j<4 : j ≤ 4 } → x =p= y → any3 x i<3 j<4  =p= any3 y i<3 j<4
-     any3cong {i} {j} {x} {y} {i<3} {j<4} x=y = presp {5} {save2 i<3 j<4 ∘ₚ (pprep (pprep x))} {_} {flip (save2 i<3 j<4 )}
-         (presp {5} {save2 i<3 j<4} prefl (pprep-cong (pprep-cong x=y)) ) prefl 
-
-     open _=p=_
-
-     -- derving n includes any Permutation 3 3, 
-     any3de : {i j : ℕ } → (n : ℕ) → (abc : Permutation 3 3) →  (i<3 : i ≤ 3 ) → (j<4 :  j ≤ 4 ) → deriving n (any3 abc i<3 j<4)
-     any3de {i} {j} zero abc i<3 j<4 = Level.lift tt
-     any3de {i} {j} (suc n) abc i<3 j<4 = ccong abc-from-comm (comm (any3de n (abc  ∘ₚ abc) i<3 j0<4 ) (any3de n (abc  ∘ₚ abc) i0<3 j<4 ))  where
-         i0 : ℕ
-         i0 = ?
-         j0 : ℕ
-         j0 = ?
-         i0<3 : i0 ≤ 3
-         i0<3 = {!!}
-         j0<4 : j0 ≤ 4
-         j0<4 = {!!}
-         abc-from-comm : [ any3 (abc  ∘ₚ abc) i<3 j0<4  , any3 (abc  ∘ₚ abc) i0<3 j<4 ] =p= any3 abc i<3 j<4
-         abc-from-comm = {!!}
-
-     abc : {i j : ℕ }  → (i ≤ 3 ) → ( j ≤ 4 ) → Permutation  5 5
-     abc i<3 j<4 = any3 3rot i<3 j<4
-
-     counter-example :  ¬ (abc 0<3 0<4  =p= pid )
-     counter-example eq with ←pleq _ _ eq
-     ...  | ()
-
diff -r a5b3061f15ee -r 6d1619d9f880 sym5n.agda
--- a/sym5n.agda	Tue Dec 15 08:50:32 2020 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,103 +0,0 @@
-open import Level hiding ( suc ; zero )
-open import Algebra
-module sym5n where
-
-open import Symmetric 
-open import Data.Unit
-open import Function.Inverse as Inverse using (_↔_; Inverse; _InverseOf_)
-open import Function
-open import Data.Nat hiding (_⊔_) -- using (ℕ; suc; zero)
-open import Relation.Nullary
-open import Data.Empty
-open import Data.Product
-
-open import Gutil 
-open import Putil 
-open import Solvable using (solvable)
-open import  Relation.Binary.PropositionalEquality hiding ( [_] )
-
-open import Data.Fin
-open import Data.Fin.Permutation hiding (_∘ₚ_)
-
-infixr  200 _∘ₚ_
-_∘ₚ_ = Data.Fin.Permutation._∘ₚ_
-
--- open import IO
-open import Data.String hiding (toList)
-open import Data.Unit
-open import Agda.Builtin.String 
-
-sym5solvable : (n : ℕ) → String -- ¬ solvable (Symmetric 5)
-sym5solvable n = FListtoStr (CommFListN 5 n) where
-
-   open import Data.List using ( List ; [] ; _∷_ )
-   open Solvable (Symmetric 5)
-
-   open import FLutil
-   open import Data.List.Fresh hiding ([_])
-   open import Relation.Nary using (⌊_⌋)
-
-   p0id :  FL→perm (zero :: zero :: zero :: (zero :: (zero :: f0))) =p= pid
-   p0id = pleq _ _ refl
-
-   open import Data.List.Fresh.Relation.Unary.Any
-   open import FLComm
-
-
-   stage4FList = CommFListN 5 0 
-   stage6FList = CommFListN 5 3 
-
-   -- stage5FList = {!!}
-   -- s2=s3 :  CommFListN 5 2 ≡ CommFListN 5 3 
-   -- s2=s3 = refl
-
-   FLtoStr : {n : ℕ} → (x : FL n) → String
-   FLtoStr f0 = "f0"
-   FLtoStr (x :: y) = primStringAppend ( primStringAppend (primShowNat (toℕ x)) " :: " ) (FLtoStr y)
-
-   FListtoStr : {n : ℕ} → (x : FList n) → String
-   FListtoStr [] = ""
-   FListtoStr (cons a x x₁) = primStringAppend (FLtoStr a) (primStringAppend "\n" (FListtoStr x))
-
-open import Codata.Musical.Notation
-open import Data.Maybe hiding (_>>=_)
-open import Data.List  
-open import Data.Char  
-open import IO.Primitive
-open import Codata.Musical.Costring
-
-postulate
-    getArgs : IO (List (List Char))
-{-# FOREIGN GHC import qualified System.Environment #-}
-{-# COMPILE GHC getArgs = System.Environment.getArgs #-}
-
-charToDigit : Char → Maybe ℕ
-charToDigit '0' = just ( 0)
-charToDigit '1' = just ( 1)
-charToDigit '2' = just ( 2)
-charToDigit '3' = just ( 3)
-charToDigit '4' = just ( 4)
-charToDigit '5' = just ( 5)
-charToDigit '6' = just ( 6)
-charToDigit '7' = just ( 7)
-charToDigit '8' = just ( 8)
-charToDigit '9' = just ( 9)
-charToDigit _   = nothing
-
-getNumArg1 : (List (List Char)) → ℕ
-getNumArg1 [] = 0
-getNumArg1 ([] ∷ y) = 0
-getNumArg1 ((x ∷ _) ∷ y) with charToDigit x
-... | just n = n
-... | nothing  = 0
-
-
---
--- CommFListN 5 x is too slow use compiler
--- agda --compile sym5n.agda
---
-
-main : IO ⊤
-main = getArgs >>= (λ x →  putStrLn $ toCostring $ sym5solvable $ getNumArg1 x ) 
-
-