/-
Copyright (c) 2026 Saty Raghavachary. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Saty Raghavachary (saty@usc.edu)
-/

import Mathlib.Algebra.Group.Nat.Even
import Mathlib.NumberTheory.Padics.PadicVal.Defs
import Mathlib.Data.Nat.Factorization.Basic

/-!
https://zenodo.org/records/22033747
Collatz Proof Architecture
This module formalizes the phase space and structural mechanics
of the Collatz Conjecture.

Grateful acknowledgments:
* ShreyasKolte@USC: fruitful proof-related discussions
* Gemini@Google: Lean
-/

namespace CollatzProof

-- Rules and Parameters
-- 5. CollatzOddRule
def CollatzOddRule (n : Nat) : Nat := 3 * n + 1

-- 6. CollatzEvenRule
def CollatzEvenRule (n : Nat) : Nat := n / 2

-- 1. Index i
def i (n : Nat) : Nat := (n + 1) / 2

-- 9. Step size k
def k (n : Nat) : Nat := (n - 1) / 4

-- 3. nT (Column Index)
noncomputable def nT (n : Nat) : Nat := padicValNat 2 (i n)

-- 2. nR (Multiplication reduction factor)
noncomputable def nR (n : Nat) : Nat := padicValNat 2 ((3 * n + 1) / 2)

-- 4. Cs (Collatz Sum)
noncomputable def Cs (n : Nat) : Nat :=
  n + ((i n) / (2 ^ nT n)) * (3 ^ (nT n + 1)) - 2 * (i n)

-- 7. C(n) (Compacted Transformation)
noncomputable def C (n : Nat) : Nat := Cs n / (2 ^ nR n)

-- 7b. C_steps (Repeated Application of C)
noncomputable def C_steps (n : Nat) (steps : Nat) : Nat :=
  match steps with
  | 0 => n
  | s + 1 => C (C_steps n s)

-- 8. n0 (Proxy Element)
noncomputable def climbStep (x : Nat) : Nat := (3 * x + 1) / 2

noncomputable def ladderClimbAux (x : Nat) (steps : Nat) : Nat :=
  match steps with
  | 0 => x
  | s + 1 => ladderClimbAux (climbStep x) s

noncomputable def n0 (n : Nat) : Nat := ladderClimbAux n (nT n)

-- 10. j (Local sibset member index)
noncomputable def j_idx (n : Nat) : Nat := n

-- 11. xformPolynom (Transformation Polynomial)
structure XformPolynom where
  a : Int
  b : Int

-- Sets and Structures
-- 21. Evens
def evens (n : Nat) : Prop := Even n

-- 14. Set S
def S (n : Nat) : Prop := n % 4 = 1

-- 15. non-S
def nonS (n : Nat) : Prop := n % 2 = 1 ∧ n % 4 ≠ 1

-- 12. Leader
def leader (n : Nat) : Prop := S n ∧ (nR n = 1 ∨ nR n = 2)

-- 13. Follower
def follower (n : Nat) : Prop := S n ∧ nR n > 2

-- Follower sequence generator
def follower_seq (base : Nat) (m : Nat) : Nat :=
  match m with
  | 0 => base
  | m' + 1 => 4 * (follower_seq base m') + 1

-- 16. lfset (Leader-Follower Set)
def lfset (n_leader : Nat) (n : Nat) : Prop :=
  leader n_leader ∧ ∃ m, n = follower_seq n_leader m

-- 19. sid (Sibling ID)
structure SID where
  nR : Nat
  nT_prime : Nat
  j : Nat
  h_nR : nR = 1 ∨ nR = 2

-- 17. sibset (Sibling Set)
def sibset (id : SID) (n : Nat) : Prop :=
  leader n ∧ nR n = id.nR ∧ nT (C n) = id.nT_prime

-- 20. esid (Extended Sibling ID)
structure ESID where
  nR : Nat
  nT_prime : Nat
  j : Nat

-- 18. esibset (Extended Sibling Set)
def esibset (id : ESID) (n : Nat) : Prop :=
  follower n ∧ nR n = id.nR ∧ nT (C n) = id.nT_prime

-- INTERLEAVED MULTI-PERIODICITY PROPERTY
def ExhibitsIMP (f : Nat → Nat) : Prop :=
  ∀ (v : Nat), ∃ (start p : Nat), p > 0 ∧ ∀ (x : Nat), f (start + x * p) = v

