import Erdos1135.KrasikovLagarias.EliminationShift
import Mathlib.Algebra.Order.Floor.Ring
import Mathlib.Topology.Algebra.Group.SubmonoidClosure
import Mathlib.Topology.Instances.AddCircle.DenseSubgroup

/-!
# Irrational rotation for KL elimination

This module proves that the KL shift parameter `alpha = log_[2] 3` is
irrational and packages the resulting density of its natural rotation orbit.
The final theorem extracts arbitrarily long chronological subsequences whose
fractional parts are strictly increasing.
-/

namespace Erdos1135
namespace KrasikovLagarias

open Filter Function Set

/-- The KL parameter `alpha = log_[2] 3` is irrational. -/
theorem alpha_irrational : Irrational alpha := by
  rw [Irrational]
  rintro ⟨q, hq⟩
  have hqposReal : (0 : Real) < (q : Real) := by
    rw [hq]
    exact alpha_pos
  have hqpos : (0 : ℚ) < q := by
    exact_mod_cast hqposReal
  have hnumpos : 0 < q.num := Rat.num_pos.mpr hqpos
  have hlinear : (q.den : Real) * alpha = (q.num.toNat : Real) := by
    rw [← hq, Rat.cast_def]
    field_simp
    norm_cast
    exact (Int.toNat_of_nonneg hnumpos.le).symm
  let shift : EliminationShift := ⟨q.den, q.num.toNat⟩
  have hzero : shift.value = 0 := by
    exact sub_eq_zero.mpr hlinear
  exact q.den_nz ((EliminationShift.value_eq_zero_iff shift).mp hzero).1

/-- The natural multiples of `alpha` are dense in the unit additive circle. -/
theorem denseRange_nsmul_alpha :
    DenseRange (fun n : Nat => n • (alpha : AddCircle (1 : Real))) := by
  rw [← denseRange_zsmul_iff_nsmul, AddCircle.denseRange_zsmul_coe_iff]
  simpa using alpha_irrational

private theorem strictMono_fin_cons_of_lt
    {β : Type*} [Preorder β] {n : Nat} {x : β} {f : Fin n → β}
    (hx : ∀ i, x < f i) (hf : StrictMono f) :
    StrictMono (Fin.cons x f) := by
  intro i j hij
  cases i using Fin.cases with
  | zero =>
      cases j using Fin.cases with
      | zero => simp at hij
      | succ j => simpa using hx j
  | succ i =>
      cases j using Fin.cases with
      | zero => simp at hij
      | succ j =>
          apply hf
          simpa using hij

/-- Every tail of the natural rotation orbit meets each open interval contained
in the standard representative interval `[0, 1)`. -/
private theorem exists_nat_gt_with_fract_mem_Ioo
    (start : Nat) {a b : Real} (ha : 0 ≤ a) (hab : a < b) (hb : b ≤ 1) :
    ∃ n : Nat, start < n ∧ Int.fract ((n : Real) * alpha) ∈ Ioo a b := by
  let midpoint : Real := (a + b) / 2
  let arc : Set (AddCircle (1 : Real)) :=
    ((fun x : Real => (x : AddCircle (1 : Real))) '' Ioo a b)
  have hab0 : 0 < b := ha.trans_lt hab
  have ha1 : a < 1 := hab.trans_le hb
  have hmidpoint : midpoint ∈ Ioo a b := by
    dsimp [midpoint]
    constructor <;> linarith
  have harcOpen : IsOpen arc := by
    apply (AddCircle.openPartialHomeomorphCoe (1 : Real) 0).isOpen_image_of_subset_source
    · exact isOpen_Ioo
    · intro x hx
      simpa only [AddCircle.openPartialHomeomorphCoe_source, zero_add, Set.mem_Ioo] using
        ⟨ha.trans_lt hx.1, hx.2.trans_le hb⟩
  have harcMidpoint : (midpoint : AddCircle (1 : Real)) ∈ arc :=
    ⟨midpoint, hmidpoint, rfl⟩
  have hcluster :
      MapClusterPt (midpoint : AddCircle (1 : Real)) atTop
        (fun n : Nat => n • (alpha : AddCircle (1 : Real))) :=
    ((mapClusterPt_atTop_nsmul_tfae
      (midpoint : AddCircle (1 : Real)) (alpha : AddCircle (1 : Real))).out 2 0).mp
        (denseRange_nsmul_alpha (midpoint : AddCircle (1 : Real)))
  obtain ⟨n, hnarc, hnstart⟩ :=
    ((hcluster.frequently (harcOpen.mem_nhds harcMidpoint)).and_eventually
      (eventually_gt_atTop start)).exists
  rcases hnarc with ⟨y, hy, hyorbit⟩
  have horbit :
      ((Int.fract ((n : Real) * alpha) : Real) : AddCircle (1 : Real)) =
        n • (alpha : AddCircle (1 : Real)) := by
    calc
      ((Int.fract ((n : Real) * alpha) : Real) : AddCircle (1 : Real)) =
          (((n : Real) * alpha : Real) : AddCircle (1 : Real)) :=
        AddCircle.coe_fract (𝕜 := Real) ((n : Real) * alpha)
      _ = ((n • alpha : Real) : AddCircle (1 : Real)) := by rw [nsmul_eq_mul]
      _ = n • (alpha : AddCircle (1 : Real)) := AddCircle.coe_nsmul (1 : Real)
  have hyIco : y ∈ Ico (0 : Real) 1 :=
    ⟨ha.trans hy.1.le, hy.2.trans_le hb⟩
  have hfractIco : Int.fract ((n : Real) * alpha) ∈ Ico (0 : Real) 1 :=
    ⟨Int.fract_nonneg _, Int.fract_lt_one _⟩
  have hyfract : y = Int.fract ((n : Real) * alpha) :=
    (AddCircle.coe_eq_coe_iff_of_mem_Ico (a := (0 : Real))
      (by simpa only [zero_add] using hyIco)
      (by simpa only [zero_add] using hfractIco)).mp
      (hyorbit.trans horbit.symm)
  exact ⟨n, hnstart, hyfract ▸ hy⟩

