import Erdos1135.KrasikovLagarias.EliminationNormalizer

/-!
# Structural pruning for KL critical trees

This module records a bounded skeleton-pruning relation.  A pruned tree keeps
the same root constructor and label, recursively prunes the principal child,
and replaces each auxiliary family under a `principalMin` by one recursively
pruned selected member of the full family.

No functional-evaluation monotonicity theorem is stated: replacing a full
minimum family by an arbitrary selected branch can increase that minimum.
-/

namespace Erdos1135
namespace KrasikovLagarias
namespace EliminationCriticalTree

open EliminationResidue

namespace Tree

/-- Structural pruning of a critical tree.

At every `principalMin`, the pruned tree keeps the principal spine and replaces
the full auxiliary family by a singleton containing a recursively pruned member
of that family. -/
inductive Pruning {k : Nat} : Tree k → Tree k → Prop where
  | terminal (label : EliminationPolicy.Label k) :
      Pruning (.terminal label) (.terminal label)
  | principalOnly (label : EliminationPolicy.Label k)
      {fullPrincipal prunedPrincipal : Tree k}
      (principalPruning : Pruning fullPrincipal prunedPrincipal) :
      Pruning (.principalOnly label fullPrincipal)
        (.principalOnly label prunedPrincipal)
  | principalMin (label : EliminationPolicy.Label k)
      {fullPrincipal prunedPrincipal selectedFull selectedPruned : Tree k}
      {fullAuxiliary : NonemptyFamily k}
      (principalPruning : Pruning fullPrincipal prunedPrincipal)
      (selectedMember : NonemptyFamily.Member selectedFull fullAuxiliary)
      (selectedPruning : Pruning selectedFull selectedPruned) :
      Pruning (.principalMin label fullPrincipal fullAuxiliary)
        (.principalMin label prunedPrincipal (.one selectedPruned))

end Tree

namespace NonemptyFamily

/-- The coefficient minimum of a nonempty family is at most every member's
coefficient value. -/
theorem coefficientMinimum_le_of_member {k : Nat}
    (family : NonemptyFamily k) {child : Tree k}
    (coefficients : PrincipalIndex k → Real) (lambda : Real)
    (hmember : Member child family) :
    family.coefficientMinimum coefficients lambda ≤
      child.coefficientValue coefficients lambda := by
  cases family with
  | one tree =>
      change child = tree at hmember
      subst child
      exact le_rfl
  | cons tree tail =>
      rcases hmember with heq | htail
      · subst child
        simp only [coefficientMinimum]
        exact min_le_left _ _
      · exact (min_le_right _ _).trans
          (coefficientMinimum_le_of_member tail coefficients lambda htail)
termination_by family

/-- Terminal-retardedness of a nonempty family descends to every member. -/
theorem terminalsRetarded_of_member {k : Nat}
    {family : NonemptyFamily k} {child : Tree k}
    (hfamily : family.TerminalsRetarded)
    (hmember : Member child family) :
    child.TerminalsRetarded := by
  cases family with
  | one tree =>
      change child = tree at hmember
      subst child
      exact hfamily
  | cons tree tail =>
      rcases hmember with heq | htail
      · subst child
        exact hfamily.1
      · exact terminalsRetarded_of_member hfamily.2 htail
termination_by family

/-- Shift bounds of a nonempty family's minimum expression descend to every
member. -/
theorem shiftBounds_of_member {k : Nat}
    {family : NonemptyFamily k} {child : Tree k} {mu nu : Real}
    (hfamily : family.toExprMinimum.ShiftBounds mu nu)
    (hmember : Member child family) :
    child.toExpr.ShiftBounds mu nu := by
  cases family with
  | one tree =>
      change child = tree at hmember
      subst child
      exact hfamily
  | cons tree tail =>
      rcases hmember with heq | htail
      · subst child
        exact hfamily.1
      · exact shiftBounds_of_member hfamily.2 htail
termination_by family

end NonemptyFamily

namespace Tree.Pruning

/-- A pruning keeps the root label unchanged. -/
theorem rootLabel_eq {k : Nat} {full pruned : Tree k}
    (pruning : Tree.Pruning full pruned) :
    pruned.rootLabel = full.rootLabel := by
  cases pruning <;> rfl

/-- Structural pruning preserves the property that every terminal is retarded. -/
theorem terminalsRetarded {k : Nat} {full pruned : Tree k}
    (pruning : Tree.Pruning full pruned)
    (hfull : full.TerminalsRetarded) :
    pruned.TerminalsRetarded := by
  induction pruning with
  | terminal label =>
      exact hfull
  | principalOnly label principalPruning ihPrincipal =>
      exact ihPrincipal hfull
  | principalMin label principalPruning selectedMember selectedPruning
      ihPrincipal ihSelected =>
      exact ⟨ihPrincipal hfull.1,
        ihSelected (NonemptyFamily.terminalsRetarded_of_member hfull.2
          selectedMember)⟩

/-- Structural pruning can only increase the coefficient expression: every
selected auxiliary branch is at least the full family minimum, and recursive
selected branches are compared by the same relation. -/
theorem coefficientValue_le {k : Nat} {full pruned : Tree k}
    (pruning : Tree.Pruning full pruned)
    (coefficients : PrincipalIndex k → Real) (lambda : Real) :
    full.coefficientValue coefficients lambda ≤
      pruned.coefficientValue coefficients lambda := by
  induction pruning with
  | terminal label =>
      exact le_rfl
  | principalOnly label principalPruning ihPrincipal =>
      exact ihPrincipal
  | principalMin label principalPruning selectedMember selectedPruning
      ihPrincipal ihSelected =>
      simp only [Tree.coefficientValue, NonemptyFamily.coefficientMinimum]
      exact add_le_add ihPrincipal
        ((NonemptyFamily.coefficientMinimum_le_of_member _ coefficients lambda
            selectedMember).trans ihSelected)

/-- Structural pruning preserves retarded-expression shift bounds. -/
theorem shiftBounds {k : Nat} {full pruned : Tree k} {mu nu : Real}
    (pruning : Tree.Pruning full pruned)
    (hfull : full.toExpr.ShiftBounds mu nu) :
    pruned.toExpr.ShiftBounds mu nu := by
  induction pruning with
  | terminal label =>
      exact hfull
  | principalOnly label principalPruning ihPrincipal =>
      exact ihPrincipal hfull
  | principalMin label principalPruning selectedMember selectedPruning
      ihPrincipal ihSelected =>
      exact ⟨ihPrincipal hfull.1,
        ihSelected (NonemptyFamily.shiftBounds_of_member hfull.2
          selectedMember)⟩

end Tree.Pruning

end EliminationCriticalTree
end KrasikovLagarias
end Erdos1135