--------------------------------------------------------------------------------
title:          The spectrum of a distributive lattice
author:         Ayberk Tosun
date-started:   2024-02-21
date-completed: 2024-03-01
--------------------------------------------------------------------------------

We define the spectrum locale over a distributive lattice `L`, the defining
frame of which is the frame of ideals over `L`.

\begin{code}

{-# OPTIONS --safe --without-K #-}

open import UF.PropTrunc
open import UF.FunExt
open import UF.Subsingletons

module Locales.DistributiveLattice.Spectrum
        (fe : Fun-Ext)
        (pe : Prop-Ext)
        (pt : propositional-truncations-exist)
       where

open import Locales.DistributiveLattice.Definition fe pt
open import Locales.DistributiveLattice.Ideal pt fe pe
open import Locales.DistributiveLattice.Properties fe pt
open import Locales.Frame pt fe hiding (is-directed)
open import MLTT.List hiding ([_])
open import MLTT.Spartan
open import Slice.Family
open import UF.Logic
open import UF.Powerset-MultiUniverse
open import UF.SubtypeClassifier

open AllCombinators pt fe renaming (_∧_ to _∧ₚ_; _∨_ to _∨ₚ_)
open PropositionalSubsetInclusionNotation fe
open PropositionalTruncation pt hiding (_∨_)

\end{code}

We work with a fixed distributive lattice `L` in this module.

\begin{code}

module DefnOfFrameOfIdeal (L : DistributiveLattice 𝓤) where

 open DistributiveLattice L renaming (X-is-set to σ)

\end{code}

We denote by `_⊆ᵢ_` the inclusion ordering between two ideals.

\begin{code}

 _⊆ᵢ_ : Ideal L  Ideal L  Ω (𝓤)
 ℐ₁ ⊆ᵢ ℐ₂ =  x   L ∣ᵈ , x ∈ₚ I₁  x ∈ₚ I₂
  where
   open Ideal ℐ₁ renaming (I to I₁)
   open Ideal ℐ₂ renaming (I to I₂)

 infix 30 _⊆ᵢ_

 ⊆ᵢ-is-reflexive : (I : Ideal L)  I ⊆ᵢ I holds
 ⊆ᵢ-is-reflexive _ _ = id

 ⊆ᵢ-is-transitive : (I₁ I₂ I₃ : Ideal L)  (I₁ ⊆ᵢ I₂  I₂ ⊆ᵢ I₃  I₁ ⊆ᵢ I₃) holds
 ⊆ᵢ-is-transitive I₁ I₂ I₃ p q x r = q x (p x r)

 ⊆ᵢ-is-antisymmetric : {I₁ I₂ : Ideal L}
                      I₁ ⊆ᵢ I₂ holds  I₂ ⊆ᵢ I₁ holds  I₁  I₂
 ⊆ᵢ-is-antisymmetric {I₁} {I₂} = ideal-extensionality L I₁ I₂

 ⊆ᵢ-is-partial-order : is-partial-order (Ideal L) _⊆ᵢ_
 ⊆ᵢ-is-partial-order = (⊆ᵢ-is-reflexive , ⊆ᵢ-is-transitive) , ⊆ᵢ-is-antisymmetric

 poset-of-ideals : Poset (𝓤 ) 𝓤
 poset-of-ideals = Ideal L
                 , _⊆ᵢ_
                 , (⊆ᵢ-is-reflexive  , ⊆ᵢ-is-transitive)
                 , ⊆ᵢ-is-antisymmetric

\end{code}

We denote by `𝟏ᵢ` the top ideal, which is the principal ideal on the top element
of the lattice `L`.

\begin{code}

 open PrincipalIdeals L

 𝟏ᵢ : Ideal L
 𝟏ᵢ = principal-ideal 𝟏

 𝟏ᵢ-is-top : (I : Ideal L)  (I ⊆ᵢ 𝟏ᵢ) holds
 𝟏ᵢ-is-top I x _ = 𝟏ᵈ-is-top L x

\end{code}

The binary meets of two ideals `I₁` and `I₂` is just the set intersection
`I₁ ∩ I₂`. We denote this by `I₁ ∧ᵢ I₂`.

\begin{code}

 _∧ᵢ_ : Ideal L  Ideal L  Ideal L
 ℐ₁ ∧ᵢ ℐ₂ =
  record
   { I                    = I₁  I₂
   ; I-is-inhabited       =  𝟎 , I₁-contains-𝟎 , I₂-contains-𝟎 
   ; I-is-downward-closed = 
   ; I-is-closed-under-∨  = 
  }
   where
    open Ideal ℐ₁ renaming (I to I₁; I-contains-𝟎 to I₁-contains-𝟎)
    open Ideal ℐ₂ renaming (I to I₂; I-contains-𝟎 to I₂-contains-𝟎)

     : is-downward-closed L (I₁  I₂) holds
     x y p (q₁ , q₂) = Ideal.I-is-downward-closed ℐ₁ x y p q₁
                      , Ideal.I-is-downward-closed ℐ₂ x y p q₂

     : is-closed-under-binary-joins L (I₁  I₂) holds
     x y (p₁ , p₂) (q₁ , q₂) = Ideal.I-is-closed-under-∨ ℐ₁ x y p₁ q₁
                              , Ideal.I-is-closed-under-∨ ℐ₂ x y p₂ q₂

 infix 32 _∧ᵢ_

 open Meets _⊆ᵢ_

 ∧ᵢ-is-lower : (I₁ I₂ : Ideal L)
              ((I₁ ∧ᵢ I₂) is-a-lower-bound-of (I₁ , I₂)) holds
 ∧ᵢ-is-lower I₁ I₂ =  _  pr₁) ,  _  pr₂)

 ∧ᵢ-is-greatest : (I₁ I₂ I₃ : Ideal L)
                 (I₃ is-a-lower-bound-of (I₁ , I₂)  I₃ ⊆ᵢ (I₁ ∧ᵢ I₂)) holds
 ∧ᵢ-is-greatest I₁ I₂ I₃ (φ , ψ) x p = φ x p , ψ x p

 ∧ᵢ-is-glb : (I₁ I₂ : Ideal L)  ((I₁ ∧ᵢ I₂) is-glb-of (I₁ , I₂)) holds
 ∧ᵢ-is-glb I₁ I₂ = ∧ᵢ-is-lower I₁ I₂ , λ { (I₃ , p)  ∧ᵢ-is-greatest I₁ I₂ I₃ p}

