Make 'IsDecidable' into a record to aid instance search
Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>
This commit is contained in:
@@ -12,6 +12,7 @@ open import Data.Product using (_×_; Σ; _,_; proj₁; proj₂)
|
||||
open import Data.Empty using (⊥-elim)
|
||||
open import Relation.Binary.Core using (_Preserves_⟶_ )
|
||||
open import Relation.Binary.PropositionalEquality using (sym; subst)
|
||||
open import Relation.Binary.Definitions using (Decidable)
|
||||
open import Relation.Nullary using (¬_; yes; no)
|
||||
open import Equivalence
|
||||
import Chain
|
||||
@@ -103,88 +104,92 @@ lattice = record
|
||||
; isLattice = isLattice
|
||||
}
|
||||
|
||||
module _ (≈₁-dec : IsDecidable _≈₁_) (≈₂-dec : IsDecidable _≈₂_) where
|
||||
≈-dec : IsDecidable _≈_
|
||||
module _ (≈₁-Decidable : IsDecidable _≈₁_) (≈₂-Decidable : IsDecidable _≈₂_) where
|
||||
open IsDecidable ≈₁-Decidable using () renaming (R-dec to ≈₁-dec)
|
||||
open IsDecidable ≈₂-Decidable using () renaming (R-dec to ≈₂-dec)
|
||||
|
||||
≈-dec : Decidable _≈_
|
||||
≈-dec (a₁ , b₁) (a₂ , b₂)
|
||||
with ≈₁-dec a₁ a₂ | ≈₂-dec b₁ b₂
|
||||
... | yes a₁≈a₂ | yes b₁≈b₂ = yes (a₁≈a₂ , b₁≈b₂)
|
||||
... | no a₁̷≈a₂ | _ = no (λ (a₁≈a₂ , _) → a₁̷≈a₂ a₁≈a₂)
|
||||
... | _ | no b₁̷≈b₂ = no (λ (_ , b₁≈b₂) → b₁̷≈b₂ b₁≈b₂)
|
||||
|
||||
≈-Decidable : IsDecidable _≈_
|
||||
≈-Decidable = record { R-dec = ≈-dec }
|
||||
|
||||
module _ (≈₁-dec : IsDecidable _≈₁_) (≈₂-dec : IsDecidable _≈₂_)
|
||||
(h₁ h₂ : ℕ)
|
||||
(fhA : FixedHeight₁ h₁) (fhB : FixedHeight₂ h₂) where
|
||||
module _ (h₁ h₂ : ℕ)
|
||||
(fhA : FixedHeight₁ h₁) (fhB : FixedHeight₂ h₂) where
|
||||
|
||||
open import Data.Nat.Properties
|
||||
open IsLattice isLattice using (_≼_; _≺_; ≺-cong)
|
||||
open import Data.Nat.Properties
|
||||
open IsLattice isLattice using (_≼_; _≺_; ≺-cong)
|
||||
|
||||
module ChainMapping₁ = ChainMapping joinSemilattice₁ isJoinSemilattice
|
||||
module ChainMapping₂ = ChainMapping joinSemilattice₂ isJoinSemilattice
|
||||
module ChainMapping₁ = ChainMapping joinSemilattice₁ isJoinSemilattice
|
||||
module ChainMapping₂ = ChainMapping joinSemilattice₂ isJoinSemilattice
|
||||
|
||||
module ChainA = Chain _≈₁_ ≈₁-equiv _≺₁_ ≺₁-cong
|
||||
module ChainB = Chain _≈₂_ ≈₂-equiv _≺₂_ ≺₂-cong
|
||||
module ProdChain = Chain _≈_ ≈-equiv _≺_ ≺-cong
|
||||
module ChainA = Chain _≈₁_ ≈₁-equiv _≺₁_ ≺₁-cong
|
||||
module ChainB = Chain _≈₂_ ≈₂-equiv _≺₂_ ≺₂-cong
|
||||
module ProdChain = Chain _≈_ ≈-equiv _≺_ ≺-cong
|
||||
|
||||
open ChainA using () renaming (Chain to Chain₁; done to done₁; step to step₁; Chain-≈-cong₁ to Chain₁-≈-cong₁)
|
||||
open ChainB using () renaming (Chain to Chain₂; done to done₂; step to step₂; Chain-≈-cong₁ to Chain₂-≈-cong₁)
|
||||
open ProdChain using (Chain; concat; done; step)
|
||||
open ChainA using () renaming (Chain to Chain₁; done to done₁; step to step₁; Chain-≈-cong₁ to Chain₁-≈-cong₁)
|
||||
open ChainB using () renaming (Chain to Chain₂; done to done₂; step to step₂; Chain-≈-cong₁ to Chain₂-≈-cong₁)
|
||||
open ProdChain using (Chain; concat; done; step)
|
||||
|
||||
private
|
||||
a,∙-Monotonic : ∀ (a : A) → Monotonic _≼₂_ _≼_ (λ b → (a , b))
|
||||
a,∙-Monotonic a {b₁} {b₂} b₁⊔b₂≈b₂ = (⊔₁-idemp a , b₁⊔b₂≈b₂)
|
||||
private
|
||||
a,∙-Monotonic : ∀ (a : A) → Monotonic _≼₂_ _≼_ (λ b → (a , b))
|
||||
a,∙-Monotonic a {b₁} {b₂} b₁⊔b₂≈b₂ = (⊔₁-idemp a , b₁⊔b₂≈b₂)
|
||||
|
||||
a,∙-Preserves-≈₂ : ∀ (a : A) → (λ b → (a , b)) Preserves _≈₂_ ⟶ _≈_
|
||||
a,∙-Preserves-≈₂ a {b₁} {b₂} b₁≈b₂ = (≈₁-refl , b₁≈b₂)
|
||||
a,∙-Preserves-≈₂ : ∀ (a : A) → (λ b → (a , b)) Preserves _≈₂_ ⟶ _≈_
|
||||
a,∙-Preserves-≈₂ a {b₁} {b₂} b₁≈b₂ = (≈₁-refl , b₁≈b₂)
|
||||
|
||||
∙,b-Monotonic : ∀ (b : B) → Monotonic _≼₁_ _≼_ (λ a → (a , b))
|
||||
∙,b-Monotonic b {a₁} {a₂} a₁⊔a₂≈a₂ = (a₁⊔a₂≈a₂ , ⊔₂-idemp b)
|
||||
∙,b-Monotonic : ∀ (b : B) → Monotonic _≼₁_ _≼_ (λ a → (a , b))
|
||||
∙,b-Monotonic b {a₁} {a₂} a₁⊔a₂≈a₂ = (a₁⊔a₂≈a₂ , ⊔₂-idemp b)
|
||||
|
||||
∙,b-Preserves-≈₁ : ∀ (b : B) → (λ a → (a , b)) Preserves _≈₁_ ⟶ _≈_
|
||||
∙,b-Preserves-≈₁ b {a₁} {a₂} a₁≈a₂ = (a₁≈a₂ , ≈₂-refl)
|
||||
∙,b-Preserves-≈₁ : ∀ (b : B) → (λ a → (a , b)) Preserves _≈₁_ ⟶ _≈_
|
||||
∙,b-Preserves-≈₁ b {a₁} {a₂} a₁≈a₂ = (a₁≈a₂ , ≈₂-refl)
|
||||
|
||||
open ChainA.Height fhA using () renaming (⊥ to ⊥₁; ⊤ to ⊤₁; longestChain to longestChain₁; bounded to bounded₁)
|
||||
open ChainB.Height fhB using () renaming (⊥ to ⊥₂; ⊤ to ⊤₂; longestChain to longestChain₂; bounded to bounded₂)
|
||||
open ChainA.Height fhA using () renaming (⊥ to ⊥₁; ⊤ to ⊤₁; longestChain to longestChain₁; bounded to bounded₁)
|
||||
open ChainB.Height fhB using () renaming (⊥ to ⊥₂; ⊤ to ⊤₂; longestChain to longestChain₂; bounded to bounded₂)
|
||||
|
||||
unzip : ∀ {a₁ a₂ : A} {b₁ b₂ : B} {n : ℕ} → Chain (a₁ , b₁) (a₂ , b₂) n → Σ (ℕ × ℕ) (λ (n₁ , n₂) → ((Chain₁ a₁ a₂ n₁ × Chain₂ b₁ b₂ n₂) × (n ≤ n₁ + n₂)))
|
||||
unzip (done (a₁≈a₂ , b₁≈b₂)) = ((0 , 0) , ((done₁ a₁≈a₂ , done₂ b₁≈b₂) , ≤-refl))
|
||||
unzip {a₁} {a₂} {b₁} {b₂} {n} (step {(a₁ , b₁)} {(a , b)} ((a₁≼a , b₁≼b) , a₁b₁̷≈ab) (a≈a' , b≈b') a'b'a₂b₂)
|
||||
with ≈₁-dec a₁ a | ≈₂-dec b₁ b | unzip a'b'a₂b₂
|
||||
... | yes a₁≈a | yes b₁≈b | ((n₁ , n₂) , ((c₁ , c₂) , n≤n₁+n₂)) = ⊥-elim (a₁b₁̷≈ab (a₁≈a , b₁≈b))
|
||||
... | no a₁̷≈a | yes b₁≈b | ((n₁ , n₂) , ((c₁ , c₂) , n≤n₁+n₂)) =
|
||||
((suc n₁ , n₂) , ((step₁ (a₁≼a , a₁̷≈a) a≈a' c₁ , Chain₂-≈-cong₁ (≈₂-sym (≈₂-trans b₁≈b b≈b')) c₂), +-monoʳ-≤ 1 (n≤n₁+n₂)))
|
||||
... | yes a₁≈a | no b₁̷≈b | ((n₁ , n₂) , ((c₁ , c₂) , n≤n₁+n₂)) =
|
||||
((n₁ , suc n₂) , ( (Chain₁-≈-cong₁ (≈₁-sym (≈₁-trans a₁≈a a≈a')) c₁ , step₂ (b₁≼b , b₁̷≈b) b≈b' c₂)
|
||||
, subst (n ≤_) (sym (+-suc n₁ n₂)) (+-monoʳ-≤ 1 n≤n₁+n₂)
|
||||
))
|
||||
... | no a₁̷≈a | no b₁̷≈b | ((n₁ , n₂) , ((c₁ , c₂) , n≤n₁+n₂)) =
|
||||
((suc n₁ , suc n₂) , ( (step₁ (a₁≼a , a₁̷≈a) a≈a' c₁ , step₂ (b₁≼b , b₁̷≈b) b≈b' c₂)
|
||||
, m≤n⇒m≤o+n 1 (subst (n ≤_) (sym (+-suc n₁ n₂)) (+-monoʳ-≤ 1 n≤n₁+n₂))
|
||||
unzip : ∀ {a₁ a₂ : A} {b₁ b₂ : B} {n : ℕ} → Chain (a₁ , b₁) (a₂ , b₂) n → Σ (ℕ × ℕ) (λ (n₁ , n₂) → ((Chain₁ a₁ a₂ n₁ × Chain₂ b₁ b₂ n₂) × (n ≤ n₁ + n₂)))
|
||||
unzip (done (a₁≈a₂ , b₁≈b₂)) = ((0 , 0) , ((done₁ a₁≈a₂ , done₂ b₁≈b₂) , ≤-refl))
|
||||
unzip {a₁} {a₂} {b₁} {b₂} {n} (step {(a₁ , b₁)} {(a , b)} ((a₁≼a , b₁≼b) , a₁b₁̷≈ab) (a≈a' , b≈b') a'b'a₂b₂)
|
||||
with ≈₁-dec a₁ a | ≈₂-dec b₁ b | unzip a'b'a₂b₂
|
||||
... | yes a₁≈a | yes b₁≈b | ((n₁ , n₂) , ((c₁ , c₂) , n≤n₁+n₂)) = ⊥-elim (a₁b₁̷≈ab (a₁≈a , b₁≈b))
|
||||
... | no a₁̷≈a | yes b₁≈b | ((n₁ , n₂) , ((c₁ , c₂) , n≤n₁+n₂)) =
|
||||
((suc n₁ , n₂) , ((step₁ (a₁≼a , a₁̷≈a) a≈a' c₁ , Chain₂-≈-cong₁ (≈₂-sym (≈₂-trans b₁≈b b≈b')) c₂), +-monoʳ-≤ 1 (n≤n₁+n₂)))
|
||||
... | yes a₁≈a | no b₁̷≈b | ((n₁ , n₂) , ((c₁ , c₂) , n≤n₁+n₂)) =
|
||||
((n₁ , suc n₂) , ( (Chain₁-≈-cong₁ (≈₁-sym (≈₁-trans a₁≈a a≈a')) c₁ , step₂ (b₁≼b , b₁̷≈b) b≈b' c₂)
|
||||
, subst (n ≤_) (sym (+-suc n₁ n₂)) (+-monoʳ-≤ 1 n≤n₁+n₂)
|
||||
))
|
||||
... | no a₁̷≈a | no b₁̷≈b | ((n₁ , n₂) , ((c₁ , c₂) , n≤n₁+n₂)) =
|
||||
((suc n₁ , suc n₂) , ( (step₁ (a₁≼a , a₁̷≈a) a≈a' c₁ , step₂ (b₁≼b , b₁̷≈b) b≈b' c₂)
|
||||
, m≤n⇒m≤o+n 1 (subst (n ≤_) (sym (+-suc n₁ n₂)) (+-monoʳ-≤ 1 n≤n₁+n₂))
|
||||
))
|
||||
|
||||
fixedHeight : IsLattice.FixedHeight isLattice (h₁ + h₂)
|
||||
fixedHeight = record
|
||||
{ ⊥ = (⊥₁ , ⊥₂)
|
||||
; ⊤ = (⊤₁ , ⊤₂)
|
||||
; longestChain = concat
|
||||
(ChainMapping₁.Chain-map (λ a → (a , ⊥₂)) (∙,b-Monotonic _) proj₁ (∙,b-Preserves-≈₁ _) longestChain₁)
|
||||
(ChainMapping₂.Chain-map (λ b → (⊤₁ , b)) (a,∙-Monotonic _) proj₂ (a,∙-Preserves-≈₂ _) longestChain₂)
|
||||
; bounded = λ a₁b₁a₂b₂ →
|
||||
let ((n₁ , n₂) , ((a₁a₂ , b₁b₂) , n≤n₁+n₂)) = unzip a₁b₁a₂b₂
|
||||
in ≤-trans n≤n₁+n₂ (+-mono-≤ (bounded₁ a₁a₂) (bounded₂ b₁b₂))
|
||||
}
|
||||
fixedHeight : IsLattice.FixedHeight isLattice (h₁ + h₂)
|
||||
fixedHeight = record
|
||||
{ ⊥ = (⊥₁ , ⊥₂)
|
||||
; ⊤ = (⊤₁ , ⊤₂)
|
||||
; longestChain = concat
|
||||
(ChainMapping₁.Chain-map (λ a → (a , ⊥₂)) (∙,b-Monotonic _) proj₁ (∙,b-Preserves-≈₁ _) longestChain₁)
|
||||
(ChainMapping₂.Chain-map (λ b → (⊤₁ , b)) (a,∙-Monotonic _) proj₂ (a,∙-Preserves-≈₂ _) longestChain₂)
|
||||
; bounded = λ a₁b₁a₂b₂ →
|
||||
let ((n₁ , n₂) , ((a₁a₂ , b₁b₂) , n≤n₁+n₂)) = unzip a₁b₁a₂b₂
|
||||
in ≤-trans n≤n₁+n₂ (+-mono-≤ (bounded₁ a₁a₂) (bounded₂ b₁b₂))
|
||||
}
|
||||
|
||||
isFiniteHeightLattice : IsFiniteHeightLattice (A × B) (h₁ + h₂) _≈_ _⊔_ _⊓_
|
||||
isFiniteHeightLattice = record
|
||||
{ isLattice = isLattice
|
||||
; fixedHeight = fixedHeight
|
||||
}
|
||||
isFiniteHeightLattice : IsFiniteHeightLattice (A × B) (h₁ + h₂) _≈_ _⊔_ _⊓_
|
||||
isFiniteHeightLattice = record
|
||||
{ isLattice = isLattice
|
||||
; fixedHeight = fixedHeight
|
||||
}
|
||||
|
||||
finiteHeightLattice : FiniteHeightLattice (A × B)
|
||||
finiteHeightLattice = record
|
||||
{ height = h₁ + h₂
|
||||
; _≈_ = _≈_
|
||||
; _⊔_ = _⊔_
|
||||
; _⊓_ = _⊓_
|
||||
; isFiniteHeightLattice = isFiniteHeightLattice
|
||||
}
|
||||
finiteHeightLattice : FiniteHeightLattice (A × B)
|
||||
finiteHeightLattice = record
|
||||
{ height = h₁ + h₂
|
||||
; _≈_ = _≈_
|
||||
; _⊔_ = _⊔_
|
||||
; _⊓_ = _⊓_
|
||||
; isFiniteHeightLattice = isFiniteHeightLattice
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user