Mercurial > hg > Members > kono > Proof > galois
changeset 255:6d1619d9f880
library
| author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
|---|---|
| date | Sat, 09 Jan 2021 10:18:08 +0900 |
| parents | a5b3061f15ee |
| children | e295aaee8c65 |
| files | FLComm.agda FLutil.agda Galois.agda-lib Galois.agda-pkg Gutil.agda LICENSE.md Putil.agda Solvable.agda Symmetric.agda fin.agda logic.agda nat.agda src/FLComm.agda src/FLutil.agda src/Gutil.agda src/Putil.agda src/Solvable.agda src/Symmetric.agda src/fin.agda src/logic.agda src/nat.agda src/sym2.agda src/sym2n.agda src/sym3.agda src/sym3n.agda src/sym4.agda src/sym5.agda src/sym5a.agda src/sym5n.agda sym2.agda sym2n.agda sym3.agda sym3n.agda sym4.agda sym5.agda sym5a.agda sym5n.agda |
| diffstat | 37 files changed, 2992 insertions(+), 2970 deletions(-) [+] |
line wrap: on
line diff
--- 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
--- 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 - -
--- /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
--- /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
--- 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) -
--- /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.
--- 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
--- 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 -
--- 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 } - } - } -
--- 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 - -
--- 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 - -
--- 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)) -
--- /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
--- /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 + +
--- /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) +
--- /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
--- /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 +
--- /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 } + } + } +
--- /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 + +
--- /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 + +
--- /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)) +
--- /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 + + + +
--- /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 + +
--- /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) } +
--- /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 + +
--- /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
--- /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))) +
--- /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 + ... | () +
--- /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 ) + +
--- 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 - - - -
--- 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 - -
--- 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) } -
--- 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 - -
--- 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
--- 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))) -
--- 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 - ... | () -
--- 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 ) - -