Mercurial > hg > Members > kono > Proof > automaton
changeset 360:6ba2836177b4
fix fin<n
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 18 Jul 2023 18:54:46 +0900 |
parents | 57d007e9c581 |
children | c66d664593e9 |
files | automaton-in-agda/src/fin.agda automaton-in-agda/src/finiteSetUtil.agda |
diffstat | 2 files changed, 51 insertions(+), 34 deletions(-) [+] |
line wrap: on
line diff
--- a/automaton-in-agda/src/fin.agda Tue Jul 18 18:03:49 2023 +0900 +++ b/automaton-in-agda/src/fin.agda Tue Jul 18 18:54:46 2023 +0900 @@ -12,9 +12,9 @@ -- 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}) +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 @@ -23,7 +23,7 @@ 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 +pred<n {suc n} {suc f} (s≤s z≤n) = fin<n f fin<asa : {n : ℕ} → toℕ (fromℕ< {n} a<sa) ≡ n fin<asa = toℕ-fromℕ< nat.a<sa @@ -139,7 +139,7 @@ -- if the length is longer than n, we can find duplicate element as FDup-in-list list2func : (n : ℕ) → (x : List (Fin n)) → n < length x → Fin (length x) → Fin n -list2func n x n<l y = lf00 (toℕ y) x fin<n where +list2func n x n<l y = lf00 (toℕ y) x (fin<n y) where lf00 : (i : ℕ) → (x : List (Fin n)) → i < length x → Fin n lf00 zero (x ∷ t) lt = x lf00 (suc i) (x ∷ t) (s≤s lt) = lf00 i t lt @@ -230,7 +230,7 @@ ... | tri< a ¬b ¬c₁ = f1-phase1 qs p (case2 q1) ... | tri≈ ¬a₁ b₁ ¬c₁ = ⊥-elim (fdup-10 b b₁) where fdup-10 : fromℕ< a<sa ≡ x → fin+1 i ≡ x → ⊥ - fdup-10 eq eq1 = nat-≡< (cong toℕ (trans eq1 (sym eq))) (subst₂ (λ j k → j < k ) (sym fin+1-toℕ) (sym fin<asa) fin<n ) + fdup-10 eq eq1 = nat-≡< (cong toℕ (trans eq1 (sym eq))) (subst₂ (λ j k → j < k ) (sym fin+1-toℕ) (sym fin<asa) (fin<n _)) ... | tri> ¬a₁ ¬b c = f1-phase1 qs p (case2 q1) f1-phase1 (x ∷ qs) p (case1 q1) | tri> ¬a ¬b c with <-fcmp i (fromℕ< (≤-trans c (fin≤n (fromℕ< a<sa)))) | <-fcmp (fin+1 i) x ... | tri< a ¬b₁ ¬c | tri< a₁ ¬b₂ ¬c₁ = f1-phase1 qs p (case1 q1)
--- a/automaton-in-agda/src/finiteSetUtil.agda Tue Jul 18 18:03:49 2023 +0900 +++ b/automaton-in-agda/src/finiteSetUtil.agda Tue Jul 18 18:54:46 2023 +0900 @@ -51,7 +51,7 @@ End : (m : ℕ ) → (p : Q → Bool ) → Set End m p = (i : Fin finite) → m ≤ toℕ i → p (Q←F i ) ≡ false first-end : ( p : Q → Bool ) → End finite p - first-end p i i>n = ⊥-elim (nat-≤> i>n (fin<n {finite} {i}) ) + first-end p i i>n = ⊥-elim (nat-≤> i>n (fin<n {finite} i) ) next-end : {m : ℕ } → ( p : Q → Bool ) → End (suc m) p → (m<n : m < finite ) → p (Q←F (fromℕ< m<n )) ≡ false → End m p @@ -583,10 +583,19 @@ → (is-B : (a : A ) → Dec (Is B A (InjectiveF.f fi) a) ) → FiniteSet B inject-fin {A} {B} fa fi is-B with finite fa | inspect finite fa -... | zero | record { eq = eq1 } = ? +... | zero | record { eq = eq1 } = record { + finite = 0 + ; Q←F = λ () + ; F←Q = λ b → ⊥-elim ( lem00 b) + ; finiso→ = λ b → ⊥-elim ( lem00 b) + ; finiso← = λ () + } where + lem00 : ( b : B) → ⊥ + lem00 b with subst (λ k → Fin k ) eq1 (F←Q fa (InjectiveF.f fi b)) + ... | () ... | suc pfa | record { eq = eq1 } = record { finite = maxb - ; Q←F = λ fb → CountB.b (cb00 _ (fin<n {_} {fb})) + ; Q←F = λ fb → CountB.b (cb00 _ (fin<n {_} fb)) ; F←Q = λ b → fromℕ< (cb<mb b) ; finiso→ = iso1 ; finiso← = iso0 @@ -642,8 +651,15 @@ ... | tri≈ ¬a b ¬c | tri≈ ¬a₁ b₁ ¬c₁ | _ | _ = ⊥-elim (nat-≡< (sym b) (subst (λ k → _ < k ) (sym b₁) a<sa) ) ... | tri≈ ¬a b ¬c | tri> ¬a₁ ¬b c | _ | _ = ⊥-elim (nat-≡< (sym b) (<-trans a<sa c)) ... | tri> ¬a ¬b c | tri< a ¬b₁ ¬c | _ | _ = ⊥-elim (nat-≤> a (<-transʳ c a<sa ) ) - ... | tri> ¬a ¬b c | tri≈ ¬a₁ b ¬c | record { eq = eq0 } | record { eq = eq1 } = ? - ... | tri> ¬a ¬b c | tri> ¬a₁ ¬b₁ c₁ | _ | _ = ? + ... | tri> ¬a ¬b c | tri≈ ¬a₁ b ¬c | record { eq = eq0 } | record { eq = eq1 } with is-B (Q←F fa (fromℕ< c)) + ... | yes isb = refl-≤≡ (sym eq0) + ... | no nisb = refl-≤≡ (sym eq0) + lem01 (suc i) | tri> ¬a ¬b c | tri> ¬a₁ ¬b₁ c₁ | record { eq = eq0 } | record { eq = eq1 } + with is-B (Q←F fa (fromℕ< c)) | is-B (Q←F fa (fromℕ< c₁)) + ... | yes isb0 | yes isb1 = ≤-trans (refl-≤≡ (sym eq0)) a≤sa + ... | yes isb0 | no nisb1 = refl-≤≡ (sym eq0) + ... | no nisb0 | yes isb1 = ≤-trans (refl-≤≡ (sym eq0)) a≤sa + ... | no nisb0 | no nisb1 = refl-≤≡ (sym eq0) lem31 : (b : B) → 0 < count-B (toℕ (F←Q fa (f b))) lem31 b = lem32 (toℕ (F←Q fa (f b))) refl where @@ -654,21 +670,21 @@ lem33 : f b ≡ Q←F fa ( fromℕ< {0} 0<fa ) lem33 = begin f b ≡⟨ sym (finiso→ fa _) ⟩ - Q←F fa ( F←Q fa (f b)) ≡⟨ sym (cong (λ k → Q←F fa k) ( fromℕ<-toℕ _ fin<n)) ⟩ - Q←F fa ( fromℕ< fin<n ) ≡⟨ cong (λ k → Q←F fa k) (fromℕ<-cong _ _ eq fin<n 0<fa) ⟩ + Q←F fa ( F←Q fa (f b)) ≡⟨ sym (cong (λ k → Q←F fa k) ( fromℕ<-toℕ _ (fin<n _))) ⟩ + Q←F fa ( fromℕ< (fin<n _) ) ≡⟨ cong (λ k → Q←F fa k) (fromℕ<-cong _ _ eq (fin<n _) 0<fa) ⟩ Q←F fa ( fromℕ< {0} 0<fa ) ∎ where open ≡-Reasoning lem32 (suc i) eq with <-cmp (finite fa) (suc i) | inspect count-B (suc i) - ... | tri< a ¬b ¬c | _ = ⊥-elim ( nat-≡< eq (<-trans fin<n a) ) - ... | tri≈ ¬a eq1 ¬c | _ = ⊥-elim ( nat-≡< eq (subst (λ k → toℕ (F←Q fa (f b)) < k ) eq1 fin<n )) + ... | tri< a ¬b ¬c | _ = ⊥-elim ( nat-≡< eq (<-trans (fin<n _) a) ) + ... | tri≈ ¬a eq1 ¬c | _ = ⊥-elim ( nat-≡< eq (subst (λ k → toℕ (F←Q fa (f b)) < k ) eq1 (fin<n _))) ... | tri> ¬a ¬b c | record { eq = eq1 } with is-B (Q←F fa (fromℕ< c)) ... | yes isb = s≤s z≤n ... | no nisb = ⊥-elim ( nisb record { a = b ; fa=c = lem33 } ) where lem33 : f b ≡ Q←F fa ( fromℕ< c) lem33 = begin f b ≡⟨ sym (finiso→ fa _) ⟩ - Q←F fa ( F←Q fa (f b)) ≡⟨ sym (cong (λ k → Q←F fa k) ( fromℕ<-toℕ _ fin<n)) ⟩ - Q←F fa ( fromℕ< fin<n ) ≡⟨ cong (λ k → Q←F fa k) (fromℕ<-cong _ _ eq fin<n c ) ⟩ + Q←F fa ( F←Q fa (f b)) ≡⟨ sym (cong (λ k → Q←F fa k) ( fromℕ<-toℕ _ (fin<n _))) ⟩ + Q←F fa ( fromℕ< (fin<n _) ) ≡⟨ cong (λ k → Q←F fa k) (fromℕ<-cong _ _ eq (fin<n _) c ) ⟩ Q←F fa ( fromℕ< c ) ∎ where open ≡-Reasoning @@ -679,7 +695,7 @@ count-B (finite fa) ∎ ) where open ≤-Reasoning lem02 : count-B (toℕ (F←Q fa (f b))) ≤ count-B (finite fa) - lem02 = count-B-mono (<to≤ (fin<n {_} {(F←Q fa (f b))})) + lem02 = count-B-mono (<to≤ (fin<n {_} (F←Q fa (f b)))) cb00 : (n : ℕ) → n < count-B (finite fa) → CountB n cb00 n n<cb = lem09 (finite fa) (count-B (finite fa)) (<-transˡ a<sa n<cb) refl where @@ -713,31 +729,34 @@ toℕ (F←Q fa (f (Is.a isb))) ∎ where open ≡-Reasoning ... | case2 (s≤s lt) = lem09 i j lt (cong pred eq) - iso0 : (x : Fin maxb) → fromℕ< (cb<mb (CountB.b (cb00 (toℕ x) fin<n))) ≡ x + iso0 : (x : Fin maxb) → fromℕ< (cb<mb (CountB.b (cb00 (toℕ x) (fin<n _)))) ≡ x iso0 x = begin - fromℕ< (cb<mb (CountB.b (cb00 (toℕ x) fin<n))) ≡⟨ fromℕ<-cong _ _ ( begin - pred (count-B (toℕ (F←Q fa (f (CountB.b (cb00 (toℕ x) fin<n)))))) ≡⟨ sym (cong (λ k → pred (count-B k)) (CountB.b=cn CB)) ⟩ + fromℕ< (cb<mb (CountB.b (cb00 (toℕ x) (fin<n _)))) ≡⟨ fromℕ<-cong _ _ ( begin + pred (count-B (toℕ (F←Q fa (f (CountB.b (cb00 (toℕ x) (fin<n _))))))) ≡⟨ sym (cong (λ k → pred (count-B k)) (CountB.b=cn CB)) ⟩ pred (count-B (CountB.cb CB)) ≡⟨ cong pred (CountB.cb=n CB) ⟩ pred (suc (toℕ x)) ≡⟨ refl ⟩ - toℕ x ∎ ) (cb<mb (CountB.b CB)) fin<n ⟩ - fromℕ< (fin<n {_} {x}) ≡⟨ fromℕ<-toℕ _ (fin<n {_} {x}) ⟩ + toℕ x ∎ ) (cb<mb (CountB.b CB)) (fin<n _) ⟩ + fromℕ< (fin<n {_} x) ≡⟨ fromℕ<-toℕ _ (fin<n {_} x) ⟩ x ∎ where open ≡-Reasoning - CB = cb00 (toℕ x) fin<n + CB = cb00 (toℕ x) (fin<n _) - iso1 : (b : B) → CountB.b (cb00 (toℕ (fromℕ< (cb<mb b))) fin<n) ≡ b - iso1 b with count-B (toℕ (fromℕ< (cb<mb b))) | inspect count-B (toℕ (fromℕ< (cb<mb b))) - ... | zero | record { eq = eq1 } = ? - ... | suc n | record { eq = eq1 } = begin + iso1 : (b : B) → CountB.b (cb00 (toℕ (fromℕ< (cb<mb b))) (fin<n _)) ≡ b + iso1 b = begin CountB.b CB ≡⟨ InjectiveF.inject fi (F←Q-inject fa (toℕ-injective (begin toℕ (F←Q fa (f (CountB.b CB))) ≡⟨ sym (CountB.b=cn CB) ⟩ - CountB.cb CB ≡⟨ CountB.cb-inject CB _ fin<n isb lem30 ⟩ + CountB.cb CB ≡⟨ CountB.cb-inject CB _ (fin<n _) isb lem30 ⟩ toℕ (F←Q fa (f b)) ∎ ) )) ⟩ b ∎ where open ≡-Reasoning - CB = cb00 (toℕ (fromℕ< (cb<mb b))) fin<n - isb : Is B A f (Q←F fa (fromℕ< fin<n)) - isb = ? + CB = cb00 (toℕ (fromℕ< (cb<mb b))) (fin<n _) + isb : Is B A f (Q←F fa (fromℕ< (fin<n {_} (F←Q fa (f b)) ))) + isb = record { a = b ; fa=c = lem33 } where + lem33 : f b ≡ Q←F fa (fromℕ< (fin<n (F←Q fa (f b)))) + lem33 = begin + f b ≡⟨ sym (finiso→ fa _) ⟩ + Q←F fa (F←Q fa (f b)) ≡⟨ cong (Q←F fa) (sym (fromℕ<-toℕ _ (fin<n (F←Q fa (f b))))) ⟩ + Q←F fa (fromℕ< (fin<n (F←Q fa (f b)))) ∎ lem30 : count-B (CountB.cb CB) ≡ count-B (toℕ (F←Q fa (InjectiveF.f fi b))) lem30 = begin count-B (CountB.cb CB) ≡⟨ CountB.cb=n CB ⟩ @@ -746,6 +765,4 @@ count-B (toℕ (F←Q fa (f b))) ∎ - - -- end