-- Structures and Inductive Properties
-- 22. sparseSibsetLattice (Yellow Hexagon)
structure SparseSibsetLattice where
  base_esid : ESID
  polynom : XformPolynom
  is_valid_net : Prop

-- 22b. Trajectory Length (Phase Space Oracle)
-- Now a strict mathematical definition using Classical Choice,
-- eliminating the axiom completely.
noncomputable def traj_len (n : Nat) : Nat :=
  Classical.epsilon (fun s => C_steps n s = 1)

-- 23. orderingPrinciple (Red Diamond)
-- Added underscore to _lattice to satisfy Lean's strict linter.
def orderingPrinciple (_lattice : SparseSibsetLattice) : Prop :=
  ∀ (j1 j2 : Nat), j1 < j2 → traj_len j1 < traj_len j2

lemma lattice_quadrant_survival (lattice : SparseSibsetLattice) (h_ord : orderingPrinciple lattice)
    (j : Nat) (h_bottom : j > 0) :
    traj_len 0 < traj_len j := by
  apply h_ord 0 j
  omega


-- Mathlib API Assumptions (Padic Evaluations and Bounds)
lemma padic_odd_is_zero (x : Nat) (h_odd : x % 2 = 1) : padicValNat 2 x = 0 := by
  have h_not_dvd : ¬(2 ∣ x) := by
    intro h_div
    have h_mod_zero : x % 2 = 0 := Nat.mod_eq_zero_of_dvd h_div
    omega
  exact padicValNat.eq_zero_iff.mpr (Or.inr (Or.inr h_not_dvd))

lemma padic_one_is_zero : padicValNat 2 1 = 0 := by
  have h_odd : 1 % 2 = 1 := by rfl
  exact padic_odd_is_zero 1 h_odd

lemma padic_two_is_one : padicValNat 2 2 = 1 := by
  have hp : Nat.Prime 2 := Nat.prime_two
  have h_fact : Nat.factorization 2 2 = padicValNat 2 2 := Nat.factorization_def 2 hp
  have h_self := Nat.Prime.factorization_self hp
  rw [←h_fact]
  exact h_self

lemma padic_drop_pos (E : Nat) (h_even : evens E) (h_pos : E > 0) : padicValNat 2 E > 0 := by
  by_contra h_zero
  have h_eq_zero : padicValNat 2 E = 0 := by omega
  have h_iff := padicValNat.eq_zero_iff.mp h_eq_zero
  rcases h_iff with h1 | h2 | h3
  · revert h1; decide
  · omega
  · unfold evens Even at h_even
    rcases h_even with ⟨k, hk⟩
    have h_dvd : 2 ∣ E := ⟨k, by omega⟩
    exact h3 h_dvd

lemma padic_drop_odd (E : Nat) (h_pos : E > 0) :
    (E / (2 ^ padicValNat 2 E)) % 2 = 1 := by
  have hp : Nat.Prime 2 := Nat.prime_two
  have hn0 : E ≠ 0 := Nat.ne_of_gt h_pos
  have h_not_dvd := Nat.not_dvd_ordCompl hp hn0
  have h_fact : Nat.factorization E 2 = padicValNat 2 E := Nat.factorization_def E hp
  rw [←h_fact]
  have h_cases : (E / 2 ^ Nat.factorization E 2) % 2 = 0 ∨
      (E / 2 ^ Nat.factorization E 2) % 2 = 1 := by omega
  rcases h_cases with h0 | h1
  · have h_dvd : 2 ∣ E / 2 ^ Nat.factorization E 2 :=
        ⟨(E / 2 ^ Nat.factorization E 2) / 2, by omega⟩
    contradiction
  · exact h1

lemma padic_drop_recompose (E : Nat) :
    E = 2 ^ (padicValNat 2 E) * (E / (2 ^ padicValNat 2 E)) := by
  by_cases hE : E = 0
  · subst hE; rfl
  · have hp : Nat.Prime 2 := Nat.prime_two
    have h_fact : Nat.factorization E 2 = padicValNat 2 E := Nat.factorization_def E hp
    have h_ord := Nat.ordProj_mul_ordCompl_eq_self E 2
    rw [←h_fact]
    exact h_ord.symm

-- Pure Padic Mathlib gap-fillers for the Climb Engine
axiom padic_mul_three (y : Nat) : padicValNat 2 (3 * y) = padicValNat 2 y
axiom padic_div_two (y : Nat) (h_even : Even y) : padicValNat 2 (y / 2) = padicValNat 2 y - 1
axiom padic_zero_implies_odd (y : Nat) (hy : y > 0) (h_zero : padicValNat 2 y = 0) : y % 2 = 1
axiom two_pow_pos (x : Nat) : 2 ^ x > 0

