import Erdos1135.KrasikovLagarias.EliminationPolicy
import Erdos1135.KrasikovLagarias.PotentialRecordSyndetic

/-!
# Termination of compressed KL auxiliary paths

Successive auxiliary endpoints have consecutive alpha counts.  Principal edges
between them are compressed into `PrincipalSteps`.  This module proves that no
infinite compressed path can obey the canonical capped-deletion policy when a
finite forced-transition potential is available.
-/

namespace Erdos1135
namespace KrasikovLagarias
namespace EliminationPolicy

open EliminationResidue

/-- Zero or more consecutive legal principal edges. -/
inductive PrincipalSteps {k : Nat} (hk : 2 ≤ k) : State k → State k → Prop where
  | refl (state : State k) : PrincipalSteps hk state state
  | step {start current : State k}
      (previous : PrincipalSteps hk start current)
      (hadvanced : 0 ≤ current.current.value) :
      PrincipalSteps hk start
        (current.descend
          (current.current.principalChild (Nat.le_trans (by omega) hk)))

namespace PrincipalSteps

theorem adjusted_le {k : Nat} {hk : 2 ≤ k}
    (potential : ForcedPotential k hk) {start finish : State k}
    (steps : PrincipalSteps hk start finish) :
    potential.adjusted finish.current ≤ potential.adjusted start.current := by
  induction steps with
  | refl => exact le_rfl
  | step previous hadvanced ih =>
      exact (potential.principal_adjusted_le _).trans ih

end PrincipalSteps

/-- One auxiliary edge after a possibly empty principal-only segment. -/
structure AuxiliaryStep {k : Nat} (hk : 2 ≤ k)
    (start finish : State k) where
  branch : State k
  principals : @PrincipalSteps k hk start branch
  advanced : 0 ≤ branch.current.value
  child : Label k
  allowed : @AllowedAuxiliary k hk branch child
  finish_eq : finish = State.descend branch child

/-- An infinite sequence indexed by alpha count, with principal-only segments
compressed between successive auxiliary endpoints. -/
structure AuxiliarySequence {k : Nat} (hk : 2 ≤ k) where
  state : Nat → State k
  rootIndex : PrincipalIndex k
  state_zero : state 0 = State.root rootIndex
  alphaCount : ∀ n, (state n).current.shift.alphaCount = n
  nonnegative : ∀ n, 0 ≤ (state n).current.value
  earlier_mem_prior : ∀ i j, i < j → (state i).current ∈ (state j).prior
  step : ∀ n, AuxiliaryStep hk (state n) (state (n + 1))

namespace AuxiliarySequence

/-- Exact power-of-two count along the compressed sequence. -/
def twoCount {k : Nat} {hk : 2 ≤ k} (sequence : AuxiliarySequence hk) :
    Nat → Nat := fun n => (sequence.state n).current.shift.twoCount

/-- Principal residue color along the compressed sequence. -/
def color {k : Nat} {hk : 2 ≤ k} (sequence : AuxiliarySequence hk) :
    Nat → PrincipalIndex k := fun n => (sequence.state n).current.index

/-- Root and ordinary survivor endpoints are the record set. -/
def recordSet {k : Nat} {hk : 2 ≤ k} (sequence : AuxiliarySequence hk) :
    Set Nat :=
  {n | n = 0 ∨ Survives (sequence.state n).prior (sequence.state n).current}

@[simp]
theorem codedShift_eq_value {k : Nat} {hk : 2 ≤ k}
    (sequence : AuxiliarySequence hk) (n : Nat) :
    codedShift sequence.twoCount n = (sequence.state n).current.value := by
  rw [codedShift, Label.value, EliminationShift.value, sequence.alphaCount n]
  rfl

@[simp]
theorem adjustedCodedShift_eq_adjusted {k : Nat} {hk : 2 ≤ k}
    (sequence : AuxiliarySequence hk) (potential : ForcedPotential k hk)
    (n : Nat) :
    adjustedCodedShift potential.value sequence.color sequence.twoCount n =
      potential.adjusted (sequence.state n).current := by
  rw [adjustedCodedShift, ForcedPotential.adjusted, codedShift_eq_value]
  rfl

