import Mathlib.Algebra.Order.Field.GeomSum
import Erdos1135.Tao.Section3.AmbientBoundedTrace

/-!
# Ambient Section 3 Geometric Error Budget

The seed-forward thresholds grow by exact powers of `taoAlpha`.  Consequently,
the polynomial rate errors along every bounded ambient trace form a geometric
sum.  This leaf packages that scalar estimate separately from the trace
construction that consumes it.
-/

namespace Erdos1135
namespace Tao

open Filter
open scoped Topology BigOperators

noncomputable section

theorem taoSection3ForwardThreshold_monotone
    {y : ℝ} (hy : 1 ≤ y) :
    Monotone (taoSection3ForwardThreshold y) := by
  intro m n hmn
  unfold taoSection3ForwardThreshold
  apply Real.rpow_le_rpow
  · unfold taoSection3ForwardScale
    exact Real.rpow_nonneg (zero_le_one.trans hy) _
  · exact taoSection3ForwardScale_monotone hy hmn
  · exact taoSection3AmbientRatio_pos.le

theorem taoSection3ForwardThreshold_eq_zero_rpow
    {y : ℝ} (hy : 0 ≤ y) (m : ℕ) :
    taoSection3ForwardThreshold y m =
      (taoSection3ForwardThreshold y 0) ^ (taoAlpha ^ m) := by
  unfold taoSection3ForwardThreshold taoSection3ForwardScale
  calc
    (y ^ (taoAlpha ^ m)) ^ taoSection3AmbientRatio =
        y ^ ((taoAlpha ^ m) * taoSection3AmbientRatio) :=
      (Real.rpow_mul hy (taoAlpha ^ m) taoSection3AmbientRatio).symm
    _ = y ^ (taoSection3AmbientRatio * (taoAlpha ^ m)) := by
      rw [mul_comm (taoAlpha ^ m) taoSection3AmbientRatio]
    _ = (y ^ taoSection3AmbientRatio) ^ (taoAlpha ^ m) :=
      Real.rpow_mul hy taoSection3AmbientRatio (taoAlpha ^ m)
    _ = ((y ^ (taoAlpha ^ 0)) ^ taoSection3AmbientRatio) ^
          (taoAlpha ^ m) := by
      simp only [pow_zero, Real.rpow_one]

theorem log_taoSection3ForwardThreshold_eq
    {y : ℝ} (hy : 1 ≤ y) (m : ℕ) :
    Real.log (taoSection3ForwardThreshold y m) =
      taoAlpha ^ m *
        Real.log (taoSection3ForwardThreshold y 0) := by
  have hq0 : 0 < taoSection3ForwardThreshold y 0 :=
    lt_of_lt_of_le zero_lt_one
      (taoSection3ForwardThreshold_one_le hy 0)
  calc
    Real.log (taoSection3ForwardThreshold y m) =
        Real.log ((taoSection3ForwardThreshold y 0) ^ (taoAlpha ^ m)) :=
      congrArg Real.log
        (taoSection3ForwardThreshold_eq_zero_rpow
          (zero_le_one.trans hy) m)
    _ = taoAlpha ^ m *
          Real.log (taoSection3ForwardThreshold y 0) :=
      Real.log_rpow hq0 (taoAlpha ^ m)

theorem taoSection3Forward_logRate_eq_geometric
    {y c : ℝ} (hy : 1 ≤ y) (m : ℕ) :
    (Real.log (taoSection3ForwardThreshold y m)) ^ (-c) =
      (Real.log (taoSection3ForwardThreshold y 0)) ^ (-c) *
        (taoAlpha ^ (-c)) ^ m := by
  rw [log_taoSection3ForwardThreshold_eq hy]
  rw [Real.mul_rpow (pow_nonneg taoAlpha_pos.le m)
    (Real.log_nonneg (taoSection3ForwardThreshold_one_le hy 0))]
  rw [← Real.rpow_pow_comm taoAlpha_pos.le (-c) m]
  ring

