import Erdos1135.KrasikovLagarias.SyndeticRecordDescent

/-!
# Finite-potential control of gaps between record shifts

This module is independent of the concrete elimination graph.  It says that if
non-record steps spend a fixed positive amount of a bounded adjusted shift,
then record indices have bounded gaps.  Combined with syndetic record descent,
this rules out an infinite exact KL auxiliary sequence.
-/

namespace Erdos1135
namespace KrasikovLagarias

/-- The uniform strict loss supplied by the coarse bound `3 * alpha < 5`. -/
noncomputable def forcedGap : Real :=
  5 - 3 * alpha

theorem forcedGap_pos : 0 < forcedGap := by
  exact sub_pos.mpr three_mul_alpha_lt_five

/-- Shift plus a finite color potential, scaled to match `3 * alpha < 5`. -/
noncomputable def adjustedCodedShift {color : Type*}
    (potential : color → Nat) (c : Nat → color)
    (twoCount : Nat → Nat) (n : Nat) : Real :=
  3 * codedShift twoCount n + potential (c n)

/-- A positive fixed drop at every non-record step forces record indices to be
forward-syndetic. -/
theorem exists_forwardSyndetic_of_potential_drop
    {color : Type*} [Fintype color]
    (S : Set Nat) (c : Nat → color) (twoCount : Nat → Nat)
    (potential : color → Nat) (potentialBound : Nat)
    (hpotential : ∀ color, potential color ≤ potentialBound)
    (hzero : codedShift twoCount 0 = 0)
    (hnonneg : ∀ n, 0 ≤ codedShift twoCount n)
    (hantitone : ∀ i ∈ S, ∀ j ∈ S,
      i < j → c i = c j → codedShift twoCount j ≤ codedShift twoCount i)
    (hdrop : ∀ n, n + 1 ∉ S →
      adjustedCodedShift potential c twoCount (n + 1) + forcedGap ≤
        adjustedCodedShift potential c twoCount n) :
    ∃ L, ForwardSyndetic S L := by
  classical
  let floorBound := setColorFloorBound S c twoCount
  let totalBound : Real := 3 * (floorBound + 1) + potentialBound
  have hadjustedUpper : ∀ n,
      adjustedCodedShift potential c twoCount n ≤ totalBound := by
    intro n
    induction n with
    | zero =>
        rw [adjustedCodedShift, hzero]
        have hp : (potential (c 0) : Real) ≤ potentialBound := by
          exact_mod_cast hpotential (c 0)
        have hfloorNonneg : (0 : Real) ≤ floorBound := Nat.cast_nonneg _
        dsimp [totalBound]
        linarith
    | succ n ih =>
        by_cases hrecord : n + 1 ∈ S
        · have hfloor := floor_le_setColorFloorBound
            S c twoCount hantitone hrecord
          have hshift : codedShift twoCount (n + 1) < floorBound + 1 := by
            exact (Nat.lt_floor_add_one (codedShift twoCount (n + 1))).trans_le (by
              exact_mod_cast Nat.add_le_add_right hfloor 1)
          have hp : (potential (c (n + 1)) : Real) ≤ potentialBound := by
            exact_mod_cast hpotential (c (n + 1))
          rw [adjustedCodedShift]
          dsimp [totalBound]
          linarith
        · have hstep := hdrop n hrecord
          have hgap := forcedGap_pos
          linarith
  have hadjustedNonneg : ∀ n,
      0 ≤ adjustedCodedShift potential c twoCount n := by
    intro n
    rw [adjustedCodedShift]
    exact add_nonneg (mul_nonneg (by norm_num) (hnonneg n)) (Nat.cast_nonneg _)
  obtain ⟨L : Nat, hL⟩ := exists_nat_gt (totalBound / forcedGap)
  have htotalLt : totalBound < (L : Real) * forcedGap := by
    exact (div_lt_iff₀ forcedGap_pos).mp hL
  refine ⟨L, ?_⟩
  intro start
  by_contra hnone
  have hnotRecord : ∀ d, d ≤ L → start + d ∉ S := by
    intro d hd hmem
    apply hnone
    exact ⟨start + d, hmem, by omega, by omega⟩
  have hiterate : ∀ d, d ≤ L →
      adjustedCodedShift potential c twoCount (start + d) +
          (d : Real) * forcedGap ≤
        adjustedCodedShift potential c twoCount start := by
    intro d hd
    induction d with
    | zero => simp
    | succ d ih =>
        have hdle : d ≤ L := by omega
        have hstep := hdrop (start + d) (by
          simpa [Nat.add_assoc] using hnotRecord (d + 1) hd)
        have ih' := ih hdle
        have hstep' :
            adjustedCodedShift potential c twoCount (start + (d + 1)) + forcedGap ≤
              adjustedCodedShift potential c twoCount (start + d) := by
          simpa [Nat.add_assoc] using hstep
        calc
          adjustedCodedShift potential c twoCount (start + (d + 1)) +
                ((d + 1 : Nat) : Real) * forcedGap =
              (adjustedCodedShift potential c twoCount (start + (d + 1)) +
                forcedGap) + (d : Real) * forcedGap := by
                  push_cast
                  ring
          _ ≤ adjustedCodedShift potential c twoCount (start + d) +
                (d : Real) * forcedGap := by
                  simpa [add_comm, add_left_comm, add_assoc] using
                    add_le_add_right hstep' ((d : Real) * forcedGap)
          _ ≤ adjustedCodedShift potential c twoCount start := ih'
  have hlong := hiterate L le_rfl
  have hlower := hadjustedNonneg (start + L)
  have hupper := hadjustedUpper start
  linarith

/-- The finite-potential hypotheses are incompatible with an infinite exact KL
sequence whose record shifts descend within finitely many colors. -/
theorem false_of_potential_record_codedShift_sequence
    {color : Type*} [Fintype color]
    (S : Set Nat) (c : Nat → color) (twoCount : Nat → Nat)
    (potential : color → Nat) (potentialBound : Nat)
    (hpotential : ∀ color, potential color ≤ potentialBound)
    (hzero : codedShift twoCount 0 = 0)
    (hnonneg : ∀ n, 0 ≤ codedShift twoCount n)
    (hantitone : ∀ i ∈ S, ∀ j ∈ S,
      i < j → c i = c j → codedShift twoCount j ≤ codedShift twoCount i)
    (hdrop : ∀ n, n + 1 ∉ S →
      adjustedCodedShift potential c twoCount (n + 1) + forcedGap ≤
        adjustedCodedShift potential c twoCount n) :
    False := by
  obtain ⟨L, hS⟩ := exists_forwardSyndetic_of_potential_drop
    S c twoCount potential potentialBound hpotential hzero hnonneg hantitone hdrop
  exact false_of_forwardSyndetic_classwise_codedShift_antitone
    S L c twoCount hS (fun n _ => hnonneg n) hantitone

end KrasikovLagarias
end Erdos1135