theorem codedShift_zero {k : Nat} {hk : 2 ≤ k}
    (sequence : AuxiliarySequence hk) :
    codedShift sequence.twoCount 0 = 0 := by
  rw [codedShift_eq_value, sequence.state_zero]
  simp [State.root, Label.root, Label.value]

theorem record_antitone {k : Nat} {hk : 2 ≤ k}
    (sequence : AuxiliarySequence hk) :
    ∀ i ∈ sequence.recordSet, ∀ j ∈ sequence.recordSet,
      i < j → sequence.color i = sequence.color j →
        codedShift sequence.twoCount j ≤ codedShift sequence.twoCount i := by
  intro i hi j hj hij hcolor
  rw [codedShift_eq_value, codedShift_eq_value]
  rcases hj with hjzero | hsurvives
  · omega
  · by_contra hle
    have hlt : (sequence.state i).current.value <
        (sequence.state j).current.value := lt_of_not_ge hle
    apply hsurvives
    exact ⟨sequence.nonnegative j, (sequence.state i).current,
      sequence.earlier_mem_prior i j hij, hcolor, hlt⟩

theorem nonrecord_drop {k : Nat} {hk : 2 ≤ k}
    (sequence : AuxiliarySequence hk) (potential : ForcedPotential k hk) :
    ∀ n, n + 1 ∉ sequence.recordSet →
      adjustedCodedShift potential.value sequence.color sequence.twoCount (n + 1) +
          forcedGap ≤
        adjustedCodedShift potential.value sequence.color sequence.twoCount n := by
  intro n hnonrecord
  have hnonsurvive :
      ¬ Survives (sequence.state (n + 1)).prior
        (sequence.state (n + 1)).current := by
    intro hsurvives
    exact hnonrecord (Or.inr hsurvives)
  obtain ⟨branch, hprincipals, hadvanced, child, hallowed, hfinish⟩ := sequence.step n
  have hprincipalAdjusted := hprincipals.adjusted_le potential
  have hfinishCurrent : (sequence.state (n + 1)).current = child := by
    simpa [State.descend] using
      congrArg (fun state : State k => state.current) hfinish
  have hfinishPrior : (sequence.state (n + 1)).prior = branch.history := by
    simpa [State.descend, State.history] using
      congrArg (fun state : State k => state.prior) hfinish
  have hnonsurviveChild : ¬ Survives branch.history child := by
    simpa [hfinishCurrent, hfinishPrior] using hnonsurvive
  rw [sequence.adjustedCodedShift_eq_adjusted,
    sequence.adjustedCodedShift_eq_adjusted, hfinishCurrent]
  cases hallowed with
  | d1Survivor hrow lift hsurvives => exact (hnonsurviveChild hsurvives).elim
  | d1Forced hrow hall =>
      exact (potential.d1Low_adjusted_add_gap_le branch.current hrow).trans
        hprincipalAdjusted
  | d3Survivor hrow lift hsurvives => exact (hnonsurviveChild hsurvives).elim
  | d3Forced hrow hall =>
      exact (potential.d3Low_adjusted_add_gap_le branch.current hrow).trans
        hprincipalAdjusted

/-- No infinite compressed auxiliary path obeys the canonical capped-deletion
policy in the presence of a checked forced-transition potential. -/
theorem false_of_forcedPotential {k : Nat} {hk : 2 ≤ k}
    (sequence : AuxiliarySequence hk) (potential : ForcedPotential k hk) :
    False := by
  apply false_of_potential_record_codedShift_sequence
    sequence.recordSet sequence.color sequence.twoCount
      potential.value potential.bound
  · exact potential.value_le_bound
  · exact sequence.codedShift_zero
  · intro n
    rw [sequence.codedShift_eq_value]
    exact sequence.nonnegative n
  · exact sequence.record_antitone
  · exact sequence.nonrecord_drop potential

end AuxiliarySequence
end EliminationPolicy
end KrasikovLagarias
end Erdos1135