summaryrefslogtreecommitdiff
path: root/Precond.agda
diff options
context:
space:
mode:
Diffstat (limited to 'Precond.agda')
-rw-r--r--Precond.agda35
1 files changed, 7 insertions, 28 deletions
diff --git a/Precond.agda b/Precond.agda
index 76875a7..3278867 100644
--- a/Precond.agda
+++ b/Precond.agda
@@ -29,39 +29,18 @@ assoc-enough get s v (h , p) = u , cong (fmap (flip map s′ ∘ flip lookup) âˆ
g = fromFunc (denumerate s)
u = map (flip lookup (union h g)) s′
-all-different : {A : Set} {n : ℕ} → Vec A n → Set
-all-different {_} {n} v = (i : Fin n) → (j : Fin n) → i ≢ j → lookup i v ≢ lookup j v
+data All-different {A : Set} : {n : ℕ} → Vec A n → Set where
+ different-[] : All-different []
+ different-∷ : {n : ℕ} {x : A} {xs : Vec A n} → x ∉ toList xs → All-different xs → All-different (x ∷ xs)
-suc-injective : {n : ℕ} {i j : Fin n} → (suc i ≡ suc j) → i ≡ j
-suc-injective refl = refl
-
-different-swap : {A : Set} {n : ℕ} → (a b : A) → (v : Vec A n) → all-different (a ∷ b ∷ v) → all-different (b ∷ a ∷ v)
-different-swap a b v p zero zero i≢j li≡lj = i≢j refl
-different-swap a b v p zero (suc zero) i≢j li≡lj = p (suc zero) zero (λ ()) li≡lj
-different-swap a b v p zero (suc (suc j)) i≢j li≡lj = p (suc zero) (suc (suc j)) (λ ()) li≡lj
-different-swap a b v p (suc zero) zero i≢j li≡lj = p zero (suc zero) (λ ()) li≡lj
-different-swap a b v p (suc zero) (suc zero) i≢j li≡lj = i≢j refl
-different-swap a b v p (suc zero) (suc (suc j)) i≢j li≡lj = p zero (suc (suc j)) (λ ()) li≡lj
-different-swap a b v p (suc (suc i)) zero i≢j li≡lj = p (suc (suc i)) (suc zero) (λ ()) li≡lj
-different-swap a b v p (suc (suc i)) (suc zero) i≢j li≡lj = p (suc (suc i)) zero (λ ()) li≡lj
-different-swap a b v p (suc (suc i)) (suc (suc j)) i≢j li≡lj = p (suc (suc i)) (suc (suc j)) i≢j li≡lj
-
-different-drop : {A : Set} {n : ℕ} → (a : A) → (v : Vec A n) → all-different (a ∷ v) → all-different v
-different-drop a v p i j i≢j = p (suc i) (suc j) (i≢j ∘ suc-injective)
-
-different-∉ : {A : Set} {n : ℕ} → (x : A) (xs : Vec A n) → all-different (x ∷ xs) → x ∉ (toList xs)
-different-∉ x [] p ()
-different-∉ x (y ∷ ys) p (here px) = p zero (suc zero) (λ ()) px
-different-∉ x (y ∷ ys) p (there pxs) = different-∉ x ys (different-drop y (x ∷ ys) (different-swap x y ys p)) pxs
-
-different-assoc : {m n : ℕ} → (u : Vec (Fin n) m) → (v : Vec Carrier m) → all-different u → ∃ λ h → assoc u v ≡ just h
+different-assoc : {m n : ℕ} → (u : Vec (Fin n) m) → (v : Vec Carrier m) → All-different u → ∃ λ h → assoc u v ≡ just h
different-assoc [] [] p = empty , refl
-different-assoc (u ∷ us) (v ∷ vs) p with different-assoc us vs (different-drop u us p)
-different-assoc (u ∷ us) (v ∷ vs) p | h , p' = insert u v h , (begin
+different-assoc (u ∷ us) (v ∷ vs) (different-∷ u∉us diff-us) with different-assoc us vs diff-us
+different-assoc (u ∷ us) (v ∷ vs) (different-∷ u∉us diff-us) | h , p' = insert u v h , (begin
assoc (u ∷ us) (v ∷ vs)
≡⟨ refl ⟩
assoc us vs >>= checkInsert u v
≡⟨ cong (flip _>>=_ (checkInsert u v)) p' ⟩
checkInsert u v h
- ≡⟨ lemma-checkInsert-new u v h (lemma-∉-lookupM-assoc u us vs h p' (different-∉ u us p)) ⟩
+ ≡⟨ lemma-checkInsert-new u v h (lemma-∉-lookupM-assoc u us vs h p' u∉us) ⟩
just (insert u v h) ∎)