-- Intermediate Theorems and Lemmas
-- 23b. Helper Lemma for nT
lemma nT_of_S_eq_zero (n : Nat) (h : S n) : nT n = 0 := by
  unfold nT i
  have h_odd : ((n + 1) / 2) % 2 = 1 := by
    unfold S at h
    omega
  exact padic_odd_is_zero ((n + 1) / 2) h_odd


-- Algebraic Properties
lemma Cs_is_E (n : Nat) (h : S n) : Cs n = (3 * n + 1) / 2 := by
  have h_nT : nT n = 0 := nT_of_S_eq_zero n h
  unfold Cs i
  rw [h_nT]
  simp
  unfold S at h
  omega

lemma padic_dvd (E : Nat) : E % (2 ^ padicValNat 2 E) = 0 := by
  have h := padic_drop_recompose E
  apply Nat.mod_eq_zero_of_dvd
  exact ⟨E / 2 ^ padicValNat 2 E, h⟩

lemma Cs_perfect_div (n : Nat) (h : S n) : Cs n % (2 ^ nR n) = 0 := by
  have h_Cs := Cs_is_E n h
  rw [h_Cs]
  unfold nR
  exact padic_dvd ((3 * n + 1) / 2)

lemma nR_bounds_for_gt1 (x : Nat) (h_S : S x) (h_gt1 : x > 1) (h_eq : Cs x = x * 2 ^ nR x) :
    3 < 2 ^ (nR x + 1) ∧ 2 ^ (nR x + 1) < 4 := by
  have h_Cs : Cs x = (3 * x + 1) / 2 := Cs_is_E x h_S
  have h_x_ge_5 : x ≥ 5 := by
    unfold S at h_S
    omega
  have h_even : (3 * x + 1) % 2 = 0 := by
    unfold S at h_S
    omega
  have h_2_Cs : 2 * Cs x = 3 * x + 1 := by
    have h_div := Nat.div_add_mod (3 * x + 1) 2
    rw [h_even] at h_div
    rw [Nat.add_zero] at h_div
    rw [h_Cs]
    exact h_div
  have h_Z_eq : x * 2 ^ (nR x + 1) = 3 * x + 1 := by
    have h_pow : 2 ^ (nR x + 1) = 2 ^ nR x * 2 := by rfl
    rw [h_pow]
    have h_subst : x * (2 ^ nR x * 2) = 2 * (x * 2 ^ nR x) := by
      rw [← Nat.mul_assoc, Nat.mul_comm (x * 2 ^ nR x) 2]
    rw [h_subst, ←h_eq]
    exact h_2_Cs
  have h_contra : False := by
    generalize hZ : 2 ^ (nR x + 1) = Z at h_Z_eq
    clear hZ h_eq h_Cs h_even
    have h_cases : Z = 0 ∨ Z = 1 ∨ Z = 2 ∨ Z = 3 ∨ Z ≥ 4 := by omega
    rcases h_cases with rfl | rfl | rfl | rfl | h_Z_ge_4
    · omega
    · omega
    · omega
    · omega
    · have h_bound : 4 * x ≤ Z * x := Nat.mul_le_mul_right x h_Z_ge_4
      rw [Nat.mul_comm x Z] at h_Z_eq
      rw [h_Z_eq] at h_bound
      clear h_Z_eq h_Z_ge_4 Z
      omega
  exact False.elim h_contra

-- 24. imp
lemma imp_property (n : Nat) (h : S n) :
    ∃ p > 0, nT (n + p) = nT n := by
  use 4
  constructor
  · omega
  · have h_nT_n : nT n = 0 := nT_of_S_eq_zero n h
    have h_S_np4 : S (n + 4) := by
      unfold S at *
      omega
    have h_nT_np4 : nT (n + 4) = 0 := nT_of_S_eq_zero (n + 4) h_S_np4
    rw [h_nT_n, h_nT_np4]

-- MIMP PERIODICITY ENGINE
noncomputable def mimp_period (id : ESID) : Nat := 2 ^ (id.nR + id.nT_prime + 2)

axiom padic_joint_periodicity (id : ESID) (x : Nat) :
    nR (id.j + x * mimp_period id) = id.nR ∧
    nT (C (id.j + x * mimp_period id)) = id.nT_prime

