(***************************************************************************)
(* Formalization of the Chou, Gao and Zhang's decision procedure.          *)
(* Julien Narboux (Julien@narboux.fr)                                      *)
(* LIX/INRIA FUTURS 2004-2006                                              *)
(* University of Strasbourg 2008                                           *)
(***************************************************************************)
Require Export area_elimination_lemmas.
(********************************)
(** Length ratios eliminations *)
(********************************)
unfold on_line_d in |- *.
intuition.
Qed.
unfold on_line_d in |- *.
intuition.
Qed.
unfold on_line in |- *.
intuition.
Qed.
unfold on_line in |- *.
intuition.
Qed.
Proof with Geometry.
unfold on_line_d in |- *...
intros...
decompose [and] H; clear H...
assert (Col P Q A)...
assert (Col P Q Y)...
assert (Col P A Y); eauto with Geom...
assert (A ** P + P ** Y = A ** Y)...
rewrite <- H7...
rewrite H5...
field...
Qed.
Proof with Geometry.
intros.
assert (on_line_d Y P Q (P**Y/P**Q)).
unfold on_line_d.
unfold on_line in H.
intuition.
field.
Geometry.
apply elim_length_ratio_on_line_d_1;auto.
Qed.
Lemma
invariant_par_on_line_d_1_length_ratio :
forall (A C D P Q Y : Point) (lambda : F),
on_line_d Y P Q lambda -> S A P Q = 0 ->
parallel A Y C D -> parallel A P P Q.
Lemma
invariant_par_on_line_1_length_ratio :
forall (A C D P Q Y : Point),
on_line Y P Q -> S A P Q = 0 ->
parallel A Y C D -> parallel A P P Q.
Lemma
invariant_par_on_line_d_1_length_ratio_2 :
forall (A C D P Q Y : Point) (lambda : F),
on_line_d Y P Q lambda -> S A P Q = 0 -> A<>Y ->
parallel A Y C D -> parallel C D P Q.
Proof with Geometry.
intros.
assert (parallel P Q Y A).
unfold parallel, S4.
replace (S P Q A ) with 0.
ring_simplify.
2:symmetry...
unfold on_line_d in H.
decompose [and] H.
suppose (Col P Y Q)...
suppose (Col P Q A)...
unfold on_line_d in H.
decompose [and] H;clear H.
assert (Col P Q A)...
assert (Col P A Y).
eapply col_trans_1 with (B:=Q)...
assert (Col Q A Y).
eapply col_trans_1 with (B:=P)...
assert (parallel C D A P).
eapply col_par_par with (D:=Y)...
cases_equality P A.
subst P.
eapply col_par_par with (D:=Y)...
eapply col_par_par with (D:=A)...
Qed.
Proof with Geometry.
intros.
assert (on_line_d Y P Q (P**Y / P**Q)).
apply on_line_to_on_line_d...
eapply invariant_par_on_line_d_1_length_ratio_2;eauto.
Qed.
Proof with Geometry.
intros.
unfold parallel, on_line in *.
basic_simpl.
decompose [and] H.
replace (S P Y Q) with (- S Y P Q)...
Qed.
Proof with Geometry.
intros.
unfold parallel, on_line_d in *.
basic_simpl.
decompose [and] H.
replace (S P Y Q) with (- S Y P Q)...
Qed.
(* TODO update tactic to take care of C<>D *)
Proof with Geometry.
intros.
rename H2 into T.
unfold on_line_d in H.
decompose [and] H.
clear H.
assert (not (parallel A Y P Q)).
unfold not;intro.
unfold parallel, S4 in H.
assert ((S A Y Q) = (S A Y P) + (S A P Q) + (S P Y Q))...
rewrite H3 in H.
assert ((S A P Y) = - (S A Y P))...
rewrite H6 in H.
assert ((S P Y Q) = (-0)).
unfold Col in H2.
rewrite <- H2...
rewrite H7 in H.
assert  (-(S A Y P)+((S A Y P)+(S A P Q)+-0) = (S A P Q)).
ring.
rewrite H8 in H.
unfold Col in H0.
intuition.
unfold not;intro.
assert (parallel C D P Q)...
assert (parallel A Y P Q).
eapply parallel_transitivity;try apply H1 || auto.
auto.
intuition.
Qed.
Proof with Geometry.
intros.
assert (on_line_d Y P Q (P**Y/P**Q)).
apply on_line_to_on_line_d...
eapply non_zero_denom_on_line_d_2_length_ratio;eauto.
Qed.
Proof with Geometry.
unfold on_line_d.
intros.
DecompAndAll.
assert (~A=Y).
unfold not;intro.
subst A.
intuition.
assert (T:exists Y0 : Point,
Col Y0 A Y /\
A ** Y0 = C ** D /\ weak_3_parallelogram A Y0 D C).
apply on_line_dex_spec_strong_f...
DecompExAnd T SS.
assert (A<>SS).
unfold not;intro;subst SS.
basic_simpl.
assert (C=D)...
assert (A**Y / A**SS = (S A P Q)/(S4 A P SS Q)).
apply co_side_ter...
cases_equality P Y.
subst P.
unfold not;intro.
assert (Col A SS Q).
eapply (par_col_col_1).
apply H8.
Geometry.
assert (Col A Y Q).
eapply col_trans_1 with (B:=SS)...
intuition.
eapply common_point_not_par.
2:apply H3.
Geometry.
auto.
auto.
unfold not;intro.
assert (Col P Q A).
eapply col_trans_1 with (B:= Y)...
assert (Col A P Q)...
rewrite <- H9.
rewrite H8.
clear H8.
replace (S4 A P SS Q) with (S4 C P D Q).
auto.
replace (S4 C P D Q) with (- S4 P C Q D).
2:Geometry.
replace (S4 A P SS Q) with (- S4 P A Q SS).
2:Geometry.
replace (S4 P C Q D) with (S4 P A Q SS).
auto.
eapply l2_11b_strong_strong_strong...
Qed.
Proof with Geometry.
intros.
assert (on_line_d Y P Q (P**Y/P**Q)).
apply on_line_to_on_line_d...
eapply elim_length_ratio_on_line_d_2...
apply H3.
Qed.
Proof with Geometry.
intros.
unfold not;intro.
assert (parallel C D U V)...
assert (parallel A Y U V).
eapply parallel_transitivity;eauto.
unfold inter_ll in *.
DecompAndAll.
assert (Col A U V).
eapply par_col_col_3.
2:apply H8.
Geometry.
intuition.
Qed.
Proof with Geometry.
intros.
unfold inter_ll in *.
DecompAndAll.
apply (elim_length_ratio_on_line_2 A C D U V Y)...
unfold on_line.
split...
unfold not;intro;subst U...
Qed.
(* TODO A<>Y has been added check that implementation takes care of it *)
Proof with Geometry.
intros.
unfold not;intro.
assert (parallel C D P Q)...
assert (parallel A Y P Q).
eapply parallel_transitivity.
apply H1.
Geometry.
Geometry.
unfold inter_ll in *.
DecompAndAll.
assert (P<>Q).
unfold not;intro;subst P.
intuition.
assert (U<>V).
unfold not;intro;subst U.
intuition.
assert (Col A P Q).
eapply par_col_col_3.
2:apply H7.
Geometry.
assert (Col U A Y).
eapply col_trans_1 with (B:=V)...
assert (parallel P Q A U).
eapply col_par_par.
apply H2.
Geometry.
Geometry.
assert (U<>A).
unfold not;intro.
subst U.
assert (parallel P Q A V).
eapply col_par_par.
apply H2.
Geometry.
Geometry.
intuition.
assert (parallel P Q U V).
eapply col_par_par.
apply H14.
Geometry.
Geometry.
intuition.
Qed.
Proof with Geometry.
intros.
assert (S4 C P D Q <>0).
eapply non_zero_denom_inter_ll_2_length_ratio;eauto.
unfold inter_ll in *.
DecompAndAll.
cases_equality A Y.
subst Y.
rewrite H5.
basic_simpl.
field.
Geometry.
apply (elim_length_ratio_on_line_2 A C D)...
unfold on_line.
split...
unfold not;intro;subst Q...
unfold not;intro.
assert (P<>Q).
unfold not;intro;subst P...
assert (Col P A Y).
eapply col_trans_1 with (B:=Q)...
assert (parallel C D A P).
eapply col_par_par.
apply H.
Geometry.
Geometry.
assert (P<>A).
unfold not;intro.
subst P.
clear H6 H10 H11.
assert (~ parallel C D A Q)...
assert (parallel C D A Q).
eapply col_par_par.
apply H.
Geometry.
Geometry.
intuition.
assert (parallel C D P Q).
eapply col_par_par.
apply H12.
Geometry.
Geometry.
assert (~ parallel C D P Q)...
Qed.
Proof with Geometry.
intros.
unfold not;intro.
assert (parallel C D P Q)...
clear H3.
unfold on_parallel_d in *.
DecompAndAll.
assert (parallel A Y P Q).
eapply parallel_transitivity.
apply H1.
Geometry.
Geometry.
assert (parallel A Y Y R).
eapply parallel_transitivity.
apply H3.
Geometry.
Geometry.
assert (Col A Y R)...
unfold parallel, S4 in *.
basic_simpl.
Geometry.
assert (Col A R Y)...
Qed.
Proof with Geometry.
intros.
unfold on_parallel_d in *.
DecompAndAll.
split;intro.
subst Y.
basic_simpl.
IsoleVar (lambda) H3.
rewrite H3.
field...
Geometry.
subst lambda.
basic_simpl...
Qed.
Proof with Geometry.
intros.
unfold on_parallel_d in *.
DecompAndAll.
cut (parallel P Q R A)...
eapply col_par_par.
apply H1.
Geometry.
Geometry.
Qed.
Proof with Geometry.
intros.
unfold on_parallel_d in *.
DecompAndAll.
assert (parallel P Q Y A).
eapply col_par_par.
assert (Y<>R)...
apply H.
Geometry.
Geometry.
eapply parallel_transitivity.
apply H2.
Geometry.
Geometry.
Qed.
Proof with Geometry.
intros.
unfold on_parallel_d in H.
DecompAndAll.
assert (A ** Y + Y ** R = A ** R)...
assert (Y ** R = - R ** Y)...
rewrite H3 in H.
RewriteVar (A ** Y) H.
RewriteVar lambda H5...
field...
Qed.
Proof with Geometry.
intros.
unfold on_parallel_d in H.
DecompAndAll.
assert (~R=Y).
unfold not;intro;subst R...
assert (parallel R Y P Q)...
assert (Th:= (on_line_dex_spec_strong_f R Y P Q H4 H)).
DecompExAnd Th T.
assert (A<>Y).
unfold not;intro;subst...
assert (Th:= (on_line_dex_spec_strong_f A Y C D H2 H7)).
DecompExAnd Th SS.
assert (A**Y / A**SS = (S A R T) / (S4 A R SS T)).
apply co_side_ter...
assert (Col Y A SS)...
assert (Col Y R T)...
eapply common_point_not_par.
apply H9.
auto.
unfold not;intro;subst SS.
basic_simpl.
assert (C=D)...
unfold not;intro;subst T.
basic_simpl.
assert (P=Q)...
Geometry.
rewrite H14 in H9.
rewrite H9.
assert ((S A R T) = (S4 A P R Q)).
apply l2_12b_strong_3...
rewrite H13.
suppose ((S4 A R SS T) = (S4 C P D Q)).
congruence.
assert (weak_3_parallelogram C D SS A)...
assert ((S4 C R D T) = (S4 C P D Q)).
apply l2_11b_strong_strong_strong...
rewrite <- H17.
symmetry.
assert ((S4 C R D T) = -(S4 R C T D)).
Geometry.
assert ((S4 A R SS T) = -(S4 R A T SS)).
Geometry.
assert ((S4 R C T D) = (S4 R A T SS)).
apply l2_11b_strong_strong_strong.
trivial.
congruence.
Qed.
(** This lemma is here because the proof depends on ratios elimination lemmas *)
Proof with Geometry.
intros.
unfold on_inter_parallel_parallel in *.
DecompAndAll.
assert ((S A B Y) = (S A B W) + W**Y/U**V * (S4 A U B V)).
apply elim_area_on_parallel.
unfold on_parallel.
repeat split...
unfold not;intro;subst U...
assert (P<>Q).
unfold not;intro;subst P...
assert (U<>V).
unfold not;intro;subst U...
cases_equality Y W.
subst Y.
assert (parallel P Q W R)...
unfold parallel in H7.
rewrite H7.
field...
assert (~ Col W R Y).
unfold not;intro.
assert (parallel U V Y R).
eapply col_par_par.
apply H7.
Geometry.
Geometry.
assert (parallel U V P Q).
eapply parallel_transitivity with (C:=Y) (D:=R)...
intuition.
assert (W**Y/U**V = (S4 W P R Q) / (S4 U P V Q)).
eapply elim_length_ratio_on_parallel_d_2...
unfold on_parallel_d;repeat split...
assert (R**Y = R**Y / P**Q * P**Q).
field...
eauto.
rewrite H.
rewrite H9.
replace (S4 P U Q V) with (- S4 U P V Q)...
replace (S4 W P R Q) with (- S4 P W Q R)...
field;split...
Qed.

Lemma elim_area_on_inter_parallel_parallel_RY :
forall P Q R U V W Y A B : Point,
on_inter_parallel_parallel Y R P Q W U V ->
R = Y ->
S A B Y = S A B W +
(W ** R / P ** Q + R ** Y / P ** Q) / (U ** V / P ** Q) * S4 A U B V.