Require Export Replace2.
(* Definition of the opposite for nat *)
Definition Natopp := (fun x:nat => 0%nat).
(* Definition of the opposite for N *)
Definition Nopp := (fun x:N => 0%N).
(* Auxillary functions for Z *)
Definition is_Z0 := (Zeq_bool 0).
Definition is_Z1 := (Zeq_bool 1).
Definition is_Zpos := (Zle_bool 0).
Definition is_Zdiv :=
fun x y => if Zeq_bool x Z0 then false else Zeq_bool Z0 (Zmod y x).
Definition Zgcd :=
fun x y => (if (is_Zdiv x y) then x else if (is_Zdiv y x) then y else 1%Z).
(* Check if a nat is a number *)
Ltac is_NatCst p :=
match p with
| O => constr:(true)
| S ?p' => is_NatCst p'
| _ => constr:(false)
end.
(* Convert a Z into a nat if it is a number *)
Ltac NatCst t :=
match is_NatCst t with
| false => constr:(false)
| _ => let res := eval compute in (Z_of_nat t) in constr:(res)
end.
(* Check if a number is a positive *)
Ltac is_PCst p :=
match p with
| xH => constr:(true)
| xO ?p' => is_PCst p'
| xI ?p' => is_PCst p'
| _ => constr:(false)
end.
(* Check if a N is a number *)
Ltac is_NCst p :=
match p with
| N0 => constr:(true)
| Npos ?p' => is_PCst p'
| _ => constr:(false)
end.
(* Convert a Z into a nat if it is a number *)
Ltac NCst t :=
match is_NCst t with
| false => constr:(false)
| _ => let res := eval compute in (Z_of_N t) in constr:(res)
end.
(* If a number is an integer return itself otherwise false *)
Ltac ZCst t :=
match t with
| Z0 => constr:(t)
| Zpos ?p => match is_PCst p with
| false => constr:(false)
| _ => constr:(t)
end
| Zneg ?p => match is_PCst p with
| false => constr:(false)
| _ => constr:(t)
end
| _ => constr:(false)
end.
(* Check if a number is an integer *)
Ltac is_ZCst t := match t with
| Z0 => constr:(true)
| Zpos ?p => is_PCst p
| Zneg ?p => is_PCst p
| _ => constr:(false) end.
(* Turn a positive into a real *)
Fixpoint P2R (z: positive) {struct z}: R :=
match z with
xH => 1%R
| (xO xH) => 2%R
| (xI xH) => 3%R
| (xO z1) => (2*(P2R z1))%R
| (xI z1) => (1+2*(P2R z1))%R
end.
(* Turn an integer into a real *)
Definition Z2R (z: Z): R :=
match z with
Z0 => 0%R
| (Zpos z1) => (P2R z1)%R
| (Zneg z1) => (-(P2R z1))%R
end.
(* Turn a R when possible into a Z *)
Ltac RCst t :=
match t with
| R0 => constr:(Z0)
| R1 => constr:(Zpos xH)
| Rplus ?e1 ?e2 =>
match (RCst e1) with
false => constr:(false)
| ?e3 => match (RCst e2) with
false => constr:(false)
|  ?e4 =>  eval vm_compute in (Zplus e3  e4)
end
end
| Rminus ?e1 ?e2 =>
match (RCst e1) with
false => constr:(false)
| ?e3 => match (RCst e2) with
false => constr:(false)
|  ?e4 => eval vm_compute in (Zminus e3  e4)
end
end
| Rmult ?e1 ?e2 =>
match (RCst e1) with
false => constr:(false)
| ?e3 => match (RCst e2) with
false => constr:(false)
|  ?e4 => eval vm_compute in (Zmult e3  e4)
end
end
| Ropp ?e1 =>
match (RCst e1) with
false => constr:(false)
| ?e3 => eval vm_compute in (Z.opp e3)
end
| IZR ?e1 =>
match (ZCst e1) with
false => constr:(false)
| ?e3 => e3
end
| _ => constr:(false)
end.
(* Remove the Z.abs_nat of a number, unfortunately stops at the first Z.abs_nat x where x is not a number *)
Ltac clean_zabs term :=
match term with
context id [(Z.abs_nat ?X)] =>
match is_ZCst X with
true =>
let x := eval vm_compute in (Z.abs_nat X) in
let y := context id [x] in
clean_zabs y
| false => term
end
| _ => term
end.
(* Remove the Z.abs_N of a number, unfortunately stops at the first Z.abs_nat x where x is not a number *)
Ltac clean_zabs_N term :=
match term with
context id [(Z.abs_N ?X)] =>
match is_ZCst X with
true =>
let x := eval vm_compute in (Z.abs_N X) in
let y := context id [x] in
clean_zabs_N y
| false => term
end
| _ => term
end.
(* Equality test for Ltac *)
Ltac eqterm t1 t2 :=
match constr:((t1,t2)) with (?X, ?X) => true | _ => false end.
(* For replace *)
intros; apply trans_equal with y; auto.
Qed.
(* Theorems for nat *)
Open Scope nat_scope.
intros; apply f_equal2 with (f := plus); auto.
Qed.
intros a b c H H1; case H.
apply plus_reg_l with a; auto.
Qed.
intros n m p H; unfold ge; apply plus_le_compat_l; auto.
Qed.
intros a b c H H1; case H; subst; auto.
Qed.
intros n m p H; unfold ge; apply plus_le_reg_l with p; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H1 H2; red; apply le_trans with z; auto.
Qed.
Close Scope nat_scope.
(* Theorems for N *)
Open Scope N_scope.
intros; apply f_equal2 with (f:= Nplus); auto.
Qed.
intros a b c H1 H2; case H1.
apply Nplus_reg_l with a; auto.
Qed.
intros; to_nat; auto with arith.
Qed.
intros; to_nat; auto with arith.
Qed.
intros; to_nat; auto with arith.
Qed.
intros; to_nat; auto with arith.
Qed.
intros a b c H H1; case H; apply f_equal2 with (f:= Nplus); auto.
Qed.
intros; to_nat; apply plus_lt_reg_l with nn1; auto with arith.
Qed.
intros; to_nat; apply plus_gt_reg_l with nn1; auto with arith.
Qed.
intros; to_nat; apply plus_le_reg_l with nn1; auto with arith.
Qed.
intros; to_nat; apply plus_ge_reg_l with nn1; auto with arith.
Qed.
intros; subst; auto.
Qed.
intros; subst; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros; to_nat; red; apply le_trans with nn1; auto with arith.
Qed.
Close Scope N_scope.
(* Theorems for Z *)
Open Scope Z_scope.
intros; apply f_equal2 with (f := Zplus); auto.
Qed.
intros a b c H H1; case H.
apply Zplus_reg_l with a; auto.
Qed.
intros n m p H; apply Z.le_ge; apply Zplus_le_compat_l; auto; apply Z.ge_le; auto.
Qed.
intros a b c H H1; case H; subst; auto.
Qed.
intros n m p H; apply Z.le_ge; apply Zplus_le_reg_l with p; auto; apply Z.ge_le; auto.
Qed.
(* Theorems to simplify the goal 0 ? x * y and x * y ? 0 where ? is < > <= >= *)
auto with zarith.
Qed.
intros x y H1 H2; replace (x * y)%Z with (-x * -y)%Z; auto with zarith; ring.
Qed.
auto with zarith.
Qed.
auto with zarith.
Qed.
intros x y H1 H2; apply Zle_pos_neg; replace (- (x * y))%Z with (x * (- y))%Z; auto with zarith; ring.
Qed.
intros x y H1 H2; apply Zle_pos_neg; replace (- (x * y))%Z with (-x * y)%Z; auto with zarith; ring.
Qed.
intros; apply Zmult_lt_O_compat; auto with zarith.
Qed.
intros x y H1 H2; replace (x * y)%Z with (-x * -y)%Z; auto with zarith; try ring.
apply Zmult_lt_O_compat; auto with zarith.
Qed.
auto with zarith.
Qed.
intros x y H1 H2; apply Zlt_pos_neg; replace (- (x * y))%Z with (x * (- y))%Z; auto with zarith; try ring.
apply Zmult_lt_O_compat; auto with zarith.
Qed.
intros x y H1 H2; apply Zlt_pos_neg; replace (- (x * y))%Z with (-x * y)%Z; auto with zarith; try ring.
apply Zmult_lt_O_compat; auto with zarith.
Qed.
intros; apply Z.le_ge; apply Zle_sign_neg_neg; auto with zarith.
Qed.
intros; apply Z.le_ge; apply Zle_sign_pos_pos; auto with zarith.
Qed.
auto with zarith.
Qed.
intros; apply Z.le_ge; apply Zle_sign_neg_pos; auto with zarith.
Qed.
intros; apply Z.le_ge; apply Zle_sign_pos_neg; auto with zarith.
Qed.
intros; apply Z.lt_gt; apply Zlt_sign_neg_neg; auto with zarith.
Qed.
intros; apply Z.lt_gt; apply Zlt_sign_pos_pos; auto with zarith.
Qed.
auto with zarith.
Qed.
intros; apply Z.lt_gt; apply Zlt_sign_neg_pos; auto with zarith.
Qed.
intros; apply Z.lt_gt; apply Zlt_sign_pos_neg; auto with zarith.
Qed.
(* Theorems to simplify the hyp 0 ? x * y and x * y ? 0 where ? is < > <= >= *)
intros x y H1 H2; case (Zle_or_lt 0 y); auto with zarith.
intros H3; absurd (0 <= x * y)%Z; auto with zarith.
apply Zlt_not_le;apply Zlt_sign_pos_neg; auto.
Qed.
intros x y H1 H2; case (Zle_or_lt y  0); auto with zarith.
intros H3; absurd (0 <= x * y)%Z; auto with zarith.
apply Zlt_not_le;apply Zlt_sign_neg_pos; auto.
Qed.
intros x y H1 H2; case (Zle_or_lt y 0); auto with zarith.
intros H3; absurd (x * y <= 0)%Z; auto with zarith.
apply Zlt_not_le;apply Zlt_sign_pos_pos; auto.
Qed.
intros x y H1 H2; case (Zle_or_lt 0 y); auto with zarith.
intros H3; absurd (x * y <= 0)%Z; auto with zarith.
apply Zlt_not_le;apply Zlt_sign_neg_neg; auto.
Qed.
intros x y H1 H2; apply Z.le_ge; apply Zle_sign_pos_pos_rev with x; auto with zarith.
Qed.
intros x y H1 H2; apply Z.le_ge; apply Zle_sign_neg_neg_rev with x; auto with zarith.
Qed.
intros x y H1 H2; apply Z.le_ge; apply Zle_sign_pos_neg_rev with x; auto with zarith.
Qed.
intros x y H1 H2; apply Z.le_ge; apply Zle_sign_neg_pos_rev with x; auto with zarith.
Qed.
intros x y H1 H2; case (Zle_or_lt y 0); auto with zarith.
intros H3; absurd (0 < x * y)%Z; auto with zarith.
apply Zle_not_lt;apply Zle_sign_pos_neg; auto with zarith.
Qed.
intros x y H1 H2; case (Zle_or_lt 0 y); auto with zarith.
intros H3; absurd (0 < x * y)%Z; auto with zarith.
apply Zle_not_lt;apply Zle_sign_neg_pos; auto with zarith.
Qed.
intros x y H1 H2; case (Zle_or_lt 0 y); auto with zarith.
intros H3; absurd (x * y < 0)%Z; auto with zarith.
apply Zle_not_lt;apply Zle_sign_pos_pos; auto with zarith.
Qed.
intros x y H1 H2; case (Zle_or_lt y 0); auto with zarith.
intros H3; absurd (x * y < 0)%Z; auto with zarith.
apply Zle_not_lt;apply Zle_sign_neg_neg; auto with zarith.
Qed.
intros x y H1 H2; apply Z.lt_gt; apply Zlt_sign_pos_pos_rev with x; auto with zarith.
Qed.
intros x y H1 H2; apply Z.lt_gt; apply Zlt_sign_neg_neg_rev with x; auto with zarith.
Qed.
intros x y H1 H2; apply Z.lt_gt; apply Zlt_sign_pos_neg_rev with x; auto with zarith.
Qed.
intros x y H1 H2; apply Z.lt_gt; apply Zlt_sign_neg_pos_rev with x; auto with zarith.
Qed.
(* Theorem to simplify x * y ? x * z where ? is < > <= >= *)
intros n m p H1 H2; replace (p * n)%Z with (-(-p * n))%Z; auto with zarith; try ring.
replace (p * m)%Z with (-(-p * m))%Z; auto with zarith; try ring.
apply Zopp_le; apply Zmult_le_compat_l; auto with zarith.
Qed.
auto with zarith.
Qed.
intros n m p H1 H2; replace (p * n)%Z with (-(-p * n))%Z; auto with zarith; try ring.
replace (p * m)%Z with (-(-p * m))%Z; auto with zarith; try ring.
apply Zopp_lt; apply Zmult_lt_compat_l; auto with zarith.
Qed.
auto with zarith.
Qed.
intros n m p H1 H2; replace (p * n)%Z with (-(-p * n))%Z; auto with zarith; try ring.
replace (p * m)%Z with (-(-p * m))%Z; auto with zarith; try ring.
apply Zopp_ge; apply Zmult_ge_compat_l; auto with zarith.
Qed.
auto with zarith.
Qed.
intros n m p H1 H2; replace (p * n)%Z with (-(-p * n))%Z; auto with zarith; try ring.
replace (p * m)%Z with (-(-p * m))%Z; auto with zarith; try ring.
apply Zopp_gt; apply Zmult_gt_compat_l; auto with zarith.
Qed.
(* Theorem to simplify a hyp x * y ? x * z where ? is < > <= >= *)
intros n m p H H1; case (Zle_or_lt n m); auto; intros H2.
absurd (p * n <= p * m)%Z; auto with zarith.
apply Zlt_not_le; apply Zmult_lt_compat_l; auto.
Qed.
intros n m p H H1; case (Zle_or_lt m n); auto; intros H2.
absurd (p * n <= p * m)%Z; auto with zarith.
apply Zlt_not_le; apply Zmult_lt_neg_compat_l; auto.
Qed.
intros n m p H H1; case (Zle_or_lt m n); auto; intros H2.
absurd (p * n < p * m)%Z; auto with zarith.
apply Zle_not_lt; apply Zmult_le_compat_l; auto with zarith.
Qed.
intros n m p H H1; case (Zle_or_lt n m); auto; intros H2.
absurd (p * n < p * m)%Z; auto with zarith.
apply Zle_not_lt; apply Zmult_le_neg_compat_l; auto with zarith.
Qed.
intros n m p H H1;
apply Z.le_ge; apply Zmult_le_compat_l_rev with p; auto with zarith.
Qed.
intros n m p H H1;
apply Z.le_ge; apply Zmult_le_neg_compat_l_rev with p; auto with zarith.
Qed.
intros n m p H H1;
apply Z.lt_gt; apply Zmult_lt_compat_l_rev with p; auto with zarith.
Qed.
intros n m p H H1;
apply Z.lt_gt; apply Zmult_lt_neg_compat_l_rev with p; auto with zarith.
Qed.
(* For replace *)
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H; rewrite H; auto.
Qed.
intros x y z H1 H2; red; apply Zge_trans with z; auto.
Qed.
Close Scope Z_scope.
(* Theorems for R *)
Open Scope R_scope.
intros; apply f_equal2 with (f := Rplus); auto.
Qed.
intros a b c H H1; case H.
apply Rplus_eq_reg_l with a; auto.
Qed.
intros n m p H; apply Rle_ge; apply Rplus_le_compat_l; auto; apply Rge_le; auto.
Qed.
intros a b c H H1; case H; subst; auto.
Qed.
intros n m p H; apply Rle_ge; apply Rplus_le_reg_l with p; auto; apply Rge_le; auto.
Qed.
(* Theorems to simplify the goal 0 ? x * y and x * y ? 0 where ? is < > <= >= *)
intros x y H; apply Rmult_le_pos; auto with real.
Qed.
intros x y H1 H2; replace (x * y)%R with (-x * -y)%R; auto with real; try ring.
apply Rmult_le_pos; auto with real.
Qed.
intros x H; rewrite <- (Ropp_involutive 0);  rewrite <- (Ropp_involutive x); auto with real.
apply Ropp_le_contravar; auto with real.
rewrite Ropp_0; auto with real.
Qed.
intros x y H1 H2; apply Rle_pos_neg; replace (- (x * y))%R with (x * (- y))%R; auto with real; try ring.
apply Rmult_le_pos; auto with real.
Qed.
intros x y H1 H2; apply Rle_pos_neg; replace (- (x * y))%R with (-x * y)%R; auto with real; try ring.
apply Rmult_le_pos; auto with real.
Qed.
intros; apply Rmult_lt_0_compat; auto with real.
Qed.
intros x y H1 H2; replace (x * y)%R with (-x * -y)%R; auto with real; try ring.
apply Rmult_lt_0_compat; auto with real.
Qed.
intros x H; rewrite <- (Ropp_involutive 0);  rewrite <- (Ropp_involutive x); auto with real.
apply Ropp_lt_contravar; auto with real.
rewrite Ropp_0; auto with real.
Qed.
intros x y H1 H2; apply Rlt_pos_neg; replace (- (x * y))%R with (x * (- y))%R; auto with real; try ring.
apply Rmult_lt_0_compat; auto.
replace 0%R with (-0)%R; auto with real.
Qed.
intros x y H1 H2; apply Rlt_pos_neg; replace (- (x * y))%R with (-x * y)%R; auto with real; try ring.
apply Rmult_lt_0_compat; auto with real.
Qed.
intros; apply Rle_ge; apply Rle_sign_neg_neg; auto with real.
Qed.
intros; apply Rle_ge; apply Rle_sign_pos_pos; auto with real.
Qed.
intros x H; rewrite <- (Ropp_involutive 0);  rewrite <- (Ropp_involutive x); auto with real.
apply Rle_ge;apply Ropp_le_contravar; auto with real.
rewrite Ropp_0; auto with real.
Qed.
intros; apply Rle_ge; apply Rle_sign_neg_pos; auto with real.
Qed.
intros; apply Rle_ge; apply Rle_sign_pos_neg; auto with real.
Qed.

Theorem Rgt_sign_neg_neg: forall x y, (0 > x -> 0 > y  -> x * y > 0)%R.