\end{code}

We now begin to do some preparation for the construction of small joins of
ideals. We first define the covering relation `xs ◁ ( Iⱼ )_{j : J}` which
expresses that a list `xs` of elements of the lattice `L` is contained in the
union of ideals `⋃_{j : J} I_j`. Intuitively, this just says: for every `x` in
`xs`, there is an ideal `Iⱼ` with `x ∈ Iⱼ`.

\begin{code}

 open IdealNotation L

 open binary-unions-of-subsets pt

 infix 30 covering-syntax

 covering-syntax : (S : Fam 𝓤 (Ideal L))  List  L ∣ᵈ  𝓤  ̇
 covering-syntax S []       = 𝟙
 covering-syntax S (x  xs) =
  (Σ i  index S , x ∈ᵢ (S [ i ]) holds) × covering-syntax S xs

 syntax covering-syntax S xs = xs  S

\end{code}

Below are some simple lemmas about the covering relation.

\begin{code}

 covering-cons : (S : Fam 𝓤 (Ideal L)) {x :  L ∣ᵈ} {xs : List  L ∣ᵈ}
                (x  xs)  S  xs  S
 covering-cons S (_ , c) = c

 covering-lemma : (S : Fam 𝓤 (Ideal L)) (xs : List  L ∣ᵈ)
                 xs  S
                 (x :  L ∣ᵈ)  member x xs  Σ i  index S , x ∈ⁱ (S [ i ])
 covering-lemma S []       p             x  ()
 covering-lemma S (x  xs) ((i , r) , q) x  in-head     = i , r
 covering-lemma S (x  xs) p             x′ (in-tail r) = IH
  where
   IH : Σ i  index S , x′ ∈ᵢ (S [ i ]) holds
   IH = covering-lemma S xs (covering-cons S p) x′ r

 covering-++ : (S : Fam 𝓤 (Ideal L)) (xs ys : List  L ∣ᵈ)
              xs  S  ys  S  (xs ++ ys)  S
 covering-++ S    []       []         _ q             = q
 covering-++ S    []       ys@(_  _) _ q             = q
 covering-++ S xs@(_  _)  []         p q             = transport
                                                          -  -  S)
                                                         ([]-right-neutral xs)
                                                         p
 covering-++ S    (x  xs) (y  ys)  ((i , r) , p₂) q =
  (i , r) , covering-++ S xs (y  ys) p₂ q

 covering-intersection : (S : Fam 𝓤 (Ideal L)) (I : Ideal L) (xs : List  L ∣ᵈ)
                        join-listᵈ L xs ∈ⁱ I
                        xs  S
                        xs   I ∧ᵢ (S [ i ])  i  index S 
 covering-intersection S I []       _ _             = 
 covering-intersection S I (x  xs) p ((i , r) , c) =
  (i , q , r) , covering-intersection S I xs p′ c
   where
    open Ideal I using (I-is-downward-closed)

     : (join-listᵈ L xs ≤ᵈ[ L ] join-listᵈ L (x  xs)) holds
     = ∨-is-an-upper-bound₂ L x (join-listᵈ L xs)

    q : x ∈ⁱ I
    q = I-is-downward-closed
         x
         (join-listᵈ L (x  xs))
         (∨-is-an-upper-bound₁ L x (join-listᵈ L xs)) p

    p′ : join-listᵈ L xs ∈ⁱ I
    p′ = I-is-downward-closed (join-listᵈ L xs) (join-listᵈ L (x  xs))  p

 covering-∧ : (S : Fam 𝓤 (Ideal L)) (x :  L ∣ᵈ) (xs : List  L ∣ᵈ)
             xs  S  map (x ∧_) xs  S
 covering-∧ S x []       q             = q
 covering-∧ S y (x  xs) ((i , r) , c) = (i , ) , covering-∧ S y xs c
  where
   open Ideal (S [ i ]) renaming (I to I₁;
                                  I-is-downward-closed to Sᵢ-is-downward-closed)

    : (y  x) ∈ᵢ (S [ i ]) holds
    = Sᵢ-is-downward-closed (y  x) x (∧-is-a-lower-bound₂ L y x) r

