Re-write the IterProd proofs to couple lattice and finite height lattice
Signed-off-by: Danila Fedorin <danila.fedorin@gmail.com>
This commit is contained in:
parent
29898e738b
commit
ca90f6509c
|
|
@ -23,94 +23,97 @@ IterProd k = iterate k (λ t → A × t) B
|
|||
|
||||
-- To make iteration more convenient, package the definitions in Lattice
|
||||
-- records, perform the recursion, and unpackage.
|
||||
--
|
||||
|
||||
module _ where
|
||||
lattice : ∀ {k : ℕ} → Lattice (IterProd k)
|
||||
lattice {0} = record
|
||||
-- If we prove isLattice and isFiniteHeightLattice by induction separately,
|
||||
-- we lose the connection between the operations (which should be the same)
|
||||
-- that are built up by the two iterations. So, do everything in one iteration.
|
||||
-- This requires some odd code.
|
||||
|
||||
private
|
||||
record RequiredForFixedHeight : Set (lsuc a) where
|
||||
field
|
||||
≈₁-dec : IsDecidable _≈₁_
|
||||
≈₂-dec : IsDecidable _≈₂_
|
||||
h₁ h₂ : ℕ
|
||||
fhA : FixedHeight₁ h₁
|
||||
fhB : FixedHeight₂ h₂
|
||||
|
||||
record IsFiniteHeightAndDecEq {A : Set a} {_≈_ : A → A → Set a} {_⊔_ : A → A → A} {_⊓_ : A → A → A} (isLattice : IsLattice A _≈_ _⊔_ _⊓_) : Set (lsuc a) where
|
||||
field
|
||||
height : ℕ
|
||||
fixedHeight : IsLattice.FixedHeight isLattice height
|
||||
≈-dec : IsDecidable _≈_
|
||||
|
||||
record Everything (A : Set a) : Set (lsuc a) where
|
||||
field
|
||||
_≈_ : A → A → Set a
|
||||
_⊔_ : A → A → A
|
||||
_⊓_ : A → A → A
|
||||
|
||||
isLattice : IsLattice A _≈_ _⊔_ _⊓_
|
||||
isFiniteHeightIfSupported : RequiredForFixedHeight → IsFiniteHeightAndDecEq isLattice
|
||||
|
||||
everything : ∀ (k : ℕ) → Everything (IterProd k)
|
||||
everything 0 = record
|
||||
{ _≈_ = _≈₂_
|
||||
; _⊔_ = _⊔₂_
|
||||
; _⊓_ = _⊓₂_
|
||||
; isLattice = lB
|
||||
; isFiniteHeightIfSupported = λ req → record
|
||||
{ height = RequiredForFixedHeight.h₂ req
|
||||
; fixedHeight = RequiredForFixedHeight.fhB req
|
||||
; ≈-dec = RequiredForFixedHeight.≈₂-dec req
|
||||
}
|
||||
}
|
||||
everything (suc k') = record
|
||||
{ _≈_ = P._≈_
|
||||
; _⊔_ = P._⊔_
|
||||
; _⊓_ = P._⊓_
|
||||
; isLattice = P.isLattice
|
||||
; isFiniteHeightIfSupported = λ req →
|
||||
let
|
||||
fhlRest = Everything.isFiniteHeightIfSupported everythingRest req
|
||||
in
|
||||
record
|
||||
{ height = (RequiredForFixedHeight.h₁ req) + IsFiniteHeightAndDecEq.height fhlRest
|
||||
; fixedHeight =
|
||||
P.fixedHeight
|
||||
(RequiredForFixedHeight.≈₁-dec req) (IsFiniteHeightAndDecEq.≈-dec fhlRest)
|
||||
(RequiredForFixedHeight.h₁ req) (IsFiniteHeightAndDecEq.height fhlRest)
|
||||
(RequiredForFixedHeight.fhA req) (IsFiniteHeightAndDecEq.fixedHeight fhlRest)
|
||||
; ≈-dec = P.≈-dec (RequiredForFixedHeight.≈₁-dec req) (IsFiniteHeightAndDecEq.≈-dec fhlRest)
|
||||
}
|
||||
lattice {suc k'} = record
|
||||
{ _≈_ = _≈_
|
||||
; _⊔_ = _⊔_
|
||||
; _⊓_ = _⊓_
|
||||
; isLattice = isLattice
|
||||
}
|
||||
where
|
||||
Right : Lattice (IterProd k')
|
||||
Right = lattice {k'}
|
||||
everythingRest = everything k'
|
||||
|
||||
open import Lattice.Prod
|
||||
_≈₁_ (Lattice._≈_ Right)
|
||||
_⊔₁_ (Lattice._⊔_ Right)
|
||||
_⊓₁_ (Lattice._⊓_ Right)
|
||||
lA (Lattice.isLattice Right)
|
||||
import Lattice.Prod
|
||||
_≈₁_ (Everything._≈_ everythingRest)
|
||||
_⊔₁_ (Everything._⊔_ everythingRest)
|
||||
_⊓₁_ (Everything._⊓_ everythingRest)
|
||||
lA (Everything.isLattice everythingRest) as P
|
||||
|
||||
module _ (k : ℕ) where
|
||||
open Lattice.Lattice (lattice {k}) public
|
||||
open Everything (everything k) using (_≈_; _⊔_; _⊓_; isLattice) public
|
||||
open Lattice.IsLattice isLattice public
|
||||
|
||||
module _ (≈₁-dec : IsDecidable _≈₁_) (≈₂-dec : IsDecidable _≈₂_)
|
||||
(h₁ h₂ : ℕ)
|
||||
(fhA : FixedHeight₁ h₁) (fhB : FixedHeight₂ h₂) where
|
||||
|
||||
private module _ where
|
||||
record FiniteHeightAndDecEq (A : Set a) : Set (lsuc a) where
|
||||
field
|
||||
height : ℕ
|
||||
_≈_ : A → A → Set a
|
||||
_⊔_ : A → A → A
|
||||
_⊓_ : A → A → A
|
||||
|
||||
isFiniteHeightLattice : IsFiniteHeightLattice A height _≈_ _⊔_ _⊓_
|
||||
≈-dec : IsDecidable _≈_
|
||||
|
||||
open IsFiniteHeightLattice isFiniteHeightLattice public
|
||||
|
||||
finiteHeightAndDec : ∀ {k : ℕ} → FiniteHeightAndDecEq (IterProd k)
|
||||
finiteHeightAndDec {0} = record
|
||||
{ height = h₂
|
||||
; _≈_ = _≈₂_
|
||||
; _⊔_ = _⊔₂_
|
||||
; _⊓_ = _⊓₂_
|
||||
; isFiniteHeightLattice = record
|
||||
{ isLattice = lB
|
||||
; fixedHeight = fhB
|
||||
}
|
||||
; ≈-dec = ≈₂-dec
|
||||
}
|
||||
finiteHeightAndDec {suc k'} = record
|
||||
{ height = h₁ + FiniteHeightAndDecEq.height Right
|
||||
; _≈_ = P._≈_
|
||||
; _⊔_ = P._⊔_
|
||||
; _⊓_ = P._⊓_
|
||||
; isFiniteHeightLattice = isFiniteHeightLattice
|
||||
≈₁-dec (FiniteHeightAndDecEq.≈-dec Right)
|
||||
h₁ (FiniteHeightAndDecEq.height Right)
|
||||
fhA (IsFiniteHeightLattice.fixedHeight (FiniteHeightAndDecEq.isFiniteHeightLattice Right))
|
||||
; ≈-dec = ≈-dec ≈₁-dec (FiniteHeightAndDecEq.≈-dec Right)
|
||||
}
|
||||
where
|
||||
Right = finiteHeightAndDec {k'}
|
||||
|
||||
open import Lattice.Prod
|
||||
_≈₁_ (FiniteHeightAndDecEq._≈_ Right)
|
||||
_⊔₁_ (FiniteHeightAndDecEq._⊔_ Right)
|
||||
_⊓₁_ (FiniteHeightAndDecEq._⊓_ Right)
|
||||
lA (FiniteHeightAndDecEq.isLattice Right) as P
|
||||
|
||||
module _ (k : ℕ) where
|
||||
open FiniteHeightAndDecEq (finiteHeightAndDec {k}) using (isFiniteHeightLattice) public
|
||||
|
||||
private
|
||||
FHD = finiteHeightAndDec {k}
|
||||
|
||||
finiteHeightLattice : FiniteHeightLattice (IterProd k)
|
||||
finiteHeightLattice = record
|
||||
{ height = FiniteHeightAndDecEq.height FHD
|
||||
; _≈_ = FiniteHeightAndDecEq._≈_ FHD
|
||||
; _⊔_ = FiniteHeightAndDecEq._⊔_ FHD
|
||||
; _⊓_ = FiniteHeightAndDecEq._⊓_ FHD
|
||||
; isFiniteHeightLattice = isFiniteHeightLattice
|
||||
required : RequiredForFixedHeight
|
||||
required = record
|
||||
{ ≈₁-dec = ≈₁-dec
|
||||
; ≈₂-dec = ≈₂-dec
|
||||
; h₁ = h₁
|
||||
; h₂ = h₂
|
||||
; fhA = fhA
|
||||
; fhB = fhB
|
||||
}
|
||||
|
||||
isFiniteHeightLattice = record
|
||||
{ isLattice = isLattice
|
||||
; fixedHeight = IsFiniteHeightAndDecEq.fixedHeight (Everything.isFiniteHeightIfSupported (everything k) required)
|
||||
}
|
||||
|
|
|
|||
|
|
@ -171,10 +171,8 @@ module _ (≈₁-dec : IsDecidable _≈₁_) (≈₂-dec : IsDecidable _≈₂_)
|
|||
, ≤-stepsˡ 1 (subst (n ≤_) (sym (+-suc n₁ n₂)) (+-monoʳ-≤ 1 n≤n₁+n₂))
|
||||
))
|
||||
|
||||
isFiniteHeightLattice : IsFiniteHeightLattice (A × B) (h₁ + h₂) _≈_ _⊔_ _⊓_
|
||||
isFiniteHeightLattice = record
|
||||
{ isLattice = isLattice
|
||||
; fixedHeight =
|
||||
fixedHeight : IsLattice.FixedHeight isLattice (h₁ + h₂)
|
||||
fixedHeight =
|
||||
( ( ((amin , bmin) , (amax , bmax))
|
||||
, concat
|
||||
(ChainMapping₁.Chain-map (λ a → (a , bmin)) (∙,b-Monotonic _) proj₁ (∙,b-Preserves-≈₁ _) (proj₂ (proj₁ fhA)))
|
||||
|
|
@ -183,6 +181,11 @@ module _ (≈₁-dec : IsDecidable _≈₁_) (≈₂-dec : IsDecidable _≈₂_)
|
|||
, λ 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-≤ (proj₂ fhA a₁a₂) (proj₂ fhB b₁b₂))
|
||||
)
|
||||
|
||||
isFiniteHeightLattice : IsFiniteHeightLattice (A × B) (h₁ + h₂) _≈_ _⊔_ _⊓_
|
||||
isFiniteHeightLattice = record
|
||||
{ isLattice = isLattice
|
||||
; fixedHeight = fixedHeight
|
||||
}
|
||||
|
||||
finiteHeightLattice : FiniteHeightLattice (A × B)
|
||||
|
|
|
|||
|
|
@ -107,10 +107,13 @@ private
|
|||
isLongest {tt} {tt} (step (tt⊔tt≈tt , tt̷≈tt) _ _) = ⊥-elim (tt̷≈tt refl)
|
||||
isLongest (done _) = z≤n
|
||||
|
||||
fixedHeight : IsLattice.FixedHeight isLattice 0
|
||||
fixedHeight = (((tt , tt) , longestChain) , isLongest)
|
||||
|
||||
isFiniteHeightLattice : IsFiniteHeightLattice ⊤ 0 _≈_ _⊔_ _⊓_
|
||||
isFiniteHeightLattice = record
|
||||
{ isLattice = isLattice
|
||||
; fixedHeight = (((tt , tt) , longestChain) , isLongest)
|
||||
; fixedHeight = fixedHeight
|
||||
}
|
||||
|
||||
finiteHeightLattice : FiniteHeightLattice ⊤
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user