(* Copyright 2001, 2009 Luc Rutten  This file is part of ModRed.  ModRed is free software: you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.  ModRed is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public License for more details.  You should have received a copy of the GNU Lesser General Public License along with ModRed.  If not, see <http://www.gnu.org/licenses/>. *)
(* Preparations for fast modular reduction lemmas. *)
(* Coq 8.2 *)
Open Scope Z_scope.
Definition in_Z_ (m x : Z) := 0 <= x < m.
Definition Z_ (m : Z) := sig (in_Z_ m).
Coercion Z_from_Z_ (m : Z) (x : Z_ m) := proj1_sig (P := in_Z_ m) x.
Notation _Z := (Z_from_Z_ _).
Definition in_Zpls (x : Z) := 0 < x.
Definition Zpls := sig in_Zpls.
Coercion Zpls_ (x : Zpls) := proj1_sig (P := in_Zpls) x.
intros n i. case i. unfold in_Z_. simpl. tauto. Qed.
intros n i. case i. unfold in_Z_. simpl. tauto. Qed.
intros x m H. elim (Z_mod_lt x m); omega. Qed.
intros x m H. elim (Z_mod_lt x m); omega. Qed.
intros x m H H0. cut (m * (x / m) + x mod m < m). intro H1. cut (m * (x / m) < m).
intro H2. elim (Zle_or_lt 0 (x / m)); intro H3. elim (Zle_lt_or_eq 0 (x / m)). intro H4.
cut (m * 1 <= m * (x / m)). intro H5. absurd (m * (x / m) < m). omega. assumption.
apply Zmult_le_compat_l. omega. omega. omega. assumption. absurd (x / m < 0). apply Zle_not_lt.
apply Z.ge_le. apply Z_div_ge0; omega. assumption. cut (0 <= x mod m). omega. elim (Z_mod_lt x m). omega.
omega. rewrite <- Z_div_mod_eq. assumption. omega. Qed.
intros a m H H0. apply Z.ge_le. apply Z_div_ge0. omega. omega. Qed.
intros. apply Z.ge_le. apply Z_div_ge. omega. omega. Qed.
intros x m H. replace (x + m) with (x + 1 * m). apply Z_mod_plus. omega. ring. Qed.
intros x m H. replace (x - m) with (x + -1 * m). apply Z_mod_plus. omega. ring. Qed.
intros. rewrite Zplus_comm. apply Z_mod_plus. omega. Qed.
intros. unfold Zminus. rewrite <- Zopp_mult_distr_l_reverse. apply Z_mod_plus. omega. Qed.
intros. rewrite Zmult_comm. rewrite <- Z_div_mod_eq. trivial. omega. Qed.
intros a b m H. replace (a + b) with (a / m * m + a mod m + b). rewrite Zplus_comm.
rewrite Zplus_comm with (m := a mod m). rewrite Zplus_assoc. rewrite Z_mod_plus.
rewrite Zplus_comm. trivial. omega. rewrite Zdivmod_split. trivial. assumption. Qed.
intros a b m H. replace (a * b) with ((a / m * m + a mod m) * b).
rewrite Zmult_plus_distr_l. rewrite Zmod_plus_distr_l.
replace (a / m * m * b) with (0 + a / m * b * m). rewrite Z_mod_plus. trivial. omega.
ring. assumption. rewrite Zdivmod_split. trivial. assumption. Qed.
unfold Zminus. intros. apply Zmod_plus_distr_l. assumption. Qed.
intros a b m H. unfold Zminus. replace (- b) with (b * -1). do 2 rewrite Zplus_comm with (n := a).
rewrite Zmod_plus_distr_l. rewrite Zmod_mult_distr_l. rewrite <- Zmod_plus_distr_l.
apply f_equal2 with (f := Zmod). ring. trivial. assumption. assumption. assumption. ring. Qed.
intros x m H H0. rewrite <- Zdivmod_split with (x := x) (m := m).
replace ((x / m * m + x mod m) mod m) with (x mod m).
rewrite Zdiv_small_0; auto. rewrite Zdivmod_split. trivial. omega. omega. Qed.
intros a b H. cut (a / b * b + a mod b = a). omega. apply Zdivmod_split. assumption. Qed.
intros. rewrite Zdiv_a_b_b_Zmod. ring. assumption. Qed.
intros x y z H H0. rewrite <- Zminus_Zdiv_Zmult with (a := x). rewrite Zmult_assoc.
apply Zmod_minus_km. assumption. fold (0 * 0). apply Zmult_lt_0_compat; omega. Qed.
intros. rewrite Zplus_comm. rewrite Z_div_plus. rewrite Zdiv_small_0. ring.
assumption. assumption. omega. Qed.
intros. replace (a * m - b) with ((a - 1) * m + (m - b)). apply Zdiv_mult_plus. auto. omega.
omega. ring. Qed.
intros. rewrite Zplus_comm. rewrite Z_div_plus. ring. omega. Qed.
intro a. replace a with (a * 1). rewrite Z_div_mult. ring. omega. ring. Qed.
intro z. cut (0 <= z mod 1). cut (z mod 1 < 1). omega. apply Zmod_lt_z_m. omega. apply Zmod_le_0_z. omega. Qed.
Set Implicit Arguments.
Unset Strict Implicit.
Definition If (T : Set) (b : bool) (t e : T) :=
(* If T b t e  =  if b then t else e *)
match b with
| true => t
| false => e
end.
Set Strict Implicit.
Unset Implicit Arguments.
simple destruct x. simpl. omega. intros. simpl. symmetry.
apply Zpos_eq_Z_of_nat_o_nat_of_P. intros p H. absurd (0 <= Zneg p). unfold Z.le. tauto.
assumption. Qed.
simple induction i. replace (Zpower_nat 2 0) with 1. omega. trivial. intros n H.
rewrite <- two_power_nat_correct. rewrite two_power_nat_S. rewrite two_power_nat_correct.
omega. Qed.
induction i. simpl. trivial. rewrite <- two_power_nat_correct. rewrite two_power_nat_S.
rewrite two_power_nat_correct. rewrite IHi. replace (Z_of_nat (S i)) with (1 + Z_of_nat i).
rewrite Zpower_exp. replace (2 ^ 1) with 2. trivial. trivial. omega. omega. rewrite inj_S.
omega. Qed.
intros i H. rewrite Zpower_nat_Zpower. rewrite Z_to_inject_nat. trivial. assumption. Qed.
intros x H. rewrite Zpower_Zpower_nat. apply Zlt_0_power_nat. assumption. Qed.
intros i j Hi Hij. replace j with (i + (j - i)). rewrite Zpower_exp.
apply Z.le_lt_trans with (2 ^ i * 2 ^ 0). simpl. omega. apply Zmult_lt_compat_l. apply lt_0_Zpow.
assumption. replace (j - i) with (j - i - 1 + 1).  rewrite Zpower_exp. replace (2 ^ 1) with 2.
replace (2 ^ 0) with 1. cut (0 < 2 ^ (j - i - 1)). omega. apply lt_0_Zpow. omega. trivial. trivial.
omega. omega.  ring. omega. omega. ring. Qed.
intros i j Hi Hij. elim (Zle_lt_or_eq i j). intro. apply Zlt_le_weak. apply Zlt_pow_lt.
assumption. assumption. intro H. rewrite H. omega. assumption. Qed.
intros i j Hi Hj Hij. elim (Zle_lt_or_eq i j). trivial. intro H. rewrite H in Hij.
absurd (2 ^ j < 2 ^ j). omega. assumption. elim (Zle_or_lt i j). trivial. intro H. cut (2 ^ j < 2 ^ i).
intro H0. absurd (2 ^ j < 2 ^ i); omega. apply Zlt_pow_lt; omega. Qed.
Definition Zlog_sup (M : Z) :=
match M with
| Zpos p => log_sup p
| _ => 0
end.
intros i H. replace (2 ^ i) with (Zpos (shift_nat (Z.abs_nat i) 1)). simpl. rewrite log_sup_shift_nat.
apply Z_to_inject_nat. assumption. rewrite shift_nat_correct. rewrite Zpower_nat_Zpower.
rewrite Z_to_inject_nat. ring. assumption. Qed.
intros z H. unfold two_p. case z. trivial. intro p. rewrite two_power_pos_correct. trivial. trivial. Qed.
intro z. case z. intro H. absurd (0 < 0); omega. simpl. intros p H. apply log_sup_correct1.
intros p H. absurd (0 < Zneg p). simplify_eq. assumption. Qed.
intros z H. elim (Zle_or_lt z 1). intro Hz. cut (z = 1). intro H0. rewrite H0. simpl. omega. omega.
case z. intro. absurd (1 < 0); omega. simpl. intros p H0. rewrite <- two_p_pow. rewrite <- two_p_pow.
replace (log_sup p - 1) with (Z.pred (log_sup p)). apply log_sup_correct2. unfold Z.pred. ring. apply log_sup_correct1.
generalize H0. case p. simpl. intros q H1. cut (0 <= log_inf q). omega. apply log_inf_correct1. simpl.
intros q H1. cut (0 <= log_sup q). omega. apply log_sup_correct1. intro. absurd (1 < 1); omega.
intros p H0. absurd (1 < Zneg p). simplify_eq. assumption. Qed.
intros z Hz i j Hi Hj H0 H1 H2 H3. elim (Zle_lt_or_eq i j). intro H4. cut (2 ^ i <= 2 ^ (j - 1)).
intro H5. absurd (2 ^ (j - 1) < z). omega. assumption. apply Zle_pow_le. assumption. omega. trivial.
elim (Zle_or_lt i j); intro H4. assumption. cut (2 ^ j <= 2 ^ (i - 1)). intro H5.
absurd (2 ^ (i - 1) < z). omega. assumption. apply Zle_pow_le. assumption. omega. Qed.
intros z Hz i Hi Hl Hh. apply Zlog_sup_unique with (z := z). assumption. apply Zlog_sup_correct1.
assumption. assumption. elim (Zlog_sup_correct2 z). tauto. assumption. elim (Zlog_sup_correct2 z).
tauto. assumption. assumption. assumption. Qed.
intros p q H. elim (Zle_or_lt p 0). intro Hp. replace (Zlog_sup p) with 0. elim (Zle_or_lt q 0).
intro Hq. replace (Zlog_sup q) with 0. omega. generalize Hq. elim q. trivial. intros r Hr.
absurd (Zpos r <= 0). apply Zlt_not_le. unfold Z.lt. trivial. assumption. intros r Hr. trivial.
apply Zlog_sup_correct1. generalize Hp. elim p. trivial. intros r Hr. absurd (Zpos r <= 0).
apply Zlt_not_le. unfold Z.lt. trivial. assumption. intros r Hr. trivial. intro H0.
elim (Zle_or_lt (Zlog_sup p) (Zlog_sup q)); intro H1. assumption. cut (Zlog_sup q <= Zlog_sup p - 1).
intro H2. cut (2 ^ Zlog_sup q <= 2 ^ (Zlog_sup p - 1)). intro H3. absurd (p <= q). apply Zlt_not_le.
apply Z.le_lt_trans with (2 ^ Zlog_sup q). elim (Zlog_sup_correct2 q). omega. omega.
elim (Zlog_sup_correct2 p). omega. assumption. assumption. apply Zle_pow_le. apply Zlog_sup_correct1.
omega. assumption. omega. Qed.
intros. rewrite Zplus_diag_eq_mult_2. rewrite Zpower_exp. trivial. omega. omega. Qed.
intros x y z H H0.
replace (x / y / z) with
((x / (y * z) * z * y + x mod (y * z)) / y / z).
rewrite Zdiv_times_plus. rewrite Zdiv_times_plus. rewrite Zplus_comm. rewrite Zdiv_small_0. ring.
apply Zle_0_div. apply Zmod_le_0_z. apply Zmult_lt_0_compat; assumption. assumption.
apply Z.le_lt_trans with ((y * z - 1) / y). apply Zdiv_le. assumption. cut (x mod (y * z) < y * z).
omega. apply Zmod_lt_z_m. apply Zmult_lt_0_compat; omega. rewrite Zmult_comm. rewrite Zdiv_mult_minus;
omega. assumption. assumption. rewrite Zmult_comm with (n := y). rewrite <- Zmult_assoc.
rewrite Zdivmod_split. trivial. apply Zmult_lt_0_compat; assumption. Qed.
intros x y z H H0. rewrite Zmult_comm with (n := y). rewrite <- Zdivdivdiv.
rewrite Z_div_mult. trivial. omega. assumption. assumption. Qed.
intros x y z H H0 H1. rewrite <- Zdiv_simpl with (y := y) (z := z).
rewrite <- Zdiv_simpl with (y := z) (z := y). rewrite Zmult_comm with (n := y).
apply Zdiv_le. apply Zmult_lt_0_compat; omega. apply Zmult_le_compat_l; omega. assumption. omega. omega.
assumption. Qed.
intros c y z Hc Hy Hz Hzc. rewrite <- Z_div_mult with (a := z / y - c / y * z / c) (b := c * y).
rewrite Zmult_minus_distr_r. rewrite Zmult_comm with (n := c). rewrite Zmult_assoc.
rewrite Zdiv_a_b_b_Zmod. rewrite Zmult_comm with (n := y). rewrite Zmult_assoc. rewrite Zdiv_a_b_b_Zmod.
do 2 rewrite Zmult_minus_distr_r. rewrite <- Zmult_assoc. rewrite Zmult_comm with (m := y).
rewrite Zmult_assoc. rewrite Zdiv_a_b_b_Zmod. rewrite Zmult_minus_distr_r.
replace (z * c - z mod y * c - (c * z - c mod y * z - (c / y * z) mod c * y))
with (c mod y * z + (c / y * z) mod c * y - z mod y * c).
apply Z.le_trans with ((c mod y * z + c * y) / (c * y)). apply Zdiv_le. apply Zmult_lt_0_compat;
assumption. apply Z.le_trans with (c mod y * z + (c / y * z) mod c * y). cut (0 <= z mod y * c). omega.
apply Zmult_le_0_compat. apply Zmod_le_0_z. assumption. omega. apply Zplus_le_compat. omega.
apply Zmult_le_compat_r. apply Zlt_le_weak. apply Zmod_lt_z_m. assumption. omega.
replace (c mod y * z + c * y) with (1 * (c * y) + c mod y * z).
rewrite Zdiv_times_plus. cut (c mod y * z / (c * y) <= 0). omega.
apply Z.le_trans with ((y - 1) * z / (c * y)). apply Zdiv_le. apply Zmult_lt_0_compat; assumption.
apply Zmult_le_compat_r. cut (c mod y < y). omega. apply Zmod_lt_z_m.
assumption. omega. rewrite Zdiv_small_0. omega. apply Zmult_le_0_compat; omega.
rewrite Zmult_comm with (n := c). elim (Zle_lt_or_eq 0 z). intro H. apply Z.lt_le_trans with (y * z).
apply Zmult_lt_compat_r. assumption. omega. apply Zmult_le_compat_l; omega. intro H. rewrite <- H.
replace ((y - 1) * 0) with 0. apply Zmult_lt_0_compat; assumption. ring. assumption.
apply Zmult_lt_0_compat; assumption. ring. ring. assumption. assumption. assumption.
apply Zmult_gt_0_compat; omega. Qed.
intros a b y x Ha Hb Hy Hx Hxab. rewrite Zmult_comm with (m := a * b / y).
rewrite <- Zdiv_simpl with (y := b) (z := a). rewrite <- Zmult_assoc. rewrite Zmult_comm with (n := b).
apply approx_cz. apply Zmult_lt_0_compat; assumption. assumption. apply Zmult_le_0_compat.
apply Zle_0_div; assumption. omega. rewrite Zmult_comm with (m := b). apply Zmult_le_compat_r.
apply Z.le_trans with ((b * a + (a - 1)) / a). apply Zdiv_le. assumption. rewrite Zmult_comm. omega.
rewrite Zdiv_mult_plus; omega. omega. assumption. assumption. Qed.
intros a b y x Ha Hb Hy Hx Hxab. cut (x / a * a / y - x / a * (a * b / y) / b <= 1). omega.
apply approx_le1; assumption. Qed.
intros c y z Hc Hy Hz. rewrite <- Zdiv_simpl with (z := y). replace (c / y * z * y) with (c / y * y * z).
apply Z.le_trans with (c * z / (c * y)). apply Zdiv_le. apply Zmult_lt_0_compat; assumption.
apply Zmult_le_compat_r. rewrite Zmult_comm. apply Z_mult_div_ge. omega. assumption.
do 2 rewrite Zmult_comm with (n := c). rewrite Zdiv_simpl. omega. assumption. assumption. ring.
assumption. assumption. Qed.
intros a b y x Ha Hb Hy Hx. rewrite Zmult_comm. rewrite <- Zdiv_simpl with (z := a).
rewrite <- Zmult_assoc. rewrite Zmult_comm with (n := b). apply approx_cz0. apply Zmult_lt_0_compat; assumption.
assumption. apply Zmult_le_0_compat. apply Zle_0_div; assumption. omega. assumption. assumption. Qed.
intros y a b x lt_0_y lt_0_a le_a_y lt_0_b le_0_x. replace (x / y) with ((a * (x / a) + x mod a) / y).
unfold Zminus. rewrite <- Z_div_plus. apply Zdiv_le. assumption. rewrite Zmult_comm.
cut (x mod a <= 1 * y). omega. apply Z.le_trans with a. apply Zlt_le_weak. apply Zmod_lt_z_m. assumption.
omega. omega. rewrite <- Z_div_mod_eq. trivial. omega. Qed.
intros y a b x lt_0_y lt_0_a lt_a_y lt_0_b le_0_x lt_x_ab.
apply Z.le_trans with (x / a * a / y - 1). cut (x / y - 1 <= x / a * a / y). omega.
apply approx_m1_two with (b := b); assumption. apply approx_m1_one; omega. Qed.
intros y a b x lt_0_y lt_0_a lt_0_b le_0_x. rewrite <- Zdiv_simpl with (z := y). rewrite <- Zmult_assoc.
apply Z.le_trans with (x / a * (a * b) / (b * y)). apply Zdiv_le. apply Zmult_lt_0_compat; omega.
apply Zmult_le_compat_l. rewrite Zmult_comm. apply Z_mult_div_ge. omega. apply Zle_0_div;
omega. rewrite Zmult_comm with (m := y). rewrite Zmult_assoc. rewrite Zdiv_simpl. omega. assumption.
assumption. assumption. assumption. Qed.
intros y a b x lt_0_y lt_0_a lt_0_b le_0_x.
apply Zdiv_le. assumption. rewrite Zmult_comm. apply Z_mult_div_ge. omega. Qed.
intros y a b x lt_0_y lt_0_a lt_0_b le_0_x. apply Z.le_trans with (x / a * a / y). apply approx_0_one;
assumption. apply approx_0_two with (b := b); assumption. Qed.
intros a b c m Hb Hm. rewrite Zplus_comm. rewrite Z_div_plus. rewrite Zplus_comm with (m := c). rewrite Z_div_plus.
rewrite Zmod_mult_distr_l. rewrite Zplus_comm. rewrite Zmod_plus_distr_l. rewrite Zplus_comm. rewrite <- Zmod_mult_distr_l.
trivial. assumption. assumption. assumption. omega. omega. Qed.
intros a b m H. cut (0 <= (a mod m + b mod m) / m). cut ((a mod m + b mod m) / m <= 1). omega.
apply Z.le_trans with ((m - 1 + m) / m). apply Zdiv_le. omega. apply Zplus_le_compat. cut (a mod m < m). omega.
apply Zmod_lt_z_m. omega. cut (b mod m < m). omega. apply Zmod_lt_z_m. omega. replace (m - 1 + m) with (2 * m - 1).
rewrite Zdiv_mult_minus. omega. omega. omega. omega. ring. apply Zle_0_div. fold (0 + 0). apply Zplus_le_compat.
apply Zmod_le_0_z. omega. apply Zmod_le_0_z. omega. omega. Qed.
intros a b m H. rewrite Z_div_mod_eq with (a := a mod m + b mod m) (b := m). elim sum_r'_i with (a := a) (b := b) (m := m).
intro H0. rewrite H0. left. rewrite <- Zmod_plus_distr_l. rewrite Zplus_comm with (n := a). rewrite <- Zmod_plus_distr_l.
rewrite Zplus_comm with (m := a). ring. omega. omega. intro H0. rewrite H0. right. rewrite <- Zmod_plus_distr_l.
rewrite Zplus_comm with (n := a). rewrite <- Zmod_plus_distr_l. rewrite Zplus_comm with (m := a). ring. omega. omega. omega.
omega. Qed.
intros m H. elim (Zle_lt_or_eq 1 m). intro H0. replace (2 ^ Zlog_sup m) with (1 * m + (2 ^ Zlog_sup m - m)).
apply Zdiv_mult_plus. omega. cut (m <= 2 ^ Zlog_sup m). omega. elim (Zlog_sup_correct2 m). tauto. assumption.
cut (2 ^ Zlog_sup m < m + m). omega.
apply Z.lt_le_trans with (2 ^ (Zlog_sup m - 1) + 1 + (2 ^ (Zlog_sup m - 1) + 1)).
replace (2 ^ (Zlog_sup m - 1) + 1 + (2 ^ (Zlog_sup m - 1) + 1))
with (2 ^ (Zlog_sup m - 1) + 2 ^ (Zlog_sup m - 1) + 2). rewrite Z_pow_plus.
replace (Zlog_sup m - 1 + 1) with (Zlog_sup m). omega. ring. cut (1 <= Zlog_sup m). omega. replace 1 with (Zlog_sup 2).
apply Zlog_sup_seq. omega. trivial. ring. apply Zplus_le_compat. cut (2 ^ (Zlog_sup m - 1) < m). omega.
elim (Zlog_sup_correct2 m). tauto. assumption. cut (2 ^ (Zlog_sup m - 1) < m). omega. elim (Zlog_sup_correct2 m). tauto.
assumption. ring. intro H0. rewrite <- H0. simpl. unfold Z.div. trivial. omega. Qed.
intros a m H. cut (0 <= a mod 2 ^ Zlog_sup m / m). cut (a mod 2 ^ Zlog_sup m / m <= 1). omega.
apply Z.le_trans with (2 ^ Zlog_sup m / m). apply Zdiv_le. assumption. cut (a mod 2 ^ Zlog_sup m < 2 ^ Zlog_sup m). omega.
apply Zmod_lt_z_m. apply lt_0_Zpow. apply Zlog_sup_correct1. assumption. rewrite div_m_1. omega. assumption. apply Zle_0_div.
apply Zmod_le_0_z. apply lt_0_Zpow. apply Zlog_sup_correct1. assumption. assumption. Qed.

(* <KEEP TOGETHER - approx_0_m2 *)
Theorem approx_0_m2 : forall (y b : Zpls) (a : Z_ y) (x : Z_ (a * b + a)),
x / y - 2 <= x / a * (a * b / y) / b <= x / y.