\end{code}

The lemma below captures the fact that covers of lists always have a finite
subcover.

\begin{code}

 open Locale
 open import Locales.DirectedFamily pt fe _⊆ᵢ_


 finite-subcover : (S : Fam 𝓤 (Ideal L)) (xs : List  L ∣ᵈ)
                  is-directed S holds
                  xs  S
                   i  index S , join-listᵈ L xs ∈ᵢ (S [ i ]) holds
 finite-subcover S [] δ c = ∥∥-rec ∃-is-prop γ (directed-implies-inhabited S δ)
  where
   γ : index S   i  index S , join-listᵈ L [] ∈ⁱ (S [ i ])
   γ i =  i , Sᵢ-contains-𝟎 
    where
     open Ideal (S [ i ]) renaming (I-contains-𝟎 to Sᵢ-contains-𝟎)
 finite-subcover S (x  xs) δ ((i , μ) , c) = ∥∥-rec ∃-is-prop  IH
  where
   IH :  i  index S , join-listᵈ L xs ∈ᵢ (S [ i ]) holds
   IH = finite-subcover S xs δ c

    : Σ i  index S , join-listᵈ L xs ∈ⁱ (S [ i ])
       k  index S , join-listᵈ L (x  xs) ∈ⁱ (S [ k ])
    (j , p) = ∥∥-rec ∃-is-prop  (pr₂ δ i j)
    where
      : Σ k  index S , ((S [ i ]) ⊆ᵢ (S [ k ]) ∧ₚ (S [ j ]) ⊆ᵢ (S [ k ])) holds
         k  index S , join-listᵈ L (x  xs) ∈ⁱ (S [ k ])
      (k , μ₁ , μ₂) =
       k , Sᵢ-is-closed-under-∨ x (join-listᵈ L xs ) (μ₁ x μ) (μ₂ (join-listᵈ L xs) p) 
       where
        open Ideal (S [ k ]) renaming (I-is-closed-under-∨ to Sᵢ-is-closed-under-∨)