/-- A uniform polynomial rate packet costs only a geometric multiple of its
first logarithmic error along a bounded seed-forward trace. -/
theorem taoSection3Forward_error_sum_le_logRate
    {errNoHit errTV : ℕ → ℝ} {C c y : ℝ}
    (hC : 0 ≤ C) (hc : 0 < c) (hy : 1 ≤ y)
    (hq0 : Real.exp 1 < taoSection3ForwardThreshold y 0)
    (J : ℕ)
    (hrate : ∀ m < J,
      0 ≤ errNoHit (Nat.floor (taoSection3ForwardThreshold y m)) ∧
        0 ≤ errTV (Nat.floor (taoSection3ForwardThreshold y m)) ∧
          errNoHit (Nat.floor (taoSection3ForwardThreshold y m)) ≤
              C * (taoSection3ForwardThreshold y m) ^ (-c) ∧
            errTV (Nat.floor (taoSection3ForwardThreshold y m)) ≤
              C * (Real.log
                (taoSection3ForwardThreshold y m)) ^ (-c)) :
    (∑ m ∈ Finset.range J,
      taoSection3ForwardStepError errNoHit errTV y m) ≤
        (2 * C *
          (Real.log (taoSection3ForwardThreshold y 0)) ^ (-c)) /
            (1 - taoAlpha ^ (-c)) := by
  have hratioNonneg : 0 ≤ taoAlpha ^ (-c) :=
    Real.rpow_nonneg taoAlpha_pos.le _
  have hratioLt : taoAlpha ^ (-c) < 1 :=
    Real.rpow_lt_one_of_one_lt_of_neg taoAlpha_one_lt (neg_lt_zero.mpr hc)
  have hlog0pos :
      0 < Real.log (taoSection3ForwardThreshold y 0) := by
    have hq0pos : 0 < taoSection3ForwardThreshold y 0 :=
      (Real.exp_pos 1).trans hq0
    exact zero_lt_one.trans ((Real.lt_log_iff_exp_lt hq0pos).2 hq0)
  have hcoefficient :
      0 ≤ 2 * C *
        (Real.log (taoSection3ForwardThreshold y 0)) ^ (-c) := by
    positivity
  calc
    (∑ m ∈ Finset.range J,
        taoSection3ForwardStepError errNoHit errTV y m) ≤
        ∑ m ∈ Finset.range J,
          (2 * C *
            (Real.log (taoSection3ForwardThreshold y 0)) ^ (-c)) *
              (taoAlpha ^ (-c)) ^ m := by
      apply Finset.sum_le_sum
      intro m hm
      have hmJ : m < J := Finset.mem_range.mp hm
      rcases hrate m hmJ with ⟨_hNoHitNonneg, _hTVNonneg,
        hNoHit, hTV⟩
      have hq0m :=
        taoSection3ForwardThreshold_monotone hy (Nat.zero_le m)
      have hexpM : Real.exp 1 < taoSection3ForwardThreshold y m :=
        hq0.trans_le hq0m
      have hqMpos : 0 < taoSection3ForwardThreshold y m :=
        (Real.exp_pos 1).trans hexpM
      have hlogMpos :
          0 < Real.log (taoSection3ForwardThreshold y m) :=
        zero_lt_one.trans ((Real.lt_log_iff_exp_lt hqMpos).2 hexpM)
      have hpowCompare :
          (taoSection3ForwardThreshold y m) ^ (-c) ≤
            (Real.log (taoSection3ForwardThreshold y m)) ^ (-c) :=
        Real.rpow_le_rpow_of_nonpos hlogMpos
          (Real.log_le_self hqMpos.le) (neg_nonpos.mpr hc.le)
      unfold taoSection3ForwardStepError taoSection3AmbientStepError
      have hscaled := mul_le_mul_of_nonneg_left hpowCompare hC
      calc
        errTV (Nat.floor (taoSection3ForwardThreshold y m)) +
            errNoHit (Nat.floor (taoSection3ForwardThreshold y m)) ≤
            2 * C *
              (Real.log (taoSection3ForwardThreshold y m)) ^ (-c) := by
          nlinarith
        _ = (2 * C *
              (Real.log
                (taoSection3ForwardThreshold y 0)) ^ (-c)) *
                (taoAlpha ^ (-c)) ^ m := by
          rw [taoSection3Forward_logRate_eq_geometric hy]
          ring
    _ = (2 * C *
          (Real.log (taoSection3ForwardThreshold y 0)) ^ (-c)) *
          (∑ m ∈ Finset.range J, (taoAlpha ^ (-c)) ^ m) := by
      rw [Finset.mul_sum]
    _ ≤ (2 * C *
          (Real.log (taoSection3ForwardThreshold y 0)) ^ (-c)) *
          (1 / (1 - taoAlpha ^ (-c))) := by
      apply mul_le_mul_of_nonneg_left _ hcoefficient
      simpa only [Finset.range_eq_Ico, pow_zero, one_div] using
        (geom_sum_Ico_le_of_lt_one (m := 0) (n := J)
          hratioNonneg hratioLt)
    _ = (2 * C *
          (Real.log (taoSection3ForwardThreshold y 0)) ^ (-c)) /
            (1 - taoAlpha ^ (-c)) := by
      simp only [one_mul, div_eq_mul_inv]

