(* This program 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 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program 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 General Public License for more details.                       *)
(*                                                                    *)
(* You should have received a copy of the GNU Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)
Require Export Qquadratic.
Functional Scheme Qquadratic_Qpositive_to_Q_ind :=
Induction for Qquadratic_Qpositive_to_Q Sort Prop.
Ltac QSign_mismatch_ :=
apply False_ind;
match goal with
| id1:(?X1 = 1%Z),id2:(?X1 = 0%Z) |- _ =>
rewrite id2 in id1; discriminate id1
| id1:(?X1 = (-1)%Z),id2:(?X1 = 0%Z) |- _ =>
rewrite id2 in id1; discriminate id1
| id1:(?X1 = 1%Z),id2:(?X1 = (-1)%Z) |- _ =>
rewrite id2 in id1; discriminate id1
| id2:(?X1 = 0%Z),id1:(?X1 = 1%Z) |- _ =>
rewrite id2 in id1; discriminate id1
| id1:(?X1 = 0%Z),id2:(?X1 = (-1)%Z) |- _ =>
rewrite id2 in id1; discriminate id1
| id1:(?X1 = (-1)%Z),id2:(?X1 = 1%Z) |- _ =>
rewrite id2 in id1; discriminate id1
end.
(* The tactique Absurd_q_sign_ solves the goal by contradiction if in the context we have:  (C1)  id1:(q_sign a b c d e f g h p1 p2 H)=1 id2:(Z.sgn new_a+new_b+new_c+new_d)=0 ----------------------------------  or  (C2)  id1:(q_sign a b c d e f g h p1 p2 H)=1 id2:(Z.sgn new_e+new_f+new_g+new_h)=0 ----------------------------------  or  (C3)  id1:(q_sign a b c d e f g h p1 p2 H)=-1 id2:(Z.sgn new_a+new_b+new_c+new_d)=0 ----------------------------------  or  (C4)  id1:(q_sign a b c d e f g h p1 p2 H)=-1 id2:(Z.sgn new_e+new_f+new_g+new_h)=0 ----------------------------------  otherwise if in the context we have  (C5)  id1:(q_sign a b c d e f g h p1 p2 H)=0 id2:(Z.sgn ?)=0 ----------------------------------  it calls the QSign_mismatch_ tactic.  and otherwise it fails.  In the next files we used this tactic 4 times and all of them are instances of case (C1) or (C3) above. *)
Ltac Absurd_q_sign_ :=
match goal with
| id1:(q_sign ?X1 ?X2 ?X3 ?X4 ?X5 ?X6 ?X7 ?X8 ?X9 ?X10 ?X11 = ?X0),id2:
(Z.sgn _ = 0%Z) |- _ =>
match constr:(X0) with
| 0%Z => QSign_mismatch_
end ||
(apply False_ind;
assert
(HH :
Qquadratic_sign X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 =
(X0,
(qnew_a X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11,
(qnew_b X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11,
(qnew_c X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11,
qnew_d X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)),
(qnew_e X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11,
(qnew_f X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11,
(qnew_g X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11,
qnew_h X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11))),
(qnew_p1 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11,
qnew_p2 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11))));
[ rewrite <- id1;
unfold qnew_a, qnew_b, qnew_c, qnew_d, qnew_e, qnew_f, qnew_g,
qnew_h, qnew_p1, qnew_p2 in |- *;
replace (q_sign X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11) with
(fst (Qquadratic_sign X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11));
[ idtac | reflexivity ]; repeat rewrite <- pair_1;
reflexivity
| idtac ];
match constr:(X0) with
| 1%Z =>
generalize
(Qquadratic_sign_pos_1 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11
(qnew_a X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_b X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_c X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_d X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_e X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_f X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_g X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_h X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_p1 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_p2 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11) HH)
| (-1)%Z =>
generalize
(Qquadratic_sign_neg_1 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11
(qnew_a X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_b X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_c X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_d X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_e X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_f X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_g X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_h X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_p1 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11)
(qnew_p2 X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11) HH)
end; intros [(na_nb_nc_nd_pos, _)| (na_nb_nc_nd_neg, _)];
generalize (Zsgn_2 _ id2); [ apply sym_not_eq | idtac ];
apply Zorder.Zlt_not_eq; assumption)
end.

Lemma Qquadratic_Qpositive_to_Q_8 :
forall (a b c d e f g h : Z) (p1 p2 : Qpositive)
(H_Qquadratic_sg_denom_nonzero : Qquadratic_sg_denom_nonzero e f g h p1 p2),
~ same_ratio a b c d e f g h ->
q_sign a b c d e f g h p1 p2 H_Qquadratic_sg_denom_nonzero = (-1)%Z ->
Z.sgn
(qnew_a a b c d e f g h p1 p2 H_Qquadratic_sg_denom_nonzero +
qnew_b a b c d e f g h p1 p2 H_Qquadratic_sg_denom_nonzero +
qnew_c a b c d e f g h p1 p2 H_Qquadratic_sg_denom_nonzero +
qnew_d a b c d e f g h p1 p2 H_Qquadratic_sg_denom_nonzero) =
(-1)%Z ->
forall
hyp_quadraticAcc : quadraticAcc
(-
qnew_a a b c d e f g h p1 p2
H_Qquadratic_sg_denom_nonzero)
(-
qnew_b a b c d e f g h p1 p2
H_Qquadratic_sg_denom_nonzero)
(-
qnew_c a b c d e f g h p1 p2
H_Qquadratic_sg_denom_nonzero)
(-
qnew_d a b c d e f g h p1 p2
H_Qquadratic_sg_denom_nonzero)
(qnew_e a b c d e f g h p1 p2
H_Qquadratic_sg_denom_nonzero)
(qnew_f a b c d e f g h p1 p2
H_Qquadratic_sg_denom_nonzero)
(qnew_g a b c d e f g h p1 p2
H_Qquadratic_sg_denom_nonzero)
(qnew_h a b c d e f g h p1 p2
H_Qquadratic_sg_denom_nonzero)
(qnew_p1 a b c d e f g h p1 p2
H_Qquadratic_sg_denom_nonzero)
(qnew_p2 a b c d e f g h p1 p2
H_Qquadratic_sg_denom_nonzero),
Qquadratic_Qpositive_to_Q a b c d e f g h p1 p2
H_Qquadratic_sg_denom_nonzero =
Qneg
(Qquadratic_Qpositive_to_Qpositive
(- qnew_a a b c d e f g h p1 p2 H_Qquadratic_sg_denom_nonzero)
(- qnew_b a b c d e f g h p1 p2 H_Qquadratic_sg_denom_nonzero)
(- qnew_c a b c d e f g h p1 p2 H_Qquadratic_sg_denom_nonzero)
(- qnew_d a b c d e f g h p1 p2 H_Qquadratic_sg_denom_nonzero)
(qnew_e a b c d e f g h p1 p2 H_Qquadratic_sg_denom_nonzero)
(qnew_f a b c d e f g h p1 p2 H_Qquadratic_sg_denom_nonzero)
(qnew_g a b c d e f g h p1 p2 H_Qquadratic_sg_denom_nonzero)
(qnew_h a b c d e f g h p1 p2 H_Qquadratic_sg_denom_nonzero)
(qnew_p1 a b c d e f g h p1 p2 H_Qquadratic_sg_denom_nonzero)
(qnew_p2 a b c d e f g h p1 p2 H_Qquadratic_sg_denom_nonzero)
hyp_quadraticAcc).