private theorem exists_strictMono_fract_indices_above
    (length start : Nat) {lower : Real} (hlower : lower < 1) :
    ∃ indices : Fin length → Nat,
      (∀ i, start < indices i) ∧
      StrictMono indices ∧
      (∀ i, lower < Int.fract ((indices i : Real) * alpha)) ∧
      StrictMono (fun i => Int.fract ((indices i : Real) * alpha)) := by
  induction length generalizing start lower with
  | zero =>
      let indices : Fin 0 → Nat := Fin.elim0
      refine ⟨indices, ?_, Subsingleton.strictMono _, ?_, Subsingleton.strictMono _⟩
      · exact fun i => Fin.elim0 i
      · exact fun i => Fin.elim0 i
  | succ length ih =>
      let lower' := max lower 0
      have hlower'0 : 0 ≤ lower' := le_max_right _ _
      have hlower'1 : lower' < 1 := max_lt hlower zero_lt_one
      obtain ⟨first, hstartFirst, hfirstLower, hfirstOne⟩ :=
        exists_nat_gt_with_fract_mem_Ioo start hlower'0 hlower'1 le_rfl
      obtain ⟨tail, hfirstTail, htailMono, htailLower, htailValueMono⟩ :=
        ih first hfirstOne
      let indices : Fin (length + 1) → Nat := Fin.cons first tail
      refine ⟨indices, ?_, ?_, ?_, ?_⟩
      · intro i
        refine Fin.cases hstartFirst (fun i' => ?_) i
        exact hstartFirst.trans (hfirstTail i')
      · exact strictMono_fin_cons_of_lt hfirstTail htailMono
      · intro i
        refine Fin.cases ?_ (fun i' => ?_) i
        · exact (le_max_left lower 0).trans_lt hfirstLower
        · exact ((le_max_left lower 0).trans_lt hfirstLower).trans (htailLower i')
      · rw [show (fun i => Int.fract ((indices i : Real) * alpha)) =
            Fin.cons (Int.fract ((first : Real) * alpha))
              (fun i => Int.fract ((tail i : Real) * alpha)) by
          funext i
          refine Fin.cases ?_ (fun i' => ?_) i
          · rfl
          · rfl]
        exact strictMono_fin_cons_of_lt htailLower htailValueMono

/-- For every finite length and lower index bound, the fractional-part sequence
`fract (n * alpha)` has a strictly increasing chronological subsequence, all of
whose indices are strictly greater than the supplied bound. -/
theorem exists_strictMono_fract_subsequence (length start : Nat) :
    ∃ indices : Fin length → Nat,
      (∀ i, start < indices i) ∧
      StrictMono indices ∧
      StrictMono (fun i => Int.fract ((indices i : Real) * alpha)) := by
  obtain ⟨indices, hstart, hindices, _, hvalues⟩ :=
    exists_strictMono_fract_indices_above length start (lower := 0) zero_lt_one
  exact ⟨indices, hstart, hindices, hvalues⟩

end KrasikovLagarias
end Erdos1135