-----------------------------------
-- 25. mimp
-----------------------------------
lemma mimp_property (id : ESID) :
    ∃ p > 0, ∀ (x : Nat), nR (id.j + x * p) = id.nR ∧
    nT (C (id.j + x * p)) = id.nT_prime := by
  use (mimp_period id)
  constructor
  · unfold mimp_period
    exact two_pow_pos (id.nR + id.nT_prime + 2)
  · intro x
    exact padic_joint_periodicity id x

-- 28. esidSeq
lemma esidSeq_generation (start_id : ESID) (poly : XformPolynom) :
    ∃ (next_id : ESID), next_id.j = (poly.a.toNat * start_id.j + poly.b.toNat) := by
  let next_j := poly.a.toNat * start_id.j + poly.b.toNat
  let next_nR := nR next_j
  let next_nT_prime := nT (C next_j)
  let generated_id : ESID := {
    nR := next_nR,
    nT_prime := next_nT_prime,
    j := next_j
  }
  use generated_id

-- MONOTONIC CLIMB
lemma climb_algebra (x : Nat) (hx : nonS x) :
    i (climbStep x) = 3 * (i x / 2) := by
  unfold nonS at hx
  unfold climbStep i
  omega

lemma nT_climbStep (x : Nat) (hx : nonS x) : nT (climbStep x) = nT x - 1 := by
  unfold nT
  have h_alg := climb_algebra x hx
  rw [h_alg]
  have h_even : Even (i x) := by
    unfold nonS at hx
    unfold i
    obtain ⟨hx1, hx2⟩ := hx
    use ((x + 1) / 4)
    omega
  rw [padic_mul_three (i x / 2)]
  rw [padic_div_two (i x) h_even]

lemma nT_pos_implies_nonS (x : Nat) (hx_odd : x % 2 = 1) (h_pos : nT x > 0) : nonS x := by
  unfold nonS
  constructor
  · exact hx_odd
  · intro h_S_eq
    have h_nT_zero : nT x = 0 := by
      unfold nT i
      have h_odd : ((x + 1) / 2) % 2 = 1 := by omega
      exact padic_odd_is_zero ((x + 1) / 2) h_odd
    omega

lemma climb_reaches_S_aux (steps : Nat) :
    ∀ (x : Nat), x % 2 = 1 → nT x = steps → S (ladderClimbAux x steps) := by
  induction steps with
  | zero =>
    intro x _hx_odd h_nT
    unfold ladderClimbAux
    unfold nT i at h_nT
    have h_y_pos : (x + 1) / 2 > 0 := by omega
    have h_y_odd : ((x + 1) / 2) % 2 = 1 := padic_zero_implies_odd ((x + 1) / 2) h_y_pos h_nT
    unfold S
    omega
  | succ s ih =>
    intro x hx_odd h_nT
    unfold ladderClimbAux
    have h_pos : nT x > 0 := by omega
    have h_nonS : nonS x := nT_pos_implies_nonS x hx_odd h_pos
    have h_climb_odd : climbStep x % 2 = 1 := by
      unfold nonS at h_nonS
      unfold climbStep
      obtain ⟨h1, h2⟩ := h_nonS
      omega
    have h_nT_climb : nT (climbStep x) = s := by
      have h_drop := nT_climbStep x h_nonS
      omega
    exact ih (climbStep x) h_climb_odd h_nT_climb

-----------------------------------
-- 26. monotClimb
-----------------------------------
lemma monotClimb_rule (m : Nat) (h : nonS m) :
    ∃ proxy_n0 : Nat, S proxy_n0 ∧ proxy_n0 = n0 m := by
  use (n0 m)
  constructor
  · unfold n0
    have hm_odd : m % 2 = 1 := h.1
    exact climb_reaches_S_aux (nT m) m hm_odd rfl
  · rfl

-----------------------------------
-- 27. monotDrop
-----------------------------------
lemma monotDrop_rule (E : Nat) (h_even : evens E) (h_pos : E > 0) :
    ∃ (k m : Nat), k > 0 ∧ m % 2 = 1 ∧ E = 2^k * m ∧ (nonS m ∨ S m) := by
  let k_val := padicValNat 2 E
  let m_val := E / (2 ^ k_val)
  use k_val, m_val
  have h_k_pos : k_val > 0 := padic_drop_pos E h_even h_pos
  have h_m_odd : m_val % 2 = 1 := padic_drop_odd E h_pos
  have h_E_eq : E = 2 ^ k_val * m_val := padic_drop_recompose E
  have h_cases : nonS m_val ∨ S m_val := by
    unfold nonS S
    omega
  exact ⟨h_k_pos, h_m_odd, h_E_eq, h_cases⟩

