import Erdos1135.Tao.Syracuse.CollatzBridge
import Erdos1135.Tao.Syracuse.ParityBridge

/-!
# Quantitative Syracuse-to-Collatz clock bridge

The existing reachability bridge forgets its raw step count.  Here the actual
valuation list retains that count and a coarse telescoping estimate bounds it
by a fixed linear combination of the Syracuse time and the source logarithm.
-/

namespace Erdos1135
namespace Tao

noncomputable section

/-- The raw Collatz time of a finite odd Syracuse trajectory is its number of
Syracuse steps plus the sum of the stripped two-adic valuations. -/
theorem collatz_iterate_syracuseValuationTime
    (n M : ℕ) (hM : Odd M) :
    (collatzStep^[n +
      taoTupleWeight (syracuseValuationPNatList n M hM)]) M =
        (syracuse^[n]) M := by
  induction n generalizing M with
  | zero =>
      simp [syracuseValuationPNatList, taoTupleWeight]
  | succ n ih =>
      let a : ℕ := syracuseExponent M
      let W : ℕ := taoTupleWeight
        (syracuseValuationPNatList n (syracuse M) (syracuse_odd M))
      have htime :
          n + 1 + (a + W) = (n + W) + (a + 1) := by omega
      simp only [syracuseValuationPNatList, taoTupleWeight,
        Function.iterate_succ_apply]
      change (collatzStep^[n + 1 + (a + W)]) M =
        (syracuse^[n]) (syracuse M)
      rw [htime, Function.iterate_add_apply]
      rw [collatz_iterate_syracuse_block hM]
      exact ih (syracuse M) (syracuse_odd M)

/-- Telescoping the elementary inequality
`2^v * syracuse M = 3M+1 ≤ 4M` controls the total valuation weight. -/
theorem two_pow_syracuseValuationWeight_mul_iterate_le
    (n M : ℕ) (hM : Odd M) :
    2 ^ taoTupleWeight (syracuseValuationPNatList n M hM) *
        (syracuse^[n]) M ≤
      4 ^ n * M := by
  induction n generalizing M with
  | zero =>
      simp [syracuseValuationPNatList, taoTupleWeight]
  | succ n ih =>
      let a : ℕ := syracuseExponent M
      let W : ℕ := taoTupleWeight
        (syracuseValuationPNatList n (syracuse M) (syracuse_odd M))
      have htail := ih (syracuse M) (syracuse_odd M)
      have hstep : 3 * M + 1 ≤ 4 * M := by
        have hMpos : 0 < M := Odd.pos hM
        omega
      simp only [syracuseValuationPNatList, taoTupleWeight,
        Function.iterate_succ_apply]
      change 2 ^ (a + W) * (syracuse^[n]) (syracuse M) ≤
        4 ^ (n + 1) * M
      calc
        2 ^ (a + W) * (syracuse^[n]) (syracuse M) =
            2 ^ a *
              (2 ^ W * (syracuse^[n]) (syracuse M)) := by
          rw [pow_add]
          ring
        _ ≤ 2 ^ a * (4 ^ n * syracuse M) :=
          Nat.mul_le_mul_left _ htail
        _ = 4 ^ n * (2 ^ a * syracuse M) := by ring
        _ = 4 ^ n * (3 * M + 1) := by
          rw [two_pow_syracuseExponent_mul_syracuse]
        _ ≤ 4 ^ n * (4 * M) := Nat.mul_le_mul_left _ hstep
        _ = 4 ^ (n + 1) * M := by
          rw [pow_succ]
          ring

/-- Removing the positive terminal iterate leaves a pure weight bound. -/
theorem two_pow_syracuseValuationWeight_le
    (n M : ℕ) (hM : Odd M) :
    2 ^ taoTupleWeight (syracuseValuationPNatList n M hM) ≤
      4 ^ n * M := by
  have hendPos : 0 < (syracuse^[n]) M :=
    Odd.pos (syracuse_iterate_odd n M hM)
  calc
    2 ^ taoTupleWeight (syracuseValuationPNatList n M hM) ≤
        2 ^ taoTupleWeight (syracuseValuationPNatList n M hM) *
          (syracuse^[n]) M :=
      Nat.le_mul_of_pos_right _ hendPos
    _ ≤ 4 ^ n * M :=
      two_pow_syracuseValuationWeight_mul_iterate_le n M hM

