{-# OPTIONS --cubical --safe #-}

module GaloisConnection where

open import Cubical.Core.Everything
open import Basis
open import Poset
open import Frame

The monotonic map that is right adjoint to the diagonal monotonic map.

hasBinMeets : (P : Poset ℓ₀ ℓ₁)  Type (ℓ-max ℓ₀ ℓ₁)
hasBinMeets P = Σ[ _⊓_  ( P ∣ₚ   P ∣ₚ   P ∣ₚ) ] [ isGLB P _⊓_ ]

hasBinMeets′ : (P : Poset ℓ₀ ℓ₁)  Type (ℓ-max ℓ₀ ℓ₁)
hasBinMeets′ P = Σ[ g  (P ×ₚ P) ─m→ P ] [ (Δ P)  g ]
  where
    open GaloisConnection P (P ×ₚ P)

hasBinMeets′-prop : (P : Poset ℓ₀ ℓ₁)  isProp (hasBinMeets′ P)
hasBinMeets′-prop P (_⊓₀_ , Δ⊣⊓₀) (_⊓₁_ , Δ⊣⊓₁) =
  Σ≡Prop  g  isProp[] (Δ P  g)) (⊣-unique-right (Δ P) _⊓₀_ _⊓₁_ Δ⊣⊓₀ Δ⊣⊓₁)
  where
    open GaloisConnection P (P ×ₚ P)
bin-meets→bin-meets′ : (P : Poset ℓ₀ ℓ₁)  hasBinMeets P  hasBinMeets′ P
bin-meets→bin-meets′ P meet = (f , f-mono) , f⊣Δ
  where
    open GaloisConnection P (P ×ₚ P)
    open PosetReasoning P

    f :  P ×ₚ P ∣ₚ    P ∣ₚ
    f (x , y) = fst meet x y

    f-mono : isMonotonic (P ×ₚ P) P f
    f-mono (x₀ , x₁) (y₀ , y₁) (x₀⊑y₀ , x₁⊑y₁) =
      π₁ (π₁ meet) y₀ y₁ (f (x₀ , x₁)) (φ , ψ)
      where
        φ : [ f (x₀ , x₁) ⊑[ P ] y₀ ]
        φ = f (x₀ , x₁) ⊑⟨ fst (fst (snd meet) x₀ x₁)   x₀ ⊑⟨ x₀⊑y₀  y₀ 

        ψ : [ f (x₀ , x₁) ⊑[ P ] y₁ ]
        ψ = f (x₀ , x₁) ⊑⟨ snd (fst (snd meet) x₀ x₁)   x₁ ⊑⟨ x₁⊑y₁  y₁ 

    f⊣Δ : [ Δ P  (f , f-mono) ]
    f⊣Δ x (y₀ , y₁) = NTS₀ , NTS₁
      where
        NTS₀ : [ (x , x) ⊑[ P ×ₚ P ] (y₀ , y₁)  x ⊑[ P ] f (y₀ , y₁) ]
        NTS₀ (x⊑y₀ , x⊑y₁) = π₁ (π₁ meet) y₀ y₁ x (x⊑y₀ , x⊑y₁)

        NTS₁ : [ x ⊑[ P ] f (y₀ , y₁) ]  [ (x , x) ⊑[ P ×ₚ P ] (y₀ , y₁) ]
        NTS₁ x⊑fy₀y₁ = x⊑y₀ , x⊑y₁
          where
            x⊑y₀ : [ x ⊑[ P ] y₀ ]
            x⊑y₀ = x ⊑⟨ x⊑fy₀y₁  f (y₀ , y₁) ⊑⟨ fst (fst (snd meet) y₀ y₁)  y₀ 

            x⊑y₁ : [ x ⊑[ P ] y₁ ]
            x⊑y₁ = x ⊑⟨ x⊑fy₀y₁  f (y₀ , y₁) ⊑⟨ snd (fst (snd meet) y₀ y₁)  y₁ 
bin-meets′→bin-meets : (P : Poset ℓ₀ ℓ₁)
                      hasBinMeets′ P
                      hasBinMeets  P
bin-meets′→bin-meets P (g , Δ⊣g) = inf , inf-is-glb
  where
    inf :  P ∣ₚ   P ∣ₚ   P ∣ₚ
    inf x y = g $ₘ (x , y)

    inf-is-glb : [ isGLB P inf ]
    inf-is-glb = NTS₀ , NTS₁
      where
        NTS₀ : (x y :  P ∣ₚ)  [ (inf x y) ⊑[ P ] x  (inf x y) ⊑[ P ] y ]
        NTS₀ x y = snd (Δ⊣g (inf x y) (x , y)) (⊑[ P ]-refl _)

        NTS₁ : (x y z :  P ∣ₚ)  [ z ⊑[ P ] x  z ⊑[ P ] y  z ⊑[ P ] inf x y ]
        NTS₁ x y z (z⊑x , z⊑y) = π₀ (Δ⊣g z (x , y)) (z⊑x , z⊑y)
meets⇔meets′ : (P : Poset ℓ₀ ℓ₁)  hasBinMeets P  hasBinMeets′ P
meets⇔meets′ P = bin-meets→bin-meets′ P , bin-meets′→bin-meets P