/-- The bounded ambient trace has a no-hit error budget independent of its
least-crossing index.  The active prefix still has exactly `j + 1` passage
calls, ending at the ambient window based at `X^(1 / alpha)`. -/
theorem exists_taoSection3AmbientGeometricBudget_checked :
    ∃ Ctrace c : ℝ, ∃ Bstar : ℕ,
      0 ≤ Ctrace ∧ 0 < c ∧ 2 ≤ Bstar ∧
        ∀ {B : ℕ}, Bstar ≤ B →
          ∀ {X : ℝ}, (B : ℝ) < X →
            ∃ j : ℕ,
              let y := taoSection3AmbientBoundary X (j + 2)
              taoSection3ForwardScale y 1 ≤ (B : ℝ) ∧
                taoSection3ForwardWindow y (j + 1) =
                  taoSection3AmbientWindow X 1 ∧
                ∀ J : ℕ, J ≤ j + 1 →
                  ∃ hmassJ :
                      0 < logFinsetMass
                        (taoSection3ForwardWindow y J),
                    syracuseNoHitWindowProb B
                        (taoNyLo (taoSection3ForwardScale y J))
                        (taoNyHi (taoSection3ForwardScale y J) taoAlpha)
                        hmassJ ≤
                      Ctrace * (Real.log (B : ℝ)) ^ (-c) := by
  rcases exists_taoSection3AmbientBoundedTrace_checked with
    ⟨errNoHit, errTV, C, c, Ymass, hC, hc, hrate, hYmass, htrace⟩
  rcases (eventually_atTop.1 hrate) with ⟨Qrate, hQrate⟩
  have hratioNonneg : 0 ≤ taoAlpha ^ (-c) :=
    Real.rpow_nonneg taoAlpha_pos.le _
  have hratioLt : taoAlpha ^ (-c) < 1 :=
    Real.rpow_lt_one_of_one_lt_of_neg taoAlpha_one_lt (neg_lt_zero.mpr hc)
  have hdenomPos : 0 < 1 - taoAlpha ^ (-c) := sub_pos.mpr hratioLt
  let Ctrace : ℝ :=
    (2 * C * (taoSection3AmbientRatio ^ 3) ^ (-c)) /
      (1 - taoAlpha ^ (-c))
  have hCtrace : 0 ≤ Ctrace := by
    dsimp only [Ctrace]
    apply div_nonneg
    · exact mul_nonneg (mul_nonneg (by positivity) hC)
        (Real.rpow_nonneg (pow_nonneg taoSection3AmbientRatio_pos.le 3) _)
    · exact hdenomPos.le
  have hpow2 :
      Tendsto
        (fun B : ℕ =>
          (B : ℝ) ^ (taoSection3AmbientRatio ^ 2)) atTop atTop := by
    simpa only [Function.comp_def] using
      (tendsto_rpow_atTop
        (pow_pos taoSection3AmbientRatio_pos 2)).comp
          tendsto_natCast_atTop_atTop
  have hpow3 :
      Tendsto
        (fun B : ℕ =>
          (B : ℝ) ^ (taoSection3AmbientRatio ^ 3)) atTop atTop := by
    simpa only [Function.comp_def] using
      (tendsto_rpow_atTop
        (pow_pos taoSection3AmbientRatio_pos 3)).comp
          tendsto_natCast_atTop_atTop
  have hlarge : ∀ᶠ B : ℕ in atTop,
      2 ≤ B ∧
        Ymass ≤ (B : ℝ) ^ (taoSection3AmbientRatio ^ 2) ∧
          max Qrate (Real.exp 1) ≤
            (B : ℝ) ^ (taoSection3AmbientRatio ^ 3) := by
    filter_upwards [eventually_ge_atTop (2 : ℕ),
      hpow2.eventually_ge_atTop Ymass,
      hpow3.eventually_ge_atTop (max Qrate (Real.exp 1))]
      with B hB hmass hQ
    exact ⟨hB, hmass, hQ⟩
  rcases (eventually_atTop.1 hlarge) with ⟨Bstar, hBstar⟩
  refine ⟨Ctrace, c, Bstar, hCtrace, hc, (hBstar Bstar le_rfl).1, ?_⟩
  intro B hBBstar X hBX
  rcases hBstar B hBBstar with ⟨hB, hmassB, hrateB⟩
  rcases htrace hB hBX hmassB with
    ⟨j, hseed, hseedLower, hthresholdLower, hq0Eq, hterminal,
      hpartials, _hmassTerminal, _hnoHitTerminal⟩
  refine ⟨j, ?_⟩
  dsimp only
  have hXnonneg : 0 ≤ X := (Nat.cast_nonneg B).trans hBX.le
  have hident := taoSection3AmbientForwardTrace_identifications hXnonneg j
  refine ⟨?_, hterminal, ?_⟩
  · rw [hident.1]
    exact hseed
  have hy :
      1 ≤ taoSection3AmbientBoundary X (j + 2) :=
    hYmass.trans (hmassB.trans hseedLower.le)
  have hq0Large :
      max Qrate (Real.exp 1) <
        taoSection3ForwardThreshold
          (taoSection3AmbientBoundary X (j + 2)) 0 := by
    calc
      max Qrate (Real.exp 1) ≤
          (B : ℝ) ^ (taoSection3AmbientRatio ^ 3) := hrateB
      _ < taoSection3AmbientBoundary X (j + 3) := hthresholdLower
      _ = taoSection3ForwardThreshold
          (taoSection3AmbientBoundary X (j + 2)) 0 := hq0Eq.symm
  have hBpos : 0 < (B : ℝ) := by positivity
  have hBone : (1 : ℝ) < (B : ℝ) := by
    exact_mod_cast (show 1 < B by omega)
  have hlogBpos : 0 < Real.log (B : ℝ) := Real.log_pos hBone
  have hboundaryLogLower :
      taoSection3AmbientRatio ^ 3 * Real.log (B : ℝ) <
        Real.log (taoSection3ForwardThreshold
          (taoSection3AmbientBoundary X (j + 2)) 0) := by
    calc
      taoSection3AmbientRatio ^ 3 * Real.log (B : ℝ) =
          Real.log ((B : ℝ) ^ (taoSection3AmbientRatio ^ 3)) :=
        (Real.log_rpow hBpos (taoSection3AmbientRatio ^ 3)).symm
      _ < Real.log (taoSection3ForwardThreshold
          (taoSection3AmbientBoundary X (j + 2)) 0) :=
        Real.log_lt_log
          (Real.rpow_pos_of_pos hBpos (taoSection3AmbientRatio ^ 3))
          (by
            calc
              (B : ℝ) ^ (taoSection3AmbientRatio ^ 3) <
                  taoSection3AmbientBoundary X (j + 3) := hthresholdLower
              _ = taoSection3ForwardThreshold
                  (taoSection3AmbientBoundary X (j + 2)) 0 := hq0Eq.symm)
  have hlogRateCompare :
      (Real.log (taoSection3ForwardThreshold
          (taoSection3AmbientBoundary X (j + 2)) 0)) ^ (-c) ≤
        (taoSection3AmbientRatio ^ 3) ^ (-c) *
          (Real.log (B : ℝ)) ^ (-c) := by
    calc
      (Real.log (taoSection3ForwardThreshold
          (taoSection3AmbientBoundary X (j + 2)) 0)) ^ (-c) ≤
          (taoSection3AmbientRatio ^ 3 *
            Real.log (B : ℝ)) ^ (-c) :=
        Real.rpow_le_rpow_of_nonpos
          (mul_pos (pow_pos taoSection3AmbientRatio_pos 3) hlogBpos)
          hboundaryLogLower.le (neg_nonpos.mpr hc.le)
      _ = (taoSection3AmbientRatio ^ 3) ^ (-c) *
          (Real.log (B : ℝ)) ^ (-c) :=
        Real.mul_rpow
          (pow_nonneg taoSection3AmbientRatio_pos.le 3) hlogBpos.le
  intro J hJ
  rcases hpartials J hJ with ⟨hmassJ, _hgoodJ, hnoHitJ⟩
  refine ⟨hmassJ, hnoHitJ.trans ?_⟩
  have hrateJ : ∀ m < J,
      0 ≤ errNoHit (Nat.floor (taoSection3ForwardThreshold
        (taoSection3AmbientBoundary X (j + 2)) m)) ∧
        0 ≤ errTV (Nat.floor (taoSection3ForwardThreshold
          (taoSection3AmbientBoundary X (j + 2)) m)) ∧
          errNoHit (Nat.floor (taoSection3ForwardThreshold
            (taoSection3AmbientBoundary X (j + 2)) m)) ≤
              C * (taoSection3ForwardThreshold
                (taoSection3AmbientBoundary X (j + 2)) m) ^ (-c) ∧
            errTV (Nat.floor (taoSection3ForwardThreshold
              (taoSection3AmbientBoundary X (j + 2)) m)) ≤
                C * (Real.log (taoSection3ForwardThreshold
                  (taoSection3AmbientBoundary X (j + 2)) m)) ^ (-c) := by
    intro m _hm
    apply hQrate
    exact (le_max_left Qrate (Real.exp 1)).trans
      (hq0Large.le.trans
        (taoSection3ForwardThreshold_monotone hy (Nat.zero_le m)))
  have hsum := taoSection3Forward_error_sum_le_logRate
    hC hc hy ((le_max_right Qrate (Real.exp 1)).trans_lt hq0Large)
    J hrateJ
  refine hsum.trans ?_
  have hfactorNonneg :
      0 ≤ (2 * C) / (1 - taoAlpha ^ (-c)) := by positivity
  calc
    (2 * C *
        (Real.log (taoSection3ForwardThreshold
          (taoSection3AmbientBoundary X (j + 2)) 0)) ^ (-c)) /
          (1 - taoAlpha ^ (-c)) =
        ((2 * C) / (1 - taoAlpha ^ (-c))) *
          (Real.log (taoSection3ForwardThreshold
            (taoSection3AmbientBoundary X (j + 2)) 0)) ^ (-c) := by
      ring
    _ ≤ ((2 * C) / (1 - taoAlpha ^ (-c))) *
        ((taoSection3AmbientRatio ^ 3) ^ (-c) *
          (Real.log (B : ℝ)) ^ (-c)) :=
      mul_le_mul_of_nonneg_left hlogRateCompare hfactorNonneg
    _ = Ctrace * (Real.log (B : ℝ)) ^ (-c) := by
      dsimp only [Ctrace]
      ring

end

end Tao
end Erdos1135