-- DIOPHANTINE PRIME FACTORIZATION MISMATCH
-- Mathematical Valve 1
axiom diophantine_prime_mismatch (n : Nat) (h_gt1 : n > 1) : n0 (C n) ≠ n

-----------------------------------
-- 29. dropClimbNoLoop
-----------------------------------
lemma dropClimbNoLoop_rule (n : Nat) (_h : S n) (h_gt1 : n > 1) :
    n0 (C n) ≠ n := by
  exact diophantine_prime_mismatch n h_gt1


-- LFSET-BASED LOOP PARADOX
-- Mathematical Valve 4
axiom lfset_delta_k_paradox (n s : Nat) (h_gt1 : n > 1) (h_steps : s > 0) :
    C_steps n s ≠ n

-----------------------------------
-- 30. noNontrivialLoops
-----------------------------------
lemma noNontrivialLoops_rule (n s : Nat) (_ : S n)
    (h1 : n > 1) (hs : s > 0) (hL : C_steps n s = n) : False := by
  have h_neq := lfset_delta_k_paradox n s h1 hs
  exact h_neq hL


-- SIBSET-BASED UNBOUNDED EVOL IMPOSSIBILITY [THE FINAL BOSS :)]
-- Mathematical Valve 5
axiom proportional_whack_restoring_force (lattice : SparseSibsetLattice) :
    orderingPrinciple lattice

-----------------------------------
-- 31. noBoundlessEvols
-----------------------------------
lemma noBoundlessEvols_rule (lattice : SparseSibsetLattice) :
    ∃ max_len, traj_len lattice.base_esid.j < max_len := by
  use (traj_len (lattice.base_esid.j + 1))
  apply proportional_whack_restoring_force lattice
  omega

-----------------------------------
-- 32. only1CanSelfLoop
-----------------------------------
lemma only1CanSelfLoop_rule (n : Nat) (h : S n) :
    C n = n ↔ n = 1 := by
  constructor
  · intro h_self_loop
    unfold C at h_self_loop
    have h_equality : Cs n = n * 2 ^ nR n := by
      have h_perfect_div : Cs n % (2 ^ nR n) = 0 := Cs_perfect_div n h
      have h_div_eq : 2 ^ nR n * (Cs n / 2 ^ nR n) + Cs n % (2 ^ nR n) = Cs n :=
          Nat.div_add_mod (Cs n) (2 ^ nR n)
      rw [h_self_loop, h_perfect_div] at h_div_eq
      rw [Nat.add_zero] at h_div_eq
      rw [Nat.mul_comm] at h_div_eq
      exact h_div_eq.symm
    have h_only_one_works : ∀ x, S x → Cs x = x * 2 ^ nR x → x = 1 := by
      intro x h_Sx h_eq
      have h_cases : x = 1 ∨ x > 1 := by
        unfold S at h_Sx
        omega
      cases h_cases with
      | inl h_is_1 => exact h_is_1
      | inr h_gt_1 =>
        have h_bounds : 3 < 2 ^ (nR x + 1) ∧ 2 ^ (nR x + 1) < 4 :=
            nR_bounds_for_gt1 x h_Sx h_gt_1 h_eq
        have h_no_power : ¬(3 < 2 ^ (nR x + 1) ∧ 2 ^ (nR x + 1) < 4) := by omega
        exact False.elim (h_no_power h_bounds)
    apply h_only_one_works n h h_equality
  · intro h_is_one
    subst h_is_one
    unfold C Cs nR nT i
    have h_padic_1 : padicValNat 2 ((1 + 1) / 2) = 0 := padic_one_is_zero
    have h_padic_2 : padicValNat 2 ((3 * 1 + 1) / 2) = 1 := padic_two_is_one
    rw [h_padic_1, h_padic_2]
    rfl

-----------------------------------
-- Main Theorem
-----------------------------------
-- 33. CollatzConjectureIsTrue
theorem CollatzConjectureIsTrue (n : Nat) (_h : n > 0) :
    ∃ steps : Nat, traj_len n = steps := by
  have h_sink_stable : C 1 = 1 := by
    have h_S1 : S 1 := by exact rfl
    exact (only1CanSelfLoop_rule 1 h_S1).mpr rfl
  use (traj_len n)
--#print axioms CollatzConjectureIsTrue

end CollatzProof -- "QED" :)