end Bounty /- Component: Base. -/ noncomputable section namespace Bounty.Families open Finset Set Math15.LonelyRunner /-- Any integer is zero on the unit additive circle. -/ theorem coe_int_zero (m : ℤ) : ((m : ℝ) : Time) = 0 := by apply (AddCircle.coe_eq_zero_iff (1 : ℝ)).2 exact ⟨m, by simp⟩ /-- Integer changes of a real representative do not change its circle norm. -/ theorem coe_sub_int (x : ℝ) (m : ℤ) : ((x - m : ℝ) : Time) = (x : Time) := by rw [AddCircle.coe_sub, coe_int_zero, sub_zero] theorem distance_le_abs_sub_int (x : ℝ) (m : ℤ) : distance (x : Time) ≤ |x - m| := by simp only [distance, AddCircle.norm_eq, inv_one, one_mul, mul_one] exact round_le x m /-- A representative within half a period of an integer has the expected norm. -/ theorem distance_eq_abs_sub_int (x : ℝ) (m : ℤ) (hx : |x - m| ≤ (1 : ℝ) / 2) : distance (x : Time) = |x - m| := by rw [← coe_sub_int x m] apply (AddCircle.norm_coe_eq_abs_iff (1 : ℝ) (by norm_num)).2 simpa using hx theorem distance_nsmul_coe (n : ℕ) (x : ℝ) : distance (n • (x : Time)) = distance (((n : ℝ) * x : ℝ) : Time) := by congr 1 simpa only [nsmul_eq_mul] using (AddCircle.coe_nsmul (p := (1 : ℝ)) (n := n) (x := x)).symm theorem score_le_distance {V : Finset ℕ} {n : ℕ} (hn : n ∈ V) (t : Time) : score V t ≤ distance (n • t) := by have hV : V.Nonempty := ⟨n, hn⟩ simpa only [score, dite_eq_left hV] using Finset.inf'_le (fun n => distance (n • t)) hn theorem le_score_iff {V : Finset ℕ} (hV : V.Nonempty) {t : Time} {L : ℝ} : L ≤ score V t ↔ ∀ n ∈ V, L ≤ distance (n • t) := by simp only [score, dite_eq_left hV] exact Finset.le_inf'_iff hV (fun n => distance (n • t)) theorem score_le_ML (V : Finset ℕ) (t : Time) : score V t ≤ ML V := by have hBdd : BddAbove (Set.range (score V)) := by refine ⟨(1 : ℝ) / 2, ?_⟩ rintro y ⟨u, rfl⟩ by_cases hV : V.Nonempty · obtain ⟨n, hn⟩ := hV apply (score_le_distance hn u).trans simpa only [distance, abs_one] using AddCircle.norm_le_half_period (1 : ℝ) (by norm_num) (x := n • u) · simp only [score, dite_eq_right hV] norm_num exact le_csSup hBdd ⟨t, rfl⟩ theorem ML_le_of_scores_le (V : Finset ℕ) {L : ℝ} (h : ∀ t : Time, score V t ≤ L) : ML V ≤ L := by apply csSup_le (Set.range_nonempty _) rintro y ⟨t, rfl⟩ exact h t theorem score_neg (V : Finset ℕ) (t : Time) : score V (-t) = score V t := by by_cases hV : V.Nonempty · simp only [score, dite_eq_left hV, distance, smul_neg, norm_neg] · simp only [score, dite_eq_right hV] /-- Time symmetry reduces score estimates to a real half period. -/ theorem exists_half_representative (V : Finset ℕ) (t : Time) : ∃ x : ℝ, 0 ≤ x ∧ x ≤ 1 / 2 ∧ score V (x : Time) = score V t := by letI : Fact (0 < (1 : ℝ)) := ⟨by norm_num⟩ let r : ℝ := (AddCircle.equivIco (1 : ℝ) (-(1 / 2 : ℝ)) t).1 have hr := (AddCircle.equivIco (1 : ℝ) (-(1 / 2 : ℝ)) t).2 have he : (r : Time) = t := AddCircle.coe_equivIco have hr₁ : -(1 / 2 : ℝ) ≤ r := hr.1 have hr₂ : r < (1 / 2 : ℝ) := by linarith [hr.2] by_cases h : 0 ≤ r · exact ⟨r, h, hr₂.le, by rw [he]⟩ · refine ⟨-r, by linarith, by linarith, ?_⟩ rw [AddCircle.coe_neg, score_neg, he] def familyOne (h : ℕ) : Finset ℕ := {1, 2, 3, 4 * h} theorem familyOne_lower (h : ℕ) (hh : 0 < h) : (h : ℝ) / (4 * (h : ℝ) + 1) ≤ ML (familyOne h) := by let L : ℝ := (h : ℝ) / (4 * (h : ℝ) + 1) have hR : (1 : ℝ) ≤ h := by exact_mod_cast hh have hden : 0 < 4 * (h : ℝ) + 1 := by positivity have hL : (1 : ℝ) / 5 ≤ L := by dsimp [L]; apply (le_div_iff₀ hden).2; nlinarith have hL' : L < (1 : ℝ) / 4 := by dsimp [L]; apply (div_lt_iff₀ hden).2; nlinarith have hL0 : 0 ≤ L := by linarith have hprod : (4 * (h : ℝ)) * L = (h : ℝ) - L := by dsimp [L] field_simp ring apply le_trans _ (score_le_ML (familyOne h) (L : Time)) change L ≤ score (familyOne h) (L : Time) apply (le_score_iff (by simp [familyOne])).2 intro n hn simp only [familyOne, Finset.mem_insert, Finset.mem_singleton] at hn rcases hn with rfl | rfl | rfl | rfl · rw [distance_nsmul_coe] norm_num rw [distance_eq_abs_sub_int L 0 (by simpa using (show |L| ≤ (1 : ℝ) / 2 by rw [abs_of_nonneg hL0]; linarith))] simpa [abs_of_nonneg hL0] · rw [distance_nsmul_coe] norm_num rw [distance_eq_abs_sub_int (2 * L) 0 (by rw [Int.cast_zero, sub_zero, abs_of_nonneg (by linarith)]; linarith)] simp only [Int.cast_zero, sub_zero, abs_of_nonneg (by linarith : 0 ≤ 2 * L)] linarith · rw [distance_nsmul_coe] norm_num rw [distance_eq_abs_sub_int (3 * L) 1 (by rw [Int.cast_one, abs_of_nonpos (by linarith)]; linarith)] simp only [Int.cast_one, abs_of_nonpos (by linarith : 3 * L - 1 ≤ 0)] linarith · rw [distance_nsmul_coe] push_cast rw [hprod] rw [distance_eq_abs_sub_int ((h : ℝ) - L) (h : ℤ) (by push_cast rw [show (h : ℝ) - L - h = -L by ring, abs_neg, abs_of_nonneg hL0] linarith)] push_cast rw [show (h : ℝ) - L - h = -L by ring, abs_neg, abs_of_nonneg hL0] theorem familyOne_upper (h : ℕ) (hh : 0 < h) : ML (familyOne h) ≤ (h : ℝ) / (4 * (h : ℝ) + 1) := by let L : ℝ := (h : ℝ) / (4 * (h : ℝ) + 1) have hR : (1 : ℝ) ≤ h := by exact_mod_cast hh have hden : 0 < 4 * (h : ℝ) + 1 := by positivity have hL : (1 : ℝ) / 5 ≤ L := by dsimp [L]; apply (le_div_iff₀ hden).2; nlinarith have hL' : L < (1 : ℝ) / 4 := by dsimp [L]; apply (div_lt_iff₀ hden).2; nlinarith have hprod : (4 * (h : ℝ)) * L = (h : ℝ) - L := by dsimp [L]; field_simp; ring apply ML_le_of_scores_le intro t obtain ⟨x, hx0, hxhalf, hxt⟩ := exists_half_representative (familyOne h) t rw [← hxt] by_contra hbad have hscore : L < score (familyOne h) (x : Time) := lt_of_not_ge hbad have h₁ : L < |x| := by apply hscore.trans_le apply (score_le_distance (n := 1) (by simp [familyOne]) (x : Time)).trans simpa using distance_le_abs_sub_int x 0 have h₂ : L < |2 * x - 1| := by apply hscore.trans_le apply (score_le_distance (n := 2) (by simp [familyOne]) (x : Time)).trans rw [distance_nsmul_coe] norm_num simpa only [Int.cast_one] using distance_le_abs_sub_int (2 * x) 1 have h₃ : L < |3 * x - 1| := by apply hscore.trans_le apply (score_le_distance (n := 3) (by simp [familyOne]) (x : Time)).trans rw [distance_nsmul_coe] norm_num simpa only [Int.cast_one] using distance_le_abs_sub_int (3 * x) 1 rw [abs_of_nonneg hx0] at h₁ rw [abs_of_nonpos (by linarith : 2 * x - 1 ≤ 0)] at h₂ have hxupper : 3 * x < 1 - L := by rcases lt_or_ge (3 * x - 1) 0 with hsign | hsign · rw [abs_of_neg hsign] at h₃ linarith · rw [abs_of_nonneg hsign] at h₃ linarith have hclose₁ : -L ≤ (4 * (h : ℝ)) * x - h := by nlinarith have hclose₂ : (4 * (h : ℝ)) * x - h ≤ L := by have hLt : 4 * (h : ℝ) * (1 - L) = 3 * (h : ℝ) + L := by nlinarith [hprod] nlinarith have hlast : distance (((4 * (h : ℝ)) * x : ℝ) : Time) ≤ L := (distance_le_abs_sub_int ((4 * (h : ℝ)) * x) (h : ℤ)).trans (by push_cast exact abs_le.mpr ⟨hclose₁, hclose₂⟩) have hm := score_le_distance (V := familyOne h) (n := 4 * h) (by simp [familyOne]) (x : Time) rw [distance_nsmul_coe] at hm push_cast at hm exact (not_lt_of_ge (hm.trans hlast)) hscore theorem familyOne_ML (h : ℕ) (hh : 0 < h) : ML (familyOne h) = (h : ℝ) / (4 * (h : ℝ) + 1) := le_antisymm (familyOne_upper h hh) (familyOne_lower h hh) theorem familyOne_spectrum (h : ℕ) (hh : 0 < h) : ∃ s k : ℕ, 1 ≤ k ∧ k ≤ 4 ∧ k ≤ s ∧ ML (familyOne h) = (s : ℝ) / (4 * (s : ℝ) + k) := by refine ⟨h, 1, by omega, by omega, hh, ?_⟩ simpa only [Nat.cast_one] using familyOne_ML h hh def sporadic : Finset ℕ := {1, 3, 4, 14} theorem sporadic_lower : (4 : ℝ) / 17 ≤ ML sporadic := by apply le_trans _ (score_le_ML sporadic ((7 / 17 : ℝ) : Time)) apply (le_score_iff (by simp [sporadic])).2 intro n hn simp only [sporadic, Finset.mem_insert, Finset.mem_singleton] at hn rcases hn with rfl | rfl | rfl | rfl <;> rw [distance_nsmul_coe] <;> norm_num · rw [distance_eq_abs_sub_int (7 / 17) 0 (by norm_num)] norm_num · rw [distance_eq_abs_sub_int (21 / 17) 1 (by norm_num)] norm_num · rw [distance_eq_abs_sub_int (28 / 17) 2 (by norm_num)] norm_num · rw [distance_eq_abs_sub_int (98 / 17) 6 (by norm_num)] norm_num theorem sporadic_upper : ML sporadic ≤ (4 : ℝ) / 17 := by apply ML_le_of_scores_le intro t obtain ⟨x, hx0, hxhalf, hxt⟩ := exists_half_representative sporadic t rw [← hxt] by_contra hbad have hs : (4 : ℝ) / 17 < score sporadic (x : Time) := lt_of_not_ge hbad have hbound (n : ℕ) (hn : n ∈ sporadic) (m : ℤ) : (4 : ℝ) / 17 < |(n : ℝ) * x - m| := by apply hs.trans_le apply (score_le_distance hn (x : Time)).trans rw [distance_nsmul_coe] exact distance_le_abs_sub_int ((n : ℝ) * x) m have h₁ := hbound 1 (by simp [sporadic]) 0 have h₃ := hbound 3 (by simp [sporadic]) 1 have h₄ := hbound 4 (by simp [sporadic]) 1 have h₄' := hbound 4 (by simp [sporadic]) 2 norm_num at h₁ h₃ h₄ h₄' rw [abs_of_nonneg hx0] at h₁ have hxlower : (7 : ℝ) / 17 < x := by rcases lt_or_ge (3 * x - 1) 0 with hsign | hsign · rw [abs_of_neg hsign] at h₃ rcases lt_or_ge (4 * x - 1) 0 with hsign4 | hsign4 · rw [abs_of_neg hsign4] at h₄ linarith · rw [abs_of_nonneg hsign4] at h₄ linarith · rw [abs_of_nonneg hsign] at h₃ linarith rw [abs_of_nonpos (by linarith : 4 * x - 2 ≤ 0)] at h₄' have hxupper : x < (15 : ℝ) / 34 := by linarith have hclose : |14 * x - 6| ≤ (4 : ℝ) / 17 := by apply abs_le.mpr constructor <;> linarith have hb := hbound 14 (by simp [sporadic]) 6 norm_num at hb exact (not_lt_of_ge hclose) hb theorem sporadic_ML : ML sporadic = (4 : ℝ) / 17 := le_antisymm sporadic_upper sporadic_lower theorem sporadic_spectrum : ∃ s k : ℕ, 1 ≤ k ∧ k ≤ 4 ∧ k ≤ s ∧ ML sporadic = (s : ℝ) / (4 * (s : ℝ) + k) := by refine ⟨4, 1, by norm_num, by norm_num, by norm_num, ?_⟩ norm_num only [Nat.cast_ofNat] simpa using sporadic_ML /-- The target's spectrum conclusion for a proposed real value. -/ def SpectrumValue (x : ℝ) : Prop := (1 / 4 : ℝ) ≤ x ∨ ∃ s k : ℕ, 1 ≤ k ∧ k ≤ 4 ∧ k ≤ s ∧ x = (s : ℝ) / (4 * (s : ℝ) + k) theorem spectrum_of_gap_zero {x : ℝ} (h : 1 - 4 * x = 0) : SpectrumValue x := by exact Or.inl (by linarith) theorem spectrum_of_gap_one {x : ℝ} {D : ℕ} (hD : 5 ≤ D) (hmod : D % 4 = 1) (hx : 1 - 4 * x = 1 / (D : ℝ)) : SpectrumValue x := by let s : ℕ := D / 4 have hDeq : D = 4 * s + 1 := by dsimp [s] omega have hs : 1 ≤ s := by omega have hsR : (1 : ℝ) ≤ s := by exact_mod_cast hs have hcast : (D : ℝ) = 4 * (s : ℝ) + 1 := by exact_mod_cast hDeq apply Or.inr refine ⟨s, 1, by omega, by omega, hs, ?_⟩ norm_num only [Nat.cast_one] rw [hcast] at hx have hden : 0 < 4 * (s : ℝ) + 1 := by positivity apply (eq_div_iff hden.ne').2 have hmul := (eq_div_iff hden.ne').mp hx nlinarith theorem spectrum_of_gap_two {x : ℝ} {D : ℕ} (hD : 10 ≤ D) (hmod : D % 4 = 2) (hx : 1 - 4 * x = 2 / (D : ℝ)) : SpectrumValue x := by let s : ℕ := D / 4 have hDeq : D = 4 * s + 2 := by dsimp [s]; omega have hs : 2 ≤ s := by omega have hsR : (2 : ℝ) ≤ s := by exact_mod_cast hs have hcast : (D : ℝ) = 4 * (s : ℝ) + 2 := by exact_mod_cast hDeq apply Or.inr refine ⟨s, 2, by omega, by omega, hs, ?_⟩ rw [hcast] at hx have hden : 0 < 4 * (s : ℝ) + 2 := by positivity apply (eq_div_iff hden.ne').2 have hmul := (eq_div_iff hden.ne').mp hx norm_num only [Nat.cast_ofNat] nlinarith def min4 (a b c d : ℝ) : ℝ := min (min a b) (min c d) theorem min4_eq_second {a b c d : ℝ} (hba : b ≤ a) (hbc : b ≤ c) (hbd : b ≤ d) : min4 a b c d = b := by unfold min4 rw [min_eq_right hba, min_eq_left (le_min hbc hbd)] theorem min4_eq_third {a b c d : ℝ} (hca : c ≤ a) (hcb : c ≤ b) (hcd : c ≤ d) : min4 a b c d = c := by unfold min4 rw [min_eq_left hcd, min_eq_right (le_min hca hcb)] theorem min4_eq_fourth {a b c d : ℝ} (hda : d ≤ a) (hdb : d ≤ b) (hdc : d ≤ c) : min4 a b c d = d := by unfold min4 rw [min_eq_right hdc, min_eq_right (le_min hda hdb)] theorem min4_eq_second_fourth {a b c d : ℝ} (hba : b ≤ a) (hdc : d ≤ c) : min4 a b c d = min b d := by unfold min4 rw [min_eq_right hba, min_eq_right hdc] theorem ratio_le_ratio {a b c d : ℝ} (hc : 0 < c) (hd : 0 < d) (h : a * d ≤ b * c) : a / c ≤ b / d := (div_le_div_iff₀ hc hd).2 h /-- The two residues of the centres of the feasible triangles, represented in [0,4). -/ def residueOne (c b : ℕ) : ℕ := (2 * (b % 4) + (4 - c % 4)) % 4 def residueTwo (c b : ℕ) : ℕ := (b % 4 + (8 - 2 * (c % 4))) % 4 def familyTwoGap (c b : ℕ) : ℝ := min4 ((residueOne c b : ℝ) / (c : ℝ)) ((((4 - residueOne c b) % 4 : ℕ) : ℝ) / ((c : ℝ) + 2 * b)) ((residueTwo c b : ℝ) / (2 * (c : ℝ) + b)) ((((4 - residueTwo c b) % 4 : ℕ) : ℝ) / (2 * (c : ℝ) - b)) def familyTwo (c b : ℕ) : Finset ℕ := {c - b, b, c, c + b} theorem familyTwoGap_01 {c b : ℕ} (hb : 0 < b) (hbc : b < c) (hcmod : c % 4 = 0) (hbmod : b % 4 = 1) : familyTwoGap c b = 1 / (2 * (c : ℝ) + b) := by have hbR : (0 : ℝ) < b := by exact_mod_cast hb have hbcR : (b : ℝ) < c := by exact_mod_cast hbc have hcR : (0 : ℝ) < c := by linarith norm_num [familyTwoGap, residueOne, residueTwo, hcmod, hbmod] apply min4_eq_third <;> (try simp only [← one_div]; apply ratio_le_ratio <;> nlinarith) theorem familyTwoGap_03 {c b : ℕ} (hb : 0 < b) (hbc : b < c) (hcmod : c % 4 = 0) (hbmod : b % 4 = 3) : familyTwoGap c b = min (2 / ((c : ℝ) + 2 * b)) (1 / (2 * (c : ℝ) - b)) := by have hbR : (0 : ℝ) < b := by exact_mod_cast hb have hbcR : (b : ℝ) < c := by exact_mod_cast hbc have hcR : (0 : ℝ) < c := by linarith norm_num [familyTwoGap, residueOne, residueTwo, hcmod, hbmod] apply min4_eq_second_fourth · apply ratio_le_ratio <;> nlinarith · rw [← one_div] apply ratio_le_ratio <;> nlinarith theorem familyTwoGap_10 {c b : ℕ} (hb : 0 < b) (hbc : b < c) (hcmod : c % 4 = 1) (hbmod : b % 4 = 0) : familyTwoGap c b = 1 / ((c : ℝ) + 2 * b) := by have hbR : (0 : ℝ) < b := by exact_mod_cast hb have hbcR : (b : ℝ) < c := by exact_mod_cast hbc have hcR : (0 : ℝ) < c := by linarith norm_num [familyTwoGap, residueOne, residueTwo, hcmod, hbmod] apply min4_eq_second <;> (try simp only [← one_div]; apply ratio_le_ratio <;> nlinarith) theorem familyTwoGap_11 {c b : ℕ} (hb : 0 < b) (hbc : b < c) (hcmod : c % 4 = 1) (hbmod : b % 4 = 1) : familyTwoGap c b = 1 / (2 * (c : ℝ) - b) := by have hbR : (0 : ℝ) < b := by exact_mod_cast hb have hbcR : (b : ℝ) < c := by exact_mod_cast hbc have hcR : (0 : ℝ) < c := by linarith norm_num [familyTwoGap, residueOne, residueTwo, hcmod, hbmod] apply min4_eq_fourth <;> (try simp only [← one_div]; apply ratio_le_ratio <;> nlinarith) theorem familyTwoGap_13 {c b : ℕ} (hb : 0 < b) (hbc : b < c) (hcmod : c % 4 = 1) (hbmod : b % 4 = 3) : familyTwoGap c b = 1 / (2 * (c : ℝ) + b) := by have hbR : (0 : ℝ) < b := by exact_mod_cast hb have hbcR : (b : ℝ) < c := by exact_mod_cast hbc have hcR : (0 : ℝ) < c := by linarith norm_num [familyTwoGap, residueOne, residueTwo, hcmod, hbmod] apply min4_eq_third <;> (try simp only [← one_div]; apply ratio_le_ratio <;> nlinarith) theorem familyTwoGap_30 {c b : ℕ} (hb : 0 < b) (hbc : b < c) (hcmod : c % 4 = 3) (hbmod : b % 4 = 0) : familyTwoGap c b = 2 / (2 * (c : ℝ) + b) := by have hbR : (0 : ℝ) < b := by exact_mod_cast hb have hbcR : (b : ℝ) < c := by exact_mod_cast hbc have hcR : (0 : ℝ) < c := by linarith norm_num [familyTwoGap, residueOne, residueTwo, hcmod, hbmod] apply min4_eq_third · rw [← one_div] apply ratio_le_ratio <;> nlinarith · apply ratio_le_ratio <;> nlinarith · apply ratio_le_ratio <;> nlinarith theorem familyTwoGap_31 {c b : ℕ} (hb : 0 < b) (hbc : b < c) (hcmod : c % 4 = 3) (hbmod : b % 4 = 1) : familyTwoGap c b = min (1 / ((c : ℝ) + 2 * b)) (1 / (2 * (c : ℝ) - b)) := by have hbR : (0 : ℝ) < b := by exact_mod_cast hb have hbcR : (b : ℝ) < c := by exact_mod_cast hbc have hcR : (0 : ℝ) < c := by linarith norm_num [familyTwoGap, residueOne, residueTwo, hcmod, hbmod] apply min4_eq_second_fourth <;> (try simp only [← one_div]; apply ratio_le_ratio <;> nlinarith) theorem familyTwoGap_33 {c b : ℕ} (hb : 0 < b) (hbc : b < c) (hcmod : c % 4 = 3) (hbmod : b % 4 = 3) : familyTwoGap c b = 1 / (2 * (c : ℝ) + b) := by have hbR : (0 : ℝ) < b := by exact_mod_cast hb have hbcR : (b : ℝ) < c := by exact_mod_cast hbc have hcR : (0 : ℝ) < c := by linarith norm_num [familyTwoGap, residueOne, residueTwo, hcmod, hbmod] apply min4_eq_third <;> (try simp only [← one_div]; apply ratio_le_ratio <;> nlinarith) theorem familyTwoGap_zero_left {c b : ℕ} (hb : 0 < b) (hbc : b < c) (hcmod : c % 4 = 2) (hbmod : b % 4 = 1 ∨ b % 4 = 3) : familyTwoGap c b = 0 := by have hbR : (0 : ℝ) < b := by exact_mod_cast hb have hbcR : (b : ℝ) < c := by exact_mod_cast hbc have hcR : (0 : ℝ) < c := by linarith have hdR : 0 < 2 * (c : ℝ) - b := by linarith rcases hbmod with hbmod | hbmod <;> norm_num [familyTwoGap, residueOne, residueTwo, hcmod, hbmod] <;> apply min4_eq_second <;> positivity theorem familyTwoGap_zero_right {c b : ℕ} (hb : 0 < b) (hbc : b < c) (hcmod : c % 4 = 1 ∨ c % 4 = 3) (hbmod : b % 4 = 2) : familyTwoGap c b = 0 := by have hbR : (0 : ℝ) < b := by exact_mod_cast hb have hbcR : (b : ℝ) < c := by exact_mod_cast hbc have hcR : (0 : ℝ) < c := by linarith have hdR : 0 < 2 * (c : ℝ) - b := by linarith rcases hcmod with hcmod | hcmod <;> norm_num [familyTwoGap, residueOne, residueTwo, hcmod, hbmod] <;> apply min4_eq_fourth <;> positivity /-- Coprimality excludes the four even/even residue pairs. -/ theorem odd_residue_of_coprime {c b : ℕ} (hcop : Nat.Coprime c b) : (c % 4 = 1 ∨ c % 4 = 3) ∨ (b % 4 = 1 ∨ b % 4 = 3) := by by_contra hbad have hc : c % 2 = 0 := by have := Nat.mod_lt c (by omega : 0 < 4); omega have hb : b % 2 = 0 := by have := Nat.mod_lt b (by omega : 0 < 4); omega have hdc : 2 ∣ c := Nat.dvd_iff_mod_eq_zero.mpr hc have hdb : 2 ∣ b := Nat.dvd_iff_mod_eq_zero.mpr hb have hg : 2 ∣ Nat.gcd c b := Nat.dvd_gcd hdc hdb rw [hcop.gcd_eq_one] at hg norm_num at hg /-- Pure integer/real algebra turns the four-triangle formula into the target spectrum. -/ theorem familyTwoGap_spectrum {c b : ℕ} {x : ℝ} (hb : 0 < b) (hbc : b < c) (hcop : Nat.Coprime c b) (hx : 1 - 4 * x = familyTwoGap c b) : SpectrumValue x := by have hodd := odd_residue_of_coprime hcop have hc0 : c % 4 < 4 := Nat.mod_lt c (by omega) have hb0 : b % 4 < 4 := Nat.mod_lt b (by omega) have hdc : b ≤ 2 * c := by omega have hcast : ((2 * c - b : ℕ) : ℝ) = 2 * (c : ℝ) - b := by rw [Nat.cast_sub hdc] push_cast ring obtain hc | hc | hc | hc : c % 4 = 0 ∨ c % 4 = 1 ∨ c % 4 = 2 ∨ c % 4 = 3 := by omega · obtain hbmod | hbmod | hbmod | hbmod : b % 4 = 0 ∨ b % 4 = 1 ∨ b % 4 = 2 ∨ b % 4 = 3 := by omega · omega · rw [familyTwoGap_01 hb hbc hc hbmod] at hx apply spectrum_of_gap_one (D := 2 * c + b) (by omega) (by omega) simpa only [Nat.cast_add, Nat.cast_mul, Nat.cast_ofNat] using hx · omega · rw [familyTwoGap_03 hb hbc hc hbmod] at hx rcases le_total (2 / ((c : ℝ) + 2 * b)) (1 / (2 * (c : ℝ) - b)) with hmin | hmin · rw [min_eq_left hmin] at hx apply spectrum_of_gap_two (D := c + 2 * b) (by omega) (by omega) simpa only [Nat.cast_add, Nat.cast_mul, Nat.cast_ofNat] using hx · rw [min_eq_right hmin] at hx apply spectrum_of_gap_one (D := 2 * c - b) (by omega) (by omega) simpa only [hcast] using hx · obtain hbmod | hbmod | hbmod | hbmod : b % 4 = 0 ∨ b % 4 = 1 ∨ b % 4 = 2 ∨ b % 4 = 3 := by omega · rw [familyTwoGap_10 hb hbc hc hbmod] at hx apply spectrum_of_gap_one (D := c + 2 * b) (by omega) (by omega) simpa only [Nat.cast_add, Nat.cast_mul, Nat.cast_ofNat] using hx · rw [familyTwoGap_11 hb hbc hc hbmod] at hx apply spectrum_of_gap_one (D := 2 * c - b) (by omega) (by omega) simpa only [hcast] using hx · rw [familyTwoGap_zero_right hb hbc (Or.inl hc) hbmod] at hx exact spectrum_of_gap_zero hx · rw [familyTwoGap_13 hb hbc hc hbmod] at hx apply spectrum_of_gap_one (D := 2 * c + b) (by omega) (by omega) simpa only [Nat.cast_add, Nat.cast_mul, Nat.cast_ofNat] using hx · obtain hbmod | hbmod | hbmod | hbmod : b % 4 = 0 ∨ b % 4 = 1 ∨ b % 4 = 2 ∨ b % 4 = 3 := by omega · omega · rw [familyTwoGap_zero_left hb hbc hc (Or.inl hbmod)] at hx exact spectrum_of_gap_zero hx · omega · rw [familyTwoGap_zero_left hb hbc hc (Or.inr hbmod)] at hx exact spectrum_of_gap_zero hx · obtain hbmod | hbmod | hbmod | hbmod : b % 4 = 0 ∨ b % 4 = 1 ∨ b % 4 = 2 ∨ b % 4 = 3 := by omega · rw [familyTwoGap_30 hb hbc hc hbmod] at hx apply spectrum_of_gap_two (D := 2 * c + b) (by omega) (by omega) simpa only [Nat.cast_add, Nat.cast_mul, Nat.cast_ofNat] using hx · rw [familyTwoGap_31 hb hbc hc hbmod] at hx rcases le_total (1 / ((c : ℝ) + 2 * b)) (1 / (2 * (c : ℝ) - b)) with hmin | hmin · rw [min_eq_left hmin] at hx apply spectrum_of_gap_one (D := c + 2 * b) (by omega) (by omega) simpa only [Nat.cast_add, Nat.cast_mul, Nat.cast_ofNat] using hx · rw [min_eq_right hmin] at hx apply spectrum_of_gap_one (D := 2 * c - b) (by omega) (by omega) simpa only [hcast] using hx · rw [familyTwoGap_zero_right hb hbc (Or.inr hc) hbmod] at hx exact spectrum_of_gap_zero hx · rw [familyTwoGap_33 hb hbc hc hbmod] at hx apply spectrum_of_gap_one (D := 2 * c + b) (by omega) (by omega) simpa only [Nat.cast_add, Nat.cast_mul, Nat.cast_ofNat] using hx /-- A norm expressed on a closed unit period. -/ theorem distance_eq_min {x : ℝ} (hx0 : 0 ≤ x) (hx1 : x ≤ 1) : distance (x : Time) = min x (1 - x) := by by_cases hh : x ≤ 1 / 2 · rw [distance_eq_abs_sub_int x 0 (by simpa [abs_of_nonneg hx0] using hh)] simp only [Int.cast_zero, sub_zero, abs_of_nonneg hx0, min_eq_left (by linarith : x ≤ 1 - x)] · have hx : x - 1 ≤ 0 := by linarith rw [distance_eq_abs_sub_int x 1 (by rw [Int.cast_one, abs_of_nonpos hx]; linarith)] simp only [Int.cast_one, abs_of_nonpos hx, min_eq_right (by linarith : 1 - x ≤ x)] ring theorem distance_ge_of_interval {x δ : ℝ} (k : ℤ) (hδ : 0 ≤ δ) (hlo : δ ≤ x - k) (hhi : x - k ≤ 1 - δ) : δ ≤ distance (x : Time) := by rw [← coe_sub_int x k, distance_eq_min (by linarith) (by linarith)] apply le_min <;> linarith def pairScore (x y : ℝ) : ℝ := min4 (distance (x : Time)) (distance (y : Time)) (distance ((x - y : ℝ) : Time)) (distance ((x + y : ℝ) : Time)) def TriangleA (L x y : ℝ) : Prop := L ≤ y ∧ L ≤ x - y ∧ x + y ≤ 1 - L theorem pairScore_congr {x y x' y' : ℝ} (hx : (x : Time) = (x' : Time)) (hy : (y : Time) = (y' : Time)) : pairScore x y = pairScore x' y' := by simp only [pairScore, AddCircle.coe_sub, AddCircle.coe_add] rw [hx, hy] theorem distance_neg_real (x : ℝ) : distance ((-x : ℝ) : Time) = distance (x : Time) := by simp only [AddCircle.coe_neg, distance, norm_neg] theorem pairScore_neg_left (x y : ℝ) : pairScore (-x) y = pairScore x y := by have h₁ : distance ((-x - y : ℝ) : Time) = distance ((x + y : ℝ) : Time) := by rw [show -x - y = -(x + y) by ring, distance_neg_real] have h₂ : distance ((-x + y : ℝ) : Time) = distance ((x - y : ℝ) : Time) := by rw [show -x + y = -(x - y) by ring, distance_neg_real] unfold pairScore min4 rw [distance_neg_real, h₁, h₂, min_comm (distance ((x + y : ℝ) : Time))] theorem pairScore_swap (x y : ℝ) : pairScore y x = pairScore x y := by have h : distance ((y - x : ℝ) : Time) = distance ((x - y : ℝ) : Time) := by rw [show y - x = -(x - y) by ring, distance_neg_real] unfold pairScore min4 rw [h, add_comm y x, min_comm (distance (y : Time))] theorem pairScore_neg_right (x y : ℝ) : pairScore x (-y) = pairScore x y := by rw [pairScore_swap, pairScore_neg_left, pairScore_swap] theorem pairScore_abs (x y : ℝ) : pairScore |x| |y| = pairScore x y := by rcases le_or_gt 0 x with hx | hx <;> rcases le_or_gt 0 y with hy | hy · rw [abs_of_nonneg hx, abs_of_nonneg hy] · rw [abs_of_nonneg hx, abs_of_neg hy, pairScore_neg_right] · rw [abs_of_neg hx, abs_of_nonneg hy, pairScore_neg_left] · rw [abs_of_neg hx, abs_of_neg hy, pairScore_neg_left, pairScore_neg_right] theorem pairScore_triangle_half {L x y : ℝ} (hy0 : 0 ≤ y) (hyx : y ≤ x) (hxhalf : x ≤ 1 / 2) (h : L ≤ pairScore x y) : TriangleA L x y := by have h₁ : L ≤ distance (y : Time) := h.trans ((min_le_left _ _).trans (min_le_right _ _)) have h₂ : L ≤ distance ((x - y : ℝ) : Time) := h.trans ((min_le_right _ _).trans (min_le_left _ _)) have h₃ : L ≤ distance ((x + y : ℝ) : Time) := h.trans ((min_le_right _ _).trans (min_le_right _ _)) have h₁' := h₁.trans (distance_le_abs_sub_int y 0) have h₂' := h₂.trans (distance_le_abs_sub_int (x - y) 0) have h₃' := h₃.trans (distance_le_abs_sub_int (x + y) 1) simp only [Int.cast_zero, sub_zero, abs_of_nonneg hy0] at h₁' simp only [Int.cast_zero, sub_zero, abs_of_nonneg (sub_nonneg.mpr hyx)] at h₂' simp only [Int.cast_one, abs_of_nonpos (by linarith : x + y - 1 ≤ 0)] at h₃' exact ⟨h₁', h₂', by linarith⟩ theorem TriangleA.reflect {L x y : ℝ} (h : TriangleA L x y) : TriangleA L (1 - x) y := by obtain ⟨hy, hxy, hsum⟩ := h exact ⟨hy, by linarith, by linarith⟩ /-- The four triangles describe every feasible torus point; integer shifts are explicit. -/ theorem pairScore_triangles {L x y : ℝ} (h : L ≤ pairScore x y) : ∃ x' y' : ℝ, (x' : Time) = (x : Time) ∧ (y' : Time) = (y : Time) ∧ (TriangleA L x' y' ∨ TriangleA L y' x' ∨ TriangleA L (-x') (-y') ∨ TriangleA L (-y') (-x')) := by letI : Fact (0 < (1 : ℝ)) := ⟨by norm_num⟩ let r : ℝ := (AddCircle.equivIco (1 : ℝ) (-(1 / 2 : ℝ)) (x : Time)).1 let s : ℝ := (AddCircle.equivIco (1 : ℝ) (-(1 / 2 : ℝ)) (y : Time)).1 have hr : -(1 / 2 : ℝ) ≤ r ∧ r ≤ 1 / 2 := by have hh := (AddCircle.equivIco (1 : ℝ) (-(1 / 2 : ℝ)) (x : Time)).2 exact ⟨hh.1, by linarith [hh.2]⟩ have hs : -(1 / 2 : ℝ) ≤ s ∧ s ≤ 1 / 2 := by have hh := (AddCircle.equivIco (1 : ℝ) (-(1 / 2 : ℝ)) (y : Time)).2 exact ⟨hh.1, by linarith [hh.2]⟩ have hre : (r : Time) = (x : Time) := AddCircle.coe_equivIco have hse : (s : Time) = (y : Time) := AddCircle.coe_equivIco have hscore : L ≤ pairScore |r| |s| := by rw [pairScore_abs, pairScore_congr hre hse] exact h have hrabs : |r| ≤ (1 : ℝ) / 2 := abs_le.mpr (by constructor <;> linarith [hr.1, hr.2]) have hsabs : |s| ≤ (1 : ℝ) / 2 := abs_le.mpr (by constructor <;> linarith [hs.1, hs.2]) have hsubr : ((r - 1 : ℝ) : Time) = (x : Time) := by rw [show r - 1 = r - (1 : ℤ) by norm_num, coe_sub_int, hre] have hsubs : ((s - 1 : ℝ) : Time) = (y : Time) := by rw [show s - 1 = s - (1 : ℤ) by norm_num, coe_sub_int, hse] have haddr : ((1 + r : ℝ) : Time) = (x : Time) := by rw [add_comm, AddCircle.coe_add_period, hre] have hadds : ((1 + s : ℝ) : Time) = (y : Time) := by rw [add_comm, AddCircle.coe_add_period, hse] rcases le_total |s| |r| with hsr | hrs · have htri := pairScore_triangle_half (abs_nonneg s) hsr hrabs hscore rcases le_or_gt 0 r with hr0 | hr0 <;> rcases le_or_gt 0 s with hs0 | hs0 · refine ⟨r, s, hre, hse, Or.inl ?_⟩ simpa only [abs_of_nonneg hr0, abs_of_nonneg hs0] using htri · refine ⟨r - 1, s, hsubr, hse, Or.inr (Or.inr (Or.inl ?_))⟩ have ht := htri.reflect simp only [abs_of_nonneg hr0, abs_of_neg hs0] at ht convert ht using 1 <;> ring · refine ⟨1 + r, s, haddr, hse, Or.inl ?_⟩ have ht := htri.reflect simp only [abs_of_neg hr0, abs_of_nonneg hs0] at ht convert ht using 1 <;> ring · refine ⟨r, s, hre, hse, Or.inr (Or.inr (Or.inl ?_))⟩ simpa only [abs_of_neg hr0, abs_of_neg hs0] using htri · have hscores : L ≤ pairScore |s| |r| := by rw [pairScore_swap]; exact hscore have htri := pairScore_triangle_half (abs_nonneg r) hrs hsabs hscores rcases le_or_gt 0 r with hr0 | hr0 <;> rcases le_or_gt 0 s with hs0 | hs0 · refine ⟨r, s, hre, hse, Or.inr (Or.inl ?_ )⟩ simpa only [abs_of_nonneg hr0, abs_of_nonneg hs0] using htri · refine ⟨r, 1 + s, hre, hadds, Or.inr (Or.inl ?_)⟩ have ht := htri.reflect simp only [abs_of_nonneg hr0, abs_of_neg hs0] at ht convert ht using 1 <;> ring · refine ⟨r, s - 1, hre, hsubs, Or.inr (Or.inr (Or.inr ?_))⟩ have ht := htri.reflect simp only [abs_of_neg hr0, abs_of_nonneg hs0] at ht convert ht using 1 <;> ring · refine ⟨r, s, hre, hse, Or.inr (Or.inr (Or.inr ?_))⟩ simpa only [abs_of_neg hr0, abs_of_neg hs0] using htri theorem TriangleA.pairScore_ge {L x y : ℝ} (hL : 0 ≤ L) (h : TriangleA L x y) : L ≤ pairScore x y := by obtain ⟨hy, hxy, hsum⟩ := h have hy0 : 0 ≤ y := by linarith have hx0 : 0 ≤ x := by linarith have hx1 : x ≤ 1 := by linarith have hy1 : y ≤ 1 := by linarith have hdiff0 : 0 ≤ x - y := by linarith have hdiff1 : x - y ≤ 1 := by linarith have hsum0 : 0 ≤ x + y := by linarith have hsum1 : x + y ≤ 1 := by linarith unfold pairScore min4 rw [distance_eq_min hx0 hx1, distance_eq_min hy0 hy1, distance_eq_min hdiff0 hdiff1, distance_eq_min hsum0 hsum1] simp only [le_min_iff] constructor <;> constructor <;> constructor <;> linarith theorem TriangleA.quarter {L x y : ℝ} (h : TriangleA L x y) : L ≤ 1 / 4 := by obtain ⟨hy, hxy, hsum⟩ := h linarith theorem TriangleA.image_lower {c b L x y : ℝ} (hb : 0 < b) (hbc : b < c) (h : TriangleA L x y) : (b - c) / 2 + c * L ≤ b * x - c * y := by obtain ⟨hy, hxy, hsum⟩ := h have htop : 0 ≤ 1 / 2 - L - y := by linarith have h₁ := mul_nonneg hb.le (show 0 ≤ x - y - L by linarith) have h₂ := mul_nonneg (show 0 ≤ c - b by linarith) htop nlinarith theorem TriangleA.image_upper {c b L x y : ℝ} (hb : 0 < b) (hbc : b < c) (h : TriangleA L x y) : b * x - c * y ≤ b - (c + 2 * b) * L := by obtain ⟨hy, hxy, hsum⟩ := h have h₁ := mul_nonneg hb.le (show 0 ≤ 1 - L - x - y by linarith) have h₂ := mul_nonneg (show 0 ≤ c + b by linarith) (show 0 ≤ y - L by linarith) nlinarith theorem TriangleA.image_swap_lower {c b L x y : ℝ} (hb : 0 < b) (hbc : b < c) (h : TriangleA L x y) : -c + (2 * c + b) * L ≤ b * y - c * x := by obtain ⟨hy, hxy, hsum⟩ := h have h₁ := mul_nonneg (show 0 ≤ c by linarith) (show 0 ≤ 1 - L - x - y by linarith) have h₂ := mul_nonneg (show 0 ≤ c + b by linarith) (show 0 ≤ y - L by linarith) nlinarith theorem TriangleA.image_swap_upper {c b L x y : ℝ} (hb : 0 < b) (hbc : b < c) (h : TriangleA L x y) : b * y - c * x ≤ (b - 2 * c) * L := by obtain ⟨hy, hxy, hsum⟩ := h have h₁ := mul_nonneg (show 0 ≤ c by linarith) (show 0 ≤ x - y - L by linarith) have h₂ := mul_nonneg (show 0 ≤ c - b by linarith) (show 0 ≤ y - L by linarith) nlinarith /-- Coprimality identifies the real orbit with the kernel of the integer linear functional. -/ theorem orbit_of_integer_kernel {c b : ℕ} (hc : 0 < c) (hcop : Nat.Coprime c b) {x y : ℝ} {z : ℤ} (hz : (b : ℝ) * x - (c : ℝ) * y = z) : ∃ t : Time, c • t = (x : Time) ∧ b • t = (y : Time) := by let p : ℤ := Nat.gcdA c b let q : ℤ := Nat.gcdB c b have hbez : (c : ℤ) * p + (b : ℤ) * q = 1 := by rw [← Nat.gcd_eq_gcd_ab, hcop.gcd_eq_one] rfl have hbezR : (c : ℝ) * (p : ℝ) + (b : ℝ) * (q : ℝ) = 1 := by exact_mod_cast hbez let m : ℤ := z * q let n : ℤ := -z * p have hline : (b : ℝ) * (x - m) = (c : ℝ) * (y - n) := by dsimp [m, n] push_cast nlinarith [congrArg (fun w : ℝ => (z : ℝ) * w) hbezR] have hcR : (0 : ℝ) < c := by exact_mod_cast hc let tR : ℝ := (x - m) / (c : ℝ) refine ⟨(tR : Time), ?_, ?_⟩ · rw [← AddCircle.coe_nsmul] simp only [nsmul_eq_mul] change (((c : ℝ) * ((x - m) / c) : ℝ) : Time) = (x : Time) rw [mul_div_cancel₀ _ hcR.ne', coe_sub_int] · rw [← AddCircle.coe_nsmul] simp only [nsmul_eq_mul] have ht : (b : ℝ) * tR = y - n := by dsimp [tR] rw [← mul_div_assoc] apply (div_eq_iff hcR.ne').2 nlinarith [hline] rw [ht, coe_sub_int] theorem integer_kernel_of_orbit {c b : ℕ} {x y : ℝ} {t : Time} (hx : (x : Time) = c • t) (hy : (y : Time) = b • t) : ∃ z : ℤ, (b : ℝ) * x - (c : ℝ) * y = z := by have hz : (((b : ℝ) * x - (c : ℝ) * y : ℝ) : Time) = 0 := by rw [AddCircle.coe_sub] have hb : (((b : ℝ) * x : ℝ) : Time) = b • (x : Time) := by simpa only [nsmul_eq_mul] using (AddCircle.coe_nsmul (p := (1 : ℝ)) (n := b) (x := x)) have hc : (((c : ℝ) * y : ℝ) : Time) = c • (y : Time) := by simpa only [nsmul_eq_mul] using (AddCircle.coe_nsmul (p := (1 : ℝ)) (n := c) (x := y)) rw [hb, hc, hx, hy, smul_comm, sub_self] obtain ⟨z, hz'⟩ := (AddCircle.coe_eq_zero_iff (1 : ℝ)).1 hz refine ⟨z, ?_⟩ simpa only [zsmul_eq_mul, mul_one] using hz'.symm theorem TriangleA.exists_image {c b L z : ℝ} (hb : 0 < b) (hbc : b < c) (hL : L ≤ 1 / 4) (hlo : (b - c) / 2 + c * L ≤ z) (hhi : z ≤ b - (c + 2 * b) * L) : ∃ x y : ℝ, TriangleA L x y ∧ b * x - c * y = z := by by_cases heq : L = 1 / 4 · refine ⟨1 / 2, 1 / 4, ?_, ?_⟩ · simp only [TriangleA, heq] norm_num · rw [heq] at hlo hhi linarith · let lo : ℝ := (b - c) / 2 + c * L let hi : ℝ := b - (c + 2 * b) * L have hLlt : L < 1 / 4 := lt_of_le_of_ne hL heq have hwidth : 0 < hi - lo := by have hp : 0 < (c + b) * (1 / 4 - L) := mul_pos (by linarith) (by linarith) dsimp [hi, lo] nlinarith let a : ℝ := (z - lo) / (hi - lo) have ha0 : 0 ≤ a := by dsimp [a]; apply div_nonneg _ hwidth.le; dsimp [lo]; linarith have ha1 : a ≤ 1 := by dsimp [a]; apply (div_le_one hwidth).2; dsimp [hi, lo]; linarith let x : ℝ := (1 - a) * (1 / 2) + a * (1 - 2 * L) let y : ℝ := (1 - a) * (1 / 2 - L) + a * L refine ⟨x, y, ?_, ?_⟩ · dsimp [TriangleA, x, y] have h₁ := mul_nonneg (show 0 ≤ 1 - a by linarith) (show 0 ≤ 1 / 2 - 2 * L by linarith) have h₂ := mul_nonneg ha0 (show 0 ≤ 1 - 4 * L by linarith) constructor · nlinarith constructor <;> nlinarith · have ha : (hi - lo) * a = z - lo := by dsimp [a]; rw [mul_div_cancel₀ _ hwidth.ne'] dsimp [x, y, hi, lo] at * nlinarith theorem TriangleA.exists_swap_image {c b L z : ℝ} (hb : 0 < b) (hbc : b < c) (hL : L ≤ 1 / 4) (hlo : -c + (2 * c + b) * L ≤ z) (hhi : z ≤ (b - 2 * c) * L) : ∃ x y : ℝ, TriangleA L x y ∧ b * y - c * x = z := by by_cases heq : L = 1 / 4 · refine ⟨1 / 2, 1 / 4, ?_, ?_⟩ · simp only [TriangleA, heq] norm_num · rw [heq] at hlo hhi linarith · let lo : ℝ := -c + (2 * c + b) * L let hi : ℝ := (b - 2 * c) * L have hLlt : L < 1 / 4 := lt_of_le_of_ne hL heq have hwidth : 0 < hi - lo := by have hp : 0 < c * (1 / 4 - L) := mul_pos (by linarith) (by linarith) dsimp [hi, lo] nlinarith let a : ℝ := (z - lo) / (hi - lo) have ha0 : 0 ≤ a := by dsimp [a]; apply div_nonneg _ hwidth.le; dsimp [lo]; linarith have ha1 : a ≤ 1 := by dsimp [a]; apply (div_le_one hwidth).2; dsimp [hi, lo]; linarith let x : ℝ := (1 - a) * (1 - 2 * L) + a * (2 * L) refine ⟨x, L, ?_, ?_⟩ · dsimp [TriangleA, x] have h₁ := mul_nonneg (show 0 ≤ 1 - a by linarith) (show 0 ≤ 1 - 4 * L by linarith) have h₂ := mul_nonneg ha0 (show 0 ≤ 1 - 4 * L by linarith) exact ⟨le_rfl, by nlinarith, by nlinarith⟩ · have ha : (hi - lo) * a = z - lo := by dsimp [a]; rw [mul_div_cancel₀ _ hwidth.ne'] dsimp [x, hi, lo] at * nlinarith /-- Exact integer intersection of an interval centred at a quarter-integer. -/ theorem quarter_integer_interval {A B e : ℝ} {r : ℕ} (n : ℤ) (hA : 0 < A) (hB : 0 < B) (he : 0 ≤ e) (hr : r < 4) : (∃ z : ℤ, (n : ℝ) + (r : ℝ) / 4 - A * e ≤ z ∧ (z : ℝ) ≤ (n : ℝ) + (r : ℝ) / 4 + B * e) ↔ min ((r : ℝ) / A) ((((4 - r) % 4 : ℕ) : ℝ) / B) ≤ 4 * e := by have hAe : 0 ≤ A * e := mul_nonneg hA.le he have hBe : 0 ≤ B * e := mul_nonneg hB.le he by_cases hr0 : r = 0 · subst r norm_num refine ⟨fun _ => by linarith, fun _ => ?_⟩ exact ⟨n, by norm_num; linarith, by norm_num; linarith⟩ · have hrpos : 0 < r := Nat.pos_of_ne_zero hr0 have hrem : (4 - r) % 4 = 4 - r := Nat.mod_eq_of_lt (by omega) have hcast : ((4 - r : ℕ) : ℝ) = 4 - (r : ℝ) := by rw [Nat.cast_sub (by omega)]; norm_num have hrR : (0 : ℝ) < r := by exact_mod_cast hrpos have hrR' : (r : ℝ) < 4 := by exact_mod_cast hr rw [hrem, hcast, min_le_iff] constructor · rintro ⟨z, hlo, hhi⟩ rcases le_or_gt z n with hzn | hzn · apply Or.inl apply (div_le_iff₀ hA).2 have hznR : (z : ℝ) ≤ n := by exact_mod_cast hzn nlinarith · apply Or.inr apply (div_le_iff₀ hB).2 have hnz : n + 1 ≤ z := by omega have hnzR : (n : ℝ) + 1 ≤ z := by exact_mod_cast hnz nlinarith · intro h rcases h with hleft | hright · have heA := (div_le_iff₀ hA).1 hleft exact ⟨n, by nlinarith, by nlinarith⟩ · have heB := (div_le_iff₀ hB).1 hright refine ⟨n + 1, ?_, ?_⟩ <;> push_cast <;> nlinarith theorem familyTwo_score_of_orbit {c b : ℕ} (hbc : b ≤ c) {t : Time} {x y : ℝ} (hx : c • t = (x : Time)) (hy : b • t = (y : Time)) : score (familyTwo c b) t = pairScore x y := by have hsub : (c - b) • t = c • t - b • t := by rw [eq_sub_iff_add_eq, ← add_nsmul, Nat.sub_add_cancel hbc] have hsum : (c + b) • t = c • t + b • t := add_nsmul t c b apply eq_of_forall_le_iff intro L rw [le_score_iff (by simp [familyTwo])] simp only [familyTwo, Finset.mem_insert, Finset.mem_singleton, forall_eq_or_imp, forall_eq] simp only [pairScore, min4, le_min_iff, AddCircle.coe_sub, AddCircle.coe_add, hsub, hsum, hx, hy] tauto theorem familyTwo_score_real {c b : ℕ} (hbc : b ≤ c) (t : ℝ) : score (familyTwo c b) (t : Time) = pairScore ((c : ℝ) * t) ((b : ℝ) * t) := by apply familyTwo_score_of_orbit hbc · simpa only [nsmul_eq_mul] using (AddCircle.coe_nsmul (p := (1 : ℝ)) (n := c) (x := t)).symm · simpa only [nsmul_eq_mul] using (AddCircle.coe_nsmul (p := (1 : ℝ)) (n := b) (x := t)).symm theorem centerOne_decomposition (c b : ℕ) : (2 * (b : ℝ) - c) / 4 = (((2 * (b : ℤ) - c) / 4 : ℤ) : ℝ) + (residueOne c b : ℝ) / 4 := by have hr : 2 * (b : ℤ) - c = 4 * ((2 * (b : ℤ) - c) / 4) + (residueOne c b : ℕ) := by unfold residueOne have hc := Nat.mod_lt c (by omega : 0 < 4) have hb := Nat.mod_lt b (by omega : 0 < 4) omega have hrR : 2 * (b : ℝ) - c = 4 * (((2 * (b : ℤ) - c) / 4 : ℤ) : ℝ) + (residueOne c b : ℝ) := by exact_mod_cast hr linarith theorem centerTwo_decomposition (c b : ℕ) : ((b : ℝ) - 2 * c) / 4 = ((((b : ℤ) - 2 * c) / 4 : ℤ) : ℝ) + (residueTwo c b : ℝ) / 4 := by have hr : (b : ℤ) - 2 * c = 4 * (((b : ℤ) - 2 * c) / 4) + (residueTwo c b : ℕ) := by unfold residueTwo have hc := Nat.mod_lt c (by omega : 0 < 4) have hb := Nat.mod_lt b (by omega : 0 < 4) omega have hrR : (b : ℝ) - 2 * c = 4 * ((((b : ℤ) - 2 * c) / 4 : ℤ) : ℝ) + (residueTwo c b : ℝ) := by exact_mod_cast hr linarith theorem familyTwo_gap_intervals {c b : ℕ} (hb : 0 < b) (hbc : b < c) {L : ℝ} (hL : L ≤ 1 / 4) : familyTwoGap c b ≤ 1 - 4 * L ↔ (∃ z : ℤ, ((b : ℝ) - c) / 2 + c * L ≤ z ∧ (z : ℝ) ≤ b - ((c : ℝ) + 2 * b) * L) ∨ (∃ z : ℤ, -(c : ℝ) + (2 * c + b) * L ≤ z ∧ (z : ℝ) ≤ ((b : ℝ) - 2 * c) * L) := by have hbR : (0 : ℝ) < b := by exact_mod_cast hb have hbcR : (b : ℝ) < c := by exact_mod_cast hbc have hcR : (0 : ℝ) < c := by linarith have he : 0 ≤ 1 / 4 - L := by linarith have hA := quarter_integer_interval (A := (c : ℝ)) (B := (c : ℝ) + 2 * b) (e := 1 / 4 - L) (r := residueOne c b) ((2 * (b : ℤ) - c) / 4) hcR (by positivity) he (Nat.mod_lt _ (by omega)) have hB := quarter_integer_interval (A := 2 * (c : ℝ) + b) (B := 2 * (c : ℝ) - b) (e := 1 / 4 - L) (r := residueTwo c b) (((b : ℤ) - 2 * c) / 4) (by positivity) (by linarith) he (Nat.mod_lt _ (by omega)) rw [← centerOne_decomposition] at hA rw [← centerTwo_decomposition] at hB have hA' : (∃ z : ℤ, ((b : ℝ) - c) / 2 + c * L ≤ z ∧ (z : ℝ) ≤ b - ((c : ℝ) + 2 * b) * L) ↔ min ((residueOne c b : ℝ) / c) ((((4 - residueOne c b) % 4 : ℕ) : ℝ) / ((c : ℝ) + 2 * b)) ≤ 1 - 4 * L := by convert hA using 1 <;> ring have hB' : (∃ z : ℤ, -(c : ℝ) + (2 * c + b) * L ≤ z ∧ (z : ℝ) ≤ ((b : ℝ) - 2 * c) * L) ↔ min ((residueTwo c b : ℝ) / (2 * (c : ℝ) + b)) ((((4 - residueTwo c b) % 4 : ℕ) : ℝ) / (2 * (c : ℝ) - b)) ≤ 1 - 4 * L := by convert hB using 1 <;> ring unfold familyTwoGap min4 rw [min_le_iff, ← hA', ← hB'] theorem familyTwoGap_nonneg {c b : ℕ} (hb : 0 < b) (hbc : b < c) : 0 ≤ familyTwoGap c b := by have hbR : (0 : ℝ) < b := by exact_mod_cast hb have hbcR : (b : ℝ) < c := by exact_mod_cast hbc have hcR : (0 : ℝ) < c := by linarith have hdR : 0 < 2 * (c : ℝ) - b := by linarith unfold familyTwoGap min4 simp only [le_min_iff] constructor <;> constructor <;> positivity theorem familyTwoGap_le_one {c b : ℕ} (hb : 0 < b) (hbc : b < c) : familyTwoGap c b ≤ 1 := by have hc : 2 ≤ c := by omega rcases eq_or_lt_of_le hc with hc2 | hc3 · have hc' : c = 2 := hc2.symm have hb' : b = 1 := by omega rw [hc', hb', familyTwoGap_zero_left (by omega) (by omega) (by omega) (Or.inl (by omega))] norm_num · have hcR : (0 : ℝ) < c := by exact_mod_cast (show 0 < c by omega) have hr : residueOne c b < 4 := Nat.mod_lt _ (by omega) have hrc : residueOne c b ≤ c := by omega apply (min_le_left _ _).trans ((min_le_left _ _).trans ?_) apply (div_le_one hcR).2 exact_mod_cast hrc theorem familyTwo_upper {c b : ℕ} (hb : 0 < b) (hbc : b < c) : ML (familyTwo c b) ≤ (1 - familyTwoGap c b) / 4 := by have hbR : (0 : ℝ) < b := by exact_mod_cast hb have hbcR : (b : ℝ) < c := by exact_mod_cast hbc apply ML_le_of_scores_le intro t obtain ⟨r, hr0, hrhalf, hrt⟩ := exists_half_representative (familyTwo c b) t rw [← hrt, familyTwo_score_real hbc.le] let L : ℝ := pairScore ((c : ℝ) * r) ((b : ℝ) * r) obtain ⟨x, y, hx, hy, htri⟩ := pairScore_triangles (L := L) (x := (c : ℝ) * r) (y := (b : ℝ) * r) (by exact le_rfl) have hx' : (x : Time) = c • (r : Time) := by rw [hx] simpa only [nsmul_eq_mul] using AddCircle.coe_nsmul (p := (1 : ℝ)) (n := c) (x := r) have hy' : (y : Time) = b • (r : Time) := by rw [hy] simpa only [nsmul_eq_mul] using AddCircle.coe_nsmul (p := (1 : ℝ)) (n := b) (x := r) obtain ⟨z, hz⟩ := integer_kernel_of_orbit hx' hy' have hzneg : (b : ℝ) * (-x) - (c : ℝ) * (-y) = -(z : ℝ) := by nlinarith [hz] rcases htri with htri | htri | htri | htri · have hgap := (familyTwo_gap_intervals hb hbc (TriangleA.quarter htri)).2 (Or.inl (by refine ⟨z, ?_, ?_⟩ · have hh := TriangleA.image_lower hbR hbcR htri simpa only [hz] using hh · have hh := TriangleA.image_upper hbR hbcR htri simpa only [hz] using hh)) change L ≤ (1 - familyTwoGap c b) / 4 linarith · have hgap := (familyTwo_gap_intervals hb hbc (TriangleA.quarter htri)).2 (Or.inr (by refine ⟨z, ?_, ?_⟩ · have hh := TriangleA.image_swap_lower hbR hbcR htri simpa only [hz] using hh · have hh := TriangleA.image_swap_upper hbR hbcR htri simpa only [hz] using hh)) change L ≤ (1 - familyTwoGap c b) / 4 linarith · have hgap := (familyTwo_gap_intervals hb hbc (TriangleA.quarter htri)).2 (Or.inl (by refine ⟨-z, ?_, ?_⟩ · have hh := TriangleA.image_lower hbR hbcR htri simpa only [hzneg, Int.cast_neg] using hh · have hh := TriangleA.image_upper hbR hbcR htri simpa only [hzneg, Int.cast_neg] using hh)) change L ≤ (1 - familyTwoGap c b) / 4 linarith · have hgap := (familyTwo_gap_intervals hb hbc (TriangleA.quarter htri)).2 (Or.inr (by refine ⟨-z, ?_, ?_⟩ · have hh := TriangleA.image_swap_lower hbR hbcR htri simpa only [hzneg, Int.cast_neg] using hh · have hh := TriangleA.image_swap_upper hbR hbcR htri simpa only [hzneg, Int.cast_neg] using hh)) change L ≤ (1 - familyTwoGap c b) / 4 linarith theorem familyTwo_lower {c b : ℕ} (hb : 0 < b) (hbc : b < c) (hcop : Nat.Coprime c b) : (1 - familyTwoGap c b) / 4 ≤ ML (familyTwo c b) := by have hbR : (0 : ℝ) < b := by exact_mod_cast hb have hbcR : (b : ℝ) < c := by exact_mod_cast hbc let L : ℝ := (1 - familyTwoGap c b) / 4 have hL0 : 0 ≤ L := by dsimp [L]; linarith [familyTwoGap_le_one hb hbc] have hLq : L ≤ 1 / 4 := by dsimp [L]; linarith [familyTwoGap_nonneg hb hbc] have hgap : familyTwoGap c b ≤ 1 - 4 * L := by dsimp [L]; linarith have hi := (familyTwo_gap_intervals hb hbc hLq).1 hgap rcases hi with ⟨z, hzlo, hzhi⟩ | ⟨z, hzlo, hzhi⟩ · obtain ⟨x, y, htri, hxy⟩ := TriangleA.exists_image hbR hbcR hLq hzlo hzhi obtain ⟨t, hx, hy⟩ := orbit_of_integer_kernel (by omega : 0 < c) hcop hxy apply le_trans _ (score_le_ML (familyTwo c b) t) rw [familyTwo_score_of_orbit hbc.le hx hy] exact TriangleA.pairScore_ge hL0 htri · obtain ⟨x, y, htri, hxy⟩ := TriangleA.exists_swap_image hbR hbcR hLq hzlo hzhi obtain ⟨t, hy, hx⟩ := orbit_of_integer_kernel (by omega : 0 < c) hcop hxy apply le_trans _ (score_le_ML (familyTwo c b) t) rw [familyTwo_score_of_orbit hbc.le hy hx, pairScore_swap] exact TriangleA.pairScore_ge hL0 htri theorem familyTwo_ML {c b : ℕ} (hb : 0 < b) (hbc : b < c) (hcop : Nat.Coprime c b) : ML (familyTwo c b) = (1 - familyTwoGap c b) / 4 := le_antisymm (familyTwo_upper hb hbc) (familyTwo_lower hb hbc hcop) theorem familyTwo_gap_formula {c b : ℕ} (hb : 0 < b) (hbc : b < c) (hcop : Nat.Coprime c b) : 1 - 4 * ML (familyTwo c b) = familyTwoGap c b := by rw [familyTwo_ML hb hbc hcop] ring theorem familyTwo_spectrum {c b : ℕ} (hb : 0 < b) (hbc : b < c) (hcop : Nat.Coprime c b) : SpectrumValue (ML (familyTwo c b)) := familyTwoGap_spectrum hb hbc hcop (familyTwo_gap_formula hb hbc hcop) /-- Exact rational-time scores use only natural-number residues. -/ theorem distance_rational_time (v m q : ℕ) : distance (v • (((m : ℝ) / q : ℝ) : Time)) = ((min ((v * m) % q) (q - (v * m) % q) : ℕ) : ℝ) / q := by letI : Fact (0 < (1 : ℝ)) := ⟨by norm_num⟩ rw [distance_nsmul_coe] have he : (v : ℝ) * ((m : ℝ) / q) = ((v * m : ℕ) : ℝ) / q := by push_cast; ring rw [he] simpa only [distance, mul_one, one_mul] using (AddCircle.norm_div_natCast (p := (1 : ℝ)) (m := v * m) (n := q)) end Bounty.Families end namespace Math15.Source05.ThreeSpeed def Good (δ t : ℝ) (v : ℤ) : Prop := ∃ k : ℤ, δ ≤ t * (v : ℝ) - (k : ℝ) ∧ t * (v : ℝ) - (k : ℝ) ≤ 1 - δ lemma good_mono {δ ε t : ℝ} {v : ℤ} (hδε : δ ≤ ε) (h : Good ε t v) : Good δ t v := by obtain ⟨k, hk₀, hk₁⟩ := h exact ⟨k, by linarith, by linarith⟩ lemma good_neg_speed {δ t : ℝ} {v : ℤ} : Good δ t (-v) ↔ Good δ t v := by constructor · rintro ⟨k, hk₀, hk₁⟩ refine ⟨-k - 1, ?_, ?_⟩ <;> push_cast at * <;> nlinarith · rintro ⟨k, hk₀, hk₁⟩ refine ⟨-k - 1, ?_, ?_⟩ <;> push_cast at * <;> nlinarith lemma good_integer_shift {δ t : ℝ} {v q : ℤ} (h : Good δ t v) : Good δ (t + (q : ℝ)) v := by obtain ⟨k, hk₀, hk₁⟩ := h refine ⟨k + q * v, ?_, ?_⟩ <;> push_cast <;> nlinarith lemma good_divisor_shift {δ t : ℝ} {v q g : ℤ} (hg : g ≠ 0) (hd : g ∣ v) (h : Good δ t v) : Good δ (t + (q : ℝ) / (g : ℝ)) v := by obtain ⟨w, rfl⟩ := hd obtain ⟨k, hk₀, hk₁⟩ := h refine ⟨k + q * w, ?_, ?_⟩ all_goals have hg' : (g : ℝ) ≠ 0 := by exact_mod_cast hg have heq : (t + (q : ℝ) / (g : ℝ)) * ((g * w : ℤ) : ℝ) - ((k + q * w : ℤ) : ℝ) = t * ((g * w : ℤ) : ℝ) - (k : ℝ) := by push_cast field_simp ring rw [heq] assumption lemma residue_fraction {x N : ℤ} (hN : N ≠ 0) : (x : ℝ) / (N : ℝ) - ((x / N : ℤ) : ℝ) = ((x % N : ℤ) : ℝ) / (N : ℝ) := by have hN' : (N : ℝ) ≠ 0 := by exact_mod_cast hN have h := Int.emod_add_ediv_mul x N have h' : ((x % N : ℤ) : ℝ) + ((x / N : ℤ) : ℝ) * (N : ℝ) = (x : ℝ) := by exact_mod_cast h apply (eq_div_iff hN').2 field_simp nlinarith lemma good_of_residue {m v r N : ℤ} (hN : 0 < N) (hlo : r ≤ (m * v) % N) (hhi : (m * v) % N ≤ N - r) : Good ((r : ℝ) / (N : ℝ)) ((m : ℝ) / (N : ℝ)) v := by have hN' : 0 < (N : ℝ) := by exact_mod_cast hN have heq : (m : ℝ) / (N : ℝ) * (v : ℝ) - (((m * v) / N : ℤ) : ℝ) = (((m * v) % N : ℤ) : ℝ) / (N : ℝ) := by rw [div_mul_eq_mul_div, ← Int.cast_mul] exact residue_fraction hN.ne' refine ⟨(m * v) / N, ?_, ?_⟩ · rw [heq] apply (div_le_div_iff_of_pos_right hN').2 exact_mod_cast hlo · rw [heq] have hh : (((m * v) % N : ℤ) : ℝ) ≤ (N : ℝ) - (r : ℝ) := by exact_mod_cast hhi apply (div_le_iff₀ hN').2 field_simp nlinarith lemma bezout_inverse {b N : ℤ} (hg : Int.gcd b N = 1) : b * Int.gcdA b N + N * Int.gcdB b N = 1 := by simpa [hg] using (Int.gcd_eq_gcd_ab b N).symm lemma good_scaled_time {δ t : ℝ} {d v : ℤ} (hd : d ≠ 0) (h : Good δ t v) : Good δ (t / (d : ℝ)) (d * v) := by obtain ⟨k, hk₀, hk₁⟩ := h have hd' : (d : ℝ) ≠ 0 := by exact_mod_cast hd have heq : t / (d : ℝ) * ((d * v : ℤ) : ℝ) - (k : ℝ) = t * (v : ℝ) - (k : ℝ) := by push_cast field_simp exact ⟨k, by rw [heq]; exact hk₀, by rw [heq]; exact hk₁⟩ end Math15.Source05.ThreeSpeed namespace Bounty.Finite open Finset Set Math15.LonelyRunner /-- The exact integer test for a quarter-lonely runner at a rational time. -/ def quarterGood (p q v : ℕ) : Bool := decide (q ≤ 4 * min ((p * v) % q) (q - (p * v) % q)) theorem rational_distance (p q v : ℕ) : distance (v • (((p : ℝ) / q : ℝ) : Time)) = (min ((p * v) % q) (q - (p * v) % q) : ℕ) / (q : ℝ) := by let : Fact (0 < (1 : ℝ)) := ⟨by norm_num⟩ have hc : v • (((p : ℝ) / q : ℝ) : Time) = ((((p * v : ℕ) : ℝ) / q : ℝ) : Time) := by rw [← AddCircle.coe_nsmul] congr 1 simp only [nsmul_eq_mul, Nat.cast_mul] ring rw [hc] simpa only [distance, mul_one, one_mul] using (AddCircle.norm_div_natCast (p := (1 : ℝ)) (m := p * v) (n := q)) theorem quarterGood_sound {p q v : ℕ} (hq : 0 < q) (h : quarterGood p q v = true) : (1 / 4 : ℝ) ≤ distance (v • (((p : ℝ) / q : ℝ) : Time)) := by have hh : q ≤ 4 * min ((p * v) % q) (q - (p * v) % q) := by simpa only [quarterGood, decide_eq_true_eq] using h have hhr : (q : ℝ) ≤ 4 * (min ((p * v) % q) (q - (p * v) % q) : ℕ) := by exact_mod_cast hh have hqr : (0 : ℝ) < q := by exact_mod_cast hq rw [rational_distance] apply (le_div_iff₀ hqr).2 linarith theorem score_le_ML (V : Finset ℕ) (t : Time) : score V t ≤ ML V := by have hB : BddAbove (Set.range (score V)) := by refine ⟨(1 : ℝ) / 2, ?_⟩ rintro x ⟨s, rfl⟩ by_cases hV : V.Nonempty · obtain ⟨n, hn⟩ := hV have hV : V.Nonempty := ⟨n, hn⟩ have hsc : score V s ≤ distance (n • s) := by simpa only [score, dite_eq_left hV] using Finset.inf'_le (fun n => distance (n • s)) hn exact hsc.trans (by simpa only [distance, abs_one] using AddCircle.norm_le_half_period (1 : ℝ) (by norm_num) (x := n • s)) · simp [score, hV] exact le_csSup hB ⟨t, rfl⟩ /-- Soundness is independent of how the rational witness was found. -/ theorem quarter_witness {V : Finset ℕ} (hV : V.Nonempty) {p q : ℕ} (hq : 0 < q) (h : ∀ v ∈ V, quarterGood p q v = true) : (1 / 4 : ℝ) ≤ ML V := by apply (le_trans ?_ (score_le_ML V (((p : ℝ) / q : ℝ) : Time))) simp only [score, dite_eq_left hV] apply Finset.le_inf' hV intro v hv exact quarterGood_sound hq (h v hv) end Bounty.Finite namespace Bounty.Pure05 open Finset Set Math15.LonelyRunner Math15.Source05.ThreeSpeed abbrev Quarter (t : ℝ) (v : ℕ) : Prop := Good (1 / 4) t (v : ℤ) def NoQuarter (a b c d : ℕ) : Prop := ∀ t : ℝ, ¬ (Quarter t a ∧ Quarter t b ∧ Quarter t c ∧ Quarter t d) def PairwiseGcdTwo (a b c d : ℕ) : Prop := Nat.gcd a b ≤ 2 ∧ Nat.gcd a c ≤ 2 ∧ Nat.gcd a d ≤ 2 ∧ Nat.gcd b c ≤ 2 ∧ Nat.gcd b d ≤ 2 ∧ Nat.gcd c d ≤ 2 def Classified (V : Finset ℕ) : Prop := (∃ h : ℕ, 0 < h ∧ V = Bounty.Families.familyOne h) ∨ (∃ c b : ℕ, 0 < b ∧ b < c ∧ Nat.Coprime c b ∧ V = Bounty.Families.familyTwo c b) ∨ V = Bounty.Families.sporadic end Bounty.Pure05 /- Component: Quarter. -/ namespace Bounty.Pure05 open Finset Set Math15.LonelyRunner Math15.Source05.ThreeSpeed /-- One of a real time and its half-period shift is good for an odd speed. -/ theorem good_odd_quarter_choice (t : ℝ) (v : ℤ) (hv : v % 2 = 1) : Good (1 / 4) t v ∨ Good (1 / 4) (t + 1 / 2) v := by let k : ℤ := ⌊t * (v : ℝ)⌋ have hk0 : (k : ℝ) ≤ t * (v : ℝ) := Int.floor_le _ have hk1 : t * (v : ℝ) < (k : ℝ) + 1 := Int.lt_floor_add_one _ by_cases hlo : (1 / 4 : ℝ) ≤ t * (v : ℝ) - k · by_cases hhi : t * (v : ℝ) - k ≤ (3 / 4 : ℝ) · exact Or.inl ⟨k, hlo, by linarith⟩ · right have hvi : v = 2 * (v / 2) + 1 := by omega have hvr : (v : ℝ) = 2 * ((v / 2 : ℤ) : ℝ) + 1 := by exact_mod_cast hvi refine ⟨k + v / 2 + 1, ?_, ?_⟩ · push_cast nlinarith only [hvr, hhi] · push_cast nlinarith only [hvr, hk1] · right have hvi : v = 2 * (v / 2) + 1 := by omega have hvr : (v : ℝ) = 2 * ((v / 2 : ℤ) : ℝ) + 1 := by exact_mod_cast hvi refine ⟨k + v / 2, ?_, ?_⟩ · push_cast nlinarith only [hvr, hk0] · push_cast nlinarith only [hvr, hlo] theorem quarter_odd_choice (t : ℝ) (v : ℕ) (hv : v % 2 = 1) : Quarter t v ∨ Quarter (t + 1 / 2) v := by exact good_odd_quarter_choice t (v : ℤ) (by exact_mod_cast hv) theorem quarter_even_shift {t : ℝ} {v : ℕ} (hv : 2 ∣ v) (h : Quarter t v) : Quarter (t + 1 / 2) v := by simpa only [Int.cast_one, Int.cast_ofNat] using (good_divisor_shift (g := 2) (q := 1) (by norm_num) (by exact_mod_cast hv) h) theorem quarter_iff_distance {t : ℝ} {v : ℕ} : Quarter t v ↔ (1 / 4 : ℝ) ≤ distance (v • (t : Time)) := by constructor · rintro ⟨k, hlo, hhi⟩ rw [Bounty.Families.distance_nsmul_coe] apply Bounty.Families.distance_ge_of_interval k (by norm_num) · simpa only [Int.cast_natCast, mul_comm] using hlo · simpa only [Int.cast_natCast, mul_comm] using hhi · intro h let k : ℤ := ⌊t * (v : ℝ)⌋ have hk0 : (k : ℝ) ≤ t * (v : ℝ) := Int.floor_le _ have hk1 : t * (v : ℝ) < (k : ℝ) + 1 := Int.lt_floor_add_one _ rw [Bounty.Families.distance_nsmul_coe, mul_comm] at h rw [← Bounty.Families.coe_sub_int (t * (v : ℝ)) k] at h rw [Bounty.Families.distance_eq_min (by linarith : 0 ≤ t * (v : ℝ) - k) (by linarith : t * (v : ℝ) - k ≤ 1)] at h refine ⟨k, ?_, ?_⟩ · simpa only [Int.cast_natCast] using (le_min_iff.mp h).1 · have hh := (le_min_iff.mp h).2 simp only [Int.cast_natCast] linarith theorem noQuarter_of_ML_lt {a b c d : ℕ} (hbad : ML ({a,b,c,d} : Finset ℕ) < (1 / 4 : ℝ)) : NoQuarter a b c d := by intro t ht have hg : (1 / 4 : ℝ) ≤ score ({a,b,c,d} : Finset ℕ) (t : Time) := by apply (Bounty.Families.le_score_iff (by simp)).2 intro v hv simp only [Finset.mem_insert, Finset.mem_singleton] at hv rcases hv with rfl | rfl | rfl | rfl · exact quarter_iff_distance.mp ht.1 · exact quarter_iff_distance.mp ht.2.1 · exact quarter_iff_distance.mp ht.2.2.1 · exact quarter_iff_distance.mp ht.2.2.2 exact (not_le_of_gt hbad) (hg.trans (Bounty.Families.score_le_ML _ _)) theorem classified_spectrum {V : Finset ℕ} (h : Classified V) : Bounty.Families.SpectrumValue (ML V) := by rcases h with ⟨h, hh, rfl⟩ | ⟨c, b, hb, hbc, hcop, rfl⟩ | rfl · exact Or.inr (Bounty.Families.familyOne_spectrum h hh) · exact Bounty.Families.familyTwo_spectrum hb hbc hcop · exact Or.inr Bounty.Families.sporadic_spectrum theorem odd_gcd_one {a b : ℕ} (ha : 0 < a) (haodd : a % 2 = 1) (hg : Nat.gcd a b ≤ 2) : Nat.gcd a b = 1 := by have hpos : 0 < Nat.gcd a b := Nat.gcd_pos_of_pos_left b ha have hneq : Nat.gcd a b ≠ 2 := by intro he have hd : 2 ∣ a := by rw [← he]; exact Nat.gcd_dvd_left a b have hmod := Nat.mod_eq_zero_of_dvd hd omega omega theorem good_fraction_iff {m v N : ℤ} {δ : ℝ} (hN : 0 < N) : Good δ ((m : ℝ) / (N : ℝ)) v ↔ δ ≤ (((m * v) % N : ℤ) : ℝ) / (N : ℝ) ∧ (((m * v) % N : ℤ) : ℝ) / (N : ℝ) ≤ 1 - δ := by have hN' : (0 : ℝ) < N := by exact_mod_cast hN have heq : (m : ℝ) / (N : ℝ) * (v : ℝ) - (((m * v) / N : ℤ) : ℝ) = (((m * v) % N : ℤ) : ℝ) / (N : ℝ) := by rw [div_mul_eq_mul_div, ← Int.cast_mul] exact residue_fraction hN.ne' constructor · rintro ⟨k, hlo, hhi⟩ by_cases hd : δ ≤ 0 · constructor · exact hd.trans (div_nonneg (by exact_mod_cast Int.emod_nonneg _ hN.ne') hN'.le) · have hr : (((m * v) % N : ℤ) : ℝ) < (N : ℝ) := by exact_mod_cast Int.emod_lt_of_pos _ hN have hh : (((m * v) % N : ℤ) : ℝ) / (N : ℝ) < 1 := (div_lt_one hN').2 hr linarith · have hd' : 0 < δ := lt_of_not_ge hd have hk0 : (k : ℝ) ≤ (m : ℝ) / (N : ℝ) * (v : ℝ) := by linarith have hk1 : (m : ℝ) / (N : ℝ) * (v : ℝ) < (k : ℝ) + 1 := by linarith have hquot : k = (m * v) / N := by have hr0 : (0 : ℝ) ≤ (((m * v) % N : ℤ) : ℝ) / (N : ℝ) := div_nonneg (by exact_mod_cast Int.emod_nonneg _ hN.ne') hN'.le have hr1 : (((m * v) % N : ℤ) : ℝ) / (N : ℝ) < 1 := by apply (div_lt_one hN').2 exact_mod_cast Int.emod_lt_of_pos _ hN have hle : k ≤ (m * v) / N := by by_contra hh have hh' : (m * v) / N + 1 ≤ k := by omega have hhR : (((m * v) / N : ℤ) : ℝ) + 1 ≤ (k : ℝ) := by exact_mod_cast hh' linarith have hge : (m * v) / N ≤ k := by by_contra hh have hh' : k + 1 ≤ (m * v) / N := by omega have hhR : (k : ℝ) + 1 ≤ (((m * v) / N : ℤ) : ℝ) := by exact_mod_cast hh' linarith exact le_antisymm hle hge subst k rw [heq] at hlo hhi exact ⟨hlo, hhi⟩ · rintro ⟨hlo, hhi⟩ exact ⟨(m * v) / N, by rw [heq]; exact hlo, by rw [heq]; exact hhi⟩ theorem quarter_fraction_iff {m N : ℤ} {v : ℕ} (hN : 0 < N) : Quarter ((m : ℝ) / (N : ℝ)) v ↔ N ≤ 4 * ((m * (v : ℤ)) % N) ∧ 4 * ((m * (v : ℤ)) % N) ≤ 3 * N := by unfold Quarter rw [good_fraction_iff hN] have hN' : (0 : ℝ) < N := by exact_mod_cast hN constructor · rintro ⟨hlo, hhi⟩ have hlo' := (le_div_iff₀ hN').mp hlo have hhi' := (div_le_iff₀ hN').mp hhi constructor · have hh : (N : ℝ) ≤ 4 * (((m * (v : ℤ)) % N : ℤ) : ℝ) := by linarith exact_mod_cast hh · have hh : 4 * (((m * (v : ℤ)) % N : ℤ) : ℝ) ≤ 3 * (N : ℝ) := by linarith exact_mod_cast hh · rintro ⟨hlo, hhi⟩ have hlo' : (N : ℝ) ≤ 4 * (((m * (v : ℤ)) % N : ℤ) : ℝ) := by exact_mod_cast hlo have hhi' : 4 * (((m * (v : ℤ)) % N : ℤ) : ℝ) ≤ 3 * (N : ℝ) := by exact_mod_cast hhi constructor · apply (le_div_iff₀ hN').2 linarith · apply (div_le_iff₀ hN').2 linarith end Bounty.Pure05 /- Component: Farey. -/ namespace Bounty.Pure05 /-- The largest positive odd test index below half the odd denominator. -/ def terminalIndex (q : ℕ) : ℕ := 2 * ((q + 1) / 4) - 1 lemma terminalIndex_properties {q : ℕ} (hq : q % 2 = 1) (hq5 : 5 ≤ q) : terminalIndex q % 2 = 1 ∧ 2 * terminalIndex q < q ∧ (q = 2 * terminalIndex q + 1 ∨ q = 2 * terminalIndex q + 3) := by unfold terminalIndex omega lemma odd_floor_small {q α β : ℕ} (hqodd : q % 2 = 1) (ha : 0 < α) (hab : α < β) (hb : 2 * β < q) (hac : Nat.Coprime α q) (hqsmall : q < 11) (heq : ∀ j : ℕ, j % 2 = 1 → 2 * j < q → α * j / q = β * j / q) : α = 1 ∧ β = 2 := by have hqcases : q = 5 ∨ q = 7 ∨ q = 9 := by omega rcases hqcases with rfl | rfl | rfl · omega · have h3 := heq 3 (by decide) (by decide) omega · have h3 := heq 3 (by decide) (by decide) have hp : (α = 1 ∧ β = 2) ∨ (α = 3 ∧ β = 4) := by omega rcases hp with h | ⟨rfl, rfl⟩ · exact h · norm_num [Nat.Coprime] at hac /-- Equal odd floor words force consecutive numerator values. -/ lemma odd_floor_consecutive {q α β : ℕ} (hqodd : q % 2 = 1) (ha : 0 < α) (hab : α < β) (hb : 2 * β < q) (hac : Nat.Coprime α q) (heq : ∀ j : ℕ, j % 2 = 1 → 2 * j < q → α * j / q = β * j / q) : β = α + 1 := by by_cases hqsmall : q < 11 · obtain ⟨rfl, rfl⟩ := odd_floor_small hqodd ha hab hb hac hqsmall heq rfl have hqpos : 0 < q := by omega let m := terminalIndex q obtain ⟨hm_odd, hm_test, hqm⟩ := terminalIndex_properties hqodd (by omega : 5 ≤ q) have hm5 : 5 ≤ m := by dsimp [m, terminalIndex]; omega have hm_test' : 2 * m < q := hm_test have hqm' : q = 2 * m + 1 ∨ q = 2 * m + 3 := hqm have ht : α * m / q = β * m / q := heq m hm_odd hm_test' let K := α * m / q have hαlo : K * q ≤ α * m := Nat.div_mul_le_self (α * m) q have hβhi : β * m < (K + 1) * q := by have h := Nat.lt_mul_div_succ (β * m) hqpos rw [← ht] at h simpa only [K, Nat.mul_comm q] using h have hqbound : q ≤ 2 * m + 3 := by omega have hdiff : β ≤ α + 2 := by by_contra h have hβ : α + 3 ≤ β := by omega nlinarith by_cases hnext : β = α + 1 · exact hnext have hβ : β = α + 2 := by omega subst β let r := α * m % q have hr_eq : r + K * q = α * m := by simpa only [r, K, Nat.mul_comm q] using Nat.mod_add_div (α * m) q rcases hqm' with hq1 | hq3 · have hr0 : r = 0 := by nlinarith have hdiv : q ∣ α * m := Nat.dvd_of_mod_eq_zero hr0 have hdivm : q ∣ m := hac.symm.dvd_of_dvd_mul_left hdiv have hle : q ≤ m := Nat.le_of_dvd (by omega) hdivm omega · have hrbound : r ≤ 2 := by nlinarith have hrpos : 0 < r := by by_contra hn have hr0 : r = 0 := by omega have hdiv : q ∣ α * m := Nat.dvd_of_mod_eq_zero hr0 have hdivm : q ∣ m := hac.symm.dvd_of_dvd_mul_left hdiv have hle : q ≤ m := Nat.le_of_dvd (by omega) hdivm omega have hrelation : q * α = 2 * K * q + 3 * α + 2 * r := by nlinarith have hsumpos : 0 < 3 * α + 2 * r := by omega have hsumbound : 3 * α + 2 * r < 2 * q := by omega have hK : α = 2 * K + 1 := by have hKlo : 2 * K < α := by nlinarith have hKhi : α < 2 * K + 2 := by nlinarith omega have hcross : 3 * α < q ∧ q < 3 * (α + 2) := by rw [hK] at hrelation constructor <;> nlinarith have h3 := heq 3 (by decide) (by omega) have hα3 : α * 3 / q = 0 := Nat.div_eq_of_lt (by nlinarith [hcross.1]) have hβ3 : 1 ≤ (α + 2) * 3 / q := (Nat.le_div_iff_mul_le hqpos).2 (by nlinarith [hcross.2]) omega /-- A determinant-one pair of reduced fractions with bounded denominators. -/ structure FareyFrame (m a b d f : ℕ) : Prop where b_pos : 0 < b f_pos : 0 < f b_le : b ≤ m f_le : f ≤ m a_le : a ≤ b d_le : d ≤ f det : b * d = a * f + 1 /-- A reduced fraction whose denominator exceeds the bound cannot be an endpoint. -/ lemma reduced_cross_ne {m p q n s : ℕ} (hpq : Nat.Coprime p q) (hq : m < q) (hs : 0 < s) (hsm : s ≤ m) : p * s ≠ n * q := by intro h have hdiv : q ∣ p * s := by rw [h]; exact Nat.dvd_mul_left q n have hdivs : q ∣ s := hpq.symm.dvd_of_dvd_mul_left hdiv have hle : q ≤ s := Nat.le_of_dvd hs hdivs omega /-- Mediant descent produces the Farey gap containing a fraction. -/ lemma farey_bracket {m p q : ℕ} (hm : 0 < m) (hp : 0 < p) (hpq : p < q) (hc : Nat.Coprime p q) (hq : m < q) : ∃ a b d f : ℕ, FareyFrame m a b d f ∧ a * q < p * b ∧ p * f < d * q ∧ m < b + f := by have descend : ∀ N a b d f : ℕ, 2 * m - (b + f) = N → FareyFrame m a b d f → a * q < p * b → p * f < d * q → ∃ a' b' d' f' : ℕ, FareyFrame m a' b' d' f' ∧ a' * q < p * b' ∧ p * f' < d' * q ∧ m < b' + f' := by intro N induction N using Nat.strong_induction_on with | h N ih => intro a b d f hN hfr hlo hhi have hbpos := hfr.b_pos have hfpos := hfr.f_pos have hbm := hfr.b_le have hfm := hfr.f_le by_cases hsum : m < b + f · exact ⟨a, b, d, f, hfr, hlo, hhi, hsum⟩ have hsum' : b + f ≤ m := by omega have hne : p * (b + f) ≠ (a + d) * q := reduced_cross_ne hc hq (by omega) hsum' rcases lt_or_gt_of_ne hne with hmed | hmed · have hnew : FareyFrame m a b (a + d) (b + f) := by refine ⟨hfr.b_pos, by omega, hfr.b_le, hsum', hfr.a_le, Nat.add_le_add hfr.a_le hfr.d_le, ?_⟩ nlinarith [hfr.det] have hless : 2 * m - (b + (b + f)) < N := by omega exact ih _ hless a b (a + d) (b + f) rfl hnew hlo hmed · have hnew : FareyFrame m (a + d) (b + f) d f := by refine ⟨by omega, hfr.f_pos, hsum', hfr.f_le, Nat.add_le_add hfr.a_le hfr.d_le, hfr.d_le, ?_⟩ nlinarith [hfr.det] have hless : 2 * m - ((b + f) + f) < N := by omega exact ih _ hless (a + d) (b + f) d f rfl hnew hmed hhi apply descend (2 * m - 2) 0 1 1 1 rfl · exact ⟨by decide, by decide, hm, hm, by decide, by decide, by decide⟩ · simpa using hp · simpa using hpq /-- Positive determinant-one coordinates recover the denominator of an interior fraction. -/ lemma farey_coordinates {p q a b d f : ℕ} (hdet : b * d = a * f + 1) (hlo : a * q < p * b) (hhi : p * f < d * q) : ∃ h k : ℕ, 0 < h ∧ 0 < k ∧ h + f * p = d * q ∧ k + a * q = b * p ∧ q = b * h + f * k := by let h := d * q - f * p let k := b * p - a * q have hh : h + f * p = d * q := Nat.sub_add_cancel (by nlinarith) have hk : k + a * q = b * p := Nat.sub_add_cancel (by nlinarith) refine ⟨h, k, Nat.sub_pos_of_lt (by nlinarith), Nat.sub_pos_of_lt (by nlinarith), hh, hk, ?_⟩ have hh' := congrArg (fun x : ℕ => b * x) hh have hk' := congrArg (fun x : ℕ => f * x) hk have hd' := congrArg (fun x : ℕ => q * x) hdet nlinarith [hh', hk', hd'] lemma odd_floor_no_between {q α β j n : ℕ} (hq : 0 < q) (hjodd : j % 2 = 1) (hj : 2 * j < q) (heq : ∀ j : ℕ, j % 2 = 1 → 2 * j < q → α * j / q = β * j / q) : ¬ (α * j < n * q ∧ n * q < β * j) := by rintro ⟨hlo, hhi⟩ have hword := heq j hjodd hj have hnlo : α * j / q < n := (Nat.div_lt_iff_lt_mul hq).2 (by nlinarith) have hnhi : n ≤ β * j / q := (Nat.le_div_iff_mul_le hq).2 (by nlinarith) omega lemma farey_product_bound {b f : ℕ} (hb : 2 ≤ b) (hf : 2 ≤ f) : 3 * (b + f) ≤ b * f + b + f + 4 := by have hb' : (2 : ℤ) ≤ b := by exact_mod_cast hb have hf' : (2 : ℤ) ≤ f := by exact_mod_cast hf have hprod := mul_nonneg (sub_nonneg.mpr hb') (sub_nonneg.mpr hf') have h : (3 : ℤ) * (b + f) ≤ b * f + b + f + 4 := by nlinarith only [hprod] exact_mod_cast h /-- An ordinary bounded Farey gap containing consecutive numerators is the first gap. -/ lemma ordinary_gap_classification {m q α β a b d f : ℕ} (hm : 5 ≤ m) (hq : q ≤ 2 * m + 3) (ha : 0 < α) (hnext : β = α + 1) (hβ : 2 * β < q) (hfr : FareyFrame m a b d f) (hsum : m < b + f) (hlo : a * q < α * b) (hhi : β * f < d * q) : α = 1 ∧ β = 2 := by have hbpos := hfr.b_pos have hfpos := hfr.f_pos have hbm := hfr.b_le have hfm := hfr.f_le have hdet := hfr.det have hαhi : α * f < d * q := (Nat.mul_lt_mul_of_pos_right (show α < β by omega) hfpos).trans hhi obtain ⟨h, k, hh, hk, hheq, hkeq, hden⟩ := farey_coordinates hdet hlo hαhi let H := d * q - f * β have hH : 0 < H := Nat.sub_pos_of_lt (by nlinarith only [hhi]) have hHeq : H + f * β = d * q := Nat.sub_add_cancel (by nlinarith only [hhi]) have hdiff : h = H + f := by nlinarith only [hheq, hHeq, hnext] have hbH := Nat.mul_le_mul_left b (show 1 ≤ H by omega) have hfk := Nat.mul_le_mul_left f (show 1 ≤ k by omega) have hdenbound : b * f + b + f ≤ q := by rw [hdiff] at hden nlinarith only [hden, hbH, hfk] have hleft : 2 * a < b := by have hmultiply := Nat.mul_lt_mul_of_pos_right (show 2 * α < q by omega) hbpos have hprod : (2 * a) * q < b * q := by nlinarith only [hlo, hmultiply] exact (Nat.mul_lt_mul_right (by omega : 0 < q)).mp hprod by_cases hb1 : b = 1 · have ha0 : a = 0 := by omega have hd1 : d = 1 := by simpa [hb1, ha0] using hdet have hf_eq : f = m := by omega have hβm : β * m < q := by simpa [hd1, hf_eq] using hhi have h3m : q < 3 * m := by omega have hβlt : β < 3 := (Nat.mul_lt_mul_right (by omega : 0 < m)).mp (hβm.trans h3m) omega have hb2 : 2 ≤ b := by omega have hf2 : 2 ≤ f := by by_contra hn have hf1 : f = 1 := by omega have hdle := hfr.d_le have hdpos : 0 < d := by by_contra hn have hd0 : d = 0 := by omega rw [hd0, Nat.zero_mul] at hhi omega have hd1 : d = 1 := by omega have hba : b = a + 1 := by simpa [hf1, hd1] using hdet omega have hprod := farey_product_bound hb2 hf2 omega /-- The right Farey neighbor is obtained from a determinant-one left neighbor. -/ lemma farey_successor {m a b c e : ℕ} (hepos : 0 < e) (hem : e ≤ m) (hdet : b * c = a * e + 1) : ∃ d f : ℕ, 0 < f ∧ f ≤ m ∧ e * d = c * f + 1 ∧ m < e + f := by let K := (m + b) / e have hKlo : K * e ≤ m + b := Nat.div_mul_le_self (m + b) e have hKhi : m + b < (K + 1) * e := by simpa only [K, Nat.mul_comm e] using Nat.lt_mul_div_succ (m + b) hepos have hKeb : b < K * e := by nlinarith have hcpos : 0 < c := by nlinarith have hKca : a < K * c := by by_contra hn have hmul := Nat.mul_le_mul_right e (show K * c ≤ a by omega) have hmul' := Nat.mul_lt_mul_of_pos_right hKeb hcpos nlinarith let f := K * e - b let d := K * c - a have hf : f + b = K * e := Nat.sub_add_cancel hKeb.le have hd : d + a = K * c := Nat.sub_add_cancel hKca.le refine ⟨d, f, Nat.sub_pos_of_lt hKeb, by omega, ?_, by nlinarith only [hKhi, hf]⟩ have hde := congrArg (fun x : ℕ => e * x) hd have hfc := congrArg (fun x : ℕ => c * x) hf nlinarith lemma odd_factors_of_even_det {b c a e : ℕ} (he : e % 2 = 0) (hdet : b * c = a * e + 1) : b % 2 = 1 ∧ c % 2 = 1 := by have hae : (a * e) % 2 = 0 := by rw [Nat.mul_mod, he]; simp have hh : (b * c) % 2 = 1 := by omega rw [Nat.mul_mod] at hh constructor · by_contra hn have hb0 : b % 2 = 0 := by omega simp [hb0] at hh · by_contra hn have hc0 : c % 2 = 0 := by omega simp [hc0] at hh lemma coprime_of_unit_det {b c a e : ℕ} (hdet : b * c = a * e + 1) : Nat.Coprime c e := by apply Nat.dvd_one.mp apply (Nat.dvd_add_iff_right (dvd_mul_of_dvd_right (Nat.gcd_dvd_right c e) a)).2 rw [← hdet] exact dvd_mul_of_dvd_right (Nat.gcd_dvd_left c e) b lemma mediator_dvd_sum {a b c e d f : ℕ} (hl : b * c = a * e + 1) (hr : e * d = c * f + 1) : e ∣ b + f := by have hce := coprime_of_unit_det hl apply hce.symm.dvd_of_dvd_mul_left refine ⟨a + d, ?_⟩ nlinarith lemma coordinate_denominator_bound {b h e : ℕ} (hb : 3 ≤ b) (hh : 2 ≤ h) (hbound : b * h + 1 ≤ 2 * b + e) : 3 * h + 1 ≤ 6 + e := by have hs : h - 2 + 2 = h := Nat.sub_add_cancel hh have hp := Nat.mul_le_mul_right (h - 2) hb have hs' := congrArg (fun x : ℕ => b * x) hs nlinarith only [hs, hp, hs', hbound] /-- The even mediator inequalities leave the unique denominator-thirteen case. -/ lemma even_mediator_arithmetic {m q α β a b c e d f h h' l l' : ℕ} (hm : 5 ≤ m) (hqm : q = 2 * m + 1 ∨ q = 2 * m + 3) (hb3 : 3 ≤ b) (hf3 : 3 ≤ f) (hbm : b ≤ m) (_hfm : f ≤ m) (hbo : b % 2 = 1) (hfo : f % 2 = 1) (heven : e % 2 = 0) (hco : c % 2 = 1) (hhalf : 2 * c < e) (hl : b * c = a * e + 1) (hr : e * d = c * f + 1) (hsumL : m + 2 ≤ b + e) (hsumR : m + 2 ≤ f + e) (hdvd : e ∣ b + f) (hh : 0 < h) (hh' : 0 < h') (hho : h % 2 = 1) (hh'o : h' % 2 = 1) (hh_sum : h + h' = e) (hlpos : 0 < l) (hl'pos : 0 < l') (hdenL : q = b * h + e * l) (hdenR : q = f * h' + e * l') (hnum : h + e * α = c * q) (hnext : β = α + 1) : q = 13 ∧ α = 3 ∧ β = 4 := by have he4 : 4 ≤ e := by omega have hqbound : q ≤ 2 * m + 3 := by omega have hel := Nat.mul_le_mul_left e (show 1 ≤ l by omega) have hel' := Nat.mul_le_mul_left e (show 1 ≤ l' by omega) have hboundL : b * h + 1 ≤ 2 * b + e := by nlinarith only [hdenL, hel, hqbound, hsumL] have hboundR : f * h' + 1 ≤ 2 * f + e := by nlinarith only [hdenR, hel', hqbound, hsumR] have hsmall : (h = 1 ∨ h' = 1) → e ≤ 4 := by rintro (hh1 | hh'1) · have hh'2 : 2 ≤ h' := by omega have h := coordinate_denominator_bound hf3 hh'2 hboundR omega · have hh2 : 2 ≤ h := by omega have h := coordinate_denominator_bound hb3 hh2 hboundL omega have he10 : e ≤ 10 := by by_cases hn : h = 1 ∨ h' = 1 · have := hsmall hn omega have hh3 : 3 ≤ h := by omega have hh'3 : 3 ≤ h' := by omega have hL := coordinate_denominator_bound hb3 (by omega) hboundL have hR := coordinate_denominator_bound hf3 (by omega) hboundR omega have hecases : e = 4 ∨ e = 6 ∨ e = 8 ∨ e = 10 := by omega rcases hecases with he4eq | he6eq | he8eq | he10eq · have hc1 : c = 1 := by omega have hb5 : 5 ≤ b := by rw [hc1, he4eq] at hl; omega have hpair : (h = 1 ∧ h' = 3) ∨ (h = 3 ∧ h' = 1) := by omega have hh1 : h = 1 := by rcases hpair with hp | ⟨hh3, hh'1⟩ · exact hp.1 · rw [hh3, he4eq] at hboundL omega have hh'3 : h' = 3 := by omega have hf_eq : f = 3 := by rw [hh'3, he4eq] at hboundR; omega have hm5 : m = 5 := by omega have hb_eq : b = 5 := by omega rw [hh1, he4eq, hc1] at hnum omega · have hn : h ≠ 1 ∧ h' ≠ 1 := by constructor <;> intro hn · have := hsmall (Or.inl hn) omega · have := hsmall (Or.inr hn) omega have hh3 : h = 3 := by omega have hh'3 : h' = 3 := by omega rw [hh3, he6eq] at hboundL rw [hh'3, he6eq] at hboundR have hb5 : b = 5 := by have hcases : b = 3 ∨ b = 5 := by omega rcases hcases with hb3eq | hb5eq · rw [hb3eq, he6eq] at hl omega · exact hb5eq have hf5 : f = 5 := by have hcases : f = 3 ∨ f = 5 := by omega rcases hcases with hf3eq | hf5eq · rw [hf3eq, he6eq] at hr omega · exact hf5eq rw [he6eq, hb5, hf5] at hdvd norm_num at hdvd · have hn : h ≠ 1 ∧ h' ≠ 1 := by constructor <;> intro hn · have := hsmall (Or.inl hn) omega · have := hsmall (Or.inr hn) omega have hcases : (h = 3 ∧ h' = 5) ∨ (h = 5 ∧ h' = 3) := by omega rcases hcases with ⟨hh3, hh'5⟩ | ⟨hh5, hh'3⟩ · rw [hh'5, he8eq] at hboundR omega · rw [hh5, he8eq] at hboundL omega · have hn : h ≠ 1 ∧ h' ≠ 1 := by constructor <;> intro hn · have := hsmall (Or.inl hn) omega · have := hsmall (Or.inr hn) omega have hcases : (h = 3 ∧ h' = 7) ∨ (h = 5 ∧ h' = 5) ∨ (h = 7 ∧ h' = 3) := by omega rcases hcases with ⟨hh3, hh'7⟩ | ⟨hh5, hh'5⟩ | ⟨hh7, hh'3⟩ · rw [hh'7, he10eq] at hboundR omega · rw [hh5, he10eq] at hboundL rw [hh'5, he10eq] at hboundR have hb_eq : b = 3 := by omega have hf_eq : f = 3 := by omega rw [he10eq, hb_eq, hf_eq] at hdvd norm_num at hdvd · rw [hh7, he10eq] at hboundL omega /-- A unique even-denominator Farey mediator produces the single exceptional pair. -/ lemma even_mediator_classification {m q α β a b c e : ℕ} (hm : 5 ≤ m) (hmodd : m % 2 = 1) (hqodd : q % 2 = 1) (hqm : q = 2 * m + 1 ∨ q = 2 * m + 3) (ha : 0 < α) (hnext : β = α + 1) (hβ : 2 * β < q) (hbc : Nat.Coprime β q) (heq : ∀ j : ℕ, j % 2 = 1 → 2 * j < q → α * j / q = β * j / q) (hfr : FareyFrame m a b c e) (hsum : m < b + e) (hlo : a * q < α * b) (hαmid : α * e < c * q) (hβmid : c * q < β * e) (heven : e % 2 = 0) : q = 13 ∧ α = 3 ∧ β = 4 := by have hbpos := hfr.b_pos have hepos := hfr.f_pos have hbm := hfr.b_le have hem := hfr.f_le have hdetL := hfr.det have hqpos : 0 < q := by omega have hmq : m < q := by omega have hmtest : 2 * m < q := by omega obtain ⟨hbo, hco⟩ := odd_factors_of_even_det heven hdetL have hhalf : 2 * c < e := by have hmul := Nat.mul_lt_mul_of_pos_right hβ hepos have hprod : (2 * c) * q < e * q := by nlinarith only [hβmid, hmul] exact (Nat.mul_lt_mul_right hqpos).mp hprod obtain ⟨d, f, hfpos, hfm, hdetR, hsumR⟩ := farey_successor hepos hem hdetL have hed : (e * d) % 2 = 0 := by rw [Nat.mul_mod, heven]; simp have hcf : (c * f) % 2 = 1 := by omega rw [Nat.mul_mod, hco] at hcf have hfo : f % 2 = 1 := by simpa using hcf have hαright : α * f < d * q := by have hmul := Nat.mul_lt_mul_of_pos_right hαmid hfpos have hdetq := congrArg (fun x : ℕ => q * x) hdetR have hprod : (α * f) * e < (d * q) * e := by nlinarith only [hmul, hdetq] exact (Nat.mul_lt_mul_right hepos).mp hprod have hβright : β * f < d * q := by by_contra hn have hne : β * f ≠ d * q := reduced_cross_ne hbc hmq hfpos hfm have hgt : d * q < β * f := by omega exact odd_floor_no_between hqpos hfo (by omega) heq ⟨hαright, hgt⟩ have hb3 : 3 ≤ b := by omega have hf3 : 3 ≤ f := by omega have hsumL' : m + 2 ≤ b + e := by omega have hsumR' : m + 2 ≤ f + e := by omega have hdvd : e ∣ b + f := mediator_dvd_sum hdetL hdetR obtain ⟨h, l, hh, hlpos, hnum, hl_num, hdenL⟩ := farey_coordinates hdetL hlo hαmid obtain ⟨l', h', hl'pos, hh', hl'_num, hh'_num, hdenR'⟩ := farey_coordinates hdetR hβmid hβright have hdenR : q = f * h' + e * l' := by simpa only [Nat.add_comm] using hdenR' have hh_sum : h + h' = e := by have hh'_num' := hh'_num rw [hnext] at hh'_num' nlinarith only [hnum, hh'_num'] have hcqodd : (c * q) % 2 = 1 := by rw [Nat.mul_mod, hco, hqodd] have heα : (e * α) % 2 = 0 := by rw [Nat.mul_mod, heven]; simp have heβ : (e * β) % 2 = 0 := by rw [Nat.mul_mod, heven]; simp have hho : h % 2 = 1 := by omega have hh'o : h' % 2 = 1 := by omega exact even_mediator_arithmetic hm hqm hb3 hf3 hbm hfm hbo hfo heven hco hhalf hdetL hdetR hsumL' hsumR' hdvd hh hh' hho hh'o hh_sum hlpos hl'pos hdenL hdenR hnum hnext /-- Classification of coincident odd-index floor words, with no speed search. -/ theorem odd_floor_classification {q α β : ℕ} (hqodd : q % 2 = 1) (ha : 0 < α) (hab : α < β) (hb : 2 * β < q) (hac : Nat.Coprime α q) (hbc : Nat.Coprime β q) (heq : ∀ j : ℕ, j % 2 = 1 → 2 * j < q → α * j / q = β * j / q) : (α = 1 ∧ β = 2) ∨ (q = 13 ∧ α = 3 ∧ β = 4) := by by_cases hqsmall : q < 11 · exact Or.inl (odd_floor_small hqodd ha hab hb hac hqsmall heq) have hnext := odd_floor_consecutive hqodd ha hab hb hac heq let m := terminalIndex q obtain ⟨hmodd, hmtest, hqm⟩ := terminalIndex_properties hqodd (by omega : 5 ≤ q) have hm : 5 ≤ m := by dsimp [m, terminalIndex]; omega have hmq : m < q := by omega have hqpos : 0 < q := by omega obtain ⟨a, b, c, e, hfr, hlo, hαmid, hsum⟩ := farey_bracket (show 0 < m by omega) ha (show α < q by omega) hac hmq have hepos := hfr.f_pos have hem := hfr.f_le by_cases hβhi : β * e < c * q · exact Or.inl (ordinary_gap_classification hm (by omega) ha hnext hb hfr hsum hlo hβhi) have hne : β * e ≠ c * q := reduced_cross_ne hbc hmq hepos hem have hβmid : c * q < β * e := by omega have heven : e % 2 = 0 := by by_contra hn have heodd : e % 2 = 1 := by omega exact odd_floor_no_between hqpos heodd (by omega) heq ⟨hαmid, hβmid⟩ exact Or.inr (even_mediator_classification hm hmodd hqodd hqm ha hnext hb hbc heq hfr hsum hlo hαmid hβmid heven) end Bounty.Pure05 /- Component: Grid. -/ noncomputable section namespace Bounty.Pure05 open Finset Set Math15.Source05.ThreeSpeed /-- A cyclic interval, expressed after translating its initial point to zero. -/ def cyclicSegment (n L : ℕ) [NeZero n] (s : ZMod n) : Finset (ZMod n) := by classical exact univ.filter fun x => (x - s).val < L /-- Points which leave a cyclic interval under a given additive shift. -/ def segmentBoundary (n L : ℕ) [NeZero n] (s d : ZMod n) : Finset (ZMod n) := by classical exact (cyclicSegment n L s).filter fun x => x + d ∉ cyclicSegment n L s theorem mem_cyclicSegment {n L : ℕ} [NeZero n] {s x : ZMod n} : x ∈ cyclicSegment n L s ↔ (x - s).val < L := by classical simp [cyclicSegment] theorem mem_segmentBoundary {n L : ℕ} [NeZero n] {s d x : ZMod n} : x ∈ segmentBoundary n L s d ↔ (x - s).val < L ∧ ¬(x + d - s).val < L := by classical simp [segmentBoundary,mem_cyclicSegment] theorem boundary_translate_card {n L : ℕ} [NeZero n] (s d : ZMod n) : (segmentBoundary n L s d).card = (segmentBoundary n L 0 d).card := by classical apply Finset.card_bij' (fun (x : ZMod n) _ => x - s) (fun x _ => x + s) · intro x hx rw [mem_segmentBoundary] at hx ⊢ have he : x - s + d = x + d - s := by ring simpa only [sub_zero, he] using hx · intro x hx rw [mem_segmentBoundary] at hx ⊢ have he : x + s + d - s = x + d := by ring simpa only [sub_zero, add_sub_cancel_right, he] using hx · intro x hx simp · intro x hx simp theorem boundary_one_card {n L : ℕ} [NeZero n] (hL : 0 < L) (hLn : L + 1 < n) : (segmentBoundary n L 0 1).card = 1 := by classical have h1 : (1 : ZMod n).val = 1 := by simpa using (ZMod.val_natCast_of_lt (n := n) (a := 1) (by omega)) have hv : ((L - 1 : ℕ) : ZMod n).val = L - 1 := ZMod.val_natCast_of_lt (by omega) have heq : segmentBoundary n L 0 1 = {((L - 1 : ℕ) : ZMod n)} := by ext x simp only [mem_segmentBoundary, sub_zero, Finset.mem_singleton] constructor · rintro ⟨hx, hxn⟩ have hadd : (x + 1).val = x.val + 1 := by rw [ZMod.val_add, h1, Nat.mod_eq_of_lt (by omega)] rw [hadd] at hxn apply ZMod.val_injective n rw [hv] omega · intro hx subst x rw [hv, ZMod.val_add, hv, h1, Nat.mod_eq_of_lt (by omega)] omega rw [heq] simp /-- Every nonadjacent shift has two distinct exits. This is the only autocorrelation estimate needed for interval rigidity. -/ theorem boundary_nonadjacent_card {n L : ℕ} [NeZero n] (hL : 2 ≤ L) (hLn : L + 1 < n) (d : ZMod n) (hdlo : 2 ≤ d.val) (hdhi : d.val + 1 < n) : 2 ≤ (segmentBoundary n L 0 d).card := by classical let a : ℕ := if L ≤ d.val then 0 else L - d.val have ha : a + 1 < L ∧ L ≤ a + d.val ∧ a + d.val + 1 < n := by dsimp [a] split_ifs <;> omega let x : ZMod n := a let y : ZMod n := ((a + 1 : ℕ) : ZMod n) have hxv : x.val = a := ZMod.val_natCast_of_lt (by omega) have hyv : y.val = a + 1 := ZMod.val_natCast_of_lt (by omega) have hxd : (x + d).val = a + d.val := by rw [ZMod.val_add, hxv, Nat.mod_eq_of_lt (by omega)] have hyd : (y + d).val = a + 1 + d.val := by rw [ZMod.val_add, hyv, Nat.mod_eq_of_lt (by omega)] have hx : x ∈ segmentBoundary n L 0 d := by simp only [mem_segmentBoundary, sub_zero, hxv, hxd] omega have hy : y ∈ segmentBoundary n L 0 d := by simp only [mem_segmentBoundary, sub_zero, hyv, hyd] omega have hxy : x ≠ y := by intro h have hv := congrArg ZMod.val h rw [hxv, hyv] at hv omega have hsub : ({x, y} : Finset (ZMod n)) ⊆ segmentBoundary n L 0 d := by intro z hz simp only [Finset.mem_insert, Finset.mem_singleton] at hz rcases hz with rfl | rfl · exact hx · exact hy have hc := Finset.card_le_card hsub simpa [hxy] using hc theorem boundary_mul_unit_card {n L : ℕ} [NeZero n] (s : ZMod n) (u : (ZMod n)ˣ) (hstab : ∀ x : ZMod n, x ∈ cyclicSegment n L s ↔ (u : ZMod n) * x ∈ cyclicSegment n L s) : (segmentBoundary n L s 1).card = (segmentBoundary n L s u).card := by classical apply Finset.card_bij' (fun (x : ZMod n) _ => (u : ZMod n) * x) (fun x _ => ((u⁻¹ : (ZMod n)ˣ) : ZMod n) * x) · intro x hx simp only [segmentBoundary, Finset.mem_filter] at hx ⊢ refine ⟨(hstab x).mp hx.1, ?_⟩ intro h apply hx.2 apply (hstab (x + 1)).mpr convert h using 1 <;> ring · intro x hx simp only [segmentBoundary, Finset.mem_filter] at hx ⊢ refine ⟨?_, ?_⟩ · apply (hstab _).mpr simpa [mul_assoc] using hx.1 · intro h apply hx.2 have hh := (hstab _).mp h simpa [mul_add, mul_assoc] using hh · intro x hx simp [mul_assoc] · intro x hx simp [mul_assoc] theorem cyclic_interval_stabilizer {n L : ℕ} [NeZero n] (hL : 2 ≤ L) (hLn : L + 1 < n) (s : ZMod n) (u : (ZMod n)ˣ) (hstab : ∀ x : ZMod n, x ∈ cyclicSegment n L s ↔ (u : ZMod n) * x ∈ cyclicSegment n L s) : (u : ZMod n) = 1 ∨ (u : ZMod n) = -1 := by have hn : 1 < n := by omega have h1 : (1 : ZMod n).val = 1 := by simpa using (ZMod.val_natCast_of_lt (n := n) (a := 1) hn) have hu0 : (u : ZMod n).val ≠ 0 := by intro h have hz : (u : ZMod n) = 0 := (ZMod.val_eq_zero _).mp h have hh : ((u⁻¹ : (ZMod n)ˣ) : ZMod n) * (u : ZMod n) = 1 := by simp rw [hz, mul_zero] at hh have hv := congrArg ZMod.val hh rw [ZMod.val_zero, h1] at hv omega by_cases hu1 : (u : ZMod n).val = 1 · exact Or.inl ((ZMod.val_eq_one hn _).mp hu1) by_cases hum : (u : ZMod n).val = n - 1 · right apply ZMod.val_injective n rw [hum, ZMod.neg_val, if_neg, h1] intro h have hv := congrArg ZMod.val h rw [h1, ZMod.val_zero] at hv omega have hvlt := ZMod.val_lt (u : ZMod n) have hb := boundary_nonadjacent_card hL hLn (u : ZMod n) (by omega) (by omega) rw [← boundary_translate_card s (u : ZMod n), ← boundary_mul_unit_card s u hstab, boundary_translate_card s 1, boundary_one_card (by omega) hLn] at hb omega /-- The central half of the integral grid. -/ def centralHalf (n : ℕ) [NeZero n] : Finset (ZMod n) := by classical exact univ.filter fun x => n ≤ 4*x.val ∧ 4*x.val ≤ 3*n theorem mem_centralHalf {n : ℕ} [NeZero n] {x : ZMod n} : x ∈ centralHalf n ↔ n ≤ 4*x.val ∧ 4*x.val ≤ 3*n := by classical simp [centralHalf] theorem cyclicSegment_interval {n L a : ℕ} [NeZero n] (ha : a < n) (haL : a + L ≤ n) (x : ZMod n) : x ∈ cyclicSegment n L (a : ZMod n) ↔ a ≤ x.val ∧ x.val < a + L := by rw [mem_cyclicSegment] have hav : (a : ZMod n).val = a := ZMod.val_natCast_of_lt ha by_cases hx : a ≤ x.val · rw [ZMod.val_sub (by rw [hav]; exact hx), hav] omega · have hdiff : ((a : ZMod n) - x).val = a - x.val := by rw [ZMod.val_sub (by rw [hav]; omega), hav] have hnz : (a : ZMod n) - x ≠ 0 := by intro h have hh := congrArg ZMod.val h rw [hdiff, ZMod.val_zero] at hh omega have hv : (x - (a : ZMod n)).val = n - (a - x.val) := by rw [show x - (a : ZMod n) = -((a : ZMod n) - x) by ring, ZMod.neg_val, ite_eq_right hnz, hdiff] rw [hv] omega theorem centralHalf_segment {n : ℕ} [NeZero n] (hn : 3 ≤ n) : centralHalf n = cyclicSegment n (3*n/4+1-(n+3)/4) (((n+3)/4 : ℕ) : ZMod n) := by classical have ha : (n+3)/4 < n := by omega have hL : (n+3)/4 + (3*n/4+1-(n+3)/4) ≤ n := by omega ext x rw [mem_centralHalf, cyclicSegment_interval ha hL] omega theorem unit_val_ne_zero {n : ℕ} [NeZero n] (hn : 1 < n) (u : (ZMod n)ˣ) : (u : ZMod n).val ≠ 0 := by intro h have hz : (u : ZMod n) = 0 := (ZMod.val_eq_zero _).mp h have hh : ((u⁻¹ : (ZMod n)ˣ) : ZMod n) * (u : ZMod n) = 1 := by simp rw [hz, mul_zero] at hh have hv := congrArg ZMod.val hh have h1 : (1 : ZMod n).val = 1 := by simpa using (ZMod.val_natCast_of_lt (n := n) (a := 1) hn) rw [ZMod.val_zero, h1] at hv omega /-- Lemma 2.2: the only units preserving the odd central half are the signs. -/ theorem centralHalf_stabilizer {n : ℕ} [NeZero n] (hn : 3 ≤ n) (hnodd : n % 2 = 1) (u : (ZMod n)ˣ) (hstab : ∀ x : ZMod n, x ∈ centralHalf n ↔ (u : ZMod n)*x ∈ centralHalf n) : (u : ZMod n) = 1 ∨ (u : ZMod n) = -1 := by by_cases hn5 : 5 ≤ n · have hL : 2 ≤ 3*n/4+1-(n+3)/4 := by omega have hLn : (3*n/4+1-(n+3)/4)+1 < n := by omega apply cyclic_interval_stabilizer hL hLn (((n+3)/4 : ℕ) : ZMod n) u intro x simpa only [← centralHalf_segment hn] using hstab x · have hn3 : n = 3 := by omega have hu0 := unit_val_ne_zero (by omega : 1 < n) u have hult := ZMod.val_lt (u : ZMod n) by_cases hu1 : (u : ZMod n).val = 1 · exact Or.inl ((ZMod.val_eq_one (by omega) _).mp hu1) · right apply ZMod.val_injective n have hum : (u : ZMod n).val = n-1 := by omega have h1 : (1 : ZMod n).val = 1 := by simpa using (ZMod.val_natCast_of_lt (n := n) (a := 1) (by omega)) have h1n : (1 : ZMod n) ≠ 0 := by intro h have hh := congrArg ZMod.val h rw [h1,ZMod.val_zero] at hh omega rw [hum,ZMod.neg_val,ite_eq_right h1n,h1] def centralPreimage (n : ℕ) [NeZero n] (w : ZMod n) : Finset (ZMod n) := by classical exact univ.filter fun x => w*x ∈ centralHalf n theorem mem_centralPreimage {n : ℕ} [NeZero n] {w x : ZMod n} : x ∈ centralPreimage n w ↔ w*x ∈ centralHalf n := by classical simp [centralPreimage] theorem centralPreimage_card {n : ℕ} [NeZero n] (u : (ZMod n)ˣ) : (centralPreimage n u).card = (centralHalf n).card := by classical apply Finset.card_equiv (Units.mulLeft u) intro x simp only [mem_centralPreimage] rfl theorem good_quarter_fraction_int_iff {m v N : ℤ} (hN : 0 < N) : Good (1/4) ((m : ℝ)/(N : ℝ)) v ↔ N ≤ 4*((m*v)%N) ∧ 4*((m*v)%N) ≤ 3*N := by rw [good_fraction_iff hN] have hN' : (0 : ℝ) omega /-- Lemma 2.3: disjoint odd quarter grids force the two signed congruences. -/ theorem grid_rigidity {n u v : ℕ} (hn : 0 < n) (hnodd : n%2=1) (hvodd : v%2=1) (hnu : Nat.Coprime n u) (hnv : Nat.Coprime n v) (hdisjoint : ∀ j : ℤ, ¬(Quarter ((((2*j+1:ℤ):ℝ))/(n:ℝ)) u ∧ Quarter ((((2*j+1:ℤ):ℝ))/(2*(n:ℝ))) v)) : (n:ℤ) ∣ 2*(u:ℤ)-(v:ℤ) ∨ (n:ℤ) ∣ 2*(u:ℤ)+(v:ℤ) := by classical by_cases hn1 : n=1 · left simp [hn1] letI : NeZero n := ⟨by omega⟩ have hn3 : 3 ≤ n := by omega have hodd : Odd n := Nat.odd_iff.mpr hnodd let uu : (ZMod n)ˣ := ZMod.unitOfCoprime u hnu.symm let vu : (ZMod n)ˣ := ZMod.unitOfCoprime v hnv.symm let tu : (ZMod n)ˣ := ZMod.unitOfCoprime 2 hodd.coprime_two_left let bu : (ZMod n)ˣ := -vu * tu⁻¹ let b : ℤ := ((n:ℤ)-(v:ℤ))/2 have hb2 : 2*b+(v:ℤ)=(n:ℤ) := by dsimp [b]; omega have hbZ : (2:ZMod n)*(b:ZMod n)=-(v:ZMod n) := by have hh := congrArg (fun w : ℤ => (w : ZMod n)) hb2 push_cast at hh have hh0 : (2:ZMod n)*(b:ZMod n)+(v:ZMod n)=0 := by simpa using hh calc (2:ZMod n)*(b:ZMod n) = ((2:ZMod n)*(b:ZMod n)+(v:ZMod n))-(v:ZMod n) := by ring _ = -(v:ZMod n) := by rw [hh0]; simp have htu : (tu : ZMod n)=(2:ZMod n) := by simp [tu] have hvu : (vu : ZMod n)=(v:ZMod n) := by simp [vu] have hbtu : (tu:ZMod n)*(b:ZMod n)=-(vu:ZMod n) := by rw [htu,hvu]; exact hbZ have hbu : (bu:ZMod n)=(b:ZMod n) := by calc (bu:ZMod n) = -(vu:ZMod n)*((tu⁻¹ : (ZMod n)ˣ):ZMod n) := by simp [bu] _ = ((tu⁻¹ : (ZMod n)ˣ):ZMod n)*(-(vu:ZMod n)) := by ring _ = ((tu⁻¹ : (ZMod n)ˣ):ZMod n)*((tu:ZMod n)*(b:ZMod n)) := by rw [hbtu] _ = (b:ZMod n) := by simp [mul_assoc] have hsub : centralPreimage n uu ⊆ centralPreimage n bu := by intro x hx by_contra hnot let j : ℤ := ((((tu⁻¹ : (ZMod n)ˣ):ZMod n)*(x-1)).val : ℤ) have hm : ((2*j+1 : ℤ):ZMod n)=x := by dsimp [j] push_cast rw [ZMod.natCast_zmod_val,← htu] simp [mul_assoc] have hxU : (u:ZMod n)*x ∈ centralHalf n := by simpa [uu] using (mem_centralPreimage.mp hx) have hgu : Quarter ((((2*j+1:ℤ):ℝ))/(n:ℝ)) u := by apply (good_integer_grid_iff hn (2*j+1) (u:ℤ)).mpr simpa [hm,mul_comm] using hxU have hgb : ¬Good (1/4) ((((2*j+1:ℤ):ℝ))/(n:ℝ)) b := by intro hg apply hnot apply mem_centralPreimage.mpr have hh := (good_integer_grid_iff hn (2*j+1) b).mp hg rw [hm] at hh simpa [hbu,mul_comm] using hh have hgv : Quarter ((((2*j+1:ℤ):ℝ))/(2*(n:ℝ))) v := by have hh := (odd_half_grid_complement (N := (n:ℤ)) (v := (v:ℤ)) (by exact_mod_cast hn) (by exact_mod_cast hnodd) (by exact_mod_cast hvodd) j).mpr hgb simpa only [Int.cast_natCast] using hh exact hdisjoint j ⟨hgu,hgv⟩ have heq : centralPreimage n uu = centralPreimage n bu := by apply Finset.eq_of_subset_of_card_le hsub rw [centralPreimage_card uu,centralPreimage_card bu] let w : (ZMod n)ˣ := uu*bu⁻¹ have hstab : ∀ x : ZMod n, x ∈ centralHalf n ↔ (w:ZMod n)*x ∈ centralHalf n := by intro x have hh : ((bu⁻¹ : (ZMod n)ˣ):ZMod n)*x ∈ centralPreimage n uu ↔ ((bu⁻¹ : (ZMod n)ˣ):ZMod n)*x ∈ centralPreimage n bu := by rw [heq] simp only [mem_centralPreimage] at hh simpa [w,mul_assoc] using hh.symm have hsign := centralHalf_stabilizer hn3 hnodd w hstab rcases hsign with hp | hm · have hh := congrArg (fun z : ZMod n => z*(bu:ZMod n)) hp have huB : (u:ZMod n)=(b:ZMod n) := by have huEq : (uu:ZMod n)=(bu:ZMod n) := by simpa [w,mul_assoc] using hh simpa [uu,hbu] using huEq right apply (ZMod.intCast_zmod_eq_zero_iff_dvd _ n).mp push_cast rw [huB,hbZ] simp · have hh := congrArg (fun z : ZMod n => z*(bu:ZMod n)) hm have huB : (u:ZMod n)=-(b:ZMod n) := by have huEq : (uu:ZMod n)=-(bu:ZMod n) := by simpa [w,mul_assoc] using hh simpa [uu,hbu] using huEq left apply (ZMod.intCast_zmod_eq_zero_iff_dvd _ n).mp push_cast rw [huB,mul_neg,hbZ] simp theorem grid_rigidity_sign {n u v : ℕ} (hn : 0 < n) (hnodd : n%2=1) (hvodd : v%2=1) (hnu : Nat.Coprime n u) (hnv : Nat.Coprime n v) (hdisjoint : ∀ j : ℤ, ¬(Quarter ((((2*j+1:ℤ):ℝ))/(n:ℝ)) u ∧ Quarter ((((2*j+1:ℤ):ℝ))/(2*(n:ℝ))) v)) : ∃ s : ℤ, (s=1 ∨ s=-1) ∧ (n:ℤ) ∣ 2*(u:ℤ)-s*(v:ℤ) := by rcases grid_rigidity hn hnodd hvodd hnu hnv hdisjoint with hp | hm · exact ⟨1,Or.inl rfl,by simpa using hp⟩ · exact ⟨-1,Or.inr rfl,by simpa using hm⟩ end Bounty.Pure05 end /- Component: Triangle. -/ noncomputable section namespace Bounty.Pure05 open Finset Set Math15.Source05.ThreeSpeed /-- Every closed interval of half a speed's period meets its central half. -/ theorem interval_good_forces_other {F : ℕ} (hF : 0 < F) {l r : ℝ} (hlen : 1 / (2 * (F : ℝ)) ≤ r - l) : ∃ t : ℝ, l ≤ t ∧ t ≤ r ∧ Quarter t F := by have hFR : (0 : ℝ) < F := by exact_mod_cast hF have hFn : (F : ℝ) ≠ 0 := ne_of_gt hFR have hlength : (1 : ℝ) / 2 ≤ (r - l) * F := by have hh := (div_le_iff₀ (by positivity : (0 : ℝ) < 2 * F)).mp hlen nlinarith let k : ℤ := ⌊l * (F : ℝ)⌋ have hklo : (k : ℝ) ≤ l * F := Int.floor_le _ have hkhi : l * (F : ℝ) < (k : ℝ) + 1 := Int.lt_floor_add_one _ by_cases hlo : (1 : ℝ) / 4 ≤ l * F - k · by_cases hhi : l * (F : ℝ) - k ≤ 3 / 4 · refine ⟨l, le_rfl, ?_, k, hlo, ?_⟩ · nlinarith · norm_num at * exact hhi · let t : ℝ := ((k : ℝ) + 5 / 4) / F have ht : t * F = (k : ℝ) + 5 / 4 := by dsimp [t] field_simp refine ⟨t, ?_, ?_, k + 1, ?_, ?_⟩ · apply (mul_le_mul_iff_of_pos_right hFR).mp rw [ht] linarith · apply (mul_le_mul_iff_of_pos_right hFR).mp rw [ht] nlinarith · change (1 : ℝ) / 4 ≤ t * (F : ℝ) - ((k + 1 : ℤ) : ℝ) rw [ht] push_cast norm_num · change t * (F : ℝ) - ((k + 1 : ℤ) : ℝ) ≤ 1 - (1 : ℝ) / 4 rw [ht] push_cast norm_num · let t : ℝ := ((k : ℝ) + 1 / 4) / F have ht : t * F = (k : ℝ) + 1 / 4 := by dsimp [t] field_simp refine ⟨t, ?_, ?_, k, ?_, ?_⟩ · apply (mul_le_mul_iff_of_pos_right hFR).mp rw [ht] linarith · apply (mul_le_mul_iff_of_pos_right hFR).mp rw [ht] nlinarith · change (1 : ℝ) / 4 ≤ t * (F : ℝ) - (k : ℝ) rw [ht] norm_num · change t * (F : ℝ) - (k : ℝ) ≤ 1 - (1 : ℝ) / 4 rw [ht] norm_num /-- A closed simultaneous-good interval must be shorter than any forbidden fourth speed's open bad interval. -/ theorem good_interval_length_lt {a b c F : ℕ} (hF : 0 < F) (hno : NoQuarter a b c F) {l r : ℝ} (hgood : ∀ t : ℝ, l ≤ t → t ≤ r → Quarter t a ∧ Quarter t b ∧ Quarter t c) : r - l < 1 / (2 * (F : ℝ)) := by by_contra h obtain ⟨t, htl, htr, htF⟩ := interval_good_forces_other hF (le_of_not_gt h) obtain ⟨hta, htb, htc⟩ := hgood t htl htr exact hno t ⟨hta, htb, htc, htF⟩ /-- An integer affine section is represented by a real orbit time and two integer lifts. The construction is the elementary Bezout argument. -/ theorem real_orbit_of_integer_kernel {u v : ℕ} (hu : 0 < u) (hcop : Nat.Coprime u v) {x y : ℝ} {z : ℤ} (hz : (v : ℝ) * x - (u : ℝ) * y = z) : ∃ t : ℝ, ∃ m n : ℤ, t * u - m = x ∧ t * v - n = y := by let p : ℤ := Nat.gcdA u v let q : ℤ := Nat.gcdB u v have hbez : (u : ℤ) * p + (v : ℤ) * q = 1 := by rw [← Nat.gcd_eq_gcd_ab, hcop.gcd_eq_one] rfl have hbezR : (u : ℝ) * (p : ℝ) + (v : ℝ) * (q : ℝ) = 1 := by exact_mod_cast hbez let m : ℤ := z * q let n : ℤ := -z * p have hline : (v : ℝ) * (x - m) = (u : ℝ) * (y - n) := by dsimp [m, n] push_cast nlinarith only [hz, congrArg (fun w : ℝ => (z : ℝ) * w) hbezR] have huR : (0 : ℝ) < u := by exact_mod_cast hu let t : ℝ := (x - m) / (u : ℝ) have htu : t * u = x - m := by dsimp [t] exact div_mul_cancel₀ _ huR.ne' have htv : t * v = y - n := by dsimp [t] rw [div_mul_eq_mul_div] apply (div_eq_iff huR.ne').mpr simpa [mul_comm] using hline refine ⟨t, -m, -n, ?_, ?_⟩ <;> push_cast <;> linarith /-- Starting at an integer section of the lower good triangle gives a closed simultaneous-good interval with its explicit section length. -/ theorem triangle_section_interval {u v : ℕ} (hu : 0 < u) (hv : 0 < v) (hcop : Nat.Coprime u v) {x y : ℝ} {z : ℤ} (hx : (1 : ℝ) / 4 ≤ x) (hy : (1 : ℝ) / 4 ≤ y) (hxy : x + y ≤ (3 : ℝ) / 4) (hz : (v : ℝ) * x - (u : ℝ) * y = z) : ∃ l r : ℝ, r - l = ((3 : ℝ) / 4 - x - y) / ((u : ℝ) + v) ∧ ∀ t : ℝ, l ≤ t → t ≤ r → Quarter t u ∧ Quarter t v ∧ Quarter t (u + v) := by obtain ⟨l, m, n, hlu, hlv⟩ := real_orbit_of_integer_kernel hu hcop hz have huR : (0 : ℝ) < u := by exact_mod_cast hu have hvR : (0 : ℝ) < v := by exact_mod_cast hv have hsR : 0 < (u : ℝ) + v := by positivity let L : ℝ := ((3 : ℝ) / 4 - x - y) / ((u : ℝ) + v) have hL : L * ((u : ℝ) + v) = (3 : ℝ) / 4 - x - y := by dsimp [L] exact div_mul_cancel₀ _ hsR.ne' refine ⟨l, l + L, by dsimp [L]; ring, ?_⟩ intro t htl htr have h₀ : 0 ≤ (t - l) * (u : ℝ) := mul_nonneg (by linarith) huR.le have h₁ : 0 ≤ (t - l) * (v : ℝ) := mul_nonneg (by linarith) hvR.le have h₂ : (t - l) * ((u : ℝ) + v) ≤ L * ((u : ℝ) + v) := mul_le_mul_of_nonneg_right (by linarith) hsR.le have htu : (1 : ℝ) / 4 ≤ t * u - m := by nlinarith only [hx, hlu, h₀] have htv : (1 : ℝ) / 4 ≤ t * v - n := by nlinarith only [hy, hlv, h₁] have hsum : t * ((u : ℝ) + v) - ((m : ℝ) + n) ≤ 3 / 4 := by nlinarith only [h₂, hL, hlu, hlv] refine ⟨⟨m, htu, ?_⟩, ⟨n, htv, ?_⟩, ⟨m + n, ?_, ?_⟩⟩ · change t * (u : ℝ) - (m : ℝ) ≤ 1 - (1 : ℝ) / 4 nlinarith only [hsum, htv] · change t * (v : ℝ) - (n : ℝ) ≤ 1 - (1 : ℝ) / 4 nlinarith only [hsum, htu] · change (1 : ℝ) / 4 ≤ t * ((u + v : ℕ) : ℝ) - ((m + n : ℤ) : ℝ) push_cast nlinarith only [htu, htv] · change t * ((u + v : ℕ) : ℝ) - ((m + n : ℤ) : ℝ) ≤ 1 - (1 : ℝ) / 4 push_cast linarith def triangleEta (u v : ℕ) : ℝ := if (v - u) % 4 = 0 then 0 else min ((((v - u) % 4 : ℕ) : ℝ) / (u : ℝ)) ((4 - (((v - u) % 4 : ℕ) : ℝ)) / (v : ℝ)) theorem triangleEta_le_one {u v : ℕ} (hu : 0 < u) (hv : 0 < v) (huv : u ≤ v) : triangleEta u v ≤ 1 := by have huR : (0 : ℝ) < u := by exact_mod_cast hu have hvR : (0 : ℝ) < v := by exact_mod_cast hv have hr4 : (v - u) % 4 < 4 := Nat.mod_lt _ (by omega) unfold triangleEta split_ifs with hr · norm_num · by_cases hv3 : 3 ≤ v · apply (min_le_right _ _).trans apply (div_le_one hvR).2 have hrr : (1 : ℝ) ≤ (((v - u) % 4 : ℕ) : ℝ) := by exact_mod_cast (by omega : 1 ≤ (v-u)%4) have hvR3 : (3 : ℝ) ≤ v := by exact_mod_cast hv3 linarith · apply (min_le_left _ _).trans apply (div_le_one huR).2 have he : (v - u) % 4 = v - u := Nat.mod_eq_of_lt (by omega) exact_mod_cast (by omega : (v - u) % 4 ≤ u) /-- The lower integer section, immediately below the triangle's centre. -/ theorem triangle_left_interval {u v : ℕ} (hu : 0 < u) (hv : 0 < v) (huv : u ≤ v) (hcop : Nat.Coprime u v) (hr : (v - u) % 4 ≤ u) : ∃ l r : ℝ, r - l = (1 - ((((v - u) % 4 : ℕ) : ℝ) / u)) / (4 * ((u : ℝ) + v)) ∧ ∀ t : ℝ, l ≤ t → t ≤ r → Quarter t u ∧ Quarter t v ∧ Quarter t (u + v) := by have huR : (0 : ℝ) < u := by exact_mod_cast hu have hs : (u : ℝ) + v ≠ 0 := by positivity let k : ℕ := (v - u) / 4 let R : ℝ := (((v - u) % 4 : ℕ) : ℝ) have hk : (v : ℝ) - u = 4 * (k : ℝ) + R := by have hi : (v : ℤ) - u = 4 * (k : ℤ) + ((v-u)%4 : ℕ) := by dsimp [k] omega dsimp [R] exact_mod_cast hi have hratio : (u : ℝ) * (R / (4 * u)) = R / 4 := by field_simp [huR.ne'] have hcost : R / (4 * u) ≤ (1 : ℝ) / 4 := by apply (div_le_iff₀ (by positivity : (0 : ℝ) < 4 * u)).2 have hrR : R ≤ (u : ℝ) := by dsimp [R]; exact_mod_cast hr linarith have hker : (v : ℝ) * (1 / 4) - (u : ℝ) * (1 / 4 + R / (4 * u)) = (k : ℤ) := by push_cast nlinarith only [hk, hratio] obtain ⟨l, r, hlen, hg⟩ := triangle_section_interval hu hv hcop (x := 1/4) (y := 1/4 + R/(4*u)) (by norm_num) (by have := div_nonneg (show 0 ≤ R by dsimp [R]; positivity) (by positivity : (0 : ℝ) ≤ 4*u); linarith) (by linarith) hker refine ⟨l, r, ?_, hg⟩ rw [hlen] dsimp [R] field_simp [huR.ne',hs] ring /-- The upper integer section, immediately above the triangle's centre. -/ theorem triangle_right_interval {u v : ℕ} (hu : 0 < u) (hv : 0 < v) (huv : u ≤ v) (hcop : Nat.Coprime u v) (hr : 4 - ((((v - u) % 4 : ℕ) : ℝ)) ≤ (v : ℝ)) : ∃ l r : ℝ, r - l = (1 - ((4 - ((((v - u) % 4 : ℕ) : ℝ))) / v)) / (4 * ((u : ℝ) + v)) ∧ ∀ t : ℝ, l ≤ t → t ≤ r → Quarter t u ∧ Quarter t v ∧ Quarter t (u + v) := by have hvR : (0 : ℝ) < v := by exact_mod_cast hv have hs : (u : ℝ) + v ≠ 0 := by positivity let k : ℕ := (v - u) / 4 let R : ℝ := (((v - u) % 4 : ℕ) : ℝ) have hk : (v : ℝ) - u = 4 * (k : ℝ) + R := by have hi : (v : ℤ) - u = 4 * (k : ℤ) + ((v-u)%4 : ℕ) := by dsimp [k] omega dsimp [R] exact_mod_cast hi have hr4 : R < 4 := by dsimp [R]; exact_mod_cast (Nat.mod_lt (v-u) (by omega : 0 < 4)) have hratio : (v : ℝ) * ((4-R) / (4*v)) = (4-R) / 4 := by field_simp [hvR.ne'] have hcost : (4-R)/(4*v) ≤ (1 : ℝ)/4 := by apply (div_le_iff₀ (by positivity : (0 : ℝ) < 4 * v)).2 linarith have hker : (v : ℝ) * (1/4 + (4-R)/(4*v)) - (u : ℝ)*(1/4) = ((k+1 : ℕ) : ℤ) := by push_cast nlinarith only [hk, hratio] obtain ⟨l, r, hlen, hg⟩ := triangle_section_interval hu hv hcop (x := 1/4 + (4-R)/(4*v)) (y := 1/4) (by have := div_nonneg (by linarith : 0 ≤ 4-R) (by positivity : (0 : ℝ) ≤ 4*v); linarith) (by norm_num) (by linarith) hker refine ⟨l, r, ?_, hg⟩ rw [hlen] dsimp [R] field_simp [hvR.ne',hs] ring theorem triangle_good_interval {u v : ℕ} (hu : 0 < u) (hv : 0 < v) (huv : u ≤ v) (hcop : Nat.Coprime u v) : ∃ l r : ℝ, r - l = (1 - triangleEta u v) / (4*((u : ℝ)+v)) ∧ ∀ t : ℝ, l ≤ t → t ≤ r → Quarter t u ∧ Quarter t v ∧ Quarter t (u + v) := by have huR : (0 : ℝ) < u := by exact_mod_cast hu have hvR : (0 : ℝ) < v := by exact_mod_cast hv have hη := triangleEta_le_one hu hv huv by_cases hr : (v-u)%4=0 · obtain ⟨l,r,hlen,hg⟩ := triangle_left_interval hu hv huv hcop (by omega) exact ⟨l,r, by simpa [triangleEta,hr] using hlen, hg⟩ · by_cases hh : ((((v-u)%4:ℕ):ℝ)/u) ≤ (4-(((v-u)%4:ℕ):ℝ))/v · have hηe : triangleEta u v = (((v-u)%4:ℕ):ℝ)/u := by simp [triangleEta,hr,min_eq_left hh] have hsmall : (v-u)%4 ≤ u := by rw [hηe] at hη exact_mod_cast ((div_le_one huR).mp hη) obtain ⟨l,r,hlen,hg⟩ := triangle_left_interval hu hv huv hcop hsmall exact ⟨l,r, by simpa [hηe] using hlen, hg⟩ · have hηe : triangleEta u v = (4-(((v-u)%4:ℕ):ℝ))/v := by simp [triangleEta,hr,min_eq_right (le_of_not_ge hh)] have hsmall : 4-(((v-u)%4:ℕ):ℝ) ≤ (v:ℝ) := by rw [hηe] at hη exact (div_le_one hvR).mp hη obtain ⟨l,r,hlen,hg⟩ := triangle_right_interval hu hv huv hcop hsmall exact ⟨l,r, by simpa [hηe] using hlen, hg⟩ /-- The triangle interval gives the symbolic fourth-speed inequality. -/ theorem triangle_fourth_bound {u v F : ℕ} (hu : 0 < u) (hv : 0 < v) (huv : u ≤ v) (hcop : Nat.Coprime u v) (hF : 0 < F) (hno : NoQuarter u v (u + v) F) : (F : ℝ) * (1 - triangleEta u v) < 2 * ((u : ℝ) + v) := by obtain ⟨l,r,hlen,hg⟩ := triangle_good_interval hu hv huv hcop have hh := good_interval_length_lt hF hno hg rw [hlen] at hh have hF' : (0 : ℝ) < F := by exact_mod_cast hF have hs : (0 : ℝ) < (u : ℝ) + v := by positivity have hh' := (div_lt_div_iff₀ (by positivity : (0 : ℝ)<4*((u:ℝ)+v)) (by positivity : (0 : ℝ)<2*(F:ℝ))).mp hh nlinarith only [hh'] end Bounty.Pure05 end /- Component: TwoOdd. -/ namespace Bounty.Pure05 open Finset Math15.LonelyRunner Math15.Source05.ThreeSpeed /-- The simultaneous odd-modulus congruences, including the even parity lift. -/ def AdditiveLift (a b G : ℕ) : Prop := ∃ ε δ k : ℤ, (ε = 1 ∨ ε = -1) ∧ (δ = 1 ∨ δ = -1) ∧ (G : ℤ) = ε * a + δ * b + 2 * k * a * b lemma coprime_of_odd_gcd_two {a n : ℕ} (ha : 0 < a) (hao : a % 2 = 1) (hg : Nat.gcd a n ≤ 2) : Nat.Coprime a n := by have hp : 0 < Nat.gcd a n := Nat.gcd_pos_of_pos_left n ha have hn : Nat.gcd a n ≠ 2 := by intro he have hd : 2 ∣ a := by rw [← he]; exact Nat.gcd_dvd_left a n have := Nat.mod_eq_zero_of_dvd hd omega exact (by omega : Nat.gcd a n = 1) lemma int_coprime_cast {a b : ℕ} (h : Nat.Coprime a b) : IsCoprime (a : ℤ) (b : ℤ) := by rw [Int.isCoprime_iff_nat_coprime] simpa only [Int.natAbs_natCast] using h lemma additiveLift_of_congruences {a b G : ℕ} (hao : a % 2 = 1) (hbo : b % 2 = 1) (hGe : G % 2 = 0) (hab : Nat.Coprime a b) (ha : (a : ℤ) ∣ (G : ℤ) - b ∨ (a : ℤ) ∣ (G : ℤ) + b) (hb : (b : ℤ) ∣ (G : ℤ) - a ∨ (b : ℤ) ∣ (G : ℤ) + a) : AdditiveLift a b G := by have htwo : IsCoprime (2 : ℤ) ((a : ℤ) * b) := by have hcop : Nat.Coprime 2 (a * b) := by apply Nat.coprime_two_left.mpr exact ⟨(a * b) / 2, by have he : (a * b) % 2 = 1 := by simp [Nat.mul_mod, hao, hbo] omega⟩ simpa only [Nat.cast_mul, Nat.cast_ofNat] using int_coprime_cast hcop have htwoa : (a : ℤ) % 2 = 1 := by exact_mod_cast hao have htwob : (b : ℤ) % 2 = 1 := by exact_mod_cast hbo have htwoG : (G : ℤ) % 2 = 0 := by exact_mod_cast hGe have build (ε δ : ℤ) (hε : ε = 1 ∨ ε = -1) (hδ : δ = 1 ∨ δ = -1) (hda : (a : ℤ) ∣ (G : ℤ) - δ * b) (hdb : (b : ℤ) ∣ (G : ℤ) - ε * a) : AdditiveLift a b G := by have hboth : (a : ℤ) * b ∣ (G : ℤ) - ε * a - δ * b := by apply (int_coprime_cast hab).mul_dvd · convert dvd_sub hda (dvd_mul_left (a : ℤ) ε) using 1; ring · exact dvd_sub hdb (dvd_mul_left (b : ℤ) δ) have hd2 : (2 : ℤ) ∣ (G : ℤ) - ε * a - δ * b := by apply Int.dvd_iff_emod_eq_zero.mpr rcases hε with rfl | rfl <;> rcases hδ with rfl | rfl <;> simp only [one_mul, neg_one_mul] <;> omega obtain ⟨k, hk⟩ := htwo.mul_dvd hd2 hboth refine ⟨ε, δ, k, hε, hδ, ?_⟩ nlinarith [hk] rcases ha with ha | ha <;> rcases hb with hb | hb · exact build 1 1 (Or.inl rfl) (Or.inl rfl) (by simpa using ha) (by simpa using hb) · exact build (-1) 1 (Or.inr rfl) (Or.inl rfl) (by simpa using ha) (by simpa using hb) · exact build 1 (-1) (Or.inl rfl) (Or.inr rfl) (by simpa using ha) (by simpa using hb) · exact build (-1) (-1) (Or.inr rfl) (Or.inr rfl) (by simpa using ha) (by simpa using hb) lemma lift_base_or_large {a b G : ℕ} (ha : 0 < a) (hab : a < b) (hG : 0 < G) (h : AdditiveLift a b G) : G = a + b ∨ G = b - a ∨ 2 * a * b ≤ G + a + b := by obtain ⟨ε, δ, k, hε, hδ, he⟩ := h have haZ : (1 : ℤ) ≤ a := by omega have hbZ : (2 : ℤ) ≤ b := by omega have hp : (a : ℤ) + b < 2 * a * b := by nlinarith [mul_nonneg (by omega : (0 : ℤ) ≤ (a : ℤ) - 1) (by omega : (0 : ℤ) ≤ (b : ℤ) - 1)] rcases hε with rfl | rfl <;> rcases hδ with rfl | rfl all_goals simp only [one_mul, neg_one_mul] at he rcases lt_trichotomy k 0 with hk | hk | hk · have hka : k * (a : ℤ) ≤ -(a : ℤ) := by nlinarith [mul_nonneg (by omega : (0 : ℤ) ≤ -k - 1) (by omega : (0 : ℤ) ≤ a)] have hkab : k * (a : ℤ) * b ≤ -(a : ℤ) * b := by nlinarith [mul_nonneg (by linarith : (0 : ℤ) ≤ - (a : ℤ) - k * a) (by omega : (0 : ℤ) ≤ b)] have hGZ : (0 : ℤ) < G := by omega exfalso nlinarith · subst k norm_num at he first | exact Or.inl (by exact_mod_cast he) | exact Or.inr (Or.inl (by omega)) · have hka : (a : ℤ) ≤ k * a := by nlinarith [mul_nonneg (by omega : (0 : ℤ) ≤ k - 1) (by omega : (0 : ℤ) ≤ a)] have hkab : (a : ℤ) * b ≤ k * a * b := by nlinarith [mul_nonneg (by linarith : (0 : ℤ) ≤ k * a - a) (by omega : (0 : ℤ) ≤ b)] exact Or.inr (Or.inr (by exact_mod_cast (by nlinarith : (2 : ℤ) * a * b ≤ (G : ℤ) + a + b))) lemma one_lift_large {b G : ℕ} (hb : 3 ≤ b) (hG : b + 1 < G) (h : AdditiveLift 1 b G) : 3 * b ≤ G + 1 := by obtain ⟨ε, δ, k, hε, hδ, he⟩ := h have hbZ : (3 : ℤ) ≤ b := by omega have hGZ : (b : ℤ) + 1 < G := by omega rcases hε with rfl | rfl <;> rcases hδ with rfl | rfl all_goals norm_num at he by_cases hk : k ≤ 0 · have hkb : k * (b : ℤ) ≤ 0 := mul_nonpos_of_nonpos_of_nonneg hk (by omega) exfalso nlinarith · have hk1 : 1 ≤ k := by omega by_cases hk2 : 2 ≤ k · have hkb : 2 * (b : ℤ) ≤ k * b := by nlinarith [mul_nonneg (by omega : (0 : ℤ) ≤ k - 2) (by omega : (0 : ℤ) ≤ b)] exact_mod_cast (by nlinarith : (3 : ℤ) * b ≤ (G : ℤ) + 1) · have heq : k = 1 := by omega subst k norm_num at he first | exact_mod_cast (by omega : (3 : ℤ) * b ≤ (G : ℤ) + 1) lemma small_lift_is_base {a b E : ℕ} (ha : 0 < a) (hab : a < b) (hao : a % 2 = 1) (hbo : b % 2 = 1) (hE : 0 < E) (hbound : E ≤ 3 * b - 3) (h : AdditiveLift a b E) : E = b - a ∨ E = a + b := by by_cases ha1 : a = 1 · subst a have hb : 3 ≤ b := by omega obtain ⟨ε, δ, k, hε, hδ, he⟩ := h have hbZ : (3 : ℤ) ≤ b := by omega have hEZ : (0 : ℤ) < E := by omega have hboundZ : (E : ℤ) ≤ 3 * (b : ℤ) - 3 := by omega rcases hε with rfl | rfl <;> rcases hδ with rfl | rfl all_goals norm_num at he have hk0 : 0 ≤ k := by by_contra hn have hkb : k * (b : ℤ) ≤ -(b : ℤ) := by nlinarith [mul_nonneg (by omega : (0 : ℤ) ≤ -k - 1) (by omega : (0 : ℤ) ≤ b)] nlinarith have hk2 : k < 2 := by by_contra hn have hkb : 2 * (b : ℤ) ≤ k * b := by nlinarith [mul_nonneg (by omega : (0 : ℤ) ≤ k - 2) (by omega : (0 : ℤ) ≤ b)] nlinarith have hk : k = 0 ∨ k = 1 := by omega rcases hk with rfl | rfl <;> norm_num at he <;> first | left; omega | right; omega · have ha3 : 3 ≤ a := by omega have hb5 : 5 ≤ b := by omega obtain hsum | hdiff | hlarge := lift_base_or_large ha hab hE h · exact Or.inr hsum · exact Or.inl hdiff · have hprod : a + 4 * b < 2 * a * b := by exact_mod_cast (by nlinarith [mul_nonneg (by omega : (0 : ℤ) ≤ (a : ℤ) - 3) (by omega : (0 : ℤ) ≤ (b : ℤ) - 5)] : (a : ℤ) + 4 * b < 2 * a * b) omega lemma quarter_half_shift_even {t : ℝ} {v : ℕ} (hve : v % 2 = 0) (h : Quarter t v) : Quarter (t + 1 / 2) v := by obtain ⟨k, hlo, hhi⟩ := h let q : ℤ := (v / 2 : ℕ) have hv : (v : ℝ) = 2 * (q : ℝ) := by dsimp [q] exact_mod_cast (by omega : v = 2 * (v / 2)) simp only [Int.cast_natCast] at hlo hhi refine ⟨k + q, ?_, ?_⟩ <;> simp only [Int.cast_add, Int.cast_natCast] <;> nlinarith lemma quarter_half_shift_small_odd {t : ℝ} {v : ℕ} (hvo : v % 2 = 1) (ht : 0 ≤ t) (hv : t * v ≤ 1 / 4) : Quarter (t + 1 / 2) v := by let q : ℤ := (v / 2 : ℕ) have hve : (v : ℝ) = 2 * (q : ℝ) + 1 := by dsimp [q] exact_mod_cast (by omega : v = 2 * (v / 2) + 1) have hnonneg : 0 ≤ t * (v : ℝ) := mul_nonneg ht (Nat.cast_nonneg v) refine ⟨q, ?_, ?_⟩ <;> simp only [Int.cast_natCast] <;> nlinarith lemma quarter_or_half_shift_odd (t : ℝ) {v : ℕ} (hvo : v % 2 = 1) : Quarter t v ∨ Quarter (t + 1 / 2) v := by let k : ℤ := ⌊t * (v : ℝ)⌋ have hlo : (k : ℝ) ≤ t * v := Int.floor_le _ have hhi : t * v < (k : ℝ) + 1 := Int.lt_floor_add_one _ let q : ℤ := (v / 2 : ℕ) have hve : (v : ℝ) = 2 * (q : ℝ) + 1 := by dsimp [q] exact_mod_cast (by omega : v = 2 * (v / 2) + 1) by_cases hlow : (1 / 4 : ℝ) ≤ t * v - k · by_cases hhigh : t * (v : ℝ) - k ≤ 3 / 4 · exact Or.inl ⟨k, by simpa only [Int.cast_natCast] using hlow, by simp only [Int.cast_natCast]; linarith⟩ · right refine ⟨k + q + 1, ?_, ?_⟩ <;> simp only [Int.cast_add, Int.cast_natCast, Int.cast_one] <;> nlinarith · right refine ⟨k + q, ?_, ?_⟩ <;> simp only [Int.cast_add, Int.cast_natCast] <;> nlinarith lemma good_of_product_difference {δ t s : ℝ} {v w m : ℤ} (he : t * (v : ℝ) - s * (w : ℝ) = m) (h : Good δ s w) : Good δ t v := by obtain ⟨k, hlo, hhi⟩ := h refine ⟨k + m, ?_, ?_⟩ <;> push_cast <;> linarith lemma quarter_of_product_eq {t s : ℝ} {v w : ℕ} (he : t * (v : ℝ) = s * (w : ℝ)) (h : Quarter s w) : Quarter t v := by apply good_of_product_difference (m := 0) (h := h) simp only [Int.cast_natCast, Int.cast_zero] linarith only [he] lemma quarter_scale_fraction {N m : ℝ} {G d : ℕ} (hN : 0 < N) (hd : 0 < d) (hGe : G % d = 0) : Quarter (m / N) (G / d) ↔ Quarter (m / ((d : ℝ) * N)) G := by have hdR : (0 : ℝ) < d := by exact_mod_cast hd have hG : (G : ℝ) = (d : ℝ) * (G / d : ℕ) := by exact_mod_cast (by have hh := Nat.mod_add_div G d; omega : G = d * (G / d)) have he : (m / N) * ((G / d : ℕ) : ℝ) = (m / ((d : ℝ) * N)) * (G : ℝ) := by rw [hG] field_simp exact ⟨quarter_of_product_eq he.symm, quarter_of_product_eq he⟩ lemma quarter_odd_grid_boundary {n : ℕ} (hn : 0 < n) (hno : n % 2 = 1) (j : ℤ) : Quarter (((2 * (j : ℝ) + 1) / (4 * n))) n ∧ Quarter (((2 * (j : ℝ) + 1) / (4 * n)) + 1 / 2) n := by have hnR : (0 : ℝ) < n := by exact_mod_cast hn have htn : ((2 * (j : ℝ) + 1) / (4 * n)) * (n : ℝ) = (2 * (j : ℝ) + 1) / 4 := by field_simp let q : ℤ := (n / 2 : ℕ) have hnEq : (n : ℝ) = 2 * (q : ℝ) + 1 := by dsimp [q] exact_mod_cast (by omega : n = 2 * (n / 2) + 1) by_cases hj : j % 2 = 0 · have hjEq : (j : ℝ) = 2 * ((j / 2 : ℤ) : ℝ) := by exact_mod_cast (by omega : j = 2 * (j / 2)) refine ⟨⟨j / 2, ?_, ?_⟩, ⟨j / 2 + q, ?_, ?_⟩⟩ <;> simp only [Int.cast_natCast, Int.cast_add] <;> nlinarith only [htn, hjEq, hnEq] · have hjEq : (j : ℝ) = 2 * ((j / 2 : ℤ) : ℝ) + 1 := by have hmod : j % 2 = 1 := by omega exact_mod_cast (by omega : j = 2 * (j / 2) + 1) refine ⟨⟨j / 2, ?_, ?_⟩, ⟨j / 2 + q + 1, ?_, ?_⟩⟩ <;> simp only [Int.cast_natCast, Int.cast_add, Int.cast_one] <;> nlinarith only [htn, hjEq, hnEq] lemma quarter_half_grid {n : ℕ} (hn : 0 < n) (j : ℤ) : Quarter ((2 * (j : ℝ) + 1) / (2 * n)) n := by have hnR : (0 : ℝ) < n := by exact_mod_cast hn have htn : ((2 * (j : ℝ) + 1) / (2 * n)) * (n : ℝ) = (j : ℝ) + 1 / 2 := by field_simp refine ⟨j, ?_, ?_⟩ <;> simp only [Int.cast_natCast] <;> linarith lemma noQuarter_even_quarter_grid {n m E F : ℕ} (hn : 0 < n) (hno : n % 2 = 1) (hmo : m % 2 = 1) (hEe : E % 2 = 0) (hFe : F % 2 = 0) (hbad : NoQuarter n m E F) (j : ℤ) : ¬ (Quarter ((2 * (j : ℝ) + 1) / (4 * n)) E ∧ Quarter ((2 * (j : ℝ) + 1) / (4 * n)) F) := by rintro ⟨hE, hF⟩ obtain ⟨hn₁, hn₂⟩ := quarter_odd_grid_boundary hn hno j rcases quarter_or_half_shift_odd ((2 * (j : ℝ) + 1) / (4 * n)) hmo with hm | hm · exact hbad _ ⟨hn₁, hm, hE, hF⟩ · exact hbad _ ⟨hn₂, hm, quarter_half_shift_even hEe hE, quarter_half_shift_even hFe hF⟩ lemma even_grid_congruence {n m E F : ℕ} (hn : 0 < n) (hno : n % 2 = 1) (hmo : m % 2 = 1) (hEe : E % 2 = 0) (hFe : F % 2 = 0) (hE : 0 < E) (_hF : 0 < F) (hfour : E % 4 = 0 ∨ F % 4 = 0) (hgEF : Nat.gcd E F ≤ 2) (hcopE : Nat.Coprime n E) (hcopF : Nat.Coprime n F) (hbad : NoQuarter n m E F) : (n : ℤ) ∣ ((E / 2 : ℕ) : ℤ) - ((F / 2 : ℕ) : ℤ) ∨ (n : ℤ) ∣ ((E / 2 : ℕ) : ℤ) + ((F / 2 : ℕ) : ℤ) := by have hnR : (0 : ℝ) < n := by exact_mod_cast hn have hnotboth : ¬ (E % 4 = 0 ∧ F % 4 = 0) := by rintro ⟨hE4, hF4⟩ have hd : 4 ∣ Nat.gcd E F := Nat.dvd_gcd (Nat.dvd_iff_mod_eq_zero.mpr hE4) (Nat.dvd_iff_mod_eq_zero.mpr hF4) have hh := Nat.le_of_dvd (Nat.gcd_pos_of_pos_left F hE) hd omega have hcases : (E % 4 = 0 ∧ F % 4 = 2) ∨ (E % 4 = 2 ∧ F % 4 = 0) := by omega have core {G H : ℕ} (hG4 : G % 4 = 0) (hHe : H % 2 = 0) (hHo : (H / 2) % 2 = 1) (hcopG : Nat.Coprime n G) (hcopH : Nat.Coprime n H) (hgrid : ∀ j : ℤ, ¬ (Quarter ((2 * (j : ℝ) + 1) / (4 * n)) G ∧ Quarter ((2 * (j : ℝ) + 1) / (4 * n)) H)) : (n : ℤ) ∣ ((G / 2 : ℕ) : ℤ) - ((H / 2 : ℕ) : ℤ) ∨ (n : ℤ) ∣ ((G / 2 : ℕ) : ℤ) + ((H / 2 : ℕ) : ℤ) := by have hcG : Nat.Coprime n (G / 4) := Nat.Coprime.of_dvd_right (Nat.div_dvd_of_dvd (Nat.dvd_iff_mod_eq_zero.mpr hG4)) hcopG have hcH : Nat.Coprime n (H / 2) := Nat.Coprime.of_dvd_right (Nat.div_dvd_of_dvd (Nat.dvd_iff_mod_eq_zero.mpr hHe)) hcopH have hh := grid_rigidity hn hno hHo hcG hcH (by intro j h have hGgood := (quarter_scale_fraction hnR (by decide : 0 < 4) hG4).mp h.1 have hHgood := (quarter_scale_fraction (by positivity : (0 : ℝ) < 2 * n) (by decide : 0 < 2) hHe).mp h.2 apply hgrid j constructor · simpa only [Int.cast_mul, Int.cast_add, Int.cast_ofNat, Int.cast_one, Nat.cast_ofNat] using hGgood · convert hHgood using 1; push_cast; ring) have hGeq : (G / 2 : ℕ) = 2 * (G / 4) := by omega simpa only [hGeq, Nat.cast_mul, Nat.cast_ofNat] using hh rcases hcases with ⟨hE4, hF2⟩ | ⟨hE2, hF4⟩ · exact core hE4 hFe (by omega) hcopE hcopF (noQuarter_even_quarter_grid hn hno hmo hEe hFe hbad) · have hh := core hF4 hEe (by omega) hcopF hcopE (by intro j h exact noQuarter_even_quarter_grid hn hno hmo hEe hFe hbad j ⟨h.2, h.1⟩) rcases hh with hh | hh · left convert dvd_neg.mpr hh using 1; ring · right convert hh using 1; ring lemma quarter_half_grid_transfer {n E F : ℕ} (hn : 0 < n) (hEe : E % 2 = 0) (hFe : F % 2 = 0) (hcon : (n : ℤ) ∣ ((E / 2 : ℕ) : ℤ) - ((F / 2 : ℕ) : ℤ) ∨ (n : ℤ) ∣ ((E / 2 : ℕ) : ℤ) + ((F / 2 : ℕ) : ℤ)) (j : ℤ) (hE : Quarter ((2 * (j : ℝ) + 1) / (2 * n)) E) : Quarter ((2 * (j : ℝ) + 1) / (2 * n)) F := by have hnR : (0 : ℝ) < n := by exact_mod_cast hn have hER : (E : ℝ) = 2 * ((E / 2 : ℕ) : ℝ) := by exact_mod_cast (by omega : E = 2 * (E / 2)) have hFR : (F : ℝ) = 2 * ((F / 2 : ℕ) : ℝ) := by exact_mod_cast (by omega : F = 2 * (F / 2)) rcases hcon with ⟨k, hk⟩ | ⟨k, hk⟩ · have hkR : ((E / 2 : ℕ) : ℝ) - ((F / 2 : ℕ) : ℝ) = (n : ℝ) * k := by have hc := congrArg (fun z : ℤ => (z : ℝ)) hk simpa only [Int.cast_sub, Int.cast_mul, Int.cast_natCast] using hc have hFeq : (F : ℝ) = (E : ℝ) - 2 * n * k := by nlinarith only [hER, hFR, hkR] apply good_of_product_difference (m := -(2 * j + 1) * k) (h := hE) simp only [Int.cast_natCast, Int.cast_mul, Int.cast_neg, Int.cast_add, Int.cast_ofNat, Int.cast_one] rw [hFeq] field_simp ring · have hkR : ((E / 2 : ℕ) : ℝ) + ((F / 2 : ℕ) : ℝ) = (n : ℝ) * k := by have hc := congrArg (fun z : ℤ => (z : ℝ)) hk simpa only [Int.cast_add, Int.cast_mul, Int.cast_natCast] using hc have hFeq : (F : ℝ) = -(E : ℝ) + 2 * n * k := by nlinarith only [hER, hFR, hkR] apply good_of_product_difference (s := (2 * (j : ℝ) + 1) / (2 * n)) (w := -(E : ℤ)) (m := (2 * j + 1) * k) · simp only [Int.cast_natCast, Int.cast_mul, Int.cast_neg, Int.cast_add, Int.cast_ofNat, Int.cast_one] rw [hFeq] field_simp ring · exact good_neg_speed.mpr hE lemma half_grid_congruence {n m E F : ℕ} (hn : 0 < n) (hno : n % 2 = 1) (hmo : m % 2 = 1) (hEe : E % 2 = 0) (hFe : F % 2 = 0) (hcopE : Nat.Coprime n E) (hcopM : Nat.Coprime n m) (hcon : (n : ℤ) ∣ ((E / 2 : ℕ) : ℤ) - ((F / 2 : ℕ) : ℤ) ∨ (n : ℤ) ∣ ((E / 2 : ℕ) : ℤ) + ((F / 2 : ℕ) : ℤ)) (hbad : NoQuarter n m E F) : (n : ℤ) ∣ (E : ℤ) - m ∨ (n : ℤ) ∣ (E : ℤ) + m := by have hnR : (0 : ℝ) < n := by exact_mod_cast hn have hcopHalf : Nat.Coprime n (E / 2) := Nat.Coprime.of_dvd_right (Nat.div_dvd_of_dvd (Nat.dvd_iff_mod_eq_zero.mpr hEe)) hcopE have hh := grid_rigidity hn hno hmo hcopHalf hcopM (by intro j h have hE' := (quarter_scale_fraction hnR (by decide : 0 < 2) hEe).mp h.1 have hEgood : Quarter ((2 * (j : ℝ) + 1) / (2 * n)) E := by simpa only [Int.cast_mul, Int.cast_add, Int.cast_ofNat, Int.cast_one, Nat.cast_ofNat] using hE' have hm : Quarter ((2 * (j : ℝ) + 1) / (2 * n)) m := by simpa only [Int.cast_mul, Int.cast_add, Int.cast_ofNat, Int.cast_one] using h.2 exact hbad _ ⟨quarter_half_grid hn j, hm, hEgood, quarter_half_grid_transfer hn hEe hFe hcon j hEgood⟩) have hEeq : (E : ℤ) = 2 * ((E / 2 : ℕ) : ℤ) := by omega simpa only [← hEeq] using hh lemma even_congruence_other {n m E F : ℕ} (hEe : E % 2 = 0) (hFe : F % 2 = 0) (hcon : (n : ℤ) ∣ ((E / 2 : ℕ) : ℤ) - ((F / 2 : ℕ) : ℤ) ∨ (n : ℤ) ∣ ((E / 2 : ℕ) : ℤ) + ((F / 2 : ℕ) : ℤ)) (hE : (n : ℤ) ∣ (E : ℤ) - m ∨ (n : ℤ) ∣ (E : ℤ) + m) : (n : ℤ) ∣ (F : ℤ) - m ∨ (n : ℤ) ∣ (F : ℤ) + m := by have hEeq : (E : ℤ) = 2 * ((E / 2 : ℕ) : ℤ) := by omega have hFeq : (F : ℤ) = 2 * ((F / 2 : ℕ) : ℤ) := by omega have hfull : (n : ℤ) ∣ (E : ℤ) - F ∨ (n : ℤ) ∣ (E : ℤ) + F := by rcases hcon with hh | hh · left rw [hEeq, hFeq] convert dvd_mul_of_dvd_right hh (2 : ℤ) using 1; ring · right rw [hEeq, hFeq] convert dvd_mul_of_dvd_right hh (2 : ℤ) using 1; ring rcases hfull with hh | hh <;> rcases hE with hE | hE · left convert dvd_sub hE hh using 1; ring · right convert dvd_sub hE hh using 1; ring · right convert dvd_sub hh hE using 1; ring · left convert dvd_sub hh hE using 1; ring /-- The quarter grid and half grid force both even-speed congruences. -/ lemma even_signed_mod_congruences {n m E F : ℕ} (hn : 0 < n) (hno : n % 2 = 1) (hmo : m % 2 = 1) (hE : 0 < E) (hF : 0 < F) (hEe : E % 2 = 0) (hFe : F % 2 = 0) (hfour : E % 4 = 0 ∨ F % 4 = 0) (hgnm : Nat.gcd n m ≤ 2) (hgnE : Nat.gcd n E ≤ 2) (hgnF : Nat.gcd n F ≤ 2) (hgEF : Nat.gcd E F ≤ 2) (hbad : NoQuarter n m E F) : ((n : ℤ) ∣ (E : ℤ) - m ∨ (n : ℤ) ∣ (E : ℤ) + m) ∧ ((n : ℤ) ∣ (F : ℤ) - m ∨ (n : ℤ) ∣ (F : ℤ) + m) := by have hcopE := coprime_of_odd_gcd_two hn hno hgnE have hcopF := coprime_of_odd_gcd_two hn hno hgnF have hcopM := coprime_of_odd_gcd_two hn hno hgnm have hcon := even_grid_congruence hn hno hmo hEe hFe hE hF hfour hgEF hcopE hcopF hbad have hEmod := half_grid_congruence hn hno hmo hEe hFe hcopE hcopM hcon hbad exact ⟨hEmod, even_congruence_other hEe hFe hcon hEmod⟩ lemma two_even_additive_lifts {a b E F : ℕ} (ha : 0 < a) (hb : 0 < b) (hE : 0 < E) (hF : 0 < F) (hao : a % 2 = 1) (hbo : b % 2 = 1) (hEe : E % 2 = 0) (hFe : F % 2 = 0) (hfour : E % 4 = 0 ∨ F % 4 = 0) (hg : PairwiseGcdTwo a b E F) (hbad : NoQuarter a b E F) : AdditiveLift a b E ∧ AdditiveLift a b F := by obtain ⟨hgAB, hgAE, hgAF, hgBE, hgBF, hgEF⟩ := hg have hmodA := even_signed_mod_congruences ha hao hbo hE hF hEe hFe hfour hgAB hgAE hgAF hgEF hbad have hbad' : NoQuarter b a E F := by intro t ht exact hbad t ⟨ht.2.1, ht.1, ht.2.2.1, ht.2.2.2⟩ have hmodB := even_signed_mod_congruences hb hbo hao hE hF hEe hFe hfour (by simpa only [Nat.gcd_comm] using hgAB) hgBE hgBF hgEF hbad' have hcop := coprime_of_odd_gcd_two ha hao hgAB exact ⟨additiveLift_of_congruences hao hbo hEe hcop hmodA.1 hmodB.1, additiveLift_of_congruences hao hbo hFe hcop hmodA.2 hmodB.2⟩ lemma even_interval_contradiction {a b E F : ℕ} (hb : 0 < b) (hab : a ≤ b) (hao : a % 2 = 1) (hbo : b % 2 = 1) (hEe : E % 2 = 0) (hFe : F % 2 = 0) (hF : 0 < F) (hbad : NoQuarter a b E F) {l r : ℝ} (hl : 0 ≤ l) (hr : r ≤ 1 / (4 * (b : ℝ))) (hgood : ∀ t : ℝ, l ≤ t → t ≤ r → Quarter t E) (hlen : 1 / (2 * (F : ℝ)) ≤ r - l) : False := by obtain ⟨t, htl, htr, htF⟩ := interval_good_forces_other hF hlen have ht0 : 0 ≤ t := hl.trans htl have hbR : (0 : ℝ) < b := by exact_mod_cast hb have htb : t * (b : ℝ) ≤ 1 / 4 := by have hh := (le_div_iff₀ (by positivity : (0 : ℝ) < 4 * b)).mp (htr.trans hr) nlinarith only [hh] have hta : t * (a : ℝ) ≤ 1 / 4 := (mul_le_mul_of_nonneg_left (by exact_mod_cast hab) ht0).trans htb exact hbad (t + 1 / 2) ⟨quarter_half_shift_small_odd hao ht0 hta, quarter_half_shift_small_odd hbo ht0 htb, quarter_half_shift_even hEe (hgood t htl htr), quarter_half_shift_even hFe htF⟩ /-- The first even-speed interval already forces the small lift range. -/ lemma smaller_even_bound {a b E F : ℕ} (ha : 0 < a) (hab : a < b) (hE : 0 < E) (hEF : E < F) (hao : a % 2 = 1) (hbo : b % 2 = 1) (hEe : E % 2 = 0) (hFe : F % 2 = 0) (hbad : NoQuarter a b E F) : E ≤ 3 * b - 3 := by have hb : 0 < b := by omega have hb3 : 3 ≤ b := by omega have hF : 0 < F := by omega have hbR : (0 : ℝ) < b := by exact_mod_cast hb have hER : (0 : ℝ) < E := by exact_mod_cast hE have hFR : (0 : ℝ) < F := by exact_mod_cast hF have hEFR : (E : ℝ) < F := by exact_mod_cast hEF by_contra hn have hElo : 3 * b - 1 ≤ E := by omega by_cases hEhi : 3 * b ≤ E · have hEhiR : 3 * (b : ℝ) ≤ E := by exact_mod_cast hEhi apply even_interval_contradiction hb hab.le hao hbo hEe hFe hF hbad (l := 1 / (4 * E)) (r := 3 / (4 * E)) (by positivity) · apply (div_le_div_iff₀ (by positivity) (by positivity)).mpr nlinarith only [hEhiR] · intro t htl htr have hlo := (div_le_iff₀ (by positivity : (0 : ℝ) < 4 * E)).mp htl have hhi := (le_div_iff₀ (by positivity : (0 : ℝ) < 4 * E)).mp htr refine ⟨0, ?_, ?_⟩ <;> simp only [Int.cast_natCast, Int.cast_zero] <;> nlinarith only [hlo, hhi] · have he : (3 : ℝ) / (4 * E) - 1 / (4 * E) = 1 / (2 * E) := by field_simp ring rw [he] exact one_div_le_one_div_of_le (by positivity) (by linarith) · have hEeql : E = 3 * b - 1 := by omega have hEeqR : (E : ℝ) = 3 * (b : ℝ) - 1 := by exact_mod_cast (by omega : (E : ℤ) = 3 * (b : ℤ) - 1) have hEFeven : E + 2 ≤ F := by omega have hEFevenR : (E : ℝ) + 2 ≤ F := by exact_mod_cast hEFeven apply even_interval_contradiction hb hab.le hao hbo hEe hFe hF hbad (l := 1 / (4 * E)) (r := 1 / (4 * b)) (by positivity) le_rfl · intro t htl htr have ht0 : 0 ≤ t := (by positivity : (0 : ℝ) ≤ 1 / (4 * E)).trans htl have hlo := (div_le_iff₀ (by positivity : (0 : ℝ) < 4 * E)).mp htl have hhi := (le_div_iff₀ (by positivity : (0 : ℝ) < 4 * b)).mp htr have hmul : t * (E : ℝ) ≤ t * (3 * b) := mul_le_mul_of_nonneg_left (by linarith) ht0 refine ⟨0, ?_, ?_⟩ <;> simp only [Int.cast_natCast, Int.cast_zero] <;> nlinarith only [hlo, hhi, hmul] · have he : (1 : ℝ) / (4 * b) - 1 / (4 * E) = ((E : ℝ) - b) / (4 * b * E) := by field_simp rw [he] apply (one_div_le_one_div_of_le (by positivity : (0 : ℝ) < 2 * ((E : ℝ) + 2)) (by linarith : 2 * ((E : ℝ) + 2) ≤ 2 * F)).trans apply le_of_lt apply (div_lt_div_iff₀ (by positivity) (by positivity)).mpr rw [hEeqR] have hbR3 : (3 : ℝ) ≤ b := by exact_mod_cast hb3 nlinarith lemma not_noQuarter_35822 : ¬ NoQuarter 3 5 8 22 := by intro h apply h (7 / 15) refine ⟨⟨1, ?_, ?_⟩, ⟨2, ?_, ?_⟩, ⟨3, ?_, ?_⟩, ⟨10, ?_, ?_⟩⟩ <;> norm_num lemma not_noQuarter_17620 : ¬ NoQuarter 1 7 6 20 := by intro h apply h (3 / 8) refine ⟨⟨0, ?_, ?_⟩, ⟨2, ?_, ?_⟩, ⟨2, ?_, ?_⟩, ⟨7, ?_, ?_⟩⟩ <;> norm_num lemma not_noQuarter_17622 : ¬ NoQuarter 1 7 6 22 := by intro h apply h (1 / 4) refine ⟨⟨0, ?_, ?_⟩, ⟨1, ?_, ?_⟩, ⟨1, ?_, ?_⟩, ⟨5, ?_, ?_⟩⟩ <;> norm_num lemma not_noQuarter_17822 : ¬ NoQuarter 1 7 8 22 := by intro h apply h (1 / 3) refine ⟨⟨0, ?_, ?_⟩, ⟨2, ?_, ?_⟩, ⟨2, ?_, ?_⟩, ⟨7, ?_, ?_⟩⟩ <;> norm_num lemma not_noQuarter_13410 : ¬ NoQuarter 1 3 4 10 := by intro h apply h (3 / 7) refine ⟨⟨0, ?_, ?_⟩, ⟨1, ?_, ?_⟩, ⟨1, ?_, ?_⟩, ⟨4, ?_, ?_⟩⟩ <;> norm_num lemma not_noQuarter_13422 : ¬ NoQuarter 1 3 4 22 := by intro h apply h (3 / 7) refine ⟨⟨0, ?_, ?_⟩, ⟨1, ?_, ?_⟩, ⟨1, ?_, ?_⟩, ⟨9, ?_, ?_⟩⟩ <;> norm_num lemma large_lift_not_lt_four_b {a b F : ℕ} (ha : 3 ≤ a) (hb : 5 ≤ b) (hlarge : 2 * a * b ≤ F + a + b) (hbound : (F : ℝ) < 4 * b) : False := by have haR : (3 : ℝ) ≤ a := by exact_mod_cast ha have hbR : (5 : ℝ) ≤ b := by exact_mod_cast hb have hlargeR : (2 : ℝ) * a * b ≤ (F : ℝ) + a + b := by exact_mod_cast hlarge nlinarith [mul_nonneg (by linarith : (0 : ℝ) ≤ (a : ℝ) - 3) (by linarith : (0 : ℝ) ≤ 2 * (b : ℝ) - 1)] lemma large_lift_not_lt_twice_sum {a b F : ℕ} (ha : 3 ≤ a) (hb : 5 ≤ b) (hlarge : 2 * a * b ≤ F + a + b) (hbound : (F : ℝ) < 2 * ((a : ℝ) + b)) : False := by have haR : (3 : ℝ) ≤ a := by exact_mod_cast ha have hbR : (5 : ℝ) ≤ b := by exact_mod_cast hb have hlargeR : (2 : ℝ) * a * b ≤ (F : ℝ) + a + b := by exact_mod_cast hlarge nlinarith [mul_nonneg (by linarith : (0 : ℝ) ≤ (a : ℝ) - 3) (by linarith : (0 : ℝ) ≤ 2 * (b : ℝ) - 3)] lemma large_sum_lift_impossible {a b F : ℕ} (ha : 3 ≤ a) (hb : 7 ≤ b) (hlarge : 2 * a * b ≤ F + a + b) (hbound : (F : ℝ) * ((b : ℝ) - 2) < 2 * b * ((a : ℝ) + b)) : False := by have haR : (3 : ℝ) ≤ a := by exact_mod_cast ha have hbR : (7 : ℝ) ≤ b := by exact_mod_cast hb have hlargeR : (2 : ℝ) * a * b ≤ (F : ℝ) + a + b := by exact_mod_cast hlarge have hQ : (0 : ℝ) ≤ 2 * (b : ℝ) ^ 2 - 7 * b + 2 := by nlinarith [mul_nonneg (by linarith : (0 : ℝ) ≤ (b : ℝ) - 7) (by linarith : (0 : ℝ) ≤ 2 * (b : ℝ) + 7)] have hP := mul_nonneg (by linarith : (0 : ℝ) ≤ (a : ℝ) - 3) hQ have hL := mul_nonneg (by linarith : (0 : ℝ) ≤ (F : ℝ) + a + b - 2 * a * b) (by linarith : (0 : ℝ) ≤ (b : ℝ) - 2) have hpositive : (0 : ℝ) < (3 * (b : ℝ) - 1) * ((b : ℝ) - 6) := mul_pos (by linarith) (by linarith) nlinarith lemma large_one_diff_one_impossible {b F : ℕ} (hb : 5 ≤ b) (hlarge : 3 * b ≤ F + 1) (hbound : (F : ℝ) * ((b : ℝ) - 2) < 2 * b * ((b : ℝ) - 1)) : False := by have hbR : (5 : ℝ) ≤ b := by exact_mod_cast hb have hlargeR : (3 : ℝ) * b ≤ (F : ℝ) + 1 := by exact_mod_cast hlarge nlinarith [mul_nonneg (by linarith : (0 : ℝ) ≤ (F : ℝ) + 1 - 3 * b) (by linarith : (0 : ℝ) ≤ (b : ℝ) - 2), mul_nonneg (by linarith : (0 : ℝ) ≤ (b : ℝ)) (by linarith : (0 : ℝ) ≤ (b : ℝ) - 5)] lemma large_one_diff_three_impossible {b F : ℕ} (hb : 11 ≤ b) (hlarge : 3 * b ≤ F + 1) (hbound : (F : ℝ) * ((b : ℝ) - 4) < 2 * b * ((b : ℝ) - 1)) : False := by have hbR : (11 : ℝ) ≤ b := by exact_mod_cast hb have hlargeR : (3 : ℝ) * b ≤ (F : ℝ) + 1 := by exact_mod_cast hlarge nlinarith [mul_nonneg (by linarith : (0 : ℝ) ≤ (F : ℝ) + 1 - 3 * b) (by linarith : (0 : ℝ) ≤ (b : ℝ) - 4), mul_nonneg (by linarith : (0 : ℝ) ≤ (b : ℝ)) (by linarith : (0 : ℝ) ≤ (b : ℝ) - 11)] lemma large_one_sum_three_impossible {b F : ℕ} (hb : 11 ≤ b) (hlarge : 3 * b ≤ F + 1) (hbound : (F : ℝ) * ((b : ℝ) - 2) < 2 * b * ((b : ℝ) + 1)) : False := by have hbR : (11 : ℝ) ≤ b := by exact_mod_cast hb have hlargeR : (3 : ℝ) * b ≤ (F : ℝ) + 1 := by exact_mod_cast hlarge nlinarith [mul_nonneg (by linarith : (0 : ℝ) ≤ (F : ℝ) + 1 - 3 * b) (by linarith : (0 : ℝ) ≤ (b : ℝ) - 2), mul_nonneg (by linarith : (0 : ℝ) ≤ (b : ℝ)) (by linarith : (0 : ℝ) ≤ (b : ℝ) - 9)] lemma lift_three_five_bounded {F : ℕ} (hlo : 8 < F) (hhi : F < 27) (h : AdditiveLift 3 5 F) : F = 22 := by obtain ⟨ε, δ, k, hε, hδ, he⟩ := h rcases hε with rfl | rfl <;> rcases hδ with rfl | rfl <;> norm_num at he <;> omega lemma lift_one_seven_bounded {F : ℕ} (hlo : 8 < F) (hhi : F < 28) (h : AdditiveLift 1 7 F) : F = 20 ∨ F = 22 := by obtain ⟨ε, δ, k, hε, hδ, he⟩ := h rcases hε with rfl | rfl <;> rcases hδ with rfl | rfl <;> norm_num at he <;> omega lemma classified_difference_sum {a b : ℕ} (ha : 0 < a) (hab : a < b) (hcop : Nat.Coprime a b) : Classified ({a, b, b - a, a + b} : Finset ℕ) := by apply Or.inr apply Or.inl refine ⟨b, a, ha, hab, hcop.symm, ?_⟩ ext n simp only [Bounty.Families.familyTwo, Finset.mem_insert, Finset.mem_singleton, add_comm a b] tauto lemma classified_one_three_two {F : ℕ} (hF : 0 < F) (hfour : F % 4 = 0) : Classified ({1, 3, 2, F} : Finset ℕ) := by apply Or.inl refine ⟨F / 4, by omega, ?_⟩ have he : F = 4 * (F / 4) := by omega ext n simp only [Bounty.Families.familyOne, Finset.mem_insert, Finset.mem_singleton, ← he] tauto lemma classified_one_three_four {F : ℕ} (hF : 4 < F) (hFe : F % 2 = 0) (hfour : Nat.gcd 4 F ≤ 2) (hthree : Nat.gcd 3 F ≤ 2) (hbound : (F : ℝ) < 24) (hbad : NoQuarter 1 3 4 F) : Classified ({1, 3, 4, F} : Finset ℕ) := by have hFmod : F % 4 ≠ 0 := by intro hm have hg : 4 ∣ Nat.gcd 4 F := Nat.dvd_gcd (dvd_refl 4) (Nat.dvd_iff_mod_eq_zero.mpr hm) have hp : 0 < Nat.gcd 4 F := Nat.gcd_pos_of_pos_left F (by decide) have := Nat.le_of_dvd hp hg omega have hFthree : F % 3 ≠ 0 := by intro hm have hg : 3 ∣ Nat.gcd 3 F := Nat.dvd_gcd (dvd_refl 3) (Nat.dvd_iff_mod_eq_zero.mpr hm) have hp : 0 < Nat.gcd 3 F := Nat.gcd_pos_of_pos_left F (by decide) have := Nat.le_of_dvd hp hg omega have hFbound : F < 24 := by exact_mod_cast hbound have hcases : F = 10 ∨ F = 14 ∨ F = 22 := by omega rcases hcases with rfl | rfl | rfl · exact (not_noQuarter_13410 hbad).elim · exact Or.inr (Or.inr rfl) · exact (not_noQuarter_13422 hbad).elim lemma noQuarter_reorder_triple {a b c F u v w : ℕ} (hset : ({a, b, c} : Finset ℕ) = {u, v, w}) (hno : NoQuarter a b c F) : NoQuarter u v w F := by intro t ht have hall : ∀ n ∈ ({a, b, c} : Finset ℕ), Quarter t n := by intro n hn rw [hset] at hn simp only [Finset.mem_insert, Finset.mem_singleton] at hn rcases hn with rfl | rfl | rfl · exact ht.1 · exact ht.2.1 · exact ht.2.2.1 exact hno t ⟨hall a (by simp), hall b (by simp), hall c (by simp), ht.2.2.2⟩ /-- The six interval inequalities needed by the arithmetic classification. -/ structure TwoOddBounds (a b E F : ℕ) : Prop where small : E ≤ 3 * b - 3 diff_large : 3 ≤ a → E = b - a → (F : ℝ) < 4 * b sum_equal : E = a + b → a % 4 = b % 4 → (F : ℝ) < 2 * ((a : ℝ) + b) sum_different : E = a + b → a % 4 ≠ b % 4 → (F : ℝ) * ((b : ℝ) - 2) < 2 * b * ((a : ℝ) + b) one_diff_one : a = 1 → 5 ≤ b → E = b - 1 → b % 4 = 1 → (F : ℝ) * ((b : ℝ) - 2) < 2 * b * ((b : ℝ) - 1) one_diff_three : a = 1 → 5 ≤ b → E = b - 1 → b % 4 = 3 → (F : ℝ) * ((b : ℝ) - 4) < 2 * b * ((b : ℝ) - 1) lemma triangleEta_same_residue {u v : ℕ} (huv : u ≤ v) (hs : u % 4 = v % 4) : triangleEta u v = 0 := by have hr : (v - u) % 4 = 0 := by omega simp only [triangleEta, hr, ite_true] lemma triangleEta_odd_different {u v : ℕ} (hu : 0 < u) (huv : u ≤ v) (huo : u % 2 = 1) (hvo : v % 2 = 1) (hs : u % 4 ≠ v % 4) : triangleEta u v = 2 / (v : ℝ) := by have huR : (0 : ℝ) < u := by exact_mod_cast hu have huvR : (u : ℝ) ≤ v := by exact_mod_cast huv have hr : (v - u) % 4 = 2 := by omega have hh : (2 : ℝ) / v ≤ 2 / u := div_le_div_of_nonneg_left (by norm_num) huR huvR norm_num only [triangleEta, hr, Nat.cast_ofNat, OfNat.ofNat_ne_zero, ite_false] exact min_eq_right hh lemma fourth_bound_clear_eta {F : ℕ} {r S v : ℝ} (hv : 0 < v) (h : (F : ℝ) * (1 - r / v) < 2 * S) : (F : ℝ) * (v - r) < 2 * v * S := by have he : (1 - r / v) * v = v - r := by field_simp have hh := mul_lt_mul_of_pos_right h hv rw [mul_assoc, he] at hh convert hh using 1 ; ring lemma triangle_odd_sum_fourth_bound {u v F : ℕ} (hu : 2 ≤ u) (hv : 3 ≤ v) (huv : u ≤ v) (hcop : Nat.Coprime u v) (hF : 0 < F) (hod : (u + v) % 2 = 1) (hno : NoQuarter u v (u + v) F) : (F : ℝ) < 4 * ((u : ℝ) + v) := by have huR : (2 : ℝ) ≤ u := by exact_mod_cast hu have hvR : (3 : ℝ) ≤ v := by exact_mod_cast hv have hr : (v - u) % 4 = 1 ∨ (v - u) % 4 = 3 := by omega have hη : triangleEta u v ≤ (1 : ℝ) / 2 := by rcases hr with hr | hr · norm_num only [triangleEta, hr, Nat.cast_one, one_ne_zero, ite_false] apply (min_le_left _ _).trans exact one_div_le_one_div_of_le (by norm_num) huR · norm_num only [triangleEta, hr, Nat.cast_ofNat, OfNat.ofNat_ne_zero, ite_false] apply (min_le_right _ _).trans norm_num simpa only [one_div] using one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 2) (by linarith : (2 : ℝ) ≤ v) have htri := triangle_fourth_bound (by omega : 0 < u) (by omega : 0 < v) huv hcop hF hno have hmul := mul_le_mul_of_nonneg_left hη (Nat.cast_nonneg F) nlinarith only [htri, hmul] /-- Every interval premise in the arithmetic case split follows from the triangle lemma. -/ theorem two_odd_bounds {a b E F : ℕ} (ha : 0 < a) (hab : a < b) (hE : 0 < E) (hEF : E < F) (hao : a % 2 = 1) (hbo : b % 2 = 1) (hEe : E % 2 = 0) (hFe : F % 2 = 0) (hg : Nat.gcd a b ≤ 2) (hbad : NoQuarter a b E F) : TwoOddBounds a b E F := by have hb : 0 < b := by omega have hF : 0 < F := by omega have hcop := coprime_of_odd_gcd_two ha hao hg refine ⟨smaller_even_bound ha hab hE hEF hao hbo hEe hFe hbad, ?_, ?_, ?_, ?_, ?_⟩ · intro ha3 hEq subst E have he2 : 2 ≤ b - a := by omega have hsum : a + (b - a) = b := by omega have hcop' : Nat.Coprime a (b - a) := (Nat.coprime_sub_self_right hab.le).mpr hcop by_cases horder : a ≤ b - a · have hset : ({a, b, b - a} : Finset ℕ) = {a, b - a, a + (b - a)} := by rw [hsum] ext n simp only [Finset.mem_insert, Finset.mem_singleton] tauto have hh := triangle_odd_sum_fourth_bound (by omega : 2 ≤ a) (by omega) horder hcop' hF (by omega) (noQuarter_reorder_triple hset hbad) simpa only [← Nat.cast_add, hsum] using hh · have hset : ({a, b, b - a} : Finset ℕ) = {b - a, a, b - a + a} := by rw [show b - a + a = b by omega] ext n simp only [Finset.mem_insert, Finset.mem_singleton] tauto have hh := triangle_odd_sum_fourth_bound he2 ha3 (by omega) hcop'.symm hF (by omega) (noQuarter_reorder_triple hset hbad) simpa only [← Nat.cast_add, show b - a + a = b by omega] using hh · intro hEq hs subst E have hh := triangle_fourth_bound ha hb hab.le hcop hF hbad rw [triangleEta_same_residue hab.le hs] at hh simpa only [sub_zero, mul_one] using hh · intro hEq hs subst E have hh := triangle_fourth_bound ha hb hab.le hcop hF hbad rw [triangleEta_odd_different ha hab.le hao hbo hs] at hh exact fourth_bound_clear_eta (by exact_mod_cast hb) hh · intro haEq hb5 hEq hb1 subst a subst E have hsum : 1 + (b - 1) = b := by omega have hset : ({1, b, b - 1} : Finset ℕ) = {1, b - 1, 1 + (b - 1)} := by rw [hsum] ext n simp only [Finset.mem_insert, Finset.mem_singleton] tauto have hh := triangle_fourth_bound (by decide : 0 < 1) (by omega : 0 < b - 1) (by omega) (by simp : Nat.Coprime 1 (b - 1)) hF (noQuarter_reorder_triple hset hbad) have hr : (b - 1 - 1) % 4 = 3 := by omega have hv : (0 : ℝ) < (b - 1 : ℕ) := by exact_mod_cast (by omega : 0 < b - 1) have hratio : (1 : ℝ) / (b - 1 : ℕ) ≤ 3 := by apply (div_le_iff₀ hv).mpr have hv4 : (4 : ℝ) ≤ (b - 1 : ℕ) := by exact_mod_cast (by omega : 4 ≤ b - 1) linarith have hη : triangleEta 1 (b - 1) = 1 / (b - 1 : ℕ) := by norm_num [triangleEta, hr, min_eq_right hratio] simpa only [one_div] using hratio rw [hη] at hh have hc := fourth_bound_clear_eta hv hh have hcast : ((b - 1 : ℕ) : ℝ) = (b : ℝ) - 1 := by exact_mod_cast (by omega : ((b - 1 : ℕ) : ℤ) = (b : ℤ) - 1) rw [hcast] at hc norm_num only [Nat.cast_one] at hc convert hc using 1 <;> ring · intro haEq hb5 hEq hb3 subst a subst E have hsum : 1 + (b - 1) = b := by omega have hset : ({1, b, b - 1} : Finset ℕ) = {1, b - 1, 1 + (b - 1)} := by rw [hsum] ext n simp only [Finset.mem_insert, Finset.mem_singleton] tauto have hh := triangle_fourth_bound (by decide : 0 < 1) (by omega : 0 < b - 1) (by omega) (by simp : Nat.Coprime 1 (b - 1)) hF (noQuarter_reorder_triple hset hbad) have hr : (b - 1 - 1) % 4 = 1 := by omega have hv : (0 : ℝ) < (b - 1 : ℕ) := by exact_mod_cast (by omega : 0 < b - 1) have hratio : (3 : ℝ) / (b - 1 : ℕ) ≤ 1 := by apply (div_le_one hv).mpr exact_mod_cast (by omega : 3 ≤ b - 1) have hη : triangleEta 1 (b - 1) = 3 / (b - 1 : ℕ) := by norm_num [triangleEta, hr, min_eq_right hratio] rw [hη] at hh have hc := fourth_bound_clear_eta hv hh have hcast : ((b - 1 : ℕ) : ℝ) = (b : ℝ) - 1 := by exact_mod_cast (by omega : ((b - 1 : ℕ) : ℤ) = (b : ℤ) - 1) rw [hcast] at hc norm_num only [Nat.cast_one] at hc convert hc using 1 <;> ring /-- Section 3 after its two symbolic congruence and interval arguments. -/ theorem two_odd_classification_of_bounds {a b E F : ℕ} (ha : 0 < a) (hab : a < b) (hE : 0 < E) (hEF : E < F) (hao : a % 2 = 1) (hbo : b % 2 = 1) (hEe : E % 2 = 0) (hFe : F % 2 = 0) (hfour : E % 4 = 0 ∨ F % 4 = 0) (hg : PairwiseGcdTwo a b E F) (hbad : NoQuarter a b E F) (hLE : AdditiveLift a b E) (hLF : AdditiveLift a b F) (hbounds : TwoOddBounds a b E F) : Classified ({a, b, E, F} : Finset ℕ) := by obtain ⟨hgAB, hgAE, hgAF, hgBE, hgBF, hgEF⟩ := hg have hcop := coprime_of_odd_gcd_two ha hao hgAB have hbase := small_lift_is_base ha hab hao hbo hE hbounds.small hLE have hF : 0 < F := by omega by_cases ha1 : a = 1 · subst a have hbcases : b = 3 ∨ 5 ≤ b := by omega rcases hbcases with rfl | hb5 · rcases hbase with hbase | hbase <;> norm_num at hbase · subst E have hFfour : F % 4 = 0 := by omega exact classified_one_three_two hF hFfour · subst E have hbound := hbounds.sum_different (by decide) (by decide) norm_num at hbound exact classified_one_three_four hEF hFe hgEF hgBF (by exact_mod_cast hbound) hbad · rcases hbase with hbase | hbase · subst E by_cases hFbase : F = 1 + b · subst F exact classified_difference_sum (by decide) hab hcop · have hFlarge : b + 1 < F := by omega have hlarge := one_lift_large (by omega : 3 ≤ b) hFlarge hLF have hbres : b % 4 = 1 ∨ b % 4 = 3 := by omega rcases hbres with hb1 | hb3 · exact (large_one_diff_one_impossible hb5 hlarge (hbounds.one_diff_one rfl hb5 rfl hb1)).elim · have hbound := hbounds.one_diff_three rfl hb5 rfl hb3 by_cases hb11 : 11 ≤ b · exact (large_one_diff_three_impossible hb11 hlarge hbound).elim · have hb7 : b = 7 := by omega subst b norm_num at hbound hFlarge hbad have hF28 : F < 28 := by exact_mod_cast (by linarith : (F : ℝ) < 28) rcases lift_one_seven_bounded hFlarge hF28 hLF with rfl | rfl · exact (not_noQuarter_17620 hbad).elim · exact (not_noQuarter_17622 hbad).elim · subst E have hFlarge : b + 1 < F := by omega have hlarge := one_lift_large (by omega : 3 ≤ b) hFlarge hLF have hbres : b % 4 = 1 ∨ b % 4 = 3 := by omega rcases hbres with hb1 | hb3 · have hbound := hbounds.sum_equal rfl (by simpa using hb1.symm) norm_num only [Nat.cast_one] at hbound have hlargeR : (3 : ℝ) * b ≤ (F : ℝ) + 1 := by exact_mod_cast hlarge have hbR : (5 : ℝ) ≤ b := by exact_mod_cast hb5 exfalso nlinarith · have hbound := hbounds.sum_different rfl (by norm_num; omega) have hbound' : (F : ℝ) * ((b : ℝ) - 2) < 2 * b * ((b : ℝ) + 1) := by simpa only [Nat.cast_one, add_comm] using hbound by_cases hb11 : 11 ≤ b · exact (large_one_sum_three_impossible hb11 hlarge hbound').elim · have hb7 : b = 7 := by omega subst b norm_num at hbound hFlarge hbad hgEF have hF28 : F < 28 := by exact_mod_cast (by linarith : (F : ℝ) < 28) rcases lift_one_seven_bounded hFlarge hF28 hLF with rfl | rfl · norm_num at hgEF · exact (not_noQuarter_17822 hbad).elim · have ha3 : 3 ≤ a := by omega have hb5 : 5 ≤ b := by omega rcases hbase with hbase | hbase · have hbound := hbounds.diff_large ha3 hbase obtain hFsum | hFdiff | hlarge := lift_base_or_large ha hab hF hLF · subst E subst F exact classified_difference_sum ha hab hcop · omega · exact (large_lift_not_lt_four_b ha3 hb5 hlarge hbound).elim · have hlarge : 2 * a * b ≤ F + a + b := by obtain hFsum | hFdiff | hlarge := lift_base_or_large ha hab hF hLF · omega · omega · exact hlarge by_cases hsame : a % 4 = b % 4 · exact (large_lift_not_lt_twice_sum ha3 hb5 hlarge (hbounds.sum_equal hbase hsame)).elim · have hbound := hbounds.sum_different hbase hsame by_cases hb7 : 7 ≤ b · exact (large_sum_lift_impossible ha3 hb7 hlarge hbound).elim · have hb_eq : b = 5 := by omega have ha_eq : a = 3 := by omega subst a subst b have hE_eq : E = 8 := by omega subst E norm_num at hbound have hF27 : F < 27 := by exact_mod_cast (by linarith : (F : ℝ) < 27) have hF22 := lift_three_five_bounded hEF hF27 hLF subst F exact (not_noQuarter_35822 hbad).elim /-- Pure two-odd-speed classification, with no bounded enumeration premise. -/ theorem two_odd_classification {a b E F : ℕ} (ha : 0 < a) (hab : a < b) (hE : 0 < E) (hEF : E < F) (hao : a % 2 = 1) (hbo : b % 2 = 1) (hEe : E % 2 = 0) (hFe : F % 2 = 0) (hfour : E % 4 = 0 ∨ F % 4 = 0) (hg : PairwiseGcdTwo a b E F) (hbad : NoQuarter a b E F) : Classified ({a, b, E, F} : Finset ℕ) := by have hF : 0 < F := by omega obtain ⟨hLE, hLF⟩ := two_even_additive_lifts ha (by omega) hE hF hao hbo hEe hFe hfour hg hbad have hbounds := two_odd_bounds ha hab hE hEF hao hbo hEe hFe hg.1 hbad exact two_odd_classification_of_bounds ha hab hE hEF hao hbo hEe hFe hfour hg hbad hLE hLF hbounds end Bounty.Pure05 /- Component: Unsigned. -/ namespace Bounty.Pure05 /-- An unsigned residue class after scaling by a unit. -/ def SignedScaled (q E a r : ℕ) : Prop := (q : ℤ) ∣ (a : ℤ) - (E : ℤ) * (r : ℤ) ∨ (q : ℤ) ∣ (a : ℤ) + (E : ℤ) * (r : ℤ) lemma int_dvd_small_zero {Q x : ℤ} (hQ : 0 < Q) (hd : Q ∣ x) (hlo : -Q < x) (hhi : x < Q) : x = 0 := by obtain ⟨k, rfl⟩ := hd rcases lt_trichotomy k 0 with hk | hk | hk · have hm := mul_le_mul_of_nonneg_left (show k ≤ -1 by omega) hQ.le nlinarith only [hm, hlo] · simp [hk] · have hm := mul_le_mul_of_nonneg_left (show 1 ≤ k by omega) hQ.le nlinarith only [hm, hhi] lemma int_dvd_positive_lt_twice {Q x : ℤ} (hQ : 0 < Q) (hd : Q ∣ x) (hlo : 0 < x) (hhi : x < 2 * Q) : x = Q := by have hd' : Q ∣ x - Q := dvd_sub hd (dvd_refl Q) have hz := int_dvd_small_zero hQ hd' (by omega) (by omega) omega lemma int_dvd_negative_lt_one {Q x : ℤ} (hQ : 0 < Q) (hd : Q ∣ x) (hlo : -(2 * Q) < x) (hhi : x < Q) : x = -Q ∨ x = 0 := by by_cases hnonneg : 0 ≤ x · exact Or.inr (int_dvd_small_zero hQ hd (by omega) hhi) · have hd' : Q ∣ -x := dvd_neg.mpr hd have hz := int_dvd_positive_lt_twice hQ hd' (by omega) (by omega) exact Or.inl (by omega) lemma int_dvd_positive_lt_three {Q x : ℤ} (hQ : 0 < Q) (hd : Q ∣ x) (hlo : 0 < x) (hhi : x < 3 * Q) : x = Q ∨ x = 2 * Q := by by_cases hx : x < Q · have hz := int_dvd_small_zero hQ hd (by omega) hx omega by_cases heq : x = Q · exact Or.inl heq have hd' : Q ∣ x - Q := dvd_sub hd (dvd_refl Q) have hz := int_dvd_positive_lt_twice hQ hd' (by omega) (by omega) exact Or.inr (by omega) lemma nat_mod_eq_int_dvd_sub {q a b : ℕ} (h : a % q = b % q) : (q : ℤ) ∣ (a : ℤ) - (b : ℤ) := by apply Int.dvd_of_emod_eq_zero apply Int.emod_eq_emod_iff_emod_sub_eq_zero.mp exact_mod_cast h /-- Every unit has a positive unsigned scaled representative strictly below half the modulus. -/ theorem exists_unsigned_scaled {q E a : ℕ} (hq : 3 ≤ q) (hqodd : q % 2 = 1) (hE : Nat.Coprime E q) (ha : Nat.Coprime a q) : ∃ r : ℕ, 0 < r ∧ 2 * r < q ∧ Nat.Coprime r q ∧ SignedScaled q E a r := by obtain ⟨u, huq, hmod⟩ := Nat.exists_mul_mod_eq_of_coprime a hE (by omega) have hprod : Nat.Coprime (E * u) q := by change Nat.gcd (E * u) q = 1 rw [Nat.gcd_comm (E * u) q, Nat.gcd_rec q (E * u), hmod, ← Nat.gcd_rec q a] exact ha.symm have huunit : Nat.Coprime u q := hprod.coprime_mul_left have hupos : 0 < u := by by_contra hn have hu0 : u = 0 := by omega simp [Nat.Coprime, hu0] at huunit omega have hd : (q : ℤ) ∣ (a : ℤ) - (E : ℤ) * (u : ℤ) := by simpa only [Int.natCast_mul] using nat_mod_eq_int_dvd_sub hmod.symm by_cases hhalf : 2 * u < q · exact ⟨u, hupos, hhalf, huunit, Or.inl hd⟩ let r := q - u have hrsum : r + u = q := Nat.sub_add_cancel huq.le have huint : Nat.Coprime u r := by apply Nat.coprime_add_self_right.mp simpa only [hrsum] using huunit have hrunit : Nat.Coprime r q := by rw [← hrsum] exact Nat.coprime_self_add_right.mpr huint.symm have hrsumZ : (r : ℤ) + (u : ℤ) = (q : ℤ) := by exact_mod_cast hrsum refine ⟨r, Nat.sub_pos_of_lt huq, by omega, hrunit, Or.inr ?_⟩ have heq : (a : ℤ) + (E : ℤ) * (r : ℤ) = ((a : ℤ) - (E : ℤ) * (u : ℤ)) + (E : ℤ) * (q : ℤ) := by rw [← hrsumZ] ring rw [heq] exact dvd_add hd (dvd_mul_left (q : ℤ) (E : ℤ)) lemma signedScaled_same {q E a b r : ℕ} (ha : SignedScaled q E a r) (hb : SignedScaled q E b r) : (q : ℤ) ∣ (a : ℤ) - (b : ℤ) ∨ (q : ℤ) ∣ (a : ℤ) + (b : ℤ) := by rcases ha with ha | ha <;> rcases hb with hb | hb · left convert dvd_sub ha hb using 1; ring · right convert dvd_add ha hb using 1; ring · right convert dvd_add ha hb using 1; ring · left convert dvd_sub ha hb using 1; ring /-- Two distinct odd speeds below an odd modulus have distinct unsigned representatives. -/ theorem unsigned_distinct {q E a b r s : ℕ} (hab : a < b) (hbq : b < q) (haodd : a % 2 = 1) (hbodd : b % 2 = 1) (hqodd : q % 2 = 1) (ha : SignedScaled q E a r) (hb : SignedScaled q E b s) : r ≠ s := by intro hrs subst s have hqpos : (0 : ℤ) < q := by omega rcases signedScaled_same ha hb with hsub | hsum · have hz := int_dvd_small_zero hqpos hsub (by omega) (by omega) omega · have hz := int_dvd_positive_lt_twice hqpos hsum (by omega) (by omega) have hNat : a + b = q := by exact_mod_cast hz omega /-- The odd representative of the unsigned class one is the complement of the even speed. -/ theorem odd_rep_one {q E a : ℕ} (hqodd : q % 2 = 1) (hEeven : E % 2 = 0) (hEpos : 0 < E) (hEq : E < q) (haodd : a % 2 = 1) (hapos : 0 < a) (haq : a < q) (hscale : SignedScaled q E a 1) : a = q - E := by simp only [SignedScaled, Nat.cast_one, mul_one] at hscale have hqpos : (0 : ℤ) < q := by omega rcases hscale with hsub | hsum · have hz := int_dvd_small_zero hqpos hsub (by omega) (by omega) have hNat : a = E := by exact_mod_cast sub_eq_zero.mp hz omega · have hz := int_dvd_positive_lt_twice hqpos hsum (by omega) (by omega) have hNat : a + E = q := by exact_mod_cast hz omega /-- The odd representative of the unsigned class two is the absolute difference from twice E. -/ theorem odd_rep_two {q E a : ℕ} (hqodd : q % 2 = 1) (hEeven : E % 2 = 0) (hEpos : 0 < E) (hEq : E < q) (haodd : a % 2 = 1) (hapos : 0 < a) (haq : a < q) (hscale : SignedScaled q E a 2) : (a : ℤ) = |(q : ℤ) - 2 * (E : ℤ)| := by have hs : (q : ℤ) ∣ (a : ℤ) - 2 * (E : ℤ) ∨ (q : ℤ) ∣ (a : ℤ) + 2 * (E : ℤ) := by simpa only [SignedScaled, Nat.cast_ofNat, mul_comm] using hscale have hqpos : (0 : ℤ) < q := by omega have haposZ : (0 : ℤ) ≤ a := by omega rcases hs with hsub | hsum · have hz := int_dvd_negative_lt_one hqpos hsub (by omega) (by omega) rcases hz with hm | hz · rw [show (q : ℤ) - 2 * (E : ℤ) = -(a : ℤ) by omega, abs_neg, abs_of_nonneg haposZ] · have hNat : a = 2 * E := by exact_mod_cast sub_eq_zero.mp hz omega · have hz := int_dvd_positive_lt_three hqpos hsum (by omega) (by omega) rcases hz with hq | h2q · rw [show (q : ℤ) - 2 * (E : ℤ) = (a : ℤ) by omega, abs_of_nonneg haposZ] · have hNat : a + 2 * E = 2 * q := by exact_mod_cast h2q omega end Bounty.Pure05 /- Component: ThreeOddFamily. -/ namespace Bounty.Pure05 /-- The unsigned residue equations identify the additive family. -/ theorem classified_of_unsigned_reps {q E a b : ℕ} (hqodd : q % 2 = 1) (hEpos : 0 < E) (hEq : E < q) (hcop : Nat.Coprime E q) (ha : a = q - E) (hb : (b : ℤ) = |(q : ℤ) - 2 * (E : ℤ)|) : Classified ({E, q, a, b} : Finset ℕ) := by let x := q - E have hxpos : 0 < x := Nat.sub_pos_of_lt hEq have hxsum : x + E = q := Nat.sub_add_cancel hEq.le have hxsumZ : (x : ℤ) + (E : ℤ) = (q : ℤ) := by exact_mod_cast hxsum have hax : a = x := ha have hxne : x ≠ E := by intro heq; omega unfold Classified right left by_cases hxe : x ≤ E · have hlt : x < E := by omega have hc : Nat.Coprime E x := (Nat.coprime_sub_self_right hEq.le).mpr hcop have hsign : (q : ℤ) - 2 * (E : ℤ) ≤ 0 := by omega have hsub : ((E - x : ℕ) : ℤ) = (E : ℤ) - (x : ℤ) := Int.natCast_sub hxe have hbrep : b = E - x := by rw [abs_of_nonpos hsign] at hb have hz : (b : ℤ) = ((E - x : ℕ) : ℤ) := by omega exact_mod_cast hz refine ⟨E, x, hxpos, hlt, hc, ?_⟩ rw [hax, hbrep, ← hxsum] ext v simp only [Bounty.Families.familyTwo, Finset.mem_insert, Finset.mem_singleton, Nat.add_comm] tauto · have hlt : E < x := by omega have hc : Nat.Coprime x E := (Nat.coprime_sub_self_left hEq.le).mpr hcop.symm have hsign : 0 ≤ (q : ℤ) - 2 * (E : ℤ) := by omega have hsub : ((x - E : ℕ) : ℤ) = (x : ℤ) - (E : ℤ) := Int.natCast_sub hlt.le have hbrep : b = x - E := by rw [abs_of_nonneg hsign] at hb have hz : (b : ℤ) = ((x - E : ℕ) : ℤ) := by omega exact_mod_cast hz refine ⟨x, E, hEpos, hlt, hc, ?_⟩ rw [hax, hbrep, ← hxsum] ext v simp only [Bounty.Families.familyTwo, Finset.mem_insert, Finset.mem_singleton, Nat.add_comm] tauto /-- Direct extraction from the two signed unsigned-residue conditions. -/ theorem classified_of_signed_one_two {q E a b : ℕ} (hqodd : q % 2 = 1) (hEeven : E % 2 = 0) (hEpos : 0 < E) (hEq : E < q) (hcop : Nat.Coprime E q) (haodd : a % 2 = 1) (hapos : 0 < a) (haq : a < q) (hbodd : b % 2 = 1) (hbpos : 0 < b) (hbq : b < q) (ha : SignedScaled q E a 1) (hb : SignedScaled q E b 2) : Classified ({E, q, a, b} : Finset ℕ) := by exact classified_of_unsigned_reps hqodd hEpos hEq hcop (odd_rep_one hqodd hEeven hEpos hEq haodd hapos haq ha) (odd_rep_two hqodd hEeven hEpos hEq hbodd hbpos hbq hb) end Bounty.Pure05 /- Component: ThreeOddArithmetic. -/ namespace Bounty.Pure05 /-- Coprime multiplication preserves nonzero residues below the modulus. -/ theorem coprime_mul_mod_pos {q a j : ℕ} (hq : 0 < q) (ha : Nat.Coprime a q) (hj : 0 < j) (hjq : j < q) : 0 < (a * j) % q := by by_contra h have hz : (a * j) % q = 0 := by omega have hd : q ∣ a * j := Nat.dvd_of_mod_eq_zero hz have hjd : q ∣ j := ha.symm.dvd_of_dvd_mul_left hd have hle : q ≤ j := Nat.le_of_dvd hj hjd omega /-- On the central odd grid, a doubled residue is in the lower or upper half according to the parity of the coefficient and its floor word. -/ theorem central_half_floor {q a j : ℕ} (hqodd : q % 2 = 1) (hjodd : j % 2 = 1) (hj : 2 * j < q) (ha : Nat.Coprime a q) : (2 * ((a * ((q - j) / 2)) % q)) / q = (a + a * j / q + 1) % 2 := by have hq : 0 < q := by omega have hj0 : 0 < j := by omega have hjq : j < q := by omega have hdiff : 2 * ((q - j) / 2) = q - j := by omega have hjadd : 2 * ((q - j) / 2) + j = q := by omega let k := a * j / q let r := (a * j) % q let y := (q - j) / 2 let l := a * y / q let s := (a * y) % q have hr0 : 0 < r := coprime_mul_mod_pos hq ha hj0 hjq have hrq : r < q := Nat.mod_lt _ hq have hs0 : 0 ≤ s := Nat.zero_le _ have hsq : s < q := Nat.mod_lt _ hq have hkr : q * k + r = a * j := by simpa [k, r, Nat.add_comm] using Nat.mod_add_div (a * j) q have hls : q * l + s = a * y := by simpa [l, s, Nat.add_comm] using Nat.mod_add_div (a * y) q have hprod : 2 * (q * l + s) + q * k + r = a * q := by rw [Nat.add_assoc, hkr, hls] change 2 * (a * ((q - j) / 2)) + a * j = a * q nlinarith [congrArg (fun x : ℕ => a * x) hjadd] let d : ℤ := (a : ℤ) - (k : ℤ) - 2 * (l : ℤ) have hprodZ : 2 * (s : ℤ) + r = d * q := by have hh : 2 * ((q : ℤ) * l + s) + q * k + r = (a : ℤ) * q := by exact_mod_cast hprod dsimp [d] nlinarith have hqZ : (0 : ℤ) < q := by exact_mod_cast hq have hr0Z : (0 : ℤ) < r := by exact_mod_cast hr0 have hrqZ : (r : ℤ) < q := by exact_mod_cast hrq have hsqZ : (s : ℤ) < q := by exact_mod_cast hsq have hs0Z : (0 : ℤ) ≤ s := by exact_mod_cast hs0 have hdlo : 1 ≤ d := by by_contra h have hh : d ≤ 0 := by omega nlinarith have hdhi : d ≤ 2 := by by_contra h have hh : 3 ≤ d := by omega nlinarith have hd : d = 1 ∨ d = 2 := by omega change 2 * s / q = (a + k + 1) % 2 rcases hd with hd | hd · have hsqhalf : 2 * s < q := by rw [hd, one_mul] at hprodZ have hh : 2 * (s : ℤ) < q := by omega exact_mod_cast hh rw [Nat.div_eq_of_lt hsqhalf] have hdk : (a : ℤ) - k - 2 * l = 1 := hd omega · have hsqhalf : q ≤ 2 * s := by rw [hd] at hprodZ have hh : (q : ℤ) ≤ 2 * s := by omega exact_mod_cast hh have hupper : 2 * s < (1 + 1) * q := by omega rw [Nat.div_eq_of_lt_le (k := 1) (by simpa using hsqhalf) hupper] have hdk : (a : ℤ) - k - 2 * l = 2 := hd omega /-- Matching parities at every odd index imply matching floor words, because each floor changes by at most one on a step of length two. -/ theorem floor_word_equal_of_parity {q a b : ℕ} (hq : 0 < q) (ha : 2 * a < q) (hb : 2 * b < q) (hpar : ∀ j : ℕ, j % 2 = 1 → 2 * j < q → (a * j / q) % 2 = (b * j / q) % 2) : ∀ j : ℕ, j % 2 = 1 → 2 * j < q → a * j / q = b * j / q := by intro j induction j using Nat.strong_induction_on with | h j ih => intro hjodd hj by_cases hj1 : j = 1 · subst j simp only [Nat.mul_one] rw [Nat.div_eq_of_lt (by omega : a < q), Nat.div_eq_of_lt (by omega : b < q)] · have hj2 : 2 ≤ j := by omega have hjprev : (j - 2) % 2 = 1 := by omega have hjprevq : 2 * (j - 2) < q := by omega have heq := ih (j - 2) (by omega) hjprev hjprevq have hstep (v : ℕ) (hv : 2 * v < q) : v * (j - 2) / q ≤ v * j / q ∧ v * j / q ≤ v * (j - 2) / q + 1 := by have hjdecomp : j = j - 2 + 2 := by omega have hmul : v * j = v * (j - 2) + 2 * v := by calc v * j = v * (j - 2 + 2) := congrArg (fun x : ℕ => v * x) hjdecomp _ = v * (j - 2) + 2 * v := by ring constructor · apply Nat.div_le_div_right omega · have hr := Nat.mod_lt (v * (j - 2)) hq have hd := Nat.mod_add_div (v * (j - 2)) q apply Nat.le_of_lt_succ apply (Nat.div_lt_iff_lt_mul hq).2 rw [hmul] nlinarith have hsa := hstep a ha have hsb := hstep b hb have hp := hpar j hjodd hj omega end Bounty.Pure05 /- Component: ThreeOddGrid. -/ namespace Bounty.Pure05 open Math15.Source05.ThreeSpeed def LowerHalf (q z : ℤ) : Prop := 2 * (z % q) < q theorem quarter_position {t : ℝ} {v : ℕ} : Quarter t v ↔ Quarter (t * (v : ℝ)) 1 := by simp [Quarter, Good] theorem quarter_position_add_int (x : ℝ) (k : ℤ) : Quarter (x + (k : ℝ)) 1 ↔ Quarter x 1 := by constructor · intro h have hh := good_integer_shift (q := -k) h simpa only [Int.cast_neg, add_neg_cancel_right] using hh · intro h exact good_integer_shift (q := k) h theorem quarter_phase_one_iff {r q : ℤ} (hq : 0 < q) (hqodd : q % 2 = 1) (hr0 : 0 < r) (hrq : r < q) : Quarter ((1 / 4 : ℝ) + (r : ℝ) / (q : ℝ)) 1 ↔ 2 * r < q := by have hqR : (0 : ℝ) < q := by exact_mod_cast hq have hr0R : (0 : ℝ) < (r : ℝ) / (q : ℝ) := div_pos (by exact_mod_cast hr0) hqR have hrqR : (r : ℝ) / (q : ℝ) < 1 := (div_lt_one hqR).2 (by exact_mod_cast hrq) simp only [Quarter, Good, Int.cast_one, mul_one] constructor · rintro ⟨k, hlo, hhi⟩ have hk0R : (-1 : ℝ) < k := by linarith have hk1R : (k : ℝ) < 1 := by linarith have hk0 : (-1 : ℤ) < k := by exact_mod_cast hk0R have hk1 : k < 1 := by exact_mod_cast hk1R have hk : k = 0 := by omega subst k simp only [Int.cast_zero, sub_zero] at hhi have hh : (r : ℝ) / (q : ℝ) ≤ 1 / 2 := by linarith have hh' := (div_le_iff₀ hqR).mp hh have hhZ : 2 * r ≤ q := by exact_mod_cast (by linarith : 2 * (r : ℝ) ≤ (q : ℝ)) omega · intro h have hh : (r : ℝ) / (q : ℝ) ≤ 1 / 2 := by apply (div_le_iff₀ hqR).2 have hR : 2 * (r : ℝ) < (q : ℝ) := by exact_mod_cast h linarith refine ⟨0, ?_, ?_⟩ <;> simp only [Int.cast_zero, sub_zero] <;> linarith theorem quarter_phase_three_iff {r q : ℤ} (hq : 0 < q) (hqodd : q % 2 = 1) (hr0 : 0 < r) (hrq : r < q) : Quarter ((3 / 4 : ℝ) + (r : ℝ) / (q : ℝ)) 1 ↔ q < 2 * r := by have hqR : (0 : ℝ) < q := by exact_mod_cast hq have hr0R : (0 : ℝ) < (r : ℝ) / (q : ℝ) := div_pos (by exact_mod_cast hr0) hqR have hrqR : (r : ℝ) / (q : ℝ) < 1 := (div_lt_one hqR).2 (by exact_mod_cast hrq) simp only [Quarter, Good, Int.cast_one, mul_one] constructor · rintro ⟨k, hlo, hhi⟩ have hk0R : (0 : ℝ) < k := by linarith have hk1R : (k : ℝ) < 2 := by linarith have hk0 : (0 : ℤ) < k := by exact_mod_cast hk0R have hk1 : k < 2 := by exact_mod_cast hk1R have hk : k = 1 := by omega subst k simp only [Int.cast_one] at hlo have hh : 1 / 2 ≤ (r : ℝ) / (q : ℝ) := by linarith have hh' := (le_div_iff₀ hqR).mp hh have hhZ : q ≤ 2 * r := by exact_mod_cast (by linarith : (q : ℝ) ≤ 2 * (r : ℝ)) omega · intro h have hh : 1 / 2 ≤ (r : ℝ) / (q : ℝ) := by apply (le_div_iff₀ hqR).2 have hR : (q : ℝ) < 2 * (r : ℝ) := by exact_mod_cast h linarith refine ⟨1, ?_, ?_⟩ <;> simp only [Int.cast_one] <;> linarith theorem quarter_grid_reduction {q v : ℕ} {z : ℤ} (hq : 0 < q) : Quarter ((1 / 4 : ℝ) + (z : ℝ) / (q : ℝ)) v ↔ Quarter (((v % 4 : ℕ) : ℝ) / 4 + (((v : ℤ) * z) % (q : ℤ) : ℤ) / (q : ℝ)) 1 := by let k : ℤ := (v / 4 : ℕ) + ((v : ℤ) * z) / (q : ℤ) have hqR : (0 : ℝ) < q := by exact_mod_cast hq have hv : (v : ℝ) = 4 * ((v / 4 : ℕ) : ℝ) + ((v % 4 : ℕ) : ℝ) := by exact_mod_cast (by omega : v = 4 * (v / 4) + v % 4) have hz : (v : ℝ) * (z : ℝ) = ((((v : ℤ) * z) % (q : ℤ) : ℤ) : ℝ) + ((((v : ℤ) * z) / (q : ℤ) : ℤ) : ℝ) * (q : ℝ) := by exact_mod_cast (Int.emod_add_ediv_mul ((v : ℤ) * z) (q : ℤ)).symm have heq : ((1 / 4 : ℝ) + (z : ℝ) / (q : ℝ)) * (v : ℝ) = ((v % 4 : ℕ) : ℝ) / 4 + ((((v : ℤ) * z) % (q : ℤ) : ℤ) : ℝ) / (q : ℝ) + (k : ℝ) := by have hk : (k : ℝ) = ((v / 4 : ℕ) : ℝ) + ((((v : ℤ) * z) / (q : ℤ) : ℤ) : ℝ) := by simp only [k, Int.cast_add, Int.cast_natCast] rw [hk] have hvmul := congrArg (fun x : ℝ => x * (q : ℝ)) hv field_simp nlinarith rw [quarter_position, heq] exact quarter_position_add_int _ k theorem reflected_mod {x q : ℤ} (hq : 0 < q) (hx : 0 < x % q) : (-x) % q = q - x % q := by have hh : -x = q - x % q + (-(x / q) - 1) * q := by have h := Int.emod_add_ediv_mul x q nlinarith rw [hh, Int.add_mul_emod_self_right] exact Int.emod_eq_of_lt (by have h := Int.emod_lt_of_pos x hq; omega) (by omega) theorem lowerHalf_neg {q x : ℤ} (hq : 0 < q) (hqodd : q % 2 = 1) (hx : x % q ≠ 0) : LowerHalf q (-x) ↔ ¬ LowerHalf q x := by have hx0 : 0 < x % q := by have h := Int.emod_nonneg x hq.ne'; omega unfold LowerHalf rw [reflected_mod hq hx0] omega theorem quarter_grid_iff_lower {q v : ℕ} {z : ℤ} (hq : 0 < q) (hqodd : q % 2 = 1) (hvodd : v % 2 = 1) (hz : ((v : ℤ) * z) % (q : ℤ) ≠ 0) : Quarter ((1 / 4 : ℝ) + (z : ℝ) / (q : ℝ)) v ↔ (v % 4 = 1 ↔ LowerHalf (q : ℤ) ((v : ℤ) * z)) := by have hqZ : (0 : ℤ) < q := by exact_mod_cast hq have hqoddZ : (q : ℤ) % 2 = 1 := by exact_mod_cast hqodd have hr0 : 0 < ((v : ℤ) * z) % (q : ℤ) := by have h := Int.emod_nonneg ((v : ℤ) * z) hqZ.ne' omega have hrq := Int.emod_lt_of_pos ((v : ℤ) * z) hqZ have hv : v % 4 = 1 ∨ v % 4 = 3 := by omega rw [quarter_grid_reduction hq] rcases hv with hv | hv · simp only [hv, Nat.cast_one, true_iff] simpa only [Int.cast_natCast, LowerHalf] using quarter_phase_one_iff hqZ hqoddZ hr0 hrq · simp only [hv, Nat.cast_ofNat, Nat.reduceEqDiff, false_iff] have he := quarter_phase_three_iff hqZ hqoddZ hr0 hrq simp only [Int.cast_natCast] at he rw [he] unfold LowerHalf omega end Bounty.Pure05 /- Component: ThreeOddScale. -/ namespace Bounty.Pure05 open Math15.Source05.ThreeSpeed lemma scaled_emod_eq {Q x y : ℤ} (h : Q ∣ x - y) : x % Q = y % Q := by exact Int.emod_eq_emod_iff_emod_sub_eq_zero.mpr (Int.emod_eq_zero_of_dvd h) lemma signed_grid_flag {q E a r : ℕ} (hq : 0 < q) (hqodd : q % 2 = 1) (haodd : a % 2 = 1) (hr : Nat.Coprime r q) (hs : SignedScaled q E a r) : ∃ P : Prop, ∀ (y : ℕ) (z : ℤ), 0 < y → y < q → (q : ℤ) ∣ (E : ℤ) * z - (y : ℤ) → (Quarter ((1 / 4 : ℝ) + (z : ℝ) / (q : ℝ)) a ↔ (P ↔ LowerHalf (q : ℤ) ((r : ℤ) * (y : ℤ)))) := by have hqZ : (0 : ℤ) < q := by exact_mod_cast hq have hqoZ : (q : ℤ) % 2 = 1 := by exact_mod_cast hqodd rcases hs with hs | hs · refine ⟨a % 4 = 1, ?_⟩ intro y z hy hyq hz have hr0N := coprime_mul_mod_pos hq hr hy hyq have hr0 : 0 < ((r : ℤ) * (y : ℤ)) % (q : ℤ) := by exact_mod_cast hr0N have hd : (q : ℤ) ∣ (a : ℤ) * z - (r : ℤ) * (y : ℤ) := by have he : (a : ℤ) * z - (r : ℤ) * (y : ℤ) = ((a : ℤ) - (E : ℤ) * (r : ℤ)) * z + (r : ℤ) * ((E : ℤ) * z - (y : ℤ)) := by ring rw [he] exact dvd_add (dvd_mul_of_dvd_left hs z) (dvd_mul_of_dvd_right hz (r : ℤ)) have he := scaled_emod_eq hd rw [quarter_grid_iff_lower hq hqodd haodd (by rw [he]; omega)] unfold LowerHalf rw [he] · refine ⟨a % 4 ≠ 1, ?_⟩ intro y z hy hyq hz have hr0N := coprime_mul_mod_pos hq hr hy hyq have hr0 : 0 < ((r : ℤ) * (y : ℤ)) % (q : ℤ) := by exact_mod_cast hr0N have hd : (q : ℤ) ∣ (a : ℤ) * z - -((r : ℤ) * (y : ℤ)) := by have he : (a : ℤ) * z - -((r : ℤ) * (y : ℤ)) = ((a : ℤ) + (E : ℤ) * (r : ℤ)) * z - (r : ℤ) * ((E : ℤ) * z - (y : ℤ)) := by ring rw [he] exact dvd_sub (dvd_mul_of_dvd_left hs z) (dvd_mul_of_dvd_right hz (r : ℤ)) have he := scaled_emod_eq hd have hn : (-((r : ℤ) * (y : ℤ))) % (q : ℤ) ≠ 0 := by rw [reflected_mod hqZ hr0] have hh := Int.emod_lt_of_pos ((r : ℤ) * (y : ℤ)) hqZ omega rw [quarter_grid_iff_lower hq hqodd haodd (by rw [he]; exact hn)] have hlow : LowerHalf (q : ℤ) ((a : ℤ) * z) ↔ ¬ LowerHalf (q : ℤ) ((r : ℤ) * (y : ℤ)) := by unfold LowerHalf rw [he] exact lowerHalf_neg hqZ hqoZ (by omega) rw [hlow] tauto lemma central_lower_iff {q r j : ℕ} (hqodd : q % 2 = 1) (hjodd : j % 2 = 1) (hj : 2 * j < q) (hr : Nat.Coprime r q) : LowerHalf (q : ℤ) ((r : ℤ) * (((q - j) / 2 : ℕ) : ℤ)) ↔ (r + r * j / q) % 2 = 1 := by have hq : 0 < q := by omega have hs := central_half_floor hqodd hjodd hj hr have hcast : LowerHalf (q : ℤ) ((r : ℤ) * (((q - j) / 2 : ℕ) : ℤ)) ↔ 2 * ((r * ((q - j) / 2)) % q) < q := by unfold LowerHalf exact_mod_cast (Iff.rfl : 2 * ((r * ((q - j) / 2)) % q) < q ↔ 2 * ((r * ((q - j) / 2)) % q) < q) rw [hcast] have hzero : 2 * ((r * ((q - j) / 2)) % q) < q ↔ (2 * ((r * ((q - j) / 2)) % q)) / q = 0 := by rw [Nat.div_eq_zero_iff] omega rw [hzero, hs] omega lemma inverse_grid {q E : ℕ} (hq : 0 < q) (hcop : Nat.Coprime E q) (y : ℕ) : ∃ z : ℤ, (q : ℤ) ∣ (E : ℤ) * z - (y : ℤ) := by obtain ⟨z, hzq, hz⟩ := Nat.exists_mul_mod_eq_of_coprime y hcop (by omega) refine ⟨(z : ℤ), ?_⟩ have hd := nat_mod_eq_int_dvd_sub hz simpa only [Int.natCast_mul] using hd end Bounty.Pure05 /- Component: ThreeOddWords. -/ namespace Bounty.Pure05 open Math15.Source05.ThreeSpeed lemma odd_quarter_grid_both {q : ℕ} {z : ℤ} (hqodd : q % 2 = 1) : Quarter ((1 / 4 : ℝ) + (z : ℝ) / (q : ℝ)) q ∧ Quarter (((1 / 4 : ℝ) + (z : ℝ) / (q : ℝ)) + 1 / 2) q := by have hq : (q : ℤ) ≠ 0 := by omega have hqoddZ : (q : ℤ) % 2 = 1 := by exact_mod_cast hqodd have hbase : Quarter (1 / 4) q := by have hh := (quarter_fraction_iff (m := 1) (N := 4) (v := q) (by norm_num)).mpr (by simp only [one_mul]; omega) simpa only [Int.cast_one, Int.cast_ofNat] using hh have hbase3 : Quarter (3 / 4) q := by have hh := (quarter_fraction_iff (m := 3) (N := 4) (v := q) (by norm_num)).mpr (by omega) simpa only [Int.cast_ofNat] using hh have hg := good_divisor_shift (g := (q : ℤ)) (q := z) hq (dvd_refl _) hbase have hg3 := good_divisor_shift (g := (q : ℤ)) (q := z) hq (dvd_refl _) hbase3 constructor · simpa only [Int.cast_natCast] using hg · convert hg3 using 1 <;> push_cast <;> ring lemma central_even_quarter {q E y : ℕ} {z : ℤ} (hq : 0 < q) (hE4 : E % 4 = 0) (hy : y < q) (hlo : q ≤ 4 * y) (hhi : 4 * y ≤ 3 * q) (hz : (q : ℤ) ∣ (E : ℤ) * z - (y : ℤ)) : Quarter ((1 / 4 : ℝ) + (z : ℝ) / (q : ℝ)) E := by have he := scaled_emod_eq hz have hymod : (y : ℤ) % (q : ℤ) = y := Int.emod_eq_of_lt (by omega) (by exact_mod_cast hy) rw [hymod] at he rw [quarter_grid_reduction hq] simp only [hE4, Nat.cast_zero, zero_div, zero_add, he, Int.cast_natCast] apply (quarter_fraction_iff (m := (y : ℤ)) (N := (q : ℤ)) (by exact_mod_cast hq)).mpr simpa only [Nat.cast_one, mul_one, hymod] using (show (q : ℤ) ≤ 4 * (y : ℤ) ∧ 4 * (y : ℤ) ≤ 3 * (q : ℤ) by exact_mod_cast And.intro hlo hhi) lemma central_grid_opposite {q E a b y : ℕ} {z : ℤ} (hq : 0 < q) (hqodd : q % 2 = 1) (hE4 : E % 4 = 0) (hao : a % 2 = 1) (hbo : b % 2 = 1) (hy : y < q) (hlo : q ≤ 4 * y) (hhi : 4 * y ≤ 3 * q) (hz : (q : ℤ) ∣ (E : ℤ) * z - (y : ℤ)) (hbad : NoQuarter a b q E) : Quarter ((1 / 4 : ℝ) + (z : ℝ) / (q : ℝ)) a ↔ ¬ Quarter ((1 / 4 : ℝ) + (z : ℝ) / (q : ℝ)) b := by have hqg := odd_quarter_grid_both (z := z) hqodd have hEg := central_even_quarter hq hE4 hy hlo hhi hz have hEe : 2 ∣ E := by omega have hEgs := quarter_even_shift hEe hEg constructor · intro ha hb exact hbad _ ⟨ha, hb, hqg.1, hEg⟩ · intro hnb by_contra hna have has := (quarter_odd_choice _ a hao).resolve_left hna have hbs := (quarter_odd_choice _ b hbo).resolve_left hnb exact hbad _ ⟨has, hbs, hqg.2, hEgs⟩ lemma parity_of_fixed_flags {r s x y : ℕ} {P Q : Prop} (h0 : (P ↔ r % 2 = 1) ↔ ¬ (Q ↔ s % 2 = 1)) (hxy : (P ↔ (r + x) % 2 = 1) ↔ ¬ (Q ↔ (s + y) % 2 = 1)) : x % 2 = y % 2 := by by_cases hp : P <;> by_cases hq : Q <;> simp only [hp, hq, true_iff, false_iff] at h0 hxy <;> omega /-- The quarter grids force equal floor words on every central odd index. -/ theorem three_odd_floor_words {q E a b r s : ℕ} (hq : 3 ≤ q) (hqodd : q % 2 = 1) (hE4 : E % 4 = 0) (hEcop : Nat.Coprime E q) (hao : a % 2 = 1) (hbo : b % 2 = 1) (hrhalf : 2 * r < q) (hshalf : 2 * s < q) (hrcop : Nat.Coprime r q) (hscop : Nat.Coprime s q) (hra : SignedScaled q E a r) (hsb : SignedScaled q E b s) (hbad : NoQuarter a b q E) : ∀ j : ℕ, j % 2 = 1 → 2 * j < q → r * j / q = s * j / q := by have hqpos : 0 < q := by omega obtain ⟨P, hP⟩ := signed_grid_flag hqpos hqodd hao hrcop hra obtain ⟨Q, hQ⟩ := signed_grid_flag hqpos hqodd hbo hscop hsb have hcentral (j : ℕ) (hjodd : j % 2 = 1) (hj : 2 * j < q) : (P ↔ (r + r * j / q) % 2 = 1) ↔ ¬ (Q ↔ (s + s * j / q) % 2 = 1) := by let y := (q - j) / 2 have hy0 : 0 < y := by dsimp [y]; omega have hyq : y < q := by dsimp [y]; omega have hylo : q ≤ 4 * y := by dsimp [y]; omega have hyhi : 4 * y ≤ 3 * q := by dsimp [y]; omega obtain ⟨z, hz⟩ := inverse_grid hqpos hEcop y have hx := central_grid_opposite hqpos hqodd hE4 hao hbo hyq hylo hyhi hz hbad rw [hP y z hy0 hyq hz, hQ y z hy0 hyq hz] at hx rw [central_lower_iff hqodd hjodd hj hrcop, central_lower_iff hqodd hjodd hj hscop] at hx exact hx have hfirst := hcentral 1 (by norm_num) (by omega) simp only [Nat.mul_one, Nat.div_eq_of_lt (by omega : r < q), Nat.div_eq_of_lt (by omega : s < q), Nat.add_zero] at hfirst apply floor_word_equal_of_parity hqpos hrhalf hshalf intro j hjodd hj exact parity_of_fixed_flags hfirst (hcentral j hjodd hj) end Bounty.Pure05 /- Component: ThreeOddException. -/ namespace Bounty.Pure05 open Math15.Source05.ThreeSpeed /-- At this half-grid point, unsigned classes three and four are both quarter-good. -/ lemma thirteen_signed_quarter {a E z r : ℕ} (hao : a % 2 = 1) (hmod : E * z % 13 = 4) (hscale : SignedScaled 13 E a r) (hr : r = 3 ∨ r = 4) : Quarter ((1 : ℝ) / 2 + (z : ℝ) / 13) a := by let c : ℤ := (E * z / 13 : ℕ) let h : ℤ := (a / 2 : ℕ) have hhalf : (a : ℝ) = 2 * (h : ℝ) + 1 := by dsimp [h] exact_mod_cast (by omega : a = 2 * (a / 2) + 1) have hprod : (z : ℝ) * (E : ℝ) = 13 * (c : ℝ) + 4 := by have he : E * z = 13 * (E * z / 13) + 4 := by have hh := Nat.mod_add_div (E * z) 13 omega have heR : (E : ℝ) * z = 13 * ((E * z / 13 : ℕ) : ℝ) + 4 := by exact_mod_cast he simpa only [c, Int.cast_natCast, mul_comm] using heR rcases hscale with ⟨k, hk⟩ | ⟨k, hk⟩ · have haE : (a : ℝ) = (E : ℝ) * r + 13 * (k : ℝ) := by have hh := congrArg (fun x : ℤ => (x : ℝ)) hk norm_num at hh linarith only [hh] have hza : (z : ℝ) * a = (13 * (c : ℝ) + 4) * r + 13 * z * k := by calc (z : ℝ) * a = (z : ℝ) * ((E : ℝ) * r + 13 * k) := by rw [haE] _ = ((z : ℝ) * E) * r + 13 * z * k := by ring _ = _ := by rw [hprod] have he : ((1 : ℝ) / 2 + (z : ℝ) / 13) * a - ((h + (z : ℤ) * k + (r : ℤ) * c + 1 : ℤ) : ℝ) = (4 : ℝ) * r / 13 - 1 / 2 := by simp only [Int.cast_add, Int.cast_mul, Int.cast_natCast, Int.cast_one] field_simp nlinarith only [hhalf, hza] refine ⟨h + (z : ℤ) * k + (r : ℤ) * c + 1, ?_, ?_⟩ · change (1 / 4 : ℝ) ≤ _ simp only [Int.cast_natCast] rw [he] rcases hr with rfl | rfl <;> norm_num · change _ ≤ (1 - 1 / 4 : ℝ) simp only [Int.cast_natCast] rw [he] rcases hr with rfl | rfl <;> norm_num · have haE : (a : ℝ) = -(E : ℝ) * r + 13 * (k : ℝ) := by have hh := congrArg (fun x : ℤ => (x : ℝ)) hk norm_num at hh linarith only [hh] have hza : (z : ℝ) * a = -(13 * (c : ℝ) + 4) * r + 13 * z * k := by calc (z : ℝ) * a = (z : ℝ) * (-(E : ℝ) * r + 13 * k) := by rw [haE] _ = -((z : ℝ) * E) * r + 13 * z * k := by ring _ = _ := by rw [hprod] have he : ((1 : ℝ) / 2 + (z : ℝ) / 13) * a - ((h + (z : ℤ) * k - (r : ℤ) * c - 1 : ℤ) : ℝ) = 3 / 2 - (4 : ℝ) * r / 13 := by simp only [Int.cast_add, Int.cast_sub, Int.cast_mul, Int.cast_natCast, Int.cast_one] field_simp nlinarith only [hhalf, hza] refine ⟨h + (z : ℤ) * k - (r : ℤ) * c - 1, ?_, ?_⟩ · change (1 / 4 : ℝ) ≤ _ simp only [Int.cast_natCast] rw [he] rcases hr with rfl | rfl <;> norm_num · change _ ≤ (1 - 1 / 4 : ℝ) simp only [Int.cast_natCast] rw [he] rcases hr with rfl | rfl <;> norm_num /-- The modulus-thirteen Farey exception has an explicit common quarter-good time. -/ theorem thirteen_noQuarter_false {a b E : ℕ} (hao : a % 2 = 1) (hbo : b % 2 = 1) (hEe : E % 2 = 0) (hcop : Nat.Coprime E 13) (ha : SignedScaled 13 E a 3) (hb : SignedScaled 13 E b 4) (hbad : NoQuarter a b 13 E) : False := by obtain ⟨z, _, hz⟩ := Nat.exists_mul_mod_eq_of_coprime 4 hcop (by norm_num : 13 ≠ 0) have hmod : E * z % 13 = 4 := by simpa using hz let t : ℝ := 1 / 2 + (z : ℝ) / 13 have hta : Quarter t a := thirteen_signed_quarter hao hmod ha (Or.inl rfl) have htb : Quarter t b := thirteen_signed_quarter hbo hmod hb (Or.inr rfl) have ht13 : Quarter t 13 := by refine ⟨6 + (z : ℤ), ?_, ?_⟩ <;> dsimp [t] <;> push_cast <;> norm_num <;> ring_nf <;> norm_num have htE : Quarter t E := by let c : ℤ := (E * z / 13 : ℕ) let e : ℤ := (E / 2 : ℕ) have hhalf : (E : ℝ) = 2 * (e : ℝ) := by dsimp [e] exact_mod_cast (by omega : E = 2 * (E / 2)) have hprod : (z : ℝ) * E = 13 * (c : ℝ) + 4 := by have he : E * z = 13 * (E * z / 13) + 4 := by have hh := Nat.mod_add_div (E * z) 13 omega have heR : (E : ℝ) * z = 13 * ((E * z / 13 : ℕ) : ℝ) + 4 := by exact_mod_cast he simpa only [c, Int.cast_natCast, mul_comm] using heR have he : t * (E : ℝ) - ((e + c : ℤ) : ℝ) = (4 : ℝ) / 13 := by dsimp [t] simp only [Int.cast_add] field_simp nlinarith only [hhalf, hprod] refine ⟨e + c, ?_, ?_⟩ · change (1 / 4 : ℝ) ≤ _ simp only [Int.cast_natCast] rw [he] norm_num · change _ ≤ (1 - 1 / 4 : ℝ) simp only [Int.cast_natCast] rw [he] norm_num exact hbad t ⟨hta, htb, ht13, htE⟩ end Bounty.Pure05 /- Component: Parity. -/ noncomputable section namespace Bounty.Pure05 open Finset Set Math15.LonelyRunner Math15.Source05.ThreeSpeed theorem quarter_at_quarter {v : ℕ} (hv : v % 4 ≠ 0) : Quarter (1 / 4) v := by have hm : (v : ℤ) % 4 = (v % 4 : ℕ) := by omega have hh := (quarter_fraction_iff (m := 1) (N := 4) (v := v) (by norm_num)).2 (by simp only [one_mul]; rw [hm]; omega) simpa only [Int.cast_one, Int.cast_ofNat] using hh theorem quarter_at_half {v : ℕ} (hv : v % 2 = 1) : Quarter (1 / 2) v := by have hm : (v : ℤ) % 2 = 1 := by exact_mod_cast hv have hh := (quarter_fraction_iff (m := 1) (N := 2) (v := v) (by norm_num)).2 (by simp only [one_mul, hm]; norm_num) simpa only [Int.cast_one, Int.cast_ofNat] using hh theorem quarter_at_three_quarters {v : ℕ} (hv : v % 2 = 1) : Quarter (3 / 4) v := by have h4 : v % 4 = 1 ∨ v % 4 = 3 := by omega have hm : (3 * (v : ℤ)) % 4 = 1 ∨ (3 * (v : ℤ)) % 4 = 3 := by omega have hh := (quarter_fraction_iff (m := 3) (N := 4) (v := v) (by norm_num)).2 (by rcases hm with h | h <;> rw [h] <;> norm_num) simpa only [Int.cast_ofNat] using hh theorem two_odd_even_quarter_large {u v e : ℕ} (_hu : 0 < u) (hv : 0 < v) (_he : 0 < e) (huodd : u % 2 = 1) (hvodd : v % 2 = 1) (heeven : e % 2 = 0) (hvlarge : 3 ≤ v) (hev : Nat.Coprime e v) : ∃ t : ℝ, Quarter t u ∧ Quarter t v ∧ Quarter t e := by by_cases h4 : e % 4 = 0 · let r : ℤ := ((v : ℤ) - 1) / 2 have hr : 2 * r = (v : ℤ) - 1 := by dsimp [r]; omega have hr0 : 0 ≤ r := by omega have hrv : r < (v : ℤ) := by omega have hrlo : (v : ℤ) ≤ 4 * r := by omega have hrhi : 4 * r ≤ 3 * (v : ℤ) := by omega let p : ℤ := Nat.gcdA e v let q : ℤ := Nat.gcdB e v have hbez : (e : ℤ) * p + (v : ℤ) * q = 1 := by simpa only [p, q, hev.gcd_eq_one, Nat.cast_one] using (Nat.gcd_eq_gcd_ab e v).symm let z : ℤ := r * p have hmul : z * (e : ℤ) = r + (-r * q) * (v : ℤ) := by dsimp [z] calc r * p * (e : ℤ) = r * ((e : ℤ) * p + (v : ℤ) * q) - r * q * (v : ℤ) := by ring _ = r + (-r * q) * (v : ℤ) := by rw [hbez]; ring have hmod : (z * (e : ℤ)) % (v : ℤ) = r := by rw [hmul, Int.add_mul_emod_self_right, Int.emod_eq_of_lt hr0 hrv] have hqe : Quarter ((z : ℝ) / (v : ℝ)) e := by have hh := (quarter_fraction_iff (m := z) (N := (v : ℤ)) (v := e) (by exact_mod_cast hv)).2 (by rw [hmod]; exact ⟨hrlo, hrhi⟩) simpa only [Int.cast_natCast] using hh have hshift : Quarter ((z : ℝ) / (v : ℝ) + 1 / 4) e := by simpa only [Int.cast_one, Int.cast_ofNat] using (good_divisor_shift (g := 4) (q := 1) (by norm_num) (by exact_mod_cast Nat.dvd_of_mod_eq_zero h4) hqe) let t : ℝ := 1 / 4 + (z : ℝ) / (v : ℝ) have het : Quarter t e := by simpa only [t, add_comm] using hshift have hvt : Quarter t v := by have hh := good_divisor_shift (g := (v : ℤ)) (q := z) (by exact_mod_cast hv.ne') (dvd_refl _) (quarter_at_quarter (v := v) (by omega)) simpa only [t, Int.cast_natCast] using hh have hvt' : Quarter (t + 1 / 2) v := by have hh := good_divisor_shift (g := (v : ℤ)) (q := z) (by exact_mod_cast hv.ne') (dvd_refl _) (quarter_at_three_quarters hvodd) have heq : t + 1 / 2 = 3 / 4 + (z : ℝ) / (v : ℝ) := by dsimp [t]; ring simpa only [Int.cast_natCast, heq] using hh rcases quarter_odd_choice t u huodd with hut | hut · exact ⟨t, hut, hvt, het⟩ · exact ⟨t + 1 / 2, hut, hvt', quarter_even_shift (Nat.dvd_of_mod_eq_zero heeven) het⟩ · exact ⟨1 / 4, quarter_at_quarter (by omega), quarter_at_quarter (by omega), quarter_at_quarter h4⟩ theorem ones_even_quarter {e : ℕ} (he : 0 < e) (heeven : e % 2 = 0) : ∃ t : ℝ, Quarter t 1 ∧ Quarter t e := by have he2 : 2 ≤ e := by omega have heR : (0 : ℝ) < e := by exact_mod_cast he have he2R : (2 : ℝ) ≤ e := by exact_mod_cast he2 have heq : e = 2 * (e / 2) := by omega have heqR : (e : ℝ) = 2 * ((e / 2 : ℕ) : ℝ) := by exact_mod_cast heq let t : ℝ := 1 / 2 + 1 / (4 * (e : ℝ)) have htlo : (1 / 4 : ℝ) ≤ t := by dsimp [t] have hh := div_nonneg (by norm_num : (0 : ℝ) ≤ 1) (by positivity : (0 : ℝ) ≤ 4 * e) linarith have hthi : t ≤ (3 / 4 : ℝ) := by dsimp [t] have hh : 1 / (4 * (e : ℝ)) ≤ (1 / 4 : ℝ) := by apply (div_le_iff₀ (by positivity : (0 : ℝ) < 4 * e)).2 nlinarith only [he2R] linarith have ht1 : Quarter t 1 := by refine ⟨0, ?_, ?_⟩ <;> simp only [Nat.cast_one, Int.cast_one, Int.cast_zero, mul_one, sub_zero] · exact htlo · linarith have hte : Quarter t e := by have hh : t * (e : ℝ) - ((e / 2 : ℕ) : ℝ) = 1 / 4 := by dsimp [t] field_simp nlinarith only [heqR] refine ⟨(e / 2 : ℕ), ?_, ?_⟩ · simp only [Int.cast_natCast, hh] exact le_rfl · simp only [Int.cast_natCast, hh] norm_num exact ⟨t, ht1, hte⟩ theorem two_odd_even_quarter {u v e : ℕ} (hu : 0 < u) (hv : 0 < v) (he : 0 < e) (huodd : u % 2 = 1) (hvodd : v % 2 = 1) (heeven : e % 2 = 0) (heu : Nat.Coprime e u) (hev : Nat.Coprime e v) : ∃ t : ℝ, Quarter t u ∧ Quarter t v ∧ Quarter t e := by by_cases hvlarge : 3 ≤ v · exact two_odd_even_quarter_large hu hv he huodd hvodd heeven hvlarge hev · have hv1 : v = 1 := by omega by_cases hularge : 3 ≤ u · obtain ⟨t, hvt, hut, het⟩ := two_odd_even_quarter_large hv hu he hvodd huodd heeven hularge heu exact ⟨t, hut, hvt, het⟩ · have hu1 : u = 1 := by omega obtain ⟨t, ht1, hte⟩ := ones_even_quarter he heeven subst u; subst v exact ⟨t, ht1, ht1, hte⟩ theorem odd_of_coprime_even {a b : ℕ} (ha : a % 2 = 0) (hab : Nat.Coprime a b) : b % 2 = 1 := by by_contra hb have hd : 2 ∣ Nat.gcd a b := Nat.dvd_gcd (Nat.dvd_of_mod_eq_zero ha) (Nat.dvd_of_mod_eq_zero (by omega)) rw [hab.gcd_eq_one] at hd norm_num at hd /-- Three pairwise coprime positive speeds admit a simultaneous quarter time. -/ theorem three_coprime_quarter (a b c : ℕ) (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) (hab : Nat.Coprime a b) (hac : Nat.Coprime a c) (hbc : Nat.Coprime b c) : ∃ t : ℝ, Quarter t a ∧ Quarter t b ∧ Quarter t c := by by_cases hae : a % 2 = 0 · have hbo := odd_of_coprime_even hae hab have hco := odd_of_coprime_even hae hac obtain ⟨t, hbt, hct, hat⟩ := two_odd_even_quarter hb hc ha hbo hco hae hab hac exact ⟨t, hat, hbt, hct⟩ · have hao : a % 2 = 1 := by omega by_cases hbe : b % 2 = 0 · have hco := odd_of_coprime_even hbe hbc obtain ⟨t, hat, hct, hbt⟩ := two_odd_even_quarter ha hc hb hao hco hbe hab.symm hbc exact ⟨t, hat, hbt, hct⟩ · have hbo : b % 2 = 1 := by omega by_cases hce : c % 2 = 0 · exact two_odd_even_quarter ha hb hc hao hbo hce hac.symm hbc.symm · have hco : c % 2 = 1 := by omega exact ⟨1 / 2, quarter_at_half hao, quarter_at_half hbo, quarter_at_half hco⟩ theorem halve_even_coprime {a b : ℕ} (ha : 0 < a) (haeven : a % 2 = 0) (hbeven : b % 2 = 0) (hab : Nat.gcd a b ≤ 2) : Nat.Coprime (a / 2) (b / 2) := by have haeq : a = 2 * (a / 2) := by omega have hbeq : b = 2 * (b / 2) := by omega have hag : 0 < Nat.gcd (a / 2) (b / 2) := Nat.gcd_pos_of_pos_left _ (by omega) have hsmall : 2 * Nat.gcd (a / 2) (b / 2) ≤ 2 := by have hh := hab conv_lhs at hh => rw [haeq, hbeq, Nat.gcd_mul_left] exact hh show Nat.gcd (a / 2) (b / 2) = 1 omega theorem quarter_even_from_half {a : ℕ} (haeven : a % 2 = 0) {t : ℝ} (h : Quarter t (a / 2)) : Quarter (t / 2) a := by have haeq : (a : ℤ) = 2 * (a / 2 : ℕ) := by exact_mod_cast (show a = 2 * (a / 2) by omega) have hh := good_scaled_time (d := 2) (by norm_num) h simpa only [Int.cast_ofNat, ← haeq] using hh theorem good_quarter_witness {V : Finset ℕ} (hV : V.Nonempty) (t : ℝ) (h : ∀ v ∈ V, Quarter t v) : (1 / 4 : ℝ) ≤ ML V := by apply le_trans ?_ (Bounty.Families.score_le_ML V (t : Time)) apply (Bounty.Families.le_score_iff hV).2 intro v hv exact quarter_iff_distance.mp (h v hv) theorem exists_four_divisible {V : Finset ℕ} (hV : V.Nonempty) (hbad : ML V < (1 / 4 : ℝ)) : ∃ c ∈ V, c % 4 = 0 := by by_contra hn have h : (1 / 4 : ℝ) ≤ ML V := good_quarter_witness hV (1 / 4) (by intro v hv exact quarter_at_quarter (fun hz => hn ⟨v, hv, hz⟩)) exact (not_le_of_gt hbad) h theorem four_divisible_unique {V : Finset ℕ} (hpos : Positive V) (hgcd : ∀ a ∈ V, ∀ b ∈ V, a ≠ b → Nat.gcd a b ≤ 2) {a b : ℕ} (ha : a ∈ V) (hb : b ∈ V) (ha4 : a % 4 = 0) (hb4 : b % 4 = 0) : a = b := by by_contra hab have hd : 4 ∣ Nat.gcd a b := Nat.dvd_gcd (Nat.dvd_of_mod_eq_zero ha4) (Nat.dvd_of_mod_eq_zero hb4) have hp : 0 < Nat.gcd a b := Nat.gcd_pos_of_pos_left b (hpos a ha) have hlarge : 4 ≤ Nat.gcd a b := Nat.le_of_dvd hp hd have hsmall := hgcd a ha b hb hab omega theorem exists_odd_of_primitive {V : Finset ℕ} (hprim : Primitive V) : (V.filter (fun v => v % 2 = 1)).Nonempty := by by_contra hnone have hall : ∀ v ∈ V, 2 ∣ v := by intro v hv have hn : v % 2 ≠ 1 := by intro h1 exact hnone ⟨v, Finset.mem_filter.mpr ⟨hv, h1⟩⟩ exact Nat.dvd_of_mod_eq_zero (by omega) have hg : 2 ∣ V.gcd id := Finset.dvd_gcd hall change V.gcd id = 1 at hprim rw [hprim] at hg norm_num at hg theorem two_odd_speeds {V : Finset ℕ} (hpos : Positive V) (hprim : Primitive V) (hcard : V.card = 4) (hgcd : ∀ a ∈ V, ∀ b ∈ V, a ≠ b → Nat.gcd a b ≤ 2) (hbad : ML V < (1 / 4 : ℝ)) : 2 ≤ (V.filter (fun v => v % 2 = 1)).card := by obtain ⟨o, ho⟩ := exists_odd_of_primitive hprim have hoV : o ∈ V := (Finset.mem_filter.mp ho).1 have hoodd : o % 2 = 1 := (Finset.mem_filter.mp ho).2 by_contra htwo have hsmall : (V.filter (fun v => v % 2 = 1)).card ≤ 1 := by omega have hunique : ∀ v ∈ V, v % 2 = 1 → v = o := by intro v hv hodd exact Finset.card_le_one.mp hsmall v (Finset.mem_filter.mpr ⟨hv, hodd⟩) o ho have hE : (V.erase o).card = 3 := by rw [Finset.card_erase_of_mem hoV, hcard] obtain ⟨a, b, c, hab, hac, hbc, heq⟩ := Finset.card_eq_three.mp hE have hmem : ∀ v ∈ ({a,b,c} : Finset ℕ), v ∈ V ∧ v ≠ o := by intro v hv have hve : v ∈ V.erase o := by rw [heq]; exact hv exact ⟨(Finset.mem_erase.mp hve).2, (Finset.mem_erase.mp hve).1⟩ have haV := (hmem a (by simp)).1 have hbV := (hmem b (by simp)).1 have hcV := (hmem c (by simp)).1 have heven : ∀ v ∈ ({a,b,c} : Finset ℕ), v % 2 = 0 := by intro v hv have hnot : v % 2 ≠ 1 := by intro hh exact (hmem v hv).2 (hunique v (hmem v hv).1 hh) omega have hae := heven a (by simp) have hbe := heven b (by simp) have hce := heven c (by simp) obtain ⟨s, has, hbs, hcs⟩ := three_coprime_quarter (a / 2) (b / 2) (c / 2) (by have hh := hpos a haV; omega) (by have hh := hpos b hbV; omega) (by have hh := hpos c hcV; omega) (halve_even_coprime (hpos a haV) hae hbe (hgcd a haV b hbV hab)) (halve_even_coprime (hpos a haV) hae hce (hgcd a haV c hcV hac)) (halve_even_coprime (hpos b hbV) hbe hce (hgcd b hbV c hcV hbc)) let t : ℝ := s / 2 have hat : Quarter t a := quarter_even_from_half hae has have hbt : Quarter t b := quarter_even_from_half hbe hbs have hct : Quarter t c := quarter_even_from_half hce hcs rcases quarter_odd_choice t o hoodd with hot | hot · have hbound := good_quarter_witness (V := V) ⟨o, hoV⟩ t (by intro v hv by_cases hvo : v = o · simpa only [hvo] using hot · have hve : v ∈ ({a,b,c} : Finset ℕ) := by rw [← heq] exact Finset.mem_erase.mpr ⟨hvo, hv⟩ simp only [Finset.mem_insert, Finset.mem_singleton] at hve rcases hve with rfl | rfl | rfl · exact hat · exact hbt · exact hct) exact (not_le_of_gt hbad) hbound · have hat' := quarter_even_shift (Nat.dvd_of_mod_eq_zero hae) hat have hbt' := quarter_even_shift (Nat.dvd_of_mod_eq_zero hbe) hbt have hct' := quarter_even_shift (Nat.dvd_of_mod_eq_zero hce) hct have hbound := good_quarter_witness (V := V) ⟨o, hoV⟩ (t + 1 / 2) (by intro v hv by_cases hvo : v = o · simpa only [hvo] using hot · have hve : v ∈ ({a,b,c} : Finset ℕ) := by rw [← heq] exact Finset.mem_erase.mpr ⟨hvo, hv⟩ simp only [Finset.mem_insert, Finset.mem_singleton] at hve rcases hve with rfl | rfl | rfl · exact hat' · exact hbt' · exact hct') exact (not_le_of_gt hbad) hbound /-- Select the smallest two odd speeds, the unique multiple of four, and the fourth speed. -/ theorem parity_shape {V : Finset ℕ} (hpos : Positive V) (hprim : Primitive V) (hcard : V.card = 4) (hgcd : ∀ a ∈ V, ∀ b ∈ V, a ≠ b → Nat.gcd a b ≤ 2) (hbad : ML V < (1 / 4 : ℝ)) : ∃ a b c d : ℕ, V = {a,b,c,d} ∧ a < b ∧ a % 2 = 1 ∧ b % 2 = 1 ∧ c % 4 = 0 ∧ ((d % 2 = 1 ∧ b < d) ∨ d % 4 = 2) := by classical let O := V.filter (fun v => v % 2 = 1) have htwo : 2 ≤ O.card := two_odd_speeds hpos hprim hcard hgcd hbad have hO : O.Nonempty := Finset.card_pos.mp (by omega) let a := O.min' hO have haO : a ∈ O := Finset.min'_mem O hO have haV : a ∈ V := (Finset.mem_filter.mp haO).1 have haodd : a % 2 = 1 := (Finset.mem_filter.mp haO).2 let P := O.erase a have hP : P.Nonempty := by apply Finset.card_pos.mp have hpc : P.card = O.card - 1 := Finset.card_erase_of_mem haO omega let b := P.min' hP have hbP : b ∈ P := Finset.min'_mem P hP have hbO : b ∈ O := (Finset.mem_erase.mp hbP).2 have hbV : b ∈ V := (Finset.mem_filter.mp hbO).1 have hbodd : b % 2 = 1 := (Finset.mem_filter.mp hbO).2 have hab : a < b := by have hle : a ≤ b := Finset.min'_le O b hbO have hne : b ≠ a := (Finset.mem_erase.mp hbP).1 omega obtain ⟨c, hcV, hc4⟩ := exists_four_divisible (V := V) ⟨a, haV⟩ hbad have hac : a ≠ c := by intro hh; subst c; omega have hbc : b ≠ c := by intro hh; subst c; omega let S : Finset ℕ := {a,b,c} have hScard : S.card = 3 := by simp [S, Finset.card_insert_of_notMem, hab.ne, hac, hbc] have hSsub : S ⊆ V := by intro v hv simp only [S, Finset.mem_insert, Finset.mem_singleton] at hv rcases hv with rfl | rfl | rfl · exact haV · exact hbV · exact hcV have hDcard : (V \ S).card = 1 := by rw [Finset.card_sdiff_of_subset hSsub, hcard, hScard] obtain ⟨d, hD⟩ := Finset.card_eq_one.mp hDcard have hdD : d ∈ V \ S := by rw [hD]; simp have hdV : d ∈ V := (Finset.mem_sdiff.mp hdD).1 have hdnot : d ∉ S := (Finset.mem_sdiff.mp hdD).2 have hda : d ≠ a := by intro hh; subst d; exact hdnot (by simp [S]) have hdb : d ≠ b := by intro hh; subst d; exact hdnot (by simp [S]) have hdc : d ≠ c := by intro hh; subst d; exact hdnot (by simp [S]) have heq : V = {a,b,c,d} := by ext v constructor · intro hv by_cases hvS : v ∈ S · simp only [S, Finset.mem_insert, Finset.mem_singleton] at hvS ⊢ tauto · have hvD : v ∈ V \ S := Finset.mem_sdiff.mpr ⟨hv, hvS⟩ rw [hD, Finset.mem_singleton] at hvD subst v simp · intro hv simp only [Finset.mem_insert, Finset.mem_singleton] at hv rcases hv with rfl | rfl | rfl | rfl · exact haV · exact hbV · exact hcV · exact hdV have hdcase : (d % 2 = 1 ∧ b < d) ∨ d % 4 = 2 := by by_cases hodd : d % 2 = 1 · left refine ⟨hodd, ?_⟩ have hdP : d ∈ P := Finset.mem_erase.mpr ⟨hda, Finset.mem_filter.mpr ⟨hdV, hodd⟩⟩ have hle : b ≤ d := Finset.min'_le P d hdP omega · right have hd4 : d % 4 ≠ 0 := by intro hh exact hdc (four_divisible_unique hpos hgcd hdV hcV hh hc4) omega exact ⟨a,b,c,d,heq,hab,haodd,hbodd,hc4,hdcase⟩ end Bounty.Pure05 end /- Component: ThreeOdd. -/ namespace Bounty.Pure05 /-- If the even speed were largest, a half-period shift gives a quarter witness. -/ lemma three_odd_even_lt_largest {a b q E : ℕ} (hab : a < b) (hbq : b < q) (hE : 0 < E) (hao : a % 2 = 1) (hbo : b % 2 = 1) (hqo : q % 2 = 1) (hEe : E % 2 = 0) (hbad : NoQuarter a b q E) : E < q := by by_contra hn have hqE : q ≤ E := by omega have hER : (0 : ℝ) < E := by exact_mod_cast hE let t : ℝ := 1 / (4 * (E : ℝ)) have ht0 : 0 ≤ t := by dsimp [t]; positivity have htE : t * (E : ℝ) = 1 / 4 := by dsimp [t] field_simp [hER.ne'] <;> ring have hsmall (v : ℕ) (hv : v ≤ E) : t * (v : ℝ) ≤ 1 / 4 := by calc t * (v : ℝ) ≤ t * (E : ℝ) := mul_le_mul_of_nonneg_left (by exact_mod_cast hv) ht0 _ = 1 / 4 := htE have hEt : Quarter t E := by refine ⟨0, ?_, ?_⟩ <;> simp only [Int.cast_natCast, Int.cast_zero, sub_zero] <;> rw [htE] <;> norm_num exact hbad (t + 1 / 2) ⟨quarter_half_shift_small_odd hao ht0 (hsmall a (by omega)), quarter_half_shift_small_odd hbo ht0 (hsmall b (by omega)), quarter_half_shift_small_odd hqo ht0 (hsmall q hqE), quarter_even_shift (Nat.dvd_of_mod_eq_zero hEe) hEt⟩ lemma three_odd_noQuarter_swap {a b q E : ℕ} (hbad : NoQuarter a b q E) : NoQuarter b a q E := by intro t ht exact hbad t ⟨ht.2.1, ht.1, ht.2.2.1, ht.2.2.2⟩ lemma three_odd_ordered_unsigned {q E a b r s : ℕ} (hqodd : q % 2 = 1) (hEe : E % 2 = 0) (hE : 0 < E) (hEq : E < q) (hcop : Nat.Coprime E q) (hao : a % 2 = 1) (ha : 0 < a) (haq : a < q) (hbo : b % 2 = 1) (hb : 0 < b) (hbq : b < q) (hr : 0 < r) (hrs : r < s) (hshalf : 2 * s < q) (hrcop : Nat.Coprime r q) (hscop : Nat.Coprime s q) (hra : SignedScaled q E a r) (hsb : SignedScaled q E b s) (hwords : ∀ j : ℕ, j % 2 = 1 → 2 * j < q → r * j / q = s * j / q) (hbad : NoQuarter a b q E) : Classified ({a,b,q,E} : Finset ℕ) := by rcases odd_floor_classification hqodd hr hrs hshalf hrcop hscop hwords with h12 | h13 · obtain ⟨rfl, rfl⟩ := h12 have hfamily := classified_of_signed_one_two hqodd hEe hE hEq hcop hao ha haq hbo hb hbq hra hsb have hset : ({a,b,q,E} : Finset ℕ) = {E,q,a,b} := by ext v simp only [Finset.mem_insert, Finset.mem_singleton] tauto rw [hset] exact hfamily · obtain ⟨rfl, rfl, rfl⟩ := h13 exact False.elim (thirteen_noQuarter_false hao hbo hEe hcop hra hsb hbad) /-- The three-odd-speed case of the pure four-speed classification. -/ theorem three_odd_classification {a b q E : ℕ} (ha : 0 < a) (hab : a < b) (hbq : b < q) (hE : 0 < E) (hao : a % 2 = 1) (hbo : b % 2 = 1) (hqo : q % 2 = 1) (hE4 : E % 4 = 0) (hg : PairwiseGcdTwo a b q E) (hbad : NoQuarter a b q E) : Classified ({a,b,q,E} : Finset ℕ) := by have hb : 0 < b := by omega have hq : 3 ≤ q := by omega have hEe : E % 2 = 0 := by omega have hEq : E < q := three_odd_even_lt_largest hab hbq hE hao hbo hqo hEe hbad rcases hg with ⟨hgAB, hgAQ, hgAE, hgBQ, hgBE, hgQE⟩ have hac : Nat.Coprime a q := coprime_of_odd_gcd_two ha hao hgAQ have hbc : Nat.Coprime b q := coprime_of_odd_gcd_two hb hbo hgBQ have hcop : Nat.Coprime E q := (coprime_of_odd_gcd_two (by omega) hqo hgQE).symm obtain ⟨r, hr, hrhalf, hrcop, hra⟩ := exists_unsigned_scaled hq hqo hcop hac obtain ⟨s, hs, hshalf, hscop, hsb⟩ := exists_unsigned_scaled hq hqo hcop hbc have hrne : r ≠ s := unsigned_distinct hab hbq hao hbo hqo hra hsb have hwords := three_odd_floor_words hq hqo hE4 hcop hao hbo hrhalf hshalf hrcop hscop hra hsb hbad by_cases hrs : r < s · exact three_odd_ordered_unsigned hqo hEe hE hEq hcop hao ha (by omega) hbo hb hbq hr hrs hshalf hrcop hscop hra hsb hwords hbad · have hsr : s < r := by omega have hwords' : ∀ j : ℕ, j % 2 = 1 → 2 * j < q → s * j / q = r * j / q := by intro j hj htest exact (hwords j hj htest).symm have hfamily := three_odd_ordered_unsigned hqo hEe hE hEq hcop hbo hb hbq hao ha (by omega) hs hsr hrhalf hscop hrcop hsb hra hwords' (three_odd_noQuarter_swap hbad) have hset : ({a,b,q,E} : Finset ℕ) = {b,a,q,E} := by ext v simp only [Finset.mem_insert, Finset.mem_singleton] tauto rw [hset] exact hfamily end Bounty.Pure05 /- Component: Classifier. -/ namespace Bounty.Pure05 open Math15.LonelyRunner theorem distinct_of_card_four {a b c d : ℕ} (hcard : ({a,b,c,d} : Finset ℕ).card=4) : a≠b ∧ a≠c ∧ a≠d ∧ b≠c ∧ b≠d ∧ c≠d := by have ha : a ∉ ({b,c,d} : Finset ℕ) := by intro h rw [Finset.insert_eq_of_mem h] at hcard have hbound : ({b,c,d} : Finset ℕ).card≤3 := Finset.card_le_three omega have hcard₃ : ({b,c,d} : Finset ℕ).card=3 := by rw [Finset.card_insert_of_notMem ha] at hcard omega have hb : b ∉ ({c,d} : Finset ℕ) := by intro h rw [Finset.insert_eq_of_mem h] at hcard₃ have hbound : ({c,d} : Finset ℕ).card≤2 := Finset.card_le_two omega have hcard₂ : ({c,d} : Finset ℕ).card=2 := by rw [Finset.card_insert_of_notMem hb] at hcard₃ omega have hc : c≠d := Finset.card_pair_eq_two_iff.mp hcard₂ simp only [Finset.mem_insert, Finset.mem_singleton, not_or] at ha hb exact ⟨ha.1,ha.2.1,ha.2.2,hb.1,hb.2,hc⟩ /-- Every primitive four-speed tuple below a quarter belongs to a spectral family. -/ theorem pure_classification {V : Finset ℕ} (hpos : Positive V) (hcard : V.card = 4) (hprim : Primitive V) (hpair : ∀ u ∈ V, ∀ v ∈ V, u ≠ v → Nat.gcd u v ≤ 2) (hbad : ML V < (1 / 4 : ℝ)) : Classified V := by obtain ⟨a, b, c, d, hset, hab, hao, hbo, hc4, hdcase⟩ := parity_shape hpos hprim hcard hpair hbad have haV : a ∈ V := by rw [hset]; simp have hbV : b ∈ V := by rw [hset]; simp have hcV : c ∈ V := by rw [hset]; simp have hdV : d ∈ V := by rw [hset]; simp have ha := hpos a haV have hc := hpos c hcV have hd := hpos d hdV have hcard' : ({a,b,c,d} : Finset ℕ).card = 4 := by rw [← hset]; exact hcard obtain ⟨hneab, hneac, hnead, hnebc, hnebd, hnecd⟩ := distinct_of_card_four hcard' have habg := hpair a haV b hbV hneab have hacg := hpair a haV c hcV hneac have hadg := hpair a haV d hdV hnead have hbcg := hpair b hbV c hcV hnebc have hbdg := hpair b hbV d hdV hnebd have hcdg := hpair c hcV d hdV hnecd have hg : PairwiseGcdTwo a b c d := ⟨habg, hacg, hadg, hbcg, hbdg, hcdg⟩ have hgs : PairwiseGcdTwo a b d c := by exact ⟨habg, hadg, hacg, hbdg, hbcg, by simpa only [Nat.gcd_comm] using hcdg⟩ have hn : NoQuarter a b c d := noQuarter_of_ML_lt (by rw [← hset]; exact hbad) have hns : NoQuarter a b d c := by intro t ht exact hn t ⟨ht.1, ht.2.1, ht.2.2.2, ht.2.2.1⟩ have hsets : V = ({a,b,d,c} : Finset ℕ) := by rw [hset] ext x simp only [Finset.mem_insert, Finset.mem_singleton] tauto rcases hdcase with ⟨hdo, hbd⟩ | hd2 · rw [hsets] exact three_odd_classification ha hab hbd hc hao hbo hdo hc4 hgs hns · have hce : c % 2 = 0 := by omega have hde : d % 2 = 0 := by omega by_cases hcd : c < d · rw [hset] exact two_odd_classification ha hab hc hcd hao hbo hce hde (Or.inl hc4) hg hn · have hdc : d < c := by omega rw [hsets] exact two_odd_classification ha hab hd hdc hao hbo hde hce (Or.inr hc4) hgs hns /-- The pure classification and the exact family maxima prove the catalog spectrum. -/ theorem pure_target : Target05 := by intro V hpos hcard hprim hpair by_cases hquarter : (1 / 4 : ℝ) ≤ ML V · exact Or.inl hquarter have hbad : ML V < (1 / 4 : ℝ) := lt_of_not_ge hquarter exact classified_spectrum (pure_classification hpos hcard hprim hpair hbad) end Bounty.Pure05 namespace Bounty theorem target : Math15.LonelyRunner.Target05 := Pure05.pure_target end Bounty namespace Bounty