\end{code}

We are now ready to define the join. Given a family `( Iⱼ )_{j : J}` of ideals,
their union is given by the family:

    { (⋁ F) ∣ F ⊆ (⋃_{j : J} I_j), F finite}.

We capture finiteness using lists instead (which amounts to Kuratowski
finiteness).

We start by defining a preliminary version of the join operation that gives the
underlying subset of the ideal. We then proceed to prove that this forms an
ideal.

\begin{code}

 ⋁⁰ᵢ_ : Fam 𝓤 (Ideal L)  𝓟 {𝓤}  L ∣ᵈ
 ⋁⁰ᵢ_ S = λ y  Ǝ xs  List  L ∣ᵈ , xs  S × (y  join-listᵈ L xs)

 infix 41 ⋁⁰ᵢ_

\end{code}

It is easy to see that this operation gives subsets that are closed under binary
joins.

\begin{code}

 ideal-join-is-closed-under-∨ : (I : Fam 𝓤 (Ideal L))
                               is-closed-under-binary-joins L (⋁⁰ᵢ I) holds
 ideal-join-is-closed-under-∨ S x y μ₁ μ₂ =
  ∥∥-rec₂ (holds-is-prop ((x  y) ∈ₚ ⋁⁰ᵢ S))  μ₁ μ₂
   where
     : Σ xs  List X , xs  S × (x  join-listᵈ L xs)
       Σ ys  List X , ys  S × (y  join-listᵈ L ys)
       (x  y)  (⋁⁰ᵢ S)
     (xs , c₁ , p₁) (ys , c₂ , p₂) =  (xs ++ ys) , c , p 
     where
      c : (xs ++ ys)  S
      c = covering-++ S xs ys c₁ c₂

      p : (x  y)  join-listᵈ L (xs ++ ys)
      p = x  y                             =⟨  
          join-listᵈ L xs  y               =⟨  
          join-listᵈ L xs  join-listᵈ L ys =⟨  
          join-listᵈ L (xs ++ ys)           
           where
             = ap (_∨ y) p₁
             = ap (join-listᵈ L xs ∨_) p₂
             = join-list-maps-∨-to-++ L xs ys

\end{code}

The operation `⋁⁰ᵢ_` gives subsets that are downward closed.

\begin{code}

 ideal-join-is-downward-closed : (S : Fam 𝓤 (Ideal L))
                                is-downward-closed L (⋁⁰ᵢ S) holds
 ideal-join-is-downward-closed S x y q = ∥∥-rec (holds-is-prop (x ∈ₚ ⋁⁰ᵢ S)) 
  where
   open PosetReasoning (poset-ofᵈ L)

    : Σ ys  List X , ys  S × (y  join-listᵈ L ys)  x  (⋁⁰ᵢ S)
    (ys , c , p) =  map (x ∧_) ys , c′ , r 
    where
     c′ : map (x ∧_) ys  S
     c′ = covering-∧ S x ys c

      : (x ≤ᵈ[ L ] join-listᵈ L ys) holds
      = x ≤⟨ q  y =⟨ p ⟩ₚ join-listᵈ L ys 

      = finite-distributivity L ys x

     r : x  join-listᵈ L (map (x ∧_) ys)
     r = x                            =⟨  ⁻¹ 
         x  join-listᵈ L ys          =⟨     
         join-listᵈ L (map (x ∧_) ys) 

\end{code}

We package the proofs up into the following join operation `⋁ᵢ_`.

\begin{code}

 ⋁ᵢ_ : Fam 𝓤 (Ideal L)  Ideal L
 ⋁ᵢ S = record
         { I                    = ⋁⁰ᵢ S
         ; I-is-inhabited       =  𝟎 ,  [] , ( , refl)  
         ; I-is-downward-closed = ideal-join-is-downward-closed S
         ; I-is-closed-under-∨  = ideal-join-is-closed-under-∨ S
        }

\end{code}

It is obvious that this gives contains all the ideals in the family.

\begin{code}

 ⋁ᵢ-is-an-upper-bound : (S : Fam 𝓤 (Ideal L))
                       (i : index S)  (S [ i ]) ⊆ᵢ (⋁ᵢ S) holds
 ⋁ᵢ-is-an-upper-bound S i x p =  (x  []) ,  , (∨-unit x ⁻¹) 
  where
   open Ideal (S [ i ]) renaming (I-is-downward-closed
                                   to Sᵢ-is-downward-closed)

    : (x  [])  S
    = (i , p) , 

\end{code}

The fact that it is a least upper bound is not as trivial and uses the
`covering-lemma` we gave above.

\begin{code}

 open Joins _⊆ᵢ_

 ⋁ᵢ-is-least : (S  : Fam 𝓤 (Ideal L))
              (Iᵤ : Ideal L)
              (Iᵤ is-an-upper-bound-of S  (⋁ᵢ S) ⊆ᵢ Iᵤ) holds
 ⋁ᵢ-is-least S Iᵤ υ x = ∥∥-rec (holds-is-prop (x ∈ᵢ Iᵤ)) 
  where
    : Σ xs  List X , xs  S × (x  join-listᵈ L xs)  x ∈ᵢ Iᵤ holds
    (xs , c , r) = transport
                      -  - ∈ᵢ Iᵤ holds)
                     (r ⁻¹)
                     (ideals-are-closed-under-finite-joins L Iᵤ xs φ)
    where
     φ : ((x , _) : type-from-list xs)  x ∈ᵢ Iᵤ holds
     φ (x , μ) = υ iₓ x ν
      where
       θ : Σ i  index S , x ∈ᵢ (S [ i ]) holds
       θ = covering-lemma S xs c x μ

       iₓ = pr₁ θ

       ν : (x ∈ᵢ (S [ iₓ ])) holds
       ν = pr₂ θ

\end{code}

Finally, we prove the distributivity law.

