changeset 84:29d81bcff049

found done
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Sat, 09 Nov 2019 07:47:32 +0900
parents 92f396c3a1d7
children 9911911b77cb
files agda/finiteSet.agda
diffstat 1 files changed, 8 insertions(+), 24 deletions(-) [+]
line wrap: on
line diff
--- a/agda/finiteSet.agda	Sat Nov 09 00:05:05 2019 +0900
+++ b/agda/finiteSet.agda	Sat Nov 09 07:47:32 2019 +0900
@@ -42,6 +42,9 @@
      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})
+     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) )
      found : { p : Q → Bool } → {q : Q } → p q ≡ true → exists p ≡ true
      found {p} {q} pt = found1 n  (lt0 n) (λ i i>n → ⊥-elim (nat-≤> i>n (fin<n {n} {i}) )) where
          next-end : {m : ℕ } → ((i : Fin n) → suc m ≤ toℕ i → p (Q←F i) ≡ false )
@@ -52,37 +55,18 @@
          next-end {m} prev m<n np i m<i | tri> ¬a ¬b c = ⊥-elim ( nat-≤> m<i c )
          next-end {m} prev m<n np i m<i | tri≈ ¬a b ¬c = subst ( λ k → p (Q←F k) ≡ false) (m<n=i i b m<n ) np where
               m<n=i : {n : ℕ } (i : Fin n) {m : ℕ } → m ≡ (toℕ i) → (m<n : m < n )  → fromℕ≤ m<n ≡ i
-              m<n=i {suc n} zero  refl (s≤s z≤n) = refl
-              m<n=i {suc n} (suc i) refl (s≤s m<n) with m<n=i {n} i refl m<n
-              ... | t =  subst₂ ( λ j k →  j ≡ k ) {!!} {!!} t
+              m<n=i i eq m<n = i=j (fromℕ≤ m<n) i (subst (λ k → k ≡ toℕ i) (sym (toℕ-fromℕ≤ m<n)) eq )
          found1 : (m : ℕ ) (m<n : m Data.Nat.≤ n ) → ((i : Fin n) → m ≤ toℕ i → p (Q←F i )  ≡ false ) →  exists1 m m<n p ≡ true
          found1 0 m<n end = ⊥-elim ( ¬-bool (subst (λ k → k ≡ false ) (cong (λ k → p k) (finiso→ q) ) (end (F←Q q) z≤n )) pt )
-         found1 (suc m)  m<n neg with fromℕ≤ m<n ≟ F←Q q
-         found1 (suc m)  m<n neg | yes eq = begin
-                 p (Q←F (fromℕ≤ m<n )) \/ exists1 m (lt2 m<n ) p
-              ≡⟨ cong (λ k → (p k \/ exists1 m (lt2 m<n ) p )) (
-                 begin
-                    Q←F (fromℕ≤ m<n)
-                 ≡⟨ cong ( λ k → Q←F k ) eq ⟩
-                    Q←F (F←Q q)
-                 ≡⟨ finiso→  q ⟩
-                    q
-                 ∎ ) ⟩
-                 p q \/ exists1 m (lt2 m<n ) p
-              ≡⟨ cong (λ k → ( k \/ exists1 m (lt2 m<n ) p )) pt ⟩
-                  true \/ exists1 m (lt2 m<n ) p
-              ≡⟨⟩
-                 true 
-              ∎  where open ≡-Reasoning
-         found1 (suc m)  m<n neg | no ¬p with bool-≡-? (p (Q←F (fromℕ≤ m<n))) true
-         found1 (suc m)  m<n neg | no ¬p | yes eq = subst (λ k → k \/ exists1 m (lt2 m<n) p ≡ true ) (sym eq) (bool-or-4 {exists1 m (lt2 m<n) p} ) 
-         found1 (suc m)  m<n neg | no ¬p | no np = begin
+         found1 (suc m)  m<n end with bool-≡-? (p (Q←F (fromℕ≤ m<n))) true
+         found1 (suc m)  m<n end | yes eq = subst (λ k → k \/ exists1 m (lt2 m<n) p ≡ true ) (sym eq) (bool-or-4 {exists1 m (lt2 m<n) p} ) 
+         found1 (suc m)  m<n end | no np = begin
                  p (Q←F (fromℕ≤ m<n)) \/ exists1 m (lt2 m<n) p
               ≡⟨ cong (λ k → k \/ exists1 m (lt2 m<n) p) (¬-bool-t np )  ⟩
                  false  \/ exists1 m (lt2 m<n) p
               ≡⟨ bool-or-1 refl ⟩
                  exists1 m (lt2 m<n) p
-              ≡⟨ found1 m (lt2 m<n) (next-end neg m<n (¬-bool-t np )) ⟩
+              ≡⟨ found1 m (lt2 m<n) (next-end end m<n (¬-bool-t np )) ⟩
                  true
               ∎  where open ≡-Reasoning
      not-found : { p : Q → Bool } → ( (q : Q ) → p q ≡ false ) → exists p ≡ false