[Accuracy of Integer Division Approximate Function 2 解説](https://zenn.dev/mizar/articles/79ef8c9680265f) の形式的証明

Divapprox2.lean

import Mwf

namespace Divapprox

/--
目的: 整数除算近似の誤差関数 `Δ(D,A,B,x)` を定義する。
定義: `Δ = ⌊x/D⌋ - ⌊⌊x/A⌋ * ⌊AB/D⌋ / B⌋` を `Int` の除算で実装する。
入力/前提: D A B x : Int、_hD : 0 < D、_hA : 0 < A。
出力: 型 `Int` の値を返す。
役割: `K < Δ` の判定変形・存在条件・最小解探索の基準になる中心定義。
-/
private def Delta (D A B x : Int) (_hD : 0 < D) (_hA : 0 < A) (_hB : 0 < B) : Int :=
  (x / D) - (((x / A) * ((A * B) / D)) / B)

/--
目的: `M = ⌊AB/D⌋` を補助記号として定義する。
定義: `(A * B) / D` を名前付きで切り出す。
入力/前提: D A B : Int。
出力: 型 `Int` の値を返す。
役割: 判定式 `Bu - M⌊Du/A⌋` や canonical 形を簡潔に書くために使う。
-/
private def Mof (D A B : Int) : Int :=
  (A * B) / D

/--
目的: `R = (AB) mod D` を補助記号として定義する。
定義: `(A * B) % D` を名前付きで切り出す。
入力/前提: D A B : Int。
出力: 型 `Int` の値を返す。
役割: `R = 0` / `R ≠ 0` の存在判定と探索上界の分岐軸になる。
-/
private def Rof (D A B : Int) : Int :=
  (A * B) % D

section Criterion

variable {D A B K u M R : Int}

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `x = D*u` を代入した `Delta` を `u` 主体の形へ書き換える。
内容: `Δ(D,A,B,Du) = u - ((M * ((D*u)/A)) / B)`（`M = ⌊AB/D⌋`）を示す。
証明: 式変形で示す。
役割: 以降の不等式変形 `K < Δ` の出発点。
-/
private lemma Delta_Du_rewrite
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (_hu : 0 ≤ u)
    (hM : M = (A * B) / D) :
    Delta D A B (D * u) hD hA hB = u - ((M * ((D * u) / A)) / B) := by
  have hD0 : D ≠ 0 := ne_of_gt hD
  unfold Delta
  rw [Int.mul_ediv_cancel_left u hD0, hM]
  simp only [mul_comm]

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `K < Δ(D,A,B,Du)` と `B*K < B*u - M*((D*u)/A)` は同値。
内容: `Delta_Du_rewrite` で展開後、`q := M*((D*u)/A)` を置いて除算不等式を往復する。
証明: 式変形・既存補題の書き換えで示す。
役割: `Δ` の比較を `f(u)` 型の一次式判定へ落とす第一段。
-/
private lemma lt_Delta_iff_BK_lt
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hu : 0 ≤ u)
    (_hK : 0 ≤ K)
    (hM : M = (A * B) / D) :
    K < Delta D A B (D * u) hD hA hB ↔ B * K < B * u - M * ((D * u) / A) := by
  rw [Delta_Du_rewrite (D := D) (A := A) (B := B) (u := u) (M := M) hD hA hB hu hM]
  let q : Int := M * ((D * u) / A)
  constructor
  · intro h
    have hsum : K + q / B < u := (lt_sub_iff_add_lt).1 h
    have hqdiv : q / B < u - K := by
      exact (lt_sub_iff_add_lt).2 (by simpa only [add_comm] using hsum)
    have hqmul : q < (u - K) * B := (Int.ediv_lt_iff_lt_mul hB).1 hqdiv
    have hq' : q < B * u - B * K := by
      calc
        q < (u - K) * B := hqmul
        _ = B * u - B * K := by ring
    have hsum' : B * K + q < B * u := by
      have : q + B * K < B * u := (lt_sub_iff_add_lt).1 hq'
      simpa only [gt_iff_lt, add_comm] using this
    have : B * K < B * u - q := (lt_sub_iff_add_lt).2 hsum'
    simpa only [gt_iff_lt] using this
  · intro h
    have hsum : B * K + q < B * u := (lt_sub_iff_add_lt).1 h
    have hq' : q < B * u - B * K := by
      have : q + B * K < B * u := by
        simpa only [add_comm] using hsum
      exact (lt_sub_iff_add_lt).2 this
    have hqmul : q < (u - K) * B := by
      calc
        q < B * u - B * K := hq'
        _ = (u - K) * B := by ring
    have hqdiv : q / B < u - K := (Int.ediv_lt_iff_lt_mul hB).2 hqmul
    have hsum' : K + q / B < u := by
      have : q / B + K < u := (lt_sub_iff_add_lt).1 hqdiv
      simpa only [gt_iff_lt, add_comm] using this
    have : K < u - q / B := (lt_sub_iff_add_lt).2 hsum'
    simpa only [gt_iff_lt] using this

/--
入力/前提: hA : 0 < A、_hB : 0 < B、_hD : 0 < D。
主張: `B*K < B*u - M*((D*u)/A)` と `A*B*K < ((D*u)%A)*M + R*u` は同値。
内容: `AB = D*M + R` と `D*u = A*q + t`（`q=(D*u)/A`, `t=(D*u)%A`）を用いて代数変形する。
証明: 式変形・既存補題の書き換えで示す。
役割: 余りと `R*u` を明示した canonical 判定式への変換を担う。
-/
private lemma BK_lt_iff_ABK_lt
    (hA : 0 < A)
    (_hB : 0 < B)
    (_hD : 0 < D)
    (_hu : 0 ≤ u)
    (_hK : 0 ≤ K)
    (hM : M = (A * B) / D)
    (hR : R = (A * B) % D) :
    B * K < B * u - M * ((D * u) / A) ↔
      A * B * K < ((D * u) % A) * M + R * u := by
  let q : Int := (D * u) / A
  let t : Int := (D * u) % A
  have hAB' : D * M + R = A * B := by
    simpa only [hM, hR] using (Int.mul_ediv_add_emod (A * B) D)
  have hAB : A * B = D * M + R := hAB'.symm
  have hDu : A * q + t = D * u := by
    simpa only using (Int.mul_ediv_add_emod (D * u) A)
  have hDu_sub : D * u - A * q = t := by
    exact (sub_eq_iff_eq_add).2 (by simpa only [add_comm] using hDu.symm)
  have hRight : A * (B * u - M * q) = t * M + R * u := by
    calc
      A * (B * u - M * q) = A * B * u - A * M * q := by ring
      _ = (D * M + R) * u - A * M * q := by rw [hAB]
      _ = M * (D * u - A * q) + R * u := by ring
      _ = M * t + R * u := by rw [hDu_sub]
      _ = t * M + R * u := by ring
  constructor
  · intro h
    have hmul : A * (B * K) < A * (B * u - M * q) := (Int.mul_lt_mul_left hA).2 h
    calc
      A * B * K = A * (B * K) := by ring
      _ < A * (B * u - M * q) := hmul
      _ = t * M + R * u := hRight
      _ = ((D * u) % A) * M + R * u := by simp only [t]
  · intro h
    have hmul : A * (B * K) < A * (B * u - M * q) := by
      calc
        A * (B * K) = A * B * K := by ring
        _ < ((D * u) % A) * M + R * u := h
        _ = t * M + R * u := by simp only [t]
        _ = A * (B * u - M * q) := hRight.symm
    exact (Int.mul_lt_mul_left hA).1 hmul

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `K < Δ(D,A,B,Du)` と `A*B*K < ((D*u)%A)*M + R*u` の最終同値を与える。
内容: `lt_Delta_iff_BK_lt` と `BK_lt_iff_ABK_lt` を `Iff.trans` で連結する。
証明: 既存補題の適用と式変形で示す。
役割: 可解性証明・上界証明・探索判定の共通インターフェース。
-/
private theorem lt_Delta_iff_ABK_lt
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hu : 0 ≤ u)
    (hK : 0 ≤ K)
    (hM : M = (A * B) / D)
    (hR : R = (A * B) % D) :
    K < Delta D A B (D * u) hD hA hB ↔
      A * B * K < ((D * u) % A) * M + R * u := by
  refine
    (lt_Delta_iff_BK_lt
      (D := D) (A := A) (B := B) (K := K) (u := u) (M := M)
      hD hA hB hu hK hM).trans ?_
  exact
    BK_lt_iff_ABK_lt
      (D := D) (A := A) (B := B) (K := K) (u := u) (M := M) (R := R)
      hA hB hD hu hK hM hR

end Criterion

section NonIncAndSearch

variable {D A B K x : Int}

namespace Search

namespace Internal

/--
目的: `x` 側での最小解仕様を述語として定義する。
定義: `x0 ≥ 0`、`K < Δ(x0)`、および任意の可解 `y` に対する `x0 ≤ y` を束ねる。
入力/前提: D A B K : Int、hD : 0 < D、hA : 0 < A。
出力: 型 `Prop` の値を返す。
役割: 最小解が `D` の倍数であること（`dvd_of_IsLeastX`）を形式化する土台。
-/
private def IsLeastX
    (D A B K : Int)
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B)
    (x0 : Int) : Prop :=
  0 ≤ x0 ∧
  K < Delta D A B x0 hD hA hB ∧
  ∀ y : Int, 0 ≤ y → K < Delta D A B y hD hA hB → x0 ≤ y

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `D ∤ (x+1)` なら `Δ(D,A,B,x+1) ≤ Δ(D,A,B,x)`。
内容: 第1項 `⌊x/D⌋` の不変性と補正項の単調非減少性を組み合わせて示す。
証明: 式変形・既存補題の書き換えで示す。
役割: `Δ` が増える可能性が `D` の倍数境界に限られることを与える。
-/
private lemma Delta_noninc_of_not_dvd_succ
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (_hx : 0 ≤ x)
    (hndvd : ¬ D ∣ (x + 1)) :
    Delta D A B (x + 1) hD hA hB ≤ Delta D A B x hD hA hB := by
  let q : Int := x / D
  let r : Int := x % D
  have hD0 : D ≠ 0 := ne_of_gt hD
  have hMain : (x + 1) / D = x / D := by
    have hxdecomp : x = D * q + r := by
      simpa only using (Int.mul_ediv_add_emod x D).symm
    have hr0 : 0 ≤ r := Int.emod_nonneg _ hD0
    have hrlt : r < D := Int.emod_lt_of_pos _ hD
    have hr1le : r + 1 ≤ D := (Int.add_one_le_iff).2 hrlt
    have hr1ne : r + 1 ≠ D := by
      intro hr1eq
      apply hndvd
      refine ⟨q + 1, ?_⟩
      calc
        x + 1 = D * q + (r + 1) := by omega
        _ = D * q + D := by rw [hr1eq]
        _ = D * (q + 1) := by ring
    have hr1lt : r + 1 < D := lt_of_le_of_ne hr1le hr1ne
    have hr1nonneg : 0 ≤ r + 1 := by omega
    have hr1div0 : (r + 1) / D = 0 := Int.ediv_eq_zero_of_lt hr1nonneg hr1lt
    have hx1 : x + 1 = r + 1 + q * D := by
      calc
        x + 1 = (D * q + r) + 1 := by rw [hxdecomp]
        _ = r + 1 + q * D := by ring
    calc
      (x + 1) / D = (r + 1 + q * D) / D := by rw [hx1]
      _ = (r + 1) / D + q := Int.add_mul_ediv_right _ _ hD0
      _ = q := by simp only [hr1div0, zero_add]
      _ = x / D := by simp only [q]
  have hCorr :
      ((x / A) * ((A * B) / D)) / B ≤
        (((x + 1) / A) * ((A * B) / D)) / B := by
    have hMnonneg : 0 ≤ (A * B) / D := by
      exact Int.ediv_nonneg (le_of_lt (Int.mul_pos hA hB)) (le_of_lt hD)
    have hAdiv : x / A ≤ (x + 1) / A := Int.ediv_le_ediv hA (by omega)
    have hMul :
        (x / A) * ((A * B) / D) ≤
          ((x + 1) / A) * ((A * B) / D) := by
      exact mul_le_mul_of_nonneg_right hAdiv hMnonneg
    exact Int.ediv_le_ediv hB hMul
  have hSub :
      (x + 1) / D - ((((x + 1) / A) * ((A * B) / D)) / B) ≤
        x / D - (((x / A) * ((A * B) / D)) / B) := by
    calc
      (x + 1) / D - ((((x + 1) / A) * ((A * B) / D)) / B)
          = x / D - ((((x + 1) / A) * ((A * B) / D)) / B) := by rw [hMain]
      _ ≤ x / D - (((x / A) * ((A * B) / D)) / B) := sub_le_sub_left hCorr (x / D)
  simpa only [Delta, tsub_le_iff_right, ge_iff_le] using hSub

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `K < Δ(D,A,B,x)` を満たす最小の `x` は `D` の倍数。
内容: `D ∤ x0` を仮定して `x0-1` に `Delta_noninc_of_not_dvd_succ` を適用し最小性と矛盾させる。
証明: 反証法・既存補題の書き換えで示す。
役割: 探索変数を `x` から `u`（`x = D*u`）へ落とす正当化。
-/
private lemma dvd_of_IsLeastX
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    {x0 : Int}
    (hmin : IsLeastX D A B K hD hA hB x0) :
    D ∣ x0 := by
  rcases hmin with ⟨hx0, hKx0, hleast⟩
  by_contra hndvd
  have hx0ne0 : x0 ≠ 0 := by
    intro hx0eq
    apply hndvd
    exact hx0eq ▸ dvd_zero D
  have hx0pos : 0 < x0 := lt_of_le_of_ne hx0 hx0ne0.symm
  have hx0m1 : 0 ≤ x0 - 1 := by omega
  have hnoninc :
      Delta D A B ((x0 - 1) + 1) hD hA hB ≤
        Delta D A B (x0 - 1) hD hA hB := by
    exact Delta_noninc_of_not_dvd_succ
      (D := D) (A := A) (B := B) (x := x0 - 1)
      hD hA hB hx0m1 (by simpa only [sub_add_cancel] using hndvd)
  have hKx0m1 : K < Delta D A B (x0 - 1) hD hA hB := by
    have hKx0' : K < Delta D A B ((x0 - 1) + 1) hD hA hB := by
      simpa only [sub_add_cancel] using hKx0
    exact lt_of_lt_of_le hKx0' hnoninc
  have hle : x0 ≤ x0 - 1 := hleast (x0 - 1) hx0m1 hKx0m1
  omega

/--
目的: `x` 側の可解性述語を定義する。
定義: `0 ≤ x` かつ `K < Delta D A B x` を満たすことを `SolX` とする。
入力/前提: D A B K : Int、hD : 0 < D、hA : 0 < A。
出力: 型 `Prop` の値を返す。
役割: 最小解存在条件・二分探索仕様の共通前提。
-/
private def SolX
    (D A B K : Int)
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B)
    (x : Int) : Prop :=
  0 ≤ x ∧ K < Delta D A B x hD hA hB

/--
目的: `u` 側の可解性述語を定義する。
定義: `0 ≤ u` かつ `K < Delta D A B (D*u)` を満たすことを `SolU` とする。
入力/前提: D A B K : Int、hD : 0 < D、hA : 0 < A。
出力: 型 `Prop` の値を返す。
役割: `uMinOf`・存在条件・二分探索仕様の共通前提。
-/
private def SolU
    (D A B K : Int)
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B)
    (u : Int) : Prop :=
  0 ≤ u ∧ K < Delta D A B (D * u) hD hA hB

end Internal

end Search

/--
目的: 可解集合から `x` 側の最小解を定義する。
定義: `hex : ∃ x, SolX ... x` の下で `{x | SolX ... x}` の `sInf` を返す。
入力/前提: D A B K : Int、hD : 0 < D、hA : 0 < A、hB : 0 < B、`hex : ∃ x, SolX ... x`。
出力: 型 `Int` の値を返す。
役割: `xMin` と実装正当化定理が一致させる `x` 側の数学的ターゲット。
-/
noncomputable def xMinOf
    (D A B K : Int)
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B)
    (_hex : ∃ x : Int, Search.Internal.SolX D A B K hD hA hB x) : Int :=
  by
    classical
    exact sInf {x : Int | Search.Internal.SolX D A B K hD hA hB x}

/--
目的: 可解集合から `u` 側の最小解を定義する。
定義: `hex : ∃ u, SolU ... u` の下で `{u | SolU ... u}` の `sInf` を返す。
入力/前提: D A B K : Int、hD : 0 < D、hA : 0 < A、hB : 0 < B、`hex : ∃ u, SolU ... u`。
出力: 型 `Int` の値を返す。
役割: `uMin`・探索境界補題・実装正当化定理で参照する `u` 側の数学的ターゲット。
-/
noncomputable def uMinOf
    (D A B K : Int)
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B)
    (_hex : ∃ u : Int, Search.Internal.SolU D A B K hD hA hB u) : Int :=
  by
    classical
    exact sInf {u : Int | Search.Internal.SolU D A B K hD hA hB u}

/--
目的: 問題で求める最小入力 `xMin` の仕様値を定義する。
定義: `∃ x, SolX ... x` が成り立てば `xMinOf`、成り立たなければ `-1` を返す。
入力/前提: D A B K : Int、hD : 0 < D、hA : 0 < A、hB : 0 < B。
出力: 型 `Int` の値を返す。
役割: 実装 `compute_xMin` が一致すべき最終仕様値を与える。
-/
noncomputable def xMin
    (D A B K : Int)
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) : Int :=
  by
    classical
    exact
      if hex : ∃ x : Int, Search.Internal.SolX D A B K hD hA hB x then
        xMinOf D A B K hD hA hB hex
      else
        -1

/--
目的: `u` 側の最小解出力 `uMin` を定義する。
定義: `∃ u, SolU ... u` が成り立てば `uMinOf`、成り立たなければ `-1` を返す。
入力/前提: D A B K : Int、hD : 0 < D、hA : 0 < A、hB : 0 < B。
出力: 型 `Int` の値を返す。
役割: `xMin` との対応付けや探索境界証明で使う `u` 側仕様値を与える。
-/
noncomputable def uMin
    (D A B K : Int)
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) : Int :=
  by
    classical
    exact
      if hex : ∃ u : Int, Search.Internal.SolU D A B K hD hA hB u then
        uMinOf D A B K hD hA hB hex
      else
        -1

namespace Correctness

namespace Internal

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `u` 側に解があるとき `xMin = D * uMinOf`。
内容: `hex` から `SolX` の解を構成し、`xMinOf` を最小解 `x0` とおく。
  `dvd_of_IsLeastX` で `x0 = D*u0` を得て `u0` が `SolU` を満たすことを示し、
  `uMinOf` の最小性と `x0` の最小性を突き合わせて `u0 = uMinOf` を導く。
証明: `csInf_mem`/`csInf_le` による最小元の性質、`dvd_of_IsLeastX`、および
  `Int.mul_le_mul_left`（`D>0`）を用いて示す。
役割: `u` 側最小解を最終出力 `x` 側へ戻す橋渡し。
-/
private lemma xMin_eq_D_mul_uMinOf
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hex : ∃ u : Int, Search.Internal.SolU D A B K hD hA hB u) :
    xMin D A B K hD hA hB =
      D * uMinOf D A B K hD hA hB hex := by
  classical
  have hexX : ∃ x : Int, Search.Internal.SolX D A B K hD hA hB x := by
    rcases hex with ⟨u, hu⟩
    exact ⟨D * u, ⟨mul_nonneg (le_of_lt hD) hu.1, hu.2⟩⟩
  have hBddX : BddBelow ({x : Int | Search.Internal.SolX D A B K hD hA hB x} : Set Int) := by
    refine ⟨0, ?_⟩
    intro z hz
    exact hz.1
  have hBddU : BddBelow ({u : Int | Search.Internal.SolU D A B K hD hA hB u} : Set Int) := by
    refine ⟨0, ?_⟩
    intro z hz
    exact hz.1
  let x0 : Int := xMinOf D A B K hD hA hB hexX
  have hx0sol : Search.Internal.SolX D A B K hD hA hB x0 := by
    dsimp only [x0]
    unfold xMinOf
    exact Int.csInf_mem (by simpa only using hexX) hBddX
  have hx0least : Search.Internal.IsLeastX D A B K hD hA hB x0 := by
    refine ⟨hx0sol.1, hx0sol.2, ?_⟩
    intro y hy0 hyDelta
    dsimp only [x0]
    unfold xMinOf
    exact csInf_le hBddX ⟨hy0, hyDelta⟩
  have hxdvd : D ∣ x0 := by
    exact Search.Internal.dvd_of_IsLeastX (D := D) (A := A) (B := B) (K := K) hD hA hB hx0least
  let u0 : Int := x0 / D
  have hx0eq : x0 = D * u0 := by
    calc
      x0 = (x0 / D) * D := by
        simpa only using (Int.ediv_mul_cancel hxdvd).symm
      _ = D * u0 := by
        simp only [mul_comm, u0]
  have hu0sol : Search.Internal.SolU D A B K hD hA hB u0 := by
    refine ⟨?_, ?_⟩
    · exact Int.ediv_nonneg hx0sol.1 (le_of_lt hD)
    · simpa only [hx0eq] using hx0sol.2
  have huMinSol : Search.Internal.SolU D A B K hD hA hB (uMinOf D A B K hD hA hB hex) := by
    unfold uMinOf
    exact Int.csInf_mem hex hBddU
  have huMin_le_u0 : uMinOf D A B K hD hA hB hex ≤ u0 := by
    unfold uMinOf
    exact csInf_le hBddU hu0sol
  have hxOfUmin : Search.Internal.SolX D A B K hD hA hB (D * uMinOf D A B K hD hA hB hex) := by
    exact ⟨mul_nonneg (le_of_lt hD) huMinSol.1, huMinSol.2⟩
  rcases hx0least with ⟨_hx0nonneg, _hx0Delta, hx0min⟩
  have hx0_le_DuMin : x0 ≤ D * uMinOf D A B K hD hA hB hex := by
    exact hx0min (D * uMinOf D A B K hD hA hB hex) hxOfUmin.1 hxOfUmin.2
  have hu0_le_uMin : u0 ≤ uMinOf D A B K hD hA hB hex := by
    have hmul : D * u0 ≤ D * uMinOf D A B K hD hA hB hex := by
      simpa only [hx0eq] using hx0_le_DuMin
    exact (Int.mul_le_mul_left hD).1 hmul
  have huEq : u0 = uMinOf D A B K hD hA hB hex := le_antisymm hu0_le_uMin huMin_le_u0
  unfold xMin
  simp only [hexX]
  calc
    xMinOf D A B K hD hA hB hexX = x0 := by rfl
    _ = D * u0 := hx0eq
    _ = D * uMinOf D A B K hD hA hB hex := by rw [huEq]

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `u` 側に解が存在しないとき `xMin = -1`。
内容: 反証法で `∃ x, SolX ... x` を仮定し、`xMinOf` の最小元 `x0` を取る。
  `dvd_of_IsLeastX` から `x0 = D*u0` を得ると `u0` は `SolU` となり `hno` に矛盾する。
  よって `¬ ∃ x, SolX ... x` が従い、`xMin` の定義を `else` 側に簡約する。
証明: `csInf_mem`/`csInf_le` と `dvd_of_IsLeastX` による矛盾導出で示す。
役割: 非可解ケースの返り値仕様を確定する。
-/
private lemma xMin_eq_neg_one_of_no_solution
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hno : ¬ ∃ u : Int, Search.Internal.SolU D A B K hD hA hB u) :
    xMin D A B K hD hA hB = -1 := by
  classical
  have hnoX : ¬ ∃ x : Int, Search.Internal.SolX D A B K hD hA hB x := by
    intro hexX
    have hBddX : BddBelow ({x : Int | Search.Internal.SolX D A B K hD hA hB x} : Set Int) := by
      refine ⟨0, ?_⟩
      intro z hz
      exact hz.1
    let x0 : Int := xMinOf D A B K hD hA hB hexX
    have hx0sol : Search.Internal.SolX D A B K hD hA hB x0 := by
      dsimp only [x0]
      unfold xMinOf
      exact Int.csInf_mem (by simpa only using hexX) hBddX
    have hx0least : Search.Internal.IsLeastX D A B K hD hA hB x0 := by
      refine ⟨hx0sol.1, hx0sol.2, ?_⟩
      intro y hy0 hyDelta
      dsimp only [x0]
      unfold xMinOf
      exact csInf_le hBddX ⟨hy0, hyDelta⟩
    have hxdvd : D ∣ x0 := by
      exact Search.Internal.dvd_of_IsLeastX (D := D) (A := A) (B := B) (K := K) hD hA hB hx0least
    let u0 : Int := x0 / D
    have hx0eq : x0 = D * u0 := by
      calc
        x0 = (x0 / D) * D := by
          simpa only using (Int.ediv_mul_cancel hxdvd).symm
        _ = D * u0 := by
          simp only [mul_comm, u0]
    have hu0sol : Search.Internal.SolU D A B K hD hA hB u0 := by
      refine ⟨?_, ?_⟩
      · exact Int.ediv_nonneg hx0sol.1 (le_of_lt hD)
      · simpa only [hx0eq] using hx0sol.2
    exact hno ⟨u0, hu0sol⟩
  unfold xMin
  simp only [hnoX, ↓reduceDIte, Int.reduceNeg]

end Internal

end Correctness

end NonIncAndSearch

section ExistAndBounds

variable {D A B K u : Int}

/--
目的: `g = gcd(D,A)` を `Int` 上で扱う補助定義。
定義: `Int.gcd D A` の短い別名を与える。
入力/前提: D A : Int。
出力: 型 `Int` の値を返す。
役割: `R = 0` ケースの条件 `D*K + g < A` と上界 `A/g` で反復利用する。
-/
private def gcdDA (D A : Int) : Int :=
  Int.gcd D A

/--
目的: `u` 側に解が存在する命題を定義する。
定義: `∃ u : Int, SolU D A B K hD hA hB u` を略記する。
入力/前提: D A B K : Int、hD : 0 < D、hA : 0 < A。
出力: 型 `Prop` の値を返す。
役割: 存在定理・上界定理・二分探索正当化の共通仮定を簡潔にする。
-/
private def HasUSolution
    (D A B K : Int)
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) : Prop :=
  ∃ u : Int, Search.Internal.SolU D A B K hD hA hB u

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: canonical 形 `A*B*K < ((D*u)%A)*Mof + Rof*u` と `K < Δ` は同値。
内容: `lt_Delta_iff_ABK_lt` に `M := Mof`, `R := Rof` を代入して整形する。
証明: 既存補題の書き換えで示す。
役割: 後続の存在証明・上界証明で `M`,`R` を明示せず使える形を与える。
-/
private lemma lt_Delta_iff_ABK_lt_canonical
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hu : 0 ≤ u)
    (hK : 0 ≤ K) :
    K < Delta D A B (D * u) hD hA hB ↔
      A * B * K < ((D * u) % A) * (Mof D A B) + (Rof D A B) * u := by
  simpa only [Mof, Rof] using
    (lt_Delta_iff_ABK_lt (D := D) (A := A) (B := B) (K := K) (u := u) (M := Mof D A B) (R :=
      Rof D A B) hD hA hB hu hK rfl rfl)

namespace Bounds

namespace Internal

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hu0 : 0 ≤ u`, `hK : 0 ≤ K`。
主張: 標準形 `A*B*K < ((D*u)%A)*Mof + Rof*u` が成り立てば `u` は `SolU` である。
内容: `lt_Delta_iff_ABK_lt_canonical` の逆向きから `K < Delta(D*u)` を回収する。
証明: `hu0` を `SolU` の第1成分に使い、第2成分は既存同値補題で与える。
役割: `ExistAndBounds` 節で繰り返す `SolU` 構成の末尾を共通化する。
-/
private lemma solU_of_lt_canonical
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    {K u : Int}
    (hu0 : 0 ≤ u)
    (hK : 0 ≤ K)
    (hABK_lt_rhs :
      A * B * K < ((D * u) % A) * Mof D A B + Rof D A B * u) :
    Search.Internal.SolU D A B K hD hA hB u := by
  exact
    ⟨hu0,
      (lt_Delta_iff_ABK_lt_canonical
        (D := D) (A := A) (B := B) (K := K) (u := u)
        hD hA hB hu0 hK).2 hABK_lt_rhs⟩

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`。
主張: `Mof D A B` は非負である。
内容: `Mof = (A*B)/D` に展開し、正数どうしの除算の非負性を使う。
証明: `Int.ediv_nonneg` を適用する。
役割: `ExistAndBounds` 節で現れる非負項評価を短くする。
-/
private lemma Mof_nonneg
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B) :
    0 ≤ Mof D A B := by
  unfold Mof
  exact Int.ediv_nonneg (le_of_lt (Int.mul_pos hA hB)) (le_of_lt hD)

/--
入力/前提: hA : 0 < A、_hu : 0 ≤ u。
主張: `0 ≤ (D*u)%A ≤ A - gcd(D,A)`。
内容: 余りの範囲 `0 ≤ r < A` と `gcd(D,A)` が `r` を割る事実から上界 `r ≤ A-g` を導く。
証明: 式変形・既存補題の書き換えで示す。
役割: `R = 0` での必要条件導出と上界評価の鍵となる剰余評価。
-/
private lemma Du_mod_A_bounds_with_gcd
    (hA : 0 < A)
    (_hu : 0 ≤ u) :
    0 ≤ (D * u) % A ∧ (D * u) % A ≤ A - gcdDA D A := by
  let g : Int := gcdDA D A
  let r : Int := (D * u) % A
  have hA0 : A ≠ 0 := ne_of_gt hA
  have hr0 : 0 ≤ r := by
    simpa only using Int.emod_nonneg (D * u) hA0
  have hrlt : r < A := by
    simpa only using Int.emod_lt_of_pos (D * u) hA
  have hgD : g ∣ D := by
    simpa only [gcdDA] using (Int.gcd_dvd_left D A)
  have hgA : g ∣ A := by
    simpa only [gcdDA] using (Int.gcd_dvd_right D A)
  have hgDu : g ∣ D * u := dvd_mul_of_dvd_left hgD u
  have hgAq : g ∣ A * ((D * u) / A) := dvd_mul_of_dvd_left hgA ((D * u) / A)
  have hrEq : r = D * u - A * ((D * u) / A) := by
    have hdecomp : A * ((D * u) / A) + r = D * u := by
      simpa only using (Int.mul_ediv_add_emod (D * u) A)
    omega
  have hgr : g ∣ r := by
    rw [hrEq]
    exact dvd_sub hgDu hgAq
  have hdiffPos : 0 < A - r := by
    exact sub_pos.mpr hrlt
  have hgDiff : g ∣ A - r := dvd_sub hgA hgr
  have hgLe : g ≤ A - r := Int.le_of_dvd hdiffPos hgDiff
  have hrLe : r ≤ A - g := by
    omega
  exact ⟨by simpa only [r] using hr0, by simpa only [gcdDA, r, g] using hrLe⟩

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `Rof D A B ≠ 0` なら `u < (A*B*K)/R + 2` を満たす可解 `u` が存在する。
内容: 候補 `u0 = (A*B*K)/R + 1` を取り、`R*u0 > A*B*K` と非負項で canonical 不等式を示す。
証明: 除算不等式と `solU_of_lt_canonical` を連結する。
役割: `R ≠ 0` ケースの存在性と上界証明で共有する witness を与える。
-/
private lemma exists_solU_lt_floor_ABK_div_R_plus_two_of_R_ne_zero
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hK : 0 ≤ K)
    (hRnz : Rof D A B ≠ 0) :
    ∃ u : Int, Search.Internal.SolU D A B K hD hA hB u ∧
      u < (A * B * K) / (Rof D A B) + 2 := by
  let u0 : Int := (A * B * K) / (Rof D A B) + 1
  have hABpos : 0 < A * B := Int.mul_pos hA hB
  have hABK0 : 0 ≤ A * B * K := mul_nonneg (le_of_lt hABpos) hK
  have hR0 : 0 ≤ Rof D A B := by
    simpa only [Rof] using Int.emod_nonneg (A * B) (ne_of_gt hD)
  have hRpos : 0 < Rof D A B := lt_of_le_of_ne hR0 (by symm; exact hRnz)
  have hu0 : 0 ≤ u0 := by
    have hdiv0 : 0 ≤ (A * B * K) / (Rof D A B) := Int.ediv_nonneg hABK0 hR0
    dsimp only [u0]
    omega
  have hM0 : 0 ≤ Mof D A B :=
    Mof_nonneg (D := D) (A := A) (B := B) hD hA hB
  have hterm0 : 0 ≤ ((D * u0) % A) * Mof D A B := by
    refine mul_nonneg ?_ hM0
    exact Int.emod_nonneg (D * u0) (ne_of_gt hA)
  have hABK_lt_Ru0 : A * B * K < Rof D A B * u0 := by
    have hlt :
        A * B * K < ((A * B * K) / (Rof D A B) + 1) * Rof D A B := by
      exact
        (Int.ediv_lt_iff_lt_mul hRpos).1
          (lt_add_one ((A * B * K) / (Rof D A B)))
    simpa only [u0, mul_comm, mul_left_comm, gt_iff_lt] using hlt
  have hABK_lt_rhs :
      A * B * K < ((D * u0) % A) * Mof D A B + Rof D A B * u0 := by
    exact lt_of_lt_of_le hABK_lt_Ru0 (le_add_of_nonneg_left hterm0)
  have huSol : Search.Internal.SolU D A B K hD hA hB u0 :=
    solU_of_lt_canonical
      (D := D) (A := A) (B := B)
      hD hA hB hu0 hK hABK_lt_rhs
  have hu0_lt : u0 < (A * B * K) / (Rof D A B) + 2 := by
    dsimp only [u0]
    omega
  exact ⟨u0, huSol, hu0_lt⟩

/--
入力/前提: `hR0 : Rof D A B = 0`。
主張: `D * Mof D A B = A * B`。
内容: 商剰余分解で余り項を消し、`Mof = (A*B)/D` を元の積へ戻す。
証明: `Int.mul_ediv_add_emod` を `hR0` で簡約する。
役割: `R = 0` 枝で `Mof` を含む積の式変形を共通化する。
-/
private lemma DMof_eq_AB_of_R_eq_zero
    (hR0 : Rof D A B = 0) :
    D * Mof D A B = A * B := by
  have hdvd : D ∣ A * B := by
    exact (Int.dvd_iff_emod_eq_zero).2 (by simpa only [Rof] using hR0)
  simpa only [Mof, mul_comm] using (Int.ediv_mul_cancel hdvd)

/--
入力/前提: hD : `0 < D`、hA : `0 < A`、hB : `0 < B`、hR0 : `Rof D A B = 0`。
主張: `Mof D A B` は正である。
内容: `D * Mof = A * B` と `A * B > 0` から `Mof > 0` を得る。
証明: 積の正値を `Int.pos_of_mul_pos_left` に渡す。
役割: `R = 0` 枝の可解候補構成と上界評価で再利用する。
-/
private lemma Mof_pos_of_R_eq_zero
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hR0 : Rof D A B = 0) :
    0 < Mof D A B := by
  have hABpos : 0 < A * B := Int.mul_pos hA hB
  have hprod : 0 < D * Mof D A B := by
    simpa only [DMof_eq_AB_of_R_eq_zero (D := D) (A := A) (B := B) hR0] using hABpos
  have hprod' : 0 < Mof D A B * D := by
    simpa only [mul_comm] using hprod
  exact Int.pos_of_mul_pos_left hprod' hD

/--
入力/前提: `hA : 0 < A`、`hglt : gcdDA D A < A`。
主張: `0 < D % A`。
内容: `gcd(D,A) < A` なら `A ∤ D` であり、剰余は 0 ではなく非負なので正である。
証明: `Int.gcd_eq_right` と `Int.dvd_iff_emod_eq_zero` を使う。
役割: `one_sol_of_R_eq_zero_of_K_zero` の局所算術を切り出す。
-/
private lemma Dmod_pos_of_gcd_lt_A
    (hA : 0 < A)
    (hglt : gcdDA D A < A) :
    0 < D % A := by
  have hDmod0 : 0 ≤ D % A := Int.emod_nonneg _ (ne_of_gt hA)
  have hDmodNe : D % A ≠ 0 := by
    intro hmod
    have hgEq : gcdDA D A = A := by
      simpa only [gcdDA] using
        (Int.gcd_eq_right (le_of_lt hA) ((Int.dvd_iff_emod_eq_zero).2 hmod))
    omega
  exact lt_of_le_of_ne hDmod0 hDmodNe.symm

/--
入力/前提: hD : `0 < D`、hA : `0 < A`、hB : `0 < B`、hK : `0 ≤ K`、
`hR0 : Rof D A B = 0`、`hK0 : K = 0`、`hcond : D*K + gcd(D,A) < A`。
主張: `u = 1` は `SolU` の具体例である。
内容: `gcd(D,A) < A` から `A ∤ D`、したがって `D % A > 0` を得て、
`K = 0` のとき `Δ` の右辺が正であることを示す。
証明: `Mof > 0` と `D % A > 0` から右辺正値を作り canonical 判定へ戻す。
役割: `uMin_lt_ABK_plus_two` の `R = 0, K = 0` 枝を短くする。
-/
private lemma one_sol_of_R_eq_zero_of_K_zero
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hK : 0 ≤ K)
    (hR0 : Rof D A B = 0)
    (hK0 : K = 0)
    (hcond : D * K + gcdDA D A < A) :
    Search.Internal.SolU D A B K hD hA hB 1 := by
  have hglt : gcdDA D A < A := by
    simpa only [hK0, mul_zero, zero_add] using hcond
  have hDmodPos : 0 < D % A := Dmod_pos_of_gcd_lt_A (D := D) (A := A) hA hglt
  have hMpos : 0 < Mof D A B :=
    Mof_pos_of_R_eq_zero (D := D) (A := A) (B := B) hD hA hB hR0
  have hABK_lt_rhs :
      A * B * K <
        ((D * (1 : Int)) % A) * Mof D A B + Rof D A B * (1 : Int) := by
    simpa only [hK0, hR0, mul_zero, mul_one, add_zero] using
      (show 0 < (D % A) * Mof D A B from Int.mul_pos hDmodPos hMpos)
  exact
    solU_of_lt_canonical
      (D := D) (A := A) (B := B)
      hD hA hB (by decide) hK hABK_lt_rhs

/--
入力/前提: `hA : 0 < A`。
主張: `0 ≤ u < A / gcd(D,A)` かつ `(D*u) % A = A - gcd(D,A)` を満たす `u` が存在する。
内容: `D = g*D1`, `A = g*A1` に既約化し、Bézout 係数から `D1*u ≡ -1 mod A1` を作る。
証明: `u := (-gcdA D1 A1) % A1` を取り、合同式と剰余計算で示す。
役割: `R = 0` ケースの具体的 witness 構成を共通化する。
-/
private lemma exists_u_lt_A_div_g_with_Du_mod_eq_A_sub_g
    (hA : 0 < A) :
    ∃ u : Int,
      0 ≤ u ∧
      u < A / gcdDA D A ∧
      (D * u) % A = A - gcdDA D A := by
  let g : Int := gcdDA D A
  let D1 : Int := D / g
  let A1 : Int := A / g
  have hg0 : 0 < g := by
    have : 0 < Int.gcd D A := Int.gcd_pos_of_ne_zero_right D (ne_of_gt hA)
    simpa only [g, gcdDA, Int.natCast_pos, Int.gcd_pos_iff, ne_eq] using this
  have hgD : g ∣ D := by
    simpa only [gcdDA] using (Int.gcd_dvd_left D A)
  have hgA : g ∣ A := by
    simpa only [gcdDA] using (Int.gcd_dvd_right D A)
  have hDsplit : D = g * D1 := by
    have h : D / g * g = D := Int.ediv_mul_cancel hgD
    have h' : g * D1 = D := by simpa only [mul_comm] using h
    exact h'.symm
  have hAsplit : A = g * A1 := by
    have h : A / g * g = A := Int.ediv_mul_cancel hgA
    have h' : g * A1 = A := by simpa only [mul_comm] using h
    exact h'.symm
  have hA1pos : 0 < A1 := by
    have hprod : 0 < A1 * g := by
      calc
        0 < A := hA
        _ = g * A1 := hAsplit
        _ = A1 * g := by ring
    exact Int.pos_of_mul_pos_left hprod hg0
  have hgNatPos : 0 < Int.gcd D A := Int.gcd_pos_of_ne_zero_right D (ne_of_gt hA)
  have hcop : Int.gcd D1 A1 = 1 := by
    simpa only [gcdDA] using (Int.gcd_div_gcd_div_gcd (i := D) (j := A) hgNatPos)
  have hbez : (1 : Int) = D1 * Int.gcdA D1 A1 + A1 * Int.gcdB D1 A1 := by
    simpa only [hcop, Nat.cast_one] using (Int.gcd_eq_gcd_ab D1 A1)
  let u : Int := (-Int.gcdA D1 A1) % A1
  have hu0 : 0 ≤ u := by
    dsimp only [u]
    exact Int.emod_nonneg _ (ne_of_gt hA1pos)
  have huLtA1 : u < A1 := by
    dsimp only [u]
    exact Int.emod_lt_of_pos _ hA1pos
  have hmodU : u ≡ -Int.gcdA D1 A1 [ZMOD A1] := by
    dsimp only [u]
    simpa only using (Int.mod_modEq (-Int.gcdA D1 A1) A1)
  have hmodMul : D1 * u ≡ D1 * (-Int.gcdA D1 A1) [ZMOD A1] :=
    Int.ModEq.mul_left D1 hmodU
  have hmodNeg1 : D1 * (-Int.gcdA D1 A1) ≡ (-1) [ZMOD A1] := by
    have hbezNeg :
        (-1 : Int) = D1 * (-Int.gcdA D1 A1) + A1 * (-Int.gcdB D1 A1) := by
      have hneg := congrArg (fun t : Int => -t) hbez
      calc
        (-1 : Int) = -(D1 * Int.gcdA D1 A1 + A1 * Int.gcdB D1 A1) := by
          simpa only [Int.reduceNeg, neg_add_rev] using hneg
        _ = D1 * (-Int.gcdA D1 A1) + A1 * (-Int.gcdB D1 A1) := by
          ring
    refine (Int.modEq_iff_dvd).2 ?_
    refine ⟨-Int.gcdB D1 A1, ?_⟩
    omega
  have hmodFinal : D1 * u ≡ (-1) [ZMOD A1] := hmodMul.trans hmodNeg1
  have hremA1 : (D1 * u) % A1 = (-1) % A1 := hmodFinal.eq
  have hneg1 : (-1) % A1 = A1 - 1 := by
    simpa only [Int.reduceNeg, Int.reduceNegSucc, CharP.cast_eq_zero, Int.zero_emod,
      sub_zero] using (Int.negSucc_emod 0 hA1pos)
  have hrem : (D * u) % A = A - g := by
    calc
      (D * u) % A = (g * (D1 * u)) % (g * A1) := by
        rw [hDsplit, hAsplit]
        ring_nf
      _ = g * ((D1 * u) % A1) := by
        exact Int.mul_emod_mul_of_pos (a := g) (b := D1 * u) (c := A1) hg0
      _ = g * (A1 - 1) := by rw [hremA1, hneg1]
      _ = A - g := by
        calc
          g * (A1 - 1) = g * A1 - g := by ring
          _ = A - g := by rw [hAsplit]
  refine ⟨u, hu0, ?_, ?_⟩
  · simpa only [g, A1]
  · simpa only [g] using hrem

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `R = 0` かつ `D*K + gcd(D,A) < A` なら `u < A/g` の可解 `u` が存在する。
内容: `D=gD1`, `A=gA1` に分解し Bézout 由来の `u` を構成して `(D*u)%A = A-g` を実現する。
証明: 式変形・既存補題の書き換えで示す。
役割: `R = 0` ケースの十分条件と具体的候補を与える中心補題。
-/
private lemma exists_solU_lt_A_div_g_of_R_eq_zero
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hK : 0 ≤ K)
    (hR0 : Rof D A B = 0)
    (hcond : D * K + gcdDA D A < A) :
    ∃ u : Int, Search.Internal.SolU D A B K hD hA hB u ∧ u < A / gcdDA D A := by
  rcases exists_u_lt_A_div_g_with_Du_mod_eq_A_sub_g (D := D) (A := A) hA with
    ⟨u, hu0, huLt, hrem⟩
  let g : Int := gcdDA D A
  have hABeqDM : A * B = D * Mof D A B := by
    simpa only using
      (DMof_eq_AB_of_R_eq_zero (D := D) (A := A) (B := B) hR0).symm
  have hMpos : 0 < Mof D A B :=
    Mof_pos_of_R_eq_zero (D := D) (A := A) (B := B) hD hA hB hR0
  have hDK_lt_Ag : D * K < A - g := by
    omega
  have hABK_lt_bound : A * B * K < (A - g) * Mof D A B := by
    have hmul : (D * K) * Mof D A B < (A - g) * Mof D A B :=
      (Int.mul_lt_mul_right hMpos).2 hDK_lt_Ag
    calc
      A * B * K = (D * K) * Mof D A B := by
        rw [hABeqDM]
        ring
      _ < (A - g) * Mof D A B := hmul
  have hABK_lt_rhs :
      A * B * K < ((D * u) % A) * Mof D A B + Rof D A B * u := by
    calc
      A * B * K < (A - g) * Mof D A B := hABK_lt_bound
      _ = ((D * u) % A) * Mof D A B := by rw [hrem]
      _ = ((D * u) % A) * Mof D A B + Rof D A B * u := by
        simp only [hR0, zero_mul, add_zero]
  have huSol : Search.Internal.SolU D A B K hD hA hB u :=
    solU_of_lt_canonical
      (D := D) (A := A) (B := B)
      hD hA hB hu0 hK hABK_lt_rhs
  exact ⟨u, huSol, huLt⟩

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`,
`hR0 : Rof D A B = 0`, `huSol : SolU ... u`。
主張: 必要条件 `D*K + gcd(D,A) < A` が成り立つ。
内容: canonical 不等式と `((D*u)%A) ≤ A-g` を連結して右辺を `(A-g)*Mof` で押さえる。
証明: `lt_Delta_iff_ABK_lt_canonical` と `Du_mod_A_bounds_with_gcd` を使う。
役割: `R = 0` の存在条件の順方向を短い補題に分離する。
-/
private lemma DK_add_g_lt_A_of_solU_of_R_eq_zero
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hK : 0 ≤ K)
    (hR0 : Rof D A B = 0)
    {u : Int}
    (huSol : Search.Internal.SolU D A B K hD hA hB u) :
    D * K + gcdDA D A < A := by
  let g : Int := gcdDA D A
  have hABeqDM : A * B = D * Mof D A B := by
    simpa only using
      (DMof_eq_AB_of_R_eq_zero (D := D) (A := A) (B := B) hR0).symm
  have hMpos : 0 < Mof D A B :=
    Mof_pos_of_R_eq_zero (D := D) (A := A) (B := B) hD hA hB hR0
  rcases huSol with ⟨hu0, huDelta⟩
  have hABK_lt_rhs :
      A * B * K < ((D * u) % A) * Mof D A B + Rof D A B * u := by
    exact
      (lt_Delta_iff_ABK_lt_canonical
        (D := D) (A := A) (B := B) (K := K) (u := u)
        hD hA hB hu0 hK).1 huDelta
  have hABK_lt_remM : A * B * K < ((D * u) % A) * Mof D A B := by
    simpa only [hR0, zero_mul, add_zero] using hABK_lt_rhs
  have hrem_le : (D * u) % A ≤ A - g :=
    (Du_mod_A_bounds_with_gcd (D := D) (A := A) (u := u) hA hu0).2
  have hremM_le : ((D * u) % A) * Mof D A B ≤ (A - g) * Mof D A B :=
    mul_le_mul_of_nonneg_right hrem_le (le_of_lt hMpos)
  have hmul : (D * K) * Mof D A B < (A - g) * Mof D A B := by
    calc
      (D * K) * Mof D A B = A * B * K := by
        rw [hABeqDM]
        ring
      _ < ((D * u) % A) * Mof D A B := hABK_lt_remM
      _ ≤ (A - g) * Mof D A B := hremM_le
  have hDK_lt_Ag : D * K < A - g := (Int.mul_lt_mul_right hMpos).1 hmul
  have : D * K + g < A := by
    omega
  simpa only [gcdDA, g] using this

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `R = 0` のとき `HasUSolution ↔ D*K + gcd(D,A) < A`。
内容: `→` は `Du_mod_A_bounds_with_gcd` で必要条件を示し、`←` は具体解構成補題を使う。
証明: 式変形・既存補題の書き換えで示す。
役割: LaTeX の存在条件（`lem:exist`）を Lean で同値として確定する。
-/
private lemma exists_u_iff_DK_add_g_lt_A_of_R_eq_zero
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hK : 0 ≤ K)
    (hR0 : Rof D A B = 0) :
    HasUSolution D A B K hD hA hB ↔ D * K + gcdDA D A < A := by
  constructor
  · intro hsol
    rcases hsol with ⟨u, huSol⟩
    exact
      DK_add_g_lt_A_of_solU_of_R_eq_zero
        (D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0 huSol
  · intro hcond
    rcases exists_solU_lt_A_div_g_of_R_eq_zero
        (D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0 hcond with
      ⟨u, huSol, _huLt⟩
    exact ⟨u, huSol⟩

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`,
  `hex : HasUSolution ...`, `hR0 : Rof D A B = 0`。
主張: `D*K + gcd(D,A) < A`。
内容: `R = 0` での可解性同値の前向き射影。
証明: `exists_u_iff_DK_add_g_lt_A_of_R_eq_zero` を適用する。
役割: `ExistAndBounds` 節で繰り返す `hcond` の導出を共通化する。
-/
private lemma DK_add_g_lt_A_of_hasUSolution_of_R_eq_zero
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hK : 0 ≤ K)
    (hex : HasUSolution D A B K hD hA hB)
    (hR0 : Rof D A B = 0) :
    D * K + gcdDA D A < A := by
  simpa using
    (exists_u_iff_DK_add_g_lt_A_of_R_eq_zero
      (D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0).mp hex

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hu : 0 ≤ u`。
主張: `Delta(D*u) ≤ u`。
内容: `Delta_Du_rewrite` で `u - (...)` の形に戻し、補正項の非負性で押さえる。
証明: `Mof_nonneg` と除算の非負性を組み合わせる。
役割: `uMin_lower_bound` の算術部分を切り出す。
-/
private lemma Delta_Du_le_u
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    {u : Int}
    (hu : 0 ≤ u) :
    Delta D A B (D * u) hD hA hB ≤ u := by
  have hM0 : 0 ≤ Mof D A B :=
    Mof_nonneg (D := D) (A := A) (B := B) hD hA hB
  have hDu0 : 0 ≤ D * u := mul_nonneg (le_of_lt hD) hu
  have hDiv0 : 0 ≤ (D * u) / A := Int.ediv_nonneg hDu0 (le_of_lt hA)
  have hSub0 : 0 ≤ ((Mof D A B * ((D * u) / A)) / B) := by
    exact Int.ediv_nonneg (mul_nonneg hM0 hDiv0) (le_of_lt hB)
  calc
    Delta D A B (D * u) hD hA hB =
        u - ((Mof D A B * ((D * u) / A)) / B) := by
      simpa only [Mof] using
        (Delta_Du_rewrite (D := D) (A := A) (B := B) (u := u)
          (M := Mof D A B) hD hA hB hu rfl)
    _ ≤ u := sub_le_self _ hSub0

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: 解があるなら `uMinOf ≥ K + 1`。
内容: 任意可解 `b` について `Δ(D,A,B,D*b) ≤ b` から `K < b` を導き `K+1 ≤ b` を得る。
証明: 式変形・既存補題の書き換えで示す。
役割: 探索区間の下界と最小解の基本的性質を与える。
-/
private lemma uMin_lower_bound
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hex : HasUSolution D A B K hD hA hB) :
    (K + 1 : Int) ≤ uMinOf D A B K hD hA hB hex := by
  unfold uMinOf
  refine le_csInf ?_ ?_
  · rcases hex with ⟨u, hu⟩
    exact ⟨u, hu⟩
  intro b hb
  rcases hb with ⟨hb0, hbK⟩
  have hDelta_le : Delta D A B (D * b) hD hA hB ≤ b :=
    Delta_Du_le_u (D := D) (A := A) (B := B) hD hA hB hb0
  have hKltb : K < b := lt_of_lt_of_le hbK hDelta_le
  exact (Int.add_one_le_iff).2 hKltb

/--
入力/前提: `hex : HasUSolution ...`、`huSol : SolU ... u`、`huLt : u < bound`。
主張: 最小解 `uMinOf` も `bound` 未満である。
内容: `csInf_le` で `uMinOf ≤ u` を取り出し、`u < bound` と連結する。
証明: 可解集合の下方有界性と `sInf` の最小性で示す。
役割: `uMin_lt_ABK_plus_two` などで繰り返す
  `sInf ≤ witness < bound` を共通化する。
-/
private lemma uMinOf_lt_of_sol_lt
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hex : HasUSolution D A B K hD hA hB)
    {u bound : Int}
    (huSol : Search.Internal.SolU D A B K hD hA hB u)
    (huLt : u < bound) :
    uMinOf D A B K hD hA hB hex < bound := by
  have hBdd : BddBelow ({z : Int | Search.Internal.SolU D A B K hD hA hB z} : Set Int) :=
    ⟨0, fun _ hz => hz.1⟩
  unfold uMinOf
  exact lt_of_le_of_lt (csInf_le hBdd huSol) huLt

/--
入力/前提: `hex : HasUSolution ...`、`hExist : ∃ u, SolU ... u ∧ u < bound`。
主張: `uMinOf < bound`。
内容: witness を 1 つ取り出して `uMinOf_lt_of_sol_lt` に渡す。
証明: 存在 witness を分解して既存補題を適用する。
役割: `ExistAndBounds` 節の上界補題から `rcases` の重複を取り除く。
-/
private lemma uMinOf_lt_of_exists_sol_lt
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hex : HasUSolution D A B K hD hA hB)
    {bound : Int}
    (hExist :
      ∃ u : Int, Search.Internal.SolU D A B K hD hA hB u ∧ u < bound) :
    uMinOf D A B K hD hA hB hex < bound := by
  rcases hExist with ⟨u, huSol, huLt⟩
  simpa using
    uMinOf_lt_of_sol_lt
      (D := D) (A := A) (B := B) (K := K) hD hA hB hex huSol huLt

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`。
主張: `((A*B*K)/Rof) + 2 ≤ A*B*K + 2`。
内容: 非負な分子に対して `⌊n/R⌋ ≤ n` を使う。
証明: `Int.ediv_le_self` を `A*B*K` に適用する。
役割: `uMin_lt_ABK_plus_two` の `R ≠ 0` 枝の算術を薄くする。
-/
private lemma floor_ABK_div_R_plus_two_le_ABK_plus_two
    (hA : 0 < A)
    (hB : 0 < B)
    (hK : 0 ≤ K) :
    (A * B * K) / (Rof D A B) + 2 ≤ A * B * K + 2 := by
  have hABK0 : 0 ≤ A * B * K := mul_nonneg (le_of_lt (Int.mul_pos hA hB)) hK
  have hdivLe : (A * B * K) / (Rof D A B) ≤ A * B * K :=
    Int.ediv_le_self (Rof D A B) hABK0
  simpa only [add_le_add_iff_right] using add_le_add_left hdivLe 2

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: 可解なら常に粗い共通上界 `uMinOf < A*B*K + 2`。
内容: `R = 0` / `R ≠ 0`（さらに `K = 0` / `K > 0`）で分岐し既存の鋭い上界を統合する。
証明: 場合分け・式変形・既存補題の書き換えで示す。
役割: 場合分け不要で使える初期探索上界を提供する。
-/
private lemma uMin_lt_ABK_plus_two
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hK : 0 ≤ K)
    (hex : HasUSolution D A B K hD hA hB) :
    uMinOf D A B K hD hA hB hex < A * B * K + 2 := by
  by_cases hR0 : Rof D A B = 0
  · have hcond : D * K + gcdDA D A < A :=
      DK_add_g_lt_A_of_hasUSolution_of_R_eq_zero
        (D := D) (A := A) (B := B) (K := K) hD hA hB hK hex hR0
    by_cases hK0 : K = 0
    · have hOneSol : Search.Internal.SolU D A B K hD hA hB 1 :=
        one_sol_of_R_eq_zero_of_K_zero
          (D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0 hK0 hcond
      simpa only [hK0, mul_zero, zero_add, gt_iff_lt] using
        (uMinOf_lt_of_sol_lt
          (D := D) (A := A) (B := B) (K := K) hD hA hB hex hOneSol (by decide))
    · have hKpos : 0 < K := lt_of_le_of_ne hK (Ne.symm hK0)
      have hltAdiv :
          uMinOf D A B K hD hA hB hex < A / gcdDA D A := by
        have hcond : D * K + gcdDA D A < A :=
          DK_add_g_lt_A_of_hasUSolution_of_R_eq_zero
            (D := D) (A := A) (B := B) (K := K) hD hA hB hK hex hR0
        simpa using
          uMinOf_lt_of_exists_sol_lt
            (D := D) (A := A) (B := B) (K := K) hD hA hB hex
            (exists_solU_lt_A_div_g_of_R_eq_zero
              (D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0 hcond)
      have hAdiv_le_A : A / gcdDA D A ≤ A :=
        Int.ediv_le_self (gcdDA D A) (le_of_lt hA)
      have hBge1 : (1 : Int) ≤ B := (Int.lt_iff_add_one_le).1 hB
      have hKge1 : (1 : Int) ≤ K := (Int.lt_iff_add_one_le).1 hKpos
      have hB0 : 0 ≤ B := le_of_lt hB
      have hBKge1 : (1 : Int) ≤ B * K := by
        calc
          (1 : Int) = 1 * 1 := by ring
          _ ≤ B * 1 := by
            simpa only [one_mul, mul_one] using
              mul_le_mul_of_nonneg_right hBge1 (show 0 ≤ (1 : Int) by decide)
          _ ≤ B * K := by
            simpa only [one_mul] using mul_le_mul_of_nonneg_left hKge1 hB0
      have hA_le_ABK : A ≤ A * B * K := by
        calc
          A = A * 1 := by ring
          _ ≤ A * (B * K) := by
            exact mul_le_mul_of_nonneg_left hBKge1 (le_of_lt hA)
          _ = A * B * K := by ring
      have hAdiv_le_ABK : A / gcdDA D A ≤ A * B * K :=
        le_trans hAdiv_le_A hA_le_ABK
      omega
  · have hlt : uMinOf D A B K hD hA hB hex < (A * B * K) / (Rof D A B) + 2 := by
      simpa using
        uMinOf_lt_of_exists_sol_lt
          (D := D) (A := A) (B := B) (K := K) hD hA hB hex
          (exists_solU_lt_floor_ABK_div_R_plus_two_of_R_ne_zero
            (D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0)
    exact
      lt_of_lt_of_le hlt
        (floor_ABK_div_R_plus_two_le_ABK_plus_two
          (D := D) (A := A) (B := B) (K := K) hA hB hK)

end Internal

end Bounds

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: 可解性条件と最小解上界を一括で与える総合定理。
内容: `R ≠ 0` の存在性、`R = 0` の同値条件、および `uMinOf` の各種上界を同時に返す。
証明: 既存補題の適用と式変形で示す。
役割: 本文 `lem:exist` に対応する統合インターフェース。
-/
private theorem exist_and_search_upper_bound
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hK : 0 ≤ K) :
      (Rof D A B ≠ 0 → HasUSolution D A B K hD hA hB) ∧
      (Rof D A B = 0 →
        (HasUSolution D A B K hD hA hB ↔ D * K + gcdDA D A < A)) ∧
    (∀ hex : HasUSolution D A B K hD hA hB,
      (Rof D A B = 0 →
        uMinOf D A B K hD hA hB hex < A / gcdDA D A) ∧
      (Rof D A B ≠ 0 →
        uMinOf D A B K hD hA hB hex < (A * B * K) / (Rof D A B) + 2) ∧
      uMinOf D A B K hD hA hB hex < A * B * K + 2) := by
  refine ⟨?_, ?_, ?_⟩
  · intro hRnz
    rcases Bounds.Internal.exists_solU_lt_floor_ABK_div_R_plus_two_of_R_ne_zero
        (D := D) (A := A) (B := B) (K := K) hD hA hB hK hRnz with
      ⟨u, huSol, _⟩
    exact ⟨u, huSol⟩
  · intro hR0
    simpa using
      Bounds.Internal.exists_u_iff_DK_add_g_lt_A_of_R_eq_zero
        (D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0
  · intro hex
    refine ⟨?_, ?_, ?_⟩
    · intro hR0
      have hcond : D * K + gcdDA D A < A :=
        Bounds.Internal.DK_add_g_lt_A_of_hasUSolution_of_R_eq_zero
          (D := D) (A := A) (B := B) (K := K) hD hA hB hK hex hR0
      simpa using
        Bounds.Internal.uMinOf_lt_of_exists_sol_lt
          (D := D) (A := A) (B := B) (K := K) hD hA hB hex
          (Bounds.Internal.exists_solU_lt_A_div_g_of_R_eq_zero
            (D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0 hcond)
    · intro hRnz
      simpa using
        Bounds.Internal.uMinOf_lt_of_exists_sol_lt
          (D := D) (A := A) (B := B) (K := K) hD hA hB hex
          (Bounds.Internal.exists_solU_lt_floor_ABK_div_R_plus_two_of_R_ne_zero
            (D := D) (A := A) (B := B) (K := K) hD hA hB hK hRnz)
    · simpa using
        Bounds.Internal.uMin_lt_ABK_plus_two
          (D := D) (A := A) (B := B) (K := K) hD hA hB hK hex

end ExistAndBounds

section BinarySearchMinSketch

variable {D A B K L R n N X u : Int}

namespace NoHit

namespace Internal

/--
目的: 二分探索で使う評価関数 `f(u)` を定義する。
定義: `f(u) = B*u - Mof*⌊D*u/A⌋`。
入力/前提: D A B : Int、u : Int。
出力: 型 `Int` の値を返す。
役割: `K < Δ` 判定を `B*K < f(u)` に写し、区間最大化 `F(L,R)` に接続する。
-/
private def fBinary (D A B : Int) (u : Int) : Int :=
  B * u - (Mof D A B) * ((D * u) / A)

/--
目的: 区間 `[L,R)` で `B*K < f(u)` を満たす点が無いことを述語化する。
定義: すべての `u` について `fBinary D A B u ≤ B*K` を要求する。
入力/前提: D A B K : Int、L R : Int。
出力: 型 `Prop` の値を返す。
役割: `F(L,R) ≤ B*K` を二分探索不変量として扱うための述語版。
-/
private def NoHitBK (D A B K : Int) (L R : Int) : Prop :=
  ∀ u : Int, L ≤ u → u < R → fBinary D A B u ≤ B * K

/--
目的: 区間 `[L,R)` で `K < Δ(D,A,B,D*u)` が成立しないことを述語化する。
定義: すべての `u` に対して `¬ (K < Delta ... (D*u))` を課す。
入力/前提: D A B K : Int、hD : 0 < D、hA : 0 < A。
出力: 型 `Prop` の値を返す。
役割: `NoHitBK` と同値化して `Δ` 側判定と探索手続きをつなぐ。
-/
private def NoHitDelta
    (D A B K : Int)
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B)
    (L R : Int) : Prop :=
  ∀ u : Int, L ≤ u → u < R → ¬ (K < Delta D A B (D * u) hD hA hB)

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `K < Δ(D,A,B,D*u)` と `B*K < fBinary D A B u` は同値。
内容: `lt_Delta_iff_BK_lt` に `M := Mof` を代入して `fBinary` 表現へ移す。
証明: 既存補題の書き換えで示す。
役割: `NoHitDelta` と `NoHitBK` の橋渡しとなる点wise同値。
-/
private lemma lt_Delta_iff_BK_lt_fBinary
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hu : 0 ≤ u)
    (hK : 0 ≤ K) :
    K < Delta D A B (D * u) hD hA hB ↔ B * K < fBinary D A B u := by
  simpa only [fBinary] using
    (lt_Delta_iff_BK_lt
      (D := D) (A := A) (B := B) (K := K) (u := u) (M := Mof D A B)
      hD hA hB hu hK
      rfl)

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `L ≥ 0` の範囲で `NoHitDelta ... L R ↔ NoHitBK ... L R`。
内容: 各 `u` で `lt_Delta_iff_BK_lt_fBinary` を適用し、否定付き述語へ持ち上げる。
証明: 反証法で示す。
役割: 二分探索不変量を `Δ` 版と `f` 版のどちらでも扱えるようにする。
-/
private lemma NoHitDelta_iff_NoHitBK
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hK : 0 ≤ K)
    (hL0 : 0 ≤ L) :
    NoHitDelta D A B K hD hA hB L R ↔ NoHitBK D A B K L R := by
  constructor
  · intro hNoDelta u hLu huR
    by_contra hge
    exact (hNoDelta u hLu huR)
      ((lt_Delta_iff_BK_lt_fBinary
        (D := D) (A := A) (B := B) (K := K) (u := u)
        hD hA hB (le_trans hL0 hLu) hK).2 (lt_of_not_ge hge))
  · intro hNoBK u hLu huR hDelta
    exact not_lt_of_ge (hNoBK u hLu huR)
      ((lt_Delta_iff_BK_lt_fBinary
        (D := D) (A := A) (B := B) (K := K) (u := u)
        hD hA hB (le_trans hL0 hLu) hK).1 hDelta)

/--
入力/前提: hnN : n ≤ N、hNo : NoHitBK D A B K 0 N。
主張: `NoHitBK ... 0 N` が成り立てば、右端を縮めた `NoHitBK ... 0 n` も成り立つ。
内容: `u < n ≤ N` から `u < N` を得て元の仮定を適用する。
証明: 既存補題の適用と式変形で示す。
役割: 区間最大の単調性（prefix 安全性）を述語で使う補題。
-/
private lemma NoHitBK_mono_right
    (hnN : n ≤ N)
    (hNo : NoHitBK D A B K 0 N) :
    NoHitBK D A B K 0 n := by
  intro u hu0 hun
  exact hNo u hu0 (lt_of_lt_of_le hun hnN)

/--
入力/前提: hn0 : 0 ≤ n、_hnN : n ≤ N、hPrefix : NoHitBK D A B K 0 n。
主張: `NoHitBK ... 0 n` を仮定すると `NoHitBK ... 0 N ↔ NoHitBK ... n N`。
内容: `u < n` と `n ≤ u` の場合分けで prefix / suffix を貼り合わせる。
証明: 場合分けで示す。
役割: 二分探索で「前半が安全なら後半だけ判定すればよい」を形式化する。
-/
private lemma NoHitBK_prefix_iff_suffix
    (hn0 : 0 ≤ n)
    (_hnN : n ≤ N)
    (hPrefix : NoHitBK D A B K 0 n) :
    NoHitBK D A B K 0 N ↔ NoHitBK D A B K n N := by
  constructor
  · intro hAll u hnu huN
    exact hAll u (le_trans hn0 hnu) huN
  · intro hSuf u hu0 huN
    by_cases huLt : u < n
    · exact hPrefix u hu0 huLt
    · have hnu : n ≤ u := le_of_not_gt huLt
      exact hSuf u hnu huN

end Internal

end NoHit

namespace Search

namespace Internal

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `uMinOf` は可解集合 `{u | SolU ... u}` に属する。
内容: 可解集合の下方有界性と `Int.csInf_mem` を使って示す。
証明: 既存補題の書き換えで示す。
役割: `uMinOf` 自身を具体的な可解点として使うための基本補題。
-/
private lemma uMinOf_mem
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hex : HasUSolution D A B K hD hA hB) :
    Search.Internal.SolU D A B K hD hA hB (uMinOf D A B K hD hA hB hex) := by
  have hBdd : BddBelow ({u : Int | Search.Internal.SolU D A B K hD hA hB u} : Set Int) := by
    refine ⟨0, ?_⟩
    intro z hz
    exact hz.1
  unfold uMinOf
  exact Int.csInf_mem (by simpa only [HasUSolution] using hex) hBdd

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: 任意の可解 `u` に対して `uMinOf ≤ u`。
内容: 可解集合の下方有界性の下で `csInf_le` を適用する。
証明: 既存補題の適用と式変形で示す。
役割: `uMinOf` の最小性を不等式として使うための補助補題。
-/
private lemma uMinOf_le_of_sol
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hex : HasUSolution D A B K hD hA hB)
    {u : Int}
    (hu : Search.Internal.SolU D A B K hD hA hB u) :
    uMinOf D A B K hD hA hB hex ≤ u := by
  have hBdd : BddBelow ({z : Int | Search.Internal.SolU D A B K hD hA hB z} : Set Int) := by
    refine ⟨0, ?_⟩
    intro z hz
    exact hz.1
  unfold uMinOf
  exact csInf_le hBdd hu

/--
目的: `Nmax` が「`NoHitDelta 0 N` を満たす最大の `N`」である仕様を定義する。
定義: 非負性・`NoHitDelta 0 Nmax`・最大性（任意 `N` は `N ≤ Nmax`）を束ねる。
入力/前提: D A B K : Int、hD : 0 < D、hA : 0 < A。
出力: 型 `Prop` の値を返す。
役割: 二分探索が満たすべき仕様を数学的に固定する。
-/
private def NmaxSpec
    (D A B K : Int)
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B)
    (Nmax : Int) : Prop :=
  0 ≤ Nmax ∧
  NoHit.Internal.NoHitDelta D A B K hD hA hB 0 Nmax ∧
  ∀ N : Int, 0 ≤ N → NoHit.Internal.NoHitDelta D A B K hD hA hB 0 N → N ≤ Nmax

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `uMinOf` は `NmaxSpec` を満たす。
内容: `uMinOf` の可解性と最小性（`u < uMinOf` は不可解）から最大性を導く。
証明: 反証法で示す。
役割: 「最小可解点 = 最大安全長」を形式的に確立する中心定理。
-/
private theorem uMinOf_is_NmaxSpec
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hex : HasUSolution D A B K hD hA hB) :
    NmaxSpec D A B K hD hA hB (uMinOf D A B K hD hA hB hex) := by
  have huMinSol : Search.Internal.SolU D A B K hD hA hB (uMinOf D A B K hD hA hB hex) :=
    uMinOf_mem (D := D) (A := A) (B := B) (K := K) hD hA hB hex
  rcases huMinSol with ⟨huMin0, huMinDelta⟩
  refine ⟨huMin0, ?_, ?_⟩
  · intro u hu0 huLt huDelta
    exact
      (not_lt_of_ge
        (uMinOf_le_of_sol
          (D := D) (A := A) (B := B) (K := K) hD hA hB hex ⟨hu0, huDelta⟩))
        huLt
  · intro N hN0 hNoHit
    by_contra hNle
    exact
      (hNoHit
        (uMinOf D A B K hD hA hB hex)
        huMin0
        (lt_of_not_ge hNle))
        huMinDelta

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `NmaxSpec` を満たす値は一意。
内容: 2つの候補の最大性を相互適用して双方の `≤` を示し、反対称性で結ぶ。
証明: 既存補題の適用と式変形で示す。
役割: 仕様を満たす探索結果が `uMinOf` と一致する根拠を与える。
-/
private lemma NmaxSpec_unique
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    {N1 N2 : Int}
    (h1 : NmaxSpec D A B K hD hA hB N1)
    (h2 : NmaxSpec D A B K hD hA hB N2) :
    N1 = N2 := by
  rcases h1 with ⟨hN10, hNo1, hMax1⟩
  rcases h2 with ⟨hN20, hNo2, hMax2⟩
  have h12 : N1 ≤ N2 := hMax2 N1 hN10 hNo1
  have h21 : N2 ≤ N1 := hMax1 N2 hN20 hNo2
  exact le_antisymm h12 h21

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `NmaxSpec` を返す二分探索結果 `Nmax` は `uMinOf` と一致し、`xMin = D*Nmax`。
内容: `uMinOf_is_NmaxSpec` と `NmaxSpec_unique` で `Nmax = uMinOf` を示し、`xMin_eq_D_mul_uMinOf` で戻す。
証明: 式変形で示す。
役割: 探索アルゴリズム仕様から最終解の正しさを得る接続定理。
-/
private theorem binary_search_correct_of_NmaxSpec
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hex : HasUSolution D A B K hD hA hB)
    {Nmax : Int}
    (hNmax : NmaxSpec D A B K hD hA hB Nmax) :
    uMinOf D A B K hD hA hB hex = Nmax ∧
    xMin D A B K hD hA hB = D * Nmax := by
  have hEq : Nmax = uMinOf D A B K hD hA hB hex :=
    NmaxSpec_unique
      (D := D) (A := A) (B := B) (K := K) hD hA hB hNmax
      (uMinOf_is_NmaxSpec (D := D) (A := A) (B := B) (K := K) hD hA hB hex)
  refine ⟨hEq.symm, ?_⟩
  simpa [hEq] using
    (Correctness.Internal.xMin_eq_D_mul_uMinOf
      (D := D) (A := A) (B := B) (K := K) hD hA hB hex)

end Internal

end Search

namespace NoHit

namespace Internal

/--
入力/前提: hA : 0 < A。
主張: `fBinary` を平行移動した `Mwf.obj` 形に等式変換できる。
内容: `u = (u-L)+L` で商の中身を再配置し、`fBinary = B*L + obj(..., u-L)` を示す。
証明: 式変形で示す。
役割: 区間最大 `F(L,R)` を `Mwf.mwf` 計算へ接続する前処理補題。
-/
private lemma fBinary_eq_shift_obj
    (hA : 0 < A) :
    fBinary D A B u =
      B * L + Mwf.Spec.obj B (-(Mof D A B)) D (D * L) A (u - L) hA := by
  unfold fBinary
  have hdiv : (D * u) / A = (D * (u - L) + D * L) / A := by
    refine congrArg (fun t : Int => t / A) ?_
    ring
  rw [hdiv]
  simp only [Mwf.Spec.obj, Mwf.Spec.zfloorDiv, neg_mul]
  ring

/--
入力/前提: `hA : 0 < A`, `hLR : L < R`, `hNo : NoHitBK D A B K L R`。
主張: shifted domain 上の任意の `x` に対し、対応する `Mwf.Spec.obj` は `B*K - B*L` 以下。
内容: `u = L + x` と置いて `NoHitBK` を適用し、`fBinary_eq_shift_obj` で shifted `obj` に戻す。
証明: `x ∈ dom(R-L)` から `L ≤ L+x < R` を作り、`fBinary` 側上界を差し引き形へ変換する。
役割: `NoHitBK_iff_mwf_le` の `NoHitBK → mwf` 方向で、各点の上界評価を共通化する。
-/
private lemma shifted_obj_le_sub_of_NoHitBK
    (hA : 0 < A)
    (hLR : L < R)
    (hNo : NoHitBK D A B K L R)
    {x : Int}
    (hxDom : x ∈ Mwf.Spec.dom (R - L) (sub_pos.mpr hLR)) :
    Mwf.Spec.obj B (-(Mof D A B)) D (D * L) A x hA ≤ B * K - B * L := by
  have hxI : x ∈ Finset.Icc (0 : Int) (R - L - 1) := by
    simpa only [Mwf.Spec.dom] using hxDom
  rcases Finset.mem_Icc.mp hxI with ⟨_hx0, hxN1⟩
  have hxLt : x < R - L := by omega
  have hLu : L ≤ L + x := by omega
  have huR : L + x < R := by omega
  have hfx : fBinary D A B (L + x) ≤ B * K := hNo (L + x) hLu huR
  have hShift :
      fBinary D A B (L + x) =
        B * L + Mwf.Spec.obj B (-(Mof D A B)) D (D * L) A x hA := by
    have hTmp :=
      fBinary_eq_shift_obj
        (D := D) (A := A) (B := B) (L := L) (u := L + x) hA
    have hCancel : L + x - L = x := by ring
    simpa only [Mwf.Spec.obj, Mwf.Spec.zfloorDiv, neg_mul, hCancel] using hTmp
  have hSum :
      B * L + Mwf.Spec.obj B (-(Mof D A B)) D (D * L) A x hA ≤ B * K := by
    simpa only [Mwf.Spec.obj, Mwf.Spec.zfloorDiv, neg_mul, hShift] using hfx
  exact
    (le_sub_iff_add_le).2 (by
      simpa only [Mwf.Spec.obj, Mwf.Spec.zfloorDiv, add_comm, neg_mul] using hSum)

/--
入力/前提: 有限集合 `s : Finset Int`、整数値関数 `f`、像の非空性 `hs`、
  および各点評価 `f x ≤ z`。
主張: `s.image f` の `max'` も `z` 以下。
内容: `Finset.max'_le` と `Finset.mem_image` の定型処理を 1 本にまとめる。
証明: 像の要素 `y` から逆像 `x ∈ s` を取り出し、点wise上界を適用する。
役割: `mwf` / `mwfLr` の前向き上界化で重複する `max'` 評価を簡潔化する。
-/
private lemma max'_image_le_of_forall
    (s : Finset Int)
    (f : Int → Int)
    (hs : (s.image f).Nonempty)
    {z : Int}
    (h : ∀ x ∈ s, f x ≤ z) :
    (s.image f).max' hs ≤ z := by
  refine Finset.max'_le (s := s.image f) (H := hs) (x := z) ?_
  intro y hy
  rcases Finset.mem_image.mp hy with ⟨x, hx, rfl⟩
  exact h x hx

/--
入力/前提: `hA : 0 < A`, `hLR : L < R`, `hNo : NoHitBK D A B K L R`。
主張: shifted `mwf` 全体も `B*K - B*L` 以下、したがって `B*L + mwf ≤ B*K`。
内容: `shifted_obj_le_sub_of_NoHitBK` を像全体へ持ち上げて `Finset.max'` を評価する。
証明: `Mwf.Spec.img_nonempty` と `Finset.max'_le` を用いて最大値を押さえる。
役割: `NoHitBK_iff_mwf_le` の前向き (`NoHitBK → mwf` 上界) を 1 本にまとめる。
-/
private lemma mwf_shift_le_of_NoHitBK
    (hA : 0 < A)
    (hLR : L < R)
    (hNo : NoHitBK D A B K L R) :
    B * L
      + Mwf.mwf (R - L) A B (-(Mof D A B)) D (D * L) (sub_pos.mpr hLR) hA
      ≤ B * K := by
  have hMwfLe :
      Mwf.mwf (R - L) A B (-(Mof D A B)) D (D * L) (sub_pos.mpr hLR) hA ≤ B * K - B * L := by
    simpa only [Mwf.Spec.img] using
      max'_image_le_of_forall
        (Mwf.Spec.dom (R - L) (sub_pos.mpr hLR))
        (fun x => Mwf.Spec.obj B (-(Mof D A B)) D (D * L) A x hA)
        (Mwf.Spec.img_nonempty
          (N := R - L) (M := A) (A := B) (B := -(Mof D A B)) (C := D) (D := D * L)
          (sub_pos.mpr hLR) hA)
        (fun x hxDom =>
          shifted_obj_le_sub_of_NoHitBK
            (D := D) (A := A) (B := B) (K := K) (L := L) (R := R)
            hA hLR hNo hxDom)
  have hTmp :
      Mwf.mwf (R - L) A B (-(Mof D A B)) D (D * L) (sub_pos.mpr hLR) hA + B * L ≤ B * K := by
    exact (le_sub_iff_add_le).1 hMwfLe
  simpa only [add_comm] using hTmp

/--
入力/前提: `hA : 0 < A`, `hLR : L < R`、shifted `mwf` 上界、
  および `u ∈ [L,R)`。
主張: `fBinary D A B u ≤ B * K`。
内容: `x := u - L` を shifted domain に戻し、`obj ≤ mwf` と `fBinary_eq_shift_obj`
  を接続する。
証明: `x ∈ dom(R-L)` を作って `Mwf.Spec.obj_le_mwf` を適用し、最後に `simpa` で戻す。
役割: `NoHitBK_of_mwf_shift_le` の点wise評価部分を共通化する。
-/
private lemma fBinary_le_of_mwf_shift_le
    (hA : 0 < A)
    (hLR : L < R)
    (hMwf :
      B * L
        + Mwf.mwf (R - L) A B (-(Mof D A B)) D (D * L) (sub_pos.mpr hLR) hA
        ≤ B * K)
    {u : Int}
    (hLu : L ≤ u)
    (huR : u < R) :
    fBinary D A B u ≤ B * K := by
  let N0 : Int := R - L
  have hN0 : 0 < N0 := by
    exact sub_pos.mpr hLR
  have hMwfLe :
      Mwf.mwf N0 A B (-(Mof D A B)) D (D * L) hN0 hA ≤ B * K - B * L := by
    exact
      (le_sub_iff_add_le).2 (by
        simpa only [N0, add_comm] using hMwf)
  let x : Int := u - L
  have hx0 : 0 ≤ x := by
    exact sub_nonneg.mpr hLu
  have hxLt : x < N0 := by
    dsimp only [x, N0]
    exact sub_lt_sub_right huR L
  have hxN1 : x ≤ N0 - 1 := by omega
  have hxDom : x ∈ Mwf.Spec.dom N0 hN0 := by
    change x ∈ Finset.Icc (0 : Int) (N0 - 1)
    exact Finset.mem_Icc.mpr ⟨hx0, hxN1⟩
  have hObj :
      Mwf.Spec.obj B (-(Mof D A B)) D (D * L) A x hA ≤ B * K - B * L := by
    exact
      le_trans
        (Mwf.Spec.obj_le_mwf
          (N := N0) (M := A) (A := B) (B := -(Mof D A B)) (C := D) (D := D * L) (x := x)
          hN0 hA hxDom)
        hMwfLe
  have hShift :
      fBinary D A B u =
        B * L + Mwf.Spec.obj B (-(Mof D A B)) D (D * L) A x hA := by
    simpa only [x, Mwf.Spec.obj, Mwf.Spec.zfloorDiv, neg_mul] using
      (fBinary_eq_shift_obj (D := D) (A := A) (B := B) (L := L) (u := u) hA)
  have hTmp :
      Mwf.Spec.obj B (-(Mof D A B)) D (D * L) A x hA + B * L ≤ B * K := by
    exact (le_sub_iff_add_le).1 hObj
  have hSum :
      B * L + Mwf.Spec.obj B (-(Mof D A B)) D (D * L) A x hA ≤ B * K := by
    simpa only [add_comm] using hTmp
  simpa only [hShift] using hSum

/--
入力/前提: `hA : 0 < A`, `hLR : L < R`、および shifted `mwf` 上界。
主張: `B * L + mwf ≤ B * K` なら区間 `[L,R)` は `NoHitBK`。
内容: 任意の `u ∈ [L,R)` を `x = u - L` に戻し、`obj ≤ mwf` と `fBinary_eq_shift_obj` をつなぐ。
証明: `x ∈ dom(R-L)` を作って `Mwf.Spec.obj_le_mwf` を適用し、最後に平行移動等式で戻す。
役割: `NoHitBK_iff_mwf_le` の逆向き (`mwf` 上界 → NoHitBK`) を共通化する。
-/
private lemma NoHitBK_of_mwf_shift_le
    (hA : 0 < A)
    (hLR : L < R)
    (hMwf :
      B * L
        + Mwf.mwf (R - L) A B (-(Mof D A B)) D (D * L) (sub_pos.mpr hLR) hA
        ≤ B * K) :
    NoHitBK D A B K L R := by
  intro u hLu huR
  simpa using
    (fBinary_le_of_mwf_shift_le
      (D := D) (A := A) (B := B) (K := K) (L := L) (R := R) hA hLR hMwf hLu huR)

/--
入力/前提: hA : 0 < A、_hL0 : 0 ≤ L、hLR : L < R。
主張: `NoHitBK D A B K L R` と `B*L + Mwf.mwf(...) ≤ B*K` は同値。
内容: `fBinary_eq_shift_obj` と `obj ≤ mwf`（および Finset 最大値評価）で両方向を示す。
証明: 既存補題の書き換えで示す。
役割: 区間判定を `mwf` の1回評価へ落とす実装接続の主補題。
-/
private lemma NoHitBK_iff_mwf_le
    (hA : 0 < A)
    (_hL0 : 0 ≤ L)
    (hLR : L < R) :
    NoHitBK D A B K L R ↔
      B * L
        + Mwf.mwf (R - L) A B (-(Mof D A B)) D (D * L) (sub_pos.mpr hLR) hA
        ≤ B * K := by
  constructor
  · intro hNo
    simpa using
      (mwf_shift_le_of_NoHitBK
        (D := D) (A := A) (B := B) (K := K) (L := L) (R := R) hA hLR hNo)
  · intro hMwf
    simpa using
      (NoHitBK_of_mwf_shift_le
        (D := D) (A := A) (B := B) (K := K) (L := L) (R := R) hA hLR hMwf)

/--
入力/前提: `hA : 0 < A`。
主張: 区間版 `mwfLr` で使う `Mwf.Spec.obj ... 0` は `fBinary` と一致する。
内容: `0` 項を消して `B*u - M*((D*u)/A)` の形へ整える。
証明: `Mwf.Spec.obj` を展開して環計算で示す。
役割: `NoHitBK_iff_mwfLr_le` で `obj` と `fBinary` を毎回展開しないための補助。
-/
private lemma obj_eq_fBinary
    (hA : 0 < A) :
    Mwf.Spec.obj B (-(Mof D A B)) D 0 A u hA = fBinary D A B u := by
  calc
    Mwf.Spec.obj B (-(Mof D A B)) D 0 A u hA
        = B * u + (-(Mof D A B)) * ((D * u + 0) / A) := by
            simp only [Mwf.Spec.obj, Mwf.Spec.zfloorDiv, add_zero, neg_mul]
    _ = B * u - (Mof D A B) * ((D * u) / A) := by ring_nf
    _ = fBinary D A B u := by
        simp only [fBinary]

/--
入力/前提: `hA : 0 < A`, `hLR : L < R`、`mwfLr ... ≤ B*K`、
  および `u ∈ [L,R)`。
主張: `fBinary D A B u ≤ B * K`。
内容: `u` を `domLr` の元として `Finset.le_max'` で `obj ≤ mwfLr` を得て、
  `obj_eq_fBinary` で `fBinary` に戻す。
証明: 区間所属を `domLr` 所属へ変換し、`le_trans` と `simpa` で示す。
役割: `NoHitBK_of_mwfLr_le` の点wise評価部分を共通化する。
-/
private lemma fBinary_le_of_mwfLr_le
    (hA : 0 < A)
    (hLR : L < R)
    (hMwf : Mwf.mwfLr L R A B (-(Mof D A B)) D 0 hLR hA ≤ B * K)
    {u : Int}
    (hLu : L ≤ u)
    (huR : u < R) :
    fBinary D A B u ≤ B * K := by
  have huR1 : u ≤ R - 1 := by omega
  have huDom : u ∈ Mwf.Spec.domLr L R hLR := by
    change u ∈ Finset.Icc L (R - 1)
    exact Finset.mem_Icc.mpr ⟨hLu, huR1⟩
  have hObjLe :
      Mwf.Spec.obj B (-(Mof D A B)) D 0 A u hA
        ≤ Mwf.mwfLr L R A B (-(Mof D A B)) D 0 hLR hA := by
    unfold Mwf.mwfLr
    exact
      Finset.le_max' (s := Mwf.Spec.imgLr L R A B (-(Mof D A B)) D 0 hLR hA)
        (x := Mwf.Spec.obj B (-(Mof D A B)) D 0 A u hA)
        (Finset.mem_image.mpr ⟨u, huDom, rfl⟩)
  simpa only [obj_eq_fBinary (D := D) (A := A) (B := B) (u := u) hA] using
    le_trans hObjLe hMwf

/--
入力/前提: `hA : 0 < A`, `hLR : L < R`, `hNo : NoHitBK D A B K L R`。
主張: 区間版最大値 `mwfLr` も `B*K` 以下。
内容: 各 `u ∈ [L,R)` で `fBinary ≤ B*K` を使い、像の `max'` を上から抑える。
証明: `Mwf.Spec.imgLr_nonempty` と `Finset.max'_le` を用いる。
役割: `NoHitBK_iff_mwfLr_le` の前向き (`NoHitBK → mwfLr` 上界) を分離する。
-/
private lemma mwfLr_le_of_NoHitBK
    (hA : 0 < A)
    (hLR : L < R)
    (hNo : NoHitBK D A B K L R) :
    Mwf.mwfLr L R A B (-(Mof D A B)) D 0 hLR hA ≤ B * K := by
  unfold Mwf.mwfLr
  simpa only [Mwf.Spec.imgLr] using
    max'_image_le_of_forall
      (Mwf.Spec.domLr L R hLR)
      (fun u => Mwf.Spec.obj B (-(Mof D A B)) D 0 A u hA)
      (Mwf.Spec.imgLr_nonempty
        (L := L) (R := R) (M := A) (A := B) (B := -(Mof D A B)) (C := D) (D := 0) hLR hA)
      (fun u huDom => by
        have huI : u ∈ Finset.Icc L (R - 1) := by
          simpa only [Mwf.Spec.domLr] using huDom
        rcases Finset.mem_Icc.mp huI with ⟨hLu, huR1⟩
        have huR : u < R := by omega
        simpa only [obj_eq_fBinary (D := D) (A := A) (B := B) (u := u) hA] using
          hNo u hLu huR)

/--
入力/前提: `hA : 0 < A`, `hLR : L < R`、`Mwf.mwfLr ... ≤ B*K`。
主張: 区間 `[L,R)` では `NoHitBK D A B K L R`。
内容: 任意の `u ∈ [L,R)` を像の要素として `Finset.le_max'` に流し、`obj_eq_fBinary` で戻す。
証明: `u ∈ domLr` の所属から `obj ≤ mwfLr` を得て、仮定と合成する。
役割: `NoHitBK_iff_mwfLr_le` の逆向き (`mwfLr` 上界 → NoHitBK`) を分離する。
-/
private lemma NoHitBK_of_mwfLr_le
    (hA : 0 < A)
    (hLR : L < R)
    (hMwf : Mwf.mwfLr L R A B (-(Mof D A B)) D 0 hLR hA ≤ B * K) :
    NoHitBK D A B K L R := by
  intro u hLu huR
  exact
    fBinary_le_of_mwfLr_le
      (D := D) (A := A) (B := B) (K := K) (L := L) (R := R) hA hLR hMwf hLu huR

/--
入力/前提: hA : 0 < A、_hL0 : 0 ≤ L、hLR : L < R。
主張: `NoHitBK D A B K L R` と `Mwf.mwfLr ... ≤ B*K` は同値。
内容: `Mwf.mwfLr` を `[L,R)` 上の `fBinary` 最大値として評価し、全称条件と突き合わせる。
証明: `Finset.max'` の評価（上界化と要素評価）で示す。
役割: `mwfLr_iter_le`（`mwfLr_iter` 判定）を `NoHitBK` に接続するために使う。
-/
private lemma NoHitBK_iff_mwfLr_le
    (hA : 0 < A)
    (_hL0 : 0 ≤ L)
    (hLR : L < R) :
    NoHitBK D A B K L R ↔
      Mwf.mwfLr L R A B (-(Mof D A B)) D 0 hLR hA ≤ B * K := by
  constructor
  · intro hNo
    exact mwfLr_le_of_NoHitBK
      (D := D) (A := A) (B := B) (K := K) (L := L) (R := R) hA hLR hNo
  · intro hMwf
    exact NoHitBK_of_mwfLr_le
      (D := D) (A := A) (B := B) (K := K) (L := L) (R := R) hA hLR hMwf

/--
入力/前提: hD : 0 < D。
主張: `D > 0` の下で `D*u < X ↔ u < (X + D - 1) / D`。
内容: `u+1` 形に変換して `Int.le_ediv_iff_mul_le` を往復する。
証明: 式変形・既存補題の書き換えで示す。
役割: `x` 側閾値比較を `u` 側の天井除算比較へ変換する。
-/
private lemma mul_lt_X_iff_lt_ceilDiv
    (hD : 0 < D) :
    D * u < X ↔ u < (X + D - 1) / D := by
  constructor
  · intro hMul
    have hDU1 : D * u + 1 ≤ X := (Int.add_one_le_iff).2 hMul
    have hMul' : (u + 1) * D ≤ X + D - 1 := by
      have hTmp : D * u + 1 + (D - 1) ≤ X + (D - 1) := by
        simpa only [add_assoc, add_sub_cancel, add_comm] using add_le_add_right hDU1 (D - 1)
      calc
        (u + 1) * D = D * u + 1 + (D - 1) := by ring
        _ ≤ X + (D - 1) := hTmp
        _ = X + D - 1 := by ring
    have hU1 : u + 1 ≤ (X + D - 1) / D := (Int.le_ediv_iff_mul_le hD).2 hMul'
    exact (Int.lt_iff_add_one_le).2 hU1
  · intro hLt
    have hU1 : u + 1 ≤ (X + D - 1) / D := (Int.lt_iff_add_one_le).1 hLt
    have hMul' : (u + 1) * D ≤ X + D - 1 := (Int.le_ediv_iff_mul_le hD).1 hU1
    have hDU1 : D * u + 1 ≤ X := by
      have hSub : (u + 1) * D - (D - 1) ≤ X + D - 1 - (D - 1) := sub_le_sub_right hMul' (D - 1)
      calc
        D * u + 1 = (u + 1) * D - (D - 1) := by ring
        _ ≤ X + D - 1 - (D - 1) := hSub
        _ = X := by ring
    exact (Int.add_one_le_iff).1 hDU1

end Internal

end NoHit

namespace NoHit

namespace Internal

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `¬ NoHitDelta ... L R` は区間内のヒット点存在と同値。
内容: `NoHitDelta` の全称否定を `simp` で存在形へ展開する。
証明: 既存補題の適用と式変形で示す。
役割: 不成立判定を具体的な証人 `u` の存在として扱う補助補題。
-/
private lemma not_NoHitDelta_iff_exists
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B) :
    ¬ NoHitDelta D A B K hD hA hB L R ↔
      ∃ u : Int, L ≤ u ∧ u < R ∧ K < Delta D A B (D * u) hD hA hB := by
  classical
  simp [NoHitDelta, not_lt, not_forall, not_le]

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: 解があるとき `¬ NoHitDelta ... 0 N ↔ uMinOf < N`。
内容: `→` は区間内可解点から `uMinOf ≤ u < N`、`←` は `uMinOf` 自身を証人に使う。
証明: 既存補題の適用と式変形で示す。
役割: 区間判定と最小解の位置比較を同一視する。
-/
private lemma not_NoHitDelta_zero_iff_uMin_lt
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hex : HasUSolution D A B K hD hA hB) :
    ¬ NoHitDelta D A B K hD hA hB 0 N ↔
      uMinOf D A B K hD hA hB hex < N := by
  constructor
  · intro hNot
    rcases
      (not_NoHitDelta_iff_exists
        (D := D) (A := A) (B := B) (K := K) (L := 0) (R := N) hD hA hB).1 hNot with
      ⟨u, hu0, huN, huDelta⟩
    have hLe :
        uMinOf D A B K hD hA hB hex ≤ u := by
      exact
        Divapprox.Search.Internal.uMinOf_le_of_sol
          (D := D) (A := A) (B := B) (K := K) hD hA hB hex ⟨hu0, huDelta⟩
    exact lt_of_le_of_lt hLe huN
  · intro huLt hNo
    rcases
        Divapprox.Search.Internal.uMinOf_mem
          (D := D) (A := A) (B := B) (K := K) hD hA hB hex
      with ⟨hu0, huDelta⟩
    exact (hNo (uMinOf D A B K hD hA hB hex) hu0 huLt) huDelta

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B、可解性 `hex`。
主張: `xMin < X` は `uMinOf < (X + D - 1) / D` と同値。
内容: `xMin = D * uMinOf` と `mul_lt_X_iff_lt_ceilDiv` を直接つなぐ。
証明: `xMin_eq_D_mul_uMinOf` で左辺を `D*uMinOf` に変換し、ceiling 除算補題を適用する。
役割: `xMin_lt_X_iff_not_NoHitDelta` から `xMin` と `uMinOf` の換算部分を切り出す。
-/
private lemma xMin_lt_X_iff_uMin_lt_ceilDiv
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hex : HasUSolution D A B K hD hA hB) :
    xMin D A B K hD hA hB < X ↔
      uMinOf D A B K hD hA hB hex < (X + D - 1) / D := by
  have hxEq :
      xMin D A B K hD hA hB = D * uMinOf D A B K hD hA hB hex := by
    exact
      Correctness.Internal.xMin_eq_D_mul_uMinOf
        (D := D) (A := A) (B := B) (K := K) hD hA hB hex
  simpa only [hxEq, gt_iff_lt] using
    (NoHit.Internal.mul_lt_X_iff_lt_ceilDiv
      (D := D) (X := X) (u := uMinOf D A B K hD hA hB hex) hD)

/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `Nceil = (X + D - 1)/D` として `xMin < X ↔ ¬ NoHitDelta ... 0 Nceil`。
内容: `xMin = D*uMinOf`、`mul_lt_X_iff_lt_ceilDiv`、`not_NoHitDelta_zero_iff_uMin_lt` を連結する。
証明: 既存補題の書き換えで示す。
役割: `x_min < X` を `NoHitDelta` の1回評価に帰着する判定定理。
-/
private theorem xMin_lt_X_iff_not_NoHitDelta
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hex : HasUSolution D A B K hD hA hB)
    (_hX : 0 ≤ X) :
    let Nceil : Int := (X + D - 1) / D
    xMin D A B K hD hA hB < X ↔
      ¬ NoHitDelta D A B K hD hA hB 0 Nceil := by
  dsimp only [Lean.Elab.WF.paramLet]
  exact
    (xMin_lt_X_iff_uMin_lt_ceilDiv
      (D := D) (A := A) (B := B) (K := K) (X := X) hD hA hB hex).trans
      (not_NoHitDelta_zero_iff_uMin_lt
        (D := D) (A := A) (B := B) (K := K) (N := (X + D - 1) / D) hD hA hB hex).symm

end Internal

end NoHit

end BinarySearchMinSketch

section Executable

/--
目的: 区間最大値判定 `max_{l≤u<r} fBinary(u) ≤ t` を実行可能な `Bool` として与える。
定義: `l<r` と `0<m` が満たされるとき `Mwf.mwfLr_iter` を評価し、`≤ t` を `decide` で返す。
入力/前提: t l r m a b c d : Int。
出力: 型 `Bool` の値を返す。
役割: 二分探索の分岐判定（`lo` 側が安全か）に用いる。
-/
private def mwfLr_iter_le (t l r m a b c d : Int) : Bool :=
  if hLR : l < r then
    if hM : 0 < m then
      decide (Mwf.Impl.mwfLr_iter l r m a b c d hLR hM ≤ t)
    else
      true
  else
    true

/--
目的: `u` 上の探索本体を実行可能に定義する。
定義: `fuel` 回を上限に区間 `[lo,hi)` を二分し、左半分の安全性で分岐して最初の unsafe 点を返す。
入力/前提: fuel bk lo hi A B M D : Int、hA : 0 < A。
出力: 型 `Int` の値を返す。
役割: `compute_u_binary` の反復本体。
-/
private def compute_u_binary_aux
    (fuel : Nat) (bk lo hi A B M D : Int) (hA : 0 < A) : Int :=
  match fuel with
  | 0 => lo
  | fuel + 1 =>
      if _hGap : lo + 1 < hi then
        let mid := (lo + hi) / 2
        if mwfLr_iter_le bk lo mid A B (-M) D 0 then
          compute_u_binary_aux fuel bk mid hi A B M D hA
        else
          compute_u_binary_aux fuel bk lo mid A B M D hA
      else
        lo

/--
目的: `u` 側探索を実行する。
定義: 始点 `lo` と上端 `hi` の区間を `compute_u_binary_aux` で二分探索し、最初の unsafe 点を返す。
入力/前提: bk lo hi A B M D : Int、hA : 0 < A。
出力: 型 `Int` の値を返す。
役割: `compute_xmin` から直接使う `u` 探索インターフェース。
-/
private def compute_u_binary (bk lo hi A B M D : Int) (hA : 0 < A) : Int :=
  compute_u_binary_aux (Int.toNat (hi - lo + 1)) bk lo hi A B M D hA

namespace Impl

/--
目的: 問題 `xMin(D,A,B,K)` の計算版を定義する。
定義: `R=(AB)%D` の分岐で探索区間 `[lo,hi)` を作り、区間判定 `mwfLr_iter_le` を使う二分探索で `u_min`
      を求め、`x_min = D * u_min` を返す。解が無い場合（`R=0` かつ `D*K+gcd(D,A)≥A`）は `-1`。
入力/前提: D A B K : Int（実装上は `D>0, A>0, B>0, K≥0` を想定）。
出力: 型 `Int` の値を返す。
役割: 後続の正当性証明で結び付ける実行可能アルゴリズム本体。
-/
def compute_xMin (D A B K : Int) : Int :=
  if _hD : 0 < D then
    if hA : 0 < A then
      if _hB : 0 < B then
        if _hK : 0 ≤ K then
          let g : Int := gcdDA D A
          let bk : Int := B * K
          let M : Int := Mof D A B
          let R : Int := Rof D A B
          if _hR0 : R = 0 then
            if _hNo : A ≤ D * K + g then
              -1
            else
              let lo : Int := K + 1
              let hi : Int := A / g
              D * compute_u_binary bk lo hi A B M D hA
          else
            let lo : Int := K + 1
            let hi : Int := (A * B * K) / R + 2
            D * compute_u_binary bk lo hi A B M D hA
        else
          -1
      else
        -1
    else
      -1
  else
    -1

end Impl

end Executable

-- #eval compute_xMin 1 1 1 0 -- 例: D=1, A=1, B=1, K=0 のときの x_min を計算
-- #eval compute_xMin 998244353 1000000000 1000000000 2
-- #eval compute_xMin 420196140727489673 679891637638612258 999999999999999989 7
-- #eval compute_xMin 10000000000000000000 18446744073709551616 18446744073709551616 2
-- #eval compute_xMin 10000000000000000000 18446744073709551616 18446744073709551616 3

section ComputeCorrectness

variable {D A B K : Int}

namespace NoHit

namespace Internal

/--
入力/前提: `hA : 0 < A`, `hL0 : 0 ≤ L`。
主張: 判定 `mwfLr_iter_le` は `NoHitBK` と同値。
内容: `L < R` の場合は `Mwf.mwfLr_iter_collect` と `NoHitBK_iff_mwfLr_le` に還元し、
  `L ≥ R` の場合は空区間で自明。
証明: 場合分けと `simp` で示す。
役割: 実装側 Bool 判定を論理側述語へ持ち上げる接続補題。
-/
private lemma mwfLr_iter_le_iff_NoHitBK
    {L R : Int}
    (hA : 0 < A)
    (hL0 : 0 ≤ L) :
    mwfLr_iter_le (B * K) L R A B (-(Mof D A B)) D 0 = true ↔
      NoHitBK D A B K L R := by
  by_cases hLR : L < R
  · have hCollect :
        Mwf.Impl.mwfLr_iter L R A B (-(Mof D A B)) D 0 hLR hA
          = Mwf.mwfLr L R A B (-(Mof D A B)) D 0 hLR hA := by
        exact Mwf.Correctness.mwfLr_iter_correct L R A B (-(Mof D A B)) D 0 hLR hA
    have hBool :
        mwfLr_iter_le (B * K) L R A B (-(Mof D A B)) D 0 = true ↔
          Mwf.mwfLr L R A B (-(Mof D A B)) D 0 hLR hA ≤ B * K := by
      simp [mwfLr_iter_le, hLR, hA, hCollect]
    exact hBool.trans
      (NoHitBK_iff_mwfLr_le
        (D := D) (A := A) (B := B) (K := K) (L := L) (R := R) hA hL0 hLR).symm
  · have hRleL : R ≤ L := le_of_not_gt hLR
    have hNo : NoHitBK D A B K L R := by
      intro u hLu huR
      exfalso
      exact (not_lt_of_ge (le_trans hRleL hLu)) huR
    simp only [mwfLr_iter_le, hLR, ↓reduceDIte, hNo]

/--
入力/前提: `hA : 0 < A`, `hL0 : 0 ≤ L`、判定値が `true`。
主張: 左区間 `[L,R)` は `NoHitBK` を満たす。
内容: `mwfLr_iter_le_iff_NoHitBK` の前向き射影。
証明: 同値補題の `mp`。
役割: 二分探索本体で safe 分岐から論理的不変量を取り出す。
-/
private lemma NoHitBK_of_mwfLr_iter_le_true
    {L R : Int}
    (hA : 0 < A) (hL0 : 0 ≤ L)
    (hSafe : mwfLr_iter_le (B * K) L R A B (-(Mof D A B)) D 0 = true) :
    NoHitBK D A B K L R :=
  (mwfLr_iter_le_iff_NoHitBK (D := D) (A := A) (B := B) (K := K) (L := L) (R := R) hA hL0).mp
    hSafe

/--
入力/前提: `hA : 0 < A`, `hL0 : 0 ≤ L`、判定値が `true` でない。
主張: 左区間 `[L,R)` には unsafe 点 `u` が存在する。
内容: `mwfLr_iter_le_iff_NoHitBK` で `¬ NoHitBK` に戻し、存在補題へ送る。
証明: 反証法で `NoHitBK` を排し、`not_NoHitBK_iff_exists_hit` を適用する。
役割: 二分探索本体で unsafe 分岐の証人抽出を 1 行にする。
-/
private lemma exists_hit_of_mwfLr_iter_le_ne_true
    {L R : Int}
    (hA : 0 < A) (hL0 : 0 ≤ L)
    (hUnsafe : mwfLr_iter_le (B * K) L R A B (-(Mof D A B)) D 0 ≠ true) :
    ∃ u : Int, L ≤ u ∧ u < R ∧ B * K < fBinary D A B u := by
  classical
  have hNo : ¬ NoHitBK D A B K L R := by
    intro hNoHit
    exact hUnsafe <|
      (mwfLr_iter_le_iff_NoHitBK
        (D := D) (A := A) (B := B) (K := K) (L := L) (R := R) hA hL0).mpr hNoHit
  simpa [NoHitBK, not_le] using hNo

end Internal

end NoHit

/--
入力/前提: なし（古典論理）。
主張: `¬ NoHitBK ... L R` は区間内の unsafe 点の存在と同値。
内容: 全称否定を存在形に展開する。
証明: 反証法で示す。
役割: 左半区間が unsafe な分岐で証人 `u` を取り出すために使う。
-/
private lemma not_NoHitBK_iff_exists_hit
    {L R : Int} :
    ¬ Divapprox.NoHit.Internal.NoHitBK D A B K L R ↔
      ∃ u : Int, L ≤ u ∧ u < R ∧
        B * K < Divapprox.NoHit.Internal.fBinary D A B u := by
  classical
  simp [Divapprox.NoHit.Internal.NoHitBK, not_le]

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`、可解性 `hex`。
主張: `uMinOf` 自身は `B*K < fBinary ...` を満たす unsafe 点である。
内容: `uMinOf_mem` で得た `K < Delta` を `lt_Delta_iff_BK_lt_fBinary` で移す。
証明: 2 本の既存補題の直接合成。
役割: `compute_u_binary_eq_uMinOf_of_hi` で目標点の unsafe 性を 1 行で得る。
-/
private lemma uMinOf_unsafe_fBinary
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) (hK : 0 ≤ K)
    (hex : HasUSolution D A B K hD hA hB) :
    B * K <
      Divapprox.NoHit.Internal.fBinary D A B
        (uMinOf D A B K hD hA hB hex) := by
  have huMin : Search.Internal.SolU D A B K hD hA hB (uMinOf D A B K hD hA hB hex) :=
    Divapprox.Search.Internal.uMinOf_mem
      (D := D) (A := A) (B := B) (K := K) hD hA hB hex
  simpa using
    (Divapprox.NoHit.Internal.lt_Delta_iff_BK_lt_fBinary
      (D := D) (A := A) (B := B) (K := K)
      (u := uMinOf D A B K hD hA hB hex) hD hA hB huMin.1 hK).1 huMin.2

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`、可解性 `hex`、
  `u` の非負性と unsafe 証明。
主張: `uMinOf ... ≤ u`。
内容: `B*K < fBinary ... u` を `K < Delta ...` に戻し、`uMinOf_le_of_sol` を適用する。
証明: 既存の変換補題と最小性補題の合成。
役割: `compute_u_binary_eq_uMinOf_of_hi` で最小性を 1 行で使う。
-/
private lemma uMinOf_le_of_unsafe_fBinary
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) (hK : 0 ≤ K)
    (hex : HasUSolution D A B K hD hA hB)
    {u : Int}
    (hu0 : 0 ≤ u)
    (huUnsafe : B * K < Divapprox.NoHit.Internal.fBinary D A B u) :
    uMinOf D A B K hD hA hB hex ≤ u := by
  simpa using
    Divapprox.Search.Internal.uMinOf_le_of_sol
      (D := D) (A := A) (B := B) (K := K) hD hA hB hex
      ⟨hu0,
        (Divapprox.NoHit.Internal.lt_Delta_iff_BK_lt_fBinary
          (D := D) (A := A) (B := B) (K := K) (u := u) hD hA hB hu0 hK).2 huUnsafe⟩

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`、可解性 `hex`。
主張: `tgt := uMinOf ...` は binary search target の 2 条件
  「unsafe」と「最小性」を満たす。
内容: unsafe 性は `uMinOf_unsafe_fBinary`、最小性は
  `uMinOf_le_of_unsafe_fBinary` をそのまま束ねる。
証明: 2 本の既存補題を組にして返す。
役割: `compute_u_binary_eq_uMinOf_of_hi` の前提準備を 1 箇所にまとめる。
-/
private lemma uMinOf_binary_target_spec
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) (hK : 0 ≤ K)
    (hex : HasUSolution D A B K hD hA hB) :
    B * K < Divapprox.NoHit.Internal.fBinary D A B (uMinOf D A B K hD hA hB hex) ∧
      (∀ u : Int, 0 ≤ u →
        B * K < Divapprox.NoHit.Internal.fBinary D A B u →
          uMinOf D A B K hD hA hB hex ≤ u) := by
  refine ⟨?_, ?_⟩
  · simpa using
      (uMinOf_unsafe_fBinary
        (D := D) (A := A) (B := B) (K := K) hD hA hB hK hex)
  · intro u hu0 huUnsafe
    simpa using
      (uMinOf_le_of_unsafe_fBinary
        (D := D) (A := A) (B := B) (K := K) hD hA hB hK hex hu0 huUnsafe)

/--
入力/前提: `lo ≤ hi`。
主張: 幅 `hi - lo` は燃料候補 `Int.toNat (hi - lo + 1)` 以下。
内容: `hi - lo + 1` の非負性で `Int.toNat` を外し、`n ≤ n+1` を使う。
証明: `Int.toNat_of_nonneg` と算術。
役割: `compute_u_binary_eq_uMinOf_of_hi` の初期 fuel 上界を共通化する。
-/
private lemma width_le_toNat_add_one (lo hi : Int) (hlohi : lo ≤ hi) :
    hi - lo ≤ (Int.toNat (hi - lo + 1) : Int) := by
  have hCast : (Int.toNat (hi - lo + 1) : Int) = hi - lo + 1 := by
    exact Int.toNat_of_nonneg (by omega)
  calc
    hi - lo ≤ hi - lo + 1 := by omega
    _ = (Int.toNat (hi - lo + 1) : Int) := by
      symm
      exact hCast

/--
入力/前提: `hA : 0 < A`、`0 ≤ lo ≤ tgt`、左半区間 `[lo, mid)` が safe。
主張: `mid ≤ tgt`。
内容: `tgt < mid` と仮定すると、safe 性から `tgt` 自身が safe になり
  `hTgtUnsafe` に矛盾する。
証明: `NoHitBK_of_mwfLr_iter_le_true` を使って左半区間の `NoHitBK` を取り出し、
  反証法で示す。
役割: `compute_u_binary_aux_eq_tgt` の safe 分岐から midpoint 比較だけを切り出す。
-/
private lemma mid_le_tgt_of_left_safe
    (hA : 0 < A)
    {lo mid tgt : Int}
    (hlo0 : 0 ≤ lo)
    (hloTgt : lo ≤ tgt)
    (hTgtUnsafe : B * K < Divapprox.NoHit.Internal.fBinary D A B tgt)
    (hSafe : mwfLr_iter_le (B * K) lo mid A B (-(Mof D A B)) D 0 = true) :
    mid ≤ tgt := by
  have hNoLeft : Divapprox.NoHit.Internal.NoHitBK D A B K lo mid := by
    simpa using
      (NoHit.Internal.NoHitBK_of_mwfLr_iter_le_true
        (D := D) (A := A) (B := B) (K := K) (L := lo) (R := mid) hA hlo0 hSafe)
  by_contra hNot
  exact
    (not_lt_of_ge (hNoLeft tgt hloTgt (lt_of_not_ge hNot))) hTgtUnsafe

/--
入力/前提: `hA : 0 < A`、`0 ≤ lo`、左半区間 `[lo, mid)` が unsafe、
  `tgt` は最小 unsafe 点。
主張: `tgt < mid`。
内容: 左半区間内の unsafe witness `u` を取り出し、最小性 `tgt ≤ u` と `u < mid`
  をつなぐ。
証明: `exists_hit_of_mwfLr_iter_le_ne_true` で witness を取得して示す。
役割: `compute_u_binary_aux_eq_tgt` の unsafe 分岐から midpoint 比較だけを切り出す。
-/
private lemma tgt_lt_mid_of_left_unsafe
    (hA : 0 < A)
    {lo mid tgt : Int}
    (hlo0 : 0 ≤ lo)
    (hTgtMin :
      ∀ u : Int, 0 ≤ u →
        B * K < Divapprox.NoHit.Internal.fBinary D A B u → tgt ≤ u)
    (hUnsafe : mwfLr_iter_le (B * K) lo mid A B (-(Mof D A B)) D 0 ≠ true) :
    tgt < mid := by
  rcases
      NoHit.Internal.exists_hit_of_mwfLr_iter_le_ne_true
        (D := D) (A := A) (B := B) (K := K) (L := lo) (R := mid) hA hlo0 hUnsafe
    with ⟨u, hLu, huMid, huUnsafe⟩
  exact lt_of_le_of_lt (hTgtMin u (le_trans hlo0 hLu) huUnsafe) huMid

/--
入力/前提: `tgt` は最小 unsafe 点（`hTgtUnsafe`, `hTgtMin`）。
主張: 区間不変量 `lo ≤ tgt < hi` と幅上界 `hi-lo ≤ fuel` の下で
  `compute_u_binary_aux` は `tgt` を返す。
内容: `lo+1<hi` なら中点 `mid` で分岐し、左半分安全なら `mid ≤ tgt`、
  unsafe なら証人から `tgt < mid` を得て帰納法を適用する。
証明: `fuel` に関する帰納法で示す。
役割: `compute_u_binary_eq_uMinOf_of_hi` の中核補題。
-/
private lemma compute_u_binary_aux_eq_tgt
    (hA : 0 < A)
    (tgt : Int)
    (hTgtUnsafe : B * K < Divapprox.NoHit.Internal.fBinary D A B tgt)
    (hTgtMin :
      ∀ u : Int, 0 ≤ u →
        B * K < Divapprox.NoHit.Internal.fBinary D A B u → tgt ≤ u) :
    ∀ fuel : Nat, ∀ lo hi : Int,
      0 ≤ lo →
      lo ≤ tgt →
      tgt < hi →
      hi - lo ≤ (fuel : Int) →
      compute_u_binary_aux fuel (B * K) lo hi A B (Mof D A B) D hA = tgt := by
  intro fuel
  induction fuel with
  | zero =>
      intro lo hi hlo0 hloTgt htgtHi hWidth
      have : False := by omega
      exact False.elim this
  | succ fuel ih =>
      intro lo hi hlo0 hloTgt htgtHi hWidth
      by_cases hGap : lo + 1 < hi
      · set mid : Int := (lo + hi) / 2
        have hTwoPos : (0 : Int) < 2 := by decide
        have hMidGeLo1 : lo + 1 ≤ mid := by
          have hMul : (lo + 1) * 2 ≤ lo + hi := by omega
          have hDiv : lo + 1 ≤ (lo + hi) / 2 := (Int.le_ediv_iff_mul_le hTwoPos).2 hMul
          simpa only [Order.add_one_le_iff, gt_iff_lt] using hDiv
        have hMidLtHi : mid < hi := by
          have hMul : lo + hi < hi * 2 := by omega
          have hDiv : (lo + hi) / 2 < hi := (Int.ediv_lt_iff_lt_mul hTwoPos).2 hMul
          simpa only [gt_iff_lt] using hDiv
        by_cases hSafe :
            mwfLr_iter_le (B * K) lo mid A B (-(Mof D A B)) D 0 = true
        · have hMidLeTgt : mid ≤ tgt :=
            mid_le_tgt_of_left_safe
              (D := D) (A := A) (B := B) (K := K) hA hlo0 hloTgt hTgtUnsafe hSafe
          have hMid0 : 0 ≤ mid := by omega
          have hWidthRight : hi - mid ≤ (fuel : Int) := by
            omega
          simpa only [compute_u_binary_aux, hGap, mid, ↓reduceDIte, hSafe, ↓reduceIte] using
            ih mid hi hMid0 hMidLeTgt htgtHi hWidthRight
        · have hTgtLtMid : tgt < mid :=
            tgt_lt_mid_of_left_unsafe
              (D := D) (A := A) (B := B) (K := K) hA hlo0 hTgtMin hSafe
          have hWidthLeft : mid - lo ≤ (fuel : Int) := by
            omega
          simpa only [compute_u_binary_aux, hGap, mid, ↓reduceDIte, hSafe, Bool.false_eq_true,
            ↓reduceIte] using ih lo mid hlo0 hloTgt hTgtLtMid hWidthLeft
      · have hEq : tgt = lo := by
          have hHiLe : hi ≤ lo + 1 := le_of_not_gt hGap
          omega
        simp only [compute_u_binary_aux, hGap, ↓reduceDIte, hEq]

namespace Impl

namespace Internal

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`。
主張: `hi` が `uMinOf` の上界なら、実装側 `compute_u_binary` は `uMinOf` を返す。
内容: 二分探索 `compute_u_binary_aux` について、左半区間安全判定と最小可解点の性質を接続する。
証明: `uMinOf` の unsafe 性と最小性を `compute_u_binary_aux_eq_tgt` に渡し、
  初期区間 `[K+1, hi)` と fuel 上界 `hi-(K+1) ≤ toNat(hi-(K+1)+1)` を与えて示す。
役割: `R=0` / `R≠0` の両分岐で使う共通接続補題。
-/
private lemma compute_u_binary_eq_uMinOf_of_hi
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) (hK : 0 ≤ K) :
    ∀ (hex : HasUSolution D A B K hD hA hB)
      (hi : Int),
      K + 1 ≤ uMinOf D A B K hD hA hB hex →
      uMinOf D A B K hD hA hB hex < hi →
      compute_u_binary (B * K) (K + 1) hi A B (Mof D A B) D hA
        = uMinOf D A B K hD hA hB hex := by
  intro hex hi hlo htgtHi
  have hSpec :=
    uMinOf_binary_target_spec (D := D) (A := A) (B := B) (K := K) hD hA hB hK hex
  have hlo0 : 0 ≤ K + 1 := by omega
  have hWidth :
      hi - (K + 1) ≤ (Int.toNat (hi - (K + 1) + 1) : Int) := by
    exact width_le_toNat_add_one (K + 1) hi (le_trans hlo (le_of_lt htgtHi))
  simpa only [compute_u_binary] using
    (compute_u_binary_aux_eq_tgt
      (D := D) (A := A) (B := B) (K := K)
      hA (uMinOf D A B K hD hA hB hex) hSpec.1 hSpec.2
      (Int.toNat (hi - (K + 1) + 1)) (K + 1) hi
      hlo0 hlo htgtHi hWidth)

end Internal

end Impl

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`、
  可解性 `hex` と上端 `hi` に対する `uMinOf < hi`。
主張: 実装側 `compute_u_binary` は `uMinOf` を返し、したがって `D` 倍しても一致する。
内容: 下界 `K + 1 ≤ uMinOf` は `uMin_lower_bound` で与え、上界仮定とともに
  `Impl.Internal.compute_u_binary_eq_uMinOf_of_hi` へ渡す。
証明: 共通下界を作って `compute_u_binary_eq_uMinOf_of_hi` を適用し、最後に `simp` する。
役割: `hbinR0` / `hbinRnz` の共通骨格をまとめる。
-/
private lemma D_mul_compute_u_binary_eq_uMinOf_of_hi
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) (hK : 0 ≤ K)
    (hex : HasUSolution D A B K hD hA hB)
    (hi : Int)
    (htgtHi : uMinOf D A B K hD hA hB hex < hi) :
    D * compute_u_binary (B * K) (K + 1) hi A B (Mof D A B) D hA =
      D * uMinOf D A B K hD hA hB hex := by
  simpa using congrArg (fun u => D * u)
    (Impl.Internal.compute_u_binary_eq_uMinOf_of_hi
      (D := D) (A := A) (B := B) (K := K) hD hA hB hK hex hi
      (Bounds.Internal.uMin_lower_bound
        (D := D) (A := A) (B := B) (K := K) hD hA hB hex)
      htgtHi)

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`、
  可解性 `hex`、`hR0 : Rof D A B = 0`。
主張: `D * K + gcdDA D A < A`。
内容: `R = 0` での可解性同値から必要条件を取り出す。
証明: `Bounds.Internal.exists_u_iff_DK_add_g_lt_A_of_R_eq_zero` の前向き射影。
役割: `hbinR0` と `compute_xMin_eq_D_mul_uMinOf_of_R_eq_zero` で
  `hiff.mp hex` の重複をなくす。
-/
private lemma DK_add_g_lt_A_of_hasUSolution_of_R_eq_zero
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) (hK : 0 ≤ K)
    (hex : HasUSolution D A B K hD hA hB)
    (hR0 : Rof D A B = 0) :
    D * K + gcdDA D A < A := by
  simpa using
    (Bounds.Internal.exists_u_iff_DK_add_g_lt_A_of_R_eq_zero
      (D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0).mp hex

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`、
  `hR0 : Rof D A B = 0`、`hcond : ¬ D * K + gcdDA D A < A`。
主張: `R = 0` の不可解条件から、`SolU` の witness は存在しない。
内容: `R = 0` での可解性同値の contraposition を、
  `HasUSolution` から `∃ u, SolU ... u` への変換までまとめる。
証明: `exists_u_iff_DK_add_g_lt_A_of_R_eq_zero` の逆向きを `mt` し、`simpa` で整える。
役割: `compute_xMin_eq_xMin_of_R_eq_zero` の不可解枝にある定型変換を共通化する。
-/
private lemma no_solU_of_not_DK_add_g_lt_A_of_R_eq_zero
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) (hK : 0 ≤ K)
    (hR0 : Rof D A B = 0)
    (hcond : ¬ D * K + gcdDA D A < A) :
    ¬ ∃ u : Int, Search.Internal.SolU D A B K hD hA hB u := by
  have hnoU : ¬ HasUSolution D A B K hD hA hB := by
    exact mt
      ((Bounds.Internal.exists_u_iff_DK_add_g_lt_A_of_R_eq_zero
        (D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0).mp)
      hcond
  simpa only [not_exists, HasUSolution] using hnoU

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`。
主張: `R=0` かつ可解な場合、実装側 `compute_u_binary` が `uMinOf` と一致する（`x=D*u` 形）。
内容: `R=0` 同値条件から `D*K+gcd(D,A)<A` を得て、
  `uMin_lower_bound` と `A/g` 未満の witness 構成で探索範囲を閉じる。
証明: `compute_u_binary_eq_uMinOf_of_hi` を `hi = A/g` に適用する。
役割: `compute_xMin_eq_xMin` の `R=0` 可解分岐を閉じる。
-/
private lemma hbinR0
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) (hK : 0 ≤ K) :
    ∀ (hex : HasUSolution D A B K hD hA hB),
      Rof D A B = 0 →
      D * compute_u_binary (B * K) (K + 1) (A / gcdDA D A) A B (Mof D A B) D hA
        = D * uMinOf D A B K hD hA hB hex := by
  intro hex hR0
  have htgtHi : uMinOf D A B K hD hA hB hex < A / gcdDA D A := by
    have hcond : D * K + gcdDA D A < A :=
      DK_add_g_lt_A_of_hasUSolution_of_R_eq_zero
        (D := D) (A := A) (B := B) (K := K) hD hA hB hK hex hR0
    simpa using
      Bounds.Internal.uMinOf_lt_of_exists_sol_lt
        (D := D) (A := A) (B := B) (K := K) hD hA hB hex
        (Bounds.Internal.exists_solU_lt_A_div_g_of_R_eq_zero
          (D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0 hcond)
  simpa using
    D_mul_compute_u_binary_eq_uMinOf_of_hi
      (D := D) (A := A) (B := B) (K := K) hD hA hB hK hex (A / gcdDA D A) htgtHi

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`。
主張: `R≠0` かつ可解な場合、実装側 `compute_u_binary` が `uMinOf` と一致する（`x=D*u` 形）。
内容: `uMin_lower_bound` と `floor(ABK/R)+2` 未満の witness 構成で探索範囲を閉じる。
証明: `compute_u_binary_eq_uMinOf_of_hi` を `hi = floor(ABK/R)+2` に適用する。
役割: `compute_xMin_eq_xMin` の `R≠0` 分岐を閉じる。
-/
private lemma hbinRnz
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) (hK : 0 ≤ K) :
    ∀ (hex : HasUSolution D A B K hD hA hB),
      Rof D A B ≠ 0 →
      let lo : Int := K + 1
      let hi : Int := (A * B * K) / (Rof D A B) + 2
      D * compute_u_binary (B * K) lo hi A B (Mof D A B) D hA
        = D * uMinOf D A B K hD hA hB hex := by
  intro hex hRnz
  have htgtHi :
      uMinOf D A B K hD hA hB hex < (A * B * K) / (Rof D A B) + 2 := by
    simpa using
      Bounds.Internal.uMinOf_lt_of_exists_sol_lt
        (D := D) (A := A) (B := B) (K := K) hD hA hB hex
        (Bounds.Internal.exists_solU_lt_floor_ABK_div_R_plus_two_of_R_ne_zero
          (D := D) (A := A) (B := B) (K := K) hD hA hB hK hRnz)
  simpa only [Lean.Elab.WF.paramLet] using
    D_mul_compute_u_binary_eq_uMinOf_of_hi
      (D := D) (A := A) (B := B) (K := K) hD hA hB hK hex
      ((A * B * K) / (Rof D A B) + 2) htgtHi

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`、
  可解性 `hex`、`hR0 : Rof D A B = 0`。
主張: `R = 0` かつ可解な場合、実装側 `compute_xMin` は `D * uMinOf` を返す。
内容: `R = 0` の可解条件を回収し、`hbinR0` に接続する。
証明: `compute_xMin` の該当分岐を展開し、`hbinR0` を適用する。
役割: `compute_xMin_eq_xMin` の `R = 0` 可解分岐を helper に分離する。
-/
private lemma compute_xMin_eq_D_mul_uMinOf_of_R_eq_zero
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) (hK : 0 ≤ K)
    (hex : HasUSolution D A B K hD hA hB)
    (hR0 : Rof D A B = 0) :
    Impl.compute_xMin D A B K = D * uMinOf D A B K hD hA hB hex := by
  have hnotle : ¬ A ≤ D * K + gcdDA D A :=
    not_le.mpr
      (DK_add_g_lt_A_of_hasUSolution_of_R_eq_zero
        (D := D) (A := A) (B := B) (K := K) hD hA hB hK hex hR0)
  simpa only [Impl.compute_xMin, hD, ↓reduceDIte, hA, hB, hK, hR0, hnotle] using
    (hbinR0 (D := D) (A := A) (B := B) (K := K) hD hA hB hK hex hR0)

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`、
  `hR0 : Rof D A B = 0`、`hLe : A ≤ D * K + gcdDA D A`。
主張: `R = 0` かつ不可解な枝では、実装側 `compute_xMin` は `-1` を返す。
内容: `compute_xMin` の `R = 0`・`No=true` 分岐を読むだけである。
証明: 定義展開と `simp` による。
役割: `compute_xMin_eq_xMin` の `R = 0` 不可解分岐を薄くする。
-/
private lemma compute_xMin_eq_neg_one_of_R_eq_zero
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) (hK : 0 ≤ K)
    (hR0 : Rof D A B = 0)
    (hLe : A ≤ D * K + gcdDA D A) :
    Impl.compute_xMin D A B K = -1 := by
  simp only [Impl.compute_xMin, hD, ↓reduceDIte, hA, hB, hK, hR0, hLe, Int.reduceNeg]

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`、
  可解性 `hex`、`hRnz : Rof D A B ≠ 0`。
主張: `R ≠ 0` の場合、実装側 `compute_xMin` は `D * uMinOf` を返す。
内容: `compute_xMin` の `R ≠ 0` 分岐を `hbinRnz` に還元する。
証明: 定義展開後に `hbinRnz` を `simpa` で読む。
役割: `compute_xMin_eq_xMin` の `R ≠ 0` 分岐を helper に分離する。
-/
private lemma compute_xMin_eq_D_mul_uMinOf_of_R_ne_zero
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) (hK : 0 ≤ K)
    (hex : HasUSolution D A B K hD hA hB)
    (hRnz : Rof D A B ≠ 0) :
    Impl.compute_xMin D A B K = D * uMinOf D A B K hD hA hB hex := by
  simpa only [Impl.compute_xMin, hD, ↓reduceDIte, hA, hB, hK, hRnz, mul_eq_mul_left_iff] using
    hbinRnz hD hA hB hK hex hRnz

/--
入力/前提: `hex : HasUSolution D A B K hD hA hB` と、
  実装側が `D * uMinOf ... hex` を返す等式 `himpl`。
主張: 実装 `compute_xMin` は仕様 `xMin` と一致する。
内容: `xMin_eq_D_mul_uMinOf` を対称向きに使って `himpl` と連結する。
証明: `trans` で示す。
役割: `compute_xMin_eq_xMin_of_R_eq_zero` と `_of_R_ne_zero` の可解枝を共通化する。
-/
private lemma compute_xMin_eq_xMin_of_solution
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B)
    (hex : HasUSolution D A B K hD hA hB)
    (himpl : Impl.compute_xMin D A B K = D * uMinOf D A B K hD hA hB hex) :
    Impl.compute_xMin D A B K = xMin D A B K hD hA hB := by
  simpa using
    (himpl.trans
      (Correctness.Internal.xMin_eq_D_mul_uMinOf
        (D := D) (A := A) (B := B) (K := K) hD hA hB hex).symm)

/--
入力/前提: `hno : ¬ ∃ u, SolU ... u` と、実装側が `-1` を返す等式 `himpl`。
主張: 実装 `compute_xMin` は仕様 `xMin` と一致する。
内容: `xMin_eq_neg_one_of_no_solution` を対称向きに使って `himpl` と連結する。
証明: `trans` で示す。
役割: `compute_xMin_eq_xMin_of_R_eq_zero` の不可解枝を薄くする。
-/
private lemma compute_xMin_eq_xMin_of_no_solution
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B)
    (hno : ¬ ∃ u : Int, Search.Internal.SolU D A B K hD hA hB u)
    (himpl : Impl.compute_xMin D A B K = -1) :
    Impl.compute_xMin D A B K = xMin D A B K hD hA hB := by
  simpa using
    (himpl.trans
      (Correctness.Internal.xMin_eq_neg_one_of_no_solution
        (D := D) (A := A) (B := B) (K := K) hD hA hB hno).symm)

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`、`hR0 : Rof D A B = 0`。
主張: `R = 0` の場合、実装 `compute_xMin` は仕様 `xMin` と一致する。
内容: `Bounds.Internal.exists_u_iff_DK_add_g_lt_A_of_R_eq_zero` で可解/不可解に分岐し、
  既存の計算側 helper と仕様側 helper を接続する。
証明: `R=0` の存在条件を直接使い、2 ケースをそれぞれ `trans` で閉じる。
役割: `compute_xMin_eq_xMin` 本体から `R = 0` 枝の分岐を外す。
-/
private lemma compute_xMin_eq_xMin_of_R_eq_zero
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) (hK : 0 ≤ K)
    (hR0 : Rof D A B = 0) :
    Impl.compute_xMin D A B K = xMin D A B K hD hA hB := by
  by_cases hcond : D * K + gcdDA D A < A
  · have hex : HasUSolution D A B K hD hA hB := by
      simpa using
        (Bounds.Internal.exists_u_iff_DK_add_g_lt_A_of_R_eq_zero
          (D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0).mpr hcond
    simpa using
      (compute_xMin_eq_xMin_of_solution
        (D := D) (A := A) (B := B) hD hA hB hex
        (compute_xMin_eq_D_mul_uMinOf_of_R_eq_zero
          (D := D) (A := A) (B := B) (K := K) hD hA hB hK hex hR0))
  · simpa using
      (compute_xMin_eq_xMin_of_no_solution
        (D := D) (A := A) (B := B) hD hA hB
        (no_solU_of_not_DK_add_g_lt_A_of_R_eq_zero
          (D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0 hcond)
        (compute_xMin_eq_neg_one_of_R_eq_zero
          (D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0
          (le_of_not_gt hcond)))

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`、`hRnz : Rof D A B ≠ 0`。
主張: `R ≠ 0` の場合、実装 `compute_xMin` は仕様 `xMin` と一致する。
内容: `R ≠ 0` の witness 構成から可解性を回収し、
  計算側/仕様側の `D * uMinOf` 表現をつなぐ。
証明: `compute_xMin_eq_D_mul_uMinOf_of_R_ne_zero` と `xMin_eq_D_mul_uMinOf` を `trans` する。
役割: `compute_xMin_eq_xMin` 本体から `R ≠ 0` 枝を外す。
-/
private lemma compute_xMin_eq_xMin_of_R_ne_zero
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) (hK : 0 ≤ K)
    (hRnz : Rof D A B ≠ 0) :
    Impl.compute_xMin D A B K = xMin D A B K hD hA hB := by
  rcases Bounds.Internal.exists_solU_lt_floor_ABK_div_R_plus_two_of_R_ne_zero
      (D := D) (A := A) (B := B) (K := K) hD hA hB hK hRnz with
    ⟨u, huSol, _⟩
  have hex : HasUSolution D A B K hD hA hB := ⟨u, huSol⟩
  simpa using
    (compute_xMin_eq_xMin_of_solution
      (D := D) (A := A) (B := B) hD hA hB hex
      (compute_xMin_eq_D_mul_uMinOf_of_R_ne_zero
        (D := D) (A := A) (B := B) (K := K) hD hA hB hK hex hRnz))

namespace Correctness

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`。
主張: 実装 `compute_xMin` は仕様定義 `xMin` と一致する。
内容: `Rof D A B = 0` / `Rof D A B ≠ 0` で分岐し、
  `exist_and_search_upper_bound`（可解性条件）と
  `xMin_eq_D_mul_uMinOf` / `xMin_eq_neg_one_of_no_solution` を接続する。
証明: `R=0` 可解/非可解と `R≠0` の 3 分岐で、`hbinR0`・`hbinRnz` と既存仕様補題を適用して示す。
役割: 実装側 `compute_xMin` の正当性を確定する最上位定理。
-/
theorem compute_xMin_eq_xMin
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) (hK : 0 ≤ K) :
    Impl.compute_xMin D A B K = xMin D A B K hD hA hB := by
  by_cases hR0 : Rof D A B = 0
  · simpa using
      compute_xMin_eq_xMin_of_R_eq_zero
        (D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0
  · simpa using
      compute_xMin_eq_xMin_of_R_ne_zero
        (D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0

end Correctness

end ComputeCorrectness

namespace Examples

namespace Pow10

/--
目的: `divmod_d19_7e37` で使う除数定数 `10^19` を名前付きで定義する。
定義: `D19 := 10^19`（`Int`）。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: 定理文で巨大定数の反復記述を避け、可読性を保つ。
-/
private def D19 : Int := 10 ^ (19 : Nat)

/--
目的: `divmod_d16_128bit` の第1段で使う除数 `10^32` を定数として与える。
定義: `D32 := 10^32`。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: 例 `D=10^32, A=2^64, B=2^64, K=1` の定理記述を簡潔にする。
-/
private def D32 : Int := 10 ^ (32 : Nat)

/--
目的: `divmod_d16_128bit` の第2段で使う除数 `10^16` を定数として与える。
定義: `D16 := 10^16`。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: 例 `D=10^16, A=2^52, B=2^64, K=1` の定理記述を簡潔にする。
-/
private def D16 : Int := 10 ^ (16 : Nat)

namespace Spec

/--
目的: 除数 `10^19` に対する標準の商・剰余ペアを定義する。
定義: `divmod_d19 x := (x / D19, x % D19)`。
入力/前提: `x : Int`。
出力: 型 `Int × Int` の値 `(x / D19, x % D19)` を返す。
役割: `divmod_d19_125bit` / `divmod_d19_127bit` / `divmod_d19_128bit`
  の正しさ定理における比較対象（仕様）として使う。
-/
def divmod_d19 (x : Int) : Int × Int :=
  (x / D19, x % D19)

/--
目的: 除数 `10^32` に対する標準の商・剰余ペアを定義する。
定義: `divmod_d32 x := (x / D32, x % D32)`。
入力/前提: `x : Int`。
出力: 型 `Int × Int` の値 `(x / D32, x % D32)` を返す。
役割: `divmod_d16_128bit` 第1段の仕様（`10^32` での分解）として使う。
-/
def divmod_d32 (x : Int) : Int × Int :=
  (x / D32, x % D32)

/--
目的: 除数 `10^16` に対する標準の商・剰余ペアを定義する。
定義: `divmod_d16 x := (x / D16, x % D16)`。
入力/前提: `x : Int`。
出力: 型 `Int × Int` の値 `(x / D16, x % D16)` を返す。
役割: `divmod_d16_128bit` 第2段の仕様（`10^16` での分解）として使う。
-/
def divmod_d16 (x : Int) : Int × Int :=
  (x / D16, x % D16)

/--
目的: `x` を `10^32` と `10^16` で段階分解し、3ブロック `(q,s,t)` を得る。
定義: まず `divmod_d32 x = (q,r)` を取り、次に `divmod_d16 r = (s,t)` として
  `(q,s,t)` を返す。
入力/前提: `x : Int`。
出力: 型 `Int × Int × Int` の値 `(q,s,t)` を返す。
役割: `split3_d16_128bit` の仕様側参照として使う。
-/
def split3_d16 (x : Int) : (Int × Int × Int) :=
  let (q, r) := divmod_d32 x
  let (s, t) := divmod_d16 r
  (q, s, t)

end Spec

namespace Impl

namespace Internal

/--
目的: `D=10^16` の段で使うシフト定数 `2^52` を定数として与える。
定義: `A52 := 2^52`。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: 例 `D=10^16, A=2^52, B=2^64, K=1` の定理記述を簡潔にする。
-/
private def A52 : Int := 2 ^ (52 : Nat)

/--
目的: `divmod_d19_125bit`, `divmod_d19_127bit` で使うシフト定数 `2^63` を名前付きで定義する。
定義: `A63 := 2^63`（`Int`）。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: 近似商 `q = floor((floor(x/A)*M)/B)` の定数部を簡潔に書く。
-/
private def A63 : Int := 2 ^ (63 : Nat)

/--
目的: `divmod_d19_128bit` で使うシフト定数 `2^64` を名前付きで定義する。
定義: `A64 := 2^64`（`Int`）。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: `divmod_d19_128bit` の証明で `A` 側定数を簡潔に書く。
-/
private def A64 : Int := 2 ^ (64 : Nat)

/--
目的: `divmod_d19_125bit`, `divmod_d19_127bit`, `divmod_d19_128bit` で使うシフト定数 `2^64` を名前付きで定義する。
定義: `B64 := 2^64`（`Int`）。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: 近似商計算および `compute_xMin` の評価式を簡潔にする。
-/
private def B64 : Int := 2 ^ (64 : Nat)

/--
目的: 125bit 版（最大 1 回補正）の想定範囲上端を定数として与える。
定義: `xBound_d19_A63_B64_K1_125bit := 78312161395427422060000000000000000000`。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: `x < xBound_d19_A63_B64_K1_125bit` から `Δ ≤ 1` を導く範囲条件として使う。
-/
private def xBound_d19_A63_B64_K1_125bit : Int := 78312161395427422060000000000000000000

/--
目的: 127bit 版（最大 2 回補正）の想定範囲上端を定数として与える。
定義: `xBound_d19_A63_B64_K2_127bit := 1086673501021195308190000000000000000000`。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: `x < xBound_d19_A63_B64_K2_127bit` から `Δ ≤ 2` を導く範囲条件として使う。
-/
private def xBound_d19_A63_B64_K2_127bit : Int := 1086673501021195308190000000000000000000

/--
目的: 128bit 版（最大 3 回補正）の想定範囲上端を定数として与える。
定義: `xBound_d19_A64_B64_K3_128bit := 1164985662416622730250000000000000000000`。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: `x < xBound_d19_A64_B64_K3_128bit` から `Δ ≤ 3` を導く範囲条件として使う。
-/
private def xBound_d19_A64_B64_K3_128bit : Int := 1164985662416622730250000000000000000000

/--
目的: 例 `D=10^32, A=2^64, B=2^64, K=1` の `x_min` 値を定数として与える。
定義: `xBound_d32_A64_B64_K1_128bit := 508484200000000000000000000000000000000`。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: `xMin` の具体値と `0 ≤ Δ ≤ 1` の範囲定理を記述する基準値。
-/
private def xBound_d32_A64_B64_K1_128bit : Int := 508484200000000000000000000000000000000

/--
目的: 例 `D=10^16, A=2^52, B=2^64, K=1` の `x_min` 値を定数として与える。
定義: `xBound_d16_A52_B64_K1_115bit := 70380273116483910380000000000000000`。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: `xMin` の具体値と `0 ≤ Δ ≤ 1` の範囲定理を記述する基準値。
-/
private def xBound_d16_A52_B64_K1_115bit : Int := 70380273116483910380000000000000000

end Internal

/--
目的: `D = 10^19` に対する近似商・剰余 `(q, r)` を 1 回補正で計算する。
定義: `A = 2^63`, `B = 2^64`, `M = ⌊AB/D⌋`,
  `q = ⌊⌊x/A⌋ * M / B⌋`, `r = x - q*D` とし、
  `r ≥ D` なら `(q+1, r-D)`、それ以外は `(q, r)` を返す。
入力/前提: `x : Int`。想定利用域は `0 ≤ x < xBound_d19_125bit`。
出力: 型 `Int × Int` の値 `(q, r)` を返す。
役割: `divmod(x, 10^19)` の 125bit 版補助関数。
  正しさは `divmod_d19_A63_B64_K1_125bit_correct_on_range` で与える。
-/
def divmod_d19_A63_B64_K1_125bit (x : Int) : Int × Int :=
  let M : Int := Internal.A63 * Internal.B64 / D19
  let q : Int := ((x / Internal.A63) * M) / Internal.B64
  let r : Int := x - q * D19
  if D19 ≤ r then
    (q + 1, r - D19)
  else
    (q, r)

/--
目的: `D = 10^19` に対し、`2^127` 近似商から最大 2 回補正で `(q, r)` を返す。
定義: `A = 2^63`, `B = 2^64`, `M = ⌊AB/D⌋`,
  `q = ⌊⌊x/A⌋ * M / B⌋`, `r = x - q*D` として、
  `r ≥ 2D` なら `(q+2, r-2D)`、`r ≥ D` なら `(q+1, r-D)`、
  それ以外は `(q, r)` を返す。
入力/前提: `x : Int`。想定利用域は `0 ≤ x ≤ 2^127 < xBound_d19_127bit`。
出力: 型 `Int × Int` の値 `(q, r)` を返す。
役割: `divmod(x, 10^19)` を 127bit 近似商＋最大2回補正で実行する補助関数。
  正しさは `divmod_d19_A63_B64_K2_127bit_correct_on_range` で与える。
-/
def divmod_d19_A63_B64_K2_127bit (x : Int) : Int × Int :=
  let M : Int := Internal.A63 * Internal.B64 / D19
  let q : Int := ((x / Internal.A63) * M) / Internal.B64
  let r : Int := x - q * D19
  if D19 * 2 ≤ r then
    (q + 2, r - D19 * 2)
  else if D19 ≤ r then
    (q + 1, r - D19)
  else
    (q, r)

/--
目的: `D = 10^19` に対し、`2^128` 近似商から最大 3 回補正で `(q, r)` を返す。
定義: `A = 2^64`, `B = 2^64`, `M = ⌊AB/D⌋`,
  `q = ⌊⌊x/A⌋ * M / B⌋`, `r = x - q*D` として、
  `r ≥ 3D` なら `(q+3, r-3D)`、`r ≥ 2D` なら `(q+2, r-2D)`、
  `r ≥ D` なら `(q+1, r-D)`、それ以外は `(q, r)` を返す。
入力/前提: `x : Int`。想定利用域は `0 ≤ x < 2^128 < xBound_d19_128bit`。
出力: 型 `Int × Int` の値 `(q, r)` を返す。
役割: `divmod(x, 10^19)` を 128bit 近似商＋最大3回補正で実行する補助関数。
  正しさは `divmod_d19_A64_B64_K3_128bit_correct_on_range` で与える。
-/
def divmod_d19_A64_B64_K3_128bit (x : Int) : Int × Int :=
  let M : Int := Internal.A64 * Internal.B64 / D19
  let q : Int := ((x / Internal.A64) * M) / Internal.B64
  let r : Int := x - q * D19
  if D19 * 3 ≤ r then
    (q + 3, r - D19 * 3)
  else if D19 * 2 ≤ r then
    (q + 2, r - D19 * 2)
  else if D19 ≤ r then
    (q + 1, r - D19)
  else
    (q, r)

/--
目的: `D = 10^32` に対し、`2^128` 近似商から最大 1 回補正で `(q, r)` を返す。
定義: `A = 2^64`, `B = 2^64`, `M = ⌊AB/D⌋` として
  `q = ⌊⌊x/A⌋ * M / B⌋`, `r = x - q*D` を計算し、
  `r ≥ D` なら `(q+1, r-D)`、それ以外は `(q, r)` を返す。
入力/前提: `x : Int`。
出力: 型 `Int × Int` の値 `(q, r)` を返す。
役割: 例 `D=10^32, A=2^64, B=2^64, K=1` の実装計算を与える。
-/
def divmod_d32_A64_B64_K1_128bit (x : Int) : Int × Int :=
  let M : Int := Internal.A64 * Internal.B64 / D32
  let q : Int := ((x / Internal.A64) * M) / Internal.B64
  let r : Int := x - q * D32
  if D32 ≤ r then
    (q + 1, r - D32)
  else
    (q, r)

/--
目的: `D = 10^16` に対し、`2^115` 想定域で最大 1 回補正の `(q, r)` を返す。
定義: `A = 2^52`, `B = 2^64`, `M = ⌊AB/D⌋` として
  `q = ⌊⌊x/A⌋ * M / B⌋`, `r = x - q*D` を計算し、
  `r ≥ D` なら `(q+1, r-D)`、それ以外は `(q, r)` を返す。
入力/前提: `x : Int`。
出力: 型 `Int × Int` の値 `(q, r)` を返す。
役割: 例 `D=10^16, A=2^52, B=2^64, K=1` の実装計算を与える。
-/
private def divmod_d16_A52_B64_K1_115bit (x : Int) : Int × Int :=
  let M : Int := Internal.A52 * Internal.B64 / D16
  let q : Int := ((x / Internal.A52) * M) / Internal.B64
  let r : Int := x - q * D16
  if D16 ≤ r then
    (q + 1, r - D16)
  else
    (q, r)

/--
目的: 近似除算ベースで `x` を `(10^32, 10^16, 10^16)` の3ブロックへ分解する。
定義: 第1段で `divmod_d32_A64_B64_K1_128bit x = (q,r)`、
  第2段で `divmod_d16_A52_B64_K1_115bit r = (s,t)` を計算し、`(q,s,t)` を返す。
入力/前提: `x : Int`。
出力: 型 `Int × Int × Int` の値 `(q,s,t)` を返す。
役割: `split3_d16` 仕様に対応する実装側関数として使う。
-/
def split3_d16_128bit (x : Int) : Int × Int × Int :=
  let (q, r) := divmod_d32_A64_B64_K1_128bit x
  let (s, t) := divmod_d16_A52_B64_K1_115bit r
  (q, s, t)

end Impl

namespace Correctness

namespace Internal

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hx : 0 ≤ x`。
主張: `q := floor( floor(x/A) * floor(AB/D) / B )` は `q ≤ floor(x/D)` を満たす。
内容: `q*B ≤ floor(x/A)*floor(AB/D)`、`floor(AB/D)*D ≤ AB`、
  `floor(x/A)*A ≤ x` を順に連結して `q*D ≤ x` を得て、最後に `q ≤ x/D` に戻す。
証明: `Int.ediv_mul_le` と単調性（正数倍）で示す。
役割: `Delta = x/D - q` の非負性（`Delta ≥ 0`）を与える補助補題。
-/
private lemma qApprox_le_trueQuot
    {D A B x : Int}
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B)
    (hx : 0 ≤ x) :
    (((x / A) * ((A * B) / D)) / B) ≤ x / D := by
  let u : Int := x / A
  let m : Int := (A * B) / D
  let q : Int := (u * m) / B
  have hD0 : D ≠ 0 := ne_of_gt hD
  have hA0 : A ≠ 0 := ne_of_gt hA
  have hB0 : B ≠ 0 := ne_of_gt hB
  have hu0 : 0 ≤ u := by
    dsimp only [u]
    exact Int.ediv_nonneg hx (le_of_lt hA)
  have hqB_le_um : q * B ≤ u * m := by
    dsimp only [q]
    simpa only [mul_comm] using (Int.ediv_mul_le (u * m) hB0)
  have hmD_le_AB : m * D ≤ A * B := by
    dsimp only [m]
    simpa only [mul_comm] using (Int.ediv_mul_le (A * B) hD0)
  have humD_le_uAB : (u * m) * D ≤ u * (A * B) := by
    have : u * (m * D) ≤ u * (A * B) := by
      exact mul_le_mul_of_nonneg_left hmD_le_AB hu0
    simpa only [mul_assoc, ge_iff_le] using this
  have hAu_le_x : u * A ≤ x := by
    dsimp only [u]
    simpa only [mul_comm] using (Int.ediv_mul_le x hA0)
  have huAB_eq_uA_mul_B : u * (A * B) = (u * A) * B := by ring
  have huAB_le_xB : u * (A * B) ≤ x * B := by
    calc
      u * (A * B) = (u * A) * B := huAB_eq_uA_mul_B
      _ ≤ x * B := by
        exact mul_le_mul_of_nonneg_right hAu_le_x (le_of_lt hB)
  have hqBD_le_xB : (q * B) * D ≤ x * B := by
    calc
      (q * B) * D ≤ (u * m) * D := by
        exact mul_le_mul_of_nonneg_right hqB_le_um (le_of_lt hD)
      _ ≤ u * (A * B) := humD_le_uAB
      _ ≤ x * B := huAB_le_xB
  have hBqD_le_Bx : B * (q * D) ≤ B * x := by
    simpa only [mul_comm, mul_left_comm] using hqBD_le_xB
  have hqD_le_x : q * D ≤ x := by
    exact (Int.mul_le_mul_left hB).1 (by simpa only [mul_comm, mul_left_comm] using hBqD_le_Bx)
  have hq_le_div : q ≤ x / D := (Int.le_ediv_iff_mul_le hD).2 hqD_le_x
  simpa only [ge_iff_le] using hq_le_div

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hx0 : 0 ≤ x`, `x < xMin ...`。
主張: `K < Delta D A B x` は成り立たない。
内容: `x` が可解 (`SolX`) だと `xMinOf ≤ x` が従い `x < xMin` に矛盾する。
  逆に可解集合が空なら `K < Delta` から直ちに矛盾する。
証明: `xMin` の場合分け（`∃ x, SolX`）と `csInf_le` で示す。
役割: `x < xMin(… ,K)` から `Delta ≤ K` を導くための補助補題。
-/
private lemma not_lt_Delta_of_lt_xMin
    {D A B K x : Int}
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B)
    (hx0 : 0 ≤ x)
    (hxMin : x < xMin D A B K hD hA hB) :
    ¬ (K < Delta D A B x hD hA hB) := by
  by_cases hexX : ∃ z : Int, Search.Internal.SolX D A B K hD hA hB z
  · intro hKx
    have hBddX : BddBelow ({z : Int | Search.Internal.SolX D A B K hD hA hB z} : Set Int) := by
      refine ⟨0, ?_⟩
      intro z hz
      exact hz.1
    have hxMinLe : xMinOf D A B K hD hA hB hexX ≤ x := by
      unfold xMinOf
      exact csInf_le hBddX ⟨hx0, hKx⟩
    have hxMinEq : xMin D A B K hD hA hB = xMinOf D A B K hD hA hB hexX := by
      unfold xMin
      simp only [hexX, ↓reduceDIte]
    have hxMinLe' : xMin D A B K hD hA hB ≤ x := by
      simpa only [hxMinEq] using hxMinLe
    exact (not_le_of_gt hxMin) hxMinLe'
  · intro hKx
    exact hexX ⟨x, ⟨hx0, hKx⟩⟩

/--
入力/前提: なし。
主張: 定数系 `(D19,A63,B64,K=1)` に対して `compute_xMin` は
  `xBound_d19_A63_B64_K1_125bit` を返す。
内容: 実装定義を計算評価して定数等式を得る。
証明: `decide` で計算して示す。
役割: 125bit 範囲条件を  `x < xMin(...,1)` に接続する。
-/
private lemma compute_xMin_D19_A63_B64_K1 :
    Impl.compute_xMin D19 Impl.Internal.A63 Impl.Internal.B64 1 =
      Impl.Internal.xBound_d19_A63_B64_K1_125bit := by
  set_option maxRecDepth 2000 in
    decide

/--
入力/前提: なし。
主張: 定数系 `(D19,A63,B64,K=2)` に対して `compute_xMin` は
  `xBound_d19_A63_B64_K2_127bit` を返す。
内容: 実装定義を計算評価して定数等式を得る。
証明: `decide` で計算して示す。
役割: 127bit 範囲条件を `x < xMin(...,2)` に接続する。
-/
private lemma compute_xMin_D19_A63_B64_K2 :
    Impl.compute_xMin D19 Impl.Internal.A63 Impl.Internal.B64 2 =
      Impl.Internal.xBound_d19_A63_B64_K2_127bit := by
  set_option maxRecDepth 2000 in
    decide

/--
入力/前提: なし。
主張: 定数系 `(D19,A64,B64,K=3)` に対して `compute_xMin` は
  `xBound_d19_128bit` を返す。
内容: 実装定義を計算評価して定数等式を得る。
証明: `decide` で計算して示す。
役割: 128bit 範囲条件を `x < xMin(...,3)` に接続する。
-/
private lemma compute_xMin_D19_A64_B64_K3 :
    Impl.compute_xMin D19 Impl.Internal.A64 Impl.Internal.B64 3 =
      Impl.Internal.xBound_d19_A64_B64_K3_128bit := by
  set_option maxRecDepth 2000 in
    decide

/--
入力/前提: なし。
主張: `compute_xMin 10^32 2^64 2^64 1` は
  `508484200000000000000000000000000000000` を返す。
内容: 実装定義を具体定数で計算評価した等式を与える。
証明: `decide` で計算して示す。
役割: `xMin` の具体値定理と `Δ` の範囲定理の起点にする。
-/
private lemma compute_xMin_D32_A64_B64_K1 :
    Impl.compute_xMin D32 Impl.Internal.A64 Impl.Internal.B64 1 =
      Impl.Internal.xBound_d32_A64_B64_K1_128bit := by
  set_option maxRecDepth 4000 in
    decide

/--
入力/前提: なし。
主張: `compute_xMin 10^16 2^52 2^64 1` は
  `70380273116483910380000000000000000` を返す。
内容: 実装定義を具体定数で計算評価した等式を与える。
証明: `decide` で計算して示す。
役割: `xMin` の具体値定理と `Δ` の範囲定理の起点にする。
-/
private lemma compute_xMin_D16_A52_B64_K1 :
    Impl.compute_xMin D16 Impl.Internal.A52 Impl.Internal.B64 1 =
      Impl.Internal.xBound_d16_A52_B64_K1_115bit := by
  set_option maxRecDepth 4000 in
    decide

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`,
  `hBound : compute_xMin D A B K = bound`, `hx : x < bound`。
主張: `x < xMin D A B K hD hA hB`。
内容: `compute_xMin_eq_xMin` で仕様値へ置換し、`bound` を経由して連鎖する。
証明: 等式の書き換えと `calc` で示す。
役割: 具体的な境界定数から `xMin` 仕様への橋渡しを共通化する。
-/
private lemma lt_xMin_of_lt_compute_xMin_bound
    {D A B K x bound : Int}
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) (hK : 0 ≤ K)
    (hBound : Impl.compute_xMin D A B K = bound)
    (hx : x < bound) :
    x < xMin D A B K hD hA hB := by
  have hxMinEqComp : Impl.compute_xMin D A B K = xMin D A B K hD hA hB := by
    exact Correctness.compute_xMin_eq_xMin (D := D) (A := A) (B := B) (K := K) hD hA hB hK
  calc
    x < bound := hx
    _ = Impl.compute_xMin D A B K := hBound.symm
    _ = xMin D A B K hD hA hB := hxMinEqComp

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`,
  `hx0 : 0 ≤ x`, `hBound : compute_xMin D A B K = bound`, `hx : x < bound`。
主張: `0 ≤ Delta D A B x hD hA hB ∧ Delta D A B x hD hA hB ≤ K`。
内容: 前半は `qApprox_le_trueQuot` から、後半は `x < xMin` を介して
  `not_lt_Delta_of_lt_xMin` から得る。
証明: 既存補題を連結して示す。
役割: 3つの `divmod_d19_*_correct_on_range` で共通の `Delta` 範囲導出をまとめる。
-/
private lemma delta_bounds_of_lt_compute_xMin_bound
    {D A B K x bound : Int}
    (hD : 0 < D) (hA : 0 < A) (hB : 0 < B) (hK : 0 ≤ K)
    (hx0 : 0 ≤ x)
    (hBound : Impl.compute_xMin D A B K = bound)
    (hx : x < bound) :
    0 ≤ Delta D A B x hD hA hB ∧ Delta D A B x hD hA hB ≤ K := by
  refine ⟨?_, ?_⟩
  · unfold Delta
    exact
      sub_nonneg.mpr
        (qApprox_le_trueQuot (D := D) (A := A) (B := B) hD hA hB hx0)
  · exact
      le_of_not_gt
        (not_lt_Delta_of_lt_xMin
          (D := D) (A := A) (B := B) (K := K) hD hA hB hx0
          (lt_xMin_of_lt_compute_xMin_bound
            (D := D) (A := A) (B := B) (K := K) (x := x) (bound := bound)
            hD hA hB hK hBound hx))

end Internal

end Correctness

/--
入力/前提: `hq` は `q = floor(floor(x/A) * floor(AB/D) / B)`。
主張: `Delta D A B x ... = x / D - q`。
内容: `Delta` の定義式に `hq` を代入する。
証明: `subst` と定義展開で示す。
役割: 各分岐で `Delta = 0,1,2,3` から `q` と真の商の関係を引く共通補題。
-/
private lemma Delta_eq_div_sub_q
    {D A B x q : Int}
    (hD : 0 < D) (_hA : 0 < A) (_hB : 0 < B)
    (hq : q = (((x / A) * ((A * B) / D)) / B)) :
    Delta D A B x hD _hA _hB = x / D - q := by
  subst q
  unfold Delta
  rfl

/--
入力/前提: `hq` は `q = floor(floor(x/A) * floor(AB/D) / B)`。
主張: `x - q*D = x%D + D*Delta D A B x ...`。
内容: `x = D*(x/D) + x%D` と `Delta` の定義を組み合わせて式変形する。
証明: 除算分解恒等式と `ring` で示す。
役割: 各 `divmod` 証明で共通する `r` 展開（`r = x% D + D*Delta`）をまとめる。
-/
private lemma sub_q_mul_eq_emod_add_Delta
    {D A B x q : Int}
    (hD : 0 < D) (_hA : 0 < A) (_hB : 0 < B)
    (hq : q = (((x / A) * ((A * B) / D)) / B)) :
    x - q * D = x % D + D * Delta D A B x hD _hA _hB := by
  have hxDecomp : D * (x / D) + x % D = x := by
    simpa only using (Int.mul_ediv_add_emod x D)
  have hxMinus :
      x - (((x / A) * ((A * B) / D)) / B) * D
        = (D * (x / D) + x % D) - (((x / A) * ((A * B) / D)) / B) * D := by
    exact
      (congrArg
        (fun t : Int => t - (((x / A) * ((A * B) / D)) / B) * D)
        hxDecomp).symm
  calc
    x - q * D
        = x - (((x / A) * ((A * B) / D)) / B) * D := by simp [hq]
    _ = (D * (x / D) + x % D) - (((x / A) * ((A * B) / D)) / B) * D := hxMinus
    _ = x % D + D * ((x / D) - (((x / A) * ((A * B) / D)) / B)) := by ring
    _ = x % D + D * Delta D A B x hD _hA _hB := by rfl

/--
入力/前提: `δ = x/D - q` かつ `δ = k`。
主張: `q + k = x / D`。
内容: 差分式を `k` に置換して線形方程式を解く。
証明: 置換と `omega` で示す。
役割: `δ` の各場合 (`0,1,2,3`) から商の一致を導く共通補題。
-/
private lemma q_add_eq_div_of_delta_eq
    {x D q δ k : Int}
    (hDeltaEq : δ = x / D - q)
    (hδk : δ = k) :
    q + k = x / D := by
  have : x / D - q = k := by simpa only [hDeltaEq] using hδk
  omega

/--
入力/前提: `r = x%D + D*δ` かつ `δ = k`。
主張: `r = x%D + D*k`。
内容: `δ` を `k` に置換するだけ。
証明: `simpa` で示す。
役割: `δ` 固定時の `r` 形を共通で扱うための補助補題。
-/
private lemma r_eq_rem_add_D_mul_of_delta_eq
    {D x r δ k : Int}
    (hrEq : r = x % D + D * δ)
    (hδk : δ = k) :
    r = x % D + D * k := by
  simpa only [hδk] using hrEq

/--
入力/前提: `r = x%D + D*δ` かつ `δ = k`。
主張: `r - D*k = x%D`。
内容: 上式を代入して整理する。
証明: 置換後 `ring` で示す。
役割: 補正後剰余が真の剰余に戻ることを共通で扱う補助補題。
-/
private lemma r_sub_D_mul_eq_rem_of_delta_eq
    {D x r δ k : Int}
    (hrEq : r = x % D + D * δ)
    (hδk : δ = k) :
    r - D * k = x % D := by
  rw [hrEq, hδk]
  ring

/--
入力/前提: `0 < D`, `0 ≤ k`, `r = x%D + D*k`。
主張: `D*k ≤ r`。
内容: `x%D ≥ 0` を加えた下界を使う。
証明: `Int.emod_nonneg` と `omega` で示す。
役割: 分岐条件 `D*k ≤ r` を共通に導く補助補題。
-/
private lemma ge_D_mul_of_r_eq_rem_add_D_mul
    {D x r k : Int}
    (hD : 0 < D)
    (hrEq : r = x % D + D * k) :
    D * k ≤ r := by
  have hRemNonneg : 0 ≤ x % D := Int.emod_nonneg x (ne_of_gt hD)
  rw [hrEq]
  omega

/--
入力/前提: `0 < D`, `0 ≤ k`, `k < m`, `r = x%D + D*k`。
主張: `¬ D*m ≤ r`。
内容: `x%D < D` より `r < D*(k+1) ≤ D*m` を示す。
証明: `Int.emod_lt_of_pos` と `omega` で示す。
役割: 上位分岐条件が偽であることを共通に導く補助補題。
-/
private lemma not_ge_D_mul_of_r_eq_rem_add_D_mul
    {D x r k m : Int}
    (hD : 0 < D)
    (hkm : k < m)
    (hrEq : r = x % D + D * k) :
    ¬ D * m ≤ r := by
  have hRemLt : x % D < D := Int.emod_lt_of_pos x hD
  have hkm1 : k + 1 ≤ m := (Int.lt_iff_add_one_le).1 hkm
  have hrlt : r < D * (k + 1) := by
    rw [hrEq]
    calc
      x % D + D * k < D + D * k := by
        simpa only [add_comm, add_left_comm, add_assoc] using
          (add_lt_add_right hRemLt (D * k))
      _ = D * (k + 1) := by ring
  have hmul : D * (k + 1) ≤ D * m := by
    exact mul_le_mul_of_nonneg_left hkm1 (le_of_lt hD)
  exact not_le_of_gt (lt_of_lt_of_le hrlt hmul)

/--
入力/前提: `δ = x/D - q`, `r = x%D + D*δ`, および `δ = k`。
主張: `(q + k, r - D*k) = (x/D, x%D)`。
内容: 商補正と剰余補正の標準形を同時に取り出す。
証明: `q_add_eq_div_of_delta_eq` と `r_sub_D_mul_eq_rem_of_delta_eq` を組み合わせる。
役割: `divmod_if1/2/3_correct_of_delta_le*` の各分岐末尾を共通化する。
-/
private lemma divmod_pair_eq_of_delta_eq
    {D x q r δ k : Int}
    (hDeltaEq : δ = x / D - q)
    (hrEq : r = x % D + D * δ)
    (hDeltaK : δ = k) :
    (q + k, r - D * k) = (x / D, x % D) := by
  simp only [
    q_add_eq_div_of_delta_eq hDeltaEq hDeltaK,
    r_sub_D_mul_eq_rem_of_delta_eq hrEq hDeltaK
  ]

/--
入力/前提: `0 < D`, `r = x%D + D*δ`, `δ = k`, `k < m`。
主張: `¬ D*m ≤ r`。
内容: `r` が `x%D + D*k` 形なら、真の剰余 `x%D < D` から
  `m > k` の閾値には届かない。
証明: `δ = k` で標準形に戻して既存補題へ送る。
役割: `divmod_if1/2/3_correct_of_delta_le*` の非到達枝判定を共通化する。
-/
private lemma not_ge_D_mul_of_delta_eq
    {D x r δ k m : Int}
    (hD : 0 < D)
    (hrEq : r = x % D + D * δ)
    (hDeltaK : δ = k)
    (hkm : k < m) :
    ¬ D * m ≤ r := by
  exact
    not_ge_D_mul_of_r_eq_rem_add_D_mul
      (D := D) (x := x) (r := r) (k := k) (m := m)
      hD hkm (r_eq_rem_add_D_mul_of_delta_eq hrEq hDeltaK)

/--
入力/前提: `0 < D`, `r = x%D + D*δ`, `δ = k`。
主張: `D*k ≤ r`。
内容: `r` が `x%D + D*k` 形なら、剰余の非負性から少なくとも `D*k` を含む。
証明: `δ = k` で標準形に戻して既存補題へ送る。
役割: `divmod_if1/2/3_correct_of_delta_le*` の到達枝判定を共通化する。
-/
private lemma ge_D_mul_of_delta_eq
    {D x r δ k : Int}
    (hD : 0 < D)
    (hrEq : r = x % D + D * δ)
    (hDeltaK : δ = k) :
    D * k ≤ r := by
  exact
    ge_D_mul_of_r_eq_rem_add_D_mul
      (D := D) (x := x) (r := r) (k := k)
      hD (r_eq_rem_add_D_mul_of_delta_eq hrEq hDeltaK)

namespace Correctness

namespace Internal

/--
入力/前提: `0 ≤ δ ≤ 1`, `δ = x/D - q`, `r = x%D + D*δ`, `0 < D`。
主張: 1 段補正
`if D ≤ r then (q+1,r-D) else (q,r)` は `(x/D, x%D)` に一致する。
内容: `δ ∈ {0,1}` の場合分けで示す。
証明: 商剰余分解と不等式評価で示す。
役割: `divmod_d19_125bit_correct_on_range` の分岐証明を共通化する。
-/
private lemma divmod_if1_correct_of_delta_le1
    {D x q r δ : Int}
    (hD : 0 < D)
    (hDeltaNonneg : 0 ≤ δ)
    (hDeltaLe1 : δ ≤ 1)
    (hDeltaEq : δ = x / D - q)
    (hrEq : r = x % D + D * δ) :
    (if D ≤ r then (q + 1, r - D) else (q, r)) = (x / D, x % D) := by
  have hDelta01 : δ = 0 ∨ δ = 1 := by
    omega
  rcases hDelta01 with hDelta0 | hDelta1
  · have hNotGe : ¬ D ≤ r := by
      simpa only [mul_one] using
        (not_ge_D_mul_of_delta_eq
          (D := D) (x := x) (r := r) (δ := δ) (k := 0) (m := 1)
          hD hrEq hDelta0 (by decide))
    simpa only [hNotGe, mul_zero, add_zero, sub_zero] using
      (divmod_pair_eq_of_delta_eq
        (D := D) (x := x) (q := q) (r := r) (δ := δ) (k := 0)
        hDeltaEq hrEq hDelta0)
  · have hGe : D ≤ r := by
      simpa only [mul_one] using
        (ge_D_mul_of_delta_eq
          (D := D) (x := x) (r := r) (δ := δ) (k := 1)
          hD hrEq hDelta1)
    simpa only [hGe, mul_one] using
      (divmod_pair_eq_of_delta_eq
        (D := D) (x := x) (q := q) (r := r) (δ := δ) (k := 1)
        hDeltaEq hrEq hDelta1)

/--
入力/前提: `0 ≤ δ ≤ 2`, `δ = x/D - q`, `r = x%D + D*δ`, `0 < D`。
主張: 2 段補正
`if 2D ≤ r then (q+2,r-2D) else if D ≤ r then (q+1,r-D) else (q,r)`
は `(x/D, x%D)` に一致する。
内容: `δ ∈ {0,1,2}` の場合分けで示す。
証明: 商剰余分解と不等式評価で示す。
役割: `divmod_d19_127bit_correct_on_range` の分岐証明を共通化する。
-/
private lemma divmod_if2_correct_of_delta_le2
    {D x q r δ : Int}
    (hD : 0 < D)
    (hDeltaNonneg : 0 ≤ δ)
    (hDeltaLe2 : δ ≤ 2)
    (hDeltaEq : δ = x / D - q)
    (hrEq : r = x % D + D * δ) :
    (if D * 2 ≤ r then (q + 2, r - D * 2)
      else if D ≤ r then (q + 1, r - D)
      else (q, r)) = (x / D, x % D) := by
  have hDelta012 : δ = 0 ∨ δ = 1 ∨ δ = 2 := by
    omega
  rcases hDelta012 with hDelta0 | hDelta1 | hDelta2
  · have hNotGe1 : ¬ D ≤ r := by
      simpa only [mul_one] using
        (not_ge_D_mul_of_delta_eq
          (D := D) (x := x) (r := r) (δ := δ) (k := 0) (m := 1)
          hD hrEq hDelta0 (by decide))
    have hNotGe2 : ¬ D * 2 ≤ r := by
      exact
        not_ge_D_mul_of_delta_eq
          (D := D) (x := x) (r := r) (δ := δ) (k := 0) (m := 2)
          hD hrEq hDelta0 (by decide)
    simpa only [hNotGe2, hNotGe1, mul_zero, add_zero, sub_zero] using
      (divmod_pair_eq_of_delta_eq
        (D := D) (x := x) (q := q) (r := r) (δ := δ) (k := 0)
        hDeltaEq hrEq hDelta0)
  · have hGe1 : D ≤ r := by
      simpa only [mul_one] using
        (ge_D_mul_of_delta_eq
          (D := D) (x := x) (r := r) (δ := δ) (k := 1)
          hD hrEq hDelta1)
    have hNotGe2 : ¬ D * 2 ≤ r := by
      exact
        not_ge_D_mul_of_delta_eq
          (D := D) (x := x) (r := r) (δ := δ) (k := 1) (m := 2)
          hD hrEq hDelta1 (by decide)
    simpa only [hNotGe2, hGe1, mul_one] using
      (divmod_pair_eq_of_delta_eq
        (D := D) (x := x) (q := q) (r := r) (δ := δ) (k := 1)
        hDeltaEq hrEq hDelta1)
  · have hGe2 : D * 2 ≤ r := by
      exact
        ge_D_mul_of_delta_eq
          (D := D) (x := x) (r := r) (δ := δ) (k := 2)
          hD hrEq hDelta2
    simpa only [hGe2] using
      (divmod_pair_eq_of_delta_eq
        (D := D) (x := x) (q := q) (r := r) (δ := δ) (k := 2)
        hDeltaEq hrEq hDelta2)

/--
入力/前提: `0 ≤ δ ≤ 3`, `δ = x/D - q`, `r = x%D + D*δ`, `0 < D`。
主張: 3 段補正
`if 3D≤r then ... else if 2D≤r then ... else if D≤r then ... else ...`
は `(x/D, x%D)` に一致する。
内容: `δ ∈ {0,1,2,3}` の場合分けで示す。
証明: 商剰余分解と不等式評価で示す。
役割: `divmod_d19_128bit_correct_on_range` の分岐証明を共通化する。
-/
private lemma divmod_if3_correct_of_delta_le3
    {D x q r δ : Int}
    (hD : 0 < D)
    (hDeltaNonneg : 0 ≤ δ)
    (hDeltaLe3 : δ ≤ 3)
    (hDeltaEq : δ = x / D - q)
    (hrEq : r = x % D + D * δ) :
    (if D * 3 ≤ r then (q + 3, r - D * 3)
      else if D * 2 ≤ r then (q + 2, r - D * 2)
      else if D ≤ r then (q + 1, r - D)
      else (q, r)) = (x / D, x % D) := by
  have hDelta0123 : δ = 0 ∨ δ = 1 ∨ δ = 2 ∨ δ = 3 := by
    omega
  rcases hDelta0123 with hDelta0 | hDelta1 | hDelta2 | hDelta3
  · have hNotGe1 : ¬ D ≤ r := by
      simpa only [mul_one] using
        (not_ge_D_mul_of_delta_eq
          (D := D) (x := x) (r := r) (δ := δ) (k := 0) (m := 1)
          hD hrEq hDelta0 (by decide))
    have hNotGe2 : ¬ D * 2 ≤ r := by
      exact
        not_ge_D_mul_of_delta_eq
          (D := D) (x := x) (r := r) (δ := δ) (k := 0) (m := 2)
          hD hrEq hDelta0 (by decide)
    have hNotGe3 : ¬ D * 3 ≤ r := by
      exact
        not_ge_D_mul_of_delta_eq
          (D := D) (x := x) (r := r) (δ := δ) (k := 0) (m := 3)
          hD hrEq hDelta0 (by decide)
    simpa only [hNotGe3, hNotGe2, hNotGe1, mul_zero, add_zero, sub_zero] using
      (divmod_pair_eq_of_delta_eq
        (D := D) (x := x) (q := q) (r := r) (δ := δ) (k := 0)
        hDeltaEq hrEq hDelta0)
  · have hGe1 : D ≤ r := by
      simpa only [mul_one] using
        (ge_D_mul_of_delta_eq
          (D := D) (x := x) (r := r) (δ := δ) (k := 1)
          hD hrEq hDelta1)
    have hNotGe2 : ¬ D * 2 ≤ r := by
      exact
        not_ge_D_mul_of_delta_eq
          (D := D) (x := x) (r := r) (δ := δ) (k := 1) (m := 2)
          hD hrEq hDelta1 (by decide)
    have hNotGe3 : ¬ D * 3 ≤ r := by
      exact
        not_ge_D_mul_of_delta_eq
          (D := D) (x := x) (r := r) (δ := δ) (k := 1) (m := 3)
          hD hrEq hDelta1 (by decide)
    simpa only [hNotGe3, hNotGe2, hGe1, mul_one] using
      (divmod_pair_eq_of_delta_eq
        (D := D) (x := x) (q := q) (r := r) (δ := δ) (k := 1)
        hDeltaEq hrEq hDelta1)
  · have hGe2 : D * 2 ≤ r := by
      exact
        ge_D_mul_of_delta_eq
          (D := D) (x := x) (r := r) (δ := δ) (k := 2)
          hD hrEq hDelta2
    have hNotGe3 : ¬ D * 3 ≤ r := by
      exact
        not_ge_D_mul_of_delta_eq
          (D := D) (x := x) (r := r) (δ := δ) (k := 2) (m := 3)
          hD hrEq hDelta2 (by decide)
    simpa only [hNotGe3, hGe2] using
      (divmod_pair_eq_of_delta_eq
        (D := D) (x := x) (q := q) (r := r) (δ := δ) (k := 2)
        hDeltaEq hrEq hDelta2)
  · have hGe3 : D * 3 ≤ r := by
      exact
        ge_D_mul_of_delta_eq
          (D := D) (x := x) (r := r) (δ := δ) (k := 3)
          hD hrEq hDelta3
    simpa only [hGe3] using
      (divmod_pair_eq_of_delta_eq
        (D := D) (x := x) (q := q) (r := r) (δ := δ) (k := 3)
        hDeltaEq hrEq hDelta3)

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`、`0 ≤ Delta ≤ 1`、
  近似商の定義式 `hqDef`、および `r = x - q * D`。
主張: 1 段補正版 `if D ≤ r then ... else ...` は真の `(x / D, x % D)` に一致する。
内容: `Delta_eq_div_sub_q` と `sub_q_mul_eq_emod_add_Delta` を接続して
  `divmod_if1_correct_of_delta_le1` の前提を一括で組み立てる。
証明: `delta` と `r` の標準形を作って共通補題へ渡す。
役割: 1 段補正の例証明から中間補題 `hDeltaEq` / `hrEq` / `hCore` を取り除く。
-/
private lemma divmod_core_eq_of_delta_le1
    {D A B x q r : Int}
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hDeltaNonneg : 0 ≤ Delta D A B x hD hA hB)
    (hDeltaLe1 : Delta D A B x hD hA hB ≤ 1)
    (hqDef : q = (((x / A) * ((A * B) / D)) / B))
    (hr : r = x - q * D) :
    (if D ≤ r then (q + 1, r - D) else (q, r)) = (x / D, x % D) := by
  have hDeltaEq : Delta D A B x hD hA hB = x / D - q := by
    exact
      Delta_eq_div_sub_q
        (D := D) (A := A) (B := B) (x := x) (q := q)
        hD hA hB hqDef
  have hrEq : r = x % D + D * Delta D A B x hD hA hB := by
    calc
      r = x - q * D := hr
      _ = x % D + D * Delta D A B x hD hA hB := by
            simpa only [hqDef] using
              (sub_q_mul_eq_emod_add_Delta
                (D := D) (A := A) (B := B) (x := x) (q := q)
                hD hA hB hqDef)
  exact
    divmod_if1_correct_of_delta_le1
      (D := D) (x := x) (q := q) (r := r) (δ := Delta D A B x hD hA hB)
      hD hDeltaNonneg hDeltaLe1 hDeltaEq hrEq

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hBound : compute_xMin D A B 1 = bound`,
  `hx0 : 0 ≤ x`, `hx : x < bound`、および `divmodImpl` の1段補正形への展開式。
主張: `divmodImpl x = (x / D, x % D)`。
内容: `delta_bounds_of_lt_compute_xMin_bound` で `0 ≤ Delta ≤ 1` を導き、
  `q`,`r` の標準形を作って `divmod_core_eq_of_delta_le1` へ渡す。
証明: 境界補題と 1 段補正共通補題の連結で示す。
役割: 1 段補正の例定理から `Delta` 範囲導出と `q`,`r` 準備の重複を取り除く。
-/
private lemma divmod_eq_spec_of_delta_le1_on_range
    (divmodImpl : Int → Int × Int)
    {D A B bound x : Int}
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hBound : Impl.compute_xMin D A B 1 = bound)
    (hx0 : 0 ≤ x)
    (hx : x < bound)
    (hDivmod :
      let M : Int := A * B / D
      let q : Int := ((x / A) * M) / B
      let r : Int := x - q * D
      divmodImpl x = if D ≤ r then (q + 1, r - D) else (q, r)) :
    divmodImpl x = (x / D, x % D) := by
  rcases
      delta_bounds_of_lt_compute_xMin_bound
        (D := D) (A := A) (B := B) (K := 1) (x := x)
        (bound := bound) hD hA hB (by decide) hx0 hBound hx
    with ⟨hDeltaNonneg, hDeltaLe1⟩
  let M : Int := A * B / D
  let q : Int := ((x / A) * M) / B
  let r : Int := x - q * D
  have hqDef : q = (((x / A) * ((A * B) / D)) / B) := by
    simp [M, q]
  have hDivmod' :
      divmodImpl x = if D ≤ r then (q + 1, r - D) else (q, r) := by
    simpa [M, q, r] using hDivmod
  exact
    hDivmod'.trans
      (divmod_core_eq_of_delta_le1
        (D := D) (A := A) (B := B) (x := x) (q := q) (r := r)
        hD hA hB hDeltaNonneg hDeltaLe1 hqDef rfl)

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`、`0 ≤ Delta ≤ 2`、
  近似商の定義式 `hqDef`、および `r = x - q * D`。
主張: 2 段補正版 `if D*2 ≤ r then ... else if D ≤ r then ...` は真の商剰余に一致する。
内容: `delta` と `r` の標準形を作って `divmod_if2_correct_of_delta_le2` に渡す。
証明: 1 段版と同じく共通の前処理をまとめる。
役割: 2 段補正の例証明から中間補題の重複を外す。
-/
private lemma divmod_core_eq_of_delta_le2
    {D A B x q r : Int}
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hDeltaNonneg : 0 ≤ Delta D A B x hD hA hB)
    (hDeltaLe2 : Delta D A B x hD hA hB ≤ 2)
    (hqDef : q = (((x / A) * ((A * B) / D)) / B))
    (hr : r = x - q * D) :
    (if D * 2 ≤ r then (q + 2, r - D * 2)
      else if D ≤ r then (q + 1, r - D)
      else (q, r)) = (x / D, x % D) := by
  have hDeltaEq : Delta D A B x hD hA hB = x / D - q := by
    exact
      Delta_eq_div_sub_q
        (D := D) (A := A) (B := B) (x := x) (q := q)
        hD hA hB hqDef
  have hrEq : r = x % D + D * Delta D A B x hD hA hB := by
    calc
      r = x - q * D := hr
      _ = x % D + D * Delta D A B x hD hA hB := by
            simpa only [hqDef] using
              (sub_q_mul_eq_emod_add_Delta
                (D := D) (A := A) (B := B) (x := x) (q := q)
                hD hA hB hqDef)
  exact
    divmod_if2_correct_of_delta_le2
      (D := D) (x := x) (q := q) (r := r) (δ := Delta D A B x hD hA hB)
      hD hDeltaNonneg hDeltaLe2 hDeltaEq hrEq

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hBound : compute_xMin D A B 2 = bound`,
  `hx0 : 0 ≤ x`, `hx : x < bound`、および `divmodImpl` の2段補正形への展開式。
主張: `divmodImpl x = (x / D, x % D)`。
内容: `delta_bounds_of_lt_compute_xMin_bound` で `0 ≤ Delta ≤ 2` を導き、
  `q`,`r` の標準形を作って `divmod_core_eq_of_delta_le2` へ渡す。
証明: 境界補題と 2 段補正共通補題の連結で示す。
役割: `divmod_d19_A63_B64_K2_127bit_correct_on_range` の重複を取り除く。
-/
private lemma divmod_eq_spec_of_delta_le2_on_range
    (divmodImpl : Int → Int × Int)
    {D A B bound x : Int}
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hBound : Impl.compute_xMin D A B 2 = bound)
    (hx0 : 0 ≤ x)
    (hx : x < bound)
    (hDivmod :
      let M : Int := A * B / D
      let q : Int := ((x / A) * M) / B
      let r : Int := x - q * D
      divmodImpl x =
        if D * 2 ≤ r then (q + 2, r - D * 2)
        else if D ≤ r then (q + 1, r - D)
        else (q, r)) :
    divmodImpl x = (x / D, x % D) := by
  rcases
      delta_bounds_of_lt_compute_xMin_bound
        (D := D) (A := A) (B := B) (K := 2) (x := x)
        (bound := bound) hD hA hB (by decide) hx0 hBound hx
    with ⟨hDeltaNonneg, hDeltaLe2⟩
  let M : Int := A * B / D
  let q : Int := ((x / A) * M) / B
  let r : Int := x - q * D
  have hqDef : q = (((x / A) * ((A * B) / D)) / B) := by
    simp [M, q]
  have hDivmod' :
      divmodImpl x =
        if D * 2 ≤ r then (q + 2, r - D * 2)
        else if D ≤ r then (q + 1, r - D)
        else (q, r) := by
    simpa [M, q, r] using hDivmod
  exact
    hDivmod'.trans
      (divmod_core_eq_of_delta_le2
        (D := D) (A := A) (B := B) (x := x) (q := q) (r := r)
        hD hA hB hDeltaNonneg hDeltaLe2 hqDef rfl)

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`、`0 ≤ Delta ≤ 3`、
  近似商の定義式 `hqDef`、および `r = x - q * D`。
主張: 3 段補正版
`if D*3 ≤ r then ... else if D*2 ≤ r then ... else if D ≤ r then ...`
は真の商剰余に一致する。
内容: `delta` と `r` の標準形を作って `divmod_if3_correct_of_delta_le3` に渡す。
証明: 1 段版・2 段版と同型の前処理をまとめる。
役割: 3 段補正の例証明から中間補題の重複を外す。
-/
private lemma divmod_core_eq_of_delta_le3
    {D A B x q r : Int}
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hDeltaNonneg : 0 ≤ Delta D A B x hD hA hB)
    (hDeltaLe3 : Delta D A B x hD hA hB ≤ 3)
    (hqDef : q = (((x / A) * ((A * B) / D)) / B))
    (hr : r = x - q * D) :
    (if D * 3 ≤ r then (q + 3, r - D * 3)
      else if D * 2 ≤ r then (q + 2, r - D * 2)
      else if D ≤ r then (q + 1, r - D)
      else (q, r)) = (x / D, x % D) := by
  have hDeltaEq : Delta D A B x hD hA hB = x / D - q := by
    exact
      Delta_eq_div_sub_q
        (D := D) (A := A) (B := B) (x := x) (q := q)
        hD hA hB hqDef
  have hrEq : r = x % D + D * Delta D A B x hD hA hB := by
    calc
      r = x - q * D := hr
      _ = x % D + D * Delta D A B x hD hA hB := by
            simpa only [hqDef] using
              (sub_q_mul_eq_emod_add_Delta
                (D := D) (A := A) (B := B) (x := x) (q := q)
                hD hA hB hqDef)
  exact
    divmod_if3_correct_of_delta_le3
      (D := D) (x := x) (q := q) (r := r) (δ := Delta D A B x hD hA hB)
      hD hDeltaNonneg hDeltaLe3 hDeltaEq hrEq

/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hBound : compute_xMin D A B 3 = bound`,
  `hx0 : 0 ≤ x`, `hx : x < bound`、および `divmodImpl` の3段補正形への展開式。
主張: `divmodImpl x = (x / D, x % D)`。
内容: `delta_bounds_of_lt_compute_xMin_bound` で `0 ≤ Delta ≤ 3` を導き、
  `q`,`r` の標準形を作って `divmod_core_eq_of_delta_le3` へ渡す。
証明: 境界補題と 3 段補正共通補題の連結で示す。
役割: `divmod_d19_A64_B64_K3_128bit_correct_on_range` の重複を取り除く。
-/
private lemma divmod_eq_spec_of_delta_le3_on_range
    (divmodImpl : Int → Int × Int)
    {D A B bound x : Int}
    (hD : 0 < D)
    (hA : 0 < A)
    (hB : 0 < B)
    (hBound : Impl.compute_xMin D A B 3 = bound)
    (hx0 : 0 ≤ x)
    (hx : x < bound)
    (hDivmod :
      let M : Int := A * B / D
      let q : Int := ((x / A) * M) / B
      let r : Int := x - q * D
      divmodImpl x =
        if D * 3 ≤ r then (q + 3, r - D * 3)
        else if D * 2 ≤ r then (q + 2, r - D * 2)
        else if D ≤ r then (q + 1, r - D)
        else (q, r)) :
    divmodImpl x = (x / D, x % D) := by
  rcases
      delta_bounds_of_lt_compute_xMin_bound
        (D := D) (A := A) (B := B) (K := 3) (x := x)
        (bound := bound) hD hA hB (by decide) hx0 hBound hx
    with ⟨hDeltaNonneg, hDeltaLe3⟩
  let M : Int := A * B / D
  let q : Int := ((x / A) * M) / B
  let r : Int := x - q * D
  have hqDef : q = (((x / A) * ((A * B) / D)) / B) := by
    simp [M, q]
  have hDivmod' :
      divmodImpl x =
        if D * 3 ≤ r then (q + 3, r - D * 3)
        else if D * 2 ≤ r then (q + 2, r - D * 2)
        else if D ≤ r then (q + 1, r - D)
        else (q, r) := by
    simpa [M, q, r] using hDivmod
  exact
    hDivmod'.trans
      (divmod_core_eq_of_delta_le3
        (D := D) (A := A) (B := B) (x := x) (q := q) (r := r)
        hD hA hB hDeltaNonneg hDeltaLe3 hqDef rfl)

/--
入力/前提: `hqr : Spec.divmod_d32 x = (q, r)`。
主張: 仕様 `divmod_d32` から得た剰余 `r` は `0 ≤ r < D32` を満たす。
内容: `r = x % D32` を取り出して、`Int.emod_nonneg` と `Int.emod_lt_of_pos` を適用する。
証明: `Prod.snd` への射影と剰余の基本不等式で示す。
役割: `split3_d16_128bit_correct_on_range` で第2段 `divmod_d16` の前提をまとめて供給する。
-/
private lemma spec_divmod_d32_rem_bounds
    {x q r : Int}
    (hqr : Spec.divmod_d32 x = (q, r)) :
    0 ≤ r ∧ r < D32 := by
  have hD32 : 0 < D32 := by decide
  have hrEq : r = x % D32 := by
    symm
    simpa only [Spec.divmod_d32] using congrArg Prod.snd hqr
  constructor
  · simpa only [hrEq] using (Int.emod_nonneg x (ne_of_gt hD32))
  · simpa only [hrEq] using (Int.emod_lt_of_pos x hD32)

/--
入力/前提: `hqr : Spec.divmod_d32 x = (q, r)`。
主張: `divmod_d32` の剰余 `r` は第2段 `divmod_d16` の想定上界より小さい。
内容: `r < D32` と具体定数不等式 `D32 < xBound_d16_A52_B64_K1_115bit` を連結する。
証明: 剰余範囲補題と `decide` による定数比較で示す。
役割: `split3_d16_128bit_correct_on_range` で第2段の利用域条件を 1 行で供給する。
-/
private lemma spec_divmod_d32_rem_lt_d16_bound
    {x q r : Int}
    (hqr : Spec.divmod_d32 x = (q, r)) :
    r < Impl.Internal.xBound_d16_A52_B64_K1_115bit := by
  exact lt_trans (spec_divmod_d32_rem_bounds hqr).2 (by decide)

end Internal

/--
入力/前提: `hx0 : 0 ≤ x`, `hx : x < xBound_d19_A63_B64_K1_125bit`。
主張: `divmod_d19_A63_B64_K1_125bit x = divmod_d19 x`。
内容: 境界条件から `0 ≤ Delta ≤ 1` を導き、`q`,`r` の形へ落とす。
  その後に共通補題 `divmod_if1_correct_of_delta_le1` を適用して結論を得る。
証明: 既存の共通補題を連結して示す。
役割: `divmod_d19_A63_B64_K1_125bit` の利用域における正当性保証を与える。
-/
theorem divmod_d19_A63_B64_K1_125bit_correct_on_range
    {x : Int}
    (hx0 : 0 ≤ x)
    (hx : x < Impl.Internal.xBound_d19_A63_B64_K1_125bit) :
    Impl.divmod_d19_A63_B64_K1_125bit x = Spec.divmod_d19 x := by
  have hD : 0 < D19 := by decide
  have hA : 0 < Impl.Internal.A63 := by decide
  have hB : 0 < Impl.Internal.B64 := by decide
  simpa only [Spec.divmod_d19, D19] using
    (Internal.divmod_eq_spec_of_delta_le1_on_range
      Impl.divmod_d19_A63_B64_K1_125bit
      (D := D19) (A := Impl.Internal.A63) (B := Impl.Internal.B64)
      (bound := Impl.Internal.xBound_d19_A63_B64_K1_125bit)
      hD hA hB Internal.compute_xMin_D19_A63_B64_K1 hx0 hx
      (by
        unfold Impl.divmod_d19_A63_B64_K1_125bit
        rfl))

/--
入力/前提: `hx0 : 0 ≤ x`, `hx : x < xBound_d19_A63_B64_K2_127bit`。
主張: `divmod_d19_A63_B64_K2_127bit x = divmod_d19 x`。
内容: 境界条件から `0 ≤ Delta ≤ 2` を導き、`q`,`r` の形へ落とす。
  その後に共通補題 `divmod_if2_correct_of_delta_le2` を適用して結論を得る。
証明: 既存の共通補題を連結して示す。
役割: `divmod_d19_A63_B64_K2_127bit` の利用域における正当性保証を与える。
-/
theorem divmod_d19_A63_B64_K2_127bit_correct_on_range
    {x : Int}
    (hx0 : 0 ≤ x)
    (hx : x < Impl.Internal.xBound_d19_A63_B64_K2_127bit) :
    Impl.divmod_d19_A63_B64_K2_127bit x = Spec.divmod_d19 x := by
  have hD : 0 < D19 := by decide
  have hA : 0 < Impl.Internal.A63 := by decide
  have hB : 0 < Impl.Internal.B64 := by decide
  simpa only [Spec.divmod_d19, D19] using
    (Internal.divmod_eq_spec_of_delta_le2_on_range
      Impl.divmod_d19_A63_B64_K2_127bit
      (D := D19) (A := Impl.Internal.A63) (B := Impl.Internal.B64)
      (bound := Impl.Internal.xBound_d19_A63_B64_K2_127bit)
      hD hA hB Internal.compute_xMin_D19_A63_B64_K2 hx0 hx
      (by
        unfold Impl.divmod_d19_A63_B64_K2_127bit
        rfl))

/--
入力/前提: `hx0 : 0 ≤ x`, `hx : x < xBound_d19_128bit`。
主張: `divmod_d19_128bit x = divmod_d19 x`。
内容: 境界条件から `0 ≤ Delta ≤ 3` を導き、`q`,`r` の形へ落とす。
  その後に共通補題 `divmod_if3_correct_of_delta_le3` を適用して結論を得る。
証明: 既存の共通補題を連結して示す。
役割: `divmod_d19_A64_B64_K3_128bit` の利用域における正当性保証を与える。
-/
theorem divmod_d19_A64_B64_K3_128bit_correct_on_range
    {x : Int}
    (hx0 : 0 ≤ x)
    (hx : x < Impl.Internal.xBound_d19_A64_B64_K3_128bit) :
    Impl.divmod_d19_A64_B64_K3_128bit x = Spec.divmod_d19 x := by
  have hD : 0 < D19 := by decide
  have hA : 0 < Impl.Internal.A64 := by decide
  have hB : 0 < Impl.Internal.B64 := by decide
  simpa only [Spec.divmod_d19, D19] using
    (Internal.divmod_eq_spec_of_delta_le3_on_range
      Impl.divmod_d19_A64_B64_K3_128bit
      (D := D19) (A := Impl.Internal.A64) (B := Impl.Internal.B64)
      (bound := Impl.Internal.xBound_d19_A64_B64_K3_128bit)
      hD hA hB Internal.compute_xMin_D19_A64_B64_K3 hx0 hx
      (by
        unfold Impl.divmod_d19_A64_B64_K3_128bit
        rfl))

/--
入力/前提: `hx0 : 0 ≤ x`, `hx : x < xBound_d32_A64_B64_K1_128bit`。
主張: `divmod_d32_A64_B64_K1_128bit x = divmod_d32 x`。
内容: 境界条件から `0 ≤ Delta ≤ 1` を導き、`q`,`r` の形へ落とす。
  その後に共通補題 `divmod_if1_correct_of_delta_le1` を適用して結論を得る。
証明: `delta_bounds_of_lt_compute_xMin_bound` と共通補題の連結で示す。
役割: `D=10^32` の1段補正実装が仕様 `divmod_d32` と一致することを与える。
-/
theorem divmod_d32_A64_B64_K1_128bit_correct_on_range
    {x : Int}
    (hx0 : 0 ≤ x)
    (hx : x < Impl.Internal.xBound_d32_A64_B64_K1_128bit) :
    Impl.divmod_d32_A64_B64_K1_128bit x = Spec.divmod_d32 x := by
  have hD : 0 < D32 := by decide
  have hA : 0 < Impl.Internal.A64 := by decide
  have hB : 0 < Impl.Internal.B64 := by decide
  simpa only [Spec.divmod_d32] using
    (Internal.divmod_eq_spec_of_delta_le1_on_range
      Impl.divmod_d32_A64_B64_K1_128bit
      (D := D32) (A := Impl.Internal.A64) (B := Impl.Internal.B64)
      (bound := Impl.Internal.xBound_d32_A64_B64_K1_128bit)
      hD hA hB Internal.compute_xMin_D32_A64_B64_K1 hx0 hx
      (by
        unfold Impl.divmod_d32_A64_B64_K1_128bit
        rfl))

/--
入力/前提: `hx0 : 0 ≤ x`, `hx : x < xBound_d16_A52_B64_K1_115bit`。
主張: `divmod_d16_A52_B64_K1_115bit x = divmod_d16 x`。
内容: 境界条件から `0 ≤ Delta ≤ 1` を導き、`q`,`r` の形へ落とす。
  その後に共通補題 `divmod_if1_correct_of_delta_le1` を適用して結論を得る。
証明: `delta_bounds_of_lt_compute_xMin_bound` と共通補題の連結で示す。
役割: `D=10^16` の1段補正実装が仕様 `divmod_d16` と一致することを与える。
-/
theorem divmod_d16_A52_B64_K1_115bit_correct_on_range
    {x : Int}
    (hx0 : 0 ≤ x)
    (hx : x < Impl.Internal.xBound_d16_A52_B64_K1_115bit) :
    Impl.divmod_d16_A52_B64_K1_115bit x = Spec.divmod_d16 x := by
  have hD : 0 < D16 := by decide
  have hA : 0 < Impl.Internal.A52 := by decide
  have hB : 0 < Impl.Internal.B64 := by decide
  simpa only [Spec.divmod_d16] using
    (Internal.divmod_eq_spec_of_delta_le1_on_range
      Impl.divmod_d16_A52_B64_K1_115bit
      (D := D16) (A := Impl.Internal.A52) (B := Impl.Internal.B64)
      (bound := Impl.Internal.xBound_d16_A52_B64_K1_115bit)
      hD hA hB Internal.compute_xMin_D16_A52_B64_K1 hx0 hx
      (by
        unfold Impl.divmod_d16_A52_B64_K1_115bit
        rfl))

/--
入力/前提: `hx0 : 0 ≤ x`, `hx : x < xBound_d32_A64_B64_K1_128bit`。
主張: `split3_d16_128bit x = split3_d16 x`。
内容: 第1段 `divmod_d32` の一致で得た剰余 `r` に対して
  `0 ≤ r < D32 < xBound_d16_A52_B64_K1_115bit` を示し、
  第2段 `divmod_d16` の一致を適用して三つ組を同一視する。
証明: 2つの範囲内正当性定理と剰余の基本不等式を連結して示す。
役割: 3ブロック分解実装 `split3_d16_128bit` の仕様一致を与える。
-/
theorem split3_d16_128bit_correct_on_range
    {x : Int}
    (hx0 : 0 ≤ x)
    (hx : x < Impl.Internal.xBound_d32_A64_B64_K1_128bit) :
    Impl.split3_d16_128bit x = Spec.split3_d16 x := by
  have h32 : Impl.divmod_d32_A64_B64_K1_128bit x = Spec.divmod_d32 x :=
    divmod_d32_A64_B64_K1_128bit_correct_on_range hx0 hx
  unfold Impl.split3_d16_128bit Spec.split3_d16
  rw [h32]
  cases hqr : Spec.divmod_d32 x with
  | mk q r =>
      have h16 :
          Impl.divmod_d16_A52_B64_K1_115bit r = Spec.divmod_d16 r := by
        exact
          divmod_d16_A52_B64_K1_115bit_correct_on_range
            (Internal.spec_divmod_d32_rem_bounds hqr).1
            (Internal.spec_divmod_d32_rem_lt_d16_bound hqr)
      simp [h16]

end Correctness

end Pow10

end Examples

end Divapprox

Fib.lean

import Mathlib.Analysis.SpecialFunctions.Log.Base
import Mathlib.Data.Nat.Fib.Zeckendorf
import Mathlib.NumberTheory.Real.GoldenRatio
namespace Fib

/-! ### Binet formula and floor/log characterization -/

noncomputable section

namespace LogPhi

/--
目的: `floor/log` 連鎖で使う引数 `logArg` を定義する。
定義: `logArg n = √5 * (n + 1/2)` と置く。
入力/前提: n : Nat。
出力: 型 `Real` の値を返す。
役割: `log_φ` 側の不等式と `fib` 側の近似不等式を同一の式で橋渡しする。
-/
def logArg (n : Nat) : Real := Real.sqrt 5 * ((n : Real) + (1 / 2 : Real))

/--
目的: 黄金比を底とする対数 `logPhi` を定義する。
定義: `logPhi x := Real.logb Real.goldenRatio x`。
入力/前提: x : Real。
出力: 型 `Real` の値を返す。
役割: 添字 `k` を `floor(log_φ(...))` で記述する主定理の記号を固定する。
-/
def logPhi (x : Real) : Real := Real.logb Real.goldenRatio x

namespace Internal

/--
入力/前提: 追加の仮定なし。
主張: `sqrt 5` は正である。
内容: `Real.sqrt_pos` を `5 > 0` に適用する。
証明: 既存補題の適用と式変形で示す。
役割: 除算・乗除不等式変形（`div_le_iff₀`, `lt_div_iff₀`）の前提に使う。
-/
private lemma sqrt5_pos : 0 < Real.sqrt 5 := by
  positivity

/--
入力/前提: n : Nat。
主張: `logArg n` は正である。
内容: `logArg` を展開し、`sqrt5_pos` と `(n : Real) + 1/2 > 0` の積として示す。
証明: 式変形で示す。
役割: `Real.le_logb_iff_rpow_le` など `logb` の正引数条件を満たす。
-/
private lemma logArg_pos (n : Nat) : 0 < logArg n := by
  unfold logArg
  positivity

/--
入力/前提: k n : Nat。
主張: `k = floor(logPhi(logArg n))` の同値条件を区間不等式で与える。
内容: `Int.floor_eq_iff` を適用し、`(k : Real)+1` を `(k+1 : Real)` に正規化する。
証明: 既存補題の書き換えで示す。
役割: `floor` 記述から連続量の不等式記述への最初の変換を担う。
-/
private lemma floor_logPhi_iff (k n : Nat) :
    (k : Int) = Int.floor (logPhi (logArg n)) ↔
      ((k : Real) ≤ logPhi (logArg n) ∧ logPhi (logArg n) < (k + 1 : Real)) := by
  constructor
  · intro hk
    simpa only using (Int.floor_eq_iff).1 hk.symm
  · intro hk
    exact ((Int.floor_eq_iff).2 (by simpa only using hk)).symm

/--
入力/前提: k n : Nat。
主張: `logPhi` の区間不等式と `phi` のべき不等式は同値である。
内容: 底条件 `Real.one_lt_goldenRatio` と引数正条件 `logArg_pos` の下で、
     `Real.le_logb_iff_rpow_le` と `Real.logb_lt_iff_lt_rpow` を往復適用する。
証明: 式変形・既存補題の書き換えで示す。
役割: 対数表現から指数表現へ移る中核変換。
-/
private lemma logPhi_bounds_iff_pow_bounds (k n : Nat) :
    ((k : Real) ≤ logPhi (logArg n) ∧ logPhi (logArg n) < (k + 1 : Real)) ↔
      (Real.goldenRatio ^ k ≤ logArg n ∧
        logArg n < Real.goldenRatio ^ (k + 1)) := by
  have hpos := logArg_pos n
  constructor
  · rintro ⟨h1, h2⟩
    exact ⟨
      by
        simpa [Real.rpow_natCast] using
          (Real.le_logb_iff_rpow_le Real.one_lt_goldenRatio hpos).1 h1,
      by
        rw [← Real.rpow_natCast]
        simpa [Nat.cast_add, Nat.cast_one] using
          (Real.logb_lt_iff_lt_rpow Real.one_lt_goldenRatio hpos).1 h2⟩
  · rintro ⟨h1, h2⟩
    exact ⟨
      (Real.le_logb_iff_rpow_le Real.one_lt_goldenRatio hpos).2 <| by
        simpa [Real.rpow_natCast] using h1,
      (Real.logb_lt_iff_lt_rpow Real.one_lt_goldenRatio hpos).2 <| by
        rw [← Real.rpow_natCast] at h2
        simpa [Nat.cast_add, Nat.cast_one] using h2⟩

/--
入力/前提: k n : Nat。
主張: `phi` のべき境界と `n` の平行移動境界は同値である。
内容: `logArg = √5*(n+1/2)` を展開し、`sqrt5_pos` を使った乗除不等式変形で
     `phi^k/√5 - 1/2 ≤ n < phi^(k+1)/√5 - 1/2` へ整理する。
証明: 式変形で示す。
役割: 解析的な指数境界を整数 `n` に直接比較できる形へ変換する。
-/
private lemma pow_bounds_iff_shifted_bounds (k n : Nat) :
    (Real.goldenRatio ^ k ≤ logArg n ∧
      logArg n < Real.goldenRatio ^ (k + 1)) ↔
      (Real.goldenRatio ^ k / Real.sqrt 5 - (1 / 2 : Real) ≤ (n : Real) ∧
        (n : Real) <
          Real.goldenRatio ^ (k + 1) / Real.sqrt 5 - (1 / 2 : Real)) := by
  constructor
  · intro h
    rcases h with ⟨h1, h2⟩
    constructor
    · have h1' :
          Real.goldenRatio ^ k / Real.sqrt 5 ≤ (n : Real) + (1 / 2 : Real) := by
        exact (div_le_iff₀ sqrt5_pos).2 <|
          by simpa [logArg, one_div, mul_comm] using h1
      linarith
    · have h2' :
          (n : Real) + (1 / 2 : Real) <
            Real.goldenRatio ^ (k + 1) / Real.sqrt 5 := by
        exact (lt_div_iff₀ sqrt5_pos).2 <|
          by simpa [logArg, one_div, mul_comm] using h2
      linarith
  · intro h
    rcases h with ⟨h1, h2⟩
    constructor
    · have h1' :
          Real.goldenRatio ^ k / Real.sqrt 5 ≤ (n : Real) + (1 / 2 : Real) := by
        linarith
      simpa [logArg, one_div, mul_comm] using (div_le_iff₀ sqrt5_pos).1 h1'
    · have h2' :
          (n : Real) + (1 / 2 : Real) <
            Real.goldenRatio ^ (k + 1) / Real.sqrt 5 := by
        linarith
      simpa [logArg, one_div, mul_comm] using (lt_div_iff₀ sqrt5_pos).1 h2'

/--
入力/前提: n : Nat。
主張: `fib n` は `phi^n/√5` の `1/2` 未満の誤差で近似される。
内容: `Real.coe_fib_eq` の誤差項 `goldenConj^n/√5` を `|goldenConj| < 1` と
     `√5 > 2` で評価し、絶対値不等式から上下評価へ変換する。
証明: `sqrt5_pos` を再利用しつつ、Binet 公式を直接展開して誤差項を評価する。
役割: `shifted_bounds_iff_fib_bounds` で `fib` の上下界を供給する。
-/
private lemma fib_binet_bounds (n : Nat) :
    Real.goldenRatio ^ n / Real.sqrt 5 - (1 / 2 : Real) < (Nat.fib n : Real) ∧
    (Nat.fib n : Real) < Real.goldenRatio ^ n / Real.sqrt 5 + (1 / 2 : Real) := by
  have habs_psi_lt_one : |Real.goldenConj| < (1 : Real) := by
    refine abs_lt.2 ?_
    constructor
    · simpa only using Real.neg_one_lt_goldenConj
    · have : Real.goldenConj < 0 := by
        simpa only using Real.goldenConj_neg
      linarith
  have habs_psi_pow_le_one : |Real.goldenConj| ^ n ≤ (1 : Real) := by
    exact pow_le_one₀ (abs_nonneg Real.goldenConj) (le_of_lt habs_psi_lt_one)
  have hone_div_sqrt5_lt_half : (1 : Real) / Real.sqrt 5 < (1 : Real) / 2 := by
    simpa [one_div] using
      (one_div_lt_one_div_of_lt (show (0 : Real) < 2 by norm_num) <|
        show (2 : Real) < Real.sqrt 5 by
          refine (Real.lt_sqrt (show (0 : Real) ≤ 2 by norm_num)).2 ?_
          norm_num)
  have habs_err_le :
      |Real.goldenConj ^ n / Real.sqrt 5| ≤ (1 : Real) / Real.sqrt 5 := by
    simpa [abs_div, abs_pow, abs_of_pos sqrt5_pos] using
      (div_le_div_of_nonneg_right habs_psi_pow_le_one (le_of_lt sqrt5_pos))
  have herr :
      (Nat.fib n : Real) - Real.goldenRatio ^ n / Real.sqrt 5 =
        -(Real.goldenConj ^ n / Real.sqrt 5) := by
    have hsqrt5_ne : (Real.sqrt 5) ≠ 0 := ne_of_gt sqrt5_pos
    rw [show (Nat.fib n : Real) =
      (Real.goldenRatio ^ n - Real.goldenConj ^ n) / Real.sqrt 5 by
        simpa only using (Real.coe_fib_eq n)]
    field_simp [hsqrt5_ne]
    ring
  have hmain :
      (-(1 / 2 : Real) < (Nat.fib n : Real) - Real.goldenRatio ^ n / Real.sqrt 5) ∧
      ((Nat.fib n : Real) - Real.goldenRatio ^ n / Real.sqrt 5 < (1 / 2 : Real)) := by
    refine abs_lt.mp ?_
    rw [herr, abs_neg]
    exact lt_of_le_of_lt habs_err_le hone_div_sqrt5_lt_half
  constructor <;> linarith [hmain.1, hmain.2]

/--
入力/前提: n : Nat。
主張: `fib_binet_bounds` の下側評価を取り出す。
内容: 連言の左成分を返すだけ。
証明: 既存補題の適用と式変形で示す。
役割: `shifted_bounds_iff_fib_bounds` で下界のみ使う場面を簡潔化する。
-/
private lemma fib_binet_lower (n : Nat) :
    Real.goldenRatio ^ n / Real.sqrt 5 - (1 / 2 : Real) < (Nat.fib n : Real) := by
  exact (fib_binet_bounds n).1

/--
入力/前提: n : Nat。
主張: `fib_binet_bounds` の上側評価を取り出す。
内容: 連言の右成分を返すだけ。
証明: 既存補題の適用と式変形で示す。
役割: `shifted_bounds_iff_fib_bounds` で上界のみ使う場面を簡潔化する。
-/
private lemma fib_binet_upper (n : Nat) :
    (Nat.fib n : Real) < Real.goldenRatio ^ n / Real.sqrt 5 + (1 / 2 : Real) := by
  exact (fib_binet_bounds n).2

/--
入力/前提: k n : Nat。
主張: 平行移動境界とフィボナッチ区間条件は同値である。
内容: `fib_binet_lower/upper` を `k` と `k+1` に適用し、
     `Nat` と `Real` のキャストを介して `fib k ≤ n < fib (k+1)` に読み替える。
証明: 式変形・既存補題の書き換えで示す。
役割: 解析的不等式から最終的な離散条件（フィボナッチ区間）へ接続する。
-/
private lemma shifted_bounds_iff_fib_bounds (k n : Nat) :
    (Real.goldenRatio ^ k / Real.sqrt 5 - (1 / 2 : Real) ≤ (n : Real) ∧
      (n : Real) < Real.goldenRatio ^ (k + 1) / Real.sqrt 5 - (1 / 2 : Real)) ↔
      (Nat.fib k ≤ n ∧ n < Nat.fib (k + 1)) := by
  constructor
  · intro h
    rcases h with ⟨h1, h2⟩
    constructor
    · have hk_lt : (Nat.fib k : Real) < (n : Real) + 1 := by
        linarith [h1, fib_binet_upper k]
      exact Nat.lt_succ_iff.mp <| by
        exact_mod_cast (show (Nat.fib k : Real) < ((n + 1 : Nat) : Real) by
          simpa [Nat.cast_add, Nat.cast_one] using hk_lt)
    · exact_mod_cast (lt_trans h2 (fib_binet_lower (k + 1)))
  · intro h
    rcases h with ⟨h1, h2⟩
    constructor
    · exact le_of_lt (lt_of_lt_of_le (fib_binet_lower k) (by exact_mod_cast h1))
    · have hcast : ((n + 1 : Nat) : Real) ≤ (Nat.fib (k + 1) : Real) := by
        exact_mod_cast Nat.succ_le_of_lt h2
      have hplus :
          ((n + 1 : Nat) : Real) <
            Real.goldenRatio ^ (k + 1) / Real.sqrt 5 + (1 / 2 : Real) :=
        lt_of_le_of_lt hcast (fib_binet_upper (k + 1))
      have hplus' :
          (n : Real) + 1 <
            Real.goldenRatio ^ (k + 1) / Real.sqrt 5 + (1 / 2 : Real) := by
        simpa [Nat.cast_add, Nat.cast_one] using hplus
      linarith

end Internal

/--
入力/前提: k n : Nat。
主張: `k = floor(log_φ(√5(n+1/2)))` と `fib k ≤ n < fib (k+1)` は同値である。
内容: `floor_logPhi_iff` から始め、`logPhi_bounds_iff_pow_bounds`、
     `pow_bounds_iff_shifted_bounds`、`shifted_bounds_iff_fib_bounds` を順に合成する。
証明: 式変形で示す。
役割: 本セクションの目標同値連鎖を一本の定理として確定する。
-/
theorem floor_logPhi_iff_fib_bounds (k n : Nat) :
    (k : Int) = Int.floor (logPhi (logArg n)) ↔
      (Nat.fib k ≤ n ∧ n < Nat.fib (k + 1)) := by
  rw [Internal.floor_logPhi_iff, Internal.logPhi_bounds_iff_pow_bounds,
    Internal.pow_bounds_iff_shifted_bounds, Internal.shifted_bounds_iff_fib_bounds]

/--
入力/前提: k n : Nat。
主張: `k = floor(log_φ(n+1/2) + log_φ(√5))` と
     `fib k ≤ n < fib (k+1)` は同値である。
内容: `log_φ(√5*(n+1/2)) = log_φ(n+1/2) + log_φ(√5)` を
     `Real.logb_mul` で示し、`floor_logPhi_iff_fib_bounds` に帰着する。
証明: 式変形・既存補題の書き換えで示す。
役割: 主定理をユーザ指定の和の対数形で利用できるようにする。
-/
theorem floor_logPhi_add_sqrt5_iff_fib_bounds (k n : Nat) :
    (k : Int) = Int.floor (logPhi ((n : Real) + (1 / 2 : Real)) + logPhi (Real.sqrt 5)) ↔
      (Nat.fib k ≤ n ∧ n < Nat.fib (k + 1)) := by
  have hlog :
      logPhi (logArg n) =
        logPhi ((n : Real) + (1 / 2 : Real)) + logPhi (Real.sqrt 5) := by
    unfold logPhi logArg
    rw [Real.logb_mul (b := Real.goldenRatio)
      (x := Real.sqrt 5) (y := (n : Real) + (1 / 2 : Real))]
    · ac_rfl
    · exact ne_of_gt Internal.sqrt5_pos
    · positivity
  simpa only [one_div, hlog] using (floor_logPhi_iff_fib_bounds (k := k) (n := n))

namespace Internal

/--
入力/前提: m : Nat。
主張: `phi^(m+1)` は `fib (m+3)` より真に小さい。
内容: `phi < 2` と `fib (m+1) > 0` から
     `phi*fib(m+1) < 2*fib(m+1)` を得て、`fib m` を加える。
証明: 式変形・既存補題の書き換えで示す。
役割: `n < phi^(m+1) < fib(m+3)` の鎖を直接作る補助補題。
-/
private lemma phi_pow_succ_lt_fib_add_three (m : Nat) :
    Real.goldenRatio ^ (m + 1) < (Nat.fib (m + 3) : Real) := by
  have hphi_lt_two : Real.goldenRatio < 2 := by
    simpa only using Real.goldenRatio_lt_two
  have hfib_pos : (0 : Real) < (Nat.fib (m + 1) : Real) := by
    exact_mod_cast (Nat.fib_pos).2 (Nat.succ_pos m)
  calc
    Real.goldenRatio ^ (m + 1) =
        Real.goldenRatio * (Nat.fib (m + 1) : Real) + (Nat.fib m : Real) := by
      simpa only using (Real.goldenRatio_mul_fib_succ_add_fib m).symm
    _ < (2 : Real) * (Nat.fib (m + 1) : Real) + (Nat.fib m : Real) := by
      nlinarith [hphi_lt_two, hfib_pos]
    _ = (Nat.fib (m + 3) : Real) := by
      simp [two_mul, Nat.cast_add, Nat.fib_add_two, add_comm, add_left_comm]

end Internal

/--
入力/前提: n : Nat。
主張: `n < Nat.fib (floor(log_φ n) + 3)` が成り立つ。
内容: `m = floor(log_φ n)` として `log_φ n < m+1` から `n < phi^(m+1)` を得て、
     `phi_pow_succ_lt_fib_add_three` で `phi^(m+1) < fib(m+3)` に移して結論する。
証明: 場合分け・式変形・既存補題の書き換えで示す。
役割: `n` に対する単純な `fib` 上界指標を `floor(log_φ n)` で与える。
-/
theorem lt_fib_floor_logPhi_add_three (n : Nat) :
    n < Nat.fib (Nat.floor (logPhi (n : Real)) + 3) := by
  by_cases hn : n = 0
  · subst hn
    norm_num [logPhi]
  · let m : Nat := Nat.floor (logPhi (n : Real))
    have hn_pos : (0 : Real) < (n : Real) := by exact_mod_cast Nat.pos_of_ne_zero hn
    have hn_lt_pow : (n : Real) < Real.goldenRatio ^ (m + 1) := by
      rw [← Real.rpow_natCast]
      exact (Real.logb_lt_iff_lt_rpow Real.one_lt_goldenRatio hn_pos).1 <|
        by simpa [m] using (Nat.lt_floor_add_one (logPhi (n : Real)))
    have : (n : Real) < (Nat.fib (Nat.floor (logPhi (n : Real)) + 3) : Real) := by
      simpa [m] using lt_trans hn_lt_pow (Internal.phi_pow_succ_lt_fib_add_three m)
    exact_mod_cast this

end LogPhi

end /- noncomputable section -/

namespace Core

namespace Internal

/--
目的: 二分探索で扱う Fibonacci 状態 `FibState` を表す。
フィールド:
  `i`   : 現在の添字
  `fi`  : `Nat.fib i` の値
  `fi1` : `Nat.fib (i + 1)` の値
不変条件: 仕様補題では常に `fi = Nat.fib i` と `fi1 = Nat.fib (i + 1)` を維持する。
役割: `fibst_add`・`fibst_dbl`・`greatestFibBinary_go` の再帰状態として用いる。
-/
@[ext]
private structure FibState where
  i : Nat
  fi : Nat
  fi1 : Nat

/--
目的: `FibState` が Fibonacci 値を正しく保持している不変量 `FibState.Valid` を定義する。
定義: `fi = Nat.fib i` かつ `fi1 = Nat.fib (i + 1)`。
入力/前提: `t : FibState`。
出力: 命題を返す。
役割: `fibst_add`・`fibst_dbl`・`greatestFibBinary_go` の仕様補題で共通利用する。
-/
private def FibState.Valid (t : FibState) : Prop :=
  t.fi = Nat.fib t.i ∧ t.fi1 = Nat.fib (t.i + 1)

/--
目的: `greatestFibBinary` の初期状態として使う単位状態 `fibst_one` を定義する。
定義: `fibst_one = ⟨1, 1, 1⟩`。
入力/前提: なし。
出力: 型 `FibState` の値を返す。
役割: `greatestFibBinary` の開始状態を名前で固定し、仕様補題で再利用する。
-/
private def fibst_one : FibState := ⟨1, 1, 1⟩

/--
目的: `greatestFibBinary_go` の失敗側で返す零状態 `fibst_zero` を定義する。
定義: `fibst_zero = ⟨0, 0, 1⟩`。
入力/前提: なし。
出力: 型 `FibState` の値を返す。
役割: `greatestFibBinary_go_spec` の `fuel = 0` ケースと `fi > n` 分岐で共通利用する。
-/
private def fibst_zero : FibState := ⟨0, 0, 1⟩

/--
目的: 加法更新 `fibst_add` を定義する。
定義: 状態 `⟨i, Fib i, Fib (i+1)⟩` と `⟨j, Fib j, Fib (j+1)⟩` から
     加法公式
     `Fib (i+j) = Fib i * Fib (j+1) + (Fib (i+1) - Fib i) * Fib j`、
     `Fib (i+j+1) = Fib (i+1) * Fib (j+1) + Fib i * Fib j`
     を用いて `⟨i+j, Fib (i+j), Fib (i+j+1)⟩` を返す。
入力/前提: `ti tj : FibState`。
出力: 型 `FibState` の値を返す。
役割: `greatestFibBinary_go` で再帰結果に現在状態を合成する補助更新として使う。
-/
@[inline]
private def fibst_add : FibState → FibState → FibState
  | ⟨i, fi, fi1⟩, ⟨j, fj, fj1⟩ =>
      ⟨i + j, fi * fj1 + (fi1 - fi) * fj, fi1 * fj1 + fi * fj⟩

/--
目的: 倍角更新 `fibst_dbl` を定義する。
定義: 状態 `⟨i, Fib i, Fib (i+1)⟩` から
     倍化公式
     `Fib (2i) = Fib i * (2 * Fib (i+1) - Fib i)`、
     `Fib (2i+1) = (Fib i)^2 + (Fib (i+1))^2`
     を用いて `⟨2*i, Fib (2*i), Fib (2*i+1)⟩` を返す。
入力/前提: `t : FibState`。
出力: 型 `FibState` の値を返す。
役割: `greatestFibBinary_go` の再帰呼び出しで添字を倍化する補助更新として使う。
-/
@[inline]
private def fibst_dbl : FibState → FibState
  | ⟨i, fi, fi1⟩ =>
      ⟨2 * i, fi * (2 * fi1 - fi), fi * fi + fi1 * fi1⟩

/--
目的: 三つ組状態に対する二分探索再帰 `greatestFibBinary_go` を定義する。
定義: 状態 `t = ⟨i, fi, fi1⟩` に対し、`fi ≤ n` なら
  `u := greatestFibBinary_go n fuel (fibst_dbl t)` を再帰計算し、
  `v := fibst_add t u` の `fi` 成分が `≤ n` かで `v` または `u` を返す。
  `fi > n` または燃料切れなら `⟨0,0,1⟩` を返す。
入力/前提: `n : Nat`、再帰引数 `fuel : Nat` と状態 `t : FibState`。
出力: 型 `FibState` の値を返す。
役割: `greatestFibBinary` の計算本体として、`fib k ≤ n` を満たす最大添字候補 `k` を構成する。
-/
private def greatestFibBinary_go (n : Nat) :
  Nat → FibState → FibState
  | 0, _t => fibst_zero
  | fuel+1, t =>
    if _h0 : t.fi ≤ n then
      let u := greatestFibBinary_go n fuel (fibst_dbl t)
      let v := fibst_add t u
      if _h1 : v.fi ≤ n then
        v
      else
        u
    else
      fibst_zero

end Internal

/--
目的: `Nat.greatestFib` の行列二分探索実装に与える燃料 `greatestFibBinaryFuel` を定義する。
定義: `m := 2 * log2(n+1) + 3` とおき、
     `greatestFibBinaryFuel n = log2 m + 1` と定める。
入力/前提: `n : Nat`。
出力: 型 `Nat` の燃料値を返す。
役割: `greatestFibBinaryFuel_bound` で
     `greatestFib n < 2 * log2(n+1) + 3 < 2 ^ greatestFibBinaryFuel n`
     を示し、`greatestFibBinary_go_spec` の初期呼び出し条件
     `greatestFib n < 1 * 2^fuel` を満たすために使う。
-/
def greatestFibBinaryFuel (n : Nat) : Nat :=
  Nat.log2 (2 * Nat.log2 (n + 1) + 3) + 1

/--
目的: `Nat.greatestFib` の二分探索実装 `greatestFibBinary` を定義する。
定義: 初期状態 `Internal.fibst_one = ⟨1,1,1⟩ = ⟨1, Fib 1, Fib 2⟩` と
  燃料 `greatestFibBinaryFuel n` を与え、`greatestFibBinary_go` の返す
  `FibState.i` 成分を結果とする。
計算量比較（`Nat` の四則演算を単位コストとみなす）:
  `Nat.greatestFib` は `findGreatest` による線形探索で判定回数 `Θ(n)`、
  `greatestFibBinary` は燃料に比例して反復し判定回数 `O(log log n)`。
入力/前提: `n : Nat`。
出力: 型 `Nat` の値を返す。
役割: `Nat.greatestFib` と同値な計算実装を与える。
-/
def greatestFibBinary (n : Nat) : Nat :=
  (Internal.greatestFibBinary_go n (greatestFibBinaryFuel n) Internal.fibst_one).i

namespace Internal

/--
入力/前提: `i j : Nat`。
主張: `fib (i + j)` を `fib i`・`fib (i+1)`・`fib j`・`fib (j+1)` で表す。
内容: `fibst_add` の `fi` 成分が加法公式と一致することを示す。
証明: `i = 0` と `i = succ _` に分け、`Nat.fib_add` と
     `Nat.fib_add_two_sub_fib_add_one` で式変形する。
役割: `fibst_add_valid` の第一成分に使う。
-/
private theorem fib_add_eq (i j : Nat) :
    Nat.fib (i + j)
      = Nat.fib i * Nat.fib (j + 1)
          + (Nat.fib (i + 1) - Nat.fib i) * Nat.fib j := by
  cases i with
  | zero => simp
  | succ i =>
      simpa [Nat.fib_add_two_sub_fib_add_one, add_comm, add_left_comm] using (Nat.fib_add i j)

/--
入力/前提: なし。
主張: `fibst_zero` は `FibState.Valid` を満たす。
内容: 零状態が `⟨0, fib 0, fib 1⟩` に一致することを確認する。
証明: 定義展開と `simp`。
役割: `greatestFibBinary_go_spec` の燃料切れ・失敗分岐で使う。
-/
private theorem fibst_zero_valid : fibst_zero.Valid := by
  simp [FibState.Valid, fibst_zero]

/--
入力/前提: なし。
主張: `fibst_one` は `FibState.Valid` を満たす。
内容: 初期状態が `⟨1, fib 1, fib 2⟩` に一致することを確認する。
証明: 定義展開と `simp`。
役割: `greatestFibBinary_spec` の初期呼び出し条件で使う。
-/
private theorem fibst_one_valid : fibst_one.Valid := by
  simp [FibState.Valid, fibst_one]

/--
入力/前提: `t u : FibState` と、それぞれの `FibState.Valid`。
主張: `fibst_add t u` も `FibState.Valid` を満たす。
内容: 加法更新が添字 `i + j` に対応する Fibonacci 値を保つことを示す。
証明: 各成分を `Nat.fib_add` と `fib_add_eq` に書き換える。
役割: `greatestFibBinary_go_spec` で再帰結果に現在状態を合成する際に使う。
-/
private theorem fibst_add_valid {t u : FibState} (ht : t.Valid) (hu : u.Valid) :
    (fibst_add t u).Valid := by
  rcases t with ⟨i, fi, fi1⟩
  rcases u with ⟨j, fj, fj1⟩
  replace ht : fi = Nat.fib i ∧ fi1 = Nat.fib (i + 1) := by
    simpa [FibState.Valid] using ht
  rcases ht with ⟨rfl, rfl⟩
  replace hu : fj = Nat.fib j ∧ fj1 = Nat.fib (j + 1) := by
    simpa [FibState.Valid] using hu
  rcases hu with ⟨rfl, rfl⟩
  constructor
  · simpa [fibst_add] using (fib_add_eq i j).symm
  · simpa [fibst_add, add_assoc, add_comm, add_left_comm] using (Nat.fib_add i j).symm

/--
入力/前提: `t : FibState` と `t.Valid`。
主張: `fibst_dbl t` も `FibState.Valid` を満たす。
内容: 倍角更新が添字 `2 * i` に対応する Fibonacci 値を保つことを示す。
証明: `Nat.fib_two_mul` と `Nat.fib_two_mul_add_one` を用いる。
役割: `greatestFibBinary_go_spec` の再帰呼び出しに使う。
-/
private theorem fibst_dbl_valid {t : FibState} (ht : t.Valid) :
    (fibst_dbl t).Valid := by
  rcases t with ⟨i, fi, fi1⟩
  replace ht : fi = Nat.fib i ∧ fi1 = Nat.fib (i + 1) := by
    simpa [FibState.Valid] using ht
  rcases ht with ⟨rfl, rfl⟩
  constructor
  · simp [fibst_dbl, Nat.fib_two_mul]
  · simpa [pow_two, fibst_dbl, two_mul, add_assoc, add_comm, add_left_comm] using
      (Nat.fib_two_mul_add_one i).symm

/--
入力/前提: `m : Nat`。
主張: `2^(m+1) ≤ fib (2*m+3)`。
内容: `fib` が 2 ステップごとに少なくとも倍増することから、
     `log2` ベースの燃料上界を支える整数評価を与える。
証明: `m` に関する帰納法で、`fib (k+2) ≥ 2 * fib k` を使う。
役割: `greatestFibBinaryFuel_bound` の中核評価として使う。
-/
private theorem two_pow_succ_le_fib_two_mul_add_three (m : Nat) :
    2 ^ (m + 1) ≤ Nat.fib (2 * m + 3) := by
  induction m with
  | zero => decide
  | succ m ih =>
      calc
        2 ^ (m + 1 + 1) ≤ 2 * Nat.fib (2 * m + 3) := by
          simpa [pow_succ, Nat.mul_assoc, Nat.mul_left_comm, Nat.mul_comm] using
            Nat.mul_le_mul_left 2 ih
        _ ≤ Nat.fib (2 * m + 3) + Nat.fib (2 * m + 4) := by
            simpa [two_mul] using
              add_le_add_left (Nat.fib_le_fib_succ (n := 2 * m + 3)) (Nat.fib (2 * m + 3))
        _ = Nat.fib (2 * (m + 1) + 3) := by simpa using (Nat.fib_add_two (n := 2 * m + 3)).symm

/--
入力/前提: `n : Nat`、`t : FibState` は `Valid`、かつ `greatestFib n < t.i * 2^fuel`。
主張: `greatestFibBinary_go n fuel t` は `Valid` な状態を返し、その添字 `r.i` は
     `r.i ≤ greatestFib n < r.i + t.i` を満たす。
内容: 戻り値が幅 `t.i` の区間の左端として `greatestFib n` を挟み込むことを示す。
証明: `fuel` に関する帰納法で、再帰結果 `u` の区間を
     `u` または `fibst_add t u` のどちらに振り分ける。
役割: `greatestFibBinary_spec` の核心仕様補題である。
-/
private theorem greatestFibBinary_go_spec (n fuel : Nat) :
    ∀ {t : FibState},
      t.Valid →
      Nat.greatestFib n < t.i * 2 ^ fuel →
      (greatestFibBinary_go n fuel t).Valid
        ∧ (greatestFibBinary_go n fuel t).i ≤ Nat.greatestFib n
        ∧ Nat.greatestFib n < (greatestFibBinary_go n fuel t).i + t.i := by
  induction fuel with
  | zero =>
      intro t ht hbound
      refine ⟨fibst_zero_valid, Nat.zero_le _, ?_⟩
      simpa [greatestFibBinary_go, fibst_zero] using hbound
  | succ fuel ih =>
      intro t ht hbound
      by_cases h0 : t.fi ≤ n
      · have hu := ih (t := fibst_dbl t) (fibst_dbl_valid ht) (by
          simpa [fibst_dbl, pow_succ, Nat.mul_assoc, Nat.mul_left_comm, Nat.mul_comm] using hbound)
        set u := greatestFibBinary_go n fuel (fibst_dbl t)
        set v := fibst_add t u
        have hv_valid : v.Valid := by
          simpa [v] using fibst_add_valid ht (by simpa [u] using hu.1)
        by_cases h1 : v.fi ≤ n
        · simpa [greatestFibBinary_go, h0, u, v, h1] using
            (⟨hv_valid, (Nat.le_greatestFib).2 (by simpa [hv_valid.1] using h1),
              by simpa [u, v, fibst_add, fibst_dbl, two_mul, add_assoc, add_comm] using hu.2.2⟩ :
              v.Valid ∧ v.i ≤ Nat.greatestFib n ∧ Nat.greatestFib n < v.i + t.i)
        · simpa [greatestFibBinary_go, h0, u, v, h1] using
            (⟨by simpa [u] using hu.1, hu.2.1, by simpa [u, v, fibst_add, add_comm] using
              (lt_of_not_ge fun hv_ge =>
                h1 (by simpa [hv_valid.1] using (Nat.le_greatestFib).1 hv_ge) :
                  Nat.greatestFib n < v.i)⟩ :
              u.Valid ∧ u.i ≤ Nat.greatestFib n ∧ Nat.greatestFib n < u.i + t.i)
      · simpa [greatestFibBinary_go, h0, fibst_zero] using
          (⟨fibst_zero_valid, Nat.zero_le _,
            by simpa [fibst_zero] using (Nat.greatestFib_lt).2 (by simpa [ht.1] using h0)⟩ :
            fibst_zero.Valid ∧ fibst_zero.i ≤ Nat.greatestFib n ∧
              Nat.greatestFib n < fibst_zero.i + t.i)

/--
入力/前提: `n : Nat`。
主張: 初期状態 `fibst_one` と燃料 `greatestFibBinaryFuel n` は
     `greatestFibBinary_go_spec` の上界条件を満たす。
内容: まず `2^(log2(n+1)+1) ≤ fib (2*log2(n+1)+3)` を示して
     `greatestFib n < 2*log2(n+1)+3` を得た後、
     `Nat.lt_log2_self` で `2*log2(n+1)+3 < 2^fuel` に持ち上げる。
証明: `two_pow_succ_le_fib_two_mul_add_three`・`Nat.greatestFib_lt`・
     `Nat.lt_log2_self` を組み合わせる。
役割: `greatestFibBinary_spec` の初期呼び出し条件を供給する。
-/
private theorem greatestFibBinaryFuel_bound (n : Nat) :
    Nat.greatestFib n < fibst_one.i * 2 ^ greatestFibBinaryFuel n := by
  calc
    Nat.greatestFib n < 2 * Nat.log2 (n + 1) + 3 := by
      exact (Nat.greatestFib_lt).2 <|
        lt_of_lt_of_le
          (lt_trans (Nat.lt_succ_self n) Nat.lt_log2_self)
          (by simpa using two_pow_succ_le_fib_two_mul_add_three (Nat.log2 (n + 1)))
    _ < 2 ^ ((2 * Nat.log2 (n + 1) + 3).log2 + 1) := Nat.lt_log2_self
    _ = fibst_one.i * 2 ^ greatestFibBinaryFuel n := by
        simp [fibst_one, greatestFibBinaryFuel]

end Internal

/--
入力/前提: `n : Nat`。
主張: `greatestFibBinary n = Nat.greatestFib n`。
内容: 二分探索実装 `greatestFibBinary` が、標準実装 `Nat.greatestFib` と
     同じ最大添字を返すことを示す。
証明: `greatestFibBinary_go_spec` を初期状態 `fibst_one` と
     燃料上界 `greatestFibBinaryFuel_bound` に適用して
     `greatestFibBinary n ≤ Nat.greatestFib n < greatestFibBinary n + 1` を得る。
     後者を `Nat.lt_succ_iff` で `Nat.greatestFib n ≤ greatestFibBinary n`
     に直し、両側の大小関係から等式を結論する。
役割: `greatestFibBinary` を `Nat.greatestFib` の正当な計算実装として公開する最終仕様定理。
-/
theorem greatestFibBinary_spec (n : Nat) :
    greatestFibBinary n = Nat.greatestFib n := by
  have hs :=
    Internal.greatestFibBinary_go_spec n (greatestFibBinaryFuel n) (t := Internal.fibst_one)
      Internal.fibst_one_valid (Internal.greatestFibBinaryFuel_bound n)
  apply Nat.le_antisymm
  · simpa [greatestFibBinary] using hs.2.1
  · exact Nat.lt_succ_iff.mp (by simpa [greatestFibBinary, Internal.fibst_one] using hs.2.2)

end Core

end Fib

lake-manifest.json

{"version": "1.1.0",
 "packagesDir": ".lake/packages",
 "packages":
 [{"url": "https://github.com/leanprover-community/mathlib4",
   "type": "git",
   "subDir": null,
   "scope": "leanprover-community",
   "rev": "4644b1dc054244e47557c6a68f1816b9c99c7cea",
   "name": "mathlib",
   "manifestFile": "lake-manifest.json",
   "inputRev": "master",
   "inherited": false,
   "configFile": "lakefile.lean"},
  {"url": "https://github.com/leanprover-community/plausible",
   "type": "git",
   "subDir": null,
   "scope": "leanprover-community",
   "rev": "e84e3e16aea6b72cc5d311ca1bb25caad417e162",
   "name": "plausible",
   "manifestFile": "lake-manifest.json",
   "inputRev": "main",
   "inherited": true,
   "configFile": "lakefile.toml"},
  {"url": "https://github.com/leanprover-community/LeanSearchClient",
   "type": "git",
   "subDir": null,
   "scope": "leanprover-community",
   "rev": "c5d5b8fe6e5158def25cd28eb94e4141ad97c843",
   "name": "LeanSearchClient",
   "manifestFile": "lake-manifest.json",
   "inputRev": "main",
   "inherited": true,
   "configFile": "lakefile.toml"},
  {"url": "https://github.com/leanprover-community/import-graph",
   "type": "git",
   "subDir": null,
   "scope": "leanprover-community",
   "rev": "f207d9fcf0cef00ba79962a33ef156061914d9c7",
   "name": "importGraph",
   "manifestFile": "lake-manifest.json",
   "inputRev": "main",
   "inherited": true,
   "configFile": "lakefile.toml"},
  {"url": "https://github.com/leanprover-community/ProofWidgets4",
   "type": "git",
   "subDir": null,
   "scope": "leanprover-community",
   "rev": "2e58165a9dcdca9837b666528f974299ee1a51cc",
   "name": "proofwidgets",
   "manifestFile": "lake-manifest.json",
   "inputRev": "v0.0.92",
   "inherited": true,
   "configFile": "lakefile.lean"},
  {"url": "https://github.com/leanprover-community/aesop",
   "type": "git",
   "subDir": null,
   "scope": "leanprover-community",
   "rev": "c3361708f266893de5d1769192b60d4b1831f2bb",
   "name": "aesop",
   "manifestFile": "lake-manifest.json",
   "inputRev": "master",
   "inherited": true,
   "configFile": "lakefile.toml"},
  {"url": "https://github.com/leanprover-community/quote4",
   "type": "git",
   "subDir": null,
   "scope": "leanprover-community",
   "rev": "221e8088e3a066b8676dc471ff10638cf1c10835",
   "name": "Qq",
   "manifestFile": "lake-manifest.json",
   "inputRev": "master",
   "inherited": true,
   "configFile": "lakefile.toml"},
  {"url": "https://github.com/leanprover-community/batteries",
   "type": "git",
   "subDir": null,
   "scope": "leanprover-community",
   "rev": "bd58e3506632241b59e406902d5e42b73cdeccce",
   "name": "batteries",
   "manifestFile": "lake-manifest.json",
   "inputRev": "main",
   "inherited": true,
   "configFile": "lakefile.toml"},
  {"url": "https://github.com/leanprover/lean4-cli",
   "type": "git",
   "subDir": null,
   "scope": "leanprover",
   "rev": "3de531c1135f5e3a01f3ac04830996fda476b28e",
   "name": "Cli",
   "manifestFile": "lake-manifest.json",
   "inputRev": "v4.29.0-rc6",
   "inherited": true,
   "configFile": "lakefile.toml"}],
 "name": "divapprox2",
 "lakeDir": ".lake"}

lakefile.toml

name = "divapprox2"
version = "0.1.0"
keywords = ["math"]
defaultTargets = ["Fib", "Mwf", "Divapprox2"]

[leanOptions]
pp.unicode.fun = true # pretty-prints `fun a ↦ b`
autoImplicit = false
relaxedAutoImplicit = false
weak.linter.mathlibStandardSet = true
maxSynthPendingDepth = 3

[[require]]
name = "mathlib"
scope = "leanprover-community"

[[lean_lib]]
name = "Fib"

[[lean_lib]]
name = "Mwf"

[[lean_lib]]
name = "Divapprox2"

lean-toolchain

leanprover/lean4:v4.29.0-rc6

Mwf.lean

/-
# Max Weighted Floor (Mwf) コア部証明

## 証明の内容

### 共通の前提

- `0 < N`, `0 < M` を満たす整数 `N, M` （自然数ではなく整数として定義）
- 整数 `A, B, C, D, R, S`
- `mwf(N, M, A, B, C, D) = max { A*x + B*⌊(C*x + D)/M⌋ | 0 ≤ x < N }`

---

### 初期化

```
mwf(N, M, A, B, C, D)
= max( B*⌊D/M⌋, 0 + mwf(N, M, A, B, C, D) )
```

* 以下は、 `max(R, S + mwf(N, M, A, B, C, D))` の形で議論を進める。
* 正規化と場合分けの両方で `R, S` は任意の整数として扱える。
* 正規化と場合分けを通じて `mwf` の引数が書き換わる際に `R, S` も同様に書き換えることで、 `max(R, S + mwf(...))` の形を保つ。
* 正規化と場合分けの過程を高々(log2(M)+1)回繰り返すことで、
  `case Y = 0` の場合分けに到達するため、
  任意の `R, S, N, M, A, B, C, D` に対して
  `max(R, S + mwf(N, M, A, B, C, D))` を計算できる。

---

### 正規化

```
max(R, S + mwf(N, M, A, B, C, D))
= max( R, (S + B*⌊D/M⌋) + mwf(N, M, (A + B*⌊C/M⌋), B, (C mod M), (D mod M)) )
```

---

### 場合分け

ここでは上の正規化を済ませた状態 `0 ≤ C, D < M` を仮定し，`Y = ⌊(C*(N-1) + D)/M⌋` とする。

```
max(R, S + mwf(N, M, A, B, C, D))
= {
  case Y = 0 =>
    max(R, S, S + max(0, A*(N-1)))

  case Y > 0, A ≥ 0 =>
    max( max(R, S + A*(N-1) + B*Y),
         S + mwf(Y, C, B, A, M, (M-D-1)) )

  case Y > 0, A < 0 =>
    max( max(R, S, (S+A+B) + mwf(Y, C, B, A, M, (M-D-1)) )
}
```

-/
import Fib
namespace Mwf

namespace Internal

/--
目的: 3 項の最大値を計算する。
定義: `max (max a b) c`。
入力/前提: `a b c : Int`。
出力: 型 `Int` の値を返す。
役割: 場合分け側の補助的な最大値記法。
-/
@[simp]
private def max3 (a b c : Int) : Int := max (max a b) c

/--
目的: 4 項の最大値を計算する。
定義: `max3` を使った 4 項版 `max`。
入力/前提: `a b c d : Int`。
出力: 型 `Int` の値を返す。
役割: 場合分け後の候補値をまとめて比較する。
-/
@[simp]
private def max4 (a b c d : Int) : Int := max (max3 a b c) d

end Internal

namespace Spec

/--
目的: 整数の床除算を `Int.ediv` で表す。
定義: `⌊t/M⌋` を `t / M` と定義。
入力/前提: t M : Int、_hM : 0 < M。
出力: 型 `Int` の値を返す。
役割: 以後の床値計算の基底。
-/
@[simp]
def zfloorDiv (t M : Int) (_hM : 0 < M) : Int :=
  t / M

/--
目的: 整数の剰余を `Int.emod` で表す。
定義: `t % M` を返す薄いラッパ。
入力/前提: t M : Int、_hM : 0 < M。
出力: 型 `Int` の値を返す。
役割: 正規化で `C,D` を `mod M` に落とす基底。
-/
@[simp]
def zfloorMod (t M : Int) (_hM : 0 < M) : Int :=
  t % M

/--
目的: mwf の点評価関数を定義する。
定義: `A*x + B*⌊(C*x + D)/M⌋` を返す。
入力/前提: A B C D M x : Int、hM : 0 < M。
出力: 型 `Int` の値を返す。
役割: 最大化対象そのもの。
-/
@[simp]
def obj (A B C D M x : Int) (hM : 0 < M) : Int :=
  A * x + B * zfloorDiv (C * x + D) M hM

/--
目的: 走査区間 `0 ≤ x < N` を有限集合で表す。
定義: `Icc 0 (N-1)` を採用。
入力/前提: N : Int、_hN : 0 < N、0 : Int。
出力: 型 `Finset Int` の値を返す。
役割: `mwf` を Finset 最大値として扱う土台。
-/
@[simp]
noncomputable def dom (N : Int) (_hN : 0 < N) : Finset Int := Finset.Icc (0 : Int) (N - 1)

/--
目的: 走査区間 `L ≤ x < R` を有限集合で表す。
定義: `Icc L (R-1)` を採用。
入力/前提: L R : Int、_hLR : L < R、L : Int。
出力: 型 `Finset Int` の値を返す。
役割: `mwf` を Finset 最大値として扱う土台。
-/
@[simp]
noncomputable def domLr (L R : Int) (_hLR : L < R) : Finset Int := Finset.Icc (L : Int) (R - 1)

/--
目的: 目的関数の像集合を作る。
定義: `dom` 上で `obj` を `image`。
入力/前提: N M A B C D : Int、hN : 0 < N、hM : 0 < M。
出力: 型 `Finset Int` の値を返す。
役割: `mwf` 定義の直接入力。
-/
@[simp]
noncomputable def img (N M A B C D : Int) (hN : 0 < N) (hM : 0 < M) : Finset Int :=
  (dom N hN).image (fun x => obj A B C D M x hM)

/--
目的: 目的関数の像集合を作る。
定義: `domLr` 上で `obj` を `image`。
入力/前提: L R M A B C D : Int、hLR : L < R、hM : 0 < M。
出力: 型 `Finset Int` の値を返す。
役割: `mwfLr` 定義の直接入力。
-/
@[simp]
noncomputable def imgLr (L R M A B C D : Int) (hLR : L < R) (hM : 0 < M) : Finset Int :=
  (domLr L R hLR).image (fun x => obj A B C D M x hM)

end Spec

namespace Internal

/--
入力/前提: N : Int、hN : 0 < N。
主張: `0<N` なら `dom` は非空。
内容: `0 ∈ Icc 0 (N-1)` を構成。
証明: 既存補題の適用と式変形で示す。
役割: `max'` 利用条件を満たす。
-/
private lemma dom_nonempty {N : Int} (hN : 0 < N) : (Spec.dom N hN).Nonempty := by
  exact ⟨0, Finset.mem_Icc.mpr ⟨le_rfl, sub_nonneg.mpr ((Int.lt_iff_add_one_le).1 hN)⟩⟩

/--
入力/前提: L R : Int、hLR : L < R。
主張: `L<R` なら `domLr` は非空。
内容: `L ∈ Icc L (R-1)` を構成。
証明: 式変形で示す。
役割: `max'` 利用条件を満たす。
-/
private lemma domLr_nonempty {L R : Int} (hLR : L < R) : (Spec.domLr L R hLR).Nonempty := by
  have hL : L ≤ R - 1 := by
    nlinarith [hLR]
  exact ⟨L, Finset.mem_Icc.mpr ⟨le_rfl, hL⟩⟩

/--
入力/前提: `x` が区間 `domLr L R` に属する。
主張: ある Nat 添字 `j < R-L` が存在して `x = L + j` と書ける。
内容: 区間内の整数を左端からのオフセットへ戻す標準変換である。
証明: `j = toNat (x-L)` と置き、`domLr` の上下界から範囲と復元式を示す。
役割: 区間版 `argmax` 証明での `Int` と `Nat` の往復を簡潔にする。
-/
private lemma exists_nat_offset_of_mem_domLr
    {L R x : Int} (hLR : L < R) (hx : x ∈ Spec.domLr L R hLR) :
    ∃ j : Nat, j < Int.toNat (R - L) ∧ L + Int.ofNat j = x := by
  have hNI : 0 < R - L := by
    nlinarith [hLR]
  let j : Nat := Int.toNat (x - L)
  have hxSub0 : 0 ≤ x - L := by
    have hxL : L ≤ x := (Finset.mem_Icc.mp hx).1
    linarith
  have hxSubLt : x - L < R - L := by
    have hxR : x ≤ R - 1 := (Finset.mem_Icc.mp hx).2
    linarith
  have hjlt : j < Int.toNat (R - L) := by
    simp only [j]
    exact (Int.toNat_lt_toNat hNI).2 hxSubLt
  have hxj : L + Int.ofNat j = x := by
    have hxSubEq : Int.ofNat j = x - L := by
      simp only [j]
      exact Int.toNat_of_nonneg hxSub0
    calc
      L + Int.ofNat j = L + (x - L) := by rw [hxSubEq]
      _ = x := by ring
  exact ⟨j, hjlt, hxj⟩

end Internal

namespace Spec

/--
入力/前提: N M A B C D : Int、hN : 0 < N、hM : 0 < M。
主張: `0<N` なら `img` も非空。
内容: `dom_nonempty` を像へ持ち上げる。
証明: 場合分けで示す。
役割: `mwf` の `max'` 定義を正当化。
-/
lemma img_nonempty {N M A B C D : Int} (hN : 0 < N) (hM : 0 < M) :
    (img N M A B C D hN hM).Nonempty := by
  rcases Internal.dom_nonempty hN with ⟨x, hx⟩
  exact ⟨obj A B C D M x hM, Finset.mem_image.mpr ⟨x, hx, rfl⟩⟩

/--
入力/前提: L R M A B C D : Int、hLR : L < R、hM : 0 < M。
主張: `L<R` なら `imgLr` も非空。
内容: `domLr_nonempty` を像へ持ち上げる。
証明: 場合分けで示す。
役割: `mwfLr` の `max'` 定義を正当化。
-/
lemma imgLr_nonempty {L R M A B C D : Int} (hLR : L < R) (hM : 0 < M) :
    (imgLr L R M A B C D hLR hM).Nonempty := by
  rcases Internal.domLr_nonempty hLR with ⟨x, hx⟩
  exact ⟨obj A B C D M x hM, Finset.mem_image.mpr ⟨x, hx, rfl⟩⟩

end Spec

/--
目的: 問題値 `mwf` を定義する。
定義: `img` の最大値 `max'` を返す。
入力/前提: N M A B C D : Int、hN : 0 < N、hM : 0 < M。
出力: 型 `Int` の値を返す。
役割: 全証明で保存・変形する中心量。
-/
@[simp]
noncomputable def mwf (N M A B C D : Int) (hN : 0 < N) (hM : 0 < M) : Int :=
  let s := Spec.img N M A B C D hN hM
  s.max' (Spec.img_nonempty (N := N) (M := M) (A := A) (B := B) (C := C) (D := D) hN hM)

/--
目的: 問題値 `mwfLr` を定義する。
定義: `imgLr` の最大値 `max'` を返す。
入力/前提: L R M A B C D : Int、hLR : L < R、hM : 0 < M。
出力: 型 `Int` の値を返す。
役割: 全証明で保存・変形する中心量。
-/
@[simp]
noncomputable def mwfLr (L R M A B C D : Int) (hLR : L < R) (hM : 0 < M) : Int :=
  let s := Spec.imgLr L R M A B C D hLR hM
  s.max' (Spec.imgLr_nonempty (L := L) (R := R) (M := M) (A := A) (B := B) (C := C) (D := D) hLR hM)

/--
目的: `mwfLr` の最大値を達成する点集合を定義する。
定義: `domLr` を `obj = mwfLr` で `filter` する。
入力/前提: L R M A B C D : Int、hLR : L < R、hM : 0 < M。
出力: 型 `Finset Int` の値を返す。
役割: 最小 `argmax` を `min'` で取り出す基底。
-/
noncomputable def mwfLrArgDom (L R M A B C D : Int) (hLR : L < R) (hM : 0 < M) : Finset Int :=
  (Spec.domLr L R hLR).filter (fun x => Spec.obj A B C D M x hM = mwfLr L R M A B C D hLR hM)

namespace Internal

/--
入力/前提: 有限集合 `s` と写像 `f`、および像 `s.image f` の非空性。
主張: `s.image f` の `max'` は、ある `x ∈ s` の像 `f x` として実現される。
内容: `Finset.max'_mem` と `Finset.mem_image` を組み合わせた汎用 witness 補題。
証明: `max'` の所属を `image` の逆像へ戻す。
役割: `mwf` / `mwfLr` の最大達成点の存在証明を共通化する。
-/
private lemma exists_mem_eq_max'_image
    {α β : Type _} [DecidableEq β] [LinearOrder β]
    (s : Finset α) (f : α → β) (hs : (s.image f).Nonempty) :
    ∃ x ∈ s, f x = (s.image f).max' hs :=
  Finset.mem_image.mp (Finset.max'_mem (s.image f) hs)

/--
入力/前提: `0 < N`, `0 < M`。
主張: `mwf` を達成する `x ∈ dom` が存在する。
内容: `mwf` は `img` の `max'` なので、その値はある元の `obj` として実現される。
証明: `Finset.max'_mem` で `img` への所属を得て、`Finset.mem_image` で逆像を取り出す。
役割: `normalize_mwf_eq` などで最大達成点の witness を毎回展開しないための補助。
-/
private lemma exists_obj_eq_mwf
    (N M A B C D : Int) (hN : 0 < N) (hM : 0 < M) :
    ∃ x ∈ Spec.dom N hN, Spec.obj A B C D M x hM = mwf N M A B C D hN hM := by
  simpa [mwf, Spec.img] using
    exists_mem_eq_max'_image
      (Spec.dom N hN)
      (fun x => Spec.obj A B C D M x hM)
      (Spec.img_nonempty (N := N) (M := M) (A := A) (B := B) (C := C) (D := D) hN hM)

/--
入力/前提: L R M A B C D : Int、hLR : L < R、hM : 0 < M。
主張: `mwfLrArgDom` は非空。
内容: `mwfLr` は像 `imgLr` の `max'` なので、達成点が必ず存在する。
証明: `Finset.max'_mem` と `Finset.mem_image` で達成点を取り出し、`filter` へ戻す。
役割: `mwfLrArgmax` の `min'` 利用条件を満たす。
-/
private lemma mwfLrArgDom_nonempty
    (L R M A B C D : Int) (hLR : L < R) (hM : 0 < M) :
    (mwfLrArgDom L R M A B C D hLR hM).Nonempty := by
  rcases exists_mem_eq_max'_image
      (Spec.domLr L R hLR)
      (fun x => Spec.obj A B C D M x hM)
      (Spec.imgLr_nonempty (L := L) (R := R) (M := M) (A := A) (B := B) (C := C) (D := D)
        hLR hM) with ⟨x, hx⟩
  exact ⟨x, by simpa [mwfLrArgDom, mwfLr, Spec.imgLr, Finset.mem_filter] using hx⟩

/--
入力/前提: `L < R`。
主張: 区間 `[L, R+1)` の定義域は、`[L, R)` に右端 `R` を 1 点追加したものに一致する。
内容: `Icc L R = insert R (Icc L (R-1))` の有限集合版。
証明: 要素所属を `simp` で展開し、境界条件を算術で整理する。
役割: `mwfLr` / `mwfLrFloorProd` の「右端を 1 つ伸ばす」更新則の基礎。
-/
private lemma domLr_right_extend
    (L R : Int) (hLR : L < R) (hLR1 : L < R + 1) :
    Spec.domLr L (R + 1) hLR1 =
      insert R (Spec.domLr L R hLR) := by
  ext x
  simp [Spec.domLr]
  omega

/--
入力/前提: `L < R`, `0 < M`。
主張: 区間像 `imgLr` は、右端 `R` の値を 1 点追加した像に一致する。
内容: `domLr_right_extend` と `Finset.image_insert` を組み合わせたもの。
証明: 定義を書き換えて `simp` する。
役割: `mwfLr` の右端更新を `Finset.max'` の計算へ帰着する。
-/
private lemma imgLr_right_extend
    (L R M A B C D : Int) (hLR : L < R) (hLR1 : L < R + 1) (hM : 0 < M) :
    Spec.imgLr L (R + 1) M A B C D hLR1 hM =
      insert (Spec.obj A B C D M R hM) (Spec.imgLr L R M A B C D hLR hM) := by
  rw [Spec.imgLr, domLr_right_extend L R hLR hLR1, Finset.image_insert, Spec.imgLr]

private lemma max'_congr_local {α : Type _} [LinearOrder α]
    {s t : Finset α} (hs : s.Nonempty) (ht : t.Nonempty) (h : s = t) :
    s.max' hs = t.max' ht := by
  subst h
  cases Subsingleton.elim hs ht
  rfl

end Internal

/--
目的: `mwfLr` の最小 `argmax` を定義する。
定義: `mwfLrArgDom` の `min'` を返す。
入力/前提: L R M A B C D : Int、hLR : L < R、hM : 0 < M。
出力: 型 `Int` の値を返す。
役割: `max` と同時に `argmax`（同値時は最小）を得るための本体。
-/
noncomputable def mwfLrArgmax (L R M A B C D : Int) (hLR : L < R) (hM : 0 < M) : Int :=
  (mwfLrArgDom L R M A B C D hLR hM).min' (Internal.mwfLrArgDom_nonempty L R M A B C D hLR hM)

/--
目的: 区間版 mwf の最大値と `argmax` を同時に返す型を定義する。
フィールド: `max`, `argmax`。
不変条件: `argmax` は `[L, R)` 内で `max` を達成する最小添字。
役割: `mwfLrWithArgmax` の返り値型。
-/
@[ext]
structure mwfWithArgResult where
  max : Int
  argmax : Int
deriving Repr, DecidableEq

/--
目的: `max_{L≤x<R}(A*x + B*⌊(C*x + D)/M⌋)` と最小 `argmax` を同時に返す。
定義: `mwfLr` と `mwfLrArgmax` を束ねる。
入力/前提: L R M A B C D : Int、hLR : L < R、hM : 0 < M。
出力: 型 `mwfWithArgResult` の値を返す。
役割: 区間最大値と最小達成点の同時計算インターフェース。
-/
noncomputable def mwfLrWithArgmax
    (L R M A B C D : Int) (hLR : L < R) (hM : 0 < M) : mwfWithArgResult :=
  { max := mwfLr L R M A B C D hLR hM
    argmax := mwfLrArgmax L R M A B C D hLR hM }

namespace Impl

/--
目的: 正規化後の `A'` を与える。
定義: `A + B*⌊C/M⌋`。
入力/前提: A B C M : Int、hM : 0 < M。
出力: 型 `Int` の値を返す。
役割: `C` の商成分を線形項へ吸収。
-/
@[simp]
def normA (A B C M : Int) (hM : 0 < M) : Int := A + B * Spec.zfloorDiv C M hM

/--
目的: 正規化後の `S'` を与える。
定義: `S + B*⌊D/M⌋`。
入力/前提: S B D M : Int、hM : 0 < M。
出力: 型 `Int` の値を返す。
役割: 定数項のずれを外側に移す。
-/
@[simp]
def normS (S B D M : Int) (hM : 0 < M) : Int := S + B * Spec.zfloorDiv D M hM

/--
目的: 正規化後の `C'` を与える。
定義: `C % M`。
入力/前提: C M : Int、hM : 0 < M。
出力: 型 `Int` の値を返す。
役割: `0 ≤ C' < M` の世界へ遷移。
-/
@[simp]
def normC (C M : Int) (hM : 0 < M) : Int := Spec.zfloorMod C M hM

/--
目的: 正規化後の `D'` を与える。
定義: `D % M`。
入力/前提: D M : Int、hM : 0 < M。
出力: 型 `Int` の値を返す。
役割: `0 ≤ D' < M` の世界へ遷移。
-/
@[simp]
def normD (D M : Int) (hM : 0 < M) : Int := Spec.zfloorMod D M hM

/--
目的: 各 `x` に対応する商 `y` を定義する。
定義: `⌊(C*x + D)/M⌋`。
入力/前提: M C D : Int、hM : 0 < M、x : Int。
出力: 型 `Int` の値を返す。
役割: `x` 側と再帰 `y` 側の橋渡し。
-/
@[simp]
def yOf (M C D : Int) (hM : 0 < M) (x : Int) : Int :=
  Spec.zfloorDiv (C * x + D) M hM

/--
目的: 右端 `x=N-1` での商 `Y` を定義する。
定義: `yOf` を `N-1` で評価。
入力/前提: N M C D : Int、hN : 0 < N、hM : 0 < M。
出力: 型 `Int` の値を返す。
役割: 分岐 (`Y=0` / `Y>0`) の判定量。
-/
@[simp]
def Yn1 (N M C D : Int) (hN : 0 < N) (hM : 0 < M) : Int :=
  let hx0 : 0 ≤ N - 1 := by
    have h1 : (1 : Int) ≤ N := (Int.lt_iff_add_one_le).1 hN
    exact sub_nonneg.mpr h1
  let hxn : N - 1 < N := by
    simp only [sub_eq_add_neg, Int.reduceNeg, add_lt_iff_neg_left, Int.neg_neg_iff_pos, zero_lt_one]
  yOf (M := M) (C := C) (D := D) (x := N - 1) hM

namespace Internal

/--
入力/前提: N M C D : Int、hN : 0 < N、hM : 0 < M。
主張: 正規化仮定下で `Yn1 ≥ 0`。
内容: 分子非負と `M>0` から `ediv_nonneg`。
証明: 式変形で示す。
役割: `step_reduce` の分岐前提を供給。
-/
private lemma Y_nonneg
    (N M C D : Int)
    (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) :
    0 ≤ Yn1 N M C D hN hM := by
  unfold Yn1 yOf Spec.zfloorDiv
  have hNm1 : 0 ≤ N - 1 := sub_nonneg.mpr ((Int.lt_iff_add_one_le).1 hN)
  have hNum : 0 ≤ C * (N - 1) + D := by
    nlinarith
  exact Int.ediv_nonneg hNum (le_of_lt hM)
/--
入力/前提: N M C D : Int、hN : 0 < N、hM : 0 < M。
主張: `Yn1>0` なら `C>0`。
内容: `C=0` とすると `Yn1=0` になる矛盾。
証明: 反証法・式変形・既存補題の書き換えで示す。
-/
private lemma hCpos_of_Y_ge_one (N M C D : Int)
    (hN : 0 < N) (hM : 0 < M) (hC0 : 0 ≤ C) (hD0 : 0 ≤ D)
    (hDM : D < M) (hYp : 0 < Impl.Yn1 N M C D hN hM) : 0 < C := by
  by_contra hCnot
  have hCeq : C = 0 := le_antisymm (le_of_not_gt hCnot) hC0
  have hdiv0 : D / M = 0 := Int.ediv_eq_zero_of_lt_abs hD0 (by simpa only [abs_of_pos hM] using hDM)
  have hY0 : Impl.Yn1 N M C D hN hM = 0 := by
    simp only [Impl.Yn1, Impl.yOf, Spec.zfloorDiv, hCeq, zero_mul, zero_add, hdiv0]
  rw [hY0] at hYp
  exact (lt_irrefl (0 : Int)) hYp

end Internal

end Impl

namespace Fuel

/--
目的: `m` から得られる反復回数上界（`greatestFibBinary m - 1`）。
定義: `greatestFibBinary` から 1 引いた上界として停止到達回数に適用する
     （`m>0` では `Nat.greatestFib m - 1` と同値）。
入力/前提: m : Nat。
出力: 型 `Nat` の値を返す。
役割: tex 側の「高々 `g(m)-1` 回で停止」と整合する上界を与える。
-/
def stepBoundOfM (m : Nat) : Nat :=
  Fib.Core.greatestFibBinary m - 1

end Fuel

namespace Impl

/--
目的: 商 `y` を与える左端代表 `x` を定義する。
定義: `y=0` は `0`、それ以外は明示式。
入力/前提: N M C D y : Int、hN : 0 < N、hM : 0 < M。
出力: 型 `Int` の値を返す。
役割: `A<0` 側再帰の下界構成。
-/
@[simp]
def iy_left
    (N M C D y : Int) (hN : 0 < N) (hM : 0 < M)
    (_hC0 : 0 ≤ C) (_hD0 : 0 ≤ D) (_hCM : C < M) (_hDM : D < M)
    (_hy0 : 0 ≤ y) (_hyN : y ≤ Yn1 N M C D hN hM) :
    Int :=
    if hY0 : y = 0 then 0
    else
      -- editorial.md「記法補助（区間端点）」の議論より，`y ≠ 0` なら区間は少なくとも 1 段上がるので `Yn1 ≥ 1` を得る方針。
      let hY1 : 1 ≤ Yn1 N M C D hN hM := by
        have hypos0 : 0 < y := lt_of_le_of_ne _hy0 (fun hyzero => hY0 hyzero.symm)
        have hypos1 : (1 : Int) ≤ y := (Int.lt_iff_add_one_le).1 hypos0
        exact le_trans hypos1 _hyN
      let hCpos : 0 < C := Internal.hCpos_of_Y_ge_one N M C D hN hM _hC0 _hD0 _hDM hY1
      Spec.zfloorDiv (M * y + C - D - 1) C hCpos

/--
目的: 商 `y` を与える右端代表 `x` を定義する。
定義: `y=Yn1` は `N-1`、それ以外は明示式。
入力/前提: N M C D y : Int、hN : 0 < N、hM : 0 < M。
出力: 型 `Int` の値を返す。
役割: `A≥0` 側再帰の上界構成。
-/
@[simp]
def iy_right
    (N M C D y : Int) (hN : 0 < N) (hM : 0 < M)
    (_hC0 : 0 ≤ C) (_hD0 : 0 ≤ D) (_hCM : C < M) (_hDM : D < M)
    (_hy0 : 0 ≤ y) (_hyN : y ≤ Yn1 N M C D hN hM) :
    Int :=
    if hYn1 : y = Yn1 N M C D hN hM then N - 1
    else
      -- editorial.md「記法補助（区間端点）」に従い，`y ≠ Yn1` の場合も商が 1 以上になることを示して `Yn1 ≥ 1` を得る。
      let hY1 : 1 ≤ Yn1 N M C D hN hM := by
        have hy_lt : y < Yn1 N M C D hN hM := lt_of_le_of_ne _hyN (fun hy => hYn1 hy)
        have hpos : 0 < Yn1 N M C D hN hM := lt_of_le_of_lt _hy0 hy_lt
        exact (Int.lt_iff_add_one_le).1 hpos
      let hCpos : 0 < C := Internal.hCpos_of_Y_ge_one N M C D hN hM _hC0 _hD0 _hDM hY1
      Spec.zfloorDiv (M * y + M - D - 1) C hCpos

/--
目的: 非正規化状態を表す構造体。
フィールド: `max(r, s+mwf(...))` の係数一式を保持。
不変条件: 必要な制約はフィールドの仮定として保持する。
役割: 1ステップ同値の対象。
-/
structure St where
  (r s n m a b c d : Int) (hn : 0 < n) (hm : 0 < m)

/--
目的: 正規化済み状態を表す構造体。
フィールド: `0 ≤ c,d < m` の証明付き状態。
不変条件: 必要な制約はフィールドの仮定として保持する。
役割: 場合分け定理の前提を型で保持。
-/
structure StNorm where
  (r s n m a b c d : Int) (hn : 0 < n) (hm : 0 < m)
  (hC0 : 0 ≤ c) (hD0 : 0 ≤ d) (hCM : c < m) (hDM : d < m)

namespace Internal

/--
目的: 2状態の評価式同値を定義する。
定義: `max(r, s+mwf)` の等式。
入力/前提: S T : St。
出力: 型 `Prop` の値を返す。
役割: 遷移の正しさ記述に使う述語。
-/
@[simp]
private def StEq (S T : St) : Prop :=
  max S.r (S.s + mwf S.n S.m S.a S.b S.c S.d S.hn S.hm) =
  max T.r (T.s + mwf T.n T.m T.a T.b T.c T.d T.hn T.hm)

/--
目的: 状態正規化ステップを定義する。
定義: `normA/normS/normC/normD` で更新。
入力/前提: U : St。
出力: 型 `StNorm` の値を返す。
役割: 再帰前の標準形への写像。
-/
@[simp]
private def step_normalize (U : St) : StNorm :=
  let a := normA U.a U.b U.c U.m U.hm
  let b := U.b
  let c := normC U.c U.m U.hm
  let d := normD U.d U.m U.hm
  let s := normS U.s U.b U.d U.m U.hm
  StNorm.mk U.r s U.n U.m a b c d U.hn U.hm
    (Int.emod_nonneg _ (ne_of_gt U.hm))
    (Int.emod_nonneg _ (ne_of_gt U.hm))
    (Int.emod_lt_of_pos _ U.hm)
    (Int.emod_lt_of_pos _ U.hm)

/--
目的: 正規化状態の分岐量 `Y` を読む。
定義: `Yn1 U.n U.m U.c U.d`。
入力/前提: U : StNorm。
出力: 型 `Int` の値を返す。
役割: `step_reduce` 分岐条件の抽象化。
-/
@[simp]
private def stnorm_y (U : StNorm) : Int :=
  Yn1 U.n U.m U.c U.d U.hn U.hm

/--
目的: 状態 `St` の `mwf` 成分を読む。
定義: フィールドを `mwf` に渡す。
入力/前提: U : St。
出力: 型 `Int` の値を返す。
役割: 状態同値式を簡潔化。
-/
@[simp]
private noncomputable def st_mwf (U : St) : Int :=
  mwf U.n U.m U.a U.b U.c U.d U.hn U.hm

/--
目的: 状態 `StNorm` の `mwf` 成分を読む。
定義: フィールドを `mwf` に渡す。
入力/前提: U : StNorm。
出力: 型 `Int` の値を返す。
役割: 正規化後同値式を簡潔化。
-/
@[simp]
private noncomputable def stnorm_mwf (U : StNorm) : Int :=
  mwf U.n U.m U.a U.b U.c U.d U.hn U.hm

/--
目的: `Y=0` 分岐の遷移先を与える。
定義: `r,s` を終端形 `(1,1,0,...)` に集約。
入力/前提: U : StNorm、_hy0 : stnorm_y U = 0。
出力: 型 `St` の値を返す。
役割: 停止ケースの具体状態。
-/
@[simp]
private def step_reduce_y0 (U : StNorm) (_hy0 : stnorm_y U = 0) : St :=
  let r := max U.r U.s
  let r' := max r (U.s + U.a * (U.n - 1))
  St.mk r' r' 1 1 0 0 0 0 (by decide) (by decide)

/--
目的: `Y>0 ∧ A≥0` 分岐の遷移先を与える。
定義: 右端寄り評価で `r` を更新し引数を入替。
入力/前提: U : StNorm、hYp : 0 < stnorm_y U、_hAnonneg : 0 ≤ U.a。
出力: 型 `St` の値を返す。
役割: 正傾き再帰を状態遷移化。
-/
@[simp]
private def step_reduce_ypos_a_nonneg
  (U : StNorm)
  (hYp : 0 < stnorm_y U)
  (_hAnonneg : 0 ≤ U.a) : St :=
  St.mk (max U.r (U.s + (U.a * (U.n - 1) + U.b * stnorm_y U))) U.s
    (stnorm_y U) U.c U.b U.a U.m (U.m - U.d - 1)
    hYp (Internal.hCpos_of_Y_ge_one U.n U.m U.c U.d U.hn U.hm U.hC0 U.hD0 U.hDM hYp)

/--
目的: `Y>0 ∧ A<0` 分岐の遷移先を与える。
定義: `s` に `A+B` を加えて引数を入替。
入力/前提: U : StNorm、hYp : 0 < stnorm_y U、_hAneg : U.a < 0。
出力: 型 `St` の値を返す。
役割: 負傾き再帰を状態遷移化。
-/
@[simp]
private def step_reduce_ypos_a_neg
  (U : StNorm)
  (hYp : 0 < stnorm_y U)
  (_hAneg : U.a < 0) : St :=
  St.mk (max U.r U.s) (U.s + (U.a + U.b))
    (stnorm_y U) U.c U.b U.a U.m (U.m - U.d - 1)
    hYp (Internal.hCpos_of_Y_ge_one U.n U.m U.c U.d U.hn U.hm U.hC0 U.hD0 U.hDM hYp)

/--
目的: 正規化状態の分岐遷移を定義する。
定義: `Y=0` と `A` の符号で3分岐。
入力/前提: U : StNorm。
出力: 型 `St` の値を返す。
役割: 再帰本体の単一関数化。
-/
@[simp]
private def step_reduce (U : StNorm) : St :=
  let y := stnorm_y U
  if hy0 : y = 0 then
    step_reduce_y0 U hy0
  else
    have hY0 : 0 ≤ y := Y_nonneg U.n U.m U.c U.d U.hn U.hm U.hC0 U.hD0
    have hYp : 0 < y := lt_of_le_of_ne hY0 (fun hyzero => hy0 hyzero.symm)
    if hAnonneg : 0 ≤ U.a then
      step_reduce_ypos_a_nonneg U hYp hAnonneg
    else
      step_reduce_ypos_a_neg U hYp (lt_of_not_ge hAnonneg)

/--
目的: 1ステップ遷移を定義する。
定義: `step_normalize` の後に `step_reduce`。
入力/前提: S : St。
出力: 型 `St` の値を返す。
役割: 反復する基本演算。
-/
@[simp]
private def step (S : St) : St :=
  step_reduce (step_normalize S)

/--
目的: `mwf_iter_aux` は `mwf` 計算の反復補助関数を定義する。
定義: `step` を高々 `fuel` 回だけ回し、`c=0` に到達した時点の `r` を返す。
入力/前提: `fuel : Nat`、`U : St`。
出力: 型 `Int` の値を返す。
役割: `mwf_iter` の反復本体。
-/
@[simp]
private def mwf_iter_aux : Nat → St → Int
  | 0, U => U.r
  | k + 1, U =>
      let V := step U
      if _ : U.c = 0 then V.r else mwf_iter_aux k V

end Internal

/--
目的: `mwf_iter` は `mwf` を反復で計算する実装を定義する。
定義: 初期状態を作り、`stepBoundOfM (Int.toNat M)` 回 `mwf_iter_aux` を適用する。
入力/前提: N M A B C D : Int、hN : 0 < N、hM : 0 < M。
出力: 型 `Int` の値を返す。
役割: 反復実装の入口（`mwf_iter_correct` の対象）。
-/
def mwf_iter (N M A B C D : Int) (hN : 0 < N) (hM : 0 < M) : Int :=
  let U : St := St.mk (B * Spec.zfloorDiv D M hM) 0 N M A B C D hN hM
  Internal.mwf_iter_aux (Fuel.stepBoundOfM (Int.toNat M)) U

/--
目的: 区間版 `mwfLr_iter` を反復計算として定義する。
定義: 置換 `x = l + t` と商・剰余分解で `mwf_iter` に還元し定数項を加える。
入力/前提: l r m a b c d : Int、hLR : l < r、hM : 0 < m。
出力: 型 `Int` の値を返す。
役割: 区間版実装の計算定義。
-/
def mwfLr_iter (l r m a b c d : Int) (hLR : l < r) (hM : 0 < m) : Int := by
  have hN : 0 < r - l := by nlinarith [hLR]
  let n : Int := r - l
  let q : Int := Spec.zfloorDiv (c * l + d) m hM
  let d' : Int := Spec.zfloorMod (c * l + d) m hM
  exact a * l + b * q + mwf_iter n m a b c d' hN hM

end Impl

namespace Examples

namespace Internal

/--
入力/前提: なし。
主張: `Nat.fib 40 = 102334155`。
内容: Fibonacci 実装の既知値テスト。
証明: `decide` で計算する。
役割: `Fuel.stepBoundOfM` 周辺の回帰確認に使う。
-/
private lemma test_nat_fib_40 :
  Nat.fib 40 = 102334155 := by decide

/--
入力/前提: なし。
主張: `stepBoundOfM 102334154 = 38`。
内容: Fibonacci 境界の直前値に対する燃料上界の回帰テスト。
証明: `decide` で計算する。
役割: `stepBoundOfM` の閾値挙動を固定する。
-/
private lemma test_stepBoundOfM_lt :
  Fuel.stepBoundOfM 102334154 = 38 := by decide

/--
入力/前提: なし。
主張: `stepBoundOfM 102334155 = 39`。
内容: Fibonacci 境界値そのものに対する燃料上界の回帰テスト。
証明: `decide` で計算する。
役割: `stepBoundOfM` の境界一致を固定する。
-/
private lemma test_stepBoundOfM_eq :
  Fuel.stepBoundOfM 102334155 = 39 := by decide

/--
入力/前提: なし。
主張: `stepBoundOfM 102334156 = 39`。
内容: Fibonacci 境界を越えた直後の燃料上界の回帰テスト。
証明: `decide` で計算する。
役割: `stepBoundOfM` の単調性確認に使う。
-/
private lemma test_stepBoundOfM_gt :
  Fuel.stepBoundOfM 102334156 = 39 := by decide

/--
入力/前提: 具体的な小さい入力。
主張: `Impl.mwfLr_iter` の結果が既知値 `41` に一致する。
内容: 区間版反復実装の回帰テスト。
証明: `decide` で計算する。
役割: `mwfLr_iter_correct` の実装側を壊していないか確認する。
-/
private lemma test_mwfLr_iter :
  Impl.mwfLr_iter 0 10 7 3 2 5 4 (by decide) (by decide) = 41 := by
    set_option maxRecDepth 160 in decide

/--
入力/前提: 具体的な大きめ入力。
主張: `Impl.mwf_iter` の結果が既知値 `215327987` に一致する。
内容: 単区間版反復実装の回帰テスト。
証明: `decide` で計算する。
役割: `mwf_iter_correct` の実装側を壊していないか確認する。
-/
private lemma test_mwf_iter :
  Impl.mwf_iter (10^9) 102334155 (-433494437) 701408733 63245986 31415926
    (by decide) (by decide) = 215327987 := by
      set_option maxRecDepth 950 in decide

end Internal
end Examples

noncomputable section

namespace Spec

/--
入力/前提: N M A B C D x : Int、hN : 0 < N、hM : 0 < M。
主張: 各点の目的値は `mwf` 以下。
内容: `obj x` が `img` の元であることを使う。
証明: 既存補題の適用と式変形で示す。
役割: 上界評価の基本補題。
-/
lemma obj_le_mwf (N M A B C D x : Int) (hN : 0 < N) (hM : 0 < M)
    (hx : x ∈ dom N hN) :
    obj A B C D M x hM ≤ mwf N M A B C D hN hM := by
  unfold mwf
  simp only [obj, zfloorDiv, img, dom]
  exact Finset.le_max' (s := img N M A B C D hN hM) (x := obj A B C D M x hM)
    (Finset.mem_image.mpr ⟨x, hx, rfl⟩)

end Spec

namespace Internal

/--
入力/前提: N M C D : Int、hN : 0 < N、hM : 0 < M。
主張: `C=0` なら `Yn1=0`。
内容: `0≤D<M` から `D/M=0` を適用。
証明: 既存補題の書き換えで示す。
役割: 退化ケースの停止判定。
-/
private lemma Y_eq_zero_of_C_eq_zero
    (N M C D : Int)
    (hN : 0 < N) (hM : 0 < M)
    (hD0 : 0 ≤ D) (hDM : D < M)
    (hC : C = 0) :
    Impl.Yn1 N M C D hN hM = 0 := by
  have hdiv0 : D / M = 0 := Int.ediv_eq_zero_of_lt_abs hD0 (by simpa only [abs_of_pos hM] using hDM)
  simp [Impl.Yn1, Impl.yOf, Spec.zfloorDiv, hC, hdiv0]

/--
入力/前提: N M C D : Int、hN : 0 < N、hM : 0 < M。
主張: `dom` 上では `yOf ≥ 0`。
内容: 分子非負と `M>0` から示す。
証明: 式変形・既存補題の書き換えで示す。
役割: 商範囲 `0..Y` の下限側。
-/
private lemma yOf_nonneg
    (N M C D : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (_hCM : C < M) (_hDM : D < M) :
    ∀ x : Spec.dom N hN,
      0 ≤ Impl.yOf M C D hM x := by
  intro x
  have hx0 : 0 ≤ (x : Int) := (Finset.mem_Icc.mp x.property).1
  have hNum : 0 ≤ C * (x : Int) + D := by
    nlinarith [mul_nonneg hC0 hx0, hD0]
  simpa only [Impl.yOf, Spec.zfloorDiv, Spec.dom, ge_iff_le]
    using Int.ediv_nonneg hNum (le_of_lt hM)

/--
入力/前提: N M C D : Int、hN : 0 < N、hM : 0 < M。
主張: `dom` 上では `yOf ≤ Yn1`。
内容: `x ≤ N-1` の単調性と除算評価で示す。
証明: 式変形・既存補題の書き換えで示す。
役割: 商範囲 `0..Y` の上限側。
-/
private lemma yOf_le_Yn1
    (N M C D : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (_hD0 : 0 ≤ D) (_hCM : C < M) (_hDM : D < M) :
    ∀ x : Spec.dom N hN,
      Impl.yOf M C D hM x ≤ Impl.Yn1 N M C D hN hM := by
  intro x
  have hxle : (x : Int) ≤ N - 1 := (Finset.mem_Icc.mp x.property).2
  have hMulLe : C * (x : Int) ≤ C * (N - 1) := mul_le_mul_of_nonneg_left hxle hC0
  have hNumLe : C * (x : Int) + D ≤ C * (N - 1) + D := by nlinarith
  have hdivLe : (C * (x : Int) + D) / M ≤ (C * (N - 1) + D) / M := Int.ediv_le_ediv hM hNumLe
  simpa only [Impl.yOf, Spec.zfloorDiv, Spec.dom, Impl.Yn1, ge_iff_le] using hdivLe

/--
入力/前提: `x ∈ dom` かつ `Yn1 = 0`。
主張: その点での `yOf` は 0。
内容: `0 ≤ yOf x ≤ Yn1` を既存の範囲補題から得て、`Yn1 = 0` を代入する。
証明: `yOf_nonneg` と `yOf_le_Yn1` を合わせて `le_antisymm`。
役割: `mwf_yn1_zero` で各点の床除算項が消えることを共通化する。
-/
private lemma yOf_eq_zero_of_Y_eq_zero
    (N M C D x : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M)
    (hxDom : x ∈ Spec.dom N hN) (hY0 : Impl.Yn1 N M C D hN hM = 0) :
    Impl.yOf M C D hM x = 0 := by
  have hnonneg := yOf_nonneg N M C D hN hM hC0 hD0 hCM hDM (Subtype.mk x hxDom)
  have hleY := yOf_le_Yn1 N M C D hN hM hC0 hD0 hCM hDM (Subtype.mk x hxDom)
  rw [hY0] at hleY
  exact le_antisymm hleY hnonneg

/--
入力/前提: `x ∈ dom` かつ `Yn1 = 0`。
主張: その点での `obj` は線形項 `A * x` に一致する。
内容: `yOf_eq_zero_of_Y_eq_zero` により床除算項が消える。
証明: `Spec.obj` を展開し、床除算値 0 を代入して整理する。
役割: `mwf_yn1_zero` の端点評価と一般点上界を短くする。
-/
private lemma obj_eq_Ax_of_Y_eq_zero
    (N M A B C D x : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M)
    (hxDom : x ∈ Spec.dom N hN) (hY0 : Impl.Yn1 N M C D hN hM = 0) :
    Spec.obj A B C D M x hM = A * x := by
  have hy0 :
      Impl.yOf M C D hM x = 0 :=
    yOf_eq_zero_of_Y_eq_zero N M C D x hN hM hC0 hD0 hCM hDM hxDom hY0
  have hdiv0 : Spec.zfloorDiv (C * x + D) M hM = 0 := by
    simpa only [Impl.yOf, Spec.zfloorDiv] using hy0
  calc
    Spec.obj A B C D M x hM = A * x + B * Spec.zfloorDiv (C * x + D) M hM := by
      simp only [Spec.obj, Spec.zfloorDiv]
    _ = A * x := by simp only [hdiv0, mul_zero, add_zero]

/--
入力/前提: N M C D : Int、hN : 0 < N、hM : 0 < M。
主張: `dom` 上の床除算値は `0..Yn1` に入る。
内容: 非負性と右端比較で上下界を同時に構成。
証明: 既存補題の書き換えで示す。
役割: 値域制御の基礎。
-/
private lemma floorDiv_range_bounds (N M C D : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (_hCM : C < M) (_hDM : D < M) :
    ∀ x ∈ Spec.dom N hN,
      0 ≤ Spec.zfloorDiv (C * x + D) M hM ∧
      Spec.zfloorDiv (C * x + D) M hM ≤ Impl.Yn1 N M C D hN hM := by
  intro x hx
  constructor
  · have h1 := yOf_nonneg N M C D hN hM hC0 hD0 _hCM _hDM (Subtype.mk x hx)
    simpa only [Spec.zfloorDiv, ge_iff_le, Impl.yOf] using h1
  · have h2 := yOf_le_Yn1 N M C D hN hM hC0 hD0 _hCM _hDM (Subtype.mk x hx)
    simpa only [Spec.zfloorDiv, Impl.Yn1, Impl.yOf, ge_iff_le] using h2

/--
入力/前提: `0 < M`、`y*M ≤ t ≤ y*M + M - 1`。
主張: `⌊t/M⌋ = y`。
内容: 床除算がちょうど `y` になるための標準的な上下界判定。
証明: 上側は `t/M ≤ (y*M + M - 1)/M = y`、下側は `y ≤ t/M` を示して `le_antisymm` を適用する。
役割: `iy_left` / `iy_right` で構成した点の `yOf` 計算を共通化する。
-/
private lemma zfloorDiv_eq_of_mul_bounds (M t y : Int) (hM : 0 < M)
    (hlow : y * M ≤ t) (hhigh : t ≤ y * M + M - 1) :
    Spec.zfloorDiv t M hM = y := by
  unfold Spec.zfloorDiv
  apply le_antisymm
  · have hdiv_le : t / M ≤ (y * M + M - 1) / M :=
      Int.ediv_le_ediv hM hhigh
    have hM1_nonneg : 0 ≤ M - 1 := by nlinarith [hM]
    have hM1_lt : M - 1 < M := by nlinarith [hM]
    have hM1_div : (M - 1) / M = 0 :=
      Int.ediv_eq_zero_of_lt_abs hM1_nonneg (by
        rw [abs_of_pos hM]
        exact hM1_lt)
    have hrhs : (y * M + M - 1) / M = y := by
      calc
        (y * M + M - 1) / M = ((M - 1) + y * M) / M := by ring_nf
        _ = (M - 1) / M + y := by
              simpa only [mul_comm, add_comm] using
                (Int.add_mul_ediv_right (M - 1) y (ne_of_gt hM))
        _ = y := by simp only [hM1_div, zero_add]
    exact le_trans hdiv_le (by simp only [hrhs, le_refl])
  · exact (Int.le_ediv_iff_mul_le hM).2 (by simpa only [mul_comm] using hlow)

/--
入力/前提: `0 < N`, `0 < C`, `0 ≤ a`, `a < C * N`。
主張: `⌊a/C⌋` は `dom N` に入る。
内容: 非負な被除数を正の除数で割った商は、上界 `a < C*N` から `N-1` 以下に抑えられる。
証明: `Int.ediv_nonneg` で下界を、`Int.ediv_le_iff_le_mul` で上界を示して `Finset.mem_Icc` に入れる。
役割: `iy_right_mem_dom` と `iy_left_mem_dom` の共通末尾を吸収する。
-/
private lemma zfloorDiv_mem_dom_of_nonneg_lt_mul (N C a : Int)
    (hN : 0 < N) (hCpos : 0 < C) (ha_nonneg : 0 ≤ a) (ha_lt : a < C * N) :
    Spec.zfloorDiv a C hCpos ∈ Spec.dom N hN := by
  have hx0 : 0 ≤ Spec.zfloorDiv a C hCpos := by
    simpa only [Spec.zfloorDiv] using Int.ediv_nonneg ha_nonneg (le_of_lt hCpos)
  have hxN : Spec.zfloorDiv a C hCpos ≤ N - 1 := by
    have hlt : a < (N - 1) * C + C := by
      calc
        a < C * N := ha_lt
        _ = (N - 1) * C + C := by ring
    exact (Int.ediv_le_iff_le_mul hCpos).2 hlt
  exact Finset.mem_Icc.mpr ⟨hx0, hxN⟩

/-!
## 初期化

`x=0` は常に許されるため、`mwf` は `obj ... 0 = B*⌊D/M⌋` 以上。
よって
  `mwf = max(B*⌊D/M⌋, 0 + mwf)`
が成立。
-/

/--
入力/前提: N M A B C D : Int、hN : 0 < N、hM : 0 < M。
主張: 初期化等式 `mwf = max(B⌊D/M⌋, 0+mwf)`。
内容: `x=0` が常に候補である事実を使う。
証明: 式変形・既存補題の書き換えで示す。
役割: 状態法の開始点。
-/
private theorem step_init_equiv
    (N M A B C D : Int)
    (hN : 0 < N) (hM : 0 < M) :
    mwf N M A B C D hN hM
      = max (B * Spec.zfloorDiv D M hM) (0 + mwf N M A B C D hN hM) := by
  have hx0 : (0 : Int) ∈ Spec.dom N hN := by
    exact Finset.mem_Icc.mpr (And.intro le_rfl (sub_nonneg.mpr ((Int.lt_iff_add_one_le).1 hN)))
  have hbase_obj : Spec.obj A B C D M 0 hM ≤ mwf N M A B C D hN hM :=
    Spec.obj_le_mwf N M A B C D 0 hN hM hx0
  have hbase : B * Spec.zfloorDiv D M hM ≤ mwf N M A B C D hN hM := by
    simpa only [Spec.zfloorDiv, mwf, Spec.img, Spec.obj, Spec.dom, mul_zero, zero_add]
      using hbase_obj
  simpa only [zero_add] using (max_eq_right hbase).symm

/-!
## 正規化

`C = M*⌊C/M⌋ + (C % M)`, `D = M*⌊D/M⌋ + (D % M)` と
`M>0` の下での
  `⌊(t + k*M)/M⌋ = ⌊t/M⌋ + k`
を用いると、各 `x` で
⌊(C*x + D)/M⌋
= ⌊C/M⌋*x + ⌊((C%M)*x + (D%M))/M⌋ + ⌊D/M⌋
よって
Ax + B⌊(Cx+D)/M⌋
= (A + B⌊C/M⌋)x + B⌊((C%M)x + (D%M))/M⌋ + B⌊D/M⌋
最大を取って外側の `max R` を付ければ主張。
-/


/--
入力/前提: A B C D M S x : Int、hM : 0 < M。
主張: `S+obj` は正規化後の `S'+obj'` と一致。
内容: `C,D` の商剰余分解を式変形。
証明: 式変形・既存補題の書き換えで示す。
役割: 点ごとの正規化同値の核。
-/
private lemma normalize_obj_eq (A B C D M S x : Int) (hM : 0 < M) :
    S + Spec.obj A B C D M x hM =
      (Impl.normS S B D M hM) + Spec.obj (Impl.normA A B C M hM) B
      (Impl.normC C M hM) (Impl.normD D M hM) M x hM := by
  have hM0 : M ≠ 0 := ne_of_gt hM
  have hdecomp : C * x + D = (C % M * x + D % M) + ((C / M) * x + D / M) * M := by
    calc
      C * x + D = (C % M + M * (C / M)) * x + (D % M + M * (D / M)) := by
        rw [Int.emod_add_mul_ediv C M, Int.emod_add_mul_ediv D M]
      _ = (C % M * x + D % M) + ((C / M) * x + D / M) * M := by ring
  have hdiv : (C * x + D) / M = (C % M * x + D % M) / M + ((C / M) * x + D / M) := by
    rw [hdecomp]
    simpa only [mul_comm, add_comm, add_left_comm, add_assoc] using
      (Int.add_mul_ediv_right (C % M * x + D % M) ((C / M) * x + D / M) hM0)
  unfold Spec.obj Impl.normS Impl.normA Impl.normC Impl.normD Spec.zfloorDiv Spec.zfloorMod
  rw [hdiv]
  ring

/--
入力/前提: R S N M A B C D : Int、`0 < N`, `0 < M`。
主張: `S + mwf` は正規化後の `normS + mwf` に一致する。
内容: 正規化前後の最大達成点をそれぞれ 1 つ取り、`normalize_obj_eq` と `obj_le_mwf` を往復させる。
証明: 両方向の不等式を最大達成点の witness で示し、`le_antisymm` で結ぶ。
役割: `mwf_step_equiv` で正規化前後の値を直接つなぐ本体補題。
-/
private lemma normalize_mwf_eq
    (S N M A B C D : Int)
    (hN : 0 < N) (hM : 0 < M) :
    S + mwf N M A B C D hN hM =
      Impl.normS S B D M hM +
        mwf N M (Impl.normA A B C M hM) B (Impl.normC C M hM) (Impl.normD D M hM) hN hM := by
  rcases exists_obj_eq_mwf N M (Impl.normA A B C M hM) B
      (Impl.normC C M hM) (Impl.normD D M hM) hN hM with ⟨x1, hx1, hx1eq⟩
  rcases exists_obj_eq_mwf N M A B C D hN hM with ⟨x0, hx0, hx0eq⟩
  have hobj1_le :
      Spec.obj A B C D M x1 hM ≤ mwf N M A B C D hN hM :=
    Spec.obj_le_mwf N M A B C D x1 hN hM hx1
  have hobj0_le :
      Spec.obj (Impl.normA A B C M hM) B (Impl.normC C M hM) (Impl.normD D M hM) M x0 hM
        ≤ mwf N M (Impl.normA A B C M hM) B (Impl.normC C M hM) (Impl.normD D M hM) hN hM :=
    Spec.obj_le_mwf N M (Impl.normA A B C M hM) B
      (Impl.normC C M hM) (Impl.normD D M hM) x0 hN hM hx0
  have hle1 :
      Impl.normS S B D M hM +
          mwf N M (Impl.normA A B C M hM) B (Impl.normC C M hM) (Impl.normD D M hM) hN hM
        ≤ S + mwf N M A B C D hN hM := by
    calc
      Impl.normS S B D M hM +
          mwf N M (Impl.normA A B C M hM) B (Impl.normC C M hM) (Impl.normD D M hM) hN hM
          =
        Impl.normS S B D M hM +
          Spec.obj (Impl.normA A B C M hM) B (Impl.normC C M hM) (Impl.normD D M hM) M x1 hM := by
            rw [← hx1eq]
      _ = S + Spec.obj A B C D M x1 hM := by
            symm
            simpa only [Spec.obj, Spec.zfloorDiv, Impl.normS, Impl.normA, Spec.zfloorMod,
              Impl.normD] using normalize_obj_eq A B C D M S x1 hM
      _ ≤ S + mwf N M A B C D hN hM := by
            simpa only [add_comm] using add_le_add_left hobj1_le S
  have hle2 :
      S + mwf N M A B C D hN hM
        ≤ Impl.normS S B D M hM +
            mwf N M (Impl.normA A B C M hM) B (Impl.normC C M hM) (Impl.normD D M hM) hN hM := by
    calc
      S + mwf N M A B C D hN hM = S + Spec.obj A B C D M x0 hM := by rw [← hx0eq]
      _ =
        Impl.normS S B D M hM +
          Spec.obj (Impl.normA A B C M hM) B (Impl.normC C M hM) (Impl.normD D M hM) M x0 hM := by
            simpa only [Spec.obj, Spec.zfloorDiv, Impl.normS, Impl.normA, Spec.zfloorMod,
              Impl.normD] using normalize_obj_eq A B C D M S x0 hM
      _ ≤ Impl.normS S B D M hM +
            mwf N M (Impl.normA A B C M hM) B (Impl.normC C M hM) (Impl.normD D M hM) hN hM := by
              simpa only [add_comm] using add_le_add_left hobj0_le (Impl.normS S B D M hM)
  exact le_antisymm hle2 hle1

/--
入力/前提: N M A B C D : Int、hN : 0 < N、hM : 0 < M。
主張: `Yn1=0` なら `mwf = max 0 (A*(N-1))`。
内容: 商項が全点で 0 になることを利用。
証明: 場合分け・式変形・既存補題の書き換えで示す。
役割: 再帰停止時の閉形式。
-/
private theorem mwf_yn1_zero (N M A B C D : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M)
    (hY0 : (Impl.Yn1 N M C D hN hM) = 0) :
    mwf N M A B C D hN hM
      =
    max 0 (A * (N - 1)) := by
  have hx0 : (0 : Int) ∈ Spec.dom N hN := by
    exact Finset.mem_Icc.mpr (And.intro le_rfl (sub_nonneg.mpr ((Int.lt_iff_add_one_le).1 hN)))
  have h0le : 0 ≤ mwf N M A B C D hN hM := by
    have hobj0_le := Spec.obj_le_mwf N M A B C D 0 hN hM hx0
    have hobj0 : Spec.obj A B C D M 0 hM = 0 := by
      simpa only [mul_zero] using
        obj_eq_Ax_of_Y_eq_zero N M A B C D 0 hN hM hC0 hD0 hCM hDM hx0 hY0
    simpa only [hobj0] using hobj0_le
  have hxN1 : (N - 1 : Int) ∈ Spec.dom N hN := by
    refine Finset.mem_Icc.mpr ?_
    constructor
    · exact sub_nonneg.mpr ((Int.lt_iff_add_one_le).1 hN)
    · exact le_rfl
  have hRight : A * (N - 1) ≤ mwf N M A B C D hN hM := by
    have hobjR_le := Spec.obj_le_mwf N M A B C D (N - 1) hN hM hxN1
    have hobjR : Spec.obj A B C D M (N - 1) hM = A * (N - 1) := by
      simpa using
        obj_eq_Ax_of_Y_eq_zero N M A B C D (N - 1) hN hM hC0 hD0 hCM hDM hxN1 hY0
    simpa only [hobjR] using hobjR_le
  have hLower : max 0 (A * (N - 1)) ≤ mwf N M A B C D hN hM :=
    max_le h0le hRight
  have hUpper : mwf N M A B C D hN hM ≤ max 0 (A * (N - 1)) := by
    change
      (Spec.img N M A B C D hN hM).max'
        (Spec.img_nonempty (N := N) (M := M) (A := A) (B := B) (C := C) (D := D) hN hM)
        ≤ max 0 (A * (N - 1))
    refine Finset.max'_le (s := Spec.img N M A B C D hN hM)
      (H := Spec.img_nonempty (N := N) (M := M) (A := A) (B := B) (C := C) (D := D) hN hM)
      (x := max 0 (A * (N - 1))) ?_
    intro z hz
    rcases Finset.mem_image.mp hz with ⟨x, hxdom, rfl⟩
    have hx0' : 0 ≤ x := (Finset.mem_Icc.mp hxdom).1
    have hxN : x ≤ N - 1 := (Finset.mem_Icc.mp hxdom).2
    have hAx :
        A * x ≤ max 0 (A * (N - 1)) := by
      by_cases hAnonneg : 0 ≤ A
      · exact le_trans (mul_le_mul_of_nonneg_left hxN hAnonneg) (le_max_right 0 (A * (N - 1)))
      · have hmul0 : A * x ≤ 0 := mul_nonpos_of_nonpos_of_nonneg (le_of_not_ge hAnonneg) hx0'
        exact le_trans hmul0 (le_max_left 0 (A * (N - 1)))
    simpa only [obj_eq_Ax_of_Y_eq_zero N M A B C D x hN hM hC0 hD0 hCM hDM hxdom hY0] using hAx
  exact le_antisymm hUpper hLower

/--
入力/前提: N M C D y : Int、hN : 0 < N、hM : 0 < M。
主張: `iy_right` は常に `dom` に属する。
内容: 端点分岐と除算不等式で区間内を示す。
証明: 場合分け・式変形・既存補題の書き換えで示す。
役割: `iy_right` を評価点として合法化。
-/
private lemma iy_right_mem_dom
    (N M C D y : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M)
    (hy0 : 0 ≤ y) (hyY : y ≤ Impl.Yn1 N M C D hN hM) :
    Impl.iy_right N M C D y hN hM hC0 hD0 hCM hDM hy0 hyY ∈ Spec.dom N hN := by
  by_cases hYn1 : y = Impl.Yn1 N M C D hN hM
  · have hxN1 : (N - 1 : Int) ∈ Spec.dom N hN := by
      refine Finset.mem_Icc.mpr ?_
      constructor
      · exact sub_nonneg.mpr ((Int.lt_iff_add_one_le).1 hN)
      · exact le_rfl
    simpa only [Spec.dom, Impl.iy_right, hYn1, Impl.Yn1, Impl.yOf, Spec.zfloorDiv, ↓reduceDIte,
      Finset.mem_Icc, Int.sub_nonneg, le_refl, and_true, ge_iff_le] using hxN1
  · have hy_lt : y < Impl.Yn1 N M C D hN hM := lt_of_le_of_ne hyY (fun hy => hYn1 hy)
    have hYpos : 0 < Impl.Yn1 N M C D hN hM := lt_of_le_of_lt hy0 hy_lt
    have hY1 : 1 ≤ Impl.Yn1 N M C D hN hM := (Int.lt_iff_add_one_le).1 hYpos
    have hCpos : 0 < C := Impl.Internal.hCpos_of_Y_ge_one N M C D hN hM hC0 hD0 hDM hY1
    have hy1 : y + 1 ≤ Impl.Yn1 N M C D hN hM := (Int.lt_iff_add_one_le).1 hy_lt
    have hy1' : y + 1 ≤ (C * (N - 1) + D) / M := by
      simpa only [Order.add_one_le_iff, Impl.Yn1, Impl.yOf, Spec.zfloorDiv] using hy1
    have hmul : (y + 1) * M ≤ C * (N - 1) + D :=
      (Int.le_ediv_iff_mul_le hM).1 hy1'
    have hnum_nonneg : 0 ≤ M * y + M - D - 1 := by
      nlinarith [mul_nonneg (le_of_lt hM) hy0, hDM]
    have hnum_lt_CN : M * y + M - D - 1 < C * N := by
      have hnum_le : M * y + M - D - 1 ≤ C * (N - 1) - 1 := by
        nlinarith [hmul]
      have hlt' : C * (N - 1) - 1 < C * (N - 1) + C := by
        nlinarith [hCpos]
      have hlt'' : C * (N - 1) + C = C * N := by ring
      exact lt_of_le_of_lt hnum_le (by simpa only [Order.sub_one_lt_iff, hlt''] using hlt')
    have hmem :
        Spec.zfloorDiv (M * y + M - D - 1) C hCpos ∈ Spec.dom N hN :=
      zfloorDiv_mem_dom_of_nonneg_lt_mul N C (M * y + M - D - 1) hN hCpos hnum_nonneg hnum_lt_CN
    have hYn1' : y ≠ (C * (N - 1) + D) / M := by
      simpa only [ne_eq, Impl.Yn1, Impl.yOf, Spec.zfloorDiv] using hYn1
    simpa only [Spec.dom, Impl.iy_right, Impl.Yn1, Impl.yOf, Spec.zfloorDiv, hYn1', ↓reduceDIte,
      Finset.mem_Icc, Order.le_sub_one_iff] using hmem

/--
入力/前提: N M C D y : Int、hN : 0 < N、hM : 0 < M。
主張: `y≠Yn1` なら `yOf (iy_right y) = y`。
内容: `iy_right` の定義式と床除算境界を照合。
証明: 式変形・既存補題の書き換えで示す。
役割: `A≥0` 再帰の値一致に必須。
-/
private lemma yOf_iy_right
    (N M C D y : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M)
    (hy0 : 0 ≤ y) (hyY : y ≤ Impl.Yn1 N M C D hN hM)
    (hy_ne : y ≠ Impl.Yn1 N M C D hN hM) :
    Impl.yOf M C D hM (Impl.iy_right N M C D y hN hM hC0 hD0 hCM hDM hy0 hyY)
      = y := by
  have hy_lt : y < Impl.Yn1 N M C D hN hM := lt_of_le_of_ne hyY (fun hy => hy_ne hy)
  have hYpos : 0 < Impl.Yn1 N M C D hN hM := lt_of_le_of_lt hy0 hy_lt
  have hY1 : 1 ≤ Impl.Yn1 N M C D hN hM := (Int.lt_iff_add_one_le).1 hYpos
  have hCpos : 0 < C := Impl.Internal.hCpos_of_Y_ge_one N M C D hN hM hC0 hD0 hDM hY1
  have hneq : y ≠ (C * (N - 1) + D) / M := by
    simpa only [ne_eq, Impl.Yn1, Impl.yOf, Spec.zfloorDiv] using hy_ne
  have hiy :
      Impl.iy_right N M C D y hN hM hC0 hD0 hCM hDM hy0 hyY
        = Spec.zfloorDiv (M * y + M - D - 1) C hCpos := by
    simp only [Impl.iy_right, Impl.Yn1, Impl.yOf, Spec.zfloorDiv, hneq, ↓reduceDIte]
  rw [hiy]
  unfold Impl.yOf Spec.zfloorDiv
  let a : Int := M * y + M - D - 1
  have hxle : a / C ≤ a / C := le_rfl
  have hlt_ax : a < (a / C) * C + C := (Int.ediv_le_iff_le_mul hCpos).1 hxle
  have hmul_up : (a / C) * C ≤ a := (Int.le_ediv_iff_mul_le hCpos).1 le_rfl
  have hnum_up : C * (a / C) + D ≤ M * y + M - 1 := by
    nlinarith [hmul_up]
  have hupper :
      (C * (a / C) + D) / M ≤ y := by
    have hdiv_le : (C * (a / C) + D) / M ≤ (M * y + M - 1) / M :=
      Int.ediv_le_ediv hM hnum_up
    have hM1_nonneg : 0 ≤ M - 1 := by nlinarith [hM]
    have hM1_lt : M - 1 < M := by nlinarith [hM]
    have hM1_div : (M - 1) / M = 0 :=
      Int.ediv_eq_zero_of_lt_abs hM1_nonneg (by
        rw [abs_of_pos hM]
        exact hM1_lt)
    have hrhs : (M * y + M - 1) / M = y := by
      calc
        (M * y + M - 1) / M = ((M - 1) + y * M) / M := by ring_nf
        _ = (M - 1) / M + y := by
              simpa only [mul_comm, add_comm] using (Int.add_mul_ediv_right (M - 1) y (ne_of_gt hM))
        _ = y := by simp only [hM1_div, zero_add]
    exact le_trans hdiv_le (by simp only [hrhs, le_refl])
  have hmul_low : y * M ≤ C * (a / C) + D := by
    have hlt1 : M * y + M - D - 1 < C * (a / C) + C := by
      simpa only [a, add_comm, Order.sub_one_lt_iff, tsub_le_iff_right, add_left_comm,
        mul_comm] using hlt_ax
    have hCMle : C ≤ M := le_of_lt hCM
    nlinarith [hlt1, hCMle]
  exact zfloorDiv_eq_of_mul_bounds M (C * (a / C) + D) y hM hmul_low
    (by simpa only [mul_comm] using hnum_up)

/--
入力/前提: N M C D y : Int、hN : 0 < N、hM : 0 < M。
主張: `iy_left` は常に `dom` に属する。
内容: 端点分岐と除算不等式で区間内を示す。
証明: 場合分け・式変形・既存補題の書き換えで示す。
役割: `iy_left` を評価点として合法化。
-/
private lemma iy_left_mem_dom
    (N M C D y : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M)
    (hy0 : 0 ≤ y) (hyY : y ≤ Impl.Yn1 N M C D hN hM) :
    Impl.iy_left N M C D y hN hM hC0 hD0 hCM hDM hy0 hyY ∈ Spec.dom N hN := by
  by_cases hY0 : y = 0
  · have hx0 : (0 : Int) ∈ Spec.dom N hN := by
      exact Finset.mem_Icc.mpr (And.intro le_rfl (sub_nonneg.mpr ((Int.lt_iff_add_one_le).1 hN)))
    simpa only [Spec.dom, Impl.iy_left, hY0, ↓reduceDIte, Finset.mem_Icc, le_refl, Int.sub_nonneg,
      true_and, ge_iff_le] using hx0
  · have hy_pos : 0 < y := lt_of_le_of_ne hy0 (fun hy => hY0 hy.symm)
    have hY1 : 1 ≤ Impl.Yn1 N M C D hN hM := by
      have hy1 : (1 : Int) ≤ y := (Int.lt_iff_add_one_le).1 hy_pos
      exact le_trans hy1 hyY
    have hCpos : 0 < C := Impl.Internal.hCpos_of_Y_ge_one N M C D hN hM hC0 hD0 hDM hY1
    have hy' : y ≤ (C * (N - 1) + D) / M := by
      simpa only [Impl.Yn1, Impl.yOf, Spec.zfloorDiv] using hyY
    have hmul : y * M ≤ C * (N - 1) + D :=
      (Int.le_ediv_iff_mul_le hM).1 hy'
    have hnum_nonneg : 0 ≤ M * y + C - D - 1 := by
      nlinarith [mul_nonneg (le_of_lt hM) (le_of_lt hy_pos), hDM, hC0]
    have hnum_lt_CN : M * y + C - D - 1 < C * N := by
      have hnum_le : M * y + C - D - 1 ≤ C * (N - 1) + C - 1 := by
        nlinarith [hmul]
      have hlt' : C * (N - 1) + C - 1 < C * (N - 1) + C := by nlinarith
      have hCN : C * (N - 1) + C = C * N := by ring
      have hltCN : C * (N - 1) + C - 1 < C * N := by
        calc
          C * (N - 1) + C - 1 < C * (N - 1) + C := hlt'
          _ = C * N := hCN
      exact lt_of_le_of_lt hnum_le hltCN
    have hmem :
        Spec.zfloorDiv (M * y + C - D - 1) C hCpos ∈ Spec.dom N hN :=
      zfloorDiv_mem_dom_of_nonneg_lt_mul N C (M * y + C - D - 1) hN hCpos hnum_nonneg hnum_lt_CN
    simpa only [Spec.dom, Impl.iy_left, hY0, ↓reduceDIte, Spec.zfloorDiv, Finset.mem_Icc,
      Order.le_sub_one_iff] using hmem

/--
入力/前提: N M C D y : Int、hN : 0 < N、hM : 0 < M。
主張: `y≠0` なら `yOf (iy_left y) = y`。
内容: `iy_left` の定義式と床除算境界を照合。
証明: 式変形・既存補題の書き換えで示す。
役割: `A<0` 再帰の値一致に必須。
-/
private lemma yOf_iy_left
    (N M C D y : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M)
    (hy0 : 0 ≤ y) (hyY : y ≤ Impl.Yn1 N M C D hN hM)
    (hy_ne : y ≠ 0) :
    Impl.yOf M C D hM (Impl.iy_left N M C D y hN hM hC0 hD0 hCM hDM hy0 hyY)
      = y := by
  have hy_pos : 0 < y := lt_of_le_of_ne hy0 (fun hy => hy_ne hy.symm)
  have hY1 : 1 ≤ Impl.Yn1 N M C D hN hM := by
    have hy1 : (1 : Int) ≤ y := (Int.lt_iff_add_one_le).1 hy_pos
    exact le_trans hy1 hyY
  have hCpos : 0 < C := Impl.Internal.hCpos_of_Y_ge_one N M C D hN hM hC0 hD0 hDM hY1
  have hiy :
      Impl.iy_left N M C D y hN hM hC0 hD0 hCM hDM hy0 hyY
        = Spec.zfloorDiv (M * y + C - D - 1) C hCpos := by
    simp only [Impl.iy_left, hy_ne, ↓reduceDIte, Spec.zfloorDiv]
  rw [hiy]
  unfold Impl.yOf Spec.zfloorDiv
  let a : Int := M * y + C - D - 1
  have hmul_up : (a / C) * C ≤ a := (Int.le_ediv_iff_mul_le hCpos).1 le_rfl
  have hnum_up : C * (a / C) + D ≤ M * y + C - 1 := by
    nlinarith [hmul_up]
  have hnum_up' : C * (a / C) + D ≤ M * y + M - 1 := by
    nlinarith [hnum_up, hCM]
  have hupper :
      (C * (a / C) + D) / M ≤ y := by
    have hdiv_le : (C * (a / C) + D) / M ≤ (M * y + M - 1) / M :=
      Int.ediv_le_ediv hM hnum_up'
    have hM1_nonneg : 0 ≤ M - 1 := by nlinarith [hM]
    have hM1_lt : M - 1 < M := by nlinarith [hM]
    have hM1_div : (M - 1) / M = 0 :=
      Int.ediv_eq_zero_of_lt_abs hM1_nonneg (by
        rw [abs_of_pos hM]
        exact hM1_lt)
    have hrhs : (M * y + M - 1) / M = y := by
      calc
        (M * y + M - 1) / M = ((M - 1) + y * M) / M := by ring_nf
        _ = (M - 1) / M + y := by
              simpa only [mul_comm, add_comm] using (Int.add_mul_ediv_right (M - 1) y (ne_of_gt hM))
        _ = y := by simp only [hM1_div, zero_add]
    exact le_trans hdiv_le (by simp only [hrhs, le_refl])
  have hlt_ax : a < (a / C) * C + C := (Int.ediv_le_iff_le_mul hCpos).1 le_rfl
  have hmul_low : y * M ≤ C * (a / C) + D := by
    have hlt1 : M * y + C - D - 1 < C * (a / C) + C := by
      simpa only [a, add_comm, Order.sub_one_lt_iff, tsub_le_iff_right, add_left_comm,
        add_le_add_iff_left, mul_comm] using hlt_ax
    have hlt2 : M * y < C * (a / C) + D + 1 := by nlinarith [hlt1]
    have hle2 : M * y ≤ C * (a / C) + D := (Int.lt_add_one_iff).1 hlt2
    simpa only [mul_comm, ge_iff_le] using hle2
  exact zfloorDiv_eq_of_mul_bounds M (C * (a / C) + D) y hM hmul_low
    (by simpa only [mul_comm] using hnum_up')

/--
入力/前提: `0 ≤ y < Yn1`。
主張: `iy_right y` は右端候補点の床除算表示に一致する。
内容: `iy_right` の `if` を非端点条件で展開した明示式。
証明: `y ≠ Yn1` に直して `Impl.iy_right` をそのまま簡約する。
役割: 右端側の再帰候補の `obj` 計算を explicit にする。
-/
private lemma iy_right_eq_floor_of_lt
    (N M C D y : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M)
    (hCpos : 0 < C) (hy0 : 0 ≤ y) (hyY : y ≤ Impl.Yn1 N M C D hN hM)
    (hy_lt : y < Impl.Yn1 N M C D hN hM) :
    Impl.iy_right N M C D y hN hM hC0 hD0 hCM hDM hy0 hyY =
      Spec.zfloorDiv (M * y + M - D - 1) C hCpos := by
  have hne : y ≠ Impl.Yn1 N M C D hN hM := ne_of_lt hy_lt
  have hneq' : y ≠ (C * (N - 1) + D) / M := by
    simpa only [ne_eq, Impl.Yn1, Impl.yOf, Spec.zfloorDiv] using hne
  unfold Impl.iy_right
  simp only [Impl.Yn1, Impl.yOf, Spec.zfloorDiv, hneq', ↓reduceDIte]

/--
入力/前提: `0 ≤ y < Yn1`。
主張: `iy_right y` での `obj` は右端再帰側の `obj` に一致する。
内容: 非端点 `y` を右側の再帰問題へ移す際の値保存。
証明: `iy_right_eq_floor_of_lt` を代入して `obj` を整理する。
役割: `mwf_yn1_pos_a_nonneg` の右側候補比較に使う。
-/
private lemma obj_iy_right_eq
    (N M A B C D y : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M)
    (hCpos : 0 < C) (hy0 : 0 ≤ y) (hyY : y ≤ Impl.Yn1 N M C D hN hM)
    (hy_lt : y < Impl.Yn1 N M C D hN hM) :
    Spec.obj B A M (M - D - 1) C y hCpos =
      Spec.obj A B C D M
        (Impl.iy_right N M C D y hN hM hC0 hD0 hCM hDM hy0 hyY) hM := by
  let x : Int := Impl.iy_right N M C D y hN hM hC0 hD0 hCM hDM hy0 hyY
  have hyOf : Impl.yOf M C D hM x = y := by
    exact yOf_iy_right N M C D y hN hM hC0 hD0 hCM hDM hy0 hyY (ne_of_lt hy_lt)
  have hxDef : x = Spec.zfloorDiv (M * y + M - D - 1) C hCpos :=
    iy_right_eq_floor_of_lt N M C D y hN hM hC0 hD0 hCM hDM hCpos hy0 hyY hy_lt
  have hyDiv : Spec.zfloorDiv (C * x + D) M hM = y := by
    simpa only [Spec.zfloorDiv, Impl.yOf] using hyOf
  have harg : M * y + (M - D - 1) = M * y + M - D - 1 := by ring
  calc
    Spec.obj B A M (M - D - 1) C y hCpos
        = B * y + A * Spec.zfloorDiv (M * y + (M - D - 1)) C hCpos := by
            simp only [Spec.obj, Spec.zfloorDiv]
    _ = B * y + A * Spec.zfloorDiv (M * y + M - D - 1) C hCpos := by rw [harg]
    _ = B * y + A * x := by rw [hxDef]
    _ = A * x + B * y := by ring
    _ = A * x + B * Spec.zfloorDiv (C * x + D) M hM := by rw [hyDiv]
    _ = Spec.obj A B C D M x hM := by simp only [Spec.zfloorDiv, Spec.obj]

/--
入力/前提: `x ∈ dom` かつ `yOf x = Yn1`、さらに `A ≥ 0`。
主張: `x` での `obj` は右端値 `A * (N - 1) + B * Yn1` 以下。
内容: 上端に達した点では `x ≤ N - 1` だけで十分に上界が出る。
証明: `x ≤ N - 1` を掛け算して `obj` を評価する。
役割: 非負傾き分岐の端点ケースを閉じる。
-/
private lemma obj_le_right_of_y_eq_top
    (N M A B C D x : Int) (hN : 0 < N) (hM : 0 < M)
    (hAnonneg : 0 ≤ A) (hxDom : x ∈ Spec.dom N hN)
    (hyTop : Impl.yOf M C D hM x = Impl.Yn1 N M C D hN hM) :
    Spec.obj A B C D M x hM ≤ A * (N - 1) + B * Impl.Yn1 N M C D hN hM := by
  have hxLe : x ≤ N - 1 := (Finset.mem_Icc.mp hxDom).2
  have hyDiv : Spec.zfloorDiv (C * x + D) M hM = Impl.Yn1 N M C D hN hM := by
    simpa only [Spec.zfloorDiv, Impl.yOf] using hyTop
  have hA_le : A * x ≤ A * (N - 1) := mul_le_mul_of_nonneg_left hxLe hAnonneg
  calc
    Spec.obj A B C D M x hM = A * x + B * Spec.zfloorDiv (C * x + D) M hM := by
      simp only [Spec.obj, Spec.zfloorDiv]
    _ = A * x + B * Impl.Yn1 N M C D hN hM := by rw [hyDiv]
    _ ≤ A * (N - 1) + B * Impl.Yn1 N M C D hN hM := by nlinarith [hA_le]

/--
入力/前提: `yOf x = y` かつ `A ≥ 0`。
主張: 元の `obj` は右側再帰問題の `obj` 以下。
内容: 同じ `y` を持つ点を右側再帰状態へ写したときの基本比較。
証明: 床除算の上界を使って `x` を `⌊(My+M-D-1)/C⌋` で抑える。
役割: `mwf_yn1_pos_a_nonneg` の一般点を再帰問題へ落とす。
-/
private lemma obj_le_obj_right_rec_of_yOf
    (M A B C D x y : Int) (hM : 0 < M) (hCpos : 0 < C) (hAnonneg : 0 ≤ A)
    (hDiv : Impl.yOf M C D hM x = y) :
    Spec.obj A B C D M x hM ≤ Spec.obj B A M (M - D - 1) C y hCpos := by
  have hDiv' : Spec.zfloorDiv (C * x + D) M hM = y := by
    simpa only [Spec.zfloorDiv, Impl.yOf] using hDiv
  have hDivEq : (C * x + D) / M = y := by simpa only [Spec.zfloorDiv] using hDiv'
  have hNum_up : C * x ≤ M * y + M - D - 1 := by
    have hdivLe : (C * x + D) / M ≤ y := le_of_eq hDivEq
    have hlt : C * x + D < y * M + M := (Int.ediv_le_iff_le_mul hM).1 hdivLe
    nlinarith
  have hXub : x ≤ Spec.zfloorDiv (M * y + M - D - 1) C hCpos := by
    exact (Int.le_ediv_iff_mul_le hCpos).2 (by
      simpa only [mul_comm, Order.le_sub_one_iff] using hNum_up)
  have hAub : A * x ≤ A * Spec.zfloorDiv (M * y + M - D - 1) C hCpos :=
    mul_le_mul_of_nonneg_left hXub hAnonneg
  have harg : M * y + (M - D - 1) = M * y + M - D - 1 := by ring
  calc
    Spec.obj A B C D M x hM = A * x + B * y := by
      calc
        Spec.obj A B C D M x hM = A * x + B * Spec.zfloorDiv (C * x + D) M hM := by
          simp only [Spec.obj, Spec.zfloorDiv]
        _ = A * x + B * y := by rw [hDiv']
    _ ≤ A * Spec.zfloorDiv (M * y + M - D - 1) C hCpos + B * y := by nlinarith [hAub]
    _ = B * y + A * Spec.zfloorDiv (M * y + M - D - 1) C hCpos := by ring
    _ = Spec.obj B A M (M - D - 1) C y hCpos := by
      calc
        B * y + A * Spec.zfloorDiv (M * y + M - D - 1) C hCpos
            = B * y + A * Spec.zfloorDiv (M * y + (M - D - 1)) C hCpos := by rw [harg]
        _ = Spec.obj B A M (M - D - 1) C y hCpos := by
            simp only [Spec.obj, Spec.zfloorDiv]

/--
入力/前提: `0 ≤ y + 1 ≤ Yn1`。
主張: `iy_left (y + 1)` は左端候補点の床除算表示に一致する。
内容: 左側候補の explicit 形を `+1` 付きで取り出す補題。
証明: `iy_left` を展開し、`C` での割り算に `+1` を移す。
役割: 負傾き分岐の候補点計算に使う。
-/
private lemma iy_left_eq_floor_add_one
    (N M C D y : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M)
    (hCpos : 0 < C)
    (hy1_nonneg : 0 ≤ y + 1) (hy1_leYY : y + 1 ≤ Impl.Yn1 N M C D hN hM)
    (hy1_ne0 : y + 1 ≠ 0) :
    Impl.iy_left N M C D (y + 1) hN hM hC0 hD0 hCM hDM hy1_nonneg hy1_leYY =
      Spec.zfloorDiv (M * y + M - D - 1) C hCpos + 1 := by
  have hxDef0 :
      Impl.iy_left N M C D (y + 1) hN hM hC0 hD0 hCM hDM hy1_nonneg hy1_leYY =
        Spec.zfloorDiv (M * (y + 1) + C - D - 1) C hCpos := by
    simp only [Impl.iy_left, hy1_ne0, ↓reduceDIte, Spec.zfloorDiv]
  have hCne : C ≠ 0 := ne_of_gt hCpos
  calc
    Impl.iy_left N M C D (y + 1) hN hM hC0 hD0 hCM hDM hy1_nonneg hy1_leYY
        = Spec.zfloorDiv (M * (y + 1) + C - D - 1) C hCpos := hxDef0
    _ = Spec.zfloorDiv ((M * y + M - D - 1) + C) C hCpos := by ring_nf
    _ = Spec.zfloorDiv (M * y + M - D - 1) C hCpos + 1 := by
        unfold Spec.zfloorDiv
        simpa only [add_comm, mul_comm, mul_one] using
          (Int.add_mul_ediv_right (M * y + M - D - 1) 1 hCne)

/--
入力/前提: `0 ≤ y ≤ Yn1 - 1`。
主張: `iy_left (y + 1)` での `obj` は左側再帰候補の `obj` に一致する。
内容: 負傾き側で使う左候補点の値保存。
証明: `iy_left_eq_floor_add_one` を代入して `obj` を整理する。
役割: `mwf_yn1_pos_a_neg` の左端候補比較に使う。
-/
private lemma obj_iy_left_eq
    (N M A B C D y : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M)
    (hCpos : 0 < C) (_hy0 : 0 ≤ y) (_hyLePred : y ≤ Impl.Yn1 N M C D hN hM - 1)
    (hy1_nonneg : 0 ≤ y + 1) (hy1_leYY : y + 1 ≤ Impl.Yn1 N M C D hN hM)
    (hy1_ne0 : y + 1 ≠ 0) :
    (A + B) + Spec.obj B A M (M - D - 1) C y hCpos =
      Spec.obj A B C D M
        (Impl.iy_left N M C D (y + 1) hN hM hC0 hD0 hCM hDM hy1_nonneg hy1_leYY) hM := by
  let x : Int := Impl.iy_left N M C D (y + 1) hN hM hC0 hD0 hCM hDM hy1_nonneg hy1_leYY
  have hyOf : Impl.yOf M C D hM x = y + 1 :=
    yOf_iy_left N M C D (y + 1) hN hM hC0 hD0 hCM hDM hy1_nonneg hy1_leYY hy1_ne0
  have hxDef :
      x = Spec.zfloorDiv (M * y + M - D - 1) C hCpos + 1 :=
    iy_left_eq_floor_add_one N M C D y hN hM hC0 hD0 hCM hDM hCpos hy1_nonneg hy1_leYY hy1_ne0
  have hyDiv : Spec.zfloorDiv (C * x + D) M hM = y + 1 := by
    simpa only [Spec.zfloorDiv, Impl.yOf] using hyOf
  have harg : M * y + (M - D - 1) = M * y + M - D - 1 := by ring
  calc
    (A + B) + Spec.obj B A M (M - D - 1) C y hCpos
        = (A + B) + (B * y + A * Spec.zfloorDiv (M * y + M - D - 1) C hCpos) := by
            rw [show Spec.obj B A M (M - D - 1) C y hCpos =
              B * y + A * Spec.zfloorDiv (M * y + M - D - 1) C hCpos by
                calc
                  Spec.obj B A M (M - D - 1) C y hCpos
                      = B * y + A * Spec.zfloorDiv (M * y + (M - D - 1)) C hCpos := by
                          simp only [Spec.obj, Spec.zfloorDiv]
                  _ = B * y + A * Spec.zfloorDiv (M * y + M - D - 1) C hCpos := by rw [harg]]
    _ = B * (y + 1) + A * (Spec.zfloorDiv (M * y + M - D - 1) C hCpos + 1) := by ring
    _ = B * (y + 1) + A * x := by rw [hxDef]
    _ = A * x + B * (y + 1) := by ring
    _ = A * x + B * Spec.zfloorDiv (C * x + D) M hM := by rw [hyDiv]
    _ = Spec.obj A B C D M x hM := by simp only [Spec.zfloorDiv, Spec.obj]

/--
入力/前提: `x ∈ dom` かつ `yOf x = 0`、さらに `A < 0`。
主張: `x` での `obj` は `0` 以下。
内容: 下端に達した点では負傾きゆえに `x ≥ 0` から上界 `0` が得られる。
証明: `A * x ≤ 0` を示して `obj` を評価する。
役割: 負傾き分岐の端点ケースを閉じる。
-/
private lemma obj_le_zero_of_y_eq_zero
    (N M A B C D x : Int) (hN : 0 < N) (hM : 0 < M)
    (hAneg : A < 0) (hxDom : x ∈ Spec.dom N hN)
    (hyZero : Impl.yOf M C D hM x = 0) :
    Spec.obj A B C D M x hM ≤ 0 := by
  have hx0 : 0 ≤ x := (Finset.mem_Icc.mp hxDom).1
  have hyDiv : Spec.zfloorDiv (C * x + D) M hM = 0 := by
    simpa only [Spec.zfloorDiv, Impl.yOf] using hyZero
  have hAx : A * x ≤ 0 := mul_nonpos_of_nonpos_of_nonneg (le_of_lt hAneg) hx0
  calc
    Spec.obj A B C D M x hM = A * x + B * Spec.zfloorDiv (C * x + D) M hM := by
      simp only [Spec.obj, Spec.zfloorDiv]
    _ = A * x + B * 0 := by rw [hyDiv]
    _ ≤ 0 := by nlinarith [hAx]

/--
入力/前提: `yOf x = y` かつ `0 < y`、さらに `A < 0`。
主張: 元の `obj` は左側再帰問題にシフト項 `A + B` を足した値以下。
内容: 負傾き分岐で一般点を左側再帰問題へ移す基本比較。
証明: 左候補点の explicit 形と `x` の下界から `obj` を整理する。
役割: `mwf_yn1_pos_a_neg` の一般点処理に使う。
-/
private lemma obj_le_obj_left_rec_shift_of_yOf
    (M A B C D x y : Int) (hM : 0 < M) (hCpos : 0 < C) (hAneg : A < 0)
    (_hyPos : 0 < y) (hDiv : Impl.yOf M C D hM x = y) :
    Spec.obj A B C D M x hM ≤
      (A + B) + Spec.obj B A M (M - D - 1) C (y - 1) hCpos := by
  have hDiv' : Spec.zfloorDiv (C * x + D) M hM = y := by
    simpa only [Spec.zfloorDiv, Impl.yOf] using hDiv
  have hDivEq : (C * x + D) / M = y := by simpa only [Spec.zfloorDiv] using hDiv'
  have hDivLe : y ≤ (C * x + D) / M := by simpa only [hDivEq] using le_rfl
  have hNumLow : y * M ≤ C * x + D := (Int.le_ediv_iff_mul_le hM).1 hDivLe
  have hLle : Spec.zfloorDiv (M * y + C - D - 1) C hCpos ≤ x := by
    have hlt : M * y + C - D - 1 < x * C + C := by
      have hlt0 : M * y + C - D - 1 < C * x + C := by nlinarith [hNumLow]
      simpa only [mul_comm, Order.sub_one_lt_iff, tsub_le_iff_right, ge_iff_le] using hlt0
    exact (Int.ediv_le_iff_le_mul hCpos).2 hlt
  have hAub : A * x ≤ A * Spec.zfloorDiv (M * y + C - D - 1) C hCpos := by
    have htmp : x * A ≤ Spec.zfloorDiv (M * y + C - D - 1) C hCpos * A :=
      mul_le_mul_of_nonpos_right hLle (le_of_lt hAneg)
    simpa only [Spec.zfloorDiv, ge_iff_le, mul_comm] using htmp
  have hCne : C ≠ 0 := ne_of_gt hCpos
  have hFloor :
      Spec.zfloorDiv (M * y + C - D - 1) C hCpos
        = Spec.zfloorDiv (M * (y - 1) + M - D - 1) C hCpos + 1 := by
    calc
      Spec.zfloorDiv (M * y + C - D - 1) C hCpos
          = Spec.zfloorDiv ((M * (y - 1) + M - D - 1) + C) C hCpos := by ring_nf
      _ = Spec.zfloorDiv (M * (y - 1) + M - D - 1) C hCpos + 1 := by
          unfold Spec.zfloorDiv
          simpa only [add_comm, mul_comm, mul_one] using
            (Int.add_mul_ediv_right (M * (y - 1) + M - D - 1) 1 hCne)
  have hObj2 :
      Spec.obj B A M (M - D - 1) C (y - 1) hCpos =
        B * (y - 1) + A * Spec.zfloorDiv (M * (y - 1) + M - D - 1) C hCpos := by
    have harg : M * (y - 1) + (M - D - 1) = M * (y - 1) + M - D - 1 := by ring
    calc
      Spec.obj B A M (M - D - 1) C (y - 1) hCpos
          = B * (y - 1) + A * Spec.zfloorDiv (M * (y - 1) + (M - D - 1)) C hCpos := by
              simp only [Spec.obj, Spec.zfloorDiv]
      _ = B * (y - 1) + A * Spec.zfloorDiv (M * (y - 1) + M - D - 1) C hCpos := by rw [harg]
  calc
    Spec.obj A B C D M x hM = A * x + B * y := by
      calc
        Spec.obj A B C D M x hM = A * x + B * Spec.zfloorDiv (C * x + D) M hM := by
          simp only [Spec.obj, Spec.zfloorDiv]
        _ = A * x + B * y := by rw [hDiv']
    _ ≤ A * Spec.zfloorDiv (M * y + C - D - 1) C hCpos + B * y := by nlinarith [hAub]
    _ = B * y + A * (Spec.zfloorDiv (M * (y - 1) + M - D - 1) C hCpos + 1) := by
      rw [hFloor]
      ring
    _ = (A + B) + (B * (y - 1) + A * Spec.zfloorDiv (M * (y - 1) + M - D - 1) C hCpos) := by ring
    _ = (A + B) + Spec.obj B A M (M - D - 1) C (y - 1) hCpos := by rw [hObj2]

/--
入力/前提: `Yn1 > 0` と `C > 0`。
主張: 右側の再帰問題の `mwf` は元の `mwf` 以下。
内容: 各再帰側候補 `y` を `iy_right y` で元問題へ戻し、値保存で比較する。
証明: `obj_iy_right_eq` と `Spec.obj_le_mwf` を各点に適用して `Finset.max'_le` を使う。
役割: `mwf_yn1_pos_a_nonneg` の再帰側下界を短く書くための helper。
-/
private lemma mwf_right_rec_le
    (N M A B C D : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M)
    (hYpos : 0 < Impl.Yn1 N M C D hN hM) (hCpos : 0 < C) :
    mwf (Impl.Yn1 N M C D hN hM) C B A M (M - D - 1) hYpos hCpos ≤
      mwf N M A B C D hN hM := by
  unfold mwf
  simp only [Spec.img, Spec.obj, Spec.zfloorDiv, Spec.dom]
  refine Finset.max'_le
    (s := Spec.img (Impl.Yn1 N M C D hN hM) C B A M (M - D - 1) hYpos hCpos)
    (H := Spec.img_nonempty
      (N := Impl.Yn1 N M C D hN hM) (M := C) (A := B) (B := A) (C := M) (D := M - D - 1)
      hYpos hCpos)
    (x := mwf N M A B C D hN hM) ?_
  intro z hz
  rcases Finset.mem_image.mp hz with ⟨y, hyDom, rfl⟩
  have hy0 : 0 ≤ y := (Finset.mem_Icc.mp hyDom).1
  have hyLePred : y ≤ Impl.Yn1 N M C D hN hM - 1 := (Finset.mem_Icc.mp hyDom).2
  have hy_lt : y < Impl.Yn1 N M C D hN hM := by nlinarith
  have hy_leYY : y ≤ Impl.Yn1 N M C D hN hM := le_of_lt hy_lt
  let x : Int := Impl.iy_right N M C D y hN hM hC0 hD0 hCM hDM hy0 hy_leYY
  have hxDom : x ∈ Spec.dom N hN :=
    iy_right_mem_dom N M C D y hN hM hC0 hD0 hCM hDM hy0 hy_leYY
  have hObjEq : Spec.obj B A M (M - D - 1) C y hCpos = Spec.obj A B C D M x hM := by
    simpa only [x] using
      obj_iy_right_eq N M A B C D y hN hM hC0 hD0 hCM hDM hCpos hy0 hy_leYY hy_lt
  exact hObjEq.symm ▸ Spec.obj_le_mwf N M A B C D x hN hM hxDom

/--
入力/前提: `x ∈ dom`、`Yn1 > 0`、`A ≥ 0`。
主張: `x` での `obj` は「右端値」と「右側再帰 `mwf`」の最大以下。
内容: `yOf x = Yn1` なら右端項、そうでなければ右側再帰項で抑える。
証明: `floorDiv_range_bounds` で `yOf x` の範囲を取り、2 ケースに分けて既存補題を適用する。
役割: `mwf_yn1_pos_a_nonneg` の各点上界を 1 本にまとめる。
-/
private lemma obj_le_nonneg_max
    (N M A B C D x : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M)
    (hYpos : 0 < Impl.Yn1 N M C D hN hM) (hCpos : 0 < C) (hAnonneg : 0 ≤ A)
    (hxDom : x ∈ Spec.dom N hN) :
    Spec.obj A B C D M x hM ≤
      max
        (A * (N - 1) + B * Impl.Yn1 N M C D hN hM)
        (mwf (Impl.Yn1 N M C D hN hM) C B A M (M - D - 1) hYpos hCpos) := by
  let y : Int := Impl.yOf M C D hM x
  rcases floorDiv_range_bounds N M C D hN hM hC0 hD0 hCM hDM x hxDom with ⟨hy0, hyY⟩
  by_cases hyTop : y = Impl.Yn1 N M C D hN hM
  · exact le_trans
      (obj_le_right_of_y_eq_top N M A B C D x hN hM hAnonneg hxDom hyTop)
      (le_max_left _ _)
  · have hy_lt : y < Impl.Yn1 N M C D hN hM := lt_of_le_of_ne hyY (fun hy' => hyTop hy')
    have hyDomYY : y ∈ Spec.dom (Impl.Yn1 N M C D hN hM) hYpos := by
      exact Finset.mem_Icc.mpr ⟨hy0, by nlinarith [hy_lt]⟩
    have hRecObj :
        Spec.obj B A M (M - D - 1) C y hCpos ≤
          mwf (Impl.Yn1 N M C D hN hM) C B A M (M - D - 1) hYpos hCpos :=
      Spec.obj_le_mwf (Impl.Yn1 N M C D hN hM) C B A M (M - D - 1) y hYpos hCpos hyDomYY
    have hObjLe :
        Spec.obj A B C D M x hM ≤ Spec.obj B A M (M - D - 1) C y hCpos :=
      obj_le_obj_right_rec_of_yOf M A B C D x y hM hCpos hAnonneg rfl
    exact le_trans hObjLe (le_trans hRecObj (le_max_right _ _))

/--
入力/前提: `0 ≤ D < M`。
主張: `x = 0` での `obj` は 0 に等しい。
内容: `D / M = 0` なので床除算項が消える。
証明: `Int.ediv_eq_zero_of_lt_abs` で `zfloorDiv D M = 0` を示して代入する。
役割: `mwf_yn1_pos_a_neg` の左端下界を短く書く。
-/
private lemma obj_zero_eq_zero
    (A B C D M : Int) (hM : 0 < M) (hD0 : 0 ≤ D) (hDM : D < M) :
    Spec.obj A B C D M 0 hM = 0 := by
  have hDdiv0 : Spec.zfloorDiv D M hM = 0 := by
    unfold Spec.zfloorDiv
    exact Int.ediv_eq_zero_of_lt_abs hD0 (by simpa only [abs_of_pos hM] using hDM)
  calc
    Spec.obj A B C D M 0 hM = A * 0 + B * Spec.zfloorDiv D M hM := by
      simp only [Spec.obj, mul_zero, Spec.zfloorDiv, zero_add]
    _ = A * 0 + B * 0 := by rw [hDdiv0]
    _ = 0 := by ring

/--
入力/前提: `Yn1 > 0` と `C > 0`。
主張: 左側再帰 `mwf` にシフト `A + B` を足した値は元の `mwf` 以下。
内容: 各再帰側候補 `y` を `iy_left (y+1)` で元問題へ戻し、値保存で比較する。
証明: `obj_iy_left_eq` と `Spec.obj_le_mwf` を各点に適用し、最後に `nlinarith` で戻す。
役割: `mwf_yn1_pos_a_neg` の再帰側下界を短く書くための helper。
-/
private lemma mwf_left_rec_shift_le
    (N M A B C D : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M)
    (hYpos : 0 < Impl.Yn1 N M C D hN hM) (hCpos : 0 < C) :
    (A + B) + mwf (Impl.Yn1 N M C D hN hM) C B A M (M - D - 1) hYpos hCpos ≤
      mwf N M A B C D hN hM := by
  have hrecCore :
      mwf (Impl.Yn1 N M C D hN hM) C B A M (M - D - 1) hYpos hCpos ≤
        mwf N M A B C D hN hM - (A + B) := by
    unfold mwf
    simp only [Spec.img, Spec.obj, Spec.zfloorDiv, Spec.dom]
    refine Finset.max'_le
      (s := Spec.img (Impl.Yn1 N M C D hN hM) C B A M (M - D - 1) hYpos hCpos)
      (H := Spec.img_nonempty
        (N := Impl.Yn1 N M C D hN hM) (M := C) (A := B) (B := A) (C := M) (D := M - D - 1)
        hYpos hCpos)
      (x := mwf N M A B C D hN hM - (A + B)) ?_
    intro z hz
    rcases Finset.mem_image.mp hz with ⟨y, hyDom, rfl⟩
    have hy0 : 0 ≤ y := (Finset.mem_Icc.mp hyDom).1
    have hyLePred : y ≤ Impl.Yn1 N M C D hN hM - 1 := (Finset.mem_Icc.mp hyDom).2
    have hy1_nonneg : 0 ≤ y + 1 := by nlinarith [hy0]
    have hy1_leYY : y + 1 ≤ Impl.Yn1 N M C D hN hM := by nlinarith [hyLePred]
    have hy1_ne0 : y + 1 ≠ 0 := by nlinarith [hy0]
    let x : Int := Impl.iy_left N M C D (y + 1) hN hM hC0 hD0 hCM hDM hy1_nonneg hy1_leYY
    have hxDom : x ∈ Spec.dom N hN :=
      iy_left_mem_dom N M C D (y + 1) hN hM hC0 hD0 hCM hDM hy1_nonneg hy1_leYY
    have hObjEq :
        (A + B) + Spec.obj B A M (M - D - 1) C y hCpos = Spec.obj A B C D M x hM := by
      simpa only [x] using
        obj_iy_left_eq N M A B C D y hN hM hC0 hD0 hCM hDM hCpos hy0 hyLePred
          hy1_nonneg hy1_leYY hy1_ne0
    have hplus :
        (A + B) + Spec.obj B A M (M - D - 1) C y hCpos ≤ mwf N M A B C D hN hM :=
      hObjEq ▸ Spec.obj_le_mwf N M A B C D x hN hM hxDom
    nlinarith [hplus]
  nlinarith [hrecCore]

/--
入力/前提: `x ∈ dom`、`Yn1 > 0`、`A < 0`。
主張: `x` での `obj` は `0` と左側再帰項付き候補の最大以下。
内容: `yOf x = 0` なら 0 で抑え、そうでなければ左側再帰項へ落とす。
証明: `floorDiv_range_bounds` で `yOf x` の範囲を取り、2 ケースに分けて既存補題を適用する。
役割: `mwf_yn1_pos_a_neg` の各点上界を 1 本にまとめる。
-/
private lemma obj_le_neg_max
    (N M A B C D x : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M)
    (hYpos : 0 < Impl.Yn1 N M C D hN hM) (hCpos : 0 < C) (hAneg : A < 0)
    (hxDom : x ∈ Spec.dom N hN) :
    Spec.obj A B C D M x hM ≤
      max 0 ((A + B) + mwf (Impl.Yn1 N M C D hN hM) C B A M (M - D - 1) hYpos hCpos) := by
  let y : Int := Impl.yOf M C D hM x
  rcases floorDiv_range_bounds N M C D hN hM hC0 hD0 hCM hDM x hxDom with ⟨hy0, hyY⟩
  by_cases hyZero : y = 0
  · exact le_trans
      (obj_le_zero_of_y_eq_zero N M A B C D x hN hM hAneg hxDom hyZero)
      (le_max_left _ _)
  · have hyPos : 0 < y := lt_of_le_of_ne hy0 (fun hy' => hyZero hy'.symm)
    have hy1 : 0 ≤ y - 1 := by nlinarith [hyPos]
    have hy1Le : y - 1 ≤ Impl.Yn1 N M C D hN hM - 1 := sub_le_sub_right hyY 1
    have hyDomYY : y - 1 ∈ Spec.dom (Impl.Yn1 N M C D hN hM) hYpos :=
      Finset.mem_Icc.mpr ⟨hy1, hy1Le⟩
    have hRecObj :
        Spec.obj B A M (M - D - 1) C (y - 1) hCpos ≤
          mwf (Impl.Yn1 N M C D hN hM) C B A M (M - D - 1) hYpos hCpos :=
      Spec.obj_le_mwf (Impl.Yn1 N M C D hN hM) C B A M (M - D - 1) (y - 1) hYpos hCpos hyDomYY
    have hObjLe :
        Spec.obj A B C D M x hM ≤ (A + B) + Spec.obj B A M (M - D - 1) C (y - 1) hCpos :=
      obj_le_obj_left_rec_shift_of_yOf M A B C D x y hM hCpos hAneg hyPos rfl
    have hRecShift :
        (A + B) + Spec.obj B A M (M - D - 1) C (y - 1) hCpos ≤
          (A + B) + mwf (Impl.Yn1 N M C D hN hM) C B A M (M - D - 1) hYpos hCpos := by
      nlinarith [hRecObj]
    exact le_trans hObjLe (le_trans hRecShift (le_max_right _ _))

/--
入力/前提: N M A B C D : Int、hN : 0 < N、hM : 0 < M。
主張: `Y>0 ∧ A≥0` の再帰式を与える。
内容: 右端項と入替後 `mwf` の二項最大に分解。
証明: 場合分け・式変形・既存補題の書き換えで示す。
役割: 正傾き分岐の主定理。
-/
private theorem mwf_yn1_pos_a_nonneg (N M A B C D : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M)
    (hYpos : 0 < Impl.Yn1 N M C D hN hM) (hAnonneg : A ≥ 0) :
  let YY := Impl.Yn1 N M C D hN hM
  let hCpos : 0 < C :=
    Impl.Internal.hCpos_of_Y_ge_one N M C D hN hM hC0 hD0 hDM hYpos
  mwf N M A B C D hN hM
      =
    max
      (A * (N - 1) + B * YY)
      (mwf YY C B A M (M - D - 1) hYpos hCpos)
      := by
  simp only [Impl.Yn1, Impl.yOf, Spec.zfloorDiv, mwf, Spec.img, Spec.obj, Spec.dom]
  let YY : Int := Impl.Yn1 N M C D hN hM
  have hCpos : 0 < C := Impl.Internal.hCpos_of_Y_ge_one N M C D hN hM hC0 hD0 hDM hYpos
  have hRight_le :
      A * (N - 1) + B * YY ≤ mwf N M A B C D hN hM := by
    have hxN1 : (N - 1 : Int) ∈ Spec.dom N hN := by
      exact Finset.mem_Icc.mpr ⟨sub_nonneg.mpr ((Int.lt_iff_add_one_le).1 hN), le_rfl⟩
    have hobj := Spec.obj_le_mwf N M A B C D (N - 1) hN hM hxN1
    have hobj_right :
        Spec.obj A B C D M (N - 1) hM = A * (N - 1) + B * Impl.Yn1 N M C D hN hM := by
      simp [Spec.obj, Spec.zfloorDiv, Impl.Yn1, Impl.yOf]
    simpa only [Impl.Yn1, Impl.yOf, Spec.zfloorDiv, mwf, Spec.img, Spec.obj, Spec.dom, ge_iff_le]
      using (hobj_right ▸ hobj)
  have hRec_le :
      mwf YY C B A M (M - D - 1) hYpos hCpos ≤ mwf N M A B C D hN hM := by
    simpa only [YY] using mwf_right_rec_le N M A B C D hN hM hC0 hD0 hCM hDM hYpos hCpos
  have hmax_le :
      max (A * (N - 1) + B * YY) (mwf YY C B A M (M - D - 1) hYpos hCpos)
        ≤ mwf N M A B C D hN hM := max_le hRight_le hRec_le
  have hmwf_le :
      mwf N M A B C D hN hM
        ≤ max (A * (N - 1) + B * YY) (mwf YY C B A M (M - D - 1) hYpos hCpos) := by
    unfold mwf
    simp only [Spec.img, Spec.obj, Spec.zfloorDiv, Spec.dom]
    refine Finset.max'_le
      (s := Spec.img N M A B C D hN hM)
      (H := Spec.img_nonempty (N := N) (M := M) (A := A) (B := B) (C := C) (D := D) hN hM)
      (x := max (A * (N - 1) + B * YY) (mwf YY C B A M (M - D - 1) hYpos hCpos)) ?_
    intro z hz
    rcases Finset.mem_image.mp hz with ⟨x, hxDom, rfl⟩
    simpa only [YY] using
      obj_le_nonneg_max N M A B C D x hN hM hC0 hD0 hCM hDM hYpos hCpos hAnonneg hxDom
  exact le_antisymm hmwf_le hmax_le

/--
入力/前提: N M A B C D : Int、hN : 0 < N、hM : 0 < M。
主張: `Y>0 ∧ A<0` の再帰式を与える。
内容: `0` と `(A+B)+`入替後 `mwf` の最大に分解。
証明: 場合分け・式変形・既存補題の書き換えで示す。
役割: 負傾き分岐の主定理。
-/
private theorem mwf_yn1_pos_a_neg (N M A B C D : Int) (hN : 0 < N) (hM : 0 < M)
    (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M)
    (hYpos : 0 < Impl.Yn1 N M C D hN hM) (hAneg : A < 0) :
  let YY := Impl.Yn1 N M C D hN hM
  let hCpos : 0 < C :=
    Impl.Internal.hCpos_of_Y_ge_one N M C D hN hM hC0 hD0 hDM hYpos
  mwf N M A B C D hN hM
      =
  max
    0
    ((A + B) + mwf YY C B A M (M - D - 1) hYpos hCpos)
      := by
  simp only [Impl.Yn1, Impl.yOf, Spec.zfloorDiv, mwf, Spec.img, Spec.obj, Spec.dom]
  let YY : Int := Impl.Yn1 N M C D hN hM
  have hCpos : 0 < C := Impl.Internal.hCpos_of_Y_ge_one N M C D hN hM hC0 hD0 hDM hYpos
  have hZero_le : 0 ≤ mwf N M A B C D hN hM := by
    have hx0 : (0 : Int) ∈ Spec.dom N hN := by
      exact Finset.mem_Icc.mpr ⟨le_rfl, sub_nonneg.mpr ((Int.lt_iff_add_one_le).1 hN)⟩
    have hobj0 := Spec.obj_le_mwf N M A B C D 0 hN hM hx0
    simpa only [obj_zero_eq_zero A B C D M hM hD0 hDM] using hobj0
  have hRec_le :
      (A + B) + mwf YY C B A M (M - D - 1) hYpos hCpos ≤ mwf N M A B C D hN hM := by
    simpa only [YY] using mwf_left_rec_shift_le N M A B C D hN hM hC0 hD0 hCM hDM hYpos hCpos
  have hMax_le :
      max 0 ((A + B) + mwf YY C B A M (M - D - 1) hYpos hCpos)
        ≤ mwf N M A B C D hN hM := max_le hZero_le hRec_le
  have hmwf_le :
      mwf N M A B C D hN hM
        ≤ max 0 ((A + B) + mwf YY C B A M (M - D - 1) hYpos hCpos) := by
    unfold mwf
    simp only [Spec.img, Spec.obj, Spec.zfloorDiv, Spec.dom]
    refine Finset.max'_le
      (s := Spec.img N M A B C D hN hM)
      (H := Spec.img_nonempty (N := N) (M := M) (A := A) (B := B) (C := C) (D := D) hN hM)
      (x := max 0 ((A + B) + mwf YY C B A M (M - D - 1) hYpos hCpos)) ?_
    intro z hz
    rcases Finset.mem_image.mp hz with ⟨x, hxDom, rfl⟩
    simpa only [YY] using
      obj_le_neg_max N M A B C D x hN hM hC0 hD0 hCM hDM hYpos hCpos hAneg hxDom
  exact le_antisymm hmwf_le hMax_le

/--
入力/前提: N M A B C D : Int、hN : 0 < N、hM : 0 < M。
主張: `step` 用初期状態表現への書換え。
内容: `step_init_equiv` を `St` 形式へ移す。
証明: 既存補題の書き換えで示す。
役割: 状態遷移定理列の入口。
-/
private theorem Mwf_step_init_equiv
  (N M A B C D : Int) (hN : 0 < N) (hM : 0 < M) :
    let U := Impl.St.mk (B * Spec.zfloorDiv D M hM) 0 N M A B C D hN hM
    mwf N M A B C D hN hM
      =
      max U.r (U.s + mwf U.n U.m U.a U.b U.c U.d U.hn U.hm) := by
  simpa only [Impl.Internal.st_mwf, zero_add] using step_init_equiv N M A B C D hN hM

/--
入力/前提: 基底状態 `(n,m,a,b,c,d)=(1,1,0,0,0,0)`。
主張: その `mwf` 値は `0`。
内容: `Yn1 = 0` の閉形式を基底状態に適用した具体例。
証明: `mwf_yn1_zero` と `Y_eq_zero_of_C_eq_zero` を使う。
役割: `step_reduce_y0` 後の停止状態評価を 0 に潰す。
-/
private lemma mwf_one_one_zero :
    mwf 1 1 0 0 0 0 (by decide) (by decide) = 0 := by
  have hY0 : Impl.Yn1 1 1 0 0 (by decide) (by decide) = 0 := by
    exact Y_eq_zero_of_C_eq_zero 1 1 0 0 (by decide) (by decide) (by decide) (by decide) rfl
  have h := mwf_yn1_zero 1 1 0 0 0 0 (by decide) (by decide)
      (by decide) (by decide) (by decide) (by decide) hY0
  calc
    mwf 1 1 0 0 0 0 (by decide) (by decide) = max 0 (0 * (1 - 1)) := h
    _ = 0 := by simp only [sub_self, mul_zero, max_self]

/--
入力/前提: 正規化状態 `U` と `stnorm_y U ≠ 0`。
主張: `stnorm_y U > 0`。
内容: `stnorm_y` は常に非負なので、0 でなければ正。
証明: `Y_nonneg` と `lt_of_le_of_ne` を使う。
役割: `Mwf_step_reduce_equiv` や `step_fields_or_stop` で非停止枝の正性を得る。
-/
private lemma stnorm_y_pos_of_ne_zero (U : Impl.StNorm) (hy : Impl.Internal.stnorm_y U ≠ 0) :
    0 < Impl.Internal.stnorm_y U := by
  exact lt_of_le_of_ne
    (Impl.Internal.Y_nonneg U.n U.m U.c U.d U.hn U.hm U.hC0 U.hD0) (fun h => hy h.symm)

/--
入力/前提: 正規化状態 `U` と `stnorm_y U > 0`。
主張: `U.c > 0`。
内容: 正規化後に高さが正なら Euclid 側第 2 成分も正である。
証明: `hCpos_of_Y_ge_one` を `stnorm_y` 表現へ写して使う。
役割: `mwf_yn1_pos_*` を `stnorm_mwf` に適用する前提を供給する。
-/
private lemma stnorm_c_pos_of_ypos (U : Impl.StNorm)
    (hYpos : 0 < Impl.Internal.stnorm_y U) :
    0 < U.c := by
  exact Impl.Internal.hCpos_of_Y_ge_one U.n U.m U.c U.d U.hn U.hm U.hC0 U.hD0 U.hDM
    (by simpa only [Impl.Internal.stnorm_y] using hYpos)

/--
入力/前提: U : StNorm。
主張: `step_reduce` 全体で評価式は不変。
内容: `Y` と `A` の符号で分岐し枝定理を貼る。
証明: 場合分け・既存補題の書き換えで示す。
役割: reduce 正しさの統合定理。
-/
private theorem Mwf_step_reduce_equiv
  (U : Impl.StNorm) :
    let V := Impl.Internal.step_reduce U
    max U.r (U.s + Impl.Internal.stnorm_mwf U)
      =
      max V.r (V.s + Impl.Internal.st_mwf V) := by
  by_cases hY0 : Impl.Internal.stnorm_y U = 0
  · have hbranch :
        let V := Impl.Internal.step_reduce_y0 U hY0
        max U.r (U.s + Impl.Internal.stnorm_mwf U)
          =
          max V.r (V.s + Impl.Internal.st_mwf V) := by
      have hLeft :
          max U.r (U.s + Impl.Internal.stnorm_mwf U) =
            max (max U.r U.s) (U.s + U.a * (U.n - 1)) := by
        have hcore :=
          mwf_yn1_zero U.n U.m U.a U.b U.c U.d U.hn U.hm U.hC0 U.hD0 U.hCM U.hDM hY0
        calc
          max U.r (U.s + Impl.Internal.stnorm_mwf U)
              = max U.r (U.s + max 0 (U.a * (U.n - 1))) := by
                  simpa only [Impl.Internal.stnorm_mwf, mwf, Spec.img, Spec.obj,
                    Spec.zfloorDiv, Spec.dom] using
                    congrArg (fun t => max U.r (U.s + t)) hcore
          _ = max (max U.r U.s) (U.s + U.a * (U.n - 1)) := by
                simp only [add_max, add_zero, max_assoc]
      have hRight :
          max (Impl.Internal.step_reduce_y0 U hY0).r
            ((Impl.Internal.step_reduce_y0 U hY0).s +
              Impl.Internal.st_mwf (Impl.Internal.step_reduce_y0 U hY0)) =
            max (max U.r U.s) (U.s + U.a * (U.n - 1)) := by
        have hmwf0 :
            Impl.Internal.st_mwf (Impl.Internal.step_reduce_y0 U hY0) = 0 := by
          simp only [Impl.Internal.step_reduce_y0, Impl.Internal.st_mwf, mwf, Spec.img,
            Spec.obj, Spec.zfloorDiv, Spec.dom, Int.reduceSub]
          exact mwf_one_one_zero
        rw [hmwf0]
        simp only [Impl.Internal.step_reduce_y0, Int.max_assoc, max_self, add_zero]
      exact hLeft.trans hRight.symm
    simpa only [Impl.Internal.step_reduce, hY0, ↓reduceDIte, Impl.Internal.st_mwf] using
      hbranch
  · have hYpos : 0 < Impl.Internal.stnorm_y U := stnorm_y_pos_of_ne_zero U hY0
    by_cases hAnonneg : 0 ≤ U.a
    · have hbranch :
          let V := Impl.Internal.step_reduce_ypos_a_nonneg U hYpos hAnonneg
          max U.r (U.s + Impl.Internal.stnorm_mwf U)
            =
            max V.r (V.s + Impl.Internal.st_mwf V) := by
        calc
          max U.r (U.s + Impl.Internal.stnorm_mwf U)
              =
                max
                  (max U.r (U.s + (U.a * (U.n - 1) + U.b * Impl.Internal.stnorm_y U)))
                  (U.s +
                    mwf (Impl.Internal.stnorm_y U) U.c U.b U.a U.m (U.m - U.d - 1)
                      hYpos (stnorm_c_pos_of_ypos U hYpos)) := by
                  rw [show Impl.Internal.stnorm_mwf U =
                      max
                        (U.a * (U.n - 1) + U.b * Impl.Internal.stnorm_y U)
                        (mwf (Impl.Internal.stnorm_y U) U.c U.b U.a U.m (U.m - U.d - 1)
                          hYpos (stnorm_c_pos_of_ypos U hYpos)) by
                        simpa only [Impl.Internal.stnorm_mwf, Impl.Internal.stnorm_y] using
                          (mwf_yn1_pos_a_nonneg U.n U.m U.a U.b U.c U.d
                            U.hn U.hm U.hC0 U.hD0 U.hCM U.hDM
                            (by simpa only [Impl.Internal.stnorm_y] using hYpos) hAnonneg)]
                  rw [add_max, max_assoc]
          _ = max (Impl.Internal.step_reduce_ypos_a_nonneg U hYpos hAnonneg).r
                ((Impl.Internal.step_reduce_ypos_a_nonneg U hYpos hAnonneg).s +
                  Impl.Internal.st_mwf
                    (Impl.Internal.step_reduce_ypos_a_nonneg U hYpos hAnonneg)) := by
                rfl
      simpa only [Impl.Internal.step_reduce, hY0, ↓reduceDIte, hAnonneg,
        Impl.Internal.st_mwf] using hbranch
    · have hAneg : U.a < 0 := lt_of_not_ge hAnonneg
      have hbranch :
          let V := Impl.Internal.step_reduce_ypos_a_neg U hYpos hAneg
          max U.r (U.s + Impl.Internal.stnorm_mwf U)
            =
            max V.r (V.s + Impl.Internal.st_mwf V) := by
        calc
          max U.r (U.s + Impl.Internal.stnorm_mwf U)
              =
                max
                  (max U.r U.s)
                  ((U.s + (U.a + U.b)) +
                    mwf (Impl.Internal.stnorm_y U) U.c U.b U.a U.m (U.m - U.d - 1)
                      hYpos (stnorm_c_pos_of_ypos U hYpos)) := by
                  rw [show Impl.Internal.stnorm_mwf U =
                      max 0
                        ((U.a + U.b) +
                          mwf (Impl.Internal.stnorm_y U) U.c U.b U.a U.m (U.m - U.d - 1)
                            hYpos (stnorm_c_pos_of_ypos U hYpos)) by
                        simpa only [Impl.Internal.stnorm_mwf, Impl.Internal.stnorm_y] using
                          (mwf_yn1_pos_a_neg U.n U.m U.a U.b U.c U.d
                            U.hn U.hm U.hC0 U.hD0 U.hCM U.hDM
                            (by simpa only [Impl.Internal.stnorm_y] using hYpos) hAneg)]
                  rw [add_max]
                  simp only [add_zero]
                  rw [← max_assoc]
                  simp only [add_assoc]
          _ = max (Impl.Internal.step_reduce_ypos_a_neg U hYpos hAneg).r
                ((Impl.Internal.step_reduce_ypos_a_neg U hYpos hAneg).s +
                  Impl.Internal.st_mwf
                    (Impl.Internal.step_reduce_ypos_a_neg U hYpos hAneg)) := by
                rfl
      simpa only [Impl.Internal.step_reduce, hY0, ↓reduceDIte, hAnonneg,
        Impl.Internal.st_mwf] using hbranch

/--
入力/前提: U : St。
主張: `step` 1回で評価式は不変。
内容: normalize 同値と reduce 同値を合成。
証明: 式変形・既存補題の書き換えで示す。
役割: 反復アルゴリズム正しさの中核。
-/
private theorem mwf_step_equiv
  (U : Impl.St) :
    let V := Impl.Internal.step U
    max U.r (U.s + mwf U.n U.m U.a U.b U.c U.d U.hn U.hm)
      =
      max V.r (V.s + mwf V.n V.m V.a V.b V.c V.d V.hn V.hm) := by
  let V := Impl.Internal.step_normalize U
  let W := Impl.Internal.step_reduce V
  have hnorm :
      max U.r (U.s + mwf U.n U.m U.a U.b U.c U.d U.hn U.hm) =
        max V.r (V.s + Impl.Internal.stnorm_mwf V) := by
    simpa only [V, Impl.Internal.st_mwf, Impl.Internal.step_normalize,
      Impl.Internal.stnorm_mwf] using
      congrArg (fun t => max U.r t) (normalize_mwf_eq U.s U.n U.m U.a U.b U.c U.d U.hn U.hm)
  have hred :
      max V.r (V.s + Impl.Internal.stnorm_mwf V) =
        max W.r (W.s + Impl.Internal.st_mwf W) := by
    simpa only [V, W] using (Mwf_step_reduce_equiv V)
  simpa only [V, W, Impl.Internal.step, Impl.Internal.st_mwf] using hnorm.trans hred

/--
入力/前提: 状態 `U`。
主張: `max U.r (U.s + st_mwf U)` は 1 ステップ後の同じ形と一致する。
内容: `step` が保持する評価量を 1 行で取り出した補題。
証明: `mwf_step_equiv` を `st_mwf` の形に言い換える。
役割: `mwf_iter_aux_correct` で各分岐を共通化する。
-/
private lemma step_value_eq (U : Impl.St) :
    max U.r (U.s + Impl.Internal.st_mwf U) =
      max (Impl.Internal.step U).r
        ((Impl.Internal.step U).s + Impl.Internal.st_mwf (Impl.Internal.step U)) := by
  simpa only [Impl.Internal.st_mwf] using (mwf_step_equiv U)

/--
入力/前提: U : St、hc0 : U.c = 0。
主張: `U.c=0` なら正規化後も `stnorm_y=0`。
内容: `normC 0 = 0` と `Y_eq_zero_of_C_eq_zero` を適用。
証明: 既存補題の書き換えで示す。
役割: 停止分岐への接続。
-/
private lemma stnorm_y_step_normalize_eq_zero
    (U : Impl.St) (hc0 : U.c = 0) :
    Impl.Internal.stnorm_y (Impl.Internal.step_normalize U) = 0 := by
  have hCmod0 : U.c % U.m = 0 := by
    simpa only [hc0] using (Int.zero_emod U.m)
  simpa only [Impl.Internal.stnorm_y, Impl.Yn1, Impl.yOf, Spec.zfloorDiv,
    Impl.Internal.step_normalize, Impl.normS, Impl.normA, Impl.normC, Spec.zfloorMod,
    hCmod0, Impl.normD, zero_mul, zero_add]
    using (Y_eq_zero_of_C_eq_zero U.n U.m (U.c % U.m) (U.d % U.m) U.hn U.hm
      (Int.emod_nonneg _ (ne_of_gt U.hm)) (Int.emod_lt_of_pos _ U.hm) hCmod0)

/--
入力/前提: W : StNorm、h : stnorm_y W = 0。
主張: 仮定 `stnorm_y=0` で `step_reduce` は `y0` 枝に一致。
内容: 外側 `if` を仮定で簡約。
証明: 既存補題の書き換えで示す。
役割: 停止証明で分岐を確定。
-/
private lemma step_reduce_eq_y0
    (W : Impl.StNorm) (h : Impl.Internal.stnorm_y W = 0) :
    Impl.Internal.step_reduce W = Impl.Internal.step_reduce_y0 W h := by
  simp only [Impl.Internal.step_reduce, h, ↓reduceDIte]

/--
入力/前提: W : StNorm、hPos : 0 < stnorm_y W、hAnonneg : 0 ≤ W.a。
主張: `stnorm_y>0 ∧ a≥0` で `step_reduce` は正傾き枝に一致。
内容: 2段の `if` を仮定で簡約。
証明: 既存補題の書き換えで示す。
役割: 縮小証明で分岐を確定。
-/
private lemma step_reduce_eq_ypos_a_nonneg
    (W : Impl.StNorm) (hPos : 0 < Impl.Internal.stnorm_y W) (hAnonneg : 0 ≤ W.a) :
    Impl.Internal.step_reduce W = Impl.Internal.step_reduce_ypos_a_nonneg W hPos hAnonneg := by
  simp only [Impl.Internal.step_reduce, ne_of_gt hPos, ↓reduceDIte, hAnonneg]

/--
入力/前提: W : StNorm、hPos : 0 < stnorm_y W、hAneg : W.a < 0。
主張: `stnorm_y>0 ∧ a<0` で `step_reduce` は負傾き枝に一致。
内容: 2段の `if` を仮定で簡約。
証明: 既存補題の書き換えで示す。
役割: 縮小証明で分岐を確定。
-/
private lemma step_reduce_eq_ypos_a_neg
    (W : Impl.StNorm) (hPos : 0 < Impl.Internal.stnorm_y W) (hAneg : W.a < 0) :
    Impl.Internal.step_reduce W = Impl.Internal.step_reduce_ypos_a_neg W hPos hAneg := by
  unfold Impl.Internal.step_reduce
  have hnot : ¬ (0 ≤ W.a) := not_le.mpr hAneg
  simp only [ne_of_gt hPos, ↓reduceDIte, hnot]

/--
入力/前提: 状態 `U` と、正規化後の `stnorm_y = 0`。
主張: そのとき `step U` の第2成分 `c` は `0`。
内容: `step_reduce` の停止枝では `c := 0` である。
証明: `step_reduce_eq_y0` に `congrArg Impl.St.c` を適用する。
役割: 停止枝の `c` の読取りを共通化する。
-/
private lemma step_c_eq_zero_of_stnorm_y_eq_zero (U : Impl.St)
    (hY0 : Impl.Internal.stnorm_y (Impl.Internal.step_normalize U) = 0) :
    (Impl.Internal.step U).c = 0 := by
  simpa only [Impl.Internal.step, hY0] using
    congrArg Impl.St.c (step_reduce_eq_y0 (Impl.Internal.step_normalize U) hY0)

/--
入力/前提: 状態 `U` と、正規化後の `stnorm_y` が 0 でないこと。
主張: そのとき `step U` の第2成分 `c` は `U.m` に等しい。
内容: `step_reduce` の非停止2分岐ではどちらも `c := m` である。
証明: `step_normalize U` に対する `a` の符号分岐と `step_reduce_eq_ypos_*` を使う。
役割: 停止判定から `stnorm_y` を逆算する補題や Euclid 接続補題を短くする。
-/
private lemma step_c_eq_m_of_stnorm_y_ne_zero (U : Impl.St)
    (hY0 : Impl.Internal.stnorm_y (Impl.Internal.step_normalize U) ≠ 0) :
    (Impl.Internal.step U).c = U.m := by
  let W := Impl.Internal.step_normalize U
  have hPos : 0 < Impl.Internal.stnorm_y W := stnorm_y_pos_of_ne_zero W
    (by simpa only [W] using hY0)
  by_cases hAnonneg : 0 ≤ W.a
  · have hstep : Impl.Internal.step U =
      Impl.Internal.step_reduce_ypos_a_nonneg W hPos hAnonneg := by
      unfold Impl.Internal.step
      exact step_reduce_eq_ypos_a_nonneg W hPos hAnonneg
    simpa only [W, Impl.Internal.step_normalize] using congrArg Impl.St.c hstep
  · have hAneg : W.a < 0 := lt_of_not_ge hAnonneg
    have hstep : Impl.Internal.step U = Impl.Internal.step_reduce_ypos_a_neg W hPos hAneg := by
      unfold Impl.Internal.step
      exact step_reduce_eq_ypos_a_neg W hPos hAneg
    simpa only [W, Impl.Internal.step_normalize] using congrArg Impl.St.c hstep

/--
入力/前提: `U.c = 0`。
主張: 1 ステップ後の tail 項 `max step.r (step.s + st_mwf step)` は `step.r` に潰れる。
内容: 既に停止している状態では再帰側寄与が消える。
証明: 正規化後の `y = 0` を使って `step_reduce_y0` に落とす。
役割: `mwf_iter_aux_correct` の停止分岐を簡約する。
-/
private lemma step_tail_eq_of_c_zero
    (U : Impl.St) (hc0 : U.c = 0) :
    max (Impl.Internal.step U).r
      ((Impl.Internal.step U).s + Impl.Internal.st_mwf (Impl.Internal.step U)) =
        (Impl.Internal.step U).r := by
  have hY0 : Impl.Internal.stnorm_y (Impl.Internal.step_normalize U) = 0 :=
    stnorm_y_step_normalize_eq_zero U hc0
  have hstep :
      Impl.Internal.step U = Impl.Internal.step_reduce_y0 (Impl.Internal.step_normalize U) hY0 := by
    unfold Impl.Internal.step
    exact step_reduce_eq_y0 (Impl.Internal.step_normalize U) hY0
  have hmwf0 :
      Impl.Internal.st_mwf
        (Impl.Internal.step_reduce_y0 (Impl.Internal.step_normalize U) hY0) = 0 := by
    simpa only [Impl.Internal.step_reduce_y0, Impl.Internal.st_mwf, mwf, Spec.img,
      Spec.obj, Spec.zfloorDiv, Spec.dom, Int.reduceSub] using mwf_one_one_zero
  rw [hstep, hmwf0]
  simp [Impl.Internal.step_reduce_y0]

/--
入力/前提: `(step U).c = 0`。
主張: 1 ステップ後の tail 項 `max step.r (step.s + st_mwf step)` は `step.r` に潰れる。
内容: 次状態で停止する場合の共通簡約。
証明: `step` の正規化後 `y = 0` を示して `step_reduce_y0` を適用する。
役割: `mwf_iter_aux_correct` の再帰停止ケースを簡約する。
-/
private lemma step_tail_eq_of_step_c_zero
    (U : Impl.St) (hc0 : (Impl.Internal.step U).c = 0) :
    max (Impl.Internal.step U).r
      ((Impl.Internal.step U).s + Impl.Internal.st_mwf (Impl.Internal.step U)) =
        (Impl.Internal.step U).r := by
  have hY0 : Impl.Internal.stnorm_y (Impl.Internal.step_normalize U) = 0 := by
    by_contra hYne
    exact (ne_of_gt U.hm) ((step_c_eq_m_of_stnorm_y_ne_zero U hYne).symm.trans hc0)
  have hstep :
      Impl.Internal.step U = Impl.Internal.step_reduce_y0 (Impl.Internal.step_normalize U) hY0 := by
    unfold Impl.Internal.step
    exact step_reduce_eq_y0 (Impl.Internal.step_normalize U) hY0
  have hmwf0 :
      Impl.Internal.st_mwf
        (Impl.Internal.step_reduce_y0 (Impl.Internal.step_normalize U) hY0) = 0 := by
    simp only [Impl.Internal.step_reduce_y0, Impl.Internal.st_mwf, mwf, Spec.img,
      Spec.obj, Spec.zfloorDiv, Spec.dom, Int.reduceSub]
    exact mwf_one_one_zero
  rw [hstep, hmwf0]
  simp [Impl.Internal.step_reduce_y0]

/--
入力/前提: `U.c = 0`。
主張: `mwf_iter_aux (k + 1) U = (step U).r`。
内容: 既停止状態では 1 回分の fuel を与えても即座に答えが返る。
証明: `mwf_iter_aux` の定義を `simp` で展開する。
役割: `mwf_iter_aux_correct` の停止ケース整理に使う。
-/
private lemma mwf_iter_aux_succ_of_c_zero
    (k : Nat) (U : Impl.St) (hc0 : U.c = 0) :
    Impl.Internal.mwf_iter_aux (k + 1) U = (Impl.Internal.step U).r := by
  simp only [Impl.Internal.mwf_iter_aux, hc0, ↓reduceDIte]

/--
入力/前提: `U.c = 0` と正の fuel `k + 1`。
主張: `mwf_iter_aux` は評価量 `max U.r (U.s + st_mwf U)` を返す。
内容: 停止状態では `mwf_iter_aux` が直ちに `(step U).r` を返し、それが保存量に一致する。
証明: `mwf_iter_aux_succ_of_c_zero` の値と `step_value_eq`, `step_tail_eq_of_c_zero` をつなぐ。
役割: `mwf_iter_aux_correct` の停止枝を共通化する。
-/
private lemma mwf_iter_aux_value_of_c_zero
    (k : Nat) (U : Impl.St) (hc0 : U.c = 0) :
    Impl.Internal.mwf_iter_aux (k + 1) U = max U.r (U.s + Impl.Internal.st_mwf U) := by
  calc
    Impl.Internal.mwf_iter_aux (k + 1) U = (Impl.Internal.step U).r :=
      mwf_iter_aux_succ_of_c_zero k U hc0
    _ = max U.r (U.s + Impl.Internal.st_mwf U) :=
      ((step_value_eq U).trans (step_tail_eq_of_c_zero U hc0)).symm

/--
入力/前提: `U.c ≠ 0` と、`step U` 側での `mwf_iter_aux` の正しさ。
主張: 元の状態でも 1 回進めた fuel で同じ保存量を返す。
内容: 非停止枝では `mwf_iter_aux` は `step U` へ進み、値は `step_value_eq` で戻せる。
証明: 定義を `simp` 展開して `step U` 側の仮定と `step_value_eq` を連結する。
役割: `mwf_iter_aux_correct` の非停止枝を base/succ で共通化する。
-/
private lemma mwf_iter_aux_step_correct_of_c_ne
    (k : Nat) (U : Impl.St) (hc : U.c ≠ 0)
    (hstep :
      Impl.Internal.mwf_iter_aux k (Impl.Internal.step U) =
        max (Impl.Internal.step U).r
        ((Impl.Internal.step U).s + Impl.Internal.st_mwf (Impl.Internal.step U))) :
    Impl.Internal.mwf_iter_aux (k + 1) U = max U.r (U.s + Impl.Internal.st_mwf U) := by
  calc
    Impl.Internal.mwf_iter_aux (k + 1) U = Impl.Internal.mwf_iter_aux k (Impl.Internal.step U) := by
      simp only [Impl.Internal.mwf_iter_aux, hc, ↓reduceDIte]
    _ = max (Impl.Internal.step U).r
      ((Impl.Internal.step U).s + Impl.Internal.st_mwf (Impl.Internal.step U)) := hstep
    _ = max U.r (U.s + Impl.Internal.st_mwf U) := (step_value_eq U).symm

/--
入力/前提: U : St、hc0 : U.c = 0。
主張: `U.c = 0` なら 1 ステップ後も `(step U).c = 0`。
内容: `stnorm_y=0` の枝へ簡約し `step_reduce_y0` の定義から従う。
証明: 式変形で示す。
役割: 停止条件の不変性。
-/
private lemma step_c_zero_of_c_zero (U : Impl.St) (hc0 : U.c = 0) :
  (Impl.Internal.step U).c = 0 := by
  have hY0 : Impl.Internal.stnorm_y (Impl.Internal.step_normalize U) = 0 :=
    stnorm_y_step_normalize_eq_zero U hc0
  exact step_c_eq_zero_of_stnorm_y_eq_zero U hY0

/--
入力/前提: `U : St`。
主張: `step U` は停止枝か、Euclid 形更新
  `((step U).c, (step U).m) = (U.m, U.c % U.m)` のどちらかである。
内容: `step_reduce` の3分岐を一度だけ展開し、`c` と `m` の更新式を同時に読む。
証明: `step_normalize U` に対する `stnorm_y` と `a` の場合分け。
役割: `step_c_or`, `step_after_preprocess_euclid`, 進捗補題の共通核。
-/
private lemma step_fields_or_stop (U : Impl.St) :
    (Impl.Internal.step U).c = 0 ∨
      ((Impl.Internal.step U).c = U.m ∧ (Impl.Internal.step U).m = U.c % U.m) := by
  let W := Impl.Internal.step_normalize U
  by_cases hy0 : Impl.Internal.stnorm_y W = 0
  · left
    exact step_c_eq_zero_of_stnorm_y_eq_zero U (by simpa only [W] using hy0)
  · right
    have hPos : 0 < Impl.Internal.stnorm_y W := stnorm_y_pos_of_ne_zero W
      (by simpa only [W] using hy0)
    by_cases hAnonneg : 0 ≤ W.a
    · have hstep : Impl.Internal.step U =
          Impl.Internal.step_reduce_ypos_a_nonneg W hPos hAnonneg := by
        unfold Impl.Internal.step
        exact step_reduce_eq_ypos_a_nonneg W hPos hAnonneg
      refine ⟨?_, ?_⟩
      · simpa only [W, Impl.Internal.step_normalize] using congrArg Impl.St.c hstep
      · simpa only [W, Impl.Internal.step_normalize] using congrArg Impl.St.m hstep
    · have hAneg : W.a < 0 := lt_of_not_ge hAnonneg
      have hstep : Impl.Internal.step U =
          Impl.Internal.step_reduce_ypos_a_neg W hPos hAneg := by
        unfold Impl.Internal.step
        exact step_reduce_eq_ypos_a_neg W hPos hAneg
      refine ⟨?_, ?_⟩
      · simpa only [W, Impl.Internal.step_normalize] using congrArg Impl.St.c hstep
      · simpa only [W, Impl.Internal.step_normalize] using congrArg Impl.St.m hstep

/--
入力/前提: U : St。
主張: `(step U).c = 0` または `(step U).c = U.m`。
内容: `step_fields_or_stop` から `c` 成分だけを取り出す。
証明: 場合分けで直ちに従う。
役割: Euclid 形更新の片方成分を特定する。
-/
private lemma step_c_or (U : Impl.St) : (Impl.Internal.step U).c = 0 ∨
  (Impl.Internal.step U).c = U.m := by
  rcases step_fields_or_stop U with hc0 | ⟨hc, _⟩
  · exact Or.inl hc0
  · exact Or.inr hc

/--
入力/前提: U : St。
主張: 1ステップで `m` が減るか `c=0` になる。
内容: `step_reduce` の3分岐を場合分け。
証明: 場合分け・式変形で示す。
役割: 反復の進捗・停止保証。
-/
private theorem mwf_step_reduce_reduction
    (U : Impl.St) : U.m > (Impl.Internal.step U).m ∨ (Impl.Internal.step U).c = 0 := by
  cases step_fields_or_stop U with
  | inl hc0 => exact Or.inr hc0
  | inr hfields =>
      left
      have hlt : (Impl.Internal.step U).m < U.m := by
        calc
          (Impl.Internal.step U).m = U.c % U.m := hfields.2
          _ < U.m := Int.emod_lt_of_pos U.c U.hm
      exact hlt

/--
入力/前提: `U : St`、`h : (step (step U)).c ≠ 0`。
主張: 前処理 1 ステップ後、次のステップが停止しなければ Euclid 1 ステップに一致。
内容: `step_fields_or_stop` を `step U` に適用し停止分岐を排除する。
証明: 場合分けで示す。
役割: Euclid 反復解析のための橋渡し。
-/
private lemma step_after_preprocess_euclid (U : Impl.St)
  (h : (Impl.Internal.step (Impl.Internal.step U)).c ≠ 0) :
    (Impl.Internal.step (Impl.Internal.step U)).c = (Impl.Internal.step U).m ∧
      (Impl.Internal.step (Impl.Internal.step U)).m =
      (Impl.Internal.step U).c % (Impl.Internal.step U).m := by
  exact (step_fields_or_stop (Impl.Internal.step U)).resolve_left h

end Internal

namespace Fuel

namespace Internal

end Internal
end Fuel

namespace Fuel
namespace Internal

/--
目的: `step` を `k` 回適用した状態 `stepN k U` を定義する。
定義: `k=0` で恒等、`k+1` で `step` を 1 回進めて再帰。
入力/前提: `k : Nat`、`U : St`。
出力: 型 `St` の値を返す。
役割: 反復回数の解析基盤。
-/
private def stepN : Nat → Impl.St → Impl.St
  | 0, U => U
  | k + 1, U => stepN k (Impl.Internal.step U)

/--
入力/前提: `k : Nat`, `U : St`。
主張: `stepN (k+1) U = stepN k (step U)`。
内容: `stepN` の再帰定義の 1 ステップ展開。
証明: 定義より自明。
役割: `stepN_eq_euclidN` や `stepN_stay_from_succ` の `succ` ケース簡約に使う。
-/
private lemma stepN_succ (k : Nat) (U : Impl.St) :
    stepN (k + 1) U = stepN k (Impl.Internal.step U) := by
  rfl

/--
入力/前提: t : Nat、V : St、h : V.c = 0。
主張: `V.c = 0` なら任意回数の `stepN` でも `c=0`。
内容: `t` による帰納法で `step_c_zero_of_c_zero` を用いる。
証明: 帰納法・既存補題の書き換えで示す。
役割: 停止条件の不変性。
-/
private lemma stepN_c_zero_of_c_zero (t : Nat) (V : Impl.St) (h : V.c = 0) :
    (stepN t V).c = 0 := by
  induction t generalizing V with
  | zero =>
      simpa only [stepN] using h
  | succ t ih =>
      have hstep : (Impl.Internal.step V).c = 0 := Mwf.Internal.step_c_zero_of_c_zero V h
      simpa only [stepN, Impl.Internal.step, Impl.Internal.step_reduce, Impl.Internal.stnorm_y,
        Impl.Yn1, Impl.yOf, Spec.zfloorDiv, Impl.Internal.step_normalize, Impl.normS, Impl.normA,
        Impl.normC, Spec.zfloorMod, Impl.normD, Impl.Internal.step_reduce_y0, Int.max_assoc,
        Impl.Internal.step_reduce_ypos_a_nonneg, Impl.Internal.step_reduce_ypos_a_neg, dite_eq_ite]
        using (ih (Impl.Internal.step V) hstep)

/--
目的: Nat 版 Euclid 1 ステップ `euclid_step` を定義する。
定義: `m=0` なら `(c,0)` に据え置き、そうでなければ `(m, c % m)`。
入力/前提: c m : Nat。
出力: 型 `Nat × Nat` の値を返す。
役割: Euclid 反復の基本操作。
-/
private def euclid_step (c m : Nat) : Nat × Nat :=
  if _ : m = 0 then (c, 0) else (m, c % m)

/--
目的: Euclid を `k` 回適用した結果 `euclidN` を定義する。
定義: `euclid_step` を `k` 回合成する再帰。
入力/前提: `k c m : Nat`。
出力: 型 `Nat × Nat` の値を返す。
役割: `stepN` と対応付ける対象。
-/
private def euclidN : Nat → Nat → Nat → Nat × Nat
  | 0, c, m => (c, m)
  | k + 1, c, m => let p := euclid_step c m; euclidN k p.1 p.2

end Internal

/--
目的: Euclid 反復 API 用に `euclidN` を `Mwf.Fuel` 配下へ再公開する。
定義: `Mwf.Fuel.Internal.euclidN` への薄い別名。
入力/前提: `k c m : Nat`。
出力: 型 `Nat × Nat` の値を返す。
役割: 停止時刻 `euclidTau` と公開停止補題の型に現れる Euclid 反復を `Mwf.Fuel` に集約する。
-/
abbrev euclidN : Nat → Nat → Nat → Nat × Nat := Internal.euclidN

namespace Internal

/--
入力/前提: c m : Nat。
主張: `euclidN 0 c m = (c, m)`。
内容: 定義の簡約（`rfl`）。
証明: 定義展開で示す。
役割: 再帰の基底簡約。
-/
@[simp] private lemma euclidN_zero (c m : Nat) : euclidN 0 c m = (c, m) := rfl

/--
入力/前提: k c m : Nat。
主張: `euclidN (k+1) c m` の 1 ステップ展開。
内容: `euclid_step` を 1 回適用した後の再帰形。
証明: 既存補題の適用と式変形で示す。
役割: 再帰展開用の補助。
-/
private lemma euclidN_succ (k c m : Nat) :
    euclidN (k + 1) c m = let p := euclid_step c m; euclidN k p.1 p.2 := by
  rfl

/--
目的: `step` の `(c,m)` を Nat へ落とす補助 `stPairNat` を定義する。
定義: `Int.toNat` で `(c,m)` を `(Nat,Nat)` に写す。
入力/前提: U : St。
出力: 型 `Nat × Nat` の値を返す。
役割: `stepN` と `euclidN` の対応付けに使う。
-/
private def stPairNat (U : Impl.St) : Nat × Nat := (Int.toNat U.c, Int.toNat U.m)

/--
入力/前提: `z : Int`、`hz : 0 < z`。
主張: `Int.toNat z ≠ 0`。
内容: `Int.toNat z = 0` なら `z ≤ 0` と矛盾する。
証明: `Int.toNat_eq_zero` に帰着する。
役割: `step_after_preprocess_euclid_nat` や Euclid 非停止性の証明で
     `Int` の正性から `Nat` 側の非零性を取り出す補助。
-/
private lemma int_toNat_ne_zero_of_pos {z : Int} (hz : 0 < z) : Int.toNat z ≠ 0 := by
  intro hz0
  exact (not_le_of_gt hz) ((Int.toNat_eq_zero).1 hz0)

/--
入力/前提: `a b : Int`、`0 ≤ a`、`0 < b`。
主張: 整数剰余を `Int.toNat` へ落とすと自然数の `%` に一致する。
内容: `Int.natCast_toNat_eq_self` と `Int.natCast_mod` による単純な移送。
証明: 両辺を `Int` に持ち上げて `rw` で示す。
役割: `step_after_preprocess_euclid_nat` で Euclid 更新の第2成分を `Nat` 側へ移す。
-/
private lemma int_toNat_emod_of_nonneg (a b : Int) (ha : 0 ≤ a) (hb : 0 < b) :
    Int.toNat (a % b) = Int.toNat a % Int.toNat b := by
  apply Int.ofNat.inj
  calc
    (Int.toNat (a % b) : Int) = a % b := by
      exact Int.toNat_of_nonneg (Int.emod_nonneg _ (ne_of_gt hb))
    _ = ((Int.toNat a : Nat) : Int) % ((Int.toNat b : Nat) : Int) := by
      rw [Int.natCast_toNat_eq_self.mpr ha, Int.natCast_toNat_eq_self.mpr (le_of_lt hb)]
    _ = ((Int.toNat a % Int.toNat b : Nat) : Int) := by
      rw [Int.natCast_mod]

/--
入力/前提: 状態 `U : St`。
主張: `(step U).c` は非負。
内容: `step` 後の `c` は `0` か `U.m`。
証明: `step_c_or` の場合分け。
役割: `Int` の剰余を `Nat` に落とす補題の前提を供給する。
-/
private lemma step_c_nonneg (U : Impl.St) : 0 ≤ (Impl.Internal.step U).c := by
  cases Mwf.Internal.step_c_or U with
  | inl h0 =>
      simp only [h0, le_refl]
  | inr h1 =>
      simpa only [h1] using (le_of_lt U.hm)

/--
入力/前提: `U : Impl.St`、`h : (Impl.Internal.step (Impl.Internal.step U)).c ≠ 0`。
主張: `Impl.Internal.step` の 1 ステップが Euclid 更新に一致する（Nat 版）。
内容: `step_after_preprocess_euclid` を `Int.toNat` と `%` の移送補題へ流す。
証明: `ext` して `simp` と helper の書換えで示す。
役割: `stepN_eq_euclidN` の橋渡し。
-/
private lemma step_after_preprocess_euclid_nat (U : Impl.St)
    (h : (Impl.Internal.step (Impl.Internal.step U)).c ≠ 0) :
    stPairNat (Impl.Internal.step (Impl.Internal.step U)) =
      euclid_step (stPairNat (Impl.Internal.step U)).1 (stPairNat (Impl.Internal.step U)).2 := by
  rcases Mwf.Internal.step_after_preprocess_euclid U h with ⟨hc, hm⟩
  have hm_nat_ne : (Int.toNat (Impl.Internal.step U).m) ≠ 0 :=
    int_toNat_ne_zero_of_pos (Impl.Internal.step U).hm
  have hmod :
      Int.toNat ((Impl.Internal.step U).c % (Impl.Internal.step U).m) =
        (Int.toNat (Impl.Internal.step U).c) % (Int.toNat (Impl.Internal.step U).m) := by
    exact int_toNat_emod_of_nonneg
      (Impl.Internal.step U).c (Impl.Internal.step U).m (step_c_nonneg U) (Impl.Internal.step U).hm
  ext <;> simp only [euclid_step, stPairNat, hm_nat_ne, ↓reduceDIte, hc, hm, hmod]

/--
入力/前提: `U : St`、`t : Nat`、`hStay : ∀ i, i ≤ t → (stepN i (step U)).c ≠ 0`。
主張: `c ≠ 0` の間、`stepN` と `euclidN` の反復が一致する。
内容: `step U` を初期状態とし、`t` 回の反復一致を帰納法で示す。
証明: 帰納法・既存補題の書き換えで示す。
役割: Euclid 反復による停止上界評価に使う。
-/
private lemma stepN_eq_euclidN (U : Impl.St) (t : Nat)
    (hStay : ∀ i, i ≤ t → (stepN i (Impl.Internal.step U)).c ≠ 0) :
    stPairNat (stepN t (Impl.Internal.step U)) =
      euclidN t (stPairNat (Impl.Internal.step U)).1 (stPairNat (Impl.Internal.step U)).2 := by
  induction t generalizing U with
  | zero =>
      simp only [stepN, euclidN]
  | succ t ih =>
      have h1 : (Impl.Internal.step (Impl.Internal.step U)).c ≠ 0 := by
        have h1' : (1 : Nat) ≤ t + 1 := Nat.succ_le_succ (Nat.zero_le _)
        simpa only [stepN_succ, stepN, ne_eq] using hStay 1 h1'
      have hstep :
          stPairNat (Impl.Internal.step (Impl.Internal.step U)) =
            euclid_step (stPairNat (Impl.Internal.step U)).1 (stPairNat (Impl.Internal.step U)).2 :=
        step_after_preprocess_euclid_nat U h1
      have hStay' : ∀ i, i ≤ t → (stepN i (Impl.Internal.step (Impl.Internal.step U))).c ≠ 0 := by
        intro i hi
        have hi' : i + 1 ≤ t + 1 := Nat.succ_le_succ hi
        simpa only [stepN_succ, ne_eq] using hStay (i + 1) hi'
      have ih' :
          stPairNat (stepN t (Impl.Internal.step (Impl.Internal.step U))) =
            euclidN t (stPairNat (Impl.Internal.step (Impl.Internal.step U))).1
              (stPairNat (Impl.Internal.step (Impl.Internal.step U))).2 :=
        ih (U := Impl.Internal.step U) hStay'
      let p := euclid_step (stPairNat (Impl.Internal.step U)).1 (stPairNat (Impl.Internal.step U)).2
      have ih'' :
          stPairNat (stepN t (Impl.Internal.step (Impl.Internal.step U))) =
            euclidN t p.1 p.2 := by
        simpa only [p, hstep] using ih'
      simpa only [stepN_succ, euclidN_succ] using ih''

/--
入力/前提: `U : St`、`k : Nat`、`hStay : ∀ i, i ≤ k + 1 → (stepN i U).c ≠ 0`。
主張: `c ≠ 0` が `k+1` 回続くなら、`step U` から `k` 回も `c ≠ 0` が続く。
内容: `i+1` の不変性を `stepN` 展開で `i` に落とす。
証明: 既存補題の書き換えで示す。
役割: `stepN_eq_euclidN` の前提を作る補助。
-/
private lemma stepN_stay_from_succ (U : Impl.St) (k : Nat)
    (hStay : ∀ i, i ≤ k + 1 → (stepN i U).c ≠ 0) :
    ∀ i, i ≤ k → (stepN i (Impl.Internal.step U)).c ≠ 0 := by
  intro i hi
  have hi' : i + 1 ≤ k + 1 := Nat.succ_le_succ hi
  have h := hStay (i + 1) hi'
  simpa only [stepN_succ, ne_eq] using h

/--
入力/前提: i j : Nat、U : St。
主張: `stepN (i + j) U = stepN j (stepN i U)`。
内容: `i` による帰納法で `stepN` の再帰を展開する。
証明: 帰納法で示す。
役割: 反復の分割・再結合に使う。
-/
private lemma stepN_add (i j : Nat) (U : Impl.St) :
    stepN (i + j) U = stepN j (stepN i U) := by
  induction i generalizing U with
  | zero =>
      simp only [zero_add, stepN]
  | succ i ih =>
      simp only [Nat.succ_add, Nat.succ_eq_add_one, stepN, Impl.Internal.step,
        Impl.Internal.step_reduce, Impl.Internal.stnorm_y, Impl.Yn1, Impl.yOf, Spec.zfloorDiv,
        Impl.Internal.step_normalize, Impl.normS, Impl.normA, Impl.normC, Spec.zfloorMod,
        Impl.normD, Impl.Internal.step_reduce_y0, Int.max_assoc,
        Impl.Internal.step_reduce_ypos_a_nonneg, Impl.Internal.step_reduce_ypos_a_neg, dite_eq_ite,
        ih]

/--
入力/前提: `U : St`、`k i : Nat`、`hk : (stepN k U).c ≠ 0`、`hi : i ≤ k`。
主張: `(stepN k U).c ≠ 0` なら任意の `i ≤ k` で `(stepN i U).c ≠ 0`。
内容: `stepN_add` と `stepN_c_zero_of_c_zero` を用いた反証法。
証明: 既存補題の書き換えで示す。
役割: 途中段階の非停止性を引き継ぐ補助。
-/
private lemma stepN_nonzero_of_le (U : Impl.St) (k i : Nat)
    (hk : (stepN k U).c ≠ 0) (hi : i ≤ k) :
    (stepN i U).c ≠ 0 := by
  intro hzero
  have hEq : stepN k U = stepN (k - i) (stepN i U) := by
    simpa only [Nat.add_sub_of_le hi] using (stepN_add i (k - i) U)
  have hzero' : (stepN (k - i) (stepN i U)).c = 0 :=
    stepN_c_zero_of_c_zero (k - i) (stepN i U) hzero
  have hk0 : (stepN k U).c = 0 := by
    simpa only [hEq] using hzero'
  exact hk hk0

/--
入力/前提: i j c m : Nat。
主張: `euclidN (i + j) c m = let p := euclidN i c m; euclidN j p.1 p.2`。
内容: `i` による帰納法で `euclidN` を展開する。
証明: 帰納法で示す。
役割: Euclid 反復の分割・再結合に使う。
-/
private lemma euclidN_add (i j c m : Nat) :
    euclidN (i + j) c m =
      let p := euclidN i c m; euclidN j p.1 p.2 := by
  induction i generalizing c m with
  | zero =>
      simp only [zero_add, euclidN]
  | succ i ih =>
      simp only [Nat.succ_add, Nat.succ_eq_add_one, euclidN_succ, ih]

/--
入力/前提: t c m : Nat、h : m = 0。
主張: `m=0` なら任意回数の `euclidN` でも第2成分は 0。
内容: `t` による帰納法と `euclid_step` の定義で示す。
証明: 帰納法で示す。
役割: Euclid 反復の停止不変性。
-/
private lemma euclidN_c_zero_of_c_zero (t c m : Nat) (h : m = 0) :
    (euclidN t c m).2 = 0 := by
  induction t generalizing c m with
  | zero =>
      simp only [euclidN, h]
  | succ t ih =>
      simp only [h, euclidN_succ, euclid_step, ↓reduceDIte, ih]

/--
入力/前提: `c m i j : Nat`、`i ≤ j`、`i` 時刻で第2成分が 0。
主張: `j` 時刻でも第2成分は 0。
内容: `euclidN_add` で後半の反復に分解し、0 から始まる tail は
     `euclidN_c_zero_of_c_zero` で消える。
証明: 反復分解と既存補題の書き換えで示す。
役割: `euclidN_nonzero_of_le` および停止性の単調性に使う。
-/
private lemma euclidN_c_zero_mono (c m i j : Nat) (hij : i ≤ j)
    (hi0 : (euclidN i c m).2 = 0) :
    (euclidN j c m).2 = 0 := by
  have hEq : euclidN j c m = let p := euclidN i c m; euclidN (j - i) p.1 p.2 := by
    simpa only [Nat.add_sub_of_le hij] using (euclidN_add i (j - i) c m)
  have htail : (euclidN (j - i) (euclidN i c m).1 (euclidN i c m).2).2 = 0 :=
    euclidN_c_zero_of_c_zero (j - i) (euclidN i c m).1 (euclidN i c m).2 hi0
  simpa only [hEq] using htail

/--
入力/前提: `c m k i : Nat`、`hk : (euclidN k c m).2 ≠ 0`、`hi : i ≤ k`。
主張: `(euclidN k c m).2 ≠ 0` なら任意の `i ≤ k` で `(euclidN i c m).2 ≠ 0`。
内容: `euclidN_add` と `euclidN_c_zero_of_c_zero` を用いた反証法。
証明: 既存補題の書き換えで示す。
役割: Euclid 反復の非停止性を引き継ぐ補助。
-/
private lemma euclidN_nonzero_of_le (c m k i : Nat)
    (hk : (euclidN k c m).2 ≠ 0) (hi : i ≤ k) :
    (euclidN i c m).2 ≠ 0 := by
  exact mt (euclidN_c_zero_mono c m i k hi) hk

/--
入力/前提: `fib (k+3) ≤ a`, `fib (k+2) ≤ b`。
主張: `fib (k+4) ≤ a + b`。
内容: Fibonacci の漸化式を上界評価に持ち上げる補題。
証明: `fib_add_two` を展開して両辺を足し合わせる。
役割: Euclid 反復の 2 段分下界を 1 つ先へ進める。
-/
private lemma fib_add_two_le_of_bounds (k a b : Nat)
    (ha : Nat.fib (k + 3) ≤ a) (hb : Nat.fib (k + 2) ≤ b) :
    Nat.fib (k + 4) ≤ a + b := by
  calc
    Nat.fib (k + 4) = Nat.fib (k + 3) + Nat.fib (k + 2) := by
      simpa only [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using
        (Nat.fib_add_two (n := k + 2))
    _ ≤ a + b := Nat.add_le_add ha hb

/--
入力/前提: `m > 0` かつ `m ≤ n`。
主張: `m + n % m ≤ n`。
内容: 商 `n / m` が少なくとも 1 であることから、余りつき分解の主項が `m` を吸収する。
証明: `n % m + m * (n / m) = n` と `1 ≤ n / m` を組み合わせる。
役割: Euclid 反復で現れる `r + n % r` 型の上界評価を共通化する。
-/
private lemma add_mod_le_self_of_le (n m : Nat) (hm_pos : 0 < m) (hm_le : m ≤ n) :
    m + n % m ≤ n := by
  have hq_ge : 1 ≤ n / m := Nat.succ_le_of_lt (Nat.div_pos hm_le hm_pos)
  have hmul_ge : m ≤ m * (n / m) := by
    calc
      m = m * 1 := by simp
      _ ≤ m * (n / m) := Nat.mul_le_mul_left m hq_ge
  have hsum_le : m + n % m ≤ m * (n / m) + n % m :=
    Nat.add_le_add_right hmul_ge (n % m)
  exact hsum_le.trans_eq (by simpa only [Nat.add_comm] using (Nat.mod_add_div n m))

/--
入力/前提: `m ≠ 0` と、`euclidN i c m` が `k+1` 回まで停止しないこと。
主張: 1 回 Euclid 更新した `(m, c % m)` から見ても、`k` 回までは停止しない。
内容: `euclidN_succ` を 1 回展開し、停止しないという仮定を tail 側へ移す。
証明: `i+1` 時刻の非停止性を `simpa` で書き換える。
役割: `euclidN_fib_lower` 系で繰り返し現れる tail への移送を共通化する。
-/
private lemma euclidN_stay_tail (c m k : Nat) (hm : m ≠ 0)
    (hStay : ∀ i, i ≤ k + 1 → (Fuel.euclidN i c m).2 ≠ 0) :
    ∀ i, i ≤ k → (Fuel.euclidN i m (c % m)).2 ≠ 0 := by
  intro i hi
  have h := hStay (i + 1) (Nat.succ_le_succ hi)
  simpa only [euclidN_succ, euclid_step, hm, ↓reduceDIte] using h

/--
入力/前提: `m ≠ 0` と `c % m ≠ 0`。
主張: `fib 3 ≤ m`。
内容: 非零剰余は `0 < c % m < m` を満たすので `m ≥ 2`。
証明: `Nat.mod_lt` と剰余の正性から `2 ≤ m` を示す。
役割: `euclidN_fib_lower` の `k = 1` 枝を短くする。
-/
private lemma fib_three_le_of_mod_ne_zero (c m : Nat) (hm : m ≠ 0) (hmod : c % m ≠ 0) :
    Nat.fib 3 ≤ m := by
  have hm_pos : 0 < m := Nat.pos_of_ne_zero hm
  have hmod_pos : 0 < c % m := Nat.pos_of_ne_zero hmod
  have hmod_lt : c % m < m := Nat.mod_lt c hm_pos
  have h1lt : 1 < m := lt_of_le_of_lt (Nat.succ_le_of_lt hmod_pos) hmod_lt
  simpa using Nat.succ_le_of_lt h1lt

/--
入力/前提: `m ≠ 0`、`c % m ≠ 0`、および `(c % m, m % (c % m))` の Fibonacci 下界。
主張: `fib (k + 4) ≤ m`。
内容: `fib (k + 4) ≤ c % m + m % (c % m)` を作り、`r + m % r ≤ m` で上から抑える。
証明: `fib_add_two_le_of_bounds` と `add_mod_le_self_of_le` を合成する。
役割: `euclidN_fib_lower` の 2 段目以降の算術部分を共通化する。
-/
private lemma fib_four_le_of_mod_bounds (c m k : Nat) (hm : m ≠ 0) (hmod : c % m ≠ 0)
    (hmod1 : Nat.fib (k + 3) ≤ c % m) (hmod2 : Nat.fib (k + 2) ≤ m % (c % m)) :
    Nat.fib (k + 4) ≤ m := by
  have hm_pos : 0 < m := Nat.pos_of_ne_zero hm
  have hmod_pos : 0 < c % m := Nat.pos_of_ne_zero hmod
  have hmod_le : c % m ≤ m := Nat.le_of_lt (Nat.mod_lt c hm_pos)
  have hsum_le : c % m + m % (c % m) ≤ m := by
    exact add_mod_le_self_of_le m (c % m) hmod_pos hmod_le
  exact (fib_add_two_le_of_bounds k (c % m) (m % (c % m)) hmod1 hmod2).trans hsum_le

/--
入力/前提: `c m k : Nat`、`hStay : ∀ i, i ≤ k → (euclidN i c m).2 ≠ 0`。
主張: `euclidN` が `k` 回続いて停止しないなら `fib (k+2) ≤ m`。
内容: 強い帰納法で Euclid 反復の下界を示す。
証明: 場合分け・既存補題の書き換えで示す。
役割: `euclidN_c_zero_of_lt_fib` の反証に使う。
-/
private lemma euclidN_fib_lower (c m k : Nat)
    (hStay : ∀ i, i ≤ k → (Fuel.euclidN i c m).2 ≠ 0) :
    Nat.fib (k + 2) ≤ m := by
  revert c m hStay
  refine Nat.strong_induction_on k ?_
  intro k ih c m hStay
  cases k with
  | zero =>
      have hm_pos : 0 < m := Nat.pos_of_ne_zero (hStay 0 (Nat.zero_le _))
      simpa using Nat.succ_le_of_lt hm_pos
  | succ k0 =>
      have hm0 : m ≠ 0 := hStay 0 (Nat.zero_le _)
      set r1 : Nat := c % m
      have hStay1 : ∀ i, i ≤ k0 → (Fuel.euclidN i m r1).2 ≠ 0 := by
        simpa only [r1] using euclidN_stay_tail c m k0 hm0 hStay
      have hr1_ne : r1 ≠ 0 := by
        simpa only [euclidN_zero, r1] using hStay1 0 (Nat.zero_le _)
      have hr1_lower : Nat.fib (k0 + 2) ≤ r1 :=
        ih k0 (Nat.lt_succ_self k0) m r1 hStay1
      cases k0 with
      | zero =>
          simpa only [r1] using fib_three_le_of_mod_ne_zero c m hm0 hr1_ne
      | succ k1 =>
          set r2 : Nat := m % r1
          have hStay2 : ∀ i, i ≤ k1 → (Fuel.euclidN i r1 r2).2 ≠ 0 := by
            simpa only [r1, r2] using euclidN_stay_tail m r1 k1 hr1_ne hStay1
          have hr2_lower : Nat.fib (k1 + 2) ≤ r2 :=
            ih k1 (Nat.lt_succ_of_lt (Nat.lt_succ_self k1)) r1 r2 hStay2
          simpa only [r1, r2] using
            fib_four_le_of_mod_bounds c m k1 hm0 hr1_ne hr1_lower hr2_lower

/--
入力/前提: `m > 0` かつ `m < c`。
主張: `fib 3 ≤ c`。
内容: `m ≥ 1` から `c ≥ 2` を得て、`fib 3 = 2` を代入する。
証明: `Nat.succ_le_of_lt` と `lt_of_le_of_lt` をつなぐ。
役割: `euclidN_fib_lower_first_of_lt` の基底ケースを短くする。
-/
private lemma fib_three_le_of_lt {c m : Nat} (hm : 0 < m) (hcm : m < c) : Nat.fib 3 ≤ c := by
  have h1_le_m : 1 ≤ m := Nat.succ_le_of_lt hm
  have h1_lt_c : 1 < c := lt_of_le_of_lt h1_le_m hcm
  have h2_le_c : 2 ≤ c := Nat.succ_le_of_lt h1_lt_c
  simpa using h2_le_c

/--
入力/前提: `euclidN` が `k+1` 回まで停止しない。
主張: 初期第2成分 `m` は `fib (k+3)` 以上。
内容: `euclidN_fib_lower` の `Nat.succ k` 版を添字だけ整える。
証明: 既存補題の `simpa`。
役割: `euclidN_fib_lower_first_of_lt` の succ ケース前半を短くする。
-/
private lemma euclidN_fib_lower_succ (c m k : Nat)
    (hStay : ∀ i, i ≤ k + 1 → (Fuel.euclidN i c m).2 ≠ 0) :
    Nat.fib (k + 3) ≤ m := by
  simpa only [Nat.succ_eq_add_one, Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using
    (euclidN_fib_lower c m (Nat.succ k) hStay)

/--
入力/前提: `m > 0`, `m < c`, および `m` と `c % m` への Fibonacci 下界。
主張: `fib (k + 4) ≤ c`。
内容: `fib (k + 4) ≤ m + c % m` を作り、`m + c % m ≤ c` で押さえる。
証明: `fib_add_two_le_of_bounds` と `add_mod_le_self_of_le` の合成。
役割: `euclidN_fib_lower_first_of_lt` の succ ケース終盤を共通化する。
-/
private lemma fib_four_le_of_lt_and_mod (c m k : Nat) (hm_pos : 0 < m) (hcm : m < c)
    (hm_lower : Nat.fib (k + 3) ≤ m) (hmod_lower : Nat.fib (k + 2) ≤ c % m) :
    Nat.fib (k + 4) ≤ c := by
  exact (fib_add_two_le_of_bounds k m (c % m) hm_lower hmod_lower).trans
    (add_mod_le_self_of_le c m hm_pos (Nat.le_of_lt hcm))

/--
入力/前提: `c m k : Nat`、`hcm : m < c`、
         `hStay : ∀ i, i ≤ k → (euclidN i c m).2 ≠ 0`。
主張: 第2成分が `k` 回まで 0 にならず、かつ初期値で `m<c` なら
     `fib (k+3) ≤ c`。
内容: `fib (k+2) ≤ m` と、1段ずらした列から得る `fib (k+1) ≤ c%m` を加え、
     `c = m*(c/m) + (c%m)`（かつ `c/m ≥ 1`）で上から押さえる。
証明: `k=0` と `k>0` の場合分け、および既存補題 `euclidN_fib_lower` の合成。
役割: `stepBoundOfM = greatestFib-1` で `step` 側停止上界を示すための強化補題。
-/
private lemma euclidN_fib_lower_first_of_lt (c m k : Nat)
    (hcm : m < c)
    (hStay : ∀ i, i ≤ k → (euclidN i c m).2 ≠ 0) :
    Nat.fib (k + 3) ≤ c := by
  cases k with
  | zero =>
      exact fib_three_le_of_lt (Nat.pos_of_ne_zero (hStay 0 (Nat.zero_le _))) hcm
  | succ k0 =>
      have hm_ne : m ≠ 0 := hStay 0 (Nat.zero_le _)
      have hm_pos : 0 < m := Nat.pos_of_ne_zero hm_ne
      set r1 : Nat := c % m
      have hStay1 : ∀ i, i ≤ k0 → (euclidN i m r1).2 ≠ 0 := by
        simpa only [r1] using euclidN_stay_tail c m k0 hm_ne hStay
      have hm_lower : Nat.fib (k0 + 3) ≤ m := euclidN_fib_lower_succ c m k0 hStay
      have hr1_lower : Nat.fib (k0 + 2) ≤ r1 :=
        euclidN_fib_lower m r1 k0 hStay1
      have hfib_le_c : Nat.fib (k0 + 4) ≤ c := by
        simpa only [r1] using fib_four_le_of_lt_and_mod c m k0 hm_pos hcm hm_lower hr1_lower
      simpa only [Nat.succ_eq_add_one, Nat.add_assoc] using hfib_le_c

/--
入力/前提: `c m k : Nat`、`h : m < Nat.fib (k + 2)`。
主張: `m < fib (k+2)` なら `(euclidN k c m).2 = 0`。
内容: 反証法で `euclidN_fib_lower` を用いて `fib (k+2) ≤ m` と矛盾させる。
証明: 反証法・既存補題の書き換えで示す。
役割: Fibonacci による Euclid 反復の停止上界。
-/
private lemma euclidN_c_zero_of_lt_fib (c m k : Nat)
    (h : m < Nat.fib (k + 2)) :
    (Fuel.euclidN k c m).2 = 0 := by
  by_contra hk
  exact (not_lt_of_ge <|
    euclidN_fib_lower c m k (fun i hi => euclidN_nonzero_of_le c m k i hk hi)) h

/--
入力/前提: `m ≤ n`。
主張: `m < fib (n+2)`。
内容: `n < n+1 ≤ fib (n+2)` を介して従う。
証明: `Nat.le_fib_add_one (n+2)` から `n+1 ≤ fib (n+2)` を得る。
役割: `euclidN_c_zero_of_le` を Fibonacci 上界版へ還元する補助。
-/
private lemma lt_fib_add_two_of_le {m n : Nat} (h : m ≤ n) :
    m < Nat.fib (n + 2) := by
  have hn1_le : n + 1 ≤ Nat.fib (n + 2) := by
    have := Nat.le_fib_add_one (n + 2)
    omega
  have hn_lt : n < Nat.fib (n + 2) :=
    lt_of_lt_of_le (Nat.lt_succ_self n) hn1_le
  exact lt_of_le_of_lt h hn_lt

/--
入力/前提: c m n : Nat、h : m <= n。
主張: `m ≤ n` なら `(euclidN n c m).2 = 0`。
内容: root 側の Fibonacci 上界版停止補題へ還元する。
証明: `m < fib (n+2)` を作って `euclidN_c_zero_of_lt_fib` を適用する。
役割: `euclidN_exists_c_zero` など Internal API から使う停止上界。
-/
private lemma euclidN_c_zero_of_le (c m n : Nat) (h : m <= n) :
    (euclidN n c m).2 = 0 :=
  euclidN_c_zero_of_lt_fib c m n (lt_fib_add_two_of_le h)

/--
入力/前提: `c m : Nat`。
主張: ある時刻 `t` で Euclid 反復の第2成分は 0 になる。
内容: `t = m` を取れば `m ≤ m` から `euclidN_c_zero_of_le` が使える。
証明: 具体的証人 `m` を与える。
役割: `euclidTau`（`Nat.find`）の存在仮定。
-/
private lemma euclidN_exists_c_zero (c m : Nat) :
    ∃ t, (euclidN t c m).2 = 0 :=
  ⟨m, euclidN_c_zero_of_le c m m le_rfl⟩

end Internal

/--
目的: Euclid 反復の最小停止時刻 `euclidTau` を定義する。
定義: `(euclidN t c m).2 = 0` を満たす `t` の最小値（`Nat.find`）。
入力/前提: `c m : Nat`。
出力: 型 `Nat` の値を返す。
役割: tex で用いる停止時刻 `\tau` の Lean 側対応物。
-/
def euclidTau (c m : Nat) : Nat :=
  Nat.find (Internal.euclidN_exists_c_zero c m)

/--
入力/前提: `c m : Nat`。
主張: `euclidTau c m` で Euclid 反復の第2成分は 0 になる。
内容: `Nat.find_spec` を展開して停止性を得る。
証明: `Nat.find` の仕様。
役割: 停止時刻の到達性を保証する基本補題。
-/
lemma euclidTau_spec (c m : Nat) :
    (euclidN (euclidTau c m) c m).2 = 0 :=
  Nat.find_spec (Internal.euclidN_exists_c_zero c m)

namespace Internal

/--
入力/前提: `c m i j : Nat`、`hij : i ≤ j`、`hi0 : (euclidN i c m).2 = 0`。
主張: ある時刻で第2成分が 0 なら、以降の時刻でも第2成分は 0。
内容: `euclidN_add` で分解し、後半は `euclidN_c_zero_of_c_zero` を適用する。
証明: 既存補題の書き換えで示す。
役割: 停止性の単調性（後方不変性）。
-/
private lemma euclidN_c_zero_of_le_index (c m i j : Nat) (hij : i ≤ j)
    (hi0 : (euclidN i c m).2 = 0) :
    (euclidN j c m).2 = 0 :=
  euclidN_c_zero_mono c m i j hij hi0

/--
入力/前提: `c m t : Nat`、`ht : (euclidN t c m).2 = 0`。
主張: `euclidTau c m ≤ t`。
内容: `Nat.find_min'` で最小性を得る。
証明: `Nat.find` の最小性。
役割: 停止時刻の最小性を与える。
-/
private lemma euclidTau_le_of_c_zero (c m t : Nat)
    (ht : (euclidN t c m).2 = 0) :
    euclidTau c m ≤ t :=
  Nat.find_min' (euclidN_exists_c_zero c m) ht

/--
入力/前提: `c m k : Nat`。
主張: `euclidTau c m ≤ k` と `(euclidN k c m).2 = 0` は同値。
内容: 前向きは停止性の単調性、後向きは `Nat.find` の最小性。
証明: 既存補題の合成。
役割: tex での「`\tau \le k`」と Lean の停止判定を接続する基礎同値。
-/
private lemma euclidTau_le_iff_c_zero (c m k : Nat) :
    euclidTau c m ≤ k ↔ (euclidN k c m).2 = 0 :=
  ⟨fun hle => euclidN_c_zero_of_le_index c m (euclidTau c m) k hle (euclidTau_spec c m),
    euclidTau_le_of_c_zero c m k⟩

/--
入力/前提: `c m k : Nat`、`euclidTau c m ≤ k`。
主張: 最小停止時刻以上では `(euclidN k c m).2 = 0`。
内容: `euclidTau_le_iff_c_zero` の前向き射影を名前付き補題として切り出す。
証明: 同値補題に `Iff.mp` を適用する。
役割: 停止時刻上界から停止を読む箇所で `(...).1` を避ける。
-/
private lemma euclidN_c_zero_of_tau_le (c m k : Nat)
    (hk : euclidTau c m ≤ k) :
    (euclidN k c m).2 = 0 :=
  Iff.mp (euclidTau_le_iff_c_zero c m k) hk

/--
入力/前提: `c m k : Nat`、`h : m < Nat.fib (k + 2)`。
主張: `m < fib (k+2)` なら `euclidTau c m ≤ k`。
内容: `euclidN_c_zero_of_lt_fib` で `k` 時刻停止を得て最小性を適用する。
証明: 既存補題の合成。
役割: tex の補題 `lem:euclid_classic` に対応する停止時刻版。
-/
private lemma euclidTau_le_of_lt_fib (c m k : Nat)
    (h : m < Nat.fib (k + 2)) :
    euclidTau c m ≤ k :=
  euclidTau_le_of_c_zero c m k (euclidN_c_zero_of_lt_fib c m k h)

/--
入力/前提: `m : Nat`。
主張: `stepBoundOfM m = greatestFib m - 1`。
内容: `greatestFibBinary_spec` を展開して定義式をそのまま読む。
証明: `simp` で `greatestFibBinary_spec` を展開する。
役割: `stepBoundOfM` を `greatestFib` の添字へ書き換える共通補題。
-/
private lemma stepBoundOfM_eq_greatestFib_pred (m : Nat) (_hm : 0 < m) :
    Fuel.stepBoundOfM m = Nat.greatestFib m - 1 := by
  simp [Fuel.stepBoundOfM, Fib.Core.greatestFibBinary_spec]

/--
入力/前提: `m : Nat`、`hm : 0 < m`。
主張: `stepBoundOfM m + 2 = greatestFib m + 1`。
内容: `stepBoundOfM = greatestFib - 1` の書換えに 2 を足した形。
証明: `stepBoundOfM_eq_greatestFib_pred` の後を `omega` で整える。
役割: `lt_fib_stepBoundOfM_add_two` で Fibonacci の添字を直接置き換える。
-/
private lemma stepBoundOfM_add_two_eq_greatestFib_add_one (m : Nat) (hm : 0 < m) :
    Fuel.stepBoundOfM m + 2 = Nat.greatestFib m + 1 := by
  have hfib1_le : Nat.fib 1 ≤ m := by
    simpa using (Nat.succ_le_of_lt hm)
  have hg_ge1 : 1 ≤ Nat.greatestFib m :=
    (Nat.le_greatestFib (m := 1) (n := m)).2 hfib1_le
  rw [stepBoundOfM_eq_greatestFib_pred m hm]
  omega

/--
入力/前提: `m : Nat`、`hm : 0 < m`。
主張: `m < fib (stepBoundOfM m + 2)`。
内容: `stepBoundOfM m = greatestFib m - 1` と
     `m < fib (greatestFib m + 1)` をつなぐ添字変換。
証明: `Nat.lt_fib_greatestFib_add_one` と `greatestFibBinary_spec` の書換え。
役割: `euclidTau_le_stepBoundOfM` を直接 `euclidTau_le_of_lt_fib` に落とす補助。
-/
private lemma lt_fib_stepBoundOfM_add_two (m : Nat) (hm : 0 < m) :
    m < Nat.fib (Fuel.stepBoundOfM m + 2) := by
  simpa only [stepBoundOfM_add_two_eq_greatestFib_add_one m hm] using
    (Nat.lt_fib_greatestFib_add_one m)

/--
入力/前提: `c m : Nat`、`hm : 0 < m`。
主張: `stepBoundOfM m` は最小停止時刻 `euclidTau c m` の上界。
内容: `stepBoundOfM = Nat.greatestFib - 1` を使って `euclidTau_le_greatestFib_pred` に帰着する。
証明: 既存補題の書き換えで示す。
役割: 実装上の反復上界 `stepBoundOfM` と厳密停止時刻評価を接続する。
-/
private lemma euclidTau_le_stepBoundOfM (c m : Nat) (hm : 0 < m) :
    Fuel.euclidTau c m ≤ Fuel.stepBoundOfM m := by
  exact euclidTau_le_of_lt_fib c m (Fuel.stepBoundOfM m)
    (lt_fib_stepBoundOfM_add_two m hm)

/--
入力/前提: `z : Int`、`hz : 0 < z`。
主張: `Int.toNat z` は正。
内容: `Int.toNat z = 0` なら `z ≤ 0` と矛盾する。
証明: `Int.toNat_eq_zero` に帰着する。
役割: `stepBoundOfM` の正性や燃料の非零性を示す補助。
-/
private lemma int_toNat_pos_of_pos {z : Int} (hz : 0 < z) : 0 < Int.toNat z := by
  exact Nat.pos_of_ne_zero (int_toNat_ne_zero_of_pos hz)

/--
入力/前提: `m : Nat`、`hm : 0 < m`。
主張: `Nat.greatestFib m ≥ 2`。
内容: `fib 2 = 1 ≤ m` を `Nat.le_greatestFib` に流し込んだ形。
証明: `Nat.fib_two` と `Nat.le_greatestFib` を組み合わせる。
役割: `stepBoundOfM_pos` と `stepN_bound_c_zero` の添字下界を共通化する。
-/
private lemma greatestFib_ge_two_of_pos (m : Nat) (hm : 0 < m) :
    2 ≤ Nat.greatestFib m := by
  have hfib2_le : Nat.fib 2 ≤ m := by
    simpa only [Nat.fib_two] using (Nat.succ_le_of_lt hm)
  exact (Nat.le_greatestFib (m := 2) (n := m)).2 hfib2_le

/--
入力/前提: `m : Nat`、`hm : 0 < m`。
主張: `stepBoundOfM m` は正。
内容: `greatestFib m ≥ 2` を用いて `greatestFibBinary m - 1 > 0` を得る。
証明: `greatestFib_ge_two_of_pos` と `stepBoundOfM_eq_greatestFib_pred` を使う。
役割: `mwf_iter_correct` で燃料が 0 でないことを示す補助。
-/
private lemma stepBoundOfM_pos (m : Nat) (hm : 0 < m) : 0 < Fuel.stepBoundOfM m := by
  have hg_ge2 : 2 ≤ Nat.greatestFib m := greatestFib_ge_two_of_pos m hm
  rw [stepBoundOfM_eq_greatestFib_pred m hm]
  omega

/--
入力/前提: `U : St`、`(step U).c ≠ 0`。
主張: `stPairNat (step U)` の第1成分は `Int.toNat U.m` に等しく、第2成分はそれより小さい。
内容: `step` が停止しない場合、`c := m` かつ `m` は真に減少する。
証明: `step_c_or` と `mwf_step_reduce_reduction` を組み合わせて `Int.toNat` に落とす。
役割: `stepN_bound_c_zero` で Euclid 側の `m<c` 前提をまとめて作る。
-/
private lemma stPairNat_step_bounds_of_nonzero (U : Impl.St)
    (hc : (Impl.Internal.step U).c ≠ 0) :
    (stPairNat (Impl.Internal.step U)).1 = Int.toNat U.m
      ∧ (stPairNat (Impl.Internal.step U)).2 < (stPairNat (Impl.Internal.step U)).1 := by
  have hdec : (Impl.Internal.step U).m < U.m := by
    cases Mwf.Internal.mwf_step_reduce_reduction U with
    | inl h => exact h
    | inr h0 => exact False.elim (hc h0)
  have hdec_nat : Int.toNat (Impl.Internal.step U).m < Int.toNat U.m := by
    exact (Int.toNat_lt_toNat U.hm).2 hdec
  have hY0_ne : Impl.Internal.stnorm_y (Impl.Internal.step_normalize U) ≠ 0 := by
    intro hY0
    exact hc (Mwf.Internal.step_c_eq_zero_of_stnorm_y_eq_zero U hY0)
  have hstep_c_eq : (Impl.Internal.step U).c = U.m := by
    exact Mwf.Internal.step_c_eq_m_of_stnorm_y_ne_zero U hY0_ne
  constructor
  · simpa only [stPairNat] using congrArg Int.toNat hstep_c_eq
  · simpa only [stPairNat, hstep_c_eq] using hdec_nat

/--
入力/前提: `step U` から `t` 回まで `c ≠ 0` が続く。
主張: 対応する Euclid 反復でも `t` 回まで第2成分は 0 にならない。
内容: `stepN_eq_euclidN` で対応付け、`stepN` 側 state の `m>0` から第2成分の非零性を得る。
証明: 各時刻 `i` ごとに対応等式の第2成分を比較する。
役割: `stepN_bound_c_zero` で `euclidN_fib_lower_first_of_lt` を適用する前提を供給する。
-/
private lemma euclidN_nonzero_of_step_stay (U : Impl.St) (t : Nat)
    (hStay : ∀ i, i ≤ t → (stepN i (Impl.Internal.step U)).c ≠ 0) :
    ∀ i, i ≤ t →
      (Fuel.euclidN i (stPairNat (Impl.Internal.step U)).1
        (stPairNat (Impl.Internal.step U)).2).2 ≠ 0 := by
  intro i hi
  have hEq :
      stPairNat (stepN i (Impl.Internal.step U)) =
        Fuel.euclidN i (stPairNat (Impl.Internal.step U)).1
          (stPairNat (Impl.Internal.step U)).2 := by
    apply stepN_eq_euclidN U i
    intro j hj
    exact hStay j (le_trans hj hi)
  have hstepN_m_ne0 : Int.toNat (stepN i (Impl.Internal.step U)).m ≠ 0 :=
    int_toNat_ne_zero_of_pos (stepN i (Impl.Internal.step U)).hm
  intro hz0
  exact hstepN_m_ne0 ((congrArg Prod.snd hEq).trans hz0)

/--
入力/前提: `step U` から始まる非停止列。
主張: 特に `(step U).c ≠ 0`。
内容: `i = 0` の場合を読むだけ。
証明: `stepN 0 = id` を `simpa` で展開する。
役割: `stepN_bound_c_zero` で `stPairNat_step_bounds_of_nonzero` に渡す前提を作る。
-/
private lemma step_c_nonzero_of_step_stay (U : Impl.St) (t : Nat)
    (hStay : ∀ i, i ≤ t → (stepN i (Impl.Internal.step U)).c ≠ 0) :
    (Impl.Internal.step U).c ≠ 0 := by
  simpa only [stepN] using hStay 0 (Nat.zero_le _)

/--
入力/前提: `step U` が非停止で、その後も `g-2` 回までは停止しない。
主張: `fib (g+1) ≤ Int.toNat U.m`。
内容: `stPairNat (step U)` に対する `euclidN_fib_lower_first_of_lt` を
  `stPairNat_step_bounds_of_nonzero` で元の `m` に戻す。
証明: Euclid 側の非停止列へ移送し、添字整形のあと成分等式で書き戻す。
役割: `stepN_bound_c_zero` の中心矛盾構成を helper 化する。
-/
private lemma fib_greatestFib_add_one_le_of_step_stay (U : Impl.St) (g : Nat)
    (hg_ge2 : 2 ≤ g) (hstep_c_ne : (Impl.Internal.step U).c ≠ 0)
    (hStayStep : ∀ i, i ≤ g - 2 → (stepN i (Impl.Internal.step U)).c ≠ 0) :
    Nat.fib (g + 1) ≤ Int.toNat U.m := by
  have hpair := stPairNat_step_bounds_of_nonzero U hstep_c_ne
  have hFib_le :
      Nat.fib ((g - 2) + 3) ≤ (stPairNat (Impl.Internal.step U)).1 :=
    euclidN_fib_lower_first_of_lt
      (stPairNat (Impl.Internal.step U)).1
      (stPairNat (Impl.Internal.step U)).2
      (g - 2) hpair.2 (euclidN_nonzero_of_step_stay U (g - 2) hStayStep)
  have hidx : (g - 2) + 3 = g + 1 := by omega
  have h' : Nat.fib (g + 1) ≤ (stPairNat (Impl.Internal.step U)).1 := by
    simpa only [hidx] using hFib_le
  exact h'.trans_eq (by simpa using hpair.1)

/--
入力/前提: `g ≥ 2` かつ `(stepN (g - 1) U).c ≠ 0`。
主張: `fib (g+1) ≤ Int.toNat U.m`。
内容: 終端時刻での非停止仮定から、`U` と `step U` の非停止列を作って
  `fib_greatestFib_add_one_le_of_step_stay` に渡す。
証明: `stepN_nonzero_of_le`, `stepN_stay_from_succ`, `step_c_nonzero_of_step_stay`
  の合成。
役割: `stepN_bound_c_zero` から中間の非停止列構成を追い出す。
-/
private lemma fib_greatestFib_add_one_le_of_stepN_nonzero (U : Impl.St) (g : Nat)
    (hg_ge2 : 2 ≤ g) (hk_non : (stepN (g - 1) U).c ≠ 0) :
    Nat.fib (g + 1) ≤ Int.toNat U.m := by
  have hStayU : ∀ i, i ≤ g - 1 → (stepN i U).c ≠ 0 := by
    intro i hi
    exact stepN_nonzero_of_le U (g - 1) i hk_non hi
  have hStayStep : ∀ i, i ≤ g - 2 → (stepN i (Impl.Internal.step U)).c ≠ 0 :=
    stepN_stay_from_succ U (g - 2) (fun i hi => hStayU i (by omega))
  have hstep_c_ne : (Impl.Internal.step U).c ≠ 0 :=
    step_c_nonzero_of_step_stay U (g - 2) hStayStep
  exact fib_greatestFib_add_one_le_of_step_stay U g hg_ge2 hstep_c_ne hStayStep

/--
入力/前提: U : St。
主張: `stepBoundOfM (Int.toNat U.m)` 回 `step` を適用すれば `c=0` に到達する。
内容: 非停止を仮定し、`step` と Euclid 反復の対応から
     強化補題 `euclidN_fib_lower_first_of_lt` を適用して矛盾を得る。
証明: 反証法・既存補題の書き換えで示す。
役割: 反復回数の上界保証（停止の証明）。
注意: `U.m` は `Int` なので `Int.toNat` を使う（`U.hm : 0 < U.m` より妥当）。
-/
private theorem stepN_bound_c_zero (U : Impl.St) :
    (stepN (Fuel.stepBoundOfM (Int.toNat U.m)) U).c = 0 := by
  set m0 : Nat := Int.toNat U.m
  set g : Nat := Nat.greatestFib m0
  have hm0_pos : 0 < m0 := by
    simpa only [m0] using int_toNat_pos_of_pos U.hm
  have hk : Fuel.stepBoundOfM m0 = g - 1 := by
    simpa only [g] using stepBoundOfM_eq_greatestFib_pred m0 hm0_pos
  have hg_ge2 : 2 ≤ g := by
    simpa only [g] using greatestFib_ge_two_of_pos m0 hm0_pos
  by_contra hnonzero
  have hk_non : (stepN (g - 1) U).c ≠ 0 := by
    simpa only [m0, hk, ne_eq] using hnonzero
  have hFib_le_m0 : Nat.fib (g + 1) ≤ m0 := by
    simpa only [m0] using fib_greatestFib_add_one_le_of_stepN_nonzero U g hg_ge2 hk_non
  have hlt_m0 : m0 < Nat.fib (g + 1) := by
    simpa only [g] using (Nat.lt_fib_greatestFib_add_one m0)
  exact (Nat.not_lt.mpr hFib_le_m0) hlt_m0

end Internal
end Fuel

namespace Correctness

namespace Internal

/--
入力/前提: `k : Nat`、`U : St`、`h : (stepN (k + 1) U).c = 0`。
主張: `stepN (k+1)` で停止が保証されるなら `mwf_iter_aux (k+1) U` は評価式の最大値を返す。
内容: `k` による帰納法と `mwf_step_equiv`・停止枝の評価で示す。
証明: 帰納法・場合分け・式変形・既存補題の書き換えで示す。
役割: `mwf_iter_correct` の中核補題。
-/
private lemma mwf_iter_aux_correct (k : Nat) (U : Impl.St)
    (h : (Fuel.Internal.stepN (k + 1) U).c = 0) :
    Impl.Internal.mwf_iter_aux (k + 1) U = max U.r (U.s + Impl.Internal.st_mwf U) := by
  induction k generalizing U with
  | zero =>
      by_cases h0 : U.c = 0
      · simpa only using Mwf.Internal.mwf_iter_aux_value_of_c_zero 0 U h0
      · have h1 : (Impl.Internal.step U).c = 0 := by
          simpa only [Fuel.Internal.stepN] using h
        have hstep :
            Impl.Internal.mwf_iter_aux 0 (Impl.Internal.step U) =
              max (Impl.Internal.step U).r ((Impl.Internal.step U).s + Impl.Internal.st_mwf
                (Impl.Internal.step U)) := by
          simpa only [Impl.Internal.mwf_iter_aux]
            using (Mwf.Internal.step_tail_eq_of_step_c_zero U h1).symm
        simpa only using Mwf.Internal.mwf_iter_aux_step_correct_of_c_ne 0 U h0 hstep
  | succ k ih =>
      by_cases h0 : U.c = 0
      · simpa only [Nat.succ_eq_add_one, Nat.add_assoc] using
          Mwf.Internal.mwf_iter_aux_value_of_c_zero (k + 1) U h0
      · have h' : (Fuel.Internal.stepN (k + 1) (Impl.Internal.step U)).c = 0 := by
          simpa only [Fuel.Internal.stepN] using h
        simpa only [Nat.succ_eq_add_one, Nat.add_assoc] using
          Mwf.Internal.mwf_iter_aux_step_correct_of_c_ne (k + 1) U h0
            (ih (U := Impl.Internal.step U) h')

/--
入力/前提: 正の fuel `k` と `(stepN k U).c = 0`。
主張: `mwf_iter_aux k U` は保存量 `max U.r (U.s + st_mwf U)` を返す。
内容: `k = k' + 1` と書き直して `mwf_iter_aux_correct` を適用する薄い wrapper。
証明: `Nat.exists_eq_succ_of_ne_zero` で `k` を分解して既存補題へ還元する。
役割: `mwf_iter_correct` から fuel 分解の雑音を除く。
-/
private lemma mwf_iter_aux_correct_of_pos (k : Nat) (hk : 0 < k) (U : Impl.St)
    (h : (Fuel.Internal.stepN k U).c = 0) :
    Impl.Internal.mwf_iter_aux k U = max U.r (U.s + Impl.Internal.st_mwf U) := by
  obtain ⟨k', hk'⟩ := Nat.exists_eq_succ_of_ne_zero (Nat.ne_of_gt hk)
  simpa only [hk'] using (mwf_iter_aux_correct k' U (by simpa only [hk'] using h))

/--
入力/前提: `N M A B C D : Int`, `hN : 0 < N`, `hM : 0 < M`。
主張: 初期状態に対する `mwf_iter_aux` は `mwf` を返す。
内容: 停止上界付きの `mwf_iter_aux_correct_of_pos` と `Mwf_step_init_equiv` を初期状態で合成する。
証明: 初期状態 `U` をおいて、反復補題と初期値補題を順に適用する。
役割: `mwf_iter_correct` から初期状態まわりの局所準備を取り除く。
-/
private lemma mwf_iter_aux_correct_init
    (N M A B C D : Int) (hN : 0 < N) (hM : 0 < M) :
    Impl.Internal.mwf_iter_aux (Fuel.stepBoundOfM (Int.toNat M))
      (Impl.St.mk (B * Spec.zfloorDiv D M hM) 0 N M A B C D hN hM) =
      mwf N M A B C D hN hM := by
  let U : Impl.St := Impl.St.mk (B * Spec.zfloorDiv D M hM) 0 N M A B C D hN hM
  have hinit : max U.r (U.s + Impl.Internal.st_mwf U) = mwf N M A B C D hN hM := by
    simpa only [Spec.zfloorDiv, Impl.Internal.st_mwf, U, mwf, Spec.img, Spec.obj, Spec.dom,
      zero_add, sup_eq_right] using (Mwf.Internal.Mwf_step_init_equiv N M A B C D hN hM).symm
  have hiter :
      Impl.Internal.mwf_iter_aux (Fuel.stepBoundOfM (Int.toNat U.m)) U =
        max U.r (U.s + Impl.Internal.st_mwf U) := by
    exact mwf_iter_aux_correct_of_pos
      (Fuel.stepBoundOfM (Int.toNat U.m))
      (Fuel.Internal.stepBoundOfM_pos (Int.toNat U.m)
        (Fuel.Internal.int_toNat_pos_of_pos U.hm))
      U
      (Fuel.Internal.stepN_bound_c_zero U)
  exact hiter.trans hinit

end Internal

/--
入力/前提: N M A B C D : Int、hN : 0 < N、hM : 0 < M。
主張: 反復実装 `Impl.mwf_iter` は定義的な `mwf` と一致する。
内容: `Impl.Internal.stepN_bound_c_zero` と `Impl.Internal.mwf_iter_aux_correct` を組み合わせて示す。
証明: 場合分け・既存補題の書き換えで示す。
役割: 実装の正しさ保証。
-/
theorem mwf_iter_correct
  (N M A B C D : Int) (hN : 0 < N) (hM : 0 < M) :
    Impl.mwf_iter N M A B C D hN hM = mwf N M A B C D hN hM := by
  simpa only [Impl.mwf_iter, Spec.zfloorDiv, mwf, Spec.img, Spec.obj, Spec.dom] using
    Internal.mwf_iter_aux_correct_init N M A B C D hN hM

namespace Internal

/--
入力/前提: 線形順序型 `α` 上の有限集合 `s,t` とその非空性。
主張: `s = t` なら `max'` も一致する。
内容: 集合等式と証明の一意性から `max'` を移す。
証明: 場合分けと proof irrelevance。
役割: `mwfLr_iter_correct` で像の書換え後の `max'` を比較する。
-/
private lemma max'_congr {α : Type _} [LinearOrder α]
    {s t : Finset α} (hs : s.Nonempty) (ht : t.Nonempty) (h : s = t) :
    s.max' hs = t.max' ht := by
  subst h
  cases Subsingleton.elim hs ht
  rfl

/--
入力/前提: `t : Int`, `m > 0`。
主張: `t = m * ⌊t/m⌋ + (t mod m)`。
内容: `Spec.zfloorDiv` / `Spec.zfloorMod` が `Int.ediv` / `Int.emod` の薄いラッパであることを明示する。
証明: `Int.emod_add_mul_ediv` をそのまま書き換える。
役割: `mwfLr_iter_translate` で商剰余分解の局所導入を 1 行にまとめる。
-/
private lemma zfloorDiv_mod_decomp (t m : Int) (hM : 0 < m) :
    t = m * Spec.zfloorDiv t m hM + Spec.zfloorMod t m hM := by
  simpa only [Spec.zfloorDiv, Spec.zfloorMod, mul_comm, add_comm] using
    (Int.emod_add_mul_ediv t m).symm

/--
入力/前提: `c*l+d = m*q+d'`。
主張: 平行移動後の床除算は `q` だけずれる。
内容: 加法と商剰余分解を整理する。
証明: `Int.add_mul_ediv_left` と環の計算。
役割: `mwfLr_iter_correct` の `obj` 変換の基礎。
-/
private lemma zfloorDiv_translate
    (l m c d q d' t : Int) (hM : 0 < m)
    (hqd : c * l + d = m * q + d') :
    Spec.zfloorDiv (c * (l + t) + d) m hM =
      q + Spec.zfloorDiv (c * t + d') m hM := by
  have hm0 : m ≠ 0 := ne_of_gt hM
  unfold Spec.zfloorDiv
  calc
    (c * (l + t) + d) / m = (c * t + (c * l + d)) / m := by ring_nf
    _ = (c * t + (m * q + d')) / m := by simp only [hqd]
    _ = (c * t + d' + m * q) / m := by ring_nf
    _ = (c * t + d') / m + q := by
          simpa only [add_comm, add_left_comm] using
            (Int.add_mul_ediv_left (a := c * t + d') (b := m) (c := q) hm0)
    _ = q + (c * t + d') / m := by ac_rfl
    _ = q + Spec.zfloorDiv (c * t + d') m hM := by rfl

/--
入力/前提: `c*l+d = m*q+d'`。
主張: 区間平行移動後の `obj` は定数項 `cst` と原点基準の `obj` に分解できる。
内容: `zfloorDiv_translate` を `obj` 展開へ代入する。
証明: 式変形。
役割: `mwfLr_iter_correct` の像変換に使う。
-/
private lemma obj_translate
    (l m a b c d q d' cst t : Int) (hM : 0 < m)
    (hqd : c * l + d = m * q + d') (hcst : cst = a * l + b * q) :
    Spec.obj a b c d m (l + t) hM =
      cst + Spec.obj a b c d' m t hM := by
  subst cst
  unfold Spec.obj
  rw [zfloorDiv_translate l m c d q d' t hM hqd]
  ring

/--
入力/前提: `n = r-l`。
主張: 区間 `[l,r)` の整数点集合は `[0,n)` を `l` だけ平行移動した像に一致する。
内容: `x ↔ x-l` の対応を取る。
証明: `Finset.ext` と区間不等式の変形。
役割: `mwfLr_iter_correct` で `domLr` を `dom` へ移す。
-/
private lemma domLr_eq_image_add
    (l r n : Int) (hLR : l < r) (hN : 0 < n) (hn : n = r - l) :
    Spec.domLr l r hLR = (Spec.dom n hN).image (fun t => l + t) := by
  subst n
  ext x; constructor
  · intro hx
    have hx' : l ≤ x ∧ x ≤ r - 1 := by
      simpa only [Order.le_sub_one_iff] using (Finset.mem_Icc.mp hx)
    refine Finset.mem_image.mpr ?_
    refine ⟨x - l, ?_, by ring_nf⟩
    have h0 : 0 ≤ x - l := sub_nonneg.mpr hx'.1
    have h1 : x - l ≤ r - l - 1 := by nlinarith [hx'.2]
    simpa only [Spec.dom, Finset.mem_Icc, Int.sub_nonneg, Order.le_sub_one_iff] using
      (Finset.mem_Icc.mpr ⟨h0, h1⟩)
  · intro hx
    rcases Finset.mem_image.mp hx with ⟨t, ht, rfl⟩
    have ht' : 0 ≤ t ∧ t ≤ r - l - 1 := by
      simpa only [Order.le_sub_one_iff] using (Finset.mem_Icc.mp ht)
    have h0 : l ≤ l + t := by nlinarith [ht'.1]
    have h1 : l + t ≤ r - 1 := by nlinarith [ht'.2]
    exact Finset.mem_Icc.mpr ⟨h0, h1⟩

/--
入力/前提: `n = r-l`, `c*l+d = m*q+d'`, `cst = a*l+b*q`。
主張: 区間版の像は、原点基準 `img` に定数 `cst` を足した像に一致する。
内容: `domLr_eq_image_add` と `obj_translate` を合成する。
証明: 画像の書換え。
役割: `mwfLr_iter_correct` の `max'` 比較を可能にする。
-/
private lemma imgLr_eq_image_translate
    (l r n m a b c d q d' cst : Int)
    (hLR : l < r) (hN : 0 < n) (hM : 0 < m)
    (hn : n = r - l) (hqd : c * l + d = m * q + d') (hcst : cst = a * l + b * q) :
    Spec.imgLr l r m a b c d hLR hM =
      (Spec.dom n hN).image (fun t => cst + Spec.obj a b c d' m t hM) := by
  calc
    Spec.imgLr l r m a b c d hLR hM =
        (Spec.domLr l r hLR).image (fun x => Spec.obj a b c d m x hM) := by rfl
    _ = ((Spec.dom n hN).image (fun t => l + t)).image (fun x => Spec.obj a b c d m x hM) := by
        rw [domLr_eq_image_add l r n hLR hN hn]
    _ = (Spec.dom n hN).image ((fun x => Spec.obj a b c d m x hM) ∘ fun t => l + t) := by
        rw [Finset.image_image]
    _ = (Spec.dom n hN).image (fun t => Spec.obj a b c d m (l + t) hM) := by rfl
    _ = (Spec.dom n hN).image (fun t => cst + Spec.obj a b c d' m t hM) := by
        refine Finset.image_congr ?_
        intro t ht
        exact obj_translate l m a b c d q d' cst t hM hqd hcst

/--
入力/前提: `S = img ...`, `f x = cst + x`。
主張: 平行移動済みの像は `S.image f` と一致する。
内容: `img` の定義と `Finset.image_image` を展開する。
証明: 定義展開。
役割: `mwfLr_iter_correct` で `Monotone.map_finset_max'` を使う準備。
-/
private lemma img_eq_image_add
    (n m a b c d cst : Int) (hN : 0 < n) (hM : 0 < m) :
    (Spec.dom n hN).image (fun t => cst + Spec.obj a b c d m t hM) =
      (Spec.img n m a b c d hN hM).image (fun x => cst + x) := by
  simp only [Spec.img, Spec.obj, Spec.zfloorDiv, Spec.dom]
  rw [Finset.image_image]
  rfl

/--
入力/前提: 整数値有限集合 `s` とその非空性。
主張: 各要素へ定数 `cst` を足した像の `max'` は、元の `max'` に `cst` を足したものに等しい。
内容: `x ↦ cst + x` は単調なので `Monotone.map_finset_max'` を適用できる。
証明: 単調性を示して既存補題へ帰着する。
役割: `mwfLr_translate_eq_mwf` の `max'` 移送を 1 行で使えるようにする。
-/
private lemma max'_image_add_eq (s : Finset Int) (hs : s.Nonempty) (cst : Int) :
    (s.image (fun x => cst + x)).max' (hs.image (fun x => cst + x)) = cst + s.max' hs := by
  have hmono : Monotone (fun x : Int => cst + x) := by
    intro x y hxy
    linarith
  simpa only [add_comm, Finset.image_add_right, neg_add_rev, add_assoc] using
    (Monotone.map_finset_max' (s := s) (f := fun x => cst + x) hmono hs).symm

/--
入力/前提: `img` の各値へ定数 `cst` を加えた像。
主張: その `max'` は `cst + mwf` に一致する。
内容: `img` の非空性と `max'_image_add_eq` を `mwf` の定義へ接続する。
証明: `S := img ...` と置いて既存補題を合成する。
役割: `mwfLr_translate_eq_mwf` で原点基準 `mwf` 側の `max'` 評価を 1 行で使う。
-/
private lemma img_max'_image_add_eq_mwf
    (n m a b c d cst : Int) (hN : 0 < n) (hM : 0 < m) :
    ((Spec.img n m a b c d hN hM).image (fun x => cst + x)).max'
        ((Spec.img_nonempty (N := n) (M := m) (A := a) (B := b) (C := c) (D := d) hN hM).image
          (fun x => cst + x)) =
      cst + mwf n m a b c d hN hM := by
  simpa only [mwf] using
    max'_image_add_eq
      (Spec.img n m a b c d hN hM)
      (Spec.img_nonempty (N := n) (M := m) (A := a) (B := b) (C := c) (D := d) hN hM)
      cst

/--
入力/前提: `img` の各値へ定数 `cst` を加えた像。
主張: その像は非空である。
内容: `img_nonempty` の witness をそのまま `image` に送る。
証明: `Finset.Nonempty.image` の直接適用。
役割: `mwfLr_translate_eq_mwf` の `max'` 比較で非空性証明を短くする。
-/
private lemma img_image_add_nonempty
    (n m a b c d cst : Int) (hN : 0 < n) (hM : 0 < m) :
    ((Spec.img n m a b c d hN hM).image (fun x => cst + x)).Nonempty :=
  (Spec.img_nonempty (N := n) (M := m) (A := a) (B := b) (C := c) (D := d) hN hM).image
    (fun x => cst + x)

/--
入力/前提: `n = r-l`, `c*l+d = m*q+d'`, `cst = a*l+b*q`。
主張: 区間版の像は、原点基準 `img` に定数 `cst` を足した像に一致する。
内容: `imgLr_eq_image_translate` と `img_eq_image_add` を直接合成した版。
証明: 2 本の像変換補題を順に適用する。
役割: `mwfLr_translate_eq_mwf` から中間の `dom.image` 形を隠す。
-/
private lemma imgLr_eq_img_image_add
    (l r n m a b c d q d' cst : Int)
    (hLR : l < r) (hN : 0 < n) (hM : 0 < m)
    (hn : n = r - l) (hqd : c * l + d = m * q + d') (hcst : cst = a * l + b * q) :
    Spec.imgLr l r m a b c d hLR hM =
      (Spec.img n m a b c d' hN hM).image (fun x => cst + x) := by
  calc
    Spec.imgLr l r m a b c d hLR hM
        = (Spec.dom n hN).image (fun t => cst + Spec.obj a b c d' m t hM) := by
            exact imgLr_eq_image_translate l r n m a b c d q d' cst hLR hN hM hn hqd hcst
    _ = (Spec.img n m a b c d' hN hM).image (fun x => cst + x) := by
          simpa only using img_eq_image_add n m a b c d' cst hN hM

/--
入力/前提: `n = r - l`、`c*l+d = m*q+d'`、`cst = a*l+b*q`。
主張: 区間版 `mwfLr` は平行移動後の `mwf` に定数項 `cst` を足した値に一致する。
内容: `imgLr` を `[0,n)` 上の像へ移し、`max'` の単調写像で最大値を移送する。
証明: `imgLr_eq_image_translate`, `img_eq_image_add`, `Monotone.map_finset_max'` を結合する。
役割: `mwfLr_iter_correct` を `mwf_iter_correct` に還元する。
-/
private lemma mwfLr_translate_eq_mwf
    (l r n m a b c d q d' cst : Int)
    (hLR : l < r) (hN : 0 < n) (hM : 0 < m)
    (hn : n = r - l) (hqd : c * l + d = m * q + d') (hcst : cst = a * l + b * q) :
    mwfLr l r m a b c d hLR hM = cst + mwf n m a b c d' hN hM := by
  classical
  have hImg : ((Spec.img n m a b c d' hN hM).image (fun x => cst + x)).Nonempty :=
    img_image_add_nonempty n m a b c d' cst hN hM
  have hImgLr : Spec.imgLr l r m a b c d hLR hM =
      (Spec.img n m a b c d' hN hM).image (fun x => cst + x) := by
    exact imgLr_eq_img_image_add l r n m a b c d q d' cst hLR hN hM hn hqd hcst
  calc
    mwfLr l r m a b c d hLR hM
        = ((Spec.img n m a b c d' hN hM).image (fun x => cst + x)).max'
            hImg := by
      unfold mwfLr
      exact max'_congr
        (Spec.imgLr_nonempty (L := l) (R := r) (M := m) (A := a) (B := b)
          (C := c) (D := d) hLR hM)
        hImg
        hImgLr
    _ = cst + mwf n m a b c d' hN hM := by
      exact img_max'_image_add_eq_mwf n m a b c d' cst hN hM

/--
入力/前提: 区間版パラメータ `l,r,m,a,b,c,d` と `l<r`, `m>0`。
主張: `mwfLr_iter` と `mwfLr` はともに、平行移動後の `mwf_iter` / `mwf`
  に同じ定数項 `cst` を足した形へ書ける。
内容: `n = r-l`, `q = ⌊(cl+d)/m⌋`, `d' = (cl+d) % m`, `cst = a*l + b*q`
  を導入して、実装側は定義展開、仕様側は `mwfLr_translate_eq_mwf` を使う。
証明: Euclid 除算の分解式と既存補題の合成。
役割: `mwfLr_iter_correct` から局所的な置換準備を切り離す。
-/
private lemma mwfLr_iter_translate
    (l r m a b c d : Int) (hLR : l < r) (hM : 0 < m) :
    ∃ n : Int, ∃ d' : Int, ∃ cst : Int, ∃ hN : 0 < n,
      Impl.mwfLr_iter l r m a b c d hLR hM = cst + Impl.mwf_iter n m a b c d' hN hM ∧
      mwfLr l r m a b c d hLR hM = cst + mwf n m a b c d' hN hM := by
  have hN : 0 < r - l := by
    nlinarith [hLR]
  refine ⟨r - l, Spec.zfloorMod (c * l + d) m hM,
      a * l + b * Spec.zfloorDiv (c * l + d) m hM, hN, ?_, ?_⟩
  · simp only [Impl.mwfLr_iter, Spec.zfloorDiv, Spec.zfloorMod]
  · exact mwfLr_translate_eq_mwf l r (r - l) m a b c d
      (Spec.zfloorDiv (c * l + d) m hM)
      (Spec.zfloorMod (c * l + d) m hM)
      (a * l + b * Spec.zfloorDiv (c * l + d) m hM)
      hLR hN hM rfl
      (zfloorDiv_mod_decomp (c * l + d) m hM) rfl

end Internal

/--
入力/前提: l r m a b c d : Int、hLR : l < r、hM : 0 < m。
主張: 区間版 `mwfLr_iter` は定義的な `mwfLr` と一致する。
内容: 置換・商剰余分解で `mwf_iter_correct` に還元する。
証明: 場合分け・式変形・既存補題の書き換えで示す。
役割: 区間版反復実装の正しさ保証。
-/
theorem mwfLr_iter_correct
  (l r m a b c d : Int) (hLR : l < r) (hM : 0 < m) :
    Impl.mwfLr_iter l r m a b c d hLR hM =
      mwfLr l r m a b c d hLR hM := by
  classical
  obtain ⟨n, d', cst, hN, hiter, hspec⟩ := Internal.mwfLr_iter_translate l r m a b c d hLR hM
  rw [hiter, mwf_iter_correct (N := n) (M := m) (A := a) (B := b) (C := c) (D := d') hN hM]
  exact hspec.symm

end Correctness

end

namespace Fuel

/--
目的: 燃料上界 API 用に `stepN` を `Mwf.Fuel` 配下へ再公開する。
定義: `Mwf.Fuel.Internal.stepN` への薄い別名。
入力/前提: `k : Nat`, `U : St`。
出力: 型 `St` の値を返す。
役割: 燃料関連 API を `Mwf.Fuel` に集約する公開面を提供する。
-/
abbrev stepN : Nat → Impl.St → Impl.St := Internal.stepN

/--
入力/前提: `c m k : Nat`、`hStay : ∀ i, i ≤ k → (euclidN i c m).2 ≠ 0`。
主張: `k` 回まで未停止なら `Nat.fib (k + 2) ≤ m`。
内容: `Internal.euclidN_fib_lower` を `Mwf.Fuel` API として再公開する。
証明: 既存補題の書き換えで示す。
役割: 「未停止なら fib 下界が伸びる」公開契約を明示する。
-/
theorem euclidN_fib_lower (c m k : Nat)
    (hStay : ∀ i, i ≤ k → (euclidN i c m).2 ≠ 0) :
    Nat.fib (k + 2) ≤ m := by
  simpa only [euclidN] using (Internal.euclidN_fib_lower c m k hStay)

/--
入力/前提: `c m k : Nat`、`h : m < Nat.fib (k + 2)`。
主張: `m < fib (k+2)` なら `(euclidN k c m).2 = 0`。
内容: `Internal.euclidN_c_zero_of_lt_fib` を `Mwf.Fuel` API として再公開する。
証明: 既存補題の書き換えで示す。
役割: fib 比較から「k 回以内停止」を得る公開契約を明示する。
-/
theorem euclidN_c_zero_of_lt_fib (c m k : Nat)
    (h : m < Nat.fib (k + 2)) :
    (euclidN k c m).2 = 0 := by
  simpa only [euclidN] using (Internal.euclidN_c_zero_of_lt_fib c m k h)

/--
入力/前提: `c m : Nat`、`hm : 0 < m`。
主張: `euclidTau c m ≤ stepBoundOfM m`。
内容: `Internal.euclidTau_le_stepBoundOfM` を `Mwf.Fuel` API として再公開する。
証明: 既存補題の書き換えで示す。
役割: 「採用燃料が停止時刻を上から抑える」公開契約を明示する。
-/
theorem euclidTau_le_stepBoundOfM (c m : Nat) (hm : 0 < m) :
    euclidTau c m ≤ stepBoundOfM m := by
  simpa only [euclidTau, stepBoundOfM] using (Internal.euclidTau_le_stepBoundOfM c m hm)

/--
入力/前提: `U : St`。
主張: `stepBoundOfM (Int.toNat U.m)` 回で `stepN` の `c` は 0 に到達する。
内容: `Internal.stepN_bound_c_zero` を `Mwf.Fuel` API として再公開する。
証明: 既存定理の書き換えで示す。
役割: `Mwf_iter` 側の燃料十分性を公開契約として固定する。
-/
theorem stepN_bound_c_zero (U : Impl.St) :
    (stepN (stepBoundOfM (Int.toNat U.m)) U).c = 0 := by
  simpa only [stepN, stepBoundOfM] using (Internal.stepN_bound_c_zero U)

end Fuel

/-
  floor_prod に基づく枠組み（sssec:Mwf_floor_prod）の
  Lean 側スケルトンをまとめるセクション。
-/
namespace FloorProd

/--
目的: floor_prod 反復の内部状態を保持する。
フィールド: `n,m,a,b,x,y,pre,suf` を保持する。
不変条件: 本スケルトンでは `Nat` の除算/剰余を使い、必要条件は定理側へ委譲する。
役割: `floorProd` 実装（while 反復相当）の中間状態表現。
-/
structure LoopState (α : Type _) where
  n : Nat
  m : Nat
  a : Nat
  b : Nat
  x : α
  y : α
  pre : α
  suf : α

namespace Spec

/--
目的: floor_prod の積そのものによる原義的仕様を定義する。
定義: tex の定義どおり、`y^(b/m)` に続けて
  `i = 0 .. n-1` の各ブロック `x * y^delta_i` を左から右へ掛ける。
入力/前提: `n,m,a,b : Nat`, `[Monoid α]`, 要素 `x,y`。
出力: モノイド要素を返す。
役割: 論文中の `floor_prod` 定義そのもの。
-/
def floorProdFormula {α : Type _} [Monoid α] (n m a b : Nat) (x y : α) : α :=
  if _hM0 : m = 0 then
    x ^ n
  else
    Nat.rec (motive := fun _ => α)
      (y ^ (b / m))
      (fun i acc =>
        acc * (x * y ^ (((a * (i + 1) + b) / m) - ((a * i + b) / m))))
      n

/--
目的: `floorProdFormula` の右端 1 ステップ追加を明示する。
定義: `Finset.range (n+1)` を `range n` と末尾 `n` に分解する。
入力/前提: `n,m,a,b : Nat`, `[Monoid α]`, 要素 `x,y`。
出力: `n+1` 項版を `n` 項版と末尾ブロックに分解した等式を返す。
役割: 積仕様から右端更新を直接読む基本補題。
-/
lemma floorProdFormula_succ {α : Type _} [Monoid α]
    (n m a b : Nat) (x y : α) :
    floorProdFormula (n + 1) m a b x y =
      floorProdFormula n m a b x y *
        (x * y ^ (((a * (n + 1) + b) / m) - ((a * n + b) / m))) := by
  by_cases hM0 : m = 0
  · simp [floorProdFormula, hM0, pow_succ]
  · simp [floorProdFormula, hM0]

/--
入力/前提: `0 < m`。
主張: `floorProdFormula` は `a,b` の商と剰余で正規化できる。
内容: tex の補題 `floor_prod` の正規化そのもの。
役割: `floorProd = floorProdFormula` の direct proof で、while 更新の
  `p,q` ステップを仕様側へ移す。
-/
lemma floorProdFormula_normalize {α : Type _} [Monoid α]
    (n m a b : Nat) (x y : α) (hM : 0 < m) :
    floorProdFormula n m a b x y =
      y ^ (b / m) * floorProdFormula n m (a % m) (b % m) (x * y ^ (a / m)) y := by
  have hquot :
      ∀ i : Nat,
        (a * i + b) / m = (a / m) * i + b / m + (((a % m) * i + b % m) / m) := by
    intro i
    have ha : a = m * (a / m) + a % m := (Nat.div_add_mod a m).symm
    have hb : b = m * (b / m) + b % m := (Nat.div_add_mod b m).symm
    rw [ha, hb]
    have hadiv : ((m * (a / m) + a % m) / m) = a / m := by
      simpa [Nat.add_comm, Nat.mul_comm] using
        (Nat.add_mul_div_right (a % m) (a / m) hM)
    have hbdiv : ((m * (b / m) + b % m) / m) = b / m := by
      simpa [Nat.add_comm, Nat.mul_comm] using
        (Nat.add_mul_div_right (b % m) (b / m) hM)
    have hamod : ((m * (a / m) + a % m) % m) = a % m := by
      rw [Nat.add_comm]
      calc
        (a % m + m * (a / m)) % m = (a % m) % m :=
          Nat.add_mul_mod_self_left (a % m) m (a / m)
        _ = a % m := Nat.mod_eq_of_lt (Nat.mod_lt a hM)
    have hbmod : ((m * (b / m) + b % m) % m) = b % m := by
      rw [Nat.add_comm]
      calc
        (b % m + m * (b / m)) % m = (b % m) % m :=
          Nat.add_mul_mod_self_left (b % m) m (b / m)
        _ = b % m := Nat.mod_eq_of_lt (Nat.mod_lt b hM)
    rw [hadiv, hbdiv, hamod, hbmod]
    have hexpr :
        (m * (a / m) + a % m) * i + (m * (b / m) + b % m) =
          ((a % m) * i + b % m) + m * ((a / m) * i + b / m) := by
      ring_nf
    rw [hexpr]
    have hquot_nat :
        (((a % m) * i + b % m) + m * ((a / m) * i + b / m)) / m =
          (((a % m) * i + b % m) / m) + ((a / m) * i + b / m) := by
      simpa [Nat.mul_comm] using
        (Nat.add_mul_div_right ((a % m) * i + b % m) ((a / m) * i + b / m) hM)
    rw [hquot_nat]
    ac_rfl
  induction n with
  | zero =>
      conv_lhs => unfold floorProdFormula
      simp [Nat.ne_of_gt hM]
      have hb0 : b % m / m = 0 := Nat.div_eq_of_lt (Nat.mod_lt b hM)
      simp [floorProdFormula, Nat.ne_of_gt hM, hb0]
  | succ n ih =>
      rw [floorProdFormula_succ, ih]
      rw [floorProdFormula_succ]
      have h0 := hquot n
      have h1 := hquot (n + 1)
      have hU :
          (((a % m) * n + b % m) / m) ≤ (((a % m) * (n + 1) + b % m) / m) := by
        apply Nat.div_le_div_right
        exact Nat.add_le_add_right (Nat.mul_le_mul_left _ (Nat.le_succ n)) _
      have hDelta :
          ((a * (n + 1) + b) / m) - ((a * n + b) / m) =
            a / m +
              ((((a % m) * (n + 1) + b % m) / m) - (((a % m) * n + b % m) / m)) := by
        set u0 : Nat := (((a % m) * n + b % m) / m)
        set u1 : Nat := (((a % m) * (n + 1) + b % m) / m)
        have hu : u0 ≤ u1 := by
          simp only [u0, u1]
          apply Nat.div_le_div_right
          exact Nat.add_le_add_right (Nat.mul_le_mul_left _ (Nat.le_succ n)) _
        rw [h1, h0]
        have hEq :
            (a / m) * (n + 1) + b / m + u1 =
              ((a / m) * n + b / m + u0) + (a / m + (u1 - u0)) := by
          have huEq : u1 = u0 + (u1 - u0) := by
            exact (Nat.add_sub_of_le hu).symm
          rw [Nat.mul_add, Nat.mul_one, huEq]
          omega
        rw [hEq, Nat.add_sub_cancel_left]
      rw [hDelta, pow_add]
      simp [mul_assoc]

end Spec

namespace Impl

/--
目的: floor_prod の while 反復（燃料付き）を定義する。
定義: Python 実装の更新式を `fuel` 回まで展開する。
入力/前提: `[Monoid α]`, `fuel : Nat`, `st : LoopState α`。
出力: 計算結果（モノイド要素）を返す。
役割: `floorProd` の本体（停止性は `fuel` で制御）。
-/
def floorProdLoop {α : Type _} [Monoid α] : Nat → LoopState α → α
  | 0, st => st.pre * (st.x ^ st.n) * st.suf
  | fuel + 1, st =>
      let p := st.a / st.m
      let a' := st.a % st.m
      let x' := st.x * (st.y ^ p)
      let q := st.b / st.m
      let b' := st.b % st.m
      let pre' := st.pre * (st.y ^ q)
      let c' := (a' * st.n + b') / st.m
      if c' = 0 then
        pre' * (x' ^ st.n) * st.suf
      else
        let d := ((st.m * c' - b' - 1) / a') + 1
        let suf' := st.y * (x' ^ (st.n - d)) * st.suf
        let st' : LoopState α :=
          { n := c' - 1
            m := a'
            a := st.m
            b := st.m - b' - 1 + a'
            x := st.y
            y := x'
            pre := pre'
            suf := suf' }
        floorProdLoop fuel st'

/--
目的: `LoopState` を入力に floor_prod 反復を十分な回数だけ実行する。
定義: `fuel := Fuel.stepBoundOfM st.m` を選び、`floorProdLoop fuel st` を返す。
入力/前提: `[Monoid α]`, `st : LoopState α`。
出力: floor_prod の計算結果を返す。
役割: 状態入力版の実装エントリとして `floorProd` 本体から利用する。
正当性: `Correctness.floorProd_correct` の内部状態版として使う。
-/
def floorProdSt {α : Type _} [Monoid α] : LoopState α → α
  | st => floorProdLoop (Fuel.stepBoundOfM st.m) st

/--
目的: floor_prod 実装エントリを定義する。
定義: `sssec:Mwf_floor_prod` の while 更新式を `floorProdLoop` で実行する。
入力/前提: `n,m,a,b : Nat`, `[Monoid α]`, 要素 `x,y`。
出力: floor_prod の計算結果を返す。
役割: floor_prod の実装本体（`floorProd_correct` の左辺）。
正当性: `Correctness.floorProd_correct` で仕様 `Spec.floorProdFormula` との一致を示す。
-/
def floorProd {α : Type _} [Monoid α] (n m a b : Nat) (x y : α) : α :=
  let st : LoopState α :=
    { n := n, m := m, a := a, b := b, x := x, y := y, pre := 1, suf := 1 }
  floorProdSt st

end Impl

namespace Fuel

/--
入力/前提: a m : Nat。
主張: `stepBoundOfM m` 回の Euclid 反復で第2成分は 0 になる。
内容: `m>0` では `euclidTau ≤ stepBoundOfM` と `euclidTau_le_iff_c_zero` を使い、
     `m=0` は自明に処理する。
証明: 場合分けと既存停止時刻補題の合成で示す。
役割: floor_prod の fuel 十分性（`a,m` 縮約側）の中核補題。
-/
lemma euclidN_second_zero_stepBoundOfM (a m : Nat) :
    (Fuel.euclidN (Fuel.stepBoundOfM m) a m).2 = 0 := by
  by_cases hm : 0 < m
  · simpa using
      Fuel.Internal.euclidN_c_zero_of_tau_le a m (Fuel.stepBoundOfM m)
        (Fuel.euclidTau_le_stepBoundOfM a m hm)
  · simpa [Nat.eq_zero_of_not_pos hm] using
      (Fuel.Internal.euclidN_c_zero_of_le a 0 (Fuel.stepBoundOfM 0) (Nat.zero_le _))

end Fuel

namespace Internal

/--
入力/前提: n m a b : Nat、hM : 0 < m、ha : a % m = 0。
主張: `a' = a % m` が 0 なら `c' = floor((a' * n + b')/m)` は 0。
内容: `b' = b % m < m` を使って除算値 0 を示す。
証明: 式変形と `Nat.div_eq_of_lt` で示す。
役割: floor_prod ループの停止判定 `c' = 0` の直接トリガー補題。
-/
private lemma floorProd_cprime_zero_of_aModZero
    (n m a b : Nat) (hM : 0 < m) (ha : a % m = 0) :
    ((a % m) * n + (b % m)) / m = 0 := by
  rw [ha, zero_mul, zero_add]
  exact Nat.div_eq_of_lt (Nat.mod_lt b hM)

end Internal

namespace Fuel

/--
入力/前提: st : LoopState α。
主張: `stepBoundOfM st.m` は `a,m` の Euclid 縮約を 0 余りまで到達させる。
内容: `euclidN_second_zero_stepBoundOfM` の状態版。
証明: 既存補題の直接適用。
役割: `floorProd` に `stepBoundOfM m` を使ってよい根拠（縮約回数側）。
-/
theorem floorProdLoop_fuel_sufficient
    {α : Type _} [Monoid α] (st : LoopState α) :
    (Fuel.euclidN (Fuel.stepBoundOfM st.m) st.a st.m).2 = 0 := by
  simpa using Fuel.euclidN_second_zero_stepBoundOfM st.a st.m

end Fuel

namespace Internal

/--
入力/前提: `m ≤ y` かつ `m > 0`。
主張: `0 < y / m`。
内容: 商が 0 でないことを取り出す自然数除算の基本補題。
証明: `y / m = 0` と仮定して `m ≤ y` に反することを示す。
役割: `floorProd_exponent_bridge` で指数の正性を得る。
-/
private lemma floorProd_div_pos_of_ge
    (y m : Nat) (hM : 0 < m) (hY : m ≤ y) :
    0 < y / m := by
  by_contra hc0
  have hdiv0 : y / m = 0 := Nat.eq_zero_of_not_pos hc0
  rcases (Nat.div_eq_zero_iff.mp hdiv0) with hm0 | hy_lt
  · exact False.elim ((Nat.ne_of_gt hM) hm0)
  · exact (Nat.not_le_of_lt hy_lt) hY

/--
入力/前提: `a > 0`。
主張: `k = r / a` とおくと `k * a ≤ r ≤ k * a + a - 1`。
内容: 商と余りの標準的な境界評価。
証明: `Nat.div_eq_iff` をそのまま使う。
役割: `floorProd_pred_div_eq` の前半境界を与える。
-/
private lemma floorProd_div_bounds
    (r a : Nat) (hApos : 0 < a) :
    let k := r / a
    k * a ≤ r ∧ r ≤ k * a + a - 1 := by
  simpa only [Nat.mul_comm] using (Nat.div_eq_iff hApos).1 rfl

/--
入力/前提: `x = a * n - r`、`0 < x`、`k * a ≤ r`。
主張: `k < n`。
内容: `r` の下界と `x` の正性から商 index が範囲内に入ることを示す。
証明: `r < a * n` を経由して `k * a < n * a` に持ち込む。
役割: `floorProd_pred_div_eq` で `n - k - 1` を正しく扱う前提に使う。
-/
private lemma floorProd_div_index_lt
    (n a k r x : Nat) (_hApos : 0 < a) (hx_pos : 0 < x)
    (hxr : x = a * n - r) (hk_lo : k * a ≤ r) :
    k < n := by
  have hr_lt_an : r < a * n := by
    have : 0 < a * n - r := by simpa only [hxr] using hx_pos
    exact Nat.sub_pos_iff_lt.mp this
  exact Nat.lt_of_mul_lt_mul_right <|
    lt_of_le_of_lt hk_lo (by simpa only [Nat.mul_comm] using hr_lt_an)

/--
入力/前提: `x = a * n - r`、`0 < x`、`k * a ≤ r ≤ k * a + a - 1`。
主張: `(x - 1) / a = n - k - 1`。
内容: `floorProd` の指数差を 1 回の除算式に橋渡しする等式。
証明: 商余り境界を使って `x - 1` の商を直接計算する。
役割: `floorProd_exponent_bridge` の中核変形。
-/
private lemma floorProd_pred_div_eq
    (n a k r x : Nat) (hApos : 0 < a) (hx_pos : 0 < x)
    (hxr : x = a * n - r) (hk_lo : k * a ≤ r) (hk_hi : r ≤ k * a + a - 1) :
    (x - 1) / a = n - k - 1 := by
  have hk_lt_n : k < n := floorProd_div_index_lt n a k r x hApos hx_pos hxr hk_lo
  apply (Nat.div_eq_iff hApos).2
  constructor
  · have hk_hi_lt : r < (k + 1) * a := by
      have hpred_lt : k * a + a - 1 < k * a + a := by
        exact Nat.sub_lt (Nat.add_pos_right _ hApos) (Nat.succ_pos 0)
      have : r < k * a + a := lt_of_le_of_lt hk_hi hpred_lt
      simpa only [Nat.succ_mul, Nat.add_comm, Nat.add_left_comm, Nat.add_assoc] using this
    have hr_lt_an : r < a * n := by
      have : 0 < a * n - r := by simpa only [hxr] using hx_pos
      exact Nat.sub_pos_iff_lt.mp this
    have hsub_lt : a * n - ((k + 1) * a) < a * n - r :=
      Nat.sub_lt_sub_left hr_lt_an hk_hi_lt
    have hsub_id : n - (k + 1) = n - k - 1 := by omega
    have hleft_eq : a * n - ((k + 1) * a) = (n - k - 1) * a := by
      calc
        a * n - ((k + 1) * a) = (n - (k + 1)) * a := by
          simpa only [Nat.mul_comm] using (Nat.sub_mul n (k + 1) a).symm
        _ = (n - k - 1) * a := by simp only [hsub_id]
    have hx_gt : (n - k - 1) * a < x := by
      calc
        (n - k - 1) * a = a * n - ((k + 1) * a) := hleft_eq.symm
        _ < a * n - r := hsub_lt
        _ = x := by simp only [hxr]
    exact Nat.le_pred_of_lt hx_gt
  · have hx_le : x ≤ (n - k) * a := by
      have hsub_le : a * n - r ≤ a * n - (k * a) := Nat.sub_le_sub_left hk_lo (a * n)
      have hright_eq : a * n - (k * a) = (n - k) * a := by
        simpa only [Nat.mul_comm] using (Nat.sub_mul n k a).symm
      calc
        x = a * n - r := hxr
        _ ≤ a * n - (k * a) := hsub_le
        _ = (n - k) * a := hright_eq
    have ht_lt_x : x - 1 < x := by
      exact Nat.sub_lt hx_pos (Nat.succ_pos 0)
    have ht_lt : x - 1 < (n - k) * a := lt_of_lt_of_le ht_lt_x hx_le
    have hmul_succ : (n - k) * a = (n - k - 1) * a + a := by
      have hnk_pos : 0 < n - k := Nat.sub_pos_of_lt hk_lt_n
      have hnk_eq : n - k = Nat.succ (n - k - 1) := by
        simpa only [Nat.succ_eq_add_one, Nat.pred_eq_sub_one] using
          (Nat.succ_pred_eq_of_pos hnk_pos).symm
      rw [hnk_eq]
      simp only [Nat.succ_eq_add_one, Nat.succ_mul, Nat.mul_comm, add_tsub_cancel_right]
    have ht_lt' : x - 1 < (n - k - 1) * a + a := by
      simpa only [hmul_succ] using ht_lt
    exact Nat.le_pred_of_lt ht_lt'

/--
入力/前提: `m>0`, `0<a<m`, `0≤b<m`, `m ≤ a*n+b`。
主張: floor_prod の while 更新で使う指数 `n-d` は仕様側の `⌊(yMax mod m)/a⌋` と一致。
内容: 実装側 `suf` 更新式と仕様側第2分岐の指数を同一視する橋渡し補題。
証明: `y=a*n+b`, `c=y/m`, `r=y%m`, `k=r/a` とおき、商剰余分解と不等式比較で `n-d=k` を導く。
役割: `floorProdLoop_spec_invariant` の `c'≠0` 分岐を閉じる算術コア。
-/
private lemma floorProd_exponent_bridge
    (n m a b : Nat)
    (hM : 0 < m) (_hA : a < m) (hB : b < m) (hApos : 0 < a)
    (hY : m ≤ a * n + b) :
    let c := (a * n + b) / m
    let d := ((m * c - b - 1) / a) + 1
    n - d = ((a * n + b) % m) / a := by
  set y : Nat := a * n + b
  set c : Nat := y / m
  set r : Nat := y % m
  set k : Nat := r / a
  set x : Nat := m * c - b
  set t : Nat := x - 1
  have hy : m * c + r = y := by
    subst c r
    simpa only [Nat.add_comm] using (Nat.mod_add_div y m)
  have hc_pos : 0 < c := by
    simpa only [c, y] using
      FloorProd.Internal.floorProd_div_pos_of_ge y m hM (by simpa only [y] using hY)
  have hb_mc : b < m * c := by
    have hm_le_mc : m ≤ m * c := by
      calc
        m = m * 1 := by simp only [mul_one]
        _ ≤ m * c := Nat.mul_le_mul_left _ (Nat.succ_le_of_lt hc_pos)
    exact lt_of_lt_of_le hB hm_le_mc
  have hx_pos : 0 < x := by
    simpa only [tsub_pos_iff_lt, x] using (Nat.sub_pos_of_lt hb_mc)
  have hmc_sub : x = a * n - r := by
    unfold x
    omega
  have hk_bounds : k * a ≤ r ∧ r ≤ k * a + a - 1 := by
    simpa only [k] using floorProd_div_bounds r a hApos
  rcases hk_bounds with ⟨hk_lo, hk_hi⟩
  have hk_lt_n : k < n := floorProd_div_index_lt n a k r x hApos hx_pos hmc_sub hk_lo
  have hq : t / a = n - k - 1 := by
    simpa only [t] using floorProd_pred_div_eq n a k r x hApos hx_pos hmc_sub hk_lo hk_hi
  have hq' : (m * c - b - 1) / a = n - k - 1 := by
    simpa only using hq
  have hd : ((m * c - b - 1) / a) + 1 = n - k := by
    rw [hq']
    omega
  calc
    n - (((m * c - b - 1) / a) + 1)
        = n - (n - k) := by simp only [hd]
    _ = k := Nat.sub_sub_self (Nat.le_of_lt hk_lt_n)
    _ = ((a * n + b) % m) / a := by simp only [k, r, y]

/--
入力/前提: `((a % m) * n + (b % m)) / m ≠ 0`。
主張: `0 < a % m`。
内容: 再帰分岐では次の傾きが正になることを示す。
証明: `a % m = 0` なら商が 0 になる補題の対偶を使う。
役割: `floorProdLoop_spec_invariant_step_case` の再帰前提を供給する。
-/
private lemma floorProd_aMod_pos_of_cprime_ne_zero
    (n m a b : Nat) (hM : 0 < m)
    (hc0 : ((a % m) * n + (b % m)) / m ≠ 0) :
    0 < a % m := by
  by_contra hNotPos
  have ha0 : a % m = 0 := Nat.eq_zero_of_not_pos hNotPos
  exact hc0 (floorProd_cprime_zero_of_aModZero n m a b hM ha0)

/--
入力/前提: `c' = (a * n + b) / m ≠ 0`。
主張: `m ≤ a * n + b`。
内容: 再帰分岐では高さが少なくとも 1 回は `m` を跨ぐ。
証明: `a * n + b < m` なら商が 0 になることの対偶を使う。
役割: `floorProdLoop_spec_invariant_step_case` で指数を橋渡しする。
-/
private lemma floorProd_yMax_ge_of_cprime_ne_zero
    (n m a b : Nat) (_hM : 0 < m) (hc0 : (a * n + b) / m ≠ 0) :
    m ≤ a * n + b := by
  exact Nat.le_of_not_gt (fun hlt => hc0 (Nat.div_eq_of_lt hlt))

/--
入力/前提: `((st.a % st.m) * st.n + (st.b % st.m)) / st.m ≠ 0`。
主張: 再帰分岐で使う正規化済み係数 `a' = st.a % st.m`, `b' = st.b % st.m`
  は `a' < st.m`, `b' < st.m`, `0 < a'`, `st.m ≤ a' * st.n + b'` を満たす。
内容: `mod_lt` と、`c' ≠ 0` から従う既存補題をまとめたパッケージ。
証明: 各成分を既存補題から順に構成する。
役割: `floorProdLoop_spec_invariant_step_case` の冒頭の前提生成をまとめる。
-/
private lemma floorProd_step_bounds_of_cprime_ne_zero
    {α : Type _} [Monoid α]
    (st : LoopState α) (hM : 0 < st.m)
    (hc0 : ((st.a % st.m) * st.n + (st.b % st.m)) / st.m ≠ 0) :
    st.a % st.m < st.m
      ∧ st.b % st.m < st.m
      ∧ 0 < st.a % st.m
      ∧ st.m ≤ (st.a % st.m) * st.n + st.b % st.m := by
  refine ⟨Nat.mod_lt st.a hM, Nat.mod_lt st.b hM, ?_, ?_⟩
  · exact floorProd_aMod_pos_of_cprime_ne_zero st.n st.m st.a st.b hM hc0
  · exact floorProd_yMax_ge_of_cprime_ne_zero st.n st.m (st.a % st.m) (st.b % st.m) hM hc0

/--
入力/前提: `Fuel.euclidN (fuel + 1) a m` が停止している。
主張: 1 段進んだ後の Euclid 問題 `Fuel.euclidN fuel m (a % m)` も停止している。
内容: Euclid 側の fuel 条件を再帰先へ 1 ステップ移す補題。
証明: `Fuel.Internal.euclidN_succ` を `simp` で展開する。
役割: `floorProdLoop_spec_invariant_step_case` で帰納法を適用する前提に使う。
-/
private lemma floorProd_fuel_tail
    (fuel a m : Nat) (hM : 0 < m)
    (hFuel : (Fuel.euclidN (fuel + 1) a m).2 = 0) :
    (Fuel.euclidN fuel m (a % m)).2 = 0 := by
  simpa only [Fuel.Internal.euclidN_succ, Fuel.Internal.euclid_step, Nat.ne_of_gt hM,
    ↓reduceDIte] using hFuel

/--
入力/前提: `q = st.b / st.m`, `x' = st.x * st.y ^ (st.a / st.m)` と停止判定 `c' = 0`。
主張: `floorProdLoop (fuel + 1)` の実装側は停止枝の形
  `(st.pre * st.y ^ q) * x' ^ st.n * st.suf` に一致する。
内容: ループ本体を 1 回展開して停止枝を読む。
証明: 定義展開と `simp` による。
役割: `floorProdLoop_spec_invariant_stop_case` の実装側整理を分離する。
-/
private lemma floorProdLoop_stop_main
    {α : Type _} [Monoid α]
    (fuel : Nat) (st : LoopState α)
    (q : Nat) (x' : α)
    (hq : q = st.b / st.m) (hx' : x' = st.x * st.y ^ (st.a / st.m))
    (hc0 : ((st.a % st.m) * st.n + (st.b % st.m)) / st.m = 0) :
    Impl.floorProdLoop (fuel + 1) st = (st.pre * st.y ^ q) * x' ^ st.n * st.suf := by
  subst q x'
  simp only [Impl.floorProdLoop, hc0, ↓reduceIte]

/--
入力/前提: `c' = 0`。
主張: 実装 `floorProdLoop (fuel + 1)` は停止枝の閉形式
  `(st.pre * st.y ^ (st.b / st.m)) * (st.x * st.y ^ (st.a / st.m)) ^ st.n * st.suf`
  に一致する。
内容: `floorProdLoop_stop_main` の特殊化版。
証明: 既存 helper の直接適用。
役割: `floorProdLoop_spec_invariant_stop_case` から局所 `set` を除く。
-/
private lemma floorProdLoop_stop_of_cprime_zero
    {α : Type _} [Monoid α]
    (fuel : Nat) (st : LoopState α)
    (hc0 : ((st.a % st.m) * st.n + (st.b % st.m)) / st.m = 0) :
    Impl.floorProdLoop (fuel + 1) st =
      (st.pre * st.y ^ (st.b / st.m)) * (st.x * st.y ^ (st.a / st.m)) ^ st.n * st.suf := by
  exact floorProdLoop_stop_main fuel st (st.b / st.m) (st.x * st.y ^ (st.a / st.m)) rfl rfl hc0

/--
目的: `best` が有効なときに束ねて保持する情報を定義する。
フィールド: `best, dx, arg`。
不変条件: `dx` は `X` 個数、`arg` は最大達成の最小添字を表す。
役割: `MwfElem.info?` の `some` 側のペイロード。
-/
private structure BestInfo where
  best : Int
  dx : Nat
  arg : Nat
deriving Repr, DecidableEq

/--
目的: floor_prod で `Mwf` の最大値と最小 argmax を運ぶデータを定義する。
フィールド: `sum, info?`。
不変条件: `info? = none` は `best/dx/arg` が無効（未定義）であることを表す。
役割: sssec:Mwf_floor_prod の `MwfElem` を Lean 化。
-/
private structure mwfElem where
  sum : Int
  info? : Option BestInfo := none
deriving Repr, DecidableEq

/--
目的: `MwfElem` の単位元を定義する。
定義: `sum=0, info?=none`。
入力/前提: なし。
出力: 型 `MwfElem` の値を返す。
役割: `MwfElem` モノイドの単位元。
-/
private def MwfElemOne : mwfElem :=
  { sum := 0, info? := none }

/--
目的: `MwfElem` の積（連結合成）を定義する。
定義: Python 実装の `__mul__` 更新式をそのまま移植する。
入力/前提: `lhs rhs : MwfElem`。
出力: 型 `MwfElem` の値を返す。
役割: floor_prod で prefix 最大と最小 argmax を合成する核。
-/
private def mwfElemMul (lhs rhs : mwfElem) : mwfElem :=
  let ssum := lhs.sum + rhs.sum
  match lhs.info?, rhs.info? with
  | none, none =>
      { sum := ssum, info? := none }
  | some l, none =>
      { sum := ssum, info? := some l }
  | none, some r =>
      { sum := ssum
        info? := some { best := lhs.sum + r.best, dx := r.dx, arg := r.arg } }
  | some l, some r =>
      let sdx := l.dx + r.dx
      let candL := l.best
      let candR := lhs.sum + r.best
      if candL >= candR then
        { sum := ssum, info? := some { best := candL, dx := sdx, arg := l.arg } }
      else
        { sum := ssum, info? := some { best := candR, dx := sdx, arg := l.dx + r.arg } }

/--
目的: `mwfElem` の単位元インスタンス。
定義: `1` を `MwfElemOne` として解釈する。
役割: `pow` と monoid 構造の基礎に使う。
-/
instance : One mwfElem := ⟨MwfElemOne⟩

/--
目的: `mwfElem` の積インスタンス。
定義: `(*)` を `mwfElemMul` として解釈する。
役割: `floorProd` の積構造を Lean の演算子で扱えるようにする。
-/
instance : Mul mwfElem := ⟨mwfElemMul⟩

/--
入力/前提: `u : MwfElem`。
主張: `1 * u = u`。
内容: `MwfElem` の左単位律。
証明: `u` と内部 `info?` を場合分けし、`mwfElemMul` の定義展開を `simp` で閉じる。
役割: `MwfElem` モノイド公理の一部。
-/
private theorem MwfElem_one_mul (u : mwfElem) : 1 * u = u := by
  rcases u with ⟨s, info⟩
  cases info with
  | none =>
      simpa using
        (by
          simp [mwfElemMul, MwfElemOne] :
            mwfElemMul MwfElemOne { sum := s, info? := none } =
              { sum := s, info? := none })
  | some info =>
      simpa using
        (by
          simp [mwfElemMul, MwfElemOne] :
            mwfElemMul MwfElemOne { sum := s, info? := some info } =
              { sum := s, info? := some info })

/--
入力/前提: `u : MwfElem`。
主張: `u * 1 = u`。
内容: `MwfElem` の右単位律。
証明: `u` と内部 `info?` を場合分けし、`mwfElemMul` の定義展開を `simp` で閉じる。
役割: `MwfElem` モノイド公理の一部。
-/
private theorem MwfElem_mul_one (u : mwfElem) : u * 1 = u := by
  rcases u with ⟨s, info⟩
  cases info with
  | none =>
      simpa using
        (by
          simp [mwfElemMul, MwfElemOne] :
            mwfElemMul { sum := s, info? := none } MwfElemOne =
              { sum := s, info? := none })
  | some info =>
      simpa using
        (by
          simp [mwfElemMul, MwfElemOne] :
            mwfElemMul { sum := s, info? := some info } MwfElemOne =
              { sum := s, info? := some info })

/--
目的: 2 つの score 候補から大きい方を選ぶ。
定義: 第 1 成分 `best` を比較し、優位な組を返す。
入力/前提: `p q : Int × Nat`。
出力: より良い score を表す組。
役割: `mwfElemMul` の `info?` 更新を抽象化する。
-/
private def MwfChooseScore (p q : Int × Nat) : Int × Nat :=
  if p.1 < q.1 then q else p

/--
入力/前提: 2 つの score 候補 `p q` と `q.1 ≤ p.1`。
主張: `MwfChooseScore p q` は左候補 `p` を返す。
内容: 第 1 成分の比較で左が右以上なら左が採用される。
証明: 定義展開後、`p.1 < q.1` が矛盾することを示す。
役割: `mwfElem` 冪補題で比較分岐を直接展開せずに済ませる。
-/
private lemma MwfChooseScore_eq_left {p q : Int × Nat} (h : q.1 ≤ p.1) :
    MwfChooseScore p q = p := by
  simp [MwfChooseScore, not_lt_of_ge h]

/--
入力/前提: 2 つの score 候補 `p q` と `p.1 < q.1`。
主張: `MwfChooseScore p q` は右候補 `q` を返す。
内容: 第 1 成分の比較で右が左より大きければ右が採用される。
証明: 定義展開して比較条件をそのまま適用する。
役割: `mwfElem` 冪補題で比較分岐を直接展開せずに済ませる。
-/
private lemma MwfChooseScore_eq_right {p q : Int × Nat} (h : p.1 < q.1) :
    MwfChooseScore p q = q := by
  simp [MwfChooseScore, h]

/--
目的: score に prefix 和と位置ずれを加える。
定義: 第 1 成分に `s`、第 2 成分に `k` を足す。
入力/前提: シフト量 `s k` と score `p`。
出力: シフト後の score。
役割: 右側要素を左側 sum 分だけ平行移動する。
-/
private def MwfShiftScore (s : Int) (k : Nat) (p : Int × Nat) : Int × Nat :=
  (s + p.1, k + p.2)

/--
目的: `BestInfo` を score 表現へ写す。
定義: `(best, arg)` の組を取り出す。
入力/前提: `BestInfo`。
出力: 比較用の score。
役割: `MwfChooseScore` と `MwfShiftScore` の入力に合わせる。
-/
private def MwfInfoScore (i : BestInfo) : Int × Nat :=
  (i.best, i.arg)

/--
目的: score から `BestInfo` を再構成する。
定義: 固定した `dx` と score の 2 成分を束ねる。
入力/前提: 区間長 `dx` と score `sc`。
出力: 対応する `BestInfo`。
役割: `mwfElemMul` の更新結果を `BestInfo` に戻す。
-/
private def MwfMkInfoFromScore (dx : Nat) (sc : Int × Nat) : BestInfo :=
  { best := sc.1, dx := dx, arg := sc.2 }

/--
入力/前提: 3 つの score 候補。
主張: `MwfChooseScore` は結合的。
内容: 最大 score を選ぶ演算としての結合律。
証明: 定義展開と整数比較の分岐を `omega` で整理する。
役割: `MwfElemMul_assoc_info` の `some/some/some` 枝で score の結合を揃える。
-/
private lemma MwfChooseScore_assoc (a b c : Int × Nat) :
    MwfChooseScore (MwfChooseScore a b) c = MwfChooseScore a (MwfChooseScore b c) := by
  unfold MwfChooseScore
  split_ifs <;> simp_all
  all_goals omega

/--
入力/前提: シフト量 `s k` と 2 つの score 候補。
主張: score の選択とシフトは可換。
内容: 大小比較は両辺へ同じシフトを足しても保たれる。
証明: 定義展開後の比較を `omega` で処理する。
役割: `MwfElemMul` の結合律で右側候補を並べ替える。
-/
private lemma MwfChooseScore_shift (s : Int) (k : Nat) (p q : Int × Nat) :
    MwfShiftScore s k (MwfChooseScore p q) =
      MwfChooseScore (MwfShiftScore s k p) (MwfShiftScore s k q) := by
  unfold MwfChooseScore MwfShiftScore
  split_ifs <;> simp_all
  all_goals omega

/--
入力/前提: 2 段のシフト量と score `p`。
主張: `MwfShiftScore` の 2 回適用は 1 回の合成シフトに等しい。
内容: prefix 和と位置ずれの平行移動の合成則。
証明: 成分ごとに足し算を整理する。
役割: `MwfElemMul` の結合律でシフトの入れ子を潰す。
-/
private lemma MwfShiftScore_comp (s1 s2 : Int) (k1 k2 : Nat) (p : Int × Nat) :
    MwfShiftScore s1 k1 (MwfShiftScore s2 k2 p) =
      MwfShiftScore (s1 + s2) (k1 + k2) p := by
  simp only [MwfShiftScore, Prod.mk.injEq]
  omega

/--
入力/前提: 左シフト `(s1, k1)`、追加シフト `(s2, k2)`、2 つの score `p q`。
主張: 左側候補を平行移動して比較する操作は、右側候補の追加シフトを吸収したうえで
 先に `MwfChooseScore` を取り、最後に左シフトする形へまとめられる。
内容: `MwfShiftScore_comp` と `MwfChooseScore_shift` の合成版。
証明: 右側候補の 2 段シフトを 1 回にまとめ、選択とシフトの可換性を適用する。
役割: `MwfElemMul_assoc_info` の `none/some/some` 枝で score 計算を圧縮する。
-/
private lemma MwfChooseScore_shift_comp
    (s1 s2 : Int) (k1 k2 : Nat) (p q : Int × Nat) :
    MwfChooseScore (MwfShiftScore s1 k1 p) (MwfShiftScore (s1 + s2) (k1 + k2) q) =
      MwfShiftScore s1 k1 (MwfChooseScore p (MwfShiftScore s2 k2 q)) := by
  rw [← MwfShiftScore_comp s1 s2 k1 k2 q]
  simpa using (MwfChooseScore_shift s1 k1 p (MwfShiftScore s2 k2 q)).symm

/--
入力/前提: `info? = some` の 2 要素。
主張: `mwfElemMul` の結果は `MwfChooseScore` と `MwfShiftScore` で書ける。
内容: `info` 付き同士の積の explicit formula。
証明: `mwfElemMul` を展開し、大小比較の 2 分岐を整理する。
役割: 各 associativity 補題の共通部品になる。
-/
private lemma MwfElemMul_some_some
    (s1 s2 : Int) (l r : BestInfo) :
    mwfElemMul { sum := s1, info? := some l } { sum := s2, info? := some r } =
      { sum := s1 + s2
        info? := some (MwfMkInfoFromScore (l.dx + r.dx)
          (MwfChooseScore (MwfInfoScore l) (MwfShiftScore s1 l.dx (MwfInfoScore r)))) } := by
  unfold mwfElemMul MwfChooseScore MwfShiftScore MwfInfoScore MwfMkInfoFromScore
  by_cases hlt : l.best < s1 + r.best
  · have hgeFalse : ¬ l.best ≥ s1 + r.best := by omega
    simp only [hlt, hgeFalse, ↓reduceIte]
  · have hge : l.best ≥ s1 + r.best := le_of_not_gt hlt
    simp only [hlt, hge, ↓reduceIte]

/--
入力/前提: 左要素は `info? = none`、右要素は `info? = some r`。
主張: `mwfElemMul` の結果は `r` を左シフトした `some` 情報を持つ。
内容: 片側だけ情報を持つ積の explicit formula。
証明: `mwfElemMul` を定義展開して `simp` で示す。
役割: `MwfElemMul_assoc_info` で片側だけ `some` を持つ内側積を展開する。
-/
private lemma MwfElemMul_none_some
    (s1 s2 : Int) (r : BestInfo) :
    mwfElemMul { sum := s1 } { sum := s2, info? := some r } =
      { sum := s1 + s2
        info? := some (MwfMkInfoFromScore r.dx (MwfShiftScore s1 0 (MwfInfoScore r))) } := by
  simp only [mwfElemMul, MwfMkInfoFromScore, MwfShiftScore, MwfInfoScore, zero_add]

/--
入力/前提: 左要素は `info? = some l`、右要素は `info? = none`。
主張: `mwfElemMul` の結果は情報 `l` を保ったまま和だけが加算される。
内容: 片側だけ情報を持つ積のもう一方の explicit formula。
証明: `mwfElemMul` を定義展開して `simp` で示す。
役割: `MwfElemMul_assoc_info` で右側が `none` の内側積を展開する。
-/
private lemma MwfElemMul_some_none
    (s1 s2 : Int) (l : BestInfo) :
    mwfElemMul { sum := s1, info? := some l } { sum := s2 } =
      { sum := s1 + s2, info? := some l } := by
  simp only [mwfElemMul]

/--
入力/前提: 両方とも `info? = none` の `MwfElem`。
主張: その積は和だけを足し、`info? = none` を保つ。
内容: `none/none` ケースの explicit formula。
証明: `mwfElemMul` を定義展開して `simp` で示す。
役割: trivial な associativity 分岐と `mwfElem` 冪計算を簡潔化する。
-/
private lemma MwfElemMul_none_none
    (s1 s2 : Int) :
    mwfElemMul { sum := s1 } { sum := s2 } = { sum := s1 + s2 } := by
  simp only [mwfElemMul]

/--
入力/前提: 3 要素の `sum` とそれぞれの `info?`。
主張: `info?` の 8 通りすべてで `mwfElemMul` は結合的。
内容: `MwfElem_mul_assoc` 用の場合分けを 1 か所に集約する。
証明: `Option BestInfo` の 8 通りを直接処理し、`MwfElemMul_*` の explicit formula と
  shift/score 補題で各枝を同一化する。
役割: 本体の `cases` と単発 helper を増やさずに associativity を支える。
-/
private lemma MwfElemMul_assoc_info
    (su sv sw : Int) :
    ∀ iu iv iw : Option BestInfo,
      mwfElemMul (mwfElemMul { sum := su, info? := iu } { sum := sv, info? := iv })
          { sum := sw, info? := iw } =
        mwfElemMul { sum := su, info? := iu }
          (mwfElemMul { sum := sv, info? := iv } { sum := sw, info? := iw })
  | none, none, none => by
      repeat rw [MwfElemMul_none_none]
      simp only [mwfElem.mk.injEq, and_true]
      omega
  | none, none, some w => by
      rw [MwfElemMul_none_none]
      repeat rw [MwfElemMul_none_some]
      simp [add_assoc, MwfMkInfoFromScore, MwfInfoScore, MwfShiftScore_comp]
  | none, some v, none => by
      rw [MwfElemMul_none_some su sv v]
      repeat rw [MwfElemMul_some_none]
      rw [MwfElemMul_none_some]
      simp [add_assoc, MwfMkInfoFromScore, MwfInfoScore]
  | none, some v, some w => by
      rw [MwfElemMul_none_some su sv v, MwfElemMul_some_some sv sw v w]
      repeat rw [MwfElemMul_some_some]
      simp only [MwfMkInfoFromScore, MwfInfoScore, Prod.mk.eta, mwfElemMul,
        mwfElem.mk.injEq, Option.some.injEq, BestInfo.mk.injEq, true_and]
      have hmain :
          MwfChooseScore (MwfShiftScore su 0 (MwfInfoScore v))
            (MwfShiftScore (su + sv) v.dx (MwfInfoScore w))
          = MwfShiftScore su 0
              (MwfChooseScore (MwfInfoScore v)
                (MwfShiftScore sv v.dx (MwfInfoScore w))) := by
        simpa only [zero_add] using
          MwfChooseScore_shift_comp su sv 0 v.dx (MwfInfoScore v) (MwfInfoScore w)
      refine ⟨by omega, ?_, ?_⟩
      · exact congrArg Prod.fst hmain
      · simpa only [MwfShiftScore, zero_add] using congrArg Prod.snd hmain
  | some u, none, none => by
      rw [MwfElemMul_some_none su sv u]
      rw [MwfElemMul_none_none]
      repeat rw [MwfElemMul_some_none]
      simp [add_assoc]
  | some u, none, some w => by
      rw [MwfElemMul_some_none su sv u, MwfElemMul_none_some sv sw w]
      repeat rw [MwfElemMul_some_some]
      simp only [MwfMkInfoFromScore, MwfInfoScore, Prod.mk.eta, MwfShiftScore_comp,
        add_zero, mwfElem.mk.injEq, and_true]
      omega
  | some u, some v, none => by
      rw [MwfElemMul_some_some su sv u v, MwfElemMul_some_none sv sw v]
      repeat rw [MwfElemMul_some_some]
      simp only [mwfElemMul, MwfMkInfoFromScore, MwfInfoScore, mwfElem.mk.injEq,
        and_true]
      omega
  | some u, some v, some w => by
      rw [MwfElemMul_some_some su sv u v, MwfElemMul_some_some sv sw v w]
      repeat rw [MwfElemMul_some_some]
      simp only [MwfMkInfoFromScore, MwfInfoScore, Prod.mk.eta, MwfChooseScore_assoc,
        MwfChooseScore_shift, MwfShiftScore_comp, mwfElem.mk.injEq,
        Option.some.injEq, BestInfo.mk.injEq, and_true, true_and]
      omega

/--
入力/前提: `u v w : MwfElem`。
主張: `MwfElemMul` は結合的。
内容: `MwfElem` をモノイドに昇格する主要補題。
証明: `u,v,w` と `info?` の全場合分け後、補助補題と `omega` で各枝を同一化する。
役割: `floorProd` を `MwfElem` に適用する前提。
-/
private theorem MwfElem_mul_assoc (u v w : mwfElem) :
    (u * v) * w = u * (v * w) := by
  rcases u with ⟨su, iu⟩
  rcases v with ⟨sv, iv⟩
  rcases w with ⟨sw, iw⟩
  simpa using MwfElemMul_assoc_info su sv sw iu iv iw

/--
目的: `mwfElem` に monoid 構造を入れる。
定義: 単位元は `1`、積は `(*)`、公理は既証明の補題で与える。
役割: `floorProd` 実装で一般 monoid 上の指数法則を使うための基盤。
-/
instance : Monoid mwfElem where
  one := 1
  mul := (· * ·)
  one_mul := MwfElem_one_mul
  mul_one := MwfElem_mul_one
  mul_assoc := MwfElem_mul_assoc

/--
目的: `MwfElem.__pow__`（閉形式）に対応する実装を定義する。
定義:
- `k = 0` なら単位元 `1` を返す。
- `k > 0` で `info? = none` なら `sum` のみを `k` 倍し、`info? = none` を保つ。
- `k > 0` で `info? = some info` の場合:
  - `sum > 0` なら `best/arg` を末尾ブロックへシフトした閉形式で更新する。
  - `sum ≤ 0` なら `best/arg` は先頭ブロック値を保持する。
入力/前提: `z : MwfElem`, `k : Nat`。
出力: 型 `MwfElem` の値を返す。
役割: Python 実装 `__pow__`（sssec:impl_Mwf_floor_prod）を Lean 上で表し、正しさ定理で検証する対象。
-/
private def mwfElemPowImpl (z : mwfElem) (k : Nat) : mwfElem :=
  match k with
  | 0 => 1
  | k + 1 =>
      let ssum : Int := z.sum * (Nat.succ k)
      match z.info? with
      | none =>
          { sum := ssum, info? := none }
      | some info =>
          if z.sum > 0 then
            { sum := ssum
              info? := some
                { best := z.sum * k + info.best
                  dx := info.dx * (Nat.succ k)
                  arg := info.dx * k + info.arg } }
          else
            { sum := ssum
              info? := some
                { best := info.best
                  dx := info.dx * (Nat.succ k)
                  arg := info.arg } }

/--
入力/前提: 整数 `s` と自然数 `k`。
主張: `s * succ k + s = s * succ (succ k)`。
内容: 累積和の閉形式で使う整数版の 1 ステップ補題。
証明: 整数環の演算を展開して整理する。
役割: `mwfElem` の冪の帰納計算を短くする。
-/
private lemma int_mul_succ (s : Int) (k : Nat) :
    s * (Nat.succ k) + s = s * (Nat.succ (Nat.succ k)) := by
  calc
    s * (Nat.succ k) + s = s * ((Nat.succ k : Int) + 1) := by ring
    _ = s * (Nat.succ (Nat.succ k)) := by simp only [Nat.succ_eq_add_one, Nat.cast_add,
      Nat.cast_one]

/--
入力/前提: 自然数 `d k`。
主張: `d * succ k + d = d * succ (succ k)`。
内容: `dx` 更新で使う自然数版の 1 ステップ補題。
証明: `Nat.mul_succ` を並べ替える。
役割: `mwfElem` の冪で `dx` を追跡する。
-/
private lemma nat_mul_succ (d : Nat) (k : Nat) :
    d * (Nat.succ k) + d = d * (Nat.succ (Nat.succ k)) := by
  simpa only [Nat.succ_eq_add_one, Nat.mul_add, mul_one, Nat.add_comm, Nat.add_left_comm,
    Nat.reduceAdd] using (Nat.mul_succ d (Nat.succ k)).symm

/--
入力/前提: `info? = none` の閉形式状態と 1 個の元 `{sum := s}`。
主張: それらの積は次の閉形式状態に一致する。
内容: `mwfElem_pow_none_succ` の帰納ステップを切り出した補題。
証明: `mwfElemMul` を展開し、和の更新を `int_mul_succ` で整理する。
役割: `mwfElem_pow_none_succ` の本体を短く保つ。
-/
private lemma mwfElem_pow_none_step (s : Int) (k : Nat) :
    ({ sum := s * (Nat.succ k), info? := none } : mwfElem) * { sum := s, info? := none } =
      { sum := s * (Nat.succ (Nat.succ k)), info? := none } := by
  change mwfElemMul { sum := s * (Nat.succ k), info? := none } { sum := s, info? := none } =
    { sum := s * (Nat.succ (Nat.succ k)), info? := none }
  rw [MwfElemMul_none_none]
  simp only [mwfElem.mk.injEq, and_true]
  simpa using int_mul_succ s k

/--
入力/前提: `s ≤ 0` の閉形式状態と 1 個の `some info` 要素。
主張: それらの積は非正ケースの次の閉形式状態に一致する。
内容: `best` は据え置きで、`sum` と `dx` だけが 1 段伸びる。
証明: 比較条件が常に左枝になることを示して `mwfElemMul` を簡約する。
役割: `mwfElem_pow_some_nonpos_succ` の帰納ステップを分離する。
-/
private lemma mwfElem_pow_some_nonpos_step (s : Int) (info : BestInfo) (k : Nat) (hS : s ≤ 0) :
    ({ sum := s * (Nat.succ k)
       info? := some
          { best := info.best
            dx := info.dx * (Nat.succ k)
            arg := info.arg } } : mwfElem) * { sum := s, info? := some info } =
      { sum := s * (Nat.succ (Nat.succ k))
        info? := some
          { best := info.best
            dx := info.dx * (Nat.succ (Nat.succ k))
            arg := info.arg } } := by
  have hMulNonPos : s * (Nat.succ k) ≤ 0 :=
    mul_nonpos_of_nonpos_of_nonneg hS (Int.natCast_nonneg _)
  have hge :
      info.best ≥ s * (Nat.succ k) + info.best := by
    nlinarith [hMulNonPos]
  have hge' :
      info.best ≥ s * ((k : Int) + 1) + info.best := by
    simpa only [Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one] using hge
  have hchoose :
      MwfChooseScore
          (MwfInfoScore
            { best := info.best
              dx := info.dx * (Nat.succ k)
              arg := info.arg })
          (MwfShiftScore (s * (Nat.succ k)) (info.dx * (Nat.succ k)) (MwfInfoScore info)) =
        MwfInfoScore
          { best := info.best
            dx := info.dx * (Nat.succ k)
            arg := info.arg } := by
    apply MwfChooseScore_eq_left
    simpa only [MwfInfoScore, MwfShiftScore, Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one]
      using hge'
  change mwfElemMul
      { sum := s * (Nat.succ k)
        info? := some
          { best := info.best
            dx := info.dx * (Nat.succ k)
            arg := info.arg } }
      { sum := s, info? := some info } =
    { sum := s * (Nat.succ (Nat.succ k))
      info? := some
        { best := info.best
          dx := info.dx * (Nat.succ (Nat.succ k))
          arg := info.arg } }
  rw [MwfElemMul_some_some]
  rw [hchoose]
  simp only [MwfMkInfoFromScore, MwfInfoScore, int_mul_succ, nat_mul_succ]

/--
入力/前提: `0 < s` の閉形式状態と 1 個の `some info` 要素。
主張: それらの積は正ケースの次の閉形式状態に一致する。
内容: 右枝が常に優勢になり、`best` と `arg` も 1 段先へ進む。
証明: 比較条件が常に右枝になることを示して `mwfElemMul` を簡約する。
役割: `mwfElem_pow_some_pos_succ` の帰納ステップを分離する。
-/
private lemma mwfElem_pow_some_pos_step (s : Int) (info : BestInfo) (k : Nat) (hS : 0 < s) :
    ({ sum := s * (Nat.succ k)
       info? := some
          { best := s * k + info.best
            dx := info.dx * (Nat.succ k)
            arg := info.dx * k + info.arg } } : mwfElem) * { sum := s, info? := some info } =
      { sum := s * (Nat.succ (Nat.succ k))
        info? := some
          { best := s * (Nat.succ k) + info.best
            dx := info.dx * (Nat.succ (Nat.succ k))
            arg := info.dx * (Nat.succ k) + info.arg } } := by
  have hlt :
      s * k + info.best < s * (Nat.succ k) + info.best := by
    have hklt : (k : Int) < (Nat.succ k : Int) := by
      exact_mod_cast Nat.lt_succ_self k
    have hmul : s * (k : Int) < s * (Nat.succ k : Int) :=
      Int.mul_lt_mul_of_pos_left hklt hS
    simpa only [add_comm, Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one, add_lt_add_iff_left,
      gt_iff_lt] using add_lt_add_right hmul info.best
  have hchoose :
      MwfChooseScore
          (MwfInfoScore
            { best := s * k + info.best
              dx := info.dx * (Nat.succ k)
              arg := info.dx * k + info.arg })
          (MwfShiftScore (s * (Nat.succ k)) (info.dx * (Nat.succ k)) (MwfInfoScore info)) =
        MwfShiftScore (s * (Nat.succ k)) (info.dx * (Nat.succ k)) (MwfInfoScore info) := by
    apply MwfChooseScore_eq_right
    simpa only [MwfInfoScore, MwfShiftScore, Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one]
      using hlt
  change mwfElemMul
      { sum := s * (Nat.succ k)
        info? := some
          { best := s * k + info.best
            dx := info.dx * (Nat.succ k)
            arg := info.dx * k + info.arg } }
      { sum := s, info? := some info } =
    { sum := s * (Nat.succ (Nat.succ k))
      info? := some
        { best := s * (Nat.succ k) + info.best
          dx := info.dx * (Nat.succ (Nat.succ k))
          arg := info.dx * (Nat.succ k) + info.arg } }
  rw [MwfElemMul_some_some]
  rw [hchoose]
  simp only [MwfMkInfoFromScore, MwfInfoScore, MwfShiftScore, int_mul_succ, nat_mul_succ]

/--
入力/前提: `z : mwfElem`、閉形式候補 `F : Nat → mwfElem`。
主張: `F 0 = z` かつ `F k * z = F (k+1)` なら、`z^(k+1) = F k`。
内容: `pow_succ` に沿った共通の帰納骨格を抽象化する。
証明: 基底は `pow_one`、帰納段は `pow_succ` と `hstep` を連結する。
役割: `mwfElem_pow_*_succ` 3 本の重複した帰納パターンを吸収する。
-/
private lemma mwfElem_pow_succ_of_step
    (z : mwfElem) (F : Nat → mwfElem)
    (h0 : z = F 0)
    (hstep : ∀ k, F k * z = F (Nat.succ k)) :
    ∀ k, z ^ (Nat.succ k) = F k
  | 0 => by
      simpa only [pow_one] using h0
  | k + 1 => by
      calc
        z ^ (Nat.succ (Nat.succ k)) = (z ^ (Nat.succ k)) * z := by
          simp only [pow_succ]
        _ = F k * z := by
          rw [mwfElem_pow_succ_of_step z F h0 hstep k]
        _ = F (Nat.succ k) := hstep k

/--
入力/前提: `info? = none` の要素 `{sum := s}`。
主張: その `succ k` 乗は `{sum := s * succ k, info? := none}`。
内容: 情報なし要素の冪の閉形式。
証明: `pow` の帰納法で積を展開し、`int_mul_succ` を使う。
役割: `mwfElemPowImpl_correct` の `none` ケースを処理する。
-/
private lemma mwfElem_pow_none_succ (s : Int) :
    ∀ k, ({ sum := s, info? := none } : mwfElem) ^ (Nat.succ k) =
      { sum := s * (Nat.succ k), info? := none } :=
    mwfElem_pow_succ_of_step
      { sum := s, info? := none }
      (fun k => ({ sum := s * (Nat.succ k), info? := none } : mwfElem))
      (by simp only [Nat.succ_eq_add_one, zero_add, Nat.cast_one, mul_one])
      (fun k => mwfElem_pow_none_step s k)

/--
入力/前提: `s ≤ 0` と `info? = some info`。
主張: その `succ k` 乗は `best` を固定しつつ `sum` と `dx` だけ線形に伸びる。
内容: 非正の和では最良値が先頭要素から動かない場合の冪の閉形式。
証明: `pow` の帰納法で、比較条件が常に同じ側を選ぶことを使う。
役割: `mwfElemPowImpl_correct` の非正ケースを処理する。
-/
private lemma mwfElem_pow_some_nonpos_succ (s : Int) (info : BestInfo) (hS : s ≤ 0) :
    ∀ k, ({ sum := s, info? := some info } : mwfElem) ^ (Nat.succ k) =
      { sum := s * (Nat.succ k)
        info? := some
          { best := info.best
            dx := info.dx * (Nat.succ k)
            arg := info.arg } } :=
    mwfElem_pow_succ_of_step
      { sum := s, info? := some info }
      (fun k =>
        ({ sum := s * (Nat.succ k)
           info? := some
             { best := info.best
               dx := info.dx * (Nat.succ k)
               arg := info.arg } } : mwfElem))
      (by simp only [Nat.succ_eq_add_one, zero_add, Nat.cast_one, mul_one])
      (fun k => mwfElem_pow_some_nonpos_step s info k hS)

/--
入力/前提: `0 < s` と `info? = some info`。
主張: その `succ k` 乗は `best` と `arg` も等差的に増える閉形式を持つ。
内容: 正の和では右へ進むほど score が伸びる場合の冪の閉形式。
証明: `pow` の帰納法で比較条件が常に右側を選ぶことを使う。
役割: `mwfElemPowImpl_correct` の正ケースを処理する。
-/
private lemma mwfElem_pow_some_pos_succ (s : Int) (info : BestInfo) (hS : 0 < s) :
    ∀ k, ({ sum := s, info? := some info } : mwfElem) ^ (Nat.succ k) =
      { sum := s * (Nat.succ k)
        info? := some
          { best := s * k + info.best
            dx := info.dx * (Nat.succ k)
            arg := info.dx * k + info.arg } } :=
    mwfElem_pow_succ_of_step
      { sum := s, info? := some info }
      (fun k =>
        ({ sum := s * (Nat.succ k)
           info? := some
             { best := s * k + info.best
               dx := info.dx * (Nat.succ k)
               arg := info.dx * k + info.arg } } : mwfElem))
      (by
        simp only [Nat.succ_eq_add_one, zero_add, Nat.cast_one, mul_one, CharP.cast_eq_zero,
          mul_zero])
      (fun k => mwfElem_pow_some_pos_step s info k hS)

/--
入力/前提: `sum = s`, `info? = some info` の `mwfElem` と `succ k`。
主張: `mwfElemPowImpl` の `some` ケースはモノイド冪 `^(succ k)` と一致する。
内容: `s > 0` と `s ≤ 0` の 2 分岐だけを処理する helper。
証明: `mwfElem_pow_some_pos_succ` と `mwfElem_pow_some_nonpos_succ` に場合分けで還元する。
役割: `mwfElemPowImpl_correct_succ` から符号分岐を切り離す。
-/
private lemma mwfElemPowImpl_correct_some_succ
    (s : Int) (info : BestInfo) (k : Nat) :
    mwfElemPowImpl ({ sum := s, info? := some info } : mwfElem) (Nat.succ k) =
      ({ sum := s, info? := some info } : mwfElem) ^ (Nat.succ k) := by
  by_cases hS : s > 0
  · simpa only [mwfElemPowImpl, gt_iff_lt, hS, ↓reduceIte, Nat.succ_eq_add_one,
      Nat.cast_add, Nat.cast_one] using (mwfElem_pow_some_pos_succ s info hS k).symm
  · simpa only [mwfElemPowImpl, gt_iff_lt, hS, ↓reduceIte, Nat.succ_eq_add_one,
      Nat.cast_add, Nat.cast_one] using
      (mwfElem_pow_some_nonpos_succ s info (le_of_not_gt hS) k).symm

/--
入力/前提: `sum = s`, `info? = none` の `mwfElem` と `succ k`。
主張: `mwfElemPowImpl` の `none` ケースはモノイド冪 `^(succ k)` と一致する。
内容: 情報なし要素の閉形式 `mwfElem_pow_none_succ` への薄い wrapper。
証明: `mwfElem_pow_none_succ` をそのまま実装定義へ戻す。
役割: `mwfElemPowImpl_correct_succ` の `none` 分岐を対称化する。
-/
private lemma mwfElemPowImpl_correct_none_succ
    (s : Int) (k : Nat) :
    mwfElemPowImpl ({ sum := s, info? := none } : mwfElem) (Nat.succ k) =
      ({ sum := s, info? := none } : mwfElem) ^ (Nat.succ k) := by
  simpa only [mwfElemPowImpl, Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one] using
    (mwfElem_pow_none_succ s k).symm

/--
入力/前提: `sum = s`, `info? = info?` の `mwfElem` と `succ k`。
主張: `mwfElemPowImpl` の `succ` ケースはモノイド冪 `^(succ k)` と一致する。
内容: `info?` の有無と `s` の符号ごとに既存の閉形式補題へ還元する。
証明: `none` / `some` を場合分けし、`some` 側はさらに `s > 0` で分岐して
  `mwfElem_pow_none_succ` / `mwfElem_pow_some_nonpos_succ` / `mwfElem_pow_some_pos_succ`
  を適用する。
役割: `mwfElemPowImpl_correct` から `succ` ケースの詳細分岐を切り離す。
-/
private lemma mwfElemPowImpl_correct_succ
    (s : Int) (info? : Option BestInfo) (k : Nat) :
    mwfElemPowImpl ({ sum := s, info? := info? } : mwfElem) (Nat.succ k) =
      ({ sum := s, info? := info? } : mwfElem) ^ (Nat.succ k) := by
  cases info? with
  | none =>
    simpa using mwfElemPowImpl_correct_none_succ s k
  | some info =>
    simpa using mwfElemPowImpl_correct_some_succ s info k

/--
入力/前提: `z : mwfElem`, `k : Nat`。
主張: `mwfElemPowImpl z k = z ^ k`。
内容: 実装 `mwfElemPowImpl`（`__pow__` の閉形式）がモノイド冪と一致することを示す。
証明: `k` の場合分け後、`info?` と `sum` の符号で補助補題
  `mwfElem_pow_none_succ` / `mwfElem_pow_some_nonpos_succ` / `mwfElem_pow_some_pos_succ`
  を適用する。
役割: sssec:impl_mwf_floor_prod の `__pow__` 実装が数理仕様（モノイド冪）に正しいことの検証定理。
-/
private theorem mwfElemPowImpl_correct (z : mwfElem) (k : Nat) :
    mwfElemPowImpl z k = z ^ k := by
  rcases z with ⟨s, info?⟩
  cases k with
  | zero =>
      simp [mwfElemPowImpl]
  | succ k =>
      simp [mwfElemPowImpl_correct_succ]

/--
目的: `X=(sum=a,info?=some(best=0,dx=1,arg=0))` を定義する。
定義: `MwfElem` の初期要素 `X`。
入力/前提: `a : Int`。
出力: 型 `MwfElem` の値を返す。
役割: sssec:mwf_floor_prod の写像で使う `x` 側モノイド要素。
-/
private def mwfElemX (a : Int) : mwfElem :=
  { sum := a, info? := some { best := 0, dx := 1, arg := 0 } }

/--
目的: `Y=(sum=b,info?=none)` を定義する。
定義: `MwfElem` の初期要素 `Y`。
入力/前提: `b : Int`。
出力: 型 `MwfElem` の値を返す。
役割: sssec:mwf_floor_prod の写像で使う `y` 側モノイド要素。
-/
private def mwfElemY (b : Int) : mwfElem :=
  { sum := b, info? := none }

end Internal

/--
目的: `floorProd` と `MwfElemX/Y` で区間版 `Mwf` と最小 `argmax` を同時に計算する。
定義:
- 区間 `[L,R)` を `t` による `[0,n)`（`n = R-L`）へ平行移動する。
- `C` と `CL+D` を `ediv/emod` 正規化し、`floorProd n m c' d' X Y` を評価する。
- `X = MwfElemX (A + B*⌊C/M⌋)`, `Y = MwfElemY B` を用いる。
入力/前提: `L<R`, `0<M`, `0≤C`, `0≤D`。
出力: 型 `mwfLrArgResult` の値を返す。
役割: `mwfLrWithArgmax`（定義的最大化）に対する floor_prod 実装版。
-/
def mwfLrWithArgmaxFloorProd
    (L R M A B C D : Int)
    (_hLR : L < R) (hM : 0 < M) (_hC0 : 0 ≤ C) (_hD0 : 0 ≤ D) :
    mwfWithArgResult :=
  let nI := R - L
  let mI := M
  let qC := Spec.zfloorDiv C M hM
  let cI := Spec.zfloorMod C M hM
  let kI := C * L + D
  let qD := Spec.zfloorDiv kI M hM
  let dI := Spec.zfloorMod kI M hM
  let aI := A + B * qC
  let cst := A * L + B * qD
  let res : Internal.mwfElem :=
    Impl.floorProd (Int.toNat nI) (Int.toNat mI) (Int.toNat cI) (Int.toNat dI)
    (Internal.mwfElemX aI) (Internal.mwfElemY B)
  match res.info? with
  | some info =>
      { max := cst + info.best
        argmax := L + Int.ofNat info.arg }
  | none =>
      -- `L<R` の下では本来起きないが、定義としては総称化しておく。
      { max := cst
        argmax := L }

/--
目的: `floorProd` 版の区間最大値を返す。
定義: `mwfLrWithArgmaxFloorProd` の `max` 射影。
入力/前提: `L<R`, `0<M`, `0≤C`, `0≤D`。
出力: 型 `Int` の値を返す。
役割: `mwfLr` に対応する floor_prod 側 API。
-/
def mwfLrFloorProd
    (L R M A B C D : Int)
    (hLR : L < R) (hM : 0 < M) (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) : Int :=
  (mwfLrWithArgmaxFloorProd L R M A B C D hLR hM hC0 hD0).max

/--
目的: `floorProd` 版の最小 `argmax` を返す。
定義: `mwfLrWithArgmaxFloorProd` の `argmax` 射影。
入力/前提: `L<R`, `0<M`, `0≤C`, `0≤D`。
出力: 型 `Int` の値を返す。
役割: `mwfLrArgmax` に対応する floor_prod 側 API。
-/
def mwfLrArgmaxFloorProd
    (L R M A B C D : Int)
    (hLR : L < R) (hM : 0 < M) (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) : Int :=
  (mwfLrWithArgmaxFloorProd L R M A B C D hLR hM hC0 hD0).argmax

namespace Correctness

namespace Internal

private lemma floorProdFormula_eq_pow_of_stop_normalized
    {α : Type _} [Monoid α]
    (n m a b : Nat) (x y : α) (hM : 0 < m)
  (_hA_lt : a < m) (hB_lt : b < m)
    (hStop : a * n + b < m) :
    FloorProd.Spec.floorProdFormula n m a b x y = x ^ n := by
  induction n with
  | zero =>
      conv_lhs => unfold FloorProd.Spec.floorProdFormula
      simp [Nat.ne_of_gt hM, Nat.div_eq_of_lt hB_lt]
  | succ n ih =>
      have hStopPrev : a * n + b < m := by
        have hmul_le : a * n ≤ a * (n + 1) := by
          exact Nat.mul_le_mul_left _ (Nat.le_succ n)
        have hle : a * n + b ≤ a * (n + 1) + b :=
          Nat.add_le_add_right hmul_le _
        exact lt_of_le_of_lt hle hStop
      have hqPrev : (a * n + b) / m = 0 := Nat.div_eq_of_lt hStopPrev
      have hqNext : (a * (n + 1) + b) / m = 0 := Nat.div_eq_of_lt hStop
      have hDelta : ((a * (n + 1) + b) / m) - ((a * n + b) / m) = 0 := by
        rw [hqNext, hqPrev]
      rw [FloorProd.Spec.floorProdFormula_succ, ih hStopPrev, hDelta, pow_succ]
      simp

/--
入力/前提: `0 < m`, `a < m` と、正規化後の 1 ステップで繰り上がりが起きない条件。
主張: 商 `⌊(a*(i+1)+b)/m⌋` は前段 `⌊(a*i+b)/m⌋` と等しい。
内容: 正規化後は 1 回で高さが 2 段以上増えないので、非繰り上がり時は商差 0。
証明: `a*i+b = m*q + r` に分解し、`r+a < m` を用いて `Nat.div_eq_iff` で示す。
役割: 再帰式の `n` 帰納で「末尾ブロックが `x` だけ」の場合を切り出す。
-/
private lemma floorProd_step_div_eq_of_lt
    (i m a b : Nat) (hM : 0 < m) (_hA_lt : a < m)
    (hNoCarry : (a * i + b) % m + a < m) :
    (a * (i + 1) + b) / m = (a * i + b) / m := by
  let q := (a * i + b) / m
  let r := (a * i + b) % m
  have hNoCarry' : r + a < m := by
    simpa only [r] using hNoCarry
  have hqr : a * i + b = m * q + r := by
    simpa only [q, r, Nat.add_comm] using (Nat.mod_add_div (a * i + b) m).symm
  have hy : a * (i + 1) + b = m * q + (r + a) := by
    calc
      a * (i + 1) + b = a * i + b + a := by ring
      _ = m * q + r + a := by rw [hqr]
      _ = m * q + (r + a) := by ac_rfl
  have hdiv : (a * (i + 1) + b) / m = q := by
    apply (Nat.div_eq_iff hM).2
    constructor
    · simpa only [Nat.mul_comm, hy] using Nat.le_add_right (q * m) (r + a)
    · have hle0 : r + a ≤ m - 1 := Nat.le_pred_of_lt hNoCarry'
      have hle1 := Nat.add_le_add_left hle0 (q * m)
      rw [hy]
      have hle2 : m * q + (r + a) ≤ q * m + (m - 1) := by
        simpa [Nat.mul_comm] using hle1
      have hle3 : q * m + (m - 1) ≤ q * m + m - 1 := by
        omega
      exact le_trans hle2 hle3
  simpa only [q] using hdiv

private lemma floorProd_step_mod_eq_of_lt
    (i m a b : Nat) (_hM : 0 < m)
    (hNoCarry : (a * i + b) % m + a < m) :
    (a * (i + 1) + b) % m = (a * i + b) % m + a := by
  let q := (a * i + b) / m
  let r := (a * i + b) % m
  have hNoCarry' : r + a < m := by
    simpa only [r] using hNoCarry
  have hqr : a * i + b = m * q + r := by
    simpa only [q, r, Nat.add_comm] using (Nat.mod_add_div (a * i + b) m).symm
  have hy : a * (i + 1) + b = m * q + (r + a) := by
    calc
      a * (i + 1) + b = a * i + b + a := by ring
      _ = m * q + r + a := by rw [hqr]
      _ = m * q + (r + a) := by ac_rfl
  calc
    (a * (i + 1) + b) % m = (m * q + (r + a)) % m := by rw [hy]
    _ = ((r + a) + m * q) % m := by ac_rfl
    _ = (r + a) % m := Nat.add_mul_mod_self_left _ _ _
    _ = r + a := Nat.mod_eq_of_lt hNoCarry'
    _ = (a * i + b) % m + a := by simp [r, Nat.add_comm]

private lemma floorProd_step_mod_div_eq_zero_of_le
    (i m a b : Nat) (hM : 0 < m) (hA_lt : a < m)
    (hCarry : m ≤ (a * i + b) % m + a) :
    ((a * (i + 1) + b) % m) / a = 0 := by
  let q := (a * i + b) / m
  let r := (a * i + b) % m
  have hCarry' : m ≤ r + a := by
    simpa only [r] using hCarry
  have hr_lt : r < m := by
    simp only [r]
    exact Nat.mod_lt _ hM
  have hqr : a * i + b = m * q + r := by
    simpa only [q, r, Nat.add_comm] using (Nat.mod_add_div (a * i + b) m).symm
  have hsplit : m * q + (r + a) = m * q + (r + a - m) + m := by
    calc
      m * q + (r + a) = m * q + ((r + a - m) + m) := by
        congr 1
        exact (Nat.sub_eq_iff_eq_add hCarry').1 rfl
      _ = m * q + (r + a - m) + m := by ac_rfl
  have hnum : a * (i + 1) + b = m * (q + 1) + (r + a - m) := by
    calc
      a * (i + 1) + b = a * i + b + a := by ring
      _ = m * q + r + a := by rw [hqr]
      _ = m * q + (r + a) := by ac_rfl
      _ = m * q + (r + a - m) + m := hsplit
      _ = m * (q + 1) + (r + a - m) := by
        simp [Nat.mul_add, Nat.add_assoc, Nat.add_comm]
  rw [calc
    (a * (i + 1) + b) % m = (m * (q + 1) + (r + a - m)) % m := by rw [hnum]
    _ = ((r + a - m) + m * (q + 1)) % m := by ac_rfl
    _ = (r + a - m) % m := Nat.add_mul_mod_self_left _ _ _
    _ = r + a - m := by
          have hrem_lt_a : r + a - m < a := by omega
          exact Nat.mod_eq_of_lt (lt_trans hrem_lt_a hA_lt)
    _ = (a * i + b) % m + a - m := by simp [r, Nat.add_comm]]
  have hr_lt : (a * i + b) % m < m := Nat.mod_lt _ hM
  have hrem_lt_a : (a * i + b) % m + a - m < a := by
    omega
  exact Nat.div_eq_of_lt hrem_lt_a

private lemma floorProd_step_div_eq_one_of_lt_of_le
    (i m a b : Nat) (hM : 0 < m) (hA_lt : a < m)
    (hPrevLt : a * i + b < m)
    (hCarry : m ≤ (a * i + b) % m + a) :
    (a * (i + 1) + b) / m = 1 := by
  apply (Nat.div_eq_iff hM).2
  constructor
  · calc
      1 * m = m := by simp
      _ ≤ (a * i + b) + a := by simpa [Nat.mod_eq_of_lt hPrevLt] using hCarry
      _ = a * (i + 1) + b := by ring
  · have hUpper : a * (i + 1) + b < m + m := by
      calc
        a * (i + 1) + b = (a * i + b) + a := by ring
        _ < m + a := Nat.add_lt_add_right hPrevLt a
        _ < m + m := Nat.add_lt_add_left hA_lt m
    simpa using Nat.le_pred_of_lt hUpper

/--
入力/前提: `0 < m`, `a < m` と、末尾ステップで繰り上がりが起きない条件。
主張: `floorProdFormula (n+1)` の末尾ブロックは `x` に簡約する。
内容: 差分指数が 0 になる場合。
証明: `floorProdFormula_succ` と商差 0 の補題を使う。
役割: recurrence を `n` 帰納で証明するときの非繰り上がり枝。
-/
private lemma floorProdFormula_succ_of_no_carry
    {α : Type _} [Monoid α]
    (n m a b : Nat) (x y : α) (hM : 0 < m) (hA_lt : a < m)
    (hNoCarry : (a * n + b) % m + a < m) :
    FloorProd.Spec.floorProdFormula (n + 1) m a b x y =
      FloorProd.Spec.floorProdFormula n m a b x y * x := by
  simpa [floorProd_step_div_eq_of_lt n m a b hM hA_lt hNoCarry] using
    FloorProd.Spec.floorProdFormula_succ n m a b x y

/--
入力/前提: `0 < m`, `a < m` と、末尾ステップで繰り上がりが起きる条件。
主張: `floorProdFormula (n+1)` の末尾ブロックは `x * y` に簡約する。
内容: 差分指数が 1 になる場合。
証明: `floorProdFormula_succ` と商差 1 の補題を使う。
役割: recurrence を `n` 帰納で証明するときの繰り上がり枝。
-/
private lemma floorProdFormula_succ_of_carry
    {α : Type _} [Monoid α]
    (n m a b : Nat) (x y : α) (hM : 0 < m) (hA_lt : a < m)
    (hCarry : m ≤ (a * n + b) % m + a) :
    FloorProd.Spec.floorProdFormula (n + 1) m a b x y =
      FloorProd.Spec.floorProdFormula n m a b x y * (x * y) := by
  have hqCarry : (a * (n + 1) + b) / m = (a * n + b) / m + 1 := by
    let q := (a * n + b) / m
    let r := (a * n + b) % m
    have hCarry' : m ≤ r + a := by
      simpa only [r] using hCarry
    have hr_lt : r < m := by
      simp only [r]
      exact Nat.mod_lt _ hM
    have hsum_lt : r + a < m + m := Nat.add_lt_add hr_lt hA_lt
    have hqr : a * n + b = m * q + r := by
      simpa only [q, r, Nat.add_comm] using (Nat.mod_add_div (a * n + b) m).symm
    have hnum : a * (n + 1) + b = m * q + (r + a) := by
      calc
        a * (n + 1) + b = a * n + b + a := by ring
        _ = m * q + r + a := by rw [hqr]
        _ = m * q + (r + a) := by ac_rfl
    have hdiv : (a * (n + 1) + b) / m = q + 1 := by
      apply (Nat.div_eq_iff hM).2
      constructor
      · have hle := Nat.add_le_add_left hCarry' (m * q)
        rw [hnum]
        calc
          (q + 1) * m = m * q + m := by ring
          _ ≤ m * q + (r + a) := hle
      · have hle0 : r + a ≤ m + m - 1 := Nat.le_pred_of_lt hsum_lt
        have hle1 := Nat.add_le_add_left hle0 (m * q)
        rw [hnum]
        calc
          m * q + (r + a) ≤ m * q + (m + m - 1) := hle1
          _ = m * q + m + m - 1 := by omega
          _ = (q + 1) * m + m - 1 := by
            rw [Nat.add_mul, one_mul]
            ac_rfl
    simpa only [q] using hdiv
  simpa [hqCarry] using
    FloorProd.Spec.floorProdFormula_succ n m a b x y

private lemma floorProd_transposed_next_num_eq
    (n m a b c r : Nat)
    (hy : a * n + b = m * c + r)
    (hB_lt : b < m) (hr_lt : r < m) :
    m * c + (m - b - 1 + a) = (m - r - 1) + a * (n + 1) := by
  have hb1 : b + 1 ≤ m := Nat.succ_le_of_lt hB_lt
  have hsubb : m - b - 1 = m - (b + 1) := by omega
  have hsubr : m - r - 1 = m - (r + 1) := by omega
  calc
    m * c + (m - b - 1 + a)
        = m * c + (m - (b + 1)) + a := by
            rw [hsubb]
            ac_rfl
    _ = (m * c + m - (b + 1)) + a := by
          rw [Nat.add_sub_assoc hb1]
    _ = (a * n + (m - (r + 1))) + a := by
          omega
    _ = (m - (r + 1)) + a * (n + 1) := by ring
    _ = (m - r - 1) + a * (n + 1) := by rw [hsubr]

/--
入力/前提: `0 < m`, `0 < a < m`, `b < m`, `m ≤ a*n+b`。
主張: transformed 再帰側の直前商は `n - ((an+b)%m)/a` に等しい。
内容: `floorProd_exponent_bridge` を transformed 側の分母 `a` に読み替えた形。
証明: `d = ((m*c-b-1)/a)+1` を経由して `Nat.add_mul_div_right` で整理する。
役割: transformed carry 補題で末尾ブロックの指数差を計算する。
-/
private lemma floorProd_transposed_prev_div_eq
    (n m a b : Nat)
  (hM : 0 < m) (_hA_lt : a < m) (hB_lt : b < m) (hA_pos : 0 < a)
    (hY : m ≤ a * n + b) :
    let c := (a * n + b) / m
    let k := ((a * n + b) % m) / a
    let b' := m - b - 1 + a
    (m * (c - 1) + b') / a = n - k := by
  set y : Nat := a * n + b
  set c : Nat := y / m
  set r : Nat := y % m
  set k : Nat := r / a
  set x : Nat := m * c - b
  set t : Nat := x - 1
  have hy : m * c + r = y := by
    subst c r
    simpa only [Nat.add_comm] using (Nat.mod_add_div y m)
  have hc_pos : 0 < c := by
    simpa only [c, y] using
      FloorProd.Internal.floorProd_div_pos_of_ge y m hM (by simpa only [y] using hY)
  have hb_mc : b < m * c := by
    have hm_le_mc : m ≤ m * c := by
      calc
        m = m * 1 := by simp only [mul_one]
        _ ≤ m * c := Nat.mul_le_mul_left _ (Nat.succ_le_of_lt hc_pos)
    exact lt_of_lt_of_le hB_lt hm_le_mc
  have hx_pos : 0 < x := by
    simpa only [tsub_pos_iff_lt, x] using (Nat.sub_pos_of_lt hb_mc)
  have hmc_sub : x = a * n - r := by
    unfold x
    omega
  have hk_bounds : k * a ≤ r ∧ r ≤ k * a + a - 1 := by
    simpa only [k] using FloorProd.Internal.floorProd_div_bounds r a hA_pos
  rcases hk_bounds with ⟨hk_lo, hk_hi⟩
  have hk_lt_n : k < n :=
    FloorProd.Internal.floorProd_div_index_lt n a k r x hA_pos hx_pos hmc_sub hk_lo
  have hq : t / a = n - k - 1 := by
    simpa only [t] using
      FloorProd.Internal.floorProd_pred_div_eq n a k r x hA_pos hx_pos hmc_sub hk_lo hk_hi
  have hq' : (m * c - b - 1) / a = n - k - 1 := by
    simpa only using hq
  have hc_succ : (c - 1) + 1 = c := by
    simpa [Nat.succ_eq_add_one] using (Nat.succ_pred_eq_of_pos hc_pos)
  have hmul : m * (c - 1) + m = m * c := by
    calc
      m * (c - 1) + m = m * ((c - 1) + 1) := by rw [Nat.mul_add, Nat.mul_one]
      _ = m * c := by rw [hc_succ]
  have hnum : m * (c - 1) + (m - b - 1 + a) = (m * c - b - 1) + a := by
    have hb1_le_m : b + 1 ≤ m := Nat.succ_le_of_lt hB_lt
    have hsubm : m - b - 1 = m - (b + 1) := by omega
    calc
      m * (c - 1) + (m - b - 1 + a)
          = m * (c - 1) + (m - (b + 1)) + a := by
              rw [hsubm]
              ac_rfl
      _ = (m * (c - 1) + m - (b + 1)) + a := by
            rw [Nat.add_sub_assoc hb1_le_m]
      _ = (m * c - (b + 1)) + a := by rw [hmul]
      _ = (m * c - b - 1) + a := by
            omega
  calc
    (m * (c - 1) + (m - b - 1 + a)) / a = ((m * c - b - 1) + a) / a := by
      rw [hnum]
    _ = (m * c - b - 1) / a + 1 := by
      simpa [Nat.mul_comm] using (Nat.add_mul_div_right (m * c - b - 1) 1 hA_pos)
    _ = n - k := by
      rw [hq']
      have hnk_pos : 0 < n - k := Nat.sub_pos_of_lt hk_lt_n
      calc
        (n - k - 1) + 1 = n - k := by
          simpa [Nat.succ_eq_add_one] using (Nat.succ_pred_eq_of_pos hnk_pos)

/--
入力/前提: `0 < m`, `0 < a < m`, `b < m`, `m ≤ a*n+b`。
主張: transformed 再帰側の次商は `n + 1` に等しい。
内容: `m*c + (m-b-1+a)` を `(m-r-1) + a*(n+1)` に分解して直接除算する。
証明: 商余り分解と `m-r-1 < a` を用いる。
役割: transformed carry 補題で末尾ステップの上段商を決める。
-/
private lemma floorProd_transposed_next_div_eq
    (n m a b : Nat)
    (hM : 0 < m) (_hA_lt : a < m) (hB_lt : b < m) (hA_pos : 0 < a)
  (hCarry : m ≤ (a * n + b) % m + a) :
    let c := (a * n + b) / m
    let b' := m - b - 1 + a
    (m * c + b') / a = n + 1 := by
  set y : Nat := a * n + b
  set c : Nat := y / m
  set r : Nat := y % m
  have hy : y = m * c + r := by
    calc
      y = y % m + m * (y / m) := by simpa using (Nat.mod_add_div y m).symm
      _ = m * c + r := by simp [c, r]; ac_rfl
  have hr_lt : r < m := by
    subst r
    exact Nat.mod_lt _ hM
  have hrest_lt : m - r - 1 < a := by
    simp [r] at hCarry
    omega
  have hnum : m * c + (m - b - 1 + a) = (m - r - 1) + a * (n + 1) := by
    have hy' : a * n + b = m * c + r := by simpa [y] using hy
    exact floorProd_transposed_next_num_eq n m a b c r hy' hB_lt hr_lt
  calc
    (m * c + (m - b - 1 + a)) / a = ((m - r - 1) + a * (n + 1)) / a := by
      rw [hnum]
    _ = (m - r - 1) / a + (n + 1) := by
      simpa [Nat.mul_comm] using (Nat.add_mul_div_right (m - r - 1) (n + 1) hA_pos)
    _ = n + 1 := by
      simp [Nat.div_eq_of_lt hrest_lt]

/--
入力/前提: `0 < m`, `0 < a < m`, `b < m`, `m ≤ a*n+b`。
主張: 正規化済み `floorProdFormula` は tex の再帰式
  `floor_prod(n,m,a,b;x,y) = floor_prod(c-1,a,m,m+a-b-1;y,x) * y * x^((an+b)%m/a)`
  を満たす。
内容: 格子路の対角反転で `x,y` が交換され、末尾境界項として
  `y * x^⌊((an+b) % m)/a⌋` が現れる。
役割: direct proof の再帰枝で必要な仕様側 recurrence を 1 本に隔離する。
-/
private lemma floorProdFormula_recurrence_normalized
    {α : Type _} [Monoid α]
    (n m a b : Nat) (x y : α)
    (hM : 0 < m) (hA_lt : a < m) (hB_lt : b < m) (hA_pos : 0 < a)
    (hY : m ≤ a * n + b) :
    FloorProd.Spec.floorProdFormula n m a b x y =
      FloorProd.Spec.floorProdFormula (((a * n + b) / m) - 1) a m (m - b - 1 + a) y x *
        y * x ^ (((a * n + b) % m) / a) := by
  induction n generalizing x y with
  | zero =>
      omega
  | succ n ih =>
      let c := (a * n + b) / m
      let r := (a * n + b) % m
      let k := r / a
      let b' := m - b - 1 + a
      by_cases hCarry : m ≤ r + a
      · have hqCarry : (a * (n + 1) + b) / m = c + 1 := by
          have hnum : a * (n + 1) + b = m * c + (r + a) := by
            calc
              a * (n + 1) + b = a * n + b + a := by ring
              _ = m * c + r + a := by
                    rw [show a * n + b = m * c + r by
                      simpa [c, r, Nat.add_comm] using (Nat.mod_add_div (a * n + b) m).symm]
              _ = m * c + (r + a) := by ac_rfl
          rw [hnum]
          apply (Nat.div_eq_iff hM).2
          constructor
          · have hle := Nat.add_le_add_left hCarry (m * c)
            calc
              (c + 1) * m = m * c + m := by ring
              _ ≤ m * c + (r + a) := hle
          · have hsum_lt : r + a < m + m := Nat.add_lt_add (Nat.mod_lt _ hM) hA_lt
            have hle0 : r + a ≤ m + m - 1 := Nat.le_pred_of_lt hsum_lt
            have hle1 := Nat.add_le_add_left hle0 (m * c)
            calc
              m * c + (r + a) ≤ m * c + (m + m - 1) := hle1
              _ = m * c + m + m - 1 := by omega
              _ = (c + 1) * m + m - 1 := by
                rw [Nat.add_mul, one_mul]
                ac_rfl
        by_cases hPrev : m ≤ a * n + b
        · have hIh := ih x y hPrev
          have hRecStep :
              FloorProd.Spec.floorProdFormula c a m b' y x =
                FloorProd.Spec.floorProdFormula (c - 1) a m b' y x * (y * x ^ (k + 1)) := by
            have hc_pos : 0 < c := by
              simpa [c] using FloorProd.Internal.floorProd_div_pos_of_ge (a * n + b) m hM hPrev
            calc
              FloorProd.Spec.floorProdFormula c a m b' y x
                = FloorProd.Spec.floorProdFormula ((c - 1) + 1) a m b' y x := by
                    have hc_succ : (c - 1) + 1 = c := by
                      simpa [Nat.succ_eq_add_one] using (Nat.succ_pred_eq_of_pos hc_pos)
                    rw [hc_succ]
              _ = FloorProd.Spec.floorProdFormula (c - 1) a m b' y x *
                    (y * x ^ (((m * (c - 1 + 1) + b') / a) - ((m * (c - 1) + b') / a))) := by
                      simpa using (FloorProd.Spec.floorProdFormula_succ (c - 1) a m b' y x)
              _ = FloorProd.Spec.floorProdFormula (c - 1) a m b' y x *
                    (y * x ^ (((m * c + b') / a) - ((m * (c - 1) + b') / a))) := by
                      rw [Nat.sub_add_cancel (Nat.succ_le_of_lt hc_pos)]
              _ = FloorProd.Spec.floorProdFormula (c - 1) a m b' y x *
                    (y * x ^ (((m * c + b') / a) - (n - k))) := by
                      have hprev : (m * (c - 1) + b') / a = n - k := by
                        simpa [c, b', k] using
                          floorProd_transposed_prev_div_eq n m a b hM hA_lt hB_lt hA_pos hPrev
                      rw [hprev]
              _ = FloorProd.Spec.floorProdFormula (c - 1) a m b' y x *
                    (y * x ^ ((n + 1) - (n - k))) := by
                      have hnext : (m * c + b') / a = n + 1 := by
                        simpa [c, b'] using
                          floorProd_transposed_next_div_eq n m a b hM hA_lt hB_lt hA_pos hCarry
                      rw [hnext]
              _ = FloorProd.Spec.floorProdFormula (c - 1) a m b' y x * (y * x ^ (k + 1)) := by
                  have hbridge :=
                    FloorProd.Internal.floorProd_exponent_bridge n m a b hM hA_lt hB_lt hA_pos hPrev
                  have hk_le_n : k ≤ n := by
                    calc
                      k = n - (((m * ((a * n + b) / m) - b - 1) / a) + 1) := by
                            simpa [k] using hbridge.symm
                      _ ≤ n := Nat.sub_le _ _
                  have hsub : (n + 1) - (n - k) = k + 1 := by
                    have hEq : (n - k) + (k + 1) = n + 1 := by
                      calc
                        (n - k) + (k + 1) = ((n - k) + k) + 1 := by ac_rfl
                        _ = n + 1 := by rw [Nat.sub_add_cancel hk_le_n]
                    rw [← hEq, Nat.add_sub_cancel_left]
                  rw [hsub]
          calc
            FloorProd.Spec.floorProdFormula (n + 1) m a b x y
                = FloorProd.Spec.floorProdFormula n m a b x y * (x * y) := by
                    exact floorProdFormula_succ_of_carry n m a b x y hM hA_lt hCarry
            _ = (FloorProd.Spec.floorProdFormula (c - 1) a m b' y x * y * x ^ k) *
                  (x * y) := by
                    rw [hIh]
            _ = FloorProd.Spec.floorProdFormula (c - 1) a m b' y x *
                  (y * x ^ (k + 1)) * y := by
                    simp [pow_succ, mul_assoc]
            _ = FloorProd.Spec.floorProdFormula c a m b' y x * y := by
                  rw [hRecStep]
            _ = FloorProd.Spec.floorProdFormula (((a * (n + 1) + b) / m) - 1) a m b' y x *
                  y * x ^ (((a * (n + 1) + b) % m) / a) := by
                    have hkCurr0 : ((a * (n + 1) + b) % m) / a = 0 := by
                      simpa using floorProd_step_mod_div_eq_zero_of_le n m a b hM hA_lt hCarry
                    simp [b', c, hqCarry, hkCurr0]
        · have hPrevLt : a * n + b < m := Nat.lt_of_not_ge hPrev
          calc
            FloorProd.Spec.floorProdFormula (n + 1) m a b x y
              = FloorProd.Spec.floorProdFormula n m a b x y * (x * y) := by
                  exact floorProdFormula_succ_of_carry n m a b x y hM hA_lt hCarry
            _ = x ^ n * (x * y) := by
                  have hStopN : FloorProd.Spec.floorProdFormula n m a b x y = x ^ n :=
                    floorProdFormula_eq_pow_of_stop_normalized n m a b x y hM hA_lt hB_lt hPrevLt
                  rw [hStopN]
            _ = x ^ (n + 1) * y := by
                  rw [pow_succ]; simp [mul_assoc]
            _ = FloorProd.Spec.floorProdFormula 0 a m b' y x * y := by
                  have hb'div : b' / a = n + 1 := by
                    have hqPrev0 : (a * n + b) / m = 0 := Nat.div_eq_of_lt hPrevLt
                    simpa [hqPrev0, mul_zero, zero_add] using
                      floorProd_transposed_next_div_eq n m a b hM hA_lt hB_lt hA_pos hCarry
                  simp [FloorProd.Spec.floorProdFormula, Nat.ne_of_gt hA_pos, hb'div]
            _ = FloorProd.Spec.floorProdFormula (((a * (n + 1) + b) / m) - 1) a m b' y x *
                y * x ^ (((a * (n + 1) + b) % m) / a) := by
                  have hkCurr0 : ((a * (n + 1) + b) % m) / a = 0 := by
                    simpa using floorProd_step_mod_div_eq_zero_of_le n m a b hM hA_lt hCarry
                  have hqCurr1 : (a * (n + 1) + b) / m = 1 := by
                    simpa using floorProd_step_div_eq_one_of_lt_of_le
                      n m a b hM hA_lt hPrevLt hCarry
                  simp [b', hqCurr1, hkCurr0]
      · have hNoCarry : r + a < m := by omega
        have hqNoCarry : (a * (n + 1) + b) / m = c := by
          simpa using floorProd_step_div_eq_of_lt n m a b hM hA_lt hNoCarry
        calc
          FloorProd.Spec.floorProdFormula (n + 1) m a b x y
            = FloorProd.Spec.floorProdFormula n m a b x y * x := by
                exact floorProdFormula_succ_of_no_carry n m a b x y hM hA_lt hNoCarry
          _ = (FloorProd.Spec.floorProdFormula (c - 1) a m b' y x * y * x ^ k) * x := by
                have hPrev : m ≤ a * n + b := by
                  have hCurrPos : 0 < (a * (n + 1) + b) / m := by
                    exact FloorProd.Internal.floorProd_div_pos_of_ge (a * (n + 1) + b) m hM hY
                  have hPrevPos : 0 < (a * n + b) / m := by
                    have hcPos : 0 < c := by
                      rw [← hqNoCarry]
                      exact hCurrPos
                    simpa [c] using hcPos
                  exact Nat.le_of_not_lt (fun hlt => by
                    have hq0 : (a * n + b) / m = 0 := Nat.div_eq_of_lt hlt
                    exact (Nat.ne_of_gt hPrevPos) hq0)
                have hIh := ih x y hPrev
                rw [hIh]
          _ = FloorProd.Spec.floorProdFormula (c - 1) a m b' y x * y * x ^ (k + 1) := by
                simp [pow_succ, mul_assoc]
          _ = FloorProd.Spec.floorProdFormula (((a * (n + 1) + b) / m) - 1) a m b' y x *
                y * x ^ (((a * (n + 1) + b) % m) / a) := by
                  have hkSucc : ((a * (n + 1) + b) % m) / a = k + 1 := by
                    rw [floorProd_step_mod_eq_of_lt n m a b hM hNoCarry]
                    simp [k, r]
                    simpa [Nat.mul_comm] using
                      (Nat.add_mul_div_right ((a * n + b) % m) 1 hA_pos)
                  simp [b', c, hqNoCarry, hkSucc]

end Internal

/--
入力/前提: `0 < st.m` と Euclid 側 fuel 十分性。
主張: `floorProdLoop fuel st` は常に
  `st.pre * floorProdFormula st.n st.m st.a st.b st.x st.y * st.suf`
  に一致する。
内容: 停止枝は閉形式補題、再帰枝は tex recurrence と tail の帰納法で処理する。
証明: fuel に関する帰納法。
役割: `floorProd_correct` を公開状態へ戻すための一般 loop invariant。
-/
lemma floorProdLoop_formula_invariant
    {α : Type _} [Monoid α]
    (fuel : Nat) (st : FloorProd.LoopState α) (hM : 0 < st.m)
    (hFuel : (Fuel.euclidN fuel st.a st.m).2 = 0) :
    Impl.floorProdLoop fuel st =
      st.pre * Spec.floorProdFormula st.n st.m st.a st.b st.x st.y * st.suf := by
  induction fuel generalizing st with
  | zero =>
      exact False.elim <|
        (Nat.ne_of_gt hM) (by simpa only [Fuel.euclidN] using hFuel)
  | succ fuel ih =>
      by_cases hc0 : ((st.a % st.m) * st.n + (st.b % st.m)) / st.m = 0
      · let p := st.a / st.m
        let q := st.b / st.m
        let a' := st.a % st.m
        let b' := st.b % st.m
        let x' := st.x * st.y ^ p
        have ha'lt : a' < st.m := by
          simp only [a']
          exact Nat.mod_lt _ hM
        have hb'lt : b' < st.m := by
          simp only [b']
          exact Nat.mod_lt _ hM
        have hlt : a' * st.n + b' < st.m := by
          rcases (Nat.div_eq_zero_iff.mp hc0) with hm | hlt
          · exact False.elim ((Nat.ne_of_gt hM) hm)
          · simpa [a', b'] using hlt
        have hStop :
            FloorProd.Spec.floorProdFormula st.n st.m a' b' x' st.y = x' ^ st.n := by
          exact Internal.floorProdFormula_eq_pow_of_stop_normalized st.n st.m a' b' x' st.y
            hM ha'lt hb'lt hlt
        calc
          Impl.floorProdLoop (fuel + 1) st
              = (st.pre * st.y ^ (st.b / st.m)) * (st.x * st.y ^ (st.a / st.m)) ^ st.n * st.suf :=
                  FloorProd.Internal.floorProdLoop_stop_of_cprime_zero fuel st hc0
          _ = st.pre * (st.y ^ q * (x' ^ st.n)) * st.suf := by
                simp [q, x', p, mul_assoc]
          _ = st.pre * FloorProd.Spec.floorProdFormula st.n st.m st.a st.b st.x st.y * st.suf := by
                rw [FloorProd.Spec.floorProdFormula_normalize st.n st.m st.a st.b st.x st.y hM,
                  hStop]
      · let p := st.a / st.m
        let a' := st.a % st.m
        let x' := st.x * st.y ^ p
        let q := st.b / st.m
        let b' := st.b % st.m
        let pre' := st.pre * st.y ^ q
        let c' := (a' * st.n + b') / st.m
        let d := ((st.m * c' - b' - 1) / a') + 1
        let suf' := st.y * (x' ^ (st.n - d)) * st.suf
        let st' : FloorProd.LoopState α :=
          { n := c' - 1
            m := a'
            a := st.m
            b := st.m - b' - 1 + a'
            x := st.y
            y := x'
            pre := pre'
            suf := suf' }
        rcases FloorProd.Internal.floorProd_step_bounds_of_cprime_ne_zero st hM hc0 with
          ⟨ha_lt, hb_lt, ha_pos, hY⟩
        rw [show Impl.floorProdLoop (fuel + 1) st = Impl.floorProdLoop fuel st' by
              simp [Impl.floorProdLoop, p, a', x', q, b', pre', c', d, suf', st', hc0]]
        rw [ih _ ha_pos (FloorProd.Internal.floorProd_fuel_tail fuel st.a st.m hM hFuel)]
        calc
          st'.pre * Spec.floorProdFormula st'.n st'.m st'.a st'.b st'.x st'.y * st'.suf
              = st.pre *
                  (st.y ^ q *
                    (Spec.floorProdFormula (c' - 1) a' st.m (st.m - b' - 1 + a') st.y x' *
                      (st.y * x' ^ (st.n - d)))) * st.suf := by
                        simp [st', pre', suf', mul_assoc]
          _ = st.pre * Spec.floorProdFormula st.n st.m st.a st.b st.x st.y * st.suf := by
                have ha'_lt : a' < st.m := by
                  simpa [a'] using ha_lt
                have hb'_lt : b' < st.m := by
                  simpa [b'] using hb_lt
                have ha'_pos : 0 < a' := by
                  simpa [a'] using ha_pos
                have hY' : st.m ≤ a' * st.n + b' := by
                  simpa [a', b'] using hY
                have hRecNorm :
                    Spec.floorProdFormula st.n st.m a' b' x' st.y =
                      Spec.floorProdFormula (c' - 1) a' st.m (st.m - b' - 1 + a') st.y x' *
                        st.y * x' ^ (((a' * st.n + b') % st.m) / a') := by
                  simpa [a', b', c', mul_assoc] using
                    (Internal.floorProdFormula_recurrence_normalized st.n st.m a' b' x' st.y
                      hM ha'_lt hb'_lt ha'_pos hY')
                have hExp : ((a' * st.n + b') % st.m) / a' = st.n - d := by
                  symm
                  simpa [a', b', c', d] using
                    (FloorProd.Internal.floorProd_exponent_bridge st.n st.m a' b'
                      hM ha'_lt hb'_lt ha'_pos hY')
                calc
                  st.pre *
                      (st.y ^ q *
                        (Spec.floorProdFormula (c' - 1) a' st.m (st.m - b' - 1 + a') st.y x' *
                          (st.y * x' ^ (st.n - d)))) * st.suf
                      = st.pre * (st.y ^ q * Spec.floorProdFormula st.n st.m a' b' x' st.y) *
                          st.suf := by
                              rw [hRecNorm, hExp]
                              simp [mul_assoc]
                  _ = st.pre * Spec.floorProdFormula st.n st.m st.a st.b st.x st.y * st.suf := by
                        rw [FloorProd.Spec.floorProdFormula_normalize
                          st.n st.m st.a st.b st.x st.y hM]

/--
入力/前提: `m>0`。
主張: 実装 `floorProd` は仕様 `floorProdFormula` と一致する。
内容: 以後の公開側では、原義的な積仕様を正準仕様として採用する。
役割: 公開側の中心正当化。
-/
theorem floorProd_correct
    {α : Type _} [Monoid α]
    (n m a b : Nat) (hM : 0 < m) (x y : α) :
    Impl.floorProd n m a b x y = Spec.floorProdFormula n m a b x y := by
  let st : FloorProd.LoopState α :=
    { n := n, m := m, a := a, b := b, x := x, y := y, pre := 1, suf := 1 }
  simpa [Impl.floorProd, Impl.floorProdSt, st] using
    floorProdLoop_formula_invariant (Fuel.stepBoundOfM m) st hM
      (by simpa using Fuel.floorProdLoop_fuel_sufficient st)

namespace Internal

/--
目的: Nat 添字版の目的関数を定義する。
定義: `a*i + b*⌊(c*i+d)/m⌋`。
入力/前提: `a b : Int`, `m c d i : Nat`。
出力: 型 `Int` の値を返す。
役割: floor_prod 側の `best/argmax` 正当性を記述する基底関数。
-/
private def phiNat (a b : Int) (m c d i : Nat) : Int :=
  a * Int.ofNat i + b * Int.ofNat ((c * i + d) / m)

/--
目的: `floorProdSpec ... (mwfElemX a) (mwfElemY b)` が最大値と最小 argmax を返す述語を定義する。
定義: `info? = some info` と、`phiNat` の上界・到達・最小性を束ねる。
入力/前提: `n m c d : Nat`, `a b : Int`, `res : FloorProd.Internal.mwfElem`。
出力: 型 `Prop` の値を返す。
役割: 基底枝・帰納枝の floor_prod 正当性補題を統一した形で表す。
-/
private def IsArgmaxResult
    (n m c d : Nat) (a b : Int) (res : FloorProd.Internal.mwfElem) : Prop :=
  ∃ info : FloorProd.Internal.BestInfo,
    res.info? = some info ∧
    (∀ i, i < n → phiNat a b m c d i ≤ info.best) ∧
    info.arg < n ∧
    phiNat a b m c d info.arg = info.best ∧
    (∀ i, i < n → phiNat a b m c d i = info.best → info.arg ≤ i)

/--
目的: `phiNat` 上で `info.best` が最大値として達成されるための基本条件を束ねる。
定義: 上界・到達点・達成点の範囲条件をまとめる。
役割: `mwf`/`mwfLr` 側への最大値復元補題の前提を短くする。
-/
private def PhiNatBestSpec
    (n m c d : Nat) (a b : Int) (info : FloorProd.Internal.BestInfo) : Prop :=
  (∀ i, i < n → phiNat a b m c d i ≤ info.best) ∧
    info.arg < n ∧
    phiNat a b m c d info.arg = info.best

/--
目的: `phiNat` 上で `info` が最小 argmax である条件を束ねる。
定義: `PhiNatBestSpec` に最小性条件を加えたもの。
役割: 区間版 argmax 復元補題の前提を短くする。
-/
private def PhiNatArgmaxSpec
    (n m c d : Nat) (a b : Int) (info : FloorProd.Internal.BestInfo) : Prop :=
  PhiNatBestSpec n m c d a b info ∧
    (∀ i, i < n → phiNat a b m c d i = info.best → info.arg ≤ i)

/--
入力/前提: `n,m,c,d : Nat`。
主張: `phiNat` の `n` から `n+1` への増分は、1 個の `X` と
  その直後に現れる `Y` 個数で表せる。
内容: `q_n = floor((c*n+d)/m)`, `q_{n+1} = floor((c*(n+1)+d)/m)` とすると、
  `phiNat(n+1) = phiNat(n) + a + b*(q_{n+1}-q_n)`。
証明: 定義展開後、商の増分を `Nat.sub_add_cancel` で分解して整理する。
役割: `R` を 1 つ増やしたときの floor_prod 側 1 ブロック追加と `phiNat` を対応させる。
-/
private lemma phiNat_succ_eq_add_step
    (n m c d : Nat) (a b : Int) :
    phiNat a b m c d (n + 1) =
      phiNat a b m c d n +
        (a + b * Int.ofNat (((c * (n + 1) + d) / m) - ((c * n + d) / m))) := by
  let q0 := (c * n + d) / m
  let q1 := (c * (n + 1) + d) / m
  have hq : q0 ≤ q1 := by
    exact Nat.div_le_div_right (Nat.add_le_add_right (Nat.mul_le_mul_left _ (Nat.le_succ _)) _)
  have hqsplitInt : (Int.ofNat q1 : Int) = Int.ofNat q0 + Int.ofNat (q1 - q0) := by
    simpa using
      (congrArg (fun t : Nat => (Int.ofNat t : Int)) (Nat.add_sub_of_le hq)).symm
  have hStep :
      a * Int.ofNat (n + 1) + b * Int.ofNat q1 =
        (a * Int.ofNat n + b * Int.ofNat q0) + (a + b * Int.ofNat (q1 - q0)) := by
    rw [hqsplitInt, show (Int.ofNat (n + 1) : Int) = Int.ofNat n + 1 by
          exact (Nat.cast_add n 1 : ((n + 1 : Nat) : Int) = _)]
    ring
  simpa [phiNat, q0, q1] using hStep

/--
入力/前提: 任意の `mwfElem` の右に 1 個の `X` ブロックを足す。
主張: `info? = none` なら新しい prefix だけが候補になり、`info? = some info` なら
  旧最大値と右端直前の累積和 `u.sum` の比較で `best/arg` が決まる。
内容: 右端更新で増える新候補は最後の 1 ブロックを使う prefix しかない。
証明: `u.info?` の場合分けと比較分岐をそのまま `mwfElemMul` から読む。
役割: `floorProdSpec` の積仕様を `n ↦ n+1` の右端更新に読み替える基本式。
-/
private lemma mwfElem_mul_mwfElemX_right_cases
    (u : FloorProd.Internal.mwfElem) (step : Int) :
    FloorProd.Internal.mwfElemMul u (FloorProd.Internal.mwfElemX step) =
      match u.info? with
      | none =>
          { sum := u.sum + step
            info? := some { best := u.sum, dx := 1, arg := 0 } }
      | some info =>
          if info.best >= u.sum then
            { sum := u.sum + step
              info? := some { best := info.best, dx := info.dx + 1, arg := info.arg } }
          else
            { sum := u.sum + step
              info? := some { best := u.sum, dx := info.dx + 1, arg := info.dx } } := by
  rcases u with ⟨s, info⟩
  cases info with
  | none =>
      simp [FloorProd.Internal.mwfElemMul, FloorProd.Internal.mwfElemX]
  | some info =>
      by_cases h : info.best >= s
      · simp [FloorProd.Internal.mwfElemMul, FloorProd.Internal.mwfElemX, h]
      · simp [FloorProd.Internal.mwfElemMul, FloorProd.Internal.mwfElemX, h]

/--
入力/前提: 任意の `mwfElem` の右に 1 個の `X` ブロックを足す。
主張: `sum` 成分は常に `u.sum + step` に更新される。
内容: `mwfElemX` は `best/arg` を持つが、`sum` 側には単に `step` を足すだけである。
証明: `mwfElem_mul_mwfElemX_right_cases` の各枝を見れば `sum` は共通で同じ。
役割: `floorProdFormula_mwfElem_sum_eq_phiNat` の帰納ステップを 1 行で済ませる。
-/
private lemma mwfElem_mul_mwfElemX_sum
    (u : FloorProd.Internal.mwfElem) (step : Int) :
    (FloorProd.Internal.mwfElemMul u (FloorProd.Internal.mwfElemX step)).sum = u.sum + step := by
  rcases u with ⟨s, info?⟩
  cases info? with
  | none =>
      simp [FloorProd.Internal.mwfElemMul, FloorProd.Internal.mwfElemX]
  | some info =>
      simp [FloorProd.Internal.mwfElemMul, FloorProd.Internal.mwfElemX]
      split_ifs <;> rfl

/--
入力/前提: `res.info? = some info` の状態で右に 1 個の `X` ブロックを足し、
  結果が `some info'` を持つ。
主張: 新しい `dx` は必ず `info.dx + 1` になる。
内容: 右端に 1 ブロック追加すると、最良 prefix の長さは比較結果に関わらず 1 だけ伸びる。
証明: `mwfElemMul` を展開し、2 分岐後の `info` を読む。
役割: `floorProdFormula_mwfElem_isArgmaxResult` の succ 枝で `dx` 更新を 1 行化する。
-/
private lemma mwfElem_mul_mwfElemX_dx_of_info
    (res : FloorProd.Internal.mwfElem) (step : Int)
    (info info' : FloorProd.Internal.BestInfo)
    (hRes : res.info? = some info)
    (hMul : (res * FloorProd.Internal.mwfElemX step).info? = some info') :
    info'.dx = info.dx + 1 := by
  rcases res with ⟨s, info?⟩
  cases info? with
  | none =>
      cases hRes
  | some info0 =>
      injection hRes with hInfoEq
      subst info0
      have hMul' :
          (FloorProd.Internal.mwfElemMul { sum := s, info? := some info }
            (FloorProd.Internal.mwfElemX step)).info? = some info' := by
        simpa using hMul
      have hCases := congrArg FloorProd.Internal.mwfElem.info?
        (mwfElem_mul_mwfElemX_right_cases { sum := s, info? := some info } step)
      rw [hCases] at hMul'
      by_cases hCmp : info.best >= s
      · have hMul' :
            some { best := info.best, dx := info.dx + 1, arg := info.arg } = some info' := by
            simpa only [hCmp] using hMul'
        cases hMul'
        simp
      · have hMul' :
            some { best := s, dx := info.dx + 1, arg := info.dx } = some info' := by
            simpa only [hCmp] using hMul'
        cases hMul'
        simp

/--
入力/前提: `k : Nat`。
主張: `mwfElemY b ^ k` は `sum = k*b`, `info? = none` に等しい。
内容: `Y` は情報を持たないので、冪でも和だけが線形に伸びる。
証明: `k` による帰納法と `mwfElemMul` の `none/none` 枝の展開で示す。
役割: `q = 1` 基底枝で `floorProdSpec 0 ...` を `X` 冪へ簡約した後の整理に使う。
-/
private lemma mwfElemY_pow (b : Int) :
    ∀ k : Nat, (FloorProd.Internal.mwfElemY b) ^ k =
      { sum := Int.ofNat k * b, info? := none }
  | 0 => by
      have hOne : (1 : FloorProd.Internal.mwfElem) = { sum := 0, info? := none } := rfl
      simpa [Int.ofNat_eq_natCast] using hOne
  | k + 1 => by
      calc
        (FloorProd.Internal.mwfElemY b) ^ (k + 1)
            = (FloorProd.Internal.mwfElemY b) ^ k * FloorProd.Internal.mwfElemY b := by
                simp only [pow_succ]
        _ = ({ sum := Int.ofNat k * b, info? := none } : FloorProd.Internal.mwfElem) *
              FloorProd.Internal.mwfElemY b := by
                rw [mwfElemY_pow b k]
        _ = { sum := Int.ofNat k * b + b, info? := none } := by
              simpa [FloorProd.Internal.mwfElemY] using
                (FloorProd.Internal.MwfElemMul_none_none (Int.ofNat k * b) b)
        _ = { sum := Int.ofNat (k + 1) * b, info? := none } := by
              have hsum : Int.ofNat k * b + b = Int.ofNat (k + 1) * b := by
                calc
                  Int.ofNat k * b + b = (Int.ofNat k + 1) * b := by ring
                  _ = Int.ofNat (k + 1) * b := by
                        simp only [Int.ofNat_eq_natCast, Nat.cast_add, Nat.cast_one]
              simp only [hsum]

/--
入力/前提: `res.info? = some info`。
主張: `Y^q * res` は `best` を `q*b` だけ平行移動した `some info` を保つ。
内容: 左側の `Y` 冪は `info` を持たないので、右側情報の位置は変わらない。
証明: `mwfElemY_pow` で冪を閉形式化し、`mwfElemMul` の `none/some` 枝を展開する。
役割: 正規化の前置因子 `Y^q` を argmax 証明へ戻すときに使う。
-/
private lemma mwfElemY_pow_mul_some
    (b s : Int) (q : Nat) (info : FloorProd.Internal.BestInfo) :
    (FloorProd.Internal.mwfElemY b) ^ q *
        { sum := s, info? := some info } =
      { sum := Int.ofNat q * b + s
        info? := some
          { best := Int.ofNat q * b + info.best
            dx := info.dx
            arg := info.arg } } := by
  rw [mwfElemY_pow]
  simpa [Int.ofNat_eq_natCast, Internal.MwfMkInfoFromScore, Internal.MwfShiftScore,
    Internal.MwfInfoScore, zero_add] using
    (FloorProd.Internal.MwfElemMul_none_some (Int.ofNat q * b) s info)
/--
入力/前提: 任意の指数 `k`。
主張: `X a * Y^k` は 1 個の `X` 要素 `X (a + b*k)` に一致する。
内容: 右側の `Y` 冪は `sum` だけを持つので、`X` の傾きに定数を加えるだけになる。
証明: `mwfElemY_pow` で `Y` 冪を閉形式化し、`mwfElemMul` の `some/none` 枝を展開する。
役割: `floorProdFormula_succ` の末尾ブロックを 1 個の `X` 更新へ落とす。
-/
private lemma mwfElemX_mul_mwfElemY_pow_eq_step
    (a b : Int) (k : Nat) :
    FloorProd.Internal.mwfElemX a * (FloorProd.Internal.mwfElemY b) ^ k =
      FloorProd.Internal.mwfElemX (a + b * Int.ofNat k) := by
  rw [mwfElemY_pow]
  simpa [FloorProd.Internal.mwfElemX, FloorProd.Internal.mwfElemY, mul_comm,
    mul_left_comm, mul_assoc] using
    (FloorProd.Internal.MwfElemMul_some_none a (Int.ofNat k * b)
      { best := 0, dx := 1, arg := 0 })

/--
入力/前提: `0 < m`。
主張: `floorProdFormula ... (X a) (Y b)` の `sum` 成分は `phiNat ... n` に一致する。
内容: `floorProdFormula_succ` と `phiNat_succ_eq_add_step` は同じ右端 1 ステップ更新を表す。
証明: `n` に関する帰納法で、末尾ブロックを `X` 1 個へまとめて比較する。
役割: 右端更新で新候補値が `phiNat ... n` になることを保証する。
-/
private lemma floorProdFormula_mwfElem_sum_eq_phiNat
    (n m c d : Nat) (a b : Int) (hM : 0 < m) :
    (FloorProd.Spec.floorProdFormula n m c d
      (FloorProd.Internal.mwfElemX a) (FloorProd.Internal.mwfElemY b)).sum =
      phiNat a b m c d n := by
  induction n with
  | zero =>
      simp [FloorProd.Spec.floorProdFormula, Nat.ne_of_gt hM, phiNat, mwfElemY_pow, mul_comm]
  | succ n ih =>
      let delta : Nat := ((c * (n + 1) + d) / m) - ((c * n + d) / m)
      let step : Int := a + b * Int.ofNat delta
      calc
        (FloorProd.Spec.floorProdFormula (n + 1) m c d
            (FloorProd.Internal.mwfElemX a) (FloorProd.Internal.mwfElemY b)).sum
            = (FloorProd.Spec.floorProdFormula n m c d
                (FloorProd.Internal.mwfElemX a) (FloorProd.Internal.mwfElemY b) *
                FloorProd.Internal.mwfElemX step).sum := by
                    rw [FloorProd.Spec.floorProdFormula_succ n m c d,
                      mwfElemX_mul_mwfElemY_pow_eq_step a b delta]
        _ = (FloorProd.Spec.floorProdFormula n m c d
              (FloorProd.Internal.mwfElemX a) (FloorProd.Internal.mwfElemY b)).sum + step := by
                exact mwfElem_mul_mwfElemX_sum
                  (FloorProd.Spec.floorProdFormula n m c d
                    (FloorProd.Internal.mwfElemX a) (FloorProd.Internal.mwfElemY b)) step
        _ = phiNat a b m c d n + step := by rw [ih]
        _ = phiNat a b m c d (n + 1) := by
              simpa [delta, step] using (phiNat_succ_eq_add_step n m c d a b).symm

/--
入力/前提: 長さ `n` の Nat 側問題で既存の最大値を保つ分岐に入る。
主張: `best/arg` を保ったまま `dx` だけを 1 増やした結果は、長さ `n+1` でも正しい。
内容: 新しい候補 `phiNat ... n` は旧最大値以下なので、最大値と最小 argmax は変化しない。
証明: `mwfElem_mul_mwfElemX_right_cases` の `keep best` 枝を展開し、
  `i < n+1` を `i < n` または `i = n` に分ける。
役割: `isArgmaxResult_step` の既存最大値維持分岐を短く保つ。
-/
private lemma isArgmaxResult_step_keep_best
    (n m c d : Nat) (a b step s : Int) (info : FloorProd.Internal.BestInfo)
    (hUpper : ∀ i, i < n → phiNat a b m c d i ≤ info.best)
    (hArgLt : info.arg < n)
    (hHit : phiNat a b m c d info.arg = info.best)
    (hMin : ∀ i, i < n → phiNat a b m c d i = info.best → info.arg ≤ i)
    (hSum : s = phiNat a b m c d n)
    (hCmp : info.best >= s) :
    IsArgmaxResult (n + 1) m c d a b
      ({ sum := s, info? := some info } * FloorProd.Internal.mwfElemX step) := by
  refine ⟨{ best := info.best, dx := info.dx + 1, arg := info.arg }, ?_, ?_, ?_, ?_, ?_⟩
  · simpa [hCmp] using congrArg FloorProd.Internal.mwfElem.info?
      (mwfElem_mul_mwfElemX_right_cases
        { sum := s, info? := some info } step)
  · intro i hi
    rcases Nat.lt_or_eq_of_le (Nat.le_of_lt_succ hi) with hin | rfl
    · exact hUpper i hin
    · simpa [hSum] using hCmp
  · exact Nat.lt_trans hArgLt (Nat.lt_succ_self n)
  · exact hHit
  · intro i hi hiEq
    rcases Nat.lt_or_eq_of_le (Nat.le_of_lt_succ hi) with hin | rfl
    · exact hMin i hin hiEq
    · exact Nat.le_of_lt hArgLt

/--
入力/前提: 長さ `n` の Nat 側問題で新しい末尾候補が旧最大値を真に上回る分岐に入る。
主張: 新しい最大値は `phiNat ... n` で、その最小 argmax は `n` になる。
内容: 旧区間の値はすべて旧最大値以下なので、新最大値より真に小さい。
証明: `mwfElem_mul_mwfElemX_right_cases` の `take new suffix` 枝を展開し、
  `i < n+1` を `i < n` または `i = n` に分ける。
役割: `isArgmaxResult_step` の新最大値更新分岐を短く保つ。
-/
private lemma isArgmaxResult_step_take_new
    (n m c d : Nat) (a b step s : Int) (info : FloorProd.Internal.BestInfo)
    (hUpper : ∀ i, i < n → phiNat a b m c d i ≤ info.best)
    (hSum : s = phiNat a b m c d n)
    (hDxInfo : info.dx = n)
    (hCmp : ¬ info.best >= s) :
    IsArgmaxResult (n + 1) m c d a b
      ({ sum := s, info? := some info } * FloorProd.Internal.mwfElemX step) := by
  refine ⟨{ best := s, dx := info.dx + 1, arg := n }, ?_, ?_, ?_, ?_, ?_⟩
  · simpa [hCmp, hDxInfo] using congrArg FloorProd.Internal.mwfElem.info?
      (mwfElem_mul_mwfElemX_right_cases
        { sum := s, info? := some info } step)
  · intro i hi
    rcases Nat.lt_or_eq_of_le (Nat.le_of_lt_succ hi) with hin | rfl
    · exact le_trans (hUpper i hin) (le_of_lt (lt_of_not_ge hCmp))
    · simp [hSum]
  · exact Nat.lt_succ_self n
  · simp [hSum]
  · intro i hi hiEq
    rcases Nat.lt_or_eq_of_le (Nat.le_of_lt_succ hi) with hin | rfl
    · exact False.elim <|
        not_lt_of_ge (hUpper i hin) (by simpa [hiEq] using (lt_of_not_ge hCmp))
    · exact le_rfl

/--
入力/前提: `res` が長さ `n` の Nat 側問題で最大値と最小 argmax を返し、
`res.sum = phiNat ... n` を満たす。
主張: 右に `X step` を 1 個付けた結果は長さ `n+1` の問題で正しい。
内容: 新しい候補は末尾 prefix `phiNat ... n` ただ 1 つであり、
旧最大値との比較だけで `best/arg` が更新される。
証明: `mwfElem_mul_mwfElemX_right_cases` の 2 分岐を、そのまま `phiNat` 側の
上界・到達・最小性へ移す。
役割: `floorProdFormula_mwfElem_isArgmaxResult` の主帰納ステップ。
-/
private lemma isArgmaxResult_step
    (n m c d : Nat) (a b step : Int) (res : FloorProd.Internal.mwfElem)
    (hRes : IsArgmaxResult n m c d a b res)
    (hSum : res.sum = phiNat a b m c d n)
    (hDx : ∀ info, res.info? = some info → info.dx = n) :
    IsArgmaxResult (n + 1) m c d a b
      (res * FloorProd.Internal.mwfElemX step) := by
  rcases hRes with ⟨info, hInfo, hUpper, hArgLt, hHit, hMin⟩
  rcases res with ⟨s, info?⟩
  cases info? with
  | none =>
      cases hInfo
  | some info0 =>
      injection hInfo with hInfoEq
      subst info0
      simp only at hSum
      by_cases hCmp : info.best >= s
      · exact isArgmaxResult_step_keep_best
          n m c d a b step s info hUpper hArgLt hHit hMin hSum hCmp
      · exact
          isArgmaxResult_step_take_new
            n m c d a b step s info hUpper hSum (hDx info rfl) hCmp

/--
入力/前提: `0 < m`。
主張: 長さ 1 の `floorProdFormula ... (mwfElemX a) (mwfElemY b)` は、
  `IsArgmaxResult` を満たし、さらに得られる `info.dx` は 1 である。
内容: `Y^q * X step` の形へ落とすと、候補は添字 0 の 1 つだけになる。
証明: `floorProdFormula_succ` を 1 回だけ展開し、`mwfElemY_pow_mul_some` で整理する。
役割: `floorProdFormula_mwfElem_isArgmaxResult` の base 枝を 1 行化する。
-/
private lemma floorProdFormula_mwfElem_isArgmaxResult_one
    (m c d : Nat) (a b : Int) (hM : 0 < m) :
    IsArgmaxResult 1 m c d a b
      (FloorProd.Spec.floorProdFormula 1 m c d
        (FloorProd.Internal.mwfElemX a) (FloorProd.Internal.mwfElemY b)) ∧
    (∀ info,
      (FloorProd.Spec.floorProdFormula 1 m c d
        (FloorProd.Internal.mwfElemX a) (FloorProd.Internal.mwfElemY b)).info? = some info →
      info.dx = 1) := by
  let q : Nat := d / m
  let delta : Nat := ((c * 1 + d) / m) - ((c * 0 + d) / m)
  let step : Int := a + b * Int.ofNat delta
  let info : FloorProd.Internal.BestInfo :=
    { best := Int.ofNat q * b, dx := 1, arg := 0 }
  have hZero :
      FloorProd.Spec.floorProdFormula 0 m c d
        (FloorProd.Internal.mwfElemX a) (FloorProd.Internal.mwfElemY b) =
      (FloorProd.Internal.mwfElemY b) ^ q := by
    simp [FloorProd.Spec.floorProdFormula, Nat.ne_of_gt hM, q]
  have hOne :
      FloorProd.Spec.floorProdFormula 1 m c d
        (FloorProd.Internal.mwfElemX a) (FloorProd.Internal.mwfElemY b) =
      (FloorProd.Internal.mwfElemY b) ^ q * FloorProd.Internal.mwfElemX step := by
    rw [FloorProd.Spec.floorProdFormula_succ 0 m c d, hZero,
      mwfElemX_mul_mwfElemY_pow_eq_step a b delta]
  have hInfoEq :
      FloorProd.Spec.floorProdFormula 1 m c d
        (FloorProd.Internal.mwfElemX a) (FloorProd.Internal.mwfElemY b) =
      { sum := Int.ofNat q * b + step, info? := some info } := by
    rw [hOne]
    simpa [q, step, info] using
      mwfElemY_pow_mul_some b step q { best := 0, dx := 1, arg := 0 }
  refine ⟨?_, ?_⟩
  · refine ⟨info, ?_, ?_, ?_, ?_, ?_⟩
    · simpa [info] using congrArg FloorProd.Internal.mwfElem.info? hInfoEq
    · intro i hi
      have hi0 : i = 0 := by omega
      subst hi0
      simp [phiNat, q, info, mul_comm]
    · simp [info]
    · simp [phiNat, q, info, mul_comm]
    · intro i hi _
      have hi0 : i = 0 := by omega
      subst hi0
      simp [info]
  · intro info' hInfo'
    have hEq : info' = info := by
      apply Option.some.inj
      exact hInfo'.symm.trans
        (by simpa [info] using congrArg FloorProd.Internal.mwfElem.info? hInfoEq)
    subst hEq
    simp [info]

/--
入力/前提: `0<n`, `0<m`。
主張: `floorProdFormula ... (mwfElemX a) (mwfElemY b)` は、`phiNat` の最大値と
  最小 `argmax` を表す `IsArgmaxResult` を満たす。
内容: Nat 添字側の主定理として、`info.best` が最大値、`info.arg` が最小 argmax
  であることを一括で述べる。
役割: Step 3 の Nat 側正当化そのもの。
-/
private lemma floorProdFormula_mwfElem_isArgmaxResult
    (n m c d : Nat) (a b : Int) (hN : 0 < n) (hM : 0 < m) :
    IsArgmaxResult n m c d a b
      (FloorProd.Spec.floorProdFormula n m c d
        (FloorProd.Internal.mwfElemX a) (FloorProd.Internal.mwfElemY b)) := by
  obtain ⟨n, rfl⟩ := Nat.exists_eq_succ_of_ne_zero (Nat.ne_of_gt hN)
  have hMain :
      ∀ n,
        IsArgmaxResult (n + 1) m c d a b
          (FloorProd.Spec.floorProdFormula (n + 1) m c d
            (FloorProd.Internal.mwfElemX a) (FloorProd.Internal.mwfElemY b)) ∧
        (∀ info,
          (FloorProd.Spec.floorProdFormula (n + 1) m c d
            (FloorProd.Internal.mwfElemX a) (FloorProd.Internal.mwfElemY b)).info? = some info →
          info.dx = n + 1) := by
    intro n
    induction n with
    | zero =>
        exact floorProdFormula_mwfElem_isArgmaxResult_one m c d a b hM
    | succ n ih =>
        rcases ih with ⟨ihArg, ihDx⟩
        let prev :=
          FloorProd.Spec.floorProdFormula (n + 1) m c d
            (FloorProd.Internal.mwfElemX a) (FloorProd.Internal.mwfElemY b)
        let delta : Nat := ((c * ((n + 1) + 1) + d) / m) - ((c * (n + 1) + d) / m)
        let step : Int := a + b * Int.ofNat delta
        have hFormula :
            FloorProd.Spec.floorProdFormula ((n + 1) + 1) m c d
              (FloorProd.Internal.mwfElemX a) (FloorProd.Internal.mwfElemY b) =
            prev * FloorProd.Internal.mwfElemX step := by
          rw [FloorProd.Spec.floorProdFormula_succ (n + 1) m c d,
            mwfElemX_mul_mwfElemY_pow_eq_step a b delta]
        refine ⟨?_, ?_⟩
        · rw [hFormula]
          have hSum : prev.sum = phiNat a b m c d (n + 1) := by
            simpa [prev] using
              floorProdFormula_mwfElem_sum_eq_phiNat (n + 1) m c d a b hM
          exact isArgmaxResult_step (n + 1) m c d a b step prev
            ihArg hSum ihDx
        · intro info hInfo
          rcases ihArg with ⟨infoPrev, hInfoPrev, _hUpperPrev, _hArgLtPrev, _hHitPrev, _hMinPrev⟩
          have hDxPrev : infoPrev.dx = n + 1 := ihDx infoPrev hInfoPrev
          have hStepDx : info.dx = infoPrev.dx + 1 := by
            apply mwfElem_mul_mwfElemX_dx_of_info prev step infoPrev info hInfoPrev
            simpa [hFormula] using hInfo
          simpa [hDxPrev] using hStepDx
  exact (hMain n).1

/--
入力/前提: `0<n`, `0<m`。
主張: `Impl.floorProd ... (mwfElemX a) (mwfElemY b)` 自体が
  `phiNat` の最大値と最小 argmax を返す `IsArgmaxResult` を満たす。
内容: `floorProd_correct` で `Impl.floorProd` を仕様側 `floorProdFormula` に移し、
  Nat 側主定理をそのまま適用する。
役割: 区間版の `max/argmax` 証明で使う共通入口。
-/
private lemma floorProd_mwfElem_isArgmaxResult
    (n m c d : Nat) (a b : Int) (hN : 0 < n) (hM : 0 < m) :
    IsArgmaxResult n m c d a b
      (Impl.floorProd n m c d
        (FloorProd.Internal.mwfElemX a) (FloorProd.Internal.mwfElemY b)) := by
  simpa only [FloorProd.Correctness.floorProd_correct n m c d hM (FloorProd.Internal.mwfElemX a)
        (FloorProd.Internal.mwfElemY b)] using
    (floorProdFormula_mwfElem_isArgmaxResult n m c d a b hN hM :
      IsArgmaxResult n m c d a b
        (FloorProd.Spec.floorProdFormula n m c d (FloorProd.Internal.mwfElemX a)
          (FloorProd.Internal.mwfElemY b)))


/--
目的: 区間復元で使う平行移動・正規化後の補助量を束ねる。
フィールド: `qC,cI,qD,dI,aI,cst`。
不変条件: 各フィールドは Step 4 の標準定義に従う。
役割: 区間版 `mwfLr` / `argmax` 復元補題の setup 記述を短く保つ。
-/
private structure FloorProdTranslateData where
  qC : Int
  cI : Int
  qD : Int
  dI : Int
  aI : Int
  cst : Int

/--
入力/前提: 区間パラメータと `0<M`。
主張: 区間復元で使う補助量 `qC,cI,qD,dI,aI,cst` をまとめて構成する。
内容: `C,D` の正規化と `x = L + i` への平行移動に必要な定数を 1 つの値へ束ねる。
役割: `phiNat` から `Spec.obj` / `mwfLr` へ戻す補題群の重複した setup を減らす。
-/
private def floorProdTranslateData
    (L M A B C D : Int) (hM : 0 < M) : FloorProdTranslateData :=
  let qC := Spec.zfloorDiv C M hM
  let cI := Spec.zfloorMod C M hM
  let qD := Spec.zfloorDiv (C * L + D) M hM
  let dI := Spec.zfloorMod (C * L + D) M hM
  let aI := A + B * qC
  let cst := A * L + B * qD
  { qC, cI, qD, dI, aI, cst }

/--
入力/前提: `0<M`, `0≤c`, `0≤d` と Nat 添字 `i`。
主張: 正規化済みの `Spec.obj a b c d M i` は `phiNat` に一致する。
内容: `c,d,M` を Nat へ落としても床除算値が保たれることを使う。
役割: 区間版証明で繰り返し現れる `Spec.obj` と `phiNat` の橋渡しを共通化する。
-/
private lemma obj_eq_phiNat_of_nonneg
    (a b c d M : Int) (i : Nat)
    (hM : 0 < M) (hc0 : 0 ≤ c) (hd0 : 0 ≤ d) :
    Spec.obj a b c d M (Int.ofNat i) hM =
      phiNat a b (Int.toNat M) (Int.toNat c) (Int.toNat d) i := by
  simp only [Spec.obj, Int.ofNat_eq_natCast, Spec.zfloorDiv, phiNat, Int.natCast_ediv, Nat.cast_add,
    Nat.cast_mul, Int.toNat_of_nonneg hc0, Int.toNat_of_nonneg hd0,
    Int.toNat_of_nonneg (le_of_lt hM)]

/--
入力/前提: `0<M` と Nat 添字 `i`。
主張: 区間版目的関数 `Spec.obj` は、Step 4 の補助量
  `qC,cI,qD,dI,aI,cst` を使って `cst + phiNat ... i` に分解できる。
内容: `x = L + i` への平行移動後、`
  floor((C*(L+i)+D)/M) = qD + floor((cI*i+dI)/M)` を `obj` 展開へ代入する。
役割: Step 4 の「Nat 側の argmax を区間 `[L,R)` へ戻す」橋渡し補題。
-/
private lemma phiNat_translate_to_obj
    (L M A B C D : Int) (hM : 0 < M) (i : Nat) :
    let qC := Spec.zfloorDiv C M hM
    let cI := Spec.zfloorMod C M hM
    let qD := Spec.zfloorDiv (C * L + D) M hM
    let dI := Spec.zfloorMod (C * L + D) M hM
    let aI := A + B * qC
    let cst := A * L + B * qD
    Spec.obj A B C D M (L + Int.ofNat i) hM =
      cst + phiNat aI B (Int.toNat M) (Int.toNat cI) (Int.toNat dI) i := by
  set qC : Int := Spec.zfloorDiv C M hM
  set cI : Int := Spec.zfloorMod C M hM
  set qD : Int := Spec.zfloorDiv (C * L + D) M hM
  set dI : Int := Spec.zfloorMod (C * L + D) M hM
  set aI : Int := A + B * qC
  set cst : Int := A * L + B * qD
  have hdI0 : 0 ≤ dI := by
    simpa only [dI, Spec.zfloorMod] using Int.emod_nonneg (C * L + D) (ne_of_gt hM)
  calc
    Spec.obj A B C D M (L + Int.ofNat i) hM
        = cst + Spec.obj A B C dI M (Int.ofNat i) hM := by
            simpa using
              Mwf.Correctness.Internal.obj_translate
                L M A B C D qD dI cst (Int.ofNat i) hM
                (by
                  simpa only [qD, dI] using
                    Mwf.Correctness.Internal.zfloorDiv_mod_decomp (C * L + D) M hM)
                rfl
    _ = cst + Spec.obj aI B cI dI M (Int.ofNat i) hM := by
          have hdIdiv0 : dI / M = 0 :=
            Int.ediv_eq_zero_of_lt_abs hdI0 (by
              simpa only [dI, Spec.zfloorMod, abs_of_pos hM] using
                Int.emod_lt_of_pos (C * L + D) hM)
          have hdImod : dI % M = dI := by
            simpa [Spec.zfloorDiv, Spec.zfloorMod, hdIdiv0] using
              (Mwf.Correctness.Internal.zfloorDiv_mod_decomp dI M hM).symm
          simpa [aI, cI, qC, Spec.obj, Spec.zfloorDiv, Spec.zfloorMod, Impl.normS,
            Impl.normA, Impl.normC, Impl.normD, hdIdiv0, hdImod] using
            congrArg
              (fun z => cst + z)
              (Mwf.Internal.normalize_obj_eq A B C dI M 0 (Int.ofNat i) hM)
    _ = cst + phiNat aI B (Int.toNat M) (Int.toNat cI) (Int.toNat dI) i := by
          simpa using
            obj_eq_phiNat_of_nonneg aI B cI dI M i hM
              (by
                simpa only [cI, Spec.zfloorMod] using
                  Int.emod_nonneg C (ne_of_gt hM))
              hdI0

/--
入力/前提: `L<R`, `0<M` と、Nat 側の `info` が最大値条件を満たすこと。
主張: その `info.best` を区間版へ戻すと `mwfLr = cst + info.best` になる。
内容: Nat 側 `phiNat` の上界・到達点を `Spec.obj` へ移し、
  平行移動された `mwfLr` の最大値と一致させる。
役割: `max` 側と `argmax` 側の両方で使う区間復元の共通部。
-/
private lemma mwfLr_eq_cst_add_best_of_bounds
    (L R M A B C D : Int)
    (hLR : L < R) (hM : 0 < M)
    (info : FloorProd.Internal.BestInfo) :
    let nI := R - L
    let qC := Spec.zfloorDiv C M hM
    let cI := Spec.zfloorMod C M hM
    let qD := Spec.zfloorDiv (C * L + D) M hM
    let dI := Spec.zfloorMod (C * L + D) M hM
    let aI := A + B * qC
    let cst := A * L + B * qD
    PhiNatBestSpec (Int.toNat nI) (Int.toNat M) (Int.toNat cI) (Int.toNat dI) aI B info →
    mwfLr L R M A B C D hLR hM = cst + info.best := by
  simp only
  intro hSpec
  let T := floorProdTranslateData L M A B C D hM
  have hNI : 0 < R - L := by
    nlinarith [hLR]
  have hcI0 : 0 ≤ T.cI := by
    simpa only [T, floorProdTranslateData, FloorProdTranslateData.cI, Spec.zfloorMod] using
      Int.emod_nonneg C (ne_of_gt hM)
  have hdI0 : 0 ≤ T.dI := by
    simpa only [T, floorProdTranslateData, FloorProdTranslateData.dI, Spec.zfloorMod] using
      Int.emod_nonneg (C * L + D) (ne_of_gt hM)
  have hNormMwf :
      mwf (R - L) M A B C T.dI hNI hM = mwf (R - L) M T.aI B T.cI T.dI hNI hM := by
    have hdIdiv0 : T.dI / M = 0 :=
      Int.ediv_eq_zero_of_lt_abs hdI0 (by
        simpa only [T, floorProdTranslateData, FloorProdTranslateData.dI, Spec.zfloorMod,
          abs_of_pos hM] using Int.emod_lt_of_pos (C * L + D) hM)
    have hdImod : T.dI % M = T.dI := by
      simpa [Spec.zfloorDiv, Spec.zfloorMod, hdIdiv0] using
        (Mwf.Correctness.Internal.zfloorDiv_mod_decomp T.dI M hM).symm
    calc
      mwf (R - L) M A B C T.dI hNI hM =
          B * (T.dI / M) + mwf (R - L) M T.aI B T.cI T.dI hNI hM := by
            simpa [T, floorProdTranslateData, hdImod, Impl.normS, Impl.normA, Impl.normC,
              Impl.normD] using
              Mwf.Internal.normalize_mwf_eq 0 (R - L) M A B C T.dI hNI hM
      _ = mwf (R - L) M T.aI B T.cI T.dI hNI hM := by simp [hdIdiv0]
  have hBestEqMwf : info.best = mwf (R - L) M T.aI B T.cI T.dI hNI hM := by
    rcases hSpec with ⟨hUpper, hArgLt, hHit⟩
    have hObjEqPhi (i : Nat) :
        Spec.obj T.aI B T.cI T.dI M (Int.ofNat i) hM =
          phiNat T.aI B (Int.toNat M) (Int.toNat T.cI) (Int.toNat T.dI) i := by
      simpa using obj_eq_phiNat_of_nonneg T.aI B T.cI T.dI M i hM hcI0 hdI0
    exact le_antisymm
      (((hObjEqPhi info.arg).trans hHit).symm ▸
        Spec.obj_le_mwf (R - L) M T.aI B T.cI T.dI (Int.ofNat info.arg) hNI hM
          (by
            refine Finset.mem_Icc.mpr ⟨Int.natCast_nonneg info.arg, ?_⟩
            have hArgLt' : Int.ofNat info.arg < R - L := by
              simpa only [Int.toNat_of_nonneg (le_of_lt hNI)] using Int.ofNat_lt.mpr hArgLt
            linarith))
      (by
        rcases Mwf.Internal.exists_obj_eq_mwf (R - L) M T.aI B T.cI T.dI hNI hM with
          ⟨x, hxDom, hxEq⟩
        have hx0 : 0 ≤ x := (Finset.mem_Icc.mp hxDom).1
        have hxlt : x < R - L := by
          have hxle : x ≤ R - L - 1 := (Finset.mem_Icc.mp hxDom).2
          linarith
        let j : Nat := Int.toNat x
        have hjlt : j < Int.toNat (R - L) := (Int.toNat_lt_toNat hNI).2 hxlt
        have hxj : Int.ofNat j = x := by
          simpa only [j] using Int.toNat_of_nonneg hx0
        rw [← hxEq, ← hxj]
        calc
          Spec.obj T.aI B T.cI T.dI M (Int.ofNat j) hM
              = phiNat T.aI B (Int.toNat M) (Int.toNat T.cI) (Int.toNat T.dI) j := hObjEqPhi j
          _ ≤ info.best := hUpper j hjlt)
  rw [Mwf.Correctness.Internal.mwfLr_translate_eq_mwf
    L R (R - L) M A B C D T.qD T.dI T.cst hLR hNI hM rfl
    (by
      simpa [T, floorProdTranslateData] using
        Mwf.Correctness.Internal.zfloorDiv_mod_decomp (C * L + D) M hM)
    rfl, hNormMwf, ← hBestEqMwf]
  simp [T, floorProdTranslateData]

/--
入力/前提: `L<R`, `0<M` と、Nat 側の `info` が最大値条件と最小 argmax 条件を満たすこと。
主張: その `info.arg` を区間版へ戻すと `mwfLrArgmax = L + info.arg` になる。
内容: `phiNat_translate_to_obj` で達成点集合へ戻し、最小性も `L + i` へ移送する。
役割: `floorProd_argmax_eq_mwfLrArgmax` の本体を共通化する。
-/
private lemma mwfLrArgmax_eq_translated_arg_of_bounds
    (L R M A B C D : Int)
    (hLR : L < R) (hM : 0 < M)
    (info : FloorProd.Internal.BestInfo) :
    let nI := R - L
    let qC := Spec.zfloorDiv C M hM
    let cI := Spec.zfloorMod C M hM
    let dI := Spec.zfloorMod (C * L + D) M hM
    let aI := A + B * qC
    PhiNatArgmaxSpec (Int.toNat nI) (Int.toNat M) (Int.toNat cI) (Int.toNat dI) aI B info →
    mwfLrArgmax L R M A B C D hLR hM = L + Int.ofNat info.arg := by
  simp only
  intro hSpec
  let T := floorProdTranslateData L M A B C D hM
  let s := mwfLrArgDom L R M A B C D hLR hM
  have hArgmin :
      L + Int.ofNat info.arg ∈ s ∧
        ∀ x, x ∈ s → L + Int.ofNat info.arg ≤ x := by
    have hSpecT :
        PhiNatArgmaxSpec (Int.toNat (R - L)) (Int.toNat M) (Int.toNat T.cI)
          (Int.toNat T.dI) T.aI B info := by
      simpa [T, floorProdTranslateData, PhiNatArgmaxSpec, PhiNatBestSpec] using hSpec
    have hMaxEq :
        mwfLr L R M A B C D hLR hM = T.cst + info.best := by
      simpa [T, floorProdTranslateData] using
        mwfLr_eq_cst_add_best_of_bounds L R M A B C D hLR hM info
          (by simpa [T, floorProdTranslateData] using hSpecT.1)
    rcases hSpecT.1 with ⟨_, hArgLt, hHit⟩
    refine ⟨?_, ?_⟩
    · refine Finset.mem_filter.mpr ⟨?_, ?_⟩
      · exact Finset.mem_Icc.mpr ⟨le_add_of_nonneg_right (Int.natCast_nonneg info.arg), by
          have : Int.ofNat info.arg < R - L := by
            simpa [T, floorProdTranslateData,
              Int.toNat_of_nonneg (sub_nonneg.mpr (le_of_lt hLR))] using
              Int.ofNat_lt.mpr hArgLt
          linarith⟩
      · calc
          Spec.obj A B C D M (L + Int.ofNat info.arg) hM
              = T.cst + phiNat T.aI B (Int.toNat M) (Int.toNat T.cI)
                  (Int.toNat T.dI) info.arg := by
                      simpa [T, floorProdTranslateData] using
                        phiNat_translate_to_obj L M A B C D hM info.arg
          _ = T.cst + info.best := by simpa [T] using congrArg (fun z => T.cst + z) hHit
          _ = mwfLr L R M A B C D hLR hM := by
            simpa [T, floorProdTranslateData] using hMaxEq.symm
    · intro x hx
      rcases Finset.mem_filter.mp hx with ⟨hxDom, hxEq⟩
      rcases Mwf.Internal.exists_nat_offset_of_mem_domLr hLR hxDom with ⟨j, hjlt, rfl⟩
      have hPhiEq :
          phiNat T.aI B (Int.toNat M) (Int.toNat T.cI) (Int.toNat T.dI) j = info.best :=
        add_left_cancel <| calc
          T.cst + phiNat T.aI B (Int.toNat M) (Int.toNat T.cI) (Int.toNat T.dI) j
              = Spec.obj A B C D M (L + Int.ofNat j) hM := by
                  simpa [T, floorProdTranslateData] using
                    (phiNat_translate_to_obj L M A B C D hM j).symm
          _ = mwfLr L R M A B C D hLR hM := hxEq
          _ = T.cst + info.best := by
            simpa [T, floorProdTranslateData] using hMaxEq
      have hArgLe : info.arg ≤ j := hSpecT.2 j hjlt hPhiEq
      simpa only [add_comm] using add_le_add_left (Int.ofNat_le.mpr hArgLe) L
  unfold mwfLrArgmax
  simpa [s] using
    (le_antisymm (Finset.min'_le _ _ hArgmin.1) (hArgmin.2 _ (Finset.min'_mem _ _)))

end Internal

/--
入力/前提: `L<R`, `0<M`, `0≤C`, `0≤D`。
主張: `max` と `argmax` の一致が示せれば、結果構造体も一致する。
内容: 内部の同値定理の逆方向だけを公開する。
証明: `Correctness.Internal` の同値定理へ成分等式の組を渡す。
役割: `mwfLrWithArgmaxFloorProd` の正当化を組み立てる公開補題。
-/
theorem mwfLrWithArgmaxFloorProd_eq_mwfLrWithArgmax
    (L R M A B C D : Int)
    (hLR : L < R) (hM : 0 < M) (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) :
    mwfLrWithArgmaxFloorProd L R M A B C D hLR hM hC0 hD0 =
      mwfLrWithArgmax L R M A B C D hLR hM := by
  let nI := R - L
  let qC := Spec.zfloorDiv C M hM
  let cI := Spec.zfloorMod C M hM
  let qD := Spec.zfloorDiv (C * L + D) M hM
  let dI := Spec.zfloorMod (C * L + D) M hM
  let aI := A + B * qC
  let cst := A * L + B * qD
  let res : FloorProd.Internal.mwfElem :=
    Impl.floorProd (Int.toNat nI) (Int.toNat M) (Int.toNat cI) (Int.toNat dI)
      (FloorProd.Internal.mwfElemX aI) (FloorProd.Internal.mwfElemY B)
  have hIsArgmax :
      Internal.IsArgmaxResult
        (Int.toNat nI) (Int.toNat M) (Int.toNat cI) (Int.toNat dI) aI B res := by
    have hNnat : 0 < Int.toNat (R - L) :=
      Mwf.Fuel.Internal.int_toNat_pos_of_pos (by nlinarith [hLR])
    have hMnat : 0 < Int.toNat M :=
      Mwf.Fuel.Internal.int_toNat_pos_of_pos hM
    simpa [nI, qC, cI, qD, dI, aI, cst, res] using
      (Internal.floorProd_mwfElem_isArgmaxResult
        (Int.toNat (R - L)) (Int.toNat M)
        (Int.toNat (Spec.zfloorMod C M hM))
        (Int.toNat (Spec.zfloorMod (C * L + D) M hM))
        (A + B * Spec.zfloorDiv C M hM) B hNnat hMnat)
  obtain ⟨info, hResInfo, hArgmaxSpec⟩ :
      ∃ info : FloorProd.Internal.BestInfo,
        res.info? = some info ∧
          Internal.PhiNatArgmaxSpec
            (Int.toNat nI) (Int.toNat M) (Int.toNat cI) (Int.toNat dI) aI B info := by
    simpa [Internal.IsArgmaxResult, Internal.PhiNatArgmaxSpec,
      Internal.PhiNatBestSpec, and_assoc] using hIsArgmax
  have hResInfo' :
      (Impl.floorProd (Int.toNat (R - L)) (Int.toNat M) (Int.toNat (C % M))
        (Int.toNat ((C * L + D) % M))
        (FloorProd.Internal.mwfElemX (A + B * (C / M)))
        (FloorProd.Internal.mwfElemY B)).info? = some info := by
    simpa [nI, qC, cI, qD, dI, aI, cst, res, Spec.zfloorDiv, Spec.zfloorMod] using hResInfo
  have hMaxEq :
      mwfLrFloorProd L R M A B C D hLR hM hC0 hD0 =
        mwfLr L R M A B C D hLR hM := by
    calc
      mwfLrFloorProd L R M A B C D hLR hM hC0 hD0 = cst + info.best := by
        simp [mwfLrFloorProd, mwfLrWithArgmaxFloorProd, cst, qD, hResInfo']
      _ = mwfLr L R M A B C D hLR hM := by
        simpa [nI, qC, cI, qD, dI, aI, cst, res] using
          (Internal.mwfLr_eq_cst_add_best_of_bounds
            L R M A B C D hLR hM info hArgmaxSpec.1).symm
  have hArgEq :
      mwfLrArgmaxFloorProd L R M A B C D hLR hM hC0 hD0 =
        mwfLrArgmax L R M A B C D hLR hM := by
    calc
      mwfLrArgmaxFloorProd L R M A B C D hLR hM hC0 hD0 = L + Int.ofNat info.arg := by
        simp [mwfLrArgmaxFloorProd, mwfLrWithArgmaxFloorProd, hResInfo']
      _ = mwfLrArgmax L R M A B C D hLR hM := by
        simpa [nI, qC, cI, qD, dI, aI, cst, res] using
          (Internal.mwfLrArgmax_eq_translated_arg_of_bounds
            L R M A B C D hLR hM info hArgmaxSpec).symm
  ext
  · simpa [mwfLrFloorProd, mwfLrWithArgmax] using hMaxEq
  · simpa [mwfLrArgmaxFloorProd, mwfLrWithArgmax] using hArgEq

/--
入力/前提: `L<R`, `0<M`, `0≤C`, `0≤D` と構造体レベルの一致。
主張: そのとき `max` 成分も一致する。
内容: `mwfLrWithArgmaxFloorProd = mwfLrWithArgmax` から第1成分を射影する。
証明: 内部の同値定理の順方向から第1成分を取り出す。
役割: `mwfLrFloorProd` の正当化を、構造体等式から取り出す補題。
-/
theorem mwfLrFloorProd_eq_mwfLr_of_withArgmaxEq
    (L R M A B C D : Int)
    (hLR : L < R) (hM : 0 < M) (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) :
    mwfLrFloorProd L R M A B C D hLR hM hC0 hD0 =
      mwfLr L R M A B C D hLR hM := by
  simpa only [mwfLrFloorProd, mwfLrWithArgmax] using
    congrArg mwfWithArgResult.max
      (mwfLrWithArgmaxFloorProd_eq_mwfLrWithArgmax
        L R M A B C D hLR hM hC0 hD0)

/--
入力/前提: `L<R`, `0<M`, `0≤C`, `0≤D` と構造体レベルの一致。
主張: そのとき `argmax` 成分も一致する。
内容: `mwfLrWithArgmaxFloorProd = mwfLrWithArgmax` から第2成分を射影する。
証明: 内部の同値定理の順方向から第2成分を取り出す。
役割: `mwfLrArgmaxFloorProd` の正当化を、構造体等式から取り出す補題。
-/
theorem mwfLrArgmaxFloorProd_eq_mwfLrArgmax_of_withArgmaxEq
    (L R M A B C D : Int)
    (hLR : L < R) (hM : 0 < M) (hC0 : 0 ≤ C) (hD0 : 0 ≤ D) :
    mwfLrArgmaxFloorProd L R M A B C D hLR hM hC0 hD0 =
      mwfLrArgmax L R M A B C D hLR hM := by
  simpa only [mwfLrArgmaxFloorProd, mwfLrWithArgmax] using
    congrArg mwfWithArgResult.argmax
      (mwfLrWithArgmaxFloorProd_eq_mwfLrWithArgmax
        L R M A B C D hLR hM hC0 hD0)

end Correctness

end FloorProd

end Mwf