/-- In real units, the total stripped valuation is at most twice the Syracuse
time plus one binary logarithm of the odd source. -/
theorem syracuseValuationWeight_cast_le
    (n M : ℕ) (hM : Odd M) :
    (taoTupleWeight (syracuseValuationPNatList n M hM) : ℝ) ≤
      2 * (n : ℝ) + Real.log (M : ℝ) / Real.log 2 := by
  let W : ℕ := taoTupleWeight (syracuseValuationPNatList n M hM)
  have hMposNat : 0 < M := Odd.pos hM
  have hMne : (M : ℝ) ≠ 0 := by exact_mod_cast hMposNat.ne'
  have hpowReal :
      (2 : ℝ) ^ W ≤ (4 : ℝ) ^ n * (M : ℝ) := by
    exact_mod_cast two_pow_syracuseValuationWeight_le n M hM
  have hlogMono :
      Real.log ((2 : ℝ) ^ W) ≤
        Real.log ((4 : ℝ) ^ n * (M : ℝ)) :=
    Real.log_le_log (pow_pos (by norm_num) W) hpowReal
  have hlogBound :
      (W : ℝ) * Real.log 2 ≤
        (n : ℝ) * Real.log 4 + Real.log (M : ℝ) := by
    calc
      (W : ℝ) * Real.log 2 = Real.log ((2 : ℝ) ^ W) := by
        rw [Real.log_pow]
      _ ≤ Real.log ((4 : ℝ) ^ n * (M : ℝ)) := hlogMono
      _ = Real.log ((4 : ℝ) ^ n) + Real.log (M : ℝ) := by
        rw [Real.log_mul (pow_ne_zero _ (by norm_num)) hMne]
      _ = (n : ℝ) * Real.log 4 + Real.log (M : ℝ) := by
        rw [Real.log_pow]
  have hlogFour : Real.log 4 = 2 * Real.log 2 := by
    calc
      Real.log 4 = Real.log ((2 : ℝ) ^ (2 : ℕ)) := by norm_num
      _ = (2 : ℝ) * Real.log 2 := by
        rw [Real.log_pow]
        norm_num
  rw [hlogFour] at hlogBound
  have hlogTwo : 0 < Real.log (2 : ℝ) := Real.log_pos (by norm_num)
  have hdivBound :
      (W : ℝ) ≤
        ((n : ℝ) * (2 * Real.log 2) + Real.log (M : ℝ)) /
          Real.log 2 := by
    exact (le_div_iff₀ hlogTwo).2 hlogBound
  dsimp only [W] at hdivBound ⊢
  calc
    (taoTupleWeight (syracuseValuationPNatList n M hM) : ℝ) ≤
        ((n : ℝ) * (2 * Real.log 2) + Real.log (M : ℝ)) /
          Real.log 2 := hdivBound
    _ = 2 * (n : ℝ) + Real.log (M : ℝ) / Real.log 2 := by
      field_simp [hlogTwo.ne']

/-- Consequently the exact raw simulation time is at most three times the
Syracuse time plus one binary logarithm of the source. -/
theorem syracuseRawTime_cast_le
    (n M : ℕ) (hM : Odd M) :
    ((n + taoTupleWeight (syracuseValuationPNatList n M hM) : ℕ) : ℝ) ≤
      3 * (n : ℝ) + Real.log (M : ℝ) / Real.log 2 := by
  have hweight := syracuseValuationWeight_cast_le n M hM
  norm_num only [Nat.cast_add]
  linarith

/-- Initial dyadic stripping followed by the exact raw simulation of an odd
Syracuse trajectory. -/
theorem collatz_iterate_powTwo_mul_syracuseValuationTime
    (a n M : ℕ) (hM : Odd M) :
    (collatzStep^[a + n +
      taoTupleWeight (syracuseValuationPNatList n M hM)])
        ((2 : ℕ) ^ a * M) =
      (syracuse^[n]) M := by
  let W := taoTupleWeight (syracuseValuationPNatList n M hM)
  have htime : a + n + W = (n + W) + a := by omega
  change (collatzStep^[a + n + W]) ((2 : ℕ) ^ a * M) =
    (syracuse^[n]) M
  rw [htime, Function.iterate_add_apply,
    collatz_iterate_powTwo_mul,
    collatz_iterate_syracuseValuationTime]

/-- The initial dyadic valuation and the binary logarithm of the odd factor
combine exactly to the binary logarithm of the original source. -/
theorem powTwo_add_log_div_eq_log_mul_div
    (a M : ℕ) (hM : 0 < M) :
    (a : ℝ) + Real.log (M : ℝ) / Real.log 2 =
      Real.log ((((2 : ℕ) ^ a * M : ℕ) : ℝ)) / Real.log 2 := by
  have hMne : (M : ℝ) ≠ 0 := by exact_mod_cast hM.ne'
  have hlogTwo : Real.log (2 : ℝ) ≠ 0 :=
    ne_of_gt (Real.log_pos (by norm_num))
  have hlogMul :
      Real.log ((((2 : ℕ) ^ a * M : ℕ) : ℝ)) =
        (a : ℝ) * Real.log 2 + Real.log (M : ℝ) := by
    push_cast
    rw [Real.log_mul (pow_ne_zero _ (by norm_num)) hMne,
      Real.log_pow]
  rw [hlogMul]
  field_simp [hlogTwo]

/-- A `C * log M` Syracuse budget on an odd factor becomes one uniform raw
Collatz budget on every dyadic multiple. -/
theorem powTwo_syracuseRawTime_cast_le
    (a n M : ℕ) (hM : Odd M) {C : ℝ} (hC : 0 ≤ C)
    (hn : (n : ℝ) ≤ C * Real.log (M : ℝ)) :
    ((a + n +
        taoTupleWeight (syracuseValuationPNatList n M hM) : ℕ) : ℝ) ≤
      (3 * C + 1 / Real.log 2) *
        Real.log (((2 : ℕ) ^ a * M : ℕ) : ℝ) := by
  let N : ℝ := (((2 : ℕ) ^ a * M : ℕ) : ℝ)
  have hMposNat : 0 < M := Odd.pos hM
  have hMOne : (1 : ℝ) ≤ (M : ℝ) := by
    exact_mod_cast hMposNat
  have hMne : (M : ℝ) ≠ 0 := by exact_mod_cast hMposNat.ne'
  have hlogTwo : 0 < Real.log (2 : ℝ) := Real.log_pos (by norm_num)
  have hNlog :
      Real.log N =
        (a : ℝ) * Real.log 2 + Real.log (M : ℝ) := by
    dsimp only [N]
    push_cast
    rw [Real.log_mul (pow_ne_zero _ (by norm_num)) hMne,
      Real.log_pow]
  have hlogMNonneg : 0 ≤ Real.log (M : ℝ) := Real.log_nonneg hMOne
  have hlogMLeN : Real.log (M : ℝ) ≤ Real.log N := by
    rw [hNlog]
    have haNonneg : (0 : ℝ) ≤ (a : ℝ) := Nat.cast_nonneg a
    nlinarith
  have hnN : (n : ℝ) ≤ C * Real.log N :=
    hn.trans (mul_le_mul_of_nonneg_left hlogMLeN hC)
  have hdyadicExact :
      (a : ℝ) + Real.log (M : ℝ) / Real.log 2 =
        Real.log N / Real.log 2 := by
    simpa only [N] using powTwo_add_log_div_eq_log_mul_div a M hMposNat
  have hraw := syracuseRawTime_cast_le n M hM
  calc
    ((a + n +
        taoTupleWeight (syracuseValuationPNatList n M hM) : ℕ) : ℝ) =
        (a : ℝ) +
          ((n + taoTupleWeight
            (syracuseValuationPNatList n M hM) : ℕ) : ℝ) := by
      push_cast
      ring
    _ ≤ (a : ℝ) +
        (3 * (n : ℝ) + Real.log (M : ℝ) / Real.log 2) :=
      add_le_add_right hraw _
    _ ≤ (a : ℝ) +
        (3 * (C * Real.log N) + Real.log (M : ℝ) / Real.log 2) := by
      have hthree : (0 : ℝ) ≤ 3 := by norm_num
      have hscaled := mul_le_mul_of_nonneg_left hnN hthree
      linarith
    _ = 3 * (C * Real.log N) +
        ((a : ℝ) + Real.log (M : ℝ) / Real.log 2) := by ring
    _ = 3 * (C * Real.log N) + Real.log N / Real.log 2 := by
      rw [hdyadicExact]
    _ = (3 * C + 1 / Real.log 2) * Real.log N := by ring
    _ = (3 * C + 1 / Real.log 2) *
        Real.log ((((2 : ℕ) ^ a * M : ℕ) : ℝ)) := by rfl

end

end Tao
end Erdos1135