\begin{code}

 distributivityᵢ : (I : Ideal L) (S : Fam 𝓤 (Ideal L))
                  I ∧ᵢ (⋁ᵢ S)  ⋁ᵢ  I ∧ᵢ (S [ i ])  i  index S 
 distributivityᵢ I S = ⊆ᵢ-is-antisymmetric  
  where
    : I ∧ᵢ (⋁ᵢ S) ⊆ᵢ (⋁ᵢ  I ∧ᵢ (S [ i ])  i  index S ) holds
    x (μ₁ , μ₂) =
    ∥∥-rec (holds-is-prop (x ∈ᵢ (⋁ᵢ  I ∧ᵢ (S [ i ])  i  index S ))) γ μ₂
     where
      γ : Σ xs  List X , xs  S × (x  join-listᵈ L xs)
        x ∈ᵢ (⋁ᵢ  I ∧ᵢ (S [ i ])  i  index S ) holds
      γ (xs , c , r) =  xs , c′ , r 
       where
        μ : join-listᵈ L xs ∈ᵢ I holds
        μ = transport  -  - ∈ᵢ I holds) r μ₁

        c′ : xs   I ∧ᵢ (S [ i ])  i  index S 
        c′ = covering-intersection S I xs μ c

    : (⋁ᵢ  I ∧ᵢ (S [ i ])  i  index S ) ⊆ᵢ (I ∧ᵢ (⋁ᵢ S)) holds
    x p = ∥∥-rec (holds-is-prop (x ∈ᵢ (I ∧ᵢ (⋁ᵢ S)))) γ p
    where
     open PosetReasoning (poset-ofᵈ L)

     γ : Σ xs  List X ,
          xs   I ∧ᵢ (S [ i ])  i  index S  × (x  join-listᵈ L xs)
        x ∈ᵢ I ∧ᵢ (⋁ᵢ S) holds
     γ (xs , c , r) = μ₁ , μ₂
      where
       ϟ : (x :  L ∣ᵈ)
          member x xs
          Σ i  index S , x ∈ᵢ I ∧ᵢ (S [ i ]) holds
       ϟ x μ = covering-lemma  I ∧ᵢ (S [ i ])  i  index S  xs c x μ

       ϵ : ((x , μ) : type-from-list xs)  x ∈ⁱ I
       ϵ (x , μ) = pr₁ (pr₂ (ϟ x μ))

       δ : join-listᵈ L xs ∈ⁱ I
       δ = ideals-are-closed-under-finite-joins L I xs ϵ

       μ₁ : x ∈ᵢ I holds
       μ₁ = transport  -  (- ∈ᵢ I) holds) (r ⁻¹) δ

       ι : ((x , μ) : type-from-list xs)  x ∈ᵢ (⋁ᵢ S) holds
       ι (x , μ) = ⋁ᵢ-is-an-upper-bound S iₓ x μ′
        where
         ν : Σ i  index S , x ∈ⁱ I ∧ᵢ (S [ i ])
         ν = ϟ x μ

         iₓ : index S
         iₓ = pr₁ ν

         μ′ : x ∈ⁱ (S [ iₓ ])
         μ′ = pr₂ (pr₂ ν)

       θ : join-listᵈ L xs ∈ⁱ (⋁ᵢ S)
       θ = ideals-are-closed-under-finite-joins L (⋁ᵢ S) xs ι

       μ₂ : x ∈ᵢ (⋁ᵢ S) holds
       μ₂ = transport  -  - ∈ᵢ (⋁ᵢ S) holds) (r ⁻¹) θ

\end{code}

We are now ready to package everything up as a frame.

\begin{code}

 frame-of-ideals : Frame (𝓤 ) 𝓤 𝓤
 frame-of-ideals =
   Ideal L
  , (_⊆ᵢ_ , 𝟏ᵢ , _∧ᵢ_ , ⋁ᵢ_)
  , ⊆ᵢ-is-partial-order
  , 𝟏ᵢ-is-top
  ,  (I₁ , I₂)  ∧ᵢ-is-lower I₁ I₂ , λ (I₃ , lb)  ∧ᵢ-is-greatest I₁ I₂ I₃ lb)
  ,  S  ⋁ᵢ-is-an-upper-bound S , λ (I , ub)  ⋁ᵢ-is-least S I ub)
  , λ { (I , S)  distributivityᵢ I S}

\end{code}

This is the frame of opens of the “spectrum space” of the distributive lattice
`L`. Because we work with locales as our notion of space, we just take the
locale that this frame defines as the spectrum over the distributive lattice
`L`.

\begin{code}

 spectrum : Locale (𝓤 ) 𝓤 𝓤
 spectrum = record
             { ⟨_⟩ₗ         = Ideal L
             ; frame-str-of = pr₂ frame-of-ideals}

\end{code}