cubical-transport-hott-lean4/Topolei/Subobject.lean

/-
  Topolei.Subobject
  =================
  H3 of the selection-foundation stack.

  ## What this file is

  A `Subobject` of `WCell` is a *characteristic function*:
  `σ : WCell → Bool`, identifying which cells are "in" the
  subobject.  Subobjects form a **Boolean algebra** under ∩, ∪, ¬
  with units ⊤, ⊥ — every law follows from `Bool`'s algebra by
  pointwise reasoning, so the file is mostly `funext + simp + Bool`.

  ## Why this layer

  H1+H2 gave us *focused* selections — one cell, with a path
  back to the root.  H3 gives us *scoped* selections — a
  *family* of candidate cells, with a focus picked from inside.
  The Boolean algebra then lets us:

    - intersect two scopes (∩) — "things in both selections";
    - union two scopes (∪) — "things in either";
    - complement (¬) — "things outside this selection".

  These operations are what peripheral observations need in
  order to *combine* or *refine* the cells they're looking at,
  without descending to ad-hoc selection tools per peripheral
  type (the VFX problem the user named: "their transports are
  forgetful, so they have many selector tools").  Here, ONE
  abstraction (Subobject + Boolean algebra) covers all of it.

  ## What this file does NOT contain

  - The *focused-subobject* combination (Selection × Subobject).
    That goes in `Topolei.Selection` once H1+H2's focus type
    is extended with a scope field.

  - The *action* of cell-endomorphisms on Subobjects.  That's
    `Subobject.preimage` below — actually, it IS in this file.
    The thing NOT here is the action on `Selection` (which
    requires the focused-subobject layer to be in place).

  - **Heyting / intuitionistic refinement** to `WCell → Type` for
    proof-relevant subobjects (where membership tracks *why* a
    cell is in scope).  That's a future H7 — when H5 (the trace
    map) needs provenance, we lift `σ`'s codomain from `Bool` to
    `Type`.  For now, classical Boolean is enough.

  ## Reference

  - Cells-spec §15.4 ("Lawvere-Tierney topology") — Subobjects
    are exactly the level-0 instance of the LT-topology hierarchy
    the cells-spec uses for accessibility / security.
  - Cells-spec §1.5 ("Rendering Context as a Cell") — peripheral
    observations as fiber selectors.
-/

namespace Topolei.Subobject

-- We don't import `Topolei.Selection` to keep this file independent;
-- both `Subobject` and `Selection` are foundational, neither
-- depends on the other.  The bridge between them lives in a
-- third file.
private inductive WCell where
  | mk : String → List WCell → WCell

namespace WCell
def data : WCell → String | .mk d _ => d
def children : WCell → List WCell | .mk _ c => c
end WCell

-- ── The Subobject type ────────────────────────────────────────────────────

/-- A subobject of `WCell`: a Boolean-valued characteristic function
    saying which cells are "in" the subobject.  Equivalence between
    subobjects is pointwise (function-extensional). -/
structure Subobject where
  σ : WCell → Bool
deriving Inhabited

namespace Subobject

/-- Two subobjects are equal iff their characteristic functions
    are pointwise equal.  Function extensionality is `funext`. -/
@[ext] theorem ext {a b : Subobject} (h : ∀ c, a.σ c = b.σ c) : a = b := by
  cases a; cases b
  congr 1
  funext c
  exact h c

-- ── Constants: ⊤ (everywhere) and ⊥ (nowhere) ────────────────────────────

/-- The total subobject — every cell is in it. -/
def top : Subobject := { σ := fun _ => true }

/-- The empty subobject — no cell is in it. -/
def bot : Subobject := { σ := fun _ => false }

-- ── Pointwise operations ─────────────────────────────────────────────────

/-- Intersection (AND of characteristic functions). -/
def inter (a b : Subobject) : Subobject := { σ := fun c => a.σ c && b.σ c }

/-- Union (OR of characteristic functions). -/
def union (a b : Subobject) : Subobject := { σ := fun c => a.σ c || b.σ c }

/-- Complement (NOT of characteristic function). -/
def compl (a : Subobject) : Subobject := { σ := fun c => !(a.σ c) }

-- ── Boolean algebra laws (every one follows from `Bool` algebra) ──────────

-- The pattern: `ext c; simp [Subobject.inter, Subobject.union, Subobject.compl,
-- Subobject.top, Subobject.bot, Bool.<lemma>]`.

-- ── Commutativity ─────────────────────────────────────────────────────────

@[simp] theorem inter_comm (a b : Subobject) : a.inter b = b.inter a := by
  ext c; simp [inter, Bool.and_comm]

@[simp] theorem union_comm (a b : Subobject) : a.union b = b.union a := by
  ext c; simp [union, Bool.or_comm]

-- ── Associativity ─────────────────────────────────────────────────────────

theorem inter_assoc (a b c : Subobject) :
    (a.inter b).inter c = a.inter (b.inter c) := by
  ext x; simp [inter, Bool.and_assoc]

theorem union_assoc (a b c : Subobject) :
    (a.union b).union c = a.union (b.union c) := by
  ext x; simp [union, Bool.or_assoc]

-- ── Idempotence ───────────────────────────────────────────────────────────

@[simp] theorem inter_self (a : Subobject) : a.inter a = a := by
  ext c; simp [inter]

