Skip to content

Instantly share code, notes, and snippets.

@mizar

mizar/Divapprox2.lean

Last active February 24, 2026 17:10
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save mizar/8bdc0cfffba61b6de1eb0acce59fdd39 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save mizar/8bdc0cfffba61b6de1eb0acce59fdd39 to your computer and use it in GitHub Desktop.
Download ZIP
[Accuracy of Integer Division Approximate Function 2 解説](https://zenn.dev/mizar/articles/79ef8c9680265f) の形式的証明
Raw
Divapprox2.lean
import Mathlib
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 < Δ` の判定変形・存在条件・最小解探索の基準になる中心定義。
-/
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 形を簡潔に書くために使う。
-/
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` の存在判定と探索上界の分岐軸になる。
-/
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 < Δ` の出発点。
-/
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)` 型の一次式判定へ落とす第一段。
-/
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 判定式への変換を担う。
-/
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` で連結する。
証明: 既存補題の適用と式変形で示す。
役割: 可解性証明・上界証明・探索判定の共通インターフェース。
-/
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}
/--
目的: `x` 側での最小解仕様を述語として定義する。
定義: `x0 ≥ 0`、`K < Δ(x0)`、および任意の可解 `y` に対する `x0 ≤ y` を束ねる。
入力/前提: D A B K : Int、hD : 0 < D、hA : 0 < A。
出力: 型 `Prop` の値を返す。
役割: 最小解が `D` の倍数であること（`dvd_of_IsLeastX`）を形式化する土台。
-/
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` の倍数境界に限られることを与える。
-/
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`）へ落とす正当化。
-/
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` の値を返す。
役割: 最小解存在条件・二分探索仕様の共通前提。
-/
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`・存在条件・二分探索仕様の共通前提。
-/
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
/--
目的: 可解集合から `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, SolX D A B K hD hA hB x) : Int :=
by
classical
exact sInf {x : Int | 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, SolU D A B K hD hA hB u) : Int :=
by
classical
exact sInf {u : Int | 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, 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, SolU D A B K hD hA hB u then
uMinOf D A B K hD hA hB hex
else
-1
/--
入力/前提: 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` 側へ戻す橋渡し。
-/
lemma xMin_eq_D_mul_uMinOf
(hD : 0 < D)
(hA : 0 < A)
(hB : 0 < B)
(hex : ∃ u : Int, 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, 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 | 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 | 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 : 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 : 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 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 : 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 : 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 : 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` による矛盾導出で示す。
役割: 非可解ケースの返り値仕様を確定する。
-/
lemma xMin_eq_neg_one_of_no_solution
(hD : 0 < D)
(hA : 0 < A)
(hB : 0 < B)
(hno : ¬ ∃ u : Int, SolU D A B K hD hA hB u) :
xMin D A B K hD hA hB = -1 := by
classical
have hnoX : ¬ ∃ x : Int, SolX D A B K hD hA hB x := by
intro hexX
have hBddX : BddBelow ({x : Int | 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 : 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 : 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 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 : 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 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` で反復利用する。
-/
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` の値を返す。
役割: 存在定理・上界定理・二分探索正当化の共通仮定を簡潔にする。
-/
def HasUSolution
(D A B K : Int)
(hD : 0 < D) (hA : 0 < A) (hB : 0 < B) : Prop :=
∃ u : Int, 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` を明示せず使える形を与える。
-/
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)
/--
入力/前提: 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` での必要条件導出と上界評価の鍵となる剰余評価。
-/
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` なら `HasUSolution` が成り立つ。
内容: 候補 `u0 = A*B*K + 1` を取り、`R*u0 > A*B*K` と非負項 `((D*u0)%A)*M` で canonical 不等式を満たす。
証明: 式変形・既存補題の書き換えで示す。
役割: `R ≠ 0` ケースの存在性を一発で与える。
-/
lemma exists_u_of_R_ne_zero
(hD : 0 < D)
(hA : 0 < A)
(hB : 0 < B)
(hK : 0 ≤ K)
(hRnz : Rof D A B ≠ 0) :
HasUSolution D A B K hD hA hB := by
let u0 : Int := A * B * K + 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 hu0 : 0 ≤ u0 := by
dsimp only [u0]
omega
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 hRge1 : (1 : Int) ≤ Rof D A B := (Int.lt_iff_add_one_le).1 hRpos
have hM0 : 0 ≤ Mof D A B := by
unfold Mof
exact Int.ediv_nonneg (le_of_lt hABpos) (le_of_lt hD)
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_u0 : A * B * K < u0 := by
dsimp only [u0]
omega
have hu0_le_Ru0 : u0 ≤ Rof D A B * u0 := by
calc
u0 = 1 * u0 := by ring
_ ≤ Rof D A B * u0 := mul_le_mul_of_nonneg_right hRge1 hu0
have hABK_lt_Ru0 : A * B * K < Rof D A B * u0 := lt_of_lt_of_le hABK_lt_u0 hu0_le_Ru0
have hRu0_le_rhs :
Rof D A B * u0 ≤ ((D * u0) % A) * Mof D A B + Rof D A B * u0 := by
exact le_add_of_nonneg_left hterm0
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 hRu0_le_rhs
refine ⟨u0, hu0, ?_⟩
exact
(lt_Delta_iff_ABK_lt_canonical
(D := D) (A := A) (B := B) (K := K) (u := u0)
hD hA hB hu0 hK).2 hABK_lt_rhs
/--
入力/前提: 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` ケースの十分条件と具体的候補を与える中心補題。
-/
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, SolU D A B K hD hA hB u ∧ u < 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, EuclideanDomain.zero_mod,
sub_zero] using (Int.negSucc_emod 0 hA1pos)
have hremA1' : (D1 * u) % A1 = A1 - 1 := by
simpa only [Int.reduceNeg, hneg1] using hremA1
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) := Int.mul_emod_mul_of_pos (a := g) (b := D1 * u) (c := A1) hg0
_ = g * (A1 - 1) := by rw [hremA1']
_ = A - g := by
calc
g * (A1 - 1) = g * A1 - g := by ring
_ = A - g := by rw [hAsplit]
have hDM_eq_AB : D * Mof D A B = A * B := by
have hdecomp : D * ((A * B) / D) + (A * B) % D = A * B := Int.mul_ediv_add_emod (A * B) D
have hmod0 : (A * B) % D = 0 := by simpa only [EuclideanDomain.mod_eq_zero, Rof] using hR0
have hmain : D * ((A * B) / D) = A * B := by omega
simpa only [Mof] using hmain
have hABeqDM : A * B = D * Mof D A B := hDM_eq_AB.symm
have hABpos : 0 < A * B := Int.mul_pos hA hB
have hMpos : 0 < Mof D A B := by
have hprod : 0 < D * Mof D A B := by simpa only [hDM_eq_AB] 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
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 huDelta : K < Delta D A B (D * u) hD hA hB := by
exact
(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
have huLtDiv : u < A / g := by
simpa only using huLtA1
exact ⟨u, ⟨hu0, huDelta⟩, by simpa only [gcdDA, g] using huLtDiv⟩
/--
入力/前提: 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 で同値として確定する。
-/
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
let g : Int := gcdDA D A
have hDM_eq_AB : D * Mof D A B = A * B := by
have hdecomp : D * ((A * B) / D) + (A * B) % D = A * B := Int.mul_ediv_add_emod (A * B) D
have hmod0 : (A * B) % D = 0 := by simpa only [EuclideanDomain.mod_eq_zero, Rof] using hR0
have hmain : D * ((A * B) / D) = A * B := by omega
simpa only [Mof] using hmain
have hABeqDM : A * B = D * Mof D A B := hDM_eq_AB.symm
have hABpos : 0 < A * B := Int.mul_pos hA hB
have hMpos : 0 < Mof D A B := by
have hprod : 0 < D * Mof D A B := by simpa only [hDM_eq_AB] 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
constructor
· intro hsol
rcases hsol with ⟨u, 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 := by
exact (Du_mod_A_bounds_with_gcd (D := D) (A := A) (u := u) hA hu0).2
have hMnonneg : 0 ≤ Mof D A B := le_of_lt hMpos
have hremM_le : ((D * u) % A) * Mof D A B ≤ (A - g) * Mof D A B := by
exact mul_le_mul_of_nonneg_right hrem_le hMnonneg
have hABK_lt_bound : A * B * K < (A - g) * Mof D A B := lt_of_lt_of_le hABK_lt_remM hremM_le
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
_ < (A - g) * Mof D A B := hABK_lt_bound
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, gt_iff_lt] using this
· 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。
主張: 解があるなら `uMinOf ≥ K + 1`。
内容: 任意可解 `b` について `Δ(D,A,B,D*b) ≤ b` から `K < b` を導き `K+1 ≤ b` を得る。
証明: 式変形・既存補題の書き換えで示す。
役割: 探索区間の下界と最小解の基本的性質を与える。
-/
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 hM0 : 0 ≤ Mof D A B := by
unfold Mof
exact Int.ediv_nonneg (le_of_lt (Int.mul_pos hA hB)) (le_of_lt hD)
have hDb0 : 0 ≤ D * b := mul_nonneg (le_of_lt hD) hb0
have hDiv0 : 0 ≤ (D * b) / A := Int.ediv_nonneg hDb0 (le_of_lt hA)
have hSub0 : 0 ≤ ((Mof D A B * ((D * b) / A)) / B) := by
exact Int.ediv_nonneg (mul_nonneg hM0 hDiv0) (le_of_lt hB)
have hDelta_le : Delta D A B (D * b) hD hA hB ≤ b := by
have hrew :
Delta D A B (D * b) hD hA hB =
b - ((Mof D A B * ((D * b) / A)) / B) := by
simpa only [Mof] using
(Delta_Du_rewrite (D := D) (A := A) (B := B) (u := b) (M := Mof D A B) hD hA hB hb0 rfl)
rw [hrew]
exact sub_le_self _ hSub0
have hKltb : K < b := lt_of_lt_of_le hbK hDelta_le
exact (Int.add_one_le_iff).2 hKltb
/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `R = 0` かつ `D*K + gcd(D,A) < A` なら `uMinOf < A / gcd(D,A)`。
内容: `u < A/g` の可解候補を取り、`sInf ≤ u` から最小解の上界へ落とす。
証明: 既存補題の適用と式変形で示す。
役割: `R = 0` ケースの探索上界を与える。
-/
lemma uMin_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)
(hex : HasUSolution D A B K hD hA hB) :
uMinOf D A B K hD hA hB hex < A / gcdDA D A := by
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⟩
have hBdd : BddBelow ({z : Int | SolU D A B K hD hA hB z} : Set Int) := by
refine ⟨0, ?_⟩
intro z hz
exact hz.1
have hInfLe :
sInf ({z : Int | SolU D A B K hD hA hB z} : Set Int) ≤ u := csInf_le hBdd huSol
unfold uMinOf
exact lt_of_le_of_lt hInfLe huLt
/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `R ≠ 0` なら `uMinOf < (A*B*K)/R + 2`。
内容: `u0 = (A*B*K)/R + 1` を可解候補として構成し、`sInf ≤ u0 < ... + 2` を示す。
証明: 既存補題の書き換えで示す。
役割: `R ≠ 0` ケースの探索上界を与える。
-/
lemma uMin_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)
(hex : HasUSolution D A B K hD hA hB) :
uMinOf D A B K hD hA hB hex < (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 := by
unfold Mof
exact Int.ediv_nonneg (le_of_lt hABpos) (le_of_lt hD)
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 hRu0_le_rhs :
Rof D A B * u0 ≤ ((D * u0) % A) * Mof D A B + Rof D A B * u0 := by
exact le_add_of_nonneg_left hterm0
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 hRu0_le_rhs
have hCand : u0 ∈ ({u : Int | SolU D A B K hD hA hB u} : Set Int) := by
refine ⟨hu0, ?_⟩
exact
(lt_Delta_iff_ABK_lt_canonical
(D := D) (A := A) (B := B) (K := K) (u := u0)
hD hA hB hu0 hK).2 hABK_lt_rhs
have hBdd : BddBelow ({u : Int | SolU D A B K hD hA hB u} : Set Int) := by
refine ⟨0, ?_⟩
intro z hz
exact hz.1
have hInfLe :
sInf ({u : Int | SolU D A B K hD hA hB u} : Set Int) ≤ u0 := csInf_le hBdd hCand
have hu0_lt : u0 < (A * B * K) / (Rof D A B) + 2 := by
dsimp only [u0]
omega
unfold uMinOf
exact lt_of_le_of_lt hInfLe hu0_lt
/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: 可解なら常に粗い共通上界 `uMinOf < A*B*K + 2`。
内容: `R = 0` / `R ≠ 0`（さらに `K = 0` / `K > 0`）で分岐し既存の鋭い上界を統合する。
証明: 場合分け・式変形・既存補題の書き換えで示す。
役割: 場合分け不要で使える初期探索上界を提供する。
-/
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 := by
exact
(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).1 hex
by_cases hK0 : K = 0
· have hA0 : A ≠ 0 := ne_of_gt hA
have hglt : gcdDA D A < A := by
simpa only [hK0, mul_zero, zero_add] using hcond
have hNotDvd : ¬ A ∣ D := by
intro hAdvd
have hgEq : gcdDA D A = A := by
simpa only [gcdDA] using (Int.gcd_eq_right (le_of_lt hA) hAdvd)
have : A < A := by
have hglt' := hglt
rw [hgEq] at hglt'
exact hglt'
exact (lt_irrefl A) this
have hDmodNe : D % A ≠ 0 := by
intro hmod
apply hNotDvd
exact (Int.dvd_iff_emod_eq_zero).2 hmod
have hDmodPos : 0 < D % A := by
have hDmod0 : 0 ≤ D % A := Int.emod_nonneg _ hA0
exact lt_of_le_of_ne hDmod0 hDmodNe.symm
have hABpos : 0 < A * B := Int.mul_pos hA hB
have hDM : D * Mof D A B = A * B := by
have hdecomp : D * ((A * B) / D) + (A * B) % D = A * B := Int.mul_ediv_add_emod (A * B) D
have hmod0 : (A * B) % D = 0 := by simpa only [EuclideanDomain.mod_eq_zero, Rof] using hR0
have : D * ((A * B) / D) = A * B := by
omega
simpa only [Mof] using this
have hMpos : 0 < Mof D A B := by
have hprod : 0 < D * Mof D A B := by simpa only [hDM] 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
have hOneSol : SolU D A B K hD hA hB 1 := by
refine ⟨by decide, ?_⟩
have hABK_lt_rhs :
A * B * K <
((D * (1 : Int)) % A) * Mof D A B + Rof D A B * (1 : Int) := by
have hposRhs : 0 < (D % A) * Mof D A B := Int.mul_pos hDmodPos hMpos
have hposRhs' : 0 < ((D * (1 : Int)) % A) * Mof D A B + Rof D A B * (1 : Int) := by
simpa only [mul_one, hR0, add_zero] using hposRhs
have hABK0 : A * B * K = 0 := by simp only [hK0, mul_zero]
simpa only [hABK0, mul_one, gt_iff_lt] using hposRhs'
exact
(lt_Delta_iff_ABK_lt_canonical
(D := D) (A := A) (B := B) (K := K) (u := 1)
hD hA hB (by decide) hK).2 hABK_lt_rhs
have hBdd : BddBelow ({u : Int | SolU D A B K hD hA hB u} : Set Int) := by
refine ⟨0, ?_⟩
intro z hz
exact hz.1
have hInfLe1 :
sInf ({u : Int | SolU D A B K hD hA hB u} : Set Int) ≤ 1 :=
csInf_le hBdd hOneSol
have hlt2 :
sInf ({u : Int | SolU D A B K hD hA hB u} : Set Int) < 2 :=
lt_of_le_of_lt hInfLe1 (by decide)
have hgoal2 : A * B * K + 2 = 2 := by simp only [hK0, mul_zero, zero_add]
unfold uMinOf
simpa only [hgoal2, gt_iff_lt] using hlt2
· have hKpos : 0 < K := by
have h0ne : 0 ≠ K := by
intro h0
apply hK0
exact h0.symm
exact lt_of_le_of_ne hK h0ne
have hltAdiv :
uMinOf D A B K hD hA hB hex < A / gcdDA D A := by
exact
uMin_lt_A_div_g_of_R_eq_zero
(D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0 hcond hex
have hAdiv_le_A : A / gcdDA D A ≤ A := Int.ediv_le_self (gcdDA D A) (le_of_lt hA)
have hA_le_ABK : A ≤ A * B * K := by
have hA_le_AB : A ≤ A * B := by
have hBge1 : (1 : Int) ≤ B := (Int.lt_iff_add_one_le).1 hB
simpa only [ge_iff_le, mul_one] using mul_le_mul_of_nonneg_left hBge1 (le_of_lt hA)
have hKge1 : (1 : Int) ≤ K := (Int.lt_iff_add_one_le).1 hKpos
have hAB_le_ABK : A * B ≤ A * B * K := by
simpa only [mul_assoc, mul_one] using
mul_le_mul_of_nonneg_left hKge1 (mul_nonneg (le_of_lt hA) (le_of_lt hB))
exact le_trans hA_le_AB hAB_le_ABK
have hAdiv_le_ABK1 : A / gcdDA D A ≤ A * B * K + 1 := by
exact le_trans hAdiv_le_A (by omega)
have hltABK1 : uMinOf D A B K hD hA hB hex < A * B * K + 1 := by
exact lt_of_lt_of_le hltAdiv hAdiv_le_ABK1
exact lt_of_lt_of_le hltABK1 (by omega)
· have hlt :
uMinOf D A B K hD hA hB hex < (A * B * K) / (Rof D A B) + 2 := by
exact
uMin_lt_floor_ABK_div_R_plus_two_of_R_ne_zero
(D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0 hex
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
have hplusLe : (A * B * K) / (Rof D A B) + 2 ≤ A * B * K + 2 := by
simpa only [add_le_add_iff_right] using add_le_add_left hdivLe 2
exact lt_of_lt_of_le hlt hplusLe
/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: 可解性条件と最小解上界を一括で与える総合定理。
内容: `R ≠ 0` の存在性、`R = 0` の同値条件、および `uMinOf` の各種上界を同時に返す。
証明: 既存補題の適用と式変形で示す。
役割: 本文 `lem:exist` に対応する統合インターフェース。
-/
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
constructor
· intro hRnz
exact exists_u_of_R_ne_zero (D := D) (A := A) (B := B) (K := K) hD hA hB hK hRnz
constructor
· intro hR0
exact
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
constructor
· intro hR0
have hcond : D * K + gcdDA D A < A := by
exact
(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).1 hex
exact
uMin_lt_A_div_g_of_R_eq_zero
(D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0 hcond hex
constructor
· intro hRnz
exact
uMin_lt_floor_ABK_div_R_plus_two_of_R_ne_zero
(D := D) (A := A) (B := B) (K := K) hD hA hB hK hRnz hex
· exact uMin_lt_ABK_plus_two (D := D) (A := A) (B := B) (K := K) hD hA hB hK hex
end ExistAndBounds
section BinarySearchMinSketch
open MWF
variable {D A B K L R n N X u : Int}
/--
目的: 二分探索で使う評価関数 `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)` に接続する。
-/
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` を二分探索不変量として扱うための述語版。
-/
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` と同値化して `Δ` 側判定と探索手続きをつなぐ。
-/
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同値。
-/
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` 版のどちらでも扱えるようにする。
-/
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
have hu0 : 0 ≤ u := le_trans hL0 hLu
have hgt : B * K < fBinary D A B u := lt_of_not_ge hge
have hDelta : K < Delta D A B (D * u) hD hA hB := by
exact
(lt_Delta_iff_BK_lt_fBinary
(D := D) (A := A) (B := B) (K := K) (u := u)
hD hA hB hu0 hK).2 hgt
exact (hNoDelta u hLu huR) hDelta
· intro hNoBK u hLu huR hDelta
have hu0 : 0 ≤ u := le_trans hL0 hLu
have hgt : B * K < fBinary D A B u := by
exact
(lt_Delta_iff_BK_lt_fBinary
(D := D) (A := A) (B := B) (K := K) (u := u)
hD hA hB hu0 hK).1 hDelta
exact not_lt_of_ge (hNoBK u hLu huR) hgt
/--
入力/前提: hnN : n ≤ N、hNo : NoHitBK D A B K 0 N。
主張: `NoHitBK ... 0 N` が成り立てば、右端を縮めた `NoHitBK ... 0 n` も成り立つ。
内容: `u < n ≤ N` から `u < N` を得て元の仮定を適用する。
証明: 既存補題の適用と式変形で示す。
役割: 区間最大の単調性（prefix 安全性）を述語で使う補題。
-/
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 を貼り合わせる。
証明: 場合分けで示す。
役割: 二分探索で「前半が安全なら後半だけ判定すればよい」を形式化する。
-/
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
have hu0 : 0 ≤ u := le_trans hn0 hnu
exact hAll u hu0 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
/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `uMinOf` は可解集合 `{u | SolU ... u}` に属する。
内容: 可解集合の下方有界性と `Int.csInf_mem` を使って示す。
証明: 既存補題の書き換えで示す。
役割: `uMinOf` 自身を具体的な可解点として使うための基本補題。
-/
lemma uMinOf_mem
(hD : 0 < D)
(hA : 0 < A)
(hB : 0 < B)
(hex : HasUSolution D A B K hD hA hB) :
SolU D A B K hD hA hB (uMinOf D A B K hD hA hB hex) := by
have hBdd : BddBelow ({u : Int | 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` の最小性を不等式として使うための補助補題。
-/
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 : 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 | 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` の値を返す。
役割: 二分探索が満たすべき仕様を数学的に固定する。
-/
def NmaxSpec
(D A B K : Int)
(hD : 0 < D) (hA : 0 < A) (hB : 0 < B)
(Nmax : Int) : Prop :=
0 ≤ Nmax ∧
NoHitDelta D A B K hD hA hB 0 Nmax ∧
∀ N : Int, 0 ≤ N → 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` は不可解）から最大性を導く。
証明: 反証法で示す。
役割: 「最小可解点 = 最大安全長」を形式的に確立する中心定理。
-/
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 : SolU D A B K hD hA hB (uMinOf D A B K hD hA hB hex) := by
exact 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
have hle : uMinOf D A B K hD hA hB hex ≤ u := by
exact uMinOf_le_of_sol (D := D) (A := A) (B := B) (K := K) hD hA hB hex ⟨hu0, huDelta⟩
exact (not_lt_of_ge hle) huLt
· intro N hN0 hNoHit
by_contra hNle
have huMinLtN : uMinOf D A B K hD hA hB hex < N := lt_of_not_ge hNle
exact (hNoHit (uMinOf D A B K hD hA hB hex) huMin0 huMinLtN) huMinDelta
/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `NmaxSpec` を満たす値は一意。
内容: 2つの候補の最大性を相互適用して双方の `≤` を示し、反対称性で結ぶ。
証明: 既存補題の適用と式変形で示す。
役割: 仕様を満たす探索結果が `uMinOf` と一致する根拠を与える。
-/
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` で戻す。
証明: 式変形で示す。
役割: 探索アルゴリズム仕様から最終解の正しさを得る接続定理。
-/
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 huSpec : NmaxSpec D A B K hD hA hB (uMinOf D A B K hD hA hB hex) := by
exact uMinOf_is_NmaxSpec (D := D) (A := A) (B := B) (K := K) hD hA hB hex
have hEq : Nmax = uMinOf D A B K hD hA hB hex := by
exact NmaxSpec_unique (D := D) (A := A) (B := B) (K := K) hD hA hB hNmax huSpec
refine ⟨hEq.symm, ?_⟩
calc
xMin D A B K hD hA hB = D * uMinOf D A B K hD hA hB hex := by
exact xMin_eq_D_mul_uMinOf (D := D) (A := A) (B := B) (K := K) hD hA hB hex
_ = D * Nmax := by rw [hEq]
/--
入力/前提: hA : 0 < A。
主張: `fBinary` を平行移動した `MWF.obj` 形に等式変換できる。
内容: `u = (u-L)+L` で商の中身を再配置し、`fBinary = B*L + obj(..., u-L)` を示す。
証明: 式変形で示す。
役割: 区間最大 `F(L,R)` を `MWF.mwf` 計算へ接続する前処理補題。
-/
lemma fBinary_eq_shift_obj
(hA : 0 < A) :
fBinary D A B u =
B * L + MWF.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 [obj, zfloorDiv, neg_mul]
ring
/--
入力/前提: 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回評価へ落とす実装接続の主補題。
-/
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
let N0 : Int := R - L
have hN0 : 0 < N0 := by
exact sub_pos.mpr hLR
constructor
· intro hNo
have hMwfLe : MWF.mwf N0 A B (-(Mof D A B)) D (D * L) hN0 hA ≤ B * K - B * L := by
classical
let s : Finset Int := MWF.img N0 A B (-(Mof D A B)) D (D * L) hN0 hA
have hsNe : s.Nonempty := by
simpa only [s, img.eq_1, obj, zfloorDiv, neg_mul, dom, Finset.image_nonempty,
Finset.nonempty_Icc, Int.sub_nonneg, img] using
(MWF.img_nonempty (N := N0) (M := A) (A := B) (B := -(Mof D A B)) (C := D) (D := D * L)
hN0 hA)
change s.max' hsNe ≤ B * K - B * L
refine Finset.max'_le (s := s) (H := hsNe) (x := B * K - B * L) ?_
intro y hy
have hy' : y ∈ MWF.img N0 A B (-(Mof D A B)) D (D * L) hN0 hA := by
simpa only [s, img, obj, zfloorDiv, neg_mul, dom, Finset.mem_image, Finset.mem_Icc,
Order.le_sub_one_iff, img.eq_1] using hy
rcases Finset.mem_image.mp hy' with ⟨x, hx, rfl⟩
have hxI : x ∈ Finset.Icc (0 : Int) (N0 - 1) := by
simpa only [Finset.mem_Icc, Order.le_sub_one_iff, dom] using hx
rcases Finset.mem_Icc.mp hxI with ⟨hx0, hxN1⟩
have hxLt : x < N0 := by omega
have hLu : L ≤ L + x := by omega
have huR : L + x < R := by
have : x < R - L := by simpa only using hxLt
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.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 [obj, zfloorDiv, neg_mul, hCancel] using hTmp
have hSum :
B * L + MWF.obj B (-(Mof D A B)) D (D * L) A x hA ≤ B * K := by
simpa only [obj, zfloorDiv, neg_mul, hShift] using hfx
have hObj :
MWF.obj B (-(Mof D A B)) D (D * L) A x hA ≤ B * K - B * L := by
exact
(le_sub_iff_add_le).2 (by
simpa only [obj, zfloorDiv, add_comm, neg_mul] using hSum)
exact hObj
have hSum :
B * L + MWF.mwf N0 A B (-(Mof D A B)) D (D * L) hN0 hA ≤ B * K := by
have hTmp :
MWF.mwf N0 A B (-(Mof D A B)) D (D * L) hN0 hA + B * L ≤ B * K := by
exact (le_sub_iff_add_le).1 hMwfLe
simpa only [mwf, img, obj, zfloorDiv, add_comm, neg_mul, dom, ge_iff_le] using hTmp
simpa only [mwf, img, obj, zfloorDiv, neg_mul, dom, ge_iff_le] using hSum
· intro hMwf u hLu huR
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.dom N0 hN0 := by
change x ∈ Finset.Icc (0 : Int) (N0 - 1)
exact Finset.mem_Icc.mpr ⟨hx0, hxN1⟩
have hObjLeMwf :
MWF.obj B (-(Mof D A B)) D (D * L) A x hA
≤ MWF.mwf N0 A B (-(Mof D A B)) D (D * L) hN0 hA := by
exact
MWF.obj_le_mwf_of_mem
(N := N0) (M := A) (A := B) (B := -(Mof D A B)) (C := D) (D := D * L) hN0 hA
(y := x) hxDom
have hMwfLe : MWF.mwf N0 A B (-(Mof D A B)) D (D * L) hN0 hA ≤ B * K - B * L := by
have hMwf' :
B * L + MWF.mwf N0 A B (-(Mof D A B)) D (D * L) hN0 hA ≤ B * K := by
simpa only [mwf, img, obj, zfloorDiv, neg_mul, dom] using hMwf
exact
(le_sub_iff_add_le).2 (by
simpa only [mwf, img, obj, zfloorDiv, add_comm, neg_mul, dom] using hMwf')
have hObj :
MWF.obj B (-(Mof D A B)) D (D * L) A x hA ≤ B * K - B * L :=
le_trans hObjLeMwf hMwfLe
have hShift :
fBinary D A B u = B * L + MWF.obj B (-(Mof D A B)) D (D * L) A x hA := by
simpa only [obj, zfloorDiv, neg_mul] using
(fBinary_eq_shift_obj (D := D) (A := A) (B := B) (L := L) (u := u) hA)
have hSum : B * L + MWF.obj B (-(Mof D A B)) D (D * L) A x hA ≤ B * K := by
have hTmp : MWF.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
simpa only [obj, zfloorDiv, add_comm, neg_mul, ge_iff_le] using hTmp
simpa only [hShift, obj, zfloorDiv, neg_mul, ge_iff_le] using hSum
/--
入力/前提: 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` に接続するために使う。
-/
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
unfold MWF.mwfLr
dsimp only [imgLr.eq_1, obj.eq_1, zfloorDiv.eq_1, domLr.eq_1, Lean.Elab.WF.paramLet]
let s : Finset Int := MWF.imgLr L R A B (-(Mof D A B)) D 0 hLR hA
have hsNe : s.Nonempty := by
simpa only [s, imgLr.eq_1, obj, zfloorDiv, add_zero, neg_mul, domLr, Finset.image_nonempty,
Finset.nonempty_Icc, Order.le_sub_one_iff, imgLr] using
(MWF.imgLr_nonempty (L := L) (R := R) (M := A) (A := B) (B := -(Mof D A B)) (C := D) (D :=
0) hLR hA)
change s.max' hsNe ≤ B * K
refine Finset.max'_le (s := s) (H := hsNe) (x := B * K) ?_
intro y hy
have hy' : y ∈ MWF.imgLr L R A B (-(Mof D A B)) D 0 hLR hA := by
simpa only [s, imgLr, obj, zfloorDiv, add_zero, neg_mul, domLr, Finset.mem_image,
Finset.mem_Icc, Order.le_sub_one_iff, imgLr.eq_1] using hy
rcases Finset.mem_image.mp hy' with ⟨u, hu, rfl⟩
have huI : u ∈ Finset.Icc L (R - 1) := by
simpa only [Finset.mem_Icc, Order.le_sub_one_iff, domLr] using hu
rcases Finset.mem_Icc.mp huI with ⟨hLu, huR1⟩
have huR : u < R := by omega
have hObj :
MWF.obj B (-(Mof D A B)) D 0 A u hA = fBinary D A B u := by
calc
MWF.obj B (-(Mof D A B)) D 0 A u hA
= B * u + (-(Mof D A B)) * ((D * u + 0) / A) := by
simp only [obj, 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]
have hNoU : fBinary D A B u ≤ B * K := hNo u hLu huR
rw [hObj]
exact hNoU
· intro hMwf u hLu huR
have huR1 : u ≤ R - 1 := by omega
have huDom : u ∈ MWF.domLr L R hLR := by
change u ∈ Finset.Icc L (R - 1)
exact Finset.mem_Icc.mpr ⟨hLu, huR1⟩
have hObjLe :
MWF.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
dsimp only [obj, zfloorDiv, imgLr, domLr, Lean.Elab.WF.paramLet]
exact
Finset.le_max' (s := MWF.imgLr L R A B (-(Mof D A B)) D 0 hLR hA)
(x := MWF.obj B (-(Mof D A B)) D 0 A u hA)
(Finset.mem_image.mpr ⟨u, huDom, rfl⟩)
have hObj :
MWF.obj B (-(Mof D A B)) D 0 A u hA = fBinary D A B u := by
calc
MWF.obj B (-(Mof D A B)) D 0 A u hA
= B * u + (-(Mof D A B)) * ((D * u + 0) / A) := by
simp only [obj, 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]
have hObjLeBK : MWF.obj B (-(Mof D A B)) D 0 A u hA ≤ B * K := le_trans hObjLe hMwf
rw [hObj] at hObjLeBK
exact hObjLeBK
/--
入力/前提: hD : 0 < D。
主張: `D > 0` の下で `D*u < X ↔ u < (X + D - 1) / D`。
内容: `u+1` 形に変換して `Int.le_ediv_iff_mul_le` を往復する。
証明: 式変形・既存補題の書き換えで示す。
役割: `x` 側閾値比較を `u` 側の天井除算比較へ変換する。
-/
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
/--
入力/前提: hD : 0 < D、hA : 0 < A、hB : 0 < B。
主張: `¬ NoHitDelta ... L R` は区間内のヒット点存在と同値。
内容: `NoHitDelta` の全称否定を `simp` で存在形へ展開する。
証明: 既存補題の適用と式変形で示す。
役割: 不成立判定を具体的な証人 `u` の存在として扱う補助補題。
-/
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` 自身を証人に使う。
証明: 既存補題の適用と式変形で示す。
役割: 区間判定と最小解の位置比較を同一視する。
-/
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 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 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。
主張: `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回評価に帰着する判定定理。
-/
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]
have hxEq :
xMin D A B K hD hA hB = D * uMinOf D A B K hD hA hB hex := by
exact xMin_eq_D_mul_uMinOf (D := D) (A := A) (B := B) (K := K) hD hA hB hex
have hNoHit :
¬ NoHitDelta D A B K hD hA hB 0 ((X + D - 1) / D) ↔
uMinOf D A B K hD hA hB hex < (X + D - 1) / D := by
exact
not_NoHitDelta_zero_iff_uMin_lt
(D := D) (A := A) (B := B) (K := K) (N := (X + D - 1) / D) hD hA hB hex
constructor
· intro hxLt
have hMul : D * uMinOf D A B K hD hA hB hex < X := by
simpa only [hxEq] using hxLt
have huLt : uMinOf D A B K hD hA hB hex < (X + D - 1) / D := by
exact
(mul_lt_X_iff_lt_ceilDiv
(D := D) (X := X) (u := uMinOf D A B K hD hA hB hex) hD).1 hMul
exact hNoHit.mpr huLt
· intro hNot
have huLt : uMinOf D A B K hD hA hB hex < (X + D - 1) / D := hNoHit.mp hNot
have hMul : D * uMinOf D A B K hD hA hB hex < X := by
exact
(mul_lt_X_iff_lt_ceilDiv
(D := D) (X := X) (u := uMinOf D A B K hD hA hB hex) hD).2 huLt
simpa only [hxEq, gt_iff_lt] using hMul
end BinarySearchMinSketch
section Executable
open MWF
/--
目的: 除数 `10^19` に対する標準の商・剰余ペアを定義する。
定義: `divmod_d19 x := (x / 10^19, x % 10^19)`。
入力/前提: `x : Int`。
出力: 型 `Int × Int` の値 `(x / 10^19, x % 10^19)` を返す。
役割: `divmod_d19_125bit` / `divmod_d19_127bit` / `divmod_d19_128bit`
の正しさ定理における比較対象（仕様）として使う。
-/
def divmod_d19 (x : Int) : Int × Int :=
(x / (10 ^ (19 : Nat)), x % (10 ^ (19 : Nat)))
/--
目的: `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_125bit_correct_on_range` で与える。
-/
def divmod_d19_125bit (x : Int) : Int × Int :=
let D : Int := 10 ^ (19 : Nat)
let A : Int := 2 ^ (63 : Nat)
let B : Int := 2 ^ (64 : Nat)
let M : Int := A * B / D
let q : Int := ((x / A) * M) / B
let r : Int := x - q * D
if D ≤ r then
(q + 1, r - D)
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_127bit_correct_on_range` で与える。
-/
def divmod_d19_127bit (x : Int) : Int × Int :=
let D : Int := 10 ^ (19 : Nat)
let A : Int := 2 ^ (63 : Nat)
let B : Int := 2 ^ (64 : Nat)
let M : Int := A * B / D
let q : Int := ((x / A) * M) / B
let r : Int := 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)
/--
目的: `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_128bit_correct_on_range` で与える。
-/
def divmod_d19_128bit (x : Int) : Int × Int :=
let D : Int := 10 ^ (19 : Nat)
let A : Int := 2 ^ (64 : Nat)
let B : Int := 2 ^ (64 : Nat)
let M : Int := A * B / D
let q : Int := ((x / A) * M) / B
let r : Int := 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)
/--
目的: 区間最大値判定 `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` 側が安全か）に用いる。
-/
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.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` の反復本体。
-/
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` 探索インターフェース。
-/
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
/--
目的: 問題 `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 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}
/--
入力/前提: `hA : 0 < A`, `hL0 : 0 ≤ L`。
主張: 判定 `mwfLr_iter_le` は `NoHitBK` と同値。
内容: `L < R` の場合は `MWF.mwfLr_iter_collect` と `NoHitBK_iff_mwfLr_le` に還元し、
`L ≥ R` の場合は空区間で自明。
証明: 場合分けと `simp` で示す。
役割: 実装側 Bool 判定を論理側述語へ持ち上げる接続補題。
-/
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.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.mwfLr_iter_collect L R A B (-(Mof D A B)) D 0 hLR hA
have hNoHit :
NoHitBK D A B K L R ↔
MWF.mwfLr L R A B (-(Mof D A B)) D 0 hLR hA ≤ B * K := by
exact
NoHitBK_iff_mwfLr_le
(D := D) (A := A) (B := B) (K := K) (L := L) (R := R) hA hL0 hLR
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 only [mwfLr_iter_le, hLR, ↓reduceDIte, hA, hCollect, MWF.mwfLr, MWF.imgLr, MWF.obj,
MWF.zfloorDiv, add_zero, neg_mul, MWF.domLr, Finset.max'_le_iff, Finset.mem_image,
Finset.mem_Icc, Order.le_sub_one_iff, forall_exists_index, and_imp, decide_eq_true_eq]
exact hBool.trans hNoHit.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]
/--
入力/前提: なし（古典論理）。
主張: `¬ NoHitBK ... L R` は区間内の unsafe 点の存在と同値。
内容: 全称否定を存在形に展開する。
証明: 反証法で示す。
役割: 左半区間が unsafe な分岐で証人 `u` を取り出すために使う。
-/
lemma not_NoHitBK_iff_exists_hit
{L R : Int} :
¬ NoHitBK D A B K L R ↔
∃ u : Int, L ≤ u ∧ u < R ∧ B * K < fBinary D A B u := by
classical
constructor
· intro hNot
by_contra hNoEx
apply hNot
intro u hLu huR
by_contra hGe
exact hNoEx ⟨u, hLu, huR, lt_of_not_ge hGe⟩
· intro hEx hNo
rcases hEx with ⟨u, hLu, huR, hGt⟩
exact (not_lt_of_ge (hNo u hLu huR)) hGt
/--
入力/前提: `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` の中核補題。
-/
lemma compute_u_binary_aux_eq_tgt
(hA : 0 < A)
(tgt : Int)
(hTgtUnsafe : B * K < fBinary D A B tgt)
(hTgtMin : ∀ u : Int, 0 ≤ u → B * K < 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 hNoLeft : NoHitBK D A B K lo mid := by
exact (mwfLr_iter_le_iff_NoHitBK
(D := D) (A := A) (B := B) (K := K) (L := lo) (R := mid) hA hlo0).1 hSafe
have hMidLeTgt : mid ≤ tgt := by
by_contra hNot
have hTgtLtMid : tgt < mid := lt_of_not_ge hNot
have hSafeTgt : fBinary D A B tgt ≤ B * K := hNoLeft tgt hloTgt hTgtLtMid
exact (not_lt_of_ge hSafeTgt) hTgtUnsafe
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 hNoLeft : ¬ NoHitBK D A B K lo mid := by
intro hNo
exact hSafe ((mwfLr_iter_le_iff_NoHitBK
(D := D) (A := A) (B := B) (K := K) (L := lo) (R := mid) hA hlo0).2 hNo)
have hEx :
∃ u : Int, lo ≤ u ∧ u < mid ∧ B * K < fBinary D A B u := by
exact (not_NoHitBK_iff_exists_hit
(D := D) (A := A) (B := B) (K := K) (L := lo) (R := mid)).1 hNoLeft
rcases hEx with ⟨u, hLu, huMid, huUnsafe⟩
have hu0 : 0 ≤ u := le_trans hlo0 hLu
have hTgtLtMid : tgt < mid := by
exact lt_of_le_of_lt (hTgtMin u hu0 huUnsafe) huMid
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]
/--
入力/前提: `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` の両分岐で使う共通接続補題。
-/
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
let tgt : Int := uMinOf D A B K hD hA hB hex
have huMin : SolU D A B K hD hA hB tgt := by
simpa only using (uMinOf_mem (D := D) (A := A) (B := B) (K := K) hD hA hB hex)
have hTgtUnsafe : B * K < fBinary D A B tgt := by
exact
(lt_Delta_iff_BK_lt_fBinary
(D := D) (A := A) (B := B) (K := K) (u := tgt) hD hA hB huMin.1 hK).1 huMin.2
have hTgtMin : ∀ u : Int, 0 ≤ u → B * K < fBinary D A B u → tgt ≤ u := by
intro u hu0 huUnsafe
have huDelta : K < Delta D A B (D * u) hD hA hB := by
exact
(lt_Delta_iff_BK_lt_fBinary
(D := D) (A := A) (B := B) (K := K) (u := u) hD hA hB hu0 hK).2 huUnsafe
have hle :
uMinOf D A B K hD hA hB hex ≤ u := by
exact
uMinOf_le_of_sol
(D := D) (A := A) (B := B) (K := K) hD hA hB hex ⟨hu0, huDelta⟩
simpa only [ge_iff_le] using hle
have hlo0 : 0 ≤ K + 1 := by omega
have hlo' : K + 1 ≤ tgt := by simpa only [Order.add_one_le_iff] using hlo
have htgtHi' : tgt < hi := by simpa only using htgtHi
have hWidthNonneg : 0 ≤ hi - (K + 1) := by omega
have hWidthCast :
(Int.toNat (hi - (K + 1) + 1) : Int) = hi - (K + 1) + 1 := by
exact Int.toNat_of_nonneg (by omega)
have hWidth :
hi - (K + 1) ≤ (Int.toNat (hi - (K + 1) + 1) : Int) := by
calc
hi - (K + 1) ≤ hi - (K + 1) + 1 := by omega
_ = (Int.toNat (hi - (K + 1) + 1) : Int) := by
symm
exact hWidthCast
have hAux :
compute_u_binary_aux (Int.toNat (hi - (K + 1) + 1)) (B * K) (K + 1) hi A B (Mof D A B) D hA
= tgt := by
exact
compute_u_binary_aux_eq_tgt
(D := D) (A := A) (B := B) (K := K)
hA tgt hTgtUnsafe hTgtMin
(Int.toNat (hi - (K + 1) + 1)) (K + 1) hi
hlo0 hlo' htgtHi' hWidth
simpa only [compute_u_binary] using hAux
/--
入力/前提: `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`・`uMin_lt_A_div_g_of_R_eq_zero` で探索範囲を閉じる。
証明: `compute_u_binary_eq_uMinOf_of_hi` を `hi = A/g` に適用する。
役割: `compute_xMin_eq_xMin` の `R=0` 可解分岐を閉じる。
-/
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 hiff :
HasUSolution D A B K hD hA hB ↔ D * K + gcdDA D A < A := by
exact
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
have hcond : D * K + gcdDA D A < A := hiff.mp hex
have hlo : (K + 1 : Int) ≤ uMinOf D A B K hD hA hB hex := by
exact uMin_lower_bound (D := D) (A := A) (B := B) (K := K) hD hA hB hex
have htgtHi : uMinOf D A B K hD hA hB hex < A / gcdDA D A := by
exact
uMin_lt_A_div_g_of_R_eq_zero
(D := D) (A := A) (B := B) (K := K) hD hA hB hK hR0 hcond hex
have hEq :
compute_u_binary (B * K) (K + 1) (A / gcdDA D A) A B (Mof D A B) D hA
= uMinOf D A B K hD hA hB hex := by
exact
compute_u_binary_eq_uMinOf_of_hi
(D := D) (A := A) (B := B) (K := K) hD hA hB hK
hex (A / gcdDA D A) hlo htgtHi
simp only [hEq]
/--
入力/前提: `hD : 0 < D`, `hA : 0 < A`, `hB : 0 < B`, `hK : 0 ≤ K`。
主張: `R≠0` かつ可解な場合、実装側 `compute_u_binary` が `uMinOf` と一致する（`x=D*u` 形）。
内容: `uMin_lower_bound` と `uMin_lt_floor_ABK_div_R_plus_two_of_R_ne_zero` で探索範囲を閉じる。
証明: `compute_u_binary_eq_uMinOf_of_hi` を `hi = floor(ABK/R)+2` に適用する。
役割: `compute_xMin_eq_xMin` の `R≠0` 分岐を閉じる。
-/
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
dsimp only [Lean.Elab.WF.paramLet]
have hlo : (K + 1 : Int) ≤ uMinOf D A B K hD hA hB hex := by
exact uMin_lower_bound (D := D) (A := A) (B := B) (K := K) hD hA hB hex
have htgtHi :
uMinOf D A B K hD hA hB hex < (A * B * K) / (Rof D A B) + 2 := by
exact
uMin_lt_floor_ABK_div_R_plus_two_of_R_ne_zero
(D := D) (A := A) (B := B) (K := K) hD hA hB hK hRnz hex
have hEq :
compute_u_binary (B * K) (K + 1) ((A * B * K) / (Rof D A B) + 2) A B (Mof D A B) D hA
= uMinOf D A B K hD hA hB hex := by
exact
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) hlo htgtHi
simp only [hEq]
/--
入力/前提: `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) :
compute_xMin D A B K = xMin D A B K hD hA hB := by
have hExistPack :=
exist_and_search_upper_bound (D := D) (A := A) (B := B) (K := K) hD hA hB hK
by_cases hR0 : Rof D A B = 0
· have hiff :
HasUSolution D A B K hD hA hB ↔ D * K + gcdDA D A < A :=
(hExistPack.2.1 hR0)
by_cases hcond : D * K + gcdDA D A < A
· have hex : HasUSolution D A B K hD hA hB := (hiff.mpr hcond)
have hcomp :
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 hcond
calc
compute_xMin D A B K
= D * compute_u_binary (B * K) (K + 1) (A / gcdDA D A) A B (Mof D A B) D hA := by
simp only [compute_xMin, hD, ↓reduceDIte, hA, hB, hK, hR0, hnotle]
_ = D * uMinOf D A B K hD hA hB hex := hbinR0 hD hA hB hK hex hR0
have hx :
xMin D A B K hD hA hB = D * uMinOf D A B K hD hA hB hex :=
xMin_eq_D_mul_uMinOf (D := D) (A := A) (B := B) (K := K) hD hA hB hex
exact hcomp.trans hx.symm
· have hnoU : ¬ HasUSolution D A B K hD hA hB := by
exact fun hex => hcond (hiff.mp hex)
have hno : ¬ ∃ u : Int, SolU D A B K hD hA hB u := by
simpa only [not_exists, HasUSolution] using hnoU
have hx :
xMin D A B K hD hA hB = -1 :=
xMin_eq_neg_one_of_no_solution
(D := D) (A := A) (B := B) (K := K) hD hA hB hno
have hcomp : compute_xMin D A B K = -1 := by
have hLe : A ≤ D * K + gcdDA D A := le_of_not_gt hcond
simp only [compute_xMin, hD, ↓reduceDIte, hA, hB, hK, hR0, hLe, Int.reduceNeg]
exact hcomp.trans hx.symm
· have hex : HasUSolution D A B K hD hA hB :=
(hExistPack.1 hR0)
have hcomp :
compute_xMin D A B K = D * uMinOf D A B K hD hA hB hex := by
simpa only [compute_xMin, hD, ↓reduceDIte, hA, hB, hK, hR0, mul_eq_mul_left_iff] using
hbinRnz hD hA hB hK hex hR0
have hx :
xMin D A B K hD hA hB = D * uMinOf D A B K hD hA hB hex :=
xMin_eq_D_mul_uMinOf (D := D) (A := A) (B := B) (K := K) hD hA hB hex
exact hcomp.trans hx.symm
end ComputeCorrectness
section DivmodD19Correctness
/--
目的: `divmod_d19_7e37` で使う除数定数 `10^19` を名前付きで定義する。
定義: `D19 := 10^19`（`Int`）。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: 定理文で巨大定数の反復記述を避け、可読性を保つ。
-/
def D19 : Int := 10 ^ (19 : Nat)
/--
目的: `divmod_d19_125bit`, `divmod_d19_127bit` で使うシフト定数 `2^63` を名前付きで定義する。
定義: `A63 := 2^63`（`Int`）。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: 近似商 `q = floor((floor(x/A)*M)/B)` の定数部を簡潔に書く。
-/
def A63 : Int := 2 ^ (63 : Nat)
/--
目的: `divmod_d19_128bit` で使うシフト定数 `2^64` を名前付きで定義する。
定義: `A64 := 2^64`（`Int`）。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: `divmod_d19_128bit` の証明で `A` 側定数を簡潔に書く。
-/
def A64 : Int := 2 ^ (64 : Nat)
/--
目的: `divmod_d19_125bit`, `divmod_d19_127bit`, `divmod_d19_128bit` で使うシフト定数 `2^64` を名前付きで定義する。
定義: `B64 := 2^64`（`Int`）。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: 近似商計算および `compute_xMin` の評価式を簡潔にする。
-/
def B64 : Int := 2 ^ (64 : Nat)
/--
目的: 125bit 版（最大 1 回補正）の想定範囲上端を定数として与える。
定義: `xBound_d19_125bit := 78312161395427422060000000000000000000`。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: `x < xBound_d19_125bit` から `Δ ≤ 1` を導く範囲条件として使う。
-/
def xBound_d19_125bit : Int := 78312161395427422060000000000000000000
/--
目的: 127bit 版（最大 2 回補正）の想定範囲上端を定数として与える。
定義: `xBound_d19_127bit := 1086673501021195308190000000000000000000`。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: `x < xBound_d19_127bit` から `Δ ≤ 2` を導く範囲条件として使う。
-/
def xBound_d19_127bit : Int := 1086673501021195308190000000000000000000
/--
目的: 128bit 版（最大 3 回補正）の想定範囲上端を定数として与える。
定義: `xBound_d19_128bit := 1164985662416622730250000000000000000000`。
入力/前提: なし。
出力: 型 `Int` の値を返す。
役割: `x < xBound_d19_128bit` から `Δ ≤ 3` を導く範囲条件として使う。
-/
def xBound_d19_128bit : Int := 1164985662416622730250000000000000000000
/--
入力/前提: `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`）を与える補助補題。
-/
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` を導くための補助補題。
-/
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, SolX D A B K hD hA hB z
· intro hKx
have hBddX : BddBelow ({z : Int | 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_125bit` を返す。
内容: 実装定義を計算評価して定数等式を得る。
証明: `decide` で計算して示す。
役割: 125bit 範囲条件を `x < xMin(...,1)` に接続する。
-/
lemma compute_xMin_D19_A63_B64_K1 :
compute_xMin D19 A63 B64 1 = xBound_d19_125bit := by
set_option maxRecDepth 2000 in
decide
/--
入力/前提: なし。
主張: 定数系 `(D19,A63,B64,K=2)` に対して `compute_xMin` は
`xBound_d19_127bit` を返す。
内容: 実装定義を計算評価して定数等式を得る。
証明: `decide` で計算して示す。
役割: 127bit 範囲条件を `x < xMin(...,2)` に接続する。
-/
lemma compute_xMin_D19_A63_B64_K2 :
compute_xMin D19 A63 B64 2 = xBound_d19_127bit := by
set_option maxRecDepth 2000 in
decide
/--
入力/前提: なし。
主張: 定数系 `(D19,A64,B64,K=3)` に対して `compute_xMin` は
`xBound_d19_128bit` を返す。
内容: 実装定義を計算評価して定数等式を得る。
証明: `decide` で計算して示す。
役割: 128bit 範囲条件を `x < xMin(...,3)` に接続する。
-/
lemma compute_xMin_D19_A64_B64_K3 :
compute_xMin D19 A64 B64 3 = xBound_d19_128bit := by
set_option maxRecDepth 2000 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` 仕様への橋渡しを共通化する。
-/
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 : compute_xMin D A B K = bound)
(hx : x < bound) :
x < xMin D A B K hD hA hB := by
have hxMinEqComp : compute_xMin D A B K = xMin D A B K hD hA hB := by
exact compute_xMin_eq_xMin (D := D) (A := A) (B := B) (K := K) hD hA hB hK
calc
x < bound := hx
_ = 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` 範囲導出をまとめる。
-/
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 : 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
have hxLtXmin : x < xMin D A B K hD hA hB := by
exact 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
have hDeltaNotGt : ¬ K < Delta D A B x hD hA hB := by
exact
not_lt_Delta_of_lt_xMin
(D := D) (A := A) (B := B) (K := K) hD hA hB hx0 hxLtXmin
have hDeltaLe : Delta D A B x hD hA hB ≤ K := le_of_not_gt hDeltaNotGt
have hqLe : (((x / A) * ((A * B) / D)) / B) ≤ x / D := by
exact qApprox_le_trueQuot (D := D) (A := A) (B := B) hD hA hB hx0
have hDeltaNonneg : 0 ≤ Delta D A B x hD hA hB := by
unfold Delta
exact sub_nonneg.mpr hqLe
exact ⟨hDeltaNonneg, hDeltaLe⟩
/--
入力/前提: `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` と真の商の関係を引く共通補題。
-/
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`）をまとめる。
-/
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`) から商の一致を導く共通補題。
-/
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` 形を共通で扱うための補助補題。
-/
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` で示す。
役割: 補正後剰余が真の剰余に戻ることを共通で扱う補助補題。
-/
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` を共通に導く補助補題。
-/
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` で示す。
役割: 上位分岐条件が偽であることを共通に導く補助補題。
-/
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)
/--
入力/前提: `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` の分岐証明を共通化する。
-/
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 hqEq : q = x / D := by
have hqEq0 : q + 0 = x / D := q_add_eq_div_of_delta_eq hDeltaEq hDelta0
omega
have hrEqRem0 : r = x % D + D * 0 := r_eq_rem_add_D_mul_of_delta_eq hrEq hDelta0
have hrEqRem : r = x % D := by simpa only [mul_zero, add_zero] using hrEqRem0
have hNotGe : ¬ D ≤ r := by
have hNotGeMul1 : ¬ D * 1 ≤ r := by
exact
not_ge_D_mul_of_r_eq_rem_add_D_mul
(D := D) (x := x) (r := r) (k := 0) (m := 1)
hD (by decide) hrEqRem0
simpa only [mul_one] using hNotGeMul1
calc
(if D ≤ r then (q + 1, r - D) else (q, r)) = (q, r) := by
simp only [hNotGe, ↓reduceIte]
_ = (x / D, x % D) := by simp only [hqEq, hrEqRem]
· have hqPlusEq : q + 1 = x / D := by
exact q_add_eq_div_of_delta_eq hDeltaEq hDelta1
have hrEqRem1 : r = x % D + D * 1 := r_eq_rem_add_D_mul_of_delta_eq hrEq hDelta1
have hGe : D ≤ r := by
have hGeMul1 : D * 1 ≤ r := by
exact
ge_D_mul_of_r_eq_rem_add_D_mul
(D := D) (x := x) (r := r) (k := 1)
hD hrEqRem1
simpa only [mul_one] using hGeMul1
have hrSubEq : r - D = x % D := by
have hrSubEq1 : r - D * 1 = x % D := r_sub_D_mul_eq_rem_of_delta_eq hrEq hDelta1
simpa only [mul_one] using hrSubEq1
calc
(if D ≤ r then (q + 1, r - D) else (q, r)) = (q + 1, r - D) := by
simp only [hGe, ↓reduceIte]
_ = (x / D, x % D) := by simp only [hqPlusEq, hrSubEq]
/--
入力/前提: `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` の分岐証明を共通化する。
-/
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 hqEq : q = x / D := by
have hqEq0 : q + 0 = x / D := q_add_eq_div_of_delta_eq hDeltaEq hDelta0
omega
have hrEqRem0 : r = x % D + D * 0 := r_eq_rem_add_D_mul_of_delta_eq hrEq hDelta0
have hrEqRem : r = x % D := by simpa only [mul_zero, add_zero] using hrEqRem0
have hNotGe1 : ¬ D ≤ r := by
have hNotGeMul1 : ¬ D * 1 ≤ r := by
exact
not_ge_D_mul_of_r_eq_rem_add_D_mul
(D := D) (x := x) (r := r) (k := 0) (m := 1)
hD (by decide) hrEqRem0
simpa only [mul_one] using hNotGeMul1
have hNotGe2 : ¬ D * 2 ≤ r := by
exact
not_ge_D_mul_of_r_eq_rem_add_D_mul
(D := D) (x := x) (r := r) (k := 0) (m := 2)
hD (by decide) hrEqRem0
calc
(if D * 2 ≤ r then (q + 2, r - D * 2)
else if D ≤ r then (q + 1, r - D)
else (q, r)) = (q, r) := by
simp only [hNotGe2, ↓reduceIte, hNotGe1]
_ = (x / D, x % D) := by simp only [hqEq, hrEqRem]
· have hqPlusEq : q + 1 = x / D := by
exact q_add_eq_div_of_delta_eq hDeltaEq hDelta1
have hrEqRem1' : r = x % D + D * 1 := r_eq_rem_add_D_mul_of_delta_eq hrEq hDelta1
have hrEqRem1 : r = x % D + D := by simpa only [mul_one] using hrEqRem1'
have hGe1 : D ≤ r := by
have hGeMul1 : D * 1 ≤ r := by
exact
ge_D_mul_of_r_eq_rem_add_D_mul
(D := D) (x := x) (r := r) (k := 1)
hD hrEqRem1'
simpa only [mul_one] using hGeMul1
have hNotGe2 : ¬ D * 2 ≤ r := by
exact
not_ge_D_mul_of_r_eq_rem_add_D_mul
(D := D) (x := x) (r := r) (k := 1) (m := 2)
hD (by decide) hrEqRem1'
have hrSubEq : r - D = x % D := by
have hrSubEq1 : r - D * 1 = x % D := r_sub_D_mul_eq_rem_of_delta_eq hrEq hDelta1
simpa only [mul_one] using hrSubEq1
calc
(if D * 2 ≤ r then (q + 2, r - D * 2)
else if D ≤ r then (q + 1, r - D)
else (q, r)) = (q + 1, r - D) := by
simp only [hNotGe2, ↓reduceIte, hGe1]
_ = (x / D, x % D) := by simp only [hqPlusEq, hrSubEq]
· have hqPlus2Eq : q + 2 = x / D := by
exact q_add_eq_div_of_delta_eq hDeltaEq hDelta2
have hrEqRem2 : r = x % D + D * 2 := r_eq_rem_add_D_mul_of_delta_eq hrEq hDelta2
have hGe2 : D * 2 ≤ r := by
exact
ge_D_mul_of_r_eq_rem_add_D_mul
(D := D) (x := x) (r := r) (k := 2)
hD hrEqRem2
have hrSub2Eq : r - D * 2 = x % D := by
exact r_sub_D_mul_eq_rem_of_delta_eq hrEq hDelta2
calc
(if D * 2 ≤ r then (q + 2, r - D * 2)
else if D ≤ r then (q + 1, r - D)
else (q, r)) = (q + 2, r - D * 2) := by
simp only [hGe2, ↓reduceIte]
_ = (x / D, x % D) := by simp only [hqPlus2Eq, hrSub2Eq]
/--
入力/前提: `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` の分岐証明を共通化する。
-/
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 hqEq : q = x / D := by
have hqEq0 : q + 0 = x / D := q_add_eq_div_of_delta_eq hDeltaEq hDelta0
omega
have hrEqRem0 : r = x % D + D * 0 := r_eq_rem_add_D_mul_of_delta_eq hrEq hDelta0
have hrEqRem : r = x % D := by simpa only [mul_zero, add_zero] using hrEqRem0
have hNotGe1 : ¬ D ≤ r := by
have hNotGeMul1 : ¬ D * 1 ≤ r := by
exact
not_ge_D_mul_of_r_eq_rem_add_D_mul
(D := D) (x := x) (r := r) (k := 0) (m := 1)
hD (by decide) hrEqRem0
simpa only [mul_one] using hNotGeMul1
have hNotGe2 : ¬ D * 2 ≤ r := by
exact
not_ge_D_mul_of_r_eq_rem_add_D_mul
(D := D) (x := x) (r := r) (k := 0) (m := 2)
hD (by decide) hrEqRem0
have hNotGe3 : ¬ D * 3 ≤ r := by
exact
not_ge_D_mul_of_r_eq_rem_add_D_mul
(D := D) (x := x) (r := r) (k := 0) (m := 3)
hD (by decide) hrEqRem0
calc
(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)) = (q, r) := by
simp only [hNotGe3, ↓reduceIte, hNotGe2, hNotGe1]
_ = (x / D, x % D) := by simp only [hqEq, hrEqRem]
· have hqPlusEq : q + 1 = x / D := by
exact q_add_eq_div_of_delta_eq hDeltaEq hDelta1
have hrEqRem1' : r = x % D + D * 1 := r_eq_rem_add_D_mul_of_delta_eq hrEq hDelta1
have hrEqRem1 : r = x % D + D := by simpa only [mul_one] using hrEqRem1'
have hGe1 : D ≤ r := by
have hGeMul1 : D * 1 ≤ r := by
exact
ge_D_mul_of_r_eq_rem_add_D_mul
(D := D) (x := x) (r := r) (k := 1)
hD hrEqRem1'
simpa only [mul_one] using hGeMul1
have hNotGe2 : ¬ D * 2 ≤ r := by
exact
not_ge_D_mul_of_r_eq_rem_add_D_mul
(D := D) (x := x) (r := r) (k := 1) (m := 2)
hD (by decide) hrEqRem1'
have hNotGe3 : ¬ D * 3 ≤ r := by
exact
not_ge_D_mul_of_r_eq_rem_add_D_mul
(D := D) (x := x) (r := r) (k := 1) (m := 3)
hD (by decide) hrEqRem1'
have hrSubEq : r - D = x % D := by
have hrSubEq1 : r - D * 1 = x % D := r_sub_D_mul_eq_rem_of_delta_eq hrEq hDelta1
simpa only [mul_one] using hrSubEq1
calc
(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)) = (q + 1, r - D) := by
simp only [hNotGe3, ↓reduceIte, hNotGe2, hGe1]
_ = (x / D, x % D) := by simp only [hqPlusEq, hrSubEq]
· have hqPlus2Eq : q + 2 = x / D := by
exact q_add_eq_div_of_delta_eq hDeltaEq hDelta2
have hrEqRem2 : r = x % D + D * 2 := r_eq_rem_add_D_mul_of_delta_eq hrEq hDelta2
have hGe2 : D * 2 ≤ r := by
exact
ge_D_mul_of_r_eq_rem_add_D_mul
(D := D) (x := x) (r := r) (k := 2)
hD hrEqRem2
have hNotGe3 : ¬ D * 3 ≤ r := by
exact
not_ge_D_mul_of_r_eq_rem_add_D_mul
(D := D) (x := x) (r := r) (k := 2) (m := 3)
hD (by decide) hrEqRem2
have hrSub2Eq : r - D * 2 = x % D := by
exact r_sub_D_mul_eq_rem_of_delta_eq hrEq hDelta2
calc
(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)) = (q + 2, r - D * 2) := by
simp only [hNotGe3, ↓reduceIte, hGe2]
_ = (x / D, x % D) := by simp only [hqPlus2Eq, hrSub2Eq]
· have hqPlus3Eq : q + 3 = x / D := by
exact q_add_eq_div_of_delta_eq hDeltaEq hDelta3
have hrEqRem3 : r = x % D + D * 3 := r_eq_rem_add_D_mul_of_delta_eq hrEq hDelta3
have hGe3 : D * 3 ≤ r := by
exact
ge_D_mul_of_r_eq_rem_add_D_mul
(D := D) (x := x) (r := r) (k := 3)
hD hrEqRem3
have hrSub3Eq : r - D * 3 = x % D := by
exact r_sub_D_mul_eq_rem_of_delta_eq hrEq hDelta3
calc
(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)) = (q + 3, r - D * 3) := by
simp only [hGe3, ↓reduceIte]
_ = (x / D, x % D) := by simp only [hqPlus3Eq, hrSub3Eq]
/--
入力/前提: `hx0 : 0 ≤ x`, `hx : x < xBound_d19_125bit`。
主張: `divmod_d19_125bit x = divmod_d19 x`。
内容: 境界条件から `0 ≤ Delta ≤ 1` を導き、`q`,`r` の形へ落とす。
その後に共通補題 `divmod_if1_correct_of_delta_le1` を適用して結論を得る。
証明: 既存の共通補題を連結して示す。
役割: `divmod_d19_125bit` の利用域における正当性保証を与える。
-/
theorem divmod_d19_125bit_correct_on_range
{x : Int}
(hx0 : 0 ≤ x)
(hx : x < xBound_d19_125bit) :
divmod_d19_125bit x = divmod_d19 x := by
have hD : 0 < D19 := by decide
have hA : 0 < A63 := by decide
have hB : 0 < B64 := by decide
have hK : 0 ≤ (1 : Int) := by decide
have hDeltaBounds : 0 ≤ Delta D19 A63 B64 x hD hA hB ∧ Delta D19 A63 B64 x hD hA hB ≤ 1 := by
exact
delta_bounds_of_lt_compute_xMin_bound
(D := D19) (A := A63) (B := B64) (K := 1) (x := x) (bound := xBound_d19_125bit)
hD hA hB hK hx0 compute_xMin_D19_A63_B64_K1 hx
have hDeltaNonneg : 0 ≤ Delta D19 A63 B64 x hD hA hB := hDeltaBounds.1
have hDeltaLe1 : Delta D19 A63 B64 x hD hA hB ≤ 1 := hDeltaBounds.2
let M : Int := A63 * B64 / D19
let q : Int := ((x / A63) * M) / B64
let r : Int := x - q * D19
have hqDef : q = (((x / A63) * ((A63 * B64) / D19)) / B64) := by
simp [M, q]
have hDivmod :
divmod_d19_125bit x = if D19 ≤ r then (q + 1, r - D19) else (q, r) := by
unfold divmod_d19_125bit
simp only [Int.reducePow, Int.reduceMul, Int.reduceDiv, D19, A63, B64, r, q, M]
have hDeltaEq : Delta D19 A63 B64 x hD hA hB = x / D19 - q := by
exact Delta_eq_div_sub_q (D := D19) (A := A63) (B := B64) (x := x) (q := q) hD hA hB hqDef
have hrEq : r = x % D19 + D19 * Delta D19 A63 B64 x hD hA hB := by
calc
r = x - q * D19 := by rfl
_ = x % D19 + D19 * Delta D19 A63 B64 x hD hA hB := by
simpa only [hqDef] using
(sub_q_mul_eq_emod_add_Delta (D := D19) (A := A63) (B := B64) (x := x) (q := q) hD hA
hB hqDef)
have hCore :
(if D19 ≤ r then (q + 1, r - D19) else (q, r)) = (x / D19, x % D19) := by
exact
divmod_if1_correct_of_delta_le1
(D := D19) (x := x) (q := q) (r := r) (δ := Delta D19 A63 B64 x hD hA hB)
hD hDeltaNonneg hDeltaLe1 hDeltaEq hrEq
calc
divmod_d19_125bit x = if D19 ≤ r then (q + 1, r - D19) else (q, r) := hDivmod
_ = (x / D19, x % D19) := hCore
_ = divmod_d19 x := by simp only [divmod_d19, D19]
/--
入力/前提: `hx0 : 0 ≤ x`, `hx : x < xBound_d19_127bit`。
主張: `divmod_d19_127bit x = divmod_d19 x`。
内容: 境界条件から `0 ≤ Delta ≤ 2` を導き、`q`,`r` の形へ落とす。
その後に共通補題 `divmod_if2_correct_of_delta_le2` を適用して結論を得る。
証明: 既存の共通補題を連結して示す。
役割: `divmod_d19_127bit` の利用域における正当性保証を与える。
-/
theorem divmod_d19_127bit_correct_on_range
{x : Int}
(hx0 : 0 ≤ x)
(hx : x < xBound_d19_127bit) :
divmod_d19_127bit x = divmod_d19 x := by
have hD : 0 < D19 := by decide
have hA : 0 < A63 := by decide
have hB : 0 < B64 := by decide
have hK : 0 ≤ (2 : Int) := by decide
have hDeltaBounds : 0 ≤ Delta D19 A63 B64 x hD hA hB ∧ Delta D19 A63 B64 x hD hA hB ≤ 2 := by
exact
delta_bounds_of_lt_compute_xMin_bound
(D := D19) (A := A63) (B := B64) (K := 2) (x := x) (bound := xBound_d19_127bit)
hD hA hB hK hx0 compute_xMin_D19_A63_B64_K2 hx
have hDeltaNonneg : 0 ≤ Delta D19 A63 B64 x hD hA hB := hDeltaBounds.1
have hDeltaLe2 : Delta D19 A63 B64 x hD hA hB ≤ 2 := hDeltaBounds.2
let M : Int := A63 * B64 / D19
let q : Int := ((x / A63) * M) / B64
let r : Int := x - q * D19
have hqDef : q = (((x / A63) * ((A63 * B64) / D19)) / B64) := by
simp only [q, M]
have hDivmod :
divmod_d19_127bit x =
if D19 * 2 ≤ r then (q + 2, r - D19 * 2)
else if D19 ≤ r then (q + 1, r - D19)
else (q, r) := by
unfold divmod_d19_127bit
simp only [Int.reducePow, Int.reduceMul, Int.reduceDiv, D19, A63, B64, r, q, M]
have hDeltaEq : Delta D19 A63 B64 x hD hA hB = x / D19 - q := by
exact Delta_eq_div_sub_q (D := D19) (A := A63) (B := B64) (x := x) (q := q) hD hA hB hqDef
have hrEq : r = x % D19 + D19 * Delta D19 A63 B64 x hD hA hB := by
calc
r = x - q * D19 := by rfl
_ = x % D19 + D19 * Delta D19 A63 B64 x hD hA hB := by
simpa only [hqDef] using
(sub_q_mul_eq_emod_add_Delta (D := D19) (A := A63) (B := B64) (x := x) (q := q) hD hA
hB hqDef)
have hCore :
(if D19 * 2 ≤ r then (q + 2, r - D19 * 2)
else if D19 ≤ r then (q + 1, r - D19)
else (q, r)) = (x / D19, x % D19) := by
exact
divmod_if2_correct_of_delta_le2
(D := D19) (x := x) (q := q) (r := r) (δ := Delta D19 A63 B64 x hD hA hB)
hD hDeltaNonneg hDeltaLe2 hDeltaEq hrEq
calc
divmod_d19_127bit x =
if D19 * 2 ≤ r then (q + 2, r - D19 * 2)
else if D19 ≤ r then (q + 1, r - D19)
else (q, r) := hDivmod
_ = (x / D19, x % D19) := hCore
_ = divmod_d19 x := by simp only [divmod_d19, D19]
/--
入力/前提: `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_128bit` の利用域における正当性保証を与える。
-/
theorem divmod_d19_128bit_correct_on_range
{x : Int}
(hx0 : 0 ≤ x)
(hx : x < xBound_d19_128bit) :
divmod_d19_128bit x = divmod_d19 x := by
have hD : 0 < D19 := by decide
have hA : 0 < A64 := by decide
have hB : 0 < B64 := by decide
have hK : 0 ≤ (3 : Int) := by decide
have hDeltaBounds : 0 ≤ Delta D19 A64 B64 x hD hA hB ∧ Delta D19 A64 B64 x hD hA hB ≤ 3 := by
exact
delta_bounds_of_lt_compute_xMin_bound
(D := D19) (A := A64) (B := B64) (K := 3) (x := x) (bound := xBound_d19_128bit)
hD hA hB hK hx0 compute_xMin_D19_A64_B64_K3 hx
have hDeltaNonneg : 0 ≤ Delta D19 A64 B64 x hD hA hB := hDeltaBounds.1
have hDeltaLe3 : Delta D19 A64 B64 x hD hA hB ≤ 3 := hDeltaBounds.2
let M : Int := A64 * B64 / D19
let q : Int := ((x / A64) * M) / B64
let r : Int := x - q * D19
have hqDef : q = (((x / A64) * ((A64 * B64) / D19)) / B64) := by
simp only [q, M]
have hDivmod :
divmod_d19_128bit x =
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) := by
unfold divmod_d19_128bit
simp only [Int.reducePow, Int.reduceMul, Int.reduceDiv, D19, A64, B64, r, q, M]
have hDeltaEq : Delta D19 A64 B64 x hD hA hB = x / D19 - q := by
exact Delta_eq_div_sub_q (D := D19) (A := A64) (B := B64) (x := x) (q := q) hD hA hB hqDef
have hrEq : r = x % D19 + D19 * Delta D19 A64 B64 x hD hA hB := by
calc
r = x - q * D19 := by rfl
_ = x % D19 + D19 * Delta D19 A64 B64 x hD hA hB := by
simpa only [hqDef] using
(sub_q_mul_eq_emod_add_Delta (D := D19) (A := A64) (B := B64) (x := x) (q := q) hD hA
hB hqDef)
have hCore :
(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)) = (x / D19, x % D19) := by
exact
divmod_if3_correct_of_delta_le3
(D := D19) (x := x) (q := q) (r := r) (δ := Delta D19 A64 B64 x hD hA hB)
hD hDeltaNonneg hDeltaLe3 hDeltaEq hrEq
calc
divmod_d19_128bit x =
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) := hDivmod
_ = (x / D19, x % D19) := hCore
_ = divmod_d19 x := by simp only [divmod_d19, D19]
end DivmodD19Correctness
end Divapprox
Raw
Fib.lean
import Mathlib.Data.Int.Basic
import Mathlib.Data.Int.Lemmas
import Mathlib.Data.Int.Fib.Basic
import Mathlib.Data.Finset.Basic
import Mathlib.Data.Nat.Fib.Zeckendorf
import Mathlib.Data.Real.Basic
import Mathlib.Analysis.SpecialFunctions.Sqrt
import Mathlib.Analysis.SpecialFunctions.Log.Base
import Mathlib.NumberTheory.Real.GoldenRatio
import Mathlib.Tactic
namespace Fib
/--
目的: `Nat.greatestFib` と同値な逐次生成版を定義する。
定義: `(F_k, F_{k+1})` を更新し、`F_{k+1} ≤ n` の間だけ `k` を進める。
入力/前提: `n : Nat`、再帰引数 `fuel k fk fk1 : Nat`。
出力: 型 `Nat` の値を返す。
役割: 計算目的で軽量な `greatestFib` 代替を与える。
-/
private def greatestFibIter_go (n : Nat) : Nat → Nat → Nat → Nat → Nat
| 0, k, _, _ => k
| fuel + 1, k, fk, fk1 =>
if _ : fk1 ≤ n then
greatestFibIter_go n fuel (k + 1) fk1 (fk + fk1)
else k
/--
目的: `Nat.greatestFib` と同値な逐次生成版を定義する。
定義: `(F_k, F_{k+1})` を更新し、`F_{k+1} ≤ n` の間だけ `k` を進める。
入力/前提: n : Nat。
出力: 型 `Nat` の値を返す。
役割: 計算目的で軽量な `greatestFib` 代替を与える。
-/
def greatestFibIter (n : Nat) : Nat :=
greatestFibIter_go n (n + 2) 0 0 1
/--
入力/前提: k : Nat。
主張: `k ≤ fib (k+1)` を与える補助補題。
内容: `Nat.le_fib_add_one` を `k+1` に適用して `k ≤ fib (k+1)` を取り出す。
証明: 既存補題の適用と式変形で示す。
役割: `n < fib (n+2)` の導出に使う基礎評価。
-/
private lemma fib_succ_ge (k : Nat) : k ≤ Nat.fib (k + 1) := by
have h := Nat.le_fib_add_one (k + 1)
exact (Nat.succ_le_succ_iff.mp h)
/--
入力/前提: n : Nat。
主張: `n < fib (n+2)` を与える補助補題。
内容: `fib (n+2)` の下界 `n+1 ≤ fib (n+2)` を `fib_succ_ge` から得て推論する。
証明: 既存補題の書き換えで示す。
役割: 燃料が尽きるケースの矛盾導出に使う。
-/
private lemma lt_fib_succ_succ (n : Nat) : n < Nat.fib (n + 2) := by
have h1 : n + 1 ≤ Nat.fib (n + 2) := by
simpa only [Order.add_one_le_iff] using (fib_succ_ge (n + 1))
exact lt_of_lt_of_le (Nat.lt_succ_self n) h1
/--
入力/前提: n : Nat。
主張: 反復版 `greatestFibIter_go` が `Nat.greatestFib` を返す。
内容: 不変量 `fk = fib k`, `fk1 = fib (k+1)` と `fib k ≤ n`, `k+fuel = n+2` のもとで
反復の分岐を追い、`fk1 ≤ n` なら次状態、そうでなければ最大性から `k` を確定する。
証明: 帰納法・場合分け・式変形・既存補題の書き換えで示す。
役割: `greatestFibIter` の正しさを示す中核補題。
-/
private lemma greatestFibIter_go_eq (n : Nat) :
∀ fuel k fk fk1,
fk = Nat.fib k →
fk1 = Nat.fib (k + 1) →
Nat.fib k ≤ n →
k + fuel = n + 2 →
greatestFibIter_go n fuel k fk fk1 = Nat.greatestFib n := by
intro fuel k fk fk1 hk hk1 hk_le hfuel
induction fuel generalizing k fk fk1 with
| zero =>
exfalso
have hk' : k = n + 2 := by simpa only [add_zero] using hfuel
have hle : Nat.fib (n + 2) ≤ n := by simpa only [hk'] using hk_le
have hlt : n < Nat.fib (n + 2) := lt_fib_succ_succ n
exact (lt_irrefl n) (lt_of_lt_of_le hlt hle)
| succ fuel ih =>
by_cases h : fk1 ≤ n
· have hk2 : fk + fk1 = Nat.fib (k + 2) := by
calc
fk + fk1 = Nat.fib k + Nat.fib (k + 1) := by simp only [hk, hk1]
_ = Nat.fib (k + 2) := by
symm
simpa only using (Nat.fib_add_two (n := k))
have hk_le' : Nat.fib (k + 1) ≤ n := by simpa only [hk1] using h
have hfuel' : k + 1 + fuel = n + 2 := by
calc
k + 1 + fuel = k + (1 + fuel) := by simp only [Nat.add_assoc]
_ = k + (fuel + 1) := by simp only [Nat.add_comm]
_ = n + 2 := hfuel
have ih' :=
ih (k := k + 1) (fk := fk1) (fk1 := fk + fk1) hk1 hk2 hk_le' hfuel'
simpa only [greatestFibIter_go, h, ↓reduceDIte] using ih'
· have hk_le_g : k ≤ Nat.greatestFib n :=
(Nat.le_greatestFib (m := k) (n := n)).2 hk_le
have hlt' : n < Nat.fib (k + 1) := by
have h' : n < fk1 := lt_of_not_ge h
simpa only [gt_iff_lt, hk1] using h'
have hgf_lt : Nat.greatestFib n < k + 1 :=
(Nat.greatestFib_lt (m := n) (n := k + 1)).2 hlt'
have hgf_le : Nat.greatestFib n ≤ k := Nat.le_of_lt_succ hgf_lt
have hk_eq : k = Nat.greatestFib n := le_antisymm hk_le_g hgf_le
simpa only [greatestFibIter_go, h, ↓reduceDIte] using hk_eq
/--
入力/前提: n : Nat。
主張: `greatestFibIter` は `Nat.greatestFib` と一致する。
内容: 初期値 `(k,fk,fk1)=(0,0,1)` と燃料 `n+2` を `greatestFibIter_go_eq` に適用する。
証明: `greatestFibIter_go_eq` へ初期値を代入して示す。
役割: 反復実装 `greatestFibIter` を `Nat.greatestFib` に置き換える根拠。
-/
@[simp]
theorem greatestFibIter_eq_greatestFib (n : Nat) :
greatestFibIter n = Nat.greatestFib n := by
have h0 : Nat.fib 0 ≤ n := by simp
have h := greatestFibIter_go_eq (n := n) (fuel := n + 2) (k := 0) (fk := 0) (fk1 := 1)
rfl rfl h0 (by simp)
simpa only [greatestFibIter] using h
/-! ### Binet formula and floor/log characterization -/
noncomputable section
open scoped goldenRatio
local notation "fib" => Nat.fib
/--
目的: 黄金比 `phi` を定義する。
定義: `phi` を `Real.goldenRatio`（`(1 + √5) / 2`）の別名として置く。
入力/前提: 追加の仮定なし。
出力: 型 `Real` の値を返す。
役割: Binet 公式および `log_φ` による添字評価の基底として使う。
-/
abbrev phi : Real := Real.goldenRatio
/--
目的: 黄金比の共役 `psi` を定義する。
定義: `psi` を `Real.goldenConj`（`(1 - √5) / 2`）の別名として置く。
入力/前提: 追加の仮定なし。
出力: 型 `Real` の値を返す。
役割: Binet 公式の誤差項 `psi^n` を扱うための定数を固定する。
-/
abbrev psi : Real := Real.goldenConj
/--
入力/前提: n : Nat、fib n : Real。
主張: 実数埋め込みしたフィボナッチ数に対する Binet 公式。
内容: `Real.coe_fib_eq` を `phi`, `psi` の別名へ読み替える。
証明: 既存補題の書き換えで示す。
役割: 以降の誤差評価および境界不等式の基本式を与える。
-/
lemma fib_binet (n : Nat) :
(fib n : Real) = (phi ^ n - psi ^ n) / Real.sqrt 5 := by
simpa only [phi, psi] using (Real.coe_fib_eq n)
/--
入力/前提: n : Nat。
主張: `fib n` は `phi^n/√5` の `1/2` 未満の誤差で近似される。
内容: `fib_binet` の誤差項 `psi^n/√5` を `|psi| < 1` と `√5 > 2` で評価し、
絶対値不等式から上下評価へ変換する。
証明: 式変形・既存補題の書き換えで示す。
役割: `floor(log_φ(...))` と `fib` 区間条件を接続するための数値境界を与える。
-/
lemma fib_binet_bounds (n : Nat) :
phi ^ n / Real.sqrt 5 - (1 / 2 : Real) < (fib n : Real) ∧
(fib n : Real) < phi ^ n / Real.sqrt 5 + (1 / 2 : Real) := by
have hsqrt5_pos : 0 < Real.sqrt 5 := by
have h : (0 : Real) < 5 := by norm_num
exact Real.sqrt_pos.2 h
have hpsi_neg : psi < 0 := by
simpa only [psi] using Real.goldenConj_neg
have hneg_one_lt_psi : (-1 : Real) < psi := by
simpa only [psi] using Real.neg_one_lt_goldenConj
have habs_psi_lt_one : |psi| < (1 : Real) := by
exact abs_lt.2 ⟨hneg_one_lt_psi, by linarith⟩
have habs_psi_pow_le_one : |psi| ^ n ≤ (1 : Real) := by
calc
|psi| ^ n ≤ (1 : Real) := by
exact pow_le_one₀ (abs_nonneg psi) (le_of_lt habs_psi_lt_one)
_ = 1 := by simp
have hsqrt5_gt2 : (2 : Real) < Real.sqrt 5 := by
refine (Real.lt_sqrt (show (0 : Real) ≤ (2 : Real) by norm_num)).2 ?_
norm_num
have hone_div_sqrt5_lt_half : (1 : Real) / Real.sqrt 5 < (1 : Real) / 2 := by
simpa only [one_div] using
(one_div_lt_one_div_of_lt (show (0 : Real) < 2 by norm_num) hsqrt5_gt2)
have habs_err_le : |psi ^ n / Real.sqrt 5| ≤ (1 : Real) / Real.sqrt 5 := by
calc
|psi ^ n / Real.sqrt 5| = |psi| ^ n / Real.sqrt 5 := by
rw [abs_div, abs_pow, abs_of_pos hsqrt5_pos]
_ ≤ (1 : Real) / Real.sqrt 5 := by
exact div_le_div_of_nonneg_right habs_psi_pow_le_one (le_of_lt hsqrt5_pos)
have herr :
(fib n : Real) - phi ^ n / Real.sqrt 5 = -(psi ^ n / Real.sqrt 5) := by
have hsqrt5_ne : (Real.sqrt 5) ≠ 0 := ne_of_gt hsqrt5_pos
rw [fib_binet]
field_simp [hsqrt5_ne]
ring
have habs_main : |(fib n : Real) - phi ^ n / Real.sqrt 5| < (1 / 2 : Real) := by
rw [herr, abs_neg]
exact lt_of_le_of_lt habs_err_le hone_div_sqrt5_lt_half
have habs_split :
(-(1 / 2 : Real) < (fib n : Real) - phi ^ n / Real.sqrt 5) ∧
((fib n : Real) - phi ^ n / Real.sqrt 5 < (1 / 2 : Real)) := abs_lt.mp habs_main
constructor <;> linarith [habs_split.1, habs_split.2]
/--
入力/前提: n : Nat。
主張: `fib_binet_bounds` の下側評価を取り出す。
内容: 連言の左成分を返すだけ。
証明: 既存補題の適用と式変形で示す。
役割: 後続補題で下界のみ使う場面を簡潔化する。
-/
lemma fib_binet_lower (n : Nat) :
phi ^ n / Real.sqrt 5 - (1 / 2 : Real) < (fib n : Real) := by
exact (fib_binet_bounds n).1
/--
入力/前提: n : Nat。
主張: `fib_binet_bounds` の上側評価を取り出す。
内容: 連言の右成分を返すだけ。
証明: 既存補題の適用と式変形で示す。
役割: 後続補題で上界のみ使う場面を簡潔化する。
-/
lemma fib_binet_upper (n : Nat) :
(fib n : Real) < phi ^ n / Real.sqrt 5 + (1 / 2 : Real) := by
exact (fib_binet_bounds n).2
/--
目的: `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))
/--
目的: `phi` を底とする対数 `logPhi` を定義する。
定義: `logPhi x := Real.logb phi x`。
入力/前提: x : Real。
出力: 型 `Real` の値を返す。
役割: 添字 `k` を `floor(log_φ(...))` で記述する主定理の記号を固定する。
-/
def logPhi (x : Real) : Real := Real.logb phi x
/--
入力/前提: 追加の仮定なし。
主張: `1 < phi` が成り立つ。
内容: `Real.one_lt_goldenRatio` を別名定義に移送する。
証明: 既存補題の書き換えで示す。
役割: `logb` と `rpow` の同値変形で必要な底条件を供給する。
-/
lemma one_lt_phi : 1 < phi := by
simpa only [phi] using Real.one_lt_goldenRatio
/--
入力/前提: 追加の仮定なし。
主張: `sqrt 5` は正である。
内容: `Real.sqrt_pos` を `5 > 0` に適用する。
証明: 既存補題の適用と式変形で示す。
役割: 除算・乗除不等式変形（`div_le_iff₀`, `lt_div_iff₀`）の前提に使う。
-/
lemma sqrt5_pos : 0 < Real.sqrt 5 := by
have h : (0 : Real) < 5 := by norm_num
exact Real.sqrt_pos.2 h
/--
入力/前提: n : Nat。
主張: `logArg n` は正である。
内容: `logArg` を展開し、`sqrt5_pos` と `(n : Real) + 1/2 > 0` の積として示す。
証明: 式変形で示す。
役割: `Real.le_logb_iff_rpow_le` など `logb` の正引数条件を満たす。
-/
lemma logArg_pos (n : Nat) : 0 < logArg n := by
unfold logArg
have hM : (0 : Real) < (n : Real) + (1 / 2 : Real) := by
have hM0 : (0 : Real) ≤ (n : Real) := by positivity
linarith
exact mul_pos sqrt5_pos hM
/--
入力/前提: k n : Nat。
主張: `k = floor(logPhi(logArg n))` の同値条件を区間不等式で与える。
内容: `Int.floor_eq_iff` を適用し、`(k : Real)+1` を `(k+1 : Real)` に正規化する。
証明: 既存補題の書き換えで示す。
役割: `floor` 記述から連続量の不等式記述への最初の変換を担う。
-/
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
have h' :
((k : Real) ≤ logPhi (logArg n) ∧ logPhi (logArg n) < (k : Real) + 1) :=
(Int.floor_eq_iff).1 hk.symm
simpa only using h'
· intro hk
have h' :
((k : Real) ≤ logPhi (logArg n) ∧ logPhi (logArg n) < (k : Real) + 1) := by
simpa only using hk
exact ((Int.floor_eq_iff).2 h').symm
/--
入力/前提: k n : Nat。
主張: `logPhi` の区間不等式と `phi` のべき不等式は同値である。
内容: 底条件 `one_lt_phi` と引数正条件 `logArg_pos` の下で、
`Real.le_logb_iff_rpow_le` と `Real.logb_lt_iff_lt_rpow` を往復適用する。
証明: 式変形・既存補題の書き換えで示す。
役割: 対数表現から指数表現へ移る中核変換。
-/
lemma logPhi_bounds_iff_pow_bounds (k n : Nat) :
((k : Real) ≤ logPhi (logArg n) ∧ logPhi (logArg n) < (k + 1 : Real)) ↔
(phi ^ k ≤ logArg n ∧ logArg n < phi ^ (k + 1)) := by
constructor
· intro h
rcases h with ⟨h1, h2⟩
have h1' : phi ^ (k : Real) ≤ logArg n :=
(Real.le_logb_iff_rpow_le one_lt_phi (logArg_pos n)).1 h1
have h2' : logArg n < phi ^ ((k : Real) + 1) := by
have h2k : logPhi (logArg n) < (k : Real) + 1 := by
simpa only using h2
exact (Real.logb_lt_iff_lt_rpow one_lt_phi (logArg_pos n)).1 h2k
have h2nat : logArg n < phi ^ (k + 1) := by
rw [← Real.rpow_natCast]
simpa only [Nat.cast_add, Nat.cast_one] using h2'
exact ⟨
by simpa only [Real.rpow_natCast] using h1',
h2nat⟩
· intro h
rcases h with ⟨h1, h2⟩
have h1' : phi ^ (k : Real) ≤ logArg n := by
simpa only [Real.rpow_natCast] using h1
have h2r := h2
rw [← Real.rpow_natCast] at h2r
have h2' : logArg n < phi ^ ((k : Real) + 1) := by
simpa only [Nat.cast_add, Nat.cast_one] using h2r
exact ⟨
(Real.le_logb_iff_rpow_le one_lt_phi (logArg_pos n)).2 h1',
by
have : logPhi (logArg n) < (k : Real) + 1 :=
(Real.logb_lt_iff_lt_rpow one_lt_phi (logArg_pos n)).2 h2'
simpa only [gt_iff_lt] using this⟩
/--
入力/前提: 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` に直接比較できる形へ変換する。
-/
lemma pow_bounds_iff_shifted_bounds (k n : Nat) :
(phi ^ k ≤ logArg n ∧ logArg n < phi ^ (k + 1)) ↔
(phi ^ k / Real.sqrt 5 - (1 / 2 : Real) ≤ (n : Real) ∧
(n : Real) < phi ^ (k + 1) / Real.sqrt 5 - (1 / 2 : Real)) := by
constructor
· intro h
rcases h with ⟨h1, h2⟩
constructor
· have h1' : phi ^ k / Real.sqrt 5 ≤ (n : Real) + (1 / 2 : Real) := by
refine (div_le_iff₀ sqrt5_pos).2 ?_
calc
phi ^ k ≤ logArg n := h1
_ = Real.sqrt 5 * ((n : Real) + (1 / 2 : Real)) := rfl
_ = ((n : Real) + (1 / 2 : Real)) * Real.sqrt 5 := by ring
linarith
· have h2' : (n : Real) + (1 / 2 : Real) < phi ^ (k + 1) / Real.sqrt 5 := by
refine (lt_div_iff₀ sqrt5_pos).2 ?_
calc
((n : Real) + (1 / 2 : Real)) * Real.sqrt 5 = logArg n := by
simp only [one_div, logArg, mul_comm]
_ < phi ^ (k + 1) := h2
linarith
· intro h
rcases h with ⟨h1, h2⟩
constructor
· have h1' : phi ^ k / Real.sqrt 5 ≤ (n : Real) + (1 / 2 : Real) := by linarith
have h1'' : phi ^ k ≤ ((n : Real) + (1 / 2 : Real)) * Real.sqrt 5 :=
(div_le_iff₀ sqrt5_pos).1 h1'
calc
phi ^ k ≤ ((n : Real) + (1 / 2 : Real)) * Real.sqrt 5 := h1''
_ = logArg n := by simp only [one_div, logArg, mul_comm]
· have h2' : (n : Real) + (1 / 2 : Real) < phi ^ (k + 1) / Real.sqrt 5 := by linarith
have h2'' : ((n : Real) + (1 / 2 : Real)) * Real.sqrt 5 < phi ^ (k + 1) :=
(lt_div_iff₀ sqrt5_pos).1 h2'
calc
logArg n = ((n : Real) + (1 / 2 : Real)) * Real.sqrt 5 := by
simp only [logArg, one_div, mul_comm]
_ < phi ^ (k + 1) := h2''
/--
入力/前提: k n : Nat。
主張: 平行移動境界とフィボナッチ区間条件は同値である。
内容: `fib_binet_lower/upper` を `k` と `k+1` に適用し、
`Nat` と `Real` のキャストを介して `fib k ≤ n < fib (k+1)` に読み替える。
証明: 式変形・既存補題の書き換えで示す。
役割: 解析的不等式から最終的な離散条件（フィボナッチ区間）へ接続する。
-/
lemma shifted_bounds_iff_fib_bounds (k n : Nat) :
(phi ^ k / Real.sqrt 5 - (1 / 2 : Real) ≤ (n : Real) ∧
(n : Real) < phi ^ (k + 1) / Real.sqrt 5 - (1 / 2 : Real)) ↔
(fib k ≤ n ∧ n < fib (k + 1)) := by
constructor
· intro h
rcases h with ⟨h1, h2⟩
constructor
· have hk_up : (fib k : Real) < phi ^ k / Real.sqrt 5 + (1 / 2 : Real) := fib_binet_upper k
have hk_lt : (fib k : Real) < (n : Real) + 1 := by linarith
have hk_lt' : (fib k : Real) < ((n + 1 : Nat) : Real) := by
simpa only [Nat.cast_add, Nat.cast_one] using hk_lt
have hk_nat : fib k < n + 1 := by exact_mod_cast hk_lt'
exact Nat.lt_succ_iff.mp hk_nat
· have hk1_low :
phi ^ (k + 1) / Real.sqrt 5 - (1 / 2 : Real) < (fib (k + 1) : Real) :=
fib_binet_lower (k + 1)
have hM_lt : (n : Real) < (fib (k + 1) : Real) := lt_trans h2 hk1_low
exact_mod_cast hM_lt
· intro h
rcases h with ⟨h1, h2⟩
constructor
· have hk_low : phi ^ k / Real.sqrt 5 - (1 / 2 : Real) < (fib k : Real) := fib_binet_lower k
have hk_le : (fib k : Real) ≤ (n : Real) := by exact_mod_cast h1
exact le_of_lt (lt_of_lt_of_le hk_low hk_le)
· have h2' : n + 1 ≤ fib (k + 1) := Nat.succ_le_of_lt h2
have h2'' : ((n + 1 : Nat) : Real) ≤ (fib (k + 1) : Real) := by
exact_mod_cast h2'
have hk1_up :
(fib (k + 1) : Real) < phi ^ (k + 1) / Real.sqrt 5 + (1 / 2 : Real) :=
fib_binet_upper (k + 1)
have hplus : ((n + 1 : Nat) : Real) < phi ^ (k + 1) / Real.sqrt 5 + (1 / 2 : Real) :=
lt_of_le_of_lt h2'' hk1_up
have hplus' : (n : Real) + 1 < phi ^ (k + 1) / Real.sqrt 5 + (1 / 2 : Real) := by
simpa only [one_div, Nat.cast_add, Nat.cast_one] using hplus
linarith
/--
入力/前提: 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)) ↔
(fib k ≤ n ∧ n < fib (k + 1)) := by
calc
(k : Int) = Int.floor (logPhi (logArg n)) ↔
((k : Real) ≤ logPhi (logArg n) ∧ logPhi (logArg n) < (k + 1 : Real)) :=
floor_logPhi_iff k n
_ ↔ (phi ^ k ≤ logArg n ∧ logArg n < phi ^ (k + 1)) :=
logPhi_bounds_iff_pow_bounds k n
_ ↔ (phi ^ k / Real.sqrt 5 - (1 / 2 : Real) ≤ (n : Real) ∧
(n : Real) < phi ^ (k + 1) / Real.sqrt 5 - (1 / 2 : Real)) :=
pow_bounds_iff_shifted_bounds k n
_ ↔ (fib k ≤ n ∧ n < fib (k + 1)) :=
shifted_bounds_iff_fib_bounds k n
/--
入力/前提: 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)) ↔
(fib k ≤ n ∧ n < fib (k + 1)) := by
have hn_pos : (0 : Real) < (n : Real) + (1 / 2 : Real) := by
have hn0 : (0 : Real) ≤ (n : Real) := by positivity
linarith
have hn_ne : ((n : Real) + (1 / 2 : Real)) ≠ 0 := ne_of_gt hn_pos
have hsqrt5_ne : (Real.sqrt 5) ≠ 0 := ne_of_gt sqrt5_pos
have hlog :
logPhi (logArg n) =
logPhi ((n : Real) + (1 / 2 : Real)) + logPhi (Real.sqrt 5) := by
unfold logPhi logArg
calc
Real.logb phi (Real.sqrt 5 * ((n : Real) + (1 / 2 : Real))) =
Real.logb phi (Real.sqrt 5) + Real.logb phi ((n : Real) + (1 / 2 : Real)) := by
simpa only [one_div] using
(Real.logb_mul (b := phi) (x := Real.sqrt 5) (y := (n : Real) + (1 / 2 : Real))
hsqrt5_ne hn_ne)
_ =
Real.logb phi ((n : Real) + (1 / 2 : Real)) + Real.logb phi (Real.sqrt 5) := by
ac_rfl
simpa only [one_div, hlog] using (floor_logPhi_iff_fib_bounds (k := k) (n := n))
/--
入力/前提: 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)` の鎖を直接作る補助補題。
-/
lemma phi_pow_succ_lt_fib_add_three (m : Nat) :
phi ^ (m + 1) < (fib (m + 3) : Real) := by
have hphi_lt_two : phi < 2 := by
simpa only [phi] using Real.goldenRatio_lt_two
have hfib_nat_pos : 0 < fib (m + 1) := by
exact (Nat.fib_pos).2 (Nat.succ_pos m)
have hfib_pos : (0 : Real) < (fib (m + 1) : Real) := by
exact_mod_cast hfib_nat_pos
have hmul :
phi * (fib (m + 1) : Real) < (2 : Real) * (fib (m + 1) : Real) := by
nlinarith [hphi_lt_two, hfib_pos]
calc
phi ^ (m + 1) = phi * (fib (m + 1) : Real) + (fib m : Real) := by
simpa only [phi] using (Real.goldenRatio_mul_fib_succ_add_fib m).symm
_ < (2 : Real) * (fib (m + 1) : Real) + (fib m : Real) := by
linarith
_ = (fib (m + 1) : Real) + (fib (m + 1) : Real) + (fib m : Real) := by ring
_ = (fib (m + 1) : Real) + (fib (m + 2) : Real) := by
norm_num [Nat.fib_add_two, Nat.cast_add, add_assoc, add_comm, add_left_comm]
_ = (fib (m + 3) : Real) := by
norm_num [Nat.fib_add_two, Nat.cast_add, add_assoc, add_comm, add_left_comm]
/--
入力/前提: n : Nat。
主張: `n < 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 < 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 hlog_lt : logPhi (n : Real) < (m + 1 : Real) := by
simpa only using (Nat.lt_floor_add_one (logPhi (n : Real)))
have hn_lt_pow' : (n : Real) < phi ^ ((m : Real) + 1) :=
(Real.logb_lt_iff_lt_rpow one_lt_phi hn_pos).1 hlog_lt
have hn_lt_pow : (n : Real) < phi ^ (m + 1) := by
rw [← Real.rpow_natCast]
simpa only [Nat.cast_add, Nat.cast_one] using hn_lt_pow'
have hpow_lt_fib : phi ^ (m + 1) < (fib (m + 3) : Real) :=
phi_pow_succ_lt_fib_add_three m
have hn_lt_fib_real : (n : Real) < (fib (m + 3) : Real) :=
lt_trans hn_lt_pow hpow_lt_fib
have htarget : (n : Real) < (fib (Nat.floor (logPhi (n : Real)) + 3) : Real) := by
simpa only [Nat.cast_lt] using hn_lt_fib_real
exact_mod_cast htarget
end
end Fib
Raw
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"
Raw
lean-toolchain
leanprover/lean4:v4.29.0-rc1
Raw
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 Mathlib.Data.Int.Basic
import Mathlib.Data.Int.Lemmas
import Mathlib.Data.Int.Fib.Basic
import Mathlib.Data.Finset.Basic
import Mathlib.Data.Nat.Fib.Zeckendorf
import Mathlib.Tactic
import Fib
namespace MWF
/--
目的: 整数の床除算を `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
/--
目的: 3項最大を定義する。
定義: `max (max a b) c`。
入力/前提: a b c : Int。
出力: 型 `Int` の値を返す。
役割: 場合分け結果の可読化。
-/
@[simp]
def max3 (a b c : Int) : Int := max (max a b) c
/--
目的: 4項最大を定義する。
定義: `max3` を使った入れ子 `max`。
入力/前提: a b c d : Int。
出力: 型 `Int` の値を返す。
役割: 分岐後の式整理を簡潔化。
-/
@[simp]
def max4 (a b c d : Int) : Int := max (max3 a b c) d
/--
目的: 走査区間 `0 ≤ x < N` を有限集合で表す。
定義: `Icc 0 (N-1)` を採用。
入力/前提: N : Int、_hN : 0 < N、0 : Int。
出力: 型 `Finset Int` の値を返す。
役割: `mwf` を Finset 最大値として扱う土台。
-/
@[simp]
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]
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]
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]
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)
/--
入力/前提: N : Int、hN : 0 < N。
主張: `0<N` なら `dom` は非空。
内容: `0 ∈ Icc 0 (N-1)` を構成。
証明: 既存補題の適用と式変形で示す。
役割: `max'` 利用条件を満たす。
-/
lemma dom_nonempty {N : Int} (hN : 0 < N) : (dom N hN).Nonempty := by
refine Exists.intro 0 ?_
exact Finset.mem_Icc.mpr (And.intro 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'` 利用条件を満たす。
-/
lemma domLr_nonempty {L R : Int} (hLR : L < R) : (domLr L R hLR).Nonempty := by
refine Exists.intro L ?_
have hL : L ≤ R - 1 := by
nlinarith [hLR]
exact Finset.mem_Icc.mpr (And.intro le_rfl hL)
/--
入力/前提: 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
cases dom_nonempty hN with
| intro x hx =>
refine Exists.intro (obj A B C D M x hM) ?_
exact Finset.mem_image.mpr (Exists.intro x (And.intro 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
cases domLr_nonempty hLR with
| intro x hx =>
refine Exists.intro (obj A B C D M x hM) ?_
exact Finset.mem_image.mpr (Exists.intro x (And.intro hx rfl))
/--
目的: 問題値 `mwf` を定義する。
定義: `img` の最大値 `max'` を返す。
入力/前提: N M A B C D : Int、hN : 0 < N、hM : 0 < M。
出力: 型 `Int` の値を返す。
役割: 全証明で保存・変形する中心量。
-/
@[simp]
def mwf (N M A B C D : Int) (hN : 0 < N) (hM : 0 < M) : Int :=
let s := img N M A B C D hN hM
s.max' (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]
def mwfLr (L R M A B C D : Int) (hLR : L < R) (hM : 0 < M) : Int :=
let s := imgLr L R M A B C D hLR hM
s.max' (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'` で取り出す基底。
-/
def mwfLrArgDom (L R M A B C D : Int) (hLR : L < R) (hM : 0 < M) : Finset Int :=
(domLr L R hLR).filter (fun x => obj A B C D M x hM = mwfLr L R M A B C D hLR 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'` 利用条件を満たす。
-/
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
have hmaxMem : mwfLr L R M A B C D hLR hM ∈ imgLr L R M A B C D hLR hM := by
unfold mwfLr
simpa only [imgLr, obj, zfloorDiv, domLr, Finset.mem_image, Finset.mem_Icc,
Order.le_sub_one_iff] using
(Finset.max'_mem (imgLr L R M A B C D hLR hM)
(imgLr_nonempty (L := L) (R := R) (M := M) (A := A) (B := B) (C := C) (D := D) hLR hM))
rcases Finset.mem_image.mp hmaxMem with ⟨x, hxDom, hxEq⟩
refine ⟨x, ?_⟩
exact Finset.mem_filter.mpr ⟨hxDom, hxEq⟩
/--
目的: `mwfLr` の最小 `argmax` を定義する。
定義: `mwfLrArgDom` の `min'` を返す。
入力/前提: L R M A B C D : Int、hLR : L < R、hM : 0 < M。
出力: 型 `Int` の値を返す。
役割: `max` と同時に `argmax`（同値時は最小）を得るための本体。
-/
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' (mwfLrArgDom_nonempty L R M A B C D hLR hM)
/--
目的: 区間版 MWF の最大値と `argmax` を同時に返す型を定義する。
フィールド: `max`, `argmax`。
不変条件: `argmax` は `[L, R)` 内で `max` を達成する最小添字。
役割: `mwfLrWithArgmax` の返り値型。
-/
structure MwfLrArgResult 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。
出力: 型 `MwfLrArgResult` の値を返す。
役割: 区間最大値と最小達成点の同時計算インターフェース。
-/
def mwfLrWithArgmax
(L R M A B C D : Int) (hLR : L < R) (hM : 0 < M) : MwfLrArgResult :=
{ max := mwfLr L R M A B C D hLR hM
argmax := mwfLrArgmax L R M A B C D hLR hM }
/--
目的: 正規化後の `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 * 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 * 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 := 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 := 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 :=
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
/--
入力/前提: N M C D : Int、hN : 0 < N、hM : 0 < M。
主張: 正規化仮定下で `Yn1 ≥ 0`。
内容: 分子非負と `M>0` から `ediv_nonneg`。
証明: 式変形で示す。
役割: `step_reduce` の分岐前提を供給。
-/
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 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 [mul_nonneg hC0 hNm1, hD0]
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` になる矛盾。
証明: 反証法・式変形・既存補題の書き換えで示す。
役割: 逆写像式の除数正性を保証。
-/
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 < 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 : Yn1 N M C D hN hM = 0 := by
simp only [Yn1, yOf, zfloorDiv, hCeq, zero_mul, zero_add, hdiv0]
rw [hY0] at hYp
exact (lt_irrefl (0 : Int)) hYp
/--
目的: 商 `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 := hCpos_of_Y_ge_one N M C D hN hM _hC0 _hD0 _hDM hY1
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 := hCpos_of_Y_ge_one N M C D hN hM _hC0 _hD0 _hDM hY1
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)
/--
目的: 2状態の評価式同値を定義する。
定義: `max(r, s+mwf)` の等式。
入力/前提: S T : St。
出力: 型 `Prop` の値を返す。
役割: 遷移の正しさ記述に使う述語。
-/
@[simp]
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]
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]
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]
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]
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]
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]
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 (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]
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 (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]
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]
def step (S : St) : St :=
step_reduce (step_normalize S)
/--
目的: `m` から得られる反復回数上界（`greatestFibIter m - 1`）。
定義: `greatestFibIter` から 1 引いた上界として停止到達回数に適用する
（`m>0` では `Nat.greatestFib m - 1` と同値）。
入力/前提: m : Nat。
出力: 型 `Nat` の値を返す。
役割: tex 側の「高々 `g(m)-1` 回で停止」と整合する上界を与える。
-/
def stepBoundOfM (m : Nat) : Nat :=
Fib.greatestFibIter m - 1
/--
目的: `mwf_iter_aux` は `mwf` 計算の反復補助関数を定義する。
定義: `step` を高々 `fuel` 回だけ回し、`c=0` に到達した時点の `r` を返す。
入力/前提: `fuel : Nat`、`U : St`。
出力: 型 `Int` の値を返す。
役割: `mwf_iter` の反復本体。
-/
@[simp]
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
/--
目的: `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 * zfloorDiv D M hM) 0 N M A B C D hN hM
mwf_iter_aux (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 := zfloorDiv (c * l + d) m hM
let d' : Int := zfloorMod (c * l + d) m hM
exact a * l + b * q + mwf_iter n m a b c d' hN hM
-- #eval mwfLr_iter 0 10 7 3 2 5 4 (by decide) (by decide) -- 41
-- #eval mwf_iter 1000000000 102334155 (-433494437) 701408733 63245986 31415926
-- (by decide) (by decide) -- 215327987
-- #eval stepBoundOfM 102334155 -- 40
-- #eval Nat.fib 40 -- 102334155
-- #eval Nat.fib 41 -- 165580141
-- #eval mwf_iter_aux 50
-- (St.mk 0 0 1000000000 102334155 (-433494437) 701408733 63245986 31415926
-- (by decide) (by decide)) -- 215327987
noncomputable section
/--
入力/前提: 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
dsimp only [obj, zfloorDiv, img, dom, Lean.Elab.WF.paramLet]
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 (Exists.intro x (And.intro hx rfl)))
/--
入力/前提: N M C D : Int、hN : 0 < N、hM : 0 < M。
主張: `C=0` なら `Yn1=0`。
内容: `0≤D<M` から `D/M=0` を適用。
証明: 既存補題の書き換えで示す。
役割: 退化ケースの停止判定。
-/
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) :
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 only [Yn1, yOf, zfloorDiv, hC, zero_mul, zero_add, hdiv0]
/--
入力/前提: N M C D : Int、hN : 0 < N、hM : 0 < M。
主張: `N=1` なら `Yn1=0`。
内容: `N-1=0` へ還元して `D/M=0` を適用。
証明: 既存補題の書き換えで示す。
役割: 最小サイズケースの停止判定。
-/
lemma Y_eq_zero_of_N_eq_one
(N M C D : Int)
(hN : 0 < N) (hM : 0 < M) (hD0 : 0 ≤ D) (hDM : D < M)
(hN1 : N = 1) :
Yn1 N M C D hN hM = 0 := by
subst hN1
have hdiv0 : D / M = 0 := Int.ediv_eq_zero_of_lt_abs hD0 (by simpa only [abs_of_pos hM] using hDM)
simp only [Yn1, yOf, zfloorDiv, sub_self, mul_zero, zero_add, hdiv0]
/-!
## 補題
-/
/--
入力/前提: N M C D : Int、hN : 0 < N、hM : 0 < M。
主張: `dom` 上では `yOf ≥ 0`。
内容: 分子非負と `M>0` から示す。
証明: 式変形・既存補題の書き換えで示す。
役割: 商範囲 `0..Y` の下限側。
-/
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 : dom N hN,
0 ≤ 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 [yOf, zfloorDiv, 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` の上限側。
-/
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 : dom N hN,
yOf M C D hM x ≤ 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 [yOf, zfloorDiv, dom, Yn1, ge_iff_le] using hdivLe
/--
入力/前提: N M A B C D : Int、hN : 0 < N、hM : 0 < M。
主張: 右端 `x=N-1` の目的値を明示化。
内容: `obj` 展開で `A*(N-1)+B*Yn1`。
証明: 既存補題の適用と式変形で示す。
役割: `A≥0` 分岐の端点評価。
-/
lemma obj_at_right (N M A B C D : Int) (hN : 0 < N) (hM : 0 < M) :
obj A B C D M (N - 1) hM = A * (N - 1) + B * Yn1 N M C D hN hM := by
simp only [obj, zfloorDiv, Yn1, yOf]
/--
入力/前提: N M A B C D : Int、hN : 0 < N、hM : 0 < M。
主張: `dom` の任意要素で `obj ≤ mwf`。
内容: `Finset.le_max'` を直接適用。
証明: 既存補題の適用と式変形で示す。
役割: 逆写像点からの上界取得。
-/
lemma obj_le_mwf_of_mem (N M A B C D : Int) (hN : 0 < N) (hM : 0 < M)
{y : Int} (hy : y ∈ dom N hN) :
obj A B C D M y hM ≤ mwf N M A B C D hN hM := by
exact obj_le_mwf N M A B C D y hN hM hy
/--
入力/前提: N M C D : Int、hN : 0 < N、hM : 0 < M。
主張: `dom` 上の床除算値は `0..Yn1` に入る。
内容: 非負性と右端比較で上下界を同時に構成。
証明: 既存補題の書き換えで示す。
役割: 値域制御の基礎。
-/
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 ∈ dom N hN,
0 ≤ zfloorDiv (C * x + D) M hM ∧
zfloorDiv (C * x + D) M hM ≤ 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 [zfloorDiv, ge_iff_le, yOf] using h1
· have h2 := yOf_le_Yn1 N M C D hN hM hC0 hD0 _hCM _hDM (Subtype.mk x hx)
simpa only [zfloorDiv, Yn1, yOf, ge_iff_le] using h2
/--
入力/前提: N M C D : Int、hN : 0 < N、hM : 0 < M。
主張: 任意の `0≤y≤Yn1` はある `x` で実現される。
内容: しきい値集合の最小元を使って構成。
証明: 場合分け・式変形・既存補題の書き換えで示す。
役割: `y` 側再帰を `x` 側へ戻す鍵。
-/
lemma floorDiv_range_attain (N M C D : Int) (hN : 0 < N) (hM : 0 < M)
(_hC0 : 0 ≤ C) (hD0 : 0 ≤ D) (hCM : C < M) (hDM : D < M) :
let Y₀ := Yn1 N M C D hN hM;
∀ y, 0 ≤ y ∧ y ≤ Y₀ → ∃ x ∈ dom N hN, zfloorDiv (C * x + D) M hM = y := by
dsimp only [Yn1, yOf, zfloorDiv, dom, Lean.Elab.WF.paramLet]
intro y hy
rcases hy with ⟨hy0, hyY⟩
by_cases hyTop : y = Yn1 N M C D hN hM
· refine ⟨N - 1, ?_, ?_⟩
· exact Finset.mem_Icc.mpr ⟨sub_nonneg.mpr ((Int.lt_iff_add_one_le).1 hN), le_rfl⟩
· simp only [hyTop, Yn1, yOf, zfloorDiv]
· have hmem :
iy_right N M C D y hN hM _hC0 hD0 hCM hDM hy0 hyY ∈ dom N hN := by
have hy_lt : y < Yn1 N M C D hN hM := lt_of_le_of_ne hyY (fun hy' => hyTop hy')
have hYpos : 0 < Yn1 N M C D hN hM := lt_of_le_of_lt hy0 hy_lt
have hY1 : 1 ≤ Yn1 N M C D hN hM := (Int.lt_iff_add_one_le).1 hYpos
have hCpos : 0 < C := hCpos_of_Y_ge_one N M C D hN hM _hC0 hD0 hDM hY1
have hy1 : y + 1 ≤ 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, Yn1, yOf, 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 hx0 :
0 ≤ zfloorDiv (M * y + M - D - 1) C hCpos := by
simpa only [zfloorDiv] using Int.ediv_nonneg hnum_nonneg (le_of_lt hCpos)
have hxN :
zfloorDiv (M * y + M - D - 1) C hCpos ≤ N - 1 := by
have hlt :
M * y + M - D - 1 < (N - 1) * C + C := by
calc
M * y + M - D - 1 < C * N := hnum_lt_CN
_ = (N - 1) * C + C := by ring
exact (Int.ediv_le_iff_le_mul hCpos).2 hlt
have hmem' :
zfloorDiv (M * y + M - D - 1) C hCpos ∈ dom N hN := by
exact Finset.mem_Icc.mpr ⟨hx0, hxN⟩
have hYn1' : y ≠ (C * (N - 1) + D) / M := by
simpa only [ne_eq, Yn1, yOf, zfloorDiv] using hyTop
simpa only [dom, iy_right, Yn1, yOf, zfloorDiv, hYn1', ↓reduceDIte, Finset.mem_Icc,
Order.le_sub_one_iff] using hmem'
have heq :
zfloorDiv (C * (iy_right N M C D y hN hM _hC0 hD0 hCM hDM hy0 hyY) + D) M hM = y := by
have hy_lt : y < Yn1 N M C D hN hM := lt_of_le_of_ne hyY (fun hy' => hyTop hy')
have hYpos : 0 < Yn1 N M C D hN hM := lt_of_le_of_lt hy0 hy_lt
have hY1 : 1 ≤ Yn1 N M C D hN hM := (Int.lt_iff_add_one_le).1 hYpos
have hCpos : 0 < C := 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, Yn1, yOf, zfloorDiv] using hyTop
have hiy :
iy_right N M C D y hN hM _hC0 hD0 hCM hDM hy0 hyY
= zfloorDiv (M * y + M - D - 1) C hCpos := by
simp only [iy_right, Yn1, yOf, zfloorDiv, hneq, ↓reduceDIte]
rw [hiy]
unfold 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]
have hlower : y ≤ (C * (a / C) + D) / M :=
(Int.le_ediv_iff_mul_le hM).2 (by
simpa only [mul_comm] using hmul_low)
exact le_antisymm hupper hlower
refine ⟨iy_right N M C D y hN hM _hC0 hD0 hCM hDM hy0 hyY, hmem, ?_⟩
exact heq
/-!
## 初期化
`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` が常に候補である事実を使う。
証明: 式変形・既存補題の書き換えで示す。
役割: 状態法の開始点。
-/
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 * zfloorDiv D M hM) (0 + mwf N M A B C D hN hM) := by
have hx0 : (0 : Int) ∈ 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 : obj A B C D M 0 hM ≤ mwf N M A B C D hN hM :=
obj_le_mwf N M A B C D 0 hN hM hx0
have hbase : B * zfloorDiv D M hM ≤ mwf N M A B C D hN hM := by
simpa only [zfloorDiv, mwf, img, obj, dom, mul_zero, zero_add] using hbase_obj
have hmax_le :
max (B * zfloorDiv D M hM) (0 + mwf N M A B C D hN hM) ≤ mwf N M A B C D hN hM := by
refine max_le hbase ?_
simp only [mwf, img, obj, zfloorDiv, dom, zero_add, le_refl]
have hle_max : mwf N M A B C D hN hM ≤ max (B * zfloorDiv D M hM) (0 + mwf N M A B C D hN hM) :=
by
calc
mwf N M A B C D hN hM = 0 + mwf N M A B C D hN hM := by simp only [mwf, img, obj, zfloorDiv,
dom, zero_add]
_ ≤ max (B * zfloorDiv D M hM) (0 + mwf N M A B C D hN hM) := le_max_right _ _
exact le_antisymm hle_max hmax_le
/-!
## 正規化
`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` の商剰余分解を式変形。
証明: 式変形・既存補題の書き換えで示す。
役割: 点ごとの正規化同値の核。
-/
lemma normalize_obj_eq (A B C D M S x : Int) (hM : 0 < M) :
S + obj A B C D M x hM =
(normS S B D M hM) + obj (normA A B C M hM) B (normC C M hM) (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 obj normS normA normC normD zfloorDiv zfloorMod
rw [hdiv]
ring
/--
入力/前提: R S N M A B C D : Int、hN : 0 < N、hM : 0 < M。
主張: 外側 `max R` 付きでも正規化前後で値が等しい。
内容: `normalize_obj_eq` を最大値へ持ち上げる。
証明: 式変形・既存補題の書き換えで示す。
役割: 状態正規化の正当化。
-/
theorem normalize_max
(R S N M A B C D : Int)
(hN : 0 < N) (hM : 0 < M) :
max R (S + mwf N M A B C D hN hM)
=
max R ((normS S B D M hM) +
mwf N M (normA A B C M hM) B (normC C M hM) (normD D M hM) hN hM) := by
let m0 := mwf N M A B C D hN hM
let m1 := mwf N M (normA A B C M hM) B (normC C M hM) (normD D M hM) hN hM
have hm1_mem :
m1 ∈ img N M (normA A B C M hM) B (normC C M hM) (normD D M hM) hN hM := by
dsimp only [normA, zfloorDiv, normC, zfloorMod, normD, img, obj, dom, mwf, m1]
exact Finset.max'_mem _ _
rcases Finset.mem_image.mp hm1_mem with ⟨x1, hx1, hx1eq⟩
have hm0_mem : m0 ∈ img N M A B C D hN hM := by
dsimp only [img, obj, zfloorDiv, dom, mwf, m0]
exact Finset.max'_mem _ _
rcases Finset.mem_image.mp hm0_mem with ⟨x0, hx0, hx0eq⟩
have hobj1_le_m0 : obj A B C D M x1 hM ≤ m0 := by
simpa only [obj, zfloorDiv, mwf, img, dom] using obj_le_mwf N M A B C D x1 hN hM hx1
have hobj0_le_m1 :
obj (normA A B C M hM) B (normC C M hM) (normD D M hM) M x0 hM ≤ m1 := by
simpa only [obj, normA, zfloorDiv, normC, zfloorMod, normD, mwf, img, dom] using
obj_le_mwf N M (normA A B C M hM) B (normC C M hM) (normD D M hM) x0 hN hM hx0
have hle1 : normS S B D M hM + m1 ≤ S + m0 := by
calc
normS S B D M hM + m1
= normS S B D M hM +
obj (normA A B C M hM) B (normC C M hM) (normD D M hM) M x1 hM := by
rw [← hx1eq]
_ = S + obj A B C D M x1 hM := by
symm
simpa only [obj, zfloorDiv, normS, normA, normC, zfloorMod, normD] using
normalize_obj_eq A B C D M S x1 hM
_ ≤ S + m0 := by
simpa only [obj, zfloorDiv, add_comm, add_le_add_iff_left] using
add_le_add_left hobj1_le_m0 S
have hle2 : S + m0 ≤ normS S B D M hM + m1 := by
calc
S + m0 = S + obj A B C D M x0 hM := by rw [← hx0eq]
_ = normS S B D M hM +
obj (normA A B C M hM) B (normC C M hM) (normD D M hM) M x0 hM := by
simpa only [obj, zfloorDiv, normS, normA, normC, zfloorMod, normD] using
normalize_obj_eq A B C D M S x0 hM
_ ≤ normS S B D M hM + m1 := by
simpa only [normS, zfloorDiv, obj, normA, normC, zfloorMod, normD, add_comm, add_assoc,
add_le_add_iff_left] using add_le_add_left hobj0_le_m1 (normS S B D M hM)
have hmwf_eq : S + m0 = normS S B D M hM + m1 := le_antisymm hle2 hle1
exact congrArg (fun t => max R t) hmwf_eq
/--
入力/前提: N M A B C D : Int、hN : 0 < N、hM : 0 < M。
主張: `Yn1=0` なら `mwf = max 0 (A*(N-1))`。
内容: 商項が全点で 0 になることを利用。
証明: 場合分け・式変形・既存補題の書き換えで示す。
役割: 再帰停止時の閉形式。
-/
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 : (Yn1 N M C D hN hM) = 0) :
mwf N M A B C D hN hM
=
max 0 (A * (N - 1)) := by
have hDdiv0 : zfloorDiv D M hM = 0 := by
unfold zfloorDiv
exact Int.ediv_eq_zero_of_lt_abs hD0 (by simpa only [abs_of_pos hM] using hDM)
have hx0 : (0 : Int) ∈ 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 := obj_le_mwf N M A B C D 0 hN hM hx0
have hDdiv0' : D / M = 0 := by simpa only [zfloorDiv] using hDdiv0
have hobj0 : obj A B C D M 0 hM = 0 := by
calc
obj A B C D M 0 hM = A * 0 + B * (D / M) := by
simp only [obj, mul_zero, zfloorDiv, zero_add]
_ = A * 0 + B * 0 := by rw [hDdiv0']
_ = 0 := by simp only [mul_zero, add_zero]
rw [hobj0] at hobj0_le
exact hobj0_le
have hxN1 : (N - 1 : Int) ∈ 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 := obj_le_mwf N M A B C D (N - 1) hN hM hxN1
have hobjR : obj A B C D M (N - 1) hM = A * (N - 1) := by
calc
obj A B C D M (N - 1) hM = A * (N - 1) + B * Yn1 N M C D hN hM := by
exact obj_at_right N M A B C D hN hM
_ = A * (N - 1) + B * 0 := by rw [hY0]
_ = A * (N - 1) := by simp only [mul_zero, add_zero]
calc
A * (N - 1) = obj A B C D M (N - 1) hM := hobjR.symm
_ ≤ mwf N M A B C D hN hM := 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
(img N M A B C D hN hM).max'
(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 := img N M A B C D hN hM)
(H := 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 hnonneg :
0 ≤ zfloorDiv (C * x + D) M hM := by
have htmp := yOf_nonneg N M C D hN hM hC0 hD0 hCM hDM (Subtype.mk x hxdom)
simpa only [zfloorDiv, ge_iff_le, yOf] using htmp
have hleY :
zfloorDiv (C * x + D) M hM ≤ Yn1 N M C D hN hM := by
have htmp := yOf_le_Yn1 N M C D hN hM hC0 hD0 hCM hDM (Subtype.mk x hxdom)
simpa only [zfloorDiv, Yn1, yOf, ge_iff_le] using htmp
have hle0 : zfloorDiv (C * x + D) M hM ≤ 0 := by
have hleY' := hleY
rw [hY0] at hleY'
exact hleY'
have hdiv0x : zfloorDiv (C * x + D) M hM = 0 := by
exact le_antisymm hle0 hnonneg
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)))
have hobjx : obj A B C D M x hM = A * x := by
calc
obj A B C D M x hM = A * x + B * zfloorDiv (C * x + D) M hM := by
simp only [obj, zfloorDiv]
_ = A * x + B * 0 := by rw [hdiv0x]
_ = A * x := by simp only [mul_zero, add_zero]
calc
obj A B C D M x hM = A * x := hobjx
_ ≤ max 0 (A * (N - 1)) := hAx
exact le_antisymm hUpper hLower
/--
入力/前提: N M C D y : Int、hN : 0 < N、hM : 0 < M。
主張: `iy_right` は常に `dom` に属する。
内容: 端点分岐と除算不等式で区間内を示す。
証明: 場合分け・式変形・既存補題の書き換えで示す。
役割: `iy_right` を評価点として合法化。
-/
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 ≤ Yn1 N M C D hN hM) :
iy_right N M C D y hN hM hC0 hD0 hCM hDM hy0 hyY ∈ dom N hN := by
by_cases hYn1 : y = Yn1 N M C D hN hM
· have hxN1 : (N - 1 : Int) ∈ 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 [dom, iy_right, hYn1, Yn1, yOf, zfloorDiv, ↓reduceDIte, Finset.mem_Icc,
Int.sub_nonneg, le_refl, and_true, ge_iff_le] using hxN1
· have hy_lt : y < Yn1 N M C D hN hM := lt_of_le_of_ne hyY (fun hy => hYn1 hy)
have hYpos : 0 < Yn1 N M C D hN hM := lt_of_le_of_lt hy0 hy_lt
have hY1 : 1 ≤ Yn1 N M C D hN hM := (Int.lt_iff_add_one_le).1 hYpos
have hCpos : 0 < C := hCpos_of_Y_ge_one N M C D hN hM hC0 hD0 hDM hY1
have hy1 : y + 1 ≤ 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, Yn1, yOf, 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 hx0 :
0 ≤ zfloorDiv (M * y + M - D - 1) C hCpos := by
simpa only [zfloorDiv] using Int.ediv_nonneg hnum_nonneg (le_of_lt hCpos)
have hxN :
zfloorDiv (M * y + M - D - 1) C hCpos ≤ N - 1 := by
have hlt :
M * y + M - D - 1 < (N - 1) * C + C := by
calc
M * y + M - D - 1 < C * N := hnum_lt_CN
_ = (N - 1) * C + C := by ring
exact (Int.ediv_le_iff_le_mul hCpos).2 hlt
have hmem :
zfloorDiv (M * y + M - D - 1) C hCpos ∈ dom N hN := by
exact Finset.mem_Icc.mpr ⟨hx0, hxN⟩
have hYn1' : y ≠ (C * (N - 1) + D) / M := by
simpa only [ne_eq, Yn1, yOf, zfloorDiv] using hYn1
simpa only [dom, iy_right, Yn1, yOf, 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` 再帰の値一致に必須。
-/
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 ≤ Yn1 N M C D hN hM)
(hy_ne : y ≠ Yn1 N M C D hN hM) :
yOf M C D hM (iy_right N M C D y hN hM hC0 hD0 hCM hDM hy0 hyY)
= y := by
have hy_lt : y < Yn1 N M C D hN hM := lt_of_le_of_ne hyY (fun hy => hy_ne hy)
have hYpos : 0 < Yn1 N M C D hN hM := lt_of_le_of_lt hy0 hy_lt
have hY1 : 1 ≤ Yn1 N M C D hN hM := (Int.lt_iff_add_one_le).1 hYpos
have hCpos : 0 < C := 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, Yn1, yOf, zfloorDiv] using hy_ne
have hiy :
iy_right N M C D y hN hM hC0 hD0 hCM hDM hy0 hyY
= zfloorDiv (M * y + M - D - 1) C hCpos := by
simp only [iy_right, Yn1, yOf, zfloorDiv, hneq, ↓reduceDIte]
rw [hiy]
unfold yOf 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]
have hlower : y ≤ (C * (a / C) + D) / M :=
(Int.le_ediv_iff_mul_le hM).2 (by simpa only [mul_comm] using hmul_low)
exact le_antisymm hupper hlower
/--
入力/前提: N M C D y : Int、hN : 0 < N、hM : 0 < M。
主張: `iy_left` は常に `dom` に属する。
内容: 端点分岐と除算不等式で区間内を示す。
証明: 場合分け・式変形・既存補題の書き換えで示す。
役割: `iy_left` を評価点として合法化。
-/
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 ≤ Yn1 N M C D hN hM) :
iy_left N M C D y hN hM hC0 hD0 hCM hDM hy0 hyY ∈ dom N hN := by
by_cases hY0 : y = 0
· have hx0 : (0 : Int) ∈ 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 [dom, 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 ≤ 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 := 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 [Yn1, yOf, 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 hx0 :
0 ≤ zfloorDiv (M * y + C - D - 1) C hCpos := by
simpa only [zfloorDiv] using Int.ediv_nonneg hnum_nonneg (le_of_lt hCpos)
have hxN :
zfloorDiv (M * y + C - D - 1) C hCpos ≤ N - 1 := by
have hlt :
M * y + C - D - 1 < (N - 1) * C + C := by
calc
M * y + C - D - 1 < C * N := hnum_lt_CN
_ = (N - 1) * C + C := by ring
exact (Int.ediv_le_iff_le_mul hCpos).2 hlt
have hmem :
zfloorDiv (M * y + C - D - 1) C hCpos ∈ dom N hN := by
exact Finset.mem_Icc.mpr ⟨hx0, hxN⟩
simpa only [dom, iy_left, hY0, ↓reduceDIte, 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` 再帰の値一致に必須。
-/
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 ≤ Yn1 N M C D hN hM)
(hy_ne : y ≠ 0) :
yOf M C D hM (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 ≤ 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 := hCpos_of_Y_ge_one N M C D hN hM hC0 hD0 hDM hY1
have hiy :
iy_left N M C D y hN hM hC0 hD0 hCM hDM hy0 hyY
= zfloorDiv (M * y + C - D - 1) C hCpos := by
simp only [iy_left, hy_ne, ↓reduceDIte, zfloorDiv]
rw [hiy]
unfold yOf 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
have hlower : y ≤ (C * (a / C) + D) / M :=
(Int.le_ediv_iff_mul_le hM).2 (by simpa only [mul_comm] using hmul_low)
exact le_antisymm hupper hlower
/--
入力/前提: N M A B C D : Int、hN : 0 < N、hM : 0 < M。
主張: `Y>0 ∧ A≥0` の再帰式を与える。
内容: 右端項と入替後 `mwf` の二項最大に分解。
証明: 場合分け・式変形・既存補題の書き換えで示す。
役割: 正傾き分岐の主定理。
-/
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 < Yn1 N M C D hN hM) (hAnonneg : A ≥ 0) :
let YY := Yn1 N M C D hN hM
let hCpos : 0 < C :=
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
dsimp only [Yn1, yOf, zfloorDiv, mwf, img, obj, dom, Lean.Elab.WF.paramLet]
let YY : Int := Yn1 N M C D hN hM
have hCpos : 0 < C := 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) ∈ dom N hN := by
exact Finset.mem_Icc.mpr ⟨sub_nonneg.mpr ((Int.lt_iff_add_one_le).1 hN), le_rfl⟩
have hobj := obj_le_mwf N M A B C D (N - 1) hN hM hxN1
simpa only [Yn1, yOf, zfloorDiv, mwf, img, obj, dom, ge_iff_le] using
(obj_at_right N M A B C D hN hM ▸ 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
unfold mwf
dsimp only [img, obj, zfloorDiv, dom, Lean.Elab.WF.paramLet]
refine Finset.max'_le
(s := img YY C B A M (M - D - 1) hYpos hCpos)
(H := img_nonempty
(N := YY) (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 ≤ YY - 1 := (Finset.mem_Icc.mp hyDom).2
have hy_lt : y < YY := by nlinarith
have hy_leYY : y ≤ YY := le_of_lt hy_lt
let x : Int := iy_right N M C D y hN hM hC0 hD0 hCM hDM hy0 hy_leYY
have hxDom : x ∈ dom N hN := iy_right_mem_dom N M C D y hN hM hC0 hD0 hCM hDM hy0 hy_leYY
have hyOf : yOf M C D hM x = y := by
have hne : y ≠ Yn1 N M C D hN hM := by simpa only [Yn1, yOf, zfloorDiv, ne_eq] using
(ne_of_lt hy_lt)
exact yOf_iy_right N M C D y hN hM hC0 hD0 hCM hDM hy0 hy_leYY hne
have hxDef : x = zfloorDiv (M * y + M - D - 1) C hCpos := by
have hneYY : y ≠ YY := ne_of_lt hy_lt
have hne : y ≠ Yn1 N M C D hN hM := by simpa only [Yn1, yOf, zfloorDiv, ne_eq] using hneYY
have hY1 : 1 ≤ Yn1 N M C D hN hM := (Int.lt_iff_add_one_le).1 hYpos
have hneq' : y ≠ (C * (N - 1) + D) / M := by
simpa only [ne_eq, Yn1, yOf, zfloorDiv] using hne
unfold x iy_right
simp only [Yn1, yOf, zfloorDiv, hneq', ↓reduceDIte]
have hyDiv : zfloorDiv (C * x + D) M hM = y := by simpa only [zfloorDiv, yOf] using hyOf
have hObjEq : obj B A M (M - D - 1) C y hCpos = obj A B C D M x hM := by
have harg : M * y + (M - D - 1) = M * y + M - D - 1 := by ring
calc
obj B A M (M - D - 1) C y hCpos
= B * y + A * zfloorDiv (M * y + (M - D - 1)) C hCpos := by
simp only [obj, zfloorDiv]
_ = B * y + A * 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 * zfloorDiv (C * x + D) M hM := by rw [hyDiv]
_ = obj A B C D M x hM := by simp only [zfloorDiv, obj]
have hObjLe : obj A B C D M x hM ≤ mwf N M A B C D hN hM :=
obj_le_mwf_of_mem N M A B C D hN hM hxDom
exact hObjEq.symm ▸ hObjLe
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
dsimp only [img, obj, zfloorDiv, dom, Lean.Elab.WF.paramLet]
refine Finset.max'_le
(s := img N M A B C D hN hM)
(H := 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⟩
let y : Int := yOf M C D hM x
have hy0 : 0 ≤ y := by
have htmp := yOf_nonneg N M C D hN hM hC0 hD0 hCM hDM (Subtype.mk x hxDom)
simpa only [yOf, zfloorDiv, ge_iff_le] using htmp
have hyY : y ≤ YY := by
have htmp := yOf_le_Yn1 N M C D hN hM hC0 hD0 hCM hDM (Subtype.mk x hxDom)
simpa only [yOf, zfloorDiv, Yn1, ge_iff_le] using htmp
by_cases hyTop : y = YY
· have hxLe : x ≤ N - 1 := (Finset.mem_Icc.mp hxDom).2
have hyDiv : zfloorDiv (C * x + D) M hM = YY := by simpa only [zfloorDiv, yOf] using hyTop
have hA_le : A * x ≤ A * (N - 1) := mul_le_mul_of_nonneg_left hxLe hAnonneg
have hObj_le : obj A B C D M x hM ≤ A * (N - 1) + B * YY := by
calc
obj A B C D M x hM = A * x + B * zfloorDiv (C * x + D) M hM := by simp only [obj,
zfloorDiv]
_ = A * x + B * YY := by rw [hyDiv]
_ ≤ A * (N - 1) + B * YY := by nlinarith [hA_le]
exact le_trans hObj_le (le_max_left _ _)
· have hy_lt : y < YY := lt_of_le_of_ne hyY (fun hy' => hyTop hy')
have hyDomYY : y ∈ dom YY hYpos := by
exact Finset.mem_Icc.mpr ⟨hy0, by nlinarith [hy_lt]⟩
have hRecObj :
obj B A M (M - D - 1) C y hCpos ≤ mwf YY C B A M (M - D - 1) hYpos hCpos :=
obj_le_mwf_of_mem YY C B A M (M - D - 1) hYpos hCpos hyDomYY
have hDiv : zfloorDiv (C * x + D) M hM = y := by rfl
have hDivEq : (C * x + D) / M = y := by simpa only [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 ≤ 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 * 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
have hObj2 : obj B A M (M - D - 1) C y hCpos =
B * y + A * zfloorDiv (M * y + M - D - 1) C hCpos := by
calc
obj B A M (M - D - 1) C y hCpos
= B * y + A * zfloorDiv (M * y + (M - D - 1)) C hCpos := by simp only [obj, zfloorDiv]
_ = B * y + A * zfloorDiv (M * y + M - D - 1) C hCpos := by rw [harg]
have hObj_le_rec : obj A B C D M x hM ≤ obj B A M (M - D - 1) C y hCpos := by
calc
obj A B C D M x hM = A * x + B * y := by simp only [obj, zfloorDiv, yOf, y]
_ ≤ A * zfloorDiv (M * y + M - D - 1) C hCpos + B * y := by nlinarith [hAub]
_ = B * y + A * zfloorDiv (M * y + M - D - 1) C hCpos := by ring
_ = obj B A M (M - D - 1) C y hCpos := hObj2.symm
exact le_trans hObj_le_rec (le_trans hRecObj (le_max_right _ _))
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` の最大に分解。
証明: 場合分け・式変形・既存補題の書き換えで示す。
役割: 負傾き分岐の主定理。
-/
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 < Yn1 N M C D hN hM) (hAneg : A < 0) :
let YY := Yn1 N M C D hN hM
let hCpos : 0 < C :=
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
dsimp only [Yn1, yOf, zfloorDiv, mwf, img, obj, dom, Lean.Elab.WF.paramLet]
let YY : Int := Yn1 N M C D hN hM
have hCpos : 0 < C := hCpos_of_Y_ge_one N M C D hN hM hC0 hD0 hDM hYpos
have hDdiv0 : zfloorDiv D M hM = 0 := by
unfold zfloorDiv
exact Int.ediv_eq_zero_of_lt_abs hD0 (by simpa only [abs_of_pos hM] using hDM)
have hZero_le : 0 ≤ mwf N M A B C D hN hM := by
have hx0 : (0 : Int) ∈ dom N hN := by
exact Finset.mem_Icc.mpr ⟨le_rfl, sub_nonneg.mpr ((Int.lt_iff_add_one_le).1 hN)⟩
have hobj0 := obj_le_mwf N M A B C D 0 hN hM hx0
have hobj0' : obj A B C D M 0 hM = 0 := by
calc
obj A B C D M 0 hM = A * 0 + B * zfloorDiv D M hM := by simp only [obj, mul_zero, zfloorDiv,
zero_add]
_ = A * 0 + B * 0 := by rw [hDdiv0]
_ = 0 := by ring
rw [hobj0'] at hobj0
exact 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
have hrec_core : mwf YY C B A M (M - D - 1) hYpos hCpos ≤ mwf N M A B C D hN hM - (A + B) := by
unfold mwf
dsimp only [img, obj, zfloorDiv, dom, Lean.Elab.WF.paramLet]
refine Finset.max'_le
(s := img YY C B A M (M - D - 1) hYpos hCpos)
(H := img_nonempty
(N := YY) (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 ≤ YY - 1 := (Finset.mem_Icc.mp hyDom).2
have hy1_nonneg : 0 ≤ y + 1 := by nlinarith [hy0]
have hy1_leYY : y + 1 ≤ YY := by nlinarith [hyLePred]
have hy1_ne0 : y + 1 ≠ 0 := by nlinarith [hy0]
let x : Int := iy_left N M C D (y + 1) hN hM hC0 hD0 hCM hDM hy1_nonneg hy1_leYY
have hxDom : x ∈ dom N hN :=
iy_left_mem_dom N M C D (y + 1) hN hM hC0 hD0 hCM hDM hy1_nonneg hy1_leYY
have hyOf : 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 hY1 : 1 ≤ Yn1 N M C D hN hM := (Int.lt_iff_add_one_le).1 hYpos
have hxDef0 : x = zfloorDiv (M * (y + 1) + C - D - 1) C hCpos := by
have hneq : y + 1 ≠ 0 := hy1_ne0
unfold x iy_left
simp only [hneq, ↓reduceDIte, zfloorDiv]
have hxDef : x = zfloorDiv (M * y + M - D - 1) C hCpos + 1 := by
have hCne : C ≠ 0 := ne_of_gt hCpos
calc
x = zfloorDiv (M * (y + 1) + C - D - 1) C hCpos := hxDef0
_ = zfloorDiv ((M * y + M - D - 1) + C) C hCpos := by ring_nf
_ = zfloorDiv (M * y + M - D - 1) C hCpos + 1 := by
unfold zfloorDiv
simpa only [add_comm, mul_comm, mul_one] using
(Int.add_mul_ediv_right (M * y + M - D - 1) 1 hCne)
have hyDiv : zfloorDiv (C * x + D) M hM = y + 1 := by simpa only [zfloorDiv, yOf] using hyOf
have harg : M * y + (M - D - 1) = M * y + M - D - 1 := by ring
have hObj2 : obj B A M (M - D - 1) C y hCpos =
B * y + A * zfloorDiv (M * y + M - D - 1) C hCpos := by
calc
obj B A M (M - D - 1) C y hCpos
= B * y + A * zfloorDiv (M * y + (M - D - 1)) C hCpos := by simp only [obj, zfloorDiv]
_ = B * y + A * zfloorDiv (M * y + M - D - 1) C hCpos := by rw [harg]
have hObjEq : (A + B) + obj B A M (M - D - 1) C y hCpos = obj A B C D M x hM := by
calc
(A + B) + obj B A M (M - D - 1) C y hCpos
= (A + B) + (B * y + A * zfloorDiv (M * y + M - D - 1) C hCpos) := by rw [hObj2]
_ = B * (y + 1) + A * (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 * zfloorDiv (C * x + D) M hM := by rw [hyDiv]
_ = obj A B C D M x hM := by simp only [zfloorDiv, obj]
have hObjLe : obj A B C D M x hM ≤ mwf N M A B C D hN hM :=
obj_le_mwf_of_mem N M A B C D hN hM hxDom
have hplus : (A + B) + obj B A M (M - D - 1) C y hCpos ≤ mwf N M A B C D hN hM :=
hObjEq ▸ hObjLe
nlinarith [hplus]
nlinarith [hrec_core]
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
dsimp only [img, obj, zfloorDiv, dom, Lean.Elab.WF.paramLet]
refine Finset.max'_le
(s := img N M A B C D hN hM)
(H := 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⟩
let y : Int := yOf M C D hM x
have hy0 : 0 ≤ y := by
have htmp := yOf_nonneg N M C D hN hM hC0 hD0 hCM hDM (Subtype.mk x hxDom)
simpa only [yOf, zfloorDiv, ge_iff_le] using htmp
have hyY : y ≤ YY := by
have htmp := yOf_le_Yn1 N M C D hN hM hC0 hD0 hCM hDM (Subtype.mk x hxDom)
simpa only [yOf, zfloorDiv, Yn1, ge_iff_le] using htmp
by_cases hyZero : y = 0
· have hx0 : 0 ≤ x := (Finset.mem_Icc.mp hxDom).1
have hyDiv : zfloorDiv (C * x + D) M hM = 0 := by simpa only [zfloorDiv, yOf] using hyZero
have hObjLe0 : obj A B C D M x hM ≤ 0 := by
have hAx : A * x ≤ 0 := mul_nonpos_of_nonpos_of_nonneg (le_of_lt hAneg) hx0
calc
obj A B C D M x hM = A * x + B * zfloorDiv (C * x + D) M hM := by simp only [obj,
zfloorDiv]
_ = A * x + B * 0 := by rw [hyDiv]
_ ≤ 0 := by nlinarith [hAx]
exact le_trans hObjLe0 (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 ≤ YY - 1 := by nlinarith [hyY]
have hyDomYY : y - 1 ∈ dom YY hYpos := Finset.mem_Icc.mpr ⟨hy1, hy1Le⟩
have hRecObj :
obj B A M (M - D - 1) C (y - 1) hCpos ≤ mwf YY C B A M (M - D - 1) hYpos hCpos :=
obj_le_mwf_of_mem YY C B A M (M - D - 1) hYpos hCpos hyDomYY
have hDiv : zfloorDiv (C * x + D) M hM = y := by rfl
have hDivEq : (C * x + D) / M = y := by simpa only [zfloorDiv] using hDiv
have hNumLow : y * M ≤ C * x + D := (Int.le_ediv_iff_mul_le hM).1 (le_of_eq hDivEq)
have hLle : 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 * zfloorDiv (M * y + C - D - 1) C hCpos := by
have htmp : x * A ≤ zfloorDiv (M * y + C - D - 1) C hCpos * A :=
mul_le_mul_of_nonpos_right hLle (le_of_lt hAneg)
simpa only [zfloorDiv, ge_iff_le, mul_comm] using htmp
have hCne : C ≠ 0 := ne_of_gt hCpos
have hFloor :
zfloorDiv (M * y + C - D - 1) C hCpos
= zfloorDiv (M * (y - 1) + M - D - 1) C hCpos + 1 := by
calc
zfloorDiv (M * y + C - D - 1) C hCpos
= zfloorDiv ((M * (y - 1) + M - D - 1) + C) C hCpos := by ring_nf
_ = zfloorDiv (M * (y - 1) + M - D - 1) C hCpos + 1 := by
unfold 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 : obj B A M (M - D - 1) C (y - 1) hCpos =
B * (y - 1) + A * 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
obj B A M (M - D - 1) C (y - 1) hCpos
= B * (y - 1) + A * zfloorDiv (M * (y - 1) + (M - D - 1)) C hCpos := by simp only
[obj, zfloorDiv]
_ = B * (y - 1) + A * zfloorDiv (M * (y - 1) + M - D - 1) C hCpos := by rw [harg]
have hObj_le :
obj A B C D M x hM ≤ (A + B) + obj B A M (M - D - 1) C (y - 1) hCpos := by
calc
obj A B C D M x hM = A * x + B * y := by simp only [obj, zfloorDiv, yOf, y]
_ ≤ A * zfloorDiv (M * y + C - D - 1) C hCpos + B * y := by nlinarith [hAub]
_ = B * y + A * (zfloorDiv (M * (y - 1) + M - D - 1) C hCpos + 1) := by rw [hFloor]; ring
_ = (A + B) + (B * (y - 1) + A * zfloorDiv (M * (y - 1) + M - D - 1) C hCpos) := by ring
_ = (A + B) + obj B A M (M - D - 1) C (y - 1) hCpos := by rw [hObj2]
exact le_trans hObj_le (le_trans (by nlinarith [hRecObj]) (le_max_right _ _))
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` 形式へ移す。
証明: 既存補題の書き換えで示す。
役割: 状態遷移定理列の入口。
-/
theorem mwf_step_init_equiv
(N M A B C D : Int) (hN : 0 < N) (hM : 0 < M) :
let U := St.mk (B * 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
dsimp only [zfloorDiv, mwf, img, obj, dom, Lean.Elab.WF.paramLet]
simpa only [zero_add, right_eq_sup, mwf, img, obj, zfloorDiv, dom] using
step_init_equiv N M A B C D hN hM
/--
入力/前提: U : St。
主張: `step_normalize` は評価式を保存。
内容: `normalize_max` とフィールド展開を結合。
証明: 既存補題の書き換えで示す。
役割: `step` 正しさの前半。
-/
theorem mwf_step_normalize_equiv
(U : St) :
let V := step_normalize U
max U.r (U.s + st_mwf U)
=
max V.r (V.s + stnorm_mwf V) := by
dsimp only [step_normalize, normS, zfloorDiv, normA, normC, zfloorMod, normD, st_mwf, mwf, img,
obj, dom, stnorm_mwf, Lean.Elab.WF.paramLet]
simpa only [mwf, img, obj, zfloorDiv, dom, normS, normA, normC, zfloorMod, normD] using
normalize_max U.r U.s U.n U.m U.a U.b U.c U.d U.hn U.hm
/--
入力/前提: U : StNorm、hY0 : stnorm_y U = 0。
主張: `Y=0` 分岐で評価式は不変。
内容: `mwf_yn1_zero` と `step_reduce_y0` 展開で一致化。
証明: 式変形・既存補題の書き換えで示す。
役割: reduce 同値の停止枝。
-/
theorem mwf_step_reduce_equiv_y0
(U : StNorm)
(hY0 : stnorm_y U = 0) :
let V := step_reduce_y0 U hY0
max U.r (U.s + stnorm_mwf U)
=
max V.r (V.s + st_mwf V) := 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
have hlift0 :
max U.r (U.s + stnorm_mwf U) =
max U.r (U.s + max 0 (U.a * (U.n - 1))) := by
simpa only [stnorm_mwf, mwf, img, obj, zfloorDiv, dom] using
congrArg (fun t => max U.r (U.s + t)) hcore
have hlift :
max U.r (U.s + stnorm_mwf U) =
max (max U.r U.s) (U.s + U.a * (U.n - 1)) := by
calc
max U.r (U.s + stnorm_mwf U) = max U.r (U.s + max 0 (U.a * (U.n - 1))) := hlift0
_ = max U.r (max U.s (U.s + U.a * (U.n - 1))) := by simp only [add_max, add_zero]
_ = max (max U.r U.s) (U.s + U.a * (U.n - 1)) := by simp only [max_assoc]
have hbase : mwf 1 1 0 0 0 0 (by decide) (by decide) = 0 := by
unfold mwf img dom obj zfloorDiv
simp only [zero_mul, add_zero, sub_self, Finset.Icc_self, Finset.image_singleton,
Finset.max'_singleton]
have hstep :
max (step_reduce_y0 U hY0).r ((step_reduce_y0 U hY0).s + st_mwf (step_reduce_y0 U hY0)) =
max (max U.r U.s) (U.s + U.a * (U.n - 1)) := by
simp only [step_reduce_y0, Int.max_assoc, st_mwf, mwf, img, obj, zero_mul, zfloorDiv, add_zero,
dom, sub_self, Finset.Icc_self, Finset.image_singleton, Finset.max'_singleton, max_self]
exact hlift.trans hstep.symm
/--
入力/前提: U : StNorm、hYpos : 0 < stnorm_y U、hAnonneg : 0 ≤ U.a。
主張: `Y>0 ∧ A≥0` 分岐で評価式は不変。
内容: `mwf_yn1_pos_a_nonneg` と状態展開で照合。
証明: 式変形・既存補題の書き換えで示す。
役割: reduce 同値の正傾き枝。
-/
theorem mwf_step_reduce_equiv_ypos_a_nonneg
(U : StNorm)
(hYpos : 0 < stnorm_y U)
(hAnonneg : 0 ≤ U.a) :
let V := step_reduce_ypos_a_nonneg U hYpos hAnonneg
max U.r (U.s + stnorm_mwf U)
=
max V.r (V.s + st_mwf V) := by
dsimp only [step_reduce_ypos_a_nonneg, stnorm_y, Yn1, yOf, zfloorDiv, stnorm_mwf, mwf, img, obj,
dom, st_mwf, Lean.Elab.WF.paramLet]
have hcore :=
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 [Yn1, yOf, zfloorDiv, stnorm_y] using hYpos) hAnonneg
have hcore' :
max U.r (U.s + stnorm_mwf U)
=
max U.r
(U.s +
max
(U.a * (U.n - 1) + U.b * stnorm_y U)
(mwf (stnorm_y U) U.c U.b U.a U.m (U.m - U.d - 1)
hYpos
(hCpos_of_Y_ge_one U.n U.m U.c U.d U.hn U.hm U.hC0 U.hD0 U.hDM hYpos))) := by
simpa only [stnorm_mwf, mwf, img, obj, zfloorDiv, dom, stnorm_y, Yn1, yOf] using
congrArg (fun t => max U.r (U.s + t)) hcore
calc
max U.r (U.s + stnorm_mwf U)
= max U.r
(U.s +
max
(U.a * (U.n - 1) + U.b * stnorm_y U)
(mwf (stnorm_y U) U.c U.b U.a U.m (U.m - U.d - 1)
hYpos
(hCpos_of_Y_ge_one U.n U.m U.c U.d U.hn U.hm U.hC0 U.hD0 U.hDM hYpos))) := hcore'
_ =
max
(max U.r (U.s + (U.a * (U.n - 1) + U.b * stnorm_y U)))
(U.s +
mwf (stnorm_y U) U.c U.b U.a U.m (U.m - U.d - 1)
hYpos
(hCpos_of_Y_ge_one U.n U.m U.c U.d U.hn U.hm U.hC0 U.hD0 U.hDM hYpos)) := by
rw [add_max]
rw [max_assoc]
_ =
max (step_reduce_ypos_a_nonneg U hYpos hAnonneg).r
((step_reduce_ypos_a_nonneg U hYpos hAnonneg).s +
st_mwf (step_reduce_ypos_a_nonneg U hYpos hAnonneg)) := by
rfl
/--
入力/前提: U : StNorm、hYpos : 0 < stnorm_y U、hAneg : U.a < 0。
主張: `Y>0 ∧ A<0` 分岐で評価式は不変。
内容: `mwf_yn1_pos_a_neg` と状態展開で照合。
証明: 式変形・既存補題の書き換えで示す。
役割: reduce 同値の負傾き枝。
-/
theorem mwf_step_reduce_equiv_ypos_a_neg
(U : StNorm)
(hYpos : 0 < stnorm_y U)
(hAneg : U.a < 0) :
let V := step_reduce_ypos_a_neg U hYpos hAneg
max U.r (U.s + stnorm_mwf U)
=
max V.r (V.s + st_mwf V) := by
dsimp only [step_reduce_ypos_a_neg, stnorm_y, Yn1, yOf, zfloorDiv, stnorm_mwf, mwf, img, obj, dom,
st_mwf, Lean.Elab.WF.paramLet]
have hcore :=
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 [Yn1, yOf, zfloorDiv, stnorm_y] using hYpos) hAneg
have hcore' :
max U.r (U.s + stnorm_mwf U)
=
max U.r
(U.s +
max
0
((U.a + U.b) +
mwf (stnorm_y U) U.c U.b U.a U.m (U.m - U.d - 1)
hYpos
(hCpos_of_Y_ge_one U.n U.m U.c U.d U.hn U.hm U.hC0 U.hD0 U.hDM hYpos))) := by
simpa only [stnorm_mwf, mwf, img, obj, zfloorDiv, dom, stnorm_y, Yn1, yOf] using
congrArg (fun t => max U.r (U.s + t)) hcore
calc
max U.r (U.s + stnorm_mwf U)
= max U.r
(U.s +
max
0
((U.a + U.b) +
mwf (stnorm_y U) U.c U.b U.a U.m (U.m - U.d - 1)
hYpos
(hCpos_of_Y_ge_one
U.n U.m U.c U.d
U.hn U.hm U.hC0 U.hD0 U.hDM
hYpos))) := hcore'
_ = max (max U.r U.s)
(U.s +
((U.a + U.b) +
mwf (stnorm_y U) U.c U.b U.a U.m (U.m - U.d - 1)
hYpos
(hCpos_of_Y_ge_one U.n U.m U.c U.d U.hn U.hm U.hC0 U.hD0 U.hDM hYpos))) := by
rw [add_max]
simp only [add_zero, mwf, img, obj, zfloorDiv, dom, stnorm_y, Yn1, yOf, Int.max_assoc]
_ = max (max U.r U.s)
((U.s + (U.a + U.b)) +
mwf (stnorm_y U) U.c U.b U.a U.m (U.m - U.d - 1)
hYpos
(hCpos_of_Y_ge_one U.n U.m U.c U.d U.hn U.hm U.hC0 U.hD0 U.hDM hYpos)) := by
simp only [mwf, img, obj, zfloorDiv, dom, stnorm_y, Yn1, yOf, add_assoc, Int.max_assoc]
_ =
max (step_reduce_ypos_a_neg U hYpos hAneg).r
((step_reduce_ypos_a_neg U hYpos hAneg).s +
st_mwf (step_reduce_ypos_a_neg U hYpos hAneg)) := by
rfl
/--
入力/前提: U : StNorm。
主張: `step_reduce` 全体で評価式は不変。
内容: `Y` と `A` の符号で分岐し枝定理を貼る。
証明: 場合分け・既存補題の書き換えで示す。
役割: reduce 正しさの統合定理。
-/
theorem mwf_step_reduce_equiv
(U : StNorm) :
let V := step_reduce U
max U.r (U.s + stnorm_mwf U)
=
max V.r (V.s + st_mwf V) := by
by_cases hY0 : stnorm_y U = 0
· have hY0' : (U.c * (U.n - 1) + U.d) / U.m = 0 := by
simpa only [stnorm_y, Yn1, yOf, zfloorDiv] using hY0
simpa only [stnorm_mwf, mwf, img, obj, zfloorDiv, dom, step_reduce, stnorm_y, Yn1, yOf, hY0',
↓reduceDIte, step_reduce_y0, Int.max_assoc, st_mwf, zero_mul, add_zero,
EuclideanDomain.div_one, mul_zero, sub_self, Finset.Icc_self, Finset.image_singleton,
Finset.max'_singleton, max_self] using mwf_step_reduce_equiv_y0 U hY0
· have hYnonneg : 0 ≤ stnorm_y U :=
Y_nonneg U.n U.m U.c U.d U.hn U.hm U.hC0 U.hD0
have hYpos : 0 < stnorm_y U := lt_of_le_of_ne hYnonneg (fun h => hY0 h.symm)
have hYpos' : 0 < (U.c * (U.n - 1) + U.d) / U.m := by
simpa only [stnorm_y, Yn1, yOf, zfloorDiv] using hYpos
have hne' : (U.c * (U.n - 1) + U.d) / U.m ≠ 0 := ne_of_gt hYpos'
by_cases hAnonneg : 0 ≤ U.a
· simpa only [stnorm_mwf, mwf, img, obj, zfloorDiv, dom, step_reduce, stnorm_y, Yn1, yOf, hne',
↓reduceDIte, hAnonneg, step_reduce_ypos_a_nonneg, st_mwf, Int.max_assoc,
Int.max_add_left] using mwf_step_reduce_equiv_ypos_a_nonneg U hYpos hAnonneg
· have hAneg : U.a < 0 := lt_of_not_ge hAnonneg
have hnot : ¬ (0 ≤ U.a) := hAnonneg
simpa only [stnorm_mwf, mwf, img, obj, zfloorDiv, dom, step_reduce, stnorm_y, Yn1, yOf, hne',
↓reduceDIte, hnot, step_reduce_ypos_a_neg, st_mwf, Int.max_assoc] using
mwf_step_reduce_equiv_ypos_a_neg U hYpos hAneg
/--
入力/前提: U : St。
主張: `step` 1回で評価式は不変。
内容: normalize 同値と reduce 同値を合成。
証明: 式変形・既存補題の書き換えで示す。
役割: 反復アルゴリズム正しさの中核。
-/
theorem mwf_step_equiv
(U : St) :
let V := 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
dsimp only [step, step_normalize, normS, zfloorDiv, normA, normC, zfloorMod, normD, step_reduce,
stnorm_y, Yn1, yOf, step_reduce_y0, step_reduce_ypos_a_nonneg, step_reduce_ypos_a_neg,
dite_eq_ite, Lean.Elab.WF.paramLet, mwf, img, obj, dom]
calc
max U.r (U.s + mwf U.n U.m U.a U.b U.c U.d U.hn U.hm)
= max (step_normalize U).r ((step_normalize U).s + stnorm_mwf (step_normalize U)) := by
simpa only [mwf, img, obj, zfloorDiv, dom, step_normalize, normS, normA, normC, zfloorMod,
normD, stnorm_mwf, st_mwf] using (mwf_step_normalize_equiv U)
_ = max (step_reduce (step_normalize U)).r
((step_reduce (step_normalize U)).s + st_mwf (step_reduce (step_normalize U))) := by
simpa only [step_normalize, normS, zfloorDiv, normA, normC, zfloorMod, normD, stnorm_mwf,
mwf, img, obj, dom, step_reduce, stnorm_y, Yn1, yOf, step_reduce_y0, Int.max_assoc,
step_reduce_ypos_a_nonneg, step_reduce_ypos_a_neg, dite_eq_ite, st_mwf] using
(mwf_step_reduce_equiv (step_normalize U))
_ = max (step_reduce (step_normalize U)).r
((step_reduce (step_normalize U)).s +
mwf (step_reduce (step_normalize U)).n (step_reduce (step_normalize U)).m
(step_reduce (step_normalize U)).a (step_reduce (step_normalize U)).b
(step_reduce (step_normalize U)).c (step_reduce (step_normalize U)).d
(step_reduce (step_normalize U)).hn (step_reduce (step_normalize U)).hm) := by
rfl
/--
入力/前提: U : St、hc0 : U.c = 0。
主張: `U.c=0` なら正規化後も `stnorm_y=0`。
内容: `normC 0 = 0` と `Y_eq_zero_of_C_eq_zero` を適用。
証明: 既存補題の書き換えで示す。
役割: 停止分岐への接続。
-/
lemma stnorm_y_step_normalize_eq_zero
(U : St) (hc0 : U.c = 0) :
stnorm_y (step_normalize U) = 0 := by
have hCmod0 : U.c % U.m = 0 := by
simpa only [hc0] using (Int.zero_emod U.m)
simpa only [stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS, normA, normC, zfloorMod, hCmod0,
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)
/--
入力/前提: 追加の仮定なし。
主張: 基底状態 `mwf 1 1 0 0 0 0 = 0`。
内容: `Yn1=0` ケース公式を直接適用。
証明: 式変形で示す。
役割: 停止枝の最終値評価。
-/
lemma mwf_one_one_zero :
mwf 1 1 0 0 0 0 (by decide) (by decide) = 0 := by
have hY0 : 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]
/--
入力/前提: W : StNorm、h : stnorm_y W = 0。
主張: `step_reduce_y0` 後の `st_mwf` は 0。
内容: 遷移先が基底状態であることを使う。
証明: 既存補題の適用と式変形で示す。
役割: 終了時の `max` 簡約に使用。
-/
lemma st_mwf_step_reduce_y0_zero
(W : StNorm) (h : stnorm_y W = 0) :
st_mwf (step_reduce_y0 W h) = 0 := by
dsimp only [step_reduce_y0, st_mwf, mwf, img, obj, zfloorDiv, dom, Int.reduceSub]
exact mwf_one_one_zero
/--
入力/前提: W : StNorm、h : stnorm_y W = 0。
主張: 仮定 `stnorm_y=0` で `step_reduce` は `y0` 枝に一致。
内容: 外側 `if` を仮定で簡約。
証明: 既存補題の書き換えで示す。
役割: 停止証明で分岐を確定。
-/
lemma step_reduce_eq_y0
(W : StNorm) (h : stnorm_y W = 0) :
step_reduce W = step_reduce_y0 W h := by
have h' : (W.c * (W.n - 1) + W.d) / W.m = 0 := by
simpa only [stnorm_y, Yn1, yOf, zfloorDiv] using h
unfold step_reduce
simp only [stnorm_y, Yn1, yOf, zfloorDiv, h', ↓reduceDIte, step_reduce_y0, Int.max_assoc]
/--
入力/前提: W : StNorm、hPos : 0 < stnorm_y W、hAnonneg : 0 ≤ W.a。
主張: `stnorm_y>0 ∧ a≥0` で `step_reduce` は正傾き枝に一致。
内容: 2段の `if` を仮定で簡約。
証明: 既存補題の書き換えで示す。
役割: 縮小証明で分岐を確定。
-/
lemma step_reduce_eq_ypos_a_nonneg
(W : StNorm) (hPos : 0 < stnorm_y W) (hAnonneg : 0 ≤ W.a) :
step_reduce W = step_reduce_ypos_a_nonneg W hPos hAnonneg := by
have hPos' : 0 < (W.c * (W.n - 1) + W.d) / W.m := by
simpa only [stnorm_y, Yn1, yOf, zfloorDiv] using hPos
have hne' : (W.c * (W.n - 1) + W.d) / W.m ≠ 0 := ne_of_gt hPos'
unfold step_reduce
simp only [stnorm_y, Yn1, yOf, zfloorDiv, hne', ↓reduceDIte, hAnonneg, step_reduce_ypos_a_nonneg]
/--
入力/前提: W : StNorm、hPos : 0 < stnorm_y W、hAneg : W.a < 0。
主張: `stnorm_y>0 ∧ a<0` で `step_reduce` は負傾き枝に一致。
内容: 2段の `if` を仮定で簡約。
証明: 既存補題の書き換えで示す。
役割: 縮小証明で分岐を確定。
-/
lemma step_reduce_eq_ypos_a_neg
(W : StNorm) (hPos : 0 < stnorm_y W) (hAneg : W.a < 0) :
step_reduce W = step_reduce_ypos_a_neg W hPos hAneg := by
have hPos' : 0 < (W.c * (W.n - 1) + W.d) / W.m := by
simpa only [stnorm_y, Yn1, yOf, zfloorDiv] using hPos
have hne' : (W.c * (W.n - 1) + W.d) / W.m ≠ 0 := ne_of_gt hPos'
unfold step_reduce
have hnot : ¬ (0 ≤ W.a) := not_le.mpr hAneg
simp only [stnorm_y, Yn1, yOf, zfloorDiv, hne', ↓reduceDIte, hnot, step_reduce_ypos_a_neg]
/--
入力/前提: `U : St`、`hc0 : (step U).c = 0`。
主張: `(step U).c = 0` なら `stnorm_y (step_normalize U) = 0`。
内容: `stnorm_y` が正なら `step` の `c` は `m` に更新され矛盾することを示す。
証明: 場合分け・既存補題の書き換えで示す。
役割: 停止条件を正規化側へ戻す補助。
-/
lemma stnorm_y_step_normalize_eq_zero_of_step_c_zero
(U : St) (hc0 : (step U).c = 0) :
stnorm_y (step_normalize U) = 0 := by
by_cases hY0 : stnorm_y (step_normalize U) = 0
· exact hY0
· have hYnonneg : 0 ≤ stnorm_y (step_normalize U) :=
Y_nonneg (step_normalize U).n (step_normalize U).m
(step_normalize U).c (step_normalize U).d
(step_normalize U).hn (step_normalize U).hm
(step_normalize U).hC0 (step_normalize U).hD0
have hYpos : 0 < stnorm_y (step_normalize U) :=
lt_of_le_of_ne hYnonneg (by simpa only [stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS,
normA, normC, zfloorMod, normD, ne_eq, eq_comm] using hY0)
by_cases hAnonneg : 0 ≤ (step_normalize U).a
· have hstep :
step U =
step_reduce_ypos_a_nonneg (step_normalize U) hYpos hAnonneg := by
unfold step
exact step_reduce_eq_ypos_a_nonneg (step_normalize U) hYpos hAnonneg
have hc : (step U).c = (step_normalize U).m := congrArg St.c hstep
have hm0 : U.m ≠ 0 := ne_of_gt U.hm
have hc' : (step U).c = U.m := by simpa only [step, step_reduce, stnorm_y, Yn1, yOf,
zfloorDiv, step_normalize, normS, normA, normC, zfloorMod, normD, step_reduce_y0,
Int.max_assoc, step_reduce_ypos_a_nonneg, step_reduce_ypos_a_neg, dite_eq_ite] using hc
exact (hm0 (hc'.symm.trans hc0)).elim
· have hAneg : (step_normalize U).a < 0 := lt_of_not_ge hAnonneg
have hstep :
step U =
step_reduce_ypos_a_neg (step_normalize U) hYpos hAneg := by
unfold step
exact step_reduce_eq_ypos_a_neg (step_normalize U) hYpos hAneg
have hc : (step U).c = (step_normalize U).m := congrArg St.c hstep
have hm0 : U.m ≠ 0 := ne_of_gt U.hm
have hc' : (step U).c = U.m := by simpa only [step, step_reduce, stnorm_y, Yn1, yOf,
zfloorDiv, step_normalize, normS, normA, normC, zfloorMod, normD, step_reduce_y0,
Int.max_assoc, step_reduce_ypos_a_nonneg, step_reduce_ypos_a_neg, dite_eq_ite] using hc
exact (hm0 (hc'.symm.trans hc0)).elim
/-! 停止条件において答えを得る方法 -/
/--
入力/前提: U : St、hc0 : U.c = 0。
主張: 停止条件 `c=0` では答えは `(step U).r`。
内容: `y0` 分岐確定と `st_mwf=0` で `max` を潰す。
証明: 式変形・既存補題の書き換えで示す。
役割: 実際の値読み出し定理。
-/
theorem mwf_step_reduce_result
(U : St) (hc0 : U.c = 0) :
max U.r (U.s + st_mwf U) = (step U).r := by
have hstepEq :
max U.r (U.s + st_mwf U)
=
max (step U).r ((step U).s + st_mwf (step U)) := by
simpa only [st_mwf, mwf, img, obj, zfloorDiv, dom, step, step_reduce, stnorm_y, Yn1, yOf,
step_normalize, normS, normA, normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc,
step_reduce_ypos_a_nonneg, step_reduce_ypos_a_neg, dite_eq_ite] using (mwf_step_equiv U)
have hY0 : stnorm_y (step_normalize U) = 0 := stnorm_y_step_normalize_eq_zero U hc0
have hstepY0 :
step_reduce (step_normalize U) = step_reduce_y0 (step_normalize U) hY0 :=
step_reduce_eq_y0 (step_normalize U) hY0
have hmwf0 : st_mwf (step_reduce_y0 (step_normalize U) hY0) = 0 :=
st_mwf_step_reduce_y0_zero (step_normalize U) hY0
have htail :
max (step U).r ((step U).s + st_mwf (step U)) = (step U).r := by
change
max (step_reduce (step_normalize U)).r
((step_reduce (step_normalize U)).s + st_mwf (step_reduce (step_normalize U)))
=
(step_reduce (step_normalize U)).r
rw [hstepY0]
have hs :
(step_reduce_y0 (step_normalize U) hY0).s =
(step_reduce_y0 (step_normalize U) hY0).r := by
simp only [step_reduce_y0, step_normalize, normS, zfloorDiv, normA, normC, zfloorMod, normD,
Int.max_assoc]
rw [hs, hmwf0]
simp only [step_reduce_y0, step_normalize, normS, zfloorDiv, normA, normC, zfloorMod, normD,
Int.max_assoc, add_zero, max_self]
exact hstepEq.trans htail
/--
入力/前提: U : St、hc0 : U.c = 0。
主張: `U.c = 0` なら 1 ステップ後も `(step U).c = 0`。
内容: `stnorm_y=0` の枝へ簡約し `step_reduce_y0` の定義から従う。
証明: 式変形で示す。
役割: 停止条件の不変性。
-/
lemma step_c_zero_of_c_zero (U : St) (hc0 : U.c = 0) : (step U).c = 0 := by
have hY0 : stnorm_y (step_normalize U) = 0 :=
stnorm_y_step_normalize_eq_zero U hc0
have hstep :
step_reduce (step_normalize U) =
step_reduce_y0 (step_normalize U) hY0 :=
step_reduce_eq_y0 (step_normalize U) hY0
change (step_reduce (step_normalize U)).c = 0
rw [hstep]
simp only [step_reduce_y0, step_normalize, normS, zfloorDiv, normA, normC, zfloorMod, normD,
Int.max_assoc]
/--
入力/前提: U : St。
主張: `(step U).c = 0` か `(step U).m = U.c % U.m` が成り立つ。
内容: `step_reduce` の分岐を展開して `m` 更新形を読み取る。
証明: 場合分け・既存補題の書き換えで示す。
役割: Euclid 形更新か停止かの判定に使う。
-/
lemma step_m_or (U : St) : (step U).c = 0 ∨ (step U).m = U.c % U.m := by
let W := step_normalize U
by_cases hy0 : stnorm_y W = 0
· left
have hstep : step U = step_reduce_y0 W hy0 := by
unfold step
exact step_reduce_eq_y0 W hy0
simpa only [step, step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS, normA,
normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc, step_reduce_ypos_a_nonneg,
step_reduce_ypos_a_neg, dite_eq_ite] using (congrArg St.c hstep)
· have hpos : 0 < stnorm_y W := by
have hge :
0 ≤ stnorm_y W :=
Y_nonneg W.n W.m W.c W.d W.hn W.hm W.hC0 W.hD0
exact lt_of_le_of_ne hge (by symm; exact hy0)
by_cases hAnonneg : 0 ≤ W.a
· right
have hstep : step U = step_reduce_ypos_a_nonneg W hpos hAnonneg := by
unfold step
exact step_reduce_eq_ypos_a_nonneg W hpos hAnonneg
have hm : (step U).m = W.c := congrArg St.m hstep
simpa only [step, step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS, normA,
normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc, step_reduce_ypos_a_nonneg,
step_reduce_ypos_a_neg, dite_eq_ite] using hm
· right
have hstep : step U = step_reduce_ypos_a_neg W hpos (lt_of_not_ge hAnonneg) := by
unfold step
exact step_reduce_eq_ypos_a_neg W hpos (lt_of_not_ge hAnonneg)
have hm : (step U).m = W.c := congrArg St.m hstep
simpa only [step, step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS, normA,
normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc, step_reduce_ypos_a_nonneg,
step_reduce_ypos_a_neg, dite_eq_ite] using hm
/--
入力/前提: U : St。
主張: `(step U).c = 0` または `(step U).c = U.m`。
内容: `step_reduce` の分岐を展開して `c` 更新形を読み取る。
証明: 場合分け・既存補題の書き換えで示す。
役割: Euclid 形更新の片方成分を特定する。
-/
lemma step_c_or (U : St) : (step U).c = 0 ∨ (step U).c = U.m := by
let W := step_normalize U
by_cases hy0 : stnorm_y W = 0
· left
have hstep : step U = step_reduce_y0 W hy0 := by
unfold step
exact step_reduce_eq_y0 W hy0
simpa only [step, step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS, normA,
normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc, step_reduce_ypos_a_nonneg,
step_reduce_ypos_a_neg, dite_eq_ite] using (congrArg St.c hstep)
· have hpos : 0 < stnorm_y W := by
have hge :
0 ≤ stnorm_y W :=
Y_nonneg W.n W.m W.c W.d W.hn W.hm W.hC0 W.hD0
exact lt_of_le_of_ne hge (by symm; exact hy0)
by_cases hAnonneg : 0 ≤ W.a
· right
have hstep : step U = step_reduce_ypos_a_nonneg W hpos hAnonneg := by
unfold step
exact step_reduce_eq_ypos_a_nonneg W hpos hAnonneg
have hc : (step U).c = W.m := congrArg St.c hstep
simpa only [step, step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS, normA,
normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc, step_reduce_ypos_a_nonneg,
step_reduce_ypos_a_neg, dite_eq_ite] using hc
· right
have hstep : step U = step_reduce_ypos_a_neg W hpos (lt_of_not_ge hAnonneg) := by
unfold step
exact step_reduce_eq_ypos_a_neg W hpos (lt_of_not_ge hAnonneg)
have hc : (step U).c = W.m := congrArg St.c hstep
simpa only [step, step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS, normA,
normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc, step_reduce_ypos_a_nonneg,
step_reduce_ypos_a_neg, dite_eq_ite] using hc
/-! ステップで状態が縮小することの証明 -/
/--
入力/前提: U : St。
主張: 1ステップで `m` が減るか `c=0` になる。
内容: `step_reduce` の3分岐を場合分け。
証明: 場合分け・式変形で示す。
役割: 反復の進捗・停止保証。
-/
theorem mwf_step_reduce_reduction
(U : St) : U.m > (step U).m ∨ (step U).c = 0 := by
cases step_m_or U with
| inl hc0 => exact Or.inr hc0
| inr hm =>
left
have hlt : (step U).m < U.m := by
calc
(step U).m = U.c % U.m := hm
_ < U.m := Int.emod_lt_of_pos U.c U.hm
exact hlt
/--
入力/前提: U : St。
主張: 1 ステップは「停止」か「Euclid 形の更新」になる。
内容: `step_c_or` と `step_m_or` を組み合わせて結論を得る。
証明: 場合分け・式変形で示す。
役割: Euclid 反復との対応付けに使う。
-/
lemma step_euclid_or_stop (U : St) :
(step U).c = 0 ∨ ((step U).c = U.m ∧ (step U).m = U.c % U.m) := by
cases step_c_or U with
| inl hc0 => exact Or.inl hc0
| inr hc1 =>
cases step_m_or U with
| inl hm0 =>
have hm0' : U.m = 0 := by
calc
U.m = (step U).c := by
symm
exact hc1
_ = 0 := hm0
exact False.elim ((ne_of_gt U.hm) hm0')
| inr hm1 =>
exact Or.inr ⟨hc1, hm1⟩
/--
入力/前提: `U : St`、`h : (step (step U)).c ≠ 0`。
主張: 前処理 1 ステップ後、次のステップが停止しなければ Euclid 1 ステップに一致。
内容: `step_euclid_or_stop` を `step U` に適用し停止分岐を排除する。
証明: 場合分けで示す。
役割: Euclid 反復解析のための橋渡し。
-/
lemma step_after_preprocess_euclid (U : St) (h : (step (step U)).c ≠ 0) :
(step (step U)).c = (step U).m ∧ (step (step U)).m = (step U).c % (step U).m := by
cases step_euclid_or_stop (step U) with
| inl hc0 => exact False.elim (h hc0)
| inr hpair => exact hpair
/-!
`Nat.greatestFib` と `Int.fib` の橋渡し補題。
-/
/--
入力/前提: n : Nat。
主張: `Int.fib (Nat.greatestFib n) ≤ n`。
内容: `Nat.fib_greatestFib_le` を `Int` にキャストする。
証明: 既存補題の書き換えで示す。
役割: `greatestFib` の上界評価に使う。
-/
theorem fib_greatestFib_le_int (n : Nat) : (Int.fib (Nat.greatestFib n) : Int) ≤ n := by
simpa only [Int.fib_natCast, Nat.cast_le] using (by exact_mod_cast (Nat.fib_greatestFib_le n))
/--
入力/前提: m n : Nat、Int.fib m : Int。
主張: `m ≤ Nat.greatestFib n ↔ (Int.fib m : Int) ≤ n`。
内容: `Nat.le_greatestFib` を `Int` に持ち上げた同値。
証明: 既存補題の書き換えで示す。
役割: `greatestFib` と `Int.fib` の比較に使う。
-/
@[simp]
theorem le_greatestFib_int {m n : Nat} :
m ≤ Nat.greatestFib n ↔ (Int.fib m : Int) ≤ n := by
constructor
· intro h
have h' : Nat.fib m ≤ n := (Nat.le_greatestFib (m := m) (n := n)).1 h
simpa only [Int.fib_natCast, Nat.cast_le, ge_iff_le] using (by exact_mod_cast h')
· intro h
have h' : (Nat.fib m : Int) ≤ n := by
simpa only [Nat.cast_le, Int.fib_natCast] using h
have h'' : Nat.fib m ≤ n := by
exact_mod_cast h'
exact (Nat.le_greatestFib (m := m) (n := n)).2 h''
/--
入力/前提: m n : Nat、m : Int。
主張: `Nat.greatestFib m < n ↔ (m : Int) < Int.fib n`。
内容: `Nat.greatestFib_lt` を `Int` にキャストして同値化する。
証明: 既存補題の書き換えで示す。
役割: `greatestFib` の下界比較に使う。
-/
@[simp]
theorem greatestFib_lt_int {m n : Nat} :
Nat.greatestFib m < n ↔ (m : Int) < Int.fib n := by
constructor
· intro h
have h' : m < Nat.fib n := (Nat.greatestFib_lt (m := m) (n := n)).1 h
simpa only [Int.fib_natCast, Nat.cast_lt, gt_iff_lt] using (by exact_mod_cast h')
· intro h
have h' : (m : Int) < Nat.fib n := by
simpa only [Nat.cast_lt, Int.fib_natCast] using h
have h'' : m < Nat.fib n := by
exact_mod_cast h'
exact (Nat.greatestFib_lt (m := m) (n := n)).2 h''
/--
入力/前提: n : Nat、n : Int。
主張: `(n : Int) < Int.fib (Nat.greatestFib n + 1)`。
内容: `Nat.lt_fib_greatestFib_add_one` を `Int` にキャストする。
証明: 既存補題の適用と式変形で示す。
役割: `stepBoundOfM` の停止上界に使う。
-/
theorem lt_fib_greatestFib_add_one_int (n : Nat) :
(n : Int) < Int.fib (Nat.greatestFib n + 1) := by
set k := Nat.greatestFib n + 1
have h_nat : n < Nat.fib k := by
dsimp only [k]
exact Nat.lt_fib_greatestFib_add_one n
have h1 : (n : Int) < (Nat.fib k : Int) := by
exact_mod_cast h_nat
have h2 : (Nat.fib k : Int) = Int.fib k := by
simp only [Int.fib_natCast]
exact lt_of_lt_of_eq h1 h2
/--
目的: `step` を `k` 回適用した状態 `stepN k U` を定義する。
定義: `k=0` で恒等、`k+1` で `step` を 1 回進めて再帰。
入力/前提: `k : Nat`、`U : St`。
出力: 型 `St` の値を返す。
役割: 反復回数の解析基盤。
-/
def stepN : Nat → St → St
| 0, U => U
| k + 1, U => stepN k (step U)
/--
入力/前提: t : Nat、V : St、h : V.c = 0。
主張: `V.c = 0` なら任意回数の `stepN` でも `c=0`。
内容: `t` による帰納法で `step_c_zero_of_c_zero` を用いる。
証明: 帰納法・既存補題の書き換えで示す。
役割: 停止条件の不変性。
-/
lemma stepN_c_zero_of_c_zero (t : Nat) (V : 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 : (step V).c = 0 := step_c_zero_of_c_zero V h
simpa only [stepN, step, step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS,
normA, normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc, step_reduce_ypos_a_nonneg,
step_reduce_ypos_a_neg, dite_eq_ite] using (ih (step V) hstep)
/--
目的: Nat 版 Euclid 1 ステップ `euclid_step` を定義する。
定義: `m=0` なら `(c,0)` に据え置き、そうでなければ `(m, c % m)`。
入力/前提: c m : Nat。
出力: 型 `Nat × Nat` の値を返す。
役割: Euclid 反復の基本操作。
-/
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` と対応付ける対象。
-/
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
/--
入力/前提: c m : Nat。
主張: `euclidN 0 c m = (c, m)`。
内容: 定義の簡約（`rfl`）。
証明: 定義展開で示す。
役割: 再帰の基底簡約。
-/
@[simp] 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 回適用した後の再帰形。
証明: 既存補題の適用と式変形で示す。
役割: 再帰展開用の補助。
-/
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` の対応付けに使う。
-/
def stPairNat (U : St) : Nat × Nat := (Int.toNat U.c, Int.toNat U.m)
/--
入力/前提: `U : St`、`h : (step (step U)).c ≠ 0`。
主張: `step` の 1 ステップが Euclid 更新に一致する（Nat 版）。
内容: `step_after_preprocess_euclid` を `Int.toNat` へ落として示す。
証明: 場合分け・式変形で示す。
役割: `stepN_eq_euclidN` の橋渡し。
-/
lemma step_after_preprocess_euclid_nat (U : St)
(h : (step (step U)).c ≠ 0) :
stPairNat (step (step U)) =
euclid_step (stPairNat (step U)).1 (stPairNat (step U)).2 := by
rcases step_after_preprocess_euclid U h with ⟨hc, hm⟩
-- `m` が 0 でないこと（`step` の不変条件より）
have hm_nat_ne : (Int.toNat (step U).m) ≠ 0 := by
intro h0
have hm_le : (step U).m ≤ 0 := (Int.toNat_eq_zero).1 h0
exact (not_le_of_gt (step U).hm) hm_le
-- `c` の非負性（正規化により `c=0` または `c=m`）
have hc1_nonneg : 0 ≤ (step U).c := by
cases step_c_or U with
| inl h0 =>
simp only [h0, le_refl]
| inr h1 =>
have hm0 : 0 ≤ U.m := le_of_lt U.hm
rw [h1]
exact hm0
-- `Int` の `%` を `Nat` の `%` に落とすための補助
have hmod :
Int.toNat ((step U).c % (step U).m) =
(Int.toNat (step U).c) % (Int.toNat (step U).m) := by
apply Int.ofNat.inj
calc
(Int.toNat ((step U).c % (step U).m) : Int)
= (step U).c % (step U).m := by
exact Int.toNat_of_nonneg (Int.emod_nonneg _ (ne_of_gt (step U).hm))
_ =
(Int.ofNat (Int.toNat (step U).c)) %
(Int.ofNat (Int.toNat (step U).m)) := by
simp only [Int.ofNat_eq_natCast, Int.toNat_of_nonneg hc1_nonneg,
Int.toNat_of_nonneg (le_of_lt (step U).hm)]
_ = (Int.ofNat ((Int.toNat (step U).c) % (Int.toNat (step U).m))) := by
exact (Int.natCast_mod (Int.toNat (step U).c) (Int.toNat (step U).m)).symm
-- 目的の等式
ext
· have hfst :
(euclid_step (stPairNat (step U)).1 (stPairNat (step U)).2).1 =
Int.toNat (step U).m := by
simp only [euclid_step, stPairNat, hm_nat_ne, ↓reduceDIte]
calc
Int.toNat (step (step U)).c = Int.toNat (step U).m := by
rw [hc]
_ = (euclid_step (stPairNat (step U)).1 (stPairNat (step U)).2).1 := by
symm
exact hfst
· have hsnd :
(euclid_step (stPairNat (step U)).1 (stPairNat (step U)).2).2 =
(Int.toNat (step U).c) % (Int.toNat (step U).m) := by
simp only [euclid_step, stPairNat, hm_nat_ne, ↓reduceDIte]
calc
Int.toNat (step (step U)).m = Int.toNat ((step U).c % (step U).m) := by
rw [hm]
_ = (Int.toNat (step U).c) % (Int.toNat (step U).m) := hmod
_ = (euclid_step (stPairNat (step U)).1 (stPairNat (step U)).2).2 := by
symm
exact hsnd
/--
入力/前提: `U : St`、`t : Nat`、`hStay : ∀ i, i ≤ t → (stepN i (step U)).c ≠ 0`。
主張: `c ≠ 0` の間、`stepN` と `euclidN` の反復が一致する。
内容: `step U` を初期状態とし、`t` 回の反復一致を帰納法で示す。
証明: 帰納法・既存補題の書き換えで示す。
役割: Euclid 反復による停止上界評価に使う。
-/
lemma stepN_eq_euclidN (U : St) (t : Nat)
(hStay : ∀ i, i ≤ t → (stepN i (step U)).c ≠ 0) :
stPairNat (stepN t (step U)) =
euclidN t (stPairNat (step U)).1 (stPairNat (step U)).2 := by
induction t generalizing U with
| zero =>
simp only [stPairNat, stepN, step, step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize,
normS, normA, normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc,
step_reduce_ypos_a_nonneg, step_reduce_ypos_a_neg, dite_eq_ite, euclidN]
| succ t ih =>
have h1 : (step (step U)).c ≠ 0 := by
have h1' : (1 : Nat) ≤ t + 1 := Nat.succ_le_succ (Nat.zero_le _)
simpa only [step, step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS, normA,
normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc, step_reduce_ypos_a_nonneg,
step_reduce_ypos_a_neg, dite_eq_ite, ne_eq, stepN] using hStay 1 h1'
have hstep :
stPairNat (step (step U)) =
euclid_step (stPairNat (step U)).1 (stPairNat (step U)).2 :=
step_after_preprocess_euclid_nat U h1
have hStay' : ∀ i, i ≤ t → (stepN i (step (step U))).c ≠ 0 := by
intro i hi
have hi' : i + 1 ≤ t + 1 := Nat.succ_le_succ hi
simpa only [step, step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS, normA,
normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc, step_reduce_ypos_a_nonneg,
step_reduce_ypos_a_neg, dite_eq_ite, ne_eq, stepN] using hStay (i + 1) hi'
have ih' :
stPairNat (stepN t (step (step U))) =
euclidN t (stPairNat (step (step U))).1 (stPairNat (step (step U))).2 :=
ih (U := step U) hStay'
have ih'' :
stPairNat (stepN t (step (step U))) =
euclidN t
(euclid_step (stPairNat (step U)).1 (stPairNat (step U)).2).1
(euclid_step (stPairNat (step U)).1 (stPairNat (step U)).2).2 := by
simpa only [hstep] using ih'
simpa only [stepN, step, step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS,
normA, normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc, step_reduce_ypos_a_nonneg,
step_reduce_ypos_a_neg, dite_eq_ite, 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` の前提を作る補助。
-/
lemma stepN_stay_from_succ (U : St) (k : Nat)
(hStay : ∀ i, i ≤ k + 1 → (stepN i U).c ≠ 0) :
∀ i, i ≤ k → (stepN i (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 [step, step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS, normA, normC,
zfloorMod, normD, step_reduce_y0, Int.max_assoc, step_reduce_ypos_a_nonneg,
step_reduce_ypos_a_neg, dite_eq_ite, ne_eq, stepN] using h
/--
入力/前提: i j : Nat、U : St。
主張: `stepN (i + j) U = stepN j (stepN i U)`。
内容: `i` による帰納法で `stepN` の再帰を展開する。
証明: 帰納法で示す。
役割: 反復の分割・再結合に使う。
-/
lemma stepN_add (i j : Nat) (U : 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, step, step_reduce, stnorm_y, Yn1, yOf,
zfloorDiv, step_normalize, normS, normA, normC, zfloorMod, normD, step_reduce_y0,
Int.max_assoc, step_reduce_ypos_a_nonneg, 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` を用いた反証法。
証明: 既存補題の書き換えで示す。
役割: 途中段階の非停止性を引き継ぐ補助。
-/
lemma stepN_nonzero_of_le (U : 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
/--
入力/前提: c m n : Nat、h : m <= n。
主張: `m ≤ n` なら `(euclidN n c m).2 = 0`。
内容: `n` による帰納法と `euclid_step` の定義で示す。
証明: 帰納法・場合分け・既存補題の書き換えで示す。
役割: Euclid 反復の停止上界に使う。
-/
lemma euclidN_c_zero_of_le (c m n : Nat) (h : m <= n) :
(euclidN n c m).2 = 0 := by
induction n generalizing c m with
| zero =>
have hm : m = 0 := Nat.eq_zero_of_le_zero h
subst hm
simp only [euclidN]
| succ n ih =>
by_cases hm0 : m = 0
case pos =>
subst hm0
have h0 := ih (c := c) (m := 0) (Nat.zero_le n)
simpa only [euclidN_succ, euclid_step, ↓reduceDIte] using h0
case neg =>
have hm_pos : 0 < m := Nat.pos_of_ne_zero hm0
have hr_lt : c % m < m := Nat.mod_lt _ hm_pos
have hr_le_n : c % m <= n := by
have hlt : c % m < n + 1 := lt_of_lt_of_le hr_lt h
exact (Nat.lt_succ_iff).1 hlt
have ih' := ih (c := m) (m := c % m) hr_le_n
simpa only [euclidN_succ, euclid_step, hm0, ↓reduceDIte] using ih'
/--
入力/前提: 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 反復の分割・再結合に使う。
-/
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 反復の停止不変性。
-/
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 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 反復の非停止性を引き継ぐ補助。
-/
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
intro hzero
have hEq : euclidN k c m = let p := euclidN i c m; euclidN (k - i) p.1 p.2 := by
simpa only [Nat.add_sub_of_le hi] using (euclidN_add i (k - i) c m)
have hzero' : (euclidN (k - i) (euclidN i c m).1 (euclidN i c m).2).2 = 0 :=
euclidN_c_zero_of_c_zero (k - i) (euclidN i c m).1 (euclidN i c m).2 hzero
have hk0 : (euclidN k c m).2 = 0 := by
simpa only [hEq] using hzero'
exact hk hk0
/--
入力/前提: `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` の反証に使う。
-/
lemma euclidN_fib_lower (c m k : Nat)
(hStay : ∀ i, i ≤ k → (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 : m ≠ 0 := hStay 0 (Nat.zero_le _)
have hmpos : 0 < m := Nat.pos_of_ne_zero hm
simpa only [zero_add, Nat.fib_two, ge_iff_le, Nat.succ_eq_add_one] using
(Nat.succ_le_iff).2 hmpos
| succ k0 =>
have hm0 : m ≠ 0 := hStay 0 (Nat.zero_le _)
have h1 : (euclidN 1 c m).2 ≠ 0 := hStay 1 (Nat.succ_le_succ (Nat.zero_le _))
have hr1_ne : c % m ≠ 0 := by
simpa only [ne_eq, euclidN_succ, euclid_step, hm0, ↓reduceDIte, euclidN_zero] using h1
set r1 : Nat := c % m
have hStay1 : ∀ i, i ≤ k0 → (euclidN i m r1).2 ≠ 0 := by
intro i hi
have h := hStay (i + 1) (Nat.succ_le_succ hi)
simpa only [ne_eq, euclidN_succ, euclid_step, hm0, ↓reduceDIte] using h
have hr1_lower : Nat.fib (k0 + 2) ≤ r1 :=
ih k0 (Nat.lt_succ_self k0) m r1 hStay1
cases k0 with
| zero =>
have hmpos : 0 < m := Nat.pos_of_ne_zero hm0
have hr1_lt : r1 < m := by
simpa only [r1] using (Nat.mod_lt c hmpos)
have h1lt : 1 < m := lt_of_le_of_lt hr1_lower hr1_lt
have h2le : 2 ≤ m := Nat.succ_le_of_lt h1lt
simpa only [zero_add, Nat.reduceAdd, Nat.fib_add_two, Nat.fib_one, Nat.fib_zero,
ge_iff_le] using h2le
| succ k1 =>
set r2 : Nat := m % r1
have hr1_ne' : r1 ≠ 0 := by
simpa only [ne_eq, r1] using hr1_ne
have hStay2 : ∀ i, i ≤ k1 → (euclidN i r1 r2).2 ≠ 0 := by
intro i hi
have hi' : i + 2 ≤ k1 + 2 := Nat.add_le_add_right hi 2
have h := hStay (i + 2) (by
simpa only [Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd,
add_le_add_iff_right] using hi')
simpa only [ne_eq, euclidN_succ, euclid_step, hm0, ↓reduceDIte, hr1_ne', r1] using h
have hr2_lower : Nat.fib (k1 + 2) ≤ r2 :=
ih k1 (Nat.lt_succ_of_lt (Nat.lt_succ_self k1)) r1 r2 hStay2
-- m ≥ r1 + r2
have hr1_pos : 0 < r1 := Nat.pos_of_ne_zero hr1_ne'
have hmpos : 0 < m := Nat.pos_of_ne_zero hm0
have hr1_lt : r1 < m := by
simpa only [r1] using (Nat.mod_lt c hmpos)
have hr1_le : r1 ≤ m := Nat.le_of_lt hr1_lt
have hdivpos : 0 < m / r1 := Nat.div_pos hr1_le hr1_pos
have hq_ge : 1 ≤ m / r1 := (Nat.succ_le_iff).2 hdivpos
have hmul_ge : r1 ≤ r1 * (m / r1) := by
simpa only [mul_one] using (Nat.mul_le_mul_left r1 hq_ge)
have hsum_le : r1 + r2 ≤ r1 * (m / r1) + r2 :=
Nat.add_le_add_right hmul_ge r2
have hmod : r2 + r1 * (m / r1) = m := by
simpa only using (Nat.mod_add_div m r1)
have hsum_le' : r1 + r2 ≤ m := by
have hmod' : r1 * (m / r1) + r2 = m := by
simpa only [Nat.add_comm] using hmod
exact hsum_le.trans_eq hmod'
-- fib (k1+4) ≤ r1 + r2
have hfib_le : Nat.fib (k1 + 4) ≤ r1 + r2 := by
have hsum : Nat.fib (k1 + 3) + Nat.fib (k1 + 2) ≤ r1 + r2 :=
Nat.add_le_add hr1_lower hr2_lower
calc
Nat.fib (k1 + 4) = Nat.fib (k1 + 3) + Nat.fib (k1 + 2) := by
simpa only [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using
(Nat.fib_add_two (n := k1 + 2))
_ ≤ r1 + r2 := hsum
exact hfib_le.trans hsum_le'
/--
入力/前提: `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` 側停止上界を示すための強化補題。
-/
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 =>
have hm_ne : m ≠ 0 := hStay 0 (Nat.zero_le _)
have hm_pos : 0 < m := Nat.pos_of_ne_zero hm_ne
have h1_le_m : 1 ≤ m := Nat.succ_le_of_lt hm_pos
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
calc
Nat.fib (0 + 3) = Nat.fib 3 := by simp
_ = 2 := by decide
_ ≤ c := h2_le_c
| 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
intro i hi
have h := hStay (i + 1) (Nat.succ_le_succ hi)
simpa only [euclidN_succ, euclid_step, hm_ne, ↓reduceDIte, r1] using h
have hm_lower : Nat.fib (k0 + 3) ≤ m := by
have htmp : Nat.fib (Nat.succ k0 + 2) ≤ m :=
euclidN_fib_lower c m (Nat.succ k0) hStay
simpa only [Nat.succ_eq_add_one, Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using htmp
have hr1_lower : Nat.fib (k0 + 2) ≤ r1 :=
euclidN_fib_lower m r1 k0 hStay1
have hfib_le_sum : Nat.fib (k0 + 4) ≤ m + r1 := by
have hsum : Nat.fib (k0 + 3) + Nat.fib (k0 + 2) ≤ m + r1 :=
Nat.add_le_add hm_lower hr1_lower
calc
Nat.fib (k0 + 4) = Nat.fib (k0 + 3) + Nat.fib (k0 + 2) := by
simpa only [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, Nat.reduceAdd] using
(Nat.fib_add_two (n := k0 + 2))
_ ≤ m + r1 := hsum
have hdiv_pos : 0 < c / m := Nat.div_pos (Nat.le_of_lt hcm) hm_pos
have hq_ge1 : 1 ≤ c / m := Nat.succ_le_of_lt hdiv_pos
have hmul_ge : m ≤ m * (c / m) := by
calc
m = m * 1 := by simp
_ ≤ m * (c / m) := Nat.mul_le_mul_left m hq_ge1
have hsum_le : m + r1 ≤ m * (c / m) + r1 :=
Nat.add_le_add_right hmul_ge r1
have hmod : r1 + m * (c / m) = c := by
simpa only [r1] using (Nat.mod_add_div c m)
have hsum_le_c : m + r1 ≤ c := by
have hmod' : m * (c / m) + r1 = c := by
simpa only [Nat.add_comm] using hmod
exact hsum_le.trans_eq hmod'
calc
Nat.fib (Nat.succ k0 + 3) = Nat.fib (k0 + 4) := by
simp only [Nat.succ_eq_add_one, Nat.add_assoc]
_ ≤ m + r1 := hfib_le_sum
_ ≤ c := hsum_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 反復の停止上界。
-/
lemma euclidN_c_zero_of_lt_fib (c m k : Nat)
(h : m < Nat.fib (k + 2)) :
(euclidN k c m).2 = 0 := by
by_contra hk
have hStay : ∀ i, i ≤ k → (euclidN i c m).2 ≠ 0 := by
intro i hi
exact euclidN_nonzero_of_le c m k i hk hi
have hlower : Nat.fib (k + 2) ≤ m := euclidN_fib_lower c m k hStay
exact (not_lt_of_ge hlower) h
/--
入力/前提: `c m : Nat`。
主張: ある時刻 `t` で Euclid 反復の第2成分は 0 になる。
内容: `t = m` を取れば `m ≤ m` から `euclidN_c_zero_of_le` が使える。
証明: 具体的証人 `m` を与える。
役割: `euclidTau`（`Nat.find`）の存在仮定。
-/
lemma euclidN_exists_c_zero (c m : Nat) :
∃ t, (euclidN t c m).2 = 0 := by
refine ⟨m, ?_⟩
exact euclidN_c_zero_of_le c m m (Nat.le_refl m)
/--
目的: 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 (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 := by
exact Nat.find_spec (euclidN_exists_c_zero c m)
/--
入力/前提: `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` を適用する。
証明: 既存補題の書き換えで示す。
役割: 停止性の単調性（後方不変性）。
-/
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 := 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 t : Nat`、`ht : (euclidN t c m).2 = 0`。
主張: `euclidTau c m ≤ t`。
内容: `Nat.find_min'` で最小性を得る。
証明: `Nat.find` の最小性。
役割: 停止時刻の最小性を与える。
-/
lemma euclidTau_le_of_c_zero (c m t : Nat)
(ht : (euclidN t c m).2 = 0) :
euclidTau c m ≤ t := by
exact Nat.find_min' (euclidN_exists_c_zero c m) ht
/--
入力/前提: `c m t : Nat`、`ht : t < euclidTau c m`。
主張: `t` は最小停止時刻より前なので `(euclidN t c m).2 ≠ 0`。
内容: 反証法で `euclidTau_le_of_c_zero` と矛盾させる。
証明: 反証法。
役割: 停止時刻より前では未停止であることを示す。
-/
lemma euclidTau_nonzero_of_lt (c m t : Nat) (ht : t < euclidTau c m) :
(euclidN t c m).2 ≠ 0 := by
intro hz
have hle : euclidTau c m ≤ t := euclidTau_le_of_c_zero c m t hz
exact (Nat.not_lt_of_ge hle) ht
/--
入力/前提: `c m k : Nat`。
主張: `euclidTau c m ≤ k` と `(euclidN k c m).2 = 0` は同値。
内容: 前向きは停止性の単調性、後向きは `Nat.find` の最小性。
証明: 既存補題の合成。
役割: tex での「`\tau \le k`」と Lean の停止判定を接続する基礎同値。
-/
lemma euclidTau_le_iff_c_zero (c m k : Nat) :
euclidTau c m ≤ k ↔ (euclidN k c m).2 = 0 := by
constructor
· intro hle
exact euclidN_c_zero_of_le_index c m (euclidTau c m) k hle (euclidTau_spec c m)
· intro hk0
exact euclidTau_le_of_c_zero c m k hk0
/--
入力/前提: `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` に対応する停止時刻版。
-/
lemma euclidTau_le_of_lt_fib (c m k : Nat)
(h : m < Nat.fib (k + 2)) :
euclidTau c m ≤ k := by
exact euclidTau_le_of_c_zero c m k (euclidN_c_zero_of_lt_fib c m k h)
/--
入力/前提: `c m : Nat`、`hm : 0 < m`。
主張: `m > 0` なら最小停止時刻 `euclidTau c m` は `Nat.greatestFib m - 1` 以下。
内容: `m < fib (greatestFib m + 1)` を `k := greatestFib m - 1` の形に直し、
`euclidTau_le_of_lt_fib` を適用する。
証明: `Nat.lt_fib_greatestFib_add_one`、`Nat.le_greatestFib`、`omega` を合成する。
役割: tex の「Euclid 反復は高々 `g(m_0)-1` 回で停止」に対応する Lean 側補題。
-/
lemma euclidTau_le_greatestFib_pred (c m : Nat) (hm : 0 < m) :
euclidTau c m ≤ 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
have hlt1 : m < Nat.fib (Nat.greatestFib m + 1) :=
Nat.lt_fib_greatestFib_add_one m
have hidx : (Nat.greatestFib m - 1) + 2 = Nat.greatestFib m + 1 := by
omega
have hlt2 : m < Nat.fib ((Nat.greatestFib m - 1) + 2) := by
simpa only [hidx] using hlt1
exact euclidTau_le_of_lt_fib c m (Nat.greatestFib m - 1) hlt2
/--
入力/前提: `c m : Nat`、`hm : 0 < m`。
主張: `stepBoundOfM m` は最小停止時刻 `euclidTau c m` の上界。
内容: `stepBoundOfM = Nat.greatestFib - 1` を使って `euclidTau_le_greatestFib_pred` に帰着する。
証明: 既存補題の書き換えで示す。
役割: 実装上の反復上界 `stepBoundOfM` と厳密停止時刻評価を接続する。
-/
lemma euclidTau_le_stepBoundOfM (c m : Nat) (hm : 0 < m) :
euclidTau c m ≤ stepBoundOfM m := by
simpa only [stepBoundOfM, Fib.greatestFibIter_eq_greatestFib] using
(euclidTau_le_greatestFib_pred c m hm)
/--
入力/前提: 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` より妥当）。
-/
theorem stepN_bound_c_zero (U : St) :
(stepN (stepBoundOfM (Int.toNat U.m)) U).c = 0 := by
set m0 : Nat := Int.toNat U.m
set g : Nat := Nat.greatestFib m0
have hm0_ne : m0 ≠ 0 := by
intro h0
have hnat0 : Int.toNat U.m = 0 := by simpa only [m0] using h0
have hle : U.m ≤ 0 := (Int.toNat_eq_zero).1 hnat0
exact (not_le_of_gt U.hm) hle
have hm0_pos : 0 < m0 := Nat.pos_of_ne_zero hm0_ne
have hm0_ge1 : 1 ≤ m0 := Nat.succ_le_of_lt hm0_pos
have hfib2_le : Nat.fib 2 ≤ m0 := by
simpa only [Nat.fib_two] using hm0_ge1
have hg_ge2 : 2 ≤ g := by
simpa only [g] using (Nat.le_greatestFib (m := 2) (n := m0)).2 hfib2_le
have hk : stepBoundOfM m0 = g - 1 := by
simp only [stepBoundOfM, Fib.greatestFibIter_eq_greatestFib, g]
by_contra hnonzero
have hk_non : (stepN (g - 1) U).c ≠ 0 := by
simpa only [m0, hk, ne_eq] using hnonzero
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 (step U)).c ≠ 0 := by
apply stepN_stay_from_succ U (g - 2)
intro i hi
have hi' : i ≤ g - 1 := by omega
exact hStayU i hi'
have hstep_c_ne : (step U).c ≠ 0 := by
have h0 := hStayStep 0 (Nat.zero_le _)
simpa only [stepN] using h0
have hdec : (step U).m < U.m := by
cases mwf_step_reduce_reduction U with
| inl h => exact h
| inr h => exact False.elim (hstep_c_ne h)
have hdec_nat : Int.toNat (step U).m < m0 := by
have htmp : Int.toNat (step U).m < Int.toNat U.m :=
(Int.toNat_lt_toNat U.hm).2 hdec
simpa only [m0] using htmp
have hstep_c_eq : (step U).c = U.m := by
cases step_c_or U with
| inl hc0 => exact False.elim (hstep_c_ne hc0)
| inr hc1 => exact hc1
have hEq :
stPairNat (stepN (g - 2) (step U)) =
euclidN (g - 2) (stPairNat (step U)).1 (stPairNat (step U)).2 :=
stepN_eq_euclidN U (g - 2) hStayStep
have hstepN_m_ne0 : Int.toNat (stepN (g - 2) (step U)).m ≠ 0 := by
intro h0
have hle : (stepN (g - 2) (step U)).m ≤ 0 := (Int.toNat_eq_zero).1 h0
exact (not_le_of_gt (stepN (g - 2) (step U)).hm) hle
have hEuclid_non :
(euclidN (g - 2) (stPairNat (step U)).1 (stPairNat (step U)).2).2 ≠ 0 := by
intro hz0
have hsndEq :
(stPairNat (stepN (g - 2) (step U))).2 =
(euclidN (g - 2) (stPairNat (step U)).1 (stPairNat (step U)).2).2 := by
exact congrArg Prod.snd hEq
exact hstepN_m_ne0 (hsndEq.trans hz0)
have hStayEuclid :
∀ i, i ≤ g - 2 →
(euclidN i (stPairNat (step U)).1 (stPairNat (step U)).2).2 ≠ 0 := by
intro i hi
exact euclidN_nonzero_of_le (stPairNat (step U)).1 (stPairNat (step U)).2 (g - 2) i
hEuclid_non hi
have hcm :
(stPairNat (step U)).2 < (stPairNat (step U)).1 := by
simpa only [stPairNat, hstep_c_eq, m0] using hdec_nat
have hFib_le :
Nat.fib ((g - 2) + 3) ≤ (stPairNat (step U)).1 :=
euclidN_fib_lower_first_of_lt
(stPairNat (step U)).1 (stPairNat (step U)).2 (g - 2) hcm hStayEuclid
have hidx : (g - 2) + 3 = g + 1 := by omega
have hFib_le_m0 : Nat.fib (g + 1) ≤ m0 := by
have h' : Nat.fib (g + 1) ≤ (stPairNat (step U)).1 := by
simpa only [hidx] using hFib_le
simpa only [stPairNat, hstep_c_eq, m0] using h'
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
/--
入力/前提: `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` の中核補題。
-/
lemma mwf_iter_aux_correct (k : Nat) (U : St)
(h : (stepN (k + 1) U).c = 0) :
mwf_iter_aux (k + 1) U = max U.r (U.s + st_mwf U) := by
induction k generalizing U with
| zero =>
by_cases h0 : U.c = 0
· calc
mwf_iter_aux 1 U = (step U).r := by simp only [mwf_iter_aux, h0, ↓reduceDIte, step,
step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS, normA, normC,
zfloorMod, normD, step_reduce_y0, Int.max_assoc, step_reduce_ypos_a_nonneg,
step_reduce_ypos_a_neg, dite_eq_ite]
_ = max U.r (U.s + st_mwf U) := by
simpa only [step, step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS,
normA, normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc,
step_reduce_ypos_a_nonneg, step_reduce_ypos_a_neg, dite_eq_ite, st_mwf, mwf, img, obj,
dom] using (mwf_step_reduce_result U h0).symm
· have h1 : (step U).c = 0 := by
simpa only [step, step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS,
normA, normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc,
step_reduce_ypos_a_nonneg, step_reduce_ypos_a_neg, dite_eq_ite, stepN] using h
have hstepEq :
max U.r (U.s + st_mwf U) =
max (step U).r ((step U).s + st_mwf (step U)) := by
simpa only [st_mwf, mwf, img, obj, zfloorDiv, dom, step, step_reduce, stnorm_y, Yn1, yOf,
step_normalize, normS, normA, normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc,
step_reduce_ypos_a_nonneg, step_reduce_ypos_a_neg, dite_eq_ite] using (mwf_step_equiv U)
have hY0 : stnorm_y (step_normalize U) = 0 :=
stnorm_y_step_normalize_eq_zero_of_step_c_zero U h1
have hstep :
step U = step_reduce_y0 (step_normalize U) hY0 := by
unfold step
exact step_reduce_eq_y0 (step_normalize U) hY0
have hs : (step U).s = (step U).r := by
rw [hstep]
simp only [step_reduce_y0, step_normalize, normS, zfloorDiv, normA, normC, zfloorMod,
normD, Int.max_assoc]
have hmwf0 : st_mwf (step U) = 0 := by
rw [hstep]
exact st_mwf_step_reduce_y0_zero (step_normalize U) hY0
have htail :
max (step U).r ((step U).s + st_mwf (step U)) = (step U).r := by
rw [hs, hmwf0]
simp only [step, step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS, normA,
normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc, step_reduce_ypos_a_nonneg,
step_reduce_ypos_a_neg, dite_eq_ite, add_zero, max_self]
calc
mwf_iter_aux 1 U = (step U).r := by simp only [mwf_iter_aux, h0, ↓reduceDIte, step,
step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS, normA, normC,
zfloorMod, normD, step_reduce_y0, Int.max_assoc, step_reduce_ypos_a_nonneg,
step_reduce_ypos_a_neg, dite_eq_ite]
_ = max (step U).r ((step U).s + st_mwf (step U)) := htail.symm
_ = max U.r (U.s + st_mwf U) := hstepEq.symm
| succ k ih =>
by_cases h0 : U.c = 0
· calc
mwf_iter_aux (Nat.succ (Nat.succ k)) U = (step U).r := by
simp only [mwf_iter_aux, h0, ↓reduceDIte, step, step_reduce, stnorm_y, Yn1, yOf,
zfloorDiv, step_normalize, normS, normA, normC, zfloorMod, normD, step_reduce_y0,
Int.max_assoc, step_reduce_ypos_a_nonneg, step_reduce_ypos_a_neg, dite_eq_ite]
_ = max U.r (U.s + st_mwf U) := by
simpa only [step, step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize, normS,
normA, normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc,
step_reduce_ypos_a_nonneg, step_reduce_ypos_a_neg, dite_eq_ite, st_mwf, mwf, img, obj,
dom] using (mwf_step_reduce_result U h0).symm
· have h' : (stepN (k + 1) (step U)).c = 0 := by
simpa only [stepN, step, step_reduce, stnorm_y, Yn1, yOf, zfloorDiv, step_normalize,
normS, normA, normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc,
step_reduce_ypos_a_nonneg, step_reduce_ypos_a_neg, dite_eq_ite] using h
have hIH :
mwf_iter_aux (k + 1) (step U) =
max (step U).r ((step U).s + st_mwf (step U)) :=
ih (U := step U) h'
have hstepEq :
max U.r (U.s + st_mwf U) =
max (step U).r ((step U).s + st_mwf (step U)) := by
simpa only [st_mwf, mwf, img, obj, zfloorDiv, dom, step, step_reduce, stnorm_y, Yn1, yOf,
step_normalize, normS, normA, normC, zfloorMod, normD, step_reduce_y0, Int.max_assoc,
step_reduce_ypos_a_nonneg, step_reduce_ypos_a_neg, dite_eq_ite] using (mwf_step_equiv U)
calc
mwf_iter_aux (Nat.succ (Nat.succ k)) U =
mwf_iter_aux (k + 1) (step U) := by
simp only [mwf_iter_aux, h0, ↓reduceDIte, step, step_reduce, stnorm_y, Yn1, yOf,
zfloorDiv, step_normalize, normS, normA, normC, zfloorMod, normD, step_reduce_y0,
Int.max_assoc, step_reduce_ypos_a_nonneg, step_reduce_ypos_a_neg, dite_eq_ite]
_ = max (step U).r ((step U).s + st_mwf (step U)) := hIH
_ = max U.r (U.s + st_mwf U) := hstepEq.symm
/--
入力/前提: N M A B C D : Int、hN : 0 < N、hM : 0 < M。
主張: 反復実装 `mwf_iter` は定義的な `mwf` と一致する。
内容: `stepN_bound_c_zero` と `mwf_iter_aux_correct` を組み合わせて示す。
証明: 場合分け・既存補題の書き換えで示す。
役割: 実装の正しさ保証。
-/
theorem mwf_iter_correct
(N M A B C D : Int) (hN : 0 < N) (hM : 0 < M) :
mwf_iter N M A B C D hN hM = mwf N M A B C D hN hM := by
let U : St := St.mk (B * zfloorDiv D M hM) 0 N M A B C D hN hM
set k : Nat := stepBoundOfM (Int.toNat M)
have hbound : (stepN k U).c = 0 := by
simpa only using (stepN_bound_c_zero U)
have hkpos : 0 < k := by
have hMnat_ne : Int.toNat M ≠ 0 := by
intro h0
have hle : M ≤ 0 := (Int.toNat_eq_zero).1 h0
exact (not_le_of_gt hM) hle
have hMnat_pos : 0 < Int.toNat M := Nat.pos_of_ne_zero hMnat_ne
have hMnat_ge1 : 1 ≤ Int.toNat M := Nat.succ_le_of_lt hMnat_pos
have hfib2_le : Nat.fib 2 ≤ Int.toNat M := by
simpa only [Nat.fib_two] using hMnat_ge1
have hg_ge2 : 2 ≤ Nat.greatestFib (Int.toNat M) :=
(Nat.le_greatestFib (m := 2) (n := Int.toNat M)).2 hfib2_le
have hk_ge1' : 1 ≤ stepBoundOfM (Int.toNat M) := by
unfold stepBoundOfM
rw [Fib.greatestFibIter_eq_greatestFib]
omega
have hk_ge1 : 1 ≤ k := by
simpa only [k] using hk_ge1'
exact (Nat.succ_le_iff).1 hk_ge1
have hinit : max U.r (U.s + st_mwf U) = mwf N M A B C D hN hM := by
simpa only [zfloorDiv, st_mwf, U, mwf, img, obj, dom, zero_add, sup_eq_right] using
(mwf_step_init_equiv N M A B C D hN hM).symm
cases hk : k with
| zero =>
simp only [hk, lt_self_iff_false] at hkpos
| succ k' =>
have h' : (stepN (k' + 1) U).c = 0 := by
simpa only [hk, k] using hbound
have hcorrect :
mwf_iter_aux (k' + 1) U =
max U.r (U.s + st_mwf U) :=
mwf_iter_aux_correct k' U h'
have hcorrect' :
mwf_iter_aux k U =
max U.r (U.s + st_mwf U) := by
simpa only [hk] using hcorrect
simpa only [mwf_iter, hk, zfloorDiv, mwf_iter_aux, step, step_reduce, stnorm_y, Yn1, yOf,
step_normalize, normS, zero_add, normA, normC, zfloorMod, normD, step_reduce_y0, max_self,
step_reduce_ypos_a_nonneg, step_reduce_ypos_a_neg, dite_eq_ite, mwf, img, obj, dom, k,
U] using hcorrect'.trans hinit
/--
入力/前提: l r m a b c d : Int、hLR : l < r、hM : 0 < m。
主張: 区間版 `mwfLr_iter` は定義的な `mwfLr` と一致する。
内容: 置換・商剰余分解で `mwf_iter_correct` に還元する。
証明: 場合分け・式変形・既存補題の書き換えで示す。
役割: 区間版反復実装の正しさ保証。
-/
theorem mwfLr_iter_collect
(l r m a b c d : Int) (hLR : l < r) (hM : 0 < m) :
mwfLr_iter l r m a b c d hLR hM =
mwfLr l r m a b c d hLR hM := by
classical
have hN : 0 < r - l := by nlinarith [hLR]
let n : Int := r - l
let q : Int := zfloorDiv (c * l + d) m hM
let d' : Int := zfloorMod (c * l + d) m hM
let cst : Int := a * l + b * q
let f : Int → Int := fun x => cst + x
have hm0 : m ≠ 0 := ne_of_gt hM
have hqd : c * l + d = m * q + d' := by
simpa only [q, d', mul_comm, add_comm, zfloorDiv, zfloorMod] using
(Int.emod_add_mul_ediv (c * l + d) m).symm
have hdiv :
∀ t : Int,
zfloorDiv (c * (l + t) + d) m hM =
q + zfloorDiv (c * t + d') m hM := by
intro t
unfold 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 + zfloorDiv (c * t + d') m hM := by rfl
have hobj :
∀ t : Int,
obj a b c d m (l + t) hM =
cst + obj a b c d' m t hM := by
intro t
unfold obj
calc
a * (l + t) + b * zfloorDiv (c * (l + t) + d) m hM
= a * l + a * t + b * zfloorDiv (c * (l + t) + d) m hM := by ring_nf
_ = a * l + a * t + b * (q + zfloorDiv (c * t + d') m hM) := by
rw [hdiv t]
_ = a * l + b * q + (a * t + b * zfloorDiv (c * t + d') m hM) := by ring_nf
_ = cst + obj a b c d' m t hM := by simp only [zfloorDiv, add_left_comm, add_assoc, obj, cst]
have hdom :
domLr l r hLR = (dom n hN).image (fun t => l + t) := by
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 := by exact sub_nonneg.mpr hx'.1
have h1 : x - l ≤ n - 1 := by nlinarith [hx'.2]
simpa only [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 ≤ n - 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⟩
have himg :
imgLr l r m a b c d hLR hM =
(dom n hN).image (fun t => cst + obj a b c d' m t hM) := by
calc
imgLr l r m a b c d hLR hM =
(domLr l r hLR).image (fun x => obj a b c d m x hM) := by rfl
_ = ((dom n hN).image (fun t => l + t)).image (fun x => obj a b c d m x hM) := by
rw [hdom]
_ = (dom n hN).image ((fun x => obj a b c d m x hM) ∘ fun t => l + t) := by
rw [Finset.image_image]
_ = (dom n hN).image (fun t => obj a b c d m (l + t) hM) := by rfl
_ = (dom n hN).image (fun t => cst + obj a b c d' m t hM) := by
refine Finset.image_congr ?_
intro t ht
exact hobj t
let S : Finset Int := img n m a b c d' hN hM
have hS : S.Nonempty := by
simpa only [S, img, obj, zfloorDiv, dom, Finset.image_nonempty, Finset.nonempty_Icc,
Int.sub_nonneg] using
(img_nonempty (N := n) (M := m) (A := a) (B := b) (C := c) (D := d') hN hM)
have max'_congr {s t : Finset Int} (hs : s.Nonempty) (ht : t.Nonempty) (h : s = t) :
s.max' hs = t.max' ht := by
cases h
have hproof : hs = ht := by
apply Subsingleton.elim
cases hproof
rfl
have himgS :
(dom n hN).image (fun t => cst + obj a b c d' m t hM) = S.image f := by
dsimp only [obj, zfloorDiv, dom, img, f, S]
symm
rw [Finset.image_image]
rfl
have hmono : Monotone f := by
intro x y hxy
dsimp only [f]
linarith
have hmax :
(S.image f).max' (hS.image f) = cst + S.max' hS := by
simpa only [add_comm, Finset.image_add_right, neg_add_rev, add_assoc] using
(Monotone.map_finset_max' (s := S) (f := f) hmono hS).symm
have hmwfLr :
mwfLr l r m a b c d hLR hM = (S.image f).max' (hS.image f) := by
dsimp only [mwfLr, imgLr, obj, zfloorDiv, domLr]
have hne : (imgLr l r m a b c d hLR hM).Nonempty :=
imgLr_nonempty (L := l) (R := r) (M := m) (A := a) (B := b)
(C := c) (D := d) hLR hM
have hne1 :
((dom n hN).image (fun t => cst + obj a b c d' m t hM)).Nonempty :=
(dom_nonempty hN).image (fun t => cst + obj a b c d' m t hM)
have hne2 : (S.image f).Nonempty := hS.image f
have hne2' : (S.image f).Nonempty := by
rw [←himgS]
exact hne1
have hmax1 :
(imgLr l r m a b c d hLR hM).max' hne =
((dom n hN).image (fun t => cst + obj a b c d' m t hM)).max' hne1 :=
max'_congr hne hne1 himg
have hmax2 :
((dom n hN).image (fun t => cst + obj a b c d' m t hM)).max' hne1 =
(S.image f).max' hne2' :=
max'_congr hne1 hne2' himgS
have hmax3 : (S.image f).max' hne2' = (S.image f).max' hne2 := by
have hproof : hne2' = hne2 := by
apply Subsingleton.elim
cases hproof
rfl
exact hmax1.trans (hmax2.trans hmax3)
-- assemble
have hiter :
mwfLr_iter l r m a b c d hLR hM =
cst + mwf_iter n m a b c d' hN hM := by
simp only [mwfLr_iter, zfloorDiv, zfloorMod, cst, q, n, d']
have hiter' :
mwf_iter n m a b c d' hN hM = mwf n m a b c d' hN hM :=
mwf_iter_correct (N := n) (M := m) (A := a) (B := b) (C := c) (D := d') hN hM
have hmwf :
mwf n m a b c d' hN hM = S.max' hS := by
simp only [mwf, img, obj, zfloorDiv, dom, S]
calc
mwfLr_iter l r m a b c d hLR hM
= cst + mwf_iter n m a b c d' hN hM := hiter
_ = cst + mwf n m a b c d' hN hM := by simp only [hiter', mwf, img, obj, zfloorDiv, dom]
_ = cst + S.max' hS := by rw [hmwf]
_ = (S.image f).max' (hS.image f) := by
simpa only using hmax.symm
_ = mwfLr l r m a b c d hLR hM := by
simpa only [mwfLr, imgLr, obj, zfloorDiv, domLr] using hmwfLr.symm
end
/-
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 : α
/--
目的: floor_prod の数式仕様を定義する。
定義: `a,b` を先に `divmod` 正規化してから、sssec:mwf_floor_prod の再帰式を適用する。
入力/前提: `n,m,a,b : Nat`, `[Monoid α]`, 要素 `x,y`。
出力: モノイド要素を返す。
役割: 実装 `floorProd` の正しさ証明で比較する仕様（tex の流れに合わせた版）。
-/
def floorProdSpec {α : Type _} [Monoid α] (n m a b : Nat) (x y : α) : α :=
if _hM0 : m = 0 then
x ^ n
else
let p := a / m
let a' := a % m
let x' := x * y ^ p
let q := b / m
let b' := b % m
let pre := y ^ q
let yMax := a' * n + b'
if _hY : yMax < m then
pre * (x' ^ n)
else
pre *
(floorProdSpec (yMax / m - 1) a' m (m + a' - b' - 1) y x'
* y * x' ^ ((yMax % m) / a'))
termination_by m
decreasing_by
have hm : 0 < m := Nat.pos_of_ne_zero _hM0
exact Nat.mod_lt _ hm
/--
目的: 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'
/--
目的: floor_prod 実装エントリを定義する。
定義: `sssec:mwf_floor_prod` の while 更新式を `floorProdLoop` で実行する。
入力/前提: `n,m,a,b : Nat`, `[Monoid α]`, 要素 `x,y`。
出力: floor_prod の計算結果を返す。
役割: floor_prod の実装本体（`floorProd_correct` の左辺）。
-/
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 }
floorProdLoop (stepBoundOfM m) st
/--
入力/前提: 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) :
(euclidN (stepBoundOfM m) a m).2 = 0 := by
by_cases hm : 0 < m
· exact (euclidTau_le_iff_c_zero a m (stepBoundOfM m)).1
(euclidTau_le_stepBoundOfM a m hm)
· have hm0 : m = 0 := Nat.eq_zero_of_not_pos hm
subst hm0
exact euclidN_c_zero_of_le a 0 (stepBoundOfM 0) (Nat.zero_le _)
/--
入力/前提: 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` の直接トリガー補題。
-/
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)
/--
入力/前提: st : LoopState α。
主張: `stepBoundOfM st.m` は `a,m` の Euclid 縮約を 0 余りまで到達させる。
内容: `euclidN_second_zero_stepBoundOfM` の状態版。
証明: 既存補題の直接適用。
役割: `floorProd` に `stepBoundOfM m` を使ってよい根拠（縮約回数側）。
-/
theorem floorProdLoop_fuel_sufficient
{α : Type _} [Monoid α] (st : LoopState α) :
(euclidN (stepBoundOfM st.m) st.a st.m).2 = 0 := by
simpa only using (euclidN_second_zero_stepBoundOfM st.a st.m)
/--
証明スケッチ:
- `0 ≤ a,b < m` と `a*n+b < m` からすべての差分指数が 0 であることを示す。
- したがって積は `x` のみを `n` 回掛けた `x^n` に簡約される。
入力/前提: `m>0`, `a<m`, `b<m`, `a*n+b<m`。
主張: 停止分岐における `floorProdSpec` の閉形式。
内容: sssec:mwf_floor_prod の再帰式第1分岐に対応。
役割: `floorProd_correct` の基底ケース。
-/
theorem floorProdSpec_stop
{α : Type _} [Monoid α]
(n m a b : Nat) (_hM : 0 < m) (_hA : a < m) (_hB : b < m)
(x y : α) (hY : a * n + b < m) :
floorProdSpec n m a b x y = x ^ n := by
have hm0 : m ≠ 0 := Nat.ne_of_gt _hM
have ha_div : a / m = 0 := Nat.div_eq_of_lt _hA
have hb_div : b / m = 0 := Nat.div_eq_of_lt _hB
have ha_mod : a % m = a := Nat.mod_eq_of_lt _hA
have hb_mod : b % m = b := Nat.mod_eq_of_lt _hB
conv_lhs => unfold floorProdSpec
simp only [hm0, ↓reduceDIte, ha_mod, hb_mod, hY, hb_div, pow_zero, ha_div, mul_one, one_mul]
/--
証明スケッチ:
- `0 ≤ a,b < m` かつ `m ≤ a*n+b` の下で、格子路の折り返しに対応する再帰式を展開する。
- `d := ⌊(m*c-b-1)/a⌋+1` と変数交換 `(n,m,a,b,x,y)` 更新を適用し、第2分岐の式を得る。
入力/前提: `m>0`, `a<m`, `b<m`, `0<a`, `m ≤ a*n+b`。
主張: 再帰分岐における `floorProdSpec` の等式。
内容: sssec:mwf_floor_prod の再帰式第2分岐に対応。
役割: `floorProd_correct` の帰納ステップ。
-/
theorem floorProdSpec_step
{α : Type _} [Monoid α]
(n m a b : Nat) (_hM : 0 < m) (hA : a < m) (_hB : b < m) (_hApos : 0 < a)
(x y : α) (hY : m ≤ a * n + b) :
floorProdSpec n m a b x y =
let yMax := a * n + b
floorProdSpec (yMax / m - 1) a m (m + a - b - 1) y x
* y * x ^ ((yMax % m) / a) := by
have hm0 : m ≠ 0 := Nat.ne_of_gt _hM
have ha_div : a / m = 0 := Nat.div_eq_of_lt hA
have hb_div : b / m = 0 := Nat.div_eq_of_lt _hB
have ha_mod : a % m = a := Nat.mod_eq_of_lt hA
have hb_mod : b % m = b := Nat.mod_eq_of_lt _hB
have hNotLt : ¬ a * n + b < m := Nat.not_lt.mpr hY
conv_lhs => unfold floorProdSpec
simp only [hm0, ↓reduceDIte, ha_mod, hb_mod, hNotLt, hb_div, pow_zero, ha_div, mul_one, one_mul]
/--
証明スケッチ:
- `yMax = a*n+b`, `c = ⌊yMax/m⌋`, `r = yMax mod m` とおく。
- `d = ⌊(m*c-b-1)/a⌋+1` と `k = ⌊r/a⌋` について、`n-d = k` を示す。
- 本質は `m*c + r = yMax` と `r = a*k + (r mod a)` を用いた商剰余の比較。
入力/前提: `m>0`, `0<a<m`, `0≤b<m`, `m ≤ a*n+b`。
主張: floor_prod の while 更新で使う指数 `n-d` は仕様側の `⌊(yMax mod m)/a⌋` と一致。
内容: 実装側 `suf` 更新式と仕様側第2分岐の指数を同一視する橋渡し補題。
役割: `floorProdLoop_spec_invariant` の `c'≠0` 分岐を閉じる算術コア。
-/
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
dsimp only [Lean.Elab.WF.paramLet]
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
by_contra hc0
have hc0' : c = 0 := Nat.eq_zero_of_not_pos hc0
have hy_lt : y < m := by
have hdiv0 : y / m = 0 := by simpa only [c, Nat.div_eq_zero_iff] using hc0'
rcases (Nat.div_eq_zero_iff.mp hdiv0) with hm0 | hlt
· exact False.elim ((Nat.ne_of_gt hM) hm0)
· exact hlt
exact (Nat.not_le_of_lt hy_lt) (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_div : r / a = k := by rfl
have hk_bounds : k * a ≤ r ∧ r ≤ k * a + a - 1 := by
simpa only [Nat.mul_comm] using (Nat.div_eq_iff hApos).1 hk_div
rcases hk_bounds with ⟨hk_lo, hk_hi⟩
have hr_lt_an : r < a * n := by
have : 0 < a * n - r := by
simpa only [tsub_pos_iff_lt, hmc_sub] using hx_pos
exact Nat.sub_pos_iff_lt.mp this
have hk_lt_n : k < n := by
have hk_mul_lt : k * a < n * a :=
lt_of_le_of_lt hk_lo
(by
simpa only [Nat.mul_comm] using hr_lt_an)
exact Nat.lt_of_mul_lt_mul_right hk_mul_lt
have hq : t / a = n - k - 1 := by
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)
exact lt_of_le_of_lt hk_hi
(by
simpa only [Nat.add_comm, Nat.succ_mul, tsub_lt_self_iff, add_pos_iff,
CanonicallyOrderedAdd.mul_pos, zero_lt_one, and_true] using hpred_lt)
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 [hmc_sub]
have : (n - k - 1) * a ≤ x - 1 := Nat.le_pred_of_lt hx_gt
simpa only [ge_iff_le] using this
· 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 := hmc_sub
_ ≤ a * n - (k * a) := hsub_le
_ = (n - k) * a := hright_eq
have ht_lt_x : t < x := by
unfold t
exact Nat.sub_lt hx_pos (Nat.succ_pos 0)
have ht_lt : t < (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' : t < (n - k - 1) * a + a := by
simpa only [hmul_succ] using ht_lt
exact Nat.le_pred_of_lt ht_lt'
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]
/--
証明スケッチ:
- `fuel` に関する帰納法を行う。
- 基底 `fuel=0` は `floorProdLoop` の定義展開で `pre * x^n * suf` に帰着する。
- 帰納段階は `c' = ((a%m)*n + (b%m))/m` で分岐する。
- `c'=0` 側は `floorProdSpec_stop`（正規化後の停止分岐）で一致。
- `c'≠0` 側は更新後状態 `st'` に IH を適用し、`floorProdSpec_step` で式を貼り合わせる。
入力/前提: `fuel : Nat`, `st : LoopState α`, `0 < st.m`、および Euclid 側の十分燃料条件。
主張: `floorProdLoop fuel st` は `st.pre * floorProdSpec ... * st.suf` と一致。
内容: while ループと再帰仕様をつなぐ中心不変量。
役割: `floorProd_correct` を初期状態へ適用するための主補題。
-/
theorem floorProdLoop_spec_invariant
{α : Type _} [Monoid α] :
∀ fuel (st : LoopState α),
0 < st.m →
(euclidN fuel st.a st.m).2 = 0 →
floorProdLoop fuel st =
st.pre * floorProdSpec st.n st.m st.a st.b st.x st.y * st.suf := by
intro fuel
induction fuel with
| zero =>
intro st hM hFuel
have hm0 : st.m = 0 := by
simpa only [euclidN] using hFuel
exact False.elim ((Nat.ne_of_gt hM) hm0)
| succ fuel ih =>
intro st hM hFuel
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
by_cases hc0 : c' = 0
· have hm0 : st.m ≠ 0 := Nat.ne_of_gt hM
have hy_lt : a' * st.n + b' < st.m := by
have hdiv0 : (a' * st.n + b') / st.m = 0 := by
simpa only [c', Nat.div_eq_zero_iff] using hc0
rcases (Nat.div_eq_zero_iff.mp hdiv0) with hzm | hlt
· exact False.elim (hm0 hzm)
· exact hlt
have hSpecStop :
floorProdSpec st.n st.m st.a st.b st.x st.y = st.y ^ q * x' ^ st.n := by
conv_lhs => unfold floorProdSpec
simp only [hm0, ↓reduceDIte, hy_lt, q, x', p, a', b']
calc
floorProdLoop (fuel + 1) st
= pre' * x' ^ st.n * st.suf := by
simp only [floorProdLoop, hc0, ↓reduceIte, pre', q, x', p, c', a', b']
_ = st.pre * (st.y ^ q * x' ^ st.n) * st.suf := by
simp only [mul_assoc, pre']
_ = st.pre * floorProdSpec st.n st.m st.a st.b st.x st.y * st.suf := by
rw [hSpecStop]
· have hm0 : st.m ≠ 0 := Nat.ne_of_gt hM
have hA_lt : a' < st.m := by
simpa only using (Nat.mod_lt st.a hM)
have hB_lt : b' < st.m := by
simpa only using (Nat.mod_lt st.b hM)
have hApos : 0 < a' := by
by_contra hNotPos
have ha0 : a' = 0 := Nat.eq_zero_of_not_pos hNotPos
have ha0' : st.a % st.m = 0 := by
simpa only using ha0
have hc0' : ((st.a % st.m) * st.n + (st.b % st.m)) / st.m = 0 := by
exact floorProd_cprime_zero_of_aModZero st.n st.m st.a st.b hM ha0'
have : c' = 0 := by
simpa only [c', a', b', Nat.div_eq_zero_iff] using hc0'
exact hc0 this
have hY_ge : st.m ≤ a' * st.n + b' := by
have hNotLt : ¬ a' * st.n + b' < st.m := by
intro hlt
have hdiv0 : (a' * st.n + b') / st.m = 0 := Nat.div_eq_of_lt hlt
have : c' = 0 := by
simpa only [c',Nat.div_eq_zero_iff] using hdiv0
exact hc0 this
exact Nat.le_of_not_gt hNotLt
have hFuel' : (euclidN fuel st.m a').2 = 0 := by
simpa only [euclidN_succ, euclid_step, hm0, ↓reduceDIte] using hFuel
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' }
have hIH :
floorProdLoop fuel st' =
st'.pre * floorProdSpec st'.n st'.m st'.a st'.b st'.x st'.y * st'.suf := by
exact ih st' (by simpa only [st'] using hApos) (by simpa only [st', a'] using hFuel')
have hStep :
floorProdSpec st.n st.m a' b' x' st.y =
let yMax := a' * st.n + b'
floorProdSpec (yMax / st.m - 1) a' st.m (st.m + a' - b' - 1) st.y x'
* st.y * x' ^ ((yMax % st.m) / a') := by
exact floorProdSpec_step st.n st.m a' b' hM hA_lt hB_lt hApos x' st.y hY_ge
have hb_norm : st.m - b' - 1 + a' = st.m + a' - b' - 1 := by
omega
have hExp : st.n - d = ((a' * st.n + b') % st.m) / a' := by
unfold d
simpa only using (floorProd_exponent_bridge st.n st.m a' b' hM hA_lt hB_lt hApos hY_ge)
have hSpecMain :
floorProdSpec st.n st.m st.a st.b st.x st.y =
st.y ^ q *
(floorProdSpec (c' - 1) a' st.m (st.m + a' - b' - 1) st.y x'
* st.y * x' ^ ((a' * st.n + b') % st.m / a')) := by
have hNotLt : ¬ a' * st.n + b' < st.m := Nat.not_lt.mpr hY_ge
conv_lhs => unfold floorProdSpec
simp only [hm0, ↓reduceDIte, hNotLt, Nat.add_mod_mod, q, c', a', b', x', p]
have hLoopStep :
floorProdLoop (fuel + 1) st =
pre' * floorProdSpec (c' - 1) a' st.m (st.m + a' - b' - 1) st.y x'
* (st.y * x' ^ ((a' * st.n + b') % st.m / a') * st.suf) := by
calc
floorProdLoop (fuel + 1) st
= floorProdLoop fuel st' := by
simp only [floorProdLoop, hc0, ↓reduceIte, st', c', a', b', x', p, pre', q,
suf', d]
_ = st'.pre * floorProdSpec st'.n st'.m st'.a st'.b st'.x st'.y * st'.suf := by
exact hIH
_ = pre' * floorProdSpec (c' - 1) a' st.m (st.m + a' - b' - 1) st.y x'
* (st.y * x' ^ (st.n - d) * st.suf) := by
simp only [hb_norm, mul_assoc, suf', st']
_ = pre' * floorProdSpec (c' - 1) a' st.m (st.m + a' - b' - 1) st.y x'
* (st.y * x' ^ ((a' * st.n + b') % st.m / a') * st.suf) := by
simp only [hExp]
calc
floorProdLoop (fuel + 1) st
= pre' * floorProdSpec (c' - 1) a' st.m (st.m + a' - b' - 1) st.y x'
* (st.y * x' ^ ((a' * st.n + b') % st.m / a') * st.suf) := hLoopStep
_ = st.pre * floorProdSpec st.n st.m st.a st.b st.x st.y * st.suf := by
rw [hSpecMain]
simp only [mul_assoc, pre']
/--
証明スケッチ:
- `floorProdLoop_fuel_sufficient` で `stepBoundOfM st.m` が Euclid 縮約に十分なことを得る。
- `floorProdLoop_spec_invariant` に代入する。
入力/前提: `st : LoopState α`, `0 < st.m`。
主張: `stepBoundOfM st.m` 回で `floorProdLoop` は仕様形 `pre * spec * suf` になる。
内容: 主不変量を既定 fuel へ具体化した形。
役割: `floorProd_correct` 直前の橋渡し補題。
-/
theorem floorProdLoop_stepBound_eq_spec
{α : Type _} [Monoid α] (st : LoopState α) (hM : 0 < st.m) :
floorProdLoop (stepBoundOfM st.m) st =
st.pre * floorProdSpec st.n st.m st.a st.b st.x st.y * st.suf := by
have hFuel : (euclidN (stepBoundOfM st.m) st.a st.m).2 = 0 := by
simpa only using (floorProdLoop_fuel_sufficient st)
exact floorProdLoop_spec_invariant (fuel := stepBoundOfM st.m) st hM hFuel
/--
証明スケッチ:
- `floorProdLoop` に対して不変量（`pre * spec * suf` 形式）を設定する。
- `c=0` 分岐で停止し、`c>0` 分岐では `floorProdSpec_step` の再帰式で不変量を保存する。
- 燃料上界が十分であることを示して初期状態に適用する。
入力/前提: `m>0`。
主張: 実装 `floorProd` は仕様 `floorProdSpec` と一致する。
内容: while 反復と数式定義の同値性。
役割: floor_prod 枠組みの中心正当化。
-/
theorem floorProd_correct
{α : Type _} [Monoid α]
(n m a b : Nat) (_hM : 0 < m) (x y : α) :
floorProd n m a b x y = floorProdSpec n m a b x y := by
let st : LoopState α :=
{ n := n, m := m, a := a, b := b, x := x, y := y, pre := 1, suf := 1 }
have hst : 0 < st.m := by
simpa only using _hM
have hmain :
floorProdLoop (stepBoundOfM st.m) st =
st.pre * floorProdSpec st.n st.m st.a st.b st.x st.y * st.suf := by
exact floorProdLoop_stepBound_eq_spec st hst
simpa only [floorProd, st, one_mul, mul_one] using hmain
/--
目的: `best` が有効なときに束ねて保持する情報を定義する。
フィールド: `best, dx, arg`。
不変条件: `dx` は `X` 個数、`arg` は最大達成の最小添字を表す。
役割: `MwfElem.info?` の `some` 側のペイロード。
-/
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 化。
-/
structure MwfElem where
sum : Int
info? : Option BestInfo := none
deriving Repr, DecidableEq
/--
目的: `MwfElem` の単位元を定義する。
定義: `sum=0, info?=none`。
入力/前提: なし。
出力: 型 `MwfElem` の値を返す。
役割: `MwfElem` モノイドの単位元。
-/
def mwfElemOne : MwfElem :=
{ sum := 0, info? := none }
/--
目的: `MwfElem` の積（連結合成）を定義する。
定義: Python 実装の `__mul__` 更新式をそのまま移植する。
入力/前提: `lhs rhs : MwfElem`。
出力: 型 `MwfElem` の値を返す。
役割: floor_prod で prefix 最大と最小 argmax を合成する核。
-/
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 } }
instance : One MwfElem := ⟨mwfElemOne⟩
instance : Mul MwfElem := ⟨mwfElemMul⟩
/--
証明スケッチ:
- `mwfElemOne` の各フィールドが左単位として作用することを `mwfElemMul` 展開で示す。
入力/前提: `u : MwfElem`。
主張: `1 * u = u`。
内容: `MwfElem` の左単位律。
役割: `MwfElem` モノイド公理の一部。
-/
theorem mwfElem_one_mul (u : MwfElem) : 1 * u = u := by
change mwfElemMul mwfElemOne u = u
cases u with
| mk s info =>
cases info with
| none =>
simp only [mwfElemMul, mwfElemOne, zero_add]
| some bi =>
cases bi with
| mk best dx arg =>
simp only [mwfElemMul, mwfElemOne, zero_add]
/--
証明スケッチ:
- `mwfElemOne` の各フィールドが右単位として作用することを `mwfElemMul` 展開で示す。
入力/前提: `u : MwfElem`。
主張: `u * 1 = u`。
内容: `MwfElem` の右単位律。
役割: `MwfElem` モノイド公理の一部。
-/
theorem mwfElem_mul_one (u : MwfElem) : u * 1 = u := by
change mwfElemMul u mwfElemOne = u
cases u with
| mk s info =>
cases info with
| none =>
simp only [mwfElemMul, mwfElemOne, add_zero]
| some bi =>
cases bi with
| mk best dx arg =>
simp only [mwfElemMul, mwfElemOne, add_zero]
private def mwfChooseScore (p q : Int × Nat) : Int × Nat :=
if p.1 < q.1 then q else p
private def mwfShiftScore (s : Int) (k : Nat) (p : Int × Nat) : Int × Nat :=
(s + p.1, k + p.2)
private def mwfInfoScore (i : BestInfo) : Int × Nat :=
(i.best, i.arg)
private def mwfMkInfoFromScore (dx : Nat) (sc : Int × Nat) : BestInfo :=
{ best := sc.1, dx := dx, arg := sc.2 }
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
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
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
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 := by
exact le_of_not_gt hlt
simp only [hlt, hge, ↓reduceIte]
private lemma mwfElemMul_assoc_none_some_some
(su sv sw : Int) (v w : BestInfo) :
mwfElemMul (mwfElemMul { sum := su } { sum := sv, info? := some v })
{ sum := sw, info? := some w } =
mwfElemMul { sum := su }
(mwfElemMul { sum := sv, info? := some v } { sum := sw, info? := some w }) := by
have hleftInner :
mwfElemMul { sum := su } { sum := sv, info? := some v } =
{ sum := su + sv
info? := some (mwfMkInfoFromScore v.dx (mwfShiftScore su 0 (mwfInfoScore v))) } := by
simp only [mwfElemMul, mwfMkInfoFromScore, mwfShiftScore, mwfInfoScore, zero_add]
have hrightInner :
mwfElemMul { sum := sv, info? := some v } { sum := sw, info? := some w } =
{ sum := sv + sw
info? := some (mwfMkInfoFromScore (v.dx + w.dx)
(mwfChooseScore (mwfInfoScore v) (mwfShiftScore sv v.dx (mwfInfoScore w)))) } :=
mwfElemMul_some_some sv sw v w
rw [hleftInner, hrightInner]
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
calc
mwfChooseScore (mwfShiftScore su 0 (mwfInfoScore v))
(mwfShiftScore (su + sv) v.dx (mwfInfoScore w))
= mwfChooseScore (mwfShiftScore su 0 (mwfInfoScore v))
(mwfShiftScore su 0 (mwfShiftScore sv v.dx (mwfInfoScore w))) := by
simp only [mwfShiftScore_comp, zero_add]
_ = mwfShiftScore su 0
(mwfChooseScore (mwfInfoScore v) (mwfShiftScore sv v.dx (mwfInfoScore w))) := by
symm
exact
mwfChooseScore_shift su 0 (mwfInfoScore v)
(mwfShiftScore sv v.dx (mwfInfoScore w))
refine ⟨by omega, ?_, ?_⟩
· exact congrArg Prod.fst hmain
· simpa only [mwfShiftScore, zero_add] using congrArg Prod.snd hmain
private lemma mwfElemMul_assoc_some_none_some
(su sv sw : Int) (u w : BestInfo) :
mwfElemMul (mwfElemMul { sum := su, info? := some u } { sum := sv })
{ sum := sw, info? := some w } =
mwfElemMul { sum := su, info? := some u }
(mwfElemMul { sum := sv } { sum := sw, info? := some w }) := by
have hleftInner :
mwfElemMul { sum := su, info? := some u } { sum := sv } =
{ sum := su + sv, info? := some u } := by
simp only [mwfElemMul]
have hrightInner :
mwfElemMul { sum := sv } { sum := sw, info? := some w } =
{ sum := sv + sw
info? := some (mwfMkInfoFromScore w.dx (mwfShiftScore sv 0 (mwfInfoScore w))) } := by
simp only [mwfElemMul, mwfMkInfoFromScore, mwfShiftScore, mwfInfoScore, zero_add]
rw [hleftInner, hrightInner]
repeat rw [mwfElemMul_some_some]
simp only [mwfMkInfoFromScore, mwfInfoScore, Prod.mk.eta, mwfShiftScore_comp, add_zero,
MwfElem.mk.injEq, and_true]
omega
private lemma mwfElemMul_assoc_some_some_none
(su sv sw : Int) (u v : BestInfo) :
mwfElemMul (mwfElemMul { sum := su, info? := some u } { sum := sv, info? := some v })
{ sum := sw } =
mwfElemMul { sum := su, info? := some u }
(mwfElemMul { sum := sv, info? := some v } { sum := sw }) := by
have hleftInner :
mwfElemMul { sum := su, info? := some u } { sum := sv, info? := some v } =
{ sum := su + sv
info? := some (mwfMkInfoFromScore (u.dx + v.dx)
(mwfChooseScore (mwfInfoScore u) (mwfShiftScore su u.dx (mwfInfoScore v)))) } :=
mwfElemMul_some_some su sv u v
have hrightInner :
mwfElemMul { sum := sv, info? := some v } { sum := sw } =
{ sum := sv + sw, info? := some v } := by
simp only [mwfElemMul]
rw [hleftInner, hrightInner]
repeat rw [mwfElemMul_some_some]
simp only [mwfElemMul, mwfMkInfoFromScore, mwfInfoScore, MwfElem.mk.injEq, and_true]
omega
private lemma mwfElemMul_assoc_some_some_some
(su sv sw : Int) (u v w : BestInfo) :
mwfElemMul (mwfElemMul { sum := su, info? := some u } { sum := sv, info? := some v })
{ sum := sw, info? := some w } =
mwfElemMul { sum := su, info? := some u }
(mwfElemMul { sum := sv, info? := some v } { sum := sw, info? := some w }) := by
have huv :
mwfElemMul { sum := su, info? := some u } { sum := sv, info? := some v } =
{ sum := su + sv
info? := some (mwfMkInfoFromScore (u.dx + v.dx)
(mwfChooseScore (mwfInfoScore u) (mwfShiftScore su u.dx (mwfInfoScore v)))) } :=
mwfElemMul_some_some su sv u v
have hvw :
mwfElemMul { sum := sv, info? := some v } { sum := sw, info? := some w } =
{ sum := sv + sw
info? := some (mwfMkInfoFromScore (v.dx + w.dx)
(mwfChooseScore (mwfInfoScore v) (mwfShiftScore sv v.dx (mwfInfoScore w)))) } :=
mwfElemMul_some_some sv sw v w
rw [huv, hvw]
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` をモノイドに昇格する主要補題。
役割: `floorProd` を `MwfElem` に適用する前提。
-/
theorem mwfElem_mul_assoc (u v w : MwfElem) :
(u * v) * w = u * (v * w) := by
change mwfElemMul (mwfElemMul u v) w = mwfElemMul u (mwfElemMul v w)
cases u with
| mk su iu =>
cases v with
| mk sv iv =>
cases w with
| mk sw iw =>
cases iu with
| none =>
cases iv with
| none =>
cases iw with
| none =>
simp only [mwfElemMul, MwfElem.mk.injEq, and_true]
omega
| some wv =>
simp only [mwfElemMul, MwfElem.mk.injEq, Option.some.injEq,
BestInfo.mk.injEq, and_self, and_true]
omega
| some vv =>
cases iw with
| none =>
simp only [mwfElemMul, MwfElem.mk.injEq, and_true]
omega
| some wv =>
exact mwfElemMul_assoc_none_some_some su sv sw vv wv
| some uv =>
cases iv with
| none =>
cases iw with
| none =>
simp only [mwfElemMul, MwfElem.mk.injEq, and_true]
omega
| some wv =>
exact mwfElemMul_assoc_some_none_some su sv sw uv wv
| some vv =>
cases iw with
| none =>
exact mwfElemMul_assoc_some_some_none su sv sw uv vv
| some wv =>
exact mwfElemMul_assoc_some_some_some su sv sw uv vv wv
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 上で表し、正しさ定理で検証する対象。
-/
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 } }
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]
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
private lemma mwfElem_pow_none_succ (s : Int) :
∀ k, ({ sum := s, info? := none } : MwfElem) ^ (Nat.succ k) =
{ sum := s * (Nat.succ k), info? := none }
| 0 => by
simp only [Nat.succ_eq_add_one, zero_add, pow_one, Nat.cast_one, mul_one]
| k + 1 => by
calc
({ sum := s, info? := none } : MwfElem) ^ (Nat.succ (Nat.succ k))
= (({ sum := s, info? := none } : MwfElem) ^ (Nat.succ k)) *
{ sum := s, info? := none } := by
simp only [Nat.succ_eq_add_one, pow_succ]
_ = { sum := s * (Nat.succ k), info? := none } * { sum := s, info? := none } := by
have hpow : ({ sum := s, info? := none } : MwfElem) ^ (Nat.succ k) =
{ sum := s * (Nat.succ k), info? := none } := mwfElem_pow_none_succ s k
rw [hpow]
_ = { 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 }
simp only [mwfElemMul, Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one,
MwfElem.mk.injEq, and_true]
simpa only [Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one] using int_mul_succ s k
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 } }
| 0 => by
simp only [Nat.succ_eq_add_one, zero_add, pow_one, Nat.cast_one, mul_one]
| k + 1 => by
have hMulNonPos : s * (Nat.succ k) ≤ 0 := by
exact mul_nonpos_of_nonpos_of_nonneg hS (Int.natCast_nonneg _)
have hge :
info.best ≥ s * (Nat.succ k) + info.best := by
nlinarith [hMulNonPos]
calc
({ sum := s, info? := some info } : MwfElem) ^ (Nat.succ (Nat.succ k))
= (({ sum := s, info? := some info } : MwfElem) ^ (Nat.succ k)) *
{ sum := s, info? := some info } := by
simp only [Nat.succ_eq_add_one, pow_succ]
_ = { sum := s * (Nat.succ k)
info? := some
{ best := info.best
dx := info.dx * (Nat.succ k)
arg := info.arg } } * { sum := s, info? := some info } := by
have hpow :
({ 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_some_nonpos_succ s info hS k
rw [hpow]
_ = { sum := s * (Nat.succ (Nat.succ k))
info? := some
{ best := info.best
dx := info.dx * (Nat.succ (Nat.succ k))
arg := info.arg } } := by
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 } }
have hCond : s * ((k : Int) + 1) ≤ 0 := by
simpa only [Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one] using hMulNonPos
simp only [mwfElemMul, Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one, ge_iff_le,
add_le_iff_nonpos_left, hCond, ↓reduceIte, MwfElem.mk.injEq, Option.some.injEq,
BestInfo.mk.injEq, and_true, true_and]
constructor
· simpa only [Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one] using int_mul_succ s k
· simpa only [Nat.succ_eq_add_one] using nat_mul_succ info.dx k
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 } }
| 0 => by
simp only [Nat.succ_eq_add_one, zero_add, pow_one, Nat.cast_one, mul_one, CharP.cast_eq_zero,
mul_zero]
| k + 1 => 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) := by
exact 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 hnotLe :
¬ (s * (Nat.succ k) ≤ s * k) := by
exact not_le.mpr (by simpa only [Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one,
add_lt_add_iff_right] using hlt)
calc
({ sum := s, info? := some info } : MwfElem) ^ (Nat.succ (Nat.succ k))
= (({ sum := s, info? := some info } : MwfElem) ^ (Nat.succ k)) *
{ sum := s, info? := some info } := by
simp only [Nat.succ_eq_add_one, pow_succ]
_ = { 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 } := by
have hpow :
({ 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_some_pos_succ s info hS k
rw [hpow]
_ = { 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
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 } }
have hnotLe' : ¬ s * ((k : Int) + 1) ≤ s * (k : Int) := by
simpa only [not_le, Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one] using hnotLe
simp only [mwfElemMul, Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one, ge_iff_le,
add_le_add_iff_right, hnotLe', ↓reduceIte, MwfElem.mk.injEq, Option.some.injEq,
BestInfo.mk.injEq, and_true, true_and]
constructor
· simpa only [Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one] using int_mul_succ s k
· simpa only [Nat.succ_eq_add_one] using nat_mul_succ info.dx 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__` 実装が数理仕様（モノイド冪）に正しいことの検証定理。
-/
theorem mwfElemPowImpl_correct (z : MwfElem) (k : Nat) :
mwfElemPowImpl z k = z ^ k := by
cases k with
| zero =>
simp only [mwfElemPowImpl, pow_zero]
| succ k =>
cases z with
| mk s info? =>
cases info? with
| none =>
simpa only [mwfElemPowImpl, Nat.succ_eq_add_one, Nat.cast_add, Nat.cast_one] using
(mwfElem_pow_none_succ s k).symm
| some info =>
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
· have hSle : s ≤ 0 := le_of_not_gt hS
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 hSle k).symm
/--
目的: `X=(sum=a,info?=some(best=0,dx=1,arg=0))` を定義する。
定義: `MwfElem` の初期要素 `X`。
入力/前提: `a : Int`。
出力: 型 `MwfElem` の値を返す。
役割: sssec:mwf_floor_prod の写像で使う `x` 側モノイド要素。
-/
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` 側モノイド要素。
-/
def mwfElemY (b : Int) : MwfElem :=
{ sum := b, info? := none }
/--
目的: `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) :
MwfLrArgResult :=
let nI := R - L
let mI := M
let qC := zfloorDiv C M hM
let cI := zfloorMod C M hM
let kI := C * L + D
let qD := zfloorDiv kI M hM
let dI := zfloorMod kI M hM
let aI := A + B * qC
let cst := A * L + B * qD
let res : MwfElem :=
floorProd (Int.toNat nI) (Int.toNat mI) (Int.toNat cI) (Int.toNat dI) (mwfElemX aI) (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
/--
入力/前提: `L<R`, `0<M`, `0≤C`, `0≤D`。
主張: floor_prod 版と定義版の構造体等式は、`max` と `argmax` の等式 2 本と同値。
内容: 構造体の extensionality で分解・再構成する。
証明: 射影 `congrArg` と `MwfLrArgResult` の ext を用いる。
役割: `mwfLrWithArgmaxFloorProd = mwfLrWithArgmax` を成分ごとに還元する橋渡し定理。
-/
theorem mwfLrWithArgmaxFloorProd_eq_mwfLrWithArgmax_iff
(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
↔
mwfLrFloorProd L R M A B C D hLR hM hC0 hD0 = mwfLr L R M A B C D hLR hM
∧
mwfLrArgmaxFloorProd L R M A B C D hLR hM hC0 hD0 = mwfLrArgmax L R M A B C D hLR hM := by
constructor
· intro hEq
constructor
· have hMax := congrArg MwfLrArgResult.max hEq
simpa only [mwfLrFloorProd, mwfLrWithArgmax] using hMax
· have hArg := congrArg MwfLrArgResult.argmax hEq
simpa only [mwfLrArgmaxFloorProd, mwfLrWithArgmax] using hArg
· intro hField
rcases hField with ⟨hMax, hArg⟩
cases hfp : mwfLrWithArgmaxFloorProd L R M A B C D hLR hM hC0 hD0 with
| mk fpMax fpArg =>
cases hmwf : mwfLrWithArgmax L R M A B C D hLR hM with
| mk mwfMax mwfArg =>
have hMwfMax : mwfLr L R M A B C D hLR hM = mwfMax := by
simpa only [mwfLrWithArgmax] using congrArg MwfLrArgResult.max hmwf
have hMwfArg : mwfLrArgmax L R M A B C D hLR hM = mwfArg := by
simpa only [mwfLrWithArgmax] using congrArg MwfLrArgResult.argmax hmwf
have hMax' : fpMax = mwfMax := by
calc
fpMax = mwfLr L R M A B C D hLR hM := by
simpa only [mwfLrFloorProd, hfp] using hMax
_ = mwfMax := hMwfMax
have hArg' : fpArg = mwfArg := by
calc
fpArg = mwfLrArgmax L R M A B C D hLR hM := by
simpa only [mwfLrArgmaxFloorProd, hfp] using hArg
_ = mwfArg := hMwfArg
cases hMax'
cases hArg'
rfl
/--
入力/前提: `L<R`, `0<M`, `0≤C`, `0≤D`。
主張: `max` と `argmax` の一致が示せれば、構造体レベルでも一致する。
内容: `mwfLrWithArgmaxFloorProd_eq_mwfLrWithArgmax_iff` の `←` 方向。
証明: 同値定理を `Iff.mpr` で適用。
役割: 以後の正当化で使う組み立て用補題。
-/
theorem mwfLrWithArgmaxFloorProd_eq_mwfLrWithArgmax_of_fields
(L R M A B C D : Int)
(hLR : L < R) (hM : 0 < M) (hC0 : 0 ≤ C) (hD0 : 0 ≤ D)
(hMax :
mwfLrFloorProd L R M A B C D hLR hM hC0 hD0 =
mwfLr L R M A B C D hLR hM)
(hArg :
mwfLrArgmaxFloorProd L R M A B C D hLR hM hC0 hD0 =
mwfLrArgmax L R M A B C D hLR hM) :
mwfLrWithArgmaxFloorProd L R M A B C D hLR hM hC0 hD0 =
mwfLrWithArgmax L R M A B C D hLR hM := by
exact (mwfLrWithArgmaxFloorProd_eq_mwfLrWithArgmax_iff
L R M A B C D hLR hM hC0 hD0).2 ⟨hMax, hArg⟩
/--
入力/前提: `L<R`, `0<M`, `0≤C`, `0≤D`。
主張: floor_prod 版の `max` と `argmax` がそれぞれ一致すれば、結果構造体も一致する。
内容: `mwfLrWithArgmaxFloorProd_eq_mwfLrWithArgmax_of_fields` の別名。
証明: 補題をそのまま適用する。
役割: `mwfLrWithArgmaxFloorProd = mwfLrWithArgmax` の最終組み立て用インターフェース。
-/
theorem mwfLrWithArgmaxFloorProd_eq_mwfLrWithArgmax
(L R M A B C D : Int)
(hLR : L < R) (hM : 0 < M) (hC0 : 0 ≤ C) (hD0 : 0 ≤ D)
(hMax :
mwfLrFloorProd L R M A B C D hLR hM hC0 hD0 =
mwfLr L R M A B C D hLR hM)
(hArg :
mwfLrArgmaxFloorProd L R M A B C D hLR hM hC0 hD0 =
mwfLrArgmax L R M A B C D hLR hM) :
mwfLrWithArgmaxFloorProd L R M A B C D hLR hM hC0 hD0 =
mwfLrWithArgmax L R M A B C D hLR hM := by
exact mwfLrWithArgmaxFloorProd_eq_mwfLrWithArgmax_of_fields
L R M A B C D hLR hM hC0 hD0 hMax hArg
/--
入力/前提: `L<R`, `0<M`, `0≤C`, `0≤D`。
主張: 構造体等式が成り立てば `max` 成分も一致する。
内容: 同値定理の `→` 方向から第1成分を取り出す。
証明: `mwfLrWithArgmaxFloorProd_eq_mwfLrWithArgmax_iff` を展開。
役割: `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)
(hEq :
mwfLrWithArgmaxFloorProd L R M A B C D hLR hM hC0 hD0 =
mwfLrWithArgmax L R M A B C D hLR hM) :
mwfLrFloorProd L R M A B C D hLR hM hC0 hD0 =
mwfLr L R M A B C D hLR hM := by
exact (mwfLrWithArgmaxFloorProd_eq_mwfLrWithArgmax_iff
L R M A B C D hLR hM hC0 hD0).1 hEq |>.1
/--
入力/前提: `L<R`, `0<M`, `0≤C`, `0≤D`。
主張: 構造体等式が成り立てば `argmax` 成分も一致する。
内容: 同値定理の `→` 方向から第2成分を取り出す。
証明: `mwfLrWithArgmaxFloorProd_eq_mwfLrWithArgmax_iff` を展開。
役割: `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)
(hEq :
mwfLrWithArgmaxFloorProd L R M A B C D hLR hM hC0 hD0 =
mwfLrWithArgmax L R M A B C D hLR hM) :
mwfLrArgmaxFloorProd L R M A B C D hLR hM hC0 hD0 =
mwfLrArgmax L R M A B C D hLR hM := by
exact (mwfLrWithArgmaxFloorProd_eq_mwfLrWithArgmax_iff
L R M A B C D hLR hM hC0 hD0).1 hEq |>.2
end FloorProd
end MWF
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment