import Erdos1135.KrasikovLagarias.AdaptiveForcedPotential
import Erdos1135.KrasikovLagarias.PotentialRecordSyndetic

/-!
# Termination of adaptive KL auxiliary paths

This is the compressed-path argument for the selected-lift policy.  Ordinary
survivors remain the record set.  Every nonrecord auxiliary endpoint must be a
certificate-selected fallback, and therefore loses the uniform positive gap
`5 - 3 * alpha` in the adjusted potential.
-/

namespace Erdos1135
namespace KrasikovLagarias
namespace AdaptiveEliminationPolicy

open EliminationPolicy
open EliminationResidue

/-- Zero or more consecutive principal edges. -/
inductive PrincipalSteps {k : Nat} {hk : 2 ≤ k}
    (potential : ForcedPotential k hk) : State k → State k → Prop where
  | refl (state : State k) : PrincipalSteps potential state state
  | step {start current : State k}
      (previous : PrincipalSteps potential start current)
      (hadvanced : 0 ≤ current.current.value) :
      PrincipalSteps potential 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 potential 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 adaptive auxiliary edge after a principal-only segment. -/
structure AuxiliaryStep {k : Nat} {hk : 2 ≤ k}
    (potential : ForcedPotential k hk) (start finish : State k) where
  branch : State k
  principals : PrincipalSteps potential start branch
  advanced : 0 ≤ branch.current.value
  child : Label k
  allowed : AllowedAuxiliary potential branch child
  finish_eq : finish = State.descend branch child

/-- An infinite adaptive path compressed at successive auxiliary endpoints. -/
structure AuxiliarySequence {k : Nat} {hk : 2 ≤ k}
    (potential : ForcedPotential k hk) 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 potential (state n) (state (n + 1))

namespace AuxiliarySequence

def twoCount {k : Nat} {hk : 2 ≤ k} {potential : ForcedPotential k hk}
    (sequence : AuxiliarySequence potential) : Nat → Nat :=
  fun n => (sequence.state n).current.shift.twoCount

def color {k : Nat} {hk : 2 ≤ k} {potential : ForcedPotential k hk}
    (sequence : AuxiliarySequence potential) : Nat → PrincipalIndex k :=
  fun n => (sequence.state n).current.index

def recordSet {k : Nat} {hk : 2 ≤ k} {potential : ForcedPotential k hk}
    (sequence : AuxiliarySequence potential) : Set Nat :=
  {n | n = 0 ∨ Survives (sequence.state n).prior (sequence.state n).current}

@[simp]
theorem codedShift_eq_value {k : Nat} {hk : 2 ≤ k}
    {potential : ForcedPotential k hk} (sequence : AuxiliarySequence potential)
    (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}
    {potential : ForcedPotential k hk} (sequence : AuxiliarySequence potential)
    (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}
    {potential : ForcedPotential k hk} (sequence : AuxiliarySequence potential) :
    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}
    {potential : ForcedPotential k hk} (sequence : AuxiliarySequence potential) :
    ∀ 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}
    {potential : ForcedPotential k hk} (sequence : AuxiliarySequence potential) :
    ∀ 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
  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.d1Selected_adjusted_add_gap_le branch.current hrow).trans
        hprincipalAdjusted
  | d3Survivor hrow lift hsurvives => exact (hnonsurviveChild hsurvives).elim
  | d3Forced hrow hall =>
      exact (potential.d3Selected_adjusted_add_gap_le branch.current hrow).trans
        hprincipalAdjusted

/-- No infinite compressed path obeys the adaptive selected-lift policy. -/
theorem false_of_forcedPotential {k : Nat} {hk : 2 ≤ k}
    {potential : ForcedPotential k hk} (sequence : AuxiliarySequence potential) :
    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

end AuxiliarySequence
end AdaptiveEliminationPolicy
end KrasikovLagarias
end Erdos1135