@[simp] theorem union_self (a : Subobject) : a.union a = a := by
  ext c; simp [union]

-- ── Identity laws (top is unit of ∩, bot is unit of ∪) ───────────────────

@[simp] theorem inter_top (a : Subobject) : a.inter top = a := by
  ext c; simp [inter, top]

@[simp] theorem top_inter (a : Subobject) : top.inter a = a := by
  ext c; simp [inter, top]

@[simp] theorem union_bot (a : Subobject) : a.union bot = a := by
  ext c; simp [union, bot]

@[simp] theorem bot_union (a : Subobject) : bot.union a = a := by
  ext c; simp [union, bot]

-- ── Annihilation (top is absorber of ∪, bot of ∩) ────────────────────────

@[simp] theorem inter_bot (a : Subobject) : a.inter bot = bot := by
  ext c; simp [inter, bot]

@[simp] theorem bot_inter (a : Subobject) : bot.inter a = bot := by
  ext c; simp [inter, bot]

@[simp] theorem union_top (a : Subobject) : a.union top = top := by
  ext c; simp [union, top]

@[simp] theorem top_union (a : Subobject) : top.union a = top := by
  ext c; simp [union, top]

-- ── Distributivity ───────────────────────────────────────────────────────

theorem inter_distrib_union (a b c : Subobject) :
    a.inter (b.union c) = (a.inter b).union (a.inter c) := by
  ext x; simp [inter, union, Bool.and_or_distrib_left]

theorem union_distrib_inter (a b c : Subobject) :
    a.union (b.inter c) = (a.union b).inter (a.union c) := by
  ext x; simp [union, inter, Bool.or_and_distrib_left]

-- ── Complement laws ──────────────────────────────────────────────────────

@[simp] theorem compl_compl (a : Subobject) : a.compl.compl = a := by
  ext c; simp [compl]

@[simp] theorem inter_compl_self (a : Subobject) : a.inter a.compl = bot := by
  ext c; simp [inter, compl, bot]

@[simp] theorem union_compl_self (a : Subobject) : a.union a.compl = top := by
  ext c; simp [union, compl, top]

@[simp] theorem compl_top : (top : Subobject).compl = bot := by
  ext c; simp [compl, top, bot]

@[simp] theorem compl_bot : (bot : Subobject).compl = top := by
  ext c; simp [compl, top, bot]

-- ── De Morgan ────────────────────────────────────────────────────────────

theorem compl_inter (a b : Subobject) :
    (a.inter b).compl = a.compl.union b.compl := by
  ext c; simp [inter, union, compl, Bool.not_and]

theorem compl_union (a b : Subobject) :
    (a.union b).compl = a.compl.inter b.compl := by
  ext c; simp [union, inter, compl, Bool.not_or]

-- ── Absorption ───────────────────────────────────────────────────────────

@[simp] theorem inter_union_self (a b : Subobject) :
    a.inter (a.union b) = a := by
  ext c; cases h : a.σ c <;> simp [inter, union, h]

@[simp] theorem union_inter_self (a b : Subobject) :
    a.union (a.inter b) = a := by
  ext c; cases h : a.σ c <;> simp [inter, union, h]

-- ── Bridge to construction: scope-preserving endomorphisms ───────────────
--
-- A peripheral observation produces a `Subobject` (the cells the
-- user is "looking at").  A constructor — i.e. an endomorphism of
-- WCell — should respect the scope: cells inside the selection
-- map to cells inside the selection.  This is the type-level
-- guarantee that "applying a tool to a selection produces a new
-- valid selection".
--
-- Note: this is a *property* of an endomorphism, not a structure
-- on Subobjects.  The action on Selections — `applyEndo` — uses
-- this property as a precondition; it lives in
-- `Topolei.Selection.Scoped` (next module to land).

/-- `f` preserves the subobject `a`: every cell in `a` maps to a
    cell in `a`.  This is the scope-preservation precondition
    for actions on focused-subobject selections. -/
def Preserves (a : Subobject) (f : WCell → WCell) : Prop :=
  ∀ c, a.σ c = true → a.σ (f c) = true

/-- The identity always preserves any subobject. -/
theorem Preserves.id (a : Subobject) : Preserves a (fun c => c) := fun _ h => h

/-- Composition of preserving endomorphisms is preserving. -/
theorem Preserves.comp {a : Subobject} {f g : WCell → WCell}
    (hf : Preserves a f) (hg : Preserves a g) :
    Preserves a (fun c => f (g c)) := fun c hc => hf (g c) (hg c hc)

end Subobject

-- ── Operational sanity check ──────────────────────────────────────────────

/-- A demo subobject: cells whose data starts with `"leaf"`. -/
def demoLeaves : Subobject := { σ := fun c => c.data.startsWith "leaf" }

#eval demoLeaves.σ (WCell.mk "leaf-A" [])     -- expected: true
#eval demoLeaves.σ (WCell.mk "root" [])        -- expected: false
#eval (demoLeaves.inter demoLeaves).σ (WCell.mk "leaf-A" [])  -- expected: true
#eval (demoLeaves.compl).σ (WCell.mk "root" [])  -- expected: true
#eval (Subobject.top : Subobject).σ (WCell.mk "anything" []) -- expected: true
#eval (Subobject.bot : Subobject).σ (WCell.mk "anything" []) -- expected: false

end Topolei.Subobject