59 lines
2.2 KiB
Lean4
59 lines
2.2 KiB
Lean4
|
/-
|
|||
|
|
Port of `Isomorphism.agda` (`TransportFiniteHeight`).
|
|||
|
|
|
|||
|
|
With propositional equality this module shrinks dramatically: the Agda
|
|||
|
|
hypotheses `f-preserves-≈`, `g-preserves-≈` are free, and `f-⊔-distr` /
|
|||
|
|
`g-⊔-distr` (which in the setoid world encoded monotonicity of `f` and `g`
|
|||
|
|
w.r.t. the derived order) become plain `Monotone` hypotheses. The chain
|
|||
|
|
transport `portChain₁` / `portChain₂` is mathlib's `LTSeries.map`, using that
|
|||
|
|
a monotone injective map between partial orders is strictly monotone.
|
|||
|
|
|
|||
|
|
Correspondence:
|
|||
|
|
IsInverseˡ / IsInverseʳ ↦ explicit inverse hypotheses `hfg` / `hgf`
|
|||
|
|
f-Injective / g-Injective ↦ local `Function.LeftInverse.injective`
|
|||
|
|
portChain₁ / portChain₂ ↦ LTSeries.map
|
|||
|
|
instance fixedHeight ↦ Spa.FixedHeight.transport
|
|||
|
|
isFiniteHeightLattice,
|
|||
|
|
finiteHeightLattice ↦ Spa.FiniteHeightLattice.transport
|
|||
|
|
-/
|
|||
|
|
import Spa.Lattice
|
|||
|
|
|
|||
|
|
namespace Spa
|
|||
|
|
|
|||
|
|
namespace FixedHeight
|
|||
|
|
|
|||
|
|
variable {α β : Type*} [PartialOrder α] [PartialOrder β] {h : ℕ}
|
|||
|
|
|
|||
|
|
/-- Agda: `TransportFiniteHeight.fixedHeight`. Transport a `FixedHeight`
|
|||
|
|
structure along a monotone inverse pair `f : α → β`, `g : β → α`. -/
|
|||
|
|
def transport (fh : FixedHeight α h) (f : α → β) (g : β → α)
|
|||
|
|
(hf : Monotone f) (hg : Monotone g)
|
|||
|
|
(hgf : ∀ a, g (f a) = a) (hfg : ∀ b, f (g b) = b) :
|
|||
|
|
FixedHeight β h where
|
|||
|
|
bot := f fh.bot
|
|||
|
|
top := f fh.top
|
|||
|
|
longestChain :=
|
|||
|
|
fh.longestChain.map f
|
|||
|
|
(hf.strictMono_of_injective (Function.LeftInverse.injective hgf))
|
|||
|
|
head_longestChain := by
|
|||
|
|
rw [LTSeries.head_map, fh.head_longestChain]
|
|||
|
|
last_longestChain := by
|
|||
|
|
rw [LTSeries.last_map, fh.last_longestChain]
|
|||
|
|
length_longestChain := fh.length_longestChain
|
|||
|
|
bounded := fun c =>
|
|||
|
|
fh.bounded
|
|||
|
|
(c.map g (hg.strictMono_of_injective (Function.LeftInverse.injective hfg)))
|
|||
|
|
|
|||
|
|
end FixedHeight
|
|||
|
|
|
|||
|
|
/-- Agda: `TransportFiniteHeight.finiteHeightLattice`. -/
|
|||
|
|
def FiniteHeightLattice.transport {α β : Type*} [Lattice α] [Lattice β]
|
|||
|
|
(I : FiniteHeightLattice α) (f : α → β) (g : β → α)
|
|||
|
|
(hf : Monotone f) (hg : Monotone g)
|
|||
|
|
(hgf : ∀ a, g (f a) = a) (hfg : ∀ b, f (g b) = b) :
|
|||
|
|
FiniteHeightLattice β where
|
|||
|
|
height := I.height
|
|||
|
|
fixedHeight := I.fixedHeight.transport f g hf hg hgf hfg
|
|||
|
|
|
|||
|
|
end Spa
|