Mercurial > hg > Members > kono > Proof > galois
changeset 240:2b7b343616af
all done
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Wed, 09 Dec 2020 18:59:14 +0900 |
parents | f45298e34491 |
children | 2a7d092e1240 |
files | FLComm.agda FLutil.agda |
diffstat | 2 files changed, 41 insertions(+), 149 deletions(-) [+] |
line wrap: on
line diff
--- a/FLComm.agda Wed Dec 09 17:33:55 2020 +0900 +++ b/FLComm.agda Wed Dec 09 18:59:14 2020 +0900 @@ -36,24 +36,13 @@ -- open import Relation.Nary using (⌊_⌋) open import Relation.Nullary.Decidable hiding (⌊_⌋) --- Flist : {n : ℕ } (i : ℕ) → i < suc n → FList n → FList n → FList (suc n) --- Flist zero i<n [] _ = [] --- Flist zero i<n (a ∷# x ) z = FLinsert ( zero :: a ) (Flist zero i<n x z ) --- Flist (suc i) (s≤s i<n) [] z = Flist i (<-trans i<n a<sa) z z --- Flist (suc i) i<n (a ∷# x ) z = FLinsert ((fromℕ< i<n ) :: a ) (Flist (suc i) i<n x z ) --- --- ∀Flist : {n : ℕ } → FL n → FList n --- ∀Flist {zero} f0 = f0 ∷# [] --- Flist {suc n} (x :: y) = Flist n a<sa (∀Flist y) (∀Flist y) - ------------- --- # 0 : # 0 : .... # 0 : # 0 :: f0 --- # 0 : # 0 : .... # 1 : # 0 :: f0 --- --- # sn: # 0 : .... # 0 : # 0 :: f0 --- --- # sn: # n : .... # 1 : # 0 :: f0 --- +-- # 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 +-- ... -- all FL record AnyFL (n : ℕ) (y : FL n) : Set where @@ -64,7 +53,6 @@ open import fin open AnyFL --- {-# TERMINATING #-} anyFL0 : (n : ℕ) → AnyFL (suc n) fmax anyFL0 zero = record { allFL = (zero :: f0) ∷# [] ; anyP = anyFL2 } where anyFL2 : (x : FL 1) → Any (_≡_ x) (cons (zero :: f0) [] (Level.lift tt)) @@ -90,7 +78,7 @@ anyFL1 : {i : ℕ} → (i<n : i < suc n) → (x<i : suc (toℕ x) ≤ suc i ) → Any (_≡_ (x :: y)) (allListF (s≤s i<n) z) anyFL10 : {i : ℕ} → (i<n : i < suc n ) → (x<i : suc (toℕ x) ≤ suc i) → (L : FList (suc n)) → Any (_≡_ (x :: y)) (allListFL (suc (fromℕ< i<n)) L (allListF (<-trans i<n a<sa) z) ) - anyFL10 {i} (s≤s j<n) (s≤s x<i) [] = anyFL3 (<-trans (s≤s j<n) a<sa) (x :: y) x<i z -- where suc (toℕ x) ≤ suc i → toℕ x ≤ i + anyFL10 {i} (s≤s j<n) (s≤s x<i) [] = anyFL3 (<-trans (s≤s j<n) a<sa) (x :: y) x<i z anyFL10 {i} i<n x<i (cons _ xs _) = insAny _ (anyFL10 {i} i<n x<i xs ) anyFL1 {i} (s≤s i<n) x<i = anyFL10 (s≤s i<n ) x<i (allFL (anyFL0 n)) ... | tri≈ ¬a b ¬c = anyFL7 (allFL (anyFL0 n)) (anyP (anyFL0 n) y) where @@ -116,26 +104,13 @@ anyFL4 f0 = here refl anyFL (suc n) = anyFL0 n -at1 = allFL (anyFL 1) -at2 = allFL (anyFL 2) -at3 = allFL (anyFL 3) - -tl3 : (FL n) → ( z : FList n) → FList n → FList n -tl3 h [] w = w -tl3 h (x ∷# z) w = tl3 h z (FLinsert ( perm→FL [ FL→perm h , FL→perm x ] ) w ) -tl2 : ( x z : FList n) → FList n → FList n -tl2 [] _ x = x -tl2 (h ∷# x) z w = tl2 x z (tl3 h z w) - -CommFList : FList n → FList n -CommFList x = tl2 x x [] - -CommFListN : ℕ → FList n -CommFListN 0 = ∀Flist fmax -CommFListN (suc i) = CommFList (CommFListN i) +at1 = toList (allFL (anyFL 1)) +at2 = toList (allFL (anyFL 2)) +at3 = toList (allFL (anyFL 3)) +at4 = toList (allFL (anyFL 4)) -- all cobmbination in P and Q -record AnyComm (P Q : FList n) (fpq : (p q : FL n) → FL n) : Set where +record AnyComm {n : ℕ} (P Q : FList n) (fpq : (p q : FL n) → FL n) : Set where field commList : FList n commAny : (p q : FL n) @@ -148,25 +123,25 @@ -- : AnyComm FL0 FL0 P Q -- p0,q -p<anyL : {p p₁ : FL n} {P : FList n} → {pr : fresh (FL n) ⌊ _f<?_ ⌋ p P } → Any (_≡_ p₁) (cons p P pr) → p f≤ p₁ -p<anyL {p} {p₁} {P} {pr} (here refl) = case1 refl -p<anyL {p} {p₁} {cons a P x} { Data.Product._,_ (Level.lift p<a) snd} (there any) with p<anyL any +p<anyL : {n : ℕ } {p p₁ : FL n} {P : FList n} → {pr : fresh (FL n) ⌊ _f<?_ ⌋ p P } → Any (_≡_ p₁) (cons p P pr) → p f≤ p₁ +p<anyL {n} {p} {p₁} {P} {pr} (here refl) = case1 refl +p<anyL {n} {p} {p₁} {cons a P x} { Data.Product._,_ (Level.lift p<a) snd} (there any) with p<anyL any ... | case1 refl = case2 (toWitness p<a) ... | case2 a<p₁ = case2 (f<-trans (toWitness p<a) a<p₁) -p<anyL1 : {p p₁ : FL n} {P : FList n} → {pr : fresh (FL n) ⌊ _f<?_ ⌋ p P } → Any (_≡_ p₁) (cons p P pr) → ¬ (p ≡ p₁) → p f< p₁ -p<anyL1 {p} {p₁} {P} {pr} any neq with p<anyL any +p<anyL1 : {n : ℕ } {p p₁ : FL n} {P : FList n} → {pr : fresh (FL n) ⌊ _f<?_ ⌋ p P } → Any (_≡_ p₁) (cons p P pr) → ¬ (p ≡ p₁) → p f< p₁ +p<anyL1 {n} {p} {p₁} {P} {pr} any neq with p<anyL any ... | case1 eq = ⊥-elim ( neq eq ) ... | case2 x = x open AnyComm -anyComm : (P Q : FList n) → (fpq : (p q : FL n) → FL n) → AnyComm P Q fpq +anyComm : {n : ℕ } → (P Q : FList n) → (fpq : (p q : FL n) → FL n) → 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 (cons p P pr) (cons q Q qr) fpq = record { commList = FLinsert (fpq p q) (commListQ Q) ; commAny = anyc0n } where +anyComm {n} (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 n - commListP [] = commList (anyComm P Q fpq) + commListP [] = commList (anyComm {n} P Q fpq) commListP (cons p₁ P1 x) = FLinsert (fpq p₁ q) (commListP P1) commListQ : (Q1 : FList n) → FList n commListQ [] = commListP P @@ -193,68 +168,28 @@ anyc04 [] = anyc05 P anyc04 (cons a Q1 x) = insAny _ (anyc04 Q1) --- {-# TERMINATING #-} -CommStage→ : (i : ℕ) → (x : Permutation n n ) → deriving i x → Any (perm→FL x ≡_) ( CommFListN i ) -CommStage→ zero x (Level.lift tt) = AnyFList (perm→FL x) -CommStage→ (suc i) .( [ g , h ] ) (comm {g} {h} p q) = comm2 (CommFListN i) (CommFListN i) (CommStage→ i g p) (CommStage→ i h q) [] where - G = perm→FL g - H = perm→FL h - - -- tl3 case - commc : (L3 L1 : FList n) → Any ((perm→FL [ FL→perm G , FL→perm H ]) ≡_) L3 - → Any ((perm→FL [ FL→perm G , FL→perm H ]) ≡_) (tl3 G L1 L3) - commc L3 [] any = any - commc L3 (cons a L1 _) any = commc (FLinsert (perm→FL [ FL→perm G , FL→perm a ]) L3) L1 (insAny _ any) - comm6 : perm→FL [ FL→perm G , FL→perm H ] ≡ perm→FL [ g , h ] - comm6 = pcong-pF (comm-resp (FL←iso _) (FL←iso _)) - comm3 : (L1 : FList n) → Any (H ≡_) L1 → (L3 : FList n) → Any ((perm→FL [ g , h ]) ≡_) (tl3 G L1 L3) - comm3 (H ∷# []) (here refl) L3 = subst (λ k → Any (k ≡_) (FLinsert (perm→FL [ FL→perm G , FL→perm H ]) L3 ) ) - comm6 (x∈FLins ( perm→FL [ FL→perm G , FL→perm H ] ) L3 ) - comm3 (cons H L1 x₁) (here refl) L3 = subst (λ k → Any (k ≡_) (tl3 G L1 (FLinsert (perm→FL [ FL→perm G , FL→perm H ]) L3))) comm6 - (commc (FLinsert (perm→FL [ FL→perm G , FL→perm H ]) L3 ) L1 (x∈FLins ( perm→FL [ FL→perm G , FL→perm H ] ) L3)) - comm3 (cons a L _) (there b) L3 = comm3 L b (FLinsert (perm→FL [ FL→perm G , FL→perm a ]) L3) +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 ] )) - -- tl2 case - comm2 : (L L1 : FList n) → Any (G ≡_) L → Any (H ≡_) L1 → (L3 : FList n) → Any (perm→FL [ g , h ] ≡_ ) (tl2 L L1 L3) - comm2 (cons G L xr) L1 (here refl) b L3 = comm7 L L3 where - comm8 : (L L4 L2 : FList n) → (a : FL n) - → Any ((perm→FL [ g , h ]) ≡_) (tl2 L4 L1 L2) - → Any ((perm→FL [ g , h ]) ≡_ ) (tl2 L4 L1 (tl3 a L L2)) - comm8← : (L L4 L2 : FList n) → (a : FL n) → ¬ ( a ≡ perm→FL g ) - → Any ((perm→FL [ g , h ]) ≡_) (tl2 L4 L1 (tl3 a L L2)) - → Any ((perm→FL [ g , h ]) ≡_) (tl2 L4 L1 L2) - comm9← : (L4 L2 : FList n) → (a a₁ : FL n) → ¬ ( a ≡ perm→FL g ) - → Any ((perm→FL [ g , h ]) ≡_) (tl2 L4 L1 (FLinsert (perm→FL [ FL→perm a , FL→perm a₁ ]) L2)) - → Any ((perm→FL [ g , h ]) ≡_) (tl2 L4 L1 L2) - -- Any (_≡ (perm→FL [ g , h ])) (FLinsert (perm→FL [ FL→perm a , FL→perm a₁ ]) L2) → Any ((perm→FL [ g , h ]) ≡_) L2 - comm9← [] L2 a a₁ not any = {!!} - comm9← (cons a₂ L4 x) L2 a a₁ not any = comm8 L1 L4 L2 a₂ - (comm9← L4 L2 a a₁ not - (comm8← L1 L4 (FLinsert (perm→FL [ FL→perm a , FL→perm a₁ ]) L2 ) a₂ {!!} any)) - -- Any (_≡ (perm→FL [ g , h ])) (tl2 L4 L1 (tl3 a₂ L1 (FLinsert (perm→FL [ FL→perm a , FL→perm a₁ ]) L2))) → - -- Any (_≡ (perm→FL [ g , h ])) (tl2 L4 L1 (FLinsert (perm→FL [ FL→perm a , FL→perm a₁ ]) L2)) - -- Any (_≡ (perm→FL [ g , h ])) (tl2 L4 L1 L2) - -- Any (_≡ (perm→FL [ g , h ])) (tl2 L4 L1 (tl3 a₂ L1 L2)) - comm8← [] L4 L2 a _ any = any - comm8← (cons a₁ L x) L4 L2 a not any = comm8← L L4 L2 a not - (comm9← L4 (tl3 a L L2 ) a a₁ not (subst (λ k → Any ((perm→FL [ g , h ]) ≡_) (tl2 L4 L1 k )) {!!} any )) - -- Any (_≡ (perm→FL [ g , h ])) (tl2 L4 L1 (tl3 a L (FLinsert (perm→FL [ FL→perm a , FL→perm a₁ ]) L2))) → - -- Any (_≡ (perm→FL [ g , h ])) (tl2 L4 L1 (FLinsert (perm→FL [ FL→perm a , FL→perm a₁ ]) (tl3 a L L2))) - comm9 : (L4 L2 : FList n) → (a a₁ : FL n) → Any ((perm→FL [ g , h ]) ≡_) (tl2 L4 L1 L2) → - Any ((perm→FL [ g , h ]) ≡_) (tl2 L4 L1 (FLinsert (perm→FL [ FL→perm a , FL→perm a₁ ]) L2)) - comm8 [] L4 L2 a any = any - comm8 (cons a₁ L x) L4 L2 a any = comm8 L L4 (FLinsert (perm→FL [ FL→perm a , FL→perm a₁ ]) L2) a (comm9 L4 L2 a a₁ any) - comm9 [] L2 a a₁ any = insAny _ any - comm9 (cons a₂ L4 x) L2 a a₁ any = comm8 L1 L4 (FLinsert (perm→FL [ FL→perm a , FL→perm a₁ ]) L2) a₂ (comm9 L4 L2 a a₁ (comm8← L1 L4 L2 a₂ {!!} any)) - -- found g, we have to walk thru till the end - comm7 : (L L3 : FList n) → Any ((perm→FL [ g , h ]) ≡_) (tl2 L L1 (tl3 G L1 L3)) - -- at the end, find h - comm7 [] L3 = comm3 L1 b L3 - -- add n path - comm7 (cons a L4 xr) L3 = comm8 L1 L4 (tl3 G L1 L3) a (comm7 L4 L3) - -- accumerate tl3 - comm2 (cons x L xr) L1 (there a) b L3 = comm2 L L1 a b (tl3 x L1 L3) -CommStage→ (suc i) x (ccong {f} {x} eq p) = subst (λ k → Any (k ≡_) (tl2 (CommFListN i) (CommFListN i) [])) (comm4 eq) (CommStage→ (suc i) f p ) where +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
--- a/FLutil.agda Wed Dec 09 17:33:55 2020 +0900 +++ b/FLutil.agda Wed Dec 09 18:59:14 2020 +0900 @@ -265,28 +265,9 @@ fr6 = FLinsert ((# 1) :: ((# 1) :: ((# 0 ) :: f0))) fr1 --- open import Data.List.Fresh.Relation.Unary.All --- fr7 = append ( ((# 1) :: ((# 1) :: ((# 0 ) :: f0))) ∷# [] ) fr1 ( ({!!} , {!!} ) ∷ [] ) - -Flist : {n : ℕ } (i : ℕ) → i < suc n → FList n → FList n → FList (suc n) -Flist zero i<n [] _ = [] -Flist zero i<n (a ∷# x ) z = FLinsert ( zero :: a ) (Flist zero i<n x z ) -Flist (suc i) (s≤s i<n) [] z = Flist i (<-trans i<n a<sa) z z -Flist (suc i) i<n (a ∷# x ) z = FLinsert ((fromℕ< i<n ) :: a ) (Flist (suc i) i<n x z ) - -∀Flist : {n : ℕ } → FL n → FList n -∀Flist {zero} f0 = f0 ∷# [] -∀Flist {suc n} (x :: y) = Flist n a<sa (∀Flist y) (∀Flist y) - ¬x<FL0 : {n : ℕ} {x : FL n} → ¬ ( x f< FL0 ) ¬x<FL0 {suc n} {zero :: y} (f<t not) = ¬x<FL0 {n} {y} not -fr8 : FList 4 -fr8 = ∀Flist fmax - -fr9 : FList 3 -fr9 = ∀Flist fmax - open import Data.List.Fresh.Relation.Unary.Any open import Data.List.Fresh.Relation.Unary.All @@ -314,30 +295,6 @@ 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) -{-# TERMINATING #-} -AnyFList : {n : ℕ } → (x : FL n ) → Any (x ≡_) (∀Flist fmax) -AnyFList {zero} f0 = here refl -AnyFList {suc zero} (zero :: f0) = here refl -AnyFList {suc (suc n)} (x :: y) = subst (λ k → Any ((k :: y) ≡_) (Flist (suc n) a<sa (∀Flist fmax) (∀Flist fmax) )) - (fromℕ<-toℕ _ _) ( AnyFList1 (suc n) (toℕ x) a<sa (∀Flist fmax) (∀Flist fmax) fin<n fin<n (AnyFList y) (AnyFList y)) where - AnyFList1 : (i x : ℕ) → (i<n : i < suc (suc n) ) → (L L1 : FList (suc n) ) → (x<n : x < suc (suc n) ) → x < suc i - → Any (y ≡_) L → Any (y ≡_) L1 - → Any (((fromℕ< x<n) :: y) ≡_) (Flist i i<n L L1) - AnyFList1 zero x i<n [] L1 (s≤s x<i) _ () _ - AnyFList1 zero zero i<n (cons y L xr) L1 x<n (s≤s z≤n) (here refl) any = x∈FLins (zero :: y) (Flist 0 i<n L L1) - AnyFList1 zero zero i<n (cons a L xr) L1 x<n (s≤s z≤n) (there wh) any = insAny _ (AnyFList1 zero zero i<n L L1 x<n (s≤s z≤n) wh any) - AnyFList1 (suc i) x (s≤s i<n) (cons y L x₁) L1 x<n (s≤s x<i) (here refl) any with <-fcmp (fromℕ< x<n) (fromℕ< (s≤s i<n)) - ... | tri< a ¬b ¬c = insAny (Flist (suc i) (s≤s i<n) L L1) (af1 L ) where - af1 : (L : FList (suc n)) → Any ((fromℕ< x<n :: y) ≡_) (Flist (suc i) (s≤s i<n) L L1) - af1 [] = AnyFList1 i x (<-trans i<n a<sa) L1 L1 x<n (subst₂ (λ j k → j < k ) (toℕ-fromℕ< _) (cong suc (toℕ-fromℕ< _)) a ) any any - af1 (cons a L x) = insAny (Flist (suc i) (s≤s i<n) L L1) (af1 L ) - ... | tri≈ ¬a b ¬c = subst (λ k → Any ((fromℕ< x<n :: y) ≡_) (FLinsert k (Flist (suc i) (s≤s i<n) L L1) )) (cong (λ k → k :: y) b) - (x∈FLins (fromℕ< x<n :: y) (Flist (suc i) (s≤s i<n) L L1)) - ... | tri> ¬a ¬b c = ⊥-elim ( nat-≤> x<i (subst₂ (λ j k → suc (suc k) ≤ j ) (toℕ-fromℕ< _) (toℕ-fromℕ< _) c) ) - AnyFList1 (suc i) x (s≤s i<n) (cons a (cons a₁ L x₂) x₁) L1 x<n (s≤s x<i) (there wh) any with FLcmp a a₁ - ... | tri< a₂ ¬b ¬c = insAny _ (AnyFList1 (suc i) x (s≤s i<n) (cons a₁ L x₂) L1 x<n (s≤s x<i) wh any ) - AnyFList1 (suc i) x (s≤s i<n) (cons a (cons .a L x₂) (Level.lift () , snd)) L1 x<n (s≤s x<i) (there wh) any | tri≈ ¬a refl ¬c - -- FLinsert membership module